GEANT321/gdraw/gdrwsc.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: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 *
  39       DIMENSION PAR(100),P(3,8)
  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