5 * Revision 1.1.1.1 1995/10/24 10:21:52 cernlib
9 #include "geant321/pilot.h"
10 *CMZ : 3.21/02 29/03/94 15.41.47 by S.Giani
14 #include "geant321/gctrak.inc"
15 #include "geant321/gcmate.inc"
16 #include "geant321/gcking.inc"
18 #include "geant321/mmicap.inc"
19 #include "geant321/minput.inc"
20 #include "geant321/mconst.inc"
21 COMMON/MNUTRN/NAME,NAMEX,E,EOLD,NMED,MEDOLD,NREG,U,V,W,
22 + UOLD,VOLD,WOLD,X,Y,ZZ,XOLD,YOLD,ZOLD,WATE,OLDWT,WTBC,
23 + BLZNT,BLZON,AGE,OLDAGE,INEU,ENE(MAXNEU)
25 #include "geant321/mapoll.inc"
26 #include "geant321/mpoint.inc"
27 #include "geant321/mrecoi.inc"
28 #include "geant321/mmass.inc"
29 #include "geant321/mpstor.inc"
30 #include "geant321/cmagic.inc"
31 #include "geant321/mcreco.inc"
33 C convert Z,A of recoil to CALOR particle code
34 C only p = 0, D = 7, T = 8, He3 = 9, alpha=10
35 * n = 13, p = 14, D = 45, T = 46, He3 = 49, alpha = 47
36 DIMENSION NGPART(4,0:2)
37 DATA ((NGPART(I,J),I=1,4),J=0,2)/13 ,-1 ,-1 ,
46 C first check, if ZEBRA still in order
47 IF(LD(LMAG1).NE.NMAGIC.OR.LD(LMAG2).NE.NMAGIC) THEN
48 WRITE(6,*) ' CALOR: ZEBRA banks screwed up --> STOP'
49 WRITE(IOUT,'('' MICAP: Magic number '',I12,'' not found: '', '
50 + //' 2I12)') NMAGIC,LD(LMAG1),LD(LMAG2)
53 C THIS ROUTINE PERFORMS THE RANDOM WALK FOR ALL PARTICLES
55 C get material and particle information
73 C Material number a la GEANT
77 C reset counter of heavy/charged and gamma bank
95 C get total cross-section
96 CALL NSIGTA(E,NMED,TSIG,D,LD(LFP32),LD(LFP33))
97 C DETERMINE WHICH ISOTOPE HAS BEEN HIT
98 CALL ISOTPE(D,LD,LD(LFP10),D(LFP12),LD(LFP16),LD(LFP26),LD(LFP27),
99 + E,TSIG,IMED,IIN,IIM)
100 C THE PARAMETER (IIN) IS THE POINTER FOR ARRAYS DIMENSIONED BY
101 C (NNUC) AND THE PARAMETER (IIM) IS THE POINTER FOR ARRAYS
102 C DIMENSIONED BY (NMIX)
103 LD(LFP42+IMED-1)=LD(LFP42+IMED-1)+1
110 + LD(LFP20),LD(LFP21),LD(LFP22),LD(LFP23),LD(LFP24),
111 + LD(LFP25),LD(LFP26),LD(LFP27),LD(LFP28),LD(LFP29),LD(LFP30),
112 + LD(LFP31),D(LFP34),D(LFP35),LD(LFP41),LD(LFP41+NNUC),
113 + LD(LFP42),LD(LFP42+MEDIA),LD(LFP42+2*MEDIA),LD(LFP42+3*MEDIA),
114 + LD(LFP42+4*MEDIA),LD(LFP42+5*MEDIA),LD(LFP42+6*MEDIA),
115 + LD(LFP42+7*MEDIA),LD(LFP42+8*MEDIA),LD(LFP42+9*MEDIA),
116 + LD(LFP42+10*MEDIA),LD(LFP42+11*MEDIA),LD(LFP42+12*MEDIA),
117 + LD(LFP42+13*MEDIA),LD(LFP42+14*MEDIA),LD(LFP42+15*MEDIA),
118 + LD(LFP42+16*MEDIA),LD(LFP42+17*MEDIA),LD(LFP42+18*MEDIA),
119 + LD(LFP42+19*MEDIA),LD(LFP42+20*MEDIA),LD(LFP42+21*MEDIA),
120 + LD(LFP42+22*MEDIA),LD(LFP45),LD(LFP46),LD(LFP13),
121 + LD(LFP35+NQ*NNUC),D(LFP35+2*NQ*NNUC),IIN,IIM)
123 C -------- fill return arrays with generated particles ---------------
124 C first heavy/charged particles
129 C -------- store neutrons -------------------------------------
137 CALL GETPAR(IDNEU,N,IERR)
141 PGEANT = SQRT(TTKIN*(TTKIN+2*AGEMNE))
142 GKIN(1,NGKINE) = UP*PGEANT
143 GKIN(2,NGKINE) = VP*PGEANT
144 GKIN(3,NGKINE) = WP*PGEANT
145 GKIN(4,NGKINE) = TTKIN + AGEMNE
147 TOFD(NGKINE) = AGEP * 1.E-9
148 GPOS(1,NGKINE) = VECT(1)
149 GPOS(2,NGKINE) = VECT(2)
150 GPOS(3,NGKINE) = VECT(3)
151 * NPHETC = NPHETC + 1
152 * IF(NPHETC.GT.MXCP) NPHETC=MXCP
154 C kinetic energy in MeV
155 * EKINET(NPHETC) = EP * 1.E-6
156 * UCAL(NPHETC,1) = UP
157 * UCAL(NPHETC,2) = VP
158 * UCAL(NPHETC,3) = WP
159 * CALTIM(NPHETC) = AGEP
162 C -------- store heavy recoil products ------------------------
164 CALL GETPAR(IDHEVY,N,IERR)
166 C check particle type
169 IF(MA.LE.4.AND.MZ.LE.2) THEN
170 IF(NGPART(MA,MZ).EQ.-1) GOTO 40
172 C get heavy recoil nucleus
176 ERMED = ERMED + EP * 1.E-9
179 C store particle type
181 JPA = LQ(JPART-NGPART(MA,MZ))
184 PGEANT = SQRT(TTKIN*(TTKIN+2*AGEMAS))
185 GKIN(1,NGKINE) = UP*PGEANT
186 GKIN(2,NGKINE) = VP*PGEANT
187 GKIN(3,NGKINE) = WP*PGEANT
188 GKIN(4,NGKINE) = TTKIN + AGEMAS
189 GKIN(5,NGKINE) = NGPART(MA,MZ)
190 TOFD(NGKINE) = AGEP * 1.E-9
191 GPOS(1,NGKINE) = VECT(1)
192 GPOS(2,NGKINE) = VECT(2)
193 GPOS(3,NGKINE) = VECT(3)
194 * NPHETC = NPHETC + 1
195 * IF(NPHETC.GT.MXCP) NPHETC=MXCP
196 * IPCAL(NPHETC) = NPART(MA,MZ)
197 C kinetic energy in MeV
198 * EKINET(NPHETC) = EP * 1.E-6
199 * UCAL(NPHETC,1) = UP
200 * UCAL(NPHETC,2) = VP
201 * UCAL(NPHETC,3) = WP
202 * CALTIM(NPHETC) = AGEP
205 * Number of produced particles (may be > MXGKIN)
206 NNEHEG = NGKINE + NGAMA
208 C----------- get generated gammas --------------------
212 IF (NS.GE.NGAMA) GO TO 60
214 CALL GETPAR(IDGAMA,NS,IERR)
216 IF (NNEHEG-NREM.GT.MXGKIN) THEN
224 * Get the other gamma to be summed with the previous one
225 CALL GETPAR(IDGAMA,NS,IERR)
230 * Normalize the new direction cosines
231 WUP = SQRT(UP**2+VP**2+WP**2)
241 GKIN(1,NGKINE) = UP*PGEANT
242 GKIN(2,NGKINE) = VP*PGEANT
243 GKIN(3,NGKINE) = WP*PGEANT
244 GKIN(4,NGKINE) = PGEANT
246 TOFD(NGKINE) = AGEP * 1.E-9
247 GPOS(1,NGKINE) = VECT(1)
248 GPOS(2,NGKINE) = VECT(2)
249 GPOS(3,NGKINE) = VECT(3)
251 * NPHETC = NPHETC + 1
252 * IF(NPHETC.GT.MXCP) NPHETC=MXCP
254 * EKINET(NPHETC) = EP*1.E-6
255 * UCAL(NPHETC,1) = UP
256 * UCAL(NPHETC,2) = VP
257 * UCAL(NPHETC,3) = WP
258 * CALTIM(NPHETC) = AGEP
259 C nucleus is in ground state !
263 * only one neutron generated -> the particle is the same
264 60 IF (NGKINE.EQ.1.AND.GKIN(5,1).EQ.13) THEN
266 CALL GETPAR(IDNEU,1,IERR)
271 GETOT = GEKIN + AGEMNE
272 VECT(7) = SQRT(GEKIN*(GEKIN+2.*AGEMNE))
273 TOFG = TOFG + AGEP * 1.E-9
279 ELSEIF (MTP .EQ. 18) THEN
280 IF (NHEVY.GT.0) INTCAL = 15
281 ELSEIF (MTP .LT. 100) THEN
282 IF (NNEU .GT.0) INTCAL = 20
283 ELSEIF (MTP .EQ. 102) THEN
284 IF (NGAMA.GT.0) INTCAL = 18
285 ELSEIF (MTP .GE. 100) THEN
286 IF (NHEVY+NGAMA.GT.0) INTCAL = 16
288 IF(NNEU+NHEVY+NGAMA.GT.0.AND.INTCAL.EQ.0) INTCAL=12
289 KCASE = NAMEC(INTCAL)