GEANT321/gtrak/ginvo2.F

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