C   12/09/79 501101126  MEMBER NAME  TOFMA5   (S)           FORTRAN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       SUBROUTINE TOFMA2
C
C  DETERMINES TOF FOR EACH TRACK AND ITS QUALITY
C  CREATES BANK TOFR
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       INTEGER *2 HADC,HTDC,HB
       REAL *8 DYC1,DYC2,C,D,FNORM
       COMMON/TFPRM/ NRNC1,NRNC2,DYC1,DYC2,IFLC(42),CM(42),CP(42),
     -DTAU(42),WM(42),WP(42),SV(42),DM(42),DP(42),PEDLM(42),PEDLP(42)
       COMMON/CWORK/NR,RAW(5,42),NC,ICRT1(5,42),NTRK,ICRT2(50),TRK(5,50)
     - ,ITRC(50),NTC,ITRK(5,42),INFM(4),IRELT(14,50)
      COMMON/EVRUN/NRUN,IEV,ITYP,NEV,IMISS,ZARUN,ZBRUN
       COMMON/TFPED/ HADC(2,42),HTDC(2,42),HB(42)
      COMMON/TMTP/TAUM(42),TAUP(42)
       DIMENSION IRAW(5,42),IW(704)
       EQUIVALENCE (IRAW(1,1),RAW(1,1)),(IW(1),INFM(1)),
     -             (IW(5),IRELT(1,1))
       DIMENSION IAGREE(3),ZT(2),TMNUS(2),TPLUS(2),DELT(2)
      DATA IENTRY/0/,IBUG/10/
      DATA CVEL/ 2.9979246E2/,DTAU1/1./
      IF(IENTRY.NE.0)  GOTO 66
      IENTRY = IENTRY + 1
      GOTO  66
   66 ZTOF = 0.
      ZTOF1 = 0.
       NNG= 0
       NOK= 0
       NTRR = 0
       CALL SETSL(IW,0,704*4,0)
       CALL SETSL(TAUM,0,84*4,0.)
C
       IBUG = IBUG + 1
      DO 1000 I=1,42
      TRANS= SV(I)
      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
      Z1= TRK(1,NTR1)
      PATH1= TRK(3,NTR1)
      PMEV1= TRK(4,NTR1)
      TAUM1= RAW(2,I)-Z1/TRANS
      TAUP1= RAW(3,I)+Z1/TRANS
      C = FNORM(0)
      D = FNORM(0)
      C = C*0.4
      D = D*0.4
      CALL HF1(555,C,1.)
      TAUM1 = TAUM1 + C
      TAUP1 = TAUP1 + D
      IF(IBUG.LE.10) PRINT 109,I,RAW(2,I),RAW(3,I),Z1,TRANS
  109 FORMAT(' TOFMA2',I5,10F10.3)

      TAUM(I) = TAUM1
      TAUP(I) = TAUP1
      NFLG= -1
            IF(HTDC(1,I).GT.10.AND.HTDC(1,I).LT.2048) GO TO 320
            TOF1= TAUP1
            GO TO 360
C
 320        IF(HTDC(2,I).LT.2048) GO TO 330
            TOF1= TAUM1
            GO TO 360
C
  330 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
      TOF1= (TAUM1+TAUP1)/2.
      ZTOF1 = (RAW(2,I)-RAW(3,I))/2.*TRANS
 360  CONTINUE
      NTRR = NTRR + 1
      IF(NTRR.GT.50)  GOTO  1001
      IF(IBUG.LE.10) PRINT 170, NEV, NTRR,NTR1,I,ITOF1,ITRC(NTR1)
  170 FORMAT(' TOFMA2',10I8)
      TDCM = HTDC(1,I)
      TDCP = HTDC(2,I)
      ADCM = HADC(1,I)
      ADCP = HADC(2,I)
      BETA1 = PATH1/TOF1/CVEL
      IF(IBUG.LE.10) PRINT 171, TAUM1,TAUP1,TOF1,BETA1,Z1,PATH1
  171 FORMAT(' TOFMA2',10F10.3)
      CALL TFSTOR(NTRR,NTR1,NFLG,I,TOF1,PATH1,TDCM,TDCP,ADCM,ADCP,
     -            TAUM1,TAUP1,ITRC(NTR1),BETA1,ZTOF1)
      NOK= NOK+1
CXXXXXXXXXX
 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
       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
