]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gtrak/ginvo2.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Better printing for MAXSTEP
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / ginvo2.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:21:45 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10#if defined(CERNLIB_OLD)
11*CMZ : 3.21/02 29/03/94 15.41.24 by S.Giani
12*-- Author :
13 SUBROUTINE GINVOL (X, ISAME)
14C.
15C. ******************************************************************
16C. * *
17C. * SUBR. GINVOL (X, ISAME*) *
18C. * *
19C. * Checks if particle at point X has left current volume/medium *
20C. * If so, returns ISAME = 0 and prepares information useful to *
21C. * identify the new volume entered. *
22C. * Otherwise, returns ISAME = 1 *
23C. * *
24C. * Note : INGOTO is set by GTNEXT, to transmit the information *
25C. * on the one volume which has limited the step SNEXT, *
26C. * >0 : INth content *
27C. * =0 : current volume *
28C. * <0 : -NLONLY, with NLONLY defined as the first 'ONLY' *
29C. * level up in the tree for the 'NOT-ONLY' volume *
30C. * where the point X is found to be. *
31C. * *
32C. * Called by : GNEXT, GTELEC, GTHADR, GTMUON, GTNEXT *
33C. * Authors : S.Banerjee, R.Brun, F.Bruyant *
34C. * *
35C. ******************************************************************
36C.
37#include "geant321/gcbank.inc"
38#include "geant321/gcvolu.inc"
39#include "geant321/gctrak.inc"
40#if defined(CERNLIB_USRJMP)
41#include "geant321/gcjump.inc"
42#endif
43C.
44 DIMENSION X(*)
45 REAL XC(3), XT(3)
46 LOGICAL BTEST
47C.
48C. ------------------------------------------------------------------
49*
50* SECTION I: The /GCVOLU/ table contains the presumed location of X in the
51* geometry tree, at level NLEVEL. The suggestion is that INGOTO
52* is the index of a content at NLEVEL which may also contain X.
53* If this is so, ISAME=0 and return. INGOTO is left unchanged.
54* If this is not so, have we left the volume at NLEVEL altogether?
55* If so, ISAME=0 and INGOTO=0, return. Otherwise, this is the
56* starting position for a search. Reset search record variables
57* and proceed to section II.
58*
59* *** Check if point is in current volume
60*
61 INGT = 0
62C***** Code Expanded From Routine: GTRNSF
63C
64 100 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
65 XC(1) = X(1) - GTRAN(1,NLEVEL)
66 XC(2) = X(2) - GTRAN(2,NLEVEL)
67 XC(3) = X(3) - GTRAN(3,NLEVEL)
68*
69 ELSE
70 XL1 = X(1) - GTRAN(1,NLEVEL)
71 XL2 = X(2) - GTRAN(2,NLEVEL)
72 XL3 = X(3) - GTRAN(3,NLEVEL)
73 XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3*
74 + GRMAT(3,NLEVEL)
75 XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3*
76 + GRMAT(6,NLEVEL)
77 XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3*
78 + GRMAT(9,NLEVEL)
79*
80 ENDIF
81C***** End of Code Expanded From Routine: GTRNSF
82*
83 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
84*
85* Note: At entry the variable INGOTO may contain the index of a volume
86* contained within the current one at NLEVEL. If so, begin by checking
87* if X lies inside. This improves the search speed over that of GMEDIA.
88*
89 NIN = Q(JVO+3)
90 IF ((INGOTO.LE.0).OR.(INGOTO.GT.NIN)) THEN
91 INGOTO = 0
92 ELSE
93*
94* *** Entrance in content INGOTO predicted by GTNEXT
95*
96 JIN = LQ(JVO-INGOTO)
97 IVOT = Q(JIN+2)
98 JVOT = LQ(JVOLUM-IVOT)
99 JPAR = LQ(JGPAR-NLEVEL-1)
100*
101 IROTT = Q(JIN+4)
102C***** Code Expanded From Routine: GITRAN
103C.
104C. ------------------------------------------------------------------
105C.
106 IF (IROTT .EQ. 0) THEN
107 XT(1) = XC(1) - Q(5+JIN)
108 XT(2) = XC(2) - Q(6+JIN)
109 XT(3) = XC(3) - Q(7+JIN)
110*
111 ELSE
112 XL1 = XC(1) - Q(5+JIN)
113 XL2 = XC(2) - Q(6+JIN)
114 XL3 = XC(3) - Q(7+JIN)
115 JR = LQ(JROTM-IROTT)
116 XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3)
117 XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6)
118 XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9)
119*
120 ENDIF
121C***** End of Code Expanded From Routine: GITRAN
122*
123* * Check if point is in content
124*
125 CALL GINME (XT, Q(JVOT+2), Q(JPAR+1), IYES)
126 IF (IYES.NE.0) THEN
127*
128* If so, prepare information for volume retrieval, and return
129*
130 NLEVIN = NLEVEL +1
131 LVOLUM(NLEVIN) = IVOT
132 NAMES(NLEVIN) = IQ(JVOLUM+IVOT)
133 NUMBER(NLEVIN) = Q(JIN+3)
134 LINDEX(NLEVIN) = INGOTO
135 LINMX(NLEVIN) = Q(JVO+3)
136 GONLY(NLEVIN) = Q(JIN+8)
137 IF (LQ(LQ(JVOLUM-IVOT)).EQ.0) THEN
138 NLDEV(NLEVIN) = NLDEV(NLEVEL)
139 ELSE
140 NLDEV(NLEVIN) = NLEVIN
141 ENDIF
142 CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5),
143 + IROTT, GTRAN(1,NLEVIN), GRMAT(1,NLEVIN))
144 ISAME = 0
145 GO TO 999
146 ENDIF
147 ENDIF
148*
149* End of INGOTO processing
150*
151 JPAR = LQ(JGPAR-NLEVEL)
152 CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
153 IF (IYES.EQ.0) THEN
154 ISAME = 0
155 INGOTO = 0
156 GO TO 999
157 ENDIF
158*
159* ** Point is in current volume
160*
161 NLEVIN = NLEVEL
162 NLMIN = NLEVEL
163 IF ((INFROM.LE.0).OR.(INFROM.GT.NIN)) THEN
164 INFROM = 0
165 ENDIF
166 INFR = INFROM
167 NLMANY = 0
168 IF (INGOTO.GT.0) THEN
169 INGT = INGOTO
170 JIN = LQ(JVO-INGOTO)
171 IQ(JIN) = IBSET(IQ(JIN),4)
172 ENDIF
173*
174* SECTION II: X is found inside current node at NLEVEL in /GCVOLU/.
175* Search all contents for any containing X. Take the
176* first one found, incrementing NLEVEL and extending the
177* /GCVOLU/ tables. Otherwise if the list of contents is
178* exhausted without finding X inside, proceed to Section III.
179* Note: Since Section II is re-entered from Section III, a blocking word
180* is used to mark those contents already checked. Upon exit from Section
181* II, these blocking words are cleared at NLEVEL, but may remain set in
182* levels between NLEVEL-1 and NLMIN, if any. They must be cleared at exit.
183*
184* ** Check contents, if any
185*
186 200 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
187 NIN = Q(JVO+3)
188*
189* * Case with no contents
190*
191 IF (NIN.EQ.0) THEN
192 GO TO 300
193*
194* * Case with contents defined by division
195*
196 ELSEIF (NIN.LT.0) THEN
197 CALL GMEDIV (JVO, IN, XC, 1)
198 IF (IN.GT.0) THEN
199 IF ((GONLY(NLEVEL).EQ.0).AND.
200 + (NLEVEL.LE.NLEVIN)) THEN
201 INFR = 0
202 INGT = 0
203 GO TO 200
204 ELSE
205 GO TO 450
206 ENDIF
207 ENDIF
208*
209* * Case with contents positioned
210*
211 ELSE
212 JCONT = LQ(JVO-NIN-1)+1
213 NCONT = IQ(JCONT)
214 ISEARC = Q(JVO+1)
215 IF (ISEARC.LT.0) THEN
216*
217* Prepare access to contents, when ordered by GSORD
218*
219 JSB = LQ(LQ(JVO-NIN-1))
220 IAX = Q(JSB+1)
221 NSB = Q(JSB+2)
222 IF (IAX.LE.3) THEN
223 IDIV = LOCATF (Q(JSB+3), NSB, XC(IAX))
224 ELSE
225 CALL GFCOOR (XC, IAX, CX)
226 IDIV = LOCATF (Q(JSB+3), NSB, CX)
227 ENDIF
228 IF (IDIV.LT.0) IDIV = -IDIV
229 IF (IDIV.EQ.0) THEN
230 IF (IAX.NE.6) GO TO 260
231 IDIV = NSB
232 ELSEIF (IDIV.EQ.NSB) THEN
233 IF (IAX.NE.6) GO TO 260
234 ENDIF
235 JSC0 = LQ(JVO-NIN-2)
236 NCONT = IQ(JSC0+IDIV)
237 JCONT = LQ(JSC0-IDIV)
238 ELSE
239*
240* otherwise, scan contents (possibly a user selection of them)
241*
242 JNEAR = LQ(JVO-NIN-1)
243 IF (ISEARC.GT.0) THEN
244#if !defined(CERNLIB_USRJMP)
245 CALL GUNEAR (ISEARC, 1, XC, JNEAR)
246#endif
247#if defined(CERNLIB_USRJMP)
248 CALL JUMPT4(JUNEAR,ISEARC, 1, XC, JNEAR)
249#endif
250 ELSEIF (INFR.GT.0) THEN
251 JNUP = LQ(LQ(JVO-INFR)-1)
252 IF (JNUP.GT.0) THEN
253 JNEAR = JNUP
254 ENDIF
255 ENDIF
256 JCONT = JNEAR +1
257 NCONT = IQ(JCONT)
258 ENDIF
259*
260* For each selected content in turn, check if point is inside
261*
262 DO 259 ICONT=1,NCONT
263 IN = IQ(JCONT+ICONT)
264 IF(IN.EQ.0) THEN
265*
266* If the value IQ(JCONT+ICONT)=0 then we are back in the mother.
267* So jump to 260, the search is finished. Clean-up should be done
268* only up to ICONT-1, so we set:
269*
270 NCONT=ICONT-1
271 GOTO 260
272 ELSE
273 JIN = LQ(JVO-IN)
274 IF (.NOT.BTEST(IQ(JIN),4)) THEN
275 CALL GMEPOS (JVO, IN, XC, 1)
276 IF (IN.GT.0) THEN
277 IF ((GONLY(NLEVEL).EQ.0).AND.
278 + (NLEVEL.LE.NLEVIN)) THEN
279 INFR = 0
280 INGT = 0
281 GO TO 200
282 ELSE
283 GO TO 450
284 ENDIF
285 ELSE
286 IQ(JIN) = IBSET(IQ(JIN),4)
287 ENDIF
288 ENDIF
289 ENDIF
290 259 CONTINUE
291*
292 260 IF(NCONT.EQ.NIN) THEN
293 DO 268 IN=1,NIN
294 JIN = LQ(JVO-IN)
295 IQ(JIN) = IBCLR(IQ(JIN),4)
296 268 CONTINUE
297 ELSE
298 DO 269 ICONT=1,NCONT
299 IN = IQ(JCONT+ICONT)
300 JIN = LQ(JVO-IN)
301 IQ(JIN) = IBCLR(IQ(JIN),4)
302 269 CONTINUE
303 IF(INFR.NE.0) THEN
304 JIN = LQ(JVO-INFR)
305 IQ(JIN) = IBCLR(IQ(JIN),4)
306 ENDIF
307 IF(INGT.NE.0) THEN
308 JIN = LQ(JVO-INGT)
309 IQ(JIN) = IBCLR(IQ(JIN),4)
310 ENDIF
311 ENDIF
312*
313 ENDIF
314*
315* SECTION III: X is found at current node (NLEVEL in /GCVOLU/) but not in
316* any of its contents, if any. If this is a MANY volume,
317* save it as a candidate best-choice, and continue the search
318* by backing up the tree one node and proceed to Section II.
319* If this is an ONLY volume, proceed to Section IV.
320*
321* *** Point is in current volume/medium, and not in any content
322*
323 300 IF (GONLY(NLEVEL).EQ.0.) THEN
324*
325* ** Lowest level is 'NOT ONLY'
326*
327 IF (NLMANY.EQ.0) THEN
328 CALL GSCVOL
329 NLMANY = NLEVEL
330 ENDIF
331*
332* * Go up the tree up to a volume with positioned contents
333*
334 310 INFR = LINDEX(NLEVEL)
335 NLEVEL = NLEVEL -1
336 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
337 NIN = Q(JVO+3)
338 IF (NIN.LT.0) GO TO 310
339*
340C***** Code Expanded From Routine: GTRNSF
341C
342 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
343 XC(1) = X(1) - GTRAN(1,NLEVEL)
344 XC(2) = X(2) - GTRAN(2,NLEVEL)
345 XC(3) = X(3) - GTRAN(3,NLEVEL)
346*
347 ELSE
348 XL1 = X(1) - GTRAN(1,NLEVEL)
349 XL2 = X(2) - GTRAN(2,NLEVEL)
350 XL3 = X(3) - GTRAN(3,NLEVEL)
351 XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) +
352 + XL3* GRMAT(3,NLEVEL)
353 XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) +
354 + XL3* GRMAT(6,NLEVEL)
355 XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) +
356 + XL3* GRMAT(9,NLEVEL)
357
358 ENDIF
359C***** End of Code Expanded From Routine: GTRNSF
360*
361 JIN = LQ(JVO-INFR)
362 IQ(JIN) = IBSET(IQ(JIN),4)
363 NLMIN = MIN(NLEVEL,NLMIN)
364 GO TO 200
365 ENDIF
366*
367* SECTION IV: This is the end of the search.
368* (1) Entry at 400: ISAME = 1 The current node (NLEVEL
369* in /GCVOLU/) is an ONLY volume and there were no contents
370* in the tree below it which could claim X.
371* (2) Entry at 450: ISAME = 0 Section II has just found
372* another volume which has more claim to X than the current
373* one: either another ONLY or a deeper MANY was found.
374* Note: A valid structure is assumed, in which no ONLY volumes overlap.
375* If this rule is violated, or if a daughter is not entirely contained
376* within the mother volume, the results are unpredictable.
377*
378 400 ISAME = 1
379 GOTO 480
380
381 450 ISAME = 0
382
383 480 DO 489 NL=NLMIN,NLEVEL-1
384 JVO = LQ(JVOLUM-LVOLUM(NL))
385 NIN = Q(JVO+3)
386 DO 488 IN=1,NIN
387 JIN = LQ(JVO-IN)
388 IQ(JIN) = IBCLR(IQ(JIN),4)
389 488 CONTINUE
390 489 CONTINUE
391*
392 IF (NLMANY.GT.0) THEN
393 CALL GFCVOL
394 NLEVIN = NLEVEL
395 ELSEIF (NLEVEL.GT.NLEVIN) THEN
396 INGOTO = LINDEX(NLEVEL)
397 NL = NLEVIN
398 NLEVIN = NLEVEL
399 NLEVEL = NL
400 ENDIF
401* END GINVOL
402 999 IF(JGSTAT.NE.0) CALL GFSTAT(ISAME)
403 END
404#endif