GEANT321/geocad/gpgset.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 GPGSET(PAR)
  13 C-
  14 C-   Created  26-JUN-1991   Nils Joar Hoimyr
  15 C-   Modified 21.02.1992  Jouko Vuoskoski
  16 C-
  17 C---------------------------------------------------------
  18 C- Calculates the sectional face of 1 cell of the PGON shape.   This face is
  19 C- copied and rotated around the Z-axis to make "the other side" of the first
  20 C- cell.  A ruled solid is generated between the 2 faces, to created the cell.
  21 C- The rest of the cells are created by copying and rotation of the first cell.
  22 C- The final result is obtained with a Boolean fusion of the cells.  (The whole
  23 C-  creation history is written to the SET file.)
  24 C----------------------------------------------------------
  25 C
  26 #include "geant321/gcsetf.inc"
  27
  28 C
  29       DIMENSION PAR(50)
  30       REAL PX,PY,PZ,PHIC,PHI1,RMIN,RMAX
  31       REAL R1,R2,R3,R4,R5,R6,R7,R8,R9
  32 C
  33 C----------------------------------------------------------------------
  34 C
  35 C        Calculates range of each cell
  36 C
  37       PHI1= (PAR(1)+180)/180*3.14159265359
  38       NZ= PAR(4)
  39       NPDV= PAR(3)
  40       PHIC= (PAR(2)/PAR(3))/180*3.14159265359
  41 C      Rotation around the Z-axis.  Coeffisients of rotation:
  42       R1= COS(PHI1)
  43       R2= -SIN(PHI1)
  44       R3= 0.0
  45       R4= SIN(PHI1)
  46       R5= COS(PHI1)
  47       R6= 0.0
  48       R7= 0.0
  49       R8= 0.0
  50       R9= 1.0
  51 C      Face defined in the yz-plane (x=0)
  52 C----------------------------------------------------------------------
  53 C
  54       WRITE(BLKSTR,10000)N1
  55       CALL GJWRIT
  56 C---------------------------------------------------------
  57 C   1. Definition point for the face:
  58 C
  59       N3= 2
  60       PX= 0.0
  61 C
  62       PY= PAR(6)
  63       PZ= PAR(5)
  64 C---------------------------------------------------------
  65 C
  66       WRITE(BLKSTR,10100)PX,PY,PZ
  67       CALL GJWRIT
  68 C---------------------------------------------------------
  69 C  Loops over the other definition points:
  70 C
  71       DO 10  K=1,NZ
  72          N3=N3+3
  73          PY= PAR(N3+2)
  74          PZ= PAR(N3)
  75          RMIN= PAR(N3+1)
  76          RMAX= PAR(N3+2)
  77          IF (RMIN .GE. RMAX) GOTO 10
  78 C
  79 C
  80 C---------------------------------------------------------
  81          WRITE(BLKSTR,10100)PX,PY,PZ
  82          CALL GJWRIT
  83 C---------------------------------------------------------
  84 C
  85    10 CONTINUE
  86 C
  87       DO 20  L=2,NZ
  88          PY= PAR(N3+1)
  89          PZ= PAR(N3)
  90 C
  91 C---------------------------------------------------------
  92          WRITE(BLKSTR,10100)PX,PY,PZ
  93          CALL GJWRIT
  94 C----------------------------------------------------------
  95          N3=N3-3
  96    20 CONTINUE
  97 C
  98 C      Geometric Transformation
  99 C*       WRITE SET @302,N1..#301,R1,R2,R3,R4,R5,R6,R7,R8,R9
 100 C
 101       N1=N1+1
 102       NG= N1
 103       WRITE(BLKSTR,10200)N1,R1,R2,R3,R4,R5,R6,R7,R8,R9
 104       CALL GJWRIT
 105 C-------------------------------------------------
 106 C---First FACE:
 107 C*       WRITE SET @113,F2..#101,!F1,N1
 108 C------------------------------------------------
 109 C
 110       N1=N1+1
 111       WRITE(BLKSTR,10300)N1,N1-2,N1-1
 112       CALL GJWRIT
 113 C---------------------------------------------------------
 114 C      Next step is to obtain the right position of the second face to
 115 C      create a cell:
 116 C      Rotation around the Z-axis.  Coeffisients of rotation:
 117       R1= COS(PHIC)
 118       R2= -SIN(PHIC)
 119       R3= 0.0
 120       R4= SIN(PHIC)
 121       R5= COS(PHIC)
 122       R6= 0.0
 123       R7= 0.0
 124       R8= 0.0
 125       R9= 1.0
 126 C
 127 C      Geometric Transformation
 128 C*       WRITE SET @302,N1..#301,R1,R2,R3,R4,R5,R6,R7,R8,R9
 129 C
 130 C------------------------------------------------------------
 131       N1=N1+1
 132       NG= N1
 133       WRITE(BLKSTR,10200)N1,R1,R2,R3,R4,R5,R6,R7,R8,R9
 134       CALL GJWRIT
 135 C--------------------------------------------------------------
 136 C      Second Face:
 137 C
 138 C      The first cell of the PGON is defined as a ruled solid between two
 139 C      faces.  The second face is defined as a copy of the first face that is
 140 C      rotated PHIC degrees around the Z-axis.
 141 C
 142 C*       WRITE SET @113,F2..#101,!F1,N1
 143 C------------------------------------------------
 144 C
 145       N1=N1+1
 146       WRITE(BLKSTR,10300)N1,N1-2,N1-1
 147       CALL GJWRIT
 148 C
 149 C-------------------------------------------------
 150 C*       WRITE SET @100,N2..#145,!F1,!F2
 151 C------------------------------------------------
 152 C
 153       N1=N1+1
 154       WRITE(BLKSTR,10400)N1,N1-3,N1-1
 155       CALL GJWRIT
 156 C
 157 C--------------------------------------------------------------
 158 C  The rest of the cells are defined as rotated copies of the first cell:
 159       N2=N1
 160       DO 30  K=2, NPDV
 161 C*       WRITE SET @100,N3..#101,!N1-1,!NG
 162 C
 163 C------------------------------------------------
 164 C
 165          N1=N1+1
 166          WRITE(BLKSTR,10500)N1,N1-1,NG
 167          CALL GJWRIT
 168 C
 169    30 CONTINUE
 170 C------------------------------------------------------------
 171 C      The final shape is a Boolean union of the cells
 172 C*       WRITE SET @100,N4..#100,2,!N1-NPDV....!N1-1
 173 C------------------------------------------------
 174 C
 175       N1=N1+1
 176       WRITE(BLKSTR,10700)N1
 177       CALL GJWRIT
 178 C------------------------------------------------
 179       DO 40  K=N2, N1-1
 180 C
 181          WRITE(BLKSTR,10600)K
 182          CALL GJWRIT
 183 C
 184    40 CONTINUE
 185 C
 186 10000   FORMAT('@103,',I10,',:5,2#3,3,2')
 187 10100   FORMAT(',',G14.7,',',G14.7,',',G14.7)
 188 10200   FORMAT('@302,',I10,',:5,2#301,',G14.7,',',G14.7,',',G14.7
 189      +  ,',',G14.7,',',G14.7,',',G14.7,',',G14.7,',',G14.7,',',G14.7)
 190 10300   FORMAT('@113,',I10,',:5,2#101,!',I10,',!',I10)
 191 10400   FORMAT('@100,',I10,',:5,2#145,!',I10,',!',I10)
 192 10500   FORMAT('@100,',I10,',:5,2#101,!',I10,',!',I10)
 193 10600   FORMAT(',!',I10)
 194 10700   FORMAT('@100,',I10,',:5,2#100,2')
 195 C
 196       END