[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdcgsl.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:21  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.26  by  S.Giani
*-- Author :
      SUBROUTINE GDCGSL(IVOLNA,ISHAPE)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       This routine allows computes the coefficients of the     *
C.    *       cut plane and the limits and array of the clipping       *
C.    *       volumes (boxes, cones, tubes, spheres).                  *
C.    *                                                                *
C.    *    ==>Called by : GDRAW                                        *
C.    *                                                                *
C.    *       Authors :  J.Salt ; S.Giani                              *
C.    ******************************************************************
C.
#include "geant321/gcdraw.inc"
#include "geant321/gcunit.inc"
#include "geant321/gconsp.inc"
#include "geant321/gcgobj.inc"
*
*
*****SG
*
#include "geant321/gcspee.inc"
#include "geant321/gcbank.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gchiln.inc"
#include "geant321/gcmutr.inc"
#include "geant321/pawc.inc"
*
      DIMENSION TMIN(3),TMAX(3),XZ(2,4)
      CHARACTER*4 NACA
*
      CALL UCTOH('PERS',IPERS,4,4)
      IF(IHOLE.NE.0)THEN
*
*   Clipping Volumes Creation
*
*   Look for volume to be clipped
*
         NAIN=0
         JJJ=0
         ICUBE=0
         CALL UHTOC(IVOLNA,4,NACA,4)
         DO 30  III=1,MULTRA
            INV=0
            IWILDC=INDEX(GNNVV(III),'*')
            IF(IWILDC.EQ.0) THEN
               CALL UCTOH(GNNVV(III),INV,4,4)
            ELSEIF(IWILDC.EQ.1.AND.JJJ.LT.2) THEN
               INV=IVOLNA
            ELSEIF(GNNVV(III)(1:IWILDC-1).EQ.
     +                NACA(1:IWILDC-1)) THEN
               INV=IVOLNA
            ENDIF
            IF(INV.EQ.IVOLNA)THEN
*
*   If you find it, compute number of times it's to be clipped
*   and set parameters of relative clipping shapes
*
               JJJ=JJJ+1
               IF(JJJ.EQ.3)THEN
                  WRITE(CHMAIL,10100)
                  CALL GMAIL(0,0)
                  GOTO 60
               ENDIF
               IF(GNASH(III).EQ.'BOX ')THEN
                  DBX=GXMAX(III)-GXMIN(III)
                  DBY=GYMAX(III)-GYMIN(III)
                  DBZ=GZMAX(III)-GZMIN(III)
*
                  IF(JJJ.EQ.2)THEN
                     ICUBE=ICUBE+1
                     CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
     +               Q(ICLIP2))
                     CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP2))
                     ENDIF
                  ELSE
                     ICUBE=ICUBE+1
                     CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
     +               Q(ICLIP1))
                     CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP1))
                     ENDIF
                  ENDIF
               ELSE IF (GNASH(III).EQ.'TUBE') THEN
                  RMIN1=0
                  RMAX1=GXMIN(III)
                  Z2=GXMAX(III)
                  RMIN2=RMIN1
                  RMAX2=RMAX1
                  XZ(1,1)=RMIN1
                  XZ(2,1)=-Z2
                  XZ(1,2)=RMAX1
                  XZ(2,2)=-Z2
                  XZ(1,3)=RMAX2
                  XZ(2,3)=Z2
                  XZ(1,4)=RMIN2
                  XZ(2,4)=Z2
                  ANG1=0.
                  ANG2=360.
                  NANG=30
*
                  IF(JJJ.EQ.2)THEN
                     CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     S1=GYMIN(III)
                     S2=GYMAX(III)
                     S3=GZMIN(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
                     CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP2))
                     ENDIF
                  ELSE
                     CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     S1=GYMIN(III)
                     S2=GYMAX(III)
                     S3=GZMIN(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
                     CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP1))
                     ENDIF
                  ENDIF
               ELSE IF (GNASH(III).EQ.'SPHE') THEN
                  R=GXMIN(III)
                  NLAT=15
                  NLON=15
*
                  IF(JJJ.EQ.2)THEN
                     CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     S1=GXMAX(III)
                     S2=GYMIN(III)
                     S3=GYMAX(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
                     CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP2))
                     ENDIF
                  ELSE
                     CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     S1=GXMAX(III)
                     S2=GYMIN(III)
                     S3=GYMAX(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
                     CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP1))
                     ENDIF
                  ENDIF
               ELSE IF (GNASH(III).EQ.'CONE') THEN
                  RMIN1=0.
                  RMAX1=GXMIN(III)
                  RMIN2=0.
                  RMAX2=GXMAX(III)
                  Z2=GYMIN(III)
                  XZ(1,1)=RMIN1
                  XZ(2,1)=-Z2
                  XZ(1,2)=RMAX1
                  XZ(2,2)=-Z2
                  XZ(1,3)=RMAX2
                  XZ(2,3)=Z2
                  XZ(1,4)=RMIN2
                  XZ(2,4)=Z2
                  ANG1=0.
                  ANG2=360.
                  NANG=30
                  IF(JJJ.EQ.2)THEN
                     CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     S1=GYMAX(III)
                     S2=GZMIN(III)
                     S3=GZMAX(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
                     CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP2))
                     ENDIF
                  ELSE
                     CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     S1=GYMAX(III)
                     S2=GZMIN(III)
                     S3=GZMAX(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
                     CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP1))
                     ENDIF
                  ENDIF
               ENDIF
*          IF(CGERR.LE.0)THEN
*             CALL GDCGER(CGERR)
*             IF(KCGST.EQ.-2)GO TO 999
*             IF(KCGST.EQ.-3)THEN
*                WRITE(CHMAIL,10100)
*                CALL GMAIL(0,0)
*                GO TO 999
*             ENDIF
*          ENDIF
*
*    Compute scope for each clipping volume
*
               DO 10 K=1,3
                  KKK=K+3*JJJ-3
                  BMIN(KKK)=TMIN(K)
                  BMAX(KKK)=TMAX(K)
   10          CONTINUE
               IF(IPORLI.EQ.1)THEN
                  DO 20 KJ=1,3
                     KKKJ=KJ+3*JJJ-3
                     CLIPMI(KKKJ)=TMIN(KJ)
                     CLIPMA(KKKJ)=TMAX(KJ)
   20             CONTINUE
               ENDIF
            ENDIF
   30    CONTINUE
*
*    If volume is not to be clipped
*
         IF(JJJ.EQ.0)THEN
            IF(IPORLI.EQ.1)THEN
               DO 40 KJ=1,6
                  CLIPMI(KJ)=-10000
                  CLIPMA(KJ)=-9999
   40          CONTINUE
               JPORJJ=1
            ENDIF
            NAIN=1
            GOTO 60
         ELSE
            IF(IPORLI.EQ.1)THEN
               JPORJJ=JJJ
            ENDIF
            NAIN=2
            ISA=0
            DO 50  J=1,6
               IF(BMIN(J).EQ.CLIPMI(J).AND.BMAX(J).EQ.CLIPMA(J))THEN
                  ISA=ISA+1
               ENDIF
   50       CONTINUE
            IF(ISA.EQ.6)NAIN=3
         ENDIF
*
*
*****SG
*
*
      ELSE
*
*   Slicing with a plane
*
         IF(ICUT.EQ.0) GO TO 999
         IF(ICUT.EQ.1)THEN
            CTHETA=90.
            CPHI=180.
         ELSE IF(ICUT.EQ.2)THEN
            CTHETA=90.
            CPHI=270.
         ELSE IF(ICUT.EQ.3)THEN
            CTHETA=180.
            CPHI=0.
         ELSE
            WRITE(CHMAIL,10000)
            CALL GMAIL(0,0)
            GO TO 999
         ENDIF
         ATH=DEGRAD*CTHETA
         APH=DEGRAD*CPHI
         ABCD(1)=SIN(ATH)*COS(APH)
         ABCD(2)=SIN(ATH)*SIN(APH)
         ABCD(3)=COS(ATH)
         ABCD(4)=DCUT
      ENDIF
   60 CONTINUE
*
10000 FORMAT(' CUT Index not implemented')
*10100 FORMAT(' Check Clipping Box Parameters ')
10100 FORMAT(' Please, reset CVOL mode. ')
*
  999 END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:20:21 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/02 29/03/94 15.41.26 by S.Giani
	11	*-- Author :
	12	SUBROUTINE GDCGSL(IVOLNA,ISHAPE)
	13	C.
	14	C. ******************************************************************
	15	C. * *
	16	C. * This routine allows computes the coefficients of the *
	17	C. * cut plane and the limits and array of the clipping *
	18	C. * volumes (boxes, cones, tubes, spheres). *
	19	C. * *
	20	C. * ==>Called by : GDRAW *
	21	C. * *
	22	C. * Authors : J.Salt ; S.Giani *
	23	C. ******************************************************************
	24	C.
	25	#include "geant321/gcdraw.inc"
	26	#include "geant321/gcunit.inc"
	27	#include "geant321/gconsp.inc"
	28	#include "geant321/gcgobj.inc"
	29	*
	30	*
	31	*****SG
	32	*
	33	#include "geant321/gcspee.inc"
	34	#include "geant321/gcbank.inc"
	35	#include "geant321/gcnum.inc"
	36	#include "geant321/gcvolu.inc"
	37	#include "geant321/gchiln.inc"
	38	#include "geant321/gcmutr.inc"
	39	#include "geant321/pawc.inc"
	40	*
	41	DIMENSION TMIN(3),TMAX(3),XZ(2,4)
	42	CHARACTER*4 NACA
	43	*
	44	CALL UCTOH('PERS',IPERS,4,4)
	45	IF(IHOLE.NE.0)THEN
	46	*
	47	* Clipping Volumes Creation
	48	*
	49	* Look for volume to be clipped
	50	*
	51	NAIN=0
	52	JJJ=0
	53	ICUBE=0
	54	CALL UHTOC(IVOLNA,4,NACA,4)
	55	DO 30 III=1,MULTRA
	56	INV=0
	57	IWILDC=INDEX(GNNVV(III),'*')
	58	IF(IWILDC.EQ.0) THEN
	59	CALL UCTOH(GNNVV(III),INV,4,4)
	60	ELSEIF(IWILDC.EQ.1.AND.JJJ.LT.2) THEN
	61	INV=IVOLNA
	62	ELSEIF(GNNVV(III)(1:IWILDC-1).EQ.
	63	+ NACA(1:IWILDC-1)) THEN
	64	INV=IVOLNA
65	ENDIF
66	IF(INV.EQ.IVOLNA)THEN
67	*
68	* If you find it, compute number of times it's to be clipped
69	* and set parameters of relative clipping shapes
70	*
71	JJJ=JJJ+1
72	IF(JJJ.EQ.3)THEN
73	WRITE(CHMAIL,10100)
74	CALL GMAIL(0,0)
75	GOTO 60
76	ENDIF
77	IF(GNASH(III).EQ.'BOX ')THEN
78	DBX=GXMAX(III)-GXMIN(III)
79	DBY=GYMAX(III)-GYMIN(III)
80	DBZ=GZMAX(III)-GZMIN(III)
81	*
82	IF(JJJ.EQ.2)THEN
83	ICUBE=ICUBE+1
84	CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP2))
85	CALL CGCEV(-1,Q(ICLIP2))
86	CALL CGCEV(-1,Q(ICLIP2))
87	CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
88	+ Q(ICLIP2))
89	CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
90	* Perspective view
91	IF (IPRJ.EQ.IPERS) THEN
92	CALL CGPERS(Q(ICLIP2))
93	ENDIF
94	ELSE
95	ICUBE=ICUBE+1
96	CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP1))
97	CALL CGCEV(-1,Q(ICLIP1))
98	CALL CGCEV(-1,Q(ICLIP1))
99	CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
100	+ Q(ICLIP1))
101	CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
102	* Perspective view
103	IF (IPRJ.EQ.IPERS) THEN
104	CALL CGPERS(Q(ICLIP1))
105	ENDIF
106	ENDIF
107	ELSE IF (GNASH(III).EQ.'TUBE') THEN
108	RMIN1=0
109	RMAX1=GXMIN(III)
110	Z2=GXMAX(III)
111	RMIN2=RMIN1
112	RMAX2=RMAX1
113	XZ(1,1)=RMIN1
114	XZ(2,1)=-Z2
115	XZ(1,2)=RMAX1
116	XZ(2,2)=-Z2
117	XZ(1,3)=RMAX2
118	XZ(2,3)=Z2
119	XZ(1,4)=RMIN2
120	XZ(2,4)=Z2
121	ANG1=0.
122	ANG2=360.
123	NANG=30
124	*
125	IF(JJJ.EQ.2)THEN
126	CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
127	CALL CGCEV(-1,Q(ICLIP2))
128	CALL CGCEV(-1,Q(ICLIP2))
129	S1=GYMIN(III)
130	S2=GYMAX(III)
131	S3=GZMIN(III)
132	CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
133	CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
134	* Perspective view
135	IF (IPRJ.EQ.IPERS) THEN
136	CALL CGPERS(Q(ICLIP2))
137	ENDIF
138	ELSE
139	CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
140	CALL CGCEV(-1,Q(ICLIP1))
141	CALL CGCEV(-1,Q(ICLIP1))
142	S1=GYMIN(III)
143	S2=GYMAX(III)
144	S3=GZMIN(III)
145	CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
146	CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
147	* Perspective view
148	IF (IPRJ.EQ.IPERS) THEN
149	CALL CGPERS(Q(ICLIP1))
150	ENDIF
151	ENDIF
152	ELSE IF (GNASH(III).EQ.'SPHE') THEN
153	R=GXMIN(III)
154	NLAT=15
155	NLON=15
156	*
157	IF(JJJ.EQ.2)THEN
158	CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP2))
159	CALL CGCEV(-1,Q(ICLIP2))
160	CALL CGCEV(-1,Q(ICLIP2))
161	S1=GXMAX(III)
162	S2=GYMIN(III)
163	S3=GYMAX(III)
164	CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
165	CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
166	* Perspective view
167	IF (IPRJ.EQ.IPERS) THEN
168	CALL CGPERS(Q(ICLIP2))
169	ENDIF
170	ELSE
171	CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP1))
172	CALL CGCEV(-1,Q(ICLIP1))
173	CALL CGCEV(-1,Q(ICLIP1))
174	S1=GXMAX(III)
175	S2=GYMIN(III)
176	S3=GYMAX(III)
177	CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
178	CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
179	* Perspective view
180	IF (IPRJ.EQ.IPERS) THEN
181	CALL CGPERS(Q(ICLIP1))
182	ENDIF
183	ENDIF
184	ELSE IF (GNASH(III).EQ.'CONE') THEN
185	RMIN1=0.
186	RMAX1=GXMIN(III)
187	RMIN2=0.
188	RMAX2=GXMAX(III)
189	Z2=GYMIN(III)
190	XZ(1,1)=RMIN1
191	XZ(2,1)=-Z2
192	XZ(1,2)=RMAX1
193	XZ(2,2)=-Z2
194	XZ(1,3)=RMAX2
195	XZ(2,3)=Z2
196	XZ(1,4)=RMIN2
197	XZ(2,4)=Z2
198	ANG1=0.
199	ANG2=360.
200	NANG=30
201	IF(JJJ.EQ.2)THEN
202	CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
203	CALL CGCEV(-1,Q(ICLIP2))
204	CALL CGCEV(-1,Q(ICLIP2))
205	S1=GYMAX(III)
206	S2=GZMIN(III)
207	S3=GZMAX(III)
208	CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
209	CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
210	* Perspective view
211	IF (IPRJ.EQ.IPERS) THEN
212	CALL CGPERS(Q(ICLIP2))
213	ENDIF
214	ELSE
215	CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
216	CALL CGCEV(-1,Q(ICLIP1))
217	CALL CGCEV(-1,Q(ICLIP1))
218	S1=GYMAX(III)
219	S2=GZMIN(III)
220	S3=GZMAX(III)
221	CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
222	CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
223	* Perspective view
224	IF (IPRJ.EQ.IPERS) THEN
225	CALL CGPERS(Q(ICLIP1))
226	ENDIF
227	ENDIF
228	ENDIF
229	* IF(CGERR.LE.0)THEN
230	* CALL GDCGER(CGERR)
231	* IF(KCGST.EQ.-2)GO TO 999
232	* IF(KCGST.EQ.-3)THEN
233	* WRITE(CHMAIL,10100)
234	* CALL GMAIL(0,0)
235	* GO TO 999
236	* ENDIF
237	* ENDIF
238	*
239	* Compute scope for each clipping volume
240	*
241	DO 10 K=1,3
242	KKK=K+3*JJJ-3
243	BMIN(KKK)=TMIN(K)
244	BMAX(KKK)=TMAX(K)
245	10 CONTINUE
246	IF(IPORLI.EQ.1)THEN
247	DO 20 KJ=1,3
248	KKKJ=KJ+3*JJJ-3
249	CLIPMI(KKKJ)=TMIN(KJ)
250	CLIPMA(KKKJ)=TMAX(KJ)
251	20 CONTINUE
252	ENDIF
253	ENDIF
254	30 CONTINUE
255	*
256	* If volume is not to be clipped
257	*
258	IF(JJJ.EQ.0)THEN
259	IF(IPORLI.EQ.1)THEN
260	DO 40 KJ=1,6
261	CLIPMI(KJ)=-10000
262	CLIPMA(KJ)=-9999
263	40 CONTINUE
264	JPORJJ=1
265	ENDIF
266	NAIN=1
267	GOTO 60
268	ELSE
269	IF(IPORLI.EQ.1)THEN
270	JPORJJ=JJJ
271	ENDIF
272	NAIN=2
273	ISA=0
274	DO 50 J=1,6
275	IF(BMIN(J).EQ.CLIPMI(J).AND.BMAX(J).EQ.CLIPMA(J))THEN
276	ISA=ISA+1
277	ENDIF
278	50 CONTINUE
279	IF(ISA.EQ.6)NAIN=3
280	ENDIF
281	*
282	*
283	*****SG
284	*
285	*
286	ELSE
287	*
288	* Slicing with a plane
289	*
290	IF(ICUT.EQ.0) GO TO 999
291	IF(ICUT.EQ.1)THEN
292	CTHETA=90.
293	CPHI=180.
294	ELSE IF(ICUT.EQ.2)THEN
295	CTHETA=90.
296	CPHI=270.
297	ELSE IF(ICUT.EQ.3)THEN
298	CTHETA=180.
299	CPHI=0.
300	ELSE
301	WRITE(CHMAIL,10000)
302	CALL GMAIL(0,0)
303	GO TO 999
304	ENDIF
305	ATH=DEGRAD*CTHETA
306	APH=DEGRAD*CPHI
307	ABCD(1)=SIN(ATH)*COS(APH)
308	ABCD(2)=SIN(ATH)*SIN(APH)
309	ABCD(3)=COS(ATH)
310	ABCD(4)=DCUT
311	ENDIF
312	60 CONTINUE
313	*
314	10000 FORMAT(' CUT Index not implemented')
315	*10100 FORMAT(' Check Clipping Box Parameters ')
316	10100 FORMAT(' Please, reset CVOL mode. ')
317	*
318	999 END