[u/mrichter/AliRoot.git] / GEANT321 / gtrak / gtrack.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:44  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.24  by  S.Giani
*FCA :          17/05/99  16:21:12  by  Federico Carminati
*               Added the modifications of P.Nevski in MANY volumes 
*               force update of alternative list of many candidates
*-- Author :
      SUBROUTINE GTRACK
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       Controls tracking of current particle,                   *
C.    *        up to end of track for sequential tracking mode, or     *
C.    *        through current volume for parallel tracking mode.      *
C.    *                                                                *
C.    *    ==>Called by : GUTRAK                                       *
C.    *       Authors   : R.Brun, F.Bruyant                            *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gccuts.inc"
#include "geant321/gcjloc.inc"
#include "geant321/gckine.inc"
#include "geant321/gcking.inc"
#include "geant321/gcmate.inc"
#include "geant321/gcphys.inc"
#include "geant321/gcparm.inc"
#include "geant321/gcsets.inc"
#include "geant321/gcstak.inc"
#include "geant321/gctmed.inc"
#include "geant321/gctrak.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcflag.inc"
#include "geant321/gcnum.inc"
#if defined(CERNLIB_USRJMP)
#include "geant321/gcjump.inc"
#endif
      COMMON/GCCHAN/LSAMVL
      LOGICAL LSAMVL
*
      DIMENSION CUTS(10),MECA(5,13)
      EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR)
      SAVE PRECOR
#if !defined(CERNLIB_SINGLE)
      PARAMETER (EPSMAC=1.E-6)
#endif
#if defined(CERNLIB_SINGLE)
      PARAMETER (EPSMAC=1.E-11)
#endif
C.
C.    ------------------------------------------------------------------
      ISTOP = 0
      EPSCUR = EPSMAC
      NSTOUT = 0
      INWOLD = 0
      LSAMVL = .FALSE.
*
* *** Check validity of tracking medium and material parameters
*
   10 IF (NUMED.NE.NUMOLD) THEN
         NUMOLD = NUMED
         IUPD   = 0
         JTM    = LQ(JTMED- NUMED)
         DO 20 I = 1,5
            NATMED(I) = IQ(JTM+I)
   20    CONTINUE
         NMAT     = Q(JTM + 6)
         ISVOL    = Q(JTM + 7)
         IFIELD   = Q(JTM + 8)
         FIELDM   = Q(JTM + 9)
         TMAXFD   = Q(JTM + 10)
         STEMAX   = Q(JTM + 11)
         DEEMAX   = Q(JTM + 12)
         EPSIL    = Q(JTM + 13)
         STMIN    = Q(JTM + 14)
         PRECOR   = MIN(0.1*EPSIL, 0.0010)
         IF (LQ(JTM).EQ.0) THEN
            IF (ISTPAR.NE.0) THEN
               DO 30 I = 1,10
                  CUTS(I) = Q(JTMED+I)
   30          CONTINUE
               DO 40 I = 1,13
                  MECA(1,I) = Q(JTMED+10+I)
   40          CONTINUE
               ILABS = Q(JTMED+10+21)
               ISYNC = Q(JTMED+10+22)
               ISTRA = Q(JTMED+10+23)
               ISTPAR = 0
            ENDIF
         ELSE
            JTMN = LQ(JTM)
            DO 50 I = 1,10
               CUTS(I) = Q(JTMN+I)
   50       CONTINUE
            DO 60 I = 1,13
               MECA(1,I) = Q(JTMN+10+I)
   60       CONTINUE
            ILABS = Q(JTMN+10+21)
            ISYNC = Q(JTMN+10+22)
            ISTRA = Q(JTMN+10+23)
            ISTPAR = 1
         ENDIF
*
         JMA   = LQ(JMATE-NMAT)
         JPROB = LQ(JMA-4)
         JMIXT = LQ(JMA-5)
         DO 70 I = 1,5
            NAMATE(I) = IQ(JMA+I)
   70    CONTINUE
         A    = Q(JMA +6)
         Z    = Q(JMA +7)
         DENS = Q(JMA +8)
         RADL = Q(JMA +9)
         ABSL = Q(JMA +10)
         IF(IQ(JTM-2).GE.3.AND.LQ(JTM-3).NE.0.AND.ITCKOV.NE.0.AND.
     +      LQ(LQ(JTM-3)-3).NE.0.AND.Z.GE.1.) THEN
*
* ***  In this tracking medium Cerenkov photons are generated and
* ***  tracked. Set to 1 the corresponding flag.
*
            IMCKOV = 1
         ELSE
            IMCKOV = 0
         ENDIF
*
*
*  **   Update precomputed quantities
*
         IMULL = IMULS
         IF (ILOSS.LE.0) THEN
            DEEMAX = 0.
            ILOSL = 0
         ELSEIF (DEEMAX.GT.0.) THEN
            ILOSL = ILOSS
         ELSE
            ILOSL = 0
         ENDIF
      ENDIF
*
      IF(LSAMVL) THEN
*
*       If now the particle is entering in the same volume where
*       it was exiting from last step, and if it has done this for
*       more than 5 times, we decrease the precision of tracking
         NSTOUT=NSTOUT+1
         IF(MOD(NSTOUT,5).EQ.0) THEN
            EPSCUR=NSTOUT*EPSMAC
*            WRITE(CHMAIL,10000)ITRA,ISTAK,NTMULT,NAPART
*10000          FORMAT(' *** GTRACK *** Boundary loop: track ',
*     +         I4,' stack ',I4,' NTMULT ',I5,1X,5A4)
*            CALL GMAIL(1,0)
*            WRITE (CHMAIL,10250) IEVENT,IDEVT,(NRNDM(I),I = 1,2)
*            CALL GMAIL(0,0)
*            WRITE(CHMAIL,10100) EPSCUR
*10100          FORMAT('                Precision now set to ',G10.3)
*            CALL GMAIL(0,1)
         ENDIF
      ELSE
         NSTOUT = 0
         EPSCUR = EPSMAC
      ENDIF
*
      INWVOL = 1
*
* *** Compute SET and DET number if volume is sensitive
*
      IF (JSET.GT.0) THEN
         IF(ISVOL.GT.0) THEN
            CALL GFINDS
         ELSE
            IHSET = 0
            IHDET = 0
            ISET = 0
            IDET = 0
            IDTYPE = 0
            NVNAME = 0
         ENDIF
      ENDIF
*
*    Clear step dependent variables
*
   80 NMEC   = 0
      STEP   = 0.
      DESTEL = 0.
      DESTEP = 0.
      NGKINE = 0
      NGPHOT = 0.
      IGNEXT = 0
      INWOLD = INWVOL
      PREC   = MAX(PRECOR,MAX(ABS(VECT(1)),ABS(VECT(2)),
     +                        ABS(VECT(3)),SLENG)*EPSCUR)
*
*     Give control to user at entrance of volume (INWVOL=1)
*
      IF (INWVOL.EQ.1) THEN
#if !defined(CERNLIB_USRJMP)
         CALL GUSTEP
#endif
#if defined(CERNLIB_USRJMP)
         CALL JUMPT0(JUSTEP)
#endif
         IF (ISTOP.NE.0) GO TO 999
         INWVOL = 0
      ENDIF
*
* *** Propagate particle up to next volume boundary or end of track
*
      INGOTO = 0
      NLEVIN = NLEVEL
      IF (IPARAM.NE.0) THEN
         IF (GEKIN.LE.PACUTS(ITRTYP)) THEN
            NMEC = NMEC+1
            LMEC(NMEC) = 26
            ISTOP = 2
#if !defined(CERNLIB_USRJMP)
            CALL GUPARA
#endif
#if defined(CERNLIB_USRJMP)
            CALL JUMPT0(JUPARA)
#endif
            GO TO 90
         ENDIF
      ENDIF
      IF      (ITRTYP.EQ.1) THEN
         CALL GTGAMA
      ELSE IF (ITRTYP.EQ.2) THEN
         CALL GTELEC
      ELSE IF (ITRTYP.EQ.3) THEN
         CALL GTNEUT
      ELSE IF (ITRTYP.EQ.4) THEN
         CALL GTHADR
      ELSE IF (ITRTYP.EQ.5) THEN
         CALL GTMUON
      ELSE IF (ITRTYP.EQ.6) THEN
         CALL GTNINO
      ELSE IF (ITRTYP.EQ.7) THEN
         CALL GTCKOV
      ELSE IF (ITRTYP.EQ.8) THEN
         CALL GTHION
      ENDIF
      IF(JGSTAT.NE.0) CALL GFSTAT(10+ITRTYP)
      STLOSS=STEP
*
*     Check for possible endless loop
*
   90 NSTEP = NSTEP +1
      IF (NSTEP.GT.MAXNST) THEN
         IF (ISTOP.EQ.0) THEN
            ISTOP = 99
            NMEC  = NMEC +1
            LMEC(NMEC) = 30
            WRITE(CHMAIL,10200) MAXNST
            CALL GMAIL(1,0)
            WRITE(CHMAIL,10250) IEVENT,IDEVT,(NRNDM(I),I = 1,2)
            CALL GMAIL(0,0)
            WRITE(CHMAIL,10300)ITRA,ISTAK,NTMULT,(NAPART(I),I=1,5),
     +      TOFG*1.E9
            CALL GMAIL(0,1)
10200       FORMAT(' *** GTRACK *** More than ',I6,
     +             ' steps, tracking abandoned!')
10250       FORMAT('                IEVENT=',I7,' IDEVT=',I7,
     +             ' Random Seeds = ',I10,2X,I10)
10300       FORMAT('                Track ',I5,' stack ',I5,' NTMULT ',
     +             I5,1X,5A4,1X,'Time of flight ',F10.3,' ns')
         ENDIF
      ENDIF
*
* *** Give control to user at end of each tracking step
*
      SAFETY = SAFETY -STEP
#if !defined(CERNLIB_USRJMP)
      CALL GUSTEP
#endif
#if defined(CERNLIB_USRJMP)
      CALL JUMPT0(JUSTEP)
#endif
*
      IF (ISTOP.NE.0) GO TO 999
*
*      Renormalize direction cosines
*
      PMOM = SQRT(VECT(4)**2+VECT(5)**2+VECT(6)**2)
      IF(PMOM.GT.0.) THEN
         CMOD = 1./PMOM
         VECT(4) = VECT(4)*CMOD
         VECT(5) = VECT(5)*CMOD
         VECT(6) = VECT(6)*CMOD
      ENDIF
*                                        force update of alternatives:  
      IF (INWVOL.EQ.0) then
         if (GONLY(NLEVEL).eq.0.and.Safety.le.0.and.Iswit(10).ge.0)
     +        CALL GTMEDI(VECT,NMED)
         GO TO 80
      endif
*
      IF (NJTMAX.GT.0) THEN
         CALL GSTRAC
         IF (NLEVIN.EQ.0) GO TO 100
         GO TO 999
      ELSE
         IF (NLEVIN.GE.NLEVEL) THEN
            INFROM = 0
         ELSE
            IF (NLEVIN.EQ.0) GO TO 100
            INFROM = LINDEX(NLEVIN+1)
         ENDIF
         IF (NLEVIN.NE.NLEVEL) INGOTO = 0
         NLEVEL = NLEVIN
*
         CALL GTMEDI (VECT, NUMED)
         IF (NUMED.NE.0) THEN
            SAFETY = 0.
            GO TO 10
         ENDIF
      ENDIF
*
*     Track outside setup, give control to user (INWVOL=3)
*
  100 INWVOL = 3
      ISTOP  = 1
      ISET   = 0
      IDET   = 0
      NMEC   = 0
      STEP   = 0.
      DESTEL = 0.
      DESTEP = 0.
      NGKINE = 0
      NLCUR  = NLEVEL
      NLEVEL = 1
#if !defined(CERNLIB_USRJMP)
      CALL GUSTEP
#endif
#if defined(CERNLIB_USRJMP)
      CALL JUMPT0(JUSTEP)
#endif
      NLEVEL = NLCUR
*                                                             END GTRACK
  999 END
Commit	Line	Data
fe4da5cc	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