C   29/04/82 208252238  MEMBER NAME  @LGTOFCL (SOURCE)      FORTRAN
C
C        MAIN ROUTINE FOR LG-TOF CALIBRATION
C
C     S.YAMADA  29-04-82   09:40
C     LAST MODIFICATION  24-08-82   18:10
C
      IMPLICIT INTEGER*2 (H)
C
      COMMON //BSPACE(35000)
      COMMON /BCS/ IDATA(40000)
      DIMENSION ADATA(40000)
      INTEGER *2 HDATA(80000)
      EQUIVALENCE (IDATA(1),ADATA(1)), (HDATA(1),IDATA(1))
      DATA LDATA/40000/
C
      COMMON /CTPMCT/ ICREC,MAXREC, NRUN,NRUN1,NRUN2,KRUN1,KRUN2,
     $                NTLEFT,NTOUT
C
      DATA ISTART/0/, ITD/0/
C
C---- INPUT UNIT=IUNIT,  OUTPUT UNIT=JUNIT
      IUNIT=1
      JUNIT=2
C
C---- SET THE RUN EXP-NUMBER RANGE TO BE COPIED.
C     NORMAL SEQUENCE IS ASSUMED.
      READ(5,500) MAXREC,NRUN1,NRUN2,MESG, ITD
  500 FORMAT(5I10)
C
      WRITE(6,602) MAXREC,NRUN1,NRUN2
  602 FORMAT('0*********** INPUT CONDITIONS ***********',
     $        /' MAXREC=',I10,'      NRUN1,NRUN2=',2I10)
C
      ICREC = 0
      ICRECO = 0
      JCREC = 0
      JCRECO = 0
      KRUN2 = 0
      CALL HBOOK1(1,'BTDC$',100,0.,2000.,0)
      CALL HBOOK2(20,'BADC VS ETOTB$',100,0.,40.,52,0.,2080.,0)
      CALL HBOOK2(22,'ETOTB(GEV) VS BTDC(CH)$',100,0.,2000.,50,0.,50.,0)
      CALL HBOOK2(2,'BADC VS BTDC$',100,0.,2000.,50,0.,2500.,0)
      CALL HBPROY(2,0)
      CALL HBOOK2(10, 'ETOTB VS CORRECTED TOF$',
     $                              100,-20.,20.,50,0.,50.,0)
      CALL HBPROX(10,0)
      CALL HSQUEZ( 3HYES )
C
      CALL BINT(LDATA,2000,1000,0)
CC    CALL BWRO( JUNIT, 1558, 2)
C
 1000 IF(ICREC.GE.MAXREC .AND. JCREC.GE.MAXREC ) GO TO 300
C
C----    CHECK TIME
      NTLEFT = NTIME(DUM)
      IF(NTLEFT.LT.100) GO TO 400
C
      CALL BREAD(IUNIT,&1001,&100)
      ICREC=ICREC+1
C
C          SET THE LAST RUN NO.
      CALL BLOC( NPHD, 'HEAD', 0, &1002 )
      NPHD2 = 2*NPHD
      NRUN=HDATA(NPHD2+9)*100000+HDATA(NPHD2+10)
C
      IF( NRUN.LT.NRUN1 ) GO TO 1010
      IF( NRUN.GT.NRUN2 ) GO TO 200
      IF( NRUN.EQ.KRUN2 ) GO TO 2000
      IF( KRUN1.EQ.0 ) GO TO 10
C
C---     NEW  RUN
      NEVIN  = ICREC-ICRECO-1
      NEVOUT = JCREC-JCRECO
      IF(MESG.GT.0) WRITE(6,600) KRUN2,ICRECO,NEVIN,NEVOUT,JCREC
  600 FORMAT(' RUN#',I8,' ICREC=',I7,'  EV.READ=',I6,' EV.WRITTEN=',
     $               I5,' JCREC=',I6)
C
C---  LG-TOF CALIBRATION OUTPUT
      IF(SUM.LE.0.) SUM = 1.0
      AVT = STDC/SUM
      WRITE(6,606) KRUN2, SUM,STDC,AVT
  606 FORMAT(' KRUN2=',I10,'  SUM,STDC,=',2F10.2,10X,'AVTOF=',F10.3,/)
      IF( SUM.GT.1. .AND. ABS( AVT-AVTO ).GT.50.0 )   CALL HPRINT(1)
      LRUN = HDATA(NPHD2+10)
      CALL HFILL(100,LRUN,AVT,1.0)
      SUM = 0.
      STDC = 0.
      AVTO = AVT
      CALL HRESET(1)
C---- BIG CHANGE BOUNDARY
      IF( KRUN2.NE.2010241 .AND. KRUN2.NE.2010263 .AND.
     *    KRUN2.NE.2010361 ) GO TO 10
C---- GET THE AVERAGE OF THE GROUP
      IF( BIGSUM.LE.0. ) BIGSUM = 1.0
      BIGAV = BIGTDC/BIGSUM
      WRITE(6,620 ) KRUN2, BIGSUM, BIGAV
  620 FORMAT('0BIG AVERAGE TILL RUN',I10,'   SUM=',F10.1,'  AV=',F10.2)
      BIGSUM = 0.
      BIGTDC = 0.
C---
   10 KRUN2 = NRUN
      ICRECO = ICREC
      JCRECO = JCREC
      IF( ISTART ) 20,20,2000
C---     NEW EVENT BEFORE ANY ANALYSIS.  REMEMBER THE FIRST RUN #.
   20               KRUN1 = NRUN
C----      SET UP FOR HITOGRAM FOR AV.TOF
           LRUN1 = HDATA(NPHD2+10)
           LRUN2 = LRUN1+500
           CALL HBOOK2(100,'AV.TOF VS RUN NO.$',100,LRUN1,LRUN2,
     *                                          60,700.,1300.,0)
           BIGSUM = 0.
           BIGTDC = 0.
                    ISTART = 1
C
C************  EVENT HIST ***************
 2000 CONTINUE
C---- CHECK TRIGGER
      NPTRG = IDATA( IBLN('TRIG') )
      JT1ACP = HDATA( 2*NPTRG+8 )
      JTB = MOD(JT1ACP,4096)/2048
      IF( JTB.NE.1 )                         GO TO 1010
C---- CHECK BARREL TDC
      NPATST = IDATA( IBLN('ATST') )*2
      BADC = HDATA(NPATST+4)
      BTDC = HDATA(NPATST+17)
      CBTDC = BTDC+280.0-70.0*(2.0-0.001*BADC)**2
        SUM = SUM+1.0
        STDC = STDC+CBTDC
        BIGSUM = BIGSUM+1.0
        BIGTDC = BIGTDC+CBTDC
      CALL HFILL( 1, CBTDC, BADC, 1.0)
      CALL HFILL( 2, CBTDC, BADC, 1.0)
C---- CORRELATION OF ETOTB AND BADC
      NPCL = IDATA( IBLN('LGCL') )
      ETOTB = ADATA( NPCL+12 )
      CALL HFILL(20,ETOTB, BADC, 1.0 )
      CALL HFILL(22, BTDC,ETOTB, 1.0)
C---- ALREADY CORRECTED ONE
      CALL LGBTDC( CTDC, JFLAG )
      IF( JFLAG.LE.0 ) CALL HFILL( 10, CTDC, ETOTB, 1.0 )
C
 2001 GO TO 1010
C
C---     READ ERROR ON INPUT DATA SET
 1001 CALL TPMESG(1)
      GO TO 1010
C
C----    HEADER IS MISSING
 1002 CALL TPMESG(2)
C
C----    ERASE ALL BANKS FOR THE NEXT EVENT.
 1010 CALL BSLT
      CALL BDLG
      GO TO 1000
C
  100 CALL TPMESG(21)
      GO TO 10000
  200 CALL TPMESG(22)
      GO TO 10000
  300 CALL TPMESG(23)
      GO TO 10000
  400 CALL TPMESG(24)
C
10000 CONTINUE
C---- GET THE AVERAGE OF THE GROUP
      IF( BIGSUM.LE.0. ) BIGSUM = 1.0
      BIGAV = BIGTDC/BIGSUM
      WRITE(6,620 ) KRUN2, BIGSUM, BIGAV
      NEVIN  = ICREC-ICRECO
      NEVOUT = JCREC-JCRECO
      IF(MESG.GT.0) WRITE(6,600) KRUN2,ICRECO,NEVIN,NEVOUT,JCREC
      CALL BSTA
      CALL HSQUEZ( 2HNO )
      CALL HPRINT(2)
      CALL HPRINT(10)
      CALL HPRINT(20)
      CALL HPRINT(22)
      CALL HPRINT(100)
      STOP
      END
