GEANT321/ggeom/glmoth.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 GLMOTH (IUDET, IUNUM, NLEV, LVOLS, LINDX)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *   Loads the top part of the Volume tree in LVOLS (IVO's),      *
  17 C.    *   LINDX (IN indices) for a given volume defined through        *
  18 C.    *   its name IUDET and number IUNUM.                             *
  19 C.    *                                                                *
  20 C.    *   The routine stores only upto the last level where JVOLUM     *
  21 C.    *   data structure is developed. If there is no development      *
  22 C.    *   above the current level, it returns NLEV zero.               *
  23 C.    *                                                                *
  24 C.    *   Called by : GDRAW, GFIPAR, GFPARA, GLVOLU                    *
  25 C.    *   Authors   : S.Banerjee                                       *
  26 C.    *                                                                *
  27 C.    ******************************************************************
  28 C.
  29 #include "geant321/gcbank.inc"
  30 C.
  31       DIMENSION  LVOLS(*), LINDX(*)
  32       CHARACTER*(*) IUDET
  33       SAVE MULT
  34 C.
  35 C.    ------------------------------------------------------------------
  36 *
  37       NLEV = 1
  38       MULT = IUNUM
  39       NLDV = 0
  40       CALL UCTOH (IUDET, LINAM, 4, 4)
  41       IVOS = IUCOMP (LINAM, IQ(JVOLUM+1), IQ(JVOLUM-1))
  42       LVOLS(1) = IVOS
  43 *
  44 * *** Scan all volumes to check if it could be mother
  45 *       of the current volume
  46 *
  47    10 IF (IVOS.GT.1) THEN
  48          DO 25 IVO = 1, IQ(JVOLUM-1)
  49             IF (IVO.EQ.IVOS)            GO TO 25
  50             JVO = LQ(JVOLUM-IVO)
  51             NIN = Q(JVO+3)
  52             IF (NIN.EQ.0)               GO TO 25
  53 *
  54             IF (NIN.LT.0) THEN
  55                JDIV = LQ(JVO-1)
  56                IVOT = Q(JDIV+2)
  57                IF (IVOT.NE.IVOS)        GO TO 25
  58                IF (MULT.EQ.0) THEN
  59                   IN   = 1
  60                   MULT = 1
  61                ELSE
  62                   IN   = MULT
  63                ENDIF
  64 *
  65             ELSE
  66                DO 15 IN = 1, NIN
  67                   JIN  = LQ(JVO-IN)
  68                   IVOT = Q(JIN+2)
  69                   IF (IVOT.NE.IVOS)     GO TO 15
  70                   MULTI = Q(JIN+3)
  71                   IF (MULT.EQ.0) THEN
  72                      MULT = MULTI
  73                   ELSE
  74                      IF (MULT.NE.MULTI) GO TO 15
  75                   ENDIF
  76                   GO TO 20
  77    15          CONTINUE
  78                GO TO 25
  79             ENDIF
  80 *
  81    20       LINDX(NLEV) = IN
  82             IF (NLDV.NE.0)              GO TO 30
  83             NLEV = NLEV + 1
  84             LVOLS(NLEV) = IVO
  85             IVOS = IVO
  86             MULT = 0
  87             IF (LQ(JVO).NE.0) NLDV = NLEV
  88             GO TO 10
  89    25    CONTINUE
  90       ENDIF
  91 *
  92 * *** Now rearrange the order of the volumes
  93 *
  94    30 IF (IVOS.EQ.1) LINDX(NLEV) = 1
  95       NLV  = NLEV/2
  96       IF (NLV.GT.0) THEN
  97          DO 35 I = 1, NLV
  98             J   = NLEV - I + 1
  99             LID = LINDX(I)
 100             LVO = LVOLS(I)
 101             LINDX(I) = LINDX(J)
 102             LVOLS(I) = LVOLS(J)
 103             LINDX(J) = LID
 104             LVOLS(J) = LVO
 105    35    CONTINUE
 106       ENDIF
 107       NLEV = NLEV -1
 108       IF (LQ(LQ(JVOLUM-LVOLS(1))).EQ.0) NLEV = 0
 109 *                                                             END GLMOTH
 110   999 END