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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1999/05/18 15:55:21  fca
* AliRoot sources
*
* 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)
            CALL GPCXYZ
            WRITE(CHMAIL,10250) IEVENT,IDEVT,(NRNDM(I),I=1,2),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,' 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$
97f74af4	5	* Revision 1.1.1.1 1999/05/18 15:55:21 fca
	6	* AliRoot sources
	7	*
fe4da5cc	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)
97f74af4	266	CALL GPCXYZ
97f74af4	267	WRITE(CHMAIL,10250) IEVENT,IDEVT,(NRNDM(I),I=1,2),TOFG*1.E9
fe4da5cc	268	CALL GMAIL(0,1)
	269	10200 FORMAT(' * GTRACK * More than ',I6,
	270	+ ' steps, tracking abandoned!')
97f74af4	271	10250 FORMAT(' IEVENT ',I7,' IDEVT ',I7,' Random Seeds ',I10,2X
97f74af4	272	$ ,I10,' Time of flight ',F10.3,' ns')
fe4da5cc	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