GEANT321/gtrak/ginvol.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:41  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 #if !defined(CERNLIB_OLD)
  11 *CMZ :  3.21/02 03/07/94  17.14.15  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 #include "geant321/gchvir.inc"
  44 C.
  45       DIMENSION  X(*)
  46       REAL       XC(6), XT(3)
  47       LOGICAL    BTEST
  48 C.
  49 C.    ------------------------------------------------------------------
  50 *
  51 * SECTION I: The /GCVOLU/ table contains the presumed location of X in the
  52 *            geometry tree, at level NLEVEL.  The suggestion is that INGOTO
  53 *            is the index of a content at NLEVEL which may also contain X.
  54 *            If this is so, ISAME=0 and return.  INGOTO is left unchanged.
  55 *            If this is not so, have we left the volume at NLEVEL altogether?
  56 *            If so, ISAME=0 and INGOTO=0, return.  Otherwise, this is the
  57 *            starting position for a search.  Reset search record variables
  58 *            and proceed to section II.
  59 *
  60 * *** Check if point is in current volume
  61 *
  62       INGT = 0
  63 C*****  Code Expanded From Routine:  GTRNSF
  64 C
  65   100 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
  66          XC(1) = X(1) - GTRAN(1,NLEVEL)
  67          XC(2) = X(2) - GTRAN(2,NLEVEL)
  68          XC(3) = X(3) - GTRAN(3,NLEVEL)
  69 *
  70       ELSE
  71          XL1 = X(1) - GTRAN(1,NLEVEL)
  72          XL2 = X(2) - GTRAN(2,NLEVEL)
  73          XL3 = X(3) - GTRAN(3,NLEVEL)
  74          XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3*
  75      +      GRMAT(3,NLEVEL)
  76          XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3*
  77      +      GRMAT(6,NLEVEL)
  78          XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3*
  79      +      GRMAT(9,NLEVEL)
  80 *
  81       ENDIF
  82       xc(4)=0.
  83       xc(5)=0.
  84       xc(6)=0.
  85 C*****  End of Code Expanded From Routine:  GTRNSF
  86 *
  87       JVO  = LQ(JVOLUM-LVOLUM(NLEVEL))
  88 *
  89 * Note: At entry the variable INGOTO may contain the index of a volume
  90 * contained within the current one at NLEVEL.  If so, begin by checking
  91 * if X lies inside.  This improves the search speed over that of GMEDIA.
  92 *
  93       NIN = Q(JVO+3)
  94       IF ((INGOTO.LE.0).OR.(INGOTO.GT.NIN)) THEN
  95          INGOTO = 0
  96       ELSE
  97 *
  98 * ***   Entrance in content INGOTO predicted by GTNEXT
  99 *
 100          JIN  = LQ(JVO-INGOTO)
 101          IVOT = Q(JIN+2)
 102          JVOT = LQ(JVOLUM-IVOT)
 103          JPAR = LQ(JGPAR-NLEVEL-1)
 104 *
 105          IROTT = Q(JIN+4)
 106 C*****  Code Expanded From Routine:  GITRAN
 107 C.
 108 C.    ------------------------------------------------------------------
 109 C.
 110          IF (IROTT .EQ. 0) THEN
 111             XT(1) = XC(1) - Q(5+JIN)
 112             XT(2) = XC(2) - Q(6+JIN)
 113             XT(3) = XC(3) - Q(7+JIN)
 114 *
 115          ELSE
 116             XL1 = XC(1) - Q(5+JIN)
 117             XL2 = XC(2) - Q(6+JIN)
 118             XL3 = XC(3) - Q(7+JIN)
 119             JR = LQ(JROTM-IROTT)
 120             XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3)
 121             XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6)
 122             XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9)
 123 *
 124          ENDIF
 125 C*****  End of Code Expanded From Routine:  GITRAN
 126 *
 127 *   *   Check if point is in content
 128 *
 129          CALL GINME (XT, Q(JVOT+2), Q(JPAR+1), IYES)
 130          IF (IYES.NE.0) THEN
 131 *
 132 *          If so, prepare information for volume retrieval, and return
 133 *
 134             NLEVIN = NLEVEL +1
 135             LVOLUM(NLEVIN) = IVOT
 136             NAMES(NLEVIN)  = IQ(JVOLUM+IVOT)
 137             NUMBER(NLEVIN) = Q(JIN+3)
 138             LINDEX(NLEVIN) = INGOTO
 139             LINMX(NLEVIN)  = Q(JVO+3)
 140             GONLY(NLEVIN)  = Q(JIN+8)
 141             IF (LQ(LQ(JVOLUM-IVOT)).EQ.0) THEN
 142                NLDEV(NLEVIN) = NLDEV(NLEVEL)
 143             ELSE
 144                NLDEV(NLEVIN) = NLEVIN
 145             ENDIF
 146             CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5),
 147      +                   IROTT, GTRAN(1,NLEVIN), GRMAT(1,NLEVIN))
 148             ISAME = 0
 149             GO TO 999
 150          ENDIF
 151       ENDIF
 152 *
 153 * End of INGOTO processing
 154 *
 155       JPAR = LQ(JGPAR-NLEVEL)
 156       CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
 157       IF (IYES.EQ.0) THEN
 158          ISAME  = 0
 159          INGOTO = 0
 160          GO TO 999
 161       ENDIF
 162 *
 163 *  **   Point is in current volume
 164 *
 165       NLEVIN = NLEVEL
 166       NLMIN = NLEVEL
 167       IF ((INFROM.LE.0).OR.(INFROM.GT.NIN)) THEN
 168          INFROM = 0
 169       ENDIF
 170       INFR = INFROM
 171       NLMANY = 0
 172       IF (INGOTO.GT.0) THEN
 173          INGT = INGOTO
 174          JIN = LQ(JVO-INGOTO)
 175          IQ(JIN) = IBSET(IQ(JIN),4)
 176       ENDIF
 177 *
 178 * SECTION II: X is found inside current node at NLEVEL in /GCVOLU/.
 179 *             Search all contents for any containing X.  Take the
 180 *             first one found, incrementing NLEVEL and extending the
 181 *             /GCVOLU/ tables.  Otherwise if the list of contents is
 182 *             exhausted without finding X inside, proceed to Section III.
 183 * Note: Since Section II is re-entered from Section III, a blocking word
 184 * is used to mark those contents already checked.  Upon exit from Section
 185 * II, these blocking words are cleared at NLEVEL, but may remain set in
 186 * levels between NLEVEL-1 and NLMIN, if any.  They must be cleared at exit.
 187 *
 188 *  **  Check contents, if any
 189 *
 190   200 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
 191       NIN = Q(JVO+3)
 192 *
 193 *   *   Case with no contents
 194 *
 195       IF (NIN.EQ.0) THEN
 196          GO TO 300
 197 *
 198 *   *   Case with contents defined by division
 199 *
 200       ELSEIF (NIN.LT.0) THEN
 201          CALL GMEDIV (JVO, IN, XC, 1)
 202          IF (IN.GT.0) THEN
 203             IF ((GONLY(NLEVEL).EQ.0).AND.
 204      +          (NLEVEL.LE.NLEVIN)) THEN
 205                 INFR = 0
 206                 INGT = 0
 207                 GO TO 200
 208              ELSE
 209                 GO TO 450
 210              ENDIF
 211          ENDIF
 212 *
 213 *   *  Case with contents positioned
 214 *
 215       ELSE
 216        if(nin.gt.1)then
 217         clmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+3)
 218         chmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+4)
 219         ndivto=q(jvirt+4*(LVOLUM(NLEVEL)-1)+2)
 220         iaxis =q(jvirt+4*(LVOLUM(NLEVEL)-1)+1)
 221         if(iaxis.le.3)then
 222           ivdiv=((xc(iaxis)-clmoth)*ndivto/(chmoth-clmoth))+1
 223             if(ivdiv.lt.1)then
 224               ivdiv=1
 225             elseif(ivdiv.gt.ndivto)then
 226               ivdiv=ndivto
 227             endif
 228         else
 229           call gfcoor(xc,iaxis,cx)
 230           if(iaxis.eq.6)then
 231             if((cx-clmoth).lt.-1.)then
 232               cx=cx+360.
 233             elseif((cx-chmoth).gt.1.)then
 234               cx=cx-360.
 235             endif
 236             if(cx.gt.chmoth)then
 237               cx=chmoth
 238             elseif(cx.lt.clmoth)then
 239               cx=clmoth
 240             endif
 241           endif
 242           ivdiv=((cx-clmoth)*ndivto/(chmoth-clmoth))+1
 243             if(ivdiv.lt.1)then
 244               ivdiv=1
 245             elseif(ivdiv.gt.ndivto)then
 246               ivdiv=ndivto
 247             endif
 248         endif
 249         jvdiv=lq(jvirt-LVOLUM(NLEVEL))
 250         iofset=iq(jvdiv+ivdiv)
 251         ncont=iq(jvdiv+iofset+1)
 252         jcont=jvdiv+iofset+1
 253         if(ncont.eq.0)goto 260
 254        else
 255          JCONT = LQ(JVO-NIN-1)+1
 256          NCONT = 1
 257        endif
 258 *
 259 *     For each selected content in turn, check if point is inside
 260 *
 261          DO 259 ICONT=1,NCONT
 262            if(nin.eq.1)then
 263             in=1
 264            else
 265             IN = IQ(JCONT+ICONT)
 266            endif
 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            if(nin.eq.1)then
 303             in=1
 304            else
 305             IN  = IQ(JCONT+ICONT)
 306            endif
 307             JIN = LQ(JVO-IN)
 308             IQ(JIN) = IBCLR(IQ(JIN),4)
 309   269    CONTINUE
 310          IF(INFR.NE.0) THEN
 311             JIN = LQ(JVO-INFR)
 312             IQ(JIN) = IBCLR(IQ(JIN),4)
 313          ENDIF
 314          IF(INGT.NE.0) THEN
 315             JIN = LQ(JVO-INGT)
 316             IQ(JIN) = IBCLR(IQ(JIN),4)
 317          ENDIF
 318          ENDIF
 319          ingt=0
 320 *
 321       ENDIF
 322 *
 323 * SECTION III: X is found at current node (NLEVEL in /GCVOLU/) but not in
 324 *              any of its contents, if any.  If this is a MANY volume,
 325 *              save it as a candidate best-choice, and continue the search
 326 *              by backing up the tree one node and proceed to Section II.
 327 *              If this is an ONLY volume, proceed to Section IV.
 328 *
 329 * *** Point is in current volume/medium, and not in any content
 330 *
 331   300 IF (GONLY(NLEVEL).EQ.0.) THEN
 332 *
 333 *  **   Lowest level is 'NOT ONLY'
 334 *
 335          IF (NLMANY.EQ.0) THEN
 336             CALL GSCVOL
 337             NLMANY = NLEVEL
 338          ENDIF
 339 *
 340 *   *   Go up the tree up to a volume with positioned contents
 341 *
 342   310    INFR   = LINDEX(NLEVEL)
 343          NLEVEL = NLEVEL -1
 344          JVO    = LQ(JVOLUM-LVOLUM(NLEVEL))
 345          NIN    = Q(JVO+3)
 346          IF (NIN.LT.0) GO TO 310
 347 *
 348 C*****  Code Expanded From Routine:  GTRNSF
 349 C
 350          IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
 351             XC(1) = X(1) - GTRAN(1,NLEVEL)
 352             XC(2) = X(2) - GTRAN(2,NLEVEL)
 353             XC(3) = X(3) - GTRAN(3,NLEVEL)
 354 *
 355          ELSE
 356             XL1 = X(1) - GTRAN(1,NLEVEL)
 357             XL2 = X(2) - GTRAN(2,NLEVEL)
 358             XL3 = X(3) - GTRAN(3,NLEVEL)
 359             XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) +
 360      +      XL3* GRMAT(3,NLEVEL)
 361             XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) +
 362      +      XL3* GRMAT(6,NLEVEL)
 363             XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) +
 364      +      XL3* GRMAT(9,NLEVEL)
 365
 366          ENDIF
 367 C*****  End of Code Expanded From Routine:  GTRNSF
 368 *
 369          JIN = LQ(JVO-INFR)
 370          IQ(JIN) = IBSET(IQ(JIN),4)
 371          NLMIN = MIN(NLEVEL,NLMIN)
 372          GO TO 200
 373       ENDIF
 374 *
 375 * SECTION IV: This is the end of the search.
 376 *             (1) Entry at 400:  ISAME = 1     The current node (NLEVEL
 377 *             in /GCVOLU/) is an ONLY volume and there were no contents
 378 *             in the tree below it which could claim X.
 379 *             (2) Entry at 450:  ISAME = 0    Section II has just found
 380 *             another volume which has more claim to X than the current
 381 *             one: either another ONLY or a deeper MANY was found.
 382 * Note: A valid structure is assumed, in which no ONLY volumes overlap.
 383 * If this rule is violated, or if a daughter is not entirely contained
 384 * within the mother volume, the results are unpredictable.
 385 *
 386   400 ISAME = 1
 387       GOTO 480
 388
 389   450 ISAME = 0
 390
 391   480 DO 489 NL=NLMIN,NLEVEL-1
 392          JVO = LQ(JVOLUM-LVOLUM(NL))
 393          NIN = Q(JVO+3)
 394          DO 488 IN=1,NIN
 395             JIN = LQ(JVO-IN)
 396             IQ(JIN) = IBCLR(IQ(JIN),4)
 397   488    CONTINUE
 398   489 CONTINUE
 399 *
 400       IF (NLMANY.GT.0) THEN
 401          CALL GFCVOL
 402          NLEVIN = NLEVEL
 403       ELSEIF (NLEVEL.GT.NLEVIN) THEN
 404          INGOTO = LINDEX(NLEVEL)
 405          NL = NLEVIN
 406          NLEVIN = NLEVEL
 407          NLEVEL = NL
 408       ENDIF
 409 *                                                             END GINVOL
 410   999 IF(JGSTAT.NE.0) CALL GFSTAT(ISAME)
 411       END
 412 #endif