SUBROUTINE BOXBW(X1PLN,XLPLN,Y1PLN,YLPLN,FREQ,SD,RD,OPT, & XP,YP) parameter (nbot_max = 5000, nbm= nbot_max+20) LOGICAL IB CHARACTER*3 XBTYPE, YBTYPE, FONT, NOWRT, SDPLOT, RDPLOT, & BWCOL, LINEP, ULC CHARACTER*80 TITLE,TITLEX,TITLEY CHARACTER*80 OPT, TEXT DIMENSION XP(1), YP(1) COMMON /BOTT/ XF(nbm), YF(nbm), NPBOTT, ISHADE, NPSH 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,ICOL COMMON /SH/ PF(440), QF(440), UF(440), VF(440) 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,YBOX COMMON /YAXC/ TITLEY,YBTYPE C C (X1,Y1),(XL,YL) : EXTREMES OF GRID COORDINATES IN DATA UNITS C XLEFT,XRIGHT,XSCALE,XINC X AXIS SPECIFICATIONS FOR PLOT C YUP,YDOWN,YSCALE,YINC Y AXIS SPECIFICATIONS FOR PLOT C NCHOPT= 9 C SAVXPL=X1PL SAVYPL=Y1PL XAXIS=ABS((XLEFT-XRIGHT)/XSCALE) XBOX=ABS((XL-X1)/(XSCALE*2.54))/(NX-1) IF(YBTYPE(1:3).EQ.'LOG') THEN YAXIS=ABS((ALOG(YUP/YDOWN)/ALOG(2.0))*YSCALE) YBOX=ABS((YLGRID-Y1GRID)*YSCALE)/((NY-1)*2.54) ELSE YAXIS=ABS((YUP-YDOWN)/YSCALE) YBOX=ABS((YLGRID-Y1GRID)/(YSCALE*(NY-1)*2.54)) END IF YLPL=Y1PL+ YAXIS/2.54 TMAX=AMAX1(ABS(Y1),ABS(YL),1.0) TMAX=(ALOG10(TMAX)+5.5)*HGT*2.54+1.0 IF(TMAX.GT. X1PL*2.54) X1PL=TMAX/2.54+0.2 XLPL=X1PL+ XAXIS/2.54 IF(IB) FACT=1.0 C SELECTION OF SYMBOL TYPE FOR TEXT ON PLOT CCC ITYPE=IFIX(AMAX1(1.0,HGTPT)) CCC CALL CHTYP(ITYPE) CALL NEWPLT(NSHEET,TITLE,56,0) CALL SETCOL(ICOL) IF(SCALF.NE.1.0) THEN SAVEX=XSCALE SAVEY=YSCALE X1PL=X1PL*SCALF Y1PL=Y1PL*SCALF XLPL=XLPL*SCALF YLPL=YLPL*SCALF XBOX=XBOX*SCALF YBOX=YBOX*SCALF YAXIS=YAXIS*SCALF XAXIS=XAXIS*SCALF SAVEH=HGT HGT=HGT*SCALF IF(XBTYPE.NE.'LOG') THEN XSCALE=XSCALE/SCALF ELSE XSCALE=XSCALE*SCALF END IF C IF(YBTYPE.NE.'LOG') THEN YSCALE=YSCALE/SCALF ELSE YSCALE=YSCALE*SCALF END IF END IF C CALL PLOT(X1PL*2.54,Y1PL*2.54,-3) XLPL=XLPL-X1PL X1PL=0.0 YLPL=YLPL-Y1PL Y1PL=0.0 C CALL FACTOR(SF) C IF(OPT(1:6).EQ.'CONFT,') DIVX=1. C IF(XBTYPE.NE.'LOG') THEN CALL XAXLIN IF(XLEFT .LE. XRIGHT) THEN X1PLN=X1PL+(X1GRID-XLEFT)/(XSCALE*2.54) XLPLN=X1PL+(XLGRID-XLEFT)/(XSCALE*2.54) ELSE X1PLN=X1PL+(XLEFT-X1GRID)/(XSCALE*2.54) XLPLN=X1PL+(XLEFT-XLGRID)/(XSCALE*2.54) END IF ELSE C THIS CASE NOT IMPLEMENTED YET C C CALL XAXLOG C X1PLN= C XLPLN= END IF HGTCH=1.5*HGT CALL CHARA(TITLE,N) C TLEN=N*HGTCH*0.95 * 2.54 XORIG=0.0 C IF(TLEN.GT.XAXIS) THEN C IF(TLEN.GT.XASIZE) THEN C TLEN=XASIZE C N=XASIZE/(HGTCH*0.95*2.54) C END IF C XORIG=(-XSHIFT+0.5*(XASIZE-TLEN))/2.54 C END IF CALL SYMBOL(XORIG,-(4.3*HGT+1.8*HGTCH),HGTCH,TITLE,0.0,N) IF(YBTYPE(1:3).EQ.'LOG') THEN ISKIP= 1 CALL YAXLOG(ISKIP) Y1PLN=Y1PL+(Y1GRID-ALOG(YUP)/ALOG(2.0))*YSCALE/2.54 YLPLN=Y1PL+(YLGRID-ALOG(YUP)/ALOG(2.0))*YSCALE/2.54 ELSE CALL YAXLIN IF(YDOWN.GT.YUP) THEN Y1PLN=Y1PL+ABS((YDOWN-AMAX1(Y1GRID,YLGRID))/(YSCALE*2.54)) ELSE Y1PLN=Y1PL+ABS((YDOWN-AMIN1(YLGRID,Y1GRID))/(YSCALE*2.54)) END IF YLPLN=Y1PLN+ABS((YLGRID-Y1GRID)/(YSCALE*2.54)) END IF CALL PLOT(X1PL,YLPL,3) CALL PLOT(XLPL,YLPL,2) CALL PLOT(XLPL,Y1PL,2) CALL PLOT(X1PL,YLPL+HGT,3) CALL PLOT(X1PL+XBOX,YLPL+HGT,2) CALL PLOT(X1PL+XBOX,YLPL+HGT+YBOX,2) CALL PLOT(X1PL,YLPL+HGT+YBOX,2) CALL PLOT(X1PL,YLPL+HGT,2) C 1100 CONTINUE CALL BOTTOM(*1150) CALL WINDOW IF(NPSH.LE.2) GO TO 1100 IF(YBTYPE.EQ.'LOG') THEN DO 1000 I=1,NPSH YP(I)=Y1PL+3.937*ABS(ALOG(VF(I)/YDOWN)/ALOG(2.0))*YSCALE 1000 CONTINUE ELSE DO 1200 I=1,NPSH YP(I)=Y1PL + YAXIS*((VF(I)-YDOWN)/((YUP-YDOWN)*2.54)) 1200 CONTINUE END IF C IF(XBTYPE.EQ.'LOG') THEN DO 2000 I=1,NPSH XP(I)=X1PL+3.937*ABS(ALOG(UF(I)/XLEFT)/ALOG(2.0))*XSCALE 2000 CONTINUE ELSE DO 2200 I=1,NPSH XP(I)=X1PL + XAXIS*((UF(I)-XLEFT)/((XRIGHT-XLEFT)*2.54)) 2200 CONTINUE END IF C c >>> changed to MINDIS shading. HS 920622 if (ishade.eq.4) then call setcol(1) else call setcol(14-3*(ishade-1)) end if call bgnfll CALL PLOTNY(XP(1),YP(1),3,2) DO 3200 I=2,NPSH CALL PLOTNY(XP(I),YP(I),2,2) 3200 CONTINUE call endfll call setcol(1) CALL PLOTNY(XP(1),YP(1),3,2) DO 3201 I=2,NPSH CALL PLOTNY(XP(I),YP(I),2,2) 3201 CONTINUE GO TO 1100 1150 CONTINUE C IF( (OPT(1:5).EQ.'CONDR') .OR. & (OPT(1:5).EQ.'EXPDR') .OR. & (OPT(1:5).EQ.'IFD ') .OR. & (OPT(1:5).EQ.'PAREQ') .OR. & (OPT(1:5).EQ.'TDPEN') ) THEN TEXT=' F= ' CALL SYMBOL(X1PL+XBOX,YLPL+HGT,HGT,TEXT,0.,6) CALL NUMBER(999.,999.,HGT,FREQ,0.,1) TEXT='Hz ' CALL SYMBOL(999.,999.,HGT,TEXT,0.,3) IF((FOM.LT.1.0) .OR. (SD.GT.0.0)) THEN TEXT=' SD= ' CALL SYMBOL(999.,999.,HGT,TEXT,0.,6) CALL NUMBER(999.,999.,HGT,SD,0.,1) CALL SYMBOL(999.,999.,HGT,SDPLOT,0.,3) IF(SCFAC.NE.0.0) THEN TEXT=' SF= 10**' CALL SYMBOL(999.,999.,HGT,TEXT,0.,10) EXPSCFAC=ALOG10(SCFAC) CALL NUMBER(999.,999.,HGT,EXPSCFAC,0.,-1) END IF C IF(SD.GE.AMIN1(YUP,YDOWN).AND.SD.LE.AMAX1(YUP,YDOWN) ) THEN XX= 0.0 YY=Y1PL+(YDOWN-SD)*(YLPL-Y1PL)/(YDOWN-YUP) CALL STARDIS(XX,YY,HGT,1.0) END IF END IF END IF IF( OPT(1:6).EQ.'CONFR,' & .OR.OPT(1:6).EQ.'CONDA,' & .OR.OPT(1:6).EQ.'CONFT,' & .OR.OPT(1:6).EQ.'INPUT ' & .OR.OPT(1:6).EQ.'STATIS' & .OR.OPT(1:6).EQ.'ERROR ' & .OR.OPT(1:6).EQ.'DIFFER') THEN TEXT=' SD= ' CALL SYMBOL(X1PL+XBOX,YLPL+HGT,HGT,TEXT,0.,6) CALL NUMBER(999.,999.,HGT,SD,0.,1) CALL SYMBOL(999.,999.,HGT,SDPLOT,0.,3) IF( OPT(1:6).NE.'CONDA,') THEN TEXT=' RD= ' CALL SYMBOL(999.,999.,HGT,TEXT,0.,6) CALL NUMBER(999.,999.,HGT,RD,0.,1) CALL SYMBOL(999.,999.,HGT,RDPLOT,0.,3) END IF END IF IF(OPT(1:5).EQ.'PAREQ' .OR. OPT(1:5).EQ.'IFD ') NCHOPT= 13 IF( NOWRT .NE. 'NWR' ) & CALL SYMBOL(XLPL-NCHOPT*HGT,YLPL+HGT,HGT,OPT,0.,NCHOPT) C IF(YBTYPE(1:3).EQ.'LOG') THEN YREF=ALOG(YUP)/ALOG(2.0) YLPL=Y1PL + (YL-YREF)*YSCALE/2.54 Y1PL=Y1PL + (Y1-YREF)*YSCALE/2.54 ELSE YLPL=Y1PL + (YDOWN-YLGRID)/(YSCALE*2.54) Y1PL=Y1PL + (YDOWN-Y1GRID)/(YSCALE*2.54) END IF X1PL=SAVXPL Y1PL=SAVYPL IF(SCALF.NE.1.0) THEN HGT=SAVEH XSCALE=SAVEX YSCALE=SAVEY END IF C RETURN END