Some function moved to AliZDC
[u/mrichter/AliRoot.git] / GEANT321 / erdecks / ertrgo.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1996/03/06 15:37:35 mclareni
6* Add geane321 source directories
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.49 by S.Giani
11*-- Author :
12 SUBROUTINE ERTRGO
13*
14C. ******************************************************************
15C. * *
16C. * Perform the tracking of the track *
17C. * Track parameters are in VECT *
18C. * *
19C. * ==>Called by : ERTRAK *
20C. * Original routines : GTRACK + GTVOL *
21C. * Authors M.Maire, E.Nagy ********* *
22C. * *
23C. ******************************************************************
24C.
25#include "geant321/gcbank.inc"
26#include "geant321/gcjloc.inc"
27#include "geant321/gccuts.inc"
28#include "geant321/gconst.inc"
29#include "geant321/gcphys.inc"
30#include "geant321/gckine.inc"
31#include "geant321/gcflag.inc"
32#include "geant321/gctmed.inc"
33#include "geant321/gcmate.inc"
34#include "geant321/gctrak.inc"
35#include "geant321/gcvolu.inc"
36#include "geant321/gcunit.inc"
37#include "geant321/gcnum.inc"
38#include "geant321/ertrio.inc"
39#include "geant321/erwork.inc"
40 COMMON/GCCHAN/LSAMVL
41 LOGICAL LSAMVL
42*
43*
44 DIMENSION CUTS(10),MECA(5,12)
45 EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR)
46 DIMENSION NAMIN(15),NUMIN(15),NAMOUT(15),NUMOUT(15)
47*
48 SAVE PRECOR,NSTOUT
49#if (!defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_IBM))
50 PARAMETER (EPSMAC=5.E-6)
51#endif
52#if (!defined(CERNLIB_SINGLE))&&(defined(CERNLIB_IBM))
53 PARAMETER (EPSMAC=5.E-5)
54#endif
55#if defined(CERNLIB_SINGLE)
56 PARAMETER (EPSMAC=1.E-11)
57#endif
58C.
59C. ------------------------------------------------------------------
60*
61 NSTOUT = 0
62 EPSCUR = EPSMAC
63 LSAMVL = .FALSE.
64 SLENG = 0.
65 ISTOP = 0
66 NUMED = 0
67 NUMOLD = 0
68 IUPD = 0
69 NMEC = 0
70 INGOTO = 0
71 INFROM = 0
72 SAFETY = 0.
73 MXNSTP = 1000
74 NSTEP = 0
75*
76 CALL GMEDIA(VECT,NUMED)
77 IF (NUMED.EQ.0) GO TO 200
78*
79* *** Come back here each time we enter into a new volume
80*
81 10 CONTINUE
82*
83* *** Get tracking medium and material parameters
84 IF (NUMED.NE.NUMOLD) THEN
85 NUMOLD = NUMED
86 IUPD = 0
87 JTM = LQ(JTMED- NUMED)
88 DO 20 I=1,5
89 NATMED(I)=IQ(JTM+I)
90 20 CONTINUE
91 NMAT = Q(JTM + 6)
92 ISVOL = Q(JTM + 7)
93 IFIELD = Q(JTM + 8)
94 FIELDM = Q(JTM + 9)
95 TMAXFD = Q(JTM + 10)
96 DMAXMS = Q(JTM + 11)
97 DEEMAX = Q(JTM + 12)
98 EPSIL = Q(JTM + 13)
99 STMIN = Q(JTM + 14)
100 PRECOR = MIN(0.1*EPSIL, 0.0010)
101*
102 IF(LQ(JTM).EQ.0)THEN
103 IF(ISTPAR.NE.0)THEN
104 DO 30 I=1,10
105 CUTS(I)=Q(JTMED+I)
106 30 CONTINUE
107 DO 40 I=1,12
108 MECA(1,I)=Q(JTMED+10+I)
109 40 CONTINUE
110 ISTPAR=0
111 ENDIF
112 ELSE
113 JTMN=LQ(JTM)
114 DO 50 I=1,10
115 CUTS(I)=Q(JTMN+I)
116 50 CONTINUE
117 DO 60 I=1,12
118 MECA(1,I)=Q(JTMN+10+I)
119 60 CONTINUE
120 ILABS = Q(JTMN+10+21)
121 ISYNC = Q(JTMN+10+22)
122 ISTRA = Q(JTMN+10+23)
123 ISTPAR=1
124 ENDIF
125*
126 JMA = LQ(JMATE- NMAT)
127 JPROB=LQ(JMA-4)
128 JMIXT=LQ(JMA-5)
129 DO 70 I=1,5
130 70 NAMATE(I)=IQ(JMA+I)
131 A = Q(JMA + 6)
132 Z = Q(JMA + 7)
133 DENS = Q(JMA + 8)
134 RADL = Q(JMA + 9)
135 ABSL = Q(JMA + 10)
136 ENDIF
137*
138 IF(LSAMVL) THEN
139*
140* If now the particle is entering in the same volume where
141* it was exiting from last step, and if it has done this for
142* more than 5 times, we decrease the precision of tracking
143 NSTOUT=NSTOUT+1
144 IF(MOD(NSTOUT,5).EQ.0) THEN
145 EPSCUR=NSTOUT*EPSMAC
146 WRITE(CHMAIL,10000)ITRA,ISTAK,NTMULT,NAPART
14710000 FORMAT(' *** ERTRGO *** Boundary loop: track ',
148 + I4,' stack ',I4,' NTMULT ',I5,1X,5A4)
149 CALL GMAIL(1,0)
150 WRITE(CHMAIL,10100) EPSCUR
15110100 FORMAT(' Precision now set to ',G10.3)
152 CALL GMAIL(0,1)
153 ENDIF
154 ELSE
155 NSTOUT = 0
156 EPSCUR = EPSMAC
157 ENDIF
158*
159* *** Initialize magnetic field for EMC package
160 HI(1) = 0.
161 HI(2) = 0.
162 HI(3) = 0.
163 IF (IFIELD.EQ.3) THEN
164 HI(3) = FIELDM
165 ELSEIF (IFIELD.NE.0) THEN
166 CALL GUFLD (VECT, HI)
167 ENDIF
168*
169* *** Control given to user at entrance of volume (INWVOL=1)
170 INWVOL = 1
171 NMEC = 1
172 LMEC(1) = 29
173 STEP = 0.
174 DESTEP = 0.
175*
176 IF((LEVOLU).AND.(SLENG.GT.0.)) THEN
177 IMEC = 0
178 CALL EVOLIO(NVLIN,NAMIN,NUMIN,NVLOUT,NAMOUT,NUMOUT)
179 DO 80 IPR =1,NEPRED
180 NAMPR = NAMEER(IPR)
181 NUMPR = NUMVER(IPR)
182 IOVPR = IOVLER(IPR)
183 IF (IOVPR.EQ.1) THEN
184 IV = IUCOMP(NAMPR,NAMIN ,NVLIN )
185 IF (IV.NE.0) THEN
186 IF (NUMPR.EQ.0) NUMPR = NUMIN (IV)
187 IF (NUMPR.EQ.NUMIN (IV)) THEN
188 NMEC = NMEC + 1
189 LMEC(NMEC) = 27
190 INLIST = IPR
191 CALL ERSTOR
192 ENDIF
193 ENDIF
194 ELSE IF (IOVPR.EQ.2) THEN
195 IV = IUCOMP(NAMPR,NAMOUT,NVLOUT)
196 IF (IV.NE.0) THEN
197 IF (NUMPR.EQ.0) NUMPR = NUMOUT(IV)
198 IF (NUMPR.EQ.NUMOUT(IV)) THEN
199 NMEC = NMEC + 1
200 LMEC(NMEC) = 27
201 INLIST = IPR
202 CALL ERSTOR
203 ENDIF
204 ENDIF
205 ENDIF
206*
207 80 CONTINUE
208*
209 ENDIF
210*
211 CALL EUSTEP
212 IF (ISTOP.NE.0) GO TO 999
213*
214* *** Particle is propagated up to the next volume boundary
215*
216 INWVOL=0
217*
218* *** Come back here after each step in the same volume
219 100 IGNEXT = 0
220 INGOTO = 0
221 NLEVIN = NLEVEL
222 NMEC = 0
223 STEP = 0.
224 DESTEP = 0.
225 DEDX2 = 0.
226 PREC = MAX(PRECOR,MAX(ABS(VECT(1)),ABS(VECT(2)),
227 + ABS(VECT(3)),SLENG)*EPSCUR)
228*
229 IF(CHARGE.NE.0.) THEN
230 CALL ERTRCH
231 ELSE
232 CALL ERTRNT
233 ENDIF
234*
235 NSTEP = NSTEP + 1
236 IF (NSTEP.GT.MXNSTP) THEN
237 ISTOP = 99
238 NMEC = NMEC + 1
239 LMEC(NMEC) = 30
240 ENDIF
241*
242 SAFETY = SAFETY - STEP
243 TLRAD = TLRAD + STEP/RADL
244 TLGCM2 = TLGCM2 + STEP*DENS
245*
246* *** Give control to user after each tracking step
247 CALL EUSTEP
248*
249 IF(ISTOP.NE.0) GO TO 999
250*
251* *** Renormalize direction cosines
252 CMOD = 1./SQRT(VECT(4)**2 + VECT(5)**2 + VECT(6)**2)
253 VECT(4) = VECT(4)*CMOD
254 VECT(5) = VECT(5)*CMOD
255 VECT(6) = VECT(6)*CMOD
256*
257 IF (INWVOL.EQ.0) GO TO 100
258*
259* *** Particle is leaving the volume (INWVOL=2) :
260*
261* Save the current volume's tree before leaving the volume
262 IF(LEVOLU) CALL EVOLIO(NVLIN,NAMIN,NUMIN,NVLOUT,NAMOUT,NUMOUT)
263*
264* find the new volume
265 IF (NLEVIN.GE.NLEVEL) THEN
266 INFROM = 0
267 ELSE
268 IF (NLEVIN.EQ.0) GO TO 200
269 INFROM = LINDEX (NLEVIN+1)
270 ENDIF
271 IF (NLEVIN.NE.NLEVEL) INGOTO = 0
272 NLEVEL = NLEVIN
273*
274 CALL GTMEDI (VECT,NUMED)
275 IF (NUMED.NE.0) THEN
276 SAFETY = 0.
277 GO TO 10
278 ENDIF
279*
280* *** Track outside setup, give control to user (INWVOL=3)
281 200 INWVOL= 3
282 ISTOP = 1
283 NMEC = NMEC + 1
284 LMEC(NMEC) = 30
285 CALL EUSTEP
286 999 CONTINUE
287 ILOSL = 0
288*
289 END