X-Git-Url: http://git.uio.no/git/?a=blobdiff_plain;f=GEANT321%2Fgdraw%2Fgdcgob.F;fp=GEANT321%2Fgdraw%2Fgdcgob.F;h=0000000000000000000000000000000000000000;hb=b9d0a01d7a0723a09071b0b56200d72f59a9c2b6;hp=87366582aa2427c8da0dd33e68480c09cae7f3eb;hpb=9754311559f405f3949bf48d6883dd02a93e7088;p=u%2Fmrichter%2FAliRoot.git diff --git a/GEANT321/gdraw/gdcgob.F b/GEANT321/gdraw/gdcgob.F deleted file mode 100644 index 87366582aa2..00000000000 --- a/GEANT321/gdraw/gdcgob.F +++ /dev/null @@ -1,1306 +0,0 @@ -* -* $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