[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdraws.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:24  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.27  by  S.Giani
*-- Author :
      SUBROUTINE GDRAWS(ISHAPE,PAR)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       Draw the shape number ISHAPE, of parameters PAR          *
C.    *                                                                *
C.    * SHAPE     SHAPE    SHAPE                                       *
C.    * NUMBER    TYPE     PARAMETERS                                  *
C.    * -------------------------------------------------------------- *
C.    *                                                                *
C.    *   1       BOX      DX,DY,DZ                                    *
C.    *   2       TRD1     DX1,DX2,DY,DZ                               *
C.    *   3       TRD2     DX1,DX2,DY1,DY2,DZ                          *
C.    *   4       TRAP     DZ,TX,TY,H1,BL1,TL1,TTH1,H2,BL2,TL2,TTH2    *
C.    *                                                                *
C.    *   5       TUBE     RMIN,RMAX,DZ                                *
C.    *   6       TUBS     RMIN,RMAX,DZ,PHIMIN,PHIMAX                  *
C.    *   7       CONE     DZ,RMIN1,RMAX1,RMIN2,RMAX2                  *
C.    *   8       CONS     DZ,RMIN1,RMAX1,RMIN2,RMAX2,PHIMIN,PHIMAX    *
C.    *                                                                *
C.    *   9       SPHE     RMIN,RMAX,THEMIN,THEMAX,PHIMIN,PHIMAX       *
C.    *                                                                *
C.    *  10       PARA     DX,DY,DZ,TXY,TXZ,TYZ                        *
C.    *  11       PGON     PHIMIN,DPHI,NDIV,NZ,Z(1),RMIN(1),RMAX(1),...*
C.    *  12       PCON     PHIMIN,DPHI,NZ,Z(1),RMIN(1),RMAX(1),Z(2),...*
C.    *  13       ELTU     A,B,DZ                                      *
C.    *  14       HYPE     RMIN,RMAX,DZ,PHI                            *
C.    *  NSGTRA   GTRA     DZ,TH,PHI,TWIST,Y1,XL1,XH1,TH1,Y2,XL2,XH2,..*
C.    *  NSCTUB   CTUB     RMIN,RMAX,DZ,PHIMIN,PHIMAX,LXL,LYL,LZL,LXH,.*
C.    *                                                                *
C.    *    ==>Called by : GDRAW                                        *
C.    *       Author : P.Zanarini   *********                          *
C.    *       Modification log.                                        *
C.    *        1-Jun-88 A.C.McPherson - Introduce cut tube shape.      *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcdraw.inc"
#include "geant321/gconsp.inc"
#include "geant321/gcshno.inc"
*
      PARAMETER ( NLPC = 40 )
*
*            The constant NLPC defined in the parameter statement
*            is the number of line elements to form a complete
*            circle in the surface definitions for a cut tube.
*
      DIMENSION CPHIS(NLPC+1),SPHIS(NLPC+1)
*
      DIMENSION X(3,46), U(46), V(46)
      DIMENSION PAR(50),P(3,8),PP(3,8)
C.
C.    ------------------------------------------------------------------
C.
      IF (ISHAPE.NE.1) GO TO 200
C
C             BOX
C
      DX1=PAR(1)
      DY1=PAR(2)
      DX2=DX1
      DY2=DY1
      DZ=PAR(3)
      GO TO 1000
C
  200 IF (ISHAPE.NE.2) GO TO 300
C
C             TRD1
C
      DX1=PAR(1)
      DX2=PAR(2)
      DY1=PAR(3)
      DY2=DY1
      DZ=PAR(4)
      GO TO 1000
C
  300 IF (ISHAPE.NE.3) GO TO 400
C
C             TRD2
C
      DX1=PAR(1)
      DX2=PAR(2)
      DY1=PAR(3)
      DY2=PAR(4)
      DZ=PAR(5)
      GO TO 1000
C
  400 IF (ISHAPE.NE.4) GO TO 500
C
C             TRAP
C
      DZ=PAR(1)
      TX=PAR(2)
      TY=PAR(3)
      H1=PAR(4)
      BL1=PAR(5)
      TL1=PAR(6)
      TTH1=PAR(7)
      H2=PAR(8)
      BL2=PAR(9)
      TL2=PAR(10)
      TTH2=PAR(11)
      GO TO 1500
C
  500 IF (ISHAPE.NE.5) GO TO 600
C
C             TUBE
C
      RMIN1=PAR(1)
      RMAX1=PAR(2)
      RMIN2=RMIN1
      RMAX2=RMAX1
      Z2=PAR(3)
      Z1=-Z2
      GO TO 2000
C
  600 IF (ISHAPE.NE.6) GO TO 700
C
C             TUBS
C
      RMIN1=PAR(1)
      RMAX1=PAR(2)
      RMIN2=RMIN1
      RMAX2=RMAX1
      Z2=PAR(3)
      Z1=-Z2
      PHIMIN=PAR(4)
      PHIMAX=PAR(5)
      GO TO 2500
C
  700 IF (ISHAPE.NE.7) GO TO 800
C
C             CONE
C
      RMIN1=PAR(2)
      RMAX1=PAR(3)
      RMIN2=PAR(4)
      RMAX2=PAR(5)
      Z2=PAR(1)
      Z1=-Z2
      GO TO 2000
C
  800 IF (ISHAPE.NE.8) GO TO 900
C
C             CONS
C
      RMIN1=PAR(2)
      RMAX1=PAR(3)
      RMIN2=PAR(4)
      RMAX2=PAR(5)
      Z2=PAR(1)
      Z1=-Z2
      PHIMIN=PAR(6)
      PHIMAX=PAR(7)
      GO TO 2500
C
  900 IF (ISHAPE.NE.9) GO TO 910
C
C             SPHE
C
      RMIN=PAR(1)
      RMAX=PAR(2)
      PHMI=PAR(5)
      PHMA=PAR(6)
      GO TO 3000
C
  910 IF (ISHAPE.NE.10) GO TO 911
C
C             PARA
C
      DX=PAR(1)
      DY=PAR(2)
      DZ=PAR(3)
      TXY=PAR(4)
      TXZ=PAR(5)
      TYZ=PAR(6)
C
      TX=TXZ
      TY=TYZ
      H1=DY
      BL1=DX
      TL1=DX
      TTH1=TXY
      H2=DY
      BL2=DX
      TL2=DX
      TTH2=TXY
      GO TO 1500
C
  911 IF (ISHAPE.NE.11) GO TO 912
C
C             PGON
C
      PHIMIN=PAR(1)
      PHIMAX=PHIMIN+PAR(2)
      NDIV=PAR(3)
      NZ=PAR(4)
      DPHI=(PHIMAX-PHIMIN)/NDIV
C
C             Z(1)=PAR(5) - RMIN(1)=PAR(6) - RMAX(1)=PAR(7) - Z(2)=PAR(8) - ...
C
      GO TO 4000
C
  912 IF (ISHAPE.NE.12) GO TO 950
C
C             PCON
C
      PHIMIN=PAR(1)
      PHIMAX=PHIMIN+PAR(2)
      NZ=PAR(3)
C
C             Z(1)=PAR(4) - RMIN(1)=PAR(5) - RMAX(1)=PAR(6) - Z(2)=PAR(7) - ...
C
      GO TO 5000
C
  950 CONTINUE
C
      IF (ISHAPE.NE.13) GO TO 951
C
C             ELTU
C
      A=PAR(1)
      B=PAR(2)
      Z2=PAR(3)
      Z1=-Z2
      GO TO 7000
  951 CONTINUE
C
      IF (ISHAPE.NE.14) GO TO 955
C
C             HYPErboloid
C
      RMIN1 = PAR(1)
      RMAX1 = PAR(2)
      Z2=PAR(3)
      TANTHS = (TAN(PAR(4)*DEGRAD))**2
      RMIN12 = RMIN1*RMIN1
      RMAX12 = RMAX1*RMAX1
      RMIN2 = SQRT(RMIN12 + Z2*Z2*TANTHS)
      RMAX2 = SQRT(RMAX12 + Z2*Z2*TANTHS)
      Z1=-Z2
      GO TO 7410
 
  955 CONTINUE
      IF(ISHAPE.NE.28) GO TO 980
C
C             General twisted trapezoid.
C
      DO 970 IL=1,4
      I0=IL*4+11
      P(3,IL)=-PAR(1)
      P(1,IL)=PAR(I0)+PAR(I0+2)*P(3,IL)
      P(2,IL)=PAR(I0+1)+PAR(I0+3)*P(3,IL)
      P(3,IL+4)=PAR(1)
      P(1,IL+4)=PAR(I0)+PAR(I0+2)*P(3,IL+4)
      P(2,IL+4)=PAR(I0+1)+PAR(I0+3)*P(3,IL+4)
  970 CONTINUE
C
      GO TO 1600
*
  980 CONTINUE
      IF( ISHAPE .EQ. NSCTUB ) THEN
*
        DPHIS = PAR(5)-PAR(4)
        IF( DPHIS .LE. 0.0 ) DPHIS=DPHIS+TWOPI
        NL = MAX(DPHIS*NLPC/360.0,1.)
        DPHI = 360.0/NLPC
        PHIS = PAR(4)
        IF( PAR(4) .EQ. 0.0 .AND. PAR(5) .EQ. 360.0 ) THEN
          ISEG = 0
        ELSE
          ISEG = 1
          DPHI = DPHIS/NL
        ENDIF
*
        GO TO 6000
*
      ELSE
        GO TO 9999
      ENDIF
C
 1000 CONTINUE
C
C             Rectilinear shapes: BOX,TRD1,TRD2
C
      X1=0.
      Y1=0.
      X2=0.
      Y2=0.
      Z1=-DZ
      Z2=DZ
C
C             Calculate the 8 vertex for rectilinear shapes
C
      P(1,1)=X1+DX1
      P(2,1)=Y1+DY1
      P(3,1)=Z1
      P(1,2)=X1-DX1
      P(2,2)=Y1+DY1
      P(3,2)=Z1
      P(1,3)=X1-DX1
      P(2,3)=Y1-DY1
      P(3,3)=Z1
      P(1,4)=X1+DX1
      P(2,4)=Y1-DY1
      P(3,4)=Z1
      P(1,5)=X2+DX2
      P(2,5)=Y2+DY2
      P(3,5)=Z2
      P(1,6)=X2-DX2
      P(2,6)=Y2+DY2
      P(3,6)=Z2
      P(1,7)=X2-DX2
      P(2,7)=Y2-DY2
      P(3,7)=Z2
      P(1,8)=X2+DX2
      P(2,8)=Y2-DY2
      P(3,8)=Z2
C
      CALL GDRECT(P(1,1),P(1,2),P(1,3),P(1,4))
      CALL GDRECT(P(1,5),P(1,6),P(1,7),P(1,8))
      CALL GDLINE(P(1,1),P(1,5))
      CALL GDLINE(P(1,2),P(1,6))
      CALL GDLINE(P(1,3),P(1,7))
      CALL GDLINE(P(1,4),P(1,8))
C
      GO TO 9999
C
 1500 CONTINUE
C
C             TRAP,PARA
C
C             Calculate the 8 vertex
C
      P(1,1)=-DZ*TX+TTH1*H1+TL1
      P(2,1)=+H1-DZ*TY
      P(3,1)=-DZ
      P(1,2)=-DZ*TX+TTH1*H1-TL1
      P(2,2)=+H1-DZ*TY
      P(3,2)=-DZ
      P(1,3)=-DZ*TX-TTH1*H1-BL1
      P(2,3)=-H1-DZ*TY
      P(3,3)=-DZ
      P(1,4)=-DZ*TX-TTH1*H1+BL1
      P(2,4)=-H1-DZ*TY
      P(3,4)=-DZ
      P(1,5)=+DZ*TX+TTH2*H2+TL2
      P(2,5)=+H2+DZ*TY
      P(3,5)=+DZ
      P(1,6)=+DZ*TX+TTH2*H2-TL2
      P(2,6)=+H2+DZ*TY
      P(3,6)=+DZ
      P(1,7)=+DZ*TX-TTH2*H2-BL2
      P(2,7)=-H2+DZ*TY
      P(3,7)=+DZ
      P(1,8)=+DZ*TX-TTH2*H2+BL2
      P(2,8)=-H2+DZ*TY
      P(3,8)=+DZ
C
 1600 CONTINUE
C
      CALL GDRECT(P(1,1),P(1,2),P(1,3),P(1,4))
      CALL GDRECT(P(1,5),P(1,6),P(1,7),P(1,8))
      CALL GDLINE(P(1,1),P(1,5))
      CALL GDLINE(P(1,2),P(1,6))
      CALL GDLINE(P(1,3),P(1,7))
      CALL GDLINE(P(1,4),P(1,8))
C
C             Condition for plane sides are :
C
C             TTH1=TTH2
C
C             and
C
C             H2*(BL1-TL1)=H1(BL2-TL2)
C
C             In that case we should draw on each side 10 lines
C             (perpendicular to side lines) to make an easy
C             visualisation that sides are not planes
C
      GO TO 9999
C
 2000 CONTINUE
C
C             Cylindric shapes: TUBE,CONE
C
      CALL GDCIRC(RMAX1,Z1)
      CALL GDCIRC(RMIN1,Z1)
      CALL GDCIRC(RMAX2,Z2)
      CALL GDCIRC(RMIN2,Z2)
      PHIP=GPHI+90.
      PHIM=GPHI+270.
      CALL GDLCYL(RMIN1,PHIP,Z1,RMIN2,PHIP,Z2)
      CALL GDLCYL(RMIN1,PHIM,Z1,RMIN2,PHIM,Z2)
      CALL GDLCYL(RMAX1,PHIP,Z1,RMAX2,PHIP,Z2)
      CALL GDLCYL(RMAX1,PHIM,Z1,RMAX2,PHIM,Z2)
C
      GO TO 9999
C
 2500 CONTINUE
C
C             Segmented cylindric shapes: TUBS,CONS
C
      CALL GDARC(RMAX1,Z1,PHIMIN,PHIMAX)
      CALL GDARC(RMIN1,Z1,PHIMIN,PHIMAX)
      CALL GDARC(RMAX2,Z2,PHIMIN,PHIMAX)
      CALL GDARC(RMIN2,Z2,PHIMIN,PHIMAX)
      PHIP=AMOD((GPHI+90.),360.)
      PHIM=AMOD((GPHI+270.),360.)
      IF (PHIP.LE.PHIMIN.OR.PHIP.GE.PHIMAX) GO TO 2510
      CALL GDLCYL(RMIN1,PHIP,Z1,RMIN2,PHIP,Z2)
      CALL GDLCYL(RMAX1,PHIP,Z1,RMAX2,PHIP,Z2)
 2510 IF (PHIM.LE.PHIMIN.OR.PHIM.GE.PHIMAX) GO TO 2520
      CALL GDLCYL(RMIN1,PHIM,Z1,RMIN2,PHIM,Z2)
      CALL GDLCYL(RMAX1,PHIM,Z1,RMAX2,PHIM,Z2)
 2520 CALL GDLCYL(RMAX1,PHIMIN,Z1,RMAX2,PHIMIN,Z2)
      CALL GDLCYL(RMAX1,PHIMAX,Z1,RMAX2,PHIMAX,Z2)
      CALL GDLCYL(RMIN1,PHIMIN,Z1,RMIN2,PHIMIN,Z2)
      CALL GDLCYL(RMIN1,PHIMAX,Z1,RMIN2,PHIMAX,Z2)
      CALL GDLCYL(RMAX1,PHIMIN,Z1,RMIN1,PHIMIN,Z1)
      CALL GDLCYL(RMAX2,PHIMIN,Z2,RMIN2,PHIMIN,Z2)
      CALL GDLCYL(RMAX1,PHIMAX,Z1,RMIN1,PHIMAX,Z1)
      CALL GDLCYL(RMAX2,PHIMAX,Z2,RMIN2,PHIMAX,Z2)
C
      GO TO 9999
C
 3000 CONTINUE
C
C             SPHE
C
      CALL GDARC(RMAX,0.,PHMI,PHMA)
      CALL GDARC(RMIN,0.,PHMI,PHMA)
      DP = PHMA-PHMI
      IF(DP.LE.0.) DP=DP+360.
      NSTEP = MAX(DP/15.,1.)
      DDP = DP/NSTEP
      PPH = PHMI-DDP
      DO 3005 I=1,NSTEP+1
      PPH = PPH+DDP
      RPPH = PPH*DEGRAD
      COSPH = COS(RPPH)
      SINPH = SIN(RPPH)
      DO 3004 J=1,46
      THET = (J-1)*PI/45.
      X(1,J) = RMAX*SIN(THET)*COSPH
      X(2,J) = RMAX*SIN(THET)*SINPH
      X(3,J) = RMAX*COS(THET)
 3004 CONTINUE
      CALL GDFR3D(X,46,U,V)
      CALL GDRAWV(U,V,46)
 3005 CONTINUE
      IF(RMIN.GE.0.) THEN
      PPH = PHMI-DDP
      DO 3007 I=1,NSTEP+1
      PPH = PPH+DDP
      RPPH = PPH*DEGRAD
      COSPH = COS(RPPH)
      SINPH = SIN(RPPH)
      DO 3006 J=1,46
      THET = (J-1)*PI/45.
      X(1,J) = RMIN*SIN(THET)*COSPH
      X(2,J) = RMIN*SIN(THET)*SINPH
      X(3,J) = RMIN*COS(THET)
 3006 CONTINUE
      CALL GDFR3D(X,46,U,V)
      CALL GDRAWV(U,V,46)
 3007 CONTINUE
      ENDIF
      DO 3010 I=1,3
      DO 3010 J=1,6
 3010 P(I,J)=0.
      IF(DP.GE.360.) THEN
      P(3,1)=-RMAX
      P(3,2)=RMAX
      P(1,3)=-RMAX
      P(1,4)=RMAX
      P(2,5)=RMAX
      P(2,6)=-RMAX
      CALL GDLINE(P(1,1),P(1,2))
      CALL GDLINE(P(1,3),P(1,4))
      CALL GDLINE(P(1,5),P(1,6))
      ELSE
      P(1,1) = RMIN*COS(PHMI*DEGRAD)
      P(2,1) = RMIN*SIN(PHMI*DEGRAD)
      P(1,2) = RMAX*COS(PHMI*DEGRAD)
      P(2,2) = RMAX*SIN(PHMI*DEGRAD)
      CALL GDLINE(P(1,1),P(1,2))
      P(1,1) = RMIN*COS(PHMA*DEGRAD)
      P(2,1) = RMIN*SIN(PHMA*DEGRAD)
      P(1,2) = RMAX*COS(PHMA*DEGRAD)
      P(2,2) = RMAX*SIN(PHMA*DEGRAD)
      CALL GDLINE(P(1,1),P(1,2))
      P(3,3) = -RMAX
      P(3,4) = -RMIN
      CALL GDLINE(P(1,3),P(1,4))
      P(3,3) =  RMAX
      P(3,4) =  RMIN
      CALL GDLINE(P(1,3),P(1,4))
      ENDIF
      GO TO 9999
C
 4000 CONTINUE
C
C             PGON
C
      FACT=1./COS(DEGRAD*DPHI/2.)
      DO 4002 IZ=1,NZ
        PAR(6+(IZ-1)*3)=PAR(6+(IZ-1)*3)*FACT
        PAR(7+(IZ-1)*3)=PAR(7+(IZ-1)*3)*FACT
 4002 CONTINUE
C
      DO 4050 IZ=1,NZ
C
        ZI=PAR(5+(IZ-1)*3)
        R0=PAR(6+(IZ-1)*3)
        R1=PAR(7+(IZ-1)*3)
C
        IF (IZ.EQ.1.OR.IZ.EQ.NZ) GO TO 4003
        R0PRE=PAR(6+(IZ-2)*3)
        R0POST=PAR(6+IZ*3)
        IF (R0.EQ.R0PRE)GO TO 4006
        IF (R0.EQ.R0POST)GO TO 4006
 4003     CONTINUE
          DO 4005 IDIV=1,NDIV
            PHI0=PHIMIN+(IDIV-1)*DPHI
            PHI1=PHI0+DPHI
            CALL GDLCYL(R0,PHI0,ZI,R0,PHI1,ZI)
 4005     CONTINUE
C
 4006   IF (IZ.EQ.1.OR.IZ.EQ.NZ) GO TO 4008
        R1PRE=PAR(7+(IZ-2)*3)
        R1POST=PAR(7+IZ*3)
        IF (R1.EQ.R1PRE )GO TO 4020
        IF (R1.EQ.R1POST)GO TO 4020
 4008     CONTINUE
          DO 4010 IDIV=1,NDIV
            PHI0=PHIMIN+(IDIV-1)*DPHI
            PHI1=PHI0+DPHI
            CALL GDLCYL(R1,PHI0,ZI,R1,PHI1,ZI)
 4010     CONTINUE
C
 4020   IF ((IZ.EQ.1.OR.IZ.EQ.NZ).AND.(PHIMAX-PHIMIN.NE.360.)) THEN
          CALL GDLCYL(R0,PHIMIN,ZI,R1,PHIMIN,ZI)
          CALL GDLCYL(R0,PHIMAX,ZI,R1,PHIMAX,ZI)
        ENDIF
C
        IF (IZ.EQ.1) GO TO 4050
C
        ZI0=PAR(5+(IZ-2)*3)
        R00=PAR(6+(IZ-2)*3)
        R10=PAR(7+(IZ-2)*3)
        DO 4030 IDIV=1,NDIV
          PH=PHIMIN+(IDIV-1)*DPHI
          CALL GDLCYL(R00,PH,ZI0,R0,PH,ZI)
          CALL GDLCYL(R10,PH,ZI0,R1,PH,ZI)
 4030   CONTINUE
        CALL GDLCYL(R00,PHIMAX,ZI0,R0,PHIMAX,ZI)
        CALL GDLCYL(R10,PHIMAX,ZI0,R1,PHIMAX,ZI)
C
 4050 CONTINUE
C
      GO TO 9999
C
 5000 CONTINUE
C
C             PCON
C
      DO 5555 IZ=1,NZ
        ZI=PAR(4+(IZ-1)*3)
        R0=PAR(5+(IZ-1)*3)
        R1=PAR(6+(IZ-1)*3)
        IF (IZ.EQ.1.OR.IZ.EQ.NZ) GO TO 5010
        R1PRE=PAR(6+(IZ-2)*3)
        R1POST=PAR(6+IZ*3)
        IF (R1.LE.R1PRE.OR.R1.LE.R1POST) GO TO 5015
 5010   CONTINUE
        CALL GDARC(R0,ZI,PHIMIN,PHIMAX)
        CALL GDARC(R1,ZI,PHIMIN,PHIMAX)
 5015   CONTINUE
        IF ((PHIMAX-PHIMIN).EQ.360.) GO TO 5020
        CALL GDLCYL(R0,PHIMIN,ZI,R1,PHIMIN,ZI)
        CALL GDLCYL(R0,PHIMAX,ZI,R1,PHIMAX,ZI)
 5020   CONTINUE
        IF (IZ.EQ.1) GO TO 5555
        ZI0=PAR(4+(IZ-2)*3)
        R00=PAR(5+(IZ-2)*3)
        R10=PAR(6+(IZ-2)*3)
        IF ((PHIMAX-PHIMIN).EQ.360.) GO TO 5030
        CALL GDLCYL(R00,PHIMIN,ZI0,R0,PHIMIN,ZI)
        CALL GDLCYL(R10,PHIMIN,ZI0,R1,PHIMIN,ZI)
        CALL GDLCYL(R00,PHIMAX,ZI0,R0,PHIMAX,ZI)
        CALL GDLCYL(R10,PHIMAX,ZI0,R1,PHIMAX,ZI)
C
 5030   CONTINUE
        PHIP=AMOD((GPHI+90.),360.)
        PHIM=AMOD((GPHI+270.),360.)
        IF (PHIP.LT.PHIMIN.OR.PHIP.GT.PHIMAX) GO TO 5510
        CALL GDLCYL(R00,PHIP,ZI0,R0,PHIP,ZI)
        CALL GDLCYL(R10,PHIP,ZI0,R1,PHIP,ZI)
 5510   IF (PHIM.LT.PHIMIN.OR.PHIM.GT.PHIMAX) GO TO 5555
        CALL GDLCYL(R00,PHIM,ZI0,R0,PHIM,ZI)
        CALL GDLCYL(R10,PHIM,ZI0,R1,PHIM,ZI)
 5555 CONTINUE
C
      GO TO 9999
*
 6000 CONTINUE
*
*          Cut tube shape.
*
      CPHIS(1) = COS( PHIS*DEGRAD )
      SPHIS(1) = SIN( PHIS*DEGRAD )
      DO 6010 I = 1, NL
        PHIS = PHIS+DPHI
        CPHIS(I+1) = COS( PHIS*DEGRAD )
        SPHIS(I+1) = SIN( PHIS*DEGRAD )
 6010 CONTINUE
      P( 1, 1) = PAR(2)*CPHIS(1)
      P( 2, 1) = PAR(2)*SPHIS(1)
      P( 3, 1) = -( PAR( 6)*P( 1, 1) +PAR( 7)*P( 2, 1) )/PAR( 8)
     + -PAR( 3)
      P( 1, 4) = PAR(1)*CPHIS(1)
      P( 2, 4) = PAR(1)*SPHIS(1)
      P( 3, 4) = -( PAR( 6)*P( 1, 4) +PAR( 7)*P( 2, 4) )/PAR( 8)
     + -PAR( 3)
      P( 1, 5) = PAR(2)*CPHIS(1)
      P( 2, 5) = PAR(2)*SPHIS(1)
      P( 3, 5) = -( PAR( 9)*P( 1, 5) +PAR( 10)*P( 2, 5) )/PAR( 11)
     + +PAR( 3)
      P( 1, 8) = PAR(1)*CPHIS(1)
      P( 2, 8) = PAR(1)*SPHIS(1)
      P( 3, 8) = -( PAR( 9)*P( 1, 8) +PAR( 10)*P( 2, 8) )/PAR( 11)
     + +PAR( 3)
*
      IF( ISEG .EQ. 1 ) THEN
        CALL GDRECT( P( 1, 1), P( 1, 4), P( 1, 8), P( 1, 5) )
      ENDIF
*
      DO 6020 I = 1, NL
        P( 1, 2) = PAR(2)*CPHIS(I+1)
        P( 2, 2) = PAR(2)*SPHIS(I+1)
        P( 3, 2) = -( PAR( 6)*P( 1, 2) +PAR( 7)*P( 2, 2) )/PAR( 8)
     +   -PAR( 3)
        CALL GDLINE( P( 1, 1),  P( 1, 2) )
        P( 1, 1) = P( 1, 2)
        P( 2, 1) = P( 2, 2)
        P( 3, 1) = P( 3, 2)
 6020 CONTINUE
*
      DO 6030 I = 1, NL
        P( 1, 3) = PAR(1)*CPHIS(I+1)
        P( 2, 3) = PAR(1)*SPHIS(I+1)
        P( 3, 3) = -( PAR( 6)*P( 1, 3) +PAR( 7)*P( 2, 3) )/PAR( 8)
     +   -PAR( 3)
        CALL GDLINE( P( 1, 4),  P( 1, 3) )
        P( 1, 4) = P( 1, 3)
        P( 2, 4) = P( 2, 3)
        P( 3, 4) = P( 3, 3)
 6030 CONTINUE
*
      DO 6040 I = 1, NL
        P( 1, 6) = PAR(2)*CPHIS(I+1)
        P( 2, 6) = PAR(2)*SPHIS(I+1)
        P( 3, 6) = -( PAR( 9)*P( 1, 6) +PAR( 10)*P( 2, 6) )/PAR( 11)
     +   +PAR( 3)
        CALL GDLINE( P( 1, 5),  P( 1, 6) )
        P( 1, 5) = P( 1, 6)
        P( 2, 5) = P( 2, 6)
        P( 3, 5) = P( 3, 6)
 6040 CONTINUE
*
      DO 6050 I = 1, NL
        P( 1, 7) = PAR(1)*CPHIS(I+1)
        P( 2, 7) = PAR(1)*SPHIS(I+1)
        P( 3, 7) = -( PAR( 9)*P( 1, 7) +PAR( 10)*P( 2, 7) )/PAR( 11)
     +   +PAR( 3)
        CALL GDLINE( P( 1, 8),  P( 1, 7) )
        P( 1, 8) = P( 1, 7)
        P( 2, 8) = P( 2, 7)
        P( 3, 8) = P( 3, 7)
 6050 CONTINUE
*
      IF( ISEG .EQ. 1 ) THEN
        CALL GDRECT( P( 1, 1), P( 1, 4), P( 1, 8), P( 1, 5) )
      ENDIF
*
      PHIP = AMOD( GPHI+90.0, 360.0 )
      PHIM = AMOD( GPHI+270.0, 360.0 )
      DPHIP = PHIP-PAR(4)
      DPHIM = PHIM-PAR(4)
      IF( DPHIP .LT. 0.0 ) DPHIP = DPHIP+TWOPI
      IF( DPHIM .LT. 0.0 ) DPHIM = DPHIM+TWOPI
*
      IF( DPHIP .LE. DPHIS ) THEN
        CP = COS( PHIP*DEGRAD )
        SP = SIN( PHIP*DEGRAD )
        P( 1, 1) = PAR(2)*CP
        P( 2, 1) = PAR(2)*SP
        P( 3, 1) = -( PAR( 6)*P( 1, 1) +PAR( 7)*P( 2, 1) )/PAR( 8)
     +   -PAR( 3)
        P( 1, 4) = PAR(1)*CP
        P( 2, 4) = PAR(1)*SP
        P( 3, 4) = -( PAR( 6)*P( 1, 4) +PAR( 7)*P( 2, 4) )/PAR( 8)
     +   -PAR( 3)
        P( 1, 5) = PAR(2)*CP
        P( 2, 5) = PAR(2)*SP
        P( 3, 5) = -( PAR( 9)*P( 1, 5) +PAR( 10)*P( 2, 5) )/PAR( 11)
     +   +PAR( 3)
        P( 1, 8) = PAR(1)*CP
        P( 2, 8) = PAR(1)*SP
        P( 3, 8) = -( PAR( 9)*P( 1, 8) +PAR( 10)*P( 2, 8) )/PAR( 11)
     +   +PAR( 3)
        CALL GDLINE( P( 1, 1), P( 1, 5) )
        CALL GDLINE( P( 1, 4), P( 1, 8) )
*
      ENDIF
*
      IF( DPHIM .LE. DPHIS ) THEN
        CP = COS( PHIM*DEGRAD )
        SP = SIN( PHIM*DEGRAD )
        P( 1, 1) = PAR(2)*CP
        P( 2, 1) = PAR(2)*SP
        P( 3, 1) = -( PAR( 6)*P( 1, 1) +PAR( 7)*P( 2, 1) )/PAR( 8)
     +   -PAR( 3)
        P( 1, 4) = PAR(1)*CP
        P( 2, 4) = PAR(1)*SP
        P( 3, 4) = -( PAR( 6)*P( 1, 4) +PAR( 7)*P( 2, 4) )/PAR( 8)
     +   -PAR( 3)
        P( 1, 5) = PAR(2)*CP
        P( 2, 5) = PAR(2)*SP
        P( 3, 5) = -( PAR( 9)*P( 1, 5) +PAR( 10)*P( 2, 5) )/PAR( 11)
     +   +PAR( 3)
        P( 1, 8) = PAR(1)*CP
        P( 2, 8) = PAR(1)*SP
        P( 3, 8) = -( PAR( 9)*P( 1, 8) +PAR( 10)*P( 2, 8) )/PAR( 11)
     +   +PAR( 3)
        CALL GDLINE( P( 1, 1), P( 1, 5) )
        CALL GDLINE( P( 1, 4), P( 1, 8) )
*
      ENDIF
      GO TO 9999
C
 7000 CONTINUE
C
C             ELTU
C
      CALL GDELTU(A,B,Z1)
      CALL GDELTU(A,B,Z2)
      P(1,1)=A
      P(2,1)=0.
      P(3,1)=Z1
      P(1,2)=A
      P(2,2)=0.
      P(3,2)=Z2
      P(1,3)=-A
      P(2,3)=0.
      P(3,3)=Z1
      P(1,4)=-A
      P(2,4)=0.
      P(3,4)=Z2
      CALL GDLINE(P(1,1),P(1,2))
      CALL GDLINE(P(1,3),P(1,4))
      GO TO 9999
C                               draw HYPErboloid
 7410 CONTINUE
      PP(2,1) = RMAX2
      PP(2,3) = RMIN2
      P(1,1) = 0.
      P(1,2) = 0.
      P(1,3) = 0.
      P(1,4) = 0.
      PP(3,1) = Z2
      PP(3,3) = Z2
      CALL GDCIRC(RMAX2,Z1)
      CALL GDCIRC(RMIN2,Z1)
      CALL GDCIRC(RMAX2,Z2)
      CALL GDCIRC(RMIN2,Z2)
      NZSTEP = 20
      DELZ = Z2 / NZSTEP
      DO 7440 IZ = 1, NZSTEP
         ZZ = Z2 - IZ*DELZ
         PP(3,2) = ZZ
         PP(3,4) = ZZ
         ZZZ = ZZ*ZZ*TANTHS
         PP(2,2) = SQRT(RMAX12 + ZZZ)
         PP(2,4) = SQRT(RMIN12 + ZZZ)
         DO 7430 ISY = -1, +1, 2
         DO 7430 ISZ = -1, +1, 2
            DO 7420 J = 1, 4
               P(2,J) = ISY * PP(2,J)
               P(3,J) = ISZ * PP(3,J)
 7420       CONTINUE
            CALL GDLINE(P(1,1),P(1,2))
            CALL GDLINE(P(1,3),P(1,4))
 7430    CONTINUE
         PP(2,1) = PP(2,2)
         PP(2,3) = PP(2,4)
         PP(3,1) = PP(3,2)
         PP(3,3) = PP(3,4)
 7440 CONTINUE
C
 9999 END
Commit	Line	Data
fe4da5cc	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 + Z2Z2TANTHS)
251	RMAX2 = SQRT(RMAX12 + Z2Z2TANTHS)
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)=-DZTX+TTH1H1+TL1
347	P(2,1)=+H1-DZ*TY
348	P(3,1)=-DZ
349	P(1,2)=-DZTX+TTH1H1-TL1
350	P(2,2)=+H1-DZ*TY
351	P(3,2)=-DZ
352	P(1,3)=-DZTX-TTH1H1-BL1
353	P(2,3)=-H1-DZ*TY
354	P(3,3)=-DZ
355	P(1,4)=-DZTX-TTH1H1+BL1
356	P(2,4)=-H1-DZ*TY
357	P(3,4)=-DZ
358	P(1,5)=+DZTX+TTH2H2+TL2
359	P(2,5)=+H2+DZ*TY
360	P(3,5)=+DZ
361	P(1,6)=+DZTX+TTH2H2-TL2
362	P(2,6)=+H2+DZ*TY
363	P(3,6)=+DZ
364	P(1,7)=+DZTX-TTH2H2-BL2
365	P(2,7)=-H2+DZ*TY
366	P(3,7)=+DZ
367	P(1,8)=+DZTX-TTH2H2+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) = RMAXSIN(THET)COSPH
457	X(2,J) = RMAXSIN(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) = RMINSIN(THET)COSPH
473	X(2,J) = RMINSIN(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) = RMINCOS(PHMIDEGRAD)
495	P(2,1) = RMINSIN(PHMIDEGRAD)
496	P(1,2) = RMAXCOS(PHMIDEGRAD)
497	P(2,2) = RMAXSIN(PHMIDEGRAD)
498	CALL GDLINE(P(1,1),P(1,2))
499	P(1,1) = RMINCOS(PHMADEGRAD)
500	P(2,1) = RMINSIN(PHMADEGRAD)
501	P(1,2) = RMAXCOS(PHMADEGRAD)
502	P(2,2) = RMAXSIN(PHMADEGRAD)
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 = ZZZZTANTHS
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