GEANT321/gtrak/gtmed2.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 GTMEDI (X, NUMED)
  14 C.
  15 C.    ******************************************************************
  16 C.    *                                                                *
  17 C.    *   Finds in which volume/medium the point X is, and updates the *
  18 C.    *    common /GCVOLU/ and the structure JGPAR accordingly.        *
  19 C.    *                                                                *
  20 C.    *   NUMED returns the tracking medium number, or 0 if point is   *
  21 C.    *         outside the experimental setup.                        *
  22 C.    *                                                                *
  23 C.    *   Note : For INWVOL = 2, INFROM set to a positive number is    *
  24 C.    *      interpreted by GTMEDI as the number IN of the content     *
  25 C.    *      just left by the current track within the mother volume   *
  26 C.    *      where the point X is assumed to be.                       *
  27 C.    *                                                                *
  28 C.    *   Note : INFROM is set correctly by this routine but it is     *
  29 C.    *      used on entrance only in the case GSNEXT has been called  *
  30 C.    *      by the user. In other words the value of INFROM received  *
  31 C.    *      on entrance is not considered necessarily valid. This     *
  32 C.    *      assumption has been made for safety. A wrong value of     *
  33 C.    *      INFROM can cause wrong tracking.                          *
  34 C.    *                                                                *
  35 C.    *   Called by : GTRACK                                           *
  36 C.    *   Authors   : S.Banerjee, R.Brun, F.Bruyant, A.McPherson       *
  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       COMMON/GCCHAN/LSAMVL
  47       LOGICAL LSAMVL
  48 C.
  49       DIMENSION  X(*)
  50       REAL       XC(3), XT(3)
  51       LOGICAL    BTEST
  52 C.
  53 C.    ------------------------------------------------------------------
  54 *
  55 * SECTION I: The /GCVOLU/ table contains the initial guess for a path
  56 *            in the geometry tree on which X may be found.  Look along this
  57 *            path until X is found inside.  This is the starting position.
  58 *            If this is an ONLY volume with no daughters, we are done;
  59 *            otherwise reset search record variables, proceed to section II.
  60 *
  61 * *** Check if point is in current volume
  62 *
  63       INFR = 0
  64       INGT = 0
  65       JVIN = 0
  66 *
  67 * *** LSAMVL is a logical variable that indicates whether we are still
  68 * *** in the current volume or not. It is used in GTRACK to detect
  69 * *** precision problems.
  70       LSAMVL = .TRUE.
  71 C*****  Code Expanded From Routine:  GTRNSF
  72 C
  73   100 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
  74          XC(1) = X(1) - GTRAN(1,NLEVEL)
  75          XC(2) = X(2) - GTRAN(2,NLEVEL)
  76          XC(3) = X(3) - GTRAN(3,NLEVEL)
  77 *
  78       ELSE
  79          XL1 = X(1) - GTRAN(1,NLEVEL)
  80          XL2 = X(2) - GTRAN(2,NLEVEL)
  81          XL3 = X(3) - GTRAN(3,NLEVEL)
  82          XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3*
  83      +      GRMAT(3,NLEVEL)
  84          XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3*
  85      +      GRMAT(6,NLEVEL)
  86          XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3*
  87      +      GRMAT(9,NLEVEL)
  88
  89       ENDIF
  90 C*****  End of Code Expanded From Routine:  GTRNSF
  91 *
  92       JVO  = LQ(JVOLUM-LVOLUM(NLEVEL))
  93 *
  94 * Note: At entry the variable INGOTO may contain the index of a volume
  95 * contained within the current one at NLEVEL.  If so, begin by checking
  96 * if X lies inside.  This improves the search speed over that of GMEDIA.
  97 *
  98       NIN = Q(JVO+3)
  99       IF ((INGOTO.LE.0).OR.(INGOTO.GT.NIN)) THEN
 100          INGOTO = 0
 101       ELSE
 102 *
 103 * ***   Entrance in content INGOTO predicted by GTNEXT
 104 *
 105          JIN  = LQ(JVO-INGOTO)
 106          IVOT = Q(JIN+2)
 107          JVOT = LQ(JVOLUM-IVOT)
 108          JPAR = LQ(JGPAR-NLEVEL-1)
 109 *
 110          IROTT = Q(JIN+4)
 111 C*****  Code Expanded From Routine:  GITRAN
 112 C.
 113 C.    ------------------------------------------------------------------
 114 C.
 115          IF (IROTT .EQ. 0) THEN
 116             XT(1) = XC(1) - Q(5+JIN)
 117             XT(2) = XC(2) - Q(6+JIN)
 118             XT(3) = XC(3) - Q(7+JIN)
 119 *
 120          ELSE
 121             XL1 = XC(1) - Q(5+JIN)
 122             XL2 = XC(2) - Q(6+JIN)
 123             XL3 = XC(3) - Q(7+JIN)
 124             JR = LQ(JROTM-IROTT)
 125             XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3)
 126             XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6)
 127             XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9)
 128 *
 129          ENDIF
 130 C*****  End of Code Expanded From Routine:  GITRAN
 131 *
 132 *   *   Check if point is in content
 133 *
 134          CALL GINME (XT, Q(JVOT+2), Q(JPAR+1), IYES)
 135          IF (IYES.NE.0) THEN
 136 *
 137 *          If so, prepare information for volume retrieval, and return
 138 *
 139             LSAMVL = .FALSE.
 140             NL1 = NLEVEL +1
 141             LVOLUM(NL1) = IVOT
 142             NAMES(NL1)  = IQ(JVOLUM+IVOT)
 143             NUMBER(NL1) = Q(JIN+3)
 144             LINDEX(NL1) = INGOTO
 145             LINMX(NL1)  = Q(JVO+3)
 146             GONLY(NL1)  = Q(JIN+8)
 147             IF (LQ(LQ(JVOLUM-IVOT)).EQ.0) THEN
 148                NLDEV(NL1) = NLDEV(NLEVEL)
 149             ELSE
 150                NLDEV(NL1) = NL1
 151             ENDIF
 152             CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5),
 153      +                   IROTT, GTRAN(1,NL1), GRMAT(1,NL1))
 154             NLEVEL = NL1
 155             XC(1) = XT(1)
 156             XC(2) = XT(2)
 157             XC(3) = XT(3)
 158             JVO = JVOT
 159             INFROM = 0
 160             GO TO 190
 161          ENDIF
 162       ENDIF
 163 *
 164 * End of INGOTO processing
 165 *
 166       JPAR = LQ(JGPAR-NLEVEL)
 167       CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
 168       IF (IYES.EQ.0) THEN
 169 *
 170 *  **   Point not in current volume, go up the tree
 171 *
 172          LSAMVL = .FALSE.
 173          INGOTO = 0
 174          IF (NLEVEL.GT.1) THEN
 175             NLEVEL = NLEVEL -1
 176             JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
 177             NIN = Q(JVO+3)
 178             IF(NIN.GT.0) THEN
 179                INFROM=LINDEX(NLEVEL+1)
 180             ELSE
 181                INFROM=0
 182             ENDIF
 183             INFR = INFROM
 184             GO TO 100
 185          ELSE
 186 *
 187 *   *      Point is outside setup
 188 *
 189             NUMED = 0
 190             GO TO 999
 191          ENDIF
 192       ELSE
 193 *
 194 *   *      Point in current volume but not in INGOTO. We block the
 195 *   *      corresponding volume
 196 *
 197          IF (INGOTO.GT.0) THEN
 198             INGT = INGOTO
 199             JIN = LQ(JVO-INGOTO)
 200             IQ(JIN) = IBSET(IQ(JIN),4)
 201          ENDIF
 202       ENDIF
 203 *
 204 *   *      Found a volume up the tree which contains our point. We block
 205 *   *      the branch we came up from.
 206 *
 207       IF(INFR.GT.0) THEN
 208          JIN=LQ(JVO-INFR)
 209          IQ(JIN) = IBSET(IQ(JIN),4)
 210          JVIN = JIN
 211       ENDIF
 212 *
 213 *  **   Point is in current volume
 214 *
 215   190 INGOTO = 0
 216       NLMIN = NLEVEL
 217       IF (INWVOL.NE.2) INFROM = 0
 218       NLMANY = 0
 219 *
 220 * SECTION II: X is found inside current node at NLEVEL in /GCVOLU/.
 221 *             Search all contents recursively for any containing X.
 222 *             Take the first one found, if any, and continue at that
 223 *             level, incrementing NLEVEL and extending /GCVOLU/ tables.
 224 *             This is continued until a level is reached where X is not
 225 *             found in any of the contents, or there are no contents.
 226 * Note: Since Section II is re-entered from Section III, a blocking word
 227 * is used to mark those contents already checked.  Upon exit from Section
 228 * II, these blocking words are cleared at NLEVEL, but may remain set in
 229 * levels between NLEVEL-1 and NLMIN, if any.  They must be cleared at exit.
 230 *
 231 *  **  Check contents, if any
 232 *
 233   200 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
 234       NIN = Q(JVO+3)
 235 *
 236 *   *   Case with no contents
 237 *
 238       IF (NIN.EQ.0) THEN
 239          GO TO 300
 240 *
 241 *   *   Case with contents defined by division
 242 *
 243       ELSEIF (NIN.LT.0) THEN
 244          CALL GMEDIV (JVO, IN, XC, 1)
 245          IF (IN.GT.0) THEN
 246             INFROM = 0
 247             INFR   = 0
 248             INGT   = 0
 249             LSAMVL = .FALSE.
 250             GO TO 200
 251          ENDIF
 252 *
 253 *   *  Case with contents positioned
 254 *
 255       ELSE
 256          JCONT = LQ(JVO-NIN-1)+1
 257          NCONT = IQ(JCONT)
 258          ISEARC = Q(JVO+1)
 259          IF (ISEARC.LT.0) THEN
 260 *
 261 *       Prepare access to contents, when ordered by GSORD
 262 *
 263             JSB = LQ(LQ(JVO-NIN-1))
 264             IAX = Q(JSB+1)
 265             NSB = Q(JSB+2)
 266             IF (IAX.LE.3) THEN
 267                CX   = XC(IAX)
 268             ELSE
 269                CALL GFCOOR (XC, IAX, CX)
 270             ENDIF
 271             IDIV = ABS(LOCATF (Q(JSB+3), NSB, CX))
 272             IF (IDIV.EQ.0) THEN
 273                IF (IAX.NE.6) GO TO 260
 274                IDIV = NSB
 275             ELSEIF (IDIV.EQ.NSB) THEN
 276                IF (IAX.NE.6) GO TO 260
 277             ENDIF
 278             JSC0  = LQ(JVO-NIN-2)
 279             NCONT = IQ(JSC0+IDIV)
 280             JCONT = LQ(JSC0-IDIV)
 281          ELSE
 282 *
 283 *       otherwise, scan contents (possibly a user selection of them)
 284 *
 285             JNEAR = LQ(JVO-NIN-1)
 286             IF (ISEARC.GT.0) THEN
 287 #if !defined(CERNLIB_USRJMP)
 288                CALL GUNEAR (ISEARC, 1, XC, JNEAR)
 289 #endif
 290 #if defined(CERNLIB_USRJMP)
 291                CALL JUMPT4(JUNEAR,ISEARC, 1, XC, JNEAR)
 292 #endif
 293             ELSEIF (INFROM.GT.0) THEN
 294                JNUP = LQ(LQ(JVO-INFROM)-1)
 295                IF (JNUP.GT.0) THEN
 296                   JNEAR = JNUP
 297                ENDIF
 298             ENDIF
 299             JCONT = JNEAR +1
 300             NCONT = IQ(JCONT)
 301          ENDIF
 302 *
 303 *     For each selected content in turn, check if point is inside
 304 *
 305          DO 259 ICONT=1,NCONT
 306             IN = IQ(JCONT+ICONT)
 307             IF(IN.EQ.0) THEN
 308 *
 309 *     If the value IQ(JCONT+ICONT)=0 then we are back in the mother.
 310 *     So jump to 260, the search is finished. Clean-up should be done
 311 *     only up to ICONT-1, so we set:
 312 *
 313                NCONT=ICONT-1
 314                GOTO 260
 315             ELSE
 316             JIN = LQ(JVO-IN)
 317             IF (.NOT.BTEST(IQ(JIN),4)) THEN
 318                CALL GMEPOS (JVO, IN, XC, 1)
 319                IF (IN.GT.0) THEN
 320                   IF (GONLY(NLEVEL).NE.0.) NLMANY = 0
 321                   INFROM = 0
 322                   INGT   = 0
 323                   INFR   = 0
 324                   LSAMVL = .FALSE.
 325                   GO TO 200
 326                ELSE
 327                   IQ(JIN) = IBSET(IQ(JIN),4)
 328                ENDIF
 329             ENDIF
 330             ENDIF
 331   259    CONTINUE
 332 *
 333   260    IF(NCONT.EQ.NIN) THEN
 334          DO 268 IN=1,NIN
 335             JIN = LQ(JVO-IN)
 336             IQ(JIN) = IBCLR(IQ(JIN),4)
 337   268    CONTINUE
 338          ELSE
 339          DO 269 ICONT=1,NCONT
 340             IN  = IQ(JCONT+ICONT)
 341             JIN = LQ(JVO-IN)
 342             IQ(JIN) = IBCLR(IQ(JIN),4)
 343   269    CONTINUE
 344          IF(INFR.NE.0) THEN
 345             JIN = LQ(JVO-INFR)
 346             IQ(JIN) = IBCLR(IQ(JIN),4)
 347             INFR = 0
 348          ENDIF
 349          IF(INGT.NE.0) THEN
 350             JIN = LQ(JVO-INGT)
 351             IQ(JIN) = IBCLR(IQ(JIN),4)
 352             INGT = 0
 353          ENDIF
 354          ENDIF
 355 *
 356       ENDIF
 357 *
 358 * SECTION III: X is found at current node (NLEVEL in /GCVOLU) but not in
 359 *              any of its contents, if any.  If this is a MANY volume,
 360 *              save it as a candidate best-choice, and continue the search
 361 *              by backing up the tree one node and proceed to Section II.
 362 *              If this is an ONLY volume, proceed to Section IV.
 363 *
 364 * *** Point is in current volume/medium, and not in any content
 365 *
 366   300 IF (GONLY(NLEVEL).EQ.0.) THEN
 367 *
 368 *  **   Lowest level is 'NOT ONLY'
 369 *
 370          IF (NLEVEL.GT.NLMANY) THEN
 371             CALL GSCVOL
 372             NLMANY = NLEVEL
 373          ENDIF
 374 *
 375 *   *   Go up the tree up to a volume with positioned contents
 376 *
 377   310    INFROM = LINDEX(NLEVEL)
 378          NLEVEL = NLEVEL -1
 379          JVO    = LQ(JVOLUM-LVOLUM(NLEVEL))
 380          NIN    = Q(JVO+3)
 381          IF (NIN.LT.0) GO TO 310
 382 *
 383 C*****  Code Expanded From Routine:  GTRNSF
 384 C
 385          IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
 386             XC(1) = X(1) - GTRAN(1,NLEVEL)
 387             XC(2) = X(2) - GTRAN(2,NLEVEL)
 388             XC(3) = X(3) - GTRAN(3,NLEVEL)
 389 *
 390          ELSE
 391             XL1 = X(1) - GTRAN(1,NLEVEL)
 392             XL2 = X(2) - GTRAN(2,NLEVEL)
 393             XL3 = X(3) - GTRAN(3,NLEVEL)
 394             XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) +
 395      +      XL3* GRMAT(3,NLEVEL)
 396             XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) +
 397      +      XL3* GRMAT(6,NLEVEL)
 398             XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) +
 399      +      XL3* GRMAT(9,NLEVEL)
 400 *
 401          ENDIF
 402 C*****  End of Code Expanded From Routine:  GTRNSF
 403 *
 404          INFR = INFROM
 405          JIN = LQ(JVO-INFROM)
 406          IQ(JIN) = IBSET(IQ(JIN),4)
 407          NLMIN = MIN(NLEVEL,NLMIN)
 408          GO TO 200
 409       ENDIF
 410 *
 411 * SECTION IV: This is the end of the search.  The current node (NLEVEL
 412 *             in /GCVOLU/) is the lowest ONLY volume in which X is found.
 413 *             If X was also found in any of its contents, they are MANY
 414 *             volumes: the best-choice is the one among them at the greatest
 415 *             level in the tree, and it is stored.  Otherwise the current
 416 *             volume is the solution.  Before exit, all of the blocking
 417 *             words leftover in the tree must be reset to zero.
 418 * Note: A valid structure is assumed, in which no ONLY volumes overlap.
 419 * If this rule is violated, or if a daughter is not entirely contained
 420 * within the mother volume, the results are unpredictable.
 421 *
 422       DO 419 NL=NLMIN,NLEVEL-1
 423          JVO = LQ(JVOLUM-LVOLUM(NL))
 424          NIN = Q(JVO+3)
 425          DO 418 IN=1,NIN
 426             JIN = LQ(JVO-IN)
 427             IQ(JIN) = IBCLR(IQ(JIN),4)
 428   418    CONTINUE
 429   419 CONTINUE
 430 *
 431       IF (NLMANY.GT.0) CALL GFCVOL
 432       JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
 433       IF(JVIN.NE.0) IQ(JVIN) = IBCLR(IQ(JVIN),4)
 434       NUMED = Q(JVO+4)
 435 *                                                             END GTMEDI
 436   999 IF(JGSTAT.NE.0) CALL GFSTAT(4)
 437       END
 438 #endif