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