[u/mrichter/AliRoot.git] / GEANT321 / geocad / gctset.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:46  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
*-- Author :
      SUBROUTINE GCTSET(PAR)
C-
C-   Created  26-JUL-1991   Nils Joar Hoimyr
C-   Modified by J. Vuoskoski 21.02.1992
C-
C-   Describes a contour face of a tube segment from the GEANT
C-   CTUB shape parameters.  This face is rotated around the
C-   Z-axis to generated a solid tube segment in SET.  To cut the
C-   tube, the cutting planes are calculated from the shape parameters,
C-   and then 2 half-spaces are generated and subtracted from the tube
C-   in a boolean CUT operation.
C
#include "geant321/gcsetf.inc"
 
C
      DIMENSION PAR(50)
C
      REAL  Z,DX,DY,DZ,RMIN,RMAX,PHIMIN,PHIMAX
      REAL  LXL,LYL,LZL,LXH,LYH,LZH
C
C----------------------------------------------------------
C
      RMIN=PAR(1)
      RMAX=PAR(2)
      DX=0.0
      DY=0.0
      DZ=PAR(3)
      PHIMIN=PAR(4)
      PHIMAX=PAR(5)
      LXL= PAR(6)
      LYL= PAR(7)
      LZL= PAR(8)
      LXH= PAR(9)
      LYH= PAR(10)
      LZH= PAR(11)
      IF (RMAX .LE. 0.0) THEN
         WRITE (*,*) 'IMPOSSIBLE RADIUS VALUE'
         N1=N1-1
         GOTO 10
      ENDIF
C
C       SET CONVERSION
      Z= 2*DZ
C
C   Starts with a normal TUBS element
C *WRITE SET @50,N1,:5,2#32,RMAX,Z,PHIMIN,PHIMAX,RMIN
C *WRITE SET @302,N2,:5,2#317,0,0,-DZ
C *WRITE SET @100,N3,:5,2,:9,'MATNAM'#101,!N1,!N2
C
C------------------------------------------------------------------
C
      WRITE(BLKSTR,10000)N1,RMAX,Z,PHIMIN,PHIMAX,RMIN
      CALL GJWRIT
      N1=N1+1
      WRITE(BLKSTR,10100)N1,-DX,-DY,-DZ
      CALL GJWRIT
      N1=N1+1
      WRITE(BLKSTR,10200)N1,N1-2,N1-1
      CALL GJWRIT
C
C     Tube cutting:
C
C     Create cutting planes, and semi-spaces which are used to
C     cut the tube section
C     SET blocks @30..#30 plane normals given by LXL, etc
C
      N1=N1+1
      WRITE(BLKSTR,10300)N1,LXL,LYL,LZL,-DZ
      CALL GJWRIT
      N1=N1+1
      WRITE(BLKSTR,10400)N1,N1-1
      CALL GJWRIT
      N1=N1+1
      WRITE(BLKSTR,10300)N1,LXH,LYH,LZH,DZ
      CALL GJWRIT
      N1=N1+1
      WRITE(BLKSTR,10400)N1,N1-1
      CALL GJWRIT
      N1=N1+1
      WRITE(BLKSTR,10500)N1,N1-5,N1-1,N1-3
      CALL GJWRIT
C
10000   FORMAT('@50,',I10,',:5,2#32,',G14.7,',',G14.7,','
     +  ,G14.7,',',G14.7,',',G14.7)
10100   FORMAT('@302,',I10,'#317,',G14.7,',',G14.7,',',G14.7)
10200   FORMAT('@100,',I10,',:5,2#101,!',I10,',!',I10)
10300   FORMAT('@30,',I10,',:5,2#30,',G14.7,',',G14.7,','
     +  ,G14.7,',',G14.7)
10400   FORMAT('@100,',I10,',:5,2#139,!',I10,',1,1')
10500   FORMAT('@100,',I10,',:5,2#100,3,!',I10,',!',I10,',!',I10)
C
   10 RETURN
      END
Commit	Line	Data
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)
	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