GEANT321/geocad/gpcset.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:46  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GPCSET(PAR)
  13 C-
  14 C-   Created  26-JUN-1991   Nils Joar Hoimyr
  15 C-   Modified 21.02.1992  Jouko Vuoskoski
  16 C-   Modified  02.04.92  NJH
  17 C-
  18 C---------------------------------------------------------
  19 #include "geant321/gcsetf.inc"
  20
  21 C
  22       DIMENSION PAR(50)
  23       REAL PHIMIN,PHIMAX,PX,PY,PZ,RMIN,RMAX
  24 C-
  25 C-   Describes a contour face of a PCON shape calculated from the GEANT
  26 C-   PCON shape parameters.  This face is rotated around the
  27 C-   Z-axis to generated the solid shape in SET.
  28 C---------------------------------------------------------
  29 C
  30       PHIMIN=(PAR(1)-90.0)
  31       PHIMAX=(PHIMIN+PAR(2))
  32       NZ=PAR(3)
  33 C        Solid of revolution described by rotation of a face
  34 C        Face defined in the yz-plane (x=0)
  35 C       WRITE SET@103,F1#3,3,2,P1X,P1Y,P1Z,P2X.........
  36 C---------------------------------------------------------
  37 C
  38       WRITE(BLKSTR,10000)N1
  39       CALL GJWRIT
  40 C---------------------------------------------------------
  41       N2= 1
  42       PX= 0.0
  43 C
  44       PY= PAR(5)
  45       PZ= PAR(4)
  46 C---------------------------------------------------------
  47 C
  48       WRITE(BLKSTR,10100)PX,PY,PZ
  49       CALL GJWRIT
  50 C---------------------------------------------------------
  51 C
  52       DO 10  K=1,NZ
  53          N2=N2+3
  54          PY= PAR(N2+2)
  55          PZ= PAR(N2)
  56          RMIN= PAR(N2+1)
  57          RMAX=PAR(N2+2)
  58          IF (RMIN .GE. RMAX) GOTO 10
  59 C
  60 C---------------------------------------------------------
  61 C
  62          WRITE(BLKSTR,10100)PX,PY,PZ
  63          CALL GJWRIT
  64 C---------------------------------------------------------
  65 C
  66    10 CONTINUE
  67 C
  68       DO 20  L=2,NZ
  69          PY= PAR(N2+1)
  70          PZ= PAR(N2)
  71 C
  72 C---------------------------------------------------------
  73 C
  74          WRITE(BLKSTR,10100)PX,PY,PZ
  75          CALL GJWRIT
  76 C---------------------------------------------------------
  77          N2=N2-3
  78    20 CONTINUE
  79 C     WRITE SET @100,N..#144,!F1,PHIMIN,PHIMAX.
  80 C
  81       N1=N1+1
  82       WRITE(BLKSTR,10200)N1,N1-1,PHIMIN,PHIMAX
  83       CALL GJWRIT
  84 C
  85 10000   FORMAT('@103,',I10,',:5,2#3,3,2')
  86 10100   FORMAT(',',G14.7,',',G14.7,',',G14.7)
  87 10200   FORMAT('@100,',I10,',:5,2#144,!',I10,',',G14.7,',',G14.7)
  88 C
  89       END