/[PAMELA software]/gpamela/gpcard/gpcardv.F
ViewVC logotype

Annotation of /gpamela/gpcard/gpcardv.F

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Sun Apr 9 23:28:47 2006 UTC (18 years, 7 months ago) by cafagna
Branch: MAIN
CVS Tags: v4r4, v4r6, v4r7
Several new things, among this: ND and CARD

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.5*A*SIN(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(A*SIN(BETA)/(B - A*COS(BETA))) )
101     BETA=3.14-ALPHA
102    
103     A=.6*3.02
104     B=1.1*3.02
105     C1N2(1) = ABS(0.5*A*SIN(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.5*A*SIN(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(A*SIN(BETA)/(B - A*COS(BETA))) )
196     BETA=3.14-ALPHA
197    
198     A=.6*3.02
199     B=1.1*3.02
200     C2N2(1) = ABS(0.5*A*SIN(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(ANGLCAR2*RADDEG)) - 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(ANGLCAR1*RADDEG)) + 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

  ViewVC Help
Powered by ViewVC 1.1.23