Better printing for MAXSTEP
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / gtrack.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
97f74af4 5* Revision 1.1.1.1 1999/05/18 15:55:21 fca
6* AliRoot sources
7*
fe4da5cc 8* Revision 1.1.1.1 1995/10/24 10:21:44 cernlib
9* Geant
10*
11*
12#include "geant321/pilot.h"
13*CMZ : 3.21/02 29/03/94 15.41.24 by S.Giani
14*FCA : 17/05/99 16:21:12 by Federico Carminati
15* Added the modifications of P.Nevski in MANY volumes
16* force update of alternative list of many candidates
17*-- Author :
18 SUBROUTINE GTRACK
19C.
20C. ******************************************************************
21C. * *
22C. * Controls tracking of current particle, *
23C. * up to end of track for sequential tracking mode, or *
24C. * through current volume for parallel tracking mode. *
25C. * *
26C. * ==>Called by : GUTRAK *
27C. * Authors : R.Brun, F.Bruyant *
28C. * *
29C. ******************************************************************
30C.
31#include "geant321/gcbank.inc"
32#include "geant321/gccuts.inc"
33#include "geant321/gcjloc.inc"
34#include "geant321/gckine.inc"
35#include "geant321/gcking.inc"
36#include "geant321/gcmate.inc"
37#include "geant321/gcphys.inc"
38#include "geant321/gcparm.inc"
39#include "geant321/gcsets.inc"
40#include "geant321/gcstak.inc"
41#include "geant321/gctmed.inc"
42#include "geant321/gctrak.inc"
43#include "geant321/gcvolu.inc"
44#include "geant321/gcunit.inc"
45#include "geant321/gcflag.inc"
46#include "geant321/gcnum.inc"
47#if defined(CERNLIB_USRJMP)
48#include "geant321/gcjump.inc"
49#endif
50 COMMON/GCCHAN/LSAMVL
51 LOGICAL LSAMVL
52*
53 DIMENSION CUTS(10),MECA(5,13)
54 EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR)
55 SAVE PRECOR
56#if !defined(CERNLIB_SINGLE)
57 PARAMETER (EPSMAC=1.E-6)
58#endif
59#if defined(CERNLIB_SINGLE)
60 PARAMETER (EPSMAC=1.E-11)
61#endif
62C.
63C. ------------------------------------------------------------------
64 ISTOP = 0
65 EPSCUR = EPSMAC
66 NSTOUT = 0
67 INWOLD = 0
68 LSAMVL = .FALSE.
69*
70* *** Check validity of tracking medium and material parameters
71*
72 10 IF (NUMED.NE.NUMOLD) THEN
73 NUMOLD = NUMED
74 IUPD = 0
75 JTM = LQ(JTMED- NUMED)
76 DO 20 I = 1,5
77 NATMED(I) = IQ(JTM+I)
78 20 CONTINUE
79 NMAT = Q(JTM + 6)
80 ISVOL = Q(JTM + 7)
81 IFIELD = Q(JTM + 8)
82 FIELDM = Q(JTM + 9)
83 TMAXFD = Q(JTM + 10)
84 STEMAX = Q(JTM + 11)
85 DEEMAX = Q(JTM + 12)
86 EPSIL = Q(JTM + 13)
87 STMIN = Q(JTM + 14)
88 PRECOR = MIN(0.1*EPSIL, 0.0010)
89 IF (LQ(JTM).EQ.0) THEN
90 IF (ISTPAR.NE.0) THEN
91 DO 30 I = 1,10
92 CUTS(I) = Q(JTMED+I)
93 30 CONTINUE
94 DO 40 I = 1,13
95 MECA(1,I) = Q(JTMED+10+I)
96 40 CONTINUE
97 ILABS = Q(JTMED+10+21)
98 ISYNC = Q(JTMED+10+22)
99 ISTRA = Q(JTMED+10+23)
100 ISTPAR = 0
101 ENDIF
102 ELSE
103 JTMN = LQ(JTM)
104 DO 50 I = 1,10
105 CUTS(I) = Q(JTMN+I)
106 50 CONTINUE
107 DO 60 I = 1,13
108 MECA(1,I) = Q(JTMN+10+I)
109 60 CONTINUE
110 ILABS = Q(JTMN+10+21)
111 ISYNC = Q(JTMN+10+22)
112 ISTRA = Q(JTMN+10+23)
113 ISTPAR = 1
114 ENDIF
115*
116 JMA = LQ(JMATE-NMAT)
117 JPROB = LQ(JMA-4)
118 JMIXT = LQ(JMA-5)
119 DO 70 I = 1,5
120 NAMATE(I) = IQ(JMA+I)
121 70 CONTINUE
122 A = Q(JMA +6)
123 Z = Q(JMA +7)
124 DENS = Q(JMA +8)
125 RADL = Q(JMA +9)
126 ABSL = Q(JMA +10)
127 IF(IQ(JTM-2).GE.3.AND.LQ(JTM-3).NE.0.AND.ITCKOV.NE.0.AND.
128 + LQ(LQ(JTM-3)-3).NE.0.AND.Z.GE.1.) THEN
129*
130* *** In this tracking medium Cerenkov photons are generated and
131* *** tracked. Set to 1 the corresponding flag.
132*
133 IMCKOV = 1
134 ELSE
135 IMCKOV = 0
136 ENDIF
137*
138*
139* ** Update precomputed quantities
140*
141 IMULL = IMULS
142 IF (ILOSS.LE.0) THEN
143 DEEMAX = 0.
144 ILOSL = 0
145 ELSEIF (DEEMAX.GT.0.) THEN
146 ILOSL = ILOSS
147 ELSE
148 ILOSL = 0
149 ENDIF
150 ENDIF
151*
152 IF(LSAMVL) THEN
153*
154* If now the particle is entering in the same volume where
155* it was exiting from last step, and if it has done this for
156* more than 5 times, we decrease the precision of tracking
157 NSTOUT=NSTOUT+1
158 IF(MOD(NSTOUT,5).EQ.0) THEN
159 EPSCUR=NSTOUT*EPSMAC
160* WRITE(CHMAIL,10000)ITRA,ISTAK,NTMULT,NAPART
161*10000 FORMAT(' *** GTRACK *** Boundary loop: track ',
162* + I4,' stack ',I4,' NTMULT ',I5,1X,5A4)
163* CALL GMAIL(1,0)
164* WRITE (CHMAIL,10250) IEVENT,IDEVT,(NRNDM(I),I = 1,2)
165* CALL GMAIL(0,0)
166* WRITE(CHMAIL,10100) EPSCUR
167*10100 FORMAT(' Precision now set to ',G10.3)
168* CALL GMAIL(0,1)
169 ENDIF
170 ELSE
171 NSTOUT = 0
172 EPSCUR = EPSMAC
173 ENDIF
174*
175 INWVOL = 1
176*
177* *** Compute SET and DET number if volume is sensitive
178*
179 IF (JSET.GT.0) THEN
180 IF(ISVOL.GT.0) THEN
181 CALL GFINDS
182 ELSE
183 IHSET = 0
184 IHDET = 0
185 ISET = 0
186 IDET = 0
187 IDTYPE = 0
188 NVNAME = 0
189 ENDIF
190 ENDIF
191*
192* Clear step dependent variables
193*
194 80 NMEC = 0
195 STEP = 0.
196 DESTEL = 0.
197 DESTEP = 0.
198 NGKINE = 0
199 NGPHOT = 0.
200 IGNEXT = 0
201 INWOLD = INWVOL
202 PREC = MAX(PRECOR,MAX(ABS(VECT(1)),ABS(VECT(2)),
203 + ABS(VECT(3)),SLENG)*EPSCUR)
204*
205* Give control to user at entrance of volume (INWVOL=1)
206*
207 IF (INWVOL.EQ.1) THEN
208#if !defined(CERNLIB_USRJMP)
209 CALL GUSTEP
210#endif
211#if defined(CERNLIB_USRJMP)
212 CALL JUMPT0(JUSTEP)
213#endif
214 IF (ISTOP.NE.0) GO TO 999
215 INWVOL = 0
216 ENDIF
217*
218* *** Propagate particle up to next volume boundary or end of track
219*
220 INGOTO = 0
221 NLEVIN = NLEVEL
222 IF (IPARAM.NE.0) THEN
223 IF (GEKIN.LE.PACUTS(ITRTYP)) THEN
224 NMEC = NMEC+1
225 LMEC(NMEC) = 26
226 ISTOP = 2
227#if !defined(CERNLIB_USRJMP)
228 CALL GUPARA
229#endif
230#if defined(CERNLIB_USRJMP)
231 CALL JUMPT0(JUPARA)
232#endif
233 GO TO 90
234 ENDIF
235 ENDIF
236 IF (ITRTYP.EQ.1) THEN
237 CALL GTGAMA
238 ELSE IF (ITRTYP.EQ.2) THEN
239 CALL GTELEC
240 ELSE IF (ITRTYP.EQ.3) THEN
241 CALL GTNEUT
242 ELSE IF (ITRTYP.EQ.4) THEN
243 CALL GTHADR
244 ELSE IF (ITRTYP.EQ.5) THEN
245 CALL GTMUON
246 ELSE IF (ITRTYP.EQ.6) THEN
247 CALL GTNINO
248 ELSE IF (ITRTYP.EQ.7) THEN
249 CALL GTCKOV
250 ELSE IF (ITRTYP.EQ.8) THEN
251 CALL GTHION
252 ENDIF
253 IF(JGSTAT.NE.0) CALL GFSTAT(10+ITRTYP)
254 STLOSS=STEP
255*
256* Check for possible endless loop
257*
258 90 NSTEP = NSTEP +1
259 IF (NSTEP.GT.MAXNST) THEN
260 IF (ISTOP.EQ.0) THEN
261 ISTOP = 99
262 NMEC = NMEC +1
263 LMEC(NMEC) = 30
264 WRITE(CHMAIL,10200) MAXNST
265 CALL GMAIL(1,0)
97f74af4 266 CALL GPCXYZ
267 WRITE(CHMAIL,10250) IEVENT,IDEVT,(NRNDM(I),I=1,2),TOFG*1.E9
fe4da5cc 268 CALL GMAIL(0,1)
26910200 FORMAT(' *** GTRACK *** More than ',I6,
270 + ' steps, tracking abandoned!')
97f74af4 27110250 FORMAT(' IEVENT ',I7,' IDEVT ',I7,' Random Seeds ',I10,2X
272 $ ,I10,' Time of flight ',F10.3,' ns')
fe4da5cc 273 ENDIF
274 ENDIF
275*
276* *** Give control to user at end of each tracking step
277*
278 SAFETY = SAFETY -STEP
279#if !defined(CERNLIB_USRJMP)
280 CALL GUSTEP
281#endif
282#if defined(CERNLIB_USRJMP)
283 CALL JUMPT0(JUSTEP)
284#endif
285*
286 IF (ISTOP.NE.0) GO TO 999
287*
288* Renormalize direction cosines
289*
290 PMOM = SQRT(VECT(4)**2+VECT(5)**2+VECT(6)**2)
291 IF(PMOM.GT.0.) THEN
292 CMOD = 1./PMOM
293 VECT(4) = VECT(4)*CMOD
294 VECT(5) = VECT(5)*CMOD
295 VECT(6) = VECT(6)*CMOD
296 ENDIF
297* force update of alternatives:
298 IF (INWVOL.EQ.0) then
299 if (GONLY(NLEVEL).eq.0.and.Safety.le.0.and.Iswit(10).ge.0)
300 + CALL GTMEDI(VECT,NMED)
301 GO TO 80
302 endif
303*
304 IF (NJTMAX.GT.0) THEN
305 CALL GSTRAC
306 IF (NLEVIN.EQ.0) GO TO 100
307 GO TO 999
308 ELSE
309 IF (NLEVIN.GE.NLEVEL) THEN
310 INFROM = 0
311 ELSE
312 IF (NLEVIN.EQ.0) GO TO 100
313 INFROM = LINDEX(NLEVIN+1)
314 ENDIF
315 IF (NLEVIN.NE.NLEVEL) INGOTO = 0
316 NLEVEL = NLEVIN
317*
318 CALL GTMEDI (VECT, NUMED)
319 IF (NUMED.NE.0) THEN
320 SAFETY = 0.
321 GO TO 10
322 ENDIF
323 ENDIF
324*
325* Track outside setup, give control to user (INWVOL=3)
326*
327 100 INWVOL = 3
328 ISTOP = 1
329 ISET = 0
330 IDET = 0
331 NMEC = 0
332 STEP = 0.
333 DESTEL = 0.
334 DESTEP = 0.
335 NGKINE = 0
336 NLCUR = NLEVEL
337 NLEVEL = 1
338#if !defined(CERNLIB_USRJMP)
339 CALL GUSTEP
340#endif
341#if defined(CERNLIB_USRJMP)
342 CALL JUMPT0(JUSTEP)
343#endif
344 NLEVEL = NLCUR
345* END GTRACK
346 999 END