]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | *CMZ : 19/11/98 21.32.03 by Federico Carminati |
2 | *-- Author : | |
3 | C*********************************************************************** | |
4 | C | |
5 | SUBROUTINE ZDC_ADDANG(THETA1,PHI1,THETA2,PHI2,THETA3,PHI3) | |
6 | C | |
7 | C This subroutine takes spherical polar angles THETA1 and PHI1 | |
8 | C and adds to them the direction PHI2 on a cone of half-opening angle | |
9 | C THETA2 (= angle from cone axis to cone surface) to produce | |
10 | C the new space angles THETA3 and PHI3. All angles are in | |
11 | C degrees, with 0<=THETA<=180 and 0<=PHI<360. There is no | |
12 | C other restriction on THETA1, PHI1, THETA2 or PHI2. | |
13 | C | |
14 | C 27-AUG-1992 S. Coutu | |
15 | C | |
16 | C*********************************************************************** | |
17 | #undef CERNLIB_GEANT321_GCONSP_INC | |
18 | #include "geant321/gconsp.inc" | |
19 | DOUBLE PRECISION THETA1,PHI1,THETA2,PHI2,THETA3,PHI3 | |
20 | DOUBLE PRECISION TEMP,CX,CY,CZ,CT1,ST1,CT2,ST2, | |
21 | + CP1,SP1,CP2,SP2,RTHETA3 | |
22 | C | |
23 | CT1=COS(THETA1*DEGRAD) | |
24 | ST1=SIN(THETA1*DEGRAD) | |
25 | CP1=COS(PHI1*DEGRAD) | |
26 | SP1=SIN(PHI1*DEGRAD) | |
27 | CT2=COS(THETA2*DEGRAD) | |
28 | ST2=SIN(THETA2*DEGRAD) | |
29 | CP2=COS(PHI2*DEGRAD) | |
30 | SP2=SIN(PHI2*DEGRAD) | |
31 | CX=CT1*CP1*ST2*CP2+ST1*CP1*CT2-SP1*ST2*SP2 | |
32 | CY=CT1*SP1*ST2*CP2+ST1*SP1*CT2+CP1*ST2*SP2 | |
33 | CZ=CT1*CT2-ST1*ST2*CP2 | |
34 | C | |
35 | RTHETA3=ACOS(CZ) | |
36 | THETA3=RTHETA3*RADDEG | |
37 | IF(THETA3.EQ.0.OR.THETA3.EQ.180.)THEN | |
38 | PHI3=0. | |
39 | ELSE | |
40 | TEMP=CX/SIN(RTHETA3) | |
41 | IF(TEMP.GT.1.)TEMP=1. | |
42 | IF(TEMP.LT.-1.)TEMP=-1. | |
43 | PHI3=ACOS(TEMP)*RADDEG | |
44 | IF(CY.LT.0.)PHI3=360.-PHI3 | |
45 | ENDIF | |
46 | * | |
47 | END | |
48 | ||
49 | *CMZ : 21/11/98 17.33.14 by Federico Carminati | |
50 | *-- Author : | |
51 | C================================================================== | |
52 | SUBROUTINE ZDC_EFERMI(ID) | |
53 | * | |
54 | #include "zdc_common.inc" | |
55 | #undef CERNLIB_GEANT321_GCONSP_INC | |
56 | #include "geant321/gconsp.inc" | |
57 | DIMENSION RNDM(3) | |
58 | * | |
59 | CALL GRNDM(RNDM,3) | |
60 | * | |
61 | IF(ID.EQ.14)THEN | |
62 | DO I=1,200 | |
63 | IF(RNDM(3).GE.PROBINTP(I-1).AND.RNDM(3).LT.PROBINTP(I))GO TO | |
64 | $ 10 | |
65 | END DO | |
66 | ELSE IF(ID.EQ.13) THEN | |
67 | DO I=1,200 | |
68 | IF(RNDM(3).GE.PROBINTN(I-1).AND.RNDM(3).LT.PROBINTN(I))GO TO | |
69 | $ 10 | |
70 | END DO | |
71 | ENDIF | |
72 | * | |
73 | 10 PIPPO=PP(I)+0.001 | |
74 | PHI=TWOPI*RNDM(1) | |
75 | COST=1.-2*RNDM(2) | |
76 | TET=ACOS(COST) | |
77 | DDP(1)=PIPPO*SIN(TET)*COS(PHI) | |
78 | DDP(2)=PIPPO*SIN(TET)*SIN(PHI) | |
79 | DDP(3)=PIPPO*COST | |
80 | * | |
81 | END | |
82 | ||
83 | *CMZ : 23/02/99 07.53.48 by Federico Carminati | |
84 | *CMZ : 2.03/01 06/08/98 10.13.59 by Federico Carminati | |
85 | *-- Author : E.SCOMPARIN, 13/05/1996. | |
86 | SUBROUTINE ZDC_END | |
87 | C | |
88 | C *** TERMINATION OF THE ZDC SIMULATION AT THE END OF A RUN *** | |
89 | C | |
90 | C CALLED BY : SXEND | |
91 | C ORIGIN : E. SCOMPARIN | |
92 | C | |
93 | C | |
94 | * CALL HROUT(0,ICYCLE,' ') | |
95 | * CALL HREND('ALIZ') | |
96 | * CLOSE(1) | |
97 | ||
98 | PRINT 10000 | |
99 | 10000 FORMAT(1H /1H ,36('*'),' ZDC_END ',36('*')/ | |
100 | $ 1H ,20X,'ZDC simulation package terminated'/ | |
101 | $ 1H ,80('*')) | |
102 | * | |
103 | END | |
104 | ||
105 | *CMZ : 23/02/99 07.53.48 by Federico Carminati | |
106 | *CMZ : 2.03/01 07/08/98 09.48.28 by Federico Carminati | |
107 | *-- Author : E.SCOMPARIN, 13/05/1996. | |
108 | SUBROUTINE ZDC_EVE | |
109 | C | |
110 | C *** TERMINATION OF THE ZDC SIMULATION AFTER EACH EVENT *** | |
111 | C | |
112 | C CALLED BY : SXEVE | |
113 | C ORIGIN : E. SCOMPARIN | |
114 | C | |
115 | C -- RETRIEVE HITS INFORMATION FOR THE CURRENT EVENT | |
116 | #undef CERNLIB_GEANT321_GCFLAG_INC | |
117 | #include "geant321/gcflag.inc" | |
118 | #include "zdc_common.inc" | |
119 | * | |
120 | INTEGER NUMVSP(NVZP),NUMVSN(NVZN), | |
121 | + NUMBP(NVZP,1000),NUMBN(NVZN,1000), | |
122 | + ITRP(1000),ITRN(1000) | |
123 | REAL HITP(NHZ,1000),HITN(NHZ,1000) | |
124 | * | |
125 | REAL ENEH(1000),XZPH(1000),YZPH(1000),EZPH(1000,NZPTX,NZPTY), | |
126 | + XZNH(1000),YZNH(1000),EZNH(1000,NZNTX,NZNTY) | |
127 | INTEGER NPAH(1000),SFLH(1000),NPPH(1000,NZPTX,NZPTY), | |
128 | + NPNH(1000,NZNTX,NZNTY) | |
129 | * | |
130 | DATA NUMVSP/0,0/ | |
131 | DATA NUMVSN/0,0/ | |
132 | * | |
133 | DO JZERO=1,1000 | |
134 | DO KZERO=1,NHZ | |
135 | HITP(KZERO,JZERO)=0 | |
136 | HITN(KZERO,JZERO)=0 | |
137 | ENDDO | |
138 | ENDDO | |
139 | * | |
140 | DO I=1,1000 | |
141 | NPAH(I)=0 | |
142 | XZPH(I)=99. | |
143 | YZPH(I)=99. | |
144 | XZNH(I)=99. | |
145 | YZNH(I)=99. | |
146 | ENDDO | |
147 | * | |
148 | ITOLD=0 | |
149 | * CALL GTREVE | |
150 | * | |
151 | C -- RETRIEVE HITS INFORMATION FOR THE CURRENT EVENT | |
152 | IF(ISECF.EQ.1.OR.(ISECF.EQ.0.AND.MOD(IEVENT,1).EQ.0))THEN | |
153 | WRITE(6,*)'EVENT NO. ',IEVENT | |
154 | CALL GPHITS('*','*') | |
155 | WRITE(6,*) | |
156 | ENDIF | |
157 | * | |
158 | NHMAXP=1000 | |
159 | NHMAXN=1000 | |
160 | * | |
161 | CALL GFHITS(ZSET,ZP1,NVZP,NHZ,NHMAXP,0, | |
162 | + NUMVSP,ITRP,NUMBP,HITP,NHITP) | |
163 | CALL GFHITS(ZSET,ZN1,NVZN,NHZ,NHMAXN,0, | |
164 | + NUMVSN,ITRN,NUMBN,HITN,NHITN) | |
165 | * | |
166 | * Fill n-tuple | |
167 | * | |
168 | ITCTP=0 | |
169 | DO I=1,NHITP | |
170 | IF(ITRP(I).NE.ITCTP)THEN | |
171 | ITCTP=ITRP(I) | |
172 | NPAH(ITCTP)=HITP(1,I) | |
173 | ENEH(ITCTP)=HITP(2,I) | |
174 | XZPH(ITCTP)=HITP(3,I) | |
175 | YZPH(ITCTP)=HITP(4,I) | |
176 | SFLH(ITCTP)=INT(HITP(5,I)) | |
177 | ENDIF | |
178 | J1=NUMBP(1,I) | |
179 | J2=NUMBP(2,I) | |
180 | EZPH(ITCTP,J1,J2)=HITP(7,I) | |
181 | NPPH(ITCTP,J1,J2)=HITP(6,I) | |
182 | ENDDO | |
183 | ITCTN=0 | |
184 | DO I=1,NHITN | |
185 | IF(ITRN(I).NE.ITCTN)THEN | |
186 | ITCTN=ITRN(I) | |
187 | NPAH(ITCTN)=HITN(1,I) | |
188 | ENEH(ITCTN)=HITN(2,I) | |
189 | XZNH(ITCTN)=HITN(3,I) | |
190 | YZNH(ITCTN)=HITN(4,I) | |
191 | SFLH(ITCTN)=INT(HITN(5,I)) | |
192 | ENDIF | |
193 | J1=NUMBN(1,I) | |
194 | J2=NUMBN(2,I) | |
195 | EZNH(ITCTN,J1,J2)=HITN(7,I) | |
196 | NPNH(ITCTN,J1,J2)=HITN(6,I) | |
197 | ENDDO | |
198 | * | |
199 | DO I=1,1000 | |
200 | IF(NPAH(I).NE.0)THEN | |
201 | NPA=NPAH(I) | |
202 | ENE=ENEH(I) | |
203 | XZP=XZPH(I) | |
204 | YZP=YZPH(I) | |
205 | SFL=SFLH(I) | |
206 | DO J=1,NZPTX | |
207 | DO K=1,NZPTY | |
208 | EZP(J,K)=EZPH(I,J,K) | |
209 | NPP(J,K)=NPPH(I,J,K) | |
210 | ENDDO | |
211 | ENDDO | |
212 | XZN=XZNH(I) | |
213 | YZN=YZNH(I) | |
214 | DO J=1,NZNTX | |
215 | DO K=1,NZNTY | |
216 | EZN(J,K)=EZNH(I,J,K) | |
217 | NPN(J,K)=NPNH(I,J,K) | |
218 | ENDDO | |
219 | ENDDO | |
220 | * CALL HFNT(10) | |
221 | ENDIF | |
222 | ENDDO | |
223 | * | |
224 | END | |
225 | ||
226 | *CMZ : 21/11/98 17.33.14 by Federico Carminati | |
227 | *-- Author : | |
228 | C================================================================== | |
229 | SUBROUTINE ZDC_GFERMI(A,Z) | |
230 | * | |
231 | #include "zdc_common.inc" | |
232 | #undef CERNLIB_GEANT321_GCONSP_INC | |
233 | #include "geant321/gconsp.inc" | |
234 | * CALCOLO DELLA DISTRIBUZIONE DEI MOMENTI SECONDO | |
235 | * LA DISTRIBUZIONE DOPPIA GAUSSIANA (ILINOV), UGUALE | |
236 | * PER NEUTRONI E PROTONI | |
237 | * | |
238 | PROBINTP(0)=0.0 | |
239 | PROBINTN(0)=0.0 | |
240 | SIG1=0.113 | |
241 | SIG2=0.250 | |
242 | ALFA=0.18*((A/12.)**0.333) | |
243 | XK=(4.*PI)/((1.+ALFA)*TWOPI**1.5) | |
244 | * | |
245 | DO I=1,200 | |
246 | P=FLOAT(I)*0.005 | |
247 | PP(I)=P | |
248 | E1=(P*P)/(2.*SIG1*SIG1) | |
249 | E2=(P*P)/(2.*SIG2*SIG2) | |
250 | F1=EXP(-(E1)) | |
251 | F2=EXP(-(E2)) | |
252 | PROBP=XK*P*P*(F1/(SIG1**3)+F2/(SIG2**3))*0.005 | |
253 | PROBINTP(I)=PROBINTP(I-1)+PROBP | |
254 | PROBINTN(I)=PROBINTP(I) | |
255 | END DO | |
256 | * | |
257 | END | |
258 | ||
259 | *CMZ : 23/02/99 07.53.48 by Federico Carminati | |
260 | *CMZ : 2.03/01 25/08/98 23.39.54 by Federico Carminati | |
261 | *-- Author : | |
262 | C-- Author : E.SCOMPARIN, 07/05/1996 | |
263 | SUBROUTINE ZDC_INIT | |
264 | C | |
265 | C *** INITIALISATION FOR THE ZDC SIMULATION *** | |
266 | C | |
267 | C CALLED BY : SXINIT | |
268 | C ORIGIN : E. SCOMPARIN | |
269 | C | |
270 | C | |
271 | #undef CERNLIB_GEANT321_GCFLAG_INC | |
272 | #include "geant321/gcflag.inc" | |
273 | #undef CERNLIB_GEANT321_GCKINE_INC | |
274 | #include "geant321/gckine.inc" | |
275 | C | |
276 | #include "zdc_common.inc" | |
277 | * | |
278 | * Initialize COMMON block ZDC_CGEOM | |
279 | * | |
280 | DATA HDZN/4.0,4.0,50.0/ | |
281 | DATA HDZP/8.0,8.0,75.0/ | |
282 | C Coordinates of the center of the ZDC front face in the MRS | |
283 | DATA ZNPOS/-0.5,0.,11613./ | |
284 | DATA ZPPOS/-19.0,0.,11563./ | |
285 | DATA FIZN/0.,0.01825,50.0/ | |
286 | DATA FIZP/0.,0.01825,75.0/ | |
287 | DATA GRZN/0.025,0.025,50.0/ | |
288 | DATA GRZP/0.040,0.040,75.0/ | |
289 | DATA NCEN/11,11,0/ | |
290 | DATA NCEP/10,10,0/ | |
291 | * | |
292 | * Initialize COMMON block ZDC_HITS | |
293 | * | |
294 | * Data for set ZDC | |
295 | DATA ZSET,ZN1,ZP1 /'ZDC ', 'ZN1 ','ZP1 '/ | |
296 | DATA CHNMSZN/'ZNTX','ZN1 '/ | |
297 | DATA CHNMSZP/'ZPTX','ZP1 '/ | |
298 | DATA NBITSZN /2,2/ | |
299 | DATA NBITSZP /2,2/ | |
300 | DATA IDTYPZN,IDTYPZP /1, 2/ | |
301 | DATA NWHI,NWDI /1000, 1000/ | |
302 | * | |
303 | * Data for Detectors ZN1,ZP1 | |
304 | * | |
305 | DATA CHNAMH /'IPAR','EPAR','XPAR','YPAR','SFLG','FELE','ENER'/ | |
306 | DATA NBITSH /8,32,32,32,1,32,32/ | |
307 | DATA ORIG /0.,0.,10.,10.,0.,0.,0./ | |
308 | DATA FACT /1.,1.,10000.,10000.,1.,10000.,10000./ | |
309 | DATA NHSUM /2/ | |
310 | * | |
311 | * Read tables of Cerenkov light produced in the fibers | |
312 | * | |
313 | OPEN(67,FILE='ZDC/light22620362207s', | |
314 | + FORM='FORMATTED', STATUS='OLD') | |
315 | OPEN(68,FILE='ZDC/light22620362208s', | |
316 | + FORM='FORMATTED', STATUS='OLD') | |
317 | OPEN(69,FILE='ZDC/light22620362209s', | |
318 | + FORM='FORMATTED', STATUS='OLD') | |
319 | OPEN(70,FILE='ZDC/light22620362210s', | |
320 | + FORM='FORMATTED', STATUS='OLD') | |
321 | DO 10 K=1,NALFA | |
322 | READ (67,10000)(TABLE(1,K,J),J=1,NBE) | |
323 | READ (68,10000)(TABLE(2,K,J),J=1,NBE) | |
324 | READ (69,10000)(TABLE(3,K,J),J=1,NBE) | |
325 | READ (70,10000)(TABLE(4,K,J),J=1,NBE) | |
326 | 10 CONTINUE | |
327 | 10000 FORMAT(7(1X,F10.5)) | |
328 | CLOSE (67) | |
329 | CLOSE (68) | |
330 | CLOSE (69) | |
331 | CLOSE (70) | |
332 | ||
333 | IFERMI=1 | |
334 | * | |
335 | * Set Fermi flag according to SWITCH 3 | |
336 | IF(ISWIT(3).EQ.1) IFERMI=1 | |
337 | * define the LHC energy/nucleon | |
338 | EPERN=2760. | |
339 | * | |
340 | * Open data file to read in particles from event generators | |
341 | IF(IHIJ.GE.1)THEN | |
342 | OPEN(27,FILE=FILEH,STATUS='OLD') | |
343 | ELSE IF(IVNU.GE.1)THEN | |
344 | OPEN(27,FILE=FILEV,STATUS='OLD') | |
345 | ENDIF | |
346 | C GET FERMI MOMENTUM DISTRIBUTIONS | |
347 | CALL ZDC_GFERMI(207.,82.) | |
348 | C | |
349 | * CALL HROPEN (1,'ALIZ',FILEA,'N',1024,ISTAT) | |
350 | * | |
351 | * CALL HBNT(10,'ALIZDC','D') | |
352 | * CALL HBNAME(10,'ALI',NPA, | |
353 | * +'NPA[0,112]:U,ENE,SFL[0,1]:U,'// | |
354 | * +'XZP:R*4:16:[-99,99],YZP:R*4:16:[-99,99],'// | |
355 | * +'EZP(2,2),NPP(2,2),'// | |
356 | * +'XZN:R*4:16:[-99,99],YZN:R*4:16:[-99,99],'// | |
357 | * +'EZN(2,2),NPN(2,2)') | |
358 | * | |
359 | PRINT 10100 | |
360 | 10100 FORMAT(1H /1H ,36('*'),' ZDC_INIT ',36('*')/ | |
361 | + 1H ,20X,'ZDC simulation package initialised'/ | |
362 | + 1H ,80('*')) | |
363 | ||
364 | END | |
365 | ||
366 | *CMZ : 21/11/98 17.33.14 by Federico Carminati | |
367 | *-- Author : | |
368 | SUBROUTINE ZDC_KINE(NT) | |
369 | * Generation of event kinematics * | |
370 | * ----------------------------------------------------------------* | |
371 | #undef CERNLIB_GEANT321_GCKINE_INC | |
372 | #include "geant321/gckine.inc" | |
373 | #undef CERNLIB_GEANT321_GCFLAG_INC | |
374 | #include "geant321/gcflag.inc" | |
375 | #include "zdc_common.inc" | |
376 | * | |
377 | DIMENSION KATT(10000,2),PATT(10000,4) | |
378 | * | |
379 | INTEGER ITA(49),ITB(49) | |
380 | REAL PLAB(3),UBUF(1),UB(1) | |
381 | DIMENSION VERTEX(3) | |
382 | REAL BALP(4),DDDP(4),PLABS(4) | |
383 | * | |
384 | DATA UBUF/0./ | |
385 | DATA ITA/22,-11,11,0,-13,13,111,211,-211,130,321,-321, | |
386 | +2112,2212,-2212,310,221,3122,3222,3212,3112,3322,3312, | |
387 | +3334,-2112,-3122,-3112,-3212,-3222,-3322,-3312,-3334, | |
388 | +-15,15,411,-411,421,-421,431,-431,4122,0,0,0,0,0,0,0,0/ | |
389 | DATA ITB/10,-12,12,0,-14,14,110,120,-120,230,130,-130, | |
390 | +1220,1120,-1120,0,220,2130,1130,1230,2230,1330,2330,3331, | |
391 | +-1220,-2130,-1130,-1230,-2230,-1330,-2330,-3331,-16,16, | |
392 | +-240,240,-140,140,0,0,2140,0,0,0,0,0,0,0,0/ | |
393 | DATA IVR/0/ | |
394 | * | |
395 | DIMENSION RNDM(2) | |
396 | CHARACTER*20 PARTNAME | |
397 | * | |
398 | * --- BEAMTY=1 Gaussian beam (width sigx sigy, mean values fx fy) | |
399 | * --- BEAMTY=2 Uniform beam (width sigx sigy, mean values fx fy) | |
400 | * Data cards BMTY, INBM | |
401 | * | |
402 | DO KZ=1,3 | |
403 | VERTEX(KZ)=0 | |
404 | ENDDO | |
405 | IF(BEAMTY.EQ.1) THEN | |
406 | CALL SXGAUS(RNDM,2) | |
407 | VERTEX(1)= VERTEX(1)+FX+RNDM(1)*SIGX | |
408 | VERTEX(2)= VERTEX(2)+FY+RNDM(2)*SIGY | |
409 | VERTEX(3)= 0.05 | |
410 | ELSEIF(BEAMTY.EQ.2) THEN | |
411 | CALL GRNDM(RNDM,2) | |
412 | VERTEX(1)= VERTEX(1)+FX+(2.*RNDM(1)-1.)*SIGX | |
413 | VERTEX(2)= VERTEX(2)+FY+(2.*RNDM(2)-1.)*SIGY | |
414 | VERTEX(3)= 0.05 | |
415 | ENDIF | |
416 | * | |
417 | * Fill the vertex bank | |
418 | * | |
419 | CALL GSVERT(VERTEX,0,0,0.,0,NVTX) | |
420 | IF(NVTX.EQ.0)WRITE(6,*)'Error defining vertex' | |
421 | * | |
422 | * Read HIJING event file | |
423 | * | |
424 | IF(IHIJ.GE.1)THEN | |
425 | 10 READ(27,*,END=70) NMUL,EATT,JATT,NT,NP,N0,N01,N10,N11,B,NATT | |
426 | IF(IHIJ.EQ.2)THEN | |
427 | WRITE(6,*)'HIJING EVENT HEADER= ',NMUL,EATT,JATT,NT,NP, | |
428 | + N0,N01,N10,N11,B,NATT | |
429 | ENDIF | |
430 | READ(27,*) (KATT(I,1),KATT(I,2),(PATT(I,J),J=1,4),I=1,NATT) | |
431 | IVR=IVR+1 | |
432 | IF(IVR.LT.IHIJF) GOTO 10 | |
433 | * | |
434 | BIMP=B | |
435 | PARTI=FLOAT(NT)+FLOAT(NP) | |
436 | RMULTI=FLOAT(NATT) | |
437 | * | |
438 | DO I=1,NATT | |
439 | * -- Remove particles with negative z-direction | |
440 | IF(PATT(I,3).LT.0.0) GOTO 30 | |
441 | * -- Remove (if required) the spectators | |
442 | IF(IHIJSP.EQ.1)THEN | |
443 | IF(KATT(I,2).EQ.0..OR.KATT(I,2).EQ.10.) GOTO 30 | |
444 | ENDIF | |
445 | * -- Define participant flag : UBUF(1) | |
446 | IF(KATT(I,2).EQ.0..OR.KATT(I,2).EQ.10.) THEN | |
447 | UBUF(1)=0. | |
448 | ELSE | |
449 | UBUF(1)=1. | |
450 | ENDIF | |
451 | * -- Translate the particle ID from HIJING to GEANT | |
452 | DO J=1,49 | |
453 | IF(KATT(I,1).EQ.ITA(J)) THEN | |
454 | IPART=J | |
455 | GOTO 20 | |
456 | ENDIF | |
457 | ENDDO | |
458 | 20 CONTINUE | |
459 | * | |
460 | DO JJ=1,3 | |
461 | PLAB(JJ)=PATT(I,JJ) | |
462 | ENDDO | |
463 | * | |
464 | * Rotations to account for beam divergence and crossing angle | |
465 | IF(BMDIV.NE.0.) CALL ZDC_ROTP(PLAB,0) | |
466 | IF(BMCRA.NE.0.) CALL ZDC_ROTP(PLAB,1) | |
467 | * | |
468 | * Fill the tracks bank | |
469 | CALL GSKINE(PLAB,IPART,NVTX,UBUF,1,NT) | |
470 | IF(IHIJ.EQ.2)THEN | |
471 | WRITE(6,*)'IPART= ',IPART,'PLAB= ',PLAB | |
472 | ENDIF | |
473 | IF(NT.EQ.0)WRITE(6,*)'Error defining track' | |
474 | * | |
475 | 30 CONTINUE | |
476 | ENDDO | |
477 | * | |
478 | * Read VENUS event file | |
479 | * | |
480 | ELSE IF(IVNU.GE.1)THEN | |
481 | 40 READ(27,*,END=80)LEVT,NREVT,NMUL,B,KOLEVT,COLEVT, PMXEVT, | |
482 | + EGYEVT,NP,NT,NATT | |
483 | IF(LEVT.NE.1) THEN | |
484 | WRITE(6,*) ' Error in reading VENUS data' | |
485 | STOP | |
486 | ENDIF | |
487 | IF(IVNU.EQ.2)THEN | |
488 | WRITE(6,*)'VENUS EVENT HEADER= ',LEVT,NREVT,NATT,B,KOLEVT, | |
489 | + COLEVT,PMXEVT,EGYEVT,NP,NT | |
490 | ENDIF | |
491 | * | |
492 | DO I=1,NATT | |
493 | *-- read produced particles | |
494 | READ(27,*,END=80) LPTL,NREVT,NRPTL,KATT(I,1), (PATT(I,J),J= | |
495 | + 1,4),AMASSS | |
496 | * | |
497 | * lptl ......... record label (lptl=3) | |
498 | * nrevt ........ event number | |
499 | * nrptl ........ particle number | |
500 | * katt(1,1)..... particle id | |
501 | * patt ......... 4-momentum (px,py,pz,en) in lab | |
502 | * amasss ........ mass of particle | |
503 | * | |
504 | IF(LPTL.NE.3) THEN | |
505 | WRITE(6,*) ' ERROR IN READING VENUS DATA' | |
506 | STOP | |
507 | ENDIF | |
508 | ENDDO | |
509 | * | |
510 | IVR=IVR+1 | |
511 | IF(IVR.LT.IVNUF) GOTO 40 | |
512 | * | |
513 | BIMP=B | |
514 | PARTI=(FLOAT(NT)+FLOAT(NP))/2. | |
515 | RMULTI=FLOAT(NATT) | |
516 | * | |
517 | DO I=1,NATT | |
518 | * -- remove particles in negative direction | |
519 | IF(PATT(I,3).LT.0.0) GOTO 60 | |
520 | * -- if required remove the spectators | |
521 | IF(IVNSP.EQ.1)THEN | |
522 | IF((KATT(I,1).EQ.1120.OR.KATT(I,1).EQ.1220).AND. (PATT(I | |
523 | + ,4).LT.(EPERN*1.005).AND. PATT(I,4).GT.(EPERN*0.995))) | |
524 | + GOTO 60 | |
525 | ENDIF | |
526 | * -- flag the spectators (UBUF(1)=0) | |
527 | IF((KATT(I,1).EQ.1120.OR.KATT(I,1).EQ.1220).AND. (PATT(I,4) | |
528 | + .GT.(EPERN*0.995).AND. PATT(I,4).LT.(EPERN*1.005))) THEN | |
529 | UBUF(1)=0. | |
530 | ELSE | |
531 | UBUF(1)=1. | |
532 | ENDIF | |
533 | * -- Translate the particle ID from VENUS to GEANT | |
534 | DO J=1,49 | |
535 | IF(KATT(I,1).EQ.ITB(J))THEN | |
536 | IPART=J | |
537 | GOTO 50 | |
538 | ENDIF | |
539 | ENDDO | |
540 | 50 CONTINUE | |
541 | DO JJ=1,3 | |
542 | PLAB(JJ)=PATT(I,JJ) | |
543 | ENDDO | |
544 | * | |
545 | * Rotations to account for beam divergence and crossing angle | |
546 | IF(BMCRA.NE.0.)CALL ZDC_ROTP(PLAB,1) | |
547 | IF(BMDIV.NE.0.)CALL ZDC_ROTP(PLAB,0) | |
548 | * | |
549 | * Fill the tracks bank | |
550 | CALL GSKINE(PLAB,IPART,NVTX,UBUF,1,NT) | |
551 | IF(IVNU.EQ.2)THEN | |
552 | WRITE(6,*)'IPART= ',IPART,'PLAB= ',PLAB | |
553 | ENDIF | |
554 | IF(NT.EQ.0)WRITE(6,*)'Error defining track' | |
555 | 60 CONTINUE | |
556 | ENDDO | |
557 | * | |
558 | ELSE | |
559 | * | |
560 | * Generation of test particles | |
561 | * | |
562 | * Definition of the incident particle | |
563 | * | |
564 | IPART = NINT(PKINE(1)) | |
565 | UBUF(1)=1 | |
566 | CALL GFPART(IPART,PARTNAME,ITRTYP,AMASS,CHARGE,TLIFE,UB,NB) | |
567 | AAP=1.0 | |
568 | * | |
569 | * --- In case of a ion , find out energy and momentum | |
570 | * --- NAAP=A=Z+N - atomic number of the initial particle | |
571 | IF(IPART.GE.45) THEN | |
572 | NAAP = INT(0.5 + AMASS/0.93149432) | |
573 | AAP = NAAP | |
574 | UBUF(1)=0. | |
575 | ENDIF | |
576 | IF((IPART.GE.45).OR.(IPART.EQ.13).OR.(IPART.EQ.14)) THEN | |
577 | UBUF(1)=0. | |
578 | ENDIF | |
579 | * | |
580 | IF(IPART.EQ.14)THEN | |
581 | AMA=0.938 | |
582 | ELSE IF(IPART.EQ.13)THEN | |
583 | AMA=0.939 | |
584 | ELSE | |
585 | AMA=AMASS | |
586 | ENDIF | |
587 | * | |
588 | IF(PKINE(6).EQ.0.)THEN | |
589 | PLAB(1)=PKINE(2)*PKINE(3) | |
590 | PLAB(2)=PKINE(2)*PKINE(4) | |
591 | PLAB(3)=PKINE(2)*PKINE(5) | |
592 | ELSE | |
593 | SCANG=2*ATAN(EXP(-(PKINE(6)))) | |
594 | PLAB(1)=-PKINE(2)*SIN(SCANG) | |
595 | PLAB(2)=0. | |
596 | PLAB(3)=PKINE(2)*COS(SCANG) | |
597 | ENDIF | |
598 | * | |
599 | * Rotations to account for beam divergence and crossing angle | |
600 | IF(BMCRA.NE.0.)CALL ZDC_ROTP(PLAB,1) | |
601 | IF(BMDIV.NE.0.)CALL ZDC_ROTP(PLAB,0) | |
602 | * | |
603 | * -- in case of a nucleon, if required, apply the Fermi momentum | |
604 | IF(UBUF(1).EQ.0.AND.IFERMI.EQ.1) THEN | |
605 | IF(IPART.EQ.13.OR.IPART.EQ.14)THEN | |
606 | CALL ZDC_EFERMI(IPART) | |
607 | ELSE IF(IPART.GE.45)THEN | |
608 | CALL ZDC_EFERMI(13) | |
609 | GOLDHABER=SQRT(AAP*(207-AAP)/(207-1.)) | |
610 | DO JJ=1,3 | |
611 | DDP(JJ)=DDP(JJ)*GOLDHABER | |
612 | ENDDO | |
613 | ENDIF | |
614 | DO II=1,3 | |
615 | BALP(II)=-PLAB(II) | |
616 | ENDDO | |
617 | BALP(4)=SQRT(BALP(1)**2+BALP(2)**2+BALP(3)**2+AMA**2) | |
618 | DO II=1,3 | |
619 | DDDP(II)=DDP(II) | |
620 | ENDDO | |
621 | DDDP(4)=SQRT(DDDP(1)**2+DDDP(2)**2+DDDP(3)**2+AMA**2) | |
622 | CALL LORENF(AMA,BALP,DDDP,PLABS) | |
623 | DO II=1,3 | |
624 | PLAB(II)=PLABS(II) | |
625 | ENDDO | |
626 | c WRITE(6,*)'BALP ',BALP,'DDDP ',DDDP,'PLABS ',PLABS | |
627 | ENDIF | |
628 | * | |
629 | BIMP=999. | |
630 | * | |
631 | * Fill the tracks bank | |
632 | CALL GSKINE(PLAB,IPART,NVTX,UBUF,1,NT) | |
633 | IF(NT.EQ.0)WRITE(6,*)'Error defining track' | |
634 | ||
635 | ENDIF | |
636 | * | |
637 | * Some debug printings | |
638 | IF(IHIJ.EQ.2.OR.IVNU.EQ.2)THEN | |
639 | CALL GPVERT(NVTX) | |
640 | DO KK=1,NT | |
641 | CALL GPKINE(KK) | |
642 | ENDDO | |
643 | ENDIF | |
644 | * | |
645 | C | |
646 | RETURN | |
647 | 70 WRITE(6,*) 'END OF HIJING FILE' | |
648 | IEORUN=1 | |
649 | GOTO 999 | |
650 | 80 WRITE(6,*) 'END OF VENUS FILE' | |
651 | IEORUN=1 | |
652 | * | |
653 | 999 END | |
654 | ||
655 | *CMZ : 19/11/98 09.54.52 by Federico Carminati | |
656 | *-- Author : | |
657 | SUBROUTINE ZDC_ROTP(PLAB,ICROSS) | |
658 | #undef CERNLIB_GEANT321_GCKINE_INC | |
659 | #include "geant321/gckine.inc" | |
660 | #undef CERNLIB_GEANT321_GCFLAG_INC | |
661 | #include "geant321/gcflag.inc" | |
662 | C | |
663 | #undef CERNLIB_GEANT321_GCONSP_INC | |
664 | #include "geant321/gconsp.inc" | |
665 | #include "zdc_common.inc" | |
666 | C | |
667 | DOUBLE PRECISION TETPART,FIPART,TETDIV,FIDIV,TETSUM,FISUM | |
668 | DOUBLE PRECISION DPLAB(3) | |
669 | DIMENSION PLAB(3) | |
670 | DIMENSION RVEC(1) | |
671 | DIMENSION RNDM(1) | |
672 | C | |
673 | C TAKE NON-ZERO DIVERGENCY | |
674 | c write(6,*)'PLAB (NODIV) = ',plab | |
675 | PMOD=0.0 | |
676 | DO IJ=1,3 | |
677 | DPLAB(IJ)=PLAB(IJ) | |
678 | PMOD=PMOD+PLAB(IJ)*PLAB(IJ) | |
679 | ENDDO | |
680 | PMOD=SQRT(PMOD) | |
681 | IF(ICROSS.EQ.0)THEN | |
682 | C--- TETDIV is given in radiants and it is read by data cards | |
683 | CALL RNORML(RVEC,1) | |
684 | c WRITE(6,*)RVEC | |
685 | TETDIV=PKINE(10)*ABS(RVEC(1)) | |
686 | C--- PHIDIV is randomly chosen between 0 and 360 | |
687 | CALL GRNDM(RNDM,1) | |
688 | FIDIV=RNDM(1)*TWOPI | |
689 | ELSE IF(ICROSS.EQ.1)THEN | |
690 | IF(ISWIT(7).EQ.0)THEN | |
691 | TETDIV=0. | |
692 | FIDIV=0. | |
693 | ELSE IF(ISWIT(7).EQ.1)THEN | |
694 | TETDIV=PKINE(4) | |
695 | FIDIV=0. | |
696 | ELSE IF(ISWIT(7).EQ.2)THEN | |
697 | TETDIV=PKINE(4) | |
698 | FIDIV=PIBY2 | |
699 | ENDIF | |
700 | ENDIF | |
701 | TETPART=DATAN(DSQRT(DPLAB(1)**2+DPLAB(2)**2)/DPLAB(3)) | |
702 | IF(DPLAB(2).NE.0..OR.DPLAB(1).NE.0.) THEN | |
703 | FIPART=DATAN2(DPLAB(2),DPLAB(1)) | |
704 | ELSE | |
705 | FIPART=0. | |
706 | ENDIF | |
707 | IF (FIPART.LT.0)FIPART=FIPART+TWOPI | |
708 | C write(6,*)' TETPART= ',tetpart,' FIPART= ',fipart | |
709 | TETDIV=TETDIV*RADDEG | |
710 | FIDIV=FIDIV*RADDEG | |
711 | TETPART=TETPART*RADDEG | |
712 | FIPART=FIPART*RADDEG | |
713 | c CALL ZDC_ADDANG(TETDIV,FIDIV,TETPART,FIPART,TETSUM,FISUM) | |
714 | CALL ZDC_ADDANG(TETPART,FIPART,TETDIV,FIDIV,TETSUM,FISUM) | |
715 | C write(6,*)' TETSUM= ',tetsum,'FISUM= ',fisum | |
716 | TETSUM=TETSUM*DEGRAD | |
717 | FISUM=FISUM*DEGRAD | |
718 | PLAB(1)=PMOD*DSIN(TETSUM)*DCOS(FISUM) | |
719 | PLAB(2)=PMOD*DSIN(TETSUM)*DSIN(FISUM) | |
720 | PLAB(3)=PMOD*DCOS(TETSUM) | |
721 | C write(6,*)'PLAB (DIV) = ',plab | |
722 | RETURN | |
723 | END | |
724 | ||
725 | *CMZ : 19/11/98 09.54.52 by Federico Carminati | |
726 | *CMZ : 2.03/01 25/08/98 23.40.04 by Federico Carminati | |
727 | *-- Author : E.SCOMPARIN, 13/05/1996. | |
728 | SUBROUTINE ZDC_STEP | |
729 | C | |
730 | C *** RECORDING OF ZDC HITS AFTER EACH TRACKING STEP *** | |
731 | C | |
732 | C CALLED BY : SXSTEP | |
733 | C ORIGIN : E. SCOMPARIN | |
734 | C | |
735 | #undef CERNLIB_GEANT321_GCKINE_INC | |
736 | #undef CERNLIB_GEANT321_GCONSP_INC | |
737 | #undef CERNLIB_GEANT321_GCVOLU_INC | |
738 | #undef CERNLIB_GEANT321_GCKMAX_INC | |
739 | #undef CERNLIB_GEANT321_GCKING_INC | |
740 | #undef CERNLIB_GEANT321_GCNUM_INC | |
741 | #undef CERNLIB_GEANT321_GCTRAK_INC | |
742 | #undef CERNLIB_GEANT321_GCFLAG_INC | |
743 | #undef CERNLIB_GEANT321_GCTMED_INC | |
744 | #undef CERNLIB_GEANT321_GCMATE_INC | |
745 | #undef CERNLIB_GEANT321_GCSETS_INC | |
746 | #include "geant321/gckine.inc" | |
747 | #include "geant321/gconsp.inc" | |
748 | #include "geant321/gcvolu.inc" | |
749 | #include "geant321/gcking.inc" | |
750 | #include "geant321/gcnum.inc" | |
751 | #include "geant321/gctrak.inc" | |
752 | #include "geant321/gcflag.inc" | |
753 | #include "geant321/gctmed.inc" | |
754 | #include "geant321/gcmate.inc" | |
755 | #include "geant321/gcsets.inc" | |
756 | #include "zdc_common.inc" | |
757 | * | |
758 | DIMENSION LNAM(15),LNUM(15) | |
759 | DIMENSION UB(1) | |
760 | * | |
761 | DIMENSION VERT0(3),PVERT0(4) | |
762 | CHARACTER*20 CHNPART0 | |
763 | * | |
764 | DIMENSION XLOCM(3),XANGM(3),XLOCL(3),XANGL(3),FNULA(3),ZENTR(3) | |
765 | DATA ALFMAX /110.0/ | |
766 | * | |
767 | * New track | |
768 | * | |
769 | IF(ITRA.NE.ITOLD)THEN | |
770 | IF(INWVOL.EQ.1.AND.IDTYPE.GT.0)THEN | |
771 | * | |
772 | * Impact point on the ZDC (either ZPRO or ZNEU) | |
773 | * | |
774 | NLEV0=NLEVEL | |
775 | CALL GFPATH(ISET,IDET,NUMBV,NLEV,LNAM,LNUM) | |
776 | CALL UCTOH('ZNEU',IZNEU,4,4) | |
777 | CALL UCTOH('ZPRO',IZPRO,4,4) | |
778 | DO I=NLEV,1,-1 | |
779 | IF(LNAM(I).EQ.IZNEU.OR.LNAM(I).EQ.IZPRO)THEN | |
780 | NLEVEL=0 | |
781 | CALL GLVOLU(I,LNAM,LNUM,IER) | |
782 | IF(IDTYPE.EQ.1)THEN | |
783 | CALL GMTOD(VECT,HITSBUPN(3),1) | |
784 | HITSBUPP(3)=99. | |
785 | HITSBUPP(4)=99. | |
786 | ELSE IF(IDTYPE.EQ.2)THEN | |
787 | CALL GMTOD(VECT,HITSBUPP(3),1) | |
788 | HITSBUPN(3)=99. | |
789 | HITSBUPN(4)=99. | |
790 | ENDIF | |
791 | NLEVEL=NLEV0 | |
792 | GOTO 10 | |
793 | ENDIF | |
794 | ENDDO | |
795 | 10 CONTINUE | |
796 | * | |
797 | * Particle type and energy for the primary track | |
798 | * | |
799 | CALL GFKINE(ITRA,VERT0,PVERT0,IPART0,NVERT0,UB,NB) | |
800 | CALL GFPART(IPART0,CHNPART0,ITRTYP0,AMASS0,CHARGE0,TLIFE0, | |
801 | + UB,NB) | |
802 | PVERTM=VMOD(PVERT0,3) | |
803 | GEKIN0=SQRT(PVERTM**2+AMASS0**2) | |
804 | IF(IPART.NE.IPART0.OR.GEKIN.LT.GEKIN0*0.95)THEN | |
805 | HITSBUPP(1)=FLOAT(IPART0) | |
806 | HITSBUPP(2)=GEKIN0 | |
807 | HITSBUPP(5)=1. | |
808 | HITSBUPN(1)=FLOAT(IPART0) | |
809 | HITSBUPN(2)=GEKIN0 | |
810 | HITSBUPN(5)=1. | |
811 | ELSE | |
812 | HITSBUPP(1)=FLOAT(IPART) | |
813 | HITSBUPP(2)=GEKIN | |
814 | HITSBUPP(5)=0. | |
815 | HITSBUPN(1)=FLOAT(IPART) | |
816 | HITSBUPN(2)=GEKIN | |
817 | HITSBUPN(5)=0. | |
818 | ENDIF | |
819 | HITSBUPP(6)=0. | |
820 | HITSBUPP(7)=0. | |
821 | HITSBUPN(6)=0. | |
822 | HITSBUPN(7)=0. | |
823 | IF(IDTYPE.EQ.1)THEN | |
824 | CALL GSAHIT(ISET,IDET,ITRA,NUMBV,HITSBUPN,IHIT) | |
825 | ELSE IF(IDTYPE.EQ.2)THEN | |
826 | CALL GSAHIT(ISET,IDET,ITRA,NUMBV,HITSBUPP,IHIT) | |
827 | ENDIF | |
828 | ITOLD=ITRA | |
829 | ENDIF | |
830 | ENDIF | |
831 | * | |
832 | * Energy deposition in the passive material | |
833 | * | |
834 | IF(INWVOL.EQ.0.AND.IDTYPE.GT.0)THEN | |
835 | HITS(6)=0. | |
836 | IF(ISTOP.EQ.2)THEN | |
837 | HITS(7)=GEKIN | |
838 | ELSE | |
839 | HITS(7)=DESTEP | |
840 | ENDIF | |
841 | IF(IDTYPE.EQ.1)THEN | |
842 | DO KCOPY=1,5 | |
843 | HITSBUPN(KCOPY)=HITS(KCOPY) | |
844 | ENDDO | |
845 | ELSE IF(IDTYPE.EQ.2)THEN | |
846 | DO KCOPY=1,5 | |
847 | HITSBUPP(KCOPY)=HITS(KCOPY) | |
848 | ENDDO | |
849 | ENDIF | |
850 | CALL GSCHIT(ISET,IDET,ITRA,NUMBV,HITS,NHSUM,IHIT) | |
851 | ENDIF | |
852 | * | |
853 | * Select charged relativistic particles | |
854 | * | |
855 | IF(ABS(CHARGE).EQ.0)RETURN | |
856 | IF(GEKIN.GT.0.00001) THEN | |
857 | BETA = VECT(7)/GETOT | |
858 | ELSE | |
859 | RETURN | |
860 | ENDIF | |
861 | IF(BETA.LT.0.67) RETURN | |
862 | ||
863 | * | |
864 | * Particle inside fiber | |
865 | * | |
866 | IF(NUMED.EQ.803.AND.IDTYPE.GT.0) THEN | |
867 | * | |
868 | XLOCM(1)= VECT(1) | |
869 | XLOCM(2)= VECT(2) | |
870 | XLOCM(3)= VECT(3) | |
871 | XANGM(1)= VECT(4) | |
872 | XANGM(2)= VECT(5) | |
873 | XANGM(3)= VECT(6) | |
874 | * | |
875 | * --- Calculating the position of the centre of the fiber in MARS | |
876 | DO KZERO=1,3 | |
877 | FNULA(KZERO)=0 | |
878 | ZENTR(KZERO)=0 | |
879 | ENDDO | |
880 | CALL GDTOM(FNULA,ZENTR,1) | |
881 | * | |
882 | * --- Angle between the particle trajectory and the fiber axis | |
883 | * | |
884 | CALL GMTOD(XANGM,XANGL,2) | |
885 | IF(XANGL(3).GT.1.0) XANGL(3)=SIGN(1.0,XANGL(3)) | |
886 | ALFAR=ACOS(XANGL(3)) | |
887 | ALFAD=ALFAR*RADDEG | |
888 | * | |
889 | IF (ALFAD.GT.ALFMAX) RETURN | |
890 | IALFA = INT(1.+ALFAD/2.) | |
891 | * | |
892 | * --- Distance between the particle trajectory and the fiber axis | |
893 | * | |
894 | CALL GMTOD(XLOCM,XLOCL,1) | |
895 | IF(ABS(XANGL(1)).GT.0.0001) THEN | |
896 | DCOEFF = XANGL(2)/XANGL(1) | |
897 | BE=ABS(XLOCL(2)-DCOEFF*XLOCL(1))/SQRT(DCOEFF*DCOEFF+1.) | |
898 | ELSE | |
899 | BE = ABS(XLOCL(1)) | |
900 | ENDIF | |
901 | IF(IDTYPE.EQ.1)THEN | |
902 | RADIUS=FIZN(2) | |
903 | ELSEIF(IDTYPE.EQ.2)THEN | |
904 | RADIUS=FIZP(2) | |
905 | ENDIF | |
906 | IF(BE.GT.RADIUS) THEN | |
907 | PRINT*,'DISTANCE GREATER THAN FIBER RADIUS' | |
908 | RETURN | |
909 | ENDIF | |
910 | IBE = 1+INT(1000.*BE) | |
911 | IF(IBE.GT.NBE)IBE=NBE | |
912 | * | |
913 | * --- Finding out proper index for beta | |
914 | IF(BETA.GE.0.67 .AND. BETA.LE.0.75) IBETA=1 | |
915 | IF(BETA.GT.0.75 .AND. BETA.LE.0.85) IBETA=2 | |
916 | IF(BETA.GT.0.85 .AND. BETA.LE.0.95) IBETA=3 | |
917 | IF(BETA.GT.0.95 .AND. BETA.LE.1.00) IBETA=4 | |
918 | * | |
919 | * --- Looking into the tables | |
920 | OUT = CHARGE*CHARGE*TABLE(IBETA,IALFA,IBE) | |
921 | CALL RNPSSN(OUT,N,IERROR) | |
922 | HITS(6)=FLOAT(N) | |
923 | HITS(7)=0. | |
924 | IF(IDTYPE.EQ.1)THEN | |
925 | CALL UCOPY(HITSBUPN,HITS,4) | |
926 | ELSE IF(IDTYPE.EQ.2)THEN | |
927 | CALL UCOPY(HITSBUPP,HITS,4) | |
928 | ENDIF | |
929 | CALL GSCHIT(ISET,IDET,ITRA,NUMBV,HITS,NHSUM,IHIT) | |
930 | ENDIF | |
931 | * | |
932 | 999 END | |
933 | ||
934 | *CMZ : 18/11/98 16.55.53 by Federico Carminati | |
935 | *CMZ : 2.03/01 06/08/98 10.13.59 by Federico Carminati | |
936 | *-- Author : E. SCOMPARIN | |
937 | SUBROUTINE ZDC_TRKI(IFLAG) | |
938 | C | |
939 | C *** DEFINITION OF THE GEOMETRY OF THE PHOS *** | |
940 | C *** NVE 24-SEP-1990 CERN GENEVA *** | |
941 | C | |
942 | C CALLED BY : SXTRKI | |
943 | C ORIGIN : E. SCOMPARIN | |
944 | C | |
945 | #undef CERNLIB_GEANT321_GCKINE_INC | |
946 | #undef CERNLIB_GEANT321_GCKMAX_INC | |
947 | #undef CERNLIB_GEANT321_GCKING_INC | |
948 | #undef CERNLIB_GEANT321_GCTRAK_INC | |
949 | #undef CERNLIB_GEANT321_GCTMED_INC | |
950 | #undef CERNLIB_GEANT321_GCFLAG_INC | |
951 | #undef CERNLIB_GEANT321_GCMATE_INC | |
952 | #include "geant321/gckine.inc" | |
953 | #include "geant321/gcking.inc" | |
954 | #include "geant321/gctrak.inc" | |
955 | #include "geant321/gctmed.inc" | |
956 | #include "geant321/gcflag.inc" | |
957 | #include "geant321/gcmate.inc" | |
958 | #include "zdc_common.inc" | |
959 | ||
960 | REAL UBUF(1) | |
961 | DATA ITOLDG/0/ | |
962 | ||
963 | * Fetch new track (VENUS or HIJING) | |
964 | IF(ITRA.NE.ITOLDG)THEN | |
965 | CALL GFKINE(ITRA,VERT,PVERT,IPART,NVERT,UBUF,NUBUF) | |
966 | IFLPART=INT(UBUF(1)) | |
967 | IF(IHIJ.EQ.2.OR.IVNU.EQ.2)WRITE(6,*)'ITRA,IFLPART ',ITRA, | |
968 | + IFLPART | |
969 | ITOLDG=ITRA | |
970 | ENDIF | |
971 | * | |
972 | END | |
973 | ||
974 | *CMZ : 15/02/99 14.40.30 by Federico Carminati | |
975 | *-- Author : Rene Brun | |
976 | SUBROUTINE ZDC_DEFS | |
977 | C | |
978 | C *** DEFINITION OF THE ZDC parameters | |
979 | C CALLED BY : SXDEFS | |
980 | C | |
981 | end | |
982 | ||
983 | subroutine zdc_setbeam(beam, fxoff, fyoff, sx, sy, | |
984 | + div, angle, cross) | |
985 | * beam : 1 = gaussian beam | |
986 | * : 2 = uniform beam | |
987 | * fxoff : x-coordinate of beam offset | |
988 | * fyoff : y-coordinate of beam offset | |
989 | * sx : sigma-x of the beam (gaussian or uniform) | |
990 | * sy : sigma-y of the beam (gaussian or uniform) | |
991 | * div : divergency of the beam (32*10**-6 rad for LHC) | |
992 | * angle : beam crossing angle (100*10**-6 rad for LHC) | |
993 | * cross : 1 = horizontal beam crossing | |
994 | * : 2 = vertical beam crossing | |
995 | #include "zdc_common.inc" | |
996 | integer beam, cross | |
997 | real fxoff,fyoff,sx,sy,div,angle | |
998 | beamty = type | |
999 | fx = fxoff | |
1000 | fy = fyoff | |
1001 | sigx = sx | |
1002 | sigy = sy | |
1003 | bmdiv = div | |
1004 | bmcra = angle | |
1005 | iflcr = cross | |
1006 | end | |
1007 | ||
1008 | subroutine zdc_sethijing(hij, hijf, hijsp, file) | |
1009 | * IHIJ : 1 = read HIJING event file | |
1010 | * : 2 = " " " " + debug | |
1011 | * IHIJF : event number of the first event to be read from file | |
1012 | * IHIJSP: 0 = read all particles | |
1013 | * : 1 = remove spectator nucleons | |
1014 | #include "zdc_common.inc" | |
1015 | integer hij,hijf,hijsp | |
1016 | character *(*) file | |
1017 | ihij = hij | |
1018 | ihijf = hijf | |
1019 | ihijsp = hijsp | |
1020 | fileh = file | |
1021 | end | |
1022 | ||
1023 | subroutine zdc_setvenus(hiv, hivf, hivsp, file) | |
1024 | * IHIV : 1 = read VENUS event file | |
1025 | * : 2 = " " " " + debug | |
1026 | * IHIVF : event number of the first event to be read from file | |
1027 | * IHIVSP: 0 = read all particles | |
1028 | * : 1 = remove spectator nucleons | |
1029 | #include "zdc_common.inc" | |
1030 | integer hiv,hivf,hivsp | |
1031 | character *(*) file | |
1032 | ihiv = hiv | |
1033 | ihivf = hivf | |
1034 | ihivsp = hivsp | |
1035 | filev = file | |
1036 | end | |
1037 | ||
1038 | subroutine zdc_setkine(code, pmom, cx, cy, cz, type, fermi) | |
1039 | * code : GEANT code of the test particle | |
1040 | * pmom : absolute value of particle momentum | |
1041 | * cx,cy,cz : director cosines of the track (if type) | |
1042 | * type : 0 = take director cosines from cx,cy,cz) | |
1043 | * : <>0 = pseudorapidity of the test particle | |
1044 | * fermi : 0 = no Fermi motion for the spectator nucleons | |
1045 | * : 1 = Fermi motion for the spectator nucleons | |
1046 | #undef CERNLIB_GEANT321_GCKINE_INC | |
1047 | #include "geant321/gckine.inc" | |
1048 | #include "zdc_common.inc" | |
1049 | integer code,type,fermi | |
1050 | real pmom,cx,cy,cz | |
1051 | pkine(1) = code | |
1052 | pkine(2) = pmom | |
1053 | pkine(3) = cx | |
1054 | pkine(4) = cy | |
1055 | pkine(5) = cz | |
1056 | pkine(6) = type | |
1057 | ifermi = fermi | |
1058 | end | |
1059 | *CMZ : 19/11/98 09.31.36 by Federico Carminati | |
1060 | *-- Author : Federico Carminati 19/11/98 | |
1061 | SUBROUTINE SXGAUS(RVEC,N) | |
1062 | #undef CERNLIB_GEANT321_GCONSP_INC | |
1063 | #include "geant321/gconsp.inc" | |
1064 | *KEND. | |
1065 | * | |
1066 | * Vector of random numbers distributed like a gaussian | |
1067 | DIMENSION RNDM(2), RVEC(N) | |
1068 | DO K=1,(N-1)/2+1 | |
1069 | CALL GRNDM(RNDM,2) | |
1070 | PHI = TWOPI*RNDM(1) | |
1071 | RHO = SQRT(-2.*LOG(RNDM(2))) | |
1072 | RVEC(2*K-1) = RHO*SIN(PHI) | |
1073 | IF(2*K.LE.N) RVEC(2*K ) = RHO*COS(PHI) | |
1074 | ENDDO | |
1075 | * | |
1076 | END |