SUBROUTINE NEWPLT(NSHEET,LTITLE,NCHAR,ISECU) CHARACTER*80 LTITLE CHARACTER*3 XBTYPE, YBTYPE, FONT CHARACTER*4 IDUMMY, TITLEX, TITLEY COMMON/FONTEX/FONT COMMON /PLT/FACT,YASIZE,SCALF,SF,IB,ICOL COMMON /XAX/XDUM1,XDUM2,XLEFT,XRIGHT,XSCALE,XINC,DX, % X1PL,XDUM4,IXDUM1,XDUM5,XDUM6,DIVX,XVAL(100),NXVAL COMMON/XAXC/TITLEX(20),XBTYPE COMMON/YAX/Y1,YL,YUP,YDOWN,YSCALE,YINC,DY, % Y1PL,YDUM4,IYDUM1,YDUM5,YDUM6,DIVY,YVAL(100),NYVAL, % YBOX COMMON/YAXC/TITLEY(20),YBTYPE COMMON /XYLAST/XLAST, YLAST, AXISX, AXISY, ISGN common /pltnum/ npnum DIMENSION APLOT(6) DATA APLOT/21.0,29.7,42.0,59.4,84.1,118.9/ DATA IDUMMY/' '/ DATA XPB,YPB,A4/14.6,9.3,11.7/ DATA npnum /0/ C XPB : Page border along X axis (inches) C YPB : Page border along Y axis (inches) C IF(XBTYPE.NE.'LOG') THEN AXISX=ABS((XRIGHT-XLEFT)/(XSCALE*2.54)) ELSE AMIN=AMIN1(XVAL(NXVAL),XVAL(1)) AMAX=AMAX1(XVAL(NXVAL),XVAL(1)) AXISX=(ALOG(AMAX/AMIN)/ALOG(2.0)*XSCALE)/2.54 END IF C IF(YBTYPE.NE.'LOG') THEN AXISY=ABS((YUP-YDOWN)/(YSCALE*2.54)) ELSE AXISY=ABS(ALOG(YUP/YDOWN)/ALOG(2.0))*YSCALE/2.54 END IF C ISGN=-1 XLEN=AXISX+X1PL YLEN=AXISY+Y1PL+0.5+YBOX/2.54 C IF(XLEN.GT.XPB) THEN XT=XPB-X1PL XFACT=XT/AXISX WRITE(6,*)' MAX ALLOWED LENGTH ALONG X AXIS (INCHES)',XT ELSE XFACT=1.0 END IF C IF(YLEN.GT.YPB) THEN YT=YPB-(Y1PL+0.5+YBOX/2.54) YFACT=YT/AXISY WRITE(6,*)' MAX ALLOWED LENGTH ALONG Y AXIS (INCHES)',YT ELSE YFACT=1.0 END IF C SCALF=MIN(XFACT,YFACT,1.0) IF(SCALF.NE.1.0) THEN WRITE(6,*)' WARNING : A SCALE FACTOR WILL BE APPLIED ON PLOT ' END IF C npnum=npnum+1 write(6,*) 'calling BGNPL, NP=',npnum CALL BGNPL(npnum) CALL NOBRDR C IF(FONT.EQ.'CPX') THEN CALL COMPLX ELSE IF(FONT.EQ.'DPX') THEN CALL DUPLX ELSE CALL SIMPLX END IF END IF C c CALL PAGE(YPB,AMIN1(AMAX1(XLEN+X1PL,A4),XPB)) CALL PAGE(YLEN+.5,XLEN+.5) c write(6,*) '>>> exit newplt <<<' RETURN END C C SUBROUTINE PLOT(X,Y,IPLOT) DIMENSION CX(2), CY(2) COMMON /XYLAST/XLAST, YLAST, AXISX, AXISY, ISGN character*80 LTITLE,IDUMMY C IF(IPLOT.EQ.2) THEN CALL CONNPT(X,Y) ELSE C IF(IPLOT.EQ.3) THEN CALL VECTOR(X,Y,X,Y,0000) ELSE C IF(IPLOT.EQ.-3) THEN CALL PHYSOR(X/2.54,Y/2.54) IDUMMY=' ' LTITLE=' ' CALL TITLE(IDUMMY,ISGN,LTITLE,0,LTITLE,0,AXISX,AXISY) C CALL GRAF(... ) IS USED FOR RAISING DISPLA FROM C LEVEL 2 TO LEVEL 3. CALL GRAF(0.,1.,1.,0.,1.,1.) ELSE C IF(IPLOT.EQ.999) THEN CALL ENDPL(0) END IF C END IF C END IF C END IF C IF((X.EQ.999.).AND.(Y.EQ.999.)) THEN X=XLAST Y=YLAST ELSE XLAST=X YLAST=Y END IF RETURN END C C SUBROUTINE FACTOR(SF) C DUMMY ROUTINE RETURN END C C C C SUBROUTINE NUMBER(X,Y,HGT,XNUMB,ANG,NDEC) CHARACTER*20 TEXT CHARACTER*80 FORM INTEGER DECIML, POINT DATA POINT/1/ C 200 FORMAT('(I',I2,')') 300 FORMAT('(F',I2,'.',I2,')') 301 FORMAT('(1X,F',I2,'.',I2,')') C 600 FORMAT(1X,A20,4X,4(I3)) C ISGN=0 IZERO=0 C IF(NDEC.GT.0) THEN C C NDEC= NUMBER OF DECIMALS TO BE PLOTTED AFTER ROUNDING C XTEMP=ABS(XNUMB) DECIML=NDEC XVAL=ANINT(XTEMP*10.0**(NDEC)) IF(XTEMP.LT.1.0) IZERO=-1 XVAL=XVAL/10.0**(NDEC) XABS=AMAX1(1.,ABS(XVAL)) IX10=ALOG10(XABS) NDIGIT=(IX10+1) + POINT + DECIML + IZERO IF(XNUMB.GE.0.) THEN WRITE(FORM,300)NDIGIT,DECIML WRITE(TEXT,FORM) XTEMP ELSE WRITE(FORM,301)NDIGIT,DECIML WRITE(TEXT,FORM) XTEMP TEXT(1:1)='-' NDIGIT=NDIGIT + 1 END IF C WRITE(6,600) TEXT, NDEC,DECIML,ISGN,IZERO C ELSE C IF(NDEC.EQ.0) THEN C C ONLY THE INTEGER PORTION AND A DECIMAL POINT ARE PLOTTED C AFTER ROUNDING C DECIML=0 XVAL=ANINT(XNUMB) IF((XNUMB.LT.0.).AND.(ABS(XVAL).GT.0.0)) ISGN=1 XABS=AMAX1(1.,ABS(XVAL)) IX10=ALOG10(XABS) NDIGIT=(IX10+1) + POINT + DECIML + ISGN WRITE(FORM,300)NDIGIT,DECIML WRITE(TEXT,FORM) XNUMB C WRITE(6,600) TEXT, NDEC,DECIML,ISGN,IZERO ELSE C IF(NDEC.EQ.-1) THEN C C ONLY THE INTEGER PORTION IS PLOTTED AFTER ROUNDING C DECIML=0 XVAL=ANINT(XNUMB) IF((XNUMB.LT.0.).AND.(ABS(XVAL).GT.0.0)) ISGN=1 XABS=AMAX1(1.,ABS(XVAL)) IX10=ALOG10(XABS) NDIGIT=(IX10+1) + DECIML + ISGN WRITE(FORM,200)NDIGIT INUMB=NINT(XVAL) IF(ISGN.EQ.1) INUMB=INUMB WRITE(TEXT,FORM) INUMB C WRITE(6,600) TEXT, NDEC,DECIML,ISGN,IZERO ELSE C IF(NDEC.LT.-1) THEN C C ABS(NDEC)-1 DIGITS ARE TRUNCATED FROM THE INTEGER PORTION C AFTER ROUNDING C DECIML=0 XVAL=ANINT(XNUMB/10.0**(ABS(NDEC)-1)) XVAL=XVAL*10.0**(ABS(NDEC)-1) IF((XNUMB.LT.0.).AND.(ABS(XVAL).GT.0.0)) ISGN=1 XABS=AMAX1(1.,ABS(XVAL)) WRITE(FORM,200)NDIGIT IX10=ALOG10(XABS) NDIGIT=(IX10+1) + DECIML + ISGN WRITE(FORM,200)NDIGIT INUMB=NINT(XVAL) IF(ISGN.EQ.1) INUMB=INUMB WRITE(TEXT,FORM) INUMB C WRITE(6,600) TEXT, NDEC,DECIML,ISGN,IZERO END IF END IF END IF END IF C CALL SYMBOL(X,Y,HGT,TEXT,ANG,NDIGIT) C RETURN END C C SUBROUTINE SYMBOL(X,Y,HGT,STRING,ANG,IMESS) CHARACTER*80 STRING COMMON /XYLAST/XLAST, YLAST, AXISX, AXISY, ISGN DATA TWOPI/6.2831853/ C CALL HEIGHT(HGT) CALL ANGLE(ANG) C IF((X.EQ.999.).AND.(Y.EQ.999.)) THEN CALL MESSAG(STRING,IMESS,XLAST,YLAST) XLAST= XLAST + IMESS*HGT*COS((TWOPI*ANG)/360.) YLAST= YLAST + IMESS*HGT*SIN((TWOPI*ANG)/360.) ELSE CALL MESSAG(STRING,IMESS,X,Y) XLAST= X + IMESS*HGT*COS((TWOPI*ANG)/360.) YLAST= Y + IMESS*HGT*SIN((TWOPI*ANG)/360.) END IF C RETURN END C C SUBROUTINE SIMBOL(X,Y,HGT,ISYMB,ANG,IMESS) DIMENSION CX(2), CY(2) COMMON /XAX/XDUM1,XDUM2,XLEFT,XRIGHT,XSCALE,XINC,DX, % XDUM3,XDUM4,IXDUM1,XDUM5,XDUM6,DIVX,XVAL(100),NXVAL COMMON /YAX/YDUM1,YDUM2,YUP,YDOWN,YSCALE,YINC,DY, % YDUM3,YDUM4,IYDUM1,YDUM5,YDUM6,DIVY,YVAL(100),NYVAL, % YBOX COMMON /XYLAST/XLAST, YLAST, AXISX, AXISY, ISGN C C IMESS= -1 THE PEN IS UP DURING THE MOVE C IMESS= -2 THE PEN IS DOWN DURING THE MOVE C CALL HEIGHT(HGT) CALL ANGLE(ANG) CALL MARKER(ISYMB) IF(IMESS.EQ.-2) THEN IMARK=1 ELSE IMARK=-1 END IF C IF((X.EQ.999.).AND.(Y.EQ.999.)) THEN CX(1)=XLAST/AXISX CY(1)=YLAST/AXISY ELSE CX(1)=X/AXISX CY(1)=Y/AXISY END IF C IF(IMESS.EQ.-1) THEN CALL CURVE(CX,CY,1,IMARK) IF((X.NE.999.).OR.(Y.NE.999.)) THEN XLAST= X YLAST= Y END IF ELSE IF((X.EQ.999.).AND.(Y.EQ.999.)) THEN CALL CURVE(CX,CY,1,IMARK) ELSE CALL VECTOR(XLAST,YLAST,X,Y,0011) CALL CURVE(CX,CY,1,IMARK) XLAST= X YLAST= Y END IF END IF C RETURN END