GEANT321/gdraw/gdraws.F

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