1 *CMZ : 15/02/99 14.40.30 by Federico Carminati
2 *CMZ : 2.03/01 20/08/98 09.43.00 by Federico Carminati
3 *CMZ : 2.03/00 09/07/98 19.21.29 by Federico Carminati
4 *CMZ : 2.00/05 25/05/98 14.39.01 by Federico Carminati
5 *CMZ : 1.05/06 26/10/95 17.04.53 by Nick van Eijndhoven (RUU/CERN)
6 *CMZ : 1.05/00 11/11/94 15.21.30 by Nick van Eijndhoven (RUU/CERN)
7 *-- Author : Nick van Eijndhoven (CERN) 24/09/90
10 C *** DEFINITION OF THE GEOMETRY OF THE PHOS ***
11 C *** NVE 24-SEP-1990 CERN GENEVA ***
14 C ORIGIN : NICK VAN EIJNDHOVEN
17 COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
18 + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
20 INTEGER IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD
21 REAL PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT
24 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
30 COMMON /SHRUNP/ VMAJ,IMIN,NRUN,NEVTOT
32 COMMON /SHPHYP/ JWEI,NDNDY,YLIM,PTLIM,JWEAK,JPI0,JETA,JPIC,JPRO,
33 + JKAC,JKA0,JRHO,JOME,JPHI,JPSI,JDRY
36 PARAMETER (MAXCRAD=100)
37 INTEGER PHOSsize,PHOS_Ndiv_magic
38 REAL PHOSflags,PHOScell,PHOSradius,PHOSCPV,
39 + PHOScradlesA,PHOSTXW,PHOSAIR,PHOSFTI,
40 + PHOSextra, PHOSangle
41 COMMON /PHOS_PARS/ PHOSflags(9),
42 + PHOScell(9),PHOSradius,PHOSCPV(9),
43 + PHOSsize(3), PHOScradlesA,
44 + PHOSTXW(3),PHOSAIR(3),PHOSFTI(4),
45 + PHOSextra(9), PHOSangle(MAXCRAD),
49 IF (PHOSsize(3).GT.MAXCRAD) THEN
50 STOP 'PHOS_INIT Increase MAXCRAD, too many cradles!'
53 *AZ { SHAKER initialization
54 IF( IKINE.EQ.700 ) THEN
56 NDNDY = NINT(PKINE(4))
73 MSTU(11) = 6 ! Shaker output to screen (Fortran channel 6).
74 CALL SHINIT ! Shaker initialization.
76 print *,'************************************************'
77 print *,'Print some SHAKER parameters.'
78 print *,'NDNDY=',NDNDY
80 print *,'PTLIM=',PTLIM
82 print *,'************************************************'
88 *CMZ : 15/02/99 14.40.30 by Federico Carminati
89 *CMZ : 2.03/01 28/07/98 16.12.22 by Federico Carminati
90 *-- Author : Federico Carminati 17/07/98
91 SUBROUTINE PHOS_KINE(NT)
93 COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
94 + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
96 INTEGER IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD
97 REAL PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT
100 COMMON /SHGENE/ IEVT,NPI0,NETA,NPIC,NPRO,NKAC,NKA0,NRHO,NOME,
103 COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
108 PARAMETER (MAXCRAD=100)
109 INTEGER PHOSsize,PHOS_Ndiv_magic
110 REAL PHOSflags,PHOScell,PHOSradius,PHOSCPV,
111 + PHOScradlesA,PHOSTXW,PHOSAIR,PHOSFTI,
112 + PHOSextra, PHOSangle
113 COMMON /PHOS_PARS/ PHOSflags(9),
114 + PHOScell(9),PHOSradius,PHOSCPV(9),
115 + PHOSsize(3), PHOScradlesA,
116 + PHOSTXW(3),PHOSAIR(3),PHOSFTI(4),
117 + PHOSextra(9), PHOSangle(MAXCRAD),
121 DIMENSION V_TMP(3),P_TMP(3)
123 IF(IKINE.EQ.700) THEN
124 * Shaker genrator SHOULD BE CHECKED!!!!
125 IEVT = IEVT + 1 ! Increament SHAKER event number.
129 ***********************************
130 * Begin: create list of SHAKER particles (if required)
132 * PHOSflags: YES: X<>0 NO: X=0
133 * PHOSflags(1) : -----X Create branch for TObjArray of AliPHOSCradle
134 * ----X- Create file (ftn03 on HP-UX) with list of SHAKER particles (7Mb/event)
135 tmp = PHOSflags(1)/(10**2)
139 IF( i.NE.0. ) CALL SHLIST ! List of SHAKER particles. 7 Mbytes/event
142 ************************************
145 !? IF( K_LUJETS(I,5).EQ.0 ) MPRIMA=MPRIMA+1
146 IPART = IPART_FROM_LUJET_TO_GEANT(K(I,2))
148 IF( K(I,5).EQ.0 ) THEN
157 CALL RXSTRAK(IFLAG_DONE,K(I,3),IPART,P_TMP
158 $ ,V_TMP,V(I,4),'Primary',NT)
160 STOP 'GUKINE: Bad thing...'
170 INTEGER FUNCTION IPART_FROM_LUJET_TO_GEANT(N)
171 ! Return GEANT particle number from LUJET particle number.
172 ! This code is from file shake005.f : SUBROUTINE SHTOGL
178 IPART_FROM_LUJET_TO_GEANT = 0
179 ELSE IF (N.EQ.22) THEN
180 IPART_FROM_LUJET_TO_GEANT = 1 ! gamma
181 ELSE IF (N.EQ.-11) THEN
182 IPART_FROM_LUJET_TO_GEANT = 2
183 ELSE IF (N.EQ.11) THEN
184 IPART_FROM_LUJET_TO_GEANT = 3
185 ELSE IF (ABS(N).EQ.12) THEN
186 IPART_FROM_LUJET_TO_GEANT = 4
187 ELSE IF (ABS(N).EQ.14) THEN
188 IPART_FROM_LUJET_TO_GEANT = 4
189 ELSE IF (ABS(N).EQ.16) THEN
190 IPART_FROM_LUJET_TO_GEANT = 4
191 ELSE IF (N.EQ.-13) THEN
192 IPART_FROM_LUJET_TO_GEANT = 5
193 ELSE IF (N.EQ.13) THEN
194 IPART_FROM_LUJET_TO_GEANT = 6
195 ELSE IF (N.EQ.111) THEN
196 IPART_FROM_LUJET_TO_GEANT = 7
197 ELSE IF (N.EQ.211) THEN
198 IPART_FROM_LUJET_TO_GEANT = 8
199 ELSE IF (N.EQ.-211) THEN
200 IPART_FROM_LUJET_TO_GEANT = 9
201 ELSE IF (N.EQ.130) THEN
202 IPART_FROM_LUJET_TO_GEANT = 10
203 ELSE IF (N.EQ.321) THEN
204 IPART_FROM_LUJET_TO_GEANT = 11
205 ELSE IF (N.EQ.-321) THEN
206 IPART_FROM_LUJET_TO_GEANT = 12
207 ELSE IF (N.EQ.2112) THEN
208 IPART_FROM_LUJET_TO_GEANT = 13
209 ELSE IF (N.EQ.2212) THEN
210 IPART_FROM_LUJET_TO_GEANT = 14
211 ELSE IF (N.EQ.-2212) THEN
212 IPART_FROM_LUJET_TO_GEANT = 15
213 ELSE IF (N.EQ.310) THEN
214 IPART_FROM_LUJET_TO_GEANT = 16
215 ELSE IF (N.EQ.221) THEN
216 IPART_FROM_LUJET_TO_GEANT = 17 ! eta
217 ELSE IF (N.EQ.311) THEN ! This is (K0) and we set it to
218 IPART_FROM_LUJET_TO_GEANT = 10 ! GEANT K0 short
219 ELSE IF (N.EQ.-311) THEN ! This is (K~0) and we set it to
220 IPART_FROM_LUJET_TO_GEANT = 10 ! GEANT K0 short
222 WRITE(*,*) 'Unknown LUJET particle ', N
227 ********************************************************************************