C   09/06/83 306282232  MEMBER NAME  ADCPLT   (S)           FORTRAN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       SUBROUTINE TOFMAS
C
C  THIS IS THE CALIBRATION VERSION      ********************
C  USING NEW TESTFILE CUPDAT1           ********************
C
C  DETERMINES TOF FOR EACH TRACK AND ITS QUALITY
C  CREATES BANK TOFR
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
#include "tfadc.for"
#include "tcalcm1.for"
#include "tfprm.for"
#include "ddata.for"
#include "chead.for"
      COMMON/EVRUN/NRUN,IEV,ITYP,NEV,IMISS
      COMMON/PRPOS/PRPLS,CPOS
      DIMENSION IAGREE(3),ZT(2),TMNUS(2),TPLUS(2),DELT(2)
      DIMENSION CORM(84),CM1(84)
C
      DATA IENTRY/0/,IBUG/0/,NEXIST/0/
      DATA CVEL/ 2.9979246E2/,DTAU1/1./
      DATA RADTOF/920./
      DATA IRUN/0/,CORM/84*0./
C
      IF(IENTRY.NE.0)  GOTO 66
      IENTRY = IENTRY + 1
C     READ(16) CM1
      GOTO  67
      READ(33) CORM
      DO   19   I=1,84
   19 CORM(I) = CORM(I) + CM1(I)
      PRINT 232,CORM
  232 FORMAT(' CM1  '/(1X,10F10.3))
      PRINT 232,CORM
C
   67 ZA = NRUN
      ZB = ZA + 500.
      ZA = 8700
      ZB = 9700
      ZA = 12500
      ZB = 13000
      ZA = 13000
      ZB = 13800
      CALL CNTFIT(1,I,TM,TP,T)
C
      CALL HDELET(0)
C
      ID = 2500
      IDL= 2600
C     CALL HBOOK2(701,' CORADM NCN $',50,-10.,10.,42,0.,42.)
C     CALL HBOOK2(702,' CORADP NCN $',50,-10.,10.,42,0.,42.)
      CALL HBOOK2(ID+57,' ADCM  ITOF $',100,0.,1000.,42,0.,42.)
      CALL HBOOK2(ID+58,' ADCP  ITOF $',100,0.,1000.,42,0.,42.)
      CALL HBPROX(ID+57)
      CALL HBPROX(ID+58)
      DO   64   I=1,42
      CALL HBOOK1(ID+I,' ADC  -/+      $',100,0.,1000.)
   64 CONTINUE
   66 ZTOF = 0.
C
      NRUN = HEADR(18)
   10 IRUN = NRUN
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
      IRESET = 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)
      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)
      TAUM1= RAW(2,I)-Z1/VELSC
      TAUP1= RAW(3,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  )
      PCOR = (PATH1-RADTOF)/CVEL
      TAUM1 = TAUM1 - PCOR
      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 SINCE 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.LT.10000) GOTO  321
      TAUM1 = TAUM1  + 3.07
      TAUP1 = TAUP1  + 3.07
      IF(NRUN.GT.12518) TAUM1 = TAUM1 - CORM(2*I-1)
      IF(NRUN.GT.12518) TAUP1 = TAUP1 - CORM(2*I)
      IF(NRUN.GT.12518) GOTO  321
  321 CONTINUE
      CALL HFILL(ID+57,ADCM,FLOAT(I))
      CALL HFILL(ID+58,ADCP,FLOAT(I))
      ADCML = ADCM
      IF(ADCML.GT.999.) ADCML = 999.
      ADCPL = ADCP
      IF(ADCPL.GT.999.) ADCPL = 999.
      CALL HFILL(ID+I,ADCML,1.)
      CALL HFILL(ID+I,ADCPL+1000.,1.)
      NOK= NOK+1
C
 1001 CONTINUE
 1000 CONTINUE
C
      RETURN
      END
