+++ /dev/null
-*
-* $Id$
-*
-* $Log$
-* Revision 1.1.1.1 1999/05/18 15:55:03 fca
-* AliRoot sources
-*
-* Revision 1.2 1996/02/27 10:02:05 ravndal
-* Drawing of PCON's optimized for 'HIDE ON'
-*
-* Revision 1.1.1.1 1995/10/24 10:20:20 cernlib
-* Geant
-*
-*
-#include "geant321/pilot.h"
-*CMZ : 3.21/04 13/12/94 17.13.38 by S.Giani
-*-- Author :
-*
- SUBROUTINE GDCGOB(ITASK,ISHAPE,PAR,NOBJ,NWWS,IVOLNA,
- +LSTEP)
-C.
-C. ******************************************************************
-C. * *
-C. * Make the CG-Object with shape ISHAPE of parameters PAR *
-C. * with the same logic as GDRAWS. 1992 *
-C. * *
-C. * Input Parameters : *
-C. * *
-C. * ITASK: Number for indicating the task to be performed *
-C. * *
-C. * *
-C. * = 0 Counting task *
-C. * = 1 Slicing + Counting *
-C. * = 2 Clipping + Counting *
-C. * = 3 Insert into the H.S. + Convert to Wire *
-C. * = 4 Slicing + Insert into the H.S. + Convert *
-C. * to Wire *
-C. * = 5 Clipping + Insert into the H.S. + Convert *
-C. * to Wire *
-C. * *
-C. * SHAPE SHAPE SHAPE *
-C. * NUMBER TYPE PARAMETERS *
-C. * -------------------------------------------------------------- *
-C. * *
-C. * 1 BOX DX,DY,DZ *
-C. * 2 TRD1 DX1,DX2,DY,DZ *
-C. * 3 TRD2 DX1,DX2,DY1,DY2,DZ *
-C. * 4 TRAP DZ,TX,TY,H1,BL1,TL1,TTH1,H2,BL2,TL2,TTH2 *
-C. * *
-C. * 5 TUBE RMIN,RMAX,DZ *
-C. * 6 TUBS RMIN,RMAX,DZ,PHIMIN,PHIMAX *
-C. * 7 CONE DZ,RMIN1,RMAX1,RMIN2,RMAX2 *
-C. * 8 CONS DZ,RMIN1,RMAX1,RMIN2,RMAX2,PHIMIN,PHIMAX *
-C. * *
-C. * 9 SPHE RMIN,RMAX,THEMIN,THEMAX,PHIMIN,PHIMAX *
-C. * *
-C. * 10 PARA DX,DY,DZ,TXY,TXZ,TYZ *
-C. * 11 PGON PHIMIN,DPHI,NDIV,NZ,Z(1),RMIN(1),RMAX(1),...*
-C. * 12 PCON PHIMIN,DPHI,NZ,Z(1),RMIN(1),RMAX(1),Z(2),...*
-C. * *
-C. * NOBJ = Counter of cg objects *
-C. * NWWS = Size of Wire structure *
-C. * IVOLNA = Name of volume *
-C. * LSTEP = Number of CG objects forming each volume *
-C. * *
-C. * ==>Called by : GDRAW *
-C. * Author : P.Zanarini, J.Salt, S.Giani ********* *
-C. * *
-C. ******************************************************************
-C.
-#include "geant321/gcbank.inc"
-#include "geant321/gcunit.inc"
-#include "geant321/gcvolu.inc"
-#include "geant321/gcgobj.inc"
-#include "geant321/gcmutr.inc"
-#include "geant321/gcdraw.inc"
-#include "geant321/gchiln.inc"
-#include "geant321/gcspee.inc"
-#include "geant321/gconsp.inc"
- SAVE NWPROD
- COMMON /QUEST/IQUEST(100)
- DIMENSION PAR(100),P(3,8)
-*SG
- DIMENSION RRMIN(3),RRMAX(3)
- DIMENSION SLI1(4),SLI2(4),SPI1(4),SPI2(4)
-*SG
- DIMENSION XZ(2,4),ZR(18),RMIR(18),RMAR(18),AMIRMA(18),AMARMA(18)
- DIMENSION T(4,3)
-C. ------------------------------------------------------------------
-C.
-**SG
- CALL UCTOH('PERS',IPERS,4,4)
- T(4,1)=0.
- T(4,2)=0.
- T(4,3)=0.
- LINSTY=IBITS(LINATT,10,3)
- IF(LINSTY.EQ.7)THEN
- APPROS=30.
- ELSE
- APPROS=15.
- ENDIF
- IF(ISUBLI.LT.IOLDSU)THEN
- PORGX=0
- PORGY=0
- PORGZ=0
- DO 10 J=1,15
- POX(J)=0
- POY(J)=0
- POZ(J)=0
- 10 CONTINUE
- ENDIF
- IOLDSU=ISUBLI
-*
-* LHC flag 'ON' (default)
-*
-* CALL UCTOH('ON ',LHIF,4,4)
-* IF(LEP.EQ.LHIF)THEN
-* VITE=1
-* ELSE
-* VITE=0
-* ENDIF
-*
-* Flag for GDCGHI resetted for each CG object
- ISG=0
- ICGP=0
- LINFIL=IBITS(LINATT,13,3)
-**SG
- IVCLOS=0
- IVFUN=1
- IWORK=ITASK
- CALL UCTOH('ON ',IFLH,4,4)
-*JS
- IF (ISHAPE.EQ.1) THEN
-C
-C BOX
-C
- DX1=PAR(1)
- DY1=PAR(2)
- DX2=DX1
- DY2=DY1
- DZ=PAR(3)
- GO TO 20
-C
- ELSEIF (ISHAPE.EQ.2) THEN
-C
-C TRD1
-C
- DX1=PAR(1)
- DX2=PAR(2)
- DY1=PAR(3)
- DY2=DY1
- DZ=PAR(4)
- GO TO 20
-C
- ELSEIF (ISHAPE.EQ.3) THEN
-C
-C TRD2
-C
- DX1=PAR(1)
- DX2=PAR(2)
- DY1=PAR(3)
- DY2=PAR(4)
- DZ=PAR(5)
- GO TO 20
-C
- ELSEIF (ISHAPE.EQ.4) THEN
-C
-C TRAP
-C
- DZ=PAR(1)
- TX=PAR(2)
- TY=PAR(3)
- H1=PAR(4)
- BL1=PAR(5)
- TL1=PAR(6)
- TTH1=PAR(7)
- H2=PAR(8)
- BL2=PAR(9)
- TL2=PAR(10)
- TTH2=PAR(11)
- GO TO 30
-C
- ELSEIF (ISHAPE.EQ.5) THEN
-C
-C TUBE
-C
- AFINV=1./COS(PI/APPROS)
- FINV=ABS(AFINV)
- RMIN1=PAR(1)*FINV
- RMAX1=PAR(2)*FINV
- RMIN2=RMIN1
- RMAX2=RMAX1
- Z2=PAR(3)
-* Z1=-Z2
- PHIMIN=0.
- PHIMAX=360.
- IF((LINFIL.EQ.2.OR.LINFIL.EQ.3)
- + .AND.RMIN1.NE.0)PHIMIN=5.
-*SG
- ANG1=PHIMIN
- ANG2=PHIMAX
- AANG=ABS(ANG2-ANG1)
- AZLAT=AANG*APPROS
- ZLAT=AZLAT/360
- NANG=ZLAT
- IF(NANG.EQ.0)NANG=1
- AZ=ZLAT-NANG
- IF(AZ.GT..5)NANG=NANG+1
-*SG
- GO TO 70
-C
- ELSEIF (ISHAPE.EQ.6.OR.ISHAPE.EQ.29) THEN
-C
-C TUBS
-C
- AFINV=1./COS(PI/APPROS)
- FINV=ABS(AFINV)
- RMIN1=PAR(1)*FINV
- RMAX1=PAR(2)*FINV
- RMIN2=RMIN1
- RMAX2=RMAX1
- AZ2=PAR(3)
- Z2=ABS(AZ2)
-* Z1=-Z2
- PHIMIN=PAR(4)
- PHIMAX=PAR(5)
-**SG
- ANG1=PHIMIN
- ANG2=PHIMAX
- AANG=ABS(ANG2-ANG1)
- AZLAT=AANG*APPROS
- ZLAT=AZLAT/360
- NANG=ZLAT
- IF(NANG.EQ.0)NANG=1
- AZ=ZLAT-NANG
- IF(AZ.GT..5)NANG=NANG+1
- IF(ISHAPE.EQ.29)NANG=APPROS
-**SG
- GO TO 70
-C
- ELSEIF (ISHAPE.EQ.7) THEN
-C
-C CONE
-C
- AFINV=1./COS(PI/APPROS)
- FINV=ABS(AFINV)
- RMIN1=PAR(2)*FINV
- RMAX1=PAR(3)*FINV
- RMIN2=PAR(4)*FINV
- RMAX2=PAR(5)*FINV
- Z2=PAR(1)
-* Z1=-Z2
- PHIMIN=0.
- PHIMAX=360.
- IF((LINFIL.EQ.2.OR.LINFIL.EQ.3).AND.RMIN2.NE.0)PHIMIN=5.
-*SG
- ANG1=PHIMIN
- ANG2=PHIMAX
- AANG=ABS(ANG2-ANG1)
- AZLAT=AANG*APPROS
- ZLAT=AZLAT/360
- NANG=ZLAT
- IF(NANG.EQ.0)NANG=1
- AZ=ZLAT-NANG
- IF(AZ.GT..5)NANG=NANG+1
-*SG
- GO TO 70
-C
- ELSEIF (ISHAPE.EQ.8) THEN
-C
-C CONS
-C
- AFINV=1./COS(PI/APPROS)
- FINV=ABS(AFINV)
- RMIN1=PAR(2)*FINV
- RMAX1=PAR(3)*FINV
- RMIN2=PAR(4)*FINV
- RMAX2=PAR(5)*FINV
- Z2=PAR(1)
-* Z1=-Z2
- PHIMIN=PAR(6)
- PHIMAX=PAR(7)
-**SG
- ANG1=PHIMIN
- ANG2=PHIMAX+.1
- AANG=ABS(ANG2-ANG1)
- AZLAT=AANG*APPROS
- ZLAT=AZLAT/360
- NANG=ZLAT
- IF(NANG.EQ.0)NANG=1
- AZ=ZLAT-NANG
- IF(AZ.GT..5)NANG=NANG+1
-**SG
- GO TO 70
-C
- ELSEIF (ISHAPE.EQ.9) THEN
-C
-C SPHE
-C
-* RMIN=PAR(1)
- RMAX=PAR(2)
- GO TO 120
-C
- ELSEIF (ISHAPE.EQ.10) THEN
-C
-C PARA
-C
- DX=PAR(1)
- DY=PAR(2)
- DZ=PAR(3)
- TXY=PAR(4)
- TXZ=PAR(5)
- TYZ=PAR(6)
-C
- TX=TXZ
- TY=TYZ
- H1=DY
- BL1=DX
- TL1=DX
- TTH1=TXY
- H2=DY
- BL2=DX
- TL2=DX
- TTH2=TXY
- GO TO 30
-C
- ELSEIF (ISHAPE.EQ.11) THEN
-C
-C PGON
-C
- PHIMIN=PAR(1)
- IF((LINFIL.EQ.2.OR.LINFIL.EQ.3).AND.PAR(2).GT.359.)PAR(2)=359.
- PHIMAX=PHIMIN+PAR(2)
- NDIVAN=PAR(3)
- NZ=PAR(4)
-C
-C Z(1)=PAR(5) - RMIN(1)=PAR(6) - RMAX(1)=PAR(7) - Z(2)=PAR(8
-C
- GO TO 150
-C
- ELSEIF (ISHAPE.EQ.12) THEN
-C
-C PCON
-C
- PHIMIN=PAR(1)
- IF((LINFIL.EQ.2.OR.LINFIL.EQ.3).AND.PAR(2).GT.359.)PAR(2)=359.
- PHIMAX=PHIMIN+PAR(2)
- NZ=PAR(3)
-C
-C Z(1)=PAR(4) - RMIN(1)=PAR(5) - RMAX(1)=PAR(6) - Z(2)=PAR(7
-C
- GO TO 230
- ELSE
- GO TO 999
- ENDIF
-C
-* GO TO 150
-C
- 20 CONTINUE
-C
-C Rectilinear shapes: BOX,TRD1,TRD2
-C
- X1=0.
- Y1=0.
- X2=0.
- Y2=0.
- IF(DZ.LT.0.001)DZ=0.001
- Z1=-DZ
- Z2=DZ
-C
-C Calculate the 8 vertex for rectilinear shapes
-C
- IF(DX1.EQ.0.)DX1=0.0001
- IF(DY1.EQ.0.)DY1=0.0001
- IF(DX2.EQ.0.)DX2=0.0001
- IF(DY2.EQ.0.)DY2=0.0001
- P(1,1)=X1+DX1
- P(2,1)=Y1+DY1
- P(3,1)=Z1
- P(1,2)=X1-DX1
- P(2,2)=Y1+DY1
- P(3,2)=Z1
- P(1,3)=X1-DX1
- P(2,3)=Y1-DY1
- P(3,3)=Z1
- P(1,4)=X1+DX1
- P(2,4)=Y1-DY1
- P(3,4)=Z1
- P(1,5)=X2+DX2
- P(2,5)=Y2+DY2
- P(3,5)=Z2
- P(1,6)=X2-DX2
- P(2,6)=Y2+DY2
- P(3,6)=Z2
- P(1,7)=X2-DX2
- P(2,7)=Y2-DY2
- P(3,7)=Z2
- P(1,8)=X2+DX2
- P(2,8)=Y2-DY2
- P(3,8)=Z2
-*
- GOTO 40
-C
- 30 CONTINUE
-C
-C TRAP,PARA
-C
-C Calculate the 8 vertex
-C
- P(1,1)=-DZ*TX+TTH1*H1+TL1
- P(2,1)=+H1-DZ*TY
- P(3,1)=-DZ
- P(1,2)=-DZ*TX+TTH1*H1-TL1
- P(2,2)=+H1-DZ*TY
- P(3,2)=-DZ
- P(1,3)=-DZ*TX-TTH1*H1-BL1
- P(2,3)=-H1-DZ*TY
- P(3,3)=-DZ
- P(1,4)=-DZ*TX-TTH1*H1+BL1
- P(2,4)=-H1-DZ*TY
- P(3,4)=-DZ
- P(1,5)=+DZ*TX+TTH2*H2+TL2
- P(2,5)=+H2+DZ*TY
- P(3,5)=+DZ
- P(1,6)=+DZ*TX+TTH2*H2-TL2
- P(2,6)=+H2+DZ*TY
- P(3,6)=+DZ
- P(1,7)=+DZ*TX-TTH2*H2-BL2
- P(2,7)=-H2+DZ*TY
- P(3,7)=+DZ
- P(1,8)=+DZ*TX-TTH2*H2+BL2
- P(2,8)=-H2+DZ*TY
- P(3,8)=+DZ
-C
- 40 CONTINUE
-C
-C BOX,TRD1,TRD2,TRAP,PARA --->> call CGBOX
-C
- IVCLOS=1
-*SG
-* Size evaluation
-*
- IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
-* NWB = n. words for each box
- NCGVOL=NCGVOL+NWB
- GOTO 999
- ENDIF
- ICPOIN=JCGOBJ+1
-* Creating object
-*SG
- RMIN1=0
- RMIN2=0
- RMAX1=0
- RMAX2=0
- CALL CGBOX(P,4,4,300,Q(ICPOIN))
- DO 50 J=1,3
- T(J,1)=GRMAT(3*J-2,NLEVEL)
- T(J,2)=GRMAT(3*J-1,NLEVEL)
- T(J,3)=GRMAT(3*J,NLEVEL)
- 50 CONTINUE
- CALL CGRIFL(T,Q(ICPOIN))
- CGERR=Q(ICPOIN)
- IF(CGERR.LE.0)THEN
- CALL GDCGER(CGERR)
- IF(KCGST.EQ.-2) GOTO 999
- IF(KCGST.EQ.-3) THEN
- KCGST=0
- WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
- CALL GMAIL(0,0)
- GOTO 999
- ENDIF
- ENDIF
- CALL CGCEV(1,Q(ICPOIN))
- DO 60 J=1,3
- T(J,1)=GRMAT(3*J-2,NLEVEL)
- T(J,2)=GRMAT(3*J-1,NLEVEL)
- T(J,3)=GRMAT(3*J,NLEVEL)
- 60 CONTINUE
- CALL CGAFFI(T,Q(ICPOIN))
- XV=GTRAN(1,NLEVEL)
- YV=GTRAN(2,NLEVEL)
- ZV=GTRAN(3,NLEVEL)
- CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
-***SG
-* Shifting object
- IF(KSHIFT.GT.0)THEN
- CALL GDSHIF(IVOLNA,ICPOIN)
- ENDIF
-*
- IF(GBOOM.NE.0)THEN
- CALL GDBOMB(ICPOIN,ISHAPE)
- IF(ITSTCU.EQ.0)GOTO 999
- ENDIF
-*
-*
-*
-* Hidden Volume Removal:
-* Computing volumes visibility and skipping
-* the unvisible ones; a great increase in speed
-* and a great reduction in n. of words used can be
-* obtained in this way.
-*
- CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
- IF(ISUBLI.EQ.1)THEN
- AA1=RRMIN(1)-S1
- AA2=RRMIN(2)-S2
- AA3=RRMIN(3)-S3
- BB1=RRMAX(1)-SS1
- BB2=RRMAX(2)-SS2
- BB3=RRMAX(3)-SS3
- IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND. BB1.LT.
- + 0.001.AND.BB2.LT.0.001.AND.BB3.LT.0.001)THEN
- IF(ISCOP.NE.1)THEN
- IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
- ITSTCU=0
- NCGVOL=NCGVOL-NWB
- GOTO 999
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- IF(IPORLI.EQ.1)THEN
- S1=RRMIN(1)
- S2=RRMIN(2)
- S3=RRMIN(3)
- SS1=RRMAX(1)
- SS2=RRMAX(2)
- SS3=RRMAX(3)
- SRAGMX=0
- SRAGMN=0
- RAINT1=0
- RAINT2=0
- ENDIF
-* Create clipping objects
- IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
-* Perspective view
- IF (IPRJ.EQ.IPERS) THEN
- CALL CGPERS(Q(ICPOIN))
- ENDIF
-* Inserting volumes in Hide + Wire Structures
- CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
- GOTO 999
-***SG
-C
- 70 CONTINUE
-C
-C TUBE,CONE,TUBS,CONS -----> call CGZREV
-C
-*
-* Checking Shape Parameters
-*
- IF(RMIN1.GT.RMAX1) THEN
- WRITE(CHMAIL,10100)ISHAPE,NAMES(NLEVEL)
- CALL GMAIL(0,0)
- ENDIF
- IF(RMIN2.GT.RMAX2) THEN
- WRITE(CHMAIL,10200)ISHAPE,NAMES(NLEVEL)
- CALL GMAIL(0,0)
- ENDIF
- IF(PHIMIN.GT.PHIMAX)THEN
- WRITE(CHMAIL,10300)ISHAPE,NAMES(NLEVEL)
- CALL GMAIL(0,0)
- ENDIF
-*
-*
-* Checking if all Inner Radii are 0. ==> 'Closed' Volume
-*
- IF(RMIN1.LE.0.00001.AND.RMIN2.LE.0.00001)IVCLOS=1
-*SG
-* Size evaluation
- IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
-* NWPROD = n. words for each body of revolution
- NWPROD=NWREV*(NANG+1)
- NCGVOL=NCGVOL+NWPROD
- GOTO 999
- ENDIF
-* Creating object
- ICPOIN=JCGOBJ+1
-*SG
- IF(ISHAPE.EQ.29)THEN
- SAL=PAR(8)
- IF(PAR(11).GT.SAL)SAL=PAR(11)
- PAR3=MAX(PAR(3),0.)
- Z2=PAR3+1.001*RMAX1*SQRT((1-SAL*SAL)/(SAL*SAL))
- ENDIF
- XZ(1,1)=RMIN1
- XZ(2,1)=-Z2
- XZ(1,2)=RMAX1
- XZ(2,2)=-Z2
- XZ(1,3)=RMAX2
- XZ(2,3)=Z2
- XZ(1,4)=RMIN2
- XZ(2,4)=Z2
- CALL CGZREV(XZ,ANG1,ANG2,NANG,4000,Q(ICPOIN))
- DO 80 J=1,3
- T(J,1)=GRMAT(3*J-2,NLEVEL)
- T(J,2)=GRMAT(3*J-1,NLEVEL)
- T(J,3)=GRMAT(3*J,NLEVEL)
- 80 CONTINUE
- CALL CGRIFL(T,Q(ICPOIN))
- CGERR=Q(ICPOIN)
- IF(CGERR.LE.0)THEN
- CALL GDCGER(CGERR)
- IF(KCGST.EQ.-2) GOTO 999
- IF(KCGST.EQ.-3) THEN
- KCGST=0
- WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
- CALL GMAIL(0,0)
- GOTO 999
- ENDIF
- ENDIF
- CALL CGCEV(1,Q(ICPOIN))
- IF(ISHAPE.EQ.29)THEN
- SLI1(1)=-PAR(6)
- SLI1(2)=-PAR(7)
- SLI1(3)=-PAR(8)
- SLI1(4)=-PAR(3)*PAR(8)
- SLI2(1)=-PAR(9)
- SLI2(2)=-PAR(10)
- SLI2(3)=-PAR(11)
- SLI2(4)=+PAR(3)*PAR(11)
- ISL1=JCGOBJ+4000
- CALL CGSLIC(Q(ICPOIN),SLI1,4000,Q(ISL1))
- ISL2=JCGOBJ+8000
- CALL CGSLIC(Q(ISL1),SLI2,4000,Q(ISL2))
- ICPOIN=ISL2
- CALL CGCEV(1,Q(ICPOIN))
- ENDIF
- DO 90 J=1,3
- T(J,1)=GRMAT(3*J-2,NLEVEL)
- T(J,2)=GRMAT(3*J-1,NLEVEL)
- T(J,3)=GRMAT(3*J,NLEVEL)
- 90 CONTINUE
- CALL CGAFFI(T,Q(ICPOIN))
- XV=GTRAN(1,NLEVEL)
- YV=GTRAN(2,NLEVEL)
- ZV=GTRAN(3,NLEVEL)
- CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
-***SG
-* Shifting object
- IF(KSHIFT.GT.0)THEN
- CALL GDSHIF(IVOLNA,ICPOIN)
- ENDIF
-*
- IF(GBOOM.NE.0)THEN
- CALL GDBOMB(ICPOIN,ISHAPE)
- IF(ITSTCU.EQ.0)GOTO 999
- ENDIF
-*
-*
-* Hidden Volume Removal:
-* Computing closed volumes visibility and skipping
-* the unvisible ones; a great increase in speed
-* and a great reduction in n. of words used are obtained
-* in this way.
-*
- CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
- IF(ISUBLI.EQ.1)THEN
- AA1=RRMIN(1)-S1
- AA2=RRMIN(2)-S2
- AA3=RRMIN(3)-S3
- BB1=RRMAX(1)-SS1
- BB2=RRMAX(2)-SS2
- BB3=RRMAX(3)-SS3
- IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND. BB1.LT.
- + -0.001.AND.BB2.LT.-0.001.AND.BB3.LT.-0.001)THEN
- IF(ISHAPE.EQ.7.OR.ISHAPE.EQ.8)THEN
- IF((RMAX2.LT.SRAGMX.AND.RMAX1.LT.SRAGMN).OR. (SRAGMX.EQ.
- + 0))THEN
- IF((RMIN2.GT.RAINT2.AND.RMIN1.GT.RAINT1).OR. (RAINT2.
- + EQ.0))THEN
- IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
- ITSTCU=0
- NCGVOL=NCGVOL-NWPROD
- GOTO 999
- ENDIF
- ENDIF
- ENDIF
- ELSEIF(SRAGMX.NE.0.)THEN
- DO 100 ITER=1,IPORNT
- IF(RMAX1.EQ.PORMAR(ITER))GOTO 110
- IF(RMIN1.EQ.PORMIR(ITER))THEN
- IF(PORMIR(ITER).NE.0.)GOTO 110
- ENDIF
- 100 CONTINUE
- ENDIF
- IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
- ITSTCU=0
- NCGVOL=NCGVOL-NWPROD
- GOTO 999
- ENDIF
- ENDIF
- ENDIF
- IF(IPORLI.EQ.1)THEN
- S1=RRMIN(1)
- S2=RRMIN(2)
- S3=RRMIN(3)
- SS1=RRMAX(1)
- SS2=RRMAX(2)
- SS3=RRMAX(3)
- SRAGMX=RMAX2
- SRAGMN=RMAX1
- RAINT1=RMIN1
- RAINT2=RMIN2
- IPORNT=1
- PORMAR(1)=RMAX2
- PORMIR(1)=RMIN1
- ENDIF
- 110 CONTINUE
-* Create clipping objects
- IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
-* Perspective view
- IF (IPRJ.EQ.IPERS) THEN
- CALL CGPERS(Q(ICPOIN))
- ENDIF
-* Inserting objects in Hide + Wire structures
- CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
- GOTO 999
-***SG
-C
- 120 CONTINUE
-C
-C SPHE -----> call CGSPHE
-C
- IVCLOS=1
-*SG
-* Size evaluation
- IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
-* NWS = n. words for each sphere
- NCGVOL=NCGVOL+NWS
- GOTO 999
- ENDIF
-*
- R=RMAX
- RMAX2=R
- RMAX1=0
- RMIN1=0
- RMIN2=0
- NLAT=11
- NLON=11
- NWOR=4000
- IF(IWORK.EQ.3.AND.(PAR(3).EQ.0.AND.(PAR(4).EQ.0.OR.
- +PAR(4).EQ.180)))THEN
- NLAT=29
- NLON=29
- NWOR=30000
- ENDIF
- ICPOIN=JCGOBJ+1
-* Creating object
- CALL CGSPHE(R,NLAT,NLON,NWOR,Q(ICPOIN))
- DO 130 J=1,3
- T(J,1)=GRMAT(3*J-2,NLEVEL)
- T(J,2)=GRMAT(3*J-1,NLEVEL)
- T(J,3)=GRMAT(3*J,NLEVEL)
- 130 CONTINUE
- CALL CGRIFL(T,Q(ICPOIN))
-*SG
- CGERR=Q(ICPOIN)
- IF(CGERR.LE.0)THEN
- CALL GDCGER(CGERR)
- IF(KCGST.EQ.-2) GOTO 999
- IF(KCGST.EQ.-3) THEN
- KCGST=0
- WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
- CALL GMAIL(0,0)
- GOTO 999
- ENDIF
- ENDIF
- CALL CGCEV(1,Q(ICPOIN))
- IF(PAR(3).NE.0.OR.(PAR(4).NE.0.AND.PAR(4).NE.180))THEN
- ISHAPE=99
- SPI1(1)=-COS((90-PAR(3))*DEGRAD)
- SPI1(2)=0
- SPI1(3)=-COS(PAR(3)*DEGRAD)
- SPI1(4)=0
- SPI2(1)=-COS((90-PAR(4))*DEGRAD)
- SPI2(2)=0
- SPI2(3)=-COS(PAR(4)*DEGRAD)
- SPI2(4)=0
- ISP1=JCGOBJ+4000
- CALL CGSLIC(Q(ICPOIN),SPI1,4000,Q(ISP1))
- ISP2=JCGOBJ+8000
- CALL CGSLIC(Q(ISP1),SPI2,4000,Q(ISP2))
- ICPOIN=ISP2
- CALL CGCEV(1,Q(ICPOIN))
- ENDIF
- DO 140 J=1,3
- T(J,1)=GRMAT(3*J-2,NLEVEL)
- T(J,2)=GRMAT(3*J-1,NLEVEL)
- T(J,3)=GRMAT(3*J,NLEVEL)
- 140 CONTINUE
- CALL CGAFFI(T,Q(ICPOIN))
- XV=GTRAN(1,NLEVEL)
- YV=GTRAN(2,NLEVEL)
- ZV=GTRAN(3,NLEVEL)
- CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
-***SG
-* Shifting object
- IF(KSHIFT.GT.0)THEN
- CALL GDSHIF(IVOLNA,ICPOIN)
- ENDIF
-*
- IF(GBOOM.NE.0)THEN
- CALL GDBOMB(ICPOIN,ISHAPE)
- IF(ITSTCU.EQ.0)GOTO 999
- ENDIF
-*
-*
-* Hidden Volume Removal:
-* Computing closed volumes visibility and skipping
-* the unvisible ones; a great increase in speed
-* and a great reduction in n. of words used are obtained
-* in this way.
-*
- CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
- IF(ISUBLI.EQ.1)THEN
- AA1=RRMIN(1)-S1
- AA2=RRMIN(2)-S2
- AA3=RRMIN(3)-S3
- BB1=RRMAX(1)-SS1
- BB2=RRMAX(2)-SS2
- BB3=RRMAX(3)-SS3
- IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND. BB1.LT.
- + -0.001.AND.BB2.LT.-0.001.AND.BB3.LT.-0.001)THEN
- IF(ISHAPE.NE.99)THEN
- IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
- ITSTCU=0
- NCGVOL=NCGVOL-NWS
- GOTO 999
- ENDIF
- ENDIF
- ENDIF
- ENDIF
- IF(IPORLI.EQ.1)THEN
- S1=RRMIN(1)
- S2=RRMIN(2)
- S3=RRMIN(3)
- SS1=RRMAX(1)
- SS2=RRMAX(2)
- SS3=RRMAX(3)
- SRAGMX=R
- SRAGMN=0.
- RAINT1=0.
- RAINT2=0.
- IPORNT=1
- PORMAR(1)=R
- PORMIR(1)=0.
- ENDIF
-* Create clipping objects
- IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
-* Perspective view
- IF (IPRJ.EQ.IPERS) THEN
- CALL CGPERS(Q(ICPOIN))
- ENDIF
-* Inserting objects in Hide + Wire structures
- CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
- GOTO 999
-***SG
-*
- 150 CONTINUE
-C
-C PGON ----> call CGZREV
-C
- NTVOL=NZ-1
- ANG1=PHIMIN
- ANG2=PHIMAX
-**SG
- AANG=ABS(ANG2-ANG1)
- AZLAT=AANG*APPROS
- ZLAT=AZLAT/360
- NANG=ZLAT
- IF(NANG.EQ.0)NANG=1
- AZ=ZLAT-NANG
- IF(AZ.GT..5)NANG=NANG+1
- IF(NDIVAN.LT.NANG)THEN
- NANG=NDIVAN
-* WRITE(CHMAIL,10400)NANG,NAMES(NLEVEL)
-* CALL GMAIL(0,0)
- ENDIF
- AATMAX=NANG*360./AANG
- LATMAX=AATMAX
- ALA=AATMAX-LATMAX
- IF(ALA.GT..5)LATMAX=LATMAX+1
-**SG
- AFINV=1./COS(PI/LATMAX)
- FINV=ABS(AFINV)
- JSURZ=1
- ZR(1)=PAR(5)
- RMIR(1)=PAR(6)*FINV
- RMAR(1)=PAR(7)*FINV
-*SG
- RMAR(1)=RMAR(1)+.001
-*SG
- DO 160 I=1,NTVOL
-* ZA=PAR(5+3*(I-1))
- ZB=PAR(5+3*I)
-**SG
- ZB=ZB+.001
-********* DIFZ=ABS(ZB-ZA)
-********* IF(DIFZ.LT.0.001)GOTO 220
-**SG
- JSURZ=JSURZ+1
- ZR(JSURZ)=ZB
- RMIR(JSURZ)=PAR(6+3*I)*FINV
- RMAR(JSURZ)=PAR(7+3*I)*FINV
-**SG
- RMAR(JSURZ)=RMAR(JSURZ)+.001
-*
- 160 CONTINUE
-*
-* Checking if all Inner Radii are 0. ==> 'Closed' Volume
-*
-* NRAD=NTVOL+1
-* DO 230 I=1,NRAD
-* IF(RMIR(I).GT.0.00001)GOTO 240
-* 230 CONTINUE
-* IVCLOS=1
-* 240 CONTINUE
-*
-* Size evaluation
- IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
- NCGVOL=NCGVOL+NWREV*(NANG+1)*NTVOL
- GOTO 999
- ENDIF
- IF(IPORLI.EQ.1)THEN
- SRAGMN=10000.
- RAINT1=10000.
- ENDIF
-*
- DO 220 IVOL=1,NTVOL
- ISG=ISG+1
- IVCLOS=1
- IF((RMIR(IVOL).GT.0.00001).OR.(RMIR(IVOL+1).GT.
- + 0.00001))IVCLOS=0
- XZ(1,1)=RMIR(IVOL)
- XZ(2,1)=ZR(IVOL)
- XZ(1,2)=RMAR(IVOL)
- XZ(2,2)=ZR(IVOL)
- XZ(1,3)=RMAR(IVOL+1)
- XZ(2,3)=ZR(IVOL+1)
- XZ(1,4)=RMIR(IVOL+1)
- XZ(2,4)=ZR(IVOL+1)
- ZR(IVOL+1)=ZR(IVOL+1)+.001
- ICPOIN=JCGOBJ+1
-* Creating object
-**SG
- CALL CGZREV(XZ,ANG1,ANG2,NANG,4000,Q(ICPOIN))
- DO 170 J=1,3
- T(J,1)=GRMAT(3*J-2,NLEVEL)
- T(J,2)=GRMAT(3*J-1,NLEVEL)
- T(J,3)=GRMAT(3*J,NLEVEL)
- 170 CONTINUE
- CALL CGRIFL(T,Q(ICPOIN))
- CGERR=Q(ICPOIN)
- IF(CGERR.LE.0)THEN
- CALL GDCGER(CGERR)
- IF(KCGST.EQ.-2) GOTO 999
- IF(KCGST.EQ.-3) THEN
- KCGST=0
- WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
- CALL GMAIL(0,0)
- WRITE(CHMAIL,10400)(PAR(I),I=1,4)
- CALL GMAIL(0,0)
- DO 180 J=1,NZ
- ZPR=PAR(5+(J-1)*3)
- RMIPR=PAR(6+(J-1)*3)
- RMAPR=PAR(7+(J-1)*3)
- WRITE(CHMAIL,10600)J,ZPR,RMIPR,RMAPR
- CALL GMAIL(0,0)
- 180 CONTINUE
- GOTO 999
- ENDIF
- ENDIF
- CALL CGCEV(1,Q(ICPOIN))
- DO 190 J=1,3
- T(J,1)=GRMAT(3*J-2,NLEVEL)
- T(J,2)=GRMAT(3*J-1,NLEVEL)
- T(J,3)=GRMAT(3*J,NLEVEL)
- 190 CONTINUE
- CALL CGAFFI(T,Q(ICPOIN))
- XV=GTRAN(1,NLEVEL)
- YV=GTRAN(2,NLEVEL)
- ZV=GTRAN(3,NLEVEL)
- CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
-***SG
-* Shifting object
- IF(KSHIFT.GT.0)THEN
- CALL GDSHIF(IVOLNA,ICPOIN)
- ENDIF
-*
- IF(GBOOM.NE.0)THEN
- CALL GDBOMB(ICPOIN,ISHAPE)
- IF(ITSTCU.EQ.0)GOTO 220
- ENDIF
-*
-*
-* Hidden Volume Removal:
-* Computing closed volumes visibility and skipping
-* the unvisible ones; a great increase in speed
-* and a great reduction in n. of words used are obtained
-* in this way.
-*
- CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
- IF(ISUBLI.EQ.1)THEN
- AA1=RRMIN(1)-S1
- AA2=RRMIN(2)-S2
- AA3=RRMIN(3)-S3
- BB1=RRMAX(1)-SS1
- BB2=RRMAX(2)-SS2
- BB3=RRMAX(3)-SS3
- IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND.
- + BB1.LT.-0.001.AND.BB2.LT.-0.001.AND.BB3.LT.-0.001)THEN
- AMARMA(IVOL) =MIN(RMAR(IVOL),RMAR(IVOL+1))
- AMARMA(IVOL+1)=MAX(RMAR(IVOL),RMAR(IVOL+1))
- AMIRMA(IVOL) =MIN(RMIR(IVOL),RMIR(IVOL+1))
- AMIRMA(IVOL+1)=MAX(RMIR(IVOL),RMIR(IVOL+1))
- RMAX1=AMARMA(IVOL)
- RMAX2=AMARMA(IVOL+1)
- RMIN1=AMIRMA(IVOL)
- RMIN2=AMIRMA(IVOL+1)
- IF(SRAGMX.NE.0.)THEN
- DO 200 ITER=1,IPORNT
- IF(RMAX1.EQ.PORMAR(ITER).OR.RMAX2.EQ.PORMAR(ITER))
- + GOTO 210
- IF(RMIN1.EQ.PORMIR(ITER).OR.RMIN2.EQ.PORMIR(ITER))
- + THEN
- IF(PORMIR(ITER).NE.0.)GOTO 210
- ENDIF
- 200 CONTINUE
- ENDIF
- IF(ISCOP.EQ.1)THEN
- IF((AMARMA(IVOL+1).GE.SRAGMX.OR.AMARMA(IVOL) .GT.SRAG
- + MN))GOTO 210
- IF((AMIRMA(IVOL+1).LE.RAINT2.OR.AMIRMA(IVOL)
- + .LE.RAINT1).AND.(RAINT2.NE.0))GOTO 210
- ENDIF
- IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
- ITSTCU=0
- NCGVOL=NCGVOL-NWPROD
- GOTO 220
- ENDIF
- ENDIF
- ENDIF
- IF(IPORLI.EQ.1)THEN
- IF(RRMIN(1).LT.S1)S1=RRMIN(1)
- IF(RRMIN(2).LT.S2)S2=RRMIN(2)
- IF(RRMIN(3).LT.S3)S3=RRMIN(3)
- IF(RRMAX(1).GT.SS1)SS1=RRMAX(1)
- IF(RRMAX(2).GT.SS2)SS2=RRMAX(2)
- IF(RRMAX(3).GT.SS3)SS3=RRMAX(3)
- IF(RMAR(IVOL).GT.SRAGMX)SRAGMX=RMAR(IVOL)
- IF(RMAR(IVOL).LT.SRAGMN)SRAGMN=RMAR(IVOL)
- IF(RMAR(IVOL+1).GT.SRAGMX)SRAGMX=RMAR(IVOL+1)
- IF(RMAR(IVOL+1).LT.SRAGMN)SRAGMN=RMAR(IVOL+1)
- IF(RMIR(IVOL).GT.RAINT2)RAINT2=RMIR(IVOL)
- IF(RMIR(IVOL).LT.RAINT1)RAINT1=RMIR(IVOL)
- IF(RMIR(IVOL+1).GT.RAINT2)RAINT2=RMIR(IVOL+1)
- IF(RMIR(IVOL+1).LT.RAINT1)RAINT1=RMIR(IVOL+1)
- PORMAR(IVOL)=RMAR(IVOL)
- PORMIR(IVOL)=RMIR(IVOL)
- IPORNT =NTVOL
- ENDIF
- 210 CONTINUE
-* Create clipping objects
- IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
-* Perspective view
- IF (IPRJ.EQ.IPERS) THEN
- CALL CGPERS(Q(ICPOIN))
- ENDIF
-* Inserting objects in Hide + Wire structures
- CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
-***SG
- 220 CONTINUE
- GOTO 999
-*
- 230 CONTINUE
-C
-C PCON ----> call CGZREV
-C
- NTVOL=NZ-1
- ANG1=PHIMIN
- ANG2=PHIMAX
-**SG
- AANG=ABS(ANG2-ANG1)
- AZLAT=AANG*APPROS
- ZLAT=AZLAT/360
- NANG=ZLAT
- IF(NANG.EQ.0)NANG=1
- AZ=ZLAT-NANG
- IF(AZ.GT..5)NANG=NANG+1
-**SG
- AFINV=1./COS(PI/APPROS)
- FINV=ABS(AFINV)
- JSURZ=1
- ZR(1)=PAR(4)
- RMIR(1)=PAR(5)*FINV
- RMAR(1)=PAR(6)*FINV
-*SG
- RMAR(1)=RMAR(1)+.1
-*SG
- DO 240 I=1,NTVOL
-* ZA=PAR(4+3*(I-1))
- ZB=PAR(4+3*I)
-**SG
- ZB=ZB+.001
-******** DIFZ=ABS(ZB-ZA)
-******** IF(DIFZ.LT.0.001)GOTO 290
-**SG
- JSURZ=JSURZ+1
- ZR(JSURZ)=ZB
- RMIR(JSURZ)=PAR(5+3*I)*FINV
- RMAR(JSURZ)=PAR(6+3*I)*FINV
-**SG
- RMAR(JSURZ)=RMAR(JSURZ)+.1
-*
- 240 CONTINUE
-*
-* Checking if all Inner Radii are 0. ==> 'Closed' Volume
-*
-* NRAD=NTVOL+1
-* DO 300 I=1,NRAD
-* IF(RMIR(I).GT.0.00001)GOTO 310
-* 300 CONTINUE
-* IVCLOS=1
-* 310 CONTINUE
-*
-*
-* Size evaluation
- IF(IWORK.LE.2.AND.IVFUN.NE.0)THEN
- NCGVOL=NCGVOL+NWREV*(NANG+1)*NTVOL
- GOTO 999
- ENDIF
- IF(IPORLI.EQ.1)THEN
- SRAGMN=10000.
- RAINT1=10000.
- ENDIF
-*
- DO 300 IVOL=1,NTVOL
- ISG=ISG+1
- IVCLOS=1
- IF((RMIR(IVOL).GT.0.00001).OR.(RMIR(IVOL+1).GT.
- + 0.00001))IVCLOS=0
- XZ(1,1)=RMIR(IVOL)
- XZ(2,1)=ZR(IVOL)
- XZ(1,2)=RMAR(IVOL)
- XZ(2,2)=ZR(IVOL)
- XZ(1,3)=RMAR(IVOL+1)
- XZ(2,3)=ZR(IVOL+1)
- XZ(1,4)=RMIR(IVOL+1)
- XZ(2,4)=ZR(IVOL+1)
- ZR(IVOL+1)=ZR(IVOL+1)+.1
- ICPOIN=JCGOBJ+1
-* Creating object
-**SG
- CALL CGZREV(XZ,ANG1,ANG2,NANG,4000,Q(ICPOIN))
- DO 250 J=1,3
- T(J,1)=GRMAT(3*J-2,NLEVEL)
- T(J,2)=GRMAT(3*J-1,NLEVEL)
- T(J,3)=GRMAT(3*J,NLEVEL)
- 250 CONTINUE
- CALL CGRIFL(T,Q(ICPOIN))
- CALL CGCEV(-1,Q(ICPOIN))
- CGERR=Q(ICPOIN)
- IF(CGERR.LE.0)THEN
- CALL GDCGER(CGERR)
- IF(KCGST.EQ.-2) GOTO 999
- IF(KCGST.EQ.-3) THEN
- KCGST=0
- WRITE(CHMAIL,10000)ISHAPE,NAMES(NLEVEL)
- CALL GMAIL(0,0)
- WRITE(CHMAIL,10500)(PAR(I),I=1,3)
- CALL GMAIL(0,0)
- DO 260 J=1,NZ
- ZPR=PAR(4+(J-1)*3)
- RMIPR=PAR(5+(J-1)*3)
- RMAPR=PAR(6+(J-1)*3)
- WRITE(CHMAIL,10600)J,ZPR,RMIPR,RMAPR
- CALL GMAIL(0,0)
- 260 CONTINUE
- GOTO 999
- ENDIF
- ENDIF
- CALL CGCEV(1,Q(ICPOIN))
- DO 270 J=1,3
- T(1,J)=GRMAT(3*J-2,NLEVEL)
- T(2,J)=GRMAT(3*J-1,NLEVEL)
- T(3,J)=GRMAT(3*J,NLEVEL)
- T(4,J)=0.
- 270 CONTINUE
- CALL CGAFFI(T,Q(ICPOIN))
- XV=GTRAN(1,NLEVEL)
- YV=GTRAN(2,NLEVEL)
- ZV=GTRAN(3,NLEVEL)
- CALL CGSHIF(XV,YV,ZV,Q(ICPOIN))
-*
-***SG
-* Shifting object
- IF(KSHIFT.GT.0)THEN
- CALL GDSHIF(IVOLNA,ICPOIN)
- ENDIF
-*
- IF(GBOOM.NE.0)THEN
- CALL GDBOMB(ICPOIN,ISHAPE)
- IF(ITSTCU.EQ.0)GOTO 300
- ENDIF
-*
-*
-* Hidden Volume Removal:
-* Computing closed volumes visibility and skipping
-* the unvisible ones; a great increase in speed
-* and a great reduction in n. of words used are obtained
-* in this way.
-*
- CALL CGMNMX(Q(ICPOIN),RRMIN,RRMAX)
- IF(ISUBLI.EQ.1)THEN
- AA1=RRMIN(1)-S1
- AA2=RRMIN(2)-S2
- AA3=RRMIN(3)-S3
- BB1=RRMAX(1)-SS1
- BB2=RRMAX(2)-SS2
- BB3=RRMAX(3)-SS3
- IF(AA1.GT.0.001.AND.AA2.GT.0.001.AND.AA3.GT.0.001.AND.
- + BB1.LT.-0.001.AND.BB2.LT.-0.001.AND.BB3.LT.-0.001)THEN
- AMARMA(IVOL) =MIN(RMAR(IVOL),RMAR(IVOL+1))
- AMARMA(IVOL+1)=MAX(RMAR(IVOL),RMAR(IVOL+1))
- AMIRMA(IVOL) =MIN(RMIR(IVOL),RMIR(IVOL+1))
- AMIRMA(IVOL+1)=MAX(RMIR(IVOL),RMIR(IVOL+1))
- RMAX1=AMARMA(IVOL)
- RMAX2=AMARMA(IVOL+1)
- RMIN1=AMIRMA(IVOL)
- RMIN2=AMIRMA(IVOL+1)
- IF(SRAGMX.NE.0.)THEN
- DO 280 ITER=1,IPORNT
- IF(RMAX1.EQ.PORMAR(ITER).OR.RMAX2.EQ.PORMAR(ITER))
- + GOTO 290
- IF(RMIN1.EQ.PORMIR(ITER).OR.RMIN2.EQ.PORMIR(ITER))
- + THEN
- IF(PORMIR(ITER).NE.0)GOTO 290
- ENDIF
- 280 CONTINUE
- ENDIF
- IF(ISCOP.EQ.1)THEN
- IF((AMARMA(IVOL+1).GE.SRAGMX.OR.AMARMA(IVOL) .GE.SRAG
- + MN))GOTO 290
- IF((AMIRMA(IVOL+1).LE.RAINT2.AND.AMIRMA(IVOL)
- + .LE.RAINT1).AND.(RAINT2.NE.0))GOTO 290
- ENDIF
- IF(IWORK.EQ.0.OR.IWORK.EQ.3)THEN
- NCGVOL=NCGVOL-NWPROD
- ITSTCU=0
- GOTO 300
- ENDIF
- ENDIF
- ENDIF
- IF(IPORLI.EQ.1)THEN
- IF(RRMIN(1).LT.S1)S1=RRMIN(1)
- IF(RRMIN(2).LT.S2)S2=RRMIN(2)
- IF(RRMIN(3).LT.S3)S3=RRMIN(3)
- IF(RRMAX(1).GT.SS1)SS1=RRMAX(1)
- IF(RRMAX(2).GT.SS2)SS2=RRMAX(2)
- IF(RRMAX(3).GT.SS3)SS3=RRMAX(3)
- IF(RMAR(IVOL).GT.SRAGMX)SRAGMX=RMAR(IVOL)
- IF(RMAR(IVOL).LT.SRAGMN)SRAGMN=RMAR(IVOL)
- IF(RMAR(IVOL+1).GT.SRAGMX)SRAGMX=RMAR(IVOL+1)
- IF(RMAR(IVOL+1).LT.SRAGMN)SRAGMN=RMAR(IVOL+1)
- IF(RMIR(IVOL).GT.RAINT2)RAINT2=RMIR(IVOL)
- IF(RMIR(IVOL).LT.RAINT1)RAINT1=RMIR(IVOL)
- IF(RMIR(IVOL+1).GT.RAINT2)RAINT2=RMIR(IVOL+1)
- IF(RMIR(IVOL+1).LT.RAINT1)RAINT1=RMIR(IVOL+1)
- PORMAR(IVOL)=RMAR(IVOL)
- PORMIR(IVOL)=RMIR(IVOL)
- IPORNT =NTVOL
- ENDIF
- 290 CONTINUE
-* Create clipping objects
- IF(ICUT.NE.0.OR.IHOLE.NE.0)CALL GDCGSL(IVOLNA,ISHAPE)
-* Perspective view
- IF (IPRJ.EQ.IPERS) THEN
- CALL CGPERS(Q(ICPOIN))
- ENDIF
-* Inserting object in Hide + Wire structures
- CALL GDCGHI(IWORK,NOBJ,NWWS,LSTEP,ISG,NTVOL,ISHAPE)
- 300 CONTINUE
- GOTO 999
-*
-***SG
-*
-10000 FORMAT(' Check Parameters of Shape ',I3,' in volume ',A4)
-10100 FORMAT(' Warning >>> RMIN1 greater than RMAX1 for shape '
- + ,I3,' in volume ',A4)
-10200 FORMAT(' Warning >>> RMIN2 greater than RMAX2 for shape '
- + ,I3,' in volume ',A4)
-10300 FORMAT(' Warning >>> PHIMIN greater than PHIMAX for shape'
- + ,I3,' in volume ',A4)
-*10400 FORMAT(' PGON with NPDV = ',I5,' in volume ',A4,' NPDV very
-* + large . It must be < 30 . Volume will not be drawn. ')
-10400 FORMAT(' PHI1 = ',F8.3,' DPHI = ',F8.3,' NPDV = ',F8.1
- + ,' NZ = ',F8.1)
-10500 FORMAT(' PHI1 = ',F8.3,' DPHI = ',F8.3,' NZ = ',F8.1)
-10600 FORMAT(' J = ',I5,' Z = ',F8.3,' RMIN = ',F8.3
- + ,' RMAX = ',F8.3)
-*10800 FORMAT(' Please, increase size of Zebra store by ',I10,
-* + ' words')
-*
-***SG
- 999 END
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff