This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / erdecks / ertrgo.F
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 *
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       Perform the tracking of the track                        *
17 C.    *       Track parameters are in VECT                             *
18 C.    *                                                                *
19 C.    *    ==>Called by : ERTRAK                                       *
20 C.    *       Original routines : GTRACK + GTVOL                       *
21 C.    *       Authors   M.Maire, E.Nagy  *********                     *
22 C.    *                                                                *
23 C.    ******************************************************************
24 C.
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
58 C.
59 C.    ------------------------------------------------------------------
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
147 10000          FORMAT(' *** ERTRGO *** Boundary loop: track ',
148      +         I4,' stack ',I4,' NTMULT ',I5,1X,5A4)
149             CALL GMAIL(1,0)
150             WRITE(CHMAIL,10100) EPSCUR
151 10100          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