]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 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 | |
8 | SUBROUTINE PHOS_INIT | |
9 | C | |
10 | C *** DEFINITION OF THE GEOMETRY OF THE PHOS *** | |
11 | C *** NVE 24-SEP-1990 CERN GENEVA *** | |
12 | C | |
13 | C CALLED BY : SXGEOM | |
14 | C ORIGIN : NICK VAN EIJNDHOVEN | |
15 | C | |
16 | *KEEP,GCKINE. | |
17 | COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP | |
18 | + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD | |
19 | C | |
20 | INTEGER IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD | |
21 | REAL PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT | |
22 | C | |
23 | *KEEP,LUDAT1. | |
24 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
25 | INTEGER MSTU,MSTJ | |
26 | REAL PARU,PARJ | |
27 | SAVE /LUDAT1/ | |
28 | * | |
29 | *KEEP,SHRUNP. | |
30 | COMMON /SHRUNP/ VMAJ,IMIN,NRUN,NEVTOT | |
31 | *KEEP,SHPHYP. | |
32 | COMMON /SHPHYP/ JWEI,NDNDY,YLIM,PTLIM,JWEAK,JPI0,JETA,JPIC,JPRO, | |
33 | + JKAC,JKA0,JRHO,JOME,JPHI,JPSI,JDRY | |
34 | *KEEP,SCPHOS. | |
35 | INTEGER MAXCRAD | |
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), | |
46 | + PHOS_Ndiv_magic | |
47 | *KEND. | |
48 | C | |
49 | IF (PHOSsize(3).GT.MAXCRAD) THEN | |
50 | STOP 'PHOS_INIT Increase MAXCRAD, too many cradles!' | |
51 | ENDIF | |
52 | ||
53 | *AZ { SHAKER initialization | |
54 | IF( IKINE.EQ.700 ) THEN | |
55 | JWEI = 0 | |
56 | NDNDY = NINT(PKINE(4)) | |
57 | YLIM = PKINE(5) | |
58 | PTLIM = PKINE(6) | |
59 | JWEAK = 0 | |
60 | JPI0 = 1 | |
61 | JETA = 1 | |
62 | JPIC = NINT(PKINE(7)) | |
63 | JPRO = NINT(PKINE(7)) | |
64 | JKAC = NINT(PKINE(7)) | |
65 | JKA0 = NINT(PKINE(7)) | |
66 | JRHO = NINT(PKINE(7)) | |
67 | JOME = NINT(PKINE(7)) | |
68 | JPHI = NINT(PKINE(7)) | |
69 | JPSI = NINT(PKINE(7)) | |
70 | JDRY = NINT(PKINE(7)) | |
71 | NEVTOT = 999999999 | |
72 | ||
73 | MSTU(11) = 6 ! Shaker output to screen (Fortran channel 6). | |
74 | CALL SHINIT ! Shaker initialization. | |
75 | ||
76 | print *,'************************************************' | |
77 | print *,'Print some SHAKER parameters.' | |
78 | print *,'NDNDY=',NDNDY | |
79 | print *,'YLIM=',YLIM | |
80 | print *,'PTLIM=',PTLIM | |
81 | print *,'JPIC=',JPIC | |
82 | print *,'************************************************' | |
83 | *AZ } | |
84 | ||
85 | ENDIF | |
86 | * | |
87 | END | |
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) | |
92 | *KEEP,GCKINE. | |
93 | COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP | |
94 | + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD | |
95 | C | |
96 | INTEGER IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD | |
97 | REAL PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT | |
98 | C | |
99 | *KEEP,SHGENE. | |
100 | COMMON /SHGENE/ IEVT,NPI0,NETA,NPIC,NPRO,NKAC,NKA0,NRHO,NOME, | |
101 | + NPHI,NPSI,NDRY | |
102 | *KEEP,BLUJETS. | |
103 | COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5) | |
104 | SAVE /LUJETS/ | |
105 | ||
106 | *KEEP,SCPHOS. | |
107 | INTEGER MAXCRAD | |
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), | |
118 | + PHOS_Ndiv_magic | |
119 | *KEND. | |
120 | * | |
121 | DIMENSION V_TMP(3),P_TMP(3) | |
122 | * | |
123 | IF(IKINE.EQ.700) THEN | |
124 | * Shaker genrator SHOULD BE CHECKED!!!! | |
125 | IEVT = IEVT + 1 ! Increament SHAKER event number. | |
126 | CALL SHEVNT | |
127 | ||
128 | ||
129 | *********************************** | |
130 | * Begin: create list of SHAKER particles (if required) | |
131 | * ------ | |
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) | |
136 | i = tmp | |
137 | i = (tmp-i)*10 | |
138 | ||
139 | IF( i.NE.0. ) CALL SHLIST ! List of SHAKER particles. 7 Mbytes/event | |
140 | ||
141 | * End of creation | |
142 | ************************************ | |
143 | ||
144 | DO I=1,N | |
145 | !? IF( K_LUJETS(I,5).EQ.0 ) MPRIMA=MPRIMA+1 | |
146 | IPART = IPART_FROM_LUJET_TO_GEANT(K(I,2)) | |
147 | ||
148 | IF( K(I,5).EQ.0 ) THEN | |
149 | IFLAG_DONE = 1 | |
150 | ELSE | |
151 | IFLAG_DONE = 0 | |
152 | ENDIF | |
153 | DO JJ=1,3 | |
154 | V_TMP(JJ)=V(I,JJ) | |
155 | P_TMP(JJ)=P(I,JJ) | |
156 | ENDDO | |
157 | CALL RXSTRAK(IFLAG_DONE,K(I,3),IPART,P_TMP | |
158 | $ ,V_TMP,V(I,4),'Primary',NT) | |
159 | IF( I.NE.NT ) THEN | |
160 | STOP 'GUKINE: Bad thing...' | |
161 | ENDIF | |
162 | ||
163 | CALL RXKEEP(I) | |
164 | ENDDO | |
165 | ||
166 | ENDIF | |
167 | GOTO 999 | |
168 | * | |
169 | 999 END | |
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 | |
173 | ||
174 | IMPLICIT NONE | |
175 | INTEGER N | |
176 | ||
177 | IF (N.EQ.0) THEN | |
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 | |
221 | ELSE | |
222 | WRITE(*,*) 'Unknown LUJET particle ', N | |
223 | stop | |
224 | ENDIF | |
225 | END | |
226 | ||
227 | ******************************************************************************** |