Put headers before libraries in the make.
[u/mrichter/AliRoot.git] / ZDC / AliZDCf.F
CommitLineData
fe4da5cc 1*CMZ : 19/11/98 21.32.03 by Federico Carminati
2*-- Author :
3C***********************************************************************
4C
5 SUBROUTINE ZDC_ADDANG(THETA1,PHI1,THETA2,PHI2,THETA3,PHI3)
6C
7C This subroutine takes spherical polar angles THETA1 and PHI1
8C and adds to them the direction PHI2 on a cone of half-opening angle
9C THETA2 (= angle from cone axis to cone surface) to produce
10C the new space angles THETA3 and PHI3. All angles are in
11C degrees, with 0<=THETA<=180 and 0<=PHI<360. There is no
12C other restriction on THETA1, PHI1, THETA2 or PHI2.
13C
14C 27-AUG-1992 S. Coutu
15C
16C***********************************************************************
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
22C
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
34C
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 :
51C==================================================================
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
87C
88C *** TERMINATION OF THE ZDC SIMULATION AT THE END OF A RUN ***
89C
90C CALLED BY : SXEND
91C ORIGIN : E. SCOMPARIN
92C
93C
94* CALL HROUT(0,ICYCLE,' ')
95* CALL HREND('ALIZ')
96* CLOSE(1)
97
98 PRINT 10000
9910000 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
109C
110C *** TERMINATION OF THE ZDC SIMULATION AFTER EACH EVENT ***
111C
112C CALLED BY : SXEVE
113C ORIGIN : E. SCOMPARIN
114C
115C -- 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*
151C -- 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 :
228C==================================================================
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 :
262C-- Author : E.SCOMPARIN, 07/05/1996
263 SUBROUTINE ZDC_INIT
264C
265C *** INITIALISATION FOR THE ZDC SIMULATION ***
266C
267C CALLED BY : SXINIT
268C ORIGIN : E. SCOMPARIN
269C
270C
271#undef CERNLIB_GEANT321_GCFLAG_INC
272#include "geant321/gcflag.inc"
273#undef CERNLIB_GEANT321_GCKINE_INC
274#include "geant321/gckine.inc"
275C
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/
282C 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
32710000 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
346C GET FERMI MOMENTUM DISTRIBUTIONS
347 CALL ZDC_GFERMI(207.,82.)
348C
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
36010100 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
626c 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*
645C
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"
662C
663#undef CERNLIB_GEANT321_GCONSP_INC
664#include "geant321/gconsp.inc"
665#include "zdc_common.inc"
666C
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)
672C
673C TAKE NON-ZERO DIVERGENCY
674c 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
682C--- TETDIV is given in radiants and it is read by data cards
683 CALL RNORML(RVEC,1)
684c WRITE(6,*)RVEC
685 TETDIV=PKINE(10)*ABS(RVEC(1))
686C--- 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
708C write(6,*)' TETPART= ',tetpart,' FIPART= ',fipart
709 TETDIV=TETDIV*RADDEG
710 FIDIV=FIDIV*RADDEG
711 TETPART=TETPART*RADDEG
712 FIPART=FIPART*RADDEG
713c CALL ZDC_ADDANG(TETDIV,FIDIV,TETPART,FIPART,TETSUM,FISUM)
714 CALL ZDC_ADDANG(TETPART,FIPART,TETDIV,FIDIV,TETSUM,FISUM)
715C 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)
721C 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
729C
730C *** RECORDING OF ZDC HITS AFTER EACH TRACKING STEP ***
731C
732C CALLED BY : SXSTEP
733C ORIGIN : E. SCOMPARIN
734C
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)
938C
939C *** DEFINITION OF THE GEOMETRY OF THE PHOS ***
940C *** NVE 24-SEP-1990 CERN GENEVA ***
941C
942C CALLED BY : SXTRKI
943C ORIGIN : E. SCOMPARIN
944C
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
977C
978C *** DEFINITION OF THE ZDC parameters
979C CALLED BY : SXDEFS
980C
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