]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/ggeom/gmedia.F.ori
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Dummy subroutines to avoid files with no code in
[u/mrichter/AliRoot.git] / GEANT321 / ggeom / gmedia.F.ori
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.3 1998/02/09 16:48:33 japost
6* Simone's fix for MANY volumes in gmedia.
7*
8* Revision 1.2 1996/09/30 14:25:07 ravndal
9* Windows NT related modifications
10*
11* Revision 1.1.1.1 1995/10/24 10:20:51 cernlib
12* Geant
13*
14*
15#include "geant321/pilot.h"
16#if !defined(CERNLIB_OLD)
17*CMZ : 3.21/02 29/03/94 15.24.17 by S.Giani
18*-- Author :
19 SUBROUTINE GMEDIA (X, NUMED)
20C.
21C. ******************************************************************
22C. * *
23C. * Finds in which volume/medium the point X is, and updates the *
24C. * common /GCVOLU/ and the structure JGPAR accordingly. *
25C. * *
26C. * NUMED returns the tracking medium number, or 0 if point is *
27C. * outside the experimental setup. *
28C. * *
29C. * Called by : GTREVE, GLTRAC, 'User' *
30C. * Authors : R.Brun, F.Bruyant, A.McPherson *
31C. * S.Giani. *
32C. * *
33C. * Modified by S.Giani (1993) to perform the search according *
34C. * to the new 'virtual divisions' algorithm and to build the *
35C. * stack of the 'possible overlapping volumes' in the case of *
36C. * MANY volumes. Any kind of boolean operation is now possible.*
37C. * Divisions along arbitrary axis are now possible. *
38C. * *
39C. ******************************************************************
40C.
41#include "geant321/gcflag.inc"
42#include "geant321/gckine.inc"
43#include "geant321/gcbank.inc"
44#include "geant321/gcvolu.inc"
45#include "geant321/gctrak.inc"
46#if defined(CERNLIB_USRJMP)
47#include "geant321/gcjump.inc"
48#endif
49#include "geant321/gcvdma.inc"
50#include "geant321/gchvir.inc"
51C.
52 DIMENSION X(*)
53 REAL XC(6)
54 LOGICAL BTEST
55 CHARACTER*4 NAME
56C.
57C. ------------------------------------------------------------------
58*
59 nvmany=0
60 nfmany=0
61 new2fl=0
62*
63 IF (NLEVEL.EQ.0) CALL GMEDIN
64*
65* SECTION I: The /GCVOLU/ table contains the initial guess for a path
66* in the geometry tree on which X may be found. Look along this
67* path until X is found inside. This is the starting position.
68* If this is an ONLY volume with no daughters, we are done;
69* otherwise reset search record variables, proceed to section II.
70*
71* The information contained in INFROM has to be invalidated
72* because it has no meaning for the subsequent tracking. INFR
73* is a local variable used to optimise the search in the
74* geometry tree.
75*
76 INFROM = 0
77*
78* *** Check if point is in current volume
79*
80 INFR = 0
81 JVIN = 0
82C***** Code Expanded From Routine: GTRNSF
83C
84 100 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
85 XC(1) = X(1) - GTRAN(1,NLEVEL)
86 XC(2) = X(2) - GTRAN(2,NLEVEL)
87 XC(3) = X(3) - GTRAN(3,NLEVEL)
88*
89 ELSE
90 XL1 = X(1) - GTRAN(1,NLEVEL)
91 XL2 = X(2) - GTRAN(2,NLEVEL)
92 XL3 = X(3) - GTRAN(3,NLEVEL)
93 XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3*GRMAT(3
94 + ,NLEVEL)
95 XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3*GRMAT(6
96 + ,NLEVEL)
97 XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3*GRMAT(9
98 + ,NLEVEL)
99
100 ENDIF
101 xc(4)=0.
102 xc(5)=0.
103 xc(6)=0.
104C***** End of Code Expanded From Routine: GTRNSF
105*
106 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
107 JPAR = LQ(JGPAR-NLEVEL)
108 CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
109 IF (IYES.EQ.0) THEN
110*
111* ** Point not in current volume, go up the tree
112*
113 IF (NLEVEL.GT.1) THEN
114 NLEVEL = NLEVEL -1
115 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
116 NIN = Q(JVO+3)
117 IF(NIN.GT.0) THEN
118*
119* Do not set INFR whne going up the tree. GMEDIA can be called
120* by the user and it should not assume that the previous
121* position has something to do with the current search. INFR
122* is otherwise useful when searching in a 'MANY' volume
123* configuration. This statement is commented for the above reason.
124*
125* INFR =LINDEX(NLEVEL+1)
126 ELSE
127 INFR =0
128 ENDIF
129 GO TO 100
130 ELSE
131*
132* * Point is outside setup
133*
134 NUMED = 0
135 GO TO 999
136 ENDIF
137 ENDIF
138*
139* ** Point is in current volume
140*
141 IF(INFR .GT.0) THEN
142 JIN=LQ(JVO-INFR )
143 IQ(JIN) = IBSET(IQ(JIN),4)
144 JVIN = JIN
145 ENDIF
146* To avoid starting from the protuding part of a MANY volume
147 IF(GONLY(NLEVEL).EQ.0.) THEN
148 NLEVEL = NLEVEL -1
149 GO TO 100
150 ENDIF
151 NLMIN = NLEVEL
152 NLMANY = 0
153*
154* SECTION II: X is found inside current node at NLEVEL in /GCVOLU/.
155* Search all contents recursively for any containing X.
156* Take the first one found, if any, and continue at that
157* level, incrementing NLEVEL and extending /GCVOLU/ tables.
158* This is continued until a level is reached where X is not
159* found in any of the contents, or there are no contents.
160* Note: Since Section II is re-entered from Section III, a blocking word
161* is used to mark those contents already checked. Upon exit from Section
162* II, these blocking words are cleared at NLEVEL, but may remain set in
163* levels between NLEVEL-1 and NLMIN, if any. They must be cleared at exit.
164*
165* ** Check contents, if any
166*
167 200 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
168 NIN = Q(JVO+3)
169 if(raytra.eq.1..and.imyse.eq.1)then
170 CALL UHTOC(NAMES(NLEVEL),4,NAME,4)
171 CALL GFIND(NAME,'SEEN',ISSEEN)
172 if(isseen.eq.-2.or.isseen.eq.-1)goto 300
173 endif
174*
175* * Case with no contents
176*
177 IF (NIN.EQ.0) THEN
178 GO TO 300
179*
180* * Case with contents defined by division
181*
182 ELSEIF (NIN.LT.0) THEN
183 CALL GMEDIV (JVO, IN, XC, 1)
184 IF (IN.GT.0) THEN
185 INFR = 0
186 GO TO 200
187 ENDIF
188*
189* * Case with contents positioned
190*
191 ELSE
192 if(nin.gt.1)then
193 clmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+3)
194 chmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+4)
195 ndivto=q(jvirt+4*(LVOLUM(NLEVEL)-1)+2)
196 iaxis =q(jvirt+4*(LVOLUM(NLEVEL)-1)+1)
197 if(iaxis.le.3)then
198 ivdiv=((xc(iaxis)-clmoth)*ndivto/(chmoth-clmoth))+1
199 if(ivdiv.lt.1)then
200 ivdiv=1
201 elseif(ivdiv.gt.ndivto)then
202 ivdiv=ndivto
203 endif
204 else
205 call gfcoor(xc,iaxis,cx)
206 if(iaxis.eq.6)then
207 if((cx-clmoth).lt.-1.)then
208 cx=cx+360.
209 elseif((cx-chmoth).gt.1.)then
210 cx=cx-360.
211 endif
212 if(cx.gt.chmoth)then
213 cx=chmoth
214 elseif(cx.lt.clmoth)then
215 cx=clmoth
216 endif
217 endif
218 ivdiv=((cx-clmoth)*ndivto/(chmoth-clmoth))+1
219 if(ivdiv.lt.1)then
220 ivdiv=1
221 elseif(ivdiv.gt.ndivto)then
222 ivdiv=ndivto
223 endif
224 endif
225 jvdiv=lq(jvirt-LVOLUM(NLEVEL))
226 iofset=iq(jvdiv+ivdiv)
227 ncont=iq(jvdiv+iofset+1)
228 jcont=jvdiv+iofset+1
229 if(ncont.eq.0)goto 260
230 else
231 JCONT = LQ(JVO-NIN-1)+1
232 NCONT = 1
233 endif
234*
235* For each selected content in turn, check if point is inside
236*
237 DO 259 ICONT=1,NCONT
238 if(nin.eq.1)then
239 in=1
240 else
241 IN = IQ(JCONT+ICONT)
242 endif
243 IF(IN.EQ.0) THEN
244*
245* If the value IQ(JCONT+ICONT)=0 then we are back in the mother.
246* So jump to 260, the search is finished. Clean-up should be done
247* only up to ICONT-1, so we set:
248*
249 NCONT=ICONT-1
250 GOTO 260
251 ELSE
252 JIN = LQ(JVO-IN)
253 IF (.NOT.BTEST(IQ(JIN),4)) THEN
254 CALL GMEPOS (JVO, IN, XC, 1)
255 IF (IN.GT.0) THEN
256 new2fl=0
257 IF (GONLY(NLEVEL).NE.0.) THEN
258 NLMANY = 0
259 nvmany = 0
260 nfmany = 0
261 ENDIF
262 INFR = 0
263 GO TO 200
264 ELSE
265 IQ(JIN) = IBSET(IQ(JIN),4)
266 ENDIF
267 ENDIF
268 ENDIF
269 259 CONTINUE
270*
271 260 IF(NCONT.EQ.NIN) THEN
272 DO 268 IN=1,NIN
273 JIN = LQ(JVO-IN)
274 IQ(JIN) = IBCLR(IQ(JIN),4)
275 268 CONTINUE
276 ELSE
277 DO 269 ICONT=1,NCONT
278 if(nin.eq.1)then
279 in=1
280 else
281 IN = IQ(JCONT+ICONT)
282 endif
283 JIN = LQ(JVO-IN)
284 IQ(JIN) = IBCLR(IQ(JIN),4)
285 269 CONTINUE
286 IF(INFR .GT.0) THEN
287 JIN = LQ(JVO-INFR )
288 IQ(JIN) = IBCLR(IQ(JIN),4)
289 ENDIF
290 ENDIF
291*
292 ENDIF
293*
294* SECTION III: X is found at current node (NLEVEL in /GCVOLU) but not in
295* any of its contents, if any. If this is a MANY volume,
296* save it as a candidate best-choice, and continue the search
297* by backing up the tree one node and proceed to Section II.
298* If this is an ONLY volume, proceed to Section IV.
299*
300* *** Point is in current volume/medium, and not in any content
301*
302 300 IF (GONLY(NLEVEL).EQ.0.) THEN
303*
304* ** Lowest level is 'NOT ONLY'
305*
306 IF (NLEVEL.GT.NLMANY) THEN
307 CALL GSCVOL
308 NLMANY = NLEVEL
309 nfmany=nvmany+1
310 ENDIF
311 if(new2fl.eq.0)then
312 nvmany=nvmany+1
313 manyle(nvmany)=nlevel
314 do 401 i = 1,nlevel
315 manyna(nvmany,i)=names(i)
316 manynu(nvmany,i)=number(i)
317 401 continue
318 endif
319*
320* * Go up the tree up to a volume with positioned contents
321*
322 new2fl=-1
323 310 INFR = LINDEX(NLEVEL)
324 NLEVEL = NLEVEL -1
325 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
326 NIN = Q(JVO+3)
327 IF (NIN.LT.0) GO TO 310
328*
329C***** Code Expanded From Routine: GTRNSF
330C
331 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
332 XC(1) = X(1) - GTRAN(1,NLEVEL)
333 XC(2) = X(2) - GTRAN(2,NLEVEL)
334 XC(3) = X(3) - GTRAN(3,NLEVEL)
335*
336 ELSE
337 XL1 = X(1) - GTRAN(1,NLEVEL)
338 XL2 = X(2) - GTRAN(2,NLEVEL)
339 XL3 = X(3) - GTRAN(3,NLEVEL)
340 XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3*
341 + GRMAT(3,NLEVEL)
342 XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3*
343 + GRMAT(6,NLEVEL)
344 XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3*
345 + GRMAT(9,NLEVEL)
346
347 ENDIF
348C***** End of Code Expanded From Routine: GTRNSF
349*
350 JIN = LQ(JVO-INFR )
351 IQ(JIN) = IBSET(IQ(JIN),4)
352 NLMIN = MIN(NLEVEL,NLMIN)
353 GO TO 200
354 ENDIF
355*
356* SECTION IV: This is the end of the search. The current node (NLEVEL
357* in /GCVOLU/) is the lowest ONLY volume in which X is found.
358* If X was also found in any of its contents, they are MANY
359* volumes: the best-choice is the one among them at the greatest
360* level in the tree, and it is stored. Otherwise the current
361* volume is the solution. Before exit, all of the blocking
362* words leftover in the tree must be reset to zero.
363* Note: A valid structure is assumed, in which no ONLY volumes overlap.
364* If this rule is violated, or if a daughter is not entirely contained
365* within the mother volume, the results are unpredictable.
366*
367 DO 419 NL=NLMIN,NLEVEL-1
368 JVO = LQ(JVOLUM-LVOLUM(NL))
369 NIN = Q(JVO+3)
370 DO 418 IN=1,NIN
371 JIN = LQ(JVO-IN)
372 IQ(JIN) = IBCLR(IQ(JIN),4)
373 418 CONTINUE
374 419 CONTINUE
375*
376 if(nlmany.eq.0)then
377 nvmany=0
378 nfmany=0
379 endif
380 IF (NLMANY.GT.0) CALL GFCVOL
381 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
382 IF(JVIN.NE.0) IQ(JVIN) = IBCLR(IQ(JVIN),4)
383 NUMED = Q(JVO+4)
384* END GMEDIA
385 999 IF(JGSTAT.NE.0) CALL GFSTAT(2)
386 END
387#endif