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