This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdcgob.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.2  1996/02/27 10:02:05  ravndal
6 * Drawing of PCON's optimized for 'HIDE ON'
7 *
8 * Revision 1.1.1.1  1995/10/24 10:20:20  cernlib
9 * Geant
10 *
11 *
12 #include "geant321/pilot.h"
13 *CMZ :  3.21/04 13/12/94  17.13.38  by  S.Giani
14 *-- Author :
15 *
16       SUBROUTINE GDCGOB(ITASK,ISHAPE,PAR,NOBJ,NWWS,IVOLNA,
17      +LSTEP)
18 C.
19 C.    ******************************************************************
20 C.    *                                                                *
21 C.    *       Make the CG-Object with shape ISHAPE of parameters PAR   *
22 C.    *       with the same logic as GDRAWS. 1992                      *
23 C.    *                                                                *
24 C.    *     Input Parameters :                                         *
25 C.    *                                                                *
26 C.    *     ITASK:   Number for indicating the task to be performed    *
27 C.    *                                                                *
28 C.    *                                                                *
29 C.    *           = 0      Counting task                               *
30 C.    *           = 1      Slicing + Counting                          *
31 C.    *           = 2      Clipping + Counting                         *
32 C.    *           = 3      Insert into the H.S. + Convert to Wire      *
33 C.    *           = 4      Slicing + Insert into the H.S. + Convert    *
34 C.    *                    to Wire                                     *
35 C.    *           = 5      Clipping + Insert into the H.S. + Convert   *
36 C.    *                    to Wire                                     *
37 C.    *                                                                *
38 C.    * SHAPE     SHAPE    SHAPE                                       *
39 C.    * NUMBER    TYPE     PARAMETERS                                  *
40 C.    * -------------------------------------------------------------- *
41 C.    *                                                                *
42 C.    *   1       BOX      DX,DY,DZ                                    *
43 C.    *   2       TRD1     DX1,DX2,DY,DZ                               *
44 C.    *   3       TRD2     DX1,DX2,DY1,DY2,DZ                          *
45 C.    *   4       TRAP     DZ,TX,TY,H1,BL1,TL1,TTH1,H2,BL2,TL2,TTH2    *
46 C.    *                                                                *
47 C.    *   5       TUBE     RMIN,RMAX,DZ                                *
48 C.    *   6       TUBS     RMIN,RMAX,DZ,PHIMIN,PHIMAX                  *
49 C.    *   7       CONE     DZ,RMIN1,RMAX1,RMIN2,RMAX2                  *
50 C.    *   8       CONS     DZ,RMIN1,RMAX1,RMIN2,RMAX2,PHIMIN,PHIMAX    *
51 C.    *                                                                *
52 C.    *   9       SPHE     RMIN,RMAX,THEMIN,THEMAX,PHIMIN,PHIMAX       *
53 C.    *                                                                *
54 C.    *  10       PARA     DX,DY,DZ,TXY,TXZ,TYZ                        *
55 C.    *  11       PGON     PHIMIN,DPHI,NDIV,NZ,Z(1),RMIN(1),RMAX(1),...*
56 C.    *  12       PCON     PHIMIN,DPHI,NZ,Z(1),RMIN(1),RMAX(1),Z(2),...*
57 C.    *                                                                *
58 C.    * NOBJ = Counter of cg objects                                   *
59 C.    * NWWS = Size of Wire structure                                  *
60 C.    * IVOLNA = Name of volume                                        *
61 C.    * LSTEP = Number of CG objects forming each volume                *
62 C.    *                                                                *
63 C.    *    ==>Called by : GDRAW                                        *
64 C.    *       Author : P.Zanarini, J.Salt, S.Giani *********           *
65 C.    *                                                                *
66 C.    ******************************************************************
67 C.
68 #include "geant321/gcbank.inc"
69 #include "geant321/gcunit.inc"
70 #include "geant321/gcvolu.inc"
71 #include "geant321/gcgobj.inc"
72 #include "geant321/gcmutr.inc"
73 #include "geant321/gcdraw.inc"
74 #include "geant321/gchiln.inc"
75 #include "geant321/gcspee.inc"
76 #include "geant321/gconsp.inc"
77       SAVE NWPROD
78       COMMON /QUEST/IQUEST(100)
79       DIMENSION PAR(50),P(3,8)
80 *SG
81       DIMENSION RRMIN(3),RRMAX(3)
82       DIMENSION SLI1(4),SLI2(4),SPI1(4),SPI2(4)
83 *SG
84       DIMENSION XZ(2,4),ZR(18),RMIR(18),RMAR(18),AMIRMA(18),AMARMA(18)
85       DIMENSION T(4,3)
86 C.    ------------------------------------------------------------------
87 C.
88 **SG
89       CALL UCTOH('PERS',IPERS,4,4)
90       T(4,1)=0.
91       T(4,2)=0.
92       T(4,3)=0.
93       LINSTY=IBITS(LINATT,10,3)
94       IF(LINSTY.EQ.7)THEN
95          APPROS=30.
96       ELSE
97          APPROS=15.
98       ENDIF
99       IF(ISUBLI.LT.IOLDSU)THEN
100          PORGX=0
101          PORGY=0
102          PORGZ=0
103          DO 10  J=1,15
104             POX(J)=0
105             POY(J)=0
106             POZ(J)=0
107    10    CONTINUE
108       ENDIF
109       IOLDSU=ISUBLI
110 *
111 *       LHC flag 'ON' (default)
112 *
113 *      CALL UCTOH('ON  ',LHIF,4,4)
114 *      IF(LEP.EQ.LHIF)THEN
115 *         VITE=1
116 *      ELSE
117 *         VITE=0
118 *      ENDIF
119 *
120 * Flag for GDCGHI resetted for each CG object
121       ISG=0
122       ICGP=0
123       LINFIL=IBITS(LINATT,13,3)
124 **SG
125       IVCLOS=0
126       IVFUN=1
127       IWORK=ITASK
128       CALL UCTOH('ON  ',IFLH,4,4)
129 *JS
130       IF (ISHAPE.EQ.1) THEN
131 C
132 C             BOX
133 C
134          DX1=PAR(1)
135          DY1=PAR(2)
136          DX2=DX1
137          DY2=DY1
138          DZ=PAR(3)
139          GO TO 20
140 C
141       ELSEIF (ISHAPE.EQ.2) THEN
142 C
143 C             TRD1
144 C
145          DX1=PAR(1)
146          DX2=PAR(2)
147          DY1=PAR(3)
148          DY2=DY1
149          DZ=PAR(4)
150          GO TO 20
151 C
152       ELSEIF (ISHAPE.EQ.3) THEN
153 C
154 C             TRD2
155 C
156          DX1=PAR(1)
157          DX2=PAR(2)
158          DY1=PAR(3)
159          DY2=PAR(4)
160          DZ=PAR(5)
161          GO TO 20
162 C
163       ELSEIF (ISHAPE.EQ.4) THEN
164 C
165 C             TRAP
166 C
167          DZ=PAR(1)
168          TX=PAR(2)
169          TY=PAR(3)
170          H1=PAR(4)
171          BL1=PAR(5)
172          TL1=PAR(6)
173          TTH1=PAR(7)
174          H2=PAR(8)
175          BL2=PAR(9)
176          TL2=PAR(10)
177          TTH2=PAR(11)
178          GO TO 30
179 C
180       ELSEIF (ISHAPE.EQ.5) THEN
181 C
182 C             TUBE
183 C
184          AFINV=1./COS(PI/APPROS)
185          FINV=ABS(AFINV)
186          RMIN1=PAR(1)*FINV
187          RMAX1=PAR(2)*FINV
188          RMIN2=RMIN1
189          RMAX2=RMAX1
190          Z2=PAR(3)
191 *         Z1=-Z2
192          PHIMIN=0.
193          PHIMAX=360.
194          IF((LINFIL.EQ.2.OR.LINFIL.EQ.3)
195      +   .AND.RMIN1.NE.0)PHIMIN=5.
196 *SG
197          ANG1=PHIMIN
198          ANG2=PHIMAX
199          AANG=ABS(ANG2-ANG1)
200          AZLAT=AANG*APPROS
201          ZLAT=AZLAT/360
202          NANG=ZLAT
203          IF(NANG.EQ.0)NANG=1
204          AZ=ZLAT-NANG
205          IF(AZ.GT..5)NANG=NANG+1
206 *SG
207          GO TO 70
208 C
209       ELSEIF (ISHAPE.EQ.6.OR.ISHAPE.EQ.29) THEN
210 C
211 C             TUBS
212 C
213          AFINV=1./COS(PI/APPROS)
214          FINV=ABS(AFINV)
215          RMIN1=PAR(1)*FINV
216          RMAX1=PAR(2)*FINV
217          RMIN2=RMIN1
218          RMAX2=RMAX1
219          AZ2=PAR(3)
220          Z2=ABS(AZ2)
221 *         Z1=-Z2
222          PHIMIN=PAR(4)
223          PHIMAX=PAR(5)
224 **SG
225          ANG1=PHIMIN
226          ANG2=PHIMAX
227          AANG=ABS(ANG2-ANG1)
228          AZLAT=AANG*APPROS
229          ZLAT=AZLAT/360
230          NANG=ZLAT
231          IF(NANG.EQ.0)NANG=1
232          AZ=ZLAT-NANG
233          IF(AZ.GT..5)NANG=NANG+1
234          IF(ISHAPE.EQ.29)NANG=APPROS
235 **SG
236          GO TO 70
237 C
238       ELSEIF (ISHAPE.EQ.7) THEN
239 C
240 C             CONE
241 C
242          AFINV=1./COS(PI/APPROS)
243          FINV=ABS(AFINV)
244          RMIN1=PAR(2)*FINV
245          RMAX1=PAR(3)*FINV
246          RMIN2=PAR(4)*FINV
247          RMAX2=PAR(5)*FINV
248          Z2=PAR(1)
249 *         Z1=-Z2
250          PHIMIN=0.
251          PHIMAX=360.
252          IF((LINFIL.EQ.2.OR.LINFIL.EQ.3).AND.RMIN2.NE.0)PHIMIN=5.
253 *SG
254          ANG1=PHIMIN
255          ANG2=PHIMAX
256          AANG=ABS(ANG2-ANG1)
257          AZLAT=AANG*APPROS
258          ZLAT=AZLAT/360
259          NANG=ZLAT
260          IF(NANG.EQ.0)NANG=1
261          AZ=ZLAT-NANG
262          IF(AZ.GT..5)NANG=NANG+1
263 *SG
264          GO TO 70
265 C
266       ELSEIF (ISHAPE.EQ.8) THEN
267 C
268 C             CONS
269 C
270          AFINV=1./COS(PI/APPROS)
271          FINV=ABS(AFINV)
272          RMIN1=PAR(2)*FINV
273          RMAX1=PAR(3)*FINV
274          RMIN2=PAR(4)*FINV
275          RMAX2=PAR(5)*FINV
276          Z2=PAR(1)
277 *         Z1=-Z2
278          PHIMIN=PAR(6)
279          PHIMAX=PAR(7)
280 **SG
281          ANG1=PHIMIN
282          ANG2=PHIMAX+.1
283          AANG=ABS(ANG2-ANG1)
284          AZLAT=AANG*APPROS
285          ZLAT=AZLAT/360
286          NANG=ZLAT
287          IF(NANG.EQ.0)NANG=1
288          AZ=ZLAT-NANG
289          IF(AZ.GT..5)NANG=NANG+1
290 **SG
291          GO TO 70
292 C
293       ELSEIF (ISHAPE.EQ.9) THEN
294 C
295 C             SPHE
296 C
297 *         RMIN=PAR(1)
298          RMAX=PAR(2)
299          GO TO 120
300 C
301       ELSEIF (ISHAPE.EQ.10) THEN
302 C
303 C             PARA
304 C
305          DX=PAR(1)
306          DY=PAR(2)
307          DZ=PAR(3)
308          TXY=PAR(4)
309          TXZ=PAR(5)
310          TYZ=PAR(6)
311 C
312          TX=TXZ
313          TY=TYZ
314          H1=DY
315          BL1=DX
316          TL1=DX
317          TTH1=TXY
318          H2=DY
319          BL2=DX
320          TL2=DX
321          TTH2=TXY
322          GO TO 30
323 C
324       ELSEIF (ISHAPE.EQ.11) THEN
325 C
326 C             PGON
327 C
328          PHIMIN=PAR(1)
329          IF((LINFIL.EQ.2.OR.LINFIL.EQ.3).AND.PAR(2).GT.359.)PAR(2)=359.
330          PHIMAX=PHIMIN+PAR(2)
331          NDIVAN=PAR(3)
332          NZ=PAR(4)
333 C
334 C             Z(1)=PAR(5) - RMIN(1)=PAR(6) - RMAX(1)=PAR(7) - Z(2)=PAR(8
335 C
336          GO TO 150
337 C
338       ELSEIF (ISHAPE.EQ.12) THEN
339 C
340 C             PCON
341 C
342          PHIMIN=PAR(1)
343          IF((LINFIL.EQ.2.OR.LINFIL.EQ.3).AND.PAR(2).GT.359.)PAR(2)=359.
344          PHIMAX=PHIMIN+PAR(2)
345          NZ=PAR(3)
346 C
347 C             Z(1)=PAR(4) - RMIN(1)=PAR(5) - RMAX(1)=PAR(6) - Z(2)=PAR(7
348 C
349          GO TO 230
350       ELSE
351          GO TO 999
352       ENDIF
353 C
354 *      GO TO 150
355 C
356    20 CONTINUE
357 C
358 C             Rectilinear shapes: BOX,TRD1,TRD2
359 C
360       X1=0.
361       Y1=0.
362       X2=0.
363       Y2=0.
364       IF(DZ.LT.0.001)DZ=0.001
365       Z1=-DZ
366       Z2=DZ
367 C
368 C             Calculate the 8 vertex for rectilinear shapes
369 C
370       IF(DX1.EQ.0.)DX1=0.0001
371       IF(DY1.EQ.0.)DY1=0.0001
372       IF(DX2.EQ.0.)DX2=0.0001
373       IF(DY2.EQ.0.)DY2=0.0001
374       P(1,1)=X1+DX1
375       P(2,1)=Y1+DY1
376       P(3,1)=Z1
377       P(1,2)=X1-DX1
378       P(2,2)=Y1+DY1
379       P(3,2)=Z1
380       P(1,3)=X1-DX1
381       P(2,3)=Y1-DY1
382       P(3,3)=Z1
383       P(1,4)=X1+DX1
384       P(2,4)=Y1-DY1
385       P(3,4)=Z1
386       P(1,5)=X2+DX2
387       P(2,5)=Y2+DY2
388       P(3,5)=Z2
389       P(1,6)=X2-DX2
390       P(2,6)=Y2+DY2
391       P(3,6)=Z2
392       P(1,7)=X2-DX2
393       P(2,7)=Y2-DY2
394       P(3,7)=Z2
395       P(1,8)=X2+DX2
396       P(2,8)=Y2-DY2
397       P(3,8)=Z2
398 *
399       GOTO 40
400 C
401    30 CONTINUE
402 C
403 C             TRAP,PARA
404 C
405 C             Calculate the 8 vertex
406 C
407       P(1,1)=-DZ*TX+TTH1*H1+TL1
408       P(2,1)=+H1-DZ*TY
409       P(3,1)=-DZ
410       P(1,2)=-DZ*TX+TTH1*H1-TL1
411       P(2,2)=+H1-DZ*TY
412       P(3,2)=-DZ
413       P(1,3)=-DZ*TX-TTH1*H1-BL1
414       P(2,3)=-H1-DZ*TY
415       P(3,3)=-DZ
416       P(1,4)=-DZ*TX-TTH1*H1+BL1
417       P(2,4)=-H1-DZ*TY
418       P(3,4)=-DZ
419       P(1,5)=+DZ*TX+TTH2*H2+TL2
420       P(2,5)=+H2+DZ*TY
421       P(3,5)=+DZ
422       P(1,6)=+DZ*TX+TTH2*H2-TL2
423       P(2,6)=+H2+DZ*TY
424       P(3,6)=+DZ
425       P(1,7)=+DZ*TX-TTH2*H2-BL2
426       P(2,7)=-H2+DZ*TY
427       P(3,7)=+DZ
428       P(1,8)=+DZ*TX-TTH2*H2+BL2
429       P(2,8)=-H2+DZ*TY
430       P(3,8)=+DZ
431 C
432    40 CONTINUE
433 C
434 C       BOX,TRD1,TRD2,TRAP,PARA --->>  call CGBOX
435 C
436       IVCLOS=1
437 *SG
438 *  Size evaluation
439 *
440       IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
441 *  NWB = n. words for each box
442          NCGVOL=NCGVOL+NWB
443          GOTO 999
444       ENDIF
445       ICPOIN=JCGOBJ+1
446 *   Creating object
447 *SG
448       RMIN1=0
449       RMIN2=0
450       RMAX1=0
451       RMAX2=0
452       CALL CGBOX(P,4,4,300,Q(ICPOIN))
453       DO 50  J=1,3
454          T(J,1)=GRMAT(3*J-2,NLEVEL)
455          T(J,2)=GRMAT(3*J-1,NLEVEL)
456          T(J,3)=GRMAT(3*J,NLEVEL)
457    50 CONTINUE
458       CALL CGRIFL(T,Q(ICPOIN))
459       CGERR=Q(ICPOIN)
460       IF(CGERR.LE.0)THEN
461          CALL GDCGER(CGERR)
462          IF(KCGST.EQ.-2) GOTO 999
463          IF(KCGST.EQ.-3) THEN
464             KCGST=0
465             WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
466             CALL GMAIL(0,0)
467             GOTO 999
468          ENDIF
469       ENDIF
470       CALL CGCEV(1,Q(ICPOIN))
471       DO 60  J=1,3
472          T(J,1)=GRMAT(3*J-2,NLEVEL)
473          T(J,2)=GRMAT(3*J-1,NLEVEL)
474          T(J,3)=GRMAT(3*J,NLEVEL)
475    60 CONTINUE
476       CALL CGAFFI(T,Q(ICPOIN))
477       XV=GTRAN(1,NLEVEL)
478       YV=GTRAN(2,NLEVEL)
479       ZV=GTRAN(3,NLEVEL)
480       CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
481 ***SG
482 *    Shifting object
483       IF(KSHIFT.GT.0)THEN
484          CALL GDSHIF(IVOLNA,ICPOIN)
485       ENDIF
486 *
487       IF(GBOOM.NE.0)THEN
488          CALL GDBOMB(ICPOIN,ISHAPE)
489          IF(ITSTCU.EQ.0)GOTO 999
490       ENDIF
491 *
492 *
493 *
494 *   Hidden Volume Removal:
495 *   Computing volumes visibility and skipping
496 *   the unvisible ones; a great increase in speed
497 *   and a great reduction in n. of words used can be
498 *   obtained in this way.
499 *
500       CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
501       IF(ISUBLI.EQ.1)THEN
502          AA1=RRMIN(1)-S1
503          AA2=RRMIN(2)-S2
504          AA3=RRMIN(3)-S3
505          BB1=RRMAX(1)-SS1
506          BB2=RRMAX(2)-SS2
507          BB3=RRMAX(3)-SS3
508          IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND. BB1.LT.
509      +   0.001.AND.BB2.LT.0.001.AND.BB3.LT.0.001)THEN
510             IF(ISCOP.NE.1)THEN
511                IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
512                   ITSTCU=0
513                   NCGVOL=NCGVOL-NWB
514                   GOTO 999
515                ENDIF
516             ENDIF
517          ENDIF
518       ENDIF
519       IF(IPORLI.EQ.1)THEN
520          S1=RRMIN(1)
521          S2=RRMIN(2)
522          S3=RRMIN(3)
523          SS1=RRMAX(1)
524          SS2=RRMAX(2)
525          SS3=RRMAX(3)
526          SRAGMX=0
527          SRAGMN=0
528          RAINT1=0
529          RAINT2=0
530       ENDIF
531 *   Create clipping objects
532       IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
533 *   Perspective view
534       IF (IPRJ.EQ.IPERS) THEN
535          CALL CGPERS(Q(ICPOIN))
536       ENDIF
537 *   Inserting volumes in Hide + Wire Structures
538       CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
539       GOTO 999
540 ***SG
541 C
542    70 CONTINUE
543 C
544 C     TUBE,CONE,TUBS,CONS  -----> call CGZREV
545 C
546 *
547 *     Checking Shape Parameters
548 *
549       IF(RMIN1.GT.RMAX1) THEN
550          WRITE(CHMAIL,10100)ISHAPE,NAMES(NLEVEL)
551          CALL GMAIL(0,0)
552       ENDIF
553       IF(RMIN2.GT.RMAX2) THEN
554          WRITE(CHMAIL,10200)ISHAPE,NAMES(NLEVEL)
555          CALL GMAIL(0,0)
556       ENDIF
557       IF(PHIMIN.GT.PHIMAX)THEN
558          WRITE(CHMAIL,10300)ISHAPE,NAMES(NLEVEL)
559          CALL GMAIL(0,0)
560       ENDIF
561 *
562 *
563 *   Checking if all Inner Radii are  0. ==> 'Closed' Volume
564 *
565       IF(RMIN1.LE.0.00001.AND.RMIN2.LE.0.00001)IVCLOS=1
566 *SG
567 *   Size evaluation
568       IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
569 *   NWPROD = n. words for each body of revolution
570          NWPROD=NWREV*(NANG+1)
571          NCGVOL=NCGVOL+NWPROD
572          GOTO 999
573       ENDIF
574 *  Creating object
575       ICPOIN=JCGOBJ+1
576 *SG
577       IF(ISHAPE.EQ.29)THEN
578          SAL=PAR(8)
579          IF(PAR(11).GT.SAL)SAL=PAR(11)
580          PAR3=MAX(PAR(3),0.)
581          Z2=PAR3+1.001*RMAX1*SQRT((1-SAL*SAL)/(SAL*SAL))
582       ENDIF
583       XZ(1,1)=RMIN1
584       XZ(2,1)=-Z2
585       XZ(1,2)=RMAX1
586       XZ(2,2)=-Z2
587       XZ(1,3)=RMAX2
588       XZ(2,3)=Z2
589       XZ(1,4)=RMIN2
590       XZ(2,4)=Z2
591       CALL CGZREV(XZ,ANG1,ANG2,NANG,4000,Q(ICPOIN))
592       DO 80  J=1,3
593          T(J,1)=GRMAT(3*J-2,NLEVEL)
594          T(J,2)=GRMAT(3*J-1,NLEVEL)
595          T(J,3)=GRMAT(3*J,NLEVEL)
596    80 CONTINUE
597       CALL CGRIFL(T,Q(ICPOIN))
598       CGERR=Q(ICPOIN)
599       IF(CGERR.LE.0)THEN
600          CALL GDCGER(CGERR)
601          IF(KCGST.EQ.-2) GOTO 999
602          IF(KCGST.EQ.-3) THEN
603             KCGST=0
604             WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
605             CALL GMAIL(0,0)
606             GOTO 999
607          ENDIF
608       ENDIF
609       CALL CGCEV(1,Q(ICPOIN))
610       IF(ISHAPE.EQ.29)THEN
611          SLI1(1)=-PAR(6)
612          SLI1(2)=-PAR(7)
613          SLI1(3)=-PAR(8)
614          SLI1(4)=-PAR(3)*PAR(8)
615          SLI2(1)=-PAR(9)
616          SLI2(2)=-PAR(10)
617          SLI2(3)=-PAR(11)
618          SLI2(4)=+PAR(3)*PAR(11)
619          ISL1=JCGOBJ+4000
620          CALL CGSLIC(Q(ICPOIN),SLI1,4000,Q(ISL1))
621          ISL2=JCGOBJ+8000
622          CALL CGSLIC(Q(ISL1),SLI2,4000,Q(ISL2))
623          ICPOIN=ISL2
624          CALL CGCEV(1,Q(ICPOIN))
625       ENDIF
626       DO 90  J=1,3
627          T(J,1)=GRMAT(3*J-2,NLEVEL)
628          T(J,2)=GRMAT(3*J-1,NLEVEL)
629          T(J,3)=GRMAT(3*J,NLEVEL)
630    90 CONTINUE
631       CALL CGAFFI(T,Q(ICPOIN))
632       XV=GTRAN(1,NLEVEL)
633       YV=GTRAN(2,NLEVEL)
634       ZV=GTRAN(3,NLEVEL)
635       CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
636 ***SG
637 *    Shifting object
638       IF(KSHIFT.GT.0)THEN
639          CALL GDSHIF(IVOLNA,ICPOIN)
640       ENDIF
641 *
642       IF(GBOOM.NE.0)THEN
643          CALL GDBOMB(ICPOIN,ISHAPE)
644          IF(ITSTCU.EQ.0)GOTO 999
645       ENDIF
646 *
647 *
648 *   Hidden Volume Removal:
649 *   Computing closed volumes visibility and skipping
650 *   the unvisible ones; a great increase in speed
651 *   and a great reduction in n. of words used are obtained
652 *   in this way.
653 *
654       CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
655       IF(ISUBLI.EQ.1)THEN
656          AA1=RRMIN(1)-S1
657          AA2=RRMIN(2)-S2
658          AA3=RRMIN(3)-S3
659          BB1=RRMAX(1)-SS1
660          BB2=RRMAX(2)-SS2
661          BB3=RRMAX(3)-SS3
662          IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND. BB1.LT.
663      +   -0.001.AND.BB2.LT.-0.001.AND.BB3.LT.-0.001)THEN
664             IF(ISHAPE.EQ.7.OR.ISHAPE.EQ.8)THEN
665                IF((RMAX2.LT.SRAGMX.AND.RMAX1.LT.SRAGMN).OR. (SRAGMX.EQ.
666      +         0))THEN
667                   IF((RMIN2.GT.RAINT2.AND.RMIN1.GT.RAINT1).OR. (RAINT2.
668      +            EQ.0))THEN
669                      IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
670                         ITSTCU=0
671                         NCGVOL=NCGVOL-NWPROD
672                         GOTO 999
673                      ENDIF
674                   ENDIF
675                ENDIF
676             ELSEIF(SRAGMX.NE.0.)THEN
677                DO 100 ITER=1,IPORNT
678                   IF(RMAX1.EQ.PORMAR(ITER))GOTO 110
679                   IF(RMIN1.EQ.PORMIR(ITER))THEN
680                      IF(PORMIR(ITER).NE.0.)GOTO 110
681                   ENDIF
682   100          CONTINUE
683             ENDIF
684             IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
685                ITSTCU=0
686                NCGVOL=NCGVOL-NWPROD
687                GOTO 999
688             ENDIF
689          ENDIF
690       ENDIF
691       IF(IPORLI.EQ.1)THEN
692          S1=RRMIN(1)
693          S2=RRMIN(2)
694          S3=RRMIN(3)
695          SS1=RRMAX(1)
696          SS2=RRMAX(2)
697          SS3=RRMAX(3)
698          SRAGMX=RMAX2
699          SRAGMN=RMAX1
700          RAINT1=RMIN1
701          RAINT2=RMIN2
702          IPORNT=1
703          PORMAR(1)=RMAX2
704          PORMIR(1)=RMIN1
705       ENDIF
706   110 CONTINUE
707 *   Create clipping objects
708       IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
709 *   Perspective view
710       IF (IPRJ.EQ.IPERS) THEN
711          CALL CGPERS(Q(ICPOIN))
712       ENDIF
713 *   Inserting objects in Hide + Wire structures
714       CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
715       GOTO 999
716 ***SG
717 C
718   120 CONTINUE
719 C
720 C     SPHE  -----> call CGSPHE
721 C
722       IVCLOS=1
723 *SG
724 *   Size evaluation
725       IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
726 *  NWS = n. words for each sphere
727          NCGVOL=NCGVOL+NWS
728          GOTO 999
729       ENDIF
730 *
731       R=RMAX
732       RMAX2=R
733       RMAX1=0
734       RMIN1=0
735       RMIN2=0
736       NLAT=11
737       NLON=11
738       NWOR=4000
739       IF(IWORK.EQ.3.AND.(PAR(3).EQ.0.AND.(PAR(4).EQ.0.OR.
740      +PAR(4).EQ.180)))THEN
741          NLAT=29
742          NLON=29
743          NWOR=30000
744       ENDIF
745       ICPOIN=JCGOBJ+1
746 *  Creating object
747       CALL CGSPHE(R,NLAT,NLON,NWOR,Q(ICPOIN))
748       DO 130 J=1,3
749          T(J,1)=GRMAT(3*J-2,NLEVEL)
750          T(J,2)=GRMAT(3*J-1,NLEVEL)
751          T(J,3)=GRMAT(3*J,NLEVEL)
752   130 CONTINUE
753       CALL CGRIFL(T,Q(ICPOIN))
754 *SG
755       CGERR=Q(ICPOIN)
756       IF(CGERR.LE.0)THEN
757          CALL GDCGER(CGERR)
758          IF(KCGST.EQ.-2) GOTO 999
759          IF(KCGST.EQ.-3) THEN
760             KCGST=0
761             WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
762             CALL GMAIL(0,0)
763             GOTO 999
764          ENDIF
765       ENDIF
766       CALL CGCEV(1,Q(ICPOIN))
767       IF(PAR(3).NE.0.OR.(PAR(4).NE.0.AND.PAR(4).NE.180))THEN
768          ISHAPE=99
769          SPI1(1)=-COS((90-PAR(3))*DEGRAD)
770          SPI1(2)=0
771          SPI1(3)=-COS(PAR(3)*DEGRAD)
772          SPI1(4)=0
773          SPI2(1)=-COS((90-PAR(4))*DEGRAD)
774          SPI2(2)=0
775          SPI2(3)=-COS(PAR(4)*DEGRAD)
776          SPI2(4)=0
777          ISP1=JCGOBJ+4000
778          CALL CGSLIC(Q(ICPOIN),SPI1,4000,Q(ISP1))
779          ISP2=JCGOBJ+8000
780          CALL CGSLIC(Q(ISP1),SPI2,4000,Q(ISP2))
781          ICPOIN=ISP2
782          CALL CGCEV(1,Q(ICPOIN))
783       ENDIF
784       DO 140 J=1,3
785          T(J,1)=GRMAT(3*J-2,NLEVEL)
786          T(J,2)=GRMAT(3*J-1,NLEVEL)
787          T(J,3)=GRMAT(3*J,NLEVEL)
788   140 CONTINUE
789       CALL CGAFFI(T,Q(ICPOIN))
790       XV=GTRAN(1,NLEVEL)
791       YV=GTRAN(2,NLEVEL)
792       ZV=GTRAN(3,NLEVEL)
793       CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
794 ***SG
795 *    Shifting object
796       IF(KSHIFT.GT.0)THEN
797          CALL GDSHIF(IVOLNA,ICPOIN)
798       ENDIF
799 *
800       IF(GBOOM.NE.0)THEN
801          CALL GDBOMB(ICPOIN,ISHAPE)
802          IF(ITSTCU.EQ.0)GOTO 999
803       ENDIF
804 *
805 *
806 *   Hidden Volume Removal:
807 *   Computing closed volumes visibility and skipping
808 *   the unvisible ones; a great increase in speed
809 *   and a great reduction in n. of words used are obtained
810 *   in this way.
811 *
812       CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
813       IF(ISUBLI.EQ.1)THEN
814          AA1=RRMIN(1)-S1
815          AA2=RRMIN(2)-S2
816          AA3=RRMIN(3)-S3
817          BB1=RRMAX(1)-SS1
818          BB2=RRMAX(2)-SS2
819          BB3=RRMAX(3)-SS3
820          IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND. BB1.LT.
821      +   -0.001.AND.BB2.LT.-0.001.AND.BB3.LT.-0.001)THEN
822             IF(ISHAPE.NE.99)THEN
823                IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
824                   ITSTCU=0
825                   NCGVOL=NCGVOL-NWS
826                   GOTO 999
827                ENDIF
828             ENDIF
829          ENDIF
830       ENDIF
831       IF(IPORLI.EQ.1)THEN
832          S1=RRMIN(1)
833          S2=RRMIN(2)
834          S3=RRMIN(3)
835          SS1=RRMAX(1)
836          SS2=RRMAX(2)
837          SS3=RRMAX(3)
838          SRAGMX=R
839          SRAGMN=0.
840          RAINT1=0.
841          RAINT2=0.
842          IPORNT=1
843          PORMAR(1)=R
844          PORMIR(1)=0.
845       ENDIF
846 *   Create clipping objects
847       IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
848 *   Perspective view
849       IF (IPRJ.EQ.IPERS) THEN
850          CALL CGPERS(Q(ICPOIN))
851       ENDIF
852 *   Inserting objects in Hide + Wire structures
853       CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
854       GOTO 999
855 ***SG
856 *
857   150 CONTINUE
858 C
859 C         PGON   ---->  call CGZREV
860 C
861       NTVOL=NZ-1
862       ANG1=PHIMIN
863       ANG2=PHIMAX
864 **SG
865       AANG=ABS(ANG2-ANG1)
866       AZLAT=AANG*APPROS
867       ZLAT=AZLAT/360
868       NANG=ZLAT
869       IF(NANG.EQ.0)NANG=1
870       AZ=ZLAT-NANG
871       IF(AZ.GT..5)NANG=NANG+1
872       IF(NDIVAN.LT.NANG)THEN
873          NANG=NDIVAN
874 *         WRITE(CHMAIL,10400)NANG,NAMES(NLEVEL)
875 *         CALL GMAIL(0,0)
876       ENDIF
877       AATMAX=NANG*360./AANG
878       LATMAX=AATMAX
879       ALA=AATMAX-LATMAX
880       IF(ALA.GT..5)LATMAX=LATMAX+1
881 **SG
882       AFINV=1./COS(PI/LATMAX)
883       FINV=ABS(AFINV)
884       JSURZ=1
885       ZR(1)=PAR(5)
886       RMIR(1)=PAR(6)*FINV
887       RMAR(1)=PAR(7)*FINV
888 *SG
889       RMAR(1)=RMAR(1)+.001
890 *SG
891       DO 160 I=1,NTVOL
892 *         ZA=PAR(5+3*(I-1))
893          ZB=PAR(5+3*I)
894 **SG
895          ZB=ZB+.001
896 *********         DIFZ=ABS(ZB-ZA)
897 *********         IF(DIFZ.LT.0.001)GOTO 220
898 **SG
899          JSURZ=JSURZ+1
900          ZR(JSURZ)=ZB
901          RMIR(JSURZ)=PAR(6+3*I)*FINV
902          RMAR(JSURZ)=PAR(7+3*I)*FINV
903 **SG
904          RMAR(JSURZ)=RMAR(JSURZ)+.001
905 *
906   160 CONTINUE
907 *
908 *   Checking if all Inner Radii are  0. ==> 'Closed' Volume
909 *
910 *      NRAD=NTVOL+1
911 *      DO 230 I=1,NRAD
912 *         IF(RMIR(I).GT.0.00001)GOTO 240
913 *  230 CONTINUE
914 *      IVCLOS=1
915 *  240 CONTINUE
916 *
917 *   Size evaluation
918       IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
919          NCGVOL=NCGVOL+NWREV*(NANG+1)*NTVOL
920          GOTO 999
921       ENDIF
922       IF(IPORLI.EQ.1)THEN
923          SRAGMN=10000.
924          RAINT1=10000.
925       ENDIF
926 *
927       DO 220  IVOL=1,NTVOL
928          ISG=ISG+1
929          IVCLOS=1
930          IF((RMIR(IVOL).GT.0.00001).OR.(RMIR(IVOL+1).GT.
931      +   0.00001))IVCLOS=0
932          XZ(1,1)=RMIR(IVOL)
933          XZ(2,1)=ZR(IVOL)
934          XZ(1,2)=RMAR(IVOL)
935          XZ(2,2)=ZR(IVOL)
936          XZ(1,3)=RMAR(IVOL+1)
937          XZ(2,3)=ZR(IVOL+1)
938          XZ(1,4)=RMIR(IVOL+1)
939          XZ(2,4)=ZR(IVOL+1)
940          ZR(IVOL+1)=ZR(IVOL+1)+.001
941          ICPOIN=JCGOBJ+1
942 *   Creating object
943 **SG
944          CALL CGZREV(XZ,ANG1,ANG2,NANG,4000,Q(ICPOIN))
945          DO 170 J=1,3
946             T(J,1)=GRMAT(3*J-2,NLEVEL)
947             T(J,2)=GRMAT(3*J-1,NLEVEL)
948             T(J,3)=GRMAT(3*J,NLEVEL)
949   170    CONTINUE
950          CALL CGRIFL(T,Q(ICPOIN))
951          CGERR=Q(ICPOIN)
952          IF(CGERR.LE.0)THEN
953             CALL GDCGER(CGERR)
954             IF(KCGST.EQ.-2) GOTO 999
955             IF(KCGST.EQ.-3) THEN
956                KCGST=0
957                WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
958                CALL GMAIL(0,0)
959                WRITE(CHMAIL,10400)(PAR(I),I=1,4)
960                CALL GMAIL(0,0)
961                DO 180 J=1,NZ
962                   ZPR=PAR(5+(J-1)*3)
963                   RMIPR=PAR(6+(J-1)*3)
964                   RMAPR=PAR(7+(J-1)*3)
965                   WRITE(CHMAIL,10600)J,ZPR,RMIPR,RMAPR
966                   CALL GMAIL(0,0)
967   180          CONTINUE
968                GOTO 999
969             ENDIF
970          ENDIF
971          CALL CGCEV(1,Q(ICPOIN))
972          DO 190  J=1,3
973             T(J,1)=GRMAT(3*J-2,NLEVEL)
974             T(J,2)=GRMAT(3*J-1,NLEVEL)
975             T(J,3)=GRMAT(3*J,NLEVEL)
976   190    CONTINUE
977          CALL CGAFFI(T,Q(ICPOIN))
978          XV=GTRAN(1,NLEVEL)
979          YV=GTRAN(2,NLEVEL)
980          ZV=GTRAN(3,NLEVEL)
981          CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
982 ***SG
983 *    Shifting object
984          IF(KSHIFT.GT.0)THEN
985             CALL GDSHIF(IVOLNA,ICPOIN)
986          ENDIF
987 *
988          IF(GBOOM.NE.0)THEN
989             CALL GDBOMB(ICPOIN,ISHAPE)
990             IF(ITSTCU.EQ.0)GOTO 220
991          ENDIF
992 *
993 *
994 *   Hidden Volume Removal:
995 *   Computing closed volumes visibility and skipping
996 *   the unvisible ones; a great increase in speed
997 *   and a great reduction in n. of words used are obtained
998 *   in this way.
999 *
1000          CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
1001          IF(ISUBLI.EQ.1)THEN
1002             AA1=RRMIN(1)-S1
1003             AA2=RRMIN(2)-S2
1004             AA3=RRMIN(3)-S3
1005             BB1=RRMAX(1)-SS1
1006             BB2=RRMAX(2)-SS2
1007             BB3=RRMAX(3)-SS3
1008             IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND.
1009      +      BB1.LT.-0.001.AND.BB2.LT.-0.001.AND.BB3.LT.-0.001)THEN
1010                AMARMA(IVOL) =MIN(RMAR(IVOL),RMAR(IVOL+1))
1011                AMARMA(IVOL+1)=MAX(RMAR(IVOL),RMAR(IVOL+1))
1012                AMIRMA(IVOL) =MIN(RMIR(IVOL),RMIR(IVOL+1))
1013                AMIRMA(IVOL+1)=MAX(RMIR(IVOL),RMIR(IVOL+1))
1014                RMAX1=AMARMA(IVOL)
1015                RMAX2=AMARMA(IVOL+1)
1016                RMIN1=AMIRMA(IVOL)
1017                RMIN2=AMIRMA(IVOL+1)
1018                IF(SRAGMX.NE.0.)THEN
1019                   DO 200 ITER=1,IPORNT
1020                      IF(RMAX1.EQ.PORMAR(ITER).OR.RMAX2.EQ.PORMAR(ITER))
1021      +               GOTO 210
1022                      IF(RMIN1.EQ.PORMIR(ITER).OR.RMIN2.EQ.PORMIR(ITER))
1023      +               THEN
1024                         IF(PORMIR(ITER).NE.0.)GOTO 210
1025                      ENDIF
1026   200             CONTINUE
1027                ENDIF
1028                IF(ISCOP.EQ.1)THEN
1029                   IF((AMARMA(IVOL+1).GE.SRAGMX.OR.AMARMA(IVOL) .GT.SRAG
1030      +            MN))GOTO 210
1031                   IF((AMIRMA(IVOL+1).LE.RAINT2.OR.AMIRMA(IVOL)
1032      +            .LE.RAINT1).AND.(RAINT2.NE.0))GOTO 210
1033                ENDIF
1034                IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
1035                   ITSTCU=0
1036                   NCGVOL=NCGVOL-NWPROD
1037                   GOTO 220
1038                ENDIF
1039             ENDIF
1040          ENDIF
1041          IF(IPORLI.EQ.1)THEN
1042             IF(RRMIN(1).LT.S1)S1=RRMIN(1)
1043             IF(RRMIN(2).LT.S2)S2=RRMIN(2)
1044             IF(RRMIN(3).LT.S3)S3=RRMIN(3)
1045             IF(RRMAX(1).GT.SS1)SS1=RRMAX(1)
1046             IF(RRMAX(2).GT.SS2)SS2=RRMAX(2)
1047             IF(RRMAX(3).GT.SS3)SS3=RRMAX(3)
1048             IF(RMAR(IVOL).GT.SRAGMX)SRAGMX=RMAR(IVOL)
1049             IF(RMAR(IVOL).LT.SRAGMN)SRAGMN=RMAR(IVOL)
1050             IF(RMAR(IVOL+1).GT.SRAGMX)SRAGMX=RMAR(IVOL+1)
1051             IF(RMAR(IVOL+1).LT.SRAGMN)SRAGMN=RMAR(IVOL+1)
1052             IF(RMIR(IVOL).GT.RAINT2)RAINT2=RMIR(IVOL)
1053             IF(RMIR(IVOL).LT.RAINT1)RAINT1=RMIR(IVOL)
1054             IF(RMIR(IVOL+1).GT.RAINT2)RAINT2=RMIR(IVOL+1)
1055             IF(RMIR(IVOL+1).LT.RAINT1)RAINT1=RMIR(IVOL+1)
1056             PORMAR(IVOL)=RMAR(IVOL)
1057             PORMIR(IVOL)=RMIR(IVOL)
1058             IPORNT =NTVOL
1059          ENDIF
1060   210    CONTINUE
1061 *   Create clipping objects
1062          IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
1063 *   Perspective view
1064          IF (IPRJ.EQ.IPERS) THEN
1065             CALL CGPERS(Q(ICPOIN))
1066          ENDIF
1067 *   Inserting objects in Hide + Wire structures
1068          CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
1069 ***SG
1070   220 CONTINUE
1071       GOTO 999
1072 *
1073   230 CONTINUE
1074 C
1075 C         PCON    ---->  call CGZREV
1076 C
1077       NTVOL=NZ-1
1078       ANG1=PHIMIN
1079       ANG2=PHIMAX
1080 **SG
1081       AANG=ABS(ANG2-ANG1)
1082       AZLAT=AANG*APPROS
1083       ZLAT=AZLAT/360
1084       NANG=ZLAT
1085       IF(NANG.EQ.0)NANG=1
1086       AZ=ZLAT-NANG
1087       IF(AZ.GT..5)NANG=NANG+1
1088 **SG
1089       AFINV=1./COS(PI/APPROS)
1090       FINV=ABS(AFINV)
1091       JSURZ=1
1092       ZR(1)=PAR(4)
1093       RMIR(1)=PAR(5)*FINV
1094       RMAR(1)=PAR(6)*FINV
1095 *SG
1096       RMAR(1)=RMAR(1)+.1
1097 *SG
1098       DO 240 I=1,NTVOL
1099 *         ZA=PAR(4+3*(I-1))
1100          ZB=PAR(4+3*I)
1101 **SG
1102          ZB=ZB+.001
1103 ********         DIFZ=ABS(ZB-ZA)
1104 ********         IF(DIFZ.LT.0.001)GOTO 290
1105 **SG
1106          JSURZ=JSURZ+1
1107          ZR(JSURZ)=ZB
1108          RMIR(JSURZ)=PAR(5+3*I)*FINV
1109          RMAR(JSURZ)=PAR(6+3*I)*FINV
1110 **SG
1111          RMAR(JSURZ)=RMAR(JSURZ)+.1
1112 *
1113   240 CONTINUE
1114 *
1115 *   Checking if all Inner Radii are  0. ==> 'Closed' Volume
1116 *
1117 *      NRAD=NTVOL+1
1118 *      DO 300 I=1,NRAD
1119 *         IF(RMIR(I).GT.0.00001)GOTO 310
1120 *  300 CONTINUE
1121 *      IVCLOS=1
1122 *  310 CONTINUE
1123 *
1124 *
1125 *   Size evaluation
1126       IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
1127          NCGVOL=NCGVOL+NWREV*(NANG+1)*NTVOL
1128          GOTO 999
1129       ENDIF
1130       IF(IPORLI.EQ.1)THEN
1131          SRAGMN=10000.
1132          RAINT1=10000.
1133       ENDIF
1134 *
1135       DO 300 IVOL=1,NTVOL
1136          ISG=ISG+1
1137          IVCLOS=1
1138          IF((RMIR(IVOL).GT.0.00001).OR.(RMIR(IVOL+1).GT.
1139      +   0.00001))IVCLOS=0
1140          XZ(1,1)=RMIR(IVOL)
1141          XZ(2,1)=ZR(IVOL)
1142          XZ(1,2)=RMAR(IVOL)
1143          XZ(2,2)=ZR(IVOL)
1144          XZ(1,3)=RMAR(IVOL+1)
1145          XZ(2,3)=ZR(IVOL+1)
1146          XZ(1,4)=RMIR(IVOL+1)
1147          XZ(2,4)=ZR(IVOL+1)
1148          ZR(IVOL+1)=ZR(IVOL+1)+.1
1149          ICPOIN=JCGOBJ+1
1150 *  Creating object
1151 **SG
1152          CALL CGZREV(XZ,ANG1,ANG2,NANG,4000,Q(ICPOIN))
1153          DO 250 J=1,3
1154             T(J,1)=GRMAT(3*J-2,NLEVEL)
1155             T(J,2)=GRMAT(3*J-1,NLEVEL)
1156             T(J,3)=GRMAT(3*J,NLEVEL)
1157   250    CONTINUE
1158          CALL CGRIFL(T,Q(ICPOIN))
1159          CALL CGCEV(-1,Q(ICPOIN))
1160          CGERR=Q(ICPOIN)
1161          IF(CGERR.LE.0)THEN
1162             CALL GDCGER(CGERR)
1163             IF(KCGST.EQ.-2) GOTO 999
1164             IF(KCGST.EQ.-3) THEN
1165                KCGST=0
1166                WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
1167                CALL GMAIL(0,0)
1168                WRITE(CHMAIL,10500)(PAR(I),I=1,3)
1169                CALL GMAIL(0,0)
1170                DO 260 J=1,NZ
1171                   ZPR=PAR(4+(J-1)*3)
1172                   RMIPR=PAR(5+(J-1)*3)
1173                   RMAPR=PAR(6+(J-1)*3)
1174                   WRITE(CHMAIL,10600)J,ZPR,RMIPR,RMAPR
1175                   CALL GMAIL(0,0)
1176   260          CONTINUE
1177                GOTO 999
1178             ENDIF
1179          ENDIF
1180          CALL CGCEV(1,Q(ICPOIN))
1181          DO 270 J=1,3
1182             T(1,J)=GRMAT(3*J-2,NLEVEL)
1183             T(2,J)=GRMAT(3*J-1,NLEVEL)
1184             T(3,J)=GRMAT(3*J,NLEVEL)
1185             T(4,J)=0.
1186   270    CONTINUE
1187          CALL CGAFFI(T,Q(ICPOIN))
1188          XV=GTRAN(1,NLEVEL)
1189          YV=GTRAN(2,NLEVEL)
1190          ZV=GTRAN(3,NLEVEL)
1191          CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
1192 *
1193 ***SG
1194 *    Shifting object
1195          IF(KSHIFT.GT.0)THEN
1196             CALL GDSHIF(IVOLNA,ICPOIN)
1197          ENDIF
1198 *
1199          IF(GBOOM.NE.0)THEN
1200             CALL GDBOMB(ICPOIN,ISHAPE)
1201             IF(ITSTCU.EQ.0)GOTO 300
1202          ENDIF
1203 *
1204 *
1205 *   Hidden Volume Removal:
1206 *   Computing closed volumes visibility and skipping
1207 *   the unvisible ones; a great increase in speed
1208 *   and a great reduction in n. of words used are obtained
1209 *   in this way.
1210 *
1211          CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
1212          IF(ISUBLI.EQ.1)THEN
1213             AA1=RRMIN(1)-S1
1214             AA2=RRMIN(2)-S2
1215             AA3=RRMIN(3)-S3
1216             BB1=RRMAX(1)-SS1
1217             BB2=RRMAX(2)-SS2
1218             BB3=RRMAX(3)-SS3
1219             IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND.
1220      +      BB1.LT.-0.001.AND.BB2.LT.-0.001.AND.BB3.LT.-0.001)THEN
1221                AMARMA(IVOL) =MIN(RMAR(IVOL),RMAR(IVOL+1))
1222                AMARMA(IVOL+1)=MAX(RMAR(IVOL),RMAR(IVOL+1))
1223                AMIRMA(IVOL) =MIN(RMIR(IVOL),RMIR(IVOL+1))
1224                AMIRMA(IVOL+1)=MAX(RMIR(IVOL),RMIR(IVOL+1))
1225                RMAX1=AMARMA(IVOL)
1226                RMAX2=AMARMA(IVOL+1)
1227                RMIN1=AMIRMA(IVOL)
1228                RMIN2=AMIRMA(IVOL+1)
1229                IF(SRAGMX.NE.0.)THEN
1230                   DO 280 ITER=1,IPORNT
1231                      IF(RMAX1.EQ.PORMAR(ITER).OR.RMAX2.EQ.PORMAR(ITER))
1232      +               GOTO 290
1233                      IF(RMIN1.EQ.PORMIR(ITER).OR.RMIN2.EQ.PORMIR(ITER))
1234      +               THEN
1235                         IF(PORMIR(ITER).NE.0)GOTO 290
1236                      ENDIF
1237   280             CONTINUE
1238                ENDIF
1239                IF(ISCOP.EQ.1)THEN
1240                   IF((AMARMA(IVOL+1).GE.SRAGMX.OR.AMARMA(IVOL) .GE.SRAG
1241      +            MN))GOTO 290
1242                   IF((AMIRMA(IVOL+1).LE.RAINT2.AND.AMIRMA(IVOL)
1243      +            .LE.RAINT1).AND.(RAINT2.NE.0))GOTO 290
1244                ENDIF
1245                IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
1246                   NCGVOL=NCGVOL-NWPROD
1247                   ITSTCU=0
1248                   GOTO 300
1249                ENDIF
1250             ENDIF
1251          ENDIF
1252          IF(IPORLI.EQ.1)THEN
1253             IF(RRMIN(1).LT.S1)S1=RRMIN(1)
1254             IF(RRMIN(2).LT.S2)S2=RRMIN(2)
1255             IF(RRMIN(3).LT.S3)S3=RRMIN(3)
1256             IF(RRMAX(1).GT.SS1)SS1=RRMAX(1)
1257             IF(RRMAX(2).GT.SS2)SS2=RRMAX(2)
1258             IF(RRMAX(3).GT.SS3)SS3=RRMAX(3)
1259             IF(RMAR(IVOL).GT.SRAGMX)SRAGMX=RMAR(IVOL)
1260             IF(RMAR(IVOL).LT.SRAGMN)SRAGMN=RMAR(IVOL)
1261             IF(RMAR(IVOL+1).GT.SRAGMX)SRAGMX=RMAR(IVOL+1)
1262             IF(RMAR(IVOL+1).LT.SRAGMN)SRAGMN=RMAR(IVOL+1)
1263             IF(RMIR(IVOL).GT.RAINT2)RAINT2=RMIR(IVOL)
1264             IF(RMIR(IVOL).LT.RAINT1)RAINT1=RMIR(IVOL)
1265             IF(RMIR(IVOL+1).GT.RAINT2)RAINT2=RMIR(IVOL+1)
1266             IF(RMIR(IVOL+1).LT.RAINT1)RAINT1=RMIR(IVOL+1)
1267             PORMAR(IVOL)=RMAR(IVOL)
1268             PORMIR(IVOL)=RMIR(IVOL)
1269             IPORNT =NTVOL
1270          ENDIF
1271   290    CONTINUE
1272 *   Create clipping objects
1273          IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
1274 *   Perspective view
1275          IF (IPRJ.EQ.IPERS) THEN
1276             CALL CGPERS(Q(ICPOIN))
1277          ENDIF
1278 *   Inserting object in Hide + Wire structures
1279          CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
1280   300 CONTINUE
1281       GOTO 999
1282 *
1283 ***SG
1284 *
1285 10000   FORMAT(' Check Parameters of Shape ',I3,' in volume ',A4)
1286 10100   FORMAT(' Warning >>> RMIN1 greater than RMAX1 for shape '
1287      +  ,I3,' in volume ',A4)
1288 10200   FORMAT(' Warning >>> RMIN2 greater than RMAX2 for shape '
1289      +  ,I3,' in volume ',A4)
1290 10300   FORMAT(' Warning >>> PHIMIN greater than PHIMAX for shape'
1291      +  ,I3,' in volume ',A4)
1292 *10400   FORMAT(' PGON with NPDV = ',I5,' in volume ',A4,' NPDV very
1293 *     +  large . It must be < 30 . Volume will not be drawn. ')
1294 10400   FORMAT(' PHI1 = ',F8.3,' DPHI = ',F8.3,' NPDV = ',F8.1
1295      +  ,' NZ   = ',F8.1)
1296 10500   FORMAT(' PHI1 = ',F8.3,' DPHI = ',F8.3,' NZ  = ',F8.1)
1297 10600   FORMAT(' J = ',I5,' Z = ',F8.3,' RMIN = ',F8.3
1298      +  ,' RMAX = ',F8.3)
1299 *10800   FORMAT(' Please, increase size of Zebra store by ',I10,
1300 *     +         ' words')
1301 *
1302 ***SG
1303   999 END