]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/ggeom/gnex2.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 / ggeom / gnex2.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
62be6b28 5* Revision 1.1.1.1 1999/05/18 15:55:17 fca
6* AliRoot sources
7*
fe4da5cc 8* Revision 1.1.1.1 1995/10/24 10:20:57 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.31 by S.Giani
15*-- Author :
16 SUBROUTINE GNEXT (X, SNEXT, SAFETY)
17C.
18C. ******************************************************************
19C. * *
20C. * SUBR. GNEXT (X, SNEXT, SAFETY) *
21C. * *
22C. * Computes SNEXT and SAFETY *
23C. * SNEXT (output) : distance to closest boundary *
24C. * from point X(1-3) along X(4-6) *
25C. * SAFETY (output) : shortest distance to any boundary *
26C. * *
27C. * Called by : User *
28C. * Authors : S.Banerjee, R.Brun, F.Bruyant *
29C. * *
30C. ******************************************************************
31C.
32#include "geant321/gcbank.inc"
33#include "geant321/gconsp.inc"
34#include "geant321/gcshno.inc"
35#include "geant321/gctmed.inc"
36#include "geant321/gcvolu.inc"
37#if defined(CERNLIB_USRJMP)
38#include "geant321/gcjump.inc"
39#endif
40 REAL X(6), X0(3), XC(6), XT(6)
41 INTEGER IDTYP(3,12)
42 LOGICAL BTEST
43 SAVE IDTYP
44C.
45 DATA IDTYP / 1, 1, 1, 0, 1, 1, 0, 0, 1, 0, 0, 1, 2, 3, 1,
46 + 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 4, 3, 1, 1, 1,
47 + 2, 3, 1, 2, 3, 1/
48C.
49C. ------------------------------------------------------------------
50*
51* *** Transform current point and direction into local reference system
52*
53 IF (GRMAT(10,NLEVEL).EQ.0.) THEN
54 DO 19 I = 1,3
55 XC(I) = X(I) -GTRAN(I,NLEVEL)
56 XC(I+3) = X(I+3)
57 19 CONTINUE
58 ELSE
59* (later, code in line)
60 CALL GTRNSF (X, GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), XC)
61 CALL GROT (X(4), GRMAT(1,NLEVEL), XC(4))
62 ENDIF
63*
64* *** Compute distance to boundaries
65*
66 SNEXT = BIG
67 SAFETY = BIG
68 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
69 ISH = Q(JVO+2)
70 IF (Q(JVO+3).EQ.0.) GO TO 300
71 NIN = Q(JVO+3)
72 IF (NIN.LT.0) GO TO 200
73*
74* *** Case with contents positioned
75*
76 ISEARC = Q(JVO+1)
77 IF (ISEARC.GE.-1) GO TO 120
78*
79* ** Contents are ordered by (dynamic) GSORD, select neighbours
80*
81 JSB = LQ(LQ(JVO-NIN-1))
82 IAX = Q(JSB+1)
83 NSB = Q(JSB+2)
84 IF (IAX.LE.3) THEN
85 CX = XC(IAX)
86 INC = SIGN(1., XC(IAX+3))
87 ELSE
88 CALL GFCOOR (XC, IAX, CX)
89 IF (IAX.LE.5) THEN
90 DR = XC(1)*XC(4) +XC(2)*XC(5)
91 IF (IAX.EQ.5) DR = DR +XC(3)*XC(6)
92 INC = SIGN(1., DR)
93 ELSE IF (IAX.EQ.6) THEN
94 INC = SIGN(1., XC(1)*XC(5)-XC(2)*XC(4))
95 ELSE
96 INC = SIGN(1., XC(3)*(XC(1)*XC(4)+XC(2)*XC(5))
97 + -XC(6)*(XC(1)*XC(1)+XC(2)*XC(2)))
98 ENDIF
99 ENDIF
100 IDIV = LOCATF (Q(JSB+3), NSB, CX)
101 IF (IDIV.LT.0) IDIV = -IDIV
102 IF (IAX.NE.6) THEN
103 IF (IDIV.EQ.0) THEN
104 IF (INC.LT.0.AND.IAX.LE.3) THEN
105 SAFETY = Q(JSB+3) -CX
106 GO TO 300
107 ENDIF
108 IDIV = 1
109 ELSE IF (IDIV.EQ.NSB) THEN
110 IF (INC.GT.0.AND.IAX.NE.7) THEN
111 SAFETY = CX -Q(JSB+2+NSB)
112 GO TO 300
113 ENDIF
114 IDIV = NSB -1
115 ELSE
116 IF (IAX.NE.7) THEN
117 IF (INC.GT.0) THEN
118 SAFETY = CX -Q(JSB+2+IDIV)
119 ELSE
120 SAFETY = Q(JSB+3+IDIV) -CX
121 ENDIF
122 ELSE
123 SAFETY = 0.
124 ENDIF
125 ENDIF
126 ELSE IF (IAX.EQ.6) THEN
127 IF (IDIV.EQ.0) IDIV = NSB
128 SAFETY = 0.
129 ENDIF
130*
131 IDIVL = 0
132 IDIVB = 0
133 JSC0 = LQ(JVO-NIN-2)
134 110 NCONT = IQ(JSC0+IDIV)
135*
136* ** Loop over (selected) contents
137*
138 IF (NCONT.EQ.0) THEN
139 IF (IDIV.EQ.IDIVL) GO TO 400
140 IDIV = IDIV +INC
141* (following statement for IAX=6, when division NSB is empty)
142 IF (IDIV.GT.NSB) IDIV = 1
143 GO TO 110
144 ELSE
145 ICONT = 1
146 JSCV = LQ(JSC0-IDIV)
147 GO TO 140
148 ENDIF
149*
150 120 JNEAR = LQ(JVO-NIN-1)
151 IF (ISEARC.GT.0) THEN
152#if !defined(CERNLIB_USRJMP)
153 CALL GUNEAR (ISEARC, 2, XC, JNEAR)
154#endif
155#if defined(CERNLIB_USRJMP)
156 CALL JUMPT4(JUNEAR,ISEARC, 2, XC, JNEAR)
157#endif
158 IF (IQ(JNEAR+1).EQ.0) GO TO 300
159 ENDIF
160 JNEAR = JNEAR +1
161 NNEAR = IQ(JNEAR)
162 IF (IQ(JNEAR+1).NE.0) THEN
163 INEAR = 1
164 ELSE
165 INEAR = 2
166 ENDIF
167*
168 130 IN = IQ(JNEAR+INEAR)
169 GO TO 150
170*
171 140 IN = IQ(JSCV+ICONT)
172*
173 150 IF(IN.LE.0)GO TO 300
174 JIN = LQ(JVO-IN)
175 IVOT = Q(JIN+2)
176 JVOT = LQ(JVOLUM-IVOT)
177 IROTT = Q(JIN+4)
178*
179 IF (NLEVEL.GE.NLDEV(NLEVEL)) THEN
180* (case with JVOLUM structure locally developed)
181 JPAR = LQ(LQ(JVOLUM-LVOLUM(NLDEV(NLEVEL))))
182 DO 169 ILEV = NLDEV(NLEVEL), NLEVEL
183 IF (IQ(JPAR+1).EQ.0) THEN
184 IF (ILEV.EQ.NLEVEL) THEN
185 JPAR = LQ(JPAR-IN)
186 ELSE
187 JPAR = LQ(JPAR-LINDEX(ILEV+1))
188 ENDIF
189 IF (JPAR.EQ.0) GO TO 170
190 ELSE IF (IQ(JPAR-3).GT.1) THEN
191 JPAR = LQ(JPAR-LINDEX(ILEV+1))
192 ELSE
193 JPAR = LQ(JPAR-1)
194 ENDIF
195 169 CONTINUE
196 JPAR = JPAR + 5
197 GO TO 180
198 ENDIF
199* (normal case)
200 170 NPAR = Q(JVOT+5)
201 IF (NPAR.EQ.0) THEN
202 JPAR = JIN +9
203 ELSE
204 JPAR = JVOT +6
205 ENDIF
206*
207* * Compute distance to boundary of current content
208*
209 180 IF (IROTT.EQ.0) THEN
210 DO 189 I = 1,3
211 XT(I) = XC(I) -Q(JIN+4+I)
212 XT(I+3) = XC(I+3)
213 189 CONTINUE
214 ELSE
215* (later, code in line)
216 CALL GITRAN (XC, Q(JIN+5), IROTT, XT)
217 CALL GRMTD (XC(4), IROTT, XT(4))
218 ENDIF
219*
220 IACT = 2
221 ISHT = Q(JVOT+2)
222 IF (ISHT.LT.5) THEN
223 IF (ISHT.EQ.1) THEN
224 CALL GNOBOX (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE)
225 ELSE IF (ISHT.EQ.2) THEN
226 CALL GNOTRA(XT,Q(JPAR+1),IACT,1,SNEXT,SNXT,SAFE)
227 ELSE IF (ISHT.EQ.3) THEN
228 CALL GNOTRA(XT,Q(JPAR+1),IACT,2,SNEXT,SNXT,SAFE)
229 ELSE
230 CALL GNOTRP (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE)
231 ENDIF
232 ELSE IF (ISHT.LE.10) THEN
233 IF (ISHT.EQ.5) THEN
234 CALL GNOTUB(XT,Q(JPAR+1),IACT,1,SNEXT,SNXT,SAFE)
235 ELSE IF (ISHT.EQ.6) THEN
236 CALL GNOTUB(XT,Q(JPAR+1),IACT,2,SNEXT,SNXT,SAFE)
237 ELSE IF (ISHT.EQ.7) THEN
238 CALL GNOCON(XT,Q(JPAR+1),IACT,1,SNEXT,SNXT,SAFE)
239 ELSE IF (ISHT.EQ.8) THEN
240 CALL GNOCON(XT,Q(JPAR+1),IACT,2,SNEXT,SNXT,SAFE)
241 ELSE IF (ISHT.EQ.9) THEN
242 CALL GNOSPH (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE)
243 ELSE
244 CALL GNOPAR (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE)
245 ENDIF
246 ELSE IF (ISHT.EQ.11) THEN
247 CALL GNOPGO (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE)
248 ELSE IF (ISHT.EQ.12) THEN
249 CALL GNOPCO (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE)
250 ELSE IF (ISHT.EQ.13) THEN
251 CALL GNOELT (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE)
252 ELSE IF (ISHT.EQ.14) THEN
253 CALL GNOHYP (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE)
254 ELSE IF (ISHT.EQ.28) THEN
255 CALL GSNGTR (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE,0)
256 ELSE IF (ISHT.EQ.NSCTUB) THEN
257 CALL GNOCTU (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE)
258 ELSE
259 PRINT *, ' GNEXT : No code for shape ', ISHT
260 STOP
261 ENDIF
262*
263 IF (SAFE.LT.SAFETY) SAFETY = SAFE
264 IF (SNXT.LT.SNEXT) THEN
265 SNEXT = SNXT
266 IF (ISEARC.EQ.-2) THEN
267 IF (MOD(IQ(JSC0),2).NE.0) THEN
268 IDIVB = IDIV
269 ELSE
270 DO 191 I = 1,3
271 X0(I) = XC(I) + SNXT*XC(I+3)
272 191 CONTINUE
273 IF (IAX.LE.3) THEN
274 IDIVB = LOCATF (Q(JSB+3), NSB, X0(IAX))
275 ELSE
276 CALL GFCOOR (X0, IAX, CX)
277 IDIVB = LOCATF (Q(JSB+3), NSB, CX)
278 ENDIF
279 IF (IDIVB.LT.0) IDIVB = -IDIVB
280 IF (IDIVB.EQ.0) THEN
281 IF (IAX.EQ.6) THEN
282 IDIVB = NSB
283 ELSE
284 IDIVB = 1
285 ENDIF
286 ELSE IF (IDIVB.EQ.NSB) THEN
287 IF (IAX.NE.6) IDIVB = NSB - 1
288 ENDIF
289 ENDIF
290 ENDIF
291 ENDIF
292*
293 IF (ISEARC.EQ.-2) THEN
294 IF (ICONT.EQ.NCONT) THEN
295 IF (IDIVL.EQ.0) THEN
296 IF (IDIVB.NE.0) THEN
297 IF (IDIV.EQ.IDIVB) GO TO 300
298 IF (.NOT.BTEST(IQ(JVO),2)) THEN
299 IDIVL = IDIVB
300 GO TO 193
301 ENDIF
302 ENDIF
303*
304* * Compute distance to boundary of current volume
305*
306 JPAR = LQ(JGPAR-NLEVEL)
307 IACT = 2
308 ISH = Q(JVO+2)
309 IF (ISH.LT.5) THEN
310 IF (ISH.EQ.1) THEN
311 CALL GNBOX (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
312 ELSE IF (ISH.EQ.2) THEN
313 CALL GNTRAP (XC, Q(JPAR+1),IACT,1, SNEXT,SNXT,SAFE)
314 ELSE IF (ISH.EQ.3) THEN
315 CALL GNTRAP (XC, Q(JPAR+1),IACT,2, SNEXT,SNXT,SAFE)
316 ELSE
317 CALL GNTRP (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
318 ENDIF
319 ELSE IF (ISH.LE.10) THEN
320 IF (ISH.EQ.5) THEN
321 CALL GNTUBE (XC, Q(JPAR+1),IACT,1, SNEXT,SNXT,SAFE)
322 ELSE IF (ISH.EQ.6) THEN
323 CALL GNTUBE (XC, Q(JPAR+1),IACT,2, SNEXT,SNXT,SAFE)
324 ELSE IF (ISH.EQ.7) THEN
325 CALL GNCONE (XC, Q(JPAR+1),IACT,1, SNEXT,SNXT,SAFE)
326 ELSE IF (ISH.EQ.8) THEN
327 CALL GNCONE (XC, Q(JPAR+1),IACT,2, SNEXT,SNXT,SAFE)
328 ELSE IF (ISH.EQ.9) THEN
329 CALL GNSPHR (XC, Q(JPAR+1),IACT, SNEXT, SNXT, SAFE)
330 ELSE
331 CALL GNPARA (XC, Q(JPAR+1),IACT, SNEXT, SNXT, SAFE)
332 ENDIF
333 ELSE IF (ISH.EQ.12) THEN
334 CALL GNPCON (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
335 ELSE IF (ISH.EQ.11) THEN
336 CALL GNPGON (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
337 ELSE IF (ISH.EQ.13) THEN
338 CALL GNELTU (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
339 ELSE IF (ISH.EQ.14) THEN
340 CALL GNHYPE (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
341 ELSE IF (ISH.EQ.28) THEN
342 CALL GSNGTR (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE,1)
343 ELSE IF (ISH.EQ.NSCTUB) THEN
344 CALL GNCTUB (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
345 ELSE
346 PRINT *, ' GNEXT : No code for shape ', ISH
347 STOP
348 ENDIF
349*
350 IF (SAFE.LT.SAFETY) SAFETY = SAFE
351 IF (SNXT.LT.SNEXT) SNEXT = SNXT
352*
353* * Check wether other pseudo-divisions have to be scanned
354*
355 DO 192 I = 1,3
356 X0(I) = XC(I) +SNXT*XC(I+3)
357 192 CONTINUE
358 IF (IAX.LE.3) THEN
359 IDIVL = LOCATF (Q(JSB+3), NSB, X0(IAX))
360 ELSE
361 CALL GFCOOR (X0, IAX, CX)
362 IDIVL = LOCATF (Q(JSB+3), NSB, CX)
363 ENDIF
364 IF (IDIVL.LT.0) IDIVL = -IDIVL
365 IF (IDIVL.EQ.0) THEN
366 IF(IAX.EQ.6)THEN
367 IDIVL=NSB
368 ELSE
369 IDIVL=1
370 ENDIF
371 ELSEIF (IDIVL.EQ.NSB)THEN
372 IF(IAX.NE.6)IDIVL=NSB-1
373 ENDIF
374 ELSE
375 IF (IDIV.EQ.IDIVB) GO TO 400
376 ENDIF
377 193 IF ((IDIV-IDIVL)*INC.GE.0) GO TO 400
378 IDIV = IDIV +INC
379 GO TO 110
380 ELSE
381 ICONT = ICONT +1
382 GO TO 140
383 ENDIF
384 ELSE
385 IF (INEAR.EQ.NNEAR) GO TO 300
386 INEAR = INEAR +1
387 GO TO 130
388 ENDIF
389*
390* *** Case of volume incompletely divided
391*
392 200 JDIV = LQ(JVO-1)
393 IAXIS = Q(JDIV+1)
394 IVOT = Q(JDIV+2)
395 JVOT = LQ(JVOLUM-IVOT)
396 ISHT = Q(JVOT+2)
397*
398* ** Get the division parameters
399*
400 IF (NLEVEL.LT.NLDEV(NLEVEL)) THEN
401 JPARM = 0
402 ELSE
403* (case with JVOLUM structure locally developed)
404 JPARM = LQ(LQ(JVOLUM-LVOLUM(NLDEV(NLEVEL))))
405 IF (NLEVEL.EQ.NLDEV(NLEVEL)) GO TO 215
406 DO 210 ILEV = NLDEV(NLEVEL), NLEVEL-1
407 IF (IQ(JPARM+1).EQ.0) THEN
408 JPARM = LQ(JPARM-LINDEX(ILEV+1))
409 IF (JPARM.EQ.0) GO TO 215
410 ELSE IF (IQ(JPARM-3).GT.1) THEN
411 JPARM = LQ(JPARM-LINDEX(ILEV+1))
412 ELSE
413 JPARM = LQ(JPARM-1)
414 ENDIF
415 IF (ILEV.EQ.NLEVEL-1) THEN
416 NDIV = IQ(JPARM+1)
417 ORIG = Q(JPARM+2)
418 SDIV = Q(JPARM+3)
419 ENDIF
420 210 CONTINUE
421 GO TO 220
422 ENDIF
423* (normal case)
424 215 NDIV = Q(JDIV+3)
425 ORIG = Q(JDIV+4)
426 SDIV = Q(JDIV+5)
427*
428* ** Look at the first and the last divisions only
429*
430 220 IDT = IDTYP(IAXIS, ISH)
431 IF (IDT.EQ.1) THEN
432 IN2 = 0
433 IF (XC(IAXIS).LT.ORIG) THEN
434 IN = 1
435 ELSE
436 IN = NDIV
437 ENDIF
438 ELSE IF (IDT.EQ.2) THEN
439 R = XC(1)**2 + XC(2)**2
440 IF (ISH.EQ.9) R = R + XC(3)**2
441 R = SQRT(R)
442 IN2 = 0
443 IF (ISH.EQ.5.OR.ISH.EQ.6.OR.ISH.EQ.9) THEN
444 IF (R.LT.ORIG) THEN
445 IN = 1
446 ELSE
447 IN = NDIV
448 ENDIF
449 ELSE
450 PRINT *, ' GNEXT : Partially divided ',ISH,IAXIS
451 IN = 1
452 IF (NDIV.GT.1) IN2 = NDIV
453 ENDIF
454 ELSE IF (IDT.EQ.4) THEN
455 IN2 = 0
456 RXY = XC(1)**2 + XC(2)**2
457 RXY = SQRT(RXY)
458 IF (XC(3).NE.0.0) THEN
459 THET = RADDEG * ATAN (RXY/XC(3))
460 IF (THET.LT.0.0) THET = THET + 180.0
461 ELSE
462 THET = 90.
463 ENDIF
464 IF (THET.LE.ORIG) THEN
465 IN = 1
466 ELSE
467 IN = NDIV
468 ENDIF
469 ELSE
470 PRINT *, ' GNEXT : Partially divided ',ISH,IAXIS
471 IN2 = 0
472 IF (ISH.EQ.5.OR.ISH.EQ.7) THEN
473 IN = 1
474 IF (NDIV.GT.1) IN2 = NDIV
475 ELSE
476 IF (XC(1).NE.0.0.OR.XC(2).NE.0.0) THEN
477 PHI = RADDEG * ATAN2 (XC(2), XC(1))
478 ELSE
479 PHI = 0.0
480 ENDIF
481 IF (ISH.EQ.6.OR.ISH.EQ.8) THEN
482 IF (PHI.LT.ORIG) THEN
483 IN = 1
484 ELSE
485 IN = NDIV
486 ENDIF
487 ELSE
488 IN = 1
489 IF (NDIV.GT.1) IN2 = NDIV
490 ENDIF
491 ENDIF
492 ENDIF
493*
494 225 IF (IDT.EQ.1) THEN
495 DO 231 I = 1, 3
496 X0(I) = 0.0
497 231 CONTINUE
498 X0(IAXIS) = ORIG + (IN - 0.5) * SDIV
499 IF (ISH.EQ.4.OR.(ISH.EQ.10.AND.IAXIS.NE.1)) THEN
500 CALL GCENT (IAXIS, X0)
501 ENDIF
502 DO 232 I = 1, 3
503 XT(I) = XC(I) - X0(I)
504 XT(I+3) = XC(I+3)
505 232 CONTINUE
506 ELSE IF (IDT.EQ.3) THEN
507 PH0 = DEGRAD * (ORIG + (IN - 0.5) * SDIV)
508 CPHR = COS(PH0)
509 SPHR = SIN(PH0)
510 DO 233 I = 1, 4, 3
511 XT(I) = XC(I)*CPHR + XC(I+1)*SPHR
512 XT(I+1) = XC(I+1)*CPHR - XC(I)*SPHR
513 XT(I+2) = XC(I+2)
514 233 CONTINUE
515 ELSE
516 DO 234 I = 1, 6
517 XT(I) = XC(I)
518 234 CONTINUE
519 ENDIF
520*
521 IF (JPARM.NE.0) THEN
522 IF (IQ(JPARM-3).GT.1) THEN
523 JPAR = LQ(JPARM-IN)
524 ELSE
525 JPAR = LQ(JPARM-1)
526 ENDIF
527 JPAR = JPAR + 5
528 ELSE
529 JPAR = JVOT + 6
530 ENDIF
531*
532 IACT = 2
533 IF (ISHT.LT.5) THEN
534 IF (ISHT.EQ.1) THEN
535 CALL GNOBOX (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
536 ELSE IF (ISHT.EQ.2) THEN
537 CALL GNOTRA (XT, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE)
538 ELSE IF (ISHT.EQ.3) THEN
539 CALL GNOTRA (XT, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE)
540 ELSE
541 CALL GNOTRP (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
542 ENDIF
543 ELSE IF (ISHT.LE.10) THEN
544 IF (ISHT.EQ.5) THEN
545 CALL GNOTUB (XT, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE)
546 ELSE IF (ISHT.EQ.6) THEN
547 CALL GNOTUB (XT, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE)
548 ELSE IF (ISHT.EQ.7) THEN
549 CALL GNOCON (XT, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE)
550 ELSE IF (ISHT.EQ.8) THEN
551 CALL GNOCON (XT, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE)
552 ELSE IF (ISHT.EQ.9) THEN
553 CALL GNOSPH (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
554 ELSE
555 CALL GNOPAR (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
556 ENDIF
557 ELSE IF (ISHT.EQ.11) THEN
558 CALL GNOPGO (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
559 ELSE IF (ISHT.EQ.12) THEN
560 CALL GNOPCO (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
561 ELSE IF (ISHT.EQ.13) THEN
562 CALL GNOELT (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
563 ELSE IF (ISHT.EQ.14) THEN
564 CALL GNOHYP (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
565 ELSE IF (ISHT.EQ.28) THEN
566 CALL GSNGTR (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE,0)
567 ELSE IF (ISHT.EQ.NSCTUB) THEN
568 CALL GNOCTU (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
569 ELSE
570 PRINT *, ' GNEXT : No code for shape ', ISHT
571 STOP
572 ENDIF
573*
574 IF (SAFE.LT.SAFETY) SAFETY = SAFE
575 IF (SNXT.LT.SNEXT) SNEXT = SNXT
576*
577 IF (IN2.NE.0) THEN
578 IF (IN2.NE.IN) THEN
579 IN = IN2
580 GO TO 225
581 ENDIF
582 ENDIF
583*
584* *** Calculate SNEXT and SAFETY with respect to the Mother
585* *** SAFETY only for concave volumes if finite SNEXT
586* *** has been found with respect to one of its contents
587*
588 300 IACT = 2
589 IF (SNEXT.LT.0.9*BIG) THEN
590 IF (.NOT.BTEST(IQ(JVO),2)) IACT = 0
591 ENDIF
592 JPAR = LQ(JGPAR-NLEVEL)
593 IF (ISH.LT.5) THEN
594 IF (ISH.EQ.1) THEN
595 CALL GNBOX (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE )
596 ELSE IF (ISH.EQ.2) THEN
597 CALL GNTRAP (XC, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE)
598 ELSE IF (ISH.EQ.3) THEN
599 CALL GNTRAP (XC, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE)
600 ELSE
601 CALL GNTRP (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
602 ENDIF
603 ELSE IF (ISH.LE.10) THEN
604 IF (ISH.EQ.5) THEN
605 CALL GNTUBE (XC, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE)
606 ELSE IF (ISH.EQ.6) THEN
607 CALL GNTUBE (XC, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE)
608 ELSE IF (ISH.EQ.7) THEN
609 CALL GNCONE (XC, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE)
610 ELSE IF (ISH.EQ.8) THEN
611 CALL GNCONE (XC, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE)
612 ELSE IF (ISH.EQ.9) THEN
613 CALL GNSPHR (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
614 ELSE
615 CALL GNPARA (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
616 ENDIF
617 ELSE IF (ISH.EQ.12) THEN
618 CALL GNPCON (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
619 ELSE IF (ISH.EQ.11) THEN
620 CALL GNPGON (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
621 ELSE IF (ISH.EQ.13) THEN
622 CALL GNELTU (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
623 ELSE IF (ISH.EQ.14) THEN
624 CALL GNHYPE (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
625 ELSE IF (ISH.EQ.28) THEN
626 CALL GSNGTR (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE,1)
627 ELSE IF (ISH.EQ.NSCTUB) THEN
628 CALL GNCTUB (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE)
629 ELSE
630 PRINT *, ' GNEXT : No code for shape ', ISH
631 STOP
632 ENDIF
633*
634 IF (SAFE.LT.SAFETY) SAFETY = SAFE
635 IF (SNXT.LT.SNEXT) SNEXT = SNXT
636*
637 400 IF (GONLY(NLEVEL).EQ.0.) THEN
638*
639* *** Case of a 'NOT ONLY' volume -> step search
640*
641 SAFETY = 0.
642 EPSI2 = 0.5*EPSIL
643 ST = SNEXT -EPSI2
644 IF (ST.LE.0) GO TO 999
645 EPSI3 = 10.*EPSIL
646 IF (ST.LE.EPSI3) THEN
647 NN = 1
648 ELSE
649 NN = ST/EPSI3 +1
650 ST = ST/NN
651 ENDIF
652*
653 NBIN = 0
654 SN = 0.
655 420 SN = SN +ST
656 DO 429 I = 1,3
657 XT(I) = X(I) +SN*X(I+3)
658 429 CONTINUE
659*
660 CALL GINVOL (XT, ISAME)
661 IF (ISAME.EQ.0) THEN
662 IF (ST.LT.EPSI2) GO TO 490
663 SN = SN -ST
664 ST = 0.5*ST
665 NBIN = 1
666 GO TO 420
667 ENDIF
668*
669 IF (NBIN.NE.0) THEN
670 IF (ST.LT.EPSI2) THEN
671 SN = SN +EPSI2
672 GO TO 490
673 ELSE
674 ST = 0.5*ST
675 GO TO 420
676 ENDIF
677 ENDIF
678 NN = NN -1
679 IF (NN.GT.0) GO TO 420
680 GO TO 999
681*
682 490 IF (SN.LT.SNEXT) SNEXT = SN
683 ENDIF
684* END GNEXT
685 999 END
62be6b28 686
687#else
688 SUBROUTINE GNEX2_DUMMY
689 END
fe4da5cc 690#endif