This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / gtnex2.F
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
14 C.
15 C.    ******************************************************************
16 C.    *                                                                *
17 C.    *   SUBR. GTNEXT                                                 *
18 C.    *                                                                *
19 C.    *   Computes SAFETY and, only when new SAFETY is smaller than    *
20 C.    *    STEP, computes SNEXT.                                       *
21 C.    *   STEP has to be preset to BIG or to physical step size        *
22 C.    *                                                                *
23 C.    *   Called by : GTELEC, GTGAMA, GTHADR, GTMUON, GTNEUT, GTNINO   *
24 C.    *   Authors   : S.Banerjee, R.Brun, F.Bruyant                    *
25 C.    *                                                                *
26 C.    ******************************************************************
27 C.
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
39 C.
40       PARAMETER (BIG1=0.9*BIG)
41 C.
42       REAL      X0(3), XC(6), XT(6)
43       INTEGER   IDTYP(3,12)
44       LOGICAL   BTEST
45 C.
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/
49 C.
50 C.    ------------------------------------------------------------------
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
62 C*****  Code Expanded From Routine:  GTRNSF
63 C
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 *
75 C*****  End of Code Expanded From Routine:  GTRNSF
76 C*****  Code Expanded From Routine:  GROT
77 C
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 *
85 C*****  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 *
246 C*****  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 *
265 C*****  End of Code Expanded From Routine:  GITRAN
266 C*****  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 *
271 C*****  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
761 CCC debug
762          IF (ISWIT(9).EQ.123456789) THEN
763             PRINT *,' GTNEXT : SNEXT,SAFETY,INGOTO=',SNEXT,SAFETY,INGOTO
764             CALL GPCXYZ
765          ENDIF
766 CCC
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