CDECK ID>, SGV. +PATCH,*SGVDUM. +USE,DUMMY. +USE,SGVCDE. +USE,SGVDETSIM. +USE,SGVANA. +PATCH,*SGVDEF. +USE,DEFAULT. +USE,SGVCDE. +USE,SGVEVSIM. +USE,SGVDETSIM. +USE,SGVANA. +PATCH,SGVEVSIM. +SELF,IF=NEVER. Patch SGVEVSIM : Event generator -------------------------------------------------- This patch contains the code for event generation. It is to be considered as an example, to be replaced by user-code. It uses the JETSET generator LUEEVT which generates SM Z0 decays to quarks. If this is appropriate for the needs of the user, the patch can be used as is. Entry points : ZEORD ZEORD }) (initialization) ZEUGEN ZEUGEN }) The patch does not call code in other patches. The communication to the caller is by filling the JETSET common block /LUJETS/. The patch also uses /ZXSTE/,/ZXEVT/, and/ZXSPL/ +SELF. +DECK,ZEUGEN,IF=DEFAULT. SUBROUTINE ZEUGEN(I,STEER,IERR) +SELF,IF=NEVER. SUBROUTINE ZEUGEN(I, STEER, IERR) : User GENerator -------------------------------------------------- Default user event generator routine, JETSET version. Can be used as an example. ARGUMENTS: INPUT : I : Current event number. STEER : Steering info. The event generator uses row 2: STEER(2,0) : Type of event to be generated. ,1) : CMS energy of reaction to be simulated. ,2) : Lifetime of B hadrons. ,4) : 0.0 -> use fixed primary vertex position. 1,0 -> generate primary vertex position. event by event. ,5-7) : Average production point. ,8-10): Spread in production-point. All other position of the row are free to use. IERR : error code. IMPLICIT INPUTS: in the example : From /ZXSTE/ : LUNPRC, printing unit; MAXPR, max number of events to print; NEWAMV, flag to load average mean vertex. IMPLICIT OUTPUTS: To /ZXEVT/ : XYZV, average vertex position; SIGV, vertex error; EVTYPE, type of generated event. To /LUJETS/ : event record in JETSET conventions. This routine will directly modify the production points of tracks (vector V in LUJETS). CALLED BY : ZXCEST, Create the Event STructure CALLED ROUTINE(S): ZEPVTX (To generate Primary VerTeX.) In the example : ZEEVTP (To find EVent TYpe) ZEQCNT (To do Quark CouNTing.) SIDE EFFECTS: none. AUTHORS: M. Berggren, UFRJ CREATION DATE: 05-APR-1995 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER I,IERR REAL STEER(4,0:*) REAL ECMS INTEGER FLAV,III,J +CDE,ZXSIZ. +CDE,ZXSTE. +CDE,ZXEVT. +CDE,LUJETS. * If You use an event generator that produces its result * in the format of the HEPEVT standard format, * then un-comment the following defenition of the common. * * INTEGER NMXHEP * INTEGER NEVHEP,NHEP,ISTHEP,IDHEP, * . JMOHEP,JDAHEP * REAL PHEP,VHEP * PARAMETER (NMXHEP=2000) * COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), * .JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) * +SELF,IF=OSF1. LOGICAL NEVER DATA NEVER /.FALSE./ IF (NEVER) THEN CALL LUDATA CALL PYDATA ENDIF +SELF. IF ( NEWAMV ) THEN * Need to load the average main vertex position DO III =1,3 XYZV(III) = STEER(2,4+III) SIGV(III) = STEER(2,7+III) ENDDO NEWAMV = .FALSE. ENDIF ****--- Call Your generator here !!! ----**** * * * * FLAV = INT(STEER(2,0)) ECMS = STEER(2,1) CALL LUEEVT(FLAV,ECMS) * If You use an event generator that produces its result * in the format of the HEPEVT standard format, * then un-comment the following! It will do the conversion * of the event into LUJETS for You. * * CALL LUHEPC(2) * Find event type : this routine finds the primary flavour in the * event generated by LUEEVT. Possibly You want somthing else. * In any case, the variable EVTYPE is not used by SGV, it's * there for user convienience. It will be copied to the * variable with the same name in the common-block ZAEVT in * the analysis part of SGV. CALL ZEEVTP(EVTYPE) * Quark counting. Same comment. * The varibales calculated are NHARD,NCQRK,NBQRK and NQRK. They * will be copied to variables with the same names in the * common-block ZAEVT in the analysis part of SGV. CALL ZEQCNT(LUNPRC,I,MAXPR) * * * * ****--- End of generator specifc part !!! ----**** * Generate primary vertex position, and translate the * event accordingly. If high-precission position * measurements (eg. with a micro-vertex detector) is not * part of Your experiment, this call can be skipped. IF ( STEER(2,4) .EQ. 1.0 ) THEN CALL ZEPVTX(XYZV,SIGV,XYZS) ELSE CALL UCOPY(XYZV,XYZS,3) ENDIF DO J = 1,NLUND V(J,1) = V(J,1) + 10.0*XYZS(1) V(J,2) = V(J,2) + 10.0*XYZS(2) V(J,3) = V(J,3) + 10.0*XYZS(3) ENDDO END +SELF. +DECK,ZEUGEN,IF=PYTHIA. SUBROUTINE ZEUGEN(I,STEER,IERR) +SELF,IF=NEVER. SUBROUTINE ZEUGEN(I, STEER, IERR) : User GENerator -------------------------------------------------- User event generator routine, PYTHIA version. ARGUMENTS: INPUT : I : Current event number. STEER : Steering info. The event generator uses row 2: STEER(2,0) : Type of event to be generated. ,1) : CMS energy of reaction to be simulated. ,2) : Lifetime of B hadrons. ,4) : 0.0 -> use fixed primary vertex position. 1,0 -> generate primary vertex position. event by event. ,5-7) : Average production point. ,8-10): Spread in production-point. All other position of the row are free to use. IERR : error code. IMPLICIT INPUTS: From /ZXSTE/ : LUNPRC, printing unit; MAXPR, max number of events to print; NEWAMV, flag to load average mean vertex. IMPLICIT OUTPUTS: To /ZXEVT/ : XYZV, average vertex position; SIGV, vertex error; EVTYPE, type of generated event. To /LUJETS/ : event record in JETSET conventions. This routine will directly modify the production points of tracks (vector V in LUJETS), and the history code (vector K in LUJETS). CALLED BY : ZXCEST, Create the Event STructure CALLED ROUTINE(S): ZEPVTX (To generate Primary VerTeX.) LULIST (JETSET routine.) PYTEVT (PYTHIA routine.) UCOPY (CERNLIB routine.) SIDE EFFECTS: none. AUTHORS: M. Berggren, IPN Lyon CREATION DATE: 20-JAN-1998 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER I,IERR REAL STEER(4,0:*) INTEGER III,J,JJJ +CDE,ZXSIZ. +CDE,ZXSTE. +CDE,ZXEVT. +CDE,LUJETS. +SELF,IF=OSF1. LOGICAL NEVER DATA NEVER /.FALSE./ IF (NEVER) THEN CALL LUDATA CALL PYDATA ENDIF +SELF. IF ( NEWAMV ) THEN * Need to load the average main vertex position DO III =1,3 XYZV(III) = STEER(2,4+III) SIGV(III) = STEER(2,7+III) ENDDO NEWAMV = .FALSE. ENDIF * Call PYTHIA to generate event CALL PYEVNT * Reorder history code: in eg. ${\rm e}^{+}{\rm e}^{-}$->W+W-->munu munu * will first enter the W:s as documentation lines (K(*,1) = 21), * then as decayed particles (K(*,1) = 11). The ancestor of the * mu and nu (K(*,2)) will be the FIRST occurence of the W in * the event record (the documentation line), but this line * will not have the mu and nu as daugthers (K(*,3) and K(*,4)), * but the second occurence of the W. This W will, in turn, have * the mu and nu as daughters. The code bellow changes this state of * affairs : * The W lines (documentation and decayed particle) are not changed, * but the ancestor of the mu and nu is changed to the second * occurence of the W. DO III = 1, NLUND IF ( K(III,1) .LT. 20 ) THEN * ... not a documentation line IF ( K(III,4) .NE. 0 ) THEN * ... the line as daughters IF ( K(K(III,4),3) .NE. III ) THEN * ... the daughter has not the current line as * parent -> change for all the daughters. * DO JJJ=K(III,4),K(III,5) K(JJJ,3) = III ENDDO ENDIF ENDIF ENDIF ENDDO IF ( I .LE. INT(STEER(1,3)) ) THEN * List event CALL LULIST(3) ENDIF * Generate primary vertex position, and translate the * event accordingly. If high-precission position * measurements (eg. with a micro-vertex detector) is not * part of Your experiment, this call can be skipped. IF ( STEER(2,4) .EQ. 1.0 ) THEN CALL ZEPVTX(XYZV,SIGV,XYZS) ELSE CALL UCOPY(XYZV,XYZS,3) ENDIF DO J = 1,NLUND V(J,1) = V(J,1) + 10.0*XYZS(1) V(J,2) = V(J,2) + 10.0*XYZS(2) V(J,3) = V(J,3) + 10.0*XYZS(3) ENDDO END +DECK,ZEUGEN,IF=SUSYGEN. SUBROUTINE ZEUGEN(I,STEER,IERR) +SELF,IF=NEVER. SUBROUTINE ZEUGEN(I, STEER, IERR) : User GENerator -------------------------------------------------- User event generator routine, SUSYGEN version. ARGUMENTS: INPUT : I : Current event number. STEER : Steering info. The event generator uses row 2: STEER(2,0) : Type of event to be generated. ,1) : CMS energy of reaction to be simulated. ,2) : Lifetime of B hadrons. ,4) : 0.0 -> use fixed primary vertex position. 1,0 -> generate primary vertex position. event by event. ,5-7) : Average production point. ,8-10): Spread in production-point. All other position of the row are free to use. IERR : error code. IMPLICIT INPUTS: From /ZXSTE/ : LUNPRC, printing unit; MAXPR, max number of events to print; NEWAMV, flag to load average mean vertex. SUSYGEN commons : From /STR/ : SCAN, flag for SUSY parameter scan. From /SCAN/ : RVS1,RVS2,RVS3 and RVS4, list of points to scan; ISCAN, number of points in each scan-direction. From /CONST/ : IRAD, flag for ISR generation. From /DECSEL/ : IPROCSEL, list of processes. From /STEER/ : GMAUM,GMAUR,GM0,GTANB, the current working point in the SUSY parameter plane. IMPLICIT OUTPUTS: To /ZXEVT/ : XYZV, average vertex position; SIGV, vertex error; EVTYPE, type of generated event. To /LUJETS/ : event record in JETSET conventions. This routine will directly modify the production points of tracks (vector V in LUJETS), and the history code (vector K in LUJETS). SUSYGEN commons : To /STEER/ : GMAUM,GMAUR,GM0,GTANB, the current working point in the SUSY parameter plane. CALLED BY : ZXCEST, Create the Event STructure CALLED ROUTINE(S): ZURECT (To get a RECTangular random-number) ZEPVTX (To generate Primary VerTeX.) HCDIR (CERNLIB HBOOK routine.) SUSINI,PROCINIT,SUSISR,SUSEVE (SUSYGEN routines.) LULIST (JETSET routine.) UCOPY (CERNLIB routine.) SIDE EFFECTS: none. AUTHORS: M. Berggren, IPN Lyon CREATION DATE: 20-JAN-1998 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER I,IERR REAL STEER(4,0:*) REAL AAA INTEGER III,J,IM,IMU,IM0,ITA,IFAIL,NFAIL,JEVCUM,PROCPT, . JEVPROC,KPROC,N_IN_PNT,NXI,NPROC_TRIED DATA IM,IMU,IM0,ITA /1,1,1,0/ INTEGER IPROCUR COMMON/CURPR/IPROCUR +CDE,ZXSIZ. +CDE,ZXSTE. +CDE,ZXEVT. +CDE,LUJETS. * SUSYGEN cde:s +CDE,STR. +CDE,SCAN. +CDE,CONST. +CDE,KINEM. +CDE,STEER. +CDE,DECSEL. REAL ZURECT +SELF,IF=OSF1. LOGICAL NEVER DATA NEVER /.FALSE./ IF (NEVER) THEN CALL LUDATA CALL PYDATA ENDIF +SELF. IF ( NEWAMV ) THEN * Need to load the average main vertex position DO III =1,3 XYZV(III) = STEER(2,4+III) SIGV(III) = STEER(2,7+III) ENDDO NEWAMV = .FALSE. ENDIF * If SUSYGEN is run in the mode to scan the SUSY parameter * space, find out if one should change point in the space * at the current event IF ( SCAN ) THEN N_IN_PNT = MAXEV/(ISCAN(1)*ISCAN(2)*ISCAN(3)*ISCAN(4)) IF ( MOD (I-1,N_IN_PNT) .EQ. 0 ) THEN * ... go to a new point, if any left .... IF (IM .LT. ISCAN(1) .OR. . IMU .LT. ISCAN(2) .OR. . IM0 .LT. ISCAN(3) .OR. . ITA .LT. ISCAN(4) ) THEN * ... Yes, there are points left. * Find out which to change: * tan beta: ITA = ITA + 1 IF (ITA .GT. ISCAN(4) ) THEN * new tan beta point out-of-range, * change M_0 point instead: IM0 = IM0 + 1 ITA = 1 ENDIF IF (IM0 .GT. ISCAN(3) ) THEN * new M_0 point out-of-range, * change mu point instead: IMU = IMU + 1 IM0 = 1 ENDIF IF (IMU .GT. ISCAN(2) ) THEN * new mu point out-of-range, * change M point instead: IM = IM + 1 IMU = 1 ENDIF * Set SUSY paramters in this new point: GMAUM = RVS1(IM) GMAUR = RVS2(IMU) GM0 = RVS3(IM0) GTANB = RVS4(ITA) IF ( GMAUM .EQ. 0. ) THEN GMAUM = 0.05 ENDIF IF ( GMAUR .EQ. 0. ) THEN GMAUR = 0.05 ENDIF IF ( GTANB .EQ. 1. ) THEN GTANB = 1.01 ENDIF PRINT *,'**************************' PRINT *,IM,IMU,IM0,ITA * Goto the SUSYGEN subdirectory CALL HCDIR('//PAWC',' ') CALL HCDIR('SUSYGEN',' ') * Re-initialize with the new parameter values. CALL SUSINI(IFAIL) CALL HCDIR('//PAWC',' ') IF ( IFAIL .EQ. 1 ) THEN IERR = 1 GOTO 99 ENDIF ELSE * Done all points. Stop this run. IERR = -2 GOTO 99 ENDIF ENDIF ENDIF * Choose process at random from those requested by the * user. DO NPROC_TRIED = 1, 100 AAA = ZURECT(I)*1000000 JEVCUM = 0 DO PROCPT = 2 , IPROCSEL(1) + 1 * How many events does this process contribute to a * total of 1 000 000 ? CALL PROCINIT(-1,IPROCSEL(PROCPT),JEVPROC) * aha, thanks. JEVCUM = JEVCUM+JEVPROC IF ( JEVCUM .GT. AAA ) THEN * OK, I'll take this one. KPROC = IPROCSEL(PROCPT) GOTO 20 ENDIF ENDDO KPROC = IPROCSEL(IPROCSEL(1)+1) 20 CONTINUE * Generate ISR if requested IF ( IRAD .EQ. 1 ) THEN CALL SUSISR(KPROC) ENDIF DO NFAIL = 1, 100 * Goto the SUSYGEN subdirectory CALL HCDIR('//PAWC',' ') CALL HCDIR('SUSYGEN',' ') * Generate the event CALL SUSEVE(IFAIL) CALL HCDIR('//PAWC',' ') NXI = 0 DO III=1,NLUND IF ( IABS(K(III,2)) .GE. 71 .AND. . IABS(K(III,2)) .LE. 76 ) THEN * change the history code for any stable * susy particle to "documentation", to avoid * that its detector responce (which is unknown, most * likely none) is generated by SGV. K(III,1) = 21 IF ( IABS(K(III,2)) .GT. 71 ) THEN * count number of inos in the event, to determine * if there has been a cascade or not. NXI = NXI + 1 ENDIF ENDIF ENDDO *******!!!!!!!!****** * switch this on to get only direct decays, not cascades. * IF ( NXI .NE. 0 ) THEN * IFAIL = 1 * ENDIF *******!!!!!!!!****** * Check is event OK IF ( IFAIL .EQ. 0 ) THEN * Yes ! GOTO 33 ENDIF ENDDO * Too many failures ... WRITE(LUNPRC,*) ' warning nfail = ',NFAIL,' event = ',I WRITE(LUNPRC,*) ' ******** Process skipped ******** ',KPROC WRITE(LUNPRC,*) ' Point ********* ',GMAUM,GMAUR,GM0,GTANB ENDDO PRINT *, ' Too many failures in point ',GMAUM,GMAUR,GM0,GTANB PRINT *, ' Run stopped ' IERR = -2 GOTO 99 33 CONTINUE IF ( I .LE. INT(STEER(1,3)) ) THEN * List event CALL LULIST(3) ENDIF * Generate primary vertex position, and translate the * event accordingly. If high-precission position * measurements (eg. with a micro-vertex detector) is not * part of Your experiment, this call can be skipped. IF ( STEER(2,4) .EQ. 1.0 ) THEN CALL ZEPVTX(XYZV,SIGV,XYZS) ELSE CALL UCOPY(XYZV,XYZS,3) ENDIF DO J = 1,NLUND V(J,1) = V(J,1) + 10.0*XYZS(1) V(J,2) = V(J,2) + 10.0*XYZS(2) V(J,3) = V(J,3) + 10.0*XYZS(3) ENDDO 99 CONTINUE END +DECK,ZEUGEN,IF=EXTREAD. SUBROUTINE ZEUGEN(I,STEER,IERR) +SELF,IF=NEVER. SUBROUTINE ZEUGEN(I, STEER, IERR) : User GENerator -------------------------------------------------- User event generator routine, External read version. The routine reads the contents of the LUJETS common block from the external file unit=STEER(2,11). It will return IERR=-2 (=> stop run) when the end of the file is found. The file should have been written by doing : WRITE (LUNIT) + N,((K(I,J),J=1,5),(P(I,J),J=1,5),(V(I,J),J=1,5),I=1,N) for each generated event. Note that the read/write is un-formatted => don't try to write under one system, read under another ! ARGUMENTS: INPUT : I : Current event number. STEER : Steering info. The event generator uses row 2: STEER(2,0) : Type of event to be generated. ,1) : CMS energy of reaction to be simulated. ,2) : Lifetime of B hadrons. ,4) : 0.0 -> use fixed primary vertex position. 1,0 -> generate primary vertex position. event by event. ,5-7) : Average production point. ,8-10): Spread in production-point. ,11) : Unit to read LUJETS from All other position of the row are free to use. IERR : error code. IMPLICIT INPUTS: From unit STEER(2,11) : the LUJETS contents. From /ZXSTE/ : LUNPRC, printing unit; MAXPR, max number of events to print; NEWAMV, flag to load average mean vertex. IMPLICIT OUTPUTS: To /ZXEVT/ : XYZV, average vertex position; SIGV, vertex error; EVTYPE, type of generated event. To /LUJETS/ : event record in JETSET conventions. This routine will directly modify the production points of tracks (vector V in LUJETS), and the history code (vector K in LUJETS). CALLED BY : ZXCEST, Create the Event STructure CALLED ROUTINE(S): LULIST (JETSET routine.) ZEPVTX (To generate Primary VerTeX.) UCOPY (CERNLIB routine.) SIDE EFFECTS: none. AUTHORS: M. Berggren, IPN Lyon CREATION DATE: 17-FEB-1998 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER I,IERR REAL STEER(4,0:*) INTEGER III,JJJ,KKK +CDE,ZXSIZ. +CDE,ZXSTE. +CDE,ZXEVT. +CDE,LUJETS. +SELF,IF=OSF1. LOGICAL NEVER DATA NEVER /.FALSE./ IF (NEVER) THEN CALL LUDATA CALL PYDATA ENDIF +SELF. IF ( NEWAMV ) THEN * Need to load the average main vertex position DO III =1,3 XYZV(III) = STEER(2,4+III) SIGV(III) = STEER(2,7+III) ENDDO NEWAMV = .FALSE. ENDIF READ (INT(STEER(2,11)), END=100, ERR=70) . NLUND, ((K(III,JJJ),JJJ=1,5), . (P(III,JJJ),JJJ=1,5), . (V(III,JJJ),JJJ=1,5), III=1,NLUND) IF ( I .LE. INT(STEER(1,3)) ) THEN * List event CALL LULIST(3) ENDIF * Generate primary vertex position, and translate the * event accordingly. If high-precission position * measurements (eg. with a micro-vertex detector) is not * part of Your experiment, this call can be skipped. IF ( STEER(2,4) .EQ. 1.0 ) THEN CALL ZEPVTX(XYZV,SIGV,XYZS) ELSE CALL UCOPY(XYZV,XYZS,3) ENDIF DO JJJ = 1,NLUND V(JJJ,1) = V(JJJ,1) + 10.0*XYZS(1) V(JJJ,2) = V(JJJ,2) + 10.0*XYZS(2) V(JJJ,3) = V(JJJ,3) + 10.0*XYZS(3) ENDDO RETURN 70 CONTINUE IERR = 1 RETURN 100 CONTINUE IERR = -2 END +DECK,ZEORD,IF=DEFAULT. SUBROUTINE ZEORD(MODE,STEER) +SELF,IF=NEVER. SUBROUTINE ZEORD(MODE, STEER) : Event generator ORDers -------------------------------------------------- Default routine to define and read user steerings for the event generator, JETSET version. Can be used as an example. If MODE = 0, then the routine defines keys for FFREAD, if it is $\neq$ 0 then the routine reacts on the values read be FFREAD. So, the calling routine must do something like CALL ZEORD(0,STEER) . . (other key definitions) . . . CALL FFGO CALL ZEORD(1,STEER) . This is what ZXRUIN does. Note that the variables read in by FFREAD must be in a common, even if SGV uses them only in this routine ! ARGUMENTS: INPUT : MODE : 0 -> routine should define key-words, and default values. <> 0 -> load values of keys read from the steering file to the right common-blocks, do initialization etc. OUTPUT : STEER : Steering info. The event generator uses row 2: STEER(2,0) : Type of event to be generated. ,1) : CMS energy of reaction to be simulated. ,2) : Lifetime of B hadrons. ,4) : 0.0 -> use fixed primary vertex position. 1,0 -> generate primary vertex position. event by event. ,5-7) : Average production point. ,8-10): Spread in production-point. In addition STEER(1,0) is an error flag: 0 : no error 1 : error, but go on -2 : error, stop this run All other position of the row are free to use. IMPLICIT INPUTS: From /ESIVAR/ : local variables used for clarity IMPLICIT OUTPUTS: To /ESIVAR/ : local variables used for clarity, after their values have been set by FFREAD. In the example : To /LUDAT1/, /LUDAT2/, /PYPARS/, /PYSUBS/ : JETSET and PYTHIA steerings. CALLED BY : ZXRUIN, RUn INitialization CALLED ROUTINE(S): VZERO (CERNLIB routine.) FFKEY (CERNLIB FFREAD routine.) SIDE EFFECTS: none. AUTHORS: M. Berggren, UFRJ CREATION DATE: 05-APR-1995 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER MODE REAL STEER(4,0:*) +CDE,LUDAT1. +CDE,LUDAT2. +CDE,PYPARS. +CDE,PYSUBS. REAL CTAU INTEGER I * You need this common for local variables, since the * values are not read here but by FFREAD. So, any new * local variable You define should be put into the common. INTEGER FLAVOU,METHOD REAL B_LIFE,CMSENE,XYZV(3),SIGV(3) LOGICAL GENVTX COMMON /ESIVAR/ . FLAVOU,B_LIFE,CMSENE,METHOD,XYZV,SIGV,GENVTX IF ( MODE .EQ. 0 ) THEN * Define cards. * Follow the example to include Your own steering * key-words, or refer to the FFREAD long writeup. FLAVOU = 0 CALL FFKEY( 'FLAVOURS',FLAVOU ,1,'INTEGER') B_LIFE = 1.6 CALL FFKEY( 'B_LIFE',B_LIFE ,1,'REAL') CMSENE = 92.0 CALL FFKEY( 'CMS_ENE',CMSENE ,1,'REAL') METHOD = 5 CALL FFKEY( 'METHOD',METHOD ,1,'INTEGER') * JETSET steering CALL FFKEY('MSTU',MSTU,200,'INTEGER') CALL FFKEY('MSTJ',MSTJ,200,'INTEGER') CALL FFKEY('PARU',PARU,200,'REAL') CALL FFKEY('PARJ',PARJ,200,'REAL') * PYTHIA steering CALL FFKEY('MSTP',MSTP,200,'INTEGER') CALL FFKEY('MSTI',MSTI,200,'INTEGER') CALL FFKEY('PARP',PARP,200,'REAL') CALL FFKEY('PARI',PARI,200,'REAL') CALL FFKEY('MSEL',MSEL,1,'INTEGER') CALL FFKEY('MSUB',MSUB,200,'INTEGER') CALL FFKEY('KFIN',KFIN,162,'REAL') CALL FFKEY('CKIN',CKIN,200,'REAL') CALL VZERO(XYZV,3) CALL FFKEY( 'MEAN_VERTEX',XYZV ,3,'REAL') SIGV(1) = 0.015 SIGV(2) = 0.0010 SIGV(3) = 1.000 CALL FFKEY( 'VERTEX_SPREAD',SIGV,3,'REAL') GENVTX = .FALSE. CALL FFKEY( 'PRIMARY_VERTEX_SIM',GENVTX,1,'LOGICAL') ELSE * FFGO has now been called, so that the values on the * steering file has been loaded into the commons. Now, * transfere the values to the right places ! STEER(2,0) = INT(FLAVOU) STEER(2,1) = CMSENE STEER(2,2) = B_LIFE MSTJ(101) = METHOD MSTJ(107) = 1 IF ( GENVTX) THEN STEER(2,4) = 1.0 ELSE STEER(2,4) = 0.0 ENDIF DO I =1,3 STEER(2,4+I) = XYZV(I) STEER(2,7+I) = SIGV(I) ENDDO IF (( STEER(2,0) .EQ. 5 ) .OR. ( STEER(2,0) .EQ. 0 )) THEN IF ( STEER(2,2) .NE. 0.0 ) THEN * Change B-lifetime -> ctau = b_life*c (time in ps, * distance in mm) CTAU = B_LIFE*0.299792 PMAS(107,4) = CTAU PMAS(108,4) = CTAU PMAS(109,4) = CTAU PMAS(322,4) = CTAU PMAS(324,4) = CTAU PMAS(325,4) = CTAU PMAS(356,4) = CTAU ENDIF ENDIF ENDIF END +DECK,ZEORD,IF=PYTHIA. SUBROUTINE ZEORD(MODE,STEER) +SELF,IF=NEVER. SUBROUTINE ZEORD(MODE, STEER) : Event generator ORDers. -------------------------------------------------- Routine to define and read user steerings for the event generator, PYTHIA version. If MODE = 0, then the routine defines keys for FFREAD, if it is $\neq$ 0 then the routine reacts on the values read be FFREAD. So, the calling routine must do something like CALL ZEORD(0,STEER) . . (other key definitions) . . . CALL FFGO CALL ZEORD(1,STEER) . This is what ZXRUIN does. Note that the variables read in by FFREAD must be in a common, even if SGV uses them only in this routine ! ARGUMENTS: INPUT : MODE : 0 -> routine should define key-words, and default values. <> 0 -> load values of keys read from the steering file to the right common-blocks, do initialization etc. OUTPUT : STEER : Steering info. The event generator uses row 2: STEER(2,0) : Type of event to be generated. ,1) : CMS energy of reaction to be simulated. ,2) : Lifetime of B hadrons. ,4) : 0.0 -> use fixed primary vertex position. 1,0 -> generate primary vertex position. event by event. ,5-7) : Average production point. ,8-10): Spread in production-point. In addition STEER(1,0) is an error flag: 0 : no error 1 : error, but go on -2 : error, stop this run All other position of the row are free to use. IMPLICIT INPUTS: From /ESIVAR/ : local variables used for clarity IMPLICIT OUTPUTS: To /ESIVAR/ : local variables used for clarity, after their values have been set by FFREAD. To /LUDAT1/, /LUDAT2/, /LUDAT3/, /PYPARS/, /PYSUBS/ : JETSET and PYTHIA steerings. CALLED BY : ZXRUIN, RUn INitialization CALLED ROUTINE(S): PYINIT (PYTHIA routine.) VZERO,LENOCC,CLEFT,CLTOU (CERNLIB routines.) FFKEY,FFGO (CERNLIB FFREAD routines.) SIDE EFFECTS: none. AUTHORS: M. Berggren, IPNL CREATION DATE: 20-JAN-1998 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER MODE REAL STEER(4,0:*) +CDE,LUDAT1. +CDE,LUDAT2. +CDE,LUDAT3. +CDE,PYPARS. +CDE,PYSUBS. INTEGER III CHARACTER*80 LINE * You need this common for local variables, since the * values are not read here but by FFREAD. So, any new * local variable You define should be put into the common. REAL XYZV(3),SIGV(3),CMSENE LOGICAL GENVTX COMMON /ESIVAR/ . XYZV,SIGV,GENVTX,CMSENE INTEGER LENOCC IF ( MODE .EQ. 0 ) THEN * Define cards. * Follow the example to include Your own steering * key-words, or refer to the FFREAD long writeup. CMSENE = 92.0 CALL FFKEY( 'CMS_ENE',CMSENE ,1,'REAL') * JETSET steering CALL FFKEY('MSTU',MSTU,200,'INTEGER') CALL FFKEY('MSTJ',MSTJ,200,'INTEGER') CALL FFKEY('PARU',PARU,200,'REAL') CALL FFKEY('PARJ',PARJ,200,'REAL') CALL FFKEY('PMAS',PMAS,500*4,'REAL') CALL FFKEY('MDME',MDME,2000*2,'INTEGER') * PYTHIA steering CALL FFKEY('MSTP',MSTP,200,'INTEGER') CALL FFKEY('MSTI',MSTI,200,'INTEGER') CALL FFKEY('PARP',PARP,200,'REAL') CALL FFKEY('PARI',PARI,200,'REAL') MSEL = 0 CALL FFKEY('MSEL',MSEL,1,'INTEGER') CALL VZERO(MSUB,200) CALL FFKEY('MSUB',MSUB,200,'INTEGER') CALL FFKEY('KFIN',KFIN,162,'REAL') CALL FFKEY('CKIN',CKIN,200,'REAL') CALL VZERO(XYZV,3) CALL FFKEY( 'MEAN_VERTEX',XYZV ,3,'REAL') SIGV(1) = 0.015 SIGV(2) = 0.0010 SIGV(3) = 1.000 CALL FFKEY( 'VERTEX_SPREAD',SIGV,3,'REAL') GENVTX = .FALSE. CALL FFKEY( 'PRIMARY_VERTEX_SIM',GENVTX,1,'LOGICAL') ELSE * FFGO has now been called, so that the values on the * steering file has been loaded into the commons. Now, * transfere the values to the right places ! STEER(2,1) = CMSENE IF ( GENVTX) THEN STEER(2,4) = 1.0 ELSE STEER(2,4) = 0.0 ENDIF DO III =1,3 STEER(2,4+III) = XYZV(III) STEER(2,7+III) = SIGV(III) ENDDO MSEL = 0 CALL PYINIT ('CMS','e-','e+',CMSENE) * Re-do reading of title cards, since the pythia initialization * might have modifies parameters. It is up to the user to * make sure that the parameter values she specifies are * internaly consistent, or at least doesn't crash the * program REWIND 17 * skip LIST, since it was aleady done at the previous * call to FFGO 10 READ (17,'(A)',END=11) LINE CALL CLEFT(LINE,1,LENOCC(LINE)) CALL CLTOU(LINE) IF ( LINE(1:LENOCC(LINE)) .EQ. 'LIST' ) THEN GOTO 12 ELSE GOTO 10 ENDIF 11 REWIND 17 12 CALL FFGO ENDIF END +DECK,ZEORD,IF=SUSYGEN. SUBROUTINE ZEORD(MODE,STEER) +SELF,IF=NEVER. SUBROUTINE ZEORD(MODE, STEER) : Event generator ORDers. -------------------------------------------------- Routine to define and read user steerings for the event generator, SUSYGEN version. If MODE = 0, then the routine defines keys for FFREAD, if it is $\neq$ 0 then the routine reacts on the values read be FFREAD. So, the calling routine must do something like CALL ZEORD(0,STEER) . . (other key definitions) . . . CALL FFGO CALL ZEORD(1,STEER) . This is what ZXRUIN does. Note that the variables read in by FFREAD must be in a common, even if SGV uses them only in this routine ! ARGUMENTS: INPUT : MODE : 0 -> routine should define key-words, and default values. <> 0 -> load values of keys read from the steering file to the right common-blocks, do initialization etc. OUTPUT : STEER : Steering info. The event generator uses row 2: STEER(2,0) : Type of event to be generated. ,1) : CMS energy of reaction to be simulated. ,2) : Lifetime of B hadrons. ,4) : 0.0 -> use fixed primary vertex position. 1,0 -> generate primary vertex position. event by event. ,5-7) : Average production point. ,8-10): Spread in production-point. In addition STEER(1,0) is an error flag: 0 : no error 1 : error, but go on -2 : error, stop this run All other position of the row are free to use. IMPLICIT INPUTS: From /ESIVAR/ : local variables used for clarity From /STR/ : SCAN, flag for SUSY parameter scan. From /STEER/ : GMAUM,GMAUR,GM0,GTANB, the current working point in the SUSY parameter plane. IMPLICIT OUTPUTS: To /ESIVAR/ : local variables used for clarity, after their values have been set by FFREAD. To /LUDAT1/, /LUDAT2/, /LUDAT3/, /PYPARS/, /PYSUBS/ : JETSET and PYTHIA steerings. SUSYGEN commons: To /SCAN/ : RVS1,RVS2,RVS3 and RVS4, list of points to scan; ISCAN, number of points in each scan-direction. To /KINEM/ : ECM, CMS energy; s, ECM^2, FLUM, number of events to normalize to in SUSYGEN. (Other SUSYGEN commons set in SCARDS) CALLED BY : ZXRUIN, RUn INitialization CALLED ROUTINE(S): SCARDS,NTUPLE\_INIT,SUPART,SUSINI (SUSYGEN routines.) VZERO (CERNLIB routines.) FFKEY (CERNLIB FFREAD routine.) HCDIR,HMDIR,HROUT (CERNLIB HBOOK routines.) SIDE EFFECTS: none. AUTHORS: M. Berggren, IPNL CREATION DATE: 20-JAN-1998 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER MODE REAL STEER(4,0:*) +CDE,LUDAT1. +CDE,LUDAT2. +CDE,PYPARS. +CDE,PYSUBS. * SUSYGEN cdes. +CDE,STR. +CDE,SCAN. +CDE,STEER. +CDE,KINEM. +CDE,INDEXX. INTEGER III,IM,IMU,IM0,ITA,MFAIL,ICYC,IFAIL * You need this common for local variables, since the * values are not read here but by FFREAD. So, any new * local variable You define should be put into the common. REAL XYZV(3),SIGV(3),CMSENE LOGICAL GENVTX COMMON /ESIVAR/ . GENVTX,XYZV,SIGV,CMSENE IF ( MODE .EQ. 0 ) THEN * Define cards. * Follow the example to include Your own steering * key-words, or refer to the FFREAD long writeup. CMSENE = 92.0 CALL FFKEY( 'CMS_ENE',CMSENE ,1,'REAL') * JETSET steering CALL FFKEY('MSTU',MSTU,200,'INTEGER') CALL FFKEY('MSTJ',MSTJ,200,'INTEGER') CALL FFKEY('PARU',PARU,200,'REAL') CALL FFKEY('PARJ',PARJ,200,'REAL') * PYTHIA steering CALL FFKEY('MSTP',MSTP,200,'INTEGER') CALL FFKEY('MSTI',MSTI,200,'INTEGER') CALL FFKEY('PARP',PARP,200,'REAL') CALL FFKEY('PARI',PARI,200,'REAL') CALL FFKEY('MSEL',MSEL,1,'INTEGER') CALL FFKEY('MSUB',MSUB,200,'INTEGER') CALL FFKEY('KFIN',KFIN,162,'REAL') CALL FFKEY('CKIN',CKIN,200,'REAL') CALL VZERO(XYZV,3) CALL FFKEY( 'MEAN_VERTEX',XYZV ,3,'REAL') SIGV(1) = 0.015 SIGV(2) = 0.0010 SIGV(3) = 1.000 CALL FFKEY( 'VERTEX_SPREAD',SIGV,3,'REAL') GENVTX = .FALSE. CALL FFKEY( 'PRIMARY_VERTEX_SIM',GENVTX,1,'LOGICAL') * Define the SUSYGEN keys: CALL SCARDS(MODE) ELSE * FFGO has now been called, so that the values on the * steering file has been loaded into the commons. Now, * transfere the values to the right places ! IF ( GENVTX) THEN STEER(2,4) = 1.0 ELSE STEER(2,4) = 0.0 ENDIF DO III =1,3 STEER(2,4+III) = XYZV(III) STEER(2,7+III) = SIGV(III) ENDDO * Let SUSYGEN react on the values read CALL SCARDS(MODE) STEER(2,1) = CMSENE ECM = DBLE(CMSENE) S=ECM**2 * Create the SUSYGEN hbook directory: * Make the generator ntuple directory in memory CALL HCDIR('//PAWC',' ') CALL HMDIR('SUSYGEN','S') CALL HMDIR('*',' ') * Create the directory on disk CALL HCDIR('//NTUP',' ') CALL HMDIR('SUSYGEN','S') CALL HMDIR('*',' ') * Book ntuple CALL NTUPLE_INIT * Copy ntuple memory->disk CALL HROUT(0,ICYC,' ') * Set SUSY particle names, codes, etc. CALL SUPART * Go to the SUSYGEN directory CALL HCDIR('//PAWC',' ') CALL HCDIR('SUSYGEN',' ') * Initialize CALL SUSINI(IFAIL) CALL HCDIR('//PAWC',' ') IF ( INDEX .GE. 10 ) THEN PRINT * , ' Requested process (',INDEX,') is better' PRINT * , ' simulated using PYTHIA directly (See ' PRINT * , ' SGV_INFO.TXT, chapter 3.1.2). Run stopped.' STEER(1,0) = -2.0 RETURN ENDIF IF ( .NOT. SCAN ) THEN * No scanning of SUSY parameters requested-> * Set the parameters managing the scan accordingly. ISCAN(1)=1 ISCAN(2)=1 ISCAN(3)=1 ISCAN(4)=1 RVS1(1)=GMAUM RVS2(1)=GMAUR RVS3(1)=GM0 RVS4(1)=GTANB ENDIF * Number of events to generate, as far as SUSYGEN * knows (the actual number is the one on the SGV * card NEVENTS. SUSYGEN needs this number for certain * normalizations). FLUM=1000000.0D0 OPEN(1,STATUS='UNKNOWN',FORM='FORMATTED') ENDIF END +DECK,ZEORD,IF=EXTREAD. SUBROUTINE ZEORD(MODE,STEER) +SELF,IF=NEVER. SUBROUTINE ZEORD(MODE, STEER) : Event generator ORDers. -------------------------------------------------- Routine to define and read user steerings for the event generator, external read version. If MODE = 0, then the routine defines keys for FFREAD, if it is $\neq$ 0 then the routine reacts on the values read be FFREAD. So, the calling routine must do something like CALL ZEORD(0,STEER) . . (other key definitions) . . . CALL FFGO CALL ZEORD(1,STEER) . This is what ZXRUIN does. Note that the variables read in by FFREAD must be in a common, even if SGV uses them only in this routine ! ARGUMENTS: INPUT : MODE : 0 -> routine should define key-words, and default values. <> 0 -> load values of keys read from the steering file to the right common-blocks, do initialization etc. OUTPUT : STEER : Steering info. The event generator uses row 2: STEER(2,0) : Type of event to be generated. ,1) : CMS energy of reaction to be simulated. ,2) : Lifetime of B hadrons. ,4) : 0.0 -> use fixed primary vertex position. 1,0 -> generate primary vertex position. event by event. ,5-7) : Average production point. ,8-10): Spread in production-point. ,11) : Unit to read LUJETS from In addition STEER(1,0) is an error flag: 0 : no error 1 : error, but go on -2 : error, stop this run All other position of the row are free to use. IMPLICIT INPUTS: From /ESIVAR/ : local variables used for clarity IMPLICIT OUTPUTS: To /ESIVAR/ : local variables used for clarity, after their values have been set by FFREAD. CALLED BY : ZXRUIN, RUn INitialization CALLED ROUTINE(S): VZERO (CERNLIB routines.) FFKEY (CERNLIB FFREAD routines.) SIDE EFFECTS: none. AUTHORS: M. Berggren, IPNL CREATION DATE: 17-FEB-1998 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER MODE REAL STEER(4,0:*) +CDE,LUDAT1. +CDE,LUDAT2. +CDE,LUDAT3. +CDE,PYPARS. +CDE,PYSUBS. INTEGER III CHARACTER*80 LINE * You need this common for local variables, since the * values are not read here but by FFREAD. So, any new * local variable You define should be put into the common. REAL XYZV(3),SIGV(3),CMSENE INTEGER LJUNIT LOGICAL GENVTX COMMON /ESIVAR/ . XYZV,SIGV,GENVTX,CMSENE,LJUNIT INTEGER LENOCC IF ( MODE .EQ. 0 ) THEN * Define cards. * Follow the example to include Your own steering * key-words, or refer to the FFREAD long writeup. CMSENE = 92.0 CALL FFKEY( 'CMS_ENE',CMSENE ,1,'REAL') LJUNIT = 90 CALL FFKEY( 'LUJETS_UNIT',LJUNIT ,1,'INTEGER') CALL VZERO(XYZV,3) CALL FFKEY( 'MEAN_VERTEX',XYZV ,3,'REAL') SIGV(1) = 0.015 SIGV(2) = 0.0010 SIGV(3) = 1.000 CALL FFKEY( 'VERTEX_SPREAD',SIGV,3,'REAL') GENVTX = .FALSE. CALL FFKEY( 'PRIMARY_VERTEX_SIM',GENVTX,1,'LOGICAL') ELSE * FFGO has now been called, so that the values on the * steering file has been loaded into the commons. Now, * transfere the values to the right places ! STEER(2,1) = CMSENE IF ( GENVTX) THEN STEER(2,4) = 1.0 ELSE STEER(2,4) = 0.0 ENDIF DO III =1,3 STEER(2,4+III) = XYZV(III) STEER(2,7+III) = SIGV(III) ENDDO STEER(2,11) = 1.0*LJUNIT ENDIF END +PATCH,SGVDETSIM. +SELF,IF=NEVER. Patch SGVDETSIM : Detector simulation -------------------------------------------------- This patch contains the code for detector simulation. The event generated and stored in /LUJETS/ is followed through the detector to simulate the response, either as resulting smeared track parameters (with errors), or as patterns of hits in the detector elements (or a mixture of the two). Entry points : ZDORD ZDORD }) (initialization) ZDETSI ZDETSI }) The code of this patch communicates with other patches as follows : ZDORD (initialization) ZTINI in SGVTRKER ZDETSI ZTTRAK in SGVTRKER ZTTDST in SGVTRKER ZTERRM in SGVTRKER ZTFOLN in SGVTRKER (ZDDHIT ZTCRAD,ZTCLEN,ZTCERF,ZTCEZ,ZTTISC in SGVTRKER, and ZULETD in GENUTL) The access routines to the geometry (see SGVTRKER description bellow) is called at various places The communication with the caller is by reading the JETSET common block /LUJETS/ and filling /ZXEVT/. In addition, if interactions in the detector are generated, /LUJETS/ is also modified. The communication with the patch SGVTRKER is only by arguments. +DECK,ZDEFFI,IF=DUMMY. SUBROUTINE ZDEFFI(SEEN,PP,LAYLIS) +SELF,IF=NEVER. SUBROUTINE ZDEFFI(SEEN, PP, LAYLIS) : Detector EFFIciency -------------------------------------------------- Dummy routine (always returning SEEN=.TRUE.) to simulate track-finding inefficiencies. Look at the out-commented example !!! ARGUMENTS: INPUT : PP : 4-momentum of track LAYLIS : List of detector layers hit by particle : LAYLIS(1,i) = number of the i:th hit layer. LAYLIS(2,i) tells if it is a plane or a cylinder, if it measures or not, and if it is the reference layer. LAYLIS(2,i) = 0 : mathematical layer : no material, no measurement. Ignored in all calculations 1 : seen by a cylinder 2 : seen by a plane -1 : particle went through a cylinder, but was not seen by the detector. -2 : particle went through a plane, but was not seen by the detector. 10 : the layer is a reference cylinder 20 : the layer is a reference plane LAYLIS(3,i) = No. of radiation lengths in layer. LAYLIS(1,i) = -1 -> end of list. OUTPUT: LAYLIS : as above. SEEN : .TRUE. if track seen by the detector, .FALSE. if not. IMPLICIT INPUTS: none. IMPLICIT OUTPUTS: none. CALLED BY : ZDETSI, DETector SImulation CALLED ROUTINE(S): none. SIDE EFFECTS: none. AUTHORS: M. Berggren, UFRJ CREATION DATE: 06-APR-1995 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE LOGICAL SEEN REAL PP(*) INTEGER LAYLIS(3,*) *** REAL PI,ABSP,TH,THETA,PBARREL *** REAL X *** REAL ZURECT *** CHARACTER*14 ZTCNAM *** INTEGER I SEEN = .TRUE. *** Example on how to generate global track inefficiencies : *** Determine theta *** PI = 4.0*ATAN(1.0) *** ABSP = ABS(PP(4)) *** TH = ACOS(PP(3)/ABSP) **** Theta in [0, 90 deg] *** CALL ZUINPI(TH ,THETA) *** THETA = THETA*180.0/PI *** *** IF ( THETA .GT. 40.0 ) THEN **** In barrel *** **** define efficiency for the given momentum *** IF ( ABSP .GT. 1.0 ) THEN *** PBARRL = 0.9 *** ELSE *** PBARRL = 0.8 *** ENDIF *** **** Is it seen ? call ZURECT to get a rectangularly **** distributed random number. *** IF ( ZURECT(X) .GT. PBARRL ) THEN **** Nope, not seen. *** SEEN = .FALSE. *** ENDIF *** ELSE **** Somthing else in the forward-backward region. *** ENDIF *** Example on how to generate inefficiencies layer by layer : *** DO I = 1, 1000 *** IF (LAYLIS(2,I) .EQ. 1 ) THEN **** ... this is a measuring cylinder *** IF (ZTCNAM(IGEO,LAYLIS(1,I),'TRACKING') .EQ. *** . 'MY_DETECTOR' ) THEN **** The user-defined name of the cylinder is MY_DETECTOR : *** that happens to be the one I want to generate *** the inefficicy of : *** IF ( ZURECT(I) .GT. 0.9 ) THEN *** take the hit away : set laylis(i,2) negative ! *** LAYLIS(2,I) = -1 *** ENDIF *** ENDIF *** ENDIF *** ENDDO END +DECK,ZDIDEN,IF=DUMMY. SUBROUTINE ZDIDEN(CDSEEN,PP,CODE,LAYLIS) +SELF,IF=NEVER. SUBROUTINE ZDIDEN(CDSEEN, PP, CODE, LAYLIS) : Detector EFFIciency -------------------------------------------------- Dummy routine (always returning CDSEEN=211 (pion)) to simulate particle identification. Supply whatever parametrisation You have of the particle identification capabilities of Your detector, as a function of momentum, direction, true identity etc. ARGUMENTS: INPUT : PP : 4-momentum of track CODE : true JETSET code of particle LAYLIS : List of detector layers hit by particle : LAYLIS(1,i) = number of the i:th hit layer. LAYLIS(2,i) tells if it is a plane or a cylinder, if it measures or not, and if it is the reference layer. LAYLIS(2,i) = 0 : mathematical layer : no material, no measurement. Ignored in all calculations 1 : seen by a cylinder 2 : seen by a plane -1 : particle went through a cylinder, but was not seen by the detector. -2 : particle went through a plane, but was not seen by the detector. 10 : the layer is a reference cylinder 20 : the layer is a reference plane LAYLIS(3,i) = No. of radiation lengths in layer. LAYLIS(1,i) = -1 -> end of list. OUTPUT: CDSEEN : Seen JETSET code of particle IMPLICIT INPUTS: none. IMPLICIT OUTPUTS: none. CALLED BY : ZDETSI, DETector SImulation CALLED ROUTINE(S): none. SIDE EFFECTS: none. AUTHORS: M. Berggren, UFRJ CREATION DATE: 06-APR-1995 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER CDSEEN,CODE,LAYLIS(3,*) REAL PP(*) * Pion by default CDSEEN = 211 END +DECK,ZDCALO,IF=DEFAULT. SUBROUTINE ZDCALO(IGEOM,PP,VERT,DSTMAX,CODE, . SHOAX,PSMEAR,ESMEAR,CDSEEN,TCAL,IERR) * +SELF,IF=NEVER. SUBROUTINE ZDCALO(IGEOM, PP, VERT, DSTMAX, CODE, SHOAX, PSMEAR, ESMEAR, CDSEEN, TCAL, IERR) : CALOrimeter simulation -------------------------------------------------- Calorimeter simulation. The particle with momentum PP originating from the point VERT will be followed to the intersection with the calorimeters, and depending on what type it is (electron or gamma on one hand, hadron on the other) the responce of the correct calorimeter is simulated. Note that hadrons never inter- act in the em-calorimeters, and em-showers never leaks. ARGUMENTS: INPUT : IGEOM : Detector geometry number PP : Momentum of particle VERT : Production point of particle DSTMAX : Maximum track-length of particle (eg. for decaying particles) CODE : True JETSET code of particle OUTPUT : SHOAX : Shower axis and direction : (1) First seen impactpoint (barrel : Rphi, forward : x) (2) Second " " (barrel : z, forward : y) (3) Seen shower theta angle (4) Seen shower phi angle PSMEAR : Seen momentum ESMEAR : Seen energy CDSEEN : Seen JETSET code of particle. SET TO 0 IF PARTICLE NOT SEEN. TCAL : Code of calorimeter seeing the shower. +ve -> barrel; -ve -> forward. Absoulute value is the (internal) number of the calorimeter. IERR : Error code. 0 : no error 1 : particle hits calorimeter of right type, but was not seen due to inefficicy 2 : particle only hits calorimeter of wrong type 3 : particle hits no calorimeter 4 : particle decays before hitting any calorimeter 5 : bellow energy threshold 6 : unknow particle IMPLICIT INPUTS: none IMPLICIT OUTPUTS: none. CALLED BY : ZDETSI, DETector SImulation CALLED ROUTINE(S): ZUGAUS (To get a GAUSsian random number.) ZURECT (To get a RECTANGULAR random number.) ZUI2PI (To bring angle In the range 0 to 2PI.) ZUINPI (To bring angle IN the range 0 to PI.) ZTCALO (To Track a particle to intersections with CALOrimeters) ZTCEFF (To get Calorimeter EFFeiciency) ZTCTHR (To get Calorimeter THResholds) ZTCRES (To get Calorimeter resolution ) ZTCSDE (To get Calorimeter Shower Direction Errors) VMOD (CERNLIB routine) SIDE EFFECTS: none. AUTHORS: M. Berggren, UFRJ M. A. Do Vale, UFRJ CREATION DATE: 06-APR-1995 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE REAL PP(*),VERT(*),SHOAX(*),PSMEAR(*),ESMEAR,DSTMAX INTEGER CODE,CDSEEN,IERR,IGEOM INTEGER PARTYP,CALTYP(100),LAY,ICAL,NLAY,COORD REAL PHI,CTYP(100),SHOAXT(4,100),DIST(100),Q, PMOMS, TCAL, . DMAX,PCUT,RCAL,ABSP,X0(100),LAMBDA(100),LAMIF,X0IF, . LAMTIF,X0TIF,INTPOS,EMCOMP,EHCOMP,TMAX,TEND,ENE,X0BEF, . A,B,EC,Z,SINTH,COSTH REAL VMOD,ZUGAUS,ZURECT,ZTCEFF,ZTCSDE,ZTCRES,ZTCRAD,ZTCTHR, . GAMDIS LOGICAL SEEN CALL VZERO(SHOAX,4) ESMEAR = 0.0 CDSEEN = 0 PCUT = 0.4 SEEN = .FALSE. IF (DSTMAX .EQ. 0.0 ) THEN DMAX = 1.0E32 ELSE DMAX = DSTMAX ENDIF * Find out if the particle is going to shower in the em * calorimeters (PARTYP = 1), or the hadronic (PARTYP=2) PARTYP = 0 * 22 - gamma; 11 - electron; IF (CODE .EQ. 22 .OR. ABS(CODE) .EQ. 11 ) THEN PARTYP = 1 * 2112 - n; 310 - K0 short; 130 - K0 long; 2212 - p; * 211 - pion; 321 - K; ELSE IF (ABS(CODE) .NE. 13 .AND. . ABS(CODE) .NE. 12 .AND. . ABS(CODE) .NE. 14 .AND. . ABS(CODE) .NE. 16 ) THEN * not a muon or a neutrino, must be a hadron PARTYP = 2 ELSE IERR = 6 RETURN ENDIF ENE = PP(4) ABSP = VMOD(PP,3) SINTH=ABS(VMOD(PP,2)/ABSP) COSTH=ABS(PP(3)/ABSP) CALL ZTCALO(IGEOM,PP,VERT,DIST,CTYP,X0,LAMBDA, . SHOAXT,CALTYP,NLAY,IERR) IERR = -1 LAMIF = 0.0 X0IF = 0.0 DO LAY = 1 , NLAY * finds the minimum distance, the first calorimeter that was hit IF (DIST(LAY) .LT. DMAX ) THEN * one calorimeter has been hit IF (( PARTYP .EQ. CALTYP(LAY)) .OR. . ( CALTYP(LAY) .EQ. 3)) THEN * Calorimeter type same as particle type (ie. EM & EM or * hadr. & hadr., or calorimeter sensetive to both types) ICAL = IABS(INT(CTYP(LAY))) IF ( PARTYP .EQ. 2 ) THEN * Hadron : estimate how much energy is lost * in the material before the calorimeter * number of interaction & radiation length * in front of the calorimeter along the track: IF ( CTYP(LAY) .GT. 0.0 ) THEN LAMTIF = LAMIF/SINTH X0TIF = X0IF/SINTH ELSE LAMTIF = LAMIF/COSTH X0TIF = X0IF/COSTH ENDIF * LAMTIF = LAMIF/(SINTH*COS(BETA)) * X0TIF = X0IF/(SINTH*COS(BETA)) * Simulate the position of the first interaction * in units of interaction lengths INTPOS = -LOG(ZURECT(1.0*LAY)) EMCOMP = 0.0 EHCOMP = PP(4) IF ( INTPOS .LT. LAMTIF ) THEN * ... interaction before the start of the * calorimeter : some energy will be lost * Get the size of the pi0 component of the * first interaction. It will generate a * purely em- shower * CALL ZDNIPI(PP(4),NPI,EPI) * DO KKK = 1, NPI * IF ( ZURECT(KKK) .LT. 0.3333 ) THEN * EMCOMP = EMCOMP + EPI(KKK) * ENDIF * ENDDO EMCOMP = PP(4)/3.0 EHCOMP = PP(4) - EMCOMP * Calculate max. position and length of the * hadronic component (in lambdas) TMAX = 0.2*LOG(PP(4)) + 0.7 TEND = 1.5*LOG10(PP(4)) + 4.0 * We simply assume that the shower profile * rises linearly to t_max, then falls linearly * to t_end. IF ( LAMTIF - INTPOS .LT. TMAX ) THEN * t_max in the calorimeter EHCOMP = EHCOMP * . (1.0- (LAMTIF - INTPOS )**2/(TMAX*TEND)) ELSEIF ( LAMTIF - INTPOS .LT. TEND ) THEN * t_max before the calorimeter EHCOMP = EHCOMP*((TEND-(LAMTIF - INTPOS ))**2)/ . (TEND*(TEND-TMAX)) ELSE * The entire shower is before the calorimeter EHCOMP = 0.0 ENDIF * Number of X0 the shower traverses before * the start of the calorimeter X0BEF = X0TIF*(LAMTIF - INTPOS)/LAMTIF * Assume the em shower profile is a * gamma distribution (following ppdb) B = 0.5 Z = 60.0 EC = 0.8/(Z+1.2) TMAX = LOG(EMCOMP/EC)+0.5 A=TMAX*B + 1.0 EMCOMP = (1.0-GAMDIS(X0BEF/B,A))*EMCOMP ENDIF ENE = MIN(EMCOMP + EHCOMP,PP(4)) ENDIF * Simulate energy responce IF ( ENE .GT. 0.0 ) THEN ESMEAR = ZUGAUS(ENE, . ZTCRES(IGEOM,ICAL,CTYP(ICAL),ENE)) ELSE ESMEAR = 0.0 ENDIF * Energy threshold IF (ESMEAR .GT. ZTCTHR(IGEOM,ICAL,CTYP(LAY))) THEN * Simulate efficiency IF (ZURECT(Q) .LT. ZTCEFF(IGEOM,ICAL,CTYP(LAY))) THEN SEEN = .TRUE. PMOMS = SQRT(ABS(ESMEAR**2-PP(5)**2)) * Smear shower axis and start point DO COORD = 1,4 SHOAX(COORD) = ZUGAUS(SHOAXT(COORD,LAY), . ZTCSDE(IGEOM,ICAL,COORD,CTYP(ICAL))) ENDDO * Bring angular variables in range CALL ZUINPI(SHOAX(3),SHOAX(3)) CALL ZUI2PI(SHOAX(4),SHOAX(4)) IF ( CTYP(LAY) .GT. 0.0 ) THEN * Barrel calorimeter : make sure the RPHI * value is in range RCAL = ZTCRAD(IGEOM,ICAL,'CALORIMETER') PHI = SHOAX(1)/RCAL CALL ZUI2PI(PHI,PHI) SHOAX(1) = RCAL*PHI ENDIF TCAL = CTYP(LAY) IERR = 0 * Particle id : IF ( PARTYP .EQ. 1 ) THEN * EM particle IF ( PP(7) .NE. 0.0 ) THEN * Charged, guess electron CDSEEN = -ISIGN(11,INT(PP(7))) ELSE * neutral, guess gamma CDSEEN = 22 ENDIF ELSE * hadron IF ( PP(7) .NE. 0.0 ) THEN * charged, guess pion CDSEEN = ISIGN(211,INT(PP(7))) ELSE * neutral, guess K0_L CDSEEN = 130 ENDIF ENDIF GOTO 99 ELSE * Not seen because of inefficiency IERR = 1 ENDIF ELSE * below threshold IERR = 5 GOTO 99 ENDIF ELSE * Wrong type IF (( IERR .NE. 1 ) .AND. ( IERR .NE. 5 ) ) THEN IERR = 2 ENDIF ENDIF ENDIF LAMIF = LAMIF + LAMBDA(LAY) X0IF = X0IF + X0(LAY) ENDDO IF ( NLAY .EQ. 0 ) THEN * hits no calorimeter IERR = 3 ELSE IF ( IERR .EQ. -1 ) THEN * decays before hitting calorimeter IERR = 4 ENDIF ENDIF 99 CONTINUE IF ( SEEN ) THEN PSMEAR(1) = PMOMS*SIN(SHOAX(3))*COS(SHOAX(4)) PSMEAR(2) = PMOMS*SIN(SHOAX(3))*SIN(SHOAX(4)) PSMEAR(3) = PMOMS*COS(SHOAX(3)) ENDIF END *----------------------------------------------------------------- +PATCH,SGVANA. +SELF,IF=NEVER. Patch SGVANA : Event analysis -------------------------------------------------- This patch contains the code for event analysis. The data is delivered to the routine ZAPRCS (as arguments), decoding is done to fill the common blocks in the deck ZACDE, and the user routine ZAUSER is called. A template of such a routine is included in this patch. User alternations might also be needed in ZAORD ( to include more steerings), ZAZERC (zero counters, no-op here), and ZAINI (user initialization at start-of-run). Entry points : ZAORD ZAORD }) (initialization) ZAPRCS ZAPRCS }) ZARUEN ZARUEN }) (end-of-run) The code of this patch communicates with other patches as follows : ZAORD (initialization) ZAINI ZTINI in SGVTRKER (if not already called) ZAPRCS ZADECD ZTTRIP in SGVTRKER ZAMKTK ZTTRAK and ZTERRM in SGVTRKER (if TKR data not given on input) The communication with the caller is through arguments only. +DECK,ZAORD,IF=DEFAULT. SUBROUTINE ZAORD(MODE,STEER) +SELF,IF=NEVER. SUBROUTINE ZAORD(MODE, STEER) : Analysis ORDers -------------------------------------------------- Example of a routine to define and read user steerings for the detector simulation. If MODE = 0, then the routine defines keys for FFREAD, if it is $\neq$ 0 then the routine reacts on the values read be FFREAD. So, the calling routine must do something like CALL ZAORD(0,STEER) . . (other key definitions) . . . CALL FFGO CALL ZAORD(1,STEER) . This is what ZXRUIN does. Note that the variables read in by FFREAD must be in a common, even if SGV uses them only in this routine ! ARGUMENTS: INPUT : MODE : 0 -> routine should define key-words, and default values. <> 0 -> load values of keys read from the steering file to the right common-blocks, do initialization etc. OUTPUT : STEER : Steering info. The analysis uses row 4: STEER(4,1) : How to use the detector hits. In the example : 1 -> Use perigee parameters (ie. don't use hits at all) 2 -> Fit track using the right hits. 3 -> Run code to associate hits with tracks (met 1) 4 -> ditto, met 2. ,2) : Minimum number of jets to use event ,3) : 1 -> Make event ntuple ,4) : 1 -> Make jet ntuple ,5) : Vertex fit method : 0 -> Start with all tracks, then exclude tracks until a good vertex can be made. 1 -> Start with two tracks, then include tracks until vertex becomes bad. In addition STEER(1,0) is an error flag: 0 : no error 1 : error, but go on -2 : error, stop this run All other position of the row are free to use. IMPLICIT INPUTS: From /AINVAR/ : local variables used for clarity IMPLICIT OUTPUTS: To /AINVAR/ : local variables used for clarity, after their values have been set by FFREAD. CALLED BY : ZXRUIN, RUn INitialization CALLED ROUTINE(S): FFKEY (CERNLIB FFREAD routine.) SIDE EFFECTS: none. AUTHORS: M. Berggren, UFRJ CREATION DATE: 07-APR-1995 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE INTEGER MODE REAL STEER(4,0:*) LOGICAL MEVNT,MJETNT,DOWNUP INTEGER VDMET,MINJET COMMON /AINVAR/ . MEVNT,MJETNT,VDMET,MINJET,DOWNUP +CDE,ZXSIZ. +CDE,ZXSTE. IF (MODE .EQ. 0 ) THEN * Make event ntuple ? MEVNT = .FALSE. CALL FFKEY( 'MEVNT',MEVNT,1,'LOGICAL') * Make jet ntuple ? MJETNT = .FALSE. CALL FFKEY( 'MJETNT',MJETNT,1,'LOGICAL') * What method for detector hits ? VDMET = 1 CALL FFKEY( 'VDMET',VDMET,1,'INTEGER') * Minimum number of jets ? MINJET = 0 CALL FFKEY( 'MINJET',MINJET,1,'INTEGER') * Vertex fit method. DOWNUP = .FALSE. CALL FFKEY( 'DOWNUO',DOWNUP,1,'LOGICAL') ELSE STEER(4,1) = VDMET STEER(4,2) = MINJET IF ( MEVNT ) THEN STEER(4,3) = 1 ELSE STEER(4,3) = 0 ENDIF IF ( MJETNT ) THEN STEER(4,4) = 1 ELSE STEER(4,4) = 0 ENDIF IF ( DOWNUP ) THEN STEER(4,5) = 1 ELSE STEER(4,5) = 0 ENDIF ENDIF END +DECK,ZAUINI,IF=DEFAULT. SUBROUTINE ZAUINI(STEER,MGEOM) +SELF,IF=NEVER. SUBROUTINE ZAUINI(STEER, MGEOM) : Analysis User INItialization -------------------------------------------------- Lets the user do additional initialsation of the analysis code. ARGUMENTS: INPUT : STEER : Steering info. The analysis uses row 4: STEER(4,1) : How to use the detector hits. In the example : 1 -> Use perigee parameters (ie. don't use hits at all) 2 -> Fit track using the right hits. 3 -> Run code to associate hits with tracks (met 1) 4 -> ditto, met 2. ,2) : Minimum number of jets to use event ,3) : 1 -> Make event ntuple ,4) : 1 -> Make jet ntuple ,5) : Vertex fit method : 0 -> Start with all tracks, then exclude tracks until a good vertex can be made. 1 -> Start with two tracks, then include tracks until vertex becomes bad. In addition the following words are used : STEER(1,2) : Printing unit STEER(1,3) : Max number of events to print. STEER(1,4) : 1.0 -> runs stand-alone, so ZTINI must be called. STEER(2,4) : 1.0 -> primary vertex position variations generated. STEER(3,0) : Number of different detectors. STEER(3,1) : Number of layers in the barrel that have hit information. STEER(3,2) : Type of information on tracks: 1 -> full track fit result format. 2 -> pxpypz + production points only. MGEOM : Number of detector geometries. IMPLICIT INPUTS: none predefined. IMPLICIT OUTPUTS: none predefined. CALLED BY : ZAINI, Analysis INItialization CALLED ROUTINE(S): none by default. SIDE EFFECTS: none. AUTHORS: You. CREATION DATE: dd-mmm-yyy % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE REAL STEER(4,0:*) INTEGER MGEOM * ----------- * | * V * put your initialisation here ! * ^ * | * ----------- END +DECK,ZAZERC,IF=DUMMY. SUBROUTINE ZAZERC * Dummy routine to Zero any counters at begining of * event analysis. Use it at will for Your own commons * etc. IMPLICIT NONE END +DECK,ZAUSER. SUBROUTINE ZAUSER(STEER) +SELF,IF=NEVER. SUBROUTINE ZAUSER(STEER) : USER routine -------------------------------------------------- Default user analysis routine Add whatever You want here !!! ARGUMENTS: INPUT : STEER array of steerings IMPLICIT INPUTS: Whatever /ZA.../ commons You choose to use. IMPLICIT OUTPUTS: Whatever You want of personal commons and/or histogram filling, printing etc. Avoid changes in the /ZA.../ commons, if You're not sure what the effects are. CALLED BY : ZAPRCS, Analysis PRoCeSsing CALLED ROUTINE(S): Any routines You choose. Check the example bellow for some hints. SIDE EFFECTS: none. AUTHORS: You. CREATION DATE: dd-mmm-yyyy % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE REAL STEER(4,0:*) * the code following can be whatever You choose. *---- * ! * ! * V * Look in SGV_INFO.TXT to see whats in these * commons !!! +CDE,ZASIZ. +CDE,ZASTE. +CDE,ZAEVT. +CDE,ZAJET. +CDE,ZATRS. +CDE,ZAPRN. INTEGER ERROR,IDUM,FRCREJ,PARLIS,igeoid REAL BS(25),IPCOR,XYZRED(3),VCOVR(6),ETOTCH(2),ETOTNEU(2), . PTOT(6,2),THE_TR(27),PTTOT,TH_MISS LOGICAL RFVTX * Zero counters CALL ZAZERC call hcdir('//PAWC',' ') if ( igeom .eq. 1 ) then call hcdir('DET1',' ') elseif ( igeom .eq. 2 ) then call hcdir('DET2',' ') endif * fit vertex * FRCREJ is a bitted word which can be used to force * rejection of tracks based on their true history. * Normally one does not want this (rather that the seen * momenta etc are used for rejection), so ... FRCREJ = 0 CALL ZAUVF1(FRCREJ,ERROR) IF ( ERROR .GT. 0 ) THEN GOTO 777 ! 777 : error return label ENDIF * Cluster calorimeter showers CALL ZAUSHO(0.9995) * Do jet-clustering. PARLIS is a list of particles * to use. Here it is not used because argument 3 * is =1, meaning that all seen, charged particles * will be used. PARLIS = 0 CALL ZAUCLU(4,0.02,0,PARLIS,IDUM,ERROR) * Get shape-variables (must be called after filling * JETSET commons which was done by the call to ZAUCLU) * CALL ZAUSPH * CALL ZAUTHR * CALL ZAUFWO * Fill a few histograms (booked by the default sgv_ex.kumac) CALL HF1(1,1.0*MTRK,1.0) CALL HF1(2,1.0*TTRK,1.0) CALL HF1(3,1.0*NJET,1.0) CALL VZERO (PTOT,6*2) CALL VZERO (ETOTCH,2) CALL VZERO (ETOTNEU,2) DO TRACK = 1,MTRK IJET = JETNB(TRACK) * Calulate impact parameter RFVTX = .FALSE. CALL ZAUCIP(RFVTX,IPRF(TRACK,SEEN),IPZ(TRACK,SEEN), . EIPRF(TRACK),EIPZ(TRACK),IPCOR,XYZRED,VCOVR) * Fill a few track histograms CALL VADD (PTOT(1,SEEN),PVEC(1,TRACK,SEEN),PTOT(1,SEEN),6) IF ( CHA(TRACK,SEEN) .NE. 0.0 ) THEN ETOTCH(SEEN) = ETOTCH(SEEN) + ABSP(TRACK,SEEN) ELSE ETOTNEU(SEEN) = ETOTNEU(SEEN) + ABSP(TRACK,SEEN) ENDIF THE_TR(1) = 1.0*EVT CALL UCOPY ( PVEC(1,TRACK,SEEN) , THE_TR(2) , 7 ) THE_TR(9) = 1.0*(CD(TRACK,SEEN)) THE_TR(10)= SQRT(PVEC(1,TRACK,SEEN)**2 + PVEC(2,TRACK,SEEN)**2) THE_TR(11) = ATAN2D(THE_TR(10),PVEC(3,TRACK,SEEN)) THE_TR(12) = IPRF(TRACK,SEEN) THE_TR(13) = IPZ(TRACK,SEEN) THE_TR(14) = EIPRF(TRACK) THE_TR(15) = EIPZ(TRACK) THE_TR(16) = PVECSH(4,TRACK) THE_TR(17) = CTYP(TRACK) CALL VADD (PTOT(1,TRU),PVEC(1,TRACK,TRU),PTOT(1,TRU),6) IF ( CHA(TRACK,TRU) .NE. 0.0 ) THEN ETOTCH(TRU) = ETOTCH(TRU) + ABSP(TRACK,TRU) ELSE ETOTNEU(TRU) = ETOTNEU(TRU) + ABSP(TRACK,TRU) ENDIF CALL UCOPY ( PVEC(1,TRACK,TRU) , THE_TR(18) , 7 ) THE_TR(25) = 1.0*(CD(TRACK,TRU)) THE_TR(26)= SQRT(PVEC(1,TRACK,TRU)**2 + PVEC(2,TRACK,TRU)**2) THE_TR(27) = ATAN2D(THE_TR(26),PVEC(3,TRACK,TRU)) CALL HFN(100,THE_TR) ENDDO CALL HF1(4 ,ETOTCH(SEEN)+ETOTNEU(SEEN),1.0) CALL HF1(5 ,ETOTCH(SEEN),1.0) CALL HF1(6 ,ETOTCH(SEEN),1.0) IF ( PTOT(1,SEEN)**2 + PTOT(2,SEEN)**2 .GT. 0.0 ) THEN PTTOT = SQRT(PTOT(1,SEEN)**2 + PTOT(2,SEEN)**2) CALL HF1(7 ,PTTOT,1.0) TH_MISS = ATAN2D(PTTOT,PTOT(6,SEEN)) CALL HF1(8 ,TH_MISS,1.0) ENDIF CALL HF1(9 ,ETOTCH(TRU)+ETOTNEU(TRU),1.0) CALL HF1(10,ETOTCH(TRU),1.0) CALL HF1(11,ETOTCH(TRU),1.0) IF ( PTOT(1,TRU)**2 + PTOT(2,TRU)**2 .GT. 0.0 ) THEN PTTOT = SQRT(PTOT(1,TRU)**2 + PTOT(2,TRU)**2) CALL HF1(12,PTTOT,1.0) TH_MISS = ATAN2D(PTTOT,PTOT(6,TRU)) CALL HF1(13,TH_MISS,1.0) ENDIF DO TRACK = MTRK+1,TTRK IF (CHDLIS(0,TRACK) .EQ. 0 ) THEN * ie. no kids -> stable particle CALL VADD (PTOT(1,TRU),PVEC(1,TRACK,TRU),PTOT(1,TRU),6) IF ( CHA(TRACK,TRU) .NE. 0.0 ) THEN ETOTCH(TRU) = ETOTCH(TRU) + ABSP(TRACK,TRU) ELSE ETOTNEU(TRU) = ETOTNEU(TRU) + ABSP(TRACK,TRU) ENDIF ENDIF ENDDO CALL HF1(14 ,ETOTCH(TRU)+ETOTNEU(TRU),1.0) CALL HF1(15,ETOTCH(TRU),1.0) CALL HF1(16,ETOTCH(TRU),1.0) IF ( PTOT(1,TRU)**2 + PTOT(2,TRU)**2 .GT. 0.0 ) THEN PTTOT = SQRT(PTOT(1,TRU)**2 + PTOT(2,TRU)**2) CALL HF1(17,PTTOT,1.0) TH_MISS = ATAN2D(PTTOT,PTOT(6,TRU)) CALL HF1(18,TH_MISS,1.0) ENDIF * DO IJET = 1, NJET * Calculate boosted sphericity * CALL ZAUBOS(BS(IJET)) * ENDDO * ^ * ! * ! *---- * the code preceeding be whatever You choose. call hcdir('//PAWC',' ') RETURN * Error return 777 STEER(1,0) = 1.0 call hcdir('//PAWC',' ') CONTINUE * END +DECK,ZARUEN,IF=DUMMY. SUBROUTINE ZARUEN(STEER) +SELF,IF=NEVER. SUBROUTINE ZARUEN(STEER) : Analysis RUn ENd -------------------------------------------------- Dummy routine for user end-of-run processing. Insert whatever You need here. NB. There is no need to output histograms/ntuples, nor clossing of histogram files here. This is done automatically in SGV. ARGUMENTS: INPUT : STEER : Steering info. Cf. the comments in ZXGORD,ZEORD,ZDORD and ZAORD. STEER(1,2) is the printing unit. IMPLICIT INPUTS: defined by the user. IMPLICIT OUTPUTS: none. CALLED BY : ZXRUEN, RUn ENd CALLED ROUTINE(S): defined by user. SIDE EFFECTS: none. AUTHORS: M. Berggren, UFRJ CREATION DATE: 16-JUL-1995 % C H A N G E L O G % % Date | Name | Description %----------------+-------+----------------------------------------------------- %[change_entry] +SELF. IMPLICIT NONE REAL STEER(4,0:*) END