gpamela/gpcard/gpcardv.F

      SUBROUTINE GPCARDV
************************************************************************
*                                                                      *
* Volumes definition for the side anticoincidence counters             *
* Called by: GPGEO                                                     *
*                                                                      *
* Author: Francesco Cafagna, 08/02/96 16.58.49                         *
*                                                                      *
************************************************************************
#include "gconst.inc"
#include "gpgeo.inc"
#include "gpmed.inc"
#include "gprot.inc"
      INTEGER IROT,IVOLU,N,NMED,NUM
      REAL X,Y,Z
      REAL CAR1(11),CR1P(11)
      REAL C1D1(11),C1N1(11),C1N2(11)
      REAL CAR2(11),CR2P(11)
      REAL C2D1(11),C2N1(11),C2N2(11)
      REAL CAR1H,CAR1D,CAR1U,CAR1T
      REAL CAR2H,CAR2D,CAR2U,CAR2T
      REAL BETA, ALPHA, ANGLCAR1, ANGLCAR2
*
* CAR1 Al box sheet
*
      NMED=MAL
      CAR1CF=3.012
      CAR1ANGL=16.83
      CAR1H=6.7*CAR1CF
      CAR1D=12*CAR1CF
      CAR1U=11.3*CAR1CF
      CAR1T=1.2
      CAR1(1) = 0.5*CAR1H
      CAR1(2) = CAR1ANGL
      CAR1(3) = 0.
      CAR1(4) = 0.5*CAR1T
      CAR1(5) = 0.5*CAR1D
      CAR1(6) = CAR1(5)
      CAR1(7) = 0.
      CAR1(8) = 0.5*CAR1T
      CAR1(9) = 0.5*CAR1U
      CAR1(10) = CAR1(9)
      CAR1(11) = 0.
      CALL GSVOLU('CAR1','TRAP',NMED,CAR1,11,IVOLU)
*
* CR1P PLASTIC BOX TO CREATE RIM 
*
      NMED=MPLAS
      CR1P(1) = 0.5*(CAR1H-.7)
      CR1P(2) = CAR1ANGL
      CR1P(3) = 0.
      CR1P(4) = 0.5*(CAR1T-.4)
      CR1P(5) = 0.5*(CAR1D-0.7)
      CR1P(6) = CR1P(5)
      CR1P(7) = 0.
      CR1P(8) = 0.5*(CAR1T-.4)
      CR1P(9) = 0.5*(CAR1U-.7)
      CR1P(10) = CR1P(9)
      CR1P(11) = 0.
      CALL GSVOLU('CR1P','TRAP',NMED,CR1P,11,IVOLU)
*
* Scint sheet
*
      NMED=MSCIN
      C1D1(1) = 0.5*(CAR1H-1.3)
      C1D1(2) = CAR1ANGL
      C1D1(3) = 0.
      C1D1(4) = 0.5*(CAR1T-.4)
      C1D1(5) = 0.5*(CAR1D-1.3)
      C1D1(6) = C1D1(5)
      C1D1(7) = 0.
      C1D1(8) = 0.5*(CAR1T-.4)
      C1D1(9) = 0.5*(CAR1U-1.3)
      C1D1(10) = C1D1(9)
      C1D1(11) = 0.
      CALL GSVOLU('C1D1','TRAP',NMED,C1D1,11,IVOLU)
*
* Empty volume to be subtracted from C1D1 sheet
*
      NMED=MN2
      BETA=ATAN(
     +     2.*C1D1(1)/
     +     (C1D1(9)-C1D1(5)+2.*C1D1(1)*TAN(C1D1(2)*3.14/180.)) )
      A=3.*3.02
      B=3.*3.02
      C1N1(1) = 0.5*A*SIN(BETA)
      C1N1(9) = 0.5*B
      C1N1(2) = -RADDEG*ATAN( 
     +     (C1N1(9)-2.*C1N1(1)/TAN(BETA))*1./(2.*C1N1(1)) )
      C1N1(3) = 0.
      C1N1(4) = 0.5*(CAR1T)
      C1N1(5) = 0.
      C1N1(6) = C1N1(5)
      C1N1(7) = 0.
      C1N1(8) = 0.5*(CAR1T)
      C1N1(10) = C1N1(9)
      C1N1(11) = 0.
      CALL GSVOLU('C1N1','TRAP',NMED,C1N1,11,IVOLU)
      ALPHA=ATAN( 
     +     ABS(A*SIN(BETA)/(B - A*COS(BETA))) )
      BETA=3.14-ALPHA

      A=.6*3.02
      B=1.1*3.02
      C1N2(1) = ABS(0.5*A*SIN(BETA))
      C1N2(9) = 0.5*B
      C1N2(2) = -(90. - RADDEG*
     +     ATAN( 2.*C1N2(1) /( C1N2(9) + (2.*C1N2(1)/ABS(TAN(BETA)))) )) 
      C1N2(3) = 0.
      C1N2(4) = 0.5*CAR1T
      C1N2(5) = 0.
      C1N2(6) = C1N2(5)
      C1N2(7) = 0.
      C1N2(8) = 0.5*CAR1T
      C1N2(10) = C1N2(9)
      C1N2(11) = 0.
      CALL GSVOLU('C1N2','TRAP',NMED,C1N2,11,IVOLU)
*
* CAR2 Al box sheet
*
      NMED=MAL
      CAR2CF=3.012
      CAR2ANGL=16.24
      CAR2H=6.7*CAR2CF
      CAR2D=10.35*CAR2CF
      CAR2U=10.2*CAR2CF
      CAR2T=1.2
      CAR2(1) = 0.5*CAR2H
      CAR2(2) = CAR2ANGL
      CAR2(3) = 0.
      CAR2(4) = 0.5*CAR2T
      CAR2(5) = 0.5*CAR2D
      CAR2(6) = CAR2(5)
      CAR2(7) = 0.
      CAR2(8) = 0.5*CAR2T
      CAR2(9) = 0.5*CAR2U
      CAR2(10) = CAR2(9)
      CAR2(11) = 0.
      CALL GSVOLU('CAR2','TRAP',NMED,CAR2,11,IVOLU)
*
* CR1P PLASTIC BOX TO CREATE RIM 
*
      NMED=MPLAS
      CR2P(1) = 0.5*(CAR2H-.7)
      CR2P(2) = CAR2ANGL
      CR2P(3) = 0.
      CR2P(4) = 0.5*(CAR2T-.4)
      CR2P(5) = 0.5*(CAR2D-0.7)
      CR2P(6) = CR2P(5)
      CR2P(7) = 0.
      CR2P(8) = 0.5*(CAR2T-.4)
      CR2P(9) = 0.5*(CAR2U-.7)
      CR2P(10) = CR2P(9)
      CR2P(11) = 0.
      CALL GSVOLU('CR2P','TRAP',NMED,CR2P,11,IVOLU)
*
* Scint sheet
*
      NMED=MSCIN
      C2D1(1) = 0.5*(CAR2H-1.3)
      C2D1(2) = CAR2ANGL
      C2D1(3) = 0.
      C2D1(4) = 0.5*(CAR2T-.4)
      C2D1(5) = 0.5*(CAR2D-1.3)
      C2D1(6) = C2D1(5)
      C2D1(7) = 0.
      C2D1(8) = 0.5*(CAR2T-.4)
      C2D1(9) = 0.5*(CAR2U-1.3)
      C2D1(10) = C2D1(9)
      C2D1(11) = 0.
      CALL GSVOLU('C2D1','TRAP',NMED,C2D1,11,IVOLU)
*
* Empty volume to be subtracted from C2D1 sheet
*
      NMED=MN2
      BETA=ATAN(
     +     2.*C2D1(1)/
     +     (C2D1(9)-C2D1(5)+2.*C2D1(1)*TAN(C2D1(2)*3.14/180.)) )
      A=3.*3.02
      B=3.*3.02
      C2N1(1) = 0.5*A*SIN(BETA)
      C2N1(9) = 0.5*B
      C2N1(2) = -RADDEG*ATAN( 
     +     (C2N1(9)-2.*C2N1(1)/TAN(BETA))*1./(2.*C2N1(1)) )
      C2N1(3) = 0.
      C2N1(4) = 0.5*(CAR2T)
      C2N1(5) = 0.
      C2N1(6) = C2N1(5)
      C2N1(7) = 0.
      C2N1(8) = 0.5*(CAR2T)
      C2N1(10) = C2N1(9)
      C2N1(11) = 0.
      CALL GSVOLU('C2N1','TRAP',NMED,C2N1,11,IVOLU)
      ALPHA=ATAN( 
     +     ABS(A*SIN(BETA)/(B - A*COS(BETA))) )
      BETA=3.14-ALPHA

      A=.6*3.02
      B=1.1*3.02
      C2N2(1) = ABS(0.5*A*SIN(BETA))
      C2N2(9) = 0.5*B
      C2N2(2) = -(90. - RADDEG*
     +     ATAN( 2.*C2N2(1) /( C2N2(9) + (2.*C2N2(1)/ABS(TAN(BETA)))) )) 
      C2N2(3) = 0.
      C2N2(4) = 0.5*CAR2T
      C2N2(5) = 0.
      C2N2(6) = C2N2(5)
      C2N2(7) = 0.
      C2N2(8) = 0.5*CAR2T
      C2N2(10) = C2N2(9)
      C2N2(11) = 0.
      CALL GSVOLU('C2N2','TRAP',NMED,C2N2,11,IVOLU)
*
      NMED=MN2
      CARDB(1)=1.5*CAR2(9)
      CARDB(2)=1.5*CAR1(9)
      CARDB(3)=CAR1(1)
      CALL GSVOLU('CARD','BOX ',NMED,CARDB, 3,IVOLU)
*
* The zenihtal angle of the paddles
*
      ANGLCAR2=ASIN( 0.5*(CAR1D-(CAR1U-2.*(C1N2(9)+C1N1(9)))) / CAR1H )
      ANGLCAR1=ASIN( 0.5*(CAR2D-(CAR2U-2.*(C2N2(9)+C2N1(9)))) / CAR2H )
*
*  Define ANGLCAR rotation around Z axis
*
      IRZCAR2=11
      CALL GSROTM(IRZCAR2,90.,0.,(90.-ANGLCAR2*RADDEG),
     +     90.,(180.-ANGLCAR2*RADDEG),90.)
      IRZCAR22=12
      CALL GSROTM(IRZCAR22,90.,180.,(270.-ANGLCAR2*RADDEG),
     +     270.,(180.-ANGLCAR2*RADDEG),270.)
      IRZCAR1=13
      CALL GSROTM(IRZCAR1,90.,270.,(90.-ANGLCAR1*RADDEG),
     +     0.,(180.-ANGLCAR1*RADDEG),0.)
      IRZCAR12=14
      CALL GSROTM(IRZCAR12,90.,90.,(90.-ANGLCAR1*RADDEG),
     +     180.,(180.-ANGLCAR1*RADDEG),180.)
*
* Positioning in CAR1
*
      N=1
      X=0
      Y=0
      Z=0
      CALL GSPOS('CR1P',N,'CAR1',X,Y,Z,0,'MANY')
      N=1
      X=( CAR1(9)+CAR1(1)*TAN(CAR1(2)*DEGRAD) ) - 
     +     (C1N1(9)+C1N1(1)*TAN(C1N1(2)*DEGRAD))
      Y=0
      Z=CAR1(1)-C1N1(1)
      CALL GSPOS('C1N1',N,'CAR1',X,Y,Z,0,'ONLY')
      N=1
      X=( CAR1(9)+CAR1(1)*TAN(CAR1(2)*DEGRAD) ) - 2.*C1N1(9) -
     +     (C1N2(9)+C1N2(1)*TAN(C1N2(2)*DEGRAD))
      Y=0
      Z=CAR1(1)-C1N2(1)
      CALL GSPOS('C1N2',N,'CAR1',X,Y,Z,0,'ONLY')
      N=1
      X=0
      Y=0
      Z=0
      CALL GSPOS('C1D1',N,'CR1P',X,Y,Z,0,'ONLY')
*
* Positioning in CAR2
*
      N=1
      X=0
      Y=0
      Z=0
      CALL GSPOS('CR2P',N,'CAR2',X,Y,Z,0,'MANY')
      N=1
      X=( CAR2(9)+CAR2(1)*TAN(CAR2(2)*DEGRAD) ) - 
     +     (C2N1(9)+C2N1(1)*TAN(C2N1(2)*DEGRAD))
      Y=0
      Z=CAR2(1)-C2N1(1)
      CALL GSPOS('C2N1',N,'CAR2',X,Y,Z,0,'ONLY')
      N=1
      X=( CAR2(9)+CAR2(1)*TAN(CAR2(2)*DEGRAD) ) - 2.*C2N1(9) -
     +     (C2N2(9)+C2N2(1)*TAN(C2N2(2)*DEGRAD))
      Y=0
      Z=CAR2(1)-C2N2(1)
      CALL GSPOS('C2N2',N,'CAR2',X,Y,Z,0,'ONLY')
      N=1
      X=0
      Y=0
      Z=0
      CALL GSPOS('C2D1',N,'CR2P',X,Y,Z,0,'ONLY')
*
* Positioning in card
*

      N=1
      X=-(C2N1(9) + C2N2(9)) + CAR2(1)*ABS(TAN(CAR2(2)*DEGRAD)) 
      Y=(CAR1(9) - (C1N1(9)+C1N2(9))) 
     +     + CAR2(1)*ABS(COS(ANGLCAR2*RADDEG)) - 2.*CAR2(4)
      Z=0
      CALL GSPOS('CAR2',N,'CARD',X,Y,Z,IRZCAR22,'ONLY')
      N=2
      X=-X + 2.*CAR1(4)
      Y=-Y + 2.*CAR1(4)
      CALL GSPOS('CAR2',N,'CARD',X,Y,Z,IRZCAR2 ,'ONLY')

      N=1
      Y=(C1N1(9) + C1N2(9)) - CAR1(1)*ABS(TAN(CAR1(2)*DEGRAD))
     +     + 2.* CAR2(4)
      X=(CAR2(9) - (C2N1(9)+C2N2(9))) 
     +     + CAR1(1)*ABS(SIN(ANGLCAR1*RADDEG)) + 2.*CAR1(4)
      Z=0
      CALL GSPOS('CAR1',N,'CARD',X,Y,Z,IRZCAR12,'ONLY')
      N=2
      Y=-Y + 2.* CAR2(4)
      X=-X + 2.* CAR2(4)
      CALL GSPOS('CAR1',N,'CARD',X,Y,Z,IRZCAR1,'ONLY')

      RETURN
      END
1	cafagna	1.1	SUBROUTINE GPCARDV
2			************************************************************************
3			* *
4			* Volumes definition for the side anticoincidence counters *
5			* Called by: GPGEO *
6			* *
7			* Author: Francesco Cafagna, 08/02/96 16.58.49 *
8			* *
9			************************************************************************
10			#include "gconst.inc"
11			#include "gpgeo.inc"
12			#include "gpmed.inc"
13			#include "gprot.inc"
14			INTEGER IROT,IVOLU,N,NMED,NUM
15			REAL X,Y,Z
16			REAL CAR1(11),CR1P(11)
17			REAL C1D1(11),C1N1(11),C1N2(11)
18			REAL CAR2(11),CR2P(11)
19			REAL C2D1(11),C2N1(11),C2N2(11)
20			REAL CAR1H,CAR1D,CAR1U,CAR1T
21			REAL CAR2H,CAR2D,CAR2U,CAR2T
22			REAL BETA, ALPHA, ANGLCAR1, ANGLCAR2
23			*
24			* CAR1 Al box sheet
25			*
26			NMED=MAL
27			CAR1CF=3.012
28			CAR1ANGL=16.83
29			CAR1H=6.7*CAR1CF
30			CAR1D=12*CAR1CF
31			CAR1U=11.3*CAR1CF
32			CAR1T=1.2
33			CAR1(1) = 0.5*CAR1H
34			CAR1(2) = CAR1ANGL
35			CAR1(3) = 0.
36			CAR1(4) = 0.5*CAR1T
37			CAR1(5) = 0.5*CAR1D
38			CAR1(6) = CAR1(5)
39			CAR1(7) = 0.
40			CAR1(8) = 0.5*CAR1T
41			CAR1(9) = 0.5*CAR1U
42			CAR1(10) = CAR1(9)
43			CAR1(11) = 0.
44			CALL GSVOLU('CAR1','TRAP',NMED,CAR1,11,IVOLU)
45			*
46			* CR1P PLASTIC BOX TO CREATE RIM
47			*
48			NMED=MPLAS
49			CR1P(1) = 0.5*(CAR1H-.7)
50			CR1P(2) = CAR1ANGL
51			CR1P(3) = 0.
52			CR1P(4) = 0.5*(CAR1T-.4)
53			CR1P(5) = 0.5*(CAR1D-0.7)
54			CR1P(6) = CR1P(5)
55			CR1P(7) = 0.
56			CR1P(8) = 0.5*(CAR1T-.4)
57			CR1P(9) = 0.5*(CAR1U-.7)
58			CR1P(10) = CR1P(9)
59			CR1P(11) = 0.
60			CALL GSVOLU('CR1P','TRAP',NMED,CR1P,11,IVOLU)
61			*
62			* Scint sheet
63			*
64			NMED=MSCIN
65			C1D1(1) = 0.5*(CAR1H-1.3)
66			C1D1(2) = CAR1ANGL
67			C1D1(3) = 0.
68			C1D1(4) = 0.5*(CAR1T-.4)
69			C1D1(5) = 0.5*(CAR1D-1.3)
70			C1D1(6) = C1D1(5)
71			C1D1(7) = 0.
72			C1D1(8) = 0.5*(CAR1T-.4)
73			C1D1(9) = 0.5*(CAR1U-1.3)
74			C1D1(10) = C1D1(9)
75			C1D1(11) = 0.
76			CALL GSVOLU('C1D1','TRAP',NMED,C1D1,11,IVOLU)
77			*
78			* Empty volume to be subtracted from C1D1 sheet
79			*
80			NMED=MN2
81			BETA=ATAN(
82			+ 2.*C1D1(1)/
83			+ (C1D1(9)-C1D1(5)+2.C1D1(1)TAN(C1D1(2)*3.14/180.)) )
84			A=3.*3.02
85			B=3.*3.02
86			C1N1(1) = 0.5ASIN(BETA)
87			C1N1(9) = 0.5*B
88			C1N1(2) = -RADDEG*ATAN(
89			+ (C1N1(9)-2.C1N1(1)/TAN(BETA))1./(2.*C1N1(1)) )
90			C1N1(3) = 0.
91			C1N1(4) = 0.5*(CAR1T)
92			C1N1(5) = 0.
93			C1N1(6) = C1N1(5)
94			C1N1(7) = 0.
95			C1N1(8) = 0.5*(CAR1T)
96			C1N1(10) = C1N1(9)
97			C1N1(11) = 0.
98			CALL GSVOLU('C1N1','TRAP',NMED,C1N1,11,IVOLU)
99			ALPHA=ATAN(
100			+ ABS(ASIN(BETA)/(B - ACOS(BETA))) )
101			BETA=3.14-ALPHA
102
103			A=.6*3.02
104			B=1.1*3.02
105			C1N2(1) = ABS(0.5ASIN(BETA))
106			C1N2(9) = 0.5*B
107			C1N2(2) = -(90. - RADDEG*
108			+ ATAN( 2.C1N2(1) /( C1N2(9) + (2.C1N2(1)/ABS(TAN(BETA)))) ))
109			C1N2(3) = 0.
110			C1N2(4) = 0.5*CAR1T
111			C1N2(5) = 0.
112			C1N2(6) = C1N2(5)
113			C1N2(7) = 0.
114			C1N2(8) = 0.5*CAR1T
115			C1N2(10) = C1N2(9)
116			C1N2(11) = 0.
117			CALL GSVOLU('C1N2','TRAP',NMED,C1N2,11,IVOLU)
118			*
119			* CAR2 Al box sheet
120			*
121			NMED=MAL
122			CAR2CF=3.012
123			CAR2ANGL=16.24
124			CAR2H=6.7*CAR2CF
125			CAR2D=10.35*CAR2CF
126			CAR2U=10.2*CAR2CF
127			CAR2T=1.2
128			CAR2(1) = 0.5*CAR2H
129			CAR2(2) = CAR2ANGL
130			CAR2(3) = 0.
131			CAR2(4) = 0.5*CAR2T
132			CAR2(5) = 0.5*CAR2D
133			CAR2(6) = CAR2(5)
134			CAR2(7) = 0.
135			CAR2(8) = 0.5*CAR2T
136			CAR2(9) = 0.5*CAR2U
137			CAR2(10) = CAR2(9)
138			CAR2(11) = 0.
139			CALL GSVOLU('CAR2','TRAP',NMED,CAR2,11,IVOLU)
140			*
141			* CR1P PLASTIC BOX TO CREATE RIM
142			*
143			NMED=MPLAS
144			CR2P(1) = 0.5*(CAR2H-.7)
145			CR2P(2) = CAR2ANGL
146			CR2P(3) = 0.
147			CR2P(4) = 0.5*(CAR2T-.4)
148			CR2P(5) = 0.5*(CAR2D-0.7)
149			CR2P(6) = CR2P(5)
150			CR2P(7) = 0.
151			CR2P(8) = 0.5*(CAR2T-.4)
152			CR2P(9) = 0.5*(CAR2U-.7)
153			CR2P(10) = CR2P(9)
154			CR2P(11) = 0.
155			CALL GSVOLU('CR2P','TRAP',NMED,CR2P,11,IVOLU)
156			*
157			* Scint sheet
158			*
159			NMED=MSCIN
160			C2D1(1) = 0.5*(CAR2H-1.3)
161			C2D1(2) = CAR2ANGL
162			C2D1(3) = 0.
163			C2D1(4) = 0.5*(CAR2T-.4)
164			C2D1(5) = 0.5*(CAR2D-1.3)
165			C2D1(6) = C2D1(5)
166			C2D1(7) = 0.
167			C2D1(8) = 0.5*(CAR2T-.4)
168			C2D1(9) = 0.5*(CAR2U-1.3)
169			C2D1(10) = C2D1(9)
170			C2D1(11) = 0.
171			CALL GSVOLU('C2D1','TRAP',NMED,C2D1,11,IVOLU)
172			*
173			* Empty volume to be subtracted from C2D1 sheet
174			*
175			NMED=MN2
176			BETA=ATAN(
177			+ 2.*C2D1(1)/
178			+ (C2D1(9)-C2D1(5)+2.C2D1(1)TAN(C2D1(2)*3.14/180.)) )
179			A=3.*3.02
180			B=3.*3.02
181			C2N1(1) = 0.5ASIN(BETA)
182			C2N1(9) = 0.5*B
183			C2N1(2) = -RADDEG*ATAN(
184			+ (C2N1(9)-2.C2N1(1)/TAN(BETA))1./(2.*C2N1(1)) )
185			C2N1(3) = 0.
186			C2N1(4) = 0.5*(CAR2T)
187			C2N1(5) = 0.
188			C2N1(6) = C2N1(5)
189			C2N1(7) = 0.
190			C2N1(8) = 0.5*(CAR2T)
191			C2N1(10) = C2N1(9)
192			C2N1(11) = 0.
193			CALL GSVOLU('C2N1','TRAP',NMED,C2N1,11,IVOLU)
194			ALPHA=ATAN(
195			+ ABS(ASIN(BETA)/(B - ACOS(BETA))) )
196			BETA=3.14-ALPHA
197
198			A=.6*3.02
199			B=1.1*3.02
200			C2N2(1) = ABS(0.5ASIN(BETA))
201			C2N2(9) = 0.5*B
202			C2N2(2) = -(90. - RADDEG*
203			+ ATAN( 2.C2N2(1) /( C2N2(9) + (2.C2N2(1)/ABS(TAN(BETA)))) ))
204			C2N2(3) = 0.
205			C2N2(4) = 0.5*CAR2T
206			C2N2(5) = 0.
207			C2N2(6) = C2N2(5)
208			C2N2(7) = 0.
209			C2N2(8) = 0.5*CAR2T
210			C2N2(10) = C2N2(9)
211			C2N2(11) = 0.
212			CALL GSVOLU('C2N2','TRAP',NMED,C2N2,11,IVOLU)
213			*
214			NMED=MN2
215			CARDB(1)=1.5*CAR2(9)
216			CARDB(2)=1.5*CAR1(9)
217			CARDB(3)=CAR1(1)
218			CALL GSVOLU('CARD','BOX ',NMED,CARDB, 3,IVOLU)
219			*
220			* The zenihtal angle of the paddles
221			*
222			ANGLCAR2=ASIN( 0.5(CAR1D-(CAR1U-2.(C1N2(9)+C1N1(9)))) / CAR1H )
223			ANGLCAR1=ASIN( 0.5(CAR2D-(CAR2U-2.(C2N2(9)+C2N1(9)))) / CAR2H )
224			*
225			* Define ANGLCAR rotation around Z axis
226			*
227			IRZCAR2=11
228			CALL GSROTM(IRZCAR2,90.,0.,(90.-ANGLCAR2*RADDEG),
229			+ 90.,(180.-ANGLCAR2*RADDEG),90.)
230			IRZCAR22=12
231			CALL GSROTM(IRZCAR22,90.,180.,(270.-ANGLCAR2*RADDEG),
232			+ 270.,(180.-ANGLCAR2*RADDEG),270.)
233			IRZCAR1=13
234			CALL GSROTM(IRZCAR1,90.,270.,(90.-ANGLCAR1*RADDEG),
235			+ 0.,(180.-ANGLCAR1*RADDEG),0.)
236			IRZCAR12=14
237			CALL GSROTM(IRZCAR12,90.,90.,(90.-ANGLCAR1*RADDEG),
238			+ 180.,(180.-ANGLCAR1*RADDEG),180.)
239			*
240			* Positioning in CAR1
241			*
242			N=1
243			X=0
244			Y=0
245			Z=0
246			CALL GSPOS('CR1P',N,'CAR1',X,Y,Z,0,'MANY')
247			N=1
248			X=( CAR1(9)+CAR1(1)TAN(CAR1(2)DEGRAD) ) -
249			+ (C1N1(9)+C1N1(1)TAN(C1N1(2)DEGRAD))
250			Y=0
251			Z=CAR1(1)-C1N1(1)
252			CALL GSPOS('C1N1',N,'CAR1',X,Y,Z,0,'ONLY')
253			N=1
254			X=( CAR1(9)+CAR1(1)TAN(CAR1(2)DEGRAD) ) - 2.*C1N1(9) -
255			+ (C1N2(9)+C1N2(1)TAN(C1N2(2)DEGRAD))
256			Y=0
257			Z=CAR1(1)-C1N2(1)
258			CALL GSPOS('C1N2',N,'CAR1',X,Y,Z,0,'ONLY')
259			N=1
260			X=0
261			Y=0
262			Z=0
263			CALL GSPOS('C1D1',N,'CR1P',X,Y,Z,0,'ONLY')
264			*
265			* Positioning in CAR2
266			*
267			N=1
268			X=0
269			Y=0
270			Z=0
271			CALL GSPOS('CR2P',N,'CAR2',X,Y,Z,0,'MANY')
272			N=1
273			X=( CAR2(9)+CAR2(1)TAN(CAR2(2)DEGRAD) ) -
274			+ (C2N1(9)+C2N1(1)TAN(C2N1(2)DEGRAD))
275			Y=0
276			Z=CAR2(1)-C2N1(1)
277			CALL GSPOS('C2N1',N,'CAR2',X,Y,Z,0,'ONLY')
278			N=1
279			X=( CAR2(9)+CAR2(1)TAN(CAR2(2)DEGRAD) ) - 2.*C2N1(9) -
280			+ (C2N2(9)+C2N2(1)TAN(C2N2(2)DEGRAD))
281			Y=0
282			Z=CAR2(1)-C2N2(1)
283			CALL GSPOS('C2N2',N,'CAR2',X,Y,Z,0,'ONLY')
284			N=1
285			X=0
286			Y=0
287			Z=0
288			CALL GSPOS('C2D1',N,'CR2P',X,Y,Z,0,'ONLY')
289			*
290			* Positioning in card
291			*
292
293			N=1
294			X=-(C2N1(9) + C2N2(9)) + CAR2(1)ABS(TAN(CAR2(2)DEGRAD))
295			Y=(CAR1(9) - (C1N1(9)+C1N2(9)))
296			+ + CAR2(1)ABS(COS(ANGLCAR2RADDEG)) - 2.*CAR2(4)
297			Z=0
298			CALL GSPOS('CAR2',N,'CARD',X,Y,Z,IRZCAR22,'ONLY')
299			N=2
300			X=-X + 2.*CAR1(4)
301			Y=-Y + 2.*CAR1(4)
302			CALL GSPOS('CAR2',N,'CARD',X,Y,Z,IRZCAR2 ,'ONLY')
303
304			N=1
305			Y=(C1N1(9) + C1N2(9)) - CAR1(1)ABS(TAN(CAR1(2)DEGRAD))
306			+ + 2.* CAR2(4)
307			X=(CAR2(9) - (C2N1(9)+C2N2(9)))
308			+ + CAR1(1)ABS(SIN(ANGLCAR1RADDEG)) + 2.*CAR1(4)
309			Z=0
310			CALL GSPOS('CAR1',N,'CARD',X,Y,Z,IRZCAR12,'ONLY')
311			N=2
312			Y=-Y + 2.* CAR2(4)
313			X=-X + 2.* CAR2(4)
314			CALL GSPOS('CAR1',N,'CARD',X,Y,Z,IRZCAR1,'ONLY')
315
316			RETURN
317			END