+PATCH,$CORR. +DECK,CORR3. Updates version: 5.03/00 to 5.04/00 +REP,*TITLE*,TITLE,1. CBGEANT 5.04/00 18/08/95 13.31.41 +REP,$VERSION,V5_03,1-2. *CMZ : 5.03/04 04/08/95 15.21.05 by Curtis A. Meyer *CMZ : 5.03/03 24/05/95 07.53.11 by Curtis A. Meyer *CMZ : 5.03/02 22/05/95 10.14.30 by Curtis A. Meyer *CMZ : 5.03/01 17/03/95 10.00.09 by Curtis A. Meyer *CMZ : 5.03/00 15/03/95 15.26.48 by Curtis A. Meyer *-- Author : Curtis A. Meyer 15/03/95 * *::> VERSION 5.03/04 04/08/95 15.21.05 * *> Fix a bug in BIDCAY that essentially caused inflight * momenta to be reversed along the z axis. * *::> VERSION 5.03/03 24/05/95 07.53.11 * *> Release Version. * *::> VERSION 5.03/02 22/05/95 10.14.30 * *> Update from Fritz-Herbert and Mark Lakata: * *> BIRESO -- handle lo mass rho-meson which cannot * decay to eta-gamma * *> GUOUT -- Install environment variable GEANTEVENTSOUT, which * if defined is the output filename. * * *> UGNEWP -- Allow reading of particle definitions from the * file PARTICLEDEFS. Documentation is in the subroutine. * A small message will be printed if PARTICLEDEFS is not * defined, informing the user that standard particle * definitions have been used. * *::> VERSION 5.03/01 17/03/95 10.00.08 * *> Inclusion of Gas Target details from * Ch. Strassburger. * *> Clean up the automatic intsallation. * *> Other small changes. +ADD,$VERSION,V5_04,*. &DECK,V5_04. *CMZ : 5.04/00 18/08/95 13.31.41 by Curtis A. Meyer *-- Author : Curtis A. Meyer 18/08/95 * *::> VERSION 5.04/00 18/08/95 13.31.41 * *> Implement Rafik's changes to the vertex detector code. * Go to version 5.04/00 to make sure that we have a stable * base file. * +ADD,$KUMACS,INSTALL,0. *CMZ : 5.03/01 16/03/95 10.47.07 by Curtis A. Meyer +REP,$KUMACS,INSTALL,52. FXGEANT = FALSE +REP,COMMCB,CB_MACRO,1-11. *CMZU: 5.04/00 27/06/95 12.51.16 by RAFIK OUARED *CMZ : 26/06/95 14.48.47 by RAFIK OUARED * NEW VARIABLES TO INCLUDE SVTX TABLE * IN /CBLINK/ : LRTVX * IN /CBXDIV/ : IXRTVX * IN /CCFLAG/ : KRTVX=20 *CMZ : 24/05/95 17.28.36 by RAFIK OUARED *CMZ : 5.00/02 22/11/94 22.38.23 by Curtis A. Meyer *CMZ : 19/11/94 04.27.44 by Curtis A. Meyer * Added the /GESEED/ to retain seeds at the start of events. *CMZ : 18/09/94 12.40.20 by RAFIK OUARED *CMZ : 09/09/94 17.45.13 by RAFIK OUARED * NEW VARIABLES ADDED TO TAKE INTO ACCOUNT SILICON VERTEX DETECTOR (SVTX): * IN /CCVIEW/ : SV * IN /CCFLAG/ : KSV=10 , KRVTX=19 * IN /CCSETS/ : ISV * IN /CBLINK/ : LRVTX * IN /CBXDIV/ : IXRVTX +REP,COMMCB,CB_MACRO,20-35. *CMZ : 21/08/94 15.52.30 by RAFIK OUARED *CMZ : 5.00/00 05/07/94 18.09.17 by CBGEANT HACKERS *CMZ : 11/11/93 16.03.56 by CBGEANT HACKERS' * Added relevent bits for new coding of lookup tables for 2282 and FERA *CMZU: 11/08/93 17.42.15 by R.BOSSINGHAM * Include number of wires (NWIR1,NWIR2) in CBPWJD sequence. * Type untyped variables in CCDRIF, CENOIS. *CMZU: 30/04/93 13.24.40 by Y.Dardenne *CMZ : 06/04/93 12.49.48 by Y.Dardenne * I am creating a new common block to pass the variable NY from * subroutine dchget to jdcin. *CMZ : 17/03/93 16.01.48 by Y.Dardenne * I am adding arrays PWIR1 and PWIR2 to common block CBPWJD *CMZ : 18/02/93 16.49.11 by Y.Dardenne * I am adding arrays SINJD2 and COSJD2 to common block CCJDCD *CMZ : 21/01/93 14.03.27 by Y.Dardenne +REP,COMMCB,CB_MACRO,41-52. *CMZU: 4.06/06 11/06/92 21.50.31 by Michael Kobel * Introduce MXBCXT in COMMON/MCENER/ *CMZU: 4.06/05 23/04/92 10.45.20 by Curtis A. Meyer *CMZ : 4.06/03 26/02/92 14.01.18 by R.BOSSINGHAM * Return to MXPART=50 (intermediate resonant decays add particles) * Modify lengths of equivalenced arrays to be compatible for checking. *CMZ : 4.06/00 07/02/92 12.53.36 by R.BOSSINGHAM * Create /CBJDRS/, /CBJDSG/, /CBJDNS/ for JDC signal information. * Create /CBJDDF/ to hold information about the JDC drift table. * Create /CBPWNO/ sequence holding PWC signal variables. * Increase MXCHAN from 50 to 70. *CMZ : 4.05/00 15/11/91 13.14.25 by R.BOSSINGHAM +REP,COMMCB,CB_MACRO,59-71. *CMZ : 4.04/02 09/10/91 18.33.05 by R.BOSSINGHAM * Save all common blocks. *CMZ : 4.04/00 23/09/91 16.07.13 by R.BOSSINGHAM * Modify /CBPWJD/---split ANGPWC into ANGPWC(2) for 2 PWC chambers. *CMZ : 4.03/01 08/07/91 12.26.52 by R.BOSSINGHAM * Make ANSI standard: split common blocks into character and non-character * CBTTPR -> CBTTPC, CBTTPR * CCJDCD -> CCJDCC, CCJDCD *CMZ : 4.03/00 14/06/91 10.32.47 by R.BOSSINGHAM * /CBPWJD/ - created to hold user-adjusted PWC,JDC information. *CMZ : 13/06/91 16.22.41 by R.BOSSINGHAM * /CBKILL/ - created to hold particle types to reject (i.e. neutrinos) *CMZ : 09/06/91 17.15.34 by R.BOSSINGHAM +REP,COMMCB,CB_MACRO,83-90. *CMZ : 4.02/05 28/08/90 10.20.55 by Curtis A. Meyer *-- Author : &SELF,IF=NEVER. C-------------------------------------------------------------------- C PATCH COMMCB contains all common block sequences internal to the C CBGEANT Monte Carlo. Common blocks used by external C code (e.g. GEANT, Zebra) are found in the patch GCDES. C-------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,107. & LTVTX,LTTKS,LKRES,LRVTX,LRTVX, +REP,COMMCB,CB_MACRO,115-126. & IXTVTX,IXTTKS,IXKRES,IXRVTX,IXRTVX SAVE /CBXDIV/ &SELF,IF=NEVER. *----------------------------------------------------------------------- * CBLINK contains the Common blocks /CBLINK/ and /CBXDIV/ with * link addresses and divisions for the raw data of CB * the sequence GCBANK must be always included ! if one * uses these features. * PARAMETERS: none * VARIABLES : L**** : Bank link pointer * IX**** : Bank division identifier *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,133. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,141. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,160. PARAMETER (KEXCH = 17, KALFA = 18, KRVTX = 19, KRTVX = 20) +REP,COMMCB,CB_MACRO,172. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,185. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,194. * make the seed for NORRAN (gaussian distributed random numbers) +REP,COMMCB,CB_MACRO,203. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,217. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,226. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,236. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,248-250. *----------------------------------------------------------------------- * COMMON CCBIBA, contains BIGBANG II parameters and flags * PARAMETERS: MXPART : Maximum number of decay products allowed +REP,COMMCB,CB_MACRO,256-260. * VARIABLES : IHITBI : =1 Hit and Miss MonteCarlo enabled * =0 Normal Fowl Eventgenerator with weight * WGHTBI : Total Eventweight after resolvation by * the Bigbang Eventprocessor *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,275. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,299. *---------------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,314. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,338. *---------------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,347-352. *----------------------------------------------------------------------- * CCCAL - Common block containing crystal calibration constants * PARAMETERS: none * VARIABLES : IPW : Detector identifier for the PWC * ISV : DETECTOR IDENTIFIER FOR THE SVTX *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,360-365. *----------------------------------------------------------------------- * CCTRAK - Common block containing special CB Track parameters * PARAMETERS: SLENGM : Maximum length of one step * NSTEPM : Maximum number of steps per event * VARIABLES : RMAX : Maximum track length (distance to origin) *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,373. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,385. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,395-399. * ---------------------------------------------------------------------- * CENOIS - Noise look Up Table for drift chamber purposes (NORRAN) * PARAMETERS: MXNOIS : maximum number of random 2048-bin samples * VARIABLES : RNOISE : random noise array for JDC (volts) *---------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,414. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,434. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,443. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,449. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,458. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,464. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,480. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,501. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,525. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,559. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,592-597. * ----------------------------------------------------------------------- * COMMON CCDRIF, contains various parameters to perform drift chamber * cluster simulation * PARAMETERS: MXCLS : Maximum number of clusters between to consecutive * GEANT3 hits * VARIABLES : TRACK1 : first hit of current track in current sector +REP,COMMCB,CB_MACRO,621. * ----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,628. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,636. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,644. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,651. *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,689. * Common block for connecting hardware to software numbers +REP,COMMCB,CB_MACRO,710. *************************************************************** +REP,COMMCB,CB_MACRO,716-718. *----------------------------------------------------------------------- * CBARRL Common block for easy access to crystal hits *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,740-747. *----------------------------------------------------------------------- * CBXTPR Common block for crystal noise parameters and calibration file. * (calibration constants themselves reside in /CCCAL/CALXT). *----------------------------------------------------------------------- * Parameters: MXNAMN : Max. number characters in XFFILE,X2FILE names * NCHCOM : 26*60 (max. # theta X max. # phi) * * Variables: XCFILE : Data set name for mult. xtal calibration constants +REP,COMMCB,CB_MACRO,773. *************************************************************** +REP,COMMCB,CB_MACRO,788-791. *----------------------------------------------------------------------- * CBTTPR Common block for special target parameters. *----------------------------------------------------------------------- * Variables: ZTARG : Displacement of target center +REP,COMMCB,CB_MACRO,803-808. * Note: the TGYEAR variable is used to allow a single data card to input both * the target filling and design, since FFREAD wants to fill sucessive * variables in a common block and ANSI-77 does not allow the mixing * of character and other variables in a common block. * *************************************************************** +REP,COMMCB,CB_MACRO,817-823. *----------------------------------------------------------------------- * CBVEPR Common block for special veto counter parameters. *----------------------------------------------------------------------- * Variables: PVETO(1) : Displacement of veto face from Z=0 * PVETO(2) : Energy cut on veto * *************************************************************** +REP,COMMCB,CB_MACRO,833-842. *----------------------------------------------------------------------- * CBGATE Common block for ADC gate correction *----------------------------------------------------------------------- * Parameters: NBINGT : Number of bins for interpolation * * Variables: TMAXGT : Max. time 0f flight for interpolation * DELTGT : Bin size (seconds) * CORRGT : Normalized gate correction factor * *************************************************************** +REP,COMMCB,CB_MACRO,850-855. *----------------------------------------------------------------------- * CBGATE Common block for rotation matrix number *----------------------------------------------------------------------- * Variables: IROT : Rotation matrix number * *************************************************************** +REP,COMMCB,CB_MACRO,864-871. *----------------------------------------------------------------------- * CBKILL Common block for particle rejection *----------------------------------------------------------------------- * Parameter: MXKILL : Maximum number of particle types to kill * Variables: NPKILL : Actual number of particle types to kill * IDKILL : Particle numbers of types to kill * *************************************************************** +REP,COMMCB,CB_MACRO,890-896. *----------------------------------------------------------------------- * CBPWJD Common block for user adjustment of PWC,JDC *----------------------------------------------------------------------- * Parameters: NWIR1 : Number of sense wire types in original JDC * NWIR2 : Number of sense wire types in new JDC * * Variables: ANGPWC(1) : Rotation angle of PWC1 (wire #0 from vertical) +REP,COMMCB,CB_MACRO,913. *************************************************************** +REP,COMMCB,CB_MACRO,923-925. *----------------------------------------------------------------------- * CBSVTX Common block for user adjustment of SVTX *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,932. *----------------------------------------------------------------------- &SELF. &KEEP,CBSVXY. * REAL FSTRIP(2) * COMMON/CBSVXY/FSTRIP SAVE /CBSVXY/ * &SELF,IF=NEVER. *----------------------------------------------------------------------- * CBSVXY Common block for user adjustment of strip 128 in first module *----------------------------------------------------------------------- * FSTRIP(1) : X-COORD OF STRIP 128 IN FIRST MODULE * * FSTRIP(2) : Y-COORD OF STRIP 128 IN FIRST MODULE * *----------------------------------------------------------------------- +REP,COMMCB,CB_MACRO,942-947. *----------------------------------------------------------------------- * CBBCPR Common block for BC user parameters *----------------------------------------------------------------------- * Variables: LBCCC : .T. iff copper cooling collars are to be included * *************************************************************** +REP,COMMCB,CB_MACRO,957-962. *----------------------------------------------------------------------- * CBTGGH Common block for special GHT parameters *----------------------------------------------------------------------- * Variables: ANGGHT : Rotation angle of center of sector 0 from +Y * *************************************************************** +REP,COMMCB,CB_MACRO,974-980. *----------------------------------------------------------------------- * CCGHTD Common block for GHT digitization parameters *----------------------------------------------------------------------- * Variables: COSGHT : Cosines of angles to the sector centers * SINGHT : Sines of angles to the sector centers * ************************************************************************ +REP,COMMCB,CB_MACRO,990-995. *----------------------------------------------------------------------- * CBMCUT Common block for modifying cuts for materials. *----------------------------------------------------------------------- * Variables: LCECUT : IF .T., override no energy cuts with GSTPAR * ************************************************************************ +REP,COMMCB,CB_MACRO,1009-1012. *----------------------------------------------------------------------- * CEPWNO Sequence holding PWC noise parameters *----------------------------------------------------------------------- * Parameters: CHAEFF : PWC1,PWC2 chamber efficiency +REP,COMMCB,CB_MACRO,1018. ************************************************************************ +REP,COMMCB,CB_MACRO,1029-1037. *----------------------------------------------------------------------- * CBSVNO Sequence holding SVTX noise parameters *----------------------------------------------------------------------- * Parameters: NSSV : * SVNOI : * SVCHE : * SVNXT : * ************************************************************************ +REP,COMMCB,CB_MACRO,1048-1051. *----------------------------------------------------------------------- * CBJDDF Common block of parameters used to calculate JDC drift table *----------------------------------------------------------------------- * Variables: BJDGAS : Magnetic field at (0,0,0) in kilogauss +REP,COMMCB,CB_MACRO,1058. *************************************************************** +REP,COMMCB,CB_MACRO,1068-1076. *----------------------------------------------------------------------- * CBJDRS Common block of parameters of JDC resolution *----------------------------------------------------------------------- * Variables: SIGXJD : Width (X) of Landau smearing (cm) * SIGYJD : Width (Y) of Landau smearing (cm) * ZRESJD : Width of Z resolution (cm) * ZMAXJD : Cut on Z resolution tails (cm) * *************************************************************** +REP,COMMCB,CB_MACRO,1087-1090. *----------------------------------------------------------------------- * CBJDSG Common block of parameters of JDC signals *----------------------------------------------------------------------- * Variables: KTHRES : Signal threshold +REP,COMMCB,CB_MACRO,1097. *************************************************************** +REP,COMMCB,CB_MACRO,1107-1113. *----------------------------------------------------------------------- * CBJDNS Common block of parameters of JDC signal distortion *----------------------------------------------------------------------- * Variables: RSIGJD : Random fractional variation in JDC signals * RNOIJD : Noise on JDC signals * *************************************************************** +REP,COMMCB,CB_MACRO,1123-1131. *----------------------------------------------------------------------- * IPARA2 Common block of parameters for subroutine DCHIPO *----------------------------------------------------------------------- * Variables: IRIPA : Right parameter for phi * ILEPA : Left parameter for phi * * Both of these parameters are calculated in JDCIN in order to * save cpu time. *************************************************************** +REP,COMMCB,CB_MACRO,1141-1146. *----------------------------------------------------------------------- * DIVNUM Common block of parameters for subroutine JDCIN *----------------------------------------------------------------------- * Variables: NY : number of devisions in the drift time table. * *************************************************************** +REP,COMMCB,CB_MACRO,1154-1169. REAL XYZA(3),PARR(5),PAR2(3) REAL XYA(2),XYM(2),XYMA(2),RADM REAL ANGROT,ANGSEC,ANGSH REAL DELTL REAL PHIA,PHIM,ZPOS1,ZPOS2 REAL PHI0,PITCH,LENGM,LENGSM,LENGHM,LENGHS,LENGHA REAL RADI,WR0,WRN,ALPHA,AHYB INTEGER NMODU,IVOL * COMMON/CBSVGE/PLHT,CONE,UPSTR,PAR,COORM,COORS,THET,PHIR,XYZ, & PARH,XYZH,PHIH,TETH,SPAR,PHIS,THES,XYZS,PARA, & XYZA,PARR,PAR2,PHI0,PITCH,LENGM,LENGSM,LENGHM, & LENGHS,LENGHA,RADI,WR0,WRN,ALPHA,ANGSH, & AHYB,NMODU,XYA,XYM,XYMA,RADM,ANGROT,ANGSEC, & PHIA,PHIM,ZPOS1,ZPOS2,DELTL,IVOL SAVE/CBSVGE/ &SELF,IF=NEVER. *----------------------------------------------------------------------- * CBSVGE Common block of parameters for subroutine SVGE AND GETGLH. *----------------------------------------------------------------------- * Variables: +REP,COMMCB,CB_MACRO,1191-1192. ***************************************************************************** &SELF. &KEEP,CBSVOF. INTEGER ISOF(2) COMMON/CBSVOF/ISOF SAVE/CBSVOF/ +REP,CBBASE,GUOUT,1-10. *CMZU: 5.03/02 11/05/95 16.12.24 by F.-H.Heinsius *CMZ : 5.02/01 14/03/95 08.48.47 by Curtis A. Meyer *CMZ : 5.02/00 13/03/95 15.24.15 by Curtis A. Meyer *CMZ : 5.00/02 19/11/94 13.53.50 by Curtis A. Meyer *CMZU: 5.00/01 03/08/94 14.27.05 by CBGEANT HACKERS *CMZ : 11/09/94 18.41.19 by RAFIK OUARED * Add SVTX part code. *CMZ : 11/09/94 18.40.18 by RAFIK OUARED *CMZ : 03/08/94 14.03.51 by CBGEANT HACKERS * Add the eencoded hardware bit in IEHDCB(8) AJN *CMZ : 4.05/00 20/11/91 21.38.24 by R.BOSSINGHAM +REP,CBBASE,GUOUT,18-27. *CMZ : 4.04/02 10/10/91 12.39.07 by R.BOSSINGHAM *CMZ : 4.03/02 10/09/91 13.25.44 by R.BOSSINGHAM * Initialize and save ITIME,IDATE,ICBTIM,ICBDAT * Replace LJDF with LRJDF in call to MZDROP. *CMZ : 4.03/01 02/07/91 13.08.46 by R.BOSSINGHAM * Save IEHDCB between calls. *CMZU: 4.02/10 26/01/91 17.05.10 by Curtis A. Meyer *CMZ : 4.02/07 04/11/90 10.35.40 by Curtis A. Meyer *CMZ : 4.02/05 28/08/90 10.20.57 by Curtis A. Meyer *-- Author : M.Guckes +ADD,CBBASE,GUOUT,69. CHARACTER*255 CFILE +REP,CBBASE,GUOUT,81-85. C Call the users event routine MYEVNT C CALL MYEVNT C C Get the seeds at the end of this run: +REP,CBBASE,GUOUT,94. C Let the user know from time to time that events are still coming: +REP,CBBASE,GUOUT,106-110. C MTL addition begin CALL GETENVF('GEANTEVENTSOUT',CFILE) if (CFILE.EQ.' ') THEN CFILE = 'geant_events.out' ENDIF C MTL addition end OPEN(UNIT=59,FILE=CFILE,STATUS='UNKNOWN', & FORM='FORMATTED') * WRITE(59,5959) IH,ITIM,IDAT,IM,IY,IDEVT, & ISEQ1,JJSED1,JJSED2 5959 FORMAT(' ',I2,':',I2, 3X, I2,'/',I2,'/',I4, 3X, +REP,CBBASE,GUOUT,117. C Save banks on tape +REP,CBBASE,GUOUT,124. C Prints vertices, kinematics, hits and tracks in the debuging mode. +REP,CBBASE,GUOUT,138-143. C Output raw data format, either all data or several digitisation banks. C ALL banks are shunted into the header bank at various offsets. C IF (NRAWD.LE.0) GOTO 999 * * Fill event header words +REP,CBBASE,GUOUT,179-182. C NEW HARWARE ENCODING STARTS HERE. C IEHDCB(8) = -1 IEHDCB(8) = IHWBIT C End of modifications to header word: +REP,CBBASE,GUOUT,190-193. *-------------- * C C PWC +REP,CBBASE,GUOUT,199-205. C SVTX C IF (.NOT. QRAWD(KRVTX)) THEN CALL MZDROP(IXSTOR,LRVTX,' ') ENDIF C C Fera +REP,CBBASE,GUOUT,211. C LeCroy 2280 +REP,CBBASE,GUOUT,217. C JDC processed data +REP,CBBASE,GUOUT,223. C JDC unprocessed RAW data +REP,CBBASE,GUOUT,229. C GHT processed data +REP,CBBASE,GUOUT,235. C GHT unprocessed RAW data +REP,CBBASE,GUOUT,241-250. * Now drop the EVHD bank * LLAST=LQ(LEVHD) CALL MZDROP(IXSTOR,LEVHD,' ') C C Output and wiping of structures C CALL FZOUT(IORAWD,IXEVHD,LLAST,1,'D',2,NEHDCB,IEHDCB) C 999 CONTINUE +REP,CBBASE,GUTREV,1-6. *CMZU: 5.04/00 22/04/95 18.46.20 by RAFIK OUARED *CMZ : 5.01/00 15/09/94 19.19.39 by RAFIK OUARED *CMZ : 4.05/00 15/11/91 13.02.20 by R.BOSSINGHAM * Exchange XDC for GHT. *CMZ : 4.03/01 02/07/91 13.00.53 by R.BOSSINGHAM *CMZ : 4.02/05 28/08/90 10.20.57 by Curtis A. Meyer *-- Author : +REP,CBBASE,GUTREV,26-27. &SEQ,GTDRAW. C C-- No tracking if ISWIT(10) is set to 10 +REP,CBBASE,GUTREV,41. 20 CONTINUE +REP,CBBASE,GUTREV,61. 10 CONTINUE +REP,CBBASE,GUTREV,67. 99 RETURN +REP,CBBASE,UGCHCK,1-39. *CMZU: 5.04/00 22/04/95 15.20.25 by RAFIK OUARED *CMZ : 5.01/00 17/09/94 17.36.05 by RAFIK OUARED *CMZ : 11/09/94 17.51.04 by RAFIK OUARED * New common added : CBSVTX. *CMZ : 11/09/94 17.46.14 by RAFIK OUARED *CMZ : 11/09/94 17.44.03 by RAFIK OUARED * NEW VARIABLES ADDED FOR SVTX : LSVX,HSV,HRVTX. *CMZ : 5.00/00 05/07/94 17.46.48 by CBGEANT HACKERS *CMZU: 11/08/93 14.38.39 by R.BOSSINGHAM * Include check that JDCD has been set. * Include check that user does not mix -FASTJDC and JDCD=2 options. *CMZU: 4.06/07 01/10/92 15.47.06 by F.-H. Heinsius * Move Hollerith constants to DATA statements (required for NeXT). *CMZ : 4.06/02 12/02/92 18.07.19 by R.BOSSINGHAM * Output RMCB when RAWD 'ALL ' is selected. *CMZ : 4.06/00 06/02/92 13.02.15 by R.BOSSINGHAM * Install check on a few JDC signal parameters. * Change default mode to tape (not disk); this is mode usually used. *CMZ : 4.05/00 20/11/91 21.34.14 by R.BOSSINGHAM * Explicitly initialize more variables. * Exchange XDC for GHT. * Check TGYEAR and set NDTGLH variable. * Eliminate PWC if both are removed with PWCD data card. *CMZ : 4.04/02 10/10/91 11.17.39 by R.BOSSINGHAM *CMZ : 4.04/00 20/09/91 16.51.59 by R.BOSSINGHAM * Eliminate mutual exclusion check on EXCH,ALFA. Actually, ALFA==>EXCH. * Improve checking for EXCH,NATI and DISK,TAPE,ALFA. * Provide more checking on FLDM, ANGLOR * Find CURVE using absolute value of FLDM. *CMZ : 4.03/01 01/07/91 15.26.11 by R.BOSSINGHAM * Add check on TGLH filling. * Fix XDC vs. PWC logic (for future use with scin. fiber gas target) *CMZ : 4.03/00 14/06/91 12.15.42 by R.BOSSINGHAM * Set JDC Lorentz angle to zero for zero field. * Check list of particle types chosen for rejection with KILL data card. * Add warning about distribution version of GEANT for OPTI>0. * Add set up of veto counter as a detector element. *CMZU: 4.02/10 24/01/91 09.04.29 by Curtis A. Meyer *CMZ : 4.02/05 28/08/90 10.20.59 by Curtis A. Meyer *-- Author : K.Peters. +REP,CBBASE,UGCHCK,63. C * New variables for SVTX added up: LSVX, HSV, HRVTX +REP,CBBASE,UGCHCK,112-120. DATA HEXCH/4HEXCH/, HALFA/4HALFA/, HRVTX/4HRVTX/ C C-- Clear the logical banks C DO 100 I=1,MXINDX*MXQARR QANY(I) = .FALSE. 100 CONTINUE C C-- Check the GET card and define flags QZGET(..) +REP,CBBASE,UGCHCK,136. C-- Check the PRINT data card , flags QPRIN(..) +REP,CBBASE,UGCHCK,152. C-- Check PWC design types; disable PWC if both PWC's are turned off: +REP,CBBASE,UGCHCK,178-181. C-- Check GEOM card content, flags QGEOM(..) C IF (NGEOM .EQ. 0) THEN * Put in default values for geometry if no GEOM card +REP,CBBASE,UGCHCK,203. C-- Check GEOM card against PWCD card : +REP,CBBASE,UGCHCK,210. C-- Check GEOM card against SVTX card : +REP,CBBASE,UGCHCK,217-220. C-- Check SETS card content, flags QSETS(..) C IF (NSETS.EQ.0) THEN * Put in default values for sets +REP,CBBASE,UGCHCK,250-253. C-- Check DIGI card content, flags QDIGI(..) C IF (NDIGI .EQ. 0) THEN * Put in default values for digi +REP,CBBASE,UGCHCK,283. C-- Check PREC card content, flags QPREC(..) +REP,CBBASE,UGCHCK,295. C-- Check RAWD card content, flags QRAWD(..) +REP,CBBASE,UGCHCK,315-319. QRAWD(KRVTX) = (IUCOMP(HRVTX,LRAWD,NRAWD).NE.0) C C-- Consistency checks have to be included below C C-- Check for digitisation of all parts of the detector +REP,CBBASE,UGCHCK,328-331. QRAWD(KRVTX) = .FALSE. ELSEIF (QSETS(KSV)) THEN QRAWD(KRPWC) = .FALSE. QRAWD(KRVTX) = .TRUE. +REP,CBBASE,UGCHCK,339-347. C-- Check for digitisation if raw data requested C IF (QRAWD(KRBCL).OR.QRAWD(KRBCF)) QDIGI(KBC)=.TRUE. IF (QRAWD(KRJDC).OR.QRAWD(KRJDF)) QDIGI(KJD)=.TRUE. IF (QRAWD(KRGHC).OR.QRAWD(KRGHF)) QDIGI(KGH)=.TRUE. IF (.NOT.QRAWD(KRVTX).AND.QRAWD(KRPWC)) QDIGI(KPW)=.TRUE. IF (.NOT.QRAWD(KRPWC).AND.QRAWD(KRVTX)) QDIGI(KSV)=.TRUE. C C-- Check for sets if digitisation requested +REP,CBBASE,UGCHCK,356. C-- Check for geometry for given sets +REP,CBBASE,UGCHCK,422. C-- Print warning if optimization chosen: +REP,CBBASE,UGCHCK,428. C-- Check that a valid hadronic package has been selected. +REP,CBBASE,UGCHCK,434. C-- Options for RAW DATA FORMAT +REP,CBBASE,UGCHCK,468-475. C-- Check that particle types chosen for killing are possible C DO 200 I=1,NPKILL IF (IDKILL(I).LE.0 .OR. IDKILL(I).GT.NPART) & CALL ERRWRN(IDKILL(I), 'KILL CARD PART. ID NOT AVAILABLE$') 200 CONTINUE C C-- Calculate curvature for given magnetic field +REP,CBBASE,UGCHCK,483. C-- Check Lorentz angle vs. B field +REP,CBBASE,UGCHCK,501. C-- Check JDC options +REP,CBBASE,UGCHCK,517. C-- Check JDC signal parameters +REP,CBBASE,UGCHCK,531-544. C-- Set switch 10 if it is necessary to store kinematics C IF (QPRIN(KJXYZ)) ISWIT(10)=1 C C-- Convert SAV and GET arrays C DO 1201 I=1,NSAVE CALL UHTOC(LSAVE(I),4,CGSAV(I),4) 1201 CONTINUE DO 1202 I=1,NGET CALL UHTOC(LGET(I),4,CGGET(I),4) 1202 CONTINUE C C-- Return +REP,CBBASE,UGINFO,1-11. *CMZU: 5.04/00 20/05/95 20.33.26 by RAFIK OUARED *CMZ : 5.01/00 18/09/94 13.50.37 by RAFIK OUARED *CMZ : 11/09/94 18.57.12 by RAFIK OUARED * Added SVTX info. *CMZ : 5.00/00 05/07/94 17.40.18 by CBGEANT HACKERS * Output information about which Hadronic package was in use. AJN. * Output information about non-linearity correction. AJN. *CMZ : 4.06/09 06/08/93 15.18.08 by CBGEANT HACKERS' * Add information message about where the look up tables for the 2282 * and FERA are coming from. *CMZ : 4.06/08 07/07/93 11.59.36 by Gunter Folger *CMZ : 4.06/00 07/02/92 14.41.42 by R.BOSSINGHAM +REP,CBBASE,UGINFO,18-27. *CMZ : 4.05/00 20/11/91 20.42.34 by R.BOSSINGHAM * Add output of QGEOM, QPREC, QSETS, QDIGI, QRAWD for detectors. * Add output for more patches. * Add output for NDPWC, TGYEAR, ANGGHT. *CMZ : 4.04/00 25/09/91 17.56.09 by R.BOSSINGHAM * Fix bug causing first option to RAWD card to not be printed. * Clean up output somewhat. * Output rotations separately for PWC1,2. * Add output for FLDM. *CMZ : 4.03/02 10/09/91 14.02.45 by R.BOSSINGHAM +REP,CBBASE,UGINFO,33-35. *CMZ : 4.03/01 08/07/91 12.52.29 by R.BOSSINGHAM * Add output line for TGLH filling. *CMZ : 4.03/00 14/06/91 12.03.08 by R.BOSSINGHAM +REP,CBBASE,UGINFO,43-58. *CMZ : 4.02/05 28/08/90 10.21.00 by Curtis A. Meyer *-- Author : C SUBROUTINE UGINFO C C ********************************************************************** C * * C * SUBROUTINE UGINFO * C * * C * Prints a lot of information about settings and data cards etc. * C * in an easy readable format on FORTRAN I/O channel 6 * C * * C * ====> called by UGINIT * C * Author : Klaus (Nov. 1987) * C * * C ********************************************************************** +ADD,CBBASE,UGINFO,84. &SEQ,CBSVXY. &SEQ,CBSVOF. +REP,CBBASE,UGINFO,102-173. & 'NATI', 'EXCH', 'ALFA', 'RVTX'/ DATA TDINFO /'GHT ', 'PWC ', 'JDC ', 'BC ', 'MG ', & 'TGH2', 'TGLH', 'TGHP', 'VETO', 'SV '/ C 1000 FORMAT(' ',79('*')) 1001 FORMAT(' *',77X,'*') 1002 FORMAT(' * CBGEANT INFORMATION LOG ',12X, + ' DATE: ',A8,' TIME: ',A8,' *') 1003 FORMAT(' * EVENT GENERATOR : ',4X,A8,' (',A8,')',26X,'*', + /,' * EVENT ID : ',4X,I8,37X,'*', + /,' * NUMBER EVENTS : ',4X,I8,37X,'*') 1004 FORMAT(' * INITIAL EVENT : ',I2,'-BODY DECAY INTO :',39X,'*') 1005 FORMAT(' * PARTICLE ',I2,' : ',A19,' M ',E12.5, + ' T ',E12.5,' TR ',A4,' *') 1007 FORMAT(' * VERTEX DISTRIBUTION : ',10X,I2,2X, + 3(' ',E10.3),2X,'*') 1008 FORMAT(' * EVENT TRIGGER : ',10X,I2,1X,A20,16X,'*') 1009 FORMAT(' * PROCESS MODE : ',A20,29X,'*') 1010 FORMAT(' * DIGITIZATION REQUESTS : ',8X,5(A4,1X),16X,'*', + /,' * ',8X,5(A4,1X),16X,'*') 1011 FORMAT(' * PRECISION REQUESTS : ',8X,5(A4,1X),16X,'*', + /,' * ',8X,5(A4,1X),16X,'*') 1012 FORMAT(' * GEOMETRY REQUESTS : ',8X,5(A4,1X),16X,'*', + /,' * ',8X,5(A4,1X),16X,'*') 1013 FORMAT(' * PARTICLE ',I2,' : CASCADE XRAY NO ',I2,42X,'*') 1014 FORMAT(' * PRINTING REQUESTS : ',8X,5(A4,1X),16X,'*', + /,' * ',8X,5(A4,1X),16X,'*') 1015 FORMAT(' * INITIAL BEAM P_Z (GEV/C) : ',E12.5,37X,'*') 1016 FORMAT(' * PARTICLE TOTAL MOMENTUM : ',E12.5,' GEV/C',30X,'*') 1017 FORMAT(' * PARTICLE TOTAL MOMENTUM : ',E12.5,' UP TO ',E12.5, + ' GEV/C',11X,'*') 1018 FORMAT(' * PATCHY CARDS USED FOR COMPILATION OF IMAGE FILE', + 29X,'*') 1019 FORMAT(' * CARD : ',A8,' IN USE; REMARK: ',A40,' *') 1020 FORMAT(' * USER SWITCHES (NON-ZERO) : ',49X,'*') 1021 FORMAT(' * SWITCH : ',I2,' IS ',I8,51X,'*') 1022 FORMAT(' * MAX. SQRT(X**2+Y**2) (CM): ',E12.5,37X,'*') 1023 FORMAT(' * RANDOM NUMBER SEEDS : ',I12,' AND ',I12,20X,'*') 1024 FORMAT(' * EMISSION ANGLE : ISOTROPIC',37X,'*') 1025 FORMAT(' * EMISSION ANGLE, THETA : ',E12.5,37X,'*', + /,' * PHI : ',E12.5,37X,'*') 1030 FORMAT(' * INITIAL EVENT : ',I12,'-GAMMA(S)',28X,'*') 1051 FORMAT(' * SETS DEFINED : ',8X,5(A4,1X),16X,'*', + /,' * ',8X,5(A4,1X),16X,'*') 1052 FORMAT(' * SAVE FOLLOWING BANKS : ',8X,5(A4,1X),16X,'*', + /,' * ',8X,5(A4,1X),16X,'*') 1053 FORMAT(' * GET FOLLOWING BANKS : ',8X,5(A4,1X),16X,'*', + /,' * ',8X,5(A4,1X),16X,'*') 1054 FORMAT(' * RAW DATA FILE UNIT : ',I12,37X,'*', + /,' * RAW DATA REQUESTS : ',8X,5(A4,1X),16X,'*', + /,' * ',8X,5(A4,1X),16X,'*') 2004 FORMAT(' * VERTEX SPREAD : ',3(E12.5,1X),10X,'*') 2006 FORMAT(' * TARGET FILLED WITH : ',9X,A4,36X,'*'/ + ' * TARGET DESIGN AS FOR YEAR: ',8X,A4,37X,'*') 2008 FORMAT(' * TARGET OFFSET (CM) : ',F12.5,37X,'*') 2009 FORMAT(' * VETO CTR. POS. (CM) : ',F12.5,37X,'*') 2010 FORMAT(' * VETO CTR. CUT (MEV) : ',E12.5,37X,'*') 2015 FORMAT(' * BC COPPER COOLING COLLARS: ',2X,' IN USE', 37X,'*') 2016 FORMAT(' * BC COPPER COOLING COLLARS: ',2X,'NOT IN USE', 37X,'*') 2020 FORMAT(' * XTAL CALIB. FILE : ',A40,9X,'*') 2021 FORMAT(' * XTAL CALIB. SIGMA (MEV) : ',F12.5,37X,'*') 2030 FORMAT(' * FERA NOISE FILE : ',A40,9X,'*') 2031 FORMAT(' * FERA COH. NOISE (MEV) : ',F12.5,37X,'*') 2033 FORMAT(' * FERA INCOH. NOISE (MEV) : ',F12.5,37X,'*') 2040 FORMAT(' * 2282 NOISE FILE : ',A40,9X,'*') 2041 FORMAT(' * 2282 COH. NOISE (MEV) : ',F12.5,37X,'*') 2043 FORMAT(' * 2282 INCOH. NOISE (MEV) : ',F12.5,37X,'*') 2050 FORMAT(' * IFIELD IN CENTRAL REGIONS: ',I12, 37X,'*') 2051 FORMAT(' * BFIELD AT ORIGIN (KGAUSS): ',F12.5,37X,'*') 2052 FORMAT(' * JDC LORENTZ ANGLE (DEG.) : ',F12.5,37X,'*') 2054 FORMAT(' * JDC OFFSET ANGLE (DEG.) : ',F12.5,37X,'*') 2056 FORMAT(' * ',49X,'*',/, +REP,CBBASE,UGINFO,181-187. 2057 FORMAT(' * RSIGJD = JDC SIGNAL VARI.: ',5X,F7.4,37X,'*',/, & ' * RNOIJD = JDC NOISE : ',4X,F8.4,37X,'*') 2058 FORMAT(' * SIGXJD = JDC X SMEAR (CM): ',5X,F7.4,37X,'*',/, & ' * SIGYJD = JDC Y SMEAR (CM): ',5X,F7.4,37X,'*',/, & ' * ZRESJD = JDC Z SMEAR (CM): ',5X,F7.4,37X,'*',/, & ' * ZMAXJD = Z SMEAR CUT (CM): ',5X,F7.4,37X,'*') 2059 FORMAT(' * KTHRES= JDC THRESHOLD : ',5X,I7, 37X,'*',/, +REP,CBBASE,UGINFO,193-226. 2060 FORMAT(' * PWC DESIGN TYPES : ',7X, 2(I2,1X),36X,'*') 20601 FORMAT(' * SVTX DESIGN : ',7X, (I2,1X),39X,'*') 20603 FORMAT(' * STRIP 128 POSITION : ',7X, 2(F7.4,1X),26X,'*') 20604 FORMAT(' * RVTX AND TABLE OFFSETS : ',7X, 2(I7,1X),26X,'*') 2062 FORMAT(' * PWC1 ROT FROM +Y (DEG.) : ',F12.5,37X,'*',/, & ' * PWC2 ROT FROM +Y (DEG.) : ',F12.5,37X,'*') 2064 FORMAT(' * PWC1,2 EFFICIENCIES : ',2F12.5,25X,'*',/, & ' * PWC1,2 PROB. CLUSTER=2 : ',2F12.5,25X,'*',/, & ' * PWC1,2 MAX. NOISE WIRE : ',2I12, 25X,'*',/, & ' * PWC1,2 PROB. NOISE WIRE : ',2F12.5,25X,'*') 20602 FORMAT(' * SVTX EFFICIENCY : ',1F12.5,25X,'*',/, & ' * SVTX PROB. CLUSTER=2 : ',F12.5,25X,'*',/, & ' * SVTX MAX. NOISE WIRE : ',I12, 25X,'*',/, & ' * SVTX PROB. NOISE WIRE : ',F12.5,25X,'*') 2070 FORMAT(' * GHT ROT FROM +Y (DEG.) : ',F12.5,37X,'*') 2080 FORMAT(' * DEVICE SPECS USED : ', & 'NAME QGEOM QPREC QSETS QDIGI', 16X,'*') 2082 FORMAT(' * ',A4,5X,4(L1,6X),12X,'*') 2090 FORMAT(' * RAW DATA SPECS USED : ',' ',37X,'*') 2092 FORMAT(' * ',8X,A4,37X,'*') 2150 FORMAT(' * KILL PARTICLE TYPES : ',10X,10(I2,1X),9X,'*') 2250 FORMAT(' * FERA LUT FILE : ',A40,9X,'*') 2251 FORMAT(' * WARNING: FERA LUT CALCULATED. &DOES NOT USE REAL VALUES !!',20X,'*') 2260 FORMAT(' * 2282 LUT FILE : ',A40,9X,'*') 2261 FORMAT(' * WARNING: 2282 LUT CALCULATED. &DOES NOT USE REAL VALUES !!',20X,'*') 2270 FORMAT(' * WARNING: NON-UNIFORMITY CORRECTION IN USE: ',33X,'*') 2280 FORMAT(' * HADRONIC PACKAGE IN USE : GHEISHA',42X,'*') 2281 FORMAT(' * HADRONIC PACKAGE IN USE : FLUKA',42X,'*') 2282 FORMAT(' * HADRONIC PACKAGE IN USE : GHEISHA WITH CORRECTION' &,26X,'*') 2200 FORMAT(' * VARIABLE ENERGY CUTS : ',2X,'NOT IN USE', 37X,'*') 2201 FORMAT(' * VARIABLE ENERGY CUTS : ',2X,' IN USE', 37X,'*') C C-- Check DATE, TIME and EVENT PROCESSOR +REP,CBBASE,UGINFO,259. C-- Write header with inital kinematic generator +REP,CBBASE,UGINFO,290. C-- Get list of initial particles +REP,CBBASE,UGINFO,307. C-- Get the particle properties from the JPART banks +REP,CBBASE,UGINFO,319-320. 110 CONTINUE 100 CONTINUE +REP,CBBASE,UGINFO,346-349. 120 CONTINUE ELSE C C-- if IKINE = 50 (RFQ) +REP,CBBASE,UGINFO,355-359. C-- Write Xray definition C IF (IVXRAY.GT.0) WRITE (LOUT,1013) 1,IVXRAY C C-- Write vertex information +REP,CBBASE,UGINFO,382. C-- Write xtal calib. info. +REP,CBBASE,UGINFO,391. C-- Write FERA noise info. +REP,CBBASE,UGINFO,401. C-- Write 2282 noise info. +REP,CBBASE,UGINFO,411. C-- Write FERA LUT information. +REP,CBBASE,UGINFO,420. C-- Write 2282 LUT information. +REP,CBBASE,UGINFO,430-435. C-- Write Information about non-uniformity correction: C IF(LNUNIF) WRITE (LOUT,2270) C C-- Write Information about Hadronic package +REP,CBBASE,UGINFO,441. C-- Write IFIELD in PWC/JDC +ADD,CBBASE,UGINFO,465. WRITE (LOUT,20603) FSTRIP(1),FSTRIP(2) +REP,CBBASE,UGINFO,475-477. C-- Trigger, Modes C C GUNTER PRESET IVHDTG +REP,CBBASE,UGINFO,502. C-- Print various information on data card input +REP,CBBASE,UGINFO,576. 200 CONTINUE +REP,CBBASE,UGINFO,593. 250 CONTINUE +REP,CBBASE,UGINFO,608-616. C-- Print set switches C DO 300 I=1,10 IF (ISWIT(I).NE.0) WRITE (LOUT,1021) I,ISWIT(I) 300 CONTINUE WRITE (LOUT,1001) WRITE (LOUT,1018) C C-- Patchy cards +REP,CBBASE,UGINFO,701. C-- Random number seeds +REP,CBBASE,UGINFO,708. C-- Return +ADD,CBBASE,UGNEWP,0. *CMZ : 5.03/03 24/05/95 07.53.04 by Curtis A. Meyer *CMZ : 5.03/02 11/05/95 16.49.49 by F.-H.Heinsius +REP,CBBASE,UGNEWP,19. * * 4/2/95 F.-H. Heinsius * This subroutine is now used to * read additional particle definitions from external file. * * File has to be defined by the environment variable (symbol on vms) * PARTICLEDEFS (Should be steered by card). * * Example for file PARTICLDEFS (remove the '*' in column 1): * '!' in coolumn 1 is comment character. * Everything is read in fortran free format (*). * you can repeat the 3 lines for every particle you define. * Warning: you should NOT define particle which are long-lived, * because these might get forwarded to FLUKA, which do not know * anything about new defined particles. * *! external file for private particle definitions *! *! id 'name' tracking-type (3=neut,4=charged) mass (GeV) charge life-time * 76 'ETP->PPG' 3 0.957770 0. 3.275E-21 *! decay mode (6 numbers, maximum 3 2-digit id's per decay) * 080901 5*0 *! branching ratio (6 numbers in percent) *100.0 5*0.0 *! *! end of file *! * Called from UGPART * INTEGER LOUT CHARACTER*255 FILE CHARACTER*80 CLINE PARAMETER (LOUT=6) INTEGER ID, ITYP, MODE(6) REAL RMASS, CHARGE, TIME, BR(6) CHARACTER*10 CNAME * decode filename FILE = ' ' CALL GETENVF('PARTICLEDEFS',FILE) C if file is read from card: C CALL UHTOC(XFPART,4,FILE,40) IF (FILE.EQ.' ') THEN * WRITE(LOUT,445) 445 FORMAT(' No User Particle definitions found -- default values',/, & ' are assumed for this run.') * ELSE * &SELF,IF=VAX,DECS OPEN (UNIT=12, FILE=FILE, STATUS='OLD', ACCESS='SEQUENTIAL', 1 FORM='FORMATTED', ERR=999, READONLY) * &SELF,IF=-VAX,IF=-DECS OPEN (UNIT=12, FILE=FILE, STATUS='OLD', ACCESS='SEQUENTIAL', 1 FORM='FORMATTED', ERR=999) &SELF. * WRITE (LOUT,1000) FILE 1000 FORMAT(' Read private particle definitions from file ',A) 10 CONTINUE READ(12,'(A)',ERR=900,END=900) CLINE IF (CLINE(1:1).EQ.'!') GOTO 10 READ(CLINE,*,ERR=900,END=900) ID, CNAME, ITYP, RMASS, & CHARGE, TIME 20 CONTINUE READ(12,'(A)',ERR=900,END=900) CLINE IF (CLINE(1:1).EQ.'!') GOTO 20 READ(CLINE,*,ERR=900,END=900) MODE 30 CONTINUE READ(12,'(A)',ERR=900,END=900) CLINE IF (CLINE(1:1).EQ.'!') GOTO 30 READ(CLINE,*,ERR=900,END=900) BR WRITE(LOUT,'(A,A)') &' Particle Options Mass Charge ', & ' Life Time' WRITE(LOUT,1020) ID, CNAME, ITYP, RMASS, CHARGE, TIME 1020 FORMAT(1X,I6,1X,A10,I5,9X,F11.7,1X,F5.1,9X,1PE11.5,/) WRITE(LOUT,'(5X,6F12.5)') BR WRITE(LOUT,'(5X,6I12)') MODE CALL GSPART(ID, CNAME, ITYP, RMASS, CHARGE, TIME, 0, 0) CALL GSDK(ID,BR,MODE) GOTO 10 900 CONTINUE CLOSE (UNIT=12, STATUS='KEEP',ERR=999) ENDIF 999 CONTINUE +REP,CBBASE,UGZTAB,1-17. *CMZU: 5.04/00 27/06/95 13.42.16 by RAFIK OUARED * add a call to SVTABL to load SVTX table *CMZ : 27/06/95 13.38.54 by RAFIK OUARED *CMZ : 5.00/00 05/07/94 14.36.11 by CBGEANT HACKERS *CMZ : 4.06/09 06/08/93 15.28.19 by CBGEANT HACKERS' *CMZ : 03/08/93 14.15.51 by Anthony J. Noble * modify code to allow use of external lookup tables for FERA * and 2282. *CMZ : 4.06/03 26/02/92 16.51.15 by R.BOSSINGHAM * Initialize unused header words to zero. *CMZ : 4.05/00 08/11/91 15.59.19 by R.BOSSINGHAM * Initialize LTBCF, LTBCL variables. *CMZ : 4.03/01 08/07/91 11.47.02 by R.BOSSINGHAM * Reorder specification statements to make ANSI standard. *CMZU: 4.02/10 24/01/91 09.40.58 by Curtis A. Meyer *CMZ : 4.02/05 28/08/90 10.20.59 by Curtis A. Meyer *-- Author : SUBROUTINE UGZTAB * ****************************************************************** +REP,CBBASE,UGZTAB,24-25. * Modified: 27-June 95, Ouared, SVTX table loaded * ****************************************************************** +REP,CBBASE,UGZTAB,35. * Book Zebra bank for FERA table +REP,CBBASE,UGZTAB,42. * Fill bank +REP,CBBASE,UGZTAB,49. C We now use the threshold value, so this must be written to tape. +REP,CBBASE,UGZTAB,69-71. * theta: CALL SBYT( LOOKBC(2,ISUBA,IVSN), IQ(ITBCF+4), 17, 16) * phi: +REP,CBBASE,UGZTAB,77. * normal case +REP,CBBASE,UGZTAB,83-87. 11 CONTINUE 10 CONTINUE 600 FORMAT(7(I6,1X),2(F8.4,1X)) * * Book Zebra bank for 2280 data: +REP,CBBASE,UGZTAB,118-120. * theta CALL SBYT( LK22BC(2,ICHAN-1), IQ(ITBCL+4), 17, 16) * phi +REP,CBBASE,UGZTAB,127. * normal case +REP,CBBASE,UGZTAB,134-135. 21 CONTINUE 20 CONTINUE * * SVTX table now * CALL SVTABL * +ADD,CBKINE,BIDCAY,0. *CMZ : 5.03/04 04/08/95 15.20.53 by Curtis A. Meyer * Change VELO(3) = ... to VELO(3) = - ... +REP,CBKINE,BIDCAY,90. VELO(3) = -(PBEAM+PTARG)/E12 +ADD,CBKINE,BIRESO,0. *CMZ : 5.03/02 22/05/95 10.09.39 by Curtis A. Meyer +REP,CBKINE,BIRESO,118. ******* Begin changes (March 2, 1994) ******* The following line is commented out * IEORUN = 1 ******* * Mark Lakata's patch: Sometimes in wide resonances (for example rho) a * very low mass in chosen at the first vertex interaction. Since the * initial mass is too small for decays such as rho(770) -> eta(550) g, * this will never get resolved on the level of BIRESO-- the whole event * needs to be redone at the BIDCAY level. * * in this case, it appears that BIDCAY picked a mass less than 550 MeV for the * rho (which is about 3 sigmas from the mean) which could not possible decay * into eta(550) gamma. ******* The following was added: IEOTRI = 1 ******* End of changes (March 1, 1994) +ADD,CBKINE,KIVERT,0. *CMZU: 5.03/01 13/03/95 16.33.42 by Christoph Strassburger +ADD,CBKINE,KIVERT,49. C * C * Modified 13 March 95 C. Strassburger C * Put the right Crystal Barrel TGHP-stop-distribution in C * +REP,CBKINE,KIVERT,62-70. * SIGXHP,Y,ZCB Crystal Barrel Stop distribution for high presssure * gas target * REAL SIGX,SIGY,SIGZ REAL SIGXCB,SIGYCB,SIGZCB REAL SIGXHPCB,SIGYHPCB,SIGZHPCB * SAVE SIGX,SIGY,SIGZ SAVE SIGXCB,SIGYCB,SIGZCB SAVE SIGXHPCB,SIGYHPCB,SIGZHPCB * DATA SIGX,SIGY,SIGZ / 2.300,2.300,5.710 / DATA SIGXCB,SIGYCB,SIGZCB / 0.280,0.280,0.400 / DATA SIGXHPCB,SIGYHPCB,SIGZHPCB / 0.400,0.400,0.700 / +ADD,CBKINE,KIVERT,126. * ELSEIF (IP.EQ.6) THEN * * p-bar stop distribution for Crystal Barrel high press. gas target. * VERTEX(1)=SIGXHPCB*XRN1 VERTEX(2)=SIGYHPCB*XRN2 VERTEX(3)=SIGZHPCB*XRN3 * +ADD,CBMATE,MATERI,0. *CMZU: 5.03/01 15/03/95 10.17.28 by Christoph Strassburger +REP,CBMATE,MATERI,462-464. * H2 gas to H2 gas at 1 atm density : * DATA PFACT /12.0/ +REP,CBMATE,MATERI,525. H2DENS = PFACT * 0.0838 +REP,CBVIEW,BCVFRN,1-34. *CMZU: 5.04/00 23/04/95 16.15.36 by RAFIK OUARED *CMZ : 5.01/00 12/09/94 10.15.06 by RAFIK OUARED *CMZ : 11/09/94 19.02.34 by RAFIK OUARED * Added SVTX part code. *CMZ : 11/09/94 19.01.42 by RAFIK OUARED *CMZU: 5.00/00 25/01/93 14.57.51 by Y.Dardenne *CMZ : 15/01/93 12.16.57 by Y.Dardenne * I added a call to gsatt for the volume jds2 for the case when we * look at the new JDC (15 inner secrtors, 30 outer sectors) * *CMZ : 4.05/00 14/11/91 17.16.33 by R.BOSSINGHAM * Stop plotting drift cells: too much detail. * Exchange XDC for GHT. * Improve view of target. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 11/09/91 16.45.53 by R.BOSSINGHAM *CMZ : 4.03/01 05/07/91 12.18.07 by R.BOSSINGHAM *CMZ : 4.03/00 13/06/91 13.00.52 by R.BOSSINGHAM * Offset from midplane further. *CMZ : 06/06/91 10.48.23 by R.BOSSINGHAM * Add more detail. * Add newly created regions. *CMZ : 4.02/05 28/08/90 10.21.04 by Curtis A. Meyer *-- Author : C SUBROUTINE BCVFRN(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE BCVFRN ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : K. Peters (Sep. 1987) ** C ** ** C ********************************************************************** +REP,CBVIEW,BCVFRN,44. C Set attributes to draw BC FRON view with FULL complexity +REP,CBVIEW,BCVFRN,84. IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,BCVFRN,91. C. Check if this is the new JDC +REP,CBVIEW,BCVFRN,103. 99 CONTINUE +REP,CBVIEW,BCVFRN,115. C Set attributes to draw BC FRONt view with FAST option +REP,CBVIEW,BCVFRN,130. 999 CONTINUE +REP,CBVIEW,BCVSID,1-31. *CMZU: 5.04/00 23/04/95 16.16.04 by RAFIK OUARED *CMZ : 5.01/01 13/12/94 13.05.58 by RAFIK OUARED *CMZ : 5.01/00 18/09/94 09.30.52 by RAFIK OUARED *CMZ : 11/09/94 19.04.35 by RAFIK OUARED *CMZ : Added SVTX part code. *CMZ : 10/09/94 19.11.36 by RAFIK OUARED *CMZ : 4.05/00 13/11/91 15.19.58 by R.BOSSINGHAM * Exchange XDC for GHT. * Support 1991 target and improve view of target. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.14.07 by R.BOSSINGHAM * Update PWC * Add new JDC regions. *CMZ : 4.03/01 05/07/91 12.22.04 by R.BOSSINGHAM *CMZ : 4.03/00 13/06/91 13.58.16 by R.BOSSINGHAM *CMZ : 12/06/91 12.36.37 by R.BOSSINGHAM * Take viewing cut at X=0.3, not 0.1 * Add beamline, more BC regions * Add newly created regions. *CMZ : 4.02/05 28/08/90 10.21.04 by Curtis A. Meyer *-- Author : C SUBROUTINE BCVSID(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE BCVSID ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : K. Peters (Sep. 1987) ** C ** ** C ********************************************************************** +REP,CBVIEW,BCVSID,43. C Set attributes to draw BC SIDE view with FULL complexity +REP,CBVIEW,BCVSID,95. IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,BCVSID,126. 10 CONTINUE +REP,CBVIEW,BCVSID,143. C Set attributes to draw BC SIDE view with FAST option +REP,CBVIEW,BCVSID,169. 999 CONTINUE +REP,CBVIEW,BCVTOP,1-31. *CMZU: 5.04/00 23/04/95 16.16.33 by RAFIK OUARED *CMZ : 5.01/00 12/09/94 10.18.43 by RAFIK OUARED *CMZ : 11/09/94 19.07.07 by RAFIK OUARED * ADDED SVTX PART CODE. *CMZ : 10/09/94 19.13.28 by RAFIK OUARED *CMZ : 4.05/00 13/11/91 15.20.38 by R.BOSSINGHAM * Exchange XDC for GHT. * Support 1991 target and improve target view. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.19.07 by R.BOSSINGHAM * Update PWC * Add new JDC regions. *CMZ : 4.03/01 05/07/91 12.22.56 by R.BOSSINGHAM *CMZ : 4.03/00 13/06/91 13.58.49 by R.BOSSINGHAM *CMZ : 12/06/91 12.18.33 by R.BOSSINGHAM * Offset viewing cut from midplane further. *-- Author : * Add target, beamline, more BC regions. * Add newly created regions. *CMZ : 4.02/05 28/08/90 10.21.04 by Curtis A. Meyer *-- Author : C SUBROUTINE BCVTOP(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE BCVTOP ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : K. Peters (Sep. 1987) ** C ** ** C ********************************************************************** +REP,CBVIEW,BCVTOP,43. C Set attributes to draw BC TOP view with FULL complexity +REP,CBVIEW,BCVTOP,95. IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,BCVTOP,126. 10 CONTINUE +REP,CBVIEW,BCVTOP,143. C Set attributes to draw BC TOP view with FAST option +REP,CBVIEW,BCVTOP,169. 999 CONTINUE +REP,CBVIEW,JDVFRN,1-29. *CMZU: 5.04/00 23/04/95 16.17.06 by RAFIK OUARED *CMZ : 5.01/00 12/09/94 10.20.07 by RAFIK OUARED *CMZ : 11/09/94 19.18.30 by RAFIK OUARED * ADDED SVTX PART CODE. *CMZ : 10/09/94 19.15.29 by RAFIK OUARED *CMZU: 5.00/00 07/04/93 09.19.32 by Y.Dardenne *CMZ : 4.05/00 14/11/91 17.40.52 by R.BOSSINGHAM * Only plot drift cell trapezoids for FASTJDC. * Exchange XDC for GHT. * Improve target view. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 11/09/91 16.47.55 by R.BOSSINGHAM * Update PWC * Add new JDC regions. *CMZ : 4.03/01 05/07/91 11.59.08 by R.BOSSINGHAM *CMZ : 4.03/00 13/06/91 13.57.39 by R.BOSSINGHAM * Add newly created regions. *CMZ : 4.02/05 28/08/90 10.21.05 by Curtis A. Meyer *-- Author : C SUBROUTINE JDVFRN(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE JDVFRN ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : K. Peters (Sep. 1987) ** C ** ** C ********************************************************************** +REP,CBVIEW,JDVFRN,41. C Set attributes to draw JD FRONt view with FULL complexity +REP,CBVIEW,JDVFRN,81. IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,JDVFRN,106-109. 100 CONTINUE &SELF,IF=-FASTJDC. CALL GSATT('JDSE','SEEN',1) C. If it is the new geometry then draw the inner sectors +REP,CBVIEW,JDVFRN,122. C Set attributes to draw JD FRONt view with FAST option +REP,CBVIEW,JDVFRN,131. C. If it is the new geometry then draw the inner sectors +REP,CBVIEW,JDVFRN,142. 999 CONTINUE +REP,CBVIEW,JDVSID,1-29. *CMZU: 5.04/00 23/04/95 16.17.27 by RAFIK OUARED *CMZ : 5.01/00 12/09/94 10.21.09 by RAFIK OUARED *CMZ : 11/09/94 19.20.00 by RAFIK OUARED * ADDED SVTX PART CODE. *CMZ : 10/09/94 19.17.48 by RAFIK OUARED *CMZ : 4.05/00 13/11/91 15.36.32 by R.BOSSINGHAM * Exchange XDC for GHT. * Support 1991 target and improve the target view. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.23.50 by R.BOSSINGHAM * Update PWC * Add new JDC regions. *CMZ : 4.03/01 05/07/91 12.24.59 by R.BOSSINGHAM *CMZ : 4.03/00 13/06/91 13.55.45 by R.BOSSINGHAM *CMZ : 12/06/91 12.37.17 by R.BOSSINGHAM * Add veto counter and guide. * Add newly created regions. *CMZ : 4.02/05 28/08/90 10.21.05 by Curtis A. Meyer *-- Author : C SUBROUTINE JDVSID(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE JDVSID ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : K. Peters (Sep. 1987) ** C ** ** C ********************************************************************** +REP,CBVIEW,JDVSID,39. C Set attributes to draw JD SIDE view with FULL complexity +REP,CBVIEW,JDVSID,91. IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,JDVSID,122. C Set attributes to draw JD SIDE view with FAST option +REP,CBVIEW,JDVSID,143. 999 CONTINUE +REP,CBVIEW,JDVTOP,1-27. *CMZU: 5.04/00 23/04/95 16.17.50 by RAFIK OUARED *CMZ : 5.01/00 12/09/94 10.23.13 by RAFIK OUARED *CMZ : 11/09/94 19.21.15 by RAFIK OUARED * ADDED SVTX PART CODE. *CMZ : 10/09/94 19.19.39 by RAFIK OUARED *CMZ : 4.05/00 12/11/91 17.46.26 by R.BOSSINGHAM * Exchange XDC for GHT. * Support 1991 target and improve the target view. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.24.26 by R.BOSSINGHAM * Update PWC * Add new JDC regions. *CMZ : 4.03/01 05/07/91 12.25.34 by R.BOSSINGHAM *CMZ : 4.03/00 13/06/91 13.56.21 by R.BOSSINGHAM *CMZ : 12/06/91 12.32.23 by R.BOSSINGHAM * Update regions. *-- Author : C SUBROUTINE JDVTOP(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE JDVTOP ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : K. Peters (Sep. 1987) ** C ** ** C ********************************************************************** +REP,CBVIEW,JDVTOP,37. C Set attributes to draw JD TOP view with FULL complexity +REP,CBVIEW,JDVTOP,89. IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,JDVTOP,120. C Set attributes to draw JD TOP view with FAST option +REP,CBVIEW,JDVTOP,141. 999 CONTINUE +REP,CBVIEW,PWVFRN,1-20. *CMZU: 5.04/00 23/04/95 16.18.26 by RAFIK OUARED *CMZ : 5.01/00 17/09/94 18.17.12 by RAFIK OUARED *CMZ : 4.05/00 13/11/91 15.38.56 by R.BOSSINGHAM * Include target in view. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.15.50 by R.BOSSINGHAM *CMZ : 4.03/01 05/07/91 11.58.30 by R.BOSSINGHAM *CMZ : 4.02/05 28/08/90 10.21.05 by Curtis A. Meyer *-- Author : C SUBROUTINE PWVFRN(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE PWVFRN ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : K. Peters (Sep. 1987) ** C ** Modified : K. Peters (May 1989) new PWC geometry ** C ** ** C ********************************************************************** +REP,CBVIEW,PWVFRN,27. C-- Set attributes to draw PW FRONt view +REP,CBVIEW,PWVFRN,75. * IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,PWVFRN,85. 999 CONTINUE +REP,CBVIEW,PWVSID,1-21. *CMZU: 5.04/00 23/04/95 16.18.49 by RAFIK OUARED *CMZ : 5.01/00 17/09/94 18.17.40 by RAFIK OUARED *CMZ : 4.05/00 13/11/91 15.37.02 by R.BOSSINGHAM * Include target in view. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.16.41 by R.BOSSINGHAM *CMZ : 4.03/00 06/06/91 10.57.07 by R.BOSSINGHAM * Add ROH2, ROH3 layers *CMZ : 4.02/05 28/08/90 10.21.05 by Curtis A. Meyer *-- Author : C SUBROUTINE PWVSID(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE PWVSID ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : K. Peters (Sep. 1987) ** C ** Modified : K. Peters (May 1989) new PWC geometry ** C ** ** C ********************************************************************** +REP,CBVIEW,PWVSID,28. C Set attributes to draw PW SIDE view +REP,CBVIEW,PWVSID,71. * IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,PWVSID,77. 999 CONTINUE +REP,CBVIEW,PWVTOP,1-20. *CMZU: 5.04/00 23/04/95 16.19.09 by RAFIK OUARED *CMZ : 5.01/00 17/09/94 18.16.30 by RAFIK OUARED *CMZ : 4.05/00 13/11/91 15.37.44 by R.BOSSINGHAM * Include target in display. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.17.34 by R.BOSSINGHAM *CMZ : 4.03/00 12/06/91 12.33.44 by R.BOSSINGHAM *CMZ : 4.02/05 28/08/90 10.21.05 by Curtis A. Meyer *-- Author : C SUBROUTINE PWVTOP(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE PWVTOP ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : K. Peters (Sep. 1987) ** C ** Modified : K. Peters (May 1989) new PWC geometry ** C ** ** C ********************************************************************** +REP,CBVIEW,PWVTOP,27. C-- Set attributes to draw PW TOP view +REP,CBVIEW,PWVTOP,70. * IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,PWVTOP,76. 999 CONTINUE +REP,CBVIEW,SVVFRN,1-19. *CMZU: 5.04/00 23/04/95 16.20.27 by RAFIK OUARED *CMZ : 5.01/00 17/09/94 18.19.46 by RAFIK OUARED *CMZ : 4.05/00 13/11/91 15.38.56 by R.BOSSINGHAM * Include target in view. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.15.50 by R.BOSSINGHAM *CMZ : 4.03/01 05/07/91 11.58.30 by R.BOSSINGHAM *CMZ : 4.02/05 28/08/90 10.21.05 by Curtis A. Meyer *-- Author : C SUBROUTINE SVVFRN(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE SVVFRN ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : R. OUARED (Sep. 1987) ** C ** ** C ********************************************************************** +REP,CBVIEW,SVVFRN,26. C-- Set attributes to draw PW FRONt view +REP,CBVIEW,SVVFRN,74-76. IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) IF (IICPLX.EQ.1) THEN IF (NDSVX.NE.0) CALL GSATT('ISTR','SEEN',1) IF (NDSVX.NE.0) CALL GSATT('HYBR','SEEN',1) +REP,CBVIEW,SVVFRN,84. 999 CONTINUE +REP,CBVIEW,SVVSID,1-20. *CMZU: 5.04/00 23/04/95 16.21.15 by RAFIK OUARED *CMZ : 5.01/00 17/09/94 18.20.23 by RAFIK OUARED *CMZ : 4.05/00 13/11/91 15.37.02 by R.BOSSINGHAM * Include target in view. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.16.41 by R.BOSSINGHAM *CMZ : 4.03/00 06/06/91 10.57.07 by R.BOSSINGHAM * Add ROH2, ROH3 layers *CMZ : 4.02/05 28/08/90 10.21.05 by Curtis A. Meyer *-- Author : C SUBROUTINE SVVSID(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE SVVSID ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : R. OUARED (Sep. 1994) ** C ** ** C ********************************************************************** +REP,CBVIEW,SVVSID,27. C Set attributes to draw PW SIDE view +REP,CBVIEW,SVVSID,71-73. IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) IF (IICPLX.EQ.1) THEN IF (NDSVX.NE.0) CALL GSATT('ISTR','SEEN',1) IF (NDSVX.NE.0) CALL GSATT('HYBR','SEEN',1) +REP,CBVIEW,SVVSID,81. 999 CONTINUE +REP,CBVIEW,SVVTOP,1-19. *CMZU: 5.04/00 23/04/95 16.21.54 by RAFIK OUARED *CMZ : 5.01/00 17/09/94 18.18.38 by RAFIK OUARED *CMZ : 4.05/00 13/11/91 15.37.44 by R.BOSSINGHAM * Include target in display. * Allow PWC1,2 to be included/excluded individually. *CMZ : 4.03/02 26/07/91 10.17.34 by R.BOSSINGHAM *CMZ : 4.03/00 12/06/91 12.33.44 by R.BOSSINGHAM *CMZ : 4.02/05 28/08/90 10.21.05 by Curtis A. Meyer *-- Author : C SUBROUTINE SVVTOP(IICPLX,IVIEW) C C ********************************************************************** C ** ** C ** SUBROUTINE SVVTOP ** C ** ** C ** ==> Called by : GUVIEW ** C ** Author : R. OUARED (Sep. 1994) ** C ** ** C ********************************************************************** +REP,CBVIEW,SVVTOP,26. C-- Set attributes to draw PW TOP view +REP,CBVIEW,SVVTOP,69. IF (NDSVX.NE.0) CALL GSATT('IVTX','SEEN',1) +REP,CBVIEW,SVVTOP,75. 999 CONTINUE +ADD,PW,GETGHP,0. *CMZU: 5.03/01 14/03/95 11.52.56 by Christoph Strassburger +ADD,PW,GETGHP,21. *. * modified : Ulrike Thoma and Christoph Strassburger * *. * implementation of new high pressure * *. * gas target according to a sketch * *. * of Wolfgang Duennweber * *. * * +REP,PW,GETGHP,28-34. CALL ERRWRN(0,' TGHP GEOMETRY/MATERIALS from a sketch of WD$') * * Target * PAR(1) = 0. PAR(2) = 0.14 PAR(3) = 5.9 +REP,PW,GETGHP,45-50. *-- outer carbon-mylar vessel * PAR(1) = 0.14 PAR(2) = 0.15 PAR(3) = 6.0 CALL GSVOLU('THPO','TUBE',54,PAR,3,IVOL) +REP,PW,GETGHP,57-62. PAR(2) = 0.15 PAR(3) = 0.05 CALL GSVOLU('THPE','TUBE',53,PAR,3,IVOL) IF(IVOL.LE.0) CALL ERRMES(IVOL,'GETGHP : GSVOLU THPE failed$') CALL GSPOS('THPE',1,'TGHP',0.,0.,ZTARG-5.95,0,'ONLY') CALL GSPOS('THPE',2,'TGHP',0.,0.,ZTARG+5.95,0,'ONLY') +REP,SV,GETGLHS,1-18. *CMZU: 5.04/00 25/05/95 12.43.48 by RAFIK OUARED *CMZ : 5.01/00 18/09/94 10.34.04 by RAFIK OUARED *CMZ : 4.06/09 06/08/93 17.14.40 by CBGEANT HACKERS' * We have modified the target dimensions to have a length of * 4.4 cm as compared to the old version of 4.0. This is * beleived to be the actual dimensions. *CMZ : 4.05/00 11/11/91 15.01.41 by R.BOSSINGHAM * Implement 1991 LH2 target. * Replace 40% iron region with true geometry. *CMZ : 4.03/02 31/07/91 13.00.49 by R.BOSSINGHAM * Allow beamline to move closer to JDC. * Increase the size of the mother volume. *CMZ : 4.03/01 01/07/91 15.37.03 by R.BOSSINGHAM * Add option of using LD2 instead of LH2 as the filling *CMZ : 4.03/00 14/06/91 15.34.16 by R.BOSSINGHAM *CMZ : 13/06/91 13.16.00 by R.BOSSINGHAM * Fix upstream end of beamline at the magnet face. *CMZ : 12/06/91 15.31.04 by R.BOSSINGHAM +REP,SV,GETGLHS,25-27. *CMZ : 4.02/07 16/10/90 08.34.58 by Curtis A. Meyer *CMZ : 4.02/05 28/08/90 10.21.09 by Curtis A. Meyer *-- Author : Kersten. +REP,SV,GETGLHS,53-57. REAL ZPOS * * More realistic target: * Aluminium tube (LHT), filled with isolating low density mylar (LHIS), and a * mylar window at the downstream end (LHWI) * The physical target itself is placed inside LHIS as follows: +REP,SV,GETGLHS,65. * Beamline mother volume; calculate Z coordinate of planes later +REP,SV,GETGLHS,72. * Upstream beamline section +REP,SV,GETGLHS,78. * Air mother volume LHT- +REP,SV,GETGLHS,86. * Aluminum tube LHAL: +REP,SV,GETGLHS,97-98. * Mylar window LHWI: * (Make thicker/reduce density) +REP,SV,GETGLHS,108. * Isolation LHIS: +REP,SV,GETGLHS,118. * Upstream part of iron ring LHF1: +REP,SV,GETGLHS,128-129. * Hole in upstream iron ring LHFH: * (LH2 after 1991) +REP,SV,GETGLHS,145-146. * Copper plate in upstream iron ring LHFC: * (after 1991 only) +REP,SV,GETGLHS,158. * Downstream part of iron ring LHF2: +REP,SV,GETGLHS,170. 17 CALL SVGE +REP,SV,GETGLHS,195-196. * Mylar tube LHMY: * (Make thicker, reduce density) +REP,SV,GETGLHS,206-207. * Liquid H2 LHLH: * (Shorten length slightly so reduced density Mylar ends have correct mass) +REP,SV,GETGLHS,238-240. * Set up limits for target cell * 15 RTARG2 = 0.8425 +REP,SV,SVDIGI,1-14. *CMZU: 5.04/00 30/06/95 20.07.51 by RAFIK OUARED *-- Author : R.Ouared +REP,SV,SVDIGI,25-46. *. * modified March 15, 1994 R.Ouared * *. * new RVTX filling and new display of hits. +REP,SV,SVDIGI,59-71. &SEQ,CBSVOF. * * * Zebra raw data bank size IZBSIZ * INTEGER IZBSIZ, INUMVS INTEGER NHMAX, NHDIM, NVDIM, NDDIM, NDMAX INTEGER NICEL,IOFF,IOFB2 PARAMETER (NHMAX=100,NDDIM=1,NHDIM=3,NVDIM=2,NTRA=1,NDMAX=100) PARAMETER (NTDIM=1) PARAMETER (NICEL=1920,NMODU=15) +REP,SV,SVDIGI,77-133. INTEGER HNUM,JNUM,KDIGI(NICEL),AMP(NICEL) INTEGER IAMPL(NICEL,NICEL) INTEGER NCLUS,NH(NICEL),IADC(16),IFIRST(NICEL),ISTRIP(NICEL) INTEGER IPED(16),NMASK,NPAD INTEGER IPAD(NICEL),ISUBM(NICEL),IMOD(NICEL),IAD INTEGER ITRVX(NICEL),ITRVXS(NICEL) INTEGER JWIR1,JSUBM,JMODU,NSHORT,NFORM,JNSHORT,JNFORM INTEGER RADC,LADC,RPED,LPED,HITINC,L,JAMP REAL HITS(NHDIM,NHMAX) REAL DXS(NICEL),DYS(NICEL),LENSI(NICEL),DZS(NICEL) LOGICAL LEQUAL * * Array of hit wire addresses IADD (),JADD() * INTEGER IADD (NICEL),JADD(NICEL) * * Number of wires which fired in one event NWIRES * * Zero the array of "added" wires, and set number of wires to zero. * CALL VZERO (IADD,NICEL) CALL VZERO (JADD,NICEL) CALL VZERO (ISTD,NHMAX) CALL VZERO (ITRVX,NICEL) CALL VZERO (ITRVXS,NICEL) NWIRES = 0 IOFF = ISOF(1) * * Return hits for a given STRIP ISTR if SVTX exists: * IF (NDSVX.NE.0) THEN * * get minimum volume descriptors to identify uniquely ISTR. * DO 122 II=1,NVDIM DO 123 IV=1,NHMAX NUMB(II,IV)=0 123 CONTINUE 122 CONTINUE CALL VZERO(NUMV,NVDIM) CALL GFHITS('SV ','ISTR',NVDIM,NHDIM,NHMAX,0,NUMV, & ITRA,NUMB,HITS,NHITS) * * Was there a hit in this cell? * IF(NHITS.LE.0) GOTO 100 * * * PRINT HITS IN GEANT FORMAT. * CALL GPHITS('SV ','ISTR') &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI:HIT NUMBER IN IVTX :',NHITS WRITE(6,*) 'SVDIGI:',(NUMV(I),I=1,NVDIM) &SELF. * &SELF,IF=SVDIGI. DO 150 I=1,NVDIM WRITE(6,*) 'SVDIGI:NUMB..',(NUMB(I,J),J=1,NHITS) 150 CONTINUE &SELF. * * * COMPUTE ISTR NUMBERS TO GET EFFECTIVE NUMBER OF HITS . * +REP,SV,SVDIGI,139-418. IF(NUMB(1,I).EQ.N1.AND.NUMB(2,I).EQ.N2) THEN DXS(JNUM)=HITS(1,I)-HITS(1,I-1) DYS(JNUM)=HITS(2,I)-HITS(2,I-1) DZS(JNUM)=HITS(3,I)-HITS(3,I-1) LENSI(JNUM)=SQRT((ABS(DXS(JNUM)))**2+ & (ABS(DYS(JNUM)))**2+ & (ABS(DZS(JNUM)))**2) GOTO 13 ENDIF ENDIF HNUM=(NUMB(1,I)-1)*128+NUMB(2,I) JNUM=JNUM+1 IADD(JNUM)=HNUM JADD(JNUM)=HNUM ISTD(JNUM)=NUMB(2,I) ITRVX(JNUM)=100*ITRA(I)+NUMB(1,I) ITRS(JNUM)=ITRA(I) INUV(JNUM)=I &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI:I,JNUM,IADD(JNUM)..' WRITE(6,*) I,JNUM,IADD(JNUM) WRITE(6,*) 'SVDIGI:NUMB(1,I),NUMB(2,I),ITRA(I)..' WRITE(6,*) NUMB(1,I),NUMB(2,I),ITRA(I) &SELF. GOTO 14 * * COMPUTE DIGITIZATION HERE * 13 KDIGI(JNUM)=10000 !10000 PER CM * AMP(JNUM)=FLOAT(KDIGI(JNUM))*LENSI(JNUM) IF(AMP(JNUM).EQ.0.) THEN JNUM=JNUM-1 GOTO 14 ENDIF KDIGI(JNUM)=INT(AMP(JNUM)) &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI: AMP(JNUM)..',AMP(JNUM) &SELF. * 14 CONTINUE * * NWIRES = JNUM &SELF,IF=SVDIGI. WRITE(6,*) 'ITRVX= ',(ITRVX(J),J=1,NWIRES) WRITE(6,*) 'NWIRES= ',NWIRES &SELF. * * STORE ISTR DIGITISATION. * CALL DETPOS('SV ','ISTR',ISET,IDET) &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI: ISET,IDET..',ISET,IDET &SELF. * DO 18 JI=1,NWIRES * DO 126 IA=1,NDDIM IDIGI(IA)=KDIGI(JI) 126 CONTINUE * DO 19 II=1,NTRA MTRA(II)=ITRS(JI) 19 CONTINUE * DO 22 IC=1,NVDIM NUMV(IC)=NUMB(IC,INUV(JI)) 22 CONTINUE * * STORE DIGITIZATION HERE * CALL GSDIGI(ISET,IDET,MTRA,NTRA,NUMV,IDIGI,IDIG) * 18 CONTINUE * DO 142 II=1,NVDIM DO 143 IV=1,NDMAX NUBV(II,IV)=0 143 CONTINUE 142 CONTINUE * * FIND OUT DIGITIZATON VALUES * **** CALL VZERO(NUMV,NVDIM) CALL GFDIGI('SV ','ISTR',NTDIM,NVDIM,NDDIM,NDMAX,NUMV, + LTRA,HTRA,NUBV,MDIGI,NDIGI) &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI:ITRA= ',(ITRA(K),K=1,NHITS) &SELF. * CALL GPDIGI('SV ','ISTR') * * 100 CONTINUE * ENDIF * * Also order the array, as it would appear in real data * IF(NWIRES.GT.1) THEN CALL INTSOR(IADD,NWIRES) &SELF,IF=SVDIGI. WRITE(6,*) ' ' WRITE(6,*) ' SORTED STRIPS AND WIRES STORED IN RVTX...' WRITE(6,*) ' ' WRITE(6,*) 'IADD= ',(IADD(J),J=1,NWIRES) &SELF. ENDIF * * PREPARE THE FILLING OF THE RAW BANK RVTX * * WORK OUT NUMBER OF CLUSTERS AND NUMBER OF HITS PER CLUSTER * NCLUS,NH(NCLUS) * NCLUS=0 CALL VZERO(NH,100) * DO 220 I=1,NWIRES DO K=1,NWIRES IF(JADD(K).EQ.IADD(I)) THEN ITRVXS(I)=ITRVX(K) GOTO 220 ENDIF ENDDO 220 CONTINUE * NCLUS=1 NH(NCLUS)=1 LEQUAL=.FALSE. DO 200 I=1,NWIRES IF(I.GT.1) THEN IF(ITRVXS(I).EQ.ITRVXS(I-1)) THEN NH(NCLUS)=NH(NCLUS)+1 LEQUAL=.TRUE. GOTO 201 ELSE LEQUAL=.FALSE. NCLUS=NCLUS+1 NH(NCLUS)=1 GOTO 201 ENDIF ELSE 201 J=NH(NCLUS) DO K=1,NWIRES IF(JADD(K).EQ.IADD(I)) THEN IAMPL(NCLUS,J)=INT(AMP(K)) IF(LEQUAL) GOTO 207 GOTO 205 ENDIF ENDDO 205 IFIRST(NCLUS)=IADD(I) IAD=IADD(I)/128 ISTRIP(NCLUS)=MOD(IADD(I),128) IF(ISTRIP(NCLUS).EQ.0) ISTRIP(NCLUS)=128 ISTRIP(NCLUS)=ISTRIP(NCLUS)-1 IPAD(NCLUS) =IADD(I)/256 ISUBM(NCLUS) =MOD(IAD,2) 207 IMOD(I) =2*IPAD(NCLUS)+(ISUBM(NCLUS)+1) GOTO 206 ENDIF 206 CONTINUE &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI: IN CLUSTER LOOP...' WRITE(6,*) 'I,NCLUS,NH(NCLUS),LEQUAL..' WRITE(6,*) I,NCLUS,NH(NCLUS),LEQUAL WRITE(6,*) 'K,IADD(I),J,IFIRST(NCLUS)..' WRITE(6,*) K,IADD(I),J,IFIRST(NCLUS) WRITE(6,*) 'ISTRIP(NCLUS),IPAD(NCLUS),ISUBM(NCLUS),IMOD(I)..' WRITE(6,*) ISTRIP(NCLUS),IPAD(NCLUS),ISUBM(NCLUS),IMOD(I) &SELF. 200 CONTINUE * * FLL UP BACKPLANE AMPLITUDES ARRAY IADC * CALL VZERO(IADC,16) CALL VZERO(IPED,16) DO 210 I=1,NWIRES DO 211 J=1,NWIRES IF(IADD(I).EQ.JADD(J)) THEN IADC(IMOD(I))=IADC(IMOD(I))+INT(AMP(J)) GOTO 210 ENDIF 211 CONTINUE 210 CONTINUE * &SELF,IF=SVDIGI. DO I=1,16 WRITE(6,*) 'SVDIGI: I,IADC(I)..',I,IADC(I) ENDDO &SELF. * IOFB2=IOFF/2 NSHORT = NWIRES+34+2*NCLUS+IOFF IF(2*(NSHORT/2).NE.NSHORT) THEN IZBSIZ =NSHORT/2+1 ELSE IZBSIZ=NSHORT/2 ENDIF &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI: NWIRES,NCLUS,IZBSIZ..',NWIRES,NCLUS, &IZBSIZ &SELF. CALL MZBOOK(IXRVTX,LRVTX,LLAST,0,'RVTX',0,0,IZBSIZ,1,0) LLAST = LRVTX * * STARTS FILLING UP RVTX BANK * NFORM=42499 NMASK=0 NPAD=0 CALL SBYT(NFORM,IQ(LRVTX+1),17,16) !FORMAT WORD A603 CALL SBYT(NSHORT,IQ(LRVTX+1),1,16) !TOTAL NUMBER OF SHORT WORDS CALL SBYT(NMASK,IQ(LRVTX+2),17,16) !bitmask CALL SBYT(NPAD,IQ(LRVTX+2),1,16) !padding &SELF,IF=SVDIGI. JNFORM=JBYT(IQ(LRVTX+1),17,16) JNSHORT=JBYT(IQ(LRVTX+1),1,16) WRITE(6,*) 'SVDIGI:JNFORM,JNSHORT..',JNFORM,JNSHORT &SELF. DO I=1,8 J=2*I-1 CALL SBYT(IADC(J),IQ(LRVTX+1+I+IOFB2),17,12) !backplane ampli CALL SBYT(IADC(J+1),IQ(LRVTX+1+I+IOFB2),1,12) !12-BITS ADCs CALL SBIT1(IQ(LRVTX+1+I+IOFB2),30) !valid CALL SBIT1(IQ(LRVTX+1+I+IOFB2),14) !valid IF(IADC(J).GE.4095) CALL SBIT1(IQ(LRVTX+1+I+IOFB2),31) !overflow IF(IADC(J+1).GE.4095) CALL SBIT1(IQ(LRVTX+1+I+IOFB2),15) !overflow CALL SBYT(IPED(J),IQ(LRVTX+9+I+IOFB2),17,12) !baseline offset CALL SBYT(IPED(J+1),IQ(LRVTX+9+I+IOFB2),1,12) &SELF,IF=SVDIGI. RADC=JBYT(IQ(LRVTX+1+I+IOFB2),17,12) LADC=JBYT(IQ(LRVTX+1+I+IOFB2),1,12) RPED=JBYT(IQ(LRVTX+9+I+IOFB2),17,12) LPED=JBYT(IQ(LRVTX+9+I+IOFB2),1,12) WRITE(6,*) 'SVDIGI:MODULE ,RADC,RPED..',J,RADC,RPED WRITE(6,*) 'SVDIGI:MODULE ,LADC,LPED..',J+1,LADC,LPED &SELF. ENDDO * KADD =35+IOFF !ADDRESS OFFSET DO I=1,NCLUS * &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI: CLUSTER,KADD..',I,KADD &SELF. IF(2*(KADD/2).NE.KADD) THEN CALL SBYT(NH(I),IQ(LRVTX+(KADD+1)/2),1,16) !# OF HITS IN CLUSTER CALL SBYT (ISTRIP(I),IQ(LRVTX+(KADD+1)/2),17,7) !STRIP CALL SBIT (ISUBM(I),IQ(LRVTX+(KADD+1)/2),24) !SUBMODULE CALL SBYT (IPAD(I),IQ(LRVTX+(KADD+1)/2),25,3) !PAD CALL SBIT1(IQ(LRVTX+(KADD+1)/2),32) !BIT &SELF,IF=SVDIGI. JWIR1=JBYT(IQ(LRVTX+(KADD+1)/2),17,7) JSUBM=JBIT(IQ(LRVTX+(KADD+1)/2),24) JMODU=JBYT(IQ(LRVTX+(KADD+1)/2),25,3) HITINC=JBYT(IQ(LRVTX+(KADD+1)/2),1,16) &SELF. ELSE CALL SBYT(NH(I),IQ(LRVTX+KADD/2+1),17,16 ) !# OF HITS IN CLUSTER CALL SBYT (ISTRIP(I),IQ(LRVTX+KADD/2),1,7) !STRIP CALL SBIT (ISUBM(I),IQ(LRVTX+KADD/2),8) !SUBMODULE CALL SBYT (IPAD(I),IQ(LRVTX+KADD/2),9,3) !PAD CALL SBIT1(IQ(LRVTX+KADD/2),16) !BIT &SELF,IF=SVDIGI. JWIR1=JBYT(IQ(LRVTX+KADD/2),1,7) JSUBM=JBIT(IQ(LRVTX+KADD/2),8) JMODU=JBYT(IQ(LRVTX+KADD/2),9,3) HITINC=JBYT(IQ(LRVTX+KADD/2+1),17,16) &SELF. ENDIF * &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI: NUMBER OF HITS IN CLUSTER..',HITINC WRITE(6,*) 'SVDIGI: FIRST STRIP,SUBM,PAD..' WRITE(6,*) JWIR1,JSUBM,JMODU &SELF. * DO J=KADD+2,KADD+1+NH(I) L=J-1-KADD IF(2*(J/2).NE.J) THEN CALL SBYT(IAMPL(I,L),IQ(LRVTX+(J+1)/2),17,10) !10-bits ADCs JAMP=JBYT(IQ(LRVTX+(J+1)/2),17,10) CALL SBIT1(IQ(LRVTX+(J+1)/2),30) !valid IF(JAMP.GE.1023) CALL SBIT1(IQ(LRVTX+(J+1)/2),31) !overflow ELSE CALL SBYT(IAMPL(I,L),IQ(LRVTX+(J+1)/2),1,10) !10-bits ADCs JAMP=JBYT(IQ(LRVTX+(J+1)/2),1,10) CALL SBIT1(IQ(LRVTX+(J+1)/2),14) !valid IF(JAMP.GE.1023) CALL SBIT1(IQ(LRVTX+(J+1)/2),15) !overflow ENDIF * &SELF,IF=SVDIGI. WRITE(6,*) 'SVDIGI: AMPLITUDE OF HIT ',L,' IN CLUSTER ',I, & ' IS ',JAMP &SELF. ENDDO KADD=KADD+NH(I)+2 ENDDO * 900 RETURN +REP,SV,SVGE,1-2. *CMZU: 5.04/00 25/05/95 13.19.22 by RAFIK OUARED *CMZ : 5.01/00 16/09/94 11.13.19 by RAFIK OUARED *-- Author : +REP,SV,SVGE,18-29. &SEQ,CBSVXY. * REAL ZPOS,ATETH,APHI * NMODU = 15 WR0 = 0. WRN = 63.5 ALPHA = PI/180. PHI0 = PIBY2 PITCH = 0.005 AHYB = 32. ! 32 (-32 DEGREES THETA OFFSET) +REP,SV,SVGE,42-268. ***************************************************************************** * * SVTX : 15 PADS OF 128 STRIPS EACH,halflength 3.7 cm, HEIGTH 370 MICRONS, * WIDTH 7.37 MM, centered at center of target + 1.8 cm, * snuggles inside isolation LHIS . * WRITE (6,*) ' ************************************************ ' WRITE (6,*) ' ** seting up SVTX as IVTX ** ' WRITE (6,*) ' ** ZTARG, RTARG2, ZTARG1, ZTARG2, WIDIN, NDTGLH ' WRITE (6,*) ' ** ',ZTARG, RTARG2, ZTARG1, ZTARG2, WIDIN, NDTGLH WRITE (6,*) ' ************************************************ ' * ZPOS=12.5-1.0-ZTARG * * THE ACTUAL SVTX SHAPE IS BEING SET UP. * DELTL=(WRN-WR0)*PITCH ANGSEC=TWOPI/NMODU * * PAR(3) : SVTX BOX PARAMETERS * PAR(1) = 0.32 PAR(2) = 0.0185 PAR(3) = 3.70 * * PARH(3): HYBRID BOX PARAMETERS * PARH(1)=0.415 PARH(2)=0.025 PARH(3)= 1.75 * * PARR(5): RING1 CONE PARAMETERS * PARR(1)=0.5 PARR(2)=1.9 PARR(3)=2.73 PARR(4)=1.9 PARR(5)=2.23 * * PAR2(3): RING2 TUBE PARAMETERS * PAR2(1)=1.9 PAR2(2)=2.4 PAR2(3)=0.125 * * NOW CREATE ALL THE VOLUMES * * start with rings along with their positionning... * CALL GSVOLU('RNG1','CONE',53,PARR,5,IVOL) IF(IVOL.LE.0) CALL ERRMES(IVOL,'SVGE : GVOLU RNG1 failed$') ZPOS1=ZPOS-2.0-2.0 CALL GSPOS('RNG1',1,'LHIS',0.,0.,ZPOS1,0,'ONLY') * CALL GSVOLU('RNG2','TUBE',53,PAR2,3,IVOL) IF(IVOL.LE.0) CALL ERRMES(IVOL,'SVGE : GVOLU RNG2 failed$') ZPOS2=ZPOS1-1.7 CALL GSPOS('RNG2',1,'LHIS',0.,0.,ZPOS2,0,'ONLY') * WRITE(6,*) 'SVGE: POSITIONS OF RINGS 1 & 2..',ZPOS1,ZPOS2 * * KEEP ON GOING WITH SVTX DETECTORS AND HYBRIDS * CALL GSVOLU('IVTX','BOX ',92,PAR,3,IVOL) IF(IVOL.LE.0) CALL ERRMES(IVOL,'SVGE : GVOLU IVTX failed$') CALL GSDVN('ISTR','IVTX',128,1) * CALL GSVOLU('HYBR','BOX ',92,PARH,3,IVOL) IF(IVOL.LE.0) CALL ERRMES(IVOL,'SVGE : GVOLU HYBR failed$') * **** GOTO 16 * * POSITIONNING OF 15 SVTX PADS AND HYBRIDS * THET(1)=90. THET(2)=90. THET(3)=0. PHIR(3)=0. TETH(1)=90. TETH(2)=90.-AHYB IF(TETH(2).GE.360.) TETH(2)=TETH(2)-360. IF(TETH(2).LT.0.) TETH(2)=TETH(2)+360. TETH(3)=90.-(AHYB+90.) IF(TETH(3).GE.360.) TETH(3)=TETH(3)-360. IF(TETH(3).LT.0.) TETH(3)=TETH(3)+360. XYZ(3)=ZPOS+1.8-4.0+PAR(3) ATETH=TETH(3)*ALPHA XYZH(3)= XYZ(3)-PAR(3)-PARH(3)*COS(ATETH) WRITE(6,*) 'SVGE:THET(1),THET(2),THET(3),PHIR(3),XYZ(3)..' WRITE(6,*) THET(1),THET(2),THET(3),PHIR(3),XYZ(3) WRITE(6,*) 'SVGE:TETH(1),TETH(2),TETH(3),XYZH(3)..' WRITE(6,*) TETH(1),TETH(2),TETH(3),XYZH(3) * DO 13 I=1,NMODU IF(I.EQ.1) THEN XYA(1)=FSTRIP(1) XYA(2)=FSTRIP(2) IF(XYA(1).EQ.0.) XYA(1)=1.0E-06 RADI=SQRT(XYA(1)**2 + XYA(2)**2) PHIA = ATAN2(XYA(2),XYA(1)) IF(PHIA.LT.0.) PHIA=PHIA+TWOPI XYM(1)=XYA(1)+DELTL*COS(PHIA+PIBY2-ALPHA) XYM(2)=XYA(2)+DELTL*SIN(PHIA+PIBY2-ALPHA) IF(XYM(1).EQ.0.) XYM(1)=1.E-06 RADM =SQRT(XYM(1)**2 + XYM(2)**2) PHIM = ATAN2(XYM(2),XYM(1)) IF(PHIM.LT.0.) PHIM=PHIM+TWOPI ANGSH = -ALPHA IF(ANGSH.LT.0.) ANGSH=ANGSH+TWOPI IF(ANGSH.GE.TWOPI) ANGSH=ANGSH-TWOPI ANGROT=(ANGSH*180./PI) WRITE(6,*) 'SVGE: I,PHIA,PHIM..',I,PHIA*180./PI, &PHIM*180./PI WRITE(6,*) 'SVGE: ANGSH,ANGROT..',ANGSH*180./PI, &ANGROT ELSE PHIA = PHIA-ANGSEC PHIM = PHIM-ANGSEC IF(PHIA.GE.TWOPI) PHIA=PHIA-TWOPI IF(PHIA.LT.0.) PHIA=PHIA+TWOPI IF(PHIM.GE.TWOPI) PHIM=PHIM-TWOPI IF(PHIM.LT.0.) PHIM=PHIM+TWOPI XYA(1) = RADI * COS(PHIA) XYA(2) = RADI * SIN(PHIA) XYM(1) = RADM * COS(PHIM) XYM(2) = RADM * SIN(PHIM) XYMA(1) = XYA(1) - XYM(1) XYMA(2) = XYA(2) - XYM(2) IF(XYMA(1).EQ.0.) XYMA(1)=1.E-06 ANGSH = ATAN2(XYMA(2),XYMA(1)) IF(ANGSH.LT.0.) ANGSH=ANGSH+TWOPI IF(ANGSH.GE.TWOPI) ANGSH=ANGSH-TWOPI ANGROT=(ANGSH*180./PI) IF(ANGROT.GE.360.) ANGROT=ANGROT-360. *** WRITE(6,*) 'SVGE: I,PHIA,PHIM..',I,PHIA*180./PI, *** &PHIM*180./PI *** WRITE(6,*) 'SVGE: ANGSH,ANGROT..',ANGSH*180./PI, *** &ANGROT ENDIF * * ROTATION PARAMETERS * PHIR(1)=ANGROT PHIR(2)=ANGROT+90. PHIH(1)=ANGROT PHIH(2)=ANGROT+90. PHIH(3)=PHIH(2) IF(PHIR(2).GE.360.) PHIR(2)=PHIR(2)-360. IF(PHIH(2).GE.360.) PHIH(2)=PHIH(2)-360. IF(PHIH(3).GE.360.) PHIH(3)=PHIH(3)-360. * * TRANSLATION PARAMETERS FOR SVTX * XYZ(1)=XYM(1) XYZ(2)=XYM(2) * * TRANSLATION PARAMETERS FOR HYBRIDS * APHI=PHIR(2)*ALPHA XYZH(1)=XYZ(1)-PARH(3)*SIN(ATETH)*COS(APHI) XYZH(2)=XYZ(2)-PARH(3)*SIN(ATETH)*SIN(APHI) * * PERFORM ROTATIOINS AND TRANSLATIONS EVENTUALLY. * CALL GSROTM(I+50,THET(1),PHIR(1),THET(2),PHIR(2),THET(3), > PHIR(3)) * CALL GSROTM(I+NMODU+50,TETH(1),PHIH(1),TETH(2),PHIH(2), > TETH(3),PHIH(3)) * CALL GSPOS('IVTX',I,'LHIS',XYZ(1),XYZ(2),XYZ(3),I+50, > 'ONLY') * CALL GSPOS('HYBR',I+NMODU,'LHIS',XYZH(1),XYZH(2),XYZH(3), > I+NMODU+50,'ONLY') * *** WRITE(6,*) 'SVGE: PHIR(1),PHIR(2)..' *** WRITE(6,*) PHIR(1),PHIR(2) *** WRITE(6,*) 'SVGE:XYZ(1),XYZ(2)..' *** WRITE(6,*) XYZ(1),XYZ(2) *** WRITE(6,*) 'SVGE: PHIH(1),PHIH(2),PHIH(3)..' *** WRITE(6,*) PHIH(1),PHIH(2),PHIH(3) *** WRITE(6,*) 'SVGE:XYZH(1),XYZH(2)..' *** WRITE(6,*) XYZH(1),XYZH(2) * 13 CONTINUE 16 CONTINUE +REP,SV,SVHITS,1-5. *CMZU: 5.04/00 28/04/95 16.48.02 by RAFIK OUARED *CMZ : 5.01/00 15/09/94 18.38.34 by RAFIK OUARED *CMZ : 4.03/00 14/06/91 16.41.40 by R.BOSSINGHAM *CMZ : 4.02/07 16/10/90 08.34.59 by Curtis A. Meyer *CMZ : 4.02/05 28/08/90 10.21.09 by Curtis A. Meyer *-- Author : Kersten +REP,SV,SVHITS,39. * Neutral particles don't interact in the PWC. +REP,SV,SVHITS,45. 10 CONTINUE +REP,SV,SVHITS,53-57. * 50 FORMAT(' VOL : ',I3,' =',A4,' ',I3) * 11 CONTINUE * **** WRITE(6,*) 'SVHITS:HIT NUMBER ',IHIT,'NUMBV ', **** &(NUMBV(J),J=1,NV) **** WRITE(6,*) 'NEXT LOOP ...' +REP,SV,SVSET,1-8. *CMZU: 5.04/00 23/04/95 13.50.18 by RAFIK OUARED *CMZ : 5.01/00 18/09/94 17.06.26 by RAFIK OUARED *CMZ : 4.05/00 11/11/91 16.00.50 by R.BOSSINGHAM * Do setup of PWC1 or PWC2 only if the corresponding chamber exists. *CMZ : 4.03/00 09/06/91 22.21.27 by R.BOSSINGHAM * V4.02/07 causes ORIG and FACT to be set to ~1.E-43: declare them REAL *CMZ : 4.02/07 16/10/90 08.34.59 by Curtis A. Meyer *CMZ : 4.02/05 28/08/90 10.21.09 by Curtis A. Meyer *-- Author : Unknown +REP,SV,SVSET,33. DATA NAMESI /'IVTX','ISTR'/ +REP,SV,SVSET,41. DATA NAMESD/'AMPL'/ +ADD,SV,SVTABL,*. &DECK,SVTABL. *CMZU: 5.04/00 30/06/95 16.57.56 by RAFIK OUARED *-- Author : R.Ouared SUBROUTINE SVTABL *. *. ****************************************************************** *. * * *. * SUBROUTINE SVTABL * *. * * *. * Generates the table for SVTX * *. * * *. * ==>Called by : SVDIGI * *. * * *. * * *. ****************************************************************** * &SEQ,GCTRAK. &SEQ,CCSETS. &SEQ,GCVOLU. CHARACTER*20 TMP1,TMP2 &SEQ,CBLINK. &SEQ,CBPWJD. &SEQ,CBSVTX. &SEQ,CBPWNO. &SEQ,CBSVNO. &SEQ,CBSVOF. * * * Zebra raw data bank size IZBSIZ * INTEGER IZBSIZ,KADD INTEGER IOFF,IOFB2 INTEGER NFORM,NSHORT,IMASK(2),NDET,NWIR,ITAIL,ITHOF INTEGER ISIGM,IALIGN INTEGER IDATI(4),IRES(26),IBADC(16),IBTHR(16) INTEGER ICRAM(32),IADCR(32) INTEGER IPED(0:2047),ITHR(0:2047) ***************************************************************************** ***************************************************************************** IOFF = ISOF(2) IOFB2=IOFF/2 NFORM=42999 !format NSHORT = 4232 !number of short words IZBSIZ=NSHORT/2 !size of RTVX bank CALL VZERO(IMASK,2) !bitmask for det readout NDET=15 !number of detectors NWIR=128 !number of strips per detector ITAIL=0 !tailcount ITHOF=0 !threshold offset ISIGM=0 !sigma factor IALIGN=0 !alignment CALL VZERO(IDATI,4) !time/date of ped data CALL VZERO(IRES,26) !reserved for later use CALL VZERO(IBADC,16) !backplane ADC pedestal data CALL VZERO(IBTHR,16) !backplane ADC threshold data CALL VZERO(ICRAM,32) !16 long words,CRAM Ident CALL VZERO(IADCR,32) !16 long words,back ADC Ident DO I=0,2047 * *** these values are momentarily chosen so that ped=2 and threshold=1 at the end.. * IPED(I)=32 !2048 short words pedestal data ITHR(I)=112 !2048 short words threshold ENDDO * CALL MZBOOK(IXRTVX,LRTVX,LLAST,0,'RTVX',0,0,IZBSIZ,1,0) LLAST = LRTVX * * STARTS FILLING UP RTVX BANK * CALL SBYT(NFORM,IQ(LRTVX+1),17,16) CALL SBYT(NSHORT,IQ(LRTVX+1),1,16) CALL SBYT(IMASK(1),IQ(LRTVX+2),17,16) CALL SBYT(IMASK(2),IQ(LRTVX+2),1,16) CALL SBYT(NDET,IQ(LRTVX+3),17,16) CALL SBYT(NSTRIP,IQ(LRTVX+3),1,16) CALL SBYT(ITAIL,IQ(LRTVX+4),17,16) CALL SBYT(ITHOF,IQ(LRTVX+4),1,16) CALL SBYT(ISIGM,IQ(LRTVX+5),17,16) CALL SBYT(IALIGN,IQ(LRTVX+5),1,16) DO I=1,2 J=2*I-1 CALL SBYT(IDATI(J),IQ(LRTVX+5+I),17,16) CALL SBYT(IDATI(J+1),IQ(LRTVX+5+I),1,16) ENDDO DO I=1,13 J=2*I-1 CALL SBYT(IRES(J),IQ(LRTVX+7+I),17,16) CALL SBYT(IRES(J+1),IQ(LRTVX+7+I),1,16) ENDDO DO I=1,8 J=2*I-1 CALL SBYT(IBADC(J),IQ(LRTVX+20+I),17,16) CALL SBYT(IBADC(J+1),IQ(LRTVX+20+I),1,16) ENDDO DO I=1,8 J=2*I-1 CALL SBYT(IBTHR(J),IQ(LRTVX+28+I),17,16) CALL SBYT(IBTHR(J+1),IQ(LRTVX+28+I),1,16) ENDDO DO I=1,16 J=2*I-1 CALL SBYT(ICRAM(J),IQ(LRTVX+36+I),17,16) CALL SBYT(ICRAM(J+1),IQ(LRTVX+36+I),1,16) ENDDO DO I=1,16 J=2*I-1 CALL SBYT(IADCR(J),IQ(LRTVX+52+I),17,16) CALL SBYT(IADCR(J+1),IQ(LRTVX+52+I),1,16) ENDDO * KADD =7+IOFF DO I=0,2047 J=I+KADD IF(2*(J/2).NE.J) THEN CALL SBYT(IPED(I),IQ(LRTVX+(J+1)/2),17,16) CALL SBYT(ITHR(I),IQ(LRTVX+(J+1)/2+1024),17,16) ELSE CALL SBYT(IPED(I),IQ(LRTVX+J/2),1,16) CALL SBYT(ITHR(I),IQ(LRTVX+J/2+1024),1,16) ENDIF ENDDO * RETURN END +REP,OBSOLETE,00_PATCH,0-1. &PATCH,OBSOLETE,IF=NEVER. *CMZ : 5.03/01 16/03/95 08.59.09 by Curtis A. Meyer +ADD,DFILES,CARDFILE,0. *CMZ : 5.03/01 16/03/95 09.20.27 by Curtis A. Meyer +REP,DFILES,CARDFILE,8-21. RNDM 14 0 PRINT 'VERT' 'KINE' DEBUG 1 10 KINE 3 1. 0.0 3. 7. 9. 8. SETV 91 0. 0. 0.0 BWID 0.1 0.1 0.1 RAWD 20 'EVHD' 'RPWC' 'RJDC' 'RBCL' 'RBCF' 'RMCB' JDCD 1 JDC 'jdc1_15.dat' LUTF 'mcfera.lut' LUT2 'mc2282.lut' END STOP STOP <===Explanation Below This Line === RUNG 1 == Run Number 1 TRIG 100 == Produce 100 Events RNDM 14 0 == Use internal random sequence 14 PRINT 'VERT' 'KINE' == Debug info is VERT and KINE banks. DEBUG 1 10 == Print out Debug info on events 1 to 10. SETV 91 0. 0. 0. == Vertex type 91 at (0,0,0) BWID 0.1 0.1 0.1 == Vertex (sig_x,sig_y,sig_z)