]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
d43b40e2 | 5 | * Revision 1.1.1.1 1999/05/18 15:55:03 fca |
6 | * AliRoot sources | |
7 | * | |
fe4da5cc | 8 | * Revision 1.1.1.1 1995/10/24 10:20:27 cernlib |
9 | * Geant | |
10 | * | |
11 | * | |
12 | #include "geant321/pilot.h" | |
13 | *CMZ : 3.21/02 29/03/94 15.41.27 by S.Giani | |
14 | *-- Author : | |
15 | SUBROUTINE GDRWSC(ISHAPE,PAR) | |
16 | C. | |
17 | C. ****************************************************************** | |
18 | C. * * | |
19 | C. * Draw the shape number ISHAPE, of parameters PAR, * | |
20 | C. * in cut-mode. * | |
21 | C. * * | |
22 | C. * ==>Called by : GDRAW * | |
23 | C. * Author : P.Zanarini ********* * | |
24 | C. * Modification log. * | |
25 | C. * 31-May-88 A.C.McPherson - Introduce cut tube shape. * | |
26 | C. * * | |
27 | C. ****************************************************************** | |
28 | C. | |
29 | #include "geant321/gcbank.inc" | |
30 | #include "geant321/gcdraw.inc" | |
31 | #include "geant321/gconsp.inc" | |
32 | #include "geant321/gcshno.inc" | |
33 | PARAMETER ( NLPC = 40 ) | |
34 | * | |
35 | * The constant NLPC defined in the parameter statement | |
36 | * is the number of line elements to form a complete | |
37 | * circle in the surface definitions for a cut tube. | |
38 | * | |
d43b40e2 | 39 | DIMENSION PAR(100),P(3,8) |
fe4da5cc | 40 | DIMENSION XMAX1(2,42),XMIN1(2,42),XMAX2(2,42),XMIN2(2,42) |
41 | C. | |
42 | C. ------------------------------------------------------------------ | |
43 | C. | |
44 | IF (ISHAPE.NE.1) GO TO 200 | |
45 | C | |
46 | C BOX | |
47 | C | |
48 | DX1=PAR(1) | |
49 | DY1=PAR(2) | |
50 | DX2=DX1 | |
51 | DY2=DY1 | |
52 | DZ=PAR(3) | |
53 | GO TO 1000 | |
54 | C | |
55 | 200 IF (ISHAPE.NE.2) GO TO 300 | |
56 | C | |
57 | C TRD1 | |
58 | C | |
59 | DX1=PAR(1) | |
60 | DX2=PAR(2) | |
61 | DY1=PAR(3) | |
62 | DY2=DY1 | |
63 | DZ=PAR(4) | |
64 | GO TO 1000 | |
65 | C | |
66 | 300 IF (ISHAPE.NE.3) GO TO 400 | |
67 | C | |
68 | C TRD2 | |
69 | C | |
70 | DX1=PAR(1) | |
71 | DX2=PAR(2) | |
72 | DY1=PAR(3) | |
73 | DY2=PAR(4) | |
74 | DZ=PAR(5) | |
75 | GO TO 1000 | |
76 | C | |
77 | 400 IF (ISHAPE.NE.4) GO TO 500 | |
78 | C | |
79 | C TRAP | |
80 | C | |
81 | DZ=PAR(1) | |
82 | TX=PAR(2) | |
83 | TY=PAR(3) | |
84 | H1=PAR(4) | |
85 | BL1=PAR(5) | |
86 | TL1=PAR(6) | |
87 | TTH1=PAR(7) | |
88 | H2=PAR(8) | |
89 | BL2=PAR(9) | |
90 | TL2=PAR(10) | |
91 | TTH2=PAR(11) | |
92 | GO TO 1500 | |
93 | C | |
94 | 500 IF (ISHAPE.NE.5) GO TO 600 | |
95 | C | |
96 | C TUBE | |
97 | C | |
98 | RMIN1=PAR(1) | |
99 | RMAX1=PAR(2) | |
100 | RMIN2=RMIN1 | |
101 | RMAX2=RMAX1 | |
102 | Z2=PAR(3) | |
103 | Z1=-Z2 | |
104 | GO TO 2000 | |
105 | C | |
106 | 600 IF (ISHAPE.NE.6) GO TO 700 | |
107 | C | |
108 | C TUBS | |
109 | C | |
110 | RMIN1=PAR(1) | |
111 | RMAX1=PAR(2) | |
112 | RMIN2=RMIN1 | |
113 | RMAX2=RMAX1 | |
114 | Z2=PAR(3) | |
115 | Z1=-Z2 | |
116 | PHIMIN=PAR(4) | |
117 | PHIMAX=PAR(5) | |
118 | GO TO 2500 | |
119 | C | |
120 | 700 IF (ISHAPE.NE.7) GO TO 800 | |
121 | C | |
122 | C CONE | |
123 | C | |
124 | RMIN1=PAR(2) | |
125 | RMAX1=PAR(3) | |
126 | RMIN2=PAR(4) | |
127 | RMAX2=PAR(5) | |
128 | Z2=PAR(1) | |
129 | Z1=-Z2 | |
130 | GO TO 2000 | |
131 | C | |
132 | 800 IF (ISHAPE.NE.8) GO TO 900 | |
133 | C | |
134 | C CONS | |
135 | C | |
136 | RMIN1=PAR(2) | |
137 | RMAX1=PAR(3) | |
138 | RMIN2=PAR(4) | |
139 | RMAX2=PAR(5) | |
140 | Z2=PAR(1) | |
141 | Z1=-Z2 | |
142 | PHIMIN=PAR(6) | |
143 | PHIMAX=PAR(7) | |
144 | GO TO 2500 | |
145 | C | |
146 | 900 IF (ISHAPE.NE.9) GO TO 910 | |
147 | C | |
148 | C SPHE | |
149 | C | |
150 | RMIN=PAR(1) | |
151 | RMAX=PAR(2) | |
152 | GO TO 3000 | |
153 | C | |
154 | 910 IF (ISHAPE.NE.10) GO TO 911 | |
155 | C | |
156 | C PARA | |
157 | C | |
158 | DX=PAR(1) | |
159 | DY=PAR(2) | |
160 | DZ=PAR(3) | |
161 | TXY=PAR(4) | |
162 | TXZ=PAR(5) | |
163 | TYZ=PAR(6) | |
164 | C | |
165 | TX=TXZ | |
166 | TY=TYZ | |
167 | H1=DY | |
168 | BL1=DX | |
169 | TL1=DX | |
170 | TTH1=TXY | |
171 | H2=DY | |
172 | BL2=DX | |
173 | TL2=DX | |
174 | TTH2=TXY | |
175 | GO TO 1500 | |
176 | C | |
177 | 911 IF (ISHAPE.NE.11) GO TO 912 | |
178 | C | |
179 | C PGON | |
180 | C | |
181 | PHIMIN=PAR(1) | |
182 | PHIMAX=PHIMIN+PAR(2) | |
183 | NDIV=PAR(3) | |
184 | NZ=PAR(4) | |
185 | DPHI=(PHIMAX-PHIMIN)/NDIV | |
186 | C | |
187 | C Z(1)=PAR(5) - RMIN(1)=PAR(6) - RMAX(1)=PAR(7) - Z(2)=PAR(8) - ... | |
188 | C | |
189 | GO TO 4000 | |
190 | C | |
191 | 912 IF (ISHAPE.NE.12) GO TO 950 | |
192 | C | |
193 | C PCON | |
194 | C | |
195 | PHIMIN=PAR(1) | |
196 | PHIMAX=PHIMIN+PAR(2) | |
197 | NZ=PAR(3) | |
198 | C | |
199 | C Z(1)=PAR(4) - RMIN(1)=PAR(5) - RMAX(1)=PAR(6) - Z(2)=PAR(7) - ... | |
200 | C | |
201 | GO TO 5000 | |
202 | C | |
203 | 950 CONTINUE | |
204 | C | |
205 | IF (ISHAPE.NE.13) GO TO 951 | |
206 | C | |
207 | C ELTU | |
208 | C | |
209 | A=PAR(1) | |
210 | B=PAR(2) | |
211 | Z2=PAR(3) | |
212 | Z1=-Z2 | |
213 | GO TO 7000 | |
214 | 951 CONTINUE | |
215 | C | |
216 | IF (ISHAPE.NE.14) GO TO 955 | |
217 | C | |
218 | C HYPErboloid | |
219 | C | |
220 | RMIN1 = PAR(1) | |
221 | RMAX1 = PAR(2) | |
222 | Z2=PAR(3) | |
223 | TANTHS = (TAN(PAR(4)*DEGRAD))**2 | |
224 | RMIN12 = RMIN1*RMIN1 | |
225 | RMAX12 = RMAX1*RMAX1 | |
226 | RMIN2 = SQRT(RMIN12 + Z2*Z2*TANTHS) | |
227 | RMAX2 = SQRT(RMAX12 + Z2*Z2*TANTHS) | |
228 | Z1=-Z2 | |
229 | GO TO 7350 | |
230 | ||
231 | 955 CONTINUE | |
232 | IF(ISHAPE.NE.28) GO TO 980 | |
233 | C | |
234 | C General twisted trapezoid. | |
235 | C | |
236 | DO 970 IL=1,4 | |
237 | I0=IL*4+11 | |
238 | P(3,IL)=-PAR(1) | |
239 | P(1,IL)=PAR(I0)+PAR(I0+2)*P(3,IL) | |
240 | P(2,IL)=PAR(I0+1)+PAR(I0+3)*P(3,IL) | |
241 | P(3,IL+4)=PAR(1) | |
242 | P(1,IL+4)=PAR(I0)+PAR(I0+2)*P(3,IL+4) | |
243 | P(2,IL+4)=PAR(I0+1)+PAR(I0+3)*P(3,IL+4) | |
244 | 970 CONTINUE | |
245 | C | |
246 | GO TO 1600 | |
247 | * | |
248 | 980 CONTINUE | |
249 | IF( ISHAPE .EQ. NSCTUB ) THEN | |
250 | * | |
251 | DPHIS = PAR(5)-PAR(4) | |
252 | IF( DPHIS .LE. 0.0 ) DPHIS=DPHIS+TWOPI | |
253 | NL = DPHIS*NLPC/360.0 | |
254 | DPHI = 360.0/NLPC | |
255 | PHIS = PAR(4) | |
256 | IF( PAR(4) .EQ. 0.0 .AND. PAR(5) .EQ. 360.0 ) THEN | |
257 | ISEG = 0 | |
258 | ELSE | |
259 | ISEG = 1 | |
260 | DPHI = DPHIS/NL | |
261 | ENDIF | |
262 | * | |
263 | GO TO 6000 | |
264 | * | |
265 | ELSE | |
266 | GO TO 9999 | |
267 | ENDIF | |
268 | C | |
269 | 1000 CONTINUE | |
270 | C | |
271 | C Rectilinear shapes: BOX,TRD1,TRD2 | |
272 | C | |
273 | X1=0. | |
274 | Y1=0. | |
275 | X2=0. | |
276 | Y2=0. | |
277 | Z1=-DZ | |
278 | Z2=DZ | |
279 | C | |
280 | C Calculate the 8 vertex for rectilinear shapes | |
281 | C | |
282 | P(1,1)=X1+DX1 | |
283 | P(2,1)=Y1+DY1 | |
284 | P(3,1)=Z1 | |
285 | P(1,2)=X1-DX1 | |
286 | P(2,2)=Y1+DY1 | |
287 | P(3,2)=Z1 | |
288 | P(1,3)=X1-DX1 | |
289 | P(2,3)=Y1-DY1 | |
290 | P(3,3)=Z1 | |
291 | P(1,4)=X1+DX1 | |
292 | P(2,4)=Y1-DY1 | |
293 | P(3,4)=Z1 | |
294 | P(1,5)=X2+DX2 | |
295 | P(2,5)=Y2+DY2 | |
296 | P(3,5)=Z2 | |
297 | P(1,6)=X2-DX2 | |
298 | P(2,6)=Y2+DY2 | |
299 | P(3,6)=Z2 | |
300 | P(1,7)=X2-DX2 | |
301 | P(2,7)=Y2-DY2 | |
302 | P(3,7)=Z2 | |
303 | P(1,8)=X2+DX2 | |
304 | P(2,8)=Y2-DY2 | |
305 | P(3,8)=Z2 | |
306 | C | |
307 | 1600 CONTINUE | |
308 | C | |
309 | C Store all the surfaces (back,front,top,bottom,right,left) | |
310 | C | |
311 | CALL GDSSUR(P(1,1),P(1,2),P(1,3),P(1,4)) | |
312 | CALL GDSSUR(P(1,5),P(1,6),P(1,7),P(1,8)) | |
313 | CALL GDSSUR(P(1,5),P(1,1),P(1,2),P(1,6)) | |
314 | CALL GDSSUR(P(1,8),P(1,4),P(1,3),P(1,7)) | |
315 | CALL GDSSUR(P(1,5),P(1,1),P(1,4),P(1,8)) | |
316 | CALL GDSSUR(P(1,6),P(1,2),P(1,3),P(1,7)) | |
317 | C | |
318 | C Intersect cut-plane with all the surfaces of the shape | |
319 | C and draw the resulting lines | |
320 | C | |
321 | CALL GDCUT | |
322 | C | |
323 | GO TO 9999 | |
324 | C | |
325 | 1500 CONTINUE | |
326 | C | |
327 | C TRAP or PARA | |
328 | C | |
329 | C Calculate the 8 vertex | |
330 | C | |
331 | P(1,1)=-DZ*TX+TTH1*H1+TL1 | |
332 | P(2,1)=+H1-DZ*TY | |
333 | P(3,1)=-DZ | |
334 | P(1,2)=-DZ*TX+TTH1*H1-TL1 | |
335 | P(2,2)=+H1-DZ*TY | |
336 | P(3,2)=-DZ | |
337 | P(1,3)=-DZ*TX-TTH1*H1-BL1 | |
338 | P(2,3)=-H1-DZ*TY | |
339 | P(3,3)=-DZ | |
340 | P(1,4)=-DZ*TX-TTH1*H1+BL1 | |
341 | P(2,4)=-H1-DZ*TY | |
342 | P(3,4)=-DZ | |
343 | P(1,5)=+DZ*TX+TTH2*H2+TL2 | |
344 | P(2,5)=+H2+DZ*TY | |
345 | P(3,5)=+DZ | |
346 | P(1,6)=+DZ*TX+TTH2*H2-TL2 | |
347 | P(2,6)=+H2+DZ*TY | |
348 | P(3,6)=+DZ | |
349 | P(1,7)=+DZ*TX-TTH2*H2-BL2 | |
350 | P(2,7)=-H2+DZ*TY | |
351 | P(3,7)=+DZ | |
352 | P(1,8)=+DZ*TX-TTH2*H2+BL2 | |
353 | P(2,8)=-H2+DZ*TY | |
354 | P(3,8)=+DZ | |
355 | C | |
356 | C Store all the surfaces (back,front,top,bottom,right,left) | |
357 | C | |
358 | CALL GDSSUR(P(1,1),P(1,2),P(1,3),P(1,4)) | |
359 | CALL GDSSUR(P(1,5),P(1,6),P(1,7),P(1,8)) | |
360 | CALL GDSSUR(P(1,5),P(1,1),P(1,2),P(1,6)) | |
361 | CALL GDSSUR(P(1,8),P(1,4),P(1,3),P(1,7)) | |
362 | CALL GDSSUR(P(1,5),P(1,1),P(1,4),P(1,8)) | |
363 | CALL GDSSUR(P(1,6),P(1,2),P(1,3),P(1,7)) | |
364 | C | |
365 | C Intersect cut-plane with all the surfaces of the shape | |
366 | C and draw the resulting lines | |
367 | C | |
368 | CALL GDCUT | |
369 | C | |
370 | GO TO 9999 | |
371 | C | |
372 | 2000 CONTINUE | |
373 | C | |
374 | C Cylindric shapes: TUBE,CONE | |
375 | C | |
376 | DO 2100 I=1,40 | |
377 | C | |
378 | P(1,1)=RMAX1*GCOS(I) | |
379 | P(2,1)=RMAX1*GSIN(I) | |
380 | P(3,1)=Z1 | |
381 | P(1,2)=RMAX1*GCOS(I+1) | |
382 | P(2,2)=RMAX1*GSIN(I+1) | |
383 | P(3,2)=Z1 | |
384 | P(1,3)=RMIN1*GCOS(I+1) | |
385 | P(2,3)=RMIN1*GSIN(I+1) | |
386 | P(3,3)=Z1 | |
387 | P(1,4)=RMIN1*GCOS(I) | |
388 | P(2,4)=RMIN1*GSIN(I) | |
389 | P(3,4)=Z1 | |
390 | P(1,5)=RMAX2*GCOS(I) | |
391 | P(2,5)=RMAX2*GSIN(I) | |
392 | P(3,5)=Z2 | |
393 | P(1,6)=RMAX2*GCOS(I+1) | |
394 | P(2,6)=RMAX2*GSIN(I+1) | |
395 | P(3,6)=Z2 | |
396 | P(1,7)=RMIN2*GCOS(I+1) | |
397 | P(2,7)=RMIN2*GSIN(I+1) | |
398 | P(3,7)=Z2 | |
399 | P(1,8)=RMIN2*GCOS(I) | |
400 | P(2,8)=RMIN2*GSIN(I) | |
401 | P(3,8)=Z2 | |
402 | C | |
403 | C Store top,bottom,back,front surfaces | |
404 | C | |
405 | CALL GDSSUR(P(1,1),P(1,2),P(1,6),P(1,5)) | |
406 | CALL GDSSUR(P(1,4),P(1,3),P(1,7),P(1,8)) | |
407 | CALL GDSSUR(P(1,1),P(1,2),P(1,3),P(1,4)) | |
408 | CALL GDSSUR(P(1,5),P(1,6),P(1,7),P(1,8)) | |
409 | C | |
410 | 2100 CONTINUE | |
411 | C | |
412 | C Intersect cut-plane with all the surfaces of the shape | |
413 | C and draw the resulting lines | |
414 | C | |
415 | CALL GDCUT | |
416 | C | |
417 | GO TO 9999 | |
418 | C | |
419 | 2500 CONTINUE | |
420 | C | |
421 | C Segmented cylindric shapes: TUBS,CONS | |
422 | C | |
423 | CALL GDSARC(RMAX1,PHIMIN,PHIMAX,XMAX1,NP) | |
424 | CALL GDSARC(RMIN1,PHIMIN,PHIMAX,XMIN1,NP) | |
425 | CALL GDSARC(RMAX2,PHIMIN,PHIMAX,XMAX2,NP) | |
426 | CALL GDSARC(RMIN2,PHIMIN,PHIMAX,XMIN2,NP) | |
427 | C | |
428 | NP1=NP-1 | |
429 | C | |
430 | DO 2510 I=1,NP1 | |
431 | C | |
432 | P(1,1)=XMAX1(1,I) | |
433 | P(2,1)=XMAX1(2,I) | |
434 | P(3,1)=Z1 | |
435 | P(1,2)=XMAX1(1,I+1) | |
436 | P(2,2)=XMAX1(2,I+1) | |
437 | P(3,2)=Z1 | |
438 | P(1,3)=XMIN1(1,I+1) | |
439 | P(2,3)=XMIN1(2,I+1) | |
440 | P(3,3)=Z1 | |
441 | P(1,4)=XMIN1(1,I) | |
442 | P(2,4)=XMIN1(2,I) | |
443 | P(3,4)=Z1 | |
444 | P(1,5)=XMAX2(1,I) | |
445 | P(2,5)=XMAX2(2,I) | |
446 | P(3,5)=Z2 | |
447 | P(1,6)=XMAX2(1,I+1) | |
448 | P(2,6)=XMAX2(2,I+1) | |
449 | P(3,6)=Z2 | |
450 | P(1,7)=XMIN2(1,I+1) | |
451 | P(2,7)=XMIN2(2,I+1) | |
452 | P(3,7)=Z2 | |
453 | P(1,8)=XMIN2(1,I) | |
454 | P(2,8)=XMIN2(2,I) | |
455 | P(3,8)=Z2 | |
456 | C | |
457 | C Store top,bottom,back,front surfaces | |
458 | C | |
459 | CALL GDSSUR(P(1,1),P(1,2),P(1,6),P(1,5)) | |
460 | CALL GDSSUR(P(1,4),P(1,3),P(1,7),P(1,8)) | |
461 | CALL GDSSUR(P(1,1),P(1,2),P(1,3),P(1,4)) | |
462 | CALL GDSSUR(P(1,5),P(1,6),P(1,7),P(1,8)) | |
463 | C | |
464 | C Store right surface | |
465 | C | |
466 | IF (I.NE.1) GO TO 2505 | |
467 | CALL GDSSUR(P(1,5),P(1,1),P(1,4),P(1,8)) | |
468 | C | |
469 | C Store left surface | |
470 | C | |
471 | 2505 CONTINUE | |
472 | IF (I.NE.NP1) GO TO 2510 | |
473 | CALL GDSSUR(P(1,6),P(1,2),P(1,3),P(1,7)) | |
474 | C | |
475 | 2510 CONTINUE | |
476 | C | |
477 | C Intersect cut-plane with all the surfaces of the shape | |
478 | C and draw the resulting lines | |
479 | C | |
480 | CALL GDCUT | |
481 | C | |
482 | GO TO 9999 | |
483 | C | |
484 | 3000 CONTINUE | |
485 | C | |
486 | C Normal view or X-view or Y-view or Z-view for SPHE | |
487 | C | |
488 | C Cut not implemented | |
489 | C | |
490 | GO TO 9999 | |
491 | C | |
492 | 4000 CONTINUE | |
493 | C | |
494 | C PGON | |
495 | C | |
496 | FACT=1./COS(DEGRAD*DPHI/2.) | |
497 | DO 4002 IZ=1,NZ | |
498 | PAR(6+(IZ-1)*3)=PAR(6+(IZ-1)*3)*FACT | |
499 | PAR(7+(IZ-1)*3)=PAR(7+(IZ-1)*3)*FACT | |
500 | 4002 CONTINUE | |
501 | C | |
502 | NZ1=NZ-1 | |
503 | C | |
504 | DO 4050 IZ=1,NZ1 | |
505 | C | |
506 | ZI=PAR(5+(IZ-1)*3) | |
507 | R0=PAR(6+(IZ-1)*3) | |
508 | R1=PAR(7+(IZ-1)*3) | |
509 | ZZI=PAR(5+IZ*3) | |
510 | RR0=PAR(6+IZ*3) | |
511 | RR1=PAR(7+IZ*3) | |
512 | C | |
513 | DO 4045 IDIV=1,NDIV | |
514 | C | |
515 | PHI0=PHIMIN+(IDIV-1)*DPHI | |
516 | PHI1=PHI0+DPHI | |
517 | PHI0=PHI0*DEGRAD | |
518 | PHI1=PHI1*DEGRAD | |
519 | C | |
520 | P(1,1)=R1*COS(PHI0) | |
521 | P(2,1)=R1*SIN(PHI0) | |
522 | P(3,1)=ZI | |
523 | P(1,2)=R1*COS(PHI1) | |
524 | P(2,2)=R1*SIN(PHI1) | |
525 | P(3,2)=ZI | |
526 | P(1,3)=R0*COS(PHI1) | |
527 | P(2,3)=R0*SIN(PHI1) | |
528 | P(3,3)=ZI | |
529 | P(1,4)=R0*COS(PHI0) | |
530 | P(2,4)=R0*SIN(PHI0) | |
531 | P(3,4)=ZI | |
532 | P(1,5)=RR1*COS(PHI0) | |
533 | P(2,5)=RR1*SIN(PHI0) | |
534 | P(3,5)=ZZI | |
535 | P(1,6)=RR1*COS(PHI1) | |
536 | P(2,6)=RR1*SIN(PHI1) | |
537 | P(3,6)=ZZI | |
538 | P(1,7)=RR0*COS(PHI1) | |
539 | P(2,7)=RR0*SIN(PHI1) | |
540 | P(3,7)=ZZI | |
541 | P(1,8)=RR0*COS(PHI0) | |
542 | P(2,8)=RR0*SIN(PHI0) | |
543 | P(3,8)=ZZI | |
544 | C | |
545 | C Store top and bottom surfaces | |
546 | C | |
547 | CALL GDSSUR(P(1,1),P(1,2),P(1,6),P(1,5)) | |
548 | CALL GDSSUR(P(1,4),P(1,3),P(1,7),P(1,8)) | |
549 | C | |
550 | C Store back surface | |
551 | C | |
552 | IF (IZ.NE.1) GO TO 4010 | |
553 | CALL GDSSUR(P(1,1),P(1,2),P(1,3),P(1,4)) | |
554 | C | |
555 | C Store front surface | |
556 | C | |
557 | 4010 CONTINUE | |
558 | IF (IZ.NE.NZ1) GO TO 4020 | |
559 | CALL GDSSUR(P(1,5),P(1,6),P(1,7),P(1,8)) | |
560 | C | |
561 | C Store right surface | |
562 | C | |
563 | 4020 CONTINUE | |
564 | IF (ABS(PHIMAX-PHIMIN).EQ.360.) GO TO 4045 | |
565 | IF (IDIV.NE.1) GO TO 4030 | |
566 | CALL GDSSUR(P(1,5),P(1,1),P(1,4),P(1,8)) | |
567 | C | |
568 | C Store left surface | |
569 | C | |
570 | 4030 CONTINUE | |
571 | IF (IDIV.NE.NDIV) GO TO 4045 | |
572 | CALL GDSSUR(P(1,6),P(1,2),P(1,3),P(1,7)) | |
573 | C | |
574 | 4045 CONTINUE | |
575 | C | |
576 | C Intersect cut-plane with the surfaces of one Z section | |
577 | C and draw the resulting lines | |
578 | C | |
579 | CALL GDCUT | |
580 | C | |
581 | 4050 CONTINUE | |
582 | C | |
583 | GO TO 9999 | |
584 | C | |
585 | 5000 CONTINUE | |
586 | C | |
587 | C PCON | |
588 | C | |
589 | NZ1=NZ-1 | |
590 | C | |
591 | DO 5050 IZ=1,NZ1 | |
592 | C | |
593 | ZI=PAR(4+(IZ-1)*3) | |
594 | R0=PAR(5+(IZ-1)*3) | |
595 | R1=PAR(6+(IZ-1)*3) | |
596 | ZZI=PAR(4+IZ*3) | |
597 | RR0=PAR(5+IZ*3) | |
598 | RR1=PAR(6+IZ*3) | |
599 | C | |
600 | CALL GDSARC(R1,PHIMIN,PHIMAX,XMAX1,NP) | |
601 | CALL GDSARC(R0,PHIMIN,PHIMAX,XMIN1,NP) | |
602 | CALL GDSARC(RR1,PHIMIN,PHIMAX,XMAX2,NP) | |
603 | CALL GDSARC(RR0,PHIMIN,PHIMAX,XMIN2,NP) | |
604 | NDIV=NP-1 | |
605 | C | |
606 | DO 5005 IDIV=1,NDIV | |
607 | C | |
608 | P(1,1)=XMAX1(1,IDIV) | |
609 | P(2,1)=XMAX1(2,IDIV) | |
610 | P(3,1)=ZI | |
611 | P(1,2)=XMAX1(1,IDIV+1) | |
612 | P(2,2)=XMAX1(2,IDIV+1) | |
613 | P(3,2)=ZI | |
614 | P(1,3)=XMIN1(1,IDIV+1) | |
615 | P(2,3)=XMIN1(2,IDIV+1) | |
616 | P(3,3)=ZI | |
617 | P(1,4)=XMIN1(1,IDIV) | |
618 | P(2,4)=XMIN1(2,IDIV) | |
619 | P(3,4)=ZI | |
620 | P(1,5)=XMAX2(1,IDIV) | |
621 | P(2,5)=XMAX2(2,IDIV) | |
622 | P(3,5)=ZZI | |
623 | P(1,6)=XMAX2(1,IDIV+1) | |
624 | P(2,6)=XMAX2(2,IDIV+1) | |
625 | P(3,6)=ZZI | |
626 | P(1,7)=XMIN2(1,IDIV+1) | |
627 | P(2,7)=XMIN2(2,IDIV+1) | |
628 | P(3,7)=ZZI | |
629 | P(1,8)=XMIN2(1,IDIV) | |
630 | P(2,8)=XMIN2(2,IDIV) | |
631 | P(3,8)=ZZI | |
632 | C | |
633 | C Store top and bottom surfaces | |
634 | C | |
635 | CALL GDSSUR(P(1,1),P(1,2),P(1,6),P(1,5)) | |
636 | CALL GDSSUR(P(1,4),P(1,3),P(1,7),P(1,8)) | |
637 | C | |
638 | C Store back surface | |
639 | C | |
640 | IF (IZ.NE.1) GO TO 5001 | |
641 | CALL GDSSUR(P(1,1),P(1,2),P(1,3),P(1,4)) | |
642 | C | |
643 | C Store front surface | |
644 | C | |
645 | 5001 CONTINUE | |
646 | IF (IZ.NE.NZ1) GO TO 5002 | |
647 | CALL GDSSUR(P(1,5),P(1,6),P(1,7),P(1,8)) | |
648 | C | |
649 | C Store right surface | |
650 | C | |
651 | 5002 CONTINUE | |
652 | IF (ABS(PHIMAX-PHIMIN).EQ.360.) GO TO 5005 | |
653 | IF (IDIV.NE.1) GO TO 5003 | |
654 | CALL GDSSUR(P(1,5),P(1,1),P(1,4),P(1,8)) | |
655 | C | |
656 | C Store left surface | |
657 | C | |
658 | 5003 CONTINUE | |
659 | IF (IDIV.NE.NDIV) GO TO 5005 | |
660 | CALL GDSSUR(P(1,6),P(1,2),P(1,3),P(1,7)) | |
661 | C | |
662 | 5005 CONTINUE | |
663 | C | |
664 | C Intersect cut-plane with the surfaces of one Z section | |
665 | C and draw the resulting lines | |
666 | C | |
667 | CALL GDCUT | |
668 | C | |
669 | 5050 CONTINUE | |
670 | C | |
671 | GO TO 9999 | |
672 | * | |
673 | 6000 CONTINUE | |
674 | * | |
675 | * Cut tube shape. | |
676 | * | |
677 | CPHIS = COS( PHIS*DEGRAD ) | |
678 | SPHIS = SIN( PHIS*DEGRAD ) | |
679 | P( 1, 1) = PAR(2)*CPHIS | |
680 | P( 2, 1) = PAR(2)*SPHIS | |
681 | P( 3, 1) = -( PAR( 6)*P( 1, 1) +PAR( 7)*P( 2, 1) )/PAR( 8) | |
682 | + -PAR( 3) | |
683 | P( 1, 4) = PAR(1)*CPHIS | |
684 | P( 2, 4) = PAR(1)*SPHIS | |
685 | P( 3, 4) = -( PAR( 6)*P( 1, 4) +PAR( 7)*P( 2, 4) )/PAR( 8) | |
686 | + -PAR( 3) | |
687 | P( 1, 5) = PAR(2)*CPHIS | |
688 | P( 2, 5) = PAR(2)*SPHIS | |
689 | P( 3, 5) = -( PAR( 9)*P( 1, 5) +PAR( 10)*P( 2, 5) )/PAR( 11) | |
690 | + +PAR( 3) | |
691 | P( 1, 8) = PAR(1)*CPHIS | |
692 | P( 2, 8) = PAR(1)*SPHIS | |
693 | P( 3, 8) = -( PAR( 9)*P( 1, 8) +PAR( 10)*P( 2, 8) )/PAR( 11) | |
694 | + +PAR( 3) | |
695 | * | |
696 | DO 6010 I = 1, NL | |
697 | PHIS = PHIS+DPHI | |
698 | CPHIS = COS( PHIS*DEGRAD ) | |
699 | SPHIS = SIN( PHIS*DEGRAD ) | |
700 | P( 1, 2) = PAR(2)*CPHIS | |
701 | P( 2, 2) = PAR(2)*SPHIS | |
702 | P( 3, 2) = -( PAR( 6)*P( 1, 1) +PAR( 7)*P( 2, 1) )/PAR( 8) | |
703 | + -PAR( 3) | |
704 | P( 1, 3) = PAR(1)*CPHIS | |
705 | P( 2, 3) = PAR(1)*SPHIS | |
706 | P( 3, 3) = -( PAR( 6)*P( 1, 4) +PAR( 7)*P( 2, 4) )/PAR( 8) | |
707 | + -PAR( 3) | |
708 | P( 1, 6) = PAR(2)*CPHIS | |
709 | P( 2, 6) = PAR(2)*SPHIS | |
710 | P( 3, 6) = -( PAR( 9)*P( 1, 5) +PAR( 10)*P( 2, 5) )/PAR( 11) | |
711 | + +PAR( 3) | |
712 | P( 1, 7) = PAR(1)*CPHIS | |
713 | P( 2, 7) = PAR(1)*SPHIS | |
714 | P( 3, 7) = -( PAR( 9)*P( 1, 8) +PAR( 10)*P( 2, 8) )/PAR( 11) | |
715 | + +PAR( 3) | |
716 | * | |
717 | CALL GDSSUR( P(1,1), P(1,2), P(1,6), P(1,5) ) | |
718 | CALL GDSSUR( P(1,4), P(1,3), P(1,7), P(1,8) ) | |
719 | CALL GDSSUR( P(1,1), P(1,2), P(1,3), P(1,4) ) | |
720 | CALL GDSSUR( P(1,5), P(1,6), P(1,7), P(1,8) ) | |
721 | * | |
722 | IF( ISEG .EQ. 1 ) THEN | |
723 | IF( I .EQ. 1 ) THEN | |
724 | CALL GDSSUR( P(1,5), P(1,1), P(1,4), P(1,8) ) | |
725 | ELSEIF ( I .EQ. NL ) THEN | |
726 | CALL GDSSUR( P(1,6), P(1,2), P(1,3), P(1,7) ) | |
727 | ENDIF | |
728 | ENDIF | |
729 | * | |
730 | P( 1, 1) = P( 1, 2) | |
731 | P( 2, 1) = P( 2, 2) | |
732 | P( 3, 1) = P( 3, 2) | |
733 | P( 1, 4) = P( 1, 3) | |
734 | P( 2, 4) = P( 2, 3) | |
735 | P( 3, 4) = P( 3, 3) | |
736 | P( 1, 5) = P( 1, 6) | |
737 | P( 2, 5) = P( 2, 6) | |
738 | P( 3, 5) = P( 3, 6) | |
739 | P( 1, 8) = P( 1, 7) | |
740 | P( 2, 8) = P( 2, 7) | |
741 | P( 3, 8) = P( 3, 7) | |
742 | * | |
743 | 6010 CONTINUE | |
744 | * | |
745 | CALL GDCUT | |
746 | GO TO 9999 | |
747 | * | |
748 | 7000 CONTINUE | |
749 | C | |
750 | C ELTU | |
751 | C | |
752 | DO 7010 I=1,40 | |
753 | C | |
754 | P(1,1)=A*GCOS(I) | |
755 | P(2,1)=B*GSIN(I) | |
756 | P(3,1)=Z1 | |
757 | P(1,2)=A*GCOS(I+1) | |
758 | P(2,2)=B*GSIN(I+1) | |
759 | P(3,2)=Z1 | |
760 | P(1,3)=0. | |
761 | P(2,3)=0. | |
762 | P(3,3)=Z1 | |
763 | P(1,4)=A*GCOS(I) | |
764 | P(2,4)=B*GSIN(I) | |
765 | P(3,4)=Z2 | |
766 | P(1,5)=A*GCOS(I+1) | |
767 | P(2,5)=B*GSIN(I+1) | |
768 | P(3,5)=Z2 | |
769 | P(1,6)=0. | |
770 | P(2,6)=0. | |
771 | P(3,6)=Z2 | |
772 | C | |
773 | C Store top,back,front surfaces | |
774 | C | |
775 | CALL GDSSUR(P(1,1),P(1,2),P(1,5),P(1,4)) | |
776 | CALL GDSSUR(P(1,1),P(1,2),P(1,3),P(1,3)) | |
777 | CALL GDSSUR(P(1,4),P(1,5),P(1,6),P(1,6)) | |
778 | C | |
779 | 7010 CONTINUE | |
780 | C | |
781 | C Intersect cut-plane with all the surfaces of the shape | |
782 | C and draw the resulting lines | |
783 | C | |
784 | CALL GDCUT | |
785 | C | |
786 | GO TO 9999 | |
787 | C | |
788 | * | |
789 | 7350 CONTINUE | |
790 | C | |
791 | C Another cylindrical shape: HYPE | |
792 | C | |
793 | NZSTEP = 40 | |
794 | DZ = Z2 / NZSTEP * 2. | |
795 | RMA1 = SQRT(RMAX12 + Z2*Z2*TANTHS) | |
796 | RMI1 = SQRT(RMIN12 + Z2*Z2*TANTHS) | |
797 | ZZ1 = Z2 | |
798 | DO 7400 J = 1, NZSTEP | |
799 | ZZ2 = Z2 - J*DZ | |
800 | Z2T = (ZZ2**2) * TANTHS | |
801 | RMA2 = SQRT(RMAX12 + Z2T) | |
802 | RMI2 = SQRT(RMIN12 + Z2T) | |
803 | DO 7390 I=1,40 | |
804 | C | |
805 | P(1,1)=RMA1*GCOS(I) | |
806 | P(2,1)=RMA1*GSIN(I) | |
807 | P(3,1)=ZZ1 | |
808 | P(1,2)=RMA1*GCOS(I+1) | |
809 | P(2,2)=RMA1*GSIN(I+1) | |
810 | P(3,2)=ZZ1 | |
811 | P(1,3)=RMI1*GCOS(I+1) | |
812 | P(2,3)=RMI1*GSIN(I+1) | |
813 | P(3,3)=ZZ1 | |
814 | P(1,4)=RMI1*GCOS(I) | |
815 | P(2,4)=RMI1*GSIN(I) | |
816 | P(3,4)=ZZ1 | |
817 | P(1,5)=RMA2*GCOS(I) | |
818 | P(2,5)=RMA2*GSIN(I) | |
819 | P(3,5)=ZZ2 | |
820 | P(1,6)=RMA2*GCOS(I+1) | |
821 | P(2,6)=RMA2*GSIN(I+1) | |
822 | P(3,6)=ZZ2 | |
823 | P(1,7)=RMI2*GCOS(I+1) | |
824 | P(2,7)=RMI2*GSIN(I+1) | |
825 | P(3,7)=ZZ2 | |
826 | P(1,8)=RMI2*GCOS(I) | |
827 | P(2,8)=RMI2*GSIN(I) | |
828 | P(3,8)=ZZ2 | |
829 | C | |
830 | C Store top and bottom surfaces only | |
831 | C | |
832 | CALL GDSSUR(P(1,1),P(1,2),P(1,6),P(1,5)) | |
833 | CALL GDSSUR(P(1,4),P(1,3),P(1,7),P(1,8)) | |
834 | C CALL GDSSUR(P(1,1),P(1,2),P(1,3),P(1,4)) | |
835 | C CALL GDSSUR(P(1,5),P(1,6),P(1,7),P(1,8)) | |
836 | C | |
837 | 7390 CONTINUE | |
838 | C | |
839 | RMA1 = RMA2 | |
840 | RMI1 = RMI2 | |
841 | ZZ1 = ZZ2 | |
842 | C | |
843 | 7400 CONTINUE | |
844 | C | |
845 | C Intersect cut-plane with all the surfaces of the shape | |
846 | C and draw the resulting lines | |
847 | C | |
848 | CALL GDCUT | |
849 | C | |
850 | * | |
851 | 9999 END |