GEANT321/ggeom/gnex2.F

   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)
  14 C.
  15 C.    ******************************************************************
  16 C.    *                                                                *
  17 C.    *   SUBR. GNEXT (X, SNEXT, SAFETY)                               *
  18 C.    *                                                                *
  19 C.    *   Computes SNEXT and SAFETY                                    *
  20 C.    *     SNEXT  (output) : distance to closest boundary             *
  21 C.    *                      from point X(1-3) along X(4-6)            *
  22 C.    *     SAFETY (output) : shortest distance to any boundary        *
  23 C.    *                                                                *
  24 C.    *   Called by : User                                             *
  25 C.    *   Authors   : S.Banerjee, R.Brun, F.Bruyant                    *
  26 C.    *                                                                *
  27 C.    ******************************************************************
  28 C.
  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
  41 C.
  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/
  45 C.
  46 C.    ------------------------------------------------------------------
  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