]>
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 |