This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / ggeom / gsdvn2.F
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 GSDVN2(KNAME,MOTHER,NDIV,IAXIS,C0I,NUMED)
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       DIVIDES MOTHER INTO NDIV DIVISIONS CALLED NAME           *
17 C.    *       ALONG AXIS IAXIS STARTING AT COORDINATE VALUE C0.        *
18 C.    *       THE NEW VOLUME CREATED WILL BE MEDIUM NUMBER NUMED.      *
19 C.    *                                                                *
20 C.    *          JVO=POINTER TO MOTHER VOLUME                          *
21 C.    *          JDIV=LQ(JVO-1)                                        *
22 C.    *                                                                *
23 C.    *            Q(JDIV+1)=IAXIS                                     *
24 C.    *            Q(JDIV+2)=VOLUME NUMBER                             *
25 C.    *            Q(JDIV+3)=NDIV                                      *
26 C.    *            Q(JDIV+4)=C0                                        *
27 C.    *            Q(JDIV+5)=STEP SIZE IN COORDINATES.                 *
28 C.    *                                                                *
29 C.    *    ==>Called by : <USER>, GSDVX                                *
30 C.    *         Authors F.Bruyant,   A.McPherson  *********            *
31 C.    *                                                                *
32 C.    ******************************************************************
33 C.
34 #include "geant321/gcbank.inc"
35 #include "geant321/gcflag.inc"
36 #include "geant321/gcnum.inc"
37 #include "geant321/gcunit.inc"
38 #include "geant321/gcdraw.inc"
39 #include "geant321/gcshno.inc"
40       CHARACTER*4 KNAME,MOTHER
41       DIMENSION PAR(50),ATT(20)
42       SAVE ATT
43       DATA ATT /1.,1.,1.,1.,1.,15*0./
44 C.
45 C.    ------------------------------------------------------------------
46 C.
47 C              CHECK IF VOLUME MASTER BANK EXISTS
48 C
49       CALL UCTOH(KNAME,NAME,4,4)
50       IF(JVOLUM.GT.0)GO TO 10
51       WRITE(CHMAIL,1000)
52       CALL GMAIL(0,0)
53       GO TO 99
54 C
55 C              CHECK IF MOTHER VOLUME EXISTS
56 C
57   10  CALL GLOOK(MOTHER,IQ(JVOLUM+1),NVOLUM,IVO)
58       IF(IVO.GT.0)GO TO 20
59       WRITE(CHMAIL,2000)MOTHER
60       CALL GMAIL(0,0)
61       GO TO 99
62 C
63 C              CHECK IF NAME VOLUME EXISTS
64 C
65   20  CALL GLOOK(KNAME,IQ(JVOLUM+1),NVOLUM,IN)
66       IF(IN.LE.0)GO TO 50
67       WRITE(CHMAIL,2000)NAME
68       CALL GMAIL(0,0)
69       GO TO 99
70 C
71 C              CHECK IF MOTHER IS NOT DIVIDED
72 C
73   50  JVO=LQ(JVOLUM-IVO)
74       NIN=Q(JVO+3)
75       IF(NIN.EQ.0)GO TO 60
76       WRITE(CHMAIL,4000)MOTHER
77       CALL GMAIL(0,0)
78       GO TO 99
79 C
80 C              CHECK VALIDITY OF AXIS VALUE
81 C
82   60  IF(IAXIS.GT.0.AND.IAXIS.LT.4)GO TO 70
83       WRITE(CHMAIL,5000)IAXIS
84       CALL GMAIL(0,0)
85       GO TO 99
86 C
87 C              CHECK VALIDITY OF NDIV
88 C
89   70  IF(NDIV.GT.0)GO TO 80
90       WRITE(CHMAIL,6000)NDIV
91       CALL GMAIL(0,0)
92       GO TO 99
93 C
94 C               CREATE BANK TO STORE DIVISION PARAMETERS
95 C
96   80  CALL MZBOOK(IXCONS,JDIV,JVO,-1,'VODI',0,0,6,3,0)
97       IF(IEOTRI.NE.0)GO TO 95
98       IQ(JDIV-5)=IVO
99 C
100 C               NOW STORE PARAMETERS INTO BANK AREA
101 C
102   90  Q(JDIV+1)=IAXIS
103       Q(JDIV+2)=NVOLUM+1
104       Q(JDIV+3)=NDIV
105       Q(JVO+3)=-1
106       IVOM= IVO
107       NWM = IQ(JVO-1)
108       NW  = NWM
109       CALL GFIPAR(JVO,0,0,NPAR,NATT,PAR,ATT)
110 C
111 C              CHECK START AND FIND AND STORE STEP.
112 C
113       ISH=Q(JVO+2)
114       C0 = C0I
115       IF(ISH.NE.1) GO TO 100
116 C
117 C               BOX
118 C
119       IF(PAR(IAXIS).LE.0.0) GO TO 920
120       IF(ABS(C0).GT.PAR(IAXIS)) GO TO 910
121       STEP=(PAR(IAXIS)-C0)/NDIV
122       PAR(IAXIS)=STEP/2.
123       GO TO 210
124 C
125   100 CONTINUE
126       IF(ISH.NE.2) GO TO 110
127 C
128 C              TRAPEZOID WITH ONLY X THICKNESS VARYING WITH Z.
129 C
130       IF(IAXIS.EQ.1) GO TO 900
131       IF(PAR(IAXIS+1).LE.0.0) GO TO 920
132       IF(ABS(C0).GT.PAR(IAXIS+1)) GO TO 910
133       STEP=(PAR(IAXIS+1)-C0)/NDIV
134       PAR(1)=-1.
135       PAR(2)=-1.
136       PAR(IAXIS+1)=STEP/2.
137       GO TO 210
138 C
139   110 CONTINUE
140       IF(ISH.NE.3) GO TO 120
141 C
142 C              TRAPEZOID WITH BOTH X AND Y THICKNESSES VARYING WITH
143 C              Z
144 C
145       IF(IAXIS.NE.3) GO TO 900
146       IF(PAR(5).LE.0.0) GO TO 920
147       IF(ABS(C0).GT.PAR(5)) GO TO 910
148       STEP=(PAR(5)-C0)/NDIV
149       PAR(1)=-1.
150       PAR(2)=-1.
151       PAR(3)=-1.
152       PAR(4)=-1.
153       PAR(5)=STEP/2.
154       GO TO 210
155 C
156   120 CONTINUE
157       IF(ISH.NE.4) GO TO 125
158       IF(IAXIS.NE.3) GO TO 126
159       IF(PAR(1).LE.0.0) GO TO 920
160       IF(ABS(C0).GT.PAR(1)) GO TO 910
161       STEP=(PAR(1)-C0)/NDIV
162       PAR(1)=STEP*0.5
163       PAR(4)=-1.0
164       PAR(5)=-1.0
165       PAR(6)=-1.0
166       PAR(8)=-1.0
167       PAR(9)=-1.0
168       PAR(10)=-1.0
169       GO TO 210
170 C
171   126 IF(IAXIS.NE.2) GO TO 900
172       IF(MOD(PAR(3),180.).EQ.0.) GO TO 127
173       WRITE(CHMAIL,10100)
174 10100 FORMAT(' Division of TRAP ',A4,
175      +    ' along Y only possible when PHI=0,180')
176       CALL GMAIL(0,0)
177       GOTO 99
178   127 IF(PAR(4).EQ.PAR(8))  GO TO 128
179       WRITE(CHMAIL,10200)
180 10200 FORMAT(' Division of TRAP ',A4,
181      +    ' along Y only possible when H1=H2')
182       CALL GMAIL(0,0)
183       GOTO 99
184   128 CONTINUE
185       IF(PAR(4).LE.0.) GO TO 920
186       IF(ABS(C0).GT.PAR(4)) GO TO 910
187       STEP = (PAR(4)-C0)/NDIV
188       PAR(4) = 0.5*STEP
189       PAR(5) = -1.
190       PAR(6) = -1.
191       PAR(8) = 0.5*STEP
192       PAR(9) = -1.
193       PAR(10) = -1.
194 C
195       GO TO 210
196 C
197   125 CONTINUE
198       IF(ISH.NE.5.AND.ISH.NE.6.AND.ISH.NE.NSCTUB) GO TO 160
199 C
200 C              Tube, tube segment or cut tube.
201 C
202       IF(IAXIS.NE.3) GO TO 130
203       IF(PAR(3).LE.0.0) GO TO 920
204       IF(ABS(C0).GT.PAR(3)) GO TO 910
205       STEP=(PAR(3)-C0)/NDIV
206       PAR(3)=STEP/2.
207       GO TO 210
208 C
209   130 CONTINUE
210       IF(IAXIS.NE.1) GO TO 140
211       IF(PAR(1).LE.0.0.OR.PAR(2).LE.0.0) GO TO 920
212       IF(C0.LT.PAR(1).OR.C0.GT.PAR(2)) GO TO 910
213       STEP=(PAR(2)-C0)/NDIV
214       PAR(1)=-1.
215       PAR(2)=-1.
216       GO TO 210
217 C
218   140 CONTINUE
219       IF(ISH.EQ.6) GO TO 150
220       NW=NW+2
221       ISH=6
222       STEP=360.0/NDIV
223       NPAR=5
224       PAR(4)=-STEP/2.
225       PAR(5)=STEP/2.
226       GO TO 210
227 C
228   150 CONTINUE
229       DP=PAR(5)-PAR(4)
230       DC0P = C0-PAR(4)
231       SG = SIGN(1.0,DC0P)
232       DC0P = MOD( ABS(DC0P), 360.0)
233       IF(SG.LE.0.0) DC0P = 360.0-DC0P
234       C0 = PAR(4)+DC0P
235       IF(C0-PAR(4).LT.0.0) C0=C0+360.0
236       IF(C0-PAR(4).GT.DP) GO TO 910
237       DP=PAR(5)-C0
238       IF(DP.LT.0.0) DP=DP+360
239       STEP=DP/NDIV
240       PAR(4)=-STEP/2.
241       PAR(5)=STEP/2.
242       GO TO 210
243 C
244   160 CONTINUE
245 C
246       IF(ISH.NE.7.AND.ISH.NE.8) GO TO 190
247       IF(IAXIS.EQ.1) GO TO 165
248       IF(IAXIS.NE.3) GO TO 170
249 C
250       IF(PAR(1).LE.0.0) GO TO 920
251       IF(ABS(C0).GT.PAR(1)) GO TO 910
252       STEP=(PAR(1)-C0)/NDIV
253       PAR(1)=STEP*0.5
254 C
255   165 CONTINUE
256 C
257       PAR(2)=-1.0
258       PAR(3)=-1.0
259       PAR(4)=-1.0
260       PAR(5)=-1.0
261       GO TO 210
262 C
263   170 CONTINUE
264       IF(IAXIS.EQ.1) GO TO 210
265 C
266       IF(ISH.EQ.8) GO TO 180
267       NW=NW+2
268       ISH=8
269       STEP=360.0/NDIV
270       NPAR=7
271       PAR(6)=-STEP/2.
272       PAR(7)=STEP/2.
273       GO TO 210
274 C
275   180 CONTINUE
276       DP=PAR(7)-PAR(6)
277       DC0P = C0-PAR(6)
278       SG = SIGN(1.0,DC0P)
279       DC0P = MOD( ABS(DC0P), 360.0)
280       IF(SG.LE.0.0) DC0P = 360.0-DC0P
281       C0 = PAR(6)+DC0P
282       IF(C0-PAR(6).LT.0.0) C0=C0+360.0
283       IF(C0-PAR(6).GT.DP) GO TO 910
284       DP=PAR(7)-C0
285       IF(DP.LT.0.0) DP=DP+360.0
286       STEP=DP/NDIV
287       PAR(6)=-STEP/2.
288       PAR(7)=STEP/2.
289       GO TO 210
290 C
291   190 CONTINUE
292       IF(ISH.NE.9) GO TO 200
293       IF(IAXIS.NE.1) GO TO 195
294       PAR(1)=-1.0
295       PAR(2)=-1.0
296       IF(C0.LT.PAR(1).OR.C0.GT.PAR(2)) THEN
297          GOTO 910
298       ENDIF
299       STEP = (PAR(2)-C0)/NDIV
300       GOTO 210
301   195 CONTINUE
302       IF(IAXIS.NE.2) GO TO 196
303       WRITE(CHMAIL,8102)
304       CALL GMAIL(0,0)
305       GOTO 99
306 C
307   196 CONTINUE
308       IF(IAXIS.NE.3) GO TO 210
309       ANGMIN = MOD(PAR(5),360.)
310       IF(ANGMIN.LT.0.) ANGMIN=ANGMIN+360.
311       ANGMAX = MOD(PAR(6),360.)
312       IF(ANGMAX.LE.ANGMIN) ANGMAX=ANGMAX+360.
313       C0 = MOD(C0,360.)
314       IF(C0.LT.0.0) C0=C0+360.0
315       IF(C0.GT.ANGMAX.OR.C0.LT.ANGMIN) GO TO 910
316       STEP=(ANGMAX-C0)/NDIV
317       PAR(3)=-1.
318       PAR(4)=-1.
319       PAR(5)=-0.5*STEP
320       PAR(6)=0.5*STEP
321       GO TO 210
322 C
323   200 CONTINUE
324 C
325       GO TO 900
326 C
327 C                NOW CREATE THE VOLUME FOR DIVISION
328 C
329  210  Q(JDIV+4)=C0
330       Q(JDIV+5)=STEP
331       NVOLUM=NVOLUM+1
332       NVOL  =IQ(JVOLUM-2)
333       IF(NVOLUM.GT.NVOL)CALL MZPUSH(IXCONS,JVOLUM,50,50,'I')
334       CALL MZBOOK(IXCONS,JVO,JVOLUM,-NVOLUM,'VOL1',50,50,NW,3,0)
335       IF(IEOTRI.NE.0)GO TO 95
336       IQ(JVOLUM+NVOLUM)=NAME
337 C
338 C              COPY PARAMETERS IN DATA AREA
339 C
340       JVOM=LQ(JVOLUM-IVOM)
341       CALL UCOPY(Q(JVOM+1),Q(JVO+1),NWM)
342       CALL GSIPAR(JVO,0,NPAR,NATT,PAR,ATT)
343       Q(JVO+2)=ISH
344       Q(JVO+3)=0.
345       Q(JVO+4)=NUMED
346       GO TO 99
347 C
348   900 CONTINUE
349 C
350 C        DIVIDE ACTION NOT SUPPORTED.
351 C
352       WRITE(CHMAIL,8000)
353       CALL GMAIL(0,0)
354       WRITE(CHMAIL,8001) ISH,IAXIS
355       CALL GMAIL(0,0)
356 C
357       GO TO 99
358 C
359   910 CONTINUE
360 C
361 C              C0 START OF DIVISION OUT OF OBJECT.
362 C
363       WRITE(CHMAIL,9000) C0
364       CALL GMAIL(0,0)
365 C
366       GO TO 99
367   920 CONTINUE
368 C
369 C              +VE DEFINITE PARAMETER IN DIMENSION OF C0 SET -VE OR 0.
370 C
371       WRITE(CHMAIL,9010)
372       CALL GMAIL(0,0)
373 C
374       GO TO 99
375 C
376 C              NOT ENOUGH SPACE
377 C
378   95  WRITE(CHMAIL,7000)NAME,MOTHER
379       CALL GMAIL(0,0)
380 C
381   99  CONTINUE
382  1000 FORMAT(' ***** GSDVN2 CALLED AND NO VOLUMES DEFINED *****')
383  2000 FORMAT(' ***** GSDVN2 VOLUME ',A4,' ALREADY EXISTS *****')
384  3000 FORMAT(' ***** GSDVN2 ROTATION MATRIX',I5,' DOES NOT EXIST *****')
385  4000 FORMAT(' ***** GSDVN2 MOTHER ',A4,' ALREADY DIVIDED *****')
386  5000 FORMAT(' ***** GSDVN2 BAD AXIS VALUE ',I5,' *****')
387  6000 FORMAT(' ***** GSDVN2 BAD NUMBER OF DIVISIONS ',I5,' *****')
388  7000 FORMAT(' ***** GSDVN2 NOT ENOUGH SPACE TO STORE DIVISIONS ',
389      +       ' IN ',A4,' *****')
390  8000 FORMAT(' DIVIDE ACTION WITH C0 REQUESTED NOT SUPPORTED',
391      +' AT PRESENT.')
392  8001 FORMAT(' ISH =',I5,' IAXIS =',I5)
393  8102 FORMAT(' DIVISION OF A SPHERE ALONG AXIS 2 NOT SUPPORTED')
394  9000 FORMAT(' ***** GSDVN2 C0',E15.5,' OUT OF OBJECT *****')
395  9010 FORMAT(' ***** GSDVN2 C0 WITH -VE DIMENSION IN MOTHER *****')
396       END