]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gtrak/ginvol.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / ginvol.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:21:41 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10#if !defined(CERNLIB_OLD)
11*CMZ : 3.21/02 03/07/94 17.14.15 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
43#include "geant321/gchvir.inc"
44C.
45 DIMENSION X(*)
46 REAL XC(6), XT(3)
47 LOGICAL BTEST
48C.
49C. ------------------------------------------------------------------
50*
51* SECTION I: The /GCVOLU/ table contains the presumed location of X in the
52* geometry tree, at level NLEVEL. The suggestion is that INGOTO
53* is the index of a content at NLEVEL which may also contain X.
54* If this is so, ISAME=0 and return. INGOTO is left unchanged.
55* If this is not so, have we left the volume at NLEVEL altogether?
56* If so, ISAME=0 and INGOTO=0, return. Otherwise, this is the
57* starting position for a search. Reset search record variables
58* and proceed to section II.
59*
60* *** Check if point is in current volume
61*
62 INGT = 0
63C***** Code Expanded From Routine: GTRNSF
64C
65 100 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
66 XC(1) = X(1) - GTRAN(1,NLEVEL)
67 XC(2) = X(2) - GTRAN(2,NLEVEL)
68 XC(3) = X(3) - GTRAN(3,NLEVEL)
69*
70 ELSE
71 XL1 = X(1) - GTRAN(1,NLEVEL)
72 XL2 = X(2) - GTRAN(2,NLEVEL)
73 XL3 = X(3) - GTRAN(3,NLEVEL)
74 XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3*
75 + GRMAT(3,NLEVEL)
76 XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3*
77 + GRMAT(6,NLEVEL)
78 XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3*
79 + GRMAT(9,NLEVEL)
80*
81 ENDIF
82 xc(4)=0.
83 xc(5)=0.
84 xc(6)=0.
85C***** End of Code Expanded From Routine: GTRNSF
86*
87 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
88*
89* Note: At entry the variable INGOTO may contain the index of a volume
90* contained within the current one at NLEVEL. If so, begin by checking
91* if X lies inside. This improves the search speed over that of GMEDIA.
92*
93 NIN = Q(JVO+3)
94 IF ((INGOTO.LE.0).OR.(INGOTO.GT.NIN)) THEN
95 INGOTO = 0
96 ELSE
97*
98* *** Entrance in content INGOTO predicted by GTNEXT
99*
100 JIN = LQ(JVO-INGOTO)
101 IVOT = Q(JIN+2)
102 JVOT = LQ(JVOLUM-IVOT)
103 JPAR = LQ(JGPAR-NLEVEL-1)
104*
105 IROTT = Q(JIN+4)
106C***** Code Expanded From Routine: GITRAN
107C.
108C. ------------------------------------------------------------------
109C.
110 IF (IROTT .EQ. 0) THEN
111 XT(1) = XC(1) - Q(5+JIN)
112 XT(2) = XC(2) - Q(6+JIN)
113 XT(3) = XC(3) - Q(7+JIN)
114*
115 ELSE
116 XL1 = XC(1) - Q(5+JIN)
117 XL2 = XC(2) - Q(6+JIN)
118 XL3 = XC(3) - Q(7+JIN)
119 JR = LQ(JROTM-IROTT)
120 XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3)
121 XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6)
122 XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9)
123*
124 ENDIF
125C***** End of Code Expanded From Routine: GITRAN
126*
127* * Check if point is in content
128*
129 CALL GINME (XT, Q(JVOT+2), Q(JPAR+1), IYES)
130 IF (IYES.NE.0) THEN
131*
132* If so, prepare information for volume retrieval, and return
133*
134 NLEVIN = NLEVEL +1
135 LVOLUM(NLEVIN) = IVOT
136 NAMES(NLEVIN) = IQ(JVOLUM+IVOT)
137 NUMBER(NLEVIN) = Q(JIN+3)
138 LINDEX(NLEVIN) = INGOTO
139 LINMX(NLEVIN) = Q(JVO+3)
140 GONLY(NLEVIN) = Q(JIN+8)
141 IF (LQ(LQ(JVOLUM-IVOT)).EQ.0) THEN
142 NLDEV(NLEVIN) = NLDEV(NLEVEL)
143 ELSE
144 NLDEV(NLEVIN) = NLEVIN
145 ENDIF
146 CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5),
147 + IROTT, GTRAN(1,NLEVIN), GRMAT(1,NLEVIN))
148 ISAME = 0
149 GO TO 999
150 ENDIF
151 ENDIF
152*
153* End of INGOTO processing
154*
155 JPAR = LQ(JGPAR-NLEVEL)
156 CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
157 IF (IYES.EQ.0) THEN
158 ISAME = 0
159 INGOTO = 0
160 GO TO 999
161 ENDIF
162*
163* ** Point is in current volume
164*
165 NLEVIN = NLEVEL
166 NLMIN = NLEVEL
167 IF ((INFROM.LE.0).OR.(INFROM.GT.NIN)) THEN
168 INFROM = 0
169 ENDIF
170 INFR = INFROM
171 NLMANY = 0
172 IF (INGOTO.GT.0) THEN
173 INGT = INGOTO
174 JIN = LQ(JVO-INGOTO)
175 IQ(JIN) = IBSET(IQ(JIN),4)
176 ENDIF
177*
178* SECTION II: X is found inside current node at NLEVEL in /GCVOLU/.
179* Search all contents for any containing X. Take the
180* first one found, incrementing NLEVEL and extending the
181* /GCVOLU/ tables. Otherwise if the list of contents is
182* exhausted without finding X inside, proceed to Section III.
183* Note: Since Section II is re-entered from Section III, a blocking word
184* is used to mark those contents already checked. Upon exit from Section
185* II, these blocking words are cleared at NLEVEL, but may remain set in
186* levels between NLEVEL-1 and NLMIN, if any. They must be cleared at exit.
187*
188* ** Check contents, if any
189*
190 200 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
191 NIN = Q(JVO+3)
192*
193* * Case with no contents
194*
195 IF (NIN.EQ.0) THEN
196 GO TO 300
197*
198* * Case with contents defined by division
199*
200 ELSEIF (NIN.LT.0) THEN
201 CALL GMEDIV (JVO, IN, XC, 1)
202 IF (IN.GT.0) THEN
203 IF ((GONLY(NLEVEL).EQ.0).AND.
204 + (NLEVEL.LE.NLEVIN)) THEN
205 INFR = 0
206 INGT = 0
207 GO TO 200
208 ELSE
209 GO TO 450
210 ENDIF
211 ENDIF
212*
213* * Case with contents positioned
214*
215 ELSE
216 if(nin.gt.1)then
217 clmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+3)
218 chmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+4)
219 ndivto=q(jvirt+4*(LVOLUM(NLEVEL)-1)+2)
220 iaxis =q(jvirt+4*(LVOLUM(NLEVEL)-1)+1)
221 if(iaxis.le.3)then
222 ivdiv=((xc(iaxis)-clmoth)*ndivto/(chmoth-clmoth))+1
223 if(ivdiv.lt.1)then
224 ivdiv=1
225 elseif(ivdiv.gt.ndivto)then
226 ivdiv=ndivto
227 endif
228 else
229 call gfcoor(xc,iaxis,cx)
230 if(iaxis.eq.6)then
231 if((cx-clmoth).lt.-1.)then
232 cx=cx+360.
233 elseif((cx-chmoth).gt.1.)then
234 cx=cx-360.
235 endif
236 if(cx.gt.chmoth)then
237 cx=chmoth
238 elseif(cx.lt.clmoth)then
239 cx=clmoth
240 endif
241 endif
242 ivdiv=((cx-clmoth)*ndivto/(chmoth-clmoth))+1
243 if(ivdiv.lt.1)then
244 ivdiv=1
245 elseif(ivdiv.gt.ndivto)then
246 ivdiv=ndivto
247 endif
248 endif
249 jvdiv=lq(jvirt-LVOLUM(NLEVEL))
250 iofset=iq(jvdiv+ivdiv)
251 ncont=iq(jvdiv+iofset+1)
252 jcont=jvdiv+iofset+1
253 if(ncont.eq.0)goto 260
254 else
255 JCONT = LQ(JVO-NIN-1)+1
256 NCONT = 1
257 endif
258*
259* For each selected content in turn, check if point is inside
260*
261 DO 259 ICONT=1,NCONT
262 if(nin.eq.1)then
263 in=1
264 else
265 IN = IQ(JCONT+ICONT)
266 endif
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 if(nin.eq.1)then
303 in=1
304 else
305 IN = IQ(JCONT+ICONT)
306 endif
307 JIN = LQ(JVO-IN)
308 IQ(JIN) = IBCLR(IQ(JIN),4)
309 269 CONTINUE
310 IF(INFR.NE.0) THEN
311 JIN = LQ(JVO-INFR)
312 IQ(JIN) = IBCLR(IQ(JIN),4)
313 ENDIF
314 IF(INGT.NE.0) THEN
315 JIN = LQ(JVO-INGT)
316 IQ(JIN) = IBCLR(IQ(JIN),4)
317 ENDIF
318 ENDIF
319 ingt=0
320*
321 ENDIF
322*
323* SECTION III: X is found at current node (NLEVEL in /GCVOLU/) but not in
324* any of its contents, if any. If this is a MANY volume,
325* save it as a candidate best-choice, and continue the search
326* by backing up the tree one node and proceed to Section II.
327* If this is an ONLY volume, proceed to Section IV.
328*
329* *** Point is in current volume/medium, and not in any content
330*
331 300 IF (GONLY(NLEVEL).EQ.0.) THEN
332*
333* ** Lowest level is 'NOT ONLY'
334*
335 IF (NLMANY.EQ.0) THEN
336 CALL GSCVOL
337 NLMANY = NLEVEL
338 ENDIF
339*
340* * Go up the tree up to a volume with positioned contents
341*
342 310 INFR = LINDEX(NLEVEL)
343 NLEVEL = NLEVEL -1
344 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
345 NIN = Q(JVO+3)
346 IF (NIN.LT.0) GO TO 310
347*
348C***** Code Expanded From Routine: GTRNSF
349C
350 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
351 XC(1) = X(1) - GTRAN(1,NLEVEL)
352 XC(2) = X(2) - GTRAN(2,NLEVEL)
353 XC(3) = X(3) - GTRAN(3,NLEVEL)
354*
355 ELSE
356 XL1 = X(1) - GTRAN(1,NLEVEL)
357 XL2 = X(2) - GTRAN(2,NLEVEL)
358 XL3 = X(3) - GTRAN(3,NLEVEL)
359 XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) +
360 + XL3* GRMAT(3,NLEVEL)
361 XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) +
362 + XL3* GRMAT(6,NLEVEL)
363 XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) +
364 + XL3* GRMAT(9,NLEVEL)
365
366 ENDIF
367C***** End of Code Expanded From Routine: GTRNSF
368*
369 JIN = LQ(JVO-INFR)
370 IQ(JIN) = IBSET(IQ(JIN),4)
371 NLMIN = MIN(NLEVEL,NLMIN)
372 GO TO 200
373 ENDIF
374*
375* SECTION IV: This is the end of the search.
376* (1) Entry at 400: ISAME = 1 The current node (NLEVEL
377* in /GCVOLU/) is an ONLY volume and there were no contents
378* in the tree below it which could claim X.
379* (2) Entry at 450: ISAME = 0 Section II has just found
380* another volume which has more claim to X than the current
381* one: either another ONLY or a deeper MANY was found.
382* Note: A valid structure is assumed, in which no ONLY volumes overlap.
383* If this rule is violated, or if a daughter is not entirely contained
384* within the mother volume, the results are unpredictable.
385*
386 400 ISAME = 1
387 GOTO 480
388
389 450 ISAME = 0
390
391 480 DO 489 NL=NLMIN,NLEVEL-1
392 JVO = LQ(JVOLUM-LVOLUM(NL))
393 NIN = Q(JVO+3)
394 DO 488 IN=1,NIN
395 JIN = LQ(JVO-IN)
396 IQ(JIN) = IBCLR(IQ(JIN),4)
397 488 CONTINUE
398 489 CONTINUE
399*
400 IF (NLMANY.GT.0) THEN
401 CALL GFCVOL
402 NLEVIN = NLEVEL
403 ELSEIF (NLEVEL.GT.NLEVIN) THEN
404 INGOTO = LINDEX(NLEVEL)
405 NL = NLEVIN
406 NLEVIN = NLEVEL
407 NLEVEL = NL
408 ENDIF
409* END GINVOL
410 999 IF(JGSTAT.NE.0) CALL GFSTAT(ISAME)
411 END
412#endif