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