GEANT321/ggeom/gnex2.F

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