*
* $Id$
*
* $Log$
* Revision 1.1  1995/10/24 10:21:40  cernlib
* Initial revision
*
*
#include "geant321/pilot.h"
#if !defined(CERNLIB_OLD)
*CMZ :  3.21/02 03/07/94  17.14.15  by  S.Giani
*-- Author :
      SUBROUTINE GINVOL (X, ISAME)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *    SUBR. GINVOL (X, ISAME*)                                    *
C.    *                                                                *
C.    *   Checks if particle at point X has left current volume/medium *
C.    *   If so, returns ISAME = 0 and prepares information useful to  *
C.    *    identify the new volume entered.                            *
C.    *   Otherwise, returns ISAME = 1                                 *
C.    *                                                                *
C.    *   Note : INGOTO is set by GTNEXT, to transmit the information  *
C.    *       on the one volume which has limited the step SNEXT,      *
C.    *       >0 : INth content                                        *
C.    *       =0 : current volume                                      *
C.    *       <0 : -NLONLY, with NLONLY defined as the first 'ONLY'    *
C.    *           level up in the tree for the 'NOT-ONLY' volume       *
C.    *           where the point X is found to be.                    *
C.    *                                                                *
C.    *   Called by : GNEXT, GTELEC, GTHADR, GTMUON, GTNEXT            *
C.    *   Authors   : S.Banerjee, R.Brun, F.Bruyant                    *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gctrak.inc"
#if defined(CERNLIB_USRJMP)
#include "geant321/gcjump.inc"
#endif
#include "geant321/gchvir.inc"
C.
      DIMENSION  X(*)
      REAL       XC(6), XT(3)
      LOGICAL    BTEST
C.
C.    ------------------------------------------------------------------
*
* SECTION I: The /GCVOLU/ table contains the presumed location of X in the
*            geometry tree, at level NLEVEL.  The suggestion is that INGOTO
*            is the index of a content at NLEVEL which may also contain X.
*            If this is so, ISAME=0 and return.  INGOTO is left unchanged.
*            If this is not so, have we left the volume at NLEVEL altogether?
*            If so, ISAME=0 and INGOTO=0, return.  Otherwise, this is the
*            starting position for a search.  Reset search record variables
*            and proceed to section II.
*
* *** Check if point is in current volume
*
      INGT = 0
C*****  Code Expanded From Routine:  GTRNSF
C
  100 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
         XC(1) = X(1) - GTRAN(1,NLEVEL)
         XC(2) = X(2) - GTRAN(2,NLEVEL)
         XC(3) = X(3) - GTRAN(3,NLEVEL)
*
      ELSE
         XL1 = X(1) - GTRAN(1,NLEVEL)
         XL2 = X(2) - GTRAN(2,NLEVEL)
         XL3 = X(3) - GTRAN(3,NLEVEL)
         XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3*
     +      GRMAT(3,NLEVEL)
         XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3*
     +      GRMAT(6,NLEVEL)
         XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3*
     +      GRMAT(9,NLEVEL)
*
      ENDIF
      xc(4)=0.
      xc(5)=0.
      xc(6)=0.
C*****  End of Code Expanded From Routine:  GTRNSF
*
      JVO  = LQ(JVOLUM-LVOLUM(NLEVEL))
*
* Note: At entry the variable INGOTO may contain the index of a volume
* contained within the current one at NLEVEL.  If so, begin by checking
* if X lies inside.  This improves the search speed over that of GMEDIA.
*
      NIN = Q(JVO+3)
      IF ((INGOTO.LE.0).OR.(INGOTO.GT.NIN)) THEN
         INGOTO = 0
      ELSE
*
* ***   Entrance in content INGOTO predicted by GTNEXT
*
         JIN  = LQ(JVO-INGOTO)
         IVOT = Q(JIN+2)
         JVOT = LQ(JVOLUM-IVOT)
         JPAR = LQ(JGPAR-NLEVEL-1)
*
         IROTT = Q(JIN+4)
C*****  Code Expanded From Routine:  GITRAN
C.
C.    ------------------------------------------------------------------
C.
         IF (IROTT .EQ. 0) THEN
            XT(1) = XC(1) - Q(5+JIN)
            XT(2) = XC(2) - Q(6+JIN)
            XT(3) = XC(3) - Q(7+JIN)
*
         ELSE
            XL1 = XC(1) - Q(5+JIN)
            XL2 = XC(2) - Q(6+JIN)
            XL3 = XC(3) - Q(7+JIN)
            JR = LQ(JROTM-IROTT)
            XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3)
            XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6)
            XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9)
*
         ENDIF
C*****  End of Code Expanded From Routine:  GITRAN
*
*   *   Check if point is in content
*
         CALL GINME (XT, Q(JVOT+2), Q(JPAR+1), IYES)
         IF (IYES.NE.0) THEN
*
*          If so, prepare information for volume retrieval, and return
*
            NLEVIN = NLEVEL +1
            LVOLUM(NLEVIN) = IVOT
            NAMES(NLEVIN)  = IQ(JVOLUM+IVOT)
            NUMBER(NLEVIN) = Q(JIN+3)
            LINDEX(NLEVIN) = INGOTO
            LINMX(NLEVIN)  = Q(JVO+3)
            GONLY(NLEVIN)  = Q(JIN+8)
            IF (LQ(LQ(JVOLUM-IVOT)).EQ.0) THEN
               NLDEV(NLEVIN) = NLDEV(NLEVEL)
            ELSE
               NLDEV(NLEVIN) = NLEVIN
            ENDIF
            CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5),
     +                   IROTT, GTRAN(1,NLEVIN), GRMAT(1,NLEVIN))
            ISAME = 0
            GO TO 999
         ENDIF
      ENDIF
*
* End of INGOTO processing
*
      JPAR = LQ(JGPAR-NLEVEL)
      CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES)
      IF (IYES.EQ.0) THEN
         ISAME  = 0
         INGOTO = 0
         GO TO 999
      ENDIF
*
*  **   Point is in current volume
*
      NLEVIN = NLEVEL
      NLMIN = NLEVEL
      IF ((INFROM.LE.0).OR.(INFROM.GT.NIN)) THEN
         INFROM = 0
      ENDIF
      INFR = INFROM
      NLMANY = 0
      IF (INGOTO.GT.0) THEN
         INGT = INGOTO
         JIN = LQ(JVO-INGOTO)
         IQ(JIN) = IBSET(IQ(JIN),4)
      ENDIF
*
* SECTION II: X is found inside current node at NLEVEL in /GCVOLU/.
*             Search all contents for any containing X.  Take the
*             first one found, incrementing NLEVEL and extending the
*             /GCVOLU/ tables.  Otherwise if the list of contents is
*             exhausted without finding X inside, proceed to Section III.
* Note: Since Section II is re-entered from Section III, a blocking word
* is used to mark those contents already checked.  Upon exit from Section
* II, these blocking words are cleared at NLEVEL, but may remain set in
* levels between NLEVEL-1 and NLMIN, if any.  They must be cleared at exit.
*
*  **  Check contents, if any
*
  200 JVO = LQ(JVOLUM-LVOLUM(NLEVEL))
      NIN = Q(JVO+3)
*
*   *   Case with no contents
*
      IF (NIN.EQ.0) THEN
         GO TO 300
*
*   *   Case with contents defined by division
*
      ELSEIF (NIN.LT.0) THEN
         CALL GMEDIV (JVO, IN, XC, 1)
         IF (IN.GT.0) THEN
            IF ((GONLY(NLEVEL).EQ.0).AND.
     +          (NLEVEL.LE.NLEVIN)) THEN
                INFR = 0
                INGT = 0
                GO TO 200
             ELSE
                GO TO 450
             ENDIF
         ENDIF
*
*   *  Case with contents positioned
*
      ELSE
       if(nin.gt.1)then
        clmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+3)
        chmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+4)
        ndivto=q(jvirt+4*(LVOLUM(NLEVEL)-1)+2)
        iaxis =q(jvirt+4*(LVOLUM(NLEVEL)-1)+1)
        if(iaxis.le.3)then
          ivdiv=((xc(iaxis)-clmoth)*ndivto/(chmoth-clmoth))+1
            if(ivdiv.lt.1)then
              ivdiv=1
            elseif(ivdiv.gt.ndivto)then
              ivdiv=ndivto
            endif
        else
          call gfcoor(xc,iaxis,cx)
          if(iaxis.eq.6)then
            if((cx-clmoth).lt.-1.)then
              cx=cx+360.
            elseif((cx-chmoth).gt.1.)then
              cx=cx-360.
            endif
            if(cx.gt.chmoth)then
              cx=chmoth
            elseif(cx.lt.clmoth)then
              cx=clmoth
            endif
          endif
          ivdiv=((cx-clmoth)*ndivto/(chmoth-clmoth))+1
            if(ivdiv.lt.1)then
              ivdiv=1
            elseif(ivdiv.gt.ndivto)then
              ivdiv=ndivto
            endif
        endif
        jvdiv=lq(jvirt-LVOLUM(NLEVEL))
        iofset=iq(jvdiv+ivdiv)
        ncont=iq(jvdiv+iofset+1)
        jcont=jvdiv+iofset+1
        if(ncont.eq.0)goto 260
       else
         JCONT = LQ(JVO-NIN-1)+1
         NCONT = 1
       endif
*
*     For each selected content in turn, check if point is inside
*
         DO 259 ICONT=1,NCONT
           if(nin.eq.1)then
            in=1
           else
            IN = IQ(JCONT+ICONT)
           endif
            IF(IN.EQ.0) THEN
*
*     If the value IQ(JCONT+ICONT)=0 then we are back in the mother.
*     So jump to 260, the search is finished. Clean-up should be done
*     only up to ICONT-1, so we set:
*
               NCONT=ICONT-1
               GOTO 260
            ELSE
            JIN = LQ(JVO-IN)
            IF (.NOT.BTEST(IQ(JIN),4)) THEN
               CALL GMEPOS (JVO, IN, XC, 1)
               IF (IN.GT.0) THEN
                  IF ((GONLY(NLEVEL).EQ.0).AND.
     +                (NLEVEL.LE.NLEVIN)) THEN
                     INFR = 0
                     INGT = 0
                     GO TO 200
                  ELSE
                     GO TO 450
                  ENDIF
               ELSE
                  IQ(JIN) = IBSET(IQ(JIN),4)
               ENDIF
            ENDIF
            ENDIF
  259    CONTINUE
*
  260    IF(NCONT.EQ.NIN) THEN
         DO 268 IN=1,NIN
            JIN = LQ(JVO-IN)
            IQ(JIN) = IBCLR(IQ(JIN),4)
  268    CONTINUE
         ELSE
         DO 269 ICONT=1,NCONT
           if(nin.eq.1)then
            in=1
           else
            IN  = IQ(JCONT+ICONT)
           endif
            JIN = LQ(JVO-IN)
            IQ(JIN) = IBCLR(IQ(JIN),4)
  269    CONTINUE
         IF(INFR.NE.0) THEN
            JIN = LQ(JVO-INFR)
            IQ(JIN) = IBCLR(IQ(JIN),4)
         ENDIF
         IF(INGT.NE.0) THEN
            JIN = LQ(JVO-INGT)
            IQ(JIN) = IBCLR(IQ(JIN),4)
         ENDIF
         ENDIF
         ingt=0
*
      ENDIF
*
* SECTION III: X is found at current node (NLEVEL in /GCVOLU/) but not in
*              any of its contents, if any.  If this is a MANY volume,
*              save it as a candidate best-choice, and continue the search
*              by backing up the tree one node and proceed to Section II.
*              If this is an ONLY volume, proceed to Section IV.
*
* *** Point is in current volume/medium, and not in any content
*
  300 IF (GONLY(NLEVEL).EQ.0.) THEN
*
*  **   Lowest level is 'NOT ONLY'
*
         IF (NLMANY.EQ.0) THEN
            CALL GSCVOL
            NLMANY = NLEVEL
         ENDIF
*
*   *   Go up the tree up to a volume with positioned contents
*
  310    INFR   = LINDEX(NLEVEL)
         NLEVEL = NLEVEL -1
         JVO    = LQ(JVOLUM-LVOLUM(NLEVEL))
         NIN    = Q(JVO+3)
         IF (NIN.LT.0) GO TO 310
*
C*****  Code Expanded From Routine:  GTRNSF
C
         IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN
            XC(1) = X(1) - GTRAN(1,NLEVEL)
            XC(2) = X(2) - GTRAN(2,NLEVEL)
            XC(3) = X(3) - GTRAN(3,NLEVEL)
*
         ELSE
            XL1 = X(1) - GTRAN(1,NLEVEL)
            XL2 = X(2) - GTRAN(2,NLEVEL)
            XL3 = X(3) - GTRAN(3,NLEVEL)
            XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) +
     +      XL3* GRMAT(3,NLEVEL)
            XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) +
     +      XL3* GRMAT(6,NLEVEL)
            XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) +
     +      XL3* GRMAT(9,NLEVEL)
 
         ENDIF
C*****  End of Code Expanded From Routine:  GTRNSF
*
         JIN = LQ(JVO-INFR)
         IQ(JIN) = IBSET(IQ(JIN),4)
         NLMIN = MIN(NLEVEL,NLMIN)
         GO TO 200
      ENDIF
*
* SECTION IV: This is the end of the search.
*             (1) Entry at 400:  ISAME = 1     The current node (NLEVEL
*             in /GCVOLU/) is an ONLY volume and there were no contents
*             in the tree below it which could claim X.
*             (2) Entry at 450:  ISAME = 0    Section II has just found
*             another volume which has more claim to X than the current
*             one: either another ONLY or a deeper MANY was found.
* Note: A valid structure is assumed, in which no ONLY volumes overlap.
* If this rule is violated, or if a daughter is not entirely contained
* within the mother volume, the results are unpredictable.
*
  400 ISAME = 1
      GOTO 480
 
  450 ISAME = 0
 
  480 DO 489 NL=NLMIN,NLEVEL-1
         JVO = LQ(JVOLUM-LVOLUM(NL))
         NIN = Q(JVO+3)
         DO 488 IN=1,NIN
            JIN = LQ(JVO-IN)
            IQ(JIN) = IBCLR(IQ(JIN),4)
  488    CONTINUE
  489 CONTINUE
*
      IF (NLMANY.GT.0) THEN
         CALL GFCVOL
         NLEVIN = NLEVEL
      ELSEIF (NLEVEL.GT.NLEVIN) THEN
         INGOTO = LINDEX(NLEVEL)
         NL = NLEVIN
         NLEVIN = NLEVEL
         NLEVEL = NL
      ENDIF
*                                                             END GINVOL
  999 IF(JGSTAT.NE.0) CALL GFSTAT(ISAME)
      END
#endif
