[u/mrichter/AliRoot.git] / GEANT321 / erdecks / ertrgo.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/03/06 15:37:35  mclareni
* Add geane321 source directories
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.49  by  S.Giani
*-- Author :
      SUBROUTINE ERTRGO
*
C.    ******************************************************************
C.    *                                                                *
C.    *       Perform the tracking of the track                        *
C.    *       Track parameters are in VECT                             *
C.    *                                                                *
C.    *    ==>Called by : ERTRAK                                       *
C.    *       Original routines : GTRACK + GTVOL                       *
C.    *       Authors   M.Maire, E.Nagy  *********                     *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcjloc.inc"
#include "geant321/gccuts.inc"
#include "geant321/gconst.inc"
#include "geant321/gcphys.inc"
#include "geant321/gckine.inc"
#include "geant321/gcflag.inc"
#include "geant321/gctmed.inc"
#include "geant321/gcmate.inc"
#include "geant321/gctrak.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcnum.inc"
#include "geant321/ertrio.inc"
#include "geant321/erwork.inc"
      COMMON/GCCHAN/LSAMVL
      LOGICAL LSAMVL
*
*
      DIMENSION CUTS(10),MECA(5,12)
      EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR)
      DIMENSION NAMIN(15),NUMIN(15),NAMOUT(15),NUMOUT(15)
*
      SAVE PRECOR,NSTOUT
#if (!defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_IBM))
      PARAMETER (EPSMAC=5.E-6)
#endif
#if (!defined(CERNLIB_SINGLE))&&(defined(CERNLIB_IBM))
      PARAMETER (EPSMAC=5.E-5)
#endif
#if defined(CERNLIB_SINGLE)
      PARAMETER (EPSMAC=1.E-11)
#endif
C.
C.    ------------------------------------------------------------------
*
      NSTOUT = 0
      EPSCUR = EPSMAC
      LSAMVL = .FALSE.
      SLENG  = 0.
      ISTOP  = 0
      NUMED  = 0
      NUMOLD = 0
      IUPD   = 0
      NMEC   = 0
      INGOTO = 0
      INFROM = 0
      SAFETY = 0.
      MXNSTP = 1000
      NSTEP  = 0
*
      CALL GMEDIA(VECT,NUMED)
      IF (NUMED.EQ.0) GO TO 200
*
* *** Come back here each time we enter into a new volume
*
   10 CONTINUE
*
* *** Get tracking medium and material parameters
      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)
         DMAXMS = 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,12
                  MECA(1,I)=Q(JTMED+10+I)
  40           CONTINUE
               ISTPAR=0
            ENDIF
         ELSE
            JTMN=LQ(JTM)
            DO 50 I=1,10
               CUTS(I)=Q(JTMN+I)
  50        CONTINUE
            DO 60 I=1,12
               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
  70     NAMATE(I)=IQ(JMA+I)
         A    = Q(JMA + 6)
         Z    = Q(JMA + 7)
         DENS = Q(JMA + 8)
         RADL = Q(JMA + 9)
         ABSL = Q(JMA + 10)
      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(' *** ERTRGO *** Boundary loop: track ',
     +         I4,' stack ',I4,' NTMULT ',I5,1X,5A4)
            CALL GMAIL(1,0)
            WRITE(CHMAIL,10100) EPSCUR
10100          FORMAT('                Precision now set to ',G10.3)
            CALL GMAIL(0,1)
         ENDIF
      ELSE
         NSTOUT = 0
         EPSCUR = EPSMAC
      ENDIF
*
* *** Initialize magnetic field for EMC package
      HI(1) = 0.
      HI(2) = 0.
      HI(3) = 0.
      IF (IFIELD.EQ.3) THEN
         HI(3) = FIELDM
      ELSEIF (IFIELD.NE.0) THEN
         CALL GUFLD (VECT, HI)
      ENDIF
*
* *** Control given to user at entrance of volume (INWVOL=1)
      INWVOL = 1
      NMEC   = 1
      LMEC(1) = 29
      STEP   = 0.
      DESTEP = 0.
*
      IF((LEVOLU).AND.(SLENG.GT.0.)) THEN
         IMEC = 0
         CALL EVOLIO(NVLIN,NAMIN,NUMIN,NVLOUT,NAMOUT,NUMOUT)
         DO 80 IPR =1,NEPRED
            NAMPR = NAMEER(IPR)
            NUMPR = NUMVER(IPR)
            IOVPR = IOVLER(IPR)
            IF (IOVPR.EQ.1) THEN
               IV = IUCOMP(NAMPR,NAMIN ,NVLIN )
               IF (IV.NE.0) THEN
                  IF (NUMPR.EQ.0) NUMPR = NUMIN (IV)
                  IF (NUMPR.EQ.NUMIN (IV)) THEN
                     NMEC = NMEC + 1
                     LMEC(NMEC) = 27
                     INLIST = IPR
                     CALL ERSTOR
                  ENDIF
               ENDIF
            ELSE IF (IOVPR.EQ.2) THEN
               IV = IUCOMP(NAMPR,NAMOUT,NVLOUT)
               IF (IV.NE.0) THEN
                  IF (NUMPR.EQ.0) NUMPR = NUMOUT(IV)
                  IF (NUMPR.EQ.NUMOUT(IV)) THEN
                     NMEC = NMEC + 1
                     LMEC(NMEC) = 27
                     INLIST = IPR
                     CALL ERSTOR
                  ENDIF
               ENDIF
            ENDIF
*
   80    CONTINUE
*
      ENDIF
*
      CALL EUSTEP
      IF (ISTOP.NE.0) GO TO 999
*
* *** Particle is propagated up to the next volume boundary
*
      INWVOL=0
*
* *** Come back here after each step in the same volume
 100  IGNEXT = 0
      INGOTO = 0
      NLEVIN = NLEVEL
      NMEC   = 0
      STEP   = 0.
      DESTEP = 0.
      DEDX2  = 0.
      PREC   = MAX(PRECOR,MAX(ABS(VECT(1)),ABS(VECT(2)),
     +                        ABS(VECT(3)),SLENG)*EPSCUR)
*
      IF(CHARGE.NE.0.) THEN
         CALL ERTRCH
      ELSE
         CALL ERTRNT
      ENDIF
*
      NSTEP  = NSTEP + 1
      IF (NSTEP.GT.MXNSTP) THEN
         ISTOP = 99
         NMEC  = NMEC + 1
         LMEC(NMEC) = 30
      ENDIF
*
      SAFETY = SAFETY - STEP
      TLRAD  = TLRAD  + STEP/RADL
      TLGCM2 = TLGCM2 + STEP*DENS
*
* *** Give control to user after each tracking step
      CALL EUSTEP
*
      IF(ISTOP.NE.0) GO TO 999
*
* *** Renormalize direction cosines
      CMOD = 1./SQRT(VECT(4)**2 + VECT(5)**2 + VECT(6)**2)
      VECT(4) = VECT(4)*CMOD
      VECT(5) = VECT(5)*CMOD
      VECT(6) = VECT(6)*CMOD
*
      IF (INWVOL.EQ.0) GO TO 100
*
* *** Particle is leaving the volume (INWVOL=2) :
*
*     Save the current volume's tree before leaving the volume
      IF(LEVOLU) CALL EVOLIO(NVLIN,NAMIN,NUMIN,NVLOUT,NAMOUT,NUMOUT)
*
*     find the new volume
      IF (NLEVIN.GE.NLEVEL) THEN
         INFROM = 0
      ELSE
         IF (NLEVIN.EQ.0) GO TO 200
         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
*
* *** Track outside setup, give control to user (INWVOL=3)
  200 INWVOL= 3
      ISTOP = 1
      NMEC  = NMEC + 1
      LMEC(NMEC) = 30
      CALL EUSTEP
 999  CONTINUE
      ILOSL = 0
*
      END
Commit	Line	Data
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	*
	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