GEANT321/gtrak/ginvo2.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 GINVOL (X, ISAME)
  14 C.
  15 C.    ******************************************************************
  16 C.    *                                                                *
  17 C.    *    SUBR. GINVOL (X, ISAME*)                                    *
  18 C.    *                                                                *
  19 C.    *   Checks if particle at point X has left current volume/medium *
  20 C.    *   If so, returns ISAME = 0 and prepares information useful to  *
  21 C.    *    identify the new volume entered.                            *
  22 C.    *   Otherwise, returns ISAME = 1                                 *
  23 C.    *                                                                *
  24 C.    *   Note : INGOTO is set by GTNEXT, to transmit the information  *
  25 C.    *       on the one volume which has limited the step SNEXT,      *
  26 C.    *       >0 : INth content                                        *
  27 C.    *       =0 : current volume                                      *
  28 C.    *       <0 : -NLONLY, with NLONLY defined as the first 'ONLY'    *
  29 C.    *           level up in the tree for the 'NOT-ONLY' volume       *
  30 C.    *           where the point X is found to be.                    *
  31 C.    *                                                                *
  32 C.    *   Called by : GNEXT, GTELEC, GTHADR, GTMUON, GTNEXT            *
  33 C.    *   Authors   : S.Banerjee, R.Brun, F.Bruyant                    *
  34 C.    *                                                                *
  35 C.    ******************************************************************
  36 C.
  37 #include "geant321/gcbank.inc"
  38 #include "geant321/gcvolu.inc"
  39 #include "geant321/gctrak.inc"
  40 #if defined(CERNLIB_USRJMP)
  41 #include "geant321/gcjump.inc"
  42 #endif
  43 C.
  44       DIMENSION  X(*)
  45       REAL       XC(3), XT(3)
  46       LOGICAL    BTEST
  47 C.
  48 C.    ------------------------------------------------------------------
  49 *
  50 * SECTION I: The /GCVOLU/ table contains the presumed location of X in the
  51 *            geometry tree, at level NLEVEL.  The suggestion is that INGOTO
  52 *            is the index of a content at NLEVEL which may also contain X.
  53 *            If this is so, ISAME=0 and return.  INGOTO is left unchanged.
  54 *            If this is not so, have we left the volume at NLEVEL altogether?
  55 *            If so, ISAME=0 and INGOTO=0, return.  Otherwise, this is the
  56 *            starting position for a search.  Reset search record variables
  57 *            and proceed to section II.
  58 *
  59 * *** Check if point is in current volume
  60 *
  61       INGT = 0
  62 C*****  Code Expanded From Routine:  GTRNSF
  63 C
  64   100 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
  65          XC(1) = X(1) - GTRAN(1,NLEVEL)
  66          XC(2) = X(2) - GTRAN(2,NLEVEL)
  67          XC(3) = X(3) - GTRAN(3,NLEVEL)
  68 *
  69       ELSE
  70          XL1 = X(1) - GTRAN(1,NLEVEL)
  71          XL2 = X(2) - GTRAN(2,NLEVEL)
  72          XL3 = X(3) - GTRAN(3,NLEVEL)
  73          XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3*
  74      +      GRMAT(3,NLEVEL)
  75          XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3*
  76      +      GRMAT(6,NLEVEL)
  77          XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3*
  78      +      GRMAT(9,NLEVEL)
  79 *
  80       ENDIF
  81 C*****  End of Code Expanded From Routine:  GTRNSF
  82 *
  83       JVO  = LQ(JVOLUM-LVOLUM(NLEVEL))
  84 *
  85 * Note: At entry the variable INGOTO may contain the index of a volume
  86 * contained within the current one at NLEVEL.  If so, begin by checking
  87 * if X lies inside.  This improves the search speed over that of GMEDIA.
  88 *
  89       NIN = Q(JVO+3)
  90       IF ((INGOTO.LE.0).OR.(INGOTO.GT.NIN)) THEN
  91          INGOTO = 0
  92       ELSE
  93 *
  94 * ***   Entrance in content INGOTO predicted by GTNEXT
  95 *
  96          JIN  = LQ(JVO-INGOTO)
  97          IVOT = Q(JIN+2)
  98          JVOT = LQ(JVOLUM-IVOT)
  99          JPAR = LQ(JGPAR-NLEVEL-1)
 100 *
 101          IROTT = Q(JIN+4)
 102 C*****  Code Expanded From Routine:  GITRAN
 103 C.
 104 C.    ------------------------------------------------------------------
 105 C.
 106          IF (IROTT .EQ. 0) THEN
 107             XT(1) = XC(1) - Q(5+JIN)
 108             XT(2) = XC(2) - Q(6+JIN)
 109             XT(3) = XC(3) - Q(7+JIN)
 110 *
 111          ELSE
 112             XL1 = XC(1) - Q(5+JIN)
 113             XL2 = XC(2) - Q(6+JIN)
 114             XL3 = XC(3) - Q(7+JIN)
 115             JR = LQ(JROTM-IROTT)
 116             XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3)
 117             XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6)
 118             XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9)
 119 *
 120          ENDIF
 121 C*****  End of Code Expanded From Routine:  GITRAN
 122 *
 123 *   *   Check if point is in content
 124 *
 125          CALL GINME (XT, Q(JVOT+2), Q(JPAR+1), IYES)
 126          IF (IYES.NE.0) THEN
 127 *
 128 *          If so, prepare information for volume retrieval, and return
 129 *
 130             NLEVIN = NLEVEL +1
 131             LVOLUM(NLEVIN) = IVOT
 132             NAMES(NLEVIN)  = IQ(JVOLUM+IVOT)
 133             NUMBER(NLEVIN) = Q(JIN+3)
 134             LINDEX(NLEVIN) = INGOTO
 135             LINMX(NLEVIN)  = Q(JVO+3)
 136             GONLY(NLEVIN)  = Q(JIN+8)
 137             IF (LQ(LQ(JVOLUM-IVOT)).EQ.0) THEN
 138                NLDEV(NLEVIN) = NLDEV(NLEVEL)
 139             ELSE
 140                NLDEV(NLEVIN) = NLEVIN
 141             ENDIF
 142             CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5),
 143      +                   IROTT, GTRAN(1,NLEVIN), GRMAT(1,NLEVIN))
 144             ISAME = 0
 145             GO TO 999
 146          ENDIF
 147       ENDIF
 148 *
 149 * End of INGOTO processing
 150 *
 151       JPAR = LQ(JGPAR-NLEVEL)
 152       CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
 153       IF (IYES.EQ.0) THEN
 154          ISAME  = 0
 155          INGOTO = 0
 156          GO TO 999
 157       ENDIF
 158 *
 159 *  **   Point is in current volume
 160 *
 161       NLEVIN = NLEVEL
 162       NLMIN = NLEVEL
 163       IF ((INFROM.LE.0).OR.(INFROM.GT.NIN)) THEN
 164          INFROM = 0
 165       ENDIF
 166       INFR = INFROM
 167       NLMANY = 0
 168       IF (INGOTO.GT.0) THEN
 169          INGT = INGOTO
 170          JIN = LQ(JVO-INGOTO)
 171          IQ(JIN) = IBSET(IQ(JIN),4)
 172       ENDIF
 173 *
 174 * SECTION II: X is found inside current node at NLEVEL in /GCVOLU/.
 175 *             Search all contents for any containing X.  Take the
 176 *             first one found, incrementing NLEVEL and extending the
 177 *             /GCVOLU/ tables.  Otherwise if the list of contents is
 178 *             exhausted without finding X inside, proceed to Section III.
 179 * Note: Since Section II is re-entered from Section III, a blocking word
 180 * is used to mark those contents already checked.  Upon exit from Section
 181 * II, these blocking words are cleared at NLEVEL, but may remain set in
 182 * levels between NLEVEL-1 and NLMIN, if any.  They must be cleared at exit.
 183 *
 184 *  **  Check contents, if any
 185 *
 186   200 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
 187       NIN = Q(JVO+3)
 188 *
 189 *   *   Case with no contents
 190 *
 191       IF (NIN.EQ.0) THEN
 192          GO TO 300
 193 *
 194 *   *   Case with contents defined by division
 195 *
 196       ELSEIF (NIN.LT.0) THEN
 197          CALL GMEDIV (JVO, IN, XC, 1)
 198          IF (IN.GT.0) THEN
 199             IF ((GONLY(NLEVEL).EQ.0).AND.
 200      +          (NLEVEL.LE.NLEVIN)) THEN
 201                 INFR = 0
 202                 INGT = 0
 203                 GO TO 200
 204              ELSE
 205                 GO TO 450
 206              ENDIF
 207          ENDIF
 208 *
 209 *   *  Case with contents positioned
 210 *
 211       ELSE
 212          JCONT = LQ(JVO-NIN-1)+1
 213          NCONT = IQ(JCONT)
 214          ISEARC = Q(JVO+1)
 215          IF (ISEARC.LT.0) THEN
 216 *
 217 *       Prepare access to contents, when ordered by GSORD
 218 *
 219             JSB = LQ(LQ(JVO-NIN-1))
 220             IAX = Q(JSB+1)
 221             NSB = Q(JSB+2)
 222             IF (IAX.LE.3) THEN
 223                IDIV = LOCATF (Q(JSB+3), NSB, XC(IAX))
 224             ELSE
 225                CALL GFCOOR (XC, IAX, CX)
 226                IDIV = LOCATF (Q(JSB+3), NSB, CX)
 227             ENDIF
 228             IF (IDIV.LT.0) IDIV = -IDIV
 229             IF (IDIV.EQ.0) THEN
 230                IF (IAX.NE.6) GO TO 260
 231                IDIV = NSB
 232             ELSEIF (IDIV.EQ.NSB) THEN
 233                IF (IAX.NE.6) GO TO 260
 234             ENDIF
 235             JSC0  = LQ(JVO-NIN-2)
 236             NCONT = IQ(JSC0+IDIV)
 237             JCONT = LQ(JSC0-IDIV)
 238          ELSE
 239 *
 240 *       otherwise, scan contents (possibly a user selection of them)
 241 *
 242             JNEAR = LQ(JVO-NIN-1)
 243             IF (ISEARC.GT.0) THEN
 244 #if !defined(CERNLIB_USRJMP)
 245                CALL GUNEAR (ISEARC, 1, XC, JNEAR)
 246 #endif
 247 #if defined(CERNLIB_USRJMP)
 248                CALL JUMPT4(JUNEAR,ISEARC, 1, XC, JNEAR)
 249 #endif
 250             ELSEIF (INFR.GT.0) THEN
 251                JNUP = LQ(LQ(JVO-INFR)-1)
 252                IF (JNUP.GT.0) THEN
 253                   JNEAR = JNUP
 254                ENDIF
 255             ENDIF
 256             JCONT = JNEAR +1
 257             NCONT = IQ(JCONT)
 258          ENDIF
 259 *
 260 *     For each selected content in turn, check if point is inside
 261 *
 262          DO 259 ICONT=1,NCONT
 263             IN = IQ(JCONT+ICONT)
 264             IF(IN.EQ.0) THEN
 265 *
 266 *     If the value IQ(JCONT+ICONT)=0 then we are back in the mother.
 267 *     So jump to 260, the search is finished. Clean-up should be done
 268 *     only up to ICONT-1, so we set:
 269 *
 270                NCONT=ICONT-1
 271                GOTO 260
 272             ELSE
 273             JIN = LQ(JVO-IN)
 274             IF (.NOT.BTEST(IQ(JIN),4)) THEN
 275                CALL GMEPOS (JVO, IN, XC, 1)
 276                IF (IN.GT.0) THEN
 277                   IF ((GONLY(NLEVEL).EQ.0).AND.
 278      +                (NLEVEL.LE.NLEVIN)) THEN
 279                      INFR = 0
 280                      INGT = 0
 281                      GO TO 200
 282                   ELSE
 283                      GO TO 450
 284                   ENDIF
 285                ELSE
 286                   IQ(JIN) = IBSET(IQ(JIN),4)
 287                ENDIF
 288             ENDIF
 289             ENDIF
 290   259    CONTINUE
 291 *
 292   260    IF(NCONT.EQ.NIN) THEN
 293          DO 268 IN=1,NIN
 294             JIN = LQ(JVO-IN)
 295             IQ(JIN) = IBCLR(IQ(JIN),4)
 296   268    CONTINUE
 297          ELSE
 298          DO 269 ICONT=1,NCONT
 299             IN  = IQ(JCONT+ICONT)
 300             JIN = LQ(JVO-IN)
 301             IQ(JIN) = IBCLR(IQ(JIN),4)
 302   269    CONTINUE
 303          IF(INFR.NE.0) THEN
 304             JIN = LQ(JVO-INFR)
 305             IQ(JIN) = IBCLR(IQ(JIN),4)
 306          ENDIF
 307          IF(INGT.NE.0) THEN
 308             JIN = LQ(JVO-INGT)
 309             IQ(JIN) = IBCLR(IQ(JIN),4)
 310          ENDIF
 311          ENDIF
 312 *
 313       ENDIF
 314 *
 315 * SECTION III: X is found at current node (NLEVEL in /GCVOLU/) but not in
 316 *              any of its contents, if any.  If this is a MANY volume,
 317 *              save it as a candidate best-choice, and continue the search
 318 *              by backing up the tree one node and proceed to Section II.
 319 *              If this is an ONLY volume, proceed to Section IV.
 320 *
 321 * *** Point is in current volume/medium, and not in any content
 322 *
 323   300 IF (GONLY(NLEVEL).EQ.0.) THEN
 324 *
 325 *  **   Lowest level is 'NOT ONLY'
 326 *
 327          IF (NLMANY.EQ.0) THEN
 328             CALL GSCVOL
 329             NLMANY = NLEVEL
 330          ENDIF
 331 *
 332 *   *   Go up the tree up to a volume with positioned contents
 333 *
 334   310    INFR   = LINDEX(NLEVEL)
 335          NLEVEL = NLEVEL -1
 336          JVO    = LQ(JVOLUM-LVOLUM(NLEVEL))
 337          NIN    = Q(JVO+3)
 338          IF (NIN.LT.0) GO TO 310
 339 *
 340 C*****  Code Expanded From Routine:  GTRNSF
 341 C
 342          IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
 343             XC(1) = X(1) - GTRAN(1,NLEVEL)
 344             XC(2) = X(2) - GTRAN(2,NLEVEL)
 345             XC(3) = X(3) - GTRAN(3,NLEVEL)
 346 *
 347          ELSE
 348             XL1 = X(1) - GTRAN(1,NLEVEL)
 349             XL2 = X(2) - GTRAN(2,NLEVEL)
 350             XL3 = X(3) - GTRAN(3,NLEVEL)
 351             XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) +
 352      +      XL3* GRMAT(3,NLEVEL)
 353             XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) +
 354      +      XL3* GRMAT(6,NLEVEL)
 355             XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) +
 356      +      XL3* GRMAT(9,NLEVEL)
 357
 358          ENDIF
 359 C*****  End of Code Expanded From Routine:  GTRNSF
 360 *
 361          JIN = LQ(JVO-INFR)
 362          IQ(JIN) = IBSET(IQ(JIN),4)
 363          NLMIN = MIN(NLEVEL,NLMIN)
 364          GO TO 200
 365       ENDIF
 366 *
 367 * SECTION IV: This is the end of the search.
 368 *             (1) Entry at 400:  ISAME = 1     The current node (NLEVEL
 369 *             in /GCVOLU/) is an ONLY volume and there were no contents
 370 *             in the tree below it which could claim X.
 371 *             (2) Entry at 450:  ISAME = 0    Section II has just found
 372 *             another volume which has more claim to X than the current
 373 *             one: either another ONLY or a deeper MANY was found.
 374 * Note: A valid structure is assumed, in which no ONLY volumes overlap.
 375 * If this rule is violated, or if a daughter is not entirely contained
 376 * within the mother volume, the results are unpredictable.
 377 *
 378   400 ISAME = 1
 379       GOTO 480
 380
 381   450 ISAME = 0
 382
 383   480 DO 489 NL=NLMIN,NLEVEL-1
 384          JVO = LQ(JVOLUM-LVOLUM(NL))
 385          NIN = Q(JVO+3)
 386          DO 488 IN=1,NIN
 387             JIN = LQ(JVO-IN)
 388             IQ(JIN) = IBCLR(IQ(JIN),4)
 389   488    CONTINUE
 390   489 CONTINUE
 391 *
 392       IF (NLMANY.GT.0) THEN
 393          CALL GFCVOL
 394          NLEVIN = NLEVEL
 395       ELSEIF (NLEVEL.GT.NLEVIN) THEN
 396          INGOTO = LINDEX(NLEVEL)
 397          NL = NLEVIN
 398          NLEVIN = NLEVEL
 399          NLEVEL = NL
 400       ENDIF
 401 *                                                             END GINVOL
 402   999 IF(JGSTAT.NE.0) CALL GFSTAT(ISAME)
 403       END
 404 #endif