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