Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / geocad / gctset.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
d43b40e2 5* Revision 1.1.1.1 1999/05/18 15:55:17 fca
6* AliRoot sources
7*
fe4da5cc 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)
16C-
17C- Created 26-JUL-1991 Nils Joar Hoimyr
18C- Modified by J. Vuoskoski 21.02.1992
19C-
20C- Describes a contour face of a tube segment from the GEANT
21C- CTUB shape parameters. This face is rotated around the
22C- Z-axis to generated a solid tube segment in SET. To cut the
23C- tube, the cutting planes are calculated from the shape parameters,
24C- and then 2 half-spaces are generated and subtracted from the tube
25C- in a boolean CUT operation.
26C
27#include "geant321/gcsetf.inc"
28
29C
d43b40e2 30 DIMENSION PAR(100)
fe4da5cc 31C
32 REAL Z,DX,DY,DZ,RMIN,RMAX,PHIMIN,PHIMAX
33 REAL LXL,LYL,LZL,LXH,LYH,LZH
34C
35C----------------------------------------------------------
36C
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
55C
56C SET CONVERSION
57 Z= 2*DZ
58C
59C Starts with a normal TUBS element
60C *WRITE SET @50,N1,:5,2#32,RMAX,Z,PHIMIN,PHIMAX,RMIN
61C *WRITE SET @302,N2,:5,2#317,0,0,-DZ
62C *WRITE SET @100,N3,:5,2,:9,'MATNAM'#101,!N1,!N2
63C
64C------------------------------------------------------------------
65C
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
74C
75C Tube cutting:
76C
77C Create cutting planes, and semi-spaces which are used to
78C cut the tube section
79C SET blocks @30..#30 plane normals given by LXL, etc
80C
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
96C
9710000 FORMAT('@50,',I10,',:5,2#32,',G14.7,',',G14.7,','
98 + ,G14.7,',',G14.7,',',G14.7)
9910100 FORMAT('@302,',I10,'#317,',G14.7,',',G14.7,',',G14.7)
10010200 FORMAT('@100,',I10,',:5,2#101,!',I10,',!',I10)
10110300 FORMAT('@30,',I10,',:5,2#30,',G14.7,',',G14.7,','
102 + ,G14.7,',',G14.7)
10310400 FORMAT('@100,',I10,',:5,2#139,!',I10,',1,1')
10410500 FORMAT('@100,',I10,',:5,2#100,3,!',I10,',!',I10,',!',I10)
105C
106 10 RETURN
107 END