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