Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdcgsl.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:20:21 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.26 by S.Giani
11*-- Author :
12 SUBROUTINE GDCGSL(IVOLNA,ISHAPE)
13C.
14C. ******************************************************************
15C. * *
16C. * This routine allows computes the coefficients of the *
17C. * cut plane and the limits and array of the clipping *
18C. * volumes (boxes, cones, tubes, spheres). *
19C. * *
20C. * ==>Called by : GDRAW *
21C. * *
22C. * Authors : J.Salt ; S.Giani *
23C. ******************************************************************
24C.
25#include "geant321/gcdraw.inc"
26#include "geant321/gcunit.inc"
27#include "geant321/gconsp.inc"
28#include "geant321/gcgobj.inc"
29*
30*
31*****SG
32*
33#include "geant321/gcspee.inc"
34#include "geant321/gcbank.inc"
35#include "geant321/gcnum.inc"
36#include "geant321/gcvolu.inc"
37#include "geant321/gchiln.inc"
38#include "geant321/gcmutr.inc"
39#include "geant321/pawc.inc"
40*
41 DIMENSION TMIN(3),TMAX(3),XZ(2,4)
42 CHARACTER*4 NACA
43*
44 CALL UCTOH('PERS',IPERS,4,4)
45 IF(IHOLE.NE.0)THEN
46*
47* Clipping Volumes Creation
48*
49* Look for volume to be clipped
50*
51 NAIN=0
52 JJJ=0
53 ICUBE=0
54 CALL UHTOC(IVOLNA,4,NACA,4)
55 DO 30 III=1,MULTRA
56 INV=0
57 IWILDC=INDEX(GNNVV(III),'*')
58 IF(IWILDC.EQ.0) THEN
59 CALL UCTOH(GNNVV(III),INV,4,4)
60 ELSEIF(IWILDC.EQ.1.AND.JJJ.LT.2) THEN
61 INV=IVOLNA
62 ELSEIF(GNNVV(III)(1:IWILDC-1).EQ.
63 + NACA(1:IWILDC-1)) THEN
64 INV=IVOLNA
65 ENDIF
66 IF(INV.EQ.IVOLNA)THEN
67*
68* If you find it, compute number of times it's to be clipped
69* and set parameters of relative clipping shapes
70*
71 JJJ=JJJ+1
72 IF(JJJ.EQ.3)THEN
73 WRITE(CHMAIL,10100)
74 CALL GMAIL(0,0)
75 GOTO 60
76 ENDIF
77 IF(GNASH(III).EQ.'BOX ')THEN
78 DBX=GXMAX(III)-GXMIN(III)
79 DBY=GYMAX(III)-GYMIN(III)
80 DBZ=GZMAX(III)-GZMIN(III)
81*
82 IF(JJJ.EQ.2)THEN
83 ICUBE=ICUBE+1
84 CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP2))
85 CALL CGCEV(-1,Q(ICLIP2))
86 CALL CGCEV(-1,Q(ICLIP2))
87 CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
88 + Q(ICLIP2))
89 CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
90* Perspective view
91 IF (IPRJ.EQ.IPERS) THEN
92 CALL CGPERS(Q(ICLIP2))
93 ENDIF
94 ELSE
95 ICUBE=ICUBE+1
96 CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP1))
97 CALL CGCEV(-1,Q(ICLIP1))
98 CALL CGCEV(-1,Q(ICLIP1))
99 CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
100 + Q(ICLIP1))
101 CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
102* Perspective view
103 IF (IPRJ.EQ.IPERS) THEN
104 CALL CGPERS(Q(ICLIP1))
105 ENDIF
106 ENDIF
107 ELSE IF (GNASH(III).EQ.'TUBE') THEN
108 RMIN1=0
109 RMAX1=GXMIN(III)
110 Z2=GXMAX(III)
111 RMIN2=RMIN1
112 RMAX2=RMAX1
113 XZ(1,1)=RMIN1
114 XZ(2,1)=-Z2
115 XZ(1,2)=RMAX1
116 XZ(2,2)=-Z2
117 XZ(1,3)=RMAX2
118 XZ(2,3)=Z2
119 XZ(1,4)=RMIN2
120 XZ(2,4)=Z2
121 ANG1=0.
122 ANG2=360.
123 NANG=30
124*
125 IF(JJJ.EQ.2)THEN
126 CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
127 CALL CGCEV(-1,Q(ICLIP2))
128 CALL CGCEV(-1,Q(ICLIP2))
129 S1=GYMIN(III)
130 S2=GYMAX(III)
131 S3=GZMIN(III)
132 CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
133 CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
134* Perspective view
135 IF (IPRJ.EQ.IPERS) THEN
136 CALL CGPERS(Q(ICLIP2))
137 ENDIF
138 ELSE
139 CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
140 CALL CGCEV(-1,Q(ICLIP1))
141 CALL CGCEV(-1,Q(ICLIP1))
142 S1=GYMIN(III)
143 S2=GYMAX(III)
144 S3=GZMIN(III)
145 CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
146 CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
147* Perspective view
148 IF (IPRJ.EQ.IPERS) THEN
149 CALL CGPERS(Q(ICLIP1))
150 ENDIF
151 ENDIF
152 ELSE IF (GNASH(III).EQ.'SPHE') THEN
153 R=GXMIN(III)
154 NLAT=15
155 NLON=15
156*
157 IF(JJJ.EQ.2)THEN
158 CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP2))
159 CALL CGCEV(-1,Q(ICLIP2))
160 CALL CGCEV(-1,Q(ICLIP2))
161 S1=GXMAX(III)
162 S2=GYMIN(III)
163 S3=GYMAX(III)
164 CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
165 CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
166* Perspective view
167 IF (IPRJ.EQ.IPERS) THEN
168 CALL CGPERS(Q(ICLIP2))
169 ENDIF
170 ELSE
171 CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP1))
172 CALL CGCEV(-1,Q(ICLIP1))
173 CALL CGCEV(-1,Q(ICLIP1))
174 S1=GXMAX(III)
175 S2=GYMIN(III)
176 S3=GYMAX(III)
177 CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
178 CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
179* Perspective view
180 IF (IPRJ.EQ.IPERS) THEN
181 CALL CGPERS(Q(ICLIP1))
182 ENDIF
183 ENDIF
184 ELSE IF (GNASH(III).EQ.'CONE') THEN
185 RMIN1=0.
186 RMAX1=GXMIN(III)
187 RMIN2=0.
188 RMAX2=GXMAX(III)
189 Z2=GYMIN(III)
190 XZ(1,1)=RMIN1
191 XZ(2,1)=-Z2
192 XZ(1,2)=RMAX1
193 XZ(2,2)=-Z2
194 XZ(1,3)=RMAX2
195 XZ(2,3)=Z2
196 XZ(1,4)=RMIN2
197 XZ(2,4)=Z2
198 ANG1=0.
199 ANG2=360.
200 NANG=30
201 IF(JJJ.EQ.2)THEN
202 CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
203 CALL CGCEV(-1,Q(ICLIP2))
204 CALL CGCEV(-1,Q(ICLIP2))
205 S1=GYMAX(III)
206 S2=GZMIN(III)
207 S3=GZMAX(III)
208 CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
209 CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
210* Perspective view
211 IF (IPRJ.EQ.IPERS) THEN
212 CALL CGPERS(Q(ICLIP2))
213 ENDIF
214 ELSE
215 CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
216 CALL CGCEV(-1,Q(ICLIP1))
217 CALL CGCEV(-1,Q(ICLIP1))
218 S1=GYMAX(III)
219 S2=GZMIN(III)
220 S3=GZMAX(III)
221 CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
222 CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
223* Perspective view
224 IF (IPRJ.EQ.IPERS) THEN
225 CALL CGPERS(Q(ICLIP1))
226 ENDIF
227 ENDIF
228 ENDIF
229* IF(CGERR.LE.0)THEN
230* CALL GDCGER(CGERR)
231* IF(KCGST.EQ.-2)GO TO 999
232* IF(KCGST.EQ.-3)THEN
233* WRITE(CHMAIL,10100)
234* CALL GMAIL(0,0)
235* GO TO 999
236* ENDIF
237* ENDIF
238*
239* Compute scope for each clipping volume
240*
241 DO 10 K=1,3
242 KKK=K+3*JJJ-3
243 BMIN(KKK)=TMIN(K)
244 BMAX(KKK)=TMAX(K)
245 10 CONTINUE
246 IF(IPORLI.EQ.1)THEN
247 DO 20 KJ=1,3
248 KKKJ=KJ+3*JJJ-3
249 CLIPMI(KKKJ)=TMIN(KJ)
250 CLIPMA(KKKJ)=TMAX(KJ)
251 20 CONTINUE
252 ENDIF
253 ENDIF
254 30 CONTINUE
255*
256* If volume is not to be clipped
257*
258 IF(JJJ.EQ.0)THEN
259 IF(IPORLI.EQ.1)THEN
260 DO 40 KJ=1,6
261 CLIPMI(KJ)=-10000
262 CLIPMA(KJ)=-9999
263 40 CONTINUE
264 JPORJJ=1
265 ENDIF
266 NAIN=1
267 GOTO 60
268 ELSE
269 IF(IPORLI.EQ.1)THEN
270 JPORJJ=JJJ
271 ENDIF
272 NAIN=2
273 ISA=0
274 DO 50 J=1,6
275 IF(BMIN(J).EQ.CLIPMI(J).AND.BMAX(J).EQ.CLIPMA(J))THEN
276 ISA=ISA+1
277 ENDIF
278 50 CONTINUE
279 IF(ISA.EQ.6)NAIN=3
280 ENDIF
281*
282*
283*****SG
284*
285*
286 ELSE
287*
288* Slicing with a plane
289*
290 IF(ICUT.EQ.0) GO TO 999
291 IF(ICUT.EQ.1)THEN
292 CTHETA=90.
293 CPHI=180.
294 ELSE IF(ICUT.EQ.2)THEN
295 CTHETA=90.
296 CPHI=270.
297 ELSE IF(ICUT.EQ.3)THEN
298 CTHETA=180.
299 CPHI=0.
300 ELSE
301 WRITE(CHMAIL,10000)
302 CALL GMAIL(0,0)
303 GO TO 999
304 ENDIF
305 ATH=DEGRAD*CTHETA
306 APH=DEGRAD*CPHI
307 ABCD(1)=SIN(ATH)*COS(APH)
308 ABCD(2)=SIN(ATH)*SIN(APH)
309 ABCD(3)=COS(ATH)
310 ABCD(4)=DCUT
311 ENDIF
312 60 CONTINUE
313*
31410000 FORMAT(' CUT Index not implemented')
315*10100 FORMAT(' Check Clipping Box Parameters ')
31610100 FORMAT(' Please, reset CVOL mode. ')
317*
318 999 END