This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / geocad / gctset.F
CommitLineData
fe4da5cc 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)
13C-
14C- Created 26-JUL-1991 Nils Joar Hoimyr
15C- Modified by J. Vuoskoski 21.02.1992
16C-
17C- Describes a contour face of a tube segment from the GEANT
18C- CTUB shape parameters. This face is rotated around the
19C- Z-axis to generated a solid tube segment in SET. To cut the
20C- tube, the cutting planes are calculated from the shape parameters,
21C- and then 2 half-spaces are generated and subtracted from the tube
22C- in a boolean CUT operation.
23C
24#include "geant321/gcsetf.inc"
25
26C
27 DIMENSION PAR(50)
28C
29 REAL Z,DX,DY,DZ,RMIN,RMAX,PHIMIN,PHIMAX
30 REAL LXL,LYL,LZL,LXH,LYH,LZH
31C
32C----------------------------------------------------------
33C
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
52C
53C SET CONVERSION
54 Z= 2*DZ
55C
56C Starts with a normal TUBS element
57C *WRITE SET @50,N1,:5,2#32,RMAX,Z,PHIMIN,PHIMAX,RMIN
58C *WRITE SET @302,N2,:5,2#317,0,0,-DZ
59C *WRITE SET @100,N3,:5,2,:9,'MATNAM'#101,!N1,!N2
60C
61C------------------------------------------------------------------
62C
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
71C
72C Tube cutting:
73C
74C Create cutting planes, and semi-spaces which are used to
75C cut the tube section
76C SET blocks @30..#30 plane normals given by LXL, etc
77C
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
93C
9410000 FORMAT('@50,',I10,',:5,2#32,',G14.7,',',G14.7,','
95 + ,G14.7,',',G14.7,',',G14.7)
9610100 FORMAT('@302,',I10,'#317,',G14.7,',',G14.7,',',G14.7)
9710200 FORMAT('@100,',I10,',:5,2#101,!',I10,',!',I10)
9810300 FORMAT('@30,',I10,',:5,2#30,',G14.7,',',G14.7,','
99 + ,G14.7,',',G14.7)
10010400 FORMAT('@100,',I10,',:5,2#139,!',I10,',1,1')
10110500 FORMAT('@100,',I10,',:5,2#100,3,!',I10,',!',I10,',!',I10)
102C
103 10 RETURN
104 END