GEANT321/ggeom/ggdvlp.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:49  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GGDVLP
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *    SUBR. GGDVLP                                                *
  17 C.    *                                                                *
  18 C.    *   DeVeLoPs locally the JVOLUM structure so as not to have to   *
  19 C.    *   recompute variable parameters and division specifications    *
  20 C.    *   at tracking time.                                            *
  21 C.    *                                                                *
  22 C.    *   Called by : GGCLOS                                           *
  23 C.    *   Authors   : S.Banerjee, F.Bruyant                            *
  24 C.    *                                                                *
  25 C.    ******************************************************************
  26 C.
  27 #include "geant321/gcbank.inc"
  28 #include "geant321/gcnum.inc"
  29 #include "geant321/gcunit.inc"
  30 C.
  31       PARAMETER (NLVMAX=15, NPAMAX=50)
  32 C.
  33       COMMON /GCDVLP/ LREF(2), JVO, LJVOM(NLVMAX), LLVODV(NLVMAX), LVODV
  34 C.
  35       INTEGER     ILINK(NLVMAX), LVAR(NPAMAX), NLINK(NLVMAX)
  36       INTEGER     NUMB(NLVMAX+1), NBGN(NLVMAX+1), IVOL(5200)
  37       EQUIVALENCE (IVOL(1), WS(1))
  38       REAL        PAR(NPAMAX)
  39       LOGICAL     BTEST
  40 C.
  41 C.    ------------------------------------------------------------------
  42 *
  43       CALL MZLINT (IXSTOR, '/GCDVLP/', LREF, JVO, LVODV)
  44 *
  45       CALL MZFORM ('VODV', '1I 2F 2I -F', IOVODV)
  46 *
  47 * *** Create the volume tree in memory
  48 *
  49       IF (NVOLUM.LT.1) GO TO 990
  50       NUMB(1) = 1
  51       NBGN(1) = 1
  52       IVOL(1) = 1
  53       NLVT = 1
  54 *
  55    10 NLEV = NLVT + 1
  56       NUMB(NLEV) = 0
  57       NBGN(NLEV) = NBGN(NLVT) + NUMB(NLVT)
  58       DO 30 I = 1, NUMB(NLVT)
  59          IVO  = IVOL(NBGN(NLVT) + I - 1)
  60          JVO  = LQ(JVOLUM-IVO)
  61          NIN  = Q(JVO+3)
  62          IF (NIN.GT.0) THEN
  63             DO 20 IN = 1, NIN
  64                JIN  = LQ(JVO-IN)
  65                IVOT = Q(JIN+2)
  66                DO 15 I1 = 1, NUMB(NLEV)
  67                   IVOS = IVOL(NBGN(NLEV)+I1-1)
  68                   IF (IVOS.EQ.IVOT) GO TO 20
  69    15          CONTINUE
  70                NUMB(NLEV) = NUMB(NLEV) + 1
  71                I1         = NBGN(NLEV) + NUMB(NLEV) - 1
  72                IVOL(I1)   = IVOT
  73    20       CONTINUE
  74          ELSE IF (NIN.LT.0) THEN
  75             JDIV = LQ(JVO-1)
  76             IVOT = Q(JDIV+2)
  77             DO 25 I1 = 1, NUMB(NLEV)
  78                IVOS = IVOL(NBGN(NLEV)+I1-1)
  79                IF (IVOS.EQ.IVOT) GO TO 30
  80    25       CONTINUE
  81             NUMB(NLEV) = NUMB(NLEV) + 1
  82             I1         = NBGN(NLEV) + NUMB(NLEV) - 1
  83             IVOL(I1)   = IVOT
  84          ENDIF
  85    30 CONTINUE
  86 *
  87       IF (NUMB(NLEV).GT.0) THEN
  88          NLVT = NLEV
  89          GO TO 10
  90       ENDIF
  91 *
  92       NLEV  = 1
  93       NLEVS = 1
  94 *
  95 * *** Loop over volumes in a given level
  96 *
  97   110 IF (NLEVS.GT.NLVT) GO TO 990
  98       IF (NUMB(NLEVS).GT.0) THEN
  99          NUMB(NLEVS) = NUMB(NLEVS) - 1
 100          IVOM  = IVOL(NBGN(NLEVS)+NUMB(NLEVS))
 101       ELSE
 102          NLEVS = NLEVS + 1
 103          GO TO 110
 104       ENDIF
 105 *
 106 * *** Check if current volume should be locally developed
 107 *
 108       LJVOM(1) = LQ(JVOLUM-IVOM)
 109       IF(LQ(LJVOM(1)).GT.0) THEN
 110          CALL MZDROP(IXCONS,LQ(LJVOM(1)),'L')
 111       ENDIF
 112       NIN  = Q(LJVOM(1)+3)
 113 #if defined(CERNLIB_DEBUGG)
 114       WRITE (CHMAIL,2000) IQ(JVOLUM+IVOM),NIN
 115       CALL GMAIL (0, 0)
 116  2000 FORMAT (' GGDVLP : Volume ',A4,'  NIN = ',I3)
 117 #endif
 118 *
 119 *  **  Skip it if not a possible source of local development
 120 *
 121       IF (NIN.EQ.0)                  GO TO 110
 122       IF (LQ(LJVOM(1)).NE.0)         GO TO 110
 123       IF (BTEST(IQ(LJVOM(1)),1))     GO TO 110
 124       CALL GGVCHK (LJVOM(1), 0, NVAR, LVAR)
 125       IF (NVAR.NE.0) GO TO 110
 126 *
 127 *  **  Otherwise, analyze contents
 128 *
 129       IOK = 0
 130       IF (NIN.LT.0) GO TO 120
 131 *
 132 *   *   Current volume has contents defined by position
 133 *
 134       DO 119 IN = 1,NIN
 135          CALL GGVCHK (LJVOM(1), IN, NVAR, LVAR)
 136          IF (NVAR.NE.0) THEN
 137 *
 138 *         In case a content is found with variable parameters,
 139 *          initialize development
 140 *
 141             NLINK(1) = NIN
 142             ILINK(1) = IN
 143             GO TO 200
 144          ENDIF
 145   119 CONTINUE
 146       GO TO 110
 147 *
 148 *   *   Current volume is divided
 149 *
 150   120 CALL GGVCHK (LJVOM(1), 1, NVAR, LVAR)
 151       IF (NVAR.EQ.0) GO TO 110
 152 *
 153 *        If cells have variable sizes, initialize development
 154 *
 155       IOK  = 2
 156       JDIV = LQ(LJVOM(1)-1)
 157       NLINK(1) = Q(JDIV+3)
 158       ILINK(1) = 1
 159 *
 160   200 CALL MZBOOK (IXCONS, LLVODV(1), LJVOM(1), 0, 'VODV',
 161      +                         NLINK(1), NLINK(1), 1, 2, 1)
 162 #if defined(CERNLIB_DEBUGG)
 163       WRITE (CHMAIL, 2002) ILINK(1), NLINK(1), NVAR
 164       CALL GMAIL (0, 0)
 165  2002 FORMAT (' GGDVLP :         I, N, NVAR = ',3I5)
 166 #endif
 167 *
 168 * *** Complete development for current content at current level
 169 *
 170       IF (IOK.EQ.0) GO TO 250
 171       IOK = 0
 172       IQ(LLVODV(1)+1) = NLINK(1)
 173       GO TO 260
 174 *
 175   210 NIN = Q(LJVOM(NLEV)+3)
 176       IF (NIN.LT.0) THEN
 177          CALL GGVCHK (LJVOM(NLEV), 1, NVAR, LVAR)
 178       ELSE
 179          CALL GGVCHK (LJVOM(NLEV), ILINK(NLEV), NVAR, LVAR)
 180       ENDIF
 181       IF (NVAR.EQ.0) GO TO 290
 182 #if defined(CERNLIB_DEBUGG)
 183       WRITE (CHMAIL, 2004) NLEV, ILINK(NLEV), NVAR
 184       CALL GMAIL (0, 0)
 185  2004 FORMAT (' GGDVLP :              LEVEL,I,NVAR,NIN = ',4I5)
 186 #endif
 187       IF (NIN.LT.0)  GO TO 260
 188 *
 189 *  **  Compute actual parameters for current content
 190 *
 191 *   *   Case with contents obtained by position
 192 *
 193   250 CALL GGPPAR (LJVOM(NLEV), ILINK(NLEV), NVAR,LVAR, LLVODV(NLEV),
 194      +                                                     NPAR, PAR)
 195       JIN = LQ(LJVOM(NLEV)-ILINK(NLEV))
 196       GO TO 270
 197 *
 198 *   *   Case with contents obtained by division
 199 *
 200   260 CALL GGDPAR (LJVOM(NLEV), ILINK(NLEV), NVAR,LVAR, LLVODV(NLEV),
 201      +                                                     NPAR, PAR)
 202       JIN = LQ(LJVOM(NLEV)-1)
 203 *
 204 *  **  Initialize next level down
 205 *
 206   270 IVO = Q(JIN+2)
 207       JVO = LQ(JVOLUM-IVO)
 208       NIN = Q(JVO+3)
 209       IF (NIN.GE.0) THEN
 210          IF (NIN.NE.0) IOK = 1
 211          NL = NIN
 212       ELSE
 213          IOK = 2
 214 *
 215 *   *   Current content is divided, compute division specifications
 216 *
 217          CALL GGDSPE (JVO, NPAR, PAR, NL, NDIV, ORIG, STEP)
 218       ENDIF
 219 *
 220       IQ(JVO) = IBSET(IQ(JVO),1)
 221       CALL MZBOOK (IXCONS, LVODV, LLVODV(NLEV), -ILINK(NLEV), 'VODV',
 222      +                  NL, NL, NPAR+5, IOVODV, 3)
 223       IF (IOK.EQ.2) THEN
 224          IQ(LVODV+1) = NDIV
 225           Q(LVODV+2) = ORIG
 226           Q(LVODV+3) = STEP
 227 #if defined(CERNLIB_DEBUGG)
 228           WRITE (CHMAIL, 2006) NDIV, ORIG, STEP
 229           CALL GMAIL (0, 0)
 230  2006     FORMAT (' GGDVLP : After GGDSPE, NDIV ORIG STEP = ',I4,2F10.4)
 231 #endif
 232       ENDIF
 233       IQ(LVODV+4) = IVO
 234       IQ(LVODV+5) = NPAR
 235       CALL UCOPY (PAR, Q(LVODV+6), NPAR)
 236 #if defined(CERNLIB_DEBUGG)
 237       WRITE (CHMAIL, 2008)
 238       CALL GMAIL (0, 0)
 239  2008 FORMAT (' GGDVLP : Store parameters into development structure')
 240 #endif
 241 *
 242   290 IF (IOK.EQ.0) THEN
 243          IF (ILINK(NLEV).EQ.NLINK(NLEV)) THEN
 244 *
 245 *          Go one level up
 246 *
 247             IF (NLEV.EQ.1) GO TO 110
 248             NLEV = NLEV -1
 249             GO TO 290
 250          ENDIF
 251 *
 252 *       Analyze next content
 253 *
 254          ILINK(NLEV) = ILINK(NLEV) +1
 255          GO TO 210
 256       ENDIF
 257 *
 258 *      A new level has been initialized, start analyzing it
 259 *
 260       NLEV = NLEV +1
 261       LJVOM(NLEV)  = JVO
 262       LLVODV(NLEV) = LVODV
 263       ILINK(NLEV)  = 1
 264       NLINK(NLEV)  = NL
 265       IOK = 0
 266       GO TO 210
 267 *
 268   990 DO 991 IVO = 1, NVOLUM
 269          JVO = LQ(JVOLUM-IVO)
 270          IF (BTEST(IQ(JVO),1)) THEN
 271             IF (LQ(JVO).GT.0) THEN
 272                CALL MZDROP (IXCONS, LQ(JVO), ' ')
 273                WRITE (CHMAIL, 1001) IQ(JVOLUM+IVO)
 274             ENDIF
 275          ENDIF
 276   991 CONTINUE
 277       LREF(1) = 0
 278 *
 279  1001 FORMAT (' GGDVLP : Unnecessary development at volume  ',A4)
 280 *                                                             END GGDVLP
 281       END