GEANT321/gdraw/gdcgob.F

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