]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gtrak/gtmed2.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Do not save CVS subdirectories
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / gtmed2.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 GTMEDI (X, NUMED)
14C.
15C. ******************************************************************
16C. * *
17C. * Finds in which volume/medium the point X is, and updates the *
18C. * common /GCVOLU/ and the structure JGPAR accordingly. *
19C. * *
20C. * NUMED returns the tracking medium number, or 0 if point is *
21C. * outside the experimental setup. *
22C. * *
23C. * Note : For INWVOL = 2, INFROM set to a positive number is *
24C. * interpreted by GTMEDI as the number IN of the content *
25C. * just left by the current track within the mother volume *
26C. * where the point X is assumed to be. *
27C. * *
28C. * Note : INFROM is set correctly by this routine but it is *
29C. * used on entrance only in the case GSNEXT has been called *
30C. * by the user. In other words the value of INFROM received *
31C. * on entrance is not considered necessarily valid. This *
32C. * assumption has been made for safety. A wrong value of *
33C. * INFROM can cause wrong tracking. *
34C. * *
35C. * Called by : GTRACK *
36C. * Authors : S.Banerjee, R.Brun, F.Bruyant, A.McPherson *
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
46 COMMON/GCCHAN/LSAMVL
47 LOGICAL LSAMVL
48C.
49 DIMENSION X(*)
50 REAL XC(3), XT(3)
51 LOGICAL BTEST
52C.
53C. ------------------------------------------------------------------
54*
55* SECTION I: The /GCVOLU/ table contains the initial guess for a path
56* in the geometry tree on which X may be found. Look along this
57* path until X is found inside. This is the starting position.
58* If this is an ONLY volume with no daughters, we are done;
59* otherwise reset search record variables, proceed to section II.
60*
61* *** Check if point is in current volume
62*
63 INFR = 0
64 INGT = 0
65 JVIN = 0
66*
67* *** LSAMVL is a logical variable that indicates whether we are still
68* *** in the current volume or not. It is used in GTRACK to detect
69* *** precision problems.
70 LSAMVL = .TRUE.
71C***** Code Expanded From Routine: GTRNSF
72C
73 100 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
74 XC(1) = X(1) - GTRAN(1,NLEVEL)
75 XC(2) = X(2) - GTRAN(2,NLEVEL)
76 XC(3) = X(3) - GTRAN(3,NLEVEL)
77*
78 ELSE
79 XL1 = X(1) - GTRAN(1,NLEVEL)
80 XL2 = X(2) - GTRAN(2,NLEVEL)
81 XL3 = X(3) - GTRAN(3,NLEVEL)
82 XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3*
83 + GRMAT(3,NLEVEL)
84 XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3*
85 + GRMAT(6,NLEVEL)
86 XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3*
87 + GRMAT(9,NLEVEL)
88
89 ENDIF
90C***** End of Code Expanded From Routine: GTRNSF
91*
92 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
93*
94* Note: At entry the variable INGOTO may contain the index of a volume
95* contained within the current one at NLEVEL. If so, begin by checking
96* if X lies inside. This improves the search speed over that of GMEDIA.
97*
98 NIN = Q(JVO+3)
99 IF ((INGOTO.LE.0).OR.(INGOTO.GT.NIN)) THEN
100 INGOTO = 0
101 ELSE
102*
103* *** Entrance in content INGOTO predicted by GTNEXT
104*
105 JIN = LQ(JVO-INGOTO)
106 IVOT = Q(JIN+2)
107 JVOT = LQ(JVOLUM-IVOT)
108 JPAR = LQ(JGPAR-NLEVEL-1)
109*
110 IROTT = Q(JIN+4)
111C***** Code Expanded From Routine: GITRAN
112C.
113C. ------------------------------------------------------------------
114C.
115 IF (IROTT .EQ. 0) THEN
116 XT(1) = XC(1) - Q(5+JIN)
117 XT(2) = XC(2) - Q(6+JIN)
118 XT(3) = XC(3) - Q(7+JIN)
119*
120 ELSE
121 XL1 = XC(1) - Q(5+JIN)
122 XL2 = XC(2) - Q(6+JIN)
123 XL3 = XC(3) - Q(7+JIN)
124 JR = LQ(JROTM-IROTT)
125 XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3)
126 XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6)
127 XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9)
128*
129 ENDIF
130C***** End of Code Expanded From Routine: GITRAN
131*
132* * Check if point is in content
133*
134 CALL GINME (XT, Q(JVOT+2), Q(JPAR+1), IYES)
135 IF (IYES.NE.0) THEN
136*
137* If so, prepare information for volume retrieval, and return
138*
139 LSAMVL = .FALSE.
140 NL1 = NLEVEL +1
141 LVOLUM(NL1) = IVOT
142 NAMES(NL1) = IQ(JVOLUM+IVOT)
143 NUMBER(NL1) = Q(JIN+3)
144 LINDEX(NL1) = INGOTO
145 LINMX(NL1) = Q(JVO+3)
146 GONLY(NL1) = Q(JIN+8)
147 IF (LQ(LQ(JVOLUM-IVOT)).EQ.0) THEN
148 NLDEV(NL1) = NLDEV(NLEVEL)
149 ELSE
150 NLDEV(NL1) = NL1
151 ENDIF
152 CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5),
153 + IROTT, GTRAN(1,NL1), GRMAT(1,NL1))
154 NLEVEL = NL1
155 XC(1) = XT(1)
156 XC(2) = XT(2)
157 XC(3) = XT(3)
158 JVO = JVOT
159 INFROM = 0
160 GO TO 190
161 ENDIF
162 ENDIF
163*
164* End of INGOTO processing
165*
166 JPAR = LQ(JGPAR-NLEVEL)
167 CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
168 IF (IYES.EQ.0) THEN
169*
170* ** Point not in current volume, go up the tree
171*
172 LSAMVL = .FALSE.
173 INGOTO = 0
174 IF (NLEVEL.GT.1) THEN
175 NLEVEL = NLEVEL -1
176 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
177 NIN = Q(JVO+3)
178 IF(NIN.GT.0) THEN
179 INFROM=LINDEX(NLEVEL+1)
180 ELSE
181 INFROM=0
182 ENDIF
183 INFR = INFROM
184 GO TO 100
185 ELSE
186*
187* * Point is outside setup
188*
189 NUMED = 0
190 GO TO 999
191 ENDIF
192 ELSE
193*
194* * Point in current volume but not in INGOTO. We block the
195* * corresponding volume
196*
197 IF (INGOTO.GT.0) THEN
198 INGT = INGOTO
199 JIN = LQ(JVO-INGOTO)
200 IQ(JIN) = IBSET(IQ(JIN),4)
201 ENDIF
202 ENDIF
203*
204* * Found a volume up the tree which contains our point. We block
205* * the branch we came up from.
206*
207 IF(INFR.GT.0) THEN
208 JIN=LQ(JVO-INFR)
209 IQ(JIN) = IBSET(IQ(JIN),4)
210 JVIN = JIN
211 ENDIF
212*
213* ** Point is in current volume
214*
215 190 INGOTO = 0
216 NLMIN = NLEVEL
217 IF (INWVOL.NE.2) INFROM = 0
218 NLMANY = 0
219*
220* SECTION II: X is found inside current node at NLEVEL in /GCVOLU/.
221* Search all contents recursively for any containing X.
222* Take the first one found, if any, and continue at that
223* level, incrementing NLEVEL and extending /GCVOLU/ tables.
224* This is continued until a level is reached where X is not
225* found in any of the contents, or there are no contents.
226* Note: Since Section II is re-entered from Section III, a blocking word
227* is used to mark those contents already checked. Upon exit from Section
228* II, these blocking words are cleared at NLEVEL, but may remain set in
229* levels between NLEVEL-1 and NLMIN, if any. They must be cleared at exit.
230*
231* ** Check contents, if any
232*
233 200 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
234 NIN = Q(JVO+3)
235*
236* * Case with no contents
237*
238 IF (NIN.EQ.0) THEN
239 GO TO 300
240*
241* * Case with contents defined by division
242*
243 ELSEIF (NIN.LT.0) THEN
244 CALL GMEDIV (JVO, IN, XC, 1)
245 IF (IN.GT.0) THEN
246 INFROM = 0
247 INFR = 0
248 INGT = 0
249 LSAMVL = .FALSE.
250 GO TO 200
251 ENDIF
252*
253* * Case with contents positioned
254*
255 ELSE
256 JCONT = LQ(JVO-NIN-1)+1
257 NCONT = IQ(JCONT)
258 ISEARC = Q(JVO+1)
259 IF (ISEARC.LT.0) THEN
260*
261* Prepare access to contents, when ordered by GSORD
262*
263 JSB = LQ(LQ(JVO-NIN-1))
264 IAX = Q(JSB+1)
265 NSB = Q(JSB+2)
266 IF (IAX.LE.3) THEN
267 CX = XC(IAX)
268 ELSE
269 CALL GFCOOR (XC, IAX, CX)
270 ENDIF
271 IDIV = ABS(LOCATF (Q(JSB+3), NSB, CX))
272 IF (IDIV.EQ.0) THEN
273 IF (IAX.NE.6) GO TO 260
274 IDIV = NSB
275 ELSEIF (IDIV.EQ.NSB) THEN
276 IF (IAX.NE.6) GO TO 260
277 ENDIF
278 JSC0 = LQ(JVO-NIN-2)
279 NCONT = IQ(JSC0+IDIV)
280 JCONT = LQ(JSC0-IDIV)
281 ELSE
282*
283* otherwise, scan contents (possibly a user selection of them)
284*
285 JNEAR = LQ(JVO-NIN-1)
286 IF (ISEARC.GT.0) THEN
287#if !defined(CERNLIB_USRJMP)
288 CALL GUNEAR (ISEARC, 1, XC, JNEAR)
289#endif
290#if defined(CERNLIB_USRJMP)
291 CALL JUMPT4(JUNEAR,ISEARC, 1, XC, JNEAR)
292#endif
293 ELSEIF (INFROM.GT.0) THEN
294 JNUP = LQ(LQ(JVO-INFROM)-1)
295 IF (JNUP.GT.0) THEN
296 JNEAR = JNUP
297 ENDIF
298 ENDIF
299 JCONT = JNEAR +1
300 NCONT = IQ(JCONT)
301 ENDIF
302*
303* For each selected content in turn, check if point is inside
304*
305 DO 259 ICONT=1,NCONT
306 IN = IQ(JCONT+ICONT)
307 IF(IN.EQ.0) THEN
308*
309* If the value IQ(JCONT+ICONT)=0 then we are back in the mother.
310* So jump to 260, the search is finished. Clean-up should be done
311* only up to ICONT-1, so we set:
312*
313 NCONT=ICONT-1
314 GOTO 260
315 ELSE
316 JIN = LQ(JVO-IN)
317 IF (.NOT.BTEST(IQ(JIN),4)) THEN
318 CALL GMEPOS (JVO, IN, XC, 1)
319 IF (IN.GT.0) THEN
320 IF (GONLY(NLEVEL).NE.0.) NLMANY = 0
321 INFROM = 0
322 INGT = 0
323 INFR = 0
324 LSAMVL = .FALSE.
325 GO TO 200
326 ELSE
327 IQ(JIN) = IBSET(IQ(JIN),4)
328 ENDIF
329 ENDIF
330 ENDIF
331 259 CONTINUE
332*
333 260 IF(NCONT.EQ.NIN) THEN
334 DO 268 IN=1,NIN
335 JIN = LQ(JVO-IN)
336 IQ(JIN) = IBCLR(IQ(JIN),4)
337 268 CONTINUE
338 ELSE
339 DO 269 ICONT=1,NCONT
340 IN = IQ(JCONT+ICONT)
341 JIN = LQ(JVO-IN)
342 IQ(JIN) = IBCLR(IQ(JIN),4)
343 269 CONTINUE
344 IF(INFR.NE.0) THEN
345 JIN = LQ(JVO-INFR)
346 IQ(JIN) = IBCLR(IQ(JIN),4)
347 INFR = 0
348 ENDIF
349 IF(INGT.NE.0) THEN
350 JIN = LQ(JVO-INGT)
351 IQ(JIN) = IBCLR(IQ(JIN),4)
352 INGT = 0
353 ENDIF
354 ENDIF
355*
356 ENDIF
357*
358* SECTION III: X is found at current node (NLEVEL in /GCVOLU) but not in
359* any of its contents, if any. If this is a MANY volume,
360* save it as a candidate best-choice, and continue the search
361* by backing up the tree one node and proceed to Section II.
362* If this is an ONLY volume, proceed to Section IV.
363*
364* *** Point is in current volume/medium, and not in any content
365*
366 300 IF (GONLY(NLEVEL).EQ.0.) THEN
367*
368* ** Lowest level is 'NOT ONLY'
369*
370 IF (NLEVEL.GT.NLMANY) THEN
371 CALL GSCVOL
372 NLMANY = NLEVEL
373 ENDIF
374*
375* * Go up the tree up to a volume with positioned contents
376*
377 310 INFROM = LINDEX(NLEVEL)
378 NLEVEL = NLEVEL -1
379 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
380 NIN = Q(JVO+3)
381 IF (NIN.LT.0) GO TO 310
382*
383C***** Code Expanded From Routine: GTRNSF
384C
385 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
386 XC(1) = X(1) - GTRAN(1,NLEVEL)
387 XC(2) = X(2) - GTRAN(2,NLEVEL)
388 XC(3) = X(3) - GTRAN(3,NLEVEL)
389*
390 ELSE
391 XL1 = X(1) - GTRAN(1,NLEVEL)
392 XL2 = X(2) - GTRAN(2,NLEVEL)
393 XL3 = X(3) - GTRAN(3,NLEVEL)
394 XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) +
395 + XL3* GRMAT(3,NLEVEL)
396 XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) +
397 + XL3* GRMAT(6,NLEVEL)
398 XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) +
399 + XL3* GRMAT(9,NLEVEL)
400*
401 ENDIF
402C***** End of Code Expanded From Routine: GTRNSF
403*
404 INFR = INFROM
405 JIN = LQ(JVO-INFROM)
406 IQ(JIN) = IBSET(IQ(JIN),4)
407 NLMIN = MIN(NLEVEL,NLMIN)
408 GO TO 200
409 ENDIF
410*
411* SECTION IV: This is the end of the search. The current node (NLEVEL
412* in /GCVOLU/) is the lowest ONLY volume in which X is found.
413* If X was also found in any of its contents, they are MANY
414* volumes: the best-choice is the one among them at the greatest
415* level in the tree, and it is stored. Otherwise the current
416* volume is the solution. Before exit, all of the blocking
417* words leftover in the tree must be reset to zero.
418* Note: A valid structure is assumed, in which no ONLY volumes overlap.
419* If this rule is violated, or if a daughter is not entirely contained
420* within the mother volume, the results are unpredictable.
421*
422 DO 419 NL=NLMIN,NLEVEL-1
423 JVO = LQ(JVOLUM-LVOLUM(NL))
424 NIN = Q(JVO+3)
425 DO 418 IN=1,NIN
426 JIN = LQ(JVO-IN)
427 IQ(JIN) = IBCLR(IQ(JIN),4)
428 418 CONTINUE
429 419 CONTINUE
430*
431 IF (NLMANY.GT.0) CALL GFCVOL
432 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
433 IF(JVIN.NE.0) IQ(JVIN) = IBCLR(IQ(JVIN),4)
434 NUMED = Q(JVO+4)
435* END GTMEDI
436 999 IF(JGSTAT.NE.0) CALL GFSTAT(4)
437 END
438#endif