C   23/03/97 703231219  MEMBER NAME  JEOSUM1  (SOURCE)      FORTRAN
C   04/11/81 809081600  MEMBER NAME  $HIST    (SOURCE)      FORTRAN
C
C   04-11-81   16:00      CHANGED MEMBERS (DEBUGGED)
C        ELGOBS, ENGLOS
C
C   11-12-81   XX:00      CHANGED MEMBERS
C        POSENDN          NEW VERSION OF POSEND.(DEBUGGED BY TAKEDA)
C
C   14-12-81   09:00      CHANGED MEMBERS
C        LGMESG           MODIFIED FOR DETAIED MESSAGE.
C
C   14-12-81   16:25      CHANGED MEMBERS
C        POSEND           DEBUGGED.    ENERGY CORRECTION WAS NOT
C                         CORRECT FOR END-CAP CLUSTER < 600 MEV.
C                         THE OLD VERSION WAS RENAMED AS POSEND0.
C   14-12-81   16:25
C        LGECOR           ENERGY LOSS WAS INCORPOLATED FOR THE END-
C                         CAP CLUSTERS.  THE THICKNESS OF MATERIALS
C                         IN FRONT OF LEAD GLASS IS 1.17 X0.
C                         ALSO THE THICKNESS OF MATERIALS FOR
C                         BARREL PART WAS CHANGED.
C                            OLD THICKNESS   7.88 CM
C                            NEW THICKNESS   0.97*8.9 CM
C   13-06-81   21:45      CHANGED
C        LGECOR           CORRECTION FOR FINE POSITION DEPENDENCE IN
C                         BARREL PART WAS CHANGED TO USE A NEW ROUTINE
C                         'BRLGN' INSTEAD OF 'LGPOSC'.
C                         THE ITERATION METHOD OF ENERGY CORRECTION
C                         WAS ALSO CHANGED.
C                         THE OLD VERSION WAS RENAMED AS 'LGECOR1'.
C   14-06-82   14:40      CHANGED AND LOAD
C       LGADCD            IF THE LG-DATA IS EMPTY, RETURN AFTER
C                         THE LNGTH IS PRINTED.
C   06-09-82   13:40      NEW LGINIT IS LOADED. COMMON /CLGPRM/ IS
C                         MODIFIED TO INCLUDE JCALFL.
C   12-10-82   15:00      DEAD COUNTER INFORMATION UPDATED.
C     LGDEAD              TAKEDA
C   20-08-84    9:00      NEW LG...
C   24-01-86   11:00      CORRECTED VERSIONS FROM M.KUHLEN INSTALLED.
C     LGANAL,LGERSE       OLD VERSION NOW LGANAL0,LGERSE0    J.OLSSON
C   03-09-86   20:30      CORRECTED BUG IN LGCDIR (MC CLUSTERS).
C     LGCDIR              OLD VERSION NOW LGCDIR0            J.OLSSON
C   16-09-86   19:00      ADDED SEVERAL DEAD COUNTERS TO THE
C     LGDEAD              LGDEAD LIST. #753 IS DEAD SINCE 1984
C                         ALREADY !                        N.MAGNUSSEN
C   19-01-87   15:00      UPDATED ELGOBS TO CORRECT MATERIAL THICKNESS
C     ELGOBS              IN FRONT OF BARREL. ENDCAP LOSS ALSO INCLUDED
C                         OLD VERSION = ELGOBS0            J.OLSSON
C   21-12-87   21:00      UPDATED ENGLOS,LGECOR,LGCLPB, ADDED NEW SUB-
C     ENGLOS,ETC...       ROUTINES LKCORR,ENLOSG,THCORR,BBLEAK.
C                         AS PRESENTED IN JADE MEETING 14.12.87
C                         OLD VERSIONS LGECOR0,ENGLOS0,LGCLPB0
C                            J.O. D.P.
C   14-01-88   10:30      LGECOR WAS CHANGED 12.19 13.1.88 BY MISTAKE
C     LGECOR              THE VERSION EXISTED TILL 14.1.88, 1030 AND DID
C                         NOT PERFORM CORRECTIONS AS IT SHOULD. PRESENT
C                         VERSION IDENTICAL TO OLD ONE FROM 21.12.87
C                            J.O. D.P.
C   06-04-88   17:30      SECOND HALFWORD IN ALGN-BANK ( HNORML IN
C     LGCLPB              WORK-COMMON ) STEERS CALL TO BBLEAK. D.PITZL
C   22-06-88   16:30      NEW CORRECTION VALUES IN THCORR FROM GEANT-MC
C     THCORR              ESPECIALLY FOR YEARS 79-82.          D.PITZL
C   11-07-88   11:00      CHANGED LGECOR TO AGREE WITH NEW VERSION OF
C     LGECOR              THCORR                               D.PITZL
C   25-07-88   12:15      IDATTM SCRATCHED. IT HAS A BUG; AN IDENTICAL
C     IDATTM              VERSION ON F11LHO.JADEGS/GL IS UPDATED J.O.
C   02-08-88   17:00      NEW VERSIONS OF SEVERAL ROUTINES FOR BETTER
C                         PHOTON RECONSTRUCTION (D.PITZL)
C     LGANAL9             LGANAL9 CALLS CALCOR
C       CALCOR            CALCOR PERFORMS LG CALIBRATION CORRECTION
C         BBCORR          BBCORR HAS CALIBRATION CORRECTION CONSTANTS
C       LGCLPB9           LGCLPB9 RESET TO VERSION BEFORE 12/87.
C     LGCDIR9             LGCDIR9 PASSES # OF BLOCKS TO LGECOR9
C       LGECOR9           LGECOR9 HAS # OF BLOCKS AS ARGUMENT
C                         FOR CHARGED CLUSTERS: ENGLOS, ANGBAR, BRLGN
C                         FOR PHOTONS IN DATA AND SHOWER-MC: ENCORR,
C                                              THCOFA
C                         FOR PHOTONS IN MEI-MAG-MC: ENGLOS, THCORR,
C                                      THCOFA, ANGBAR
C         ENCORR          ENERGY CORRECTION FOR PHOTONS
C         THCOFA          THRESHOLD CORRECTION FOR 1- AND MORE BLOCK
C                         PHOTONS ( T.OEST)
C   12-08-88   10:20      REMOVED BUG FOR PHOTONS WITH |COS THETA|
C     ENCORR, THCOFA      > 0.80                   T.OEST, D.PITZL
C   08-09-88   16:00      LOADED LGDEAD, THIS WAS NOT DONE SINCE
C     LGDEAD              AUG 85                   T.OEST, D.PITZL
C   04/11/81 809081600  MEMBER NAME  $MEMO    (SOURCE)      FORTRAN
  LG PROGRAM MEMO

         NEW LG CALIBRATION CONST AND THE CORRESPONDING PROGRAM CHANGE
         HAS BEEN INSTALLED.
         MONDAY,20.08.1984  10:20

C   04/11/81 809081600  MEMBER NAME  #BRLSEL0 (SOURCE)      FORTRAN
//F22TAKTE JOB 10622622,CLASS=E,MSGLEVEL=(1,1),REGION=1000K,TIME=(0,10)
//*MAIN ORG=EXT,RELPRI=HIG,LINES=(400)
//* EXEC NEWFAST
// EXEC FCLG
//SYSIN DD *
C
      IMPLICIT INTEGER *2 (H)
      COMMON / / HMEMOR(30000)
      COMMON /BCS/ IDATA(40000)
      DIMENSION HDATA(80000),ADATA(40000)
      EQUIVALENCE (HDATA(1),IDATA(1)),(ADATA(1),IDATA(1))
C
C  BOS INITIALIZATION
C
      CALL BINT(40000,40000,500,0)
      IUNIT=1
      CALL LGINIT
C
C  MAIN EVENT LOOP
C
   10 CALL BREAD(IUNIT,&1000,&1001)
C
      IPHEAD=2*IDATA(IBLN('HEAD'))
      IF(IPHEAD.LE.0) GO TO 3
      NRUN=HDATA(IPHEAD+10)
      NEVT=HDATA(IPHEAD+11)
C
      IF(NRUN.NE.11094) GO TO 3
      IF(NEVT.NE.2944) GO TO 3
C
      CALL LGANAL
      IALGN=IDATA(IBLN('ALGN'))
      ICLST=IDATA(IBLN('LGCL'))
      IPATR=IDATA(IBLN('PATR'))
      CALL LGCDIR(IPATR,IALGN,ICLST)
      STOP
C
    3 CALL BSLT
      CALL BDLG
      GO TO 10
C
C  BOS READ ERROR
C
 1000 WRITE(6,100)
  100 FORMAT(1H0,' BOS READ ERROR')
      GO TO 3
C
C  END OF FILE
C
 1001 STOP
      END
C---------------------------------------------------------------------
C   11/03/79 008260241  MEMBER NAME  INTOLG                 FORTRAN
      SUBROUTINE INTOLG(NPCL,HCLMAP,HLGADC,NPPREC)
C
C     S.YAMADA   11-12-78  14:10    COPIED FROM INTOLG(LGSOURCE)
C     LAST MODIFICATION   26-10-79 17:57 BY Y.WATANABE
C      (THE CONNECTED LG# IS WRITTEN INTO THE PATR BANK)
C
C---- CONNECT CALCULATED INNER TRACK CLUSTESTERS TO THE OBSERVED LG.CLUS
C     CHOOSE AT MOST ONE CLUSTER PAR ONE TRACK
C     THE CRITERION IS;MAX OVERLAPPING CLUSTER. IF OVERLAPPING IS EQUAL,
C     CHOOSE THE CLOSEST ONE AMONG THEM.
C
C     NPCL  =THE BOS POINTER TO THE LG-RESULT BANK ('LGCL')
C     NPPREC =THE BOS POINTER TO THE LATEST PATR BANK
C                                GIVEN AS AN ARGUMENT 26/8/80
      IMPLICIT INTEGER *2 (H)
C
C
#include "clgwork2.for"
      COMMON /CLGDMS/ X0,RADIUS(6),RADSX0(6),THX0(4),
     $                ZEND(2),ZENDX0(2),ZWID(2),ZGAP(2),PHWID(2),
     $                ZECAP(4),ZECAPX(4),THECPX(2)
C
      COMMON /CLGCHG/ NCHIND,NSTEP,CXDCHG(9,100)
      DIMENSION JBCCHG(9,100)
      EQUIVALENCE (CXDCHG(1,1),JBCCHG(1,1))
C---- CXDCHG  CONTAINS INNER TRACK INFORMATION
C     JBCCHG(1,N)     HITTING PART 0=BARREL, +/-1=+/-Z END CAP
C     CXDCHG(2,N)     CHARGE
C     CXDCHG(3-5,N)   HITTING POSITION ON THE COIL OR ON THE END CAP
C     CXDCHG(6-8,N)   DIRECTION COSIGNS
C     CXDCHG(9,N)     ABSOLUTE MOMENTUM IN GEV/C
C
#include "cdata.for"
C---- SEE  JADE COMPUTER-NOTE #14.
C     IDATA(NPCLS+1)=JBC, 0 FOR BARREL, -1 FOR BOTTOM, 1 FOR TOP
C     ADATA(NPCLS+2)=CLUSTER ENERGY IN GEV
C     ADATA(NCLST+3)=SIGMA(ENERGY)
C     ADATA(NPCLS+4)=WEIGHTED AVERAGE PHI
C     ADATA(NPCLS+5)=WEIGHTED AVERAGE Z
C     ADATA(NPCLS+6)=SIGMA PHI (WEIGHTED)
C     ADATA(NPCLS+7)=SIGMA Z (WEIGHTED)
C     IDATA(NPCLS+8)=NUMBER OF CORRESPONDING INNER TRACKS
C     ADATA(NPCLS+9-11)=DIRECTION COSIGNS CORRECTED FOR SHOWER DEPTH.
C
      DIMENSION HCLMAP(2,2), HLGADC(2,2)
C
C
      DATA IFLAG/0/
      IF(IFLAG.GT.0) GO TO 5
      IFLAG=1
C     IPTR= IBLN('PATR')
5     CONTINUE
      IF(NCHCLS.LT.1) RETURN
      NPCGI = NPCL+IDATA(NPCL+1)-1
C---- GET NO.OF CLUSTERS
      NCLST = IDATA(NPCGI+3)
      IF(NCLST.LT.1) RETURN
C
      NCHCL2 = NCHCLS
      IF(NCHCL2.GT.100) NCHCL2 = 100
      NCLST2 = NCLST
      LSTEP = IDATA(NPCGI+21)
      NPCL0 = NPCL+IDATA(NPCL+3)-1-LSTEP
      RM=(RADIUS(3)+RADIUS(4))/2.
C     LOCATE PATR BANK AND SET POINTER TO THE WORD. 26-10-79
C     NPTR = IDATA(IPTR)
      NPTR = NPPREC
      LTR=IDATA(NPTR+3)
      NPTR=NPTR+IDATA(NPTR+1)+40 -LTR
C
      WRITE(6,201) NCHCL2
  201 FORMAT(1H0,'NCHCL2=',I6)
C
        DO 100 N=1,NCHCL2
        NPTR=NPTR+LTR
        IDATA(NPTR)=0
        NS = MAPCCL(N)
        NE = MAPCCL(N+1)-1
C
      WRITE(6,202) N,NS,NE
  202 FORMAT(1H0,' N NS NE =',3I7)
        MARK=-2
        IF(NS.GT.NE) GO TO 99
        JCHB=JBCCHG(1,N)
        IF(IABS(JCHB).GT.1) GO TO 99
C
C----   GO THROUGH ALL THE OBSERVED CLUSTERS
          NPCLS=NPCL0
          COMAX=0.
          DR2MIN=1.E15
      WRITE(6,203) NCLST
  203 FORMAT(1H0,'NCLST=',I7)
          DO 80 L=1,NCLST
          NPCLS=NPCLS+LSTEP
          LS = HCLMAP(1,L)
          LE = HCLMAP(2,L)
      WRITE(6,204) L,LS,LE
  204 FORMAT(1H0,' L LS LE =',3I5)
          IF(LE.LT.LS) GO TO 80
C----     COMPARE  ALL THE COMPONENTS OF THE N-TH SIMULATED CLUSTER
C         AND L-TH OBSERVED CLUSTER.
          IF(IDATA(NPCLS+1).NE.JCHB) GO TO 80
C         (CHECK IF IS THE SAME PART OF THE APPARATUS)
            COM=0.
            DO 30 NN=NS,NE
            HADR = HCLADR(NN)
C----       TRY TO FIND HADR AMONG THE OBSERVED CLUSTER COMPONENTS.
              DO 10 LL=LS,LE
              IF(HLGADC(1,LL).EQ.HADR) GO TO 20
10            CONTINUE
              GO TO 30
20          COM=COM+1.
30          CONTINUE
      WRITE(6,205) COM
  205 FORMAT(1H0,'COM=',F10.1)
            IF(COM.LE.0.) GO TO 80
          COM=COM/(NE-NS+1)
          IF(HCLIST(1,N).LT.1) GO TO 40
      WRITE(6,200) COM,COMAX
  200 FORMAT(1H0,' COM COMAX =',2F10.3)
          IF(COM-COMAX) 80,40,70
C
C         THE SAME DEGREE OF OVERLAPP. CHOOSE THE CLOSER ONE
40        IF(JCHB.NE.0) GO TO 50
C         BARREL PART
          PHI=ADATA(NPCLS+4)
          DX=RM*COS(PHI)-CXDCHG(3,N)
          DY=RM*SIN(PHI)-CXDCHG(4,N)
          DR2=DX*DX+DY*DY+(ADATA(NPCLS+5)-CXDCHG(5,N))**2
          GO TO 60
50        DX=ADATA(NPCLS+4)-CXDCHG(3,N)
          DY=ADATA(NPCLS+5)-CXDCHG(4,N)
          DR2=DX*DX+DY*DY
60        IF(DR2.GT.DR2MIN) GO TO 80
          DR2MIN=DR2
70        COMAX=COM
          HCLIST(1,N)=1
          HCLIST(2,N)=L
          IDATA(NPTR)=L
80        CONTINUE
C
C     FILL IN INVERSE LIST
        IF(HCLIST(1,N).LT.1) GO TO 90
        L=HCLIST(2,N)
        LCOM=HCLLSO(1,L)+1
        IF(LCOM.LE.3) HCLLSO(LCOM+1,L)=N
        HCLLSO(1,L)=LCOM
        GO TO 100
C----   IF THERE IS NO MATCHED LG-CLUSTER,MARK IT.
90      MARK = -2
        JSUMC = 0
C----   JSUMC IS THE COUNTER FOR THE EDGE BLOCKS.
          DO 95 NN= NS,NE
          CALL LGCRN2( HCLADR(NN), JSUMC )
95        CONTINUE
        DR2=FLOAT(JSUMC)/(NE-NS+1)
        IF(DR2.GT.0.5) MARK=-1
99      HCLIST( 1,N ) = MARK
100     CONTINUE
      RETURN
      END
/*
//LKED.SYSLIB DD
//            DD
//            DD DISP=SHR,UNIT=FAST,DSN=JADELG.LOAD
//            DD DISP=SHR,UNIT=FAST,DSN=F11LHO.JADEGL
//            DD DISP=SHR,UNIT=FAST,DSN=F1EBLO.BOSLIB.L
//            DD DISP=SHR,UNIT=FAST,DSN=R02BUT.CERNLIB
//GO.FT01F001 DD UNIT=FAST,DISP=SHR,DSN=F22NAR.MSJAD1.MC1.R451509
C   04/11/81 809081600  MEMBER NAME  #CHK     (SOURCE)      FORTRAN
//F22WATTS JOB '10622622,LGTEST',WATANABE,CLASS=E,TIME=(0,01)
//*MAIN ORG=EXT
// EXEC FCLG,FORT=XL
#include "@chk.for"
#include "posend.for"
C   04/11/81 809081600  MEMBER NAME  #CHKRTN  (SOURCE)      FORTRAN
//F22WATTS JOB '10622622,LGTEST',WATANABE,CLASS=E,TIME=(0,06)
//*MAIN ORG=EXT
// EXEC FCLG,FORT=XL
#include "@chkrtn.for"
#include "lgecorn.for"
#include "angbar.for"
#include "posend.for"
#include "englos.for"
//LKED.SYSLIB DD
// DD
// DD DSN=JADELG.LOAD,UNIT=FAST,DISP=SHR
C   04/11/81 809081600  MEMBER NAME  #LGHIST  (SOURCE)      FORTRAN
//F22YAMLB JOB '10622622,TEST',CLASS=E,MSGLEVEL=(2,0),TIME=(0,12)
//*MAIN ORG=EXT
// EXEC FORTHCLG,PARM.FORT=XL,REGION.GO=1000K
#include "@lghist.for"
#include "lghist.for"
#include "lghitm.for"
#include "lgcalb.for"
#include "lginit.for"
      BLOCK DATA
#include "ciouni.for"
      DATA NCALI/2/
      DATA KUNITA/23,24,8*0/
      DATA LUNITA/21,22,8*0/
      END
//LKED.SYSLIB DD
// DD
// DD DSN=JADELG.LOAD,DISP=SHR
// DD DSN=F11LHO.JADEGL,DISP=SHR
// DD DSN=F1EBLO.BOSLIB.L,DISP=SHR
// DD DSN=R01UTL.HBOOKL,DISP=SHR
// DD DSN=R02BUT.CERNLIB,DISP=SHR
// DD DSN=R01UTL.SSPLIB,UNIT=FAST,DISP=SHR
// DD DSN=F22ALL.JADEMUL,DISP=SHR
//*KED.SYSIN DD *
//* INCLUDE SYSLIB()
//GO.FT21F001 DD DSN=F11LHO.BUPDAT0,DISP=SHR,UNIT=FAST
//GO.FT22F001 DD DSN=F11LHO.BUPDAT1,DISP=SHR,UNIT=FAST
//GO.FT01F001 DD DSN=F22YAM.DSK1GMC.Y82MAY,DISP=SHR
//* 11/11/81 408201036  MEMBER NAME  #LGRECAL (SOURCE)      JCL
//JADELGRC JOB 10622622,RECAL,CLASS=K,MSGLEVEL=(2,0),TIME=(3,00),
//  REGION=999K
//*MAIN ORG=EXT,RELPRI=MED,LINES=(10)
//*      *********************************************
//*      *  LG RECALIBRATION                         *    NOT READY
//*      *  BY USING THE UPDATED STANDARD CONST.FILE *
//*      *********************************************
//RECAL EXEC FCLG,FORT=XL,REGION.GO=999K
C
      IMPLICIT INTEGER*2 (H)
      COMMON /BCS/ IDATA(40000)
      DIMENSION ADATA(40000)
      INTEGER *2 HDATA(80000)
      EQUIVALENCE (IDATA(1),ADATA(1)), (HDATA(1),IDATA(1))
C
C -- INPUT UNIT=IUNIT,  OUTPUT UNIT=JUNIT
      DATA IUNIT/1/,JUNIT/2/
C
C -- INITIALIZATION
C
      CALL BINT(40000,4000,500,0)
      CALL BWRO(2, 1558, 2)
      CALL LGINIT
C
      JPHEAD = IBLN('HEAD')
      JPPATR = IBLN('PATR')
      JPALGN = IBLN('ALGN')
      JPLGCL = IBLN('LGCL')
C
      NREV= 0
      NWEV= 0
C
C ===== START OF MAIN LOOP =====
C
 1000 CONTINUE
C
C -- CHECK TIME
C
      IF( NTIME(DUM).LT.200 ) GOTO 8003
C
C -- READ A EVENT
C
      CALL BREAD(IUNIT,&8000,&8001)
      NREV= NREV+1
C
      IPHEAD = IDATA(JPHEAD)
      IF( IPHEAD.GT.0 ) GOTO 1001
       WRITE(6,1100)
 1100  FORMAT(' ??? "HEAD"-BANK MISSING ???')
      GOTO 7000
C
 1001 KPHEAD = 2*IPHEAD
      HRUN= HDATA( KPHEAD +10 )
      HEVT= HDATA( KPHEAD +11 )
      HENR= HDATA( KPHEAD +29 )
      ENRG = HENR*0.001
C
      IF( 500*(NREV/500).EQ.NREV )
     &  WRITE(6,1200) HRUN,HEVT,HENR,NREV,NWEV
 1200 FORMAT(' ***** RUN#',I6,', EVENT#',I6,', ENERGY',I6,
     &  ' --',I6,' EVENTS READ',I6,' EVENTS WRITTEN')
C
C -- RECALIBRATION
C
      CALL KALIB2
      CALL LGCALB( &7000 )
C-- GET TOTAL LG ENERGY    ADDED BY H.TAKEDA & M.MINOWA
C                           13:30  31/OCT/1983
C     CALL ERGTOT(ECYL,END1,END2)
C     ETOT=ECYL+END1+END2
C     RTOT=ETOT/HENR
C     IF(RTOT.LE.0.3) GO TO 7000
C        ; GAIN CORRECTION
      CALL LGANAL
C        ; CLUSTER ANALYSIS
      IPPATR = IDATA(JPPATR)
      IPALGN = IDATA(JPALGN)
      IPLGCL = IDATA(JPLGCL)
      CALL LGCDIR( IPPATR, IPALGN, IPLGCL )
C
C----------------- TEST ----- MONITOR PLOT ---------
      CALL PLCLEN(ENRG)
C
C -- WRITE A EVENT
C
      NWEV= NWEV+1
      CALL BSLW
      CALL BWRITE(JUNIT)
C
C -- ERASE ALL BANKS FOR THE NEXT EVENT.
C
 7000 CONTINUE
      CALL BSLT
      CALL BDLG
C
      GOTO 1000
C
C ===== END OF MAIN LOOP =====
C
C -- MESSAGES
C
 8000 WRITE(6,8100)
 8100 FORMAT(/' ??? BOS READ-ERROR ???'/)
      GOTO 7000
 8001 WRITE(6,8300)
 8300 FORMAT(/' ***** END-OF-DATA *****'/)
      GOTO 9000
 8003 WRITE(6,8400)
 8400 FORMAT(/' ***** TIME-OUT *****'/)
      GOTO 9000
C
C -- ENDING ROUTINE
C
 9000 CONTINUE
      CALL BMLT(0,DUMMY)
      CALL BWRITE(JUNIT)
      CALL BSTA
      WRITE(6,9100) NREV,NWEV
 9100 FORMAT(///10X,I10,' EVENTS WERE READ.'/
     &          10X,I10,' EVENTS WERE RECALIBRATED.'//)
C
      STOP
      END
#include "brlgnt.for"
#include "brlgn6.for"
//LKED.SYSLIB DD
//            DD
//            DD DSN=JADELG.LOAD,UNIT=FAST,DISP=SHR
//            DD DSN=F11LHO.JADEGL,UNIT=FAST,DISP=SHR
//            DD DSN=F1EBLO.BOSLIB.L,DISP=SHR,UNIT=FAST
//            DD DSN=R01UTL.SSPLIB,UNIT=FAST,DISP=SHR
//            DD DSN=R01UTL.CERN.KERNLIB4,UNIT=FAST,DISP=SHR
//*--<<  INPUT DATA  >> ----------
//*O.FT01F001 DD UNIT=TAPE,DISP=OLD,DSN=F22WAT.BRLBBGG.REDUC2.G533615
//GO.FT01F001 DD UNIT=TAPE,DISP=OLD,DSN=F22WAT.BRLBBGG.REDUC2.G616664
//    DD UNIT=AFF=FT01F001,DISP=OLD,DSN=F22WAT.BRLBBGG.REDUC2.G665705
//*--<<  OUTPUT DATA  >> ---------
//GO.FT02F001 DD DSN=&&OUTPUT,DISP=(,PASS),UNIT=DISK,
// DCB=(R01DCB.VBS,LRECL=6236),SPACE=(CYL,(150,50))
//*O.FT02F001 DD DUMMY
//*--<<  CALIBRATION CONSTANT  >>
//GO.FT21F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.BUPDAT0
//*O.FT22F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.BUPDAT1
//GO.FT22F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.INTERM.BUPDAT1
//*--<<  COPY  >> ----------------
//COPY EXEC PGM=IEBGENER
//SYSUT1 DD DSN=&&OUTPUT,DISP=(OLD,DELETE),UNIT=DISK
//SYSUT2 DD UNIT=TAPE,DSN=F22KMT.BRLBBGG.REDUC2.RECALX.G616705,
// DISP=(NEW,CATLG,DELETE),DCB=(RECFM=VBS,LRECL=6236,BLKSIZE=24948)
//SYSPRINT DD SYSOUT=*
//SYSIN DD DUMMY
C   04/11/81 809081600  MEMBER NAME  #LGTEST  (SOURCE)      FORTRAN
//F22WATTY JOB '10622622,LGTEST',WATANABE,CLASS=E,TIME=(0,15)
//*MAIN ORG=EXT,RELPRI=LOW
//*EXEC NEWFAST
// EXEC FCLG,FORT=XL,REGION=1000K
#include "@lgtest.for"
#include "lgersen.for"
#include "kalib2.for"
#include "lgsubc.for"
//LKED.SYSLIB DD
// DD
// DD DSN=JADELG.LOAD,UNIT=FAST,DISP=SHR
// DD DSN=F1EBLO.BOSLIB.L,DISP=SHR,UNIT=FAST
// DD DSN=F11LHO.JADEGL,UNIT=FAST,DISP=SHR
//GO.FT01F001 DD DISP=SHR,UNIT=FAST,DSN=JADELG.DSKSCRCH
 //*                CALIBRATION
//GO.FT21F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.AUPDAT0
//GO.FT22F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.AUPDAT1
//GO.FT23F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.ASTART0
//GO.FT24F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.ASTART1
C   04/11/81 809081600  MEMBER NAME  #LGTOFCL (SOURCE)      FORTRAN
//JADELGTG JOB 10622622,CLASS=A,MSGLEVEL=(2,0),TIME=(2,00)
//*MAIN RELPRI=MED
//*   =====  CALIBRATION OF THE BARREL LG-TOF =====
// EXEC FCLG,REGION.GO=512K
#include "@lgtofcl.for"
#include "lgbtdc.for"
//LKED.SYSLIB DD
//     DD
// DD DSN=F22YAM.PHANAL.L,UNIT=FAST,DISP=SHR
// DD DSN=R01UTL.SSPLIB,DISP=SHR,UNIT=FAST
// DD DSN=R01UTL.HBOOK321.L,UNIT=FAST,DISP=SHR
// DD DSN=R02BUT.CERNLIB,UNIT=FAST,DISP=SHR
// DD DSN=F1EBLO.BOSLIB.L,DISP=SHR,UNIT=FAST
// DD DSN=F11LHO.JADEGL,DISP=SHR,UNIT=FAST
// DD DSN=F22YAM.TPLOAD,DISP=SHR,UNIT=FAST
//LKED.SYSIN DD *
     INCLUDE SYSLIB( TPMESGLG )
//*  INCLUDE SYSLIB( TPMESGLG )  ****
//*            INPUT
//*O.FT01F001 DD DSN=F22YAM.ONEGAMCW.G408450,DISP=OLD,UNIT=TAPE
//* DD DSN=F22YAM.ONEGAMCW.G451472,UNIT=AFF=FT01F001,DISP=OLD
//* DD DSN=F22YAM.ONEGAMCW.G473480,UNIT=AFF=FT01F001,DISP=OLD
//*O.FT01F001 DD DSN=F22WAT.BRLBBGG.REDUC2.G408427,DISP=OLD,UNIT=TAPE
//*O.FT01F001 DD DSN=F22WAT.BRLBBGG.REDUC2.G428450,DISP=OLD,UNIT=TAPE
//GO.FT01F001 DD DSN=F22KAN.BRLBBGG.REDUC2.G451454,DISP=OLD,UNIT=TAPE
//            DD DSN=F22KAN.BRLBBGG.REDUC2.G455459,DISP=OLD,
//            UNIT=AFF=FT01F001
//            DD DSN=F22KAN.BRLBBGG.REDUC2.G460664,DISP=OLD,
//            UNIT=AFF=FT01F001
//*O.FT01F001 DD DSN=F22YAM.ONEGAMC.R1G408,DISP=SHR,UNIT=FAST
//*       DD DSN=JADEPR.REDUCONE.G0430V00,DISP=OLD,UNIT=AFF=FT01F001
//GO.SYSIN DD *
   1000000   0000000   9999999         1         0     14500
    MAXREC     NRUN1     NRUN2      MESG       ITD    LIMREC
C   04/11/81 809081600  MEMBER NAME  #MTCOPY  (SOURCE)      FORTRAN
//F22WATCP JOB 10622622,WATANABE,CLASS=A,TIME=(0,15)
//*MAIN LINES=(2),ORG=EXT
// EXEC FCLG,REGION=800K
#include "@mtcopy.for"
#include "bread.for"
#include "bwrite.for"
//LKED.SYSLIB DD
// DD
// DD DSN=R02BUT.CERNLIB,DISP=SHR
//GO.FT01F001 DD DISP=SHR,UNIT=TAPE,DSN=F22ORI.REDUC2D.R4404.R4434
//GO.FT02F001 DD DSN=JADELG.DSKSCRCH,DISP=(,CATLG,DELETE),
// DCB=R01DCB.VBS,SPACE=(TRK,(20,10),RLSE),UNIT=FAST
//* THE RANGE OF RUNS TO BE COPIED, AND # OUTPUT TAPES
 4433 9999    1
C   04/11/81 809081600  MEMBER NAME  #PRJNOT  (SOURCE)      FORTRAN
//JADELGL4 JOB 10622622,JADELG,CLASS=A,MSGLEVEL=(0,0),TIME=(0,5)
// EXEC FCLG
//FORT.SYSIN DD *
      DIMENSION A(80)
      DATA NCOPY/10/
      DATA DOL/1H$/
      DO 2 N=1,NCOPY
      WRITE(6,102)
      DO 1 I=1,100000
      READ(5,100,END=99) A
  100 FORMAT(80A1)
C     IF(MOD(I,33).EQ.0) WRITE(6,102)
  102 FORMAT(1H1,/)
      IF(A(1).NE.DOL) GO TO 3
      WRITE(6,102)
      GO TO 1
3     WRITE(6,101) A
  101 FORMAT(3X,72A1,30X,8A1)
C     WRITE(6,103)
  103 FORMAT(/)
    1 CONTINUE
   99 REWIND 5
    2 CONTINUE
      STOP
      END
//GO.FT06F001 DD SYSOUT=K
//GO.SYSIN DD *
  JADE COMPUTER NOTE 14D

                                      16. MAY  1984     S.YAMADA


  ANALYSIS PROGRAM FOR LEAD GLASS (LG) COUNTERS.
   ( REVISED VERSION OF THE JADE COMP.NOTES 14,14A,14B,14C
     BY S.YAMADA AND Y.WATANABE
    UPDATED AND MORE INFORMATION IS GIVEN HERE)

A SMALL CHANGE HAS BEEN MADE TO THE LG LIBRALY JADELG.SOURCE/LOAD.
THE NUMBER OF WORDS/CLUSTER IS NOW 16, BUT THERE SHOULD BE NO PROBLEM
AS LONG AS THE RIGHT WORD FOR IT IS USED IN THE PROGRAM.

THIS CHANGE IS TO ACCOMODATE A REQUEST TO INCLUDE UNCORRECTED ENERGY
IN TO THE BANK. FOR MONTE CARLO DATA, THIS WORD CONTAINS UNSMEARED
ENERGY WHEN SMEARING IS DONE AT THE LG ANALYSIS STAGE, WHICH IS
THE NORMAL PRACTICE FROM NOW ON.

THE STRUCTURE OF THE LIBRARY ,SOME DESCRIPTION OF TECHNIQUES USED IN
THE PROGRAM AND THAT OF INPUT/OUTPUT BANKS ARE GIVEN BELOW.


1. THE STRUCTURE OF THE LIBRARY

IT CONSISTS OF BANCH OF SUBROUTINES, WHICH CAN BE DIVIDED INTO 4 GROUPS.
EACH OF THE GROUPS CAN BE REPRESENTED BY ONE SUBROUTINE.

 A. SUBROUTINE LGINIT

     FUNCTION    LOAD IN VARIOUS CONSTANTS AND CUTS.
                 (IN THE FORM OF BLOCK DATA).
                 SHOULD BE CALLED AT THE BEGINNING.
                 THE SET CONSTANTS CAN BE OVERRIDDEN BY
                 SETTING TO DESIRED VALUES AFTERWARD.

 B. SUBROUTINE LGCALB(*)

     INPUT  BANK 'ALGL'/0 (RAW PULSE HEIGHTS)
     OUTPUT BANK 'ALGN'/1 (UNIT IS IN MEV)

     FUNCTION    CONVERTS ADC PULSE HEIGHTS TO MEV.
                 SUBTRACT SOME COUNTS FROM SPINNING BLOCKS AND
                 DELETE BAD AND/OR NON-EXISTING CHANNELS
                 WHEN THEY FIRE. (LGERSE)
                 (NOW USES L.H.O'NEILL'S SCHEME OF CONSTANTS)

     ERROR RETURN OCCURS IF THE INPUT DATA ARE ABNORMAL.

 C. SUBROUTINE LGANAL

     INPUT  BANK 'ALGN'/1
     OUTPUT BANK 'LGCL'/1 (SOME PART IS TO BE FILLED BY LGCDIR)

     FUNCTION    FINDS CLUSTERS AND STORES THE INFORMATION
                 IN 'LGCL'/1.
                 THE BANK 'ALGN'/1 IS REORDERED IN SUCH A WAY
                 THAT HITS BELONGING TO A CLUSTER ARE GROUPED TOGETHER.

$
 D. SUBROUTINE LGCDIR(NPPATR,NPALGN,NPLGCL)

       WHERE THE ARGUMENTS ARE POINTERS TO THE CORRESPONDING BANKS.

     INPUT  BANK 'LGCL'/1
     OUTPUT BANK 'LGCL'/1 (I.E. JUST MODIFIES THE CONTENTS)
     FUNCTION    LINKS TRACKS FOUND IN THE JET CHAMBER
                 TO LG CLUSTERS
                 PERFORMS ENERGY CORRECTION FOR DATA(J.C.NOTE#35)
                 AND ENERGY SMEARING FOR MC DATA. (LGESMR)
                 CALCULATES THE DIRECTION COSINES TAKING
                 INTO ACCOUNT THE EVENT VERTEX AND SHOWER
                 DEPTH.

       LGCDIR CAN BE CALLED INDEPENDENT OF LGANAL FOR ONCE
       ANALYSED DATA.


2. SHORT DESCRIPTION OF CLUSTER FINDING

     A. THE LIST IN 'ALGN'/1 IS ORDERED FROM THE HIGHEST ENERGY

     B. TAKE THE BLOCK WITH THE HIGHEST ENERGY AS A PARENT.
        CALL THIS BL1.  E(BL1) > ITH (DEFAULT IS 45 MEV)

     C. LOOK FOR A NEIGHBOR IN THE LIST. IF FOUND MOVE IT TO THE NEXT
        TO BL1.  CALL THIS BL2 (NEIGHBORS ARE ADJUCENT COUNTERS)

     D. FOR EACH BL2, LOOK FOR A NEIGHBOR OF BL2.  CALL THIS BL3.

     F. INCLUDE BL3 IRRESPECTIVE OF THE ENERGY IF E(BL2) > E(BL1)/5.
        IF NOT,INCLUDE BL3 IF E(BL3) < E(BL1)/2 .AND. E(BL3) < E(BL2)*3.
        IF INCLUDED TO THE FAMILY, MOVE IT NEXT TO BL2.

     G. FIND ALL NEIGHBORS OF BL2 ( GO TO C ;BL3 IS NOW BL2)

     H. AFTER ALL NEIGHBORS OF BL1 FAMILY IS FOUND, REPEAT ABOVE
        FOR UNASSIGNED BLOCKS IN THE LIST ( GO TO B )

     NOTE. DETECTOR IS DIVIDED INTO 3 PARTS; BARREL, -Z AND +Z
           END CAPS, AND CLUSTER SEARCH IS MADE SEPARATELY.
     THE THRESHOLDS USED IN THE CLUSTER SEARCH ARE STORED IN THE
     COMMON /CLGPRM/ ITH, MAXCLS, IRLTHD, IRLTH2, IRLTH3.
                    (45MEV)         5        2       3  <--- DEFAULT
     THESE VALUES CAN BE CHANGED BY USERS AFTER CALLING LGINIT.

3. CALUCULATION OF CLUSTER POSITION

      THE COORDINATES (PHI,Z) FOR BARREL AND (X,Y) FOR END CAP  ARE
      OBTAINED BY WEIGHTED AVERAGE. THE EXPONENT IN THE WEIGHT
      WAS DETERMINED BY R.EICHLER IN ORDER TO OBTAIN THE BEST
      PI-0 INVARIANT MASS BY A 3-DIMENSIONAL MONTE CARLO SHOWER
      USING THE A.SATO'S SHOWER PROGRAM.

        X = SUM (XI*EI**0.33) / SUM(EI**0.33)   (SIMILAR FOR PHI)
        Y = SUM (YI*EI**0.33) / SUM(EI**0.33)   (   "     "   Z )

      THEN THE DIRECTION COSINE IS CALUCUATED TAKING THE SHOWER
      DEPTH AND THE EVENT VERTEX(IF 'TPVX' IS THERE) INTO ACCOUNT.
$
        DEPTH = 22.39*LN(E/E0) (MM)    E0=4.979MEV FOR E+-,
                                       E0=1.725MEV FOR GAMMA.
         OR   = HALFWAY THROUGH THE LEAD GLASS
                IF E<600 MEV OR E/P < 0.75
              ("IDENTIFIED" AS A NONSHOWERING CHARGED PARTICLE)

      TO OBTAIN THE DIRECTION COSINE, E.G. FOR A BARREL CLUSTER,
      THE ADDITIONAL PARAMETER R IS ITTERATIVELY SEARCHED FOR,
      FIXING (PHI,Z), UNTIL THE DEPTH REACHES TO THE EXPECTED VALUE.

      A FURTHER CORRECTION OF THE DIRECTION IS APPLIED AS A FUNCTION
      OF THE HIT POSITION AND THE ENERGY. THE CORRECTION FUNCTION WAS
      OBTAINED BY A MONTE CARLO METHOD.


4. 'ALGN'/1 BANK

  WORD   TYPE  CONTENTS

     0    I*4  THE LENGTH OF THE BANK
     1#   I*2  >100
          I*2  10003 FOR DATA .
               FOR MONTE CARLO DATA, 1=ENERGY UNSMEARED, 2=SMEARED
               AT THE GENERATION STAGE.  ADD 4 IF SMEARING IS DONE
               BY LGESMR IN LGCDIR.
     2    I*2  POINTER=1
          I*2  POINTER TO ADDRESS OF THE DATA ( -Z END CAP)
     3    I*2  POINTER TO ADDRESS OF THE DATA ( +Z END CAP)
          I*2  POINTER TO THE LAST WORD+1
     4    I*2  ADC CHANNEL NUMBER (0 THROUGH 2879)
          I*2  THE PULSE HEIGHT IN MEV.
     5    I*2  ADC CHANNEL NUMBER (0 THROUGH 2879)
          I*2  THE PULSE HEIGHT IN MEV.
           "        "
           "        "

           ( ALL NONZERO BLOCKS
               IN THE ORDER OF THE BLOCK NUMBERS (AFTER LGCALB)
               IN FAVOR OF CLUSTERS FOUND        (AFTER LGANAL)

AN EXAMPLE  FOR THE DATA LOOK AS FOLLOWS,

   ADC  MEV   ADC  MEV   ADC  MEV   ADC  MEV   ADC  MEV
   912 4886   880  540   913  194   911  162   944  113
   881   81   879   71 /2257 3879  2289 1227  2256   92
  2225   38  2290   86  2288   76 /2400   15//2715 1661
  2720 1370//2810   76 /2800   15

 POINTERS(WORD#2-5) HAVE THE VALUES OF  1,29,33,37
        ( // INDICATES THE BOUNDARY OF DETECTOR PARTS )
        ( / INDICATES THE BOUNDARY OF CLUSTERS IN ONE PART. )
        ( IN TOTAL 6 CLUSTERS ARE FOUND )
$
5. 'LGCL'/1 BANK

   THE FORMAT OF THE BANK IS GIVEN BELOW FOR CONVENIENCE.IT IS
   ESSENTIALLY THE SAME AS THE ONE DESCRIBED IN J.C.NOTE 14 - 14B.

  WORD   TYPE  CONTENTS

     0    I*4  THE LENGTH OF THE BANK
     1     "   IP1= 5;THE POINTER TO THE GENERAL INFORMATION
     2     "   IP2=26;THE POINTER TO THE CLUSTER MAP
     3     "   IP3   ;THE POINTER TO THE CLUSTER INFORMATION(NCLST+27)
     4     "   IP4   ;THE POINTER TO THE LAST WORD +1


  /GENERAL INFORMATION/

  WORD   TYPE  CONTENTS

  IP1     I*4  VERSION# OF THE PROGRAM.
  IP1+ 1   "   THE DATE AND TIME OF THE BANK GENERATION.
  IP1+ 2   "   #CLUSTERS     TOTAL (NCLST)
  IP1+ 3   "       "         BARREL
  IP1+ 4   "       "         Z<0 ENDCAP
  IP1+ 5   "       "         Z>0 ENDCAP
  IP1+ 6  R*4  SHOWER ENERGY TOTAL
  IP1+ 7   "       "         BARREL
  IP1+ 8   "       "         Z<0 ENDCAP
  IP1+ 9   "       "         Z>0 ENDCAP
  IP1+10  I*4  #PHOTONS
  IP1+11  R*4  PHOTON ENERGY TOTAL
  IP1+12   "       "         BARREL
  IP1+13   "       "         Z<0 ENDCAP
  IP1+14   "       "         Z>0 ENDCAP
  IP1+15  I*4  ERROR FLAG. 0=NO ERROR, 1=NOT CALIBRATED, 2=NOT ENOUGH
               SPACE TO COPY INPUT DATA,1024=FORMAT CONVERSION NOT DONE
               ADD 10 IF TOO MANY CLUSTERS FOUND
               ADD 100 IF NOT ENOUGH SPACE IN /BCS/
  IP1+16   "   THE STAGE OF ANALYSIS 1=LGANAL, 2=LGCDIR.
  IP1+17   "   THE VERSION # FOR THE ENERGY CORRECTION.
  IP1+18   "   1 IF TRACK CONNECTION IS DONE.
  IP1+19   "   FLAG=HDATA(2*NPVRTX+2) SEE J.C.NOTE FOR TP.
  IP1+20#  "   #WORDS/CLUSTER (NWPCL=16 CHANGED FROM 15)
        # INDICATES MODIFICATION


  /CLUSTER MAP/

  WORD      TYPE  CONTENTS

  IP2       I*2   H(1);THE START ADDRESS OF CLUSTER 1 IN RESHUFFLED
                    'ALGN'/1 BANK.
             "    H(2);THE LAST  ADDRESS
  IP2+1      "     . . . . . . . . .
   .         "     . . . . . . . . .
   .         "     . . . . . . . . .
  IP2+NCLST  "    H(1);POINTS TO THE LAST ADC DATA +1

  FOR THE ABOVE EXAPMLE, THE VALUES OF H(1),... ARE
    1,7, 8,13, 14,16, 17,17, 19,0   RESPECTIVELY
$
  /CLUSTER INFORMATION/

   IB = IP3 + (N-1) * NWPCL - 1 (ADD ABSOLUTE POINTER TO THIS)

  WORD   TYPE  CONTENTS

  IB+ 1   I*4  DETECTOR PART; 0=BARREL, +/-1=+/1 Z END CAP
  IB+ 2   R*4  CLUSTER ENERGY IN GEV.
  IB+ 3    "   EXPECTED SIGMA OF THE ENERGY
  IB+ 4    "   PHI/X FOR BARREL/ENDCAP (RAD./MM)
  IB+ 5    "   Z  /Y FOR BARREL/ENDCAP (IN MM)
  IB+ 6    "   SIGMA(PHI)/SIGMA(X) FOR BARREL/ENDCAP (IN MM)
  IB+ 7    "   SIGMA(  Z)/SIGMA(Y) FOR BARREL/ENDCAP (IN MM)
  IB+ 8#  I*4  (#CONNECTED TRACKS)*100+1ST TRACK#, 0= A PHOTON
  IB+ 9   R*4  DX
  IB+10    "   DY  FROM EVENT VERTEX (SHOWER DEPTH CONSIDERED)
  IB+11    "   DZ
  IB+12    "   EW(2)/EW(1)                   (SIGX**2   SIGXY)
  IB+13    "   EW(2)+EW(1)  EIGEN VALUES OF  (SIGXY   SIGY**2)
  IB+14    "   THE ANGLE OF EIGEN VECTOR
  IB+15    "   THE FRACTION OF ENERGY IN THE EDGE BLOCKS.
               (IF IT IS >0.5, SAY, THE ENERGY OF THE CLUSTER COULD
                BE GROSSLY UNDERESTIMATED)
  IB+16#   "   THE ENERGY OBTAINED BY ADDING THE BLOCKS.
                (I.E. UNCORRECTED ENERGY FOR DATA, AND UNSMEARED FOR MC)

       # INDICATES MODIFICATION.
          (IN THE PATR BANK OF THE SMALLEST NR, 40TH WORD NOW CONTAINS
           THE CLUSTER NUMBER THAT IS CONNECTED TO THE TRACK.
           THIS CONNECTION IS DEFINED TO BE UNIQUE.)

$
 6  DUMP UTILITIES

       THE BOS BANK /ALGL/,/ALGN/ AND /LGCL/ CAN BE PRINTED
       BY SUBROUTINES  PRALGN AND PRLGCL.


    SUBROUTINE PRALGN(LORN,J,MM)
      DUMP THE LEAD GLASS ADC BANK('ALGN') TO LP

    ARGUMENTS (ALL ARE INPUT)
      LORN=0  FOR 'ALGL'/0,  LORN=1 FOR 'ALGN'/1
      THE ADDRESS PART IS DECODED ACCORDING TO THE INPUT J
      J=0, NO DECODING
      J=1,FOR INPUT CODE I.E. CRATE-SLOT-SUBADDRESS
      J=2,FOR POSITION CODE I.E. IPHI-IZ FOR THE BARREL PART
                            I.E. TOP/BOTTOM-NUM FOR THE ENDCAP
      MM IS NO. OF DATA TO BE PRINTED IN A LINE. (5--10 ARE RECOMENDED)
      THIS ARGUMENT IS PREPARED TO USE THE SUBROUTINE BOTH FOR
      LP AND OTHER DISPLAY DEVICES.


      SUBROUTINE PRLGCL

      PRINT THE BANK /LGCL/.
      THE CLUSTER HIT MAP, GENERAL INFORMATION AND EACH CLUSTER DATA
      ARE PRINTED.

$
 6. COMMON /CWORK/

    THE SUBROUTINE LGANAL USES THE COMMON /CWORK/, WHICH IS COPIED INTO
    THE BOS BANK /LGCL/. THE SUBROUTINE LGCDIR USES THE COMMON
    AGAIN IN LINKING THE INNER CHAMBER TRACK TO THE LG CLUSTERS.
    TO MAKE THE LINK, ALL INNER CHAMBER TRACKS ARE EXTENDED TO THE
    LEAD GLASS COUNTERS AND HIT BLOCKS ARE LISTED. POSSIBLE CLUSTERS
    DUE TO CHARGED TRACKS ARE GENERATED AND MATCHING OF THE COUNTERS
    BETWEEN THE OBSERVED CLUSTERS ARE EXAMINED. AFTER THE ANALYSIS
    THE EXPECTED LG HITS BY CHARGED TRACKS AND
    THE LINK TABLES BETWEEN THE OBSERVED LG CLUSTERS AND CHARGED TRACKS
    ARE KEPT IN THE WORK COMMON, WHICH CAN BE USED IMMEDIATELY AFTER
    THE LGCDIR-CALL IF DETAILED LINK INFORMATION IS REQUIRED.

      THE STRUCTURE OF THE COMMON
                   (  USED IN LGCDIR PART OF ANALYSIS )
      COMMON /CWORK/ NCHCLS,NPOINT,MAPCCL(101),HCLADR(1600),
     $               NCHCL2,HCLIST(4,100),  NCLST2,HCLLSO(4,80)

       NCHCLS   NUMBER OF EXPECTED CLUSTERS DUE TO CHARGED PARTICLES.
       NPOINT   TOTAL NUMBER OF HIT COUNTERS
       MAPCCL   MAP OF THE CHARGED TRACK CLUSTERS, ONLY START ADDRESS
                IS STORED.
       HCLADR   COUNTER ADDRESSES
       NCHCL2   =NCHCLS
       HCLIST(1,K)    NUMBER OF CONNECTED CLUSTERS FOR THE K-TH TRACK
             (2-4,K)  THE CLUSTER NUMBERS OF THE OBSERBED CLUSTERS
                      WHICH ARE LINKED TO THE K-TH TRACK.
       NCLST2   =NCLST
       HCLLSO(1,L)    NUMBER OF LINKED TRACKS FOR THE L-TH CLUSTER
             (2-4,L)  THE TRACK NUMBERS OF THE TRACKS WHICH ARE
                      LINKED TO THE CLUSTER

       UP TO 3 LINKS ARE STORED IN THE TABLE
       NOTE THAT IN THE /LGCL/ ONLY ONE OF THEM (THE HIGHEST ENERGY
       CLUSTER) IS STORED.
       THIS TABLE CAN BE PRINTED BY SUBROUTINE PRITOL.

           SUBROUTINE PRITOL(MODE)

       MODE=1, HIT MAP AND ADDRESS ONLY
           =2, LINK TABLES ONLY
           >2, BOTH


####################################################################
 NOTE THAT THE ADDRESS IS ONLY RELATIVE. ONE HAS TO ADD THE POINTER
 TO THE BANK TO GET A CORRECT ADDRESS.
####################################################################

********************************************************************

 ******TO OBTAIN THIS PRINT OUT, SUB 'JADELG.SOURCE(#PRJNOT)'******

*JADE*JADE*JADE*JADE*JADE*JADE*JADE*JADE*JADE*JADE*JADE*JADE*JADE*JADE
C   04/11/81 809081600  MEMBER NAME  #PRMEMO  (SOURCE)      FORTRAN
//JADELGL4 JOB 10622622,JADELG,CLASS=A,MSGLEVEL=(0,0),TIME=(0,5)
// EXEC FCLG
//FORT.SYSIN DD *
      DIMENSION A(80)
      DATA NCOPY/50/
      DATA DOL/1H$/
      DO 2 N=1,NCOPY
      WRITE(6,102)
      DO 1 I=1,100000
      READ(5,100,END=99) A
  100 FORMAT(80A1)
C     IF(MOD(I,33).EQ.0) WRITE(6,102)
  102 FORMAT(1H0,/)
      IF(A(1).NE.DOL) GO TO 3
      WRITE(6,102)
      GO TO 1
3     WRITE(6,101) A
  101 FORMAT(3X,72A1,30X,8A1)
C     WRITE(6,103)
  103 FORMAT(/)
    1 CONTINUE
   99 REWIND 5
    2 CONTINUE
      STOP
      END
//GO.SYSIN DD *
 *******************************************************************
  JADE COMPUTER MEMO

                                      16. AUG. 1984     S.YAMADA

 *******************************************************************
   PROGRAM CHANGE FOR LEAD GLASS (LG) CALIBRATION

    IN CONNECTION WITH THE NEW CALIBRATION CONST FOR THE SF6 LEAD GLASS,
    POSITION DEPENDENCE CORRECTION SUBROUTINE WILL BE CHANGED
    ON MONDAY MORNING   20.08.1984 ( 9:00 )
    TOGETHER WITH THE CONSTANT FILE.

   <<<<<  WARNING>>>>>

   IF YOUR JOB IS RUNNING AT THAT TIME, IT MAY BE AFFECTED
   BY THIS MODIFICATION.

   THERE WILL BE A MESSAGE IN THE MEMBER 'JADELG.SOURCE($MEMO)'
   WHEN ALL CHANGES ARE FINISHED.
   YOU WILL GET BETTER ENERGY RESOLUTION AFTER THE CHANGE.

*****************************************************************

