This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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