C PLOTF.FOR C C ENHANCEMENTS FOR PLOT.MAC C C THESE SUBROUTINES CALL ON PLOT FOR THE OUTPUT TO THE PLOTTER. C C PROVIDES SCALING OF VARIABLES AND PLOTTING OF AXES WITH TICS. C C THIS VERSION IS SET FOR a 12 bit D/A CONVERTER, WITH 0 and 4096 C GIVING FULL SCALE OUTPUT. C IF THE DAC RANGE IS CHANGED, THE NUMBER 4096 IN SCALE, THE C CHARACTER SIZES IN AXIS AND THE CODE FOR PLOT.MAC WILL NEED AMENDING. C C ALL FUNCTIONS OF PLOT ARE ALSO USEABLE BUT SOME MAY C GIVE RISE TO UNEXPECTED CONFLICTS. C C Last edit 26-FEB-80 C C Enhancements written by P A Irvine C CSIRO Div of Textile Physics C 338 Blaxland Rd. C Ryde, 2112, NSW C Australia. C SUBROUTINE SCALE(XMIN,XMAX,YMIN,YMAX,NN) C C C SCALE C XMIN, XMAX ARE THE MINIMUM AND MAXIMUM VALUES FOR X AXIS. C YMIN, YMAX ARE THE MINIMUM AND MAXIMUM VALUES FOR Y AXIS. C NN=0 FOR NORMAL AXES, NN=1 FOR PERPINDICULAR AXES. C COMMON /CLOT/ XSC,YSC,XMN,YMN,IAX XSC=4096./(XMAX-XMIN) YSC=4096./(YMAX-YMIN) XMN=XMIN YMN=YMIN IAX=NN IF (NN.EQ.0)GOTO 10 YMN=XMIN XMN=YMAX 10 RETURN END C C C SUBROUTINE PLOTF(X,Y,N,ISC,ICNT,STRING) C C C PLOTF C X,Y ARE COORDINATES OF POSITION REFERRED TO C N=3 FOR JUMP WITH PEN UP C N=4 TO PLOT POINT AT X,Y C N=5 TO DRAW LINE FROM CURRENT POSITION TO X,Y C N=7 TO PLOT CHARACTER STRING C ISC IS FOR CHARACTER SIZE . IF -VE CHAR IS PLOTTED PERP TO X AXIS C ICNT IS CHARACTER COUNT IN STRING. -1 IF ALL STRING C STRING IS HOLLERITH OR INTEGER C COMMON /CLOT/ XSC,YSC,XMN,YMN,IAX IX=INT((X-XMN)*XSC) IY=INT((Y-YMN)*YSC) IF(IAX.EQ.0) GOTO 10 ! FOR NORMAL AXES J=IY IY=IX IX=-J ISC=-ISC 10 IF(N.EQ.7)GOTO 20 CALL PLOT(N,IX,IY) RETURN 20 CALL PLOT(7,IX,IY,ISC,ICNT,STRING) RETURN END SUBROUTINE XAXIS(XS,YS,XF,XI,XM,RM,NN) C C C C AXES DRAWING C XS,YS START COORDS. FOR AXES C XF END POINT FOR X AXIS C XI MINOR INTERVAL FOR TICS. 0 IF NONE WANTED C XM MAJOR INTERVAL FOR TICS. 0 IF NONE C RM SIZE OF MAJOR TICS. MINOR TICS 0.6* C NN=0 FOR NORMAL TICS,1 FOR SYMMETRICAL TICS LOGICAL*1 NUM(9) CALL PLOTF(XS,YS,3) CALL PLOTF(XF,YS,5) IF (XI.EQ.0..AND.XM.EQ.0..OR.XI.EQ.0.)RETURN !No tics X=((AINT(XS/XI))*XI) IF(X.LT.XS)X=X+XI !Find value for first Tic C FIND NO. OF DECIMALS TO PLOT NDP=0 XMD=XM IF(XMD.GE.1.)GOTO 10 !NO DECIMALS NDP=1 5 XMD=XMD*10. NDP=NDP+1 IF(XMD.LT.1.)GOTO 5 10 YD=RM IF(XM.LE.0.)GOTO 15 DIFF=ABS((X/XM)-AINT((X/XM)+SIGN(.5,X/XM)))*XM IF(DIFF.GT.ABS(XI/2.)) YD=RM*.4 !MINOR TIC 15 IF(XM.LE.0.)YD=RM*.4 !NO MAJOR TICS CALL PLOTF(X,YS-YD,3) YY=0. IF(NN.GT.0)YY=YD CALL PLOTF(X,YS+YY,5) IF(YD.NE.RM)GOTO 60 ! NOT MAJOR TIC ENCODE(9,100,NUM)X CALL ISCOMP (' ',NUM,I) I=IABS(I) CALL SUBSTR(NUM,NUM,I,7) C THESE CALLS HAVE REMOVED LEADING BLANKS FROM NUM IX=X N=1 IF(X.LT.0.)N=2 !FOR -VE SIGN 20 IX=IX/10 IF(IX.EQ.0)GOTO 30 !THIS LOOP FINDS THE NUMBER N=N+1 !OF CHAR BEFORE THE GOTO 20 !DECIMAL POINT 30 N=N+NDP !ADD NUMBER OF DECIMALS TO PLOT IF (N.GT.9)N=9 50 CALL PLOTF(X,YS-2*RM,7,32,N,NUM) 60 CONTINUE X=X+XI IF(X.GT.XF)RETURN GOTO 10 100 FORMAT(F9.4) END SUBROUTINE YAXIS (XS,YS,YF,YI,YM,RM,NN) LOGICAL*1 NUM(9) CALL PLOTF(XS,YS,3) CALL PLOTF(XS,YF,5) !DRAW AXIS LINE IF (YI.EQ.0..AND.YM.EQ.0..OR.YI.EQ.0.)RETURN !NO TICS Y=((AINT(YS/YI))*YI) !POSITION FOR FIRST TIC IF(Y.LT.YS)Y=Y+YI C FIND NO OF DECIMALS TO PLOT NDP=0 YMD=YM IF(YMD.GE.1.)GOTO 10 NDP=1 5 YMD=YMD*10. NDP=NDP+1 IF(YMD.LT.1.)GOTO 5 10 XD=RM IF(YM.LE.0.)GOTO 15 DIFF=ABS((Y/YM)-AINT((Y/YM)+SIGN(.5,Y/YM)))*YM IF(DIFF.GT.ABS(YI/2.))XD=RM*.4 15 IF(YM.LE.0.)XD=RM*.4 CALL PLOTF(XS-XD,Y,3) XX=0. IF(NN.GT.0)XX=XD CALL PLOTF(XS+XX,Y,5) !PLOT THIS TIC IF( XD.NE.RM)GOTO 60 ! NO CHAR IF NOT MAJOR TIC ENCODE(9,100,NUM)Y CALL ISCOMP(' ',NUM,I) !FIND FIRST NON BLANK CHAR I=IABS(I) CALL SUBSTR(NUM,NUM,I,7) !COPY FROM FIRST NON BLANK CHAR C THESE CALLS HAVE REMOVED LEADING BLANKS FROM NUM IY=Y N=1 IF(Y.LT.0.)N=2 20 IY=IY/10 IF (IY.EQ.0)GOTO 30 N=N+1 !FIND THE NUMBER OF SIGNIFICANT FIG. BEFORE DEC. POINT GOTO 20 30 N=N+NDP IF(N.GT.9)N=9 C N IS NUMBER OF SIGNIFICANT FIGS TO WRITE 50 CALL PLOTF(XS-RM*1.5,Y,7,-32,N,NUM) 60 CONTINUE Y=Y+YI !ADD ON TIC INTERVAL IF(Y.GT.YF)RETURN !TEST IF ALL TICS DONE GOTO 10 !NO DO MORE 100 FORMAT(F9.4) END