GEANT321/geocad/gpgset.F

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