Better printing for MAXSTEP
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / gtrack.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1999/05/18 15:55:21  fca
6 * AliRoot sources
7 *
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
19 C.
20 C.    ******************************************************************
21 C.    *                                                                *
22 C.    *       Controls tracking of current particle,                   *
23 C.    *        up to end of track for sequential tracking mode, or     *
24 C.    *        through current volume for parallel tracking mode.      *
25 C.    *                                                                *
26 C.    *    ==>Called by : GUTRAK                                       *
27 C.    *       Authors   : R.Brun, F.Bruyant                            *
28 C.    *                                                                *
29 C.    ******************************************************************
30 C.
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
62 C.
63 C.    ------------------------------------------------------------------
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)
266             CALL GPCXYZ
267             WRITE(CHMAIL,10250) IEVENT,IDEVT,(NRNDM(I),I=1,2),TOFG*1.E9
268             CALL GMAIL(0,1)
269 10200       FORMAT(' *** GTRACK *** More than ',I6,
270      +             ' steps, tracking abandoned!')
271 10250       FORMAT(' IEVENT ',I7,' IDEVT ',I7,' Random Seeds ',I10,2X
272      $           ,I10,' Time of flight ',F10.3,' ns')
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