]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
d43b40e2 | 5 | * Revision 1.1.1.1 1999/05/18 15:55:17 fca |
6 | * AliRoot sources | |
7 | * | |
fe4da5cc | 8 | * Revision 1.1.1.1 1995/10/24 10:20:55 cernlib |
9 | * Geant | |
10 | * | |
11 | * | |
12 | #include "geant321/pilot.h" | |
13 | *CMZ : 3.21/02 29/03/94 15.41.30 by S.Giani | |
14 | *-- Author : | |
15 | SUBROUTINE GSDVN(KNAME,MOTHER,NDIV,IAXIS) | |
16 | C. | |
17 | C. ****************************************************************** | |
18 | C. * * | |
19 | C. * Routine divides MOTHER into NDIV divisions called NAME * | |
20 | C. * along axis number IAXIS. * | |
21 | C. * JVO=Pointer to MOTHER volume * | |
22 | C. * JDIV=LQ(JVO-1) * | |
23 | C. * * | |
24 | C. * Q(JDIV+1)=IAXIS * | |
25 | C. * Q(JDIV+2)=Volume number. * | |
26 | C. * Q(JDIV+3)=NDIV * | |
27 | C. * Q(JDIV+4)=Lowest coord of slices. * | |
28 | C. * Q(JDIV+5)=Step size in coordinates. * | |
29 | C. * * | |
30 | C. * ==>Called by : <USER>, GEDITV * | |
31 | C. * Authors R.Brun, A.McPherson ********* * | |
32 | C. * * | |
33 | C. ****************************************************************** | |
34 | C. | |
35 | #include "geant321/gcbank.inc" | |
36 | #include "geant321/gcflag.inc" | |
37 | #include "geant321/gcnum.inc" | |
38 | #include "geant321/gcunit.inc" | |
39 | #include "geant321/gcdraw.inc" | |
40 | #include "geant321/gcshno.inc" | |
41 | CHARACTER*4 KNAME,MOTHER | |
d43b40e2 | 42 | DIMENSION PAR(100),PARM(100),ATT(20) |
fe4da5cc | 43 | SAVE ATT |
44 | DATA ATT /1.,1.,1.,1.,1.,15*0./ | |
45 | C. | |
46 | C. ------------------------------------------------------------------ | |
47 | C. | |
48 | C Check if volume master bank exists. | |
49 | C | |
50 | CALL UCTOH(KNAME,NAME,4,4) | |
51 | IF(JVOLUM.GT.0)GO TO 10 | |
52 | WRITE(CHMAIL,1000) | |
53 | CALL GMAIL(0,0) | |
54 | GO TO 99 | |
55 | C | |
56 | C Check if MOTHER volume exists. | |
57 | C | |
58 | 10 CALL GLOOK(MOTHER,IQ(JVOLUM+1),NVOLUM,IVO) | |
59 | IF(IVO.GT.0)GO TO 20 | |
60 | WRITE(CHMAIL,1100)MOTHER | |
61 | CALL GMAIL(0,0) | |
62 | GO TO 99 | |
63 | C | |
64 | C Check if NAME volume exists. | |
65 | C | |
66 | 20 CALL GLOOK(KNAME,IQ(JVOLUM+1),NVOLUM,IN) | |
67 | IF(IN.LE.0)GO TO 50 | |
68 | WRITE(CHMAIL,2000)NAME | |
69 | CALL GMAIL(0,0) | |
70 | GO TO 99 | |
71 | C | |
72 | C Check if MOTHER is not divided. | |
73 | C | |
74 | 50 JVO=LQ(JVOLUM-IVO) | |
75 | NIN=Q(JVO+3) | |
76 | IF(NIN.EQ.0)GO TO 60 | |
77 | WRITE(CHMAIL,4000)MOTHER | |
78 | CALL GMAIL(0,0) | |
79 | GO TO 99 | |
80 | C | |
81 | C Check validity of axis value. | |
82 | C | |
83 | 60 IF(IAXIS.GT.0.AND.IAXIS.LT.4)GO TO 70 | |
84 | WRITE(CHMAIL,5000)IAXIS | |
85 | CALL GMAIL(0,0) | |
86 | GO TO 99 | |
87 | C | |
88 | C Check validity of NDIV | |
89 | C | |
90 | 70 IF(NDIV.GT.0)GO TO 80 | |
91 | WRITE(CHMAIL,6000)NDIV | |
92 | CALL GMAIL(0,0) | |
93 | GO TO 99 | |
94 | C | |
95 | C Create bank to store division parameters. | |
96 | C | |
97 | 80 CALL MZBOOK(IXCONS,JDIV,JVO,-1,'VODI',0,0,6,3,0) | |
98 | IF(IEOTRI.NE.0)GO TO 95 | |
99 | IQ(JDIV-5)=IVO | |
100 | C | |
101 | C Now store parameters into bank area. | |
102 | C | |
103 | 90 Q(JDIV+1)=IAXIS | |
104 | Q(JDIV+2)=NVOLUM+1 | |
105 | Q(JDIV+3)=NDIV | |
106 | Q(JVO+3)=-1 | |
107 | IVOM= IVO | |
108 | NWM = IQ(JVO-1) | |
109 | NW = NWM | |
110 | ISH = Q(JVO+2) | |
111 | C | |
112 | C Bit to allow division of objects defined | |
113 | C by GSPOSP. | |
114 | C | |
115 | C0=0.0 | |
116 | STEP=0.0 | |
117 | NPAR=Q(JVO+5) | |
118 | NATT=Q(JVO+6) | |
119 | CALL UCOPY(Q(JVO+NPAR+7),ATT,NATT) | |
120 | IF(NPAR.LE.0) GO TO 230 | |
121 | C | |
122 | CALL GFIPAR(JVO,0,0,NPAR,NATT,PAR,ATT) | |
123 | CALL UCOPY(PAR,PARM,NPAR) | |
124 | C | |
125 | C Find and store start and step. | |
126 | C | |
127 | IF(ISH.NE.1) GO TO 100 | |
128 | C | |
129 | C Box. | |
130 | C | |
131 | STEP=-1.0 | |
132 | PAR(IAXIS)=-1.0 | |
133 | IF(PARM(IAXIS).LT.0.0) GO TO 230 | |
134 | C0 =-PARM(IAXIS) | |
135 | STEP=PARM(IAXIS)*2.0/NDIV | |
136 | PAR(IAXIS)=STEP/2. | |
137 | GO TO 230 | |
138 | C | |
139 | 100 CONTINUE | |
140 | IF(ISH.NE.2) GO TO 110 | |
141 | C | |
142 | C Trapezoid with only X thickness varying with Z. | |
143 | C | |
144 | IF(IAXIS.EQ.1) GO TO 900 | |
145 | PAR(1)=-1. | |
146 | PAR(2)=-1. | |
147 | STEP=-1.0 | |
148 | PAR(IAXIS+1)=-1.0 | |
149 | IF(PARM(IAXIS+1).LT.0.0) GO TO 230 | |
150 | C0 =-PARM(IAXIS+1) | |
151 | STEP=PARM(IAXIS+1)*2.0/NDIV | |
152 | PAR(IAXIS+1)=STEP/2. | |
153 | GO TO 230 | |
154 | C | |
155 | 110 CONTINUE | |
156 | IF(ISH.NE.3) GO TO 120 | |
157 | C | |
158 | C Trapezoid with both X and Y thicknesses varying with | |
159 | C Z | |
160 | C | |
161 | IF(IAXIS.NE.3) GO TO 900 | |
162 | PAR(1)=-1. | |
163 | PAR(2)=-1. | |
164 | PAR(3)=-1. | |
165 | PAR(4)=-1. | |
166 | STEP=-1.0 | |
167 | PAR(5)=-1.0 | |
168 | IF(PARM(5).LT.0.0) GO TO 230 | |
169 | C0 =-PARM(5) | |
170 | STEP=PARM(5)*2.0/NDIV | |
171 | PAR(5)=STEP/2. | |
172 | GO TO 230 | |
173 | C | |
174 | 120 CONTINUE | |
175 | IF(ISH.NE.4) GO TO 125 | |
176 | IF(IAXIS.NE.3) GO TO 126 | |
177 | PAR(1)=-1. | |
178 | PAR(4)=-1. | |
179 | PAR(5)=-1. | |
180 | PAR(6)=-1. | |
181 | PAR(8)=-1. | |
182 | PAR(9)=-1. | |
183 | PAR(10)=-1. | |
184 | STEP=-1.0 | |
185 | IF(PARM(1).LT.0.0) GO TO 230 | |
186 | C0=-PARM(1) | |
187 | STEP=PARM(1)*2.0/NDIV | |
188 | PAR(1)=STEP*0.5 | |
189 | C | |
190 | GO TO 230 | |
191 | C | |
192 | 126 IF(IAXIS.NE.2) GO TO 900 | |
193 | IF(MOD(PARM(3),180.).EQ.0.) GO TO 127 | |
194 | WRITE(CHMAIL,10100) | |
195 | 10100 FORMAT(' Division of TRAP ',A4, | |
196 | + ' along Y only possible when PHI=0,180') | |
197 | CALL GMAIL(0,0) | |
198 | GOTO 99 | |
199 | 127 IF(PARM(4).EQ.PARM(8)) GO TO 128 | |
200 | WRITE(CHMAIL,10200) | |
201 | 10200 FORMAT(' Division of TRAP ',A4, | |
202 | + ' along Y only possible when H1=H2') | |
203 | CALL GMAIL(0,0) | |
204 | GOTO 99 | |
205 | 128 CONTINUE | |
206 | STEP = -1. | |
207 | IF(PARM(4).LT.0.0) GO TO 230 | |
208 | C0=-PARM(4) | |
209 | STEPH = PARM(4)/NDIV | |
210 | PAR(4) = STEPH | |
211 | PAR(5) = -1. | |
212 | PAR(6) = -1. | |
213 | PAR(8) = STEPH | |
214 | PAR(9) = -1. | |
215 | PAR(10) = -1. | |
216 | STEP = 2.*STEPH | |
217 | C | |
218 | GO TO 230 | |
219 | C | |
220 | 125 CONTINUE | |
221 | IF(ISH.NE.5.AND.ISH.NE.6.AND.ISH.NE.NSCTUB) GO TO 160 | |
222 | C | |
223 | C Tube, tube segment or cut tube. | |
224 | C | |
225 | IF(IAXIS.NE.3) GO TO 130 | |
226 | STEP=-1.0 | |
227 | PAR(3)=-1.0 | |
228 | IF(PARM(3).LT.0.0) GO TO 230 | |
229 | C0 =-PARM(3) | |
230 | STEP=PARM(3)*2.0/NDIV | |
231 | PAR(3)=STEP/2. | |
232 | GO TO 230 | |
233 | C | |
234 | 130 CONTINUE | |
235 | IF(IAXIS.NE.1) GO TO 140 | |
236 | PAR(1)=-1. | |
237 | PAR(2)=-1. | |
238 | STEP=-1.0 | |
239 | IF(PARM(1).LT.0.0) GO TO 230 | |
240 | C0 =PARM(1) | |
241 | IF(PARM(2).LT.0.0) GO TO 230 | |
242 | STEP=(PARM(2)-PARM(1))/NDIV | |
243 | GO TO 230 | |
244 | C | |
245 | 140 CONTINUE | |
246 | IF(ISH.EQ.6) GO TO 150 | |
247 | NW=NW+2 | |
248 | ISH=6 | |
249 | C0 =0.0 | |
250 | STEP=360.0/NDIV | |
251 | NPAR=5 | |
252 | PAR(4)=-STEP/2. | |
253 | PAR(5)=STEP/2. | |
254 | GO TO 230 | |
255 | C | |
256 | 150 CONTINUE | |
257 | DP=PAR(5)-PAR(4) | |
258 | IF(DP.LT.0.0) DP=DP+360.0 | |
259 | C0 =PAR(4) | |
260 | STEP=DP/NDIV | |
261 | PAR(4)=-STEP/2. | |
262 | PAR(5)=STEP/2. | |
263 | GO TO 230 | |
264 | C | |
265 | 160 CONTINUE | |
266 | C | |
267 | IF(ISH.NE.7.AND.ISH.NE.8) GO TO 190 | |
268 | IF(IAXIS.EQ.1) GO TO 165 | |
269 | IF(IAXIS.NE.3) GO TO 170 | |
270 | C | |
271 | STEP=-1.0 | |
272 | PAR(1)=-1.0 | |
273 | IF(PARM(1).LT.0.0) GO TO 165 | |
274 | C0=-PARM(1) | |
275 | STEP=PARM(1)*2.0/NDIV | |
276 | PAR(1)=STEP*0.5 | |
277 | C | |
278 | 165 CONTINUE | |
279 | C | |
280 | PAR(2)=-1.0 | |
281 | PAR(3)=-1.0 | |
282 | PAR(4)=-1.0 | |
283 | PAR(5)=-1.0 | |
284 | GO TO 230 | |
285 | C | |
286 | 170 CONTINUE | |
287 | IF(IAXIS.EQ.1) GO TO 230 | |
288 | C | |
289 | IF(ISH.EQ.8) GO TO 180 | |
290 | NW=NW+2 | |
291 | ISH=8 | |
292 | C0 =0.0 | |
293 | STEP=360.0/NDIV | |
294 | NPAR=7 | |
295 | PAR(6)=-STEP/2. | |
296 | PAR(7)=STEP/2. | |
297 | GO TO 230 | |
298 | C | |
299 | 180 CONTINUE | |
300 | DP=PAR(7)-PAR(6) | |
301 | IF(DP.LT.0.0) DP=DP+360.0 | |
302 | C0 =PAR(6) | |
303 | STEP=DP/NDIV | |
304 | PAR(6)=-STEP/2. | |
305 | PAR(7)=STEP/2. | |
306 | GO TO 230 | |
307 | C | |
308 | 190 CONTINUE | |
309 | IF(ISH.NE.9) GO TO 200 | |
310 | IF(IAXIS.NE.1) GO TO 195 | |
311 | PAR(1)=-1.0 | |
312 | PAR(2)=-1.0 | |
313 | C0 = PARM(1) | |
314 | STEP = (PARM(2)-PARM(1))/NDIV | |
315 | 195 CONTINUE | |
316 | IF(IAXIS.NE.2) GO TO 196 | |
317 | WRITE(CHMAIL,8102) | |
318 | CALL GMAIL(0,0) | |
319 | GOTO 99 | |
320 | C | |
321 | 196 CONTINUE | |
322 | IF(IAXIS.NE.3) GO TO 230 | |
323 | C0=PAR(5) | |
324 | DP=PAR(6)-PAR(5) | |
325 | IF(DP.LE.0.0) DP=DP+360.0 | |
326 | STEP=DP/NDIV | |
327 | PAR(3)=-1. | |
328 | PAR(4)=-1. | |
329 | PAR(5)=-0.5*STEP | |
330 | PAR(6)=0.5*STEP | |
331 | GO TO 230 | |
332 | C | |
333 | 200 CONTINUE | |
334 | C | |
335 | IF(ISH.NE.10) GO TO 210 | |
336 | C | |
337 | C Parallelipiped. | |
338 | C | |
339 | C0 =-PAR(IAXIS) | |
340 | STEP=-2.0*C0/NDIV | |
341 | PAR(IAXIS)=STEP/2. | |
342 | GO TO 230 | |
343 | C | |
344 | 210 CONTINUE | |
345 | IF(ISH.GT.12) GO TO 900 | |
346 | IF(IAXIS.EQ.1) GO TO 230 | |
347 | IF(IAXIS.EQ.2) GO TO 220 | |
348 | C | |
349 | IPNZ=4 | |
350 | IF(ISH.EQ.12) IPNZ=3 | |
351 | IF(PAR(IPNZ).NE.2) GO TO 910 | |
352 | C | |
353 | ZH=PAR(IPNZ+4) | |
354 | ZL=PAR(IPNZ+1) | |
355 | STEP=(ZH-ZL)/NDIV | |
356 | C0=ZL | |
357 | PAR(IPNZ+4)=STEP*0.5 | |
358 | PAR(IPNZ+1)=-PAR(IPNZ+4) | |
359 | PAR(IPNZ+2)=-1. | |
360 | PAR(IPNZ+3)=-1. | |
361 | PAR(IPNZ+5)=-1. | |
362 | PAR(IPNZ+6)=-1. | |
363 | C | |
364 | GO TO 230 | |
365 | 220 CONTINUE | |
366 | C | |
367 | NDV=NDIV | |
368 | IF(ISH.EQ.11) NDV=PAR(3) | |
369 | Q(JDIV+3)=NDV | |
370 | C0=PAR(1) | |
371 | STEP=PAR(2)/NDV | |
372 | PAR(1)=-STEP*0.5 | |
373 | PAR(2)=STEP | |
374 | IF(ISH.EQ.11)PAR(3)=1. | |
375 | C | |
376 | 230 CONTINUE | |
377 | C | |
378 | C Now create the volume for division. | |
379 | C | |
380 | Q(JDIV+4)=C0 | |
381 | Q(JDIV+5)=STEP | |
382 | NVOLUM=NVOLUM+1 | |
383 | NVOL =IQ(JVOLUM-2) | |
384 | IF(NVOLUM.GT.NVOL)CALL MZPUSH(IXCONS,JVOLUM,50,50,'I') | |
385 | CALL MZBOOK(IXCONS,JVO,JVOLUM,-NVOLUM,'VOL1',50,50,NW,3,0) | |
386 | IF(IEOTRI.NE.0)GO TO 95 | |
387 | IQ(JVOLUM+NVOLUM)=NAME | |
388 | C | |
389 | C Copy parameters in data area. | |
390 | C | |
391 | JVOM=LQ(JVOLUM-IVOM) | |
392 | CALL UCOPY(Q(JVOM+1),Q(JVO+1),NWM) | |
393 | IF(NPAR.GT.0) CALL GSIPAR(JVO,0,NPAR,NATT,PAR,ATT) | |
394 | Q(JVO+2)=ISH | |
395 | Q(JVO+3)=0. | |
396 | GO TO 99 | |
397 | C | |
398 | 900 CONTINUE | |
399 | C | |
400 | C Divide action not supported. | |
401 | C | |
402 | WRITE(CHMAIL,8000) | |
403 | CALL GMAIL(0,0) | |
404 | WRITE(CHMAIL,8001) ISH,IAXIS | |
405 | CALL GMAIL(0,0) | |
406 | C | |
407 | GO TO 99 | |
408 | C | |
409 | 910 CONTINUE | |
410 | C | |
411 | C Trying to divide multi Z sector shape along Z. | |
412 | C | |
413 | WRITE(CHMAIL,8100) | |
414 | CALL GMAIL(0,0) | |
415 | WRITE(CHMAIL,8101) ISH,IAXIS,IPNZ,INT(PAR(IPNZ)) | |
416 | CALL GMAIL(0,0) | |
417 | C | |
418 | GO TO 99 | |
419 | C | |
420 | C Not enough space. | |
421 | C | |
422 | 95 WRITE(CHMAIL,7000)NAME,MOTHER | |
423 | CALL GMAIL(0,0) | |
424 | C | |
425 | 99 CONTINUE | |
426 | 1000 FORMAT(' ***** GSDVN CALLED AND NO VOLUMES DEFINED *****') | |
427 | 1100 FORMAT(' ***** GSDVN MOTHER VOLUME ',A4,' DOES NOT EXIST *****') | |
428 | 2000 FORMAT(' ***** GSDVN VOLUME ',A4,' ALREADY EXISTS *****') | |
429 | 3000 FORMAT(' ***** GSDVN ROTATION MATRIX',I5,' DOES NOT EXISTS *****') | |
430 | 4000 FORMAT(' ***** GSDVN MOTHER ',A4,' ALREADY DIVIDED *****') | |
431 | 5000 FORMAT(' ***** GSDVN BAD AXIS VALUE ',I5,' *****') | |
432 | 6000 FORMAT(' ***** GSDVN BAD NUMBER OF DIVISIONS ',I5,' *****') | |
433 | 7000 FORMAT(' ***** GSDVN NOT ENOUGH SPACE TO STORE DIVISIONS ', | |
434 | + ' IN ',A4,' *****') | |
435 | 8000 FORMAT(' DIVIDE ACTION REQUESTED NOT SUPPORTED AT PRESENT.') | |
436 | 8001 FORMAT(' ISH =',I5,' IAXIS =',I5) | |
437 | 8100 FORMAT(' ATTEMPT TO DIVIDE MULTI Z SECTOR SHAPE ALONG Z.') | |
438 | 8101 FORMAT(' ISH =',I5,' IAXIS =',I5,' NZ (THE',I3,'TH PAR) IS',I5) | |
439 | 8102 FORMAT(' DIVISION OF A SPHERE ALONG AXIS 2 NOT SUPPORTED') | |
440 | END |