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