GEANT321/ggeom/gmepos.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:51  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.29  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GMEPOS (JVO, IN, XC, IFL)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *   Updates the common /GCVOLU/ and the structure JGPAR          *
  17 C.    *     for contents positioned.                                   *
  18 C.    *                                                                *
  19 C.    *   For IFL nonzero, it also checks if the point XC is inside    *
  20 C.    *     the content. It returns IN = 0, if the point is outside.   *
  21 C.    *     Otherwise, it transforms XC in the local system.           *
  22 C.    *                                                                *
  23 C.    *   Input : JVO, IN, XC, IFL                                     *
  24 C.    *   Output : IN, XC                                              *
  25 C.    *                                                                *
  26 C.    *   Called by : GDRAW, GMEDIA                                    *
  27 C.    *   Authors   : S.Banerjee, R.Brun, F.Bruyant, A.McPherson       *
  28 C.    *                                                                *
  29 C.    ******************************************************************
  30 C.
  31 #include "geant321/gcbank.inc"
  32 #include "geant321/gcvolu.inc"
  33       DIMENSION  XC(*)
  34       REAL       XT(3)
  35 C.
  36 C.    ------------------------------------------------------------------
  37 C.
  38       JIN  = LQ(JVO-IN)
  39       IVOT = Q(JIN+2)
  40       JVOT = LQ(JVOLUM-IVOT)
  41       IF (NLEVEL.GE.NLDEV(NLEVEL)) THEN
  42 *       (case with JVOLUM structure locally developed)
  43          JPAR = LQ(LQ(JVOLUM-LVOLUM(NLDEV(NLEVEL))))
  44          DO 10 ILEV = NLDEV(NLEVEL), NLEVEL
  45             IF (IQ(JPAR+1).EQ.0) THEN
  46                IF (ILEV.EQ.NLEVEL) THEN
  47                   JPAR = LQ(JPAR-IN)
  48                ELSE
  49                   JPAR = LQ(JPAR-LINDEX(ILEV+1))
  50                ENDIF
  51                IF (JPAR.EQ.0) GO TO 20
  52             ELSE IF (IQ(JPAR-3).GT.1) THEN
  53                JPAR = LQ(JPAR-LINDEX(ILEV+1))
  54             ELSE
  55                JPAR = LQ(JPAR-1)
  56             ENDIF
  57    10    CONTINUE
  58          JPAR = JPAR +5
  59          NPAR = IQ(JPAR)
  60          GO TO 30
  61       ENDIF
  62 *      (normal case)
  63    20 NPAR = Q(JVOT+5)
  64       IF (NPAR.EQ.0) THEN
  65          JPAR = JIN +9
  66          NPAR = Q(JPAR)
  67       ELSE
  68          JPAR = JVOT +6
  69       ENDIF
  70 *
  71    30 IROTT  = Q(JIN+4)
  72       IF (IFL.NE.0) THEN
  73 C*****  Code Expanded From Routine:  GITRAN
  74 C.
  75 C.    ------------------------------------------------------------------
  76 C.
  77          IF (IROTT .EQ. 0) THEN
  78             XT(1) = XC(1) - Q(5+JIN)
  79             XT(2) = XC(2) - Q(6+JIN)
  80             XT(3) = XC(3) - Q(7+JIN)
  81 *
  82          ELSE
  83             XL1 = XC(1) - Q(5+JIN)
  84             XL2 = XC(2) - Q(6+JIN)
  85             XL3 = XC(3) - Q(7+JIN)
  86             JR = LQ(JROTM-IROTT)
  87             XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3)
  88             XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6)
  89             XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9)
  90 *
  91          ENDIF
  92 C*****  End of Code Expanded From Routine:  GITRAN
  93          CALL GINME (XT, Q(JVOT+2), Q(JPAR+1), IYES)
  94          IF (IYES.EQ.0) IN = 0
  95       ENDIF
  96 *
  97       IF (IN.GT.0) THEN
  98 *
  99 *       Volume found at deeper level
 100 *
 101          NL1    = NLEVEL
 102          NLEVEL = NLEVEL +1
 103          LVOLUM(NLEVEL) = IVOT
 104          NAMES(NLEVEL)  = IQ(JVOLUM+IVOT)
 105          NUMBER(NLEVEL) = Q(JIN+3)
 106          LINDEX(NLEVEL) = IN
 107          LINMX(NLEVEL)  = Q(JVO+3)
 108          GONLY(NLEVEL)  = Q(JIN+8)
 109          IF (LQ(LQ(JVOLUM-IVOT)).EQ.0) THEN
 110             NLDEV(NLEVEL) = NLDEV(NL1)
 111          ELSE
 112             NLDEV(NLEVEL) = NLEVEL
 113          ENDIF
 114          CALL GTRMUL (GTRAN(1,NL1), GRMAT(1,NL1), Q(JIN+5), IROTT,
 115      +                GTRAN(1,NLEVEL), GRMAT(1,NLEVEL) )
 116          IQ(JGPAR +NLEVEL) = NPAR
 117          LQ(JGPAR -NLEVEL) = JPAR
 118 *
 119          IF (IFL.NE.0) THEN
 120             XC(1) = XT(1)
 121             XC(2) = XT(2)
 122             XC(3) = XT(3)
 123          ENDIF
 124       ENDIF
 125 *                                                             END GMEPOS
 126       END