C   10/01/82 206241813  MEMBER NAME  MNSMP    (S)           FORTRAN
      SUBROUTINE TSTLAR
      INTEGER *2 HDATA
      COMMON/BCS/IDATA(30000)
      COMMON/TOFRES/TOFLGT(10),TDT(10),TDR(10),BETA(10),IQUAL(10)
     1          ,ITOFHT(10),PATH(10),MUCAND,IMUCND(10),NMU,IMUFIN(10)
     2          ,TAUR(42,2)
      COMMON/TRKINF/NTRK,DX1(10),DY1(10),DZ1(10),DXL(10),DYL(10),
     1              DZL(10),NXY(10),NRZ(10),CHIXY(10),DRZ(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),R1(10),RL(10)
      COMMON/POINT/IPHEAD,IPLTCH,IPT1,IPTOF,IPCLST,IPR,IPPATR,IPNT(12),
     1             IPBP
      COMMON/PEDOLD/PEDLST(84)
      COMMON/ENRGMG/BENGEV,BKGAUS,EGCOR
      COMMON/CIOUNI/IUNIT,JUNIT,NCALI,KUNITA(10),LUNITA(10)
      COMMON/CGRAPH/ JUSCRN
      DIMENSION RDATA(6000),HDATA(12000),PH(10),SIG(3)
      EQUIVALENCE(IDATA(1),RDATA(1)),(HDATA(1),IDATA(1))
      COMMON/PU/ NTOF,NBEAM,IHIT(200),DPHI
      COMMON/EVRUN/NRUN,IEV,ITYP,NEV,IMISS
      COMMON/FLAGS/HISTFL,PRFL,NPRLIM
      COMMON/INOUT/WRITFL,EVWRIT
      LOGICAL WRITFL,EVWRIT,HISTFL,PRFL
      DIMENSION IBERR(10)
      DIMENSION LRUN(20),JELIM(100,3)
C
      DATA NUN/2/
C
      READ 501,HISTFL,PRFL,NPRLIM
  501 FORMAT(3I5)
      PRINT 502,HISTFL,PRFL,NPRLIM
  502 FORMAT(' FLAGS',2L10,I10)
      NCALI = 2
      KUNITA(1) = 10
      KUNITA(2) = 11
      LUNITA(1) = 21
      LUNITA(2) = 22
      JUSCRN = 6
C
      CALL SETSL(IBERR,0,40,0)
      CALL SETSL(JELIM,0,1200,0)
      IWRITE =0
      IFILE = 0
      NUMRUN = 0
      NBHABH = 0
      NELIM = 0
      WRITFL = .FALSE.
      WRITFL = .TRUE.
      CALL BINT(30000,4000,500,0)
      IF(WRITFL) CALL BWRO(3,1558,2)
      CALL STBUK(40000)
C     CALL PEDINT
      CALL LGINIT
      NAC = 0
      NEV = 0
      LL = 0
      IRUN = 0
      NHERE = 0
      IFIRST = 0
C     CALL MUINI
C
C  LOCATE BOS BANKS
C
      IQPATR = IBLN('PATR')
      IQTOF = IBLN('ATOF')
      IQHEAD = IBLN('HEAD')
      IQTOFR = IBLN('TOFR')
      IQLTCH = IBLN('LATC')
      IQCLST = IBLN('LGCL')
C
      DO   1   N=1,50000
  77  CONTINUE
      EVWRIT = .FALSE.
      IF(IUHR(5).NE.1)  GOTO  7002
      CALL BSLT
      CALL BDLG
      CALL BREAD(NUN,&1000,&7000)
      IPHEAD = IDATA(IQHEAD)
      IF(IPHEAD.LE.0)  GOTO  2000
      NRUN = HDATA(IPHEAD*2+10)
      NEV = NEV + 1
      IEV=HDATA(2*IPHEAD+11)
C WATERLEAK
      IF(NRUN.GE.3560.AND.NRUN.LT.3728)  GOTO  2
C FLAT CABLES INTER CHANGED 25-21  29-35
      IF(NRUN.GE.5064.AND.NRUN.LT.5141)  GOTO  2
      NAC = NAC + 1
C     CALL ELIM(NRUN,IEV,1,LOUT)
C     IF(LOUT.NE.0) GOTO  17
      IGAUS = HDATA(IPHEAD*2+30)
      BKGAUS = FLOAT(IGAUS)/1000.
      BENGEV = 0.001*HDATA(IPHEAD*2+29 )
      EGCOR = EBEAM(HDATA(IPHEAD*2+10))/1000.
C     IF(EGCOR.LT.10.)  GOTO 17
      CALL HF1(111,BKGAUS,1.)
      CALL HF1(112,BENGEV,1.)
      IF(NRUN.EQ.IRUN)  GOTO  74
      LL = LL + 1
      LRUN(LL) = NRUN
      IF(LL.LT.20)  GOTO  73
      LL = 0
      NUMRUN = NUMRUN + 1
      PRINT 704,LRUN
  704 FORMAT('  RUNS  ',20I5)
      CALL SETSL(LRUN,0,80,0)
   73 CALL KLREAD(KALRET)
      IF(KALRET.NE.0) GOTO 300
C     CALL MUREG(0)
   74 IRUN = NRUN
      ITYP=HDATA(2*IPHEAD+12)
      IF(ITYP.GE. 64) GOTO  2
      IPLTCH = IDATA(IQLTCH)
      IF(IPLTCH.LE.0)  GOTO  2002
C     IPPATR = IDATA(IBLN('PATR'))
C     IF(IPPATR.LE.0) GOTO  2003
C     CALL STOTRK(IPPATR,0,1,0,1)
C     IF(NFIN.LE.0)  GOTO  2
      CALL BLOC(IPTOF,'ATOF',0,&400)
      CALL TOFSMP(NRUN)
      CALL COMPR(NRUN)
      CALL PLSMP
      IF(NEV.LE.2) CALL ATOFPR(IPTOF)
C     IF(NEV.LE.2) CALL PRSMP
   22 IWRITE = IWRITE+ 1
      IF(IWRITE.GT.100) GOTO  2
      IF(.NOT.WRITFL) GOTO  2
C     CALL BSAW(1,'TOFR')
      CALL BSLW
      CALL BWRITE(3)
      GOTO  1
   17 CONTINUE
      NELIM = NELIM + 1
      IF(NELIM.GT.100)  GOTO  1
      JELIM(NELIM,1) = NRUN
      JELIM(NELIM,2) = IEV
      JELIM(NELIM,3) = LOUT
    2 GOTO  1
 3000 PRINT 3010
 3010 FORMAT(' ERROR RETURN FROM TOFINT')
      GOTO  2
 3001 PRINT 3011
 3011 FORMAT(' ERROR RETURN FROM TOFMAS')
      GOTO  2
2000  IBERR(1) = IBERR(1) + 1
      GOTO 77
2002  IBERR(2) = IBERR(2) + 1
      GOTO 77
2003  IBERR(3) = IBERR(3) + 1
      GOTO 77
2004  IBERR(4) = IBERR(4) + 1
      GOTO 77
2005  IBERR(5) = IBERR(5) + 1
      GOTO  77
 400  IBERR(6) = IBERR(6) + 1
      GOTO  77
 401  IBERR(7) = IBERR(7) + 1
      GOTO  77
 402  IBERR(8) = IBERR(8) + 1
      GOTO  77
      IMISS = 0
 1000 PRINT 1001,I
 1001 FORMAT(' ERROR IN BREAD  I=',I3)
    1 CONTINUE
      GOTO  7000
C
 7002 PRINT 777
      PRINT 777
      PRINT 777
  777 FORMAT('  ********   TIMELIMIT   ********')
 7000 PRINT 704,(LRUN(L),L=1,LL)
      WRITE(6,7001)NEV,NAC
C
  701 PRINT 705, NELIM
  705 FORMAT(//' EVENTS ELIMINATED'/,I5)
      IF(NELIM.GT.100) NELLIM = 100
      PRINT 706,((JELIM(N,L),L=1,3),N=1,NELIM)
  706 FORMAT(1X,I8,I5,I3)
 7001 FORMAT(' NEV=',I8,' NAC =',I8)
      PRINT 7003,IBERR
 7003 FORMAT(//' BOS ERRORS ',10I10/)
C
C  WRITE LAST EVENT
C
      CALL BMLT(0,DUMMY)
      CALL BWRITE(3)
      CALL BSTA
      PRINT600,IWRITE
  600 FORMAT(//' EVENTS WRITTEN ',I10)
      CALL HISTDO
      RETURN
  300 PRINT 301,NRUN,KALRET
  301 FORMAT(' CALIBRATION TROUBLES FOR RUN ',I6,' KALRET = 'I5)
      RETURN
      END
