SUBROUTINE MAINRAS(Z,FREQ,SD,RD,OPTION,DEVICE, & XPIXEL,YPIXEL,VUG,DEL,ZBUF,NPXYZ,FAX,ROT,REVERS,NCS,WDW) PARAMETER ( NCLZ=19,NCLZP1=NCLZ+1,NLEV1=51 ) parameter (nbot_max = 5000, nbm= nbot_max+20) LOGICAL BATCH, IB EXTERNAL BATCH CHARACTER*3 XBTYPE,YBTYPE,BWCOL,LINEP,DEVICE,FONT,VUG,DEL, & FAX, ROT, NOWRT, SDPLOT, RDPLOT, NCS, WDW, ULC CHARACTER*3 MODE CHARACTER*4 DUMMY CHARACTER*40 DIDASC CHARACTER*80 OPTION CHARACTER*80 UNIINF, UNIWRK, UNIRST CHARACTER*80 TITLE, TITLEX, TITLEY REAL ZBUF(NPXYZ) DIMENSION KOLORS(NCLZP1),ZCLASS(NCLZ),Z(1,1) REAL TRPAX(4), TRPAY(4) COMMON /BOTT/ XF(nbm), YF(nbm), NPBOTT, ISHADE, NPSH COMMON /MULBOTT/ LINES,numbot COMMON /FLSUNI/ UNIINF,UNIWRK,UNIRST COMMON /FONTEX/ FONT COMMON /CHFLAG/ BWCOL, LINEP COMMON /HSFLAG/ IFIRST,ILAST,CYL,FOM,PRB,SEG,ISEG, & IFR,SDFLAG,NCL COMMON /PARA/ LABPT,NSM,NDIV,CAY,NARC,NRNG,HGTPT,HGT, & LABC(51),LWGT(51) COMMON /PARAC/ TITLE, SDPLOT, RDPLOT COMMON /PLT/ FACT,YASIZE,SCALF,SF,IB,PLT COMMON /SNAPSHOT/ SCFAC COMMON /SWITCH/ NOWRT, ULC COMMON /XAX/ X1,XL,XLEFT,XRIGHT,XSCALE,XINC,DX, & X1PL,XLPL,NX,X1GRID,XLGRID,DIVX,XVAL(100),NXVAL COMMON /XAXC/ TITLEX,XBTYPE COMMON /YAX/ Y1,YL,YUP,YDOWN,YSCALE,YINC,DY, & Y1PL,YLPL,NY,Y1GRID,YLGRID,DIVY,YVAL(100),NYVAL COMMON /YAXC/ TITLEY,YBTYPE COMMON /ZAX/ ZMIN,ZMAX,ZINC,NLEV,ZLEV(NLEV1) DATA DIST1/30.0/ DATA AXWID/ 0.4 / C 100 FORMAT('F=',F7.1,'Hz',2X,'SD=',F6.1,A3,'$') 120 FORMAT('F=',F7.1,'Hz$') 140 FORMAT('F=',F7.1,'Hz',2X,'SD=',F6.1,A3,2X,'SF=10**',I2,'$') 160 FORMAT('SD=',F6.1,A3,'$') 200 FORMAT('SD=',F6.1,A3,2X,' RD=',F6.1,A3,'$') 300 FORMAT(1X,'REVISE NUMBER OF "Z" LEVELS.',/,'EXECUTION ', & 'TERMINATED - ERROR IN SUB. UNIRAS',/) 400 FORMAT(A4) 500 FORMAT(1X,/,' TO CLOSE THE GRAPHIC WINDOW ASSIGN THE INPUT FOCUS', & /,' TO THE WINDOW AND PRESS RETURN ') 600 FORMAT(1X,/,' *** WARNING: BOTTOM SHADING NOT ALLOWED WITH', & ' VIEWGRAPHS *** ',/) C IF(VUG.EQ.'VUG') WRITE(6,*) ' VIEWGRAPH OPTION IS SET' XSAVE=X1PL YSAVE=Y1PL IF(DEVICE.EQ.'VTT'.OR.DEVICE.EQ.'T41') THEN X1PL=40. Y1PL=35. ELSE X1PL=X1PL*25.4 Y1PL=Y1PL*25.4 END IF C X-Y PLOT ORIGIN COORDINATES ARE ADJUSTED ACCORDING TO PIXEL SIZE X1PL=X1PL - MOD(X1PL,4*XPIXEL) Y1PL=Y1PL - MOD(Y1PL,4*YPIXEL) C HGTU=HGT*25.4 HGTU1=HGTU*1.333 NLEV=MIN(NCLZ,NLEV) NLEVP1=NLEV+1 OPTION(6:6)=',' IF(OPTION(1:5).EQ.'PAREQ' .OR. OPTION(1:5).EQ.'IFD ') THEN OPTION(14:14)='$' NCHOPT= 13 ELSE OPTION(10:10)='$' NCHOPT= 9 END IF C OPEN(UNIT=28,STATUS='UNKNOWN') C CALL CHARA(TITLE,NTITQ) C CALL CHARA(TITLEX,NTITX) C CALL CHARA(TITLEY,NTITY) C DIDASC(1:1)='$' IF( (OPTION(1:5).EQ.'CONDR') .OR. & (OPTION(1:5).EQ.'EXPDR') .OR. & (OPTION(1:5).EQ.'IFD ') .OR. & (OPTION(1:5).EQ.'PAREQ') .OR. & (OPTION(1:5).EQ.'TDPEN') ) THEN IF((FOM.LT.1.0 .OR. SD.GT.0.0) .AND. (SDFLAG .LT. 1.0)) THEN IF(OPTION(1:5).EQ.'CONDR'.AND.SCFAC.NE.0.0) THEN IEXPSCFAC=ALOG10(SCFAC) WRITE(DIDASC,140)FREQ,SD,SDPLOT,IEXPSCFAC ELSE WRITE(DIDASC,100)FREQ,SD,SDPLOT END IF ELSE WRITE(DIDASC,120) FREQ END IF ELSE IF (OPTION(1:5).EQ.'CONFR' ) THEN WRITE(DIDASC,200)SD,SDPLOT,RD,RDPLOT ELSEIF (OPTION(1:5).EQ.'CONDA' ) THEN WRITE(DIDASC,160)SD,SDPLOT END IF END IF C IF(NLEV.GT.NLEV1-1) THEN WRITE(6,300) STOP END IF C C limits for color scale MUST BE in ascending order Z1=MIN(ZMIN,ZMAX) Z2=MAX(ZMIN,ZMAX) ZSTEP=ABS(ZINC) DO 1000 ILEV=1,NLEV ZCLASS(ILEV)=Z1 + (ILEV-1)*ZSTEP 1000 CONTINUE CALL CLASUN(KOLORS,OPTION,ZCLASS,NLEV,DEVICE, & VUG,IBASE,REVERS,ROT,WDW) CALL RTXFON('COMP',0) BXORIG=X1PL BYORIG=Y1PL C IF(XBTYPE.NE.'LOG') THEN BXSIZE=10.*ABS((XRIGHT-XLEFT)/XSCALE) GXSIZE=10.*ABS((XLGRID-X1GRID)/XSCALE) GXORIG=X1PL+10.0*((X1GRID-XLEFT)/XSCALE) ELSE BXSIZE=10.*ABS((XRIGHT-XLEFT)*XSCALE) GXSIZE=10.*ABS((XLGRID-X1GRID)*XSCALE) C GXORIG TO BE DEFINED YET END IF IF(YBTYPE.NE.'LOG') THEN BYSIZE=10.0*ABS((YUP-YDOWN)/YSCALE) GYSIZE=10.0*ABS((YLGRID-Y1GRID)/YSCALE) IF(YDOWN.GT.YUP) THEN GYORIG=Y1PL+10.*ABS((YDOWN-AMAX1(Y1GRID,YLGRID))/YSCALE) YINC=-ABS(YINC) ELSE GYORIG=Y1PL+10.*ABS((YDOWN-AMIN1(Y1GRID,YLGRID))/YSCALE) YINC=ABS(YINC) END IF ELSE BYSIZE=10.0*ABS(ALOG(YUP/YDOWN)/ALOG(2.0))*YSCALE GYSIZE=10.0*ABS((Y1GRID-YLGRID)*YSCALE) C MEANING OF YUP,YDOWN IS REVERSED ON LOG AXES GYORIG=Y1PL+10.0*ABS(((ALOG(YUP)/ALOG(2.0))-Y1GRID)*YSCALE) END IF C RATIO=1.0 IF((DEVICE.EQ.'VTT') .OR. & (DEVICE.EQ.'T41') .OR. & (DEVICE.EQ.'PHA') .OR. & (DEVICE.EQ.'TEK') .OR. & (DEVICE.EQ.'PSP') .OR. & (DEVICE.EQ.'PSL') .OR. & (DEVICE.EQ.'LAS') .OR. & (DEVICE.EQ.'EPS') .OR. & (DEVICE.EQ.'G41')) THEN CALL GRPPIX(NGRPIX,NGRPIY) if (ROT.eq.'ROT') then CALL GRPSIZ(YLEN,XLEN) else CALL GRPSIZ(XLEN,YLEN) end if C WRITE(67,*)' DEVICE ',DEVICE C WRITE(67,*) ' XLEN ,YLEN ',XLEN, YLEN C WRITE(67,*) ' NGRPIX, NGRPIY ',NGRPIX, NGRPIY C WRITE(67,*) 'SIZE OF XPIX, YPIX :',XLEN/NGRPIX,YLEN/NGRPIY C WRITE(67,*) ' XPIXEL, YPIXEL ',XPIXEL, YPIXEL IF((LINEP .NE. 'LIN') .AND. (NCS .NE. 'NCS')) THEN RATIOX=XLEN/(BXORIG+BXSIZE+60.0) ELSE RATIOX=XLEN/(BXORIG+BXSIZE+10.0) END IF RATIOY=YLEN/(BYORIG+BYSIZE+1.5*MAX(HGTU,BYSIZE/(NY-1))) RATIO= MIN(RATIOX,RATIOY,1.0) if (ratio.lt.1.0) then write(6,*) write(6,*) '>>> Warning: Plot scaled by factor',ratio write(6,*) ' Device x,y-dimensions:',xlen,ylen write(6,*) end if END IF C GXOLD=GXSIZE NXPIX=NINT(GXSIZE*RATIO/(XPIXEL*4.0)) GXSIZE=NXPIX*XPIXEL*4.0/RATIO NXPIX=NINT(BXSIZE*RATIO/(XPIXEL*4.0)) BXSIZE=NXPIX*XPIXEL*4.0/RATIO C BXSIZE=BXSIZE*GXSIZE/GXOLD GYOLD=GYSIZE NYPIX=NINT(GYSIZE*RATIO/(XPIXEL*4.0)) GYSIZE=NYPIX*XPIXEL*4.0/RATIO NYPIX=NINT(BYSIZE*RATIO/(XPIXEL*4.0)) BYSIZE=NYPIX*XPIXEL*4.0/RATIO C BYSIZE=BYSIZE*GYSIZE/GYOLD GXOOLD=GXORIG c >>> nxpix changed 920624 to scale origin c NXPIX=GXORIG/(XPIXEL*4.0) NXPIX=nint(GXORIG*ratio/(XPIXEL*4.0)) GXORIG=NXPIX*XPIXEL*4.0 BXORIG=GXORIG+(BXORIG-GXOOLD)*RATIO NXSHIF=NINT((GXORIG-BXORIG)/(4.0*XPIXEL)) BXORIG=GXORIG-NXSHIF*4.0*XPIXEL GYOOLD=GYORIG c >>> nypix changed 920624 to scale origin c NYPIX=GYORIG/(XPIXEL*4.0) NYPIX=nint(GYORIG*ratio/(XPIXEL*4.0)) GYORIG=NYPIX*XPIXEL*4.0 BYORIG=GYORIG+(BYORIG-GYOOLD)*RATIO NYSHIF=NINT((GYORIG-BYORIG)/(4.0*XPIXEL)) BYORIG=GYORIG-NYSHIF*4.0*XPIXEL IF( DEVICE .EQ. 'EPS') THEN C We choose portrait as default IF( ROT .EQ. 'ROT' ) THEN CALL RORIEN(1) ELSE CALL RORIEN(2) END IF ELSE C We choose landscape as default IF( ROT .EQ. 'ROT' ) THEN CALL RORIEN(2) ELSE CALL RORIEN(1) END IF END IF CALL UNDEF(Z,NX,NY) CALL GLIMIT(X1GRID*DIVX,XLGRID*DIVX, & Y1GRID*DIVY,YLGRID*DIVY,0.,0.) CALL GVPORT(GXORIG,GYORIG,GXSIZE*RATIO,GYSIZE*RATIO) BOXX=GXSIZE/MIN(GXSIZE,GYSIZE) BOXY=GYSIZE/MIN(GXSIZE,GYSIZE) CALL GWBOX(BOXX,BOXY,0.) CALL GSCALE IF( (DEVICE.EQ.'VTT') .OR. & (DEVICE.EQ.'T41') .OR. & (DEVICE.EQ.'LAS') .OR. & (DEVICE.EQ.'PHA') .OR. & (DEVICE.EQ.'EPS') .OR. & (DEVICE.EQ.'PSL') .OR. & (DEVICE.EQ.'PSP') .OR. & (DEVICE.EQ.'TEK')) THEN IF(LINEP .EQ. 'LIN') THEN CALL GCONA(HGTU,0,-MAX(GYSIZE,GXSIZE)*RATIO*0.5,2) CALL GCNR2V(Z,NX,NY) ELSE CALL GCNR2S(Z,NX,NY) IF(NCL .LT. 1 ) CALL GCNR2V(Z,NX,NY) END IF ELSE C THIS SECTION IS INTENDED FOR HIGH QUALITY OUTPUT (HQU), THAT IS WHEN A C SMOOTH SURFACE INTERPOLATION TECHNIQUE IS WANTED. C WHEN THIS IS THE CASE, THEN GINTPR SHOULD BE MADE EFFECTIVE C CALL GINTPR(Z,NX,NY,ZNEW,NXNEW,NYNEW) C CALL GCNR2S(ZNEW,NXNEW,NYNEW) C IF(NCL .LT. 1 ) CALL GCNR2V(ZNEW,NXNEW,NYNEW) CALL GCNR2S(Z,NX,NY) IF(NCL .LT. 1 ) CALL GCNR2V(Z,NX,NY) END IF CALL GLIMIT(XLEFT*DIVX,XRIGHT*DIVX,YDOWN*DIVY,YUP*DIVY, & 0.0,0.0) CALL GVPORT(BXORIG,BYORIG,BXSIZE*RATIO,BYSIZE*RATIO) BOXX=BXSIZE/MIN(BXSIZE,BYSIZE) BOXY=BYSIZE/MIN(BXSIZE,BYSIZE) CALL GWBOX(BOXX,BOXY,0.) HGTU=HGTU*ratio HGTU1=HGTU1*ratio CALL GAXLAB(HGTU1,HGTU,1,0) IDIR=1 VSTEP=XINC*DIVX APOS=YDOWN*DIVY CALL RAXTEF(4,'COMP',0) CALL RAXTEF(5,'COMP',0) CALL RAXTEF(6,'COMP',0) CALL AXES(TITLEX,IDIR,VSTEP,APOS,HGTU,AXWID) IF(YBTYPE.NE.'LOG') THEN IDIR=2 VSTEP=YINC*DIVY APOS=XLEFT*DIVX CALL RTXFON('COMP',0) CALL AXES(TITLEY,IDIR,VSTEP,APOS,HGTU,AXWID) ELSE CALL YLOGUN(RATIO) END IF CALL GSCAMM CALL RTXANG(0.0) 2000 CONTINUE CALL BOTTOM(*3000) CALL WINDOW IF(NPSH .LT. 2) GO TO 2000 MODE= 'MIX' IF( OPTION(1:5) .EQ. 'CONSV' ) MODE= 'REP' CALL SHADE(BXORIG, BYORIG, BXSIZE, BYSIZE, & BWCOL, IBASE, RATIO, MODE) CALL GEMPTY GO TO 2000 3000 CONTINUE IF( ((OPTION(1:5).EQ.'CONDR') .OR. & (OPTION(1:5).EQ.'IFD ') .OR. & (OPTION(1:5).EQ.'EXPDR') .OR. & (OPTION(1:5).EQ.'PAREQ') .OR. & (OPTION(1:5).EQ.'TDPEN')) .AND. & (FOM.LT.1.0 .OR. SD.GT.0.0) .AND. & (SDFLAG .LT. 1.0) ) THEN IF(SD.GE.MIN(YUP,YDOWN).AND.SD.LE.MAX(YUP,YDOWN) ) THEN SDEPTH=BYORIG+BYSIZE*((SD-YDOWN)/(YUP-YDOWN)) Y= (SDEPTH-BYORIG)*RATIO +BYORIG CALL GWICOL(0.6,1) CALL STAR(BXORIG, Y, HGTPT*25.4,RATIO) END IF END IF C COMPLETING THE FRAME AROUND THE PLOT AREA CALL GWICOL( AXWID, 1) CALL GVECT(BXORIG,BYORIG+RATIO*BYSIZE,0) CALL GVECT(BXORIG+RATIO*BXSIZE,BYORIG+RATIO*BYSIZE,1) CALL GVECT(BXORIG+RATIO*BXSIZE,BYORIG,1) C GRID RECTANGLE AND DIDASC ON LEFT UPPER CORNER OF PLOT YBOX=BYORIG+BYSIZE+HGTU XSIDE=BXSIZE/(NX-1) YSIDE=BYSIZE/(NY-1) YB= BYORIG + BYSIZE*RATIO + HGTU XS= BXORIG + ABS(XSIDE*RATIO) YS= YB + ABS(YSIDE*RATIO) CALL GVECT(BXORIG,YB,0) CALL GVECT(BXORIG,YS,1) CALL GVECT(XS,YS,1) CALL GVECT(XS,YB,1) CALL GVECT(BXORIG,YB,1) X=(XSIDE+HGTU)*RATIO + BXORIG Y=(YBOX-BYORIG)*RATIO + BYORIG CALL RTXHEI(HGTU) CALL RTX(-5,DIDASC,X,Y) C OPTION IDENTIFICATION IF( NOWRT .NE. 'NWR' ) THEN CALL RTXHEI(HGTU) CALL RQTXP(NCHOPT,OPTION,0.,0.,TRPAX,TRPAY) YOPT=BYORIG+BYSIZE+HGTU X=BXORIG + BXSIZE*RATIO - TRPAX(2) Y=(YOPT-BYORIG)*RATIO + BYORIG CALL RTX(NCHOPT,OPTION,X,Y) END IF IF( ULC .NE. 'ULC' ) THEN CALL RTXHEI(HGTU1) ddy=max(2.0,byorig-dist1*ratio) CALL RTX(-5,TITLE, BXORIG, ddy ) ELSE CALL RTXHEI(HGTU*1.7) Y= BYORIG + (BYSIZE + HGTU) * RATIO CALL RTX(-5,TITLE, BXORIG - 6.6*HGTU, Y ) END IF C COLOR SCALE IF((LINEP .NE. 'LIN') .AND. (NCS .NE. 'NCS')) THEN c XCOSL=BXSIZE+BXORIG+11.0 xcosl=bxorig+(bxsize+8.0)*ratio YCOSL=BYORIG c X=(XCOSL-BXORIG)*RATIO + BXORIG x=xcosl Y=YCOSL if (ratio.lt.0.95) then CALL GCOSCS(X,Y) else CALL GCOSCL(X,Y) end if END IF CALL GEMPTY C CREATION OF UNIRAS FILES FOR BATCH SPOOLING OF C CONTOUR PLOTS C IF(SEG .LT. 1.0 ) THEN NNP=0 IF(DEVICE.NE.'VTT' .AND. DEVICE.NE.'T41') THEN INQUIRE(UNIT=28,NAME=UNIINF) INQUIRE(UNIT=25,NAME=UNIWRK) if (device.eq.'TEK') then call qt4695 end if CALL GCLOSE CALL ADD(DEL,VUG,NNP,DEVICE,FAX,BWCOL) ELSE IF(WDW .EQ. 'DCW') THEN WRITE(6,500) ELSE WRITE(6,*) ' *** DEPRESS RETURN TO CLEAN THE SCREEN ***' READ(5,400) DUMMY CALL GCLEAR c CALL LIB$SPAWN('$SET TERM/BROAD') CALL GCLOSE END IF END IF ELSE WRITE(6,*) ' CLOSING SEGMENT = ',ISEG CALL GSEGCL(ISEG) CALL GCLOSE END IF C X1PL=XSAVE Y1PL=YSAVE RETURN END