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