]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 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 |