C   02/03/82 411121142  MEMBER NAME  TOFMAS   (S)           FORTRAN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       SUBROUTINE TOFMAS
C
C  DETERMINES TOF FOR EACH TRACK AND ITS QUALITY
C  CREATES BANK TOFR
C  USES SINGLE TRACK ALGORITHM AND OLD BANKFORMAT
C  CREATES BANK TOFR
C  LAST MODIFIED 25.6.82
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
#include "tcalcm1.for"
#include "tfprm.for"
#include "ddata.for"
#include "tfadc.for"
#include "chead.for"
      COMMON/PRPOS/PRPLS,CPOS
C
      DATA IENTRY/0/,IBUG/0/,NEXIST/0/
      DATA DTAU1/1./
C
      IF(IENTRY.NE.0)  GOTO 66
      IENTRY = IENTRY + 1
   66 ZTOF = 0.
C
      NRUN = HEADR(18)
C
C
      ZTOF1 = 0.
      NNG= 0
      NOK= 0
      CALL SETSL(IW,0,704*4,0)
      CALL SETSL(TAUM,0,84*4,0.)
      IBUG = IBUG + 1
      NTRR = 0
C
      DO 1000 I=1,42
      MTPY= ICRT1(2,I)
      IF(MTPY.EQ.0) GO TO 1000
      IF(MTPY.GE.4) MTPY = 3
C
      DO   1001   M=1,MTPY
      NTR1= ICRT1(M+2,I)
C
      ZTOF1 = -2000.
      ADCM = HADC(1,I) - PEDLM(I)
      ADCP = HADC(2,I) - PEDLP(I)
      CC2M = 0.
      IF(I.EQ.2.AND.ADCM.LT.25.) CC2M = 5.4
      IF(ADCM.LE.0.) ADCM = 1.
      IF(ADCP.LE.0.) ADCP = 1.
      IF(HADC(1,I).GT.1024) ADCM = 1024.
      IF(HADC(2,I).GT.1024) ADCP = 1024.
      Z1= TRK(1,NTR1)
      PATH1= TRK(3,NTR1)
      PMEV1= TRK(4,NTR1)
      TAUP1= RAW(3,I)+Z1/VELSC
      TAUM1= RAW(2,I)-Z1/VELSC
      TAUM1 = TAUM1 - (TPARM(7)*PATH1+TPARM(8))
      TAUP1 = TAUP1 - (TPARM(7)*PATH1+TPARM(8))
      IF(NRUN.GE.10000) TAUM1= RAW(2,I)-Z1*CADCA(2*I-1)
      IF(NRUN.GE.10000) TAUP1= RAW(3,I)-Z1*CADCA(2*I  )
C     PCOR = (PATH1-RADTOF)/CVEL
C     TAUM1 = TAUM1 - PCOR
C     TAUP1 = TAUP1 - PCOR
      IF(NRUN.LT.4993) GOTO  321
      IF(NRUN.GE.7592) GOTO  322
C  BEAM CURRENT CORR
      TAUM1 = TAUM1 - CPOS *TPARM(21)
      TAUP1 = TAUP1 - CPOS *TPARM(22)
C  AD HOC CORR FOR BEGIN 1981
  322 TAUM1 = TAUM1 - TPARM(25)
      TAUP1 = TAUP1 - TPARM(25)
      IF(NRUN.GT.6000.AND.NRUN.LT.7592) TAUM1 = TAUM1 +3.07
      IF(NRUN.GT.6000.AND.NRUN.LT.7592) TAUP1 = TAUP1 +3.07
      IF(NRUN.GE.10000) TAUM1= TAUM1+3.07
      IF(NRUN.GE.10000) TAUP1= TAUP1+3.07
      IF(NRUN.GE.10000.AND.I.EQ.2) TAUM1 = TAUM1  -CC2M
  321 CONTINUE
C
      NFLG= -1
      IF(HTDC(1,I).GT.10.AND.HTDC(1,I).LT.2048) GO TO 320
      TOF1= TAUP1
      TAUM1= -20.
      GO TO 360
C
  320 CONTINUE
      IF(HTDC(2,I).GT.10.AND.HTDC(2,I).LT.2048) GO TO 330
      TOF1= TAUM1
      TAUP1= -20.
      GO TO 360
C
  330 CONTINUE
      IF(ABS(TAUM1-TAUP1).LE.3.*DTAU1) GO TO 350
      IF(Z1.LT.0.) GO TO 340
      TOF1= TAUP1
      GO TO 360
 340  TOF1= TAUM1
      GO TO 360
C
 350  NFLG= 1
C
      VWM = TPARM(9)/ADCM+TPARM(10)
      VWP = TPARM(9)/ADCP+TPARM(10)
      VWM = 1./(VWM*VWM)
      VWP = 1./(VWP*VWP)
      TOF1 = (VWM*TAUM1+VWP*TAUP1)/(VWM+VWP)
      ZTOF1 =  (RAW(2,I)-RAW(3,I))/2.*VELSC
 360  CONTINUE
      NTRR = NTRR + 1
      IF(NTRR.GT.50)  GOTO  1001
      TAUM(I) = TAUM1
      TAUP(I) = TAUP1
      TDCM = HTDC(1,I)
      TDCP = HTDC(2,I)
      NFLG = NFLG * MTPY
      CALL CMASS( I,PMEV1,TOF1,PATH1,BET1,DBET1,EMAS12,DMAS1,
     -            PRO1,PKA1,PPI1,PEL1)
      CALL TFSTOR(NTR1,NFLG,I,TOF1,PATH1,BET1,DBET1,EMAS12,DMAS1,
     -            PRO1,PKA1,PPI1,PEL1,ZTOF1)
C           CALL TFSTOR(NTR1,NFLG,I,TOF1,PATH1,TDCM,TDCP,ADCM,ADCP,
C    -            TAUM1,TAUP1,ITRC(NTR1),0.,ZTOF1)
      NOK= NOK+1
C
 1001 CONTINUE
 1000 CONTINUE
C
C=========   HEADER PART
C
                 NXX= 0
                 DO 2000 I=1,NTRK
                 IF(IRELT(1,I).NE.0) GO TO 2000
                 CALL TFSTOR(I,10,0,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.)
                 NXX= NXX+1
 2000            CONTINUE
            INFM(1)= NTRK
            INFM(2)= NOK
            INFM(3)= NNG
            INFM(4)= NXX
            LTFR= 14*NTRK+4
C
C=========   STORE RESULT INTO CURRENT BUFFER
C
      CALL BCRE(INTR,'TOFR',0,LTFR,*3000,IER)
      IF(INTR.EQ.0.AND.IER.EQ.2) GO TO 3000
      IF(IER.NE.0) NEXIST = NEXIST + 1
      IF(IER.NE.0.AND. NEXIST.LE.5) PRINT 301,NEXIST
  301 FORMAT('  *********   TOFR BANK ALREADY EXISTS ,OVERWRITTEN',I5)
      CALL BSTR(INTR,IW,LTFR)
      CALL BSAT(1,'TOFR')
      RETURN
 3000 CONTINUE
C/////////
             WRITE(6,9300)
9300         FORMAT(1X,'BOS ERROR IN TOFMAS')
       RETURN
       END
