GEANT321/gdraw/gdraws.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:03  fca
   6 * AliRoot sources
   7 *
   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)
  65       DIMENSION PAR(100),P(3,8),PP(3,8)
  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