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

*
* $Id$
*
* $Log$
* Revision 1.2  1996/02/27 10:30:56  ravndal
* Correct interaction length for heavy ions
*
* Revision 1.1.1.1  1995/10/24 10:21:43  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/04 13/12/94  15.23.45  by  S.Giani
*-- Author :
      SUBROUTINE GSTRAC
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       SUBR. GSTRAC                                             *
C.    *                                                                *
C.    *  Stores in stack JTRACK the information for current track      *
C.    *   segment at exit of current Volume/Medium.                    *
C.    *                                                                *
C.    *   Called by : GTRACK                                           *
C.    *   Authors   : S.Banerjee, F.Bruyant                            *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gckine.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcphys.inc"
#include "geant321/gcstak.inc"
#include "geant321/gctrak.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcvolu.inc"
      REAL      XC(3)
C.
C.    ------------------------------------------------------------------
*
* *** Find where in the tracking skeleton to enter the current track
*
      IF (NLEVIN.EQ.NLEVEL) THEN
*       (case when GINVOL has not been called)
         JVO = LQ(JVOLUM-LVOLUM(NLEVIN))
         IF (INGOTO.GT.0) THEN
*
*  **      Point is in content predicted by GTNEXT, go one level down
*
            NLEVIN = NLEVIN +1
            INFROM = 0
            JIN    = LQ(JVO-INGOTO)
            IVOT   = Q(JIN+2)
            LVOLUM(NLEVIN) = IVOT
            LINDEX(NLEVIN) = INGOTO
            LINMX (NLEVIN) = Q(JVO+3)
*
*  **      Prepare the translation and rotation matrices if necessary
*
            JSKL = LQ(JSKLT-NLEVIN)
            IF (NLEVIN.GT.2) THEN
               IOFF = IQ(JSKL-3)
               DO 29 ILEV = 1, NLEVEL
                  IF (IQ(JSKL+IOFF+ILEV).NE.LINDEX(ILEV)) GO TO 30
   29          CONTINUE
            ENDIF
            JSK  = LQ(JSKL-INGOTO)
            IF (IQ(JSK+1).GT.0) GO TO 100
   30       IROTT = Q(JIN+4)
            CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5),
     +                   IROTT, GTRAN(1,NLEVIN), GRMAT(1,NLEVIN))
            GO TO 100
         ELSE
*
*  **      otherwise, go one level up
*
            NLEVIN = NLEVIN -1
*
         ENDIF
*
      ELSE IF (NLEVIN.GT.NLEVEL) THEN
         INFROM = 0
         GO TO 100
*
      ELSE IF (NLEVIN.LT.0) THEN
*       (case when entering a dominant overlaping volume)
         NLEVIN = -NLEVIN
         INFROM = LINDEX(NLEVIN+1)
         GO TO 100
      ENDIF
*
*  **  Track has left current volume, check levels up
*
   80 IF (NLEVIN.EQ.0) GO TO 999
*
      IF (GRMAT(10,NLEVIN).EQ.0.) THEN
         DO 88 I = 1,3
            XC(I) = VECT(I) -GTRAN(I,NLEVIN)
   88    CONTINUE
      ELSE
C       (later, code in line)
         CALL GTRNSF (VECT, GTRAN(1,NLEVIN), GRMAT(1,NLEVIN), XC)
      ENDIF
*
      JVO  = LQ(JVOLUM-LVOLUM(NLEVIN))
      JPAR = LQ(JGPAR-NLEVIN)
      CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
      IF (IYES.NE.0) THEN
         INFROM = LINDEX(NLEVIN+1)
      ELSE
         NLEVIN = NLEVIN -1
         GO TO 80
      ENDIF
*
* *** Allocate last 'garbaged' area if any, otherwise first 'free' one
*
  100 IF (NJGARB.NE.0) THEN
         NCUR   = NJGARB
         LCUR   = JTRACK +(NCUR-1)*NWTRAC
         NJGARB = IQ(LCUR+1)
      ELSE
         NCUR   = NJFREE
         LCUR   = JTRACK +(NCUR-1)*NWTRAC
         NJFREE = NCUR +1
      ENDIF
*
* *** Link allocated area to relevant chain in JSKLT structure
*
      JSKL = LQ(JSKLT-NLEVIN)
      IQ(LCUR+1) = IQ(JSKL+LINDEX(NLEVIN))
      IQ(JSKL+LINDEX(NLEVIN)) = NCUR
*
* *** Store information for current track segment in stack JTRACK
*
      IQ(LCUR+2) = 0
      IQ(LCUR+3) = NTMULT
      IQ(LCUR+4) = ITRA
      IQ(LCUR+5) = ISTAK
      IQ(LCUR+6) = IPART
      IQ(LCUR+7) = NSTEP
*free IQ(LCUR+8) = IDECAD
      IQ(LCUR+9) = IEKBIN
      IQ(LCUR+10)= ISTORY
      IQ(LCUR+11)= INFROM
*
      IPCUR = LCUR +NWINT
      DO 109 I = 1,7
         Q(IPCUR+I)  = VECT(I)
  109 CONTINUE
      Q(IPCUR+8)  = GEKIN
      Q(IPCUR+9)  = SLENG
      Q(IPCUR+10) = GEKRAT
      Q(IPCUR+11) = TOFG
      Q(IPCUR+12) = UPWGHT
*
      IPCUR = IPCUR +NWREAL
      IF (ITRTYP.EQ.1) THEN
*     Photons
         Q(IPCUR+1) = ZINTPA
         Q(IPCUR+2) = ZINTCO
         Q(IPCUR+3) = ZINTPH
         Q(IPCUR+4) = ZINTPF
         Q(IPCUR+5) = ZINTRA
      ELSE IF (ITRTYP.EQ.2) THEN
*     Electrons
         Q(IPCUR+1) = ZINTBR
         Q(IPCUR+2) = ZINTDR
         Q(IPCUR+3) = ZINTAN
      ELSE IF (ITRTYP.EQ.3) THEN
*     Neutral hadrons
         Q(IPCUR+1) = SUMLIF
         Q(IPCUR+2) = ZINTHA
      ELSE IF (ITRTYP.EQ.4) THEN
*     Charged hadrons
         Q(IPCUR+1) = SUMLIF
         Q(IPCUR+2) = ZINTHA
         Q(IPCUR+3) = ZINTDR
      ELSE IF (ITRTYP.EQ.5) THEN
*     Muons
         Q(IPCUR+1) = SUMLIF
         Q(IPCUR+2) = ZINTBR
         Q(IPCUR+3) = ZINTPA
         Q(IPCUR+4) = ZINTDR
         Q(IPCUR+5) = ZINTMU
      ELSE IF (ITRTYP.EQ.7) THEN
*     Cerenkov photons
         Q(IPCUR+1) = ZINTLA
      ELSE IF (ITRTYP.EQ.8) THEN
*     Ions
         Q(IPCUR+1) = ZINTHA
         Q(IPCUR+2) = ZINTDR
      ENDIF
*
* *** Take care of the skeleton
*
      IF (NLEVIN.GT.NLDOWN) THEN
         NLDOWN = NLEVIN
         JSKL   = LQ(JSKLT-NLDOWN)
*
*  **    Clear skeleton at lowest level if necessary
*
         JOFF   = JSKL + IQ(JSKL-3)
         DO 229 ILEV = 1, NLDOWN-1
            IF (IQ(JOFF+ILEV).EQ.LINDEX(ILEV)) GO TO 229
            NINSK = LINMX(NLDOWN)
            DO 209 IN = 1, NINSK
               JSK  = LQ(JSKL-IN)
               IQ(JSK+1) = 0
  209       CONTINUE
            DO 219 I = ILEV, NLDOWN-1
               IQ(JOFF+I) = LINDEX(I)
  219       CONTINUE
            GO TO 230
  229    CONTINUE
      ENDIF
*
*  ** Fill up the skeleton at NLDOWN
*
  230 IF (NLEVIN.GT.NLEVEL) THEN
         JSKL = LQ(JSKLT-NLDOWN)
         JSK  = LQ(JSKL-LINDEX(NLDOWN))
         IF (IQ(JSK+1).LE.0) THEN
            LQ(JSK-1) = LQ(JGPAR-NLDOWN)
            IQ(JSK+1) = IQ(JGPAR+NLDOWN)
            IQ(JSK+2) = LVOLUM(NLDOWN)
            DO 239 I = 1, 3
               Q(JSK+2+I) = GTRAN(I,NLDOWN)
  239       CONTINUE
            DO 249 I = 1, 10
               Q(JSK+5+I) = GRMAT(I,NLDOWN)
  249       CONTINUE
         ENDIF
*
      ENDIF
*
* *** Update NALIVE and test if tracking stack is full
*
      NALIVE = NALIVE + 1
      IF (NALIVE-IQ(JSTAK+1).GE.NJTMAX) THEN
         WRITE (CHMAIL, 1001)
         CALL GMAIL (0, 0)
         NJTMAX = -NJTMAX
         NLVSAV = NLEVEL
         DO 309 I = 2,NLDOWN
            LINSAV(I) = LINDEX(I)
            LMXSAV(I) = LINMX(I)
  309    CONTINUE
      ENDIF
*
 1001 FORMAT (' GSTRAC : Stack JTRACK full. Inhibit parallel tracking')
*                                                             END GSTRAC
  999 END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.2 1996/02/27 10:30:56 ravndal
	6	* Correct interaction length for heavy ions
	7	*
	8	* Revision 1.1.1.1 1995/10/24 10:21:43 cernlib
	9	* Geant
	10	*
	11	*
	12	#include "geant321/pilot.h"
	13	*CMZ : 3.21/04 13/12/94 15.23.45 by S.Giani
	14	*-- Author :
	15	SUBROUTINE GSTRAC
	16	C.
	17	C. ******************************************************************
	18	C. * *
	19	C. * SUBR. GSTRAC *
	20	C. * *
	21	C. * Stores in stack JTRACK the information for current track *
	22	C. * segment at exit of current Volume/Medium. *
	23	C. * *
	24	C. * Called by : GTRACK *
	25	C. * Authors : S.Banerjee, F.Bruyant *
	26	C. * *
	27	C. ******************************************************************
	28	C.
	29	#include "geant321/gcbank.inc"
	30	#include "geant321/gckine.inc"
	31	#include "geant321/gcnum.inc"
	32	#include "geant321/gcphys.inc"
	33	#include "geant321/gcstak.inc"
	34	#include "geant321/gctrak.inc"
	35	#include "geant321/gcunit.inc"
	36	#include "geant321/gcvolu.inc"
	37	REAL XC(3)
	38	C.
	39	C. ------------------------------------------------------------------
	40	*
	41	* *** Find where in the tracking skeleton to enter the current track
	42	*
	43	IF (NLEVIN.EQ.NLEVEL) THEN
	44	* (case when GINVOL has not been called)
	45	JVO = LQ(JVOLUM-LVOLUM(NLEVIN))
	46	IF (INGOTO.GT.0) THEN
	47	*
	48	* ** Point is in content predicted by GTNEXT, go one level down
	49	*
	50	NLEVIN = NLEVIN +1
	51	INFROM = 0
	52	JIN = LQ(JVO-INGOTO)
	53	IVOT = Q(JIN+2)
	54	LVOLUM(NLEVIN) = IVOT
	55	LINDEX(NLEVIN) = INGOTO
	56	LINMX (NLEVIN) = Q(JVO+3)
	57	*
	58	* ** Prepare the translation and rotation matrices if necessary
	59	*
	60	JSKL = LQ(JSKLT-NLEVIN)
	61	IF (NLEVIN.GT.2) THEN
	62	IOFF = IQ(JSKL-3)
	63	DO 29 ILEV = 1, NLEVEL
	64	IF (IQ(JSKL+IOFF+ILEV).NE.LINDEX(ILEV)) GO TO 30
65	29 CONTINUE
66	ENDIF
67	JSK = LQ(JSKL-INGOTO)
68	IF (IQ(JSK+1).GT.0) GO TO 100
69	30 IROTT = Q(JIN+4)
70	CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5),
71	+ IROTT, GTRAN(1,NLEVIN), GRMAT(1,NLEVIN))
72	GO TO 100
73	ELSE
74	*
75	* ** otherwise, go one level up
76	*
77	NLEVIN = NLEVIN -1
78	*
79	ENDIF
80	*
81	ELSE IF (NLEVIN.GT.NLEVEL) THEN
82	INFROM = 0
83	GO TO 100
84	*
85	ELSE IF (NLEVIN.LT.0) THEN
86	* (case when entering a dominant overlaping volume)
87	NLEVIN = -NLEVIN
88	INFROM = LINDEX(NLEVIN+1)
89	GO TO 100
90	ENDIF
91	*
92	* ** Track has left current volume, check levels up
93	*
94	80 IF (NLEVIN.EQ.0) GO TO 999
95	*
96	IF (GRMAT(10,NLEVIN).EQ.0.) THEN
97	DO 88 I = 1,3
98	XC(I) = VECT(I) -GTRAN(I,NLEVIN)
99	88 CONTINUE
100	ELSE
101	C (later, code in line)
102	CALL GTRNSF (VECT, GTRAN(1,NLEVIN), GRMAT(1,NLEVIN), XC)
103	ENDIF
104	*
105	JVO = LQ(JVOLUM-LVOLUM(NLEVIN))
106	JPAR = LQ(JGPAR-NLEVIN)
107	CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
108	IF (IYES.NE.0) THEN
109	INFROM = LINDEX(NLEVIN+1)
110	ELSE
111	NLEVIN = NLEVIN -1
112	GO TO 80
113	ENDIF
114	*
115	* *** Allocate last 'garbaged' area if any, otherwise first 'free' one
116	*
117	100 IF (NJGARB.NE.0) THEN
118	NCUR = NJGARB
119	LCUR = JTRACK +(NCUR-1)*NWTRAC
120	NJGARB = IQ(LCUR+1)
121	ELSE
122	NCUR = NJFREE
123	LCUR = JTRACK +(NCUR-1)*NWTRAC
124	NJFREE = NCUR +1
125	ENDIF
126	*
127	* *** Link allocated area to relevant chain in JSKLT structure
128	*
129	JSKL = LQ(JSKLT-NLEVIN)
130	IQ(LCUR+1) = IQ(JSKL+LINDEX(NLEVIN))
131	IQ(JSKL+LINDEX(NLEVIN)) = NCUR
132	*
133	* *** Store information for current track segment in stack JTRACK
134	*
135	IQ(LCUR+2) = 0
136	IQ(LCUR+3) = NTMULT
137	IQ(LCUR+4) = ITRA
138	IQ(LCUR+5) = ISTAK
139	IQ(LCUR+6) = IPART
140	IQ(LCUR+7) = NSTEP
141	*free IQ(LCUR+8) = IDECAD
142	IQ(LCUR+9) = IEKBIN
143	IQ(LCUR+10)= ISTORY
144	IQ(LCUR+11)= INFROM
145	*
146	IPCUR = LCUR +NWINT
147	DO 109 I = 1,7
148	Q(IPCUR+I) = VECT(I)
149	109 CONTINUE
150	Q(IPCUR+8) = GEKIN
151	Q(IPCUR+9) = SLENG
152	Q(IPCUR+10) = GEKRAT
153	Q(IPCUR+11) = TOFG
154	Q(IPCUR+12) = UPWGHT
155	*
156	IPCUR = IPCUR +NWREAL
157	IF (ITRTYP.EQ.1) THEN
158	* Photons
159	Q(IPCUR+1) = ZINTPA
160	Q(IPCUR+2) = ZINTCO
161	Q(IPCUR+3) = ZINTPH
162	Q(IPCUR+4) = ZINTPF
163	Q(IPCUR+5) = ZINTRA
164	ELSE IF (ITRTYP.EQ.2) THEN
165	* Electrons
166	Q(IPCUR+1) = ZINTBR
167	Q(IPCUR+2) = ZINTDR
168	Q(IPCUR+3) = ZINTAN
169	ELSE IF (ITRTYP.EQ.3) THEN
170	* Neutral hadrons
171	Q(IPCUR+1) = SUMLIF
172	Q(IPCUR+2) = ZINTHA
173	ELSE IF (ITRTYP.EQ.4) THEN
174	* Charged hadrons
175	Q(IPCUR+1) = SUMLIF
176	Q(IPCUR+2) = ZINTHA
177	Q(IPCUR+3) = ZINTDR
178	ELSE IF (ITRTYP.EQ.5) THEN
179	* Muons
180	Q(IPCUR+1) = SUMLIF
181	Q(IPCUR+2) = ZINTBR
182	Q(IPCUR+3) = ZINTPA
183	Q(IPCUR+4) = ZINTDR
184	Q(IPCUR+5) = ZINTMU
185	ELSE IF (ITRTYP.EQ.7) THEN
186	* Cerenkov photons
187	Q(IPCUR+1) = ZINTLA
188	ELSE IF (ITRTYP.EQ.8) THEN
189	* Ions
190	Q(IPCUR+1) = ZINTHA
191	Q(IPCUR+2) = ZINTDR
192	ENDIF
193	*
194	* *** Take care of the skeleton
195	*
196	IF (NLEVIN.GT.NLDOWN) THEN
197	NLDOWN = NLEVIN
198	JSKL = LQ(JSKLT-NLDOWN)
199	*
200	* ** Clear skeleton at lowest level if necessary
201	*
202	JOFF = JSKL + IQ(JSKL-3)
203	DO 229 ILEV = 1, NLDOWN-1
204	IF (IQ(JOFF+ILEV).EQ.LINDEX(ILEV)) GO TO 229
205	NINSK = LINMX(NLDOWN)
206	DO 209 IN = 1, NINSK
207	JSK = LQ(JSKL-IN)
208	IQ(JSK+1) = 0
209	209 CONTINUE
210	DO 219 I = ILEV, NLDOWN-1
211	IQ(JOFF+I) = LINDEX(I)
212	219 CONTINUE
213	GO TO 230
214	229 CONTINUE
215	ENDIF
216	*
217	* ** Fill up the skeleton at NLDOWN
218	*
219	230 IF (NLEVIN.GT.NLEVEL) THEN
220	JSKL = LQ(JSKLT-NLDOWN)
221	JSK = LQ(JSKL-LINDEX(NLDOWN))
222	IF (IQ(JSK+1).LE.0) THEN
223	LQ(JSK-1) = LQ(JGPAR-NLDOWN)
224	IQ(JSK+1) = IQ(JGPAR+NLDOWN)
225	IQ(JSK+2) = LVOLUM(NLDOWN)
226	DO 239 I = 1, 3
227	Q(JSK+2+I) = GTRAN(I,NLDOWN)
228	239 CONTINUE
229	DO 249 I = 1, 10
230	Q(JSK+5+I) = GRMAT(I,NLDOWN)
231	249 CONTINUE
232	ENDIF
233	*
234	ENDIF
235	*
236	* *** Update NALIVE and test if tracking stack is full
237	*
238	NALIVE = NALIVE + 1
239	IF (NALIVE-IQ(JSTAK+1).GE.NJTMAX) THEN
240	WRITE (CHMAIL, 1001)
241	CALL GMAIL (0, 0)
242	NJTMAX = -NJTMAX
243	NLVSAV = NLEVEL
244	DO 309 I = 2,NLDOWN
245	LINSAV(I) = LINDEX(I)
246	LMXSAV(I) = LINMX(I)
247	309 CONTINUE
248	ENDIF
249	*
250	1001 FORMAT (' GSTRAC : Stack JTRACK full. Inhibit parallel tracking')
251	* END GSTRAC
252	999 END
253