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