* * $Id$ * * $Log$ * Revision 1.1.1.1 1995/10/24 10:21:49 cernlib * Geant * * #include "geant321/pilot.h" *CMZ : 3.21/02 28/03/94 01.30.59 by S.Giani *-- Author : SUBROUTINE GXDRAW C. C. ****************************************************************** C. * * C. * Drawing commands * C. * * C. * Authors: R.Brun ********** * C. * P.Zanarini ********** * C. * S.Giani ********** * C. * * C. ****************************************************************** C. #include "geant321/gcbank.inc" #include "geant321/pawc.inc" #include "geant321/gcunit.inc" #include "geant321/gcdraw.inc" #include "geant321/gcgobj.inc" #include "geant321/gcmutr.inc" #include "geant321/gcspee.inc" #include "geant321/gccurs.inc" #include "geant321/gchil2.inc" #include "geant321/gcursb.inc" #if defined(CERNLIB_USRJMP) #include "geant321/gcjump.inc" #endif #include "geant321/gcvdma.inc" #include "geant321/gcfdim.inc" * COMMON/QUEST/IQUEST(100) * DIMENSION NNAME(15),NNUMB(15),RVAL(2) *SG DIMENSION VX(4),VXX(4),VVX(4),XV(4),BX(4) DIMENSION VY(4),VYY(4),VVY(4),YV(4),BY(4) CHARACTER*4 NAME,CHNUMB,IDS,IVS,ICS,NNVV,NVNV,MOTH CHARACTER*4 CHNRS,CHAX,YESNO,CENT CHARACTER*4 NOPT,SAMP,KSAM,KLSA CHARACTER*6 MODE *SG CHARACTER*80 CHTEXT CHARACTER*32 CHPATL,VNAME CHARACTER*64 NAMNUM C. C. ------------------------------------------------------------------ C. CALL KUPATL(CHPATL,NPAR) * IF (CHPATL.EQ.'BOX ') THEN IHOLE=0 * * It's now possible to clip different volumes by different SHAPES ! * Moreover, one can clip twice each volume by different SHAPES ! * NCVOLS=NCVOLS+1 IF(NCVOLS.EQ.MULTRA)THEN WRITE(CHMAIL, 10000) 10000 FORMAT(' *** GXDRAW ***:', + ' No more space to store MCVOL information.') CALL GMAIL(0,0) WRITE(CHMAIL, 10100) 10100 FORMAT(' *** GXDRAW ***: Please reset MCVOL') CALL GMAIL(0,0) GOTO 999 ENDIF CALL KUGETC(NNVV,NCH) ***SG CALL KUGETR(XMIN) CALL KUGETR(XMAX) CALL KUGETR(YMIN) CALL KUGETR(YMAX) CALL KUGETR(ZMIN) CALL KUGETR(ZMAX) IF(XMIN.GE.XMAX.OR.YMIN.GE.YMAX.OR.ZMIN.GE.ZMAX)THEN WRITE(CHMAIL,10200) 10200 FORMAT(' Wrong Box limits. Check values ') CALL GMAIL(0,0) GOTO 999 ENDIF ****SG GNNVV(NCVOLS)=NNVV GNASH(NCVOLS)='BOX' GXMIN(NCVOLS)=XMIN GXMAX(NCVOLS)=XMAX GYMIN(NCVOLS)=YMIN GYMAX(NCVOLS)=YMAX GZMIN(NCVOLS)=ZMIN GZMAX(NCVOLS)=ZMAX IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1 * Resetting Mcvol mode IF(GNNVV(NCVOLS).EQ.'.')THEN IHOLE=0 DO 10 JJ=1,NCVOLS GNNVV(JJ)=' ' GXMIN(JJ)=-100000 GXMAX(JJ)=-99999 GYMIN(JJ)=-100000 GYMAX(JJ)=-99999 GZMIN(JJ)=-100000 GZMAX(JJ)=-99999 10 CONTINUE NCVOLS=0 ENDIF ELSEIF (CHPATL.EQ.'TUBE')THEN IHOLE=0 * * It's now possible to clip different volumes by different SHAPES ! * Moreover, one can clip twice each volume by different SHAPES ! * NCVOLS=NCVOLS+1 IF(NCVOLS.EQ.MULTRA)THEN WRITE(CHMAIL, 10000) CALL GMAIL(0,0) WRITE(CHMAIL, 10100) CALL GMAIL(0,0) GOTO 999 ENDIF CALL KUGETC(NNVV,NCH) ***SG CALL KUGETR(RMAX) CALL KUGETR(ZDEM) CALL KUGETR(XMED) CALL KUGETR(YMED) CALL KUGETR(ZMED) ****SG GNNVV(NCVOLS)=NNVV GNASH(NCVOLS)='TUBE' GXMIN(NCVOLS)=RMAX GXMAX(NCVOLS)=ZDEM GYMIN(NCVOLS)=XMED GYMAX(NCVOLS)=YMED GZMIN(NCVOLS)=ZMED GZMAX(NCVOLS)=0. IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1 *Resetting Mcvol mode IF(GNNVV(NCVOLS).EQ.'.')THEN IHOLE=0 DO 20 JJ=1,NCVOLS GNNVV(JJ)=' ' GXMIN(JJ)=0.1 GXMAX(JJ)=0.1 GYMIN(JJ)=-100000 GYMAX(JJ)=-100000 GZMIN(JJ)=-100000 GZMAX(JJ)=0. 20 CONTINUE NCVOLS=0 ENDIF ELSEIF (CHPATL.EQ.'CONE')THEN IHOLE=0 * * It's now possible to clip different volumes by different SHAPES ! * Moreover, one can clip twice each volume by different SHAPES ! * NCVOLS=NCVOLS+1 IF(NCVOLS.EQ.MULTRA)THEN WRITE(CHMAIL, 10000) CALL GMAIL(0,0) WRITE(CHMAIL, 10100) CALL GMAIL(0,0) GOTO 999 ENDIF CALL KUGETC(NNVV,NCH) ***SG CALL KUGETR(RMAX1) CALL KUGETR(RMAX2) CALL KUGETR(ZDEM) CALL KUGETR(XMED) CALL KUGETR(YMED) CALL KUGETR(ZMED) ****SG GNNVV(NCVOLS)=NNVV GNASH(NCVOLS)='CONE' GXMIN(NCVOLS)=RMAX1 GXMAX(NCVOLS)=RMAX2 GYMIN(NCVOLS)=ZDEM GYMAX(NCVOLS)=XMED GZMIN(NCVOLS)=YMED GZMAX(NCVOLS)=ZMED IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1 *Resetting Mcvol mode IF(GNNVV(NCVOLS).EQ.'.')THEN IHOLE=0 DO 30 JJ=1,NCVOLS GNNVV(JJ)=' ' GXMIN(JJ)=0.1 GXMAX(JJ)=0.1 GYMIN(JJ)=0.1 GYMAX(JJ)=-100000 GZMIN(JJ)=-100000 GZMAX(JJ)=-100000 30 CONTINUE NCVOLS=0 ENDIF ELSEIF (CHPATL.EQ.'SPHE')THEN IHOLE=0 * * It's now possible to clip different volumes by different SHAPES ! * Moreover, one can clip twice each volume by different SHAPES ! * NCVOLS=NCVOLS+1 IF(NCVOLS.EQ.MULTRA)THEN WRITE(CHMAIL, 10000) CALL GMAIL(0,0) WRITE(CHMAIL, 10100) CALL GMAIL(0,0) GOTO 999 ENDIF CALL KUGETC(NNVV,NCH) ***SG CALL KUGETR(RMAX) CALL KUGETR(XMED) CALL KUGETR(YMED) CALL KUGETR(ZMED) ****SG GNNVV(NCVOLS)=NNVV GNASH(NCVOLS)='SPHE' GXMIN(NCVOLS)=RMAX GXMAX(NCVOLS)=XMED GYMIN(NCVOLS)=YMED GYMAX(NCVOLS)=ZMED IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1 *Resetting Mcvol mode IF(GNNVV(NCVOLS).EQ.'.')THEN IHOLE=0 DO 40 JJ=1,NCVOLS GNNVV(JJ)=' ' GXMIN(JJ)=0.1 GXMAX(JJ)=-100000 GYMIN(JJ)=-100000 GYMAX(JJ)=-100000 40 CONTINUE NCVOLS=0 ENDIF * ELSEIF (CHPATL.EQ.'VALCUT') THEN CALL KUGETR(XCUT) CALL KUGETR(YCUT) CALL KUGETR(ZCUT) * ELSEIF (CHPATL.EQ.'SPOT') THEN CALL KUGETR(XLPOS) CALL KUGETR(YLPOS) CALL KUGETR(ZLPOS) CALL KUGETI(INTEN) CALL GLIGHT(XLPOS,YLPOS,ZLPOS,INTEN) * ELSEIF (CHPATL.EQ.'VAR5D') THEN CALL KUGETR(TSEQTO) CALL KUGETI(NPROC) CALL KUGETI(NMPTOT) CALL KUGETR(TOTMBY) CALL KUGETR(TSEQ) CALL KUGETR(TLAT) CALL KUGETR(TNET) * ELSEIF (CHPATL.EQ.'RANG5D') THEN CALL KUGETR(X1MIN) CALL KUGETR(X1MAX) CALL KUGETR(Y1MIN) CALL KUGETR(Y1MAX) CALL KUGETR(Z1MIN) CALL KUGETR(Z1MAX) * ELSEIF (CHPATL.EQ.'DRAW') THEN CALL KUGETC(NAME,NCH) CALL KUGETR(GTHETA) CALL KUGETR(GPHI) CALL KUGETR(GPSI) CALL KUGETR(GU0) CALL KUGETR(GV0) CALL KUGETR(GSCU) CALL KUGETR(GSCV) GTHETL=GTHETA GPHIL=GPHI GPSIL=GPSI GU0L=GU0 GV0L=GV0 GSCUL=GSCU GSCVL=GSCV IF(RAYTRA.EQ.1.)THEN CALL GDRAYT(NAME,GTHETL,GPHIL,GPSIL,GU0L,GV0L,GSCUL,GSCVL) ELSE CALL GDRAW(NAME,GTHETL,GPHIL,GPSIL,GU0L,GV0L,GSCUL,GSCVL) ENDIF * ELSEIF (CHPATL.EQ.'DVOLUME') THEN CALL KUGETI(N) IF (N.EQ.0) GO TO 60 IF (N.LT.0.OR.N.GT.15) GO TO 999 * CALL KUGETC(CHTEXT,NCH) DO 50 I=1,N CALL KUGETL(NAMNUM,NCH) CALL UCTOH(NAMNUM,NNAME(I),4,4) CALL KUGETL(CHNUMB,NCH) CALL KICTON(CHNUMB,NNUMB(I),RVAL) IF (IQUEST(1).NE.0) GO TO 999 50 CONTINUE * CALL KUGETC(CHNRS,NCH) NRS=0 IF (CHNRS.EQ.'DRS') NRS=1 CALL KUGETR(GTHETA) CALL KUGETR(GPHI) CALL KUGETR(GPSI) CALL KUGETR(GU0) CALL KUGETR(GV0) CALL KUGETR(GSCU) CALL KUGETR(GSCV) 60 CALL GDRVOL(N,NNAME,NNUMB,NRS,GTHETA,GPHI,GPSI,GU0,GV0,GSCU, + GSCV) * ELSEIF (CHPATL.EQ.'DCUT') THEN IHOLE=0 CALL KUGETC(NAME,NCH) CALL KUGETC(CHAX,NCH) IF (CHAX.EQ.'X'.OR.CHAX.EQ.'1') THEN IAX=1 ELSEIF (CHAX.EQ.'Y'.OR.CHAX.EQ.'2')THEN IAX=2 ELSEIF (CHAX.EQ.'Z'.OR.CHAX.EQ.'3')THEN IAX=3 ENDIF CALL KUGETR(CCUT) CALL KUGETR(GU0) CALL KUGETR(GV0) CALL KUGETR(GSCU) CALL KUGETR(GSCV) CALL GDRAWC(NAME,IAX,CCUT,GU0,GV0,GSCU,GSCV) * ELSEIF (CHPATL.EQ.'DXCUT') THEN CALL KUGETC(NAME,NCH) CALL KUGETR(CUTTHE) CALL KUGETR(CUTPHI) CALL KUGETR(CCUT) CALL KUGETR(GTHETA) CALL KUGETR(GPHI) CALL KUGETR(GU0) CALL KUGETR(GV0) CALL KUGETR(GSCU) CALL KUGETR(GSCV) CALL GDRAWX(NAME,CUTTHE,CUTPHI,CCUT,GTHETA,GPHI,GU0,GV0,GSCU, + GSCV) * ***SG * * * It's now possible to shift each volume into a more visible place ! * ELSEIF(CHPATL.EQ.'SHIFT') THEN IF(NSHIFT.EQ.0)KSHIFT=1 NSHIFT=NSHIFT+1 IF(NSHIFT.EQ.MULTRA)THEN WRITE(CHMAIL, 10300) 10300 FORMAT(' *** GXDRAW ***:', + ' No more space to store SHIFT information.') CALL GMAIL(0,0) GOTO 999 ENDIF CALL KUGETC(NVNV,NCH) CALL KUGETR(XXXX) CALL KUGETR(YYYY) CALL KUGETR(ZZZZ) GNVNV(NSHIFT)=NVNV GXXXX(NSHIFT)=XXXX GYYYY(NSHIFT)=YYYY GZZZZ(NSHIFT)=ZZZZ * Resetting Shift mode IF(GNVNV(NSHIFT).EQ.'.')THEN KSHIFT=0 DO 70 KK=1,NSHIFT GNVNV(KK)=' ' GXXXX(KK)=0 GYYYY(KK)=0 GZZZZ(KK)=0 70 CONTINUE NSHIFT=0 ENDIF * * To make the detector 'explode' * ELSEIF(CHPATL.EQ.'BOMB')THEN CALL KUGETR(BOOM) GBOOM=BOOM * ***SG * ELSEIF (CHPATL.EQ.'DTREE') THEN * JSIM=0 KXXX=0 NNPAR=NPAR CALL KUGETC(NAME,NCH) CALL UHTOC(IQ(JVOLUM+1),4,MOMO,4) CALL KUGETI(LEVMAX) IF(NNPAR.EQ.3)THEN CALL KUGETI(ISELT) IISELT=ISELT ELSE ISELT=111 ENDIF IWTY=IGIWTY(1) JVSIM=2 IF(IWTY.GT.10.OR.IWTY.LT.1)JVSIM=1 IF (NAME.EQ.' ')NAME=MOMO IF (NAME.NE.MOMO) THEN INTFLA=10 CALL GDTREE(MOMO,0,110) DO 80 J=1,NUMND2 IQ(JFINAM+J)=IQ(JNAM1+J) IQ(JFISCA+J)=IQ(JSCA1+J) IQ(JFIMOT+J)=IQ(JMOT1+J) 80 CONTINUE KXXX=1 IF(LEVMAX.LT.0)THEN LEVMAX=-LEVMAX DO 90 II=1,LEVMAX CALL GDTR8(NAME,MOTH,IONL) NAME=MOTH 90 CONTINUE LEVMAX=3 ENDIF ELSE INTFLA=10 CALL GDTREE(NAME,0,110) DO 100 J=1,NUMND2 IQ(JFINAM+J)=IQ(JNAM1+J) IQ(JFISCA+J)=IQ(JSCA1+J) IQ(JFIMOT+J)=IQ(JMOT1+J) 100 CONTINUE INTFLA=-1 CALL GDTREE(NAME,LEVMAX,ISELT) ENDIF * CALL GDPLST(JVSIM,NAME,LEVMAX,KXXX) * ELSEIF (CHPATL.EQ.'DSPEC') THEN CALL KUGETC(NAME,NCH) CALL GDSPEC(NAME) * ELSEIF (CHPATL.EQ.'D3DSPEC') THEN CALL KUGETC(NAME,NCH) CALL KUGETR(TETA3) CALL KUGETR(PHI3) CALL KUGETR(PSI3) CALL KUGETR(U03) CALL KUGETR(V03) CALL KUGETR(ZM3) CALL GSPE3D(NAME,TETA3,PHI3,PSI3,U03,V03,ZM3) * ELSEIF (CHPATL.EQ.'DFSPC') THEN CALL KUGETC(NAME,NCH) ISORT=0 CALL KUGETC(YESNO,NCH) IF (YESNO.EQ.'Y') ISORT=1 INTER=1 CALL KUGETC(MODE,NCH) IF (MODE.EQ.'B') INTER=0 CALL GDFSPC(NAME,ISORT,INTER) * ELSEIF (CHPATL.EQ.'DTEXT') THEN CALL KUGETR(X0) CALL KUGETR(Y0) CALL KUGETS(CHTEXT,NCH) CALL KUGETR(SIZE) CALL KUGETR(ANGLE) CALL KUGETI(LWID) CALL KUGETC(CENT,NCH) IF (CENT.EQ.'LEFT'.OR.CENT.EQ.'-1') THEN IOPT=-1 ELSEIF (CENT.EQ.'RIGHT'.OR.CENT.EQ.'1') THEN IOPT=1 ELSE IOPT=0 ENDIF CALL IGSET('TXFP',-60.) IWTY=IGIWTY(1) IF(IWTY.GT.10.OR.IWTY.LT.1)CALL IGSET('TXFP',-61.) CALL GDRAWT(X0,Y0,CHTEXT,SIZE,ANGLE,LWID,IOPT) CALL IGSET('TXFP',2.) * ELSEIF (CHPATL.EQ.'DVECTOR') THEN CALL KUGETV(VNAME,LPARX,LLL) CALL KUGETV(VNAME,LPARY,LLL) CALL KUGETI(NP) CALL GDRAWV(QQ(LPARX),QQ(LPARY),NP) * ELSEIF (CHPATL.EQ.'DSCALE') THEN CALL KUGETR(X0) CALL KUGETR(Y0) CALL GDSCAL(X0,Y0) * ELSEIF (CHPATL.EQ.'DAXIS') THEN CALL KUGETR(XX0) CALL KUGETR(YY0) CALL KUGETR(ZZ0) CALL KUGETR(DDX) CALL GDAXIS(XX0,YY0,ZZ0,DDX) * ELSEIF (CHPATL.EQ.'DMAN') THEN CALL KUGETR(U0) CALL KUGETR(V0) CALL KUGETC(MODE,NCH) IF (MODE.EQ.'WM1') THEN CALL GDWMN1(U0,V0) ELSE IF (MODE.EQ.'WM3') THEN CALL GDWMN3(U0,V0) ELSE IF (MODE.EQ.'WM2') THEN CALL GDWMN2(U0,V0) ELSE IF (MODE.EQ.'MAN') THEN CALL GDMAN(U0,V0) ENDIF * ELSEIF (CHPATL.EQ.'DHEAD') THEN ISELH=111110 CALL KUGETI(ISELH) CHRSIZ=0.6 CALL KUGETS(CHTEXT,NCH) CALL KUGETR(CHRSIZ) CALL GDHEAD(ISELH,CHTEXT,CHRSIZ) * ELSEIF (CHPATL.EQ.'MEASURE') THEN CALL IGLOC2(1,NT,U0,V0,U1,V1,ISTAT,'L') IF (ISTAT.EQ.0) GO TO 999 UDIST=(U1-U0)/(GSCU*GZUA) VDIST=(V1-V0)/(GSCV*GZVA) DIST=SQRT(UDIST*UDIST+VDIST*VDIST) WRITE (CHMAIL,'('' MEASURE : '',F9.4,'' CM'')') DIST CALL GMAIL(0,0) * ELSEIF (CHPATL.EQ.'MOVE') THEN IWTY=IGIWTY(1) IF(IWTY.LE.10.AND.IWTY.GE.1)THEN ISTAT=0 LEP=-ABS(LEP) CALL KUGETC(NAME,NCH) CALL KUGETC(NOPT,NCH) VX(1)=0. VX(2)=4. VX(3)=4. VX(4)=0. VY(1)=0. VY(2)=0. VY(3)=1. VY(4)=1. VXX(1)=4. VXX(2)=8. VXX(3)=8. VXX(4)=4. VYY(1)=0. VYY(2)=0. VYY(3)=1. VYY(4)=1. VVX(1)=8. VVX(2)=12. VVX(3)=12. VVX(4)=8. VVY(1)=0. VVY(2)=0. VVY(3)=1. VVY(4)=1. XV(1)=12. XV(2)=16. XV(3)=16. XV(4)=12. YV(1)=0. YV(2)=0. YV(3)=1. YV(4)=1. BX(1)=16. BX(2)=20. BX(3)=20. BX(4)=16. BY(1)=0. BY(2)=0. BY(3)=1. BY(4)=1. ***** CALL IGSET('DRMD',2.) CALL ISFAIS(1) CALL GDCOL1(2) CALL IFA(4,VX,VY) CALL GDCOL1(3) CALL IFA(4,VXX,VYY) CALL GDCOL1(4) CALL IFA(4,VVX,VVY) CALL GDCOL1(6) CALL IFA(4,XV,YV) CALL GDCOL1(7) CALL IFA(4,BX,BY) AITXCO=5. CALL IGSET('TXCI',AITXCO) CALL IGSET('TXFP',-60.) CALL GDRAWT(2.,.2,'THETA',.7,0.,4,0) CALL GDRAWT(6.,.2,'PHI',.7,0.,4,0) CALL GDRAWT(10.,.2,'TRASL',.7,0.,4,0) CALL GDRAWT(14.,.2,'ZOOM',.7,0.,4,0) CALL GDRAWT(18.,.2,'OFF',.7,0.,4,0) CALL IGSET('TXFP',2.) LLEP=ABS(LEP) IF(LLEP.GT.1)THEN LCLC=1 ELSE LCLC=0 ENDIF CALL ISFACI(LCLC) CALL IGBOX(0.,20.,20.,1.) CALL GDRAW(NAME,GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV) IOPTS = INDEX(NOPT,'S')+INDEX(NOPT,'s') IOPTT = INDEX(NOPT,'T')+INDEX(NOPT,'t') IOPTH = INDEX(NOPT,'H')+INDEX(NOPT,'h') IF(IOPTT.NE.0) CALL GDXYZ(0) IF(IOPTH.NE.0) CALL GDHITS('*','*',0,0,.2) MO=2 * OOY2=10. * OOX2=10. OGSCU=GSCU OGSCV=GSCV * ipx=1 CALL IGQWK(1,'MXDS',RVAL) IXXX=RVAL(1) IYYY=RVAL(2) IYYY1=(IYYY*19.)/20. DO 110 J=1,1000000 IF(ISTAT.EQ.2.AND.IOPTT.NE.0) CALL GKXYZ(-.25) IF(ISTAT.EQ.2.AND.IOPTH.NE.0) CALL GKHITS('*','*',-.1) CALL IRQLC(1,MO,ISTAT,NT,X2,Y2) * CALL ISFAIS(1) ***** CALL IGSET('DRMD',2.) IF(MO.NE.-2)THEN IF(X2.GT.0..AND.X2.LT.4..AND.Y2.LT.1.)NBAR=1 IF(X2.GT.4..AND.X2.LT.8..AND.Y2.LT.1.)NBAR=2 IF(X2.GT.8..AND.X2.LT.12..AND.Y2.LT.1.)NBAR=3 IF(X2.GT.12..AND.X2.LT.16..AND.Y2.LT.1.)NBAR=4 IF(X2.GT.16..AND.X2.LT.20..AND.Y2.LT.1.)THEN CALL IGSET('DRMD',1.) LEP=-LEP GO TO 999 ENDIF ENDIF * YY22=ABS(Y2-OOY2) IF(NBAR.EQ.1) THEN GTHETA=18.*Y2 IF(IOPTS.NE.0) MO=-2 IF(ISTAT.EQ.0.OR.ISTAT.EQ.2)MO=2 * IF(YY22.LT..2)GOTO 177 * OOY2=Y2 ELSEIF(NBAR.EQ.2) THEN * GBOOM=Y2/10. GPHI=18.*Y2 IF(IOPTS.NE.0) MO=-2 IF(ISTAT.EQ.0.OR.ISTAT.EQ.2)MO=2 * IF(YY22.LT..2)GOTO 177 * OOY2=Y2 ELSEIF(NBAR.EQ.3) THEN * XX22=ABS(X2-OOY2) GU0=X2 GV0=Y2 *** GTHETA=18.*Y2 *** GPHI=18.*Y2 IF(IOPTS.NE.0) MO=-2 IF(ISTAT.EQ.0.OR.ISTAT.EQ.2)MO=2 * IF(YY22.LT..2.AND.XX22.LT..2)GOTO 177 * OOY2=Y2 * OOX2=X2 ELSEIF(NBAR.EQ.4) THEN GSCU=OGSCU*Y2*.25 GSCV=OGSCV*Y2*.25 IF(IOPTS.NE.0) MO=-2 IF(ISTAT.EQ.0.OR.ISTAT.EQ.2)MO=2 * IF(YY22.LT..2)GOTO 177 * OOY2=Y2 ENDIF ***** CALL IGSET('DRMD',1.) CALL IGPXMP(IPX,IXXX,IYYY1,'O') CALL ISFACI(LCLC) IF(LCLC.NE.0)CALL IGBOX(0.,20.,20.,1.) CALL GDRAW(NAME,GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV) IF(IOPTT.NE.0) CALL GDXYZ(0) IF(IOPTH.NE.0) CALL GDHITS('*','*',0,0,.2) CALL IGPXMP(IPX,0,0,'CDR') ** CALL GDRAW(NAME,SGT1,SGT2,SGT3,SGT4,SGT5,SGT6,SGT7) * CALL GDXYZ(0) * CALL GDHITS('*','*',0,-1,.4) 110 CONTINUE ENDIF * ELSEIF (CHPATL.EQ.'MOVE3D') THEN CALL KUGETC(NAME,NCH) CALL KUGETR(GTHETA) CALL KUGETR(GPHI) CALL KUGETR(GPSI) CALL KUGETR(GU0) CALL KUGETR(GV0) CALL KUGETR(GSCU) CALL KUGETR(GSCV) CALL KUGETR(GSCZ) CALL KUGETC(NOPT,NCH) GSCU=GSCU*GSCZ GSCV=GSCV*GSCZ CALL HPLI CALL GDRAW(NAME,GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV) IOPTT = INDEX(NOPT,'T')+INDEX(NOPT,'t') IOPTH = INDEX(NOPT,'H')+INDEX(NOPT,'h') IF(IOPTT.NE.0) CALL GDXYZ(0) IF(IOPTH.NE.0) CALL GDHITS('*','*',0,0,.2) * ELSEIF (CHPATL.EQ.'PERSP') THEN CALL KUGETC(NAME,NCH) CALL KUGETR(DISTT) CALL KUGETC(SAMP,NCH) IF(DISTT.LT.100.)DISTT=100. DPERS=DISTT IF(SAMP(1:2).EQ.'ON')THEN IWTY=IGIWTY(1) IF(IWTY.LE.10.AND.IWTY.GE.1)THEN LEP=-ABS(LEP) CALL IGQWK(1,'MXDS',RVAL) IXXX=RVAL(1) IYYY=RVAL(2) DO 120 II=1,1000000 CALL IRQLC(1,2,ISTAT,NT,X2,Y2) IF(ISTAT.EQ.0)GOTO 130 DPERS=Y2*100.+100. GTHETA=X2*4.5 GPHI=90.-GTHETA CALL IGPXMP(IPX,IXXX,IYYY,'O') CALL GDRAW(NAME,GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV) CALL IGPXMP(IPX,0,0,'CDR') 120 CONTINUE 130 CONTINUE ENDIF ENDIF ELSEIF (CHPATL.EQ.'LENS') THEN ZZFV=0. IWTY=IGIWTY(1) IF(IWTY.LE.10.AND.IWTY.GE.1)THEN CALL KUGETI(KNUM) IF(KNUM.EQ.1000)KNUM=MYISEL CALL KUGETC(KSAM,NCH) KLLM=KNUM KLSA=KSAM CALL GDLENS(KLLM,KLSA) ENDIF * ELSEIF (CHPATL.EQ.'ZOOM') THEN CONTINUE ZZFV=0. ZFU=2. CALL KUGETR(ZFU) ZFV=ZFU CALL KUGETR(ZFV) ZZFU=ZFU ZZFV=ZFV IF(ZZFU.EQ.0.)ZZFV=0. IF(ZFU.EQ.0.OR.ZFV.EQ.0)GO TO 140 IMODE=1 CALL KUGETI(IMODE) UZ0=PLTRNX*.5 CALL KUGETR(UZ0) VZ0=PLTRNY*.5 CALL KUGETR(VZ0) U0 =UZ0 CALL KUGETR(U0) V0 =U0 CALL KUGETR(V0) * IF(IMODE.GT.1000)THEN IWTY=IGIWTY(1) IF(IWTY.LE.10.AND.IWTY.GE.1)THEN ISEL1=IMODE-1000 CALL GDXZOO(ISEL1,ZFU,ZFV,UZ0,VZ0,U0,V0) RETURN ENDIF ELSEIF(IMODE.EQ.1000)THEN IWTY=IGIWTY(1) IF(IWTY.LE.10.AND.IWTY.GE.1)THEN ISEL1=MYISEL CALL GDXZOO(ISEL1,ZFU,ZFV,UZ0,VZ0,U0,V0) RETURN ENDIF ENDIF * IF(IMODE.EQ.0)THEN * CALL GDCURS(UZ0,VZ0,JCHAR) IF (JCHAR.EQ.0) GO TO 999 * ELSE IF(IMODE.EQ.1)THEN * CALL IGLOC2(1,NT,UZ1,VZ1,UZ2,VZ2,ISTAT,'R') IF (ISTAT.EQ.0) GO TO 999 IF (UZ2-UZ1.EQ.0.) UZ2=UZ1+PLTRNX/200. IF (VZ2-VZ1.EQ.0.) VZ2=VZ1+PLTRNY/200. ZFU=PLTRNX/ABS(UZ2-UZ1) ZFV=PLTRNY/ABS(VZ2-VZ1) UZ0=(UZ1+UZ2)/2. VZ0=(VZ1+VZ2)/2. * ELSE IF(IMODE.EQ.2)THEN * CALL GDCURS(UZ0,VZ0,JCHAR) IF (JCHAR.EQ.0) GO TO 999 CALL GDCURS(U0,V0,JCHAR) IF (JCHAR.EQ.0) GO TO 999 * ENDIF * 140 CALL GDZOOM(ZFU,ZFV,UZ0,VZ0,U0,V0) * * ELSEIF (CHPATL.EQ.'DXYZ') THEN CALL KUGETI(IT) CALL GDXYZ(IT) * ELSEIF (CHPATL.EQ.'KXYZ') THEN CALL KUGETR(EPSXYZ) CALL GKXYZ(EPSXYZ) * ELSEIF (CHPATL.EQ.'DPART') THEN CALL KUGETI(IT) ISELP = 11 CALL KUGETI(ISELP) CALL KUGETR(SIZE) CALL GDPART(IT,ISELP,SIZE) * ELSEIF (CHPATL.EQ.'DHITS') THEN CALL KUGETC(IVS,NCH) CALL KUGETC(ICS,NCH) CALL KUGETI(IUTR) ISYMB=0 CALL KUGETI(ISYMB) CALL KUGETR(SSYMB) CALL GDHITS(IVS,ICS,IUTR,ISYMB,SSYMB) * ELSEIF (CHPATL.EQ.'KHITS') THEN CALL KUGETC(IVS,NCH) CALL KUGETC(ICS,NCH) CALL KUGETR(EPSHIT) CALL GKHITS (IVS,ICS,EPSHIT) * ELSEIF (CHPATL.EQ.'DCHIT') THEN IUTR =0 ISYMB=0 SIZMAX=1. KDHIT =4 HITMIN=0. HITMAX=0. CALL KUGETC(IVS,NCH) CALL KUGETC(ICS,NCH) CALL KUGETI(IUTR) CALL KUGETI(ISYMB) CALL KUGETR(SIZMAX) CALL KUGETI(KDHIT) CALL KUGETR(HITMIN) CALL KUGETR(HITMAX) CALL GDCHIT(IVS,ICS,IUTR,ISYMB,SIZMAX,KDHIT, HITMIN,HITMAX) * ELSEIF (CHPATL.EQ.'DUVIEW') THEN CALL KUGETC(IDS,NCH) CALL KUGETC(IVS,NCH) CALL KUGETC(ICS,NCH) CALL KUGETI(IVIEW) #if !defined(CERNLIB_USRJMP) CALL GUVIEW(IDS,IVS,ICS,IVIEW) #endif #if defined(CERNLIB_USRJMP) CALL JUMPT4(JUVIEW,IDS,IVS,ICS,IVIEW) #endif ENDIF * 999 END