C   18/02/81 203121800  MEMBER NAME  TFPLOT   (S)           FORTRAN
      SUBROUTINE TFUNPK(IPTOFR,LHIST)
C
C   LHIST=1 PRODUCES ALL HISTOGRAMS
C
#include "tcalcm.for"
      COMMON/POINT/IPHEAD,IPLTCH,IPT1,IPTOF,IPCLST,IPR,IPPATR,IPNT(12),
     1             IPBP
      COMMON/EVRUN/NRUN,IEV,ITYP,NEV,IMISS
      COMMON/ENRGMG/BENGEV,BKGAUS,EGCOR
      COMMON/TOFHIT/XTOF(50),YTOF(50),ZTOF(50)
      COMMON/TRKINF/LTRK,DX1(10),DY1(10),DZ1(10),DXL(10),DYL(10),
     1            DZL(10),NXY(10),NRZ(10),CHIXY(10),ZPTOF(10),CHIRZ(10),
     2              X1(10),Y1(10),Z1(10),XL(10),YL(10),ZL(10),ZVER(10),
     3              NGOOD,IGOOD(10),PMOM(10),FI1(10),FIL(10),
     4              NFIN,ITRK1(10),ITRK2(10),RMIN(10)
      COMMON/TOFRES/TOFLGT(10),TDT(10),TDR(10),BETA(10),IQUAL(10)
     1          ,ITOFHT(10),PATH(10),MUCAND,IMUCND(10),NMU,IMUFIN(10)
     2          ,TAUMR(42),TAUPR(42)
      COMMON/TRACC/NACC,ALF(10),NMALF
      COMMON/DT4/NTGOOD(10),DDT1(10),DDT2(10),DDT3(10),DDT4(10)
      COMMON/BCS/IDATA(5000)
      COMMON/INOUT/WRITFL,EVWRIT
      COMMON/FLAGS/HISTFL,PRFL,NPRLIM
      LOGICAL WRITFL,EVWRIT,HISTFL,PRFL
      DIMENSION DATA(2000),KKREJ(10),JTRK(2)
      EQUIVALENCE(IDATA(1),DATA(1))
      DIMENSION RTOF(14,50),ITOF(14,50)
      EQUIVALENCE (RTOF(1,1),ITOF(1,1))
C
      DATA IBUG/30/,KBUG/ 0/,IENTRY/0/,JBUG/  0/,KERR/0/
      DATA LBUG/0/,NPRREJ/0/
      DATA CVEL/  2.997925E2 /,RADTOF/920./
C
      IF(IENTRY.NE.0)  GOTO  19
      IENTRY = 1
      CFIC = 3.142/12.
      CTOF = 6.284/42.
      CTOF2= CTOF/2.
      ZA = 1660.
      ZB = 5660.
C     CALL HDELET(0)
      CALL HBOOK1(3507,20HREJECT CODES       $,100,0.,100.)
      IF(LHIST.NE.1)  GOTO  19
      CALL HTABLE(1701,10HLAST CELL$,24,1.,25.,13,12.,25.,63.)
      CALL HTABLE(1702,20H  TOFCOUNTERS      $,22,0.,22.,22,20.,42.,63.)
      CALL HTABLE(1707,20H  TOFCOUNTERS      $,22,0.,22.,22,20.,42.,63.)
      CALL HBOOK1(1708,20H TOFCOUNTERS       $, 50,0.,50.)
      CALL HTABLE(1703,' TOF CNTR FLAG $',42,0.,42.,3,-1.,1.,511.)
      CALL HBOOK2(1704,20HT1 T2              $,40,-5.,15.,40,-5.,15.)
      CALL HBOOK1(1705,20HTDT                $,100,-10.,15.)
      CALL HBOOK2(1706,15HLTGOOD DT1800 $,100,-10.,15.,5,0.,5.)
      CALL HBOOK2(1710,15HDT1800 ITOF   $,100,-5.,15.,42,0.,42.)
      CALL HBOOK2(1711,15HTAUM   ITOF   $,100,-5.,15.,42,0.,42.)
      CALL HBOOK2(1712,15HTAUP   ITOF   $,100,-5.,15.,42,0.,42.)
      CALL HBOOK2(1720,' NRUN TM    $',100,ZA,ZB,40,0.,10.)
      CALL HBOOK2(1721,' NRUN TP    $',100,ZA,ZB,40,0.,10.)
C
   19 CONTINUE
      EVWRIT = .FALSE.
      CALL SETSL(KKREJ,0,40,0)
      MUCAND = 0
      NTR = IDATA(IPTOFR+1)
      CALL HF1(3507,20.,1.)
      KREJ = 70
      IF(NTR.LE.0) GOTO  60
      KREJ = 72
      CALL HF1(3507,22.,1.)
C
      IF(IBUG.LE.10) PRINT 106,NRUN,NEV,IEV,NTR,NOHIT
  106 FORMAT(' TOFKAW NTR',8I5)
C
      DO   1   N=1,50
      DO   1   I=1,14
      RTOF(I,N) = DATA(IPTOFR+4+(N-1)*14+I)
    1 CONTINUE
C
      KREJ = 74
      IF(NFIN.LT.1) GOTO  60
      CALL HF1(3507,23.,1.)
      IF(NTRK.GT.15) GOTO  60
      IF(NFIN.GT.10) NFIN = 10
      KREJ = 76
      CALL HF1(3507,24.,1.)
C

      CALL BHAREJ(IREJ,1)
      IF(IREJ.GT.0)  RETURN
      CALL HF1(3507,28.,1.)
C
      JBUG = JBUG + 1
      IMU = 0
      CALL ALPHA
      CALL SETSL(TOFLGT,0,4*92,0)
C
      DO   4   M=1,NFIN
      CALL HF1(3507,48.,1.)
      KKREJ(M) = 90
      I1 = ITRK1(M)
      I2 = ITRK2(M)
      P1 = ABS(PMOM(I1))
      P2 = ABS(PMOM(I2))
      IF(P1.LT.1..OR.P2.LT.1.)  GOTO  4
      CALL HFILL(1702,FLOAT(ITRC(I1)),FLOAT(ITRC(I2)))
      CALL HF1(3507,50.,1.)
C
      L1 = I1
      L2 = I2
C
      IF(L1.LE.0.OR.L2.LE.0)  GOTO  4
      CALL HF1(3507,54.,1.)
      KKREJ(M) = 91
      IF(ITOF(3,L1).LT.ITOF(3,L2))  GOTO  5
      J1 = I1
      I1 = I2
      I2 = J1
      J1 = L1
      L1 = L2
      L2 = J1
    5 CONTINUE
      ITRK1(M) = I1
      ITRK2(M) = I2
      IF(ITOF(1,L1).NE.I1.OR.ITOF(1,L2).NE.I2) GOTO  997
      CALL HF1(3507,56.,1.)
      KKREJ(M) = 92
C
      ITOF1 = ITOF(3,L1)
      ITOF2 = ITOF(3,L2)
      CALL HF1(3507,58.,1.)
      KKREJ(M) = 93
      KBUG = KBUG + 1
      IF(JBUG.LE.10) PRINT 108,NFIN,I1,I2,ITOF(2,I1),ITOF(2,I2)
  108 FORMAT(' NFIN,...',10I5)
      IF(ITOF1.GT.25)  PRINT 540
  540 FORMAT(' == TFUNPK == ITOF1 GT 25!!!'/)
      IF(ITOF1.GT.25)  CALL PRTOFR(IPTOFR)
      IF(ITOF1.GT.25)  GOTO  4
      KKREJ(M) = 94
C
C  CHECK QUALITY OF TOF DETERMINATION
C
       KKREJ(M) = 95
      CALL HFILL(1703,FLOAT(ITOF1),FLOAT(ITOF(2,L1)))
      CALL HFILL(1703,FLOAT(ITOF2),FLOAT(ITOF(2,L2)))
      IF(IABS(ITOF(2,L1)).NE.1)  GOTO  4
      IF(IABS(ITOF(2,L2)).NE.1)  GOTO  4
      CALL HF1(3507,60.,1.)
      IDTOF = IABS(ITOF1-ITOF2)
      KKREJ(M) = 96
      IF(IABS(IDTOF-21).GT.3)  GOTO  4
C
      PCOR1 = (RTOF(5,L1)-RADTOF)/CVEL
      PCOR2 = (RTOF(5,L2)-RADTOF)/CVEL
      T1 = RTOF(4,L1)-PCOR1
      T2 = RTOF(4,L2)-PCOR2
      TAUMR(ITOF1) = TAUM(ITOF1)-PCOR1
      TAUPR(ITOF1) = TAUP(ITOF1)-PCOR1
      TAUMR(ITOF2) = TAUM(ITOF2)-PCOR2
      TAUPR(ITOF2) = TAUP(ITOF2)-PCOR2
      DT1= ABS(TAUP(ITOF2)-TAUP(ITOF1))
      DT2= ABS(TAUM(ITOF2)-TAUM(ITOF1))
      DT3= ABS(TAUP(ITOF2)-TAUM(ITOF1))
      DT4= ABS(TAUM(ITOF2)-TAUP(ITOF1))
      LTGOOD = 0
      IF(DT1.LT.4.) LTGOOD = LTGOOD+1
      IF(DT2.LT.4.) LTGOOD = LTGOOD+1
      IF(DT3.LT.4.) LTGOOD = LTGOOD+1
      IF(DT4.LT.4.) LTGOOD = LTGOOD+1
      CALL HF1(3507,FLOAT(LTGOOD)+70.,1.)
      IF(ITOF(2,L1)*ITOF(2,L2).LT.0)
     *CALL HF1(3507,FLOAT(LTGOOD)+80.,1.)
      PATH1= RTOF(5,L1) + RTOF(5,L2)
      KKREJ(M) = 97
      IF(PATH1.LE.1.)  GOTO  4
      IF(JBUG.LE.10) PRINT 109,M,ITOF1,ITOF2,T1,T2,RTOF(5,L1),RTOF(5,L2)
  109 FORMAT('   ITOF1,2,...',3I5,8F10.2)
      DT1800 = T2-T1
      IF(LHIST.EQ.1) CALL HFILL(1706,DT1800,FLOAT(LTGOOD),1.)
      IF(LHIST.EQ.1) CALL HFILL(1710,DT1800,FLOAT(ITOF1),1.)
      IF(LHIST.EQ.1) CALL HFILL(1704,T1,T2,1.)
      IF(LHIST.EQ.1) CALL HF1(1705,DT1800,1.)
      IF(DT1800.LE.4.5) CALL HF1(3507,62.,1.)
      IF(LTGOOD.GE.2) CALL HF1(3507,64.,1.)
C
C   SPECIAL CUT FOR PLOCUT
C
      IF(ABS(T1-5.).GT.15.)  GOTO  4
      IF(ABS(T2-5.).GT.15.)  GOTO  4
      IF(DT1800.GT.4.5.AND.LTGOOD.LT.1)  GOTO  4
C
C CALCULATE WHICH CELL LAST POINT IS IN
      IC1 = FIL(I1)/CFIC+1
      IC2 = FIL(I2)/CFIC+1
      CALL HFILL(1701,FLOAT(IC1),FLOAT(IC2))
      CALL HF1(1708,FLOAT(ITOF1),1.)
      CALL HF1(1708,FLOAT(ITOF2),1.)
      CALL HFILL(1707,FLOAT(ITOF1),FLOAT(ITOF2))
      CALL HFILL(1711,TAUMR(ITOF1),FLOAT(ITOF1))
      CALL HFILL(1711,TAUMR(ITOF2),FLOAT(ITOF2))
      CALL HFILL(1712,TAUPR(ITOF1),FLOAT(ITOF1))
      CALL HFILL(1712,TAUPR(ITOF2),FLOAT(ITOF2))
      CALL HFILL(1720,FLOAT(NRUN),TAUMR(ITOF1))
      CALL HFILL(1720,FLOAT(NRUN),TAUMR(ITOF2))
      CALL HFILL(1721,FLOAT(NRUN),TAUPR(ITOF1))
      CALL HFILL(1721,FLOAT(NRUN),TAUPR(ITOF2))
C
    7 IMU = IMU + 1
      IF(IMU.GT.10)  GOTO  4
      KKREJ(M) = 98
      TDT(IMU) = DT1800
      IMUCND(IMU) = M
      NTGOOD(IMU) = LTGOOD
      DDT1(IMU) = DT1
      DDT2(IMU) = DT2
      DDT3(IMU) = DT3
      DDT4(IMU) = DT4
C
      TDR(I1) = T1
      TDR(I2) = T2
      ITOFHT(I1) = ITOF1
      ITOFHT(I2) = ITOF2
      TOFLGT(I1) = RTOF(4,L1)
      TOFLGT(I2) = RTOF(4,L2)
      PATH(I1) = RTOF(5,L1)
      PATH(I2) = RTOF(5,L2)
      BETA(I1) = RTOF(6,L1)
      BETA(I2) = RTOF(6,L2)
      IQUAL(I1) = ITOF(2,L1)
      IQUAL(I2) = ITOF(2,L2)
    4 CONTINUE
C
      MUCAND = IMU
      IF(IMU.GT.0) EVWRIT = .TRUE.
      IF(IMU .GT.0) KREJ = 80
      IF(EVWRIT) CALL HF1(3507,40.,1.)
      CALL HF1(200,FLOAT(IMU)+50.,1.)
C
   60 CONTINUE
      IF(MUCAND.LE.0) NPRREJ = NPRREJ + 1
      IF(MUCAND.LE.0.AND.NPRREJ.LE. 0)
     1  PRINT 701,NRUN,IEV,NEV,KREJ,KKREJ
  701 FORMAT(' REJECTED TFUNPK ',3I6,5X,I2,5X,10I3)
C
      RETURN
  997 CONTINUE
      KERR = KERR + 1
      IF(KERR.GT.20) RETURN
      PRINT 118
  118 FORMAT(' ERROR IN TOFR BANK')
      RETURN
      END
