GEANT321/geocad/gctset.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 GCTSET(PAR)
  16 C-
  17 C-   Created  26-JUL-1991   Nils Joar Hoimyr
  18 C-   Modified by J. Vuoskoski 21.02.1992
  19 C-
  20 C-   Describes a contour face of a tube segment from the GEANT
  21 C-   CTUB shape parameters.  This face is rotated around the
  22 C-   Z-axis to generated a solid tube segment in SET.  To cut the
  23 C-   tube, the cutting planes are calculated from the shape parameters,
  24 C-   and then 2 half-spaces are generated and subtracted from the tube
  25 C-   in a boolean CUT operation.
  26 C
  27 #include "geant321/gcsetf.inc"
  28
  29 C
  30       DIMENSION PAR(100)
  31 C
  32       REAL  Z,DX,DY,DZ,RMIN,RMAX,PHIMIN,PHIMAX
  33       REAL  LXL,LYL,LZL,LXH,LYH,LZH
  34 C
  35 C----------------------------------------------------------
  36 C
  37       RMIN=PAR(1)
  38       RMAX=PAR(2)
  39       DX=0.0
  40       DY=0.0
  41       DZ=PAR(3)
  42       PHIMIN=PAR(4)
  43       PHIMAX=PAR(5)
  44       LXL= PAR(6)
  45       LYL= PAR(7)
  46       LZL= PAR(8)
  47       LXH= PAR(9)
  48       LYH= PAR(10)
  49       LZH= PAR(11)
  50       IF (RMAX .LE. 0.0) THEN
  51          WRITE (*,*) 'IMPOSSIBLE RADIUS VALUE'
  52          N1=N1-1
  53          GOTO 10
  54       ENDIF
  55 C
  56 C       SET CONVERSION
  57       Z= 2*DZ
  58 C
  59 C   Starts with a normal TUBS element
  60 C *WRITE SET @50,N1,:5,2#32,RMAX,Z,PHIMIN,PHIMAX,RMIN
  61 C *WRITE SET @302,N2,:5,2#317,0,0,-DZ
  62 C *WRITE SET @100,N3,:5,2,:9,'MATNAM'#101,!N1,!N2
  63 C
  64 C------------------------------------------------------------------
  65 C
  66       WRITE(BLKSTR,10000)N1,RMAX,Z,PHIMIN,PHIMAX,RMIN
  67       CALL GJWRIT
  68       N1=N1+1
  69       WRITE(BLKSTR,10100)N1,-DX,-DY,-DZ
  70       CALL GJWRIT
  71       N1=N1+1
  72       WRITE(BLKSTR,10200)N1,N1-2,N1-1
  73       CALL GJWRIT
  74 C
  75 C     Tube cutting:
  76 C
  77 C     Create cutting planes, and semi-spaces which are used to
  78 C     cut the tube section
  79 C     SET blocks @30..#30 plane normals given by LXL, etc
  80 C
  81       N1=N1+1
  82       WRITE(BLKSTR,10300)N1,LXL,LYL,LZL,-DZ
  83       CALL GJWRIT
  84       N1=N1+1
  85       WRITE(BLKSTR,10400)N1,N1-1
  86       CALL GJWRIT
  87       N1=N1+1
  88       WRITE(BLKSTR,10300)N1,LXH,LYH,LZH,DZ
  89       CALL GJWRIT
  90       N1=N1+1
  91       WRITE(BLKSTR,10400)N1,N1-1
  92       CALL GJWRIT
  93       N1=N1+1
  94       WRITE(BLKSTR,10500)N1,N1-5,N1-1,N1-3
  95       CALL GJWRIT
  96 C
  97 10000   FORMAT('@50,',I10,',:5,2#32,',G14.7,',',G14.7,','
  98      +  ,G14.7,',',G14.7,',',G14.7)
  99 10100   FORMAT('@302,',I10,'#317,',G14.7,',',G14.7,',',G14.7)
 100 10200   FORMAT('@100,',I10,',:5,2#101,!',I10,',!',I10)
 101 10300   FORMAT('@30,',I10,',:5,2#30,',G14.7,',',G14.7,','
 102      +  ,G14.7,',',G14.7)
 103 10400   FORMAT('@100,',I10,',:5,2#139,!',I10,',1,1')
 104 10500   FORMAT('@100,',I10,',:5,2#100,3,!',I10,',!',I10,',!',I10)
 105 C
 106    10 RETURN
 107       END