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