SUBROUTINE RANGE(DATA) COMMON /PLTCOM/IP1P2(2,2),DMNMX(2,2),PMNMX(2,2),IPAPER(2,2) COMMON /PLTCOM/LEGWIN(2,2) COMMON /PLTCOM/NTICK(2) COMMON /PLTCOM/NPEN,NLINE,ISYM,NCNVER,NSTRT,IPLTOK,LEGPOS C C... USER MUST SET NSTRT=0 WHEN BEGINNING A SET OF DATA OR C... BEGINNING A NEW SET OF DATA C DIMENSION DATA(2),DELTA(2) C... FUDGE CORRECTS FOR SMALL NUMERICAL QUIRKS WHICH OCCUR C... WHEN SOME NUMBERS ARE EXACTLY INTEGER DATA FUDGE/.0001/ D TYPE*,'NSTRT=',NSTRT IF (NSTRT.NE.0) GOTO 20 C... INITIALIZE ON FIRST CALL C... RESET NSTRT TO SKIP THIS SECTION ON FUTURE PASSES NSTRT=-1 C... INDICATE THAT SO FAR, NOT ENOUGH DATA PROCESSED TO SET C... SCALES ON PLOTTER IPLTOK=0 DO 10 I=1,2 DO 10 J=1,2 10 DMNMX(I,J)=DATA(I) D TYPE*,'DATA=',DATA C... DMNMX(1,1)=XMIN C... DMNMX(1,2)=XMAX C... DMNMX(2,1)=YMIN C... DMNMX(2,2)=YMAX 20 DO 100 I=1,2 KFLAG=0 JFLAG=0 C... FIND MI AND MAX VALUES DMNMX(I,1)=AMIN1(DMNMX(I,1),DATA(I)) DMNMX(I,2)=AMAX1(DMNMX(I,2),DATA(I)) C... SET PLOTTER RANGE C... NORMALIZE MAX-MIN DELTA(I)=DMNMX(I,2)-DMNMX(I,1) D TYPE*,'DELTA=',DELTA(I) IF (DELTA(I) .EQ. 0.) GOTO 100 SHIFT=10.**(IFLOOR(ALOG10(DELTA(I))-FUDGE)) IPASS=1 UNITS=1. 30 SHIFT=SHIFT/UNITS D TYPE*,'SHIFT=',SHIFT D DEBUG=DMNMX(I,2)/SHIFT-FUDGE D TYPE*,'DEBUG=',DEBUG FMAX=(DMNMX(I,2)/SHIFT-FUDGE) FMIN=(DMNMX(I,1)/SHIFT+FUDGE) 33 IF (ABS(FMAX).LT.30000.0) GOTO 35 KFLAG=1 JFLAG=JFLAG+1 FMAX=FMAX/10.0 FMIN=FMIN/10.0 GOTO 33 35 MAX=ICEIL(FMAX) MIN=IFLOOR(FMIN) C... SHIFT MIN TO MIN=0 IF CONVENIENT IF (MIN .GT. 0 .AND. MIN .LT. 0.2*(MAX-MIN)) MIN=0 C SHIFT MAX TO 0 IF CONVIENENT IF (MAX.LT.0.AND.MAX.GT.-0.2*(MAX-MIN))MAX=0 C... RECORD NUMBER OF TICK MARKS NTICK(I)=MAX-MIN D TYPE*,'NTICK=',NTICK C... INCREASE # OF TICK MARKS? IF (IPASS .NE. 1) GOTO 40 IPASS=2 IF (NTICK(I) .LT. 6) UNITS=2. IF (NTICK(I) .LT. 3) UNITS=5. GOTO 30 C... RECORD PLOTTER RANGE 40 PMNMX(I,1)=MIN*SHIFT PMNMX(I,2)=MAX*SHIFT IF (KFLAG.NE.1) GOTO 45 RESTOR=10.0*JFLAG PMNMX(I,1)=PMNMX(I,1)*RESTOR PMNMX(I,2)=PMNMX(I,1)*RESTOR D TYPE*,'PMNMX=',PMNMX 45 IF((DMNMX(I,1)-PMNMX(I,1)).LT.0.2*SHIFT)GOTO 150 IF((PMNMX(I,2)-DMNMX(I,2)).LT.0.2*SHIFT)GOTO 200 GOTO 100 150 MIN=MIN-1 GOTO 210 200 MAX=MAX+1 210 NTICK(I)=MAX-MIN GOTO 40 100 CONTINUE C... CHECK WHETHER DATA HAS PERMITTED DEFINITION OF PLOTTER SCALES IF (DELTA(1).NE.0. .AND. DELTA(2).NE.0.) IPLTOK=-1 D TYPE*,'IPLTOK=',IPLTOK RETURN END SUBROUTINE AXES(TICLEN,LTYPE) C... C... ITYPE IS THE GRAPH TYPE C... BIT 1 SET (1) ==> PLOT A BOX, ELSE JUST X,Y AXES C... BIT 4 SET (8) ==> SUPPRESS MARKS ON TOP AND RIGHT OF BOX C... TICLEN IS THE TICK LENGTH (RATIO OF LENGTH TO DEFAULT LENGTH) C... TICLEN < 0 ==> TICK WILL CROSS AXIS C... TICLEN > 0 ==> TICK WILL LIE WITHIN THE BOX (AXES) COMMON /PLTCOM/IP1P2(2,2),DMNMX(2,2),PMNMX(2,2),IPAPER(2,2) COMMON /PLTCOM/LEGWIN(2,2) COMMON /PLTCOM/NTICK(2) COMMON /PLTCOM/NPEN,NLINE,ISYM,NCNVER,NSTRT,IPLTOK,LEGPOS COMMON /ADRS/IPLTTR BYTE M1(38) DIMENSION DATA(2) C... ENLARGE PLOTTER WINDOW FOR DRAWING AXES AND ADJUST TICK LENGTH TP=.5*ABS(TICLEN) TN=TP ITYPE=LTYPE IF(TICLEN.LE.0.0) GOTO 5 TN=0 TP=2.*TP 5 ENCODE(40,10,M1) IPAPER 10 FORMAT('SM;PU;LT;IW',3(I6,','),I6,';*') CALL XMT(M1) ENCODE(15,15,M1) TP,TN 15 FORMAT('TL',F5.2,',',F5.2,';*') CALL XMT(M1) C C C... DRAW X-AXIS DATA(1)=PMNMX(1,2) DATA(2)=PMNMX(2,1) CALL POINT(DATA,0) CALL XMT('XT;*') NTICKS=NTICK(1) DO 190 J=1,NTICKS DATA(1)=PMNMX(1,2)-J*(PMNMX(1,2)-PMNMX(1,1))/NTICKS CALL POINT(DATA,-1) 190 CALL XMT('XT;*') C... DRAW Y-AXIS NTICKS=NTICK(2) DO 390 J=0,NTICKS DATA(2)=PMNMX(2,1)+J*(PMNMX(2,2)-PMNMX(2,1))/NTICKS CALL POINT(DATA,-1) CALL XMT('YT;*') 390 CONTINUE C.. PLOT COMPLETE BOX IF DESIRED. WRITE (5,400) ITYPE 400 FORMAT (' AXES: ITYPE=', I2) IF(IBIT(ITYPE,1).EQ.0) GOTO 1000 TEMP=TN TN=TP TP=TEMP ENCODE(15,15,M1) TP,TN CALL XMT(M1) ITICK=IBIT(ITYPE,IPLTTR) NTICKS=NTICK(1) DO 490 J=0,NTICKS DATA(1)=PMNMX(1,1)+J*(PMNMX(1,2)-PMNMX(1,1))/NTICKS CALL POINT(DATA,-1) IF(ITICK.EQ.0) CALL XMT('XT;*') 490 CONTINUE NTICKS=NTICK(2) DO 590 J=0,NTICKS DATA(2)=PMNMX(2,2)-J*(PMNMX(2,2)-PMNMX(2,1))/NTICKS CALL POINT(DATA,-1) IF(ITICK.EQ.0) CALL XMT('YT;*') 590 CONTINUE C... RESTORE PLOTTER SETTINGS 1000 CALL PARAM RETURN END SUBROUTINE POINT(DATA,IPEN) COMMON /PLTCOM/IP1P2(2,2),DMNMX(2,2),PMNMX(2,2),IPAPER(2,2) COMMON /PLTCOM/LEGWIN(2,2) COMMON /PLTCOM/NTICK(2) COMMON /PLTCOM/NPEN,NLINE,ISYM,NCNVER,NSTRT,IPLTOK,LEGPOS COMMON /ADRS/IPLTTR DIMENSION DATA(2),IDATA(2) BYTE M1(16) C... PLOTS A POINT AT COORDS "DATA" C... IPEN=0 MEANS PEN UP C... IPEN=-1 MEANS PEN DOWN CALL SCALE(DATA,IDATA) IF (NCNVER .NE. 0) GOTO 100 IF (IPEN.EQ.-1) CALL XMT('PD;*') IF (IPEN.EQ.0) CALL XMT('PU;*') ENCODE(17,30,M1) IDATA 30 FORMAT('PA',I6,',',I6,';*') CALL XMT(M1) RETURN C... CONVERSION ERROR 100 WRITE (5,110) DATA 110 FORMAT(' ***** PLOTTING CONVERSION ERROR ', 1 'FOR X,Y =',G13.6,2XG13.6) NCNVER=0 RETURN END