+PATCH,$CORR. +DECK,CORR1. Updates version: 1.33/00 to 1.34/00 +REP,*TITLE*,TITLE,0-1. &TITLE. GTRAK 1.34/00 07/04/95 19.42.30 GLOBAL TRACKING SOFTWARE +REP,$VERSION,V1_33,1-4. *CMZU: 1.33/04 01/04/95 20.34.20 by Christian Voelcker *CMZU: 1.33/03 07/03/95 17.17.21 by F.-H.Heinsius *CMZU: 1.33/02 13/02/95 12.37.00 by Christian Voelcker *CMZ : 1.33/01 09/02/95 15.03.22 by Christian Voelcker *CMZU: 1.33/00 23/01/95 20.07.43 by Christian Voelcker *-- Author : Christian Voelcker 23/01/95 * *::> VERSION 1.33/04 01/04/95 20.34.20 * *> add some proper initialisation and security checks * to splitoff storing in ttks banks (Curtis Meyer) * *> fix bug when filling TTKS word 3 (Ch.V) * *::> VERSION 1.33/03 07/03/95 17.17.20 * *> TTKS word 53 was not filled correctly for TAXI (TAXSTO) * *::> VERSION 1.33/02 13/02/95 12.37.00 * *> NO WAY of getting the correct version if the * CMZ sequence VERSQQ is hardwired in the code! * That must have been introduced at version 1.31/00 * I removed the content of the sequence by the * CMZ sequence call. (GTBANK,GTVERS) * *> Inserted the printing of all splitoff recognition * packages which have been selected (GTVERS) * * *::> VERSION 1.33/01 09/02/95 15.03.21 * *> repair small bugs which were distributed with the last release. * (initialize dolby-C properly, crystal index in tarond, ..) * *::> VERSION 1.33/00 23/01/95 20.07.43 +ADD,$VERSION,V1_34,*. &DECK,V1_34. *CMZU: 1.34/00 07/04/95 19.42.30 by Christian Voelcker *-- Author : Christian Voelcker 07/04/95 * *::> VERSION 1.34/00 07/04/95 19.42.30 * we want to drop the locater vertex banks, therefore * we need the complete sub-structure if the TCVX bank * to the TVTX bank: * copy Mark Lakata's TCVH bank as well to * the global tracking vertex bank structure. * * abuse the TTKS word 13 (only filled for charged * until now) for the central crystal energy, * if the PED is neutral * +REP,GTPROGRM,GTBANK,1-19. *CMZU: 1.34/00 06/04/95 20.07.07 by Christian Voelcker *CMZU: 1.33/04 29/03/95 15.31.37 by Curtis A. Meyer *CMZU: 1.33/02 13/02/95 10.39.48 by Christian Voelcker *CMZU: 1.33/00 18/01/95 20.34.30 by Christian Voelcker *CMZU: 1.30/02 02/07/94 20.27.41 by Curtis A. Meyer *CMZ : 1.30/01 01/07/94 17.18.41 by Curtis A. Meyer *CMZ : 1.21/11 19/05/94 11.42.54 by Michael Doser *CMZU: 1.21/07 12/01/92 14.44.47 by Curtis A. Meyer *CMZ : 1.21/05 04/12/91 17.17.10 by Gunter Folger *CMZ : 1.21/02 11/10/91 11.49.35 by Mark Burchell *CMZ : 1.21/01 20/08/91 15.21.11 by Gunter Folger *CMZ : 1.21/00 02/08/91 14.35.28 by Mark Burchell *CMZ : 1.20/09 08/05/91 15.07.22 by Gunter Folger *CMZU: 1.20/08 05/04/91 10.59.21 by Mark Burchell *CMZU: 1.20/05 15/02/91 17.43.05 by Gunter Folger *CMZ : 1.20/04 14/02/91 15.47.33 by MARK J BURCHELL *CMZU: 1.20/03 05/12/90 06.55.33 by MARK BURCHELL *-- Author : Mark Burchell SUBROUTINE GTBANK * * ***************************************************************** +REP,GTPROGRM,GTBANK,96. * 13 February, 1995 -- Chr. Voelcker * *> NO WAY of getting the correct version if the * CMZ sequence VERSQQ is hardwired in the code! * That must have been introduced at version 1.31 * I removed the content of the sequence by the * CMZ sequence call. * * 29 March, 1995 C.A.Meyer * Make sure that words 52 to 58 are set to zero * when the TTKS bank is lifted. Otherwise we * get some really wierd problems when checking * them later. * * 01 April, 1995 Chr. Voelcker * copy Mark Lakata's TCVH bank as well to * the global tracking vertex bank structure. * We won't keep the TCVX structure on dst tapes! * * 06 April, 1995 Chr. Voelcker * abuse the TTKS word 13 (only filled for charged * until now) for the central crystal energy, * if the PED is neutral * *----> STRUCTURE OF BANK +REP,GTPROGRM,GTBANK,105-116. *--> WORD 1 = PARTICLE NUMBER *--> WORD 2 = 0 TO FLAG BC AND 1 TO FLAG JDC DATA *--> WORD 3 = GEANT PARTICLE ID IF ANY FAVOURED GUESS EXISTS *--> WORD 4 = CHARGE *--> WORD 5 = # OF POINTS FOR DE/DX *--> WORD 6 = ID OF TRACK ENTRY IN TCTR BANK *--> WORD 7 = FOR CHARGED TRACKS THIS IS * ID OF MATCHED PED ENTRY IN TBTK BANK (IF MATCH EXISTS) *--> WORD 8 = ID OF PARTICLES ORIGINATING VERTEX * For PEDs this is always vertex #1. *--> WORD 9 = ID OF PARTICLES DECAY VERTEX *--> WORD 10 = CHARGED TRACK RECONSTRUCTION QUALITY WORD : +REP,GTPROGRM,GTBANK,122-169. *--> WORD 11 = PED RECONSTRUCION QUALITY WORD * THIS IS (#PEDS IN THE CLUSTER) * + 100* CENTRAL CRYSTAL COMPOUND INDEX *--> WORD 12 = more data about PEDS * THIS IS (id of cluster) + 100*(number of crystals * in the cluster) and if in same cluster as a matched * PED this is multiplied by -1 * REMAINING WORDS ARE ALL REAL *--> (CV not useful) WORD 13 = Probability from LOCATER of charged track *--> WORD 13 = Chi2/ number of degrees of freedom. (good track < 1.2) *--> WORD 14 = MOMENTUM (P) *--> WORD 15 = ENERGY (FOR CHARGED TRACKS THIS ASSUMES THEY ARE PIONS) *--> WORD 16 = Px *--> WORD 17 = Py *--> WORD 18 = Pz *--> WORD 19 = ERROR ON MOMENTUM *--> WORD 20 = ERROR ON ENERGY *--> WORD 21 = ERROR ON PX *--> WORD 22 = ERROR ON Py *--> WORD 23 = ERROR ON Pz *--> WORD 24 = dE/dx *--> WORD 25 = ERROR ON dE/dx *--> WORD 26 = CHI**2(electron) *--> WORD 27 = CHI**2(muon) *--> WORD 28 = CHI**2(pion) *--> WORD 29 = CHI**2(kaon) *--> WORD 30 = CHI**2(proton) *--> WORD 31 = COSINE(ANGLE) between matched charged track and PED *--> WORD 32 = COSINE(ANGLE) between cloest unmatched track & PED *--> WORD 33 = E1/E9 for PEDs *--> WORD 34 = Second moment for PEDS *--> WORD 35 = Showermass (of parent cluster) *--> WORD 36 = Energy of parent cluster *--> WORD 37 = u directional cosine of parent cluster *--> WORD 37 = v directional cosine of parent cluster *--> WORD 37 = w directional cosine of parent cluster * THE LAST WORDS ARE THOSE NEEDED FOR KINEMATIC FITTING *--> WORD 40 = PSI ANGLE FOR CHARGED TRACKS *--> WORD 41 = 1/PT FOR CHARGED TRACKS *--> WORD 42 = TAN(LAMBDA) FOR PARTICLES *--> WORD 43 = PHI ANGLE FOR PEDS *--> WORD 44 = THETA ANGLE FOR PEDS *--> WORD 45 = SQUARE ROOT E FOR PEDS *--> WORD 46 = COVARIANT ERROR MATRIX IN LOWER TRIANGULAR FORM *--> = FOR CHARGED TRACKS IT IS FOR WORDS 40,41,42 *--> WORD 51 = FOR PEDS IT IS FOR WORDS 43,44,45 * ************************************************************* +REP,GTPROGRM,GTBANK,187-191. * declaration of a multitude of previously undefined local variables * INTEGER IMTCGT,NTTKS,ITCVT,NMX,NVT,IJ,IL,ITVVT,ITVVP, > JTTKS,ITCTR,J,NTKS,ILP,ITCVP,IK,ILN,ITCTK,IK1,IK2,JTBTK, > NPEDS,LINK,JX,IUPD,ITVTV,IVRTX, > ITVVH,ITCVH,ILH +REP,GTPROGRM,GTBANK,201-202. *---> NNTKS IS THE TOTAL NUMBER OF LIFTED SUB-BANKS *---> IVERS IS THE VERSION NUMBER OF THE BANK STRUCTURE +REP,GTPROGRM,GTBANK,210-213. INTEGER MHOL,MTVTV(10),MHOP,MTVVP(10),MHOH,MTVVH(10) SAVE MHOL,MHOP,MHOH DATA MHOL/4HTVTV/ DATA MHOP/4HTVVP/ DATA MHOH/4HTVVH/ +REP,GTPROGRM,GTBANK,228. ***> WRITE(4,*) 'EVENT ',NENT,' LIFT NEW LHTRK BANK' +REP,GTPROGRM,GTBANK,238-244. ***> WRITE(4,*) 'EVENT ',NENT,' LIFT NEW LTCVX BANK' IF (LHTJD.LE.0) THEN ***> WRITE(4,*) 'FIRST IT IS NECESSARY TO LIFT LHTJD' CALL MZLIFT(IXHTJD,LHTJD,LEVHD,-2,MHTJD,0) ENDIF MTCVX(5) = 2 ***> WRITE(4,*) (MTCVX(I),I=1,5) +REP,GTPROGRM,GTBANK,294. ***> WRITE(4,*) 'EVENT ',NENT,' LIFT NEW LTVTX BANK' +ADD,GTPROGRM,GTBANK,322. * 1/4/95 CV * do the same for the TCVH bank created recently. This bank has a * homogenous structure, therefore we may just copy its info from * MTCVH, including MTCVH(5) MTVVH(1) = MHOH CALL UCOPY(MTCVH(2),MTVVH(2),4) * +REP,GTPROGRM,GTBANK,338. * ITVVT is a local variable that needs watching. (address of TVTV bank) +REP,GTPROGRM,GTBANK,355-357. ***> WRITE(4,*) 'LIFT THE ITVVP BANK' * * Lift the TVVP sub-bank +REP,GTPROGRM,GTBANK,366. ***> WRITE(4,*) ' TVVP BANK LIFTED OK' * * * Lift the TVVH sub-bank * ITCVT must be valid for the next operation. * ITCVT = LQ(LTCVX-IJ) ! pointer to the current vertex * bank length is structure length * number of tracks at this vertex MTVVH(4) = LENVH*IQ(ITCVT+1) CALL MZLIFT(IXTVTX,ITVVH,ITVVP,0,MTVVH,0) +ADD,GTPROGRM,GTBANK,373. * cross the fingers that it works!! TVVH is the next bank in the linear * structure (page 8, zebra manual) ITVVH = LQ(ITVVP) +REP,GTPROGRM,GTBANK,381-396. * copy the TCVP bank ITCVP = LQ(ITCVT-1) ILP = (IK-1)*LENVP CALL UCOPY(IQ(ITCVP+1+ILP),IQ(ITVVP+1+ILP),2) CALL UCOPY(Q(ITCVP+3+ILP),Q(ITVVP+3+ILP),ILN) 400 CONTINUE * now the TCVH bank - only reals, copy at once! ITCVH = LQ(ITCVP) ! next linear structure ... ILH = IQ(ITCVT+1)*LENVH CALL UCOPY(Q(ITCVH+1),Q(ITVVH+1),ILH) * END IF * 500 CONTINUE * * * Always create header ttks bank. * ***> WRITE(4,*) 'EVENT ',NENT,' LIFT NEW LTTKS BANK' +REP,GTPROGRM,GTBANK,436. ***> WRITE(4,*) 'TRK ',J,'LIFTS BANK FOR PARTICLE ',NNTKS +ADD,GTPROGRM,GTBANK,447. * Make sure that the following words, which are only * optionally filled are all set to zero. * IQ(JTTKS+52) = 0 IQ(JTTKS+53) = 0 IQ(JTTKS+54) = 0 IQ(JTTKS+55) = 0 Q(JTTKS+56) = 0.0 IQ(JTTKS+57) = 0 IQ(JTTKS+58) = 0 * +REP,GTPROGRM,GTBANK,490-491. *--> IN WORD 5 ITCTK IS NOT A TYPING ERROR ! *--> GET TRACK POINTER INTO TCTK BANK +REP,GTPROGRM,GTBANK,516-524. CV IF (Q(ITCTR+17).GT.0.000001) THEN CV ND = 3*IQ(ITCTR+1) - 5 CV Q(JTTKS+13) = PROB(Q(ITCTR+17),ND) CV ELSE CV Q(JTTKS+13) = 0.0 CV ENDIF * * track probability was not useful. (and they did not substract PWC hits!) * now (18/01/95) fill the chi2/degree of freedom +REP,GTPROGRM,GTBANK,531. * a track should never have no hits .... +REP,GTPROGRM,GTBANK,538. * GET PX FROM PT TIMES COS(ANGLE IN XY PLANE), PY SIMILARLY +REP,GTPROGRM,GTBANK,544-546. * guard against floating point exception. Be careful reordering * the computation. The code has been written to try and * minimize overflow problems, aprticularly on VAXEN. +REP,GTPROGRM,GTBANK,588-593. *--> DE/Dx values. * Q(JTTKS+24) = Q(ITCTR+9) Q(JTTKS+25) = Q(ITCTR+10) * *---> Next dE/dx. First set all probabilties to zero, then call gtdedx +REP,GTPROGRM,GTBANK,604. *--> ANGLES BETWEEN TRACKS-PEDS +REP,GTPROGRM,GTBANK,693. 1000 CONTINUE +REP,GTPROGRM,GTBANK,726. ***> WRITE(4,*) 'PED ',NPEDS,'LIFTS BANK FOR PARTICLE ',NNTKS +ADD,GTPROGRM,GTBANK,733. * Make sure that the following words, which are only * optionally filled are all set to zero. * IQ(JTTKS+52) = 0 IQ(JTTKS+53) = 0 IQ(JTTKS+54) = 0 IQ(JTTKS+55) = 0 Q(JTTKS+56) = 0.0 IQ(JTTKS+57) = 0 IQ(JTTKS+58) = 0 * +REP,GTPROGRM,GTBANK,770. * * Fill the energy of the central crystal * Q(JTTKS+13) = Q(LINK+14) +REP,GTPROGRM,GTBANK,843. 1900 CONTINUE +REP,GTPROGRM,GTBANK,852-856. &SEQ,VERSQQ. ******************************* * content of VERSQQ ... * VERSQQ = ' 1.31/00' * IVERSQ = 13100 ******************************* +REP,GTPROGRM,GTDONE,1-10. *CMZU: 1.33/01 07/02/95 14.41.08 by Christian Voelcker *CMZU: 1.33/00 23/01/95 15.20.36 by Christian Voelcker *CMZ : 1.21/10 11/12/92 16.50.00 by Michael Doser *CMZ : 1.20/03 05/12/90 06.55.33 by MARK BURCHELL *-- Author : ****************************************************** * * modifications: 12/01/95 Christian Voelcker * print out split-off statistics. * ****************************************************** +REP,GTPROGRM,GTDONE,20. C--> A GLOBAL TRACKING RESULTS SUMMARY +REP,GTPROGRM,GTDONE,27. 100 FORMAT(/,/,12X,'GLOBAL TRACKING SUMMARY',/, +REP,GTPROGRM,GTDONE,44-60. WRITE(LLOG,201) NSPLGT, NSHWGT-NSPLGT, RMEAN1 ENDIF IF(DOLBGT) THEN IF(NDBGGT.GT.0) THEN RMEAN1 = FLOAT(NDBSGT)/FLOAT(NDBGGT) RMEAN2 = FLOAT(NDBTGT)/FLOAT(NDBGGT) ELSE RMEAN1 = 0 RMEAN2 = 0 ENDIF WRITE(LLOG,202) NDBGGT, NDBTGT, NDBSGT, RMEAN1, RMEAN2 ENDIF IF(SMARGT) THEN IF(NSMGGT.GT.0) THEN RMEAN1 = FLOAT(NSMSGT)/FLOAT(NSMGGT) RMEAN2 = FLOAT(NSMAGT)/FLOAT(NSMGGT) ELSE RMEAN1 = 0 RMEAN2 = 0 ENDIF WRITE(LLOG,203) NSMGGT, NSMAGT, NSMSGT, RMEAN1, RMEAN2 +REP,GTPROGRM,GTDONE,81-114. IF(NSHWGT.GT.0) THEN RMEAN1 = FLOAT(NSIXGT)/FLOAT(NSHWGT) ELSE RMEAN1 = 0 ENDIF WRITE(LLOG,206) NSIXGT, RMEAN1 ENDIF 201 FORMAT(/,5X,'=============================================', & /,5X,' Split-off Statistics', & /,5X,'=============================================',/, & /,5X,'all methods combined (based on unmatched peds)' & /,5X,'total number of split-off found ..........',I9, & /,5X,'total number of good gammas found ........',I9, & /,5X,'ratio split-off/unmatched PEDs ...........',F9.2) 202 FORMAT(/,5X,' Dolby-C Summary (using unmatched PEDs only)', & /,5X,' number of good gammas ..............',I9, & /,5X,' number of sub-treshold PEDs ........',I9, & /,5X,' number of split-off ................',I9, & /,5X,' ratio split-off/good gamma .........',F9.2, & /,5X,' ratio sub-treshold/good gamma ......',F9.2) 203 FORMAT(/,5X,' Smart Summary (using all PEDs from TBEN bank)', & /,5X,' number of good PEDs ................',I9, & /,5X,' number of ambiguous PEDs ...........',I9, & /,5X,' number of split-offs ...............',I9, & /,5X,' ratio split-off/good PEDs ..........',F9.2, & /,5X,' ratio ambiguous/good PEDs ..........',F9.2) 204 FORMAT(/,5X,' Brain Summary', & /,5X,' number of split-off ................',I9) 205 FORMAT(/,5X,' Taxi Summary (using all PEDs from TBEN bank)', & /,5X,' number of good gammas ..............',I9, & /,5X,' # of PEDs re-matched to charged ... ',I9, & /,5X,' # of charged with more than 1 PED ..',I9, & /,5X,' ratio re-matched/good gamma ........',F9.2, & /,5X,' ratio re-matched/charged tracks ....',F9.2) 206 FORMAT(/,5X,' SingXtl Summary (looking at unmatched PEDs only)', & /,5X,' number of single Xtal PEDs .........',I9, & /,5X,' ratio single Xtals/unmatched PEDs ..',F9.2) +REP,GTPROGRM,GTDUMP,1-41. *CMZU: 1.33/04 29/03/95 08.25.07 by Curtis A. Meyer *CMZ : 1.32/00 20/07/94 13.44.21 by "Curtis A. Meyer" *CMZ : 1.31/01 19/07/94 22.57.47 by "Curtis A Meyer" *CMZU: 1.30/00 23/02/94 08.18.28 by Curtis A. Meyer *-- Author : C.A.Meyer, et. al. SUBROUTINE GTDUMP (IUNIT,LINK,QBAD) ************************************************************************ *** * *** SUBROUTINE GTDUMP (IUNIT,LINK,QBAD) * *** * *** Dump of ZEBRA bank (LINK) with Global Tracking Data * *** in user readable format. * *** * *** Dumped banks: * *** TTKS * *** * *** Created: 22-FEB-1994 C.A.Meyer * *** Stolen from BCDUMP * *** * *** Arguments: (INPUT,OUTPUT,INPUT/OUTPUT) * *** Expected input: * *** IUNIT = Unit# for output of formatted text * *** LINK = Link to ZEBRA bank, which will be dumped * *** Final output: * *** QBAD = Error if LINK points to a bank for which no * *** dump is provided * *** * *** ==>Called by : user * *** ==>Calling : BITOPT, UHTOC * *** * ************************************************************************ ** commons, bcener is only for energy of cluster (TBCL) &SEQ,CBLINK. ** Output unit, ZEBRA-Link INTEGER IUNIT,LINK ** Bad Link (no dump for this bank provided) LOGICAL QBAD ** Local variables +REP,GTPROGRM,GTDUMP,58-105. *** Do the dumps according to the name of the bank * transform Hollerith IQ() to Character CNAME CALL UHTOC(IQ(LINK-4), 4, CNAME, 4) *** Dump of 'TTKS' banks - PEDs 100 FORMAT (1X,/,1X,A4,': ',A) * IF (CNAME.EQ.'TTKS') THEN WRITE (IUNIT,100) CNAME, 'Global Tracking Data' LT = LQ(LINK-1) 500 IF (LT.NE.0) THEN * WRITE(IUNIT,1500)IQ(LT+1),IQ(LT+2),IQ(LT+3),IQ(LT+4) 1500 FORMAT(' ',I2,' Data Type ',I2,' Geant ',I6, & ' Charge ',I3) * *** Crystal Data: * IF(IQ(LT+2).EQ.0) THEN * WRITE(IUNIT,1550)IQ(LT+7),IQ(LT+11),IQ(LT+12) 1550 FORMAT(1X,/,' Unmatched PED DATA: ',/, & ' TBTK:',I3,' Ped quality ',I9,1X,I9) * WRITE(IUNIT,1575)Q(LT+15),Q(LT+20),Q(LT+14),Q(LT+19), & Q(LT+16),Q(LT+17),Q(LT+18),Q(LT+21),Q(LT+22),Q(LT+23) 1575 FORMAT(' Ener=',F10.2,'+/-',F10.2,' Momentum ', & F10.2,'+/-',F10.2,/,' Pxyz ',3(1X,F10.2),/, & ' Delta_Pxyz ',3(1X,F10.2)) * WRITE(IUNIT,1600)Q(LT+33),Q(LT+34),Q(LT+35) 1600 FORMAT(' E1/E9 ',F9.4,' 2nd moment ',F9.4, & ' shower mass ',F9.4) * WRITE(IUNIT,1625)Q(LT+43),Q(LT+44),Q(LT+45) 1625 FORMAT(' phi ',F9.4,' theta ',F9.4,' sqrt(E) ',F9.3) * WRITE(IUNIT,1650)Q(LT+46),Q(LT+48),Q(LT+50) 1650 FORMAT(' CV-diag ',E12.5,1X,E12.5,1X,E12.5) * WRITE(IUNIT,1655)IQ(LT+52),IQ(LT+53),IQ(LT+54), & IQ(LT+55),IQ(LT+56),IQ(LT+57) * 1655 FORMAT(' DOLBY-C Splitoff Word ',I6,/, & ' TAXI Cluster ID ',I6,/, & ' SMART return Code ',I6,/, & ' SMART parent PED ',I6,/, & ' BRAIN Probability ',F19.12,/, & ' BRAIN parent PED ',F19.12) * *** JDC Data: * ELSEIF( IQ(LT+2).EQ.1) THEN * WRITE(IUNIT,1700)IQ(LT+6),IQ(LT+10) 1700 FORMAT(1X,/,' JDC Track Data - TCTR: ',I6,/, +REP,GTPROGRM,GTDUMP,112. 1725 FORMAT(' dE/dx: ',F9.3,'+/-',F9.3) +REP,GTPROGRM,GTDUMP,120. 1750 FORMAT(' Matched PED is TBTK ',I6, +REP,GTPROGRM,GTDUMP,135. ** Error: This bank can't be dumped with this subroutine +REP,GTPROGRM,GTINIT,1-6. *CMZU: 1.33/01 09/02/95 14.22.43 by Christian Voelcker *CMZU: 1.33/00 12/01/95 15.22.56 by Christian Voelcker *CMZU: 1.30/01 01/07/94 16.19.06 by Curtis A. Meyer *CMZ : 1.21/10 18/03/93 16.16.40 by Michael Doser *CMZ : 1.21/09 04/12/92 11.27.13 by Michael Doser *CMZ : 1.21/05 04/12/91 17.16.00 by Gunter Folger *-- Author : +REP,GTPROGRM,GTINIT,14-16. &SEQ,GTFLAG. &SEQ,GTSOST. &SEQ,GTSOCO. ********************************************************* +REP,GTPROGRM,GTINIT,48. * --> Chr. Voelcker 06-02-95 * Initialize Dolby C *************************************************************** +REP,GTPROGRM,GTINIT,56-59. * dolby c initialization variables. (see below) REAL E, ASYM, CPSI, EPI, ENONG * * __________________________________________________________ * *--> SET ERROR CODE +REP,GTPROGRM,GTINIT,75-77. 6000 FORMAT(' WELCOME TO GLOBAL TRACKING ') C C---> INITIALIZE THE COUNTERS FOR THE TOTAL NUMBER OF TRACKS AND +REP,GTPROGRM,GTINIT,88-111. C---> counters for splitoff packages C * DolBy-c NDBGGT = 0 ! 'Good gammas' NDBTGT = 0 ! 'subTreshold peds' NDBSGT = 0 ! 'Split-offs' * SMart NSMGGT = 0 ! 'Good gammas' NSMAGT = 0 ! 'Ambiguous peds' NSMSGT = 0 ! 'Split-offs' * BRain * TAxi NTAGGT = 0 ! 'Good gammas' NTASGT = 0 ! 'Split-offs (hadronic)' NTACGT = 0 ! 'Charged tracks with some splitoffs' * SIngle Xtal Peds NSIXGT = 0 ! 'peds(cluster) with only one Xtal' * all together NSPLGT = 0 * C C---> initialize variables to allow Splitoff recognition info being +REP,GTPROGRM,GTINIT,120. C---> DOLBY C needs to be initialized. But careful: USINIT is called later, C so if the user wants to run DOLBY-C with other than the default values, C he needs to call DBCINI again! (We will take the values used in the C dst production programme) C IF(DOLBGT) THEN E = 100. ! Max splitoff energy ASYM = 0.45 ! ASYM is the maximum (1 - A**2) where A is ! the energy asymmetry between the splitoff and parent CPSI = 0.2 ! is the maximum (1.0 - cos(psi)) where psi ! is the opening angle between the splitoff and parent EPI = 1150. ! is the pion energy giving the hyperbola ! below which a splitoff must lie in the ASYM vs CPSI plane ENONG = 10. ! treshold energy. below ENONG everything is a ! splitoff.. CALL DBCINI(E, ASYM, CPSI, EPI, ENONG) ENDIF C C---> CALL MZFORM FOR THE GLOBAL TRACK BANKS +REP,GTPROGRM,GTINIT,131. 100 CONTINUE +REP,GTPROGRM,GTRACK,1-10. *CMZU: 1.33/04 29/03/95 15.10.31 by Curtis A. Meyer *CMZU: 1.33/00 12/01/95 17.27.19 by Christian Voelcker *CMZ : 1.21/08 17/03/92 17.16.43 by Michael Doser *CMZ : 1.21/05 04/12/91 17.09.27 by Gunter Folger *-- Author : SUBROUTINE GTRACK(IER) ***************************************************************** +REP,GTPROGRM,GTRACK,35-51. * Mar 29/95, C.A.Meyer * Verify the Splitoff words. * ************************************************************* * &SEQ,IMPNONE. &SEQ,CBLINK. &SEQ,GTFLAG. INTEGER IER INTEGER JTTKS,I INTEGER IER001,IER002,IER003,IER004,IER005,IER006 DATA IER001,IER002,IER003,IER004,IER005,IER006 /6*0/ SAVE IER001,IER002,IER003,IER004,IER005,IER006 C C_____________________________________________________________ C C--> if retracking is required, wipe all global tracking banks C (MZWIPE is slower than MZDROP, but also cleaner...) IF (RTRKGT.AND.LHTRK.GE.0) CALL MZWIPE(IXHTRK) C C--> IF MATCHING IS REQUESTED CALL GTMTCH C IF (MTCHGT.AND.(LHTRK.EQ.0)) CALL GTMTCH C C C--> CREATE BANKS FOR THE EVENT C IF (MTCHGT.AND.(LHTRK.EQ.0)) CALL GTBANK * * do all splitoff recognition at once! +REP,GTPROGRM,GTRACK,57-58. C--> SET ERROR CODES IER = 0 C C--> Verify that the split-off codes are good: C IF (LTTKS .LE. 0) RETURN DO 1000 I = 1,IQ(LTTKS+1) JTTKS = LQ(LTTKS-IQ(LTTKS-2)-I) IF(JTTKS.LE.0) GOTO 1000 C C--> Check Dolby C codes: C IF((IQ(JTTKS+52).LT.-2).OR.(IQ(JTTKS+52).GT.50)) THEN CALL ERRLOG(IER001, &' DOLBY-C Return Code is out of Range.') ENDIF C C--> Check TAXI codes: C IF((IQ(JTTKS+53).LT.0).OR.(IQ(JTTKS+53).GT.50)) THEN CALL ERRLOG(IER002, &' TAXI Return Code is out of Range.') ENDIF C C--> Check SMART codes: C IF((IQ(JTTKS+54).LT.0).OR.(IQ(JTTKS+54).GT.2)) THEN CALL ERRLOG(IER003, &' Smart Return Code is out of Range.') ENDIF IF((IQ(JTTKS+55).LT.0).OR.(IQ(JTTKS+55).GT.50)) THEN CALL ERRLOG(IER004, &' Smart Parent Pointer is out of Range.') ENDIF C C--> Check BRAIN codes: C IF((Q(JTTKS+56).LT.0.0).OR.(Q(JTTKS+56).GT.1.0)) THEN CALL ERRLOG(IER005, &' Brain Probability is out of Range.') ENDIF IF((IQ(JTTKS+57).LT.0).OR.(IQ(JTTKS+57).GT.50)) THEN CALL ERRLOG(IER006, &' Brain Parent Pointer is out of Range.') ENDIF 1000 CONTINUE +REP,GTPROGRM,GTVERS,1-2. *CMZU: 1.33/02 13/02/95 12.36.18 by Christian Voelcker *CMZU: 1.30/00 22/06/94 21.50.54 by Curtis A. Meyer *-- Author : Curtis A. Meyer +REP,GTPROGRM,GTVERS,28-30. * 13 February, 1995 -- Chr. Voelcker * *> NO WAY of getting the correct version if the * CMZ sequence VERSQQ is hardwired in the code! * That must have been introduced at version 1.31 * I removed the content of the sequence by the * CMZ sequence call. * *> I took the occasion and inserted the printing * of all splitoff recognition packages which have * been selected. * * ******************************************************** * &SEQ,IMPNONE. &SEQ,GTFLAG. +REP,GTPROGRM,GTVERS,63-66. &SEQ,VERSQQ. +ADD,GTPROGRM,GTVERS,73. * indicate which splitoff packages are selected IF(DOLBGT.OR.SMARGT.OR.BRAIGT.OR.TAXIGT.OR.SINXGT) THEN WRITE(LLOG,120) IF(DOLBGT) WRITE(LLOG,121) IF(SMARGT) WRITE(LLOG,122) IF(BRAIGT) WRITE(LLOG,123) IF(TAXIGT) WRITE(LLOG,124) IF(SINXGT) WRITE(LLOG,125) WRITE(LLOG,130) ENDIF +REP,GTPROGRM,GTVERS,121-174. 100 FORMAT(' ############################################',/, & ' # #',/, & ' # Crystal Barrel Global Tracking Software #') 110 FORMAT(' # Version ',A8, ' #',/, & ' # #') 120 FORMAT(' # Splitoff recognition selected: #') 121 FORMAT(' # DOLBY-C #') 122 FORMAT(' # SMART #') 123 FORMAT(' # BRAIN (neural network) #') 124 FORMAT(' # TAXI-2 (for charged s-o) #') 125 FORMAT(' # Single Crystals flagging #') 130 FORMAT(' # #') 200 FORMAT(' # Code linked using the Alliant flag. #') 210 FORMAT(' # Code linked using the Apollo flag. #') 215 FORMAT(' # Code linked using the CDC flag. #') 216 FORMAT(' # Code linked using the CRAY flag. #') 217 FORMAT(' # Code linked using the DECS flag. #') 220 FORMAT(' # Code linked using the IBM flag. #') 222 FORMAT(' # Code linked using the Next flag. #') 225 FORMAT(' # Code linked using the SUN flag. #') 230 FORMAT(' # Code linked using the VAX flag. #') 295 FORMAT(' # Code linked using generic UNIX flag. #') 300 FORMAT(' # #',/, & ' ############################################') * 350 FORMAT(1X, &SELF,IF=F77. 100 FORMAT(' ############################################',/, & ' # #',/, & ' # CRYSTAL BARREL GLOBAL TRACKING SOFTWARE #') 110 FORMAT(' # VERSION ',A8, ' #',/, & ' # #') 120 FORMAT(' # SPLITOFF RECOGNITION SELECTED: #') 121 FORMAT(' # DOLBY-C #') 122 FORMAT(' # SMART #') 123 FORMAT(' # BRAIN (NEURAL NETWORK) #') 124 FORMAT(' # TAXI-2 (FOR CHARGED S-O) #') 125 FORMAT(' # SINGLE CRYSTAL FLAGGING #') 130 FORMAT(' # #') 200 FORMAT(' # CODE LINKED USING THE ALLIANT FLAG. #') 210 FORMAT(' # CODE LINKED USING THE APOLLO FLAG. #') 215 FORMAT(' # CODE LINKED USING THE CDC FLAG. #') 216 FORMAT(' # CODE LINKED USING THE CRAY FLAG. #') 217 FORMAT(' # CODE LINKED USING THE DECS FLAG. #') 220 FORMAT(' # CODE LINKED USING THE IBM FLAG. #') 222 FORMAT(' # CODE LINKED USING THE NEXT FLAG. #') 225 FORMAT(' # CODE LINKED USING THE SUN FLAG. #') 230 FORMAT(' # CODE LINKED USING THE VAX FLAG. #') 295 FORMAT(' # CODE LINKED USING GENERIC UNIX FLAG. #') 300 FORMAT(' # #',/, & ' ############################################') * 350 FORMAT(1X, &SELF. &SEQ, QFTITLE, N=45. &) &SELF,IF=-F77. 360 FORMAT(' CMZ run on ',I6,' at ',I4,'.'/) * * 400 FORMAT(' Analysis date:',I2,'.',I2,'.',I4,/, & ' Analysis time:',I2,':',I2) * &SELF,IF=F77. 360 FORMAT(' CMZ RUN ON ',I6,' AT ',I4,'.'/) * * 400 FORMAT(' ANALYSIS DATE:',I2,'.',I2,'.',I4,/, +REP,GTPROGRM,GTSOFF,1-5. *CMZU: 1.33/04 15/03/95 20.47.40 by Christian Voelcker *CMZU: 1.33/00 23/01/95 15.30.38 by Christian Voelcker *-- Author : Christian Voelcker 12/01/95 SUBROUTINE GTSOFF IMPLICIT NONE ************************************************************** +REP,GTPROGRM,GTSOFF,19. ************************************************************** +REP,GTPROGRM,GTSOFF,28-29. * all array indices refer to TTKS bank numbers, exept IVECSM(50), * which uses the TBTK numbering scheme. +REP,GTPROGRM,GTSOFF,42-46. * reset splitoff flag array DO I=1,50 LVECSO(I)=.FALSE. ENDDO * DOLBY-C +REP,GTPROGRM,GTSOFF,62. * SMART +REP,GTPROGRM,GTSOFF,72-82. * forget about LVECSO flag setting this time... whoever needs it may do it!! * but be careful and don't count peds which are matched to a track! * (IVECSM refers to TBTK bank, not to TTKS bank!) ENDIF * BRAIN IF(BRAIGT) THEN * insert calls to BRAIN here!! ENDIF * TAXI +REP,GTPROGRM,GTSOFF,105-106. * mark single unmatched Crystals (do-it-yourself) - * they are useless for analysis! +REP,GTPROGRM,GTSOFF,113-117. CALL SBIT1(IQ(JTTKS+3),32) ! mark as splitoff CALL SBIT1(IQ(JTTKS+3),5) ! set single xtal flag +REP,GTPROGRM,GTSOFF,125-134. * loop over all tracks and count the total number of splitoff DO I=1,NTRAKS IF(LVECSO(I)) NSPOFF=NSPOFF+1 ENDDO * add to global statistics NSPLGT = NSPLGT+NSPOFF * now, finally, fill the number of really *good* gammas * * IF(DOLBST.OR.SMARST.OR.BRAIST.OR.TAXIST.OR.SINGST) THEN * (that's for later..) +REP,GT_TAXI,TAROND,1-49. *CMZU: 1.33/01 07/02/95 10.48.19 by Christian Voelcker *CMZU: 1.33/00 23/01/95 11.37.15 by Christian Voelcker *-- Author : Benayoun 13/12/94 *234567890 SUBROUTINE TAROND(IVEC,IERR) IMPLICIT NONE ************************************************************** * * * Modifications * * 23/12/94 CV put common blocks into COMMON area, * * change name of subroutines * * define all variables the proper way * * fill the TAXI information into TTKS bank. * * * * 18/01/95 CV+BNY * * correct for the external xtal rings ... * * 24/01/95 CV * * call bitopt to calculate theta/phi safely! * * * ************************************************************** C----------------------------------------------------------------- C STUDY OF THE CRYSTALS C------------------------------------------------------------- C ROUTINE TO FIND IF UNMATCHED PEDs FIT MATCHED CLUSTERS C CC------------------------------------------------------------- ccccc on exit IVEC contains the NXTAL compound indices ccccc of the cluster Xtals C----------------------------------------------------------- c error codes : IERR=0 normal termination C IERR=1 normal termination but c 1 track has no matched cluster C IERR=2 normal termination but C 2 tracks or more have no matched cluster C abnormal codes : IERR=3 no TBEN bank C IERR=4 no TTKS C IERR=5 number of charged tracks>20 C IERR=6 no TBTK bank C IERR=7 wrong xtal coordinates in theta/phi C----------------------------------------------------------- C result stored in IVEC C IVEC(i),i=1,ncharged : nbr of unmatched peds C matching track i C IVEC(i), i=ncharged+1,npart : info on unmatched peds C IVEC(i)=0 true unmatched ped C ivec(i)=k unmatched ped matching track nbr=k C----------------------------------------------------------- +REP,GT_TAXI,TAROND,55. C--- CONTAINS COMMON/BCENER/ENERBC(60,26) +REP,GT_TAXI,TAROND,81-83. * do only at first call... IF(LPREM) THEN * call taxido to zero the full CONFTA array +REP,GT_TAXI,TAROND,90. * set all crystal flags to zero (has to be done for each event!) +REP,GT_TAXI,TAROND,96-105. * set the return vector to zero DO I=1,50 IVEC(I)=0. ENDDO * C-------------------------------- IERR=3 IF(LTBEN.EQ.0) RETURN !<<<<< C-------------------------------- C load crystal informations when above ECUTTA into CONFTA NTOT=IQ(LTBEN+1) DO I=1,NTOT IPOS=IQ(LTBEN+2*I) CV IY=IPOS/60+1 CV IX=IPOS-(IY-1)*60 +REP,GT_TAXI,TAROND,117. C complete all six external rings +REP,GT_TAXI,TAROND,127. C-------------------------------- +REP,GT_TAXI,TAROND,133-145. C-------------------------------- IERR=5 IF(NPION.GT.20) RETURN ! too much is too much C-------------------------------- C-------------------------------- IERR=6 IF(LTBTK.EQ.0) RETURN C-------------------------------- CV IF(LECR) WRITE(LLOG,*) 'ICALL',ICALL, CV & 'NPION,NPHOTON',NPION,NPHOT ************************************ * now loop over all charged tracks ************************************ +REP,GT_TAXI,TAROND,153-154. CV J=IW/60+1 CV I=IW-60*(J-1) CALL BITOPT(IW,I,J) IA=(J-1)*(J-26) IB=(I-1)*(I-60) IF(IA.GT.0.OR.IB.GT.0) THEN IERR=7 RETURN ENDIF +REP,GT_TAXI,TAROND,160. * now load the cluster information into the IRINDX array +REP,GT_TAXI,TAROND,166-179. CV IF(LECR) THEN CV WRITE(LLOG,*) 'ipion=',IP, 'nbre of Xtals',MAXC CV WRITE(LLOG,*) 'central Xtal',IW CV WRITE(LLOG,1000)(IRINDX(K,IP),K=1,MAXC) CV 1000 FORMAT(5(2X,I10)) CV ENDIF 80 CONTINUE ENDIF ENDDO C-------------------------------------------------------- C-- after the loop on IP, all hadronic clusters have been C identified ; now check the unmatched peds within C the hadronic clusters. C-------------------------------------------------------- +REP,GT_TAXI,TAROND,187-191. CV IF(LECR) THEN CV IPQ=IL-NPION CV WRITE(LLOG,*)' photon nbr=',IPQ CV WRITE(LLOG,*)' central Xtal',IWR CV ENDIF +REP,GT_TAXI,TAROND,203-205. 90 CONTINUE ENDDO c-- end clustering. +REP,GT_TAXI,TAROND,214-216. CV IF(LECR) THEN CV WRITE(LLOG,1000) (IVEC(I),I=1,NPART) CV ENDIF +REP,GT_TAXI,TAXIDO,1-5. *CMZU: 1.33/01 07/02/95 10.19.29 by Christian Voelcker *CMZU: 1.33/00 23/01/95 13.54.39 by Christian Voelcker *-- Author : M. Benayoun 10/11/94 SUBROUTINE TAXIDO(ITH,IPH,NC,ICLTH,ICLPH,QCLTR) IMPLICIT NONE ***************************************************************** +REP,GT_TAXI,TAXIDO,43-51. * 07/02/95 Christian Voelcker * bugs reported after release * ***************************************************************** &SEQ,GTTAXI. CV IMPLICIT LOGICAL (L) CV COMMON/BPAT/CONF(-4:30,60) INTEGER ICLTH(1400),ICLPH(1400) REAL QCLTR(1400) INTEGER ITH,IPH,NC,NTAXI,I,J,ITH0,IPH0 SAVE NTAXI +REP,GT_TAXI,TAXIDO,61-62. CV NTAXI=3 ! maximum taxiblock distance CV NTAXI=1 ! maximum taxiblock distance +REP,GT_TAXI,TAXIDO,70-77. RETURN ENDIF C IDENTIFICATION OF COLUMN -2,-1,.. WITH 60, 59... done NC=0 ITH0=ITH IPH0=IPH IC=0 100 CONTINUE +REP,GT_TAXI,TAXIDO,101-102. C drop the odd phi crystals in the six external rings C IC=0 +REP,GT_TAXI,TAXSTO,0-29. &DECK,TAXSTO. *CMZU: 1.33/04 01/04/95 20.22.12 by Christian Voelcker *CMZ : 15/03/95 20.46.27 by Christian Voelcker *CMZU: 1.33/03 07/03/95 17.04.24 by F.-H.Heinsius *CMZU: 1.33/00 19/01/95 18.05.50 by Christian Voelcker *-- Author : Christian Voelcker 19/01/95 SUBROUTINE TAXSTO(IVEC) IMPLICIT NONE **************************************************** * * Creation date: January, 1995 * * References: none * * Description: write the taxi results into the TTKS bank as follows * * TTKS word 3 = negative, if the ped is found to be a splitoff. * set bit 4 if it is a hadronic splitoff identfied by TAROND. * TTKS word 53 = charged tracks: number of associated Ped's in that cluster * neutral tracks: pointer to parent * * IEHDCB(12) should contain the number of *good* gammas, but we need to * know the total number of splitoffs before (DOLBYC, etc.). * * TTKS word 12 we should leave as it is. Otherwise we may cause confusion on * the definition of cluster and cluster numbering! * TTKS words 35-39 give info on the parent cluster. we do not want to * recalculate all those values, as they are only useful * for merged pions * * Modifications: * 07/03/95 FHH: TTKS word 53 was written for wrong particle (shifted by -1). * 14/03/95 CV: set bit 32 in TTKS WORD 3 to mark as splitoff * 29/03/95 CM : Add error logging on crazy codes -- just a check. * **************************************************** +REP,GT_TAXI,TAXSTO,36-54. * INTEGER IEBDCD,IETOMC DATA IEBDCD,IETOMC / 0,0 / SAVE IEBDCD,IETOMC * * only count charged tracks and unmatched PEDs * but nothing else (e.g. TTKS entries from PI0FND) NPART = IQ(LTTKS+2) + IQ(LTTKS+3) * IF(NPART.GT.50) THEN CALL ERRLOG(IETOMC, &' More than 50 particles found. Truncating ') NPART = 0 ENDIF * DO I=1, NPART * IF(ABS(IVEC(I).GT.50)) THEN CALL ERRLOG(IEBDCD, &' Crazy TAXI error code seen, (abs(c)>50) ') ENDIF CFHH JTTKS=LQ(LTTKS-I) JTTKS=LQ(LTTKS-IQ(LTTKS-2)-I) IQ(JTTKS+53) = IVEC(I) * * is this a neutral PED and a e-m splitoff? * IF(IQ(JTTKS+4).EQ.0.AND.IVEC(I).GT.0) THEN CALL SBIT1(IQ(JTTKS+3),32) ! mark as splitoff CALL SBIT1(IQ(JTTKS+3),4) ! set taxi flag ENDIF ENDDO RETURN END