C   11/01/79 008141207  MEMBER NAME  TOFCOR                 FORTRAN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       SUBROUTINE TOFCOR
C
C         MATCHING BETWEEN THE TOF COUNTERS AND
C         THE PARTICLE TRAJECTORIES DEFINED
C         BY THE INNER DETECTORS.
C         CODED AT 07.11.78
C         CHANGED AT 3.3.1980 BEATE NAROSKA
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       COMMON/CWORK/NR,RAW(5,42),NC,ICRT1(5,42),NTRK,ICRT2(50),TRK(5,50)
     - ,ITRC(50),NTC,ITRK(5,42),INFM(4),IR(14,50)
       DIMENSION IRAW(5,42)
       EQUIVALENCE (IRAW(1,1),RAW(1,1))
C
       DATA PAI/3.1415927/,RTOF/920./
       DATA XPAI/.14960/,SQRAD/.36742/,DSTAN/.01/
      DATA IBUG/50/
C
C=========   ININTIALIZATION OF CORRESPONDENCE TABLE
C
      IBUG = IBUG + 1
       CALL SETSL(ICRT1,0,42*20,0)
       CALL SETSL(ICRT2,0,200,0)
C
C---------------------------------------------------------------------
C   SEARCH TRACKS HITTING A PARTICULAR COUNTER,THAT HAD EITHER EXACTLY
C   ONE TRACK EXTRAPOLATING TO IT OR NONE
C---------------------------------------------------------------------
C
       DO 1000 NCNT=1,42
C=========   COUNTER(NCNT) WAS HIT OR NOT
       IF(IRAW(1,NCNT).LE.0) GO TO 1000
       NC1=NCNT-1
       IF(NCNT.EQ.1) NC1=42
       NC2=NCNT+1
       IF(NCNT.EQ.42) NC2=1
C
C==========   ONE HIT IN THIS COUNTER
C
       IF(ITRK(2,NCNT).NE.1) GO TO 300
C
C
 200        ICNT= ICRT1(2,NCNT) + 1
            ICRT1(2,NCNT)= ICNT
            ICRT1(1,NCNT)= NCNT
            JTRK= ITRK(3,NCNT)
            ICRT2(JTRK)= NCNT
            ICRT1(ICNT+2,NCNT)= JTRK
            GO TO 1000
C
C  NO TRACK EXTRAPOLATES TO THIS COUNTER
C  LOOK FOR A TRACK WITHIN MLTPLE SCATTERING RESOLUTION
C
 300  IF(ITRK(2,NCNT).NE.0) GO TO 1000
      DO   350   N=1,2
      NC1 = NCNT-1+(N-1)*2
      IF(NC1.LT.1) NC1 = NC1 + 42
      IF(NC1.GT.42) NC1 = NC1 - 42
      PH1= (FLOAT(NCNT)-3./2.)*XPAI
      IF(N.EQ.2) PH1= PH1 + XPAI
      IF(PH1.LT.0.) PH1= PH1+2.*PAI
            MTRK=ITRK(2,NC1)
            PHMN=100.
            IF(MTRK.EQ.0) GO TO 350
            IF(IRAW(1,NC1).LE.0) GO TO 310
C  IF ADJACENT COUNTER WAS SET TAKE ONLY CASES WITH TWO OR MORE TRACKS
            IF(MTRK.EQ.1) GO TO 350
            IF(MTRK.GT.3) MTRK = 3
C SEARCH CLOSEST TRACK TO THE LOWER EDGE OF THE COUNTER
 310             DO 320 I=1,MTRK
                 K= ITRK(I+2,NC1)
                 DPH= ABS(TRK(2,K)-PH1)
                 IF(DPH.GE.PHMN) GO TO 320
                 PHMN= DPH
                 KTR= I
                 KCN= NC1
 320             CONTINUE
      IF(PHMN.GE.1.)  GOTO 350
C
      IF(IBUG.LE.20) PRINT 502,NCNT,KCN,KTR,PHMN
  502 FORMAT('  NO HIT IN',2I5,' TRACK ',I5,F10.2)
C COMPUTE ANGLE OF TRACK TO THE HIT COUNTER FROM THE SCATTERING
C CENTER AT R = 841 MM(OUTER TANK)
C     DL = PHMN*RTOF
C     PHSC = DL/80.
C CALCULATE MLTPL SCATTERING DEV ASSUMING PART IS A PION
C     DSCAT = DSTAN
      JTRK= ITRK(KTR+2,KCN)
C     PMEV = ABS(TRK(4,JTRK))*1000.
C     IF(PMEV.LT..050)  GOTO 30
C     BETA = PMEV/SQRT(PMEV**2+140.**2)
C     DSCAT = 15./PMEV/BETA*SQRAD
C     DSCAT = AMIN1(DSCAT,DSTAN)
      IF(IBUG.LE.20) PRINT 501,JTRK,NCNT,KCN,PHMN
   30 IF(PHMN.GT..03) GO TO 350
  501 FORMAT(/' TOFCOR ', 3I5,54F10.3)
C
C  CHECK QUALITY OF TOF DETERMINATION
      CALL TOFBRA(NCNT,JTRK,IFLG)
      IF(IBUG.LE.20) PRINT 501,IFLG
      IF(IFLG.NE.1)  GOTO  350
C FOUND A MATCHING TRACK
            ICNT= ICRT1(2,NCNT)+1
            ICRT1(2,NCNT)= ICNT
            ICRT2(JTRK)= NCNT
            ICRT1(1,NCNT)= NCNT
            IF(ICNT.GE.4) GO TO 1000
            ICRT1(ICNT+2,NCNT)= JTRK
      GOTO  1000
  350 CONTINUE
 1000  CONTINUE
C
C-----------------------------------------------------------------------
C ASSIGN COUNTERS WITH MULTIPLE HITS AND TRACKS THE CORRESPONDING
C LATCH OF WHICH WAS NOT SET
C-----------------------------------------------------------------------
C
            DO 2000 LTRK=1,NTRK
            IF(ICRT2(LTRK).GT.0) GO TO 2000
            NCN= ITRC(LTRK)
            IF(NCN.GE.1.AND.NCN.LE.42) GO TO 1050
            ICRT2(LTRK)= -1
            GO TO 2000
 1050       CONTINUE
C
C=========   MANY HITS IN A COUNTER
C
            IF(IRAW(1,NCN).LE.0) GO TO 1500
                 MTRK=ITRK(2,NCN)
                 IF(MTRK.GE.4) GO TO 1200
                 IF(MTRK.LE.1) GO TO 1500
                      MTRK1=MTRK+2
                      DO 1100 I=3,MTRK1
                      IF(LTRK.EQ.ITRK(I,NCN)) GO TO 1200
 1100                 CONTINUE
                      GO TO 1500
 1200            ICNT=ICRT1(2,NCN)+1
                 ICRT1(2,NCN)=ICNT
                 ICRT2(LTRK)= NCN
                 ICRT1(1,NCN)= NCN
                 IF(ICNT.GE.4) GO TO 2000
                 ICRT1(ICNT+2,NCN)=LTRK
                 GO TO 2000
 1500      CONTINUE
C
C=========   LATCH WAS NOT SET
C    LOOK IN ADJACENT COUNTERS
C
           DO 1700 I=1,2
           NC1=NCN-1+2*(I-1)
           IF(NCN.EQ.1.AND.I.EQ.1) NC1=42
           IF(NCN.EQ.42.AND.I.EQ.2) NC1=1
           IF(IRAW(1,NC1).LE.0) GO TO 1700
                PH1=(FLOAT(NCN)-3./2.)*XPAI
                IF(I.EQ.2) PH1=PH1+XPAI
                IF(PH1.LE.0.) PH1=PH1+2.*PAI
                DPH=ABS(TRK(2,LTRK)-PH1)
      IF(IBUG.LE.20) PRINT 503,LTRK,NCN,NC1,DPH
  503 FORMAT(' TRACK',I5,' HITS ',I5,' TRY CNTR ',I5,F10.2)
C     DL = DPH*RTOF
C     PHSC = DL/80.
C CALCULATE MLTPL SCATTERING DEV ASSUMING PART IS A PION
C     DSCAT = DSTAN
C     PMEV = ABS(TRK(4,LTRK))*1000.
C     IF(ABS(PMEV).LT..050)  GOTO  40
C     BETA = PMEV/SQRT(PMEV**2+140.**2)
C     DSCAT = 15./PMEV/BETA*SQRAD
      IF(IBUG.LE.20) PRINT 501,LTRK,NCN,NC1,DPH
C     DSCAT = AMIN1(DSCAT,DSTAN)
   40 IF(DPH.GT..03) GO TO 1700
C  CHECK QUALITY OF TOF DETERMINATION
      CALL TOFBRA(NC1,LTRK,IFLG)
      IF(IBUG.LE.20) PRINT 501,IFLG
      IF(IFLG.NE.1)  GOTO  1700
           ICNT=ICRT1(2,NC1)+1
           ICRT1(2,NC1)=ICNT
           ICRT2(LTRK)= NC1
           ICRT1(1,NC1)= NC1
           IF(ICNT.GE.4) GO TO 2000
           ICRT1(ICNT+2,NC1)= LTRK
           ICRT2(LTRK)= NC1
           ICRT1(1,NC1)= NC1
           GO TO 2000
 1700      CONTINUE
C
 2000  CONTINUE
           RETURN
           END
