gpamela/gpcal/gpcalv.F

*
* $Id: gpcalv.F,v 3.2 2002/12/05 10:17:41 pamela Exp $
*
* $Log: gpcalv.F,v $
* Revision 3.2  2002/12/05 10:17:41  pamela
* Update CAS and CALO geometries and positions. Makefile updated as well
*
* Revision 3.1.1.1  2002/07/11 16:02:14  cafagna
* First GPAMELA release on CVS
*
*
*CMZ :  3.00/00 14/11/2000  10.17.50  by  Emiliano Mocchiutti
*CMZ :  2.02/00 12/10/2000  18.19.42  by  Francesco Cafagna
*CMZ :  2.01/00 05/04/2000  14.35.18  by  Marialuigia Ambriola
*CMZ :  2.00/00 03/03/2000  15.39.06  by  Francesco Cafagna
*CMZ :  1.02/00 21/10/99  14.46.25  by  Francesco Cafagna
*CMZ :  1.00/02 13/03/96  18.39.55  by  Francesco Cafagna
*-- Author :    Francesco Cafagna   09/12/95
      SUBROUTINE GPCALV
************************************************************************
*                                                                      *
* Volumes definition for the silicon calorimeter                       *
* Called by: GPGEM                                                     *
* Author: Francesco Cafagna, 05/12/95 13.39.41                         *
*                                                                      *
************************************************************************
#include "gpgeo.inc"
#include "gpmed.inc"
#include "gpkey.inc"
*
      INTEGER IROT,IVOLU,N,NMED
      REAL X,Y,Z
*
*  Define the CALB     volume
*
      NMED= MN2
      CALL GSVOLU('CALB','BOX ',NMED,CALB, 3,IVOLU)
*
*  Define the CALS     volume
*
      NMED= MAL
      CALL GSVOLU('CALS','BOX ',NMED,CALS, 3,IVOLU)
*
*  Define the CAPL     volume
*
      NMED= MN2
      CALL GSVOLU('CAPL','BOX ',NMED,CAPL, 3,IVOLU)
* F.V.&ML:
*
*  Define the CANS     volume
*
      NMED= MN2
      CALL GSVOLU('CANS','BOX ',NMED,CANS, 3,IVOLU)
* END  F.V.&ML.
*
*  Define the CAPD     volume
*
      NMED= MN2
      CALL GSVOLU('CAPD','BOX ',NMED,CAPD, 3,IVOLU)
*
*  Define the CASI     volume
*
      NMED= MSIC
      CALL GSVOLU('CASI','BOX ',NMED,CASI, 3,IVOLU)
*
*  Division in CASI
*
* ML:
C      CALL GSDVN ('CAST','CASI',NCASTR,1)
      CALL GSDVN ('CAST','CASI',NCASTR,2)
* END ML:
*
*  Define the CG10     volume
*
      NMED= MG10C
      CALL GSVOLU('C10C','BOX ',NMED,C10C, 3,IVOLU)
*
*  Define the CAAB     volume
*
      NMED= MW2
      CALL GSVOLU('CAAB','BOX ',NMED,CAAB, 3,IVOLU)
*EM:
*
*  Define the CAAD     volume
*
      NMED= MAL
      CALL GSVOLU('CAAD','BOX ',NMED,CAAD, 3,IVOLU)
*
*  Define the CAKA     volume
*
      NMED= MCER
      CALL GSVOLU('CAKA','BOX ',NMED,CAKA, 3,IVOLU)
*
*  Define the CAKP     volume
*
      NMED= MKAP
      CALL GSVOLU('CAKP','BOX ',NMED,CAKP, 3,IVOLU)
*
*  Define the CAGL     volume (Silicon glue)
*
      NMED= MSIC
      CALL GSVOLU('CAGL','BOX ',NMED,CAGL, 3,IVOLU)
*END EM.
*
* Positioning volumes CAKA, C10C, CAGL, CAKP into the mother CAPL and CAPD
* (Kaolite and G10 only for CAPD)
*
      N = 1
      X = 0.
      Y = 0.
*EM:
*F.V.&ML:
c      CALL GPVOLU(-2)
C      Z = -CAPL(3) + CAKA(3)
C      CALL GSPOS('CAKA',N,'CAPL',X,Y,Z,0,'ONLY')
      Z = -CANS(3) + CAKA(3)
      CALL GSPOS('CAKA',N,'CANS',X,Y,Z,0,'ONLY')
C      CALL GSPOS('CAKA',N,'CAPD',X,Y,Z,0,'ONLY')
      Z = Z + CAKA(3) + C10C(3)
C      CALL GSPOS('C10C',N,'CAPL',X,Y,Z,0,'ONLY')
      CALL GSPOS('C10C',N,'CANS',X,Y,Z,0,'ONLY')
C      CALL GSPOS('C10C',N,'CAPD',X,Y,Z,0,'ONLY')
      Z = Z + C10C(3) + CAGL(3)
C      CALL GSPOS('CAGL',N,'CAPL',X,Y,Z,0,'ONLY')
      CALL GSPOS('CAGL',N,'CANS',X,Y,Z,0,'ONLY')
      Z = Z + CAGL(3) + CAKP(3)
C      CALL GSPOS('CAKP',N,'CAPL',X,Y,Z,0,'ONLY')
      CALL GSPOS('CAKP',N,'CANS',X,Y,Z,0,'ONLY')
* END F.V.&ML
*
* Positioning volume CASI into the mother CAPL
*
      N = 0
* F.V.&ML:
C      Z= Z + CAKP(3) + CASI(3)
      Z = -CAPL(3)+CASI(3)
* END F.V.&ML
      DO I=-1,1
         Y = I*(2.*CASI(2)+ DCASIY)
         DO II=-1,1
            N= N + 1
            X = II*(2.*CASI(1)+ DCASIX)
*
* Check if detector is excluded
*
            IF(.NOT.NOCASI(N))
     +           CALL GSPOS('CASI',N,'CAPL',X,Y,Z,0,'ONLY')
         ENDDO
      ENDDO
*END EM.
*F.V.&ML:
C commenting the original code with a 'C' per raw:
C*
C* Positioning volume CAPL and CAAB into the mother CALB
C*
C      X= 0.
C      Y= 0.
CC      Z= CALB(3) + CAPL(3)
C*EM:
C      Z= CALB(3) + CAPL(3) - DCASIZ/2.
C*END EM. (we have 0.15 cm from the top to the first Si)
C      N= 0
C      DO I=1,NCAPL
C*
C* X view, absorber and Y view on the other
C*
C         Z= Z - 2*CAPL(3)
C         N= N + 1
C*
C* Check if this plane is excluded
C*
C         IF(.NOT.NOCAPL(N))
C     +        CALL GSPOS('CAPL',N,'CALB',X,Y,Z,0,'ONLY')
C         Z= Z - CAPL(3) - CAAB(3)
C*
C* Check if this absorber is excluded
C*
C         IF(.NOT.NOCAAB(I))
C     +        CALL GSPOS('CAAB',(I-1),'CALB',X,Y,Z,0,'ONLY')
C         Z= Z - CAAB(3) - CAPL(3)
C         N= N + 1
C*
C* Check if this detector is excluded
C*
C         IF(.NOT.NOCAPL(N))
C     +        CALL GSPOS('CAPL',N,'CALB',X,Y,Z,3,'ONLY')
C      ENDDO
C end comments.
*
* Positioning volume CANS ,CAPL and CAAB into the mother CALB
*
      X= 0.
      Y= 0.
      Z= CALB(3) + CAPL(3) - DCASIZ/2.
*END EM. (we have 0.15 cm from the top to the first Si)
      N= 0
*
*       I DISPARI
      DO I=1,NCAPL,2
*
* X view, absorber and Y view on the other
*
         X=0.10
         Y=0.05
         Z= Z - 2*CAPL(3)
         N= N + 1
*
* Check if this plane is excluded
*
*
         IF(.NOT.NOCAPL(N))
     +        CALL GSPOS('CAPL',N,'CALB',X,Y,Z,0,'ONLY')
*
         X = 0.
         Y = 0.
         Z= Z - CAPL(3) - CANS(3)
*
         CALL GSPOS('CANS',N,'CALB',X,Y,Z,0,'ONLY')
*
         Z= Z - CANS(3) - CAAB(3)
*
* Check if this absorber is excluded
*
*
         IF(.NOT.NOCAAB(I))
     +        CALL GSPOS('CAAB',(I-1),'CALB',X,Y,Z,0,'ONLY')
*
         Z = Z - CAAB(3)- CANS(3)
         N = N + 1
*     
         CALL GSPOS('CANS',N,'CALB',X,Y,Z,3,'ONLY')
         Z= Z - CANS(3) - CAPL(3)
         X=-0.05
         Y=0.10
*
* Check if this detector is excluded
*
         IF(.NOT.NOCAPL(N))
     +        CALL GSPOS('CAPL',N,'CALB',X,Y,Z,3,'ONLY')
         N=N+2
         Z = Z -2*(2*CAPL(3)+2*CANS(3)+CAAB(3))
      ENDDO
*
*       I PARI
*
      X= 0.
      Y= 0.
      Z= CALB(3) + CAPL(3) - DCASIZ/2.
*END EM. (we have 0.15 cm from the top to the first Si)
      N= 2
*
*
      DO I=2,NCAPL,2
*
* X view, absorber and Y view on the other
*
         Z= Z - 2*CAPL(3)-2*(2*CAPL(3)+2*CANS(3)+CAAB(3))
         N= N + 1
*
* Check if this plane is excluded
         X= -0.10
         Y= -0.05
*
         IF(.NOT.NOCAPL(N))
     +        CALL GSPOS('CAPL',N,'CALB',X,Y,Z,0,'ONLY')
         X = 0.
         Y = 0.
         Z = Z - CAPL(3) - CANS(3)
*
         CALL GSPOS('CANS',N,'CALB',X,Y,Z,0,'ONLY')
*
* Check if this absorber is excluded
*
         N = N + 1
         Z = Z - CANS(3) - CAAB(3)
*     
         IF(.NOT.NOCAAB(I))
     +        CALL GSPOS('CAAB',(I-1),'CALB',X,Y,Z,0,'ONLY')
*
         Z= Z - CAAB(3) - CANS(3)
*
         CALL GSPOS('CANS',N,'CALB',X,Y,Z,3,'ONLY')
         Z= Z - CANS(3) - CAPL(3)
         X= 0.05
         Y= -0.10
*
*
* Check if this detector is excluded
*
         IF(.NOT.NOCAPL(N))
     +        CALL GSPOS('CAPL',N,'CALB',X,Y,Z,3,'ONLY')
         N = N + 2
*
      ENDDO
*END F.V.&ML.
* F.V.&ML.:
* again we have to comment with a 'C' per raw:
C*
C* Positioning volume CAPD and CAAD into the mother CALB
C*
C      N= 0
C      DO I=1,NCAPLD
C         IF(I.EQ.1) THEN
C            Z= Z - CAPD(3) - CAPL(3)
C         ELSE
C            Z= Z - 2*CAPD(3)
C         ENDIF
C         N= N + 1
C         CALL GSPOS('CAPD',N,'CALB',X,Y,Z,0,'ONLY')
C         Z= Z - CAPD(3) - CAAD(3)
C         CALL GSPOS('CAAD',(I-1),'CALB',X,Y,Z,0,'ONLY')
C         Z= Z - CAAD(3) - CAPD(3)
C         N= N + 1
C         CALL GSPOS('CAPD',N,'CALB',X,Y,Z,3,'ONLY')
C      ENDDO
* end comments.
*END F.V.&ML.
*
* Put the shell around it
*
      X= 0.
      Y= 0.
      Z= CALS(3)-CALB(3)
      N= 1
      CALL GSPOS('CALB',N,'CALS',X,Y,Z,0,'ONLY')
*
      RETURN
      END
1	cafagna	3.1	*
2	pamela	3.3	* $Id: gpcalv.F,v 3.2 2002/12/05 10:17:41 pamela Exp $
3	pamela	3.2	*
4			* $Log: gpcalv.F,v $
5	pamela	3.3	* Revision 3.2 2002/12/05 10:17:41 pamela
6			* Update CAS and CALO geometries and positions. Makefile updated as well
7			*
8	pamela	3.2	* Revision 3.1.1.1 2002/07/11 16:02:14 cafagna
9			* First GPAMELA release on CVS
10	cafagna	3.1	*
11			*
12			*CMZ : 3.00/00 14/11/2000 10.17.50 by Emiliano Mocchiutti
13			*CMZ : 2.02/00 12/10/2000 18.19.42 by Francesco Cafagna
14			*CMZ : 2.01/00 05/04/2000 14.35.18 by Marialuigia Ambriola
15			*CMZ : 2.00/00 03/03/2000 15.39.06 by Francesco Cafagna
16			*CMZ : 1.02/00 21/10/99 14.46.25 by Francesco Cafagna
17			*CMZ : 1.00/02 13/03/96 18.39.55 by Francesco Cafagna
18			*-- Author : Francesco Cafagna 09/12/95
19			SUBROUTINE GPCALV
20			************************************************************************
21			* *
22			* Volumes definition for the silicon calorimeter *
23			* Called by: GPGEM *
24			* Author: Francesco Cafagna, 05/12/95 13.39.41 *
25			* *
26			************************************************************************
27			#include "gpgeo.inc"
28			#include "gpmed.inc"
29			#include "gpkey.inc"
30			*
31			INTEGER IROT,IVOLU,N,NMED
32			REAL X,Y,Z
33			*
34			* Define the CALB volume
35			*
36			NMED= MN2
37			CALL GSVOLU('CALB','BOX ',NMED,CALB, 3,IVOLU)
38			*
39			* Define the CALS volume
40			*
41			NMED= MAL
42			CALL GSVOLU('CALS','BOX ',NMED,CALS, 3,IVOLU)
43			*
44			* Define the CAPL volume
45			*
46			NMED= MN2
47			CALL GSVOLU('CAPL','BOX ',NMED,CAPL, 3,IVOLU)
48	pamela	3.2	* F.V.&ML:
49			*
50			* Define the CANS volume
51			*
52			NMED= MN2
53			CALL GSVOLU('CANS','BOX ',NMED,CANS, 3,IVOLU)
54			* END F.V.&ML.
55	cafagna	3.1	*
56			* Define the CAPD volume
57			*
58			NMED= MN2
59			CALL GSVOLU('CAPD','BOX ',NMED,CAPD, 3,IVOLU)
60			*
61			* Define the CASI volume
62			*
63			NMED= MSIC
64			CALL GSVOLU('CASI','BOX ',NMED,CASI, 3,IVOLU)
65			*
66			* Division in CASI
67			*
68	pamela	3.2	* ML:
69			C CALL GSDVN ('CAST','CASI',NCASTR,1)
70			CALL GSDVN ('CAST','CASI',NCASTR,2)
71			* END ML:
72	cafagna	3.1	*
73			* Define the CG10 volume
74			*
75			NMED= MG10C
76			CALL GSVOLU('C10C','BOX ',NMED,C10C, 3,IVOLU)
77			*
78			* Define the CAAB volume
79			*
80			NMED= MW2
81			CALL GSVOLU('CAAB','BOX ',NMED,CAAB, 3,IVOLU)
82			*EM:
83			*
84			* Define the CAAD volume
85			*
86			NMED= MAL
87			CALL GSVOLU('CAAD','BOX ',NMED,CAAD, 3,IVOLU)
88			*
89			* Define the CAKA volume
90			*
91			NMED= MCER
92			CALL GSVOLU('CAKA','BOX ',NMED,CAKA, 3,IVOLU)
93			*
94			* Define the CAKP volume
95			*
96			NMED= MKAP
97			CALL GSVOLU('CAKP','BOX ',NMED,CAKP, 3,IVOLU)
98			*
99			* Define the CAGL volume (Silicon glue)
100			*
101			NMED= MSIC
102			CALL GSVOLU('CAGL','BOX ',NMED,CAGL, 3,IVOLU)
103			*END EM.
104			*
105			* Positioning volumes CAKA, C10C, CAGL, CAKP into the mother CAPL and CAPD
106			* (Kaolite and G10 only for CAPD)
107			*
108			N = 1
109			X = 0.
110			Y = 0.
111			*EM:
112	pamela	3.2	*F.V.&ML:
113	pamela	3.3	c CALL GPVOLU(-2)
114	pamela	3.2	C Z = -CAPL(3) + CAKA(3)
115			C CALL GSPOS('CAKA',N,'CAPL',X,Y,Z,0,'ONLY')
116			Z = -CANS(3) + CAKA(3)
117			CALL GSPOS('CAKA',N,'CANS',X,Y,Z,0,'ONLY')
118			C CALL GSPOS('CAKA',N,'CAPD',X,Y,Z,0,'ONLY')
119	cafagna	3.1	Z = Z + CAKA(3) + C10C(3)
120	pamela	3.2	C CALL GSPOS('C10C',N,'CAPL',X,Y,Z,0,'ONLY')
121			CALL GSPOS('C10C',N,'CANS',X,Y,Z,0,'ONLY')
122			C CALL GSPOS('C10C',N,'CAPD',X,Y,Z,0,'ONLY')
123	cafagna	3.1	Z = Z + C10C(3) + CAGL(3)
124	pamela	3.2	C CALL GSPOS('CAGL',N,'CAPL',X,Y,Z,0,'ONLY')
125			CALL GSPOS('CAGL',N,'CANS',X,Y,Z,0,'ONLY')
126	cafagna	3.1	Z = Z + CAGL(3) + CAKP(3)
127	pamela	3.2	C CALL GSPOS('CAKP',N,'CAPL',X,Y,Z,0,'ONLY')
128			CALL GSPOS('CAKP',N,'CANS',X,Y,Z,0,'ONLY')
129			* END F.V.&ML
130	cafagna	3.1	*
131			* Positioning volume CASI into the mother CAPL
132			*
133			N = 0
134	pamela	3.2	* F.V.&ML:
135			C Z= Z + CAKP(3) + CASI(3)
136			Z = -CAPL(3)+CASI(3)
137			* END F.V.&ML
138	cafagna	3.1	DO I=-1,1
139			Y = I(2.CASI(2)+ DCASIY)
140			DO II=-1,1
141			N= N + 1
142			X = II(2.CASI(1)+ DCASIX)
143			*
144			* Check if detector is excluded
145			*
146			IF(.NOT.NOCASI(N))
147			+ CALL GSPOS('CASI',N,'CAPL',X,Y,Z,0,'ONLY')
148			ENDDO
149			ENDDO
150			*END EM.
151	pamela	3.2	*F.V.&ML:
152			C commenting the original code with a 'C' per raw:
153			C*
154			C* Positioning volume CAPL and CAAB into the mother CALB
155			C*
156			C X= 0.
157			C Y= 0.
158			CC Z= CALB(3) + CAPL(3)
159			C*EM:
160			C Z= CALB(3) + CAPL(3) - DCASIZ/2.
161			C*END EM. (we have 0.15 cm from the top to the first Si)
162			C N= 0
163			C DO I=1,NCAPL
164			C*
165			C* X view, absorber and Y view on the other
166			C*
167			C Z= Z - 2*CAPL(3)
168			C N= N + 1
169			C*
170			C* Check if this plane is excluded
171			C*
172			C IF(.NOT.NOCAPL(N))
173			C + CALL GSPOS('CAPL',N,'CALB',X,Y,Z,0,'ONLY')
174			C Z= Z - CAPL(3) - CAAB(3)
175			C*
176			C* Check if this absorber is excluded
177			C*
178			C IF(.NOT.NOCAAB(I))
179			C + CALL GSPOS('CAAB',(I-1),'CALB',X,Y,Z,0,'ONLY')
180			C Z= Z - CAAB(3) - CAPL(3)
181			C N= N + 1
182			C*
183			C* Check if this detector is excluded
184			C*
185			C IF(.NOT.NOCAPL(N))
186			C + CALL GSPOS('CAPL',N,'CALB',X,Y,Z,3,'ONLY')
187			C ENDDO
188			C end comments.
189	cafagna	3.1	*
190	pamela	3.2	* Positioning volume CANS ,CAPL and CAAB into the mother CALB
191	cafagna	3.1	*
192			X= 0.
193			Y= 0.
194			Z= CALB(3) + CAPL(3) - DCASIZ/2.
195			*END EM. (we have 0.15 cm from the top to the first Si)
196			N= 0
197	pamela	3.2	*
198			* I DISPARI
199			DO I=1,NCAPL,2
200	cafagna	3.1	*
201			* X view, absorber and Y view on the other
202			*
203	pamela	3.2	X=0.10
204			Y=0.05
205	cafagna	3.1	Z= Z - 2*CAPL(3)
206			N= N + 1
207			*
208			* Check if this plane is excluded
209			*
210	pamela	3.2	*
211	cafagna	3.1	IF(.NOT.NOCAPL(N))
212			+ CALL GSPOS('CAPL',N,'CALB',X,Y,Z,0,'ONLY')
213	pamela	3.2	*
214			X = 0.
215			Y = 0.
216			Z= Z - CAPL(3) - CANS(3)
217			*
218			CALL GSPOS('CANS',N,'CALB',X,Y,Z,0,'ONLY')
219			*
220			Z= Z - CANS(3) - CAAB(3)
221	cafagna	3.1	*
222			* Check if this absorber is excluded
223			*
224	pamela	3.2	*
225	cafagna	3.1	IF(.NOT.NOCAAB(I))
226			+ CALL GSPOS('CAAB',(I-1),'CALB',X,Y,Z,0,'ONLY')
227	pamela	3.2	*
228			Z = Z - CAAB(3)- CANS(3)
229			N = N + 1
230			*
231			CALL GSPOS('CANS',N,'CALB',X,Y,Z,3,'ONLY')
232			Z= Z - CANS(3) - CAPL(3)
233	pamela	3.3	X=-0.05
234			Y=0.10
235	cafagna	3.1	*
236			* Check if this detector is excluded
237			*
238			IF(.NOT.NOCAPL(N))
239			+ CALL GSPOS('CAPL',N,'CALB',X,Y,Z,3,'ONLY')
240	pamela	3.2	N=N+2
241			Z = Z -2(2CAPL(3)+2*CANS(3)+CAAB(3))
242	cafagna	3.1	ENDDO
243			*
244	pamela	3.2	* I PARI
245			*
246			X= 0.
247			Y= 0.
248			Z= CALB(3) + CAPL(3) - DCASIZ/2.
249			*END EM. (we have 0.15 cm from the top to the first Si)
250			N= 2
251			*
252			*
253			DO I=2,NCAPL,2
254			*
255			* X view, absorber and Y view on the other
256	cafagna	3.1	*
257	pamela	3.2	Z= Z - 2CAPL(3)-2(2CAPL(3)+2CANS(3)+CAAB(3))
258	cafagna	3.1	N= N + 1
259	pamela	3.2	*
260			* Check if this plane is excluded
261	pamela	3.3	X= -0.10
262			Y= -0.05
263	pamela	3.2	*
264			IF(.NOT.NOCAPL(N))
265			+ CALL GSPOS('CAPL',N,'CALB',X,Y,Z,0,'ONLY')
266			X = 0.
267			Y = 0.
268			Z = Z - CAPL(3) - CANS(3)
269			*
270			CALL GSPOS('CANS',N,'CALB',X,Y,Z,0,'ONLY')
271			*
272			* Check if this absorber is excluded
273			*
274			N = N + 1
275			Z = Z - CANS(3) - CAAB(3)
276			*
277			IF(.NOT.NOCAAB(I))
278			+ CALL GSPOS('CAAB',(I-1),'CALB',X,Y,Z,0,'ONLY')
279			*
280			Z= Z - CAAB(3) - CANS(3)
281			*
282			CALL GSPOS('CANS',N,'CALB',X,Y,Z,3,'ONLY')
283			Z= Z - CANS(3) - CAPL(3)
284	pamela	3.3	X= 0.05
285			Y= -0.10
286	pamela	3.2	*
287			*
288			* Check if this detector is excluded
289			*
290			IF(.NOT.NOCAPL(N))
291			+ CALL GSPOS('CAPL',N,'CALB',X,Y,Z,3,'ONLY')
292			N = N + 2
293			*
294	cafagna	3.1	ENDDO
295	pamela	3.2	*END F.V.&ML.
296			* F.V.&ML.:
297			* again we have to comment with a 'C' per raw:
298			C*
299			C* Positioning volume CAPD and CAAD into the mother CALB
300			C*
301			C N= 0
302			C DO I=1,NCAPLD
303			C IF(I.EQ.1) THEN
304			C Z= Z - CAPD(3) - CAPL(3)
305			C ELSE
306			C Z= Z - 2*CAPD(3)
307			C ENDIF
308			C N= N + 1
309			C CALL GSPOS('CAPD',N,'CALB',X,Y,Z,0,'ONLY')
310			C Z= Z - CAPD(3) - CAAD(3)
311			C CALL GSPOS('CAAD',(I-1),'CALB',X,Y,Z,0,'ONLY')
312			C Z= Z - CAAD(3) - CAPD(3)
313			C N= N + 1
314			C CALL GSPOS('CAPD',N,'CALB',X,Y,Z,3,'ONLY')
315			C ENDDO
316			* end comments.
317			*END F.V.&ML.
318	cafagna	3.1	*
319			* Put the shell around it
320			*
321			X= 0.
322			Y= 0.
323			Z= CALS(3)-CALB(3)
324			N= 1
325			CALL GSPOS('CALB',N,'CALS',X,Y,Z,0,'ONLY')
326			*
327			RETURN
328			END