]>
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 GGDPAR (JVOM, IN, NVAR, LVAR, LVOM, NPAR, PAR) | |
13 | C. | |
14 | C. ****************************************************************** | |
15 | C. * * | |
16 | C. * SUBR. GGDPAR (JVOM,IN,NVAR,LVAR,LVOM,NPAR*,PAR*) * | |
17 | C. * * | |
18 | C. * Computes the actual parameters for the IN'th division of the * | |
19 | C. * mother volume at address JVOM * | |
20 | C. * Returns the set of actual parameters in NPAR, PAR * | |
21 | C. * * | |
22 | C. * Called by : GGDVLP * | |
23 | C. * Author : S.Banerjee * | |
24 | C. * (Original algorithms of A.McPherson) * | |
25 | C. * * | |
26 | C. ****************************************************************** | |
27 | C. | |
28 | #include "geant321/gcbank.inc" | |
29 | #include "geant321/gcflag.inc" | |
30 | #include "geant321/gcunit.inc" | |
31 | C. | |
32 | PARAMETER (NPAMAX=50) | |
33 | C. | |
34 | DIMENSION LVAR(*), PAR(*) | |
35 | C. | |
36 | REAL PARM(NPAMAX) | |
37 | INTEGER LAX(10,12) | |
38 | SAVE LAX | |
39 | C. | |
40 | DATA LAX / 1, 2, 3, 7*0, 1, 1, 2, 3, 6*0, 1, 1, 2, 2, 3, 5*0, | |
41 | + 3, 0, 0, 2, 1, 1, 0, 2, 1, 1, 1, 1, 3, 7*0, | |
42 | + 1, 1, 3, 2, 2, 5*0, 3, 1, 1, 1, 1, 5*0, | |
43 | + 3, 1, 1, 1, 1, 2, 2, 3*0, 1, 1, 2, 2, 6*0, | |
44 | + 1, 2, 3, 7*0, 2, 2, 0, 0, 3, 1, 1, 3, 1, 1, | |
45 | + 2, 2, 0, 3, 1, 1, 3, 1, 1, 0/ | |
46 | C. | |
47 | C. ------------------------------------------------------------------ | |
48 | * | |
49 | * *** Prepares parameters for mother, in PARM, for division, in PAR | |
50 | * and the division parameters | |
51 | * | |
52 | JIN = LQ(JVOM-1) | |
53 | IF (LQ(JVOM).EQ.LVOM) THEN | |
54 | * | |
55 | * Case when current volume is source of local development | |
56 | * | |
57 | NPARM = Q(JVOM+5) | |
58 | CALL UCOPY (Q(JVOM+7), PARM, NPARM) | |
59 | NDIV = Q(JIN+3) | |
60 | ORIG = Q(JIN+4) | |
61 | STEP = Q(JIN+5) | |
62 | ELSE | |
63 | * | |
64 | * Other cases | |
65 | * | |
66 | NPARM = IQ(LVOM+5) | |
67 | CALL UCOPY (Q(LVOM+6), PARM, NPARM) | |
68 | NDIV = IQ(LVOM+1) | |
69 | ORIG = Q(LVOM+2) | |
70 | STEP = Q(LVOM+3) | |
71 | ENDIF | |
72 | * | |
73 | ISHM = Q(JVOM+2) | |
74 | * | |
75 | ORI = ORIG + (IN - 1) * STEP | |
76 | IAXIS = Q(JIN+1) | |
77 | IVO = Q(JIN+2) | |
78 | JVO = LQ(JVOLUM-IVO) | |
79 | ISH = Q(JVO+2) | |
80 | NPAR = Q(JVO+5) | |
81 | * | |
82 | * *** Prepare the division parameters | |
83 | * | |
84 | IF (NPAR.GT.0) THEN | |
85 | CALL UCOPY (Q(JVO+7), PAR, NPAR) | |
86 | ELSE | |
87 | NPAR = NPARM | |
88 | CALL UCOPY (PARM, PAR, NPARM) | |
89 | * | |
90 | * ** Special treatment for phi divisions (when NPAR=0) | |
91 | * | |
92 | IF ((ISHM.GE.5.AND.ISHM.LE.8.AND.IAXIS.EQ.2) .OR. | |
93 | + (ISHM.GE.11.AND.ISHM.LE.12.AND.IAXIS.EQ.2) .OR. | |
94 | + (ISHM.EQ.9.AND.IAXIS.EQ.3)) THEN | |
95 | IF (ISHM.EQ.5.OR.ISHM.EQ.7) THEN | |
96 | NPAR = NPARM + 2 | |
97 | PAR(NPAR-1) = -0.5 * STEP | |
98 | PAR(NPAR) = 0.5 * STEP | |
99 | ELSE IF (ISHM.EQ.6.OR.ISHM.EQ.8) THEN | |
100 | DP = PARM(NPAR) - PARM(NPAR-1) | |
101 | IF (DP.LT.0.0) DP = DP + 360.0 | |
102 | IF (ORIG-PARM(NPAR-1).LT.0.0) ORIG = ORIG + 360.0 | |
103 | IF (ORIG-PARM(NPAR-1).GT.DP ) GO TO 910 | |
104 | DP = PARM(NPAR) - ORIG | |
105 | IF (DP.LT.0.0) DP = DP + 360.0 | |
106 | PAR(NPAR-1) = -0.5 * DP / NDIV | |
107 | PAR(NPAR ) = 0.5 * DP / NDIV | |
108 | ELSE IF (ISHM.EQ.11.OR.ISHM.EQ.12) THEN | |
109 | IF (ISHM.EQ.11) NDIV = PARM(3) | |
110 | STEP = PARM(2) / NDIV | |
111 | PAR(1) = -0.5 * STEP | |
112 | PAR(2) = STEP | |
113 | PAR(3) = 1. | |
114 | ELSE IF (ISHM.EQ.9) THEN | |
115 | DP = PARM(6) - PARM(5) | |
116 | IF (DP.LT.0.0) DP = DP + 360.0 | |
117 | IF (ORIG-PARM(5).LT.0.0) ORIG = ORIG + 360.0 | |
118 | IF (ORIG-PARM(5).GT.DP ) GO TO 910 | |
119 | DP = PARM(6) - ORIG | |
120 | IF (DP.LT.0.0) DP = DP + 360.0 | |
121 | PAR(5) = -0.5 * DP / NDIV | |
122 | PAR(6) = 0.5 * DP / NDIV | |
123 | ENDIF | |
124 | ENDIF | |
125 | ENDIF | |
126 | IF (NVAR.LE.0) GO TO 999 | |
127 | * | |
128 | * *** Compute the actual parameters | |
129 | * | |
130 | IF (ISHM.EQ.1) THEN | |
131 | * | |
132 | * BOX | |
133 | * | |
134 | IF (ISH.EQ.1) THEN | |
135 | DO 10 I = 1, NVAR | |
136 | IAX = LVAR(I) | |
137 | IF (IAX.EQ.IAXIS) THEN | |
138 | PAR(IAX) = 0.5 *STEP | |
139 | ELSE | |
140 | PAR(IAX) = PARM(IAX) | |
141 | ENDIF | |
142 | 10 CONTINUE | |
143 | ELSE | |
144 | GO TO 900 | |
145 | ENDIF | |
146 | * | |
147 | ELSE IF (ISHM.EQ.2) THEN | |
148 | * | |
149 | * TRD1 | |
150 | * | |
151 | IF (ISH.EQ.2) THEN | |
152 | DO 20 I = 1, NVAR | |
153 | IAX = LVAR(I) | |
154 | IF (LAX(IAX,ISH).EQ.IAXIS) THEN | |
155 | PAR(IAX) = 0.5 * STEP | |
156 | ELSE IF (LAX(IAX,ISH).EQ.1.AND.IAXIS.EQ.3) THEN | |
157 | ZZ = ORI + PARM(4) | |
158 | DXDZ = 0.5 * (PARM(2) - PARM(1)) / PARM(4) | |
159 | IF (IAX.EQ.2) ZZ = ZZ + STEP | |
160 | PAR(IAX) = PARM(1) + DXDZ * ZZ | |
161 | ELSE | |
162 | PAR(IAX) = PARM(IAX) | |
163 | ENDIF | |
164 | 20 CONTINUE | |
165 | ELSE | |
166 | GO TO 900 | |
167 | ENDIF | |
168 | * | |
169 | ELSE IF (ISHM.EQ.3) THEN | |
170 | * | |
171 | * TRD2 | |
172 | * | |
173 | IF (ISH.EQ.3.AND.IAXIS.EQ.3) THEN | |
174 | DO 30 I = 1, NVAR | |
175 | IAX = LVAR(I) | |
176 | IF (LAX(IAX,ISH).EQ.IAXIS) THEN | |
177 | PAR(IAX) = 0.5 * STEP | |
178 | ELSE | |
179 | IP1 = 2 * LAX(IAX,ISH) - 1 | |
180 | IP2 = IP1 + 1 | |
181 | ZZ = ORI + PARM(5) | |
182 | DXDZ = 0.5 * (PARM(IP2) - PARM(IP1)) / PARM(5) | |
183 | IF (IAX.EQ.IP2) ZZ = ZZ + STEP | |
184 | PAR(IAX) = PARM(IP1) + DXDZ * ZZ | |
185 | ENDIF | |
186 | 30 CONTINUE | |
187 | ELSE IF (ISH.EQ.3) THEN | |
188 | GO TO 910 | |
189 | ELSE | |
190 | GO TO 900 | |
191 | ENDIF | |
192 | * | |
193 | ELSE IF (ISHM.EQ.4) THEN | |
194 | * | |
195 | * TRAP | |
196 | * | |
197 | IF (ISH.EQ.4.AND.IAXIS.NE.1) THEN | |
198 | IF(IAXIS.EQ.3) THEN | |
199 | DO 40 I = 1, NVAR | |
200 | IAX = LVAR(I) | |
201 | IF (IAX.EQ.1) THEN | |
202 | PAR(IAX) = 0.5 * STEP | |
203 | ELSE IF (IAX.LE.6) THEN | |
204 | ZZ = ORI + PARM(1) | |
205 | DPDZ = 0.5 * (PARM(IAX+4) - PARM(IAX)) / PARM(1) | |
206 | PAR(IAX) = PARM(IAX) + DPDZ * ZZ | |
207 | ELSE | |
208 | ZZ = ORI + PARM(1) + STEP | |
209 | DPDZ = 0.5 * (PARM(IAX) - PARM(IAX-4)) / PARM(1) | |
210 | PAR(IAX) = PARM(IAX-4) + DPDZ * ZZ | |
211 | ENDIF | |
212 | 40 CONTINUE | |
213 | HTAL = PARM(8) * PARM(11) | |
214 | HTAH = PARM(4) * PARM(7) | |
215 | ZZ1 = 0.5 * (ORI + PARM(1)) / PARM(1) | |
216 | ZZ2 = 0.5 * (ORI + PARM(1) + STEP) / PARM(1) | |
217 | PAR(7) = (HTAL*(1.0-ZZ1) + HTAH*ZZ1) / PARM(4) | |
218 | PAR(11)= (HTAL*(1.0-ZZ2) + HTAH*ZZ2) / PARM(8) | |
219 | CALL GNOTR1(PAR) | |
220 | ELSE IF (IAXIS.EQ.2) THEN | |
221 | DO 41 I = 1, NVAR | |
222 | PAR(LVAR(I)) = PARM(LVAR(I)) | |
223 | 41 CONTINUE | |
224 | DXDY1 = 0.5*(PARM(6)-PARM(5))/PARM(4) | |
225 | DXDY2 = 0.5*(PARM(10)-PARM(9))/PARM(8) | |
226 | DXM1 = 0.5*(PARM(6)+PARM(5)) | |
227 | DXM2 = 0.5*(PARM(10)+PARM(9)) | |
228 | DXH1 = DXM1+(ORI+STEP)*DXDY1 | |
229 | DXH2 = DXM2+(ORI+STEP)*DXDY2 | |
230 | DXL1 = DXM1+ORI*DXDY1 | |
231 | DXL2 = DXM2+ORI*DXDY2 | |
232 | PAR(5) = DXL1 | |
233 | PAR(6) = DXH1 | |
234 | PAR(9) = DXL2 | |
235 | PAR(10) = DXH2 | |
236 | ENDIF | |
237 | ELSE IF (ISH.EQ.4) THEN | |
238 | GO TO 910 | |
239 | ELSE | |
240 | GO TO 900 | |
241 | ENDIF | |
242 | * | |
243 | ELSE IF (ISHM.EQ.5 .OR. ISHM.EQ.6) THEN | |
244 | * | |
245 | * TUBE or TUBS | |
246 | * | |
247 | IF (ISH.EQ.5 .OR. ISH.EQ.6) THEN | |
248 | DO 50 I = 1, NVAR | |
249 | IAX = LVAR(I) | |
250 | IF (LAX(IAX,ISH).EQ.IAXIS) THEN | |
251 | IF (IAXIS.EQ.3) THEN | |
252 | PAR(IAX) = 0.5 * STEP | |
253 | ELSE IF (IAXIS.EQ.1) THEN | |
254 | IF (IAX.EQ.1) THEN | |
255 | PAR(IAX) = ORI | |
256 | ELSE | |
257 | PAR(IAX) = ORI + STEP | |
258 | ENDIF | |
259 | ELSE | |
260 | GO TO 910 | |
261 | ENDIF | |
262 | ELSE | |
263 | PAR(IAX) = PARM(IAX) | |
264 | ENDIF | |
265 | 50 CONTINUE | |
266 | ELSE | |
267 | GO TO 900 | |
268 | ENDIF | |
269 | * | |
270 | ELSE IF (ISHM.EQ.7 .OR. ISHM.EQ.8) THEN | |
271 | * | |
272 | * CONE or CONS | |
273 | * | |
274 | IF (ISH.EQ.7 .OR. ISH.EQ.8) THEN | |
275 | DO 60 I = 1, NVAR | |
276 | IAX = LVAR(I) | |
277 | IF (LAX(IAX,ISH).EQ.IAXIS .AND. IAXIS.EQ.3) THEN | |
278 | PAR(IAX) = 0.5 * STEP | |
279 | ELSE IF (IAXIS.EQ.3.AND.IAX.GT.1.AND.IAX.LT.6) THEN | |
280 | IF (IAX.EQ.2.OR.IAX.EQ.4) THEN | |
281 | DP = 0.5 * (PARM(4) - PARM(2)) / PARM(1) | |
282 | PM = 0.5 * (PARM(4) + PARM(2)) | |
283 | ELSE | |
284 | DP = 0.5 * (PARM(5) - PARM(3)) / PARM(1) | |
285 | PM = 0.5 * (PARM(5) + PARM(3)) | |
286 | ENDIF | |
287 | IF (IAX.GT.3) THEN | |
288 | DZ = ORI + STEP | |
289 | ELSE | |
290 | DZ = ORI | |
291 | ENDIF | |
292 | PAR(IAX) = PM + DP * DZ | |
293 | ELSE IF (IAXIS.EQ.1.AND.LAX(IAX,ISH).EQ.IAXIS) THEN | |
294 | IF (IAX.EQ.2) THEN | |
295 | PAR(IAX) = ORI | |
296 | ELSE IF (IAX.EQ.3) THEN | |
297 | PAR(IAX) = ORI + STEP | |
298 | ELSE IF (IAX.EQ.4) THEN | |
299 | PAR(IAX) = ORI * PARM(IAX) / PARM(2) | |
300 | ELSE | |
301 | PAR(IAX) = (ORI + STEP) * PARM(IAX) / PARM(3) | |
302 | ENDIF | |
303 | ELSE | |
304 | PAR(IAX) = PARM(IAX) | |
305 | ENDIF | |
306 | 60 CONTINUE | |
307 | ELSE | |
308 | GO TO 900 | |
309 | ENDIF | |
310 | * | |
311 | ELSE IF (ISHM.EQ.9) THEN | |
312 | * | |
313 | * SPHE | |
314 | * | |
315 | IF (ISH.EQ.9) THEN | |
316 | DO 70 I = 1, NVAR | |
317 | IAX = LVAR(I) | |
318 | IF (LAX(IAX,ISH).EQ.IAXIS) THEN | |
319 | IF (MOD(IAX,2).NE.0) THEN | |
320 | PAR(IAX) = ORI | |
321 | ELSE | |
322 | PAR(IAX) = ORI + STEP | |
323 | ENDIF | |
324 | ELSE | |
325 | PAR(IAX) = PARM(IAX) | |
326 | ENDIF | |
327 | 70 CONTINUE | |
328 | ELSE | |
329 | GO TO 900 | |
330 | ENDIF | |
331 | * | |
332 | ELSE IF (ISHM.EQ.10) THEN | |
333 | * | |
334 | * PARA | |
335 | * | |
336 | IF (ISH.EQ.10) THEN | |
337 | DO 80 I = 1, NVAR | |
338 | IAX = LVAR(I) | |
339 | IF (LAX(IAX,ISH).EQ.IAXIS) THEN | |
340 | PAR(IAX) = 0.5 * STEP | |
341 | ENDIF | |
342 | 80 CONTINUE | |
343 | ELSE | |
344 | GO TO 900 | |
345 | ENDIF | |
346 | * | |
347 | ELSE IF (ISHM.EQ.11 .OR. ISHM.EQ.12) THEN | |
348 | * | |
349 | * PGON or PCON | |
350 | * | |
351 | IF (ISH.EQ.ISHM) THEN | |
352 | IF (ISH.EQ.11) THEN | |
353 | IPNZ = 4 | |
354 | ELSE | |
355 | IPNZ = 3 | |
356 | ENDIF | |
357 | NZ = PAR(IPNZ) | |
358 | NZ1 = PARM(IPNZ) | |
359 | IF (NZ.EQ.NZ1) THEN | |
360 | IF (IAXIS.EQ.1) THEN | |
361 | RMN = ORI | |
362 | RMX = ORI + STEP | |
363 | DO 90 I = 1, NZ | |
364 | IAX1 = IPNZ + 3*I - 1 | |
365 | IAX2 = IAX1 + 1 | |
366 | IF (I.EQ.1) THEN | |
367 | PAR(IAX1) = RMN | |
368 | PAR(IAX2) = RMX | |
369 | ELSE | |
370 | PAR(IAX1) = RMN * PARM(IAX1) / PARM(IPNZ+2) | |
371 | PAR(IAX2) = RMX * PARM(IAX2) / PARM(IPNZ+3) | |
372 | ENDIF | |
373 | 90 CONTINUE | |
374 | ELSE IF (IAXIS.EQ.2) THEN | |
375 | DO 100 I = 1, NVAR | |
376 | IAX = LVAR(I) | |
377 | PAR(IAX) = PARM(IAX) | |
378 | 100 CONTINUE | |
379 | ELSE IF (NZ.EQ.2.AND.IAXIS.EQ.3) THEN | |
380 | ZL = PARM(IPNZ+1) | |
381 | ZH = PARM(IPNZ+4) | |
382 | DZ = ZH - ZL | |
383 | DRMIDZ = (PARM(IPNZ+5)-PARM(IPNZ+2))/DZ | |
384 | DRMADZ = (PARM(IPNZ+6)-PARM(IPNZ+3))/DZ | |
385 | PAR(IPNZ+1) = -0.5 * STEP | |
386 | PAR(IPNZ+4) = 0.5 * STEP | |
387 | DO 110 I = 1, NVAR | |
388 | IAX = LVAR(I)-IPNZ | |
389 | IF(IAX.EQ.2) THEN | |
390 | RAD = PARM(IPNZ+2)+(IN-1)*STEP*DRMIDZ | |
391 | ELSEIF (IAX.EQ.3) THEN | |
392 | RAD = PARM(IPNZ+3)+(IN-1)*STEP*DRMADZ | |
393 | ELSEIF (IAX.EQ.5) THEN | |
394 | RAD = PARM(IPNZ+2)+IN*STEP*DRMIDZ | |
395 | ELSEIF (IAX.EQ.6) THEN | |
396 | RAD = PARM(IPNZ+3)+IN*STEP*DRMADZ | |
397 | ENDIF | |
398 | PAR(IPNZ+IAX) = RAD | |
399 | 110 CONTINUE | |
400 | ELSE | |
401 | GO TO 920 | |
402 | ENDIF | |
403 | ELSE | |
404 | GO TO 920 | |
405 | ENDIF | |
406 | ELSE | |
407 | GO TO 900 | |
408 | ENDIF | |
409 | * | |
410 | ELSE | |
411 | GO TO 900 | |
412 | ENDIF | |
413 | * | |
414 | GO TO 999 | |
415 | * | |
416 | 900 WRITE (CHMAIL, 1001) ISH, ISHM | |
417 | GO TO 990 | |
418 | * | |
419 | 910 WRITE (CHMAIL, 1002) ISH, ISHM, IAXIS | |
420 | GO TO 990 | |
421 | * | |
422 | 920 WRITE (CHMAIL, 1003) ISH, NZ, ISHM, NZ1 | |
423 | * | |
424 | 990 CALL GMAIL( 0, 0) | |
425 | IEORUN = 1 | |
426 | * | |
427 | 1001 FORMAT (' GGDPAR : Not accepted ISH,ISHM=',2I5) | |
428 | 1002 FORMAT (' GGDPAR : Not accepted ISH,ISHM,IAXIS=',3I5) | |
429 | 1003 FORMAT (' GGDPAR : Not accepted ISH,NZ,ISHM,NZ1=',4I5) | |
430 | * END GGDPAR | |
431 | 999 END |