C....*...1.........2.........3.........4.........5.........6.........7.*.......8 C PLOT1 11/15/82 C C PURPOSE C CONSTRUCT AND PRINT "CORE" PLOTS. C C SUBROUTINES CALLED C AFC C C ***** ENTRY PLOT1 C C PURPOSE C DEFINE BOUNDRIES OF PLOTTING SPACE AND INITIALIZE. C C USAGE C CALL PLOT1(YMIN,YMAX,IYGRID,XMIN,XMAX,IXGRID,GRID) C C ARGUMENTS C YMIN - LOWER EXTREME FOR Y COORDINATE. C REAL*8 C YMAX - UPPER EXTREME FOR Y COORDINATE. C REAL*8 C IYGRID - NUMBER OF PRINT LINES IN WHICH TO PLOT C Y AXIS, VERTICAL AXIS. C INTEGER*4 C XMIN - LOWER EXTREME FOR X COORDINATE. C REAL*8 C XMAX - UPPER EXTREME FOR X COORDINATE. C REAL*8 C IXGRID - NUMBER OF SPACES IN WHICH TO PLOT X AXIS, C HORIZONTAL AXIS. IXGRID MUST BE SMALLER C THAN 255. C INTEGER*4 C GRID - WORKSPACE CONTAINING THE CORE PLOT. MUST C BE DIMENSIONED C LOGICAL*1 GRID(IYGRID,IXGRID) C IN CALLING PROGRAM. C C ***** ENTRY PLOT2 C C PURPOSE C "PLOT" A SINGLE POINT (YT,XT). C C USAGE C CALL PLOT2(YT,XT,CHAR) C C ARGUMENTS C YT - Y COORDINATE FOR POINT TO BE PLOTTED. C REAL*8 C XT - X COORDINATE FOR POINT TO BE PLOTTED. C REAL*8 C CHAR - CHARACTER TO BE USED TO LABEL THE POINT. C THIS MAY BE ENTERED AS A LITERAL, E.G. C CALL PLOT2(YT,XT,'*'). C LOGICAL*1 C C ***** ENTRY PLOT3 C C PURPOSE C "PLOT" THE POINTS IN A VECTOR Y AGAINST THE POINTS C IN THE VECTOR X. C C USAGE C CALL PLOT3(Y,X,N,CHAR) C C ARGUMENTS C Y - VECTOR CONTAINING Y COORDINATES OF POINTS C TO BE PLOTTED. C REAL*8 C X - VECTOR CONTINAING X COORDINATES OF POINTS C TO BE PLOTTED. C REAL*8 C N - LENGTH OF Y AND X. C INTEGER*4 C CHAR - CHARACTER TO BE USED TO LABEL THE POINTS C USAGE IS AS ABOVE. C LOGICAL*1 C C ***** ENTRY PLOT4 C C PURPOSE C PRINT THE PLOT WITHOUT NUMERICALLY LABELED "TIC" C MARKS. C C USAGE C CALL PLOT4(IUNIT) C C ARGUMENT C IUNIT - UNIT NUMBER ON WHICH THE PLOT IS TO BE C WRITTEN. C INTEGER*4 C C COMMENT C THIS USAGE EFFECTIVELY PRINTS THE ARRAY GRID. C C ***** ENTRY PLOT5 C C PURPOSE C PRINT THE PLOT WITH NUMERICALLY LABELED "TIC" C MARKS. NUMBERS ON THE LEFT OF THE Y AXIS AND C BELOW THE X AXIS. C C USAGE C CALL PLOT5(IUNIT) C C ARGUMENTS C IUNIT - UNIT NUMBER ON WHICH THE PLOT IS TO BE C WRITTEN. C INTEGER*4 C C COMMENT C THIS USAGE WILL USE TEN EXTRA SPACES IN THE LEFT C MARGIN OVER AND ABOVE THAT ALLOCATED BY IYGRID C AND ONE EXTRA LINE OVER THAT ALLOCATED BY IXGRID. C E.G. TO PRODUCE A 24X80 PLOT ON A TERMINAL SCREEN C CALL PLOT1(0.,10.,23,0.,100.,70,GRID) C C EXAMPLE C TO PRODUCE A 60X132 PRINTER PLOT C CALL PLOT1(0.,10.,59,0.,100.,122,GRID) C CALL PLOT2(1.,1.,'*') C CALL PLOT2(5.,5.,'*') C CALL PLOT5(3) C C SUBROUTINE PLOT1(YMIN,YMAX,IYGRID,XMIN,XMAX,IXGRID,GRID) IMPLICIT REAL*8(A-H,O-Z) save LOGICAL*1 LTEST1(4),LTEST2(4) INTEGER*4 ITEST1/'+ '/,ITEST2/' '/ EQUIVALENCE (ITEST1,LTEST1(1)),(ITEST2,LTEST2(1)) REAL*8 Y(N),X(N) LOGICAL*1 CHAR REAL*8 XTICS(25) REAL*8 FMT1(3)/'(1H ','E9.3 ',',255A1 )'/ REAL*8 FMT2(25)/'(2X, ',23*' ',') '/ REAL*8 RFMT(1),DFMT/' E10.3 '/ LOGICAL*1 LFMT(8),COMMA/','/ EQUIVALENCE(RFMT(1),LFMT(1)) LOGICAL*1 GRID(IYGRID,IXGRID) LOGICAL*1 BLANK/' '/,DASH/'-'/,STROKE/'|'/,PLUS/'+'/ COMMON/PLOT6/YMINS,YMAXS,NROW,NDUMMY,XMINS,XMAXS,NCOL,IYTIC,IXTIC YMINS=YMIN YMAXS=YMAX NROW=IYGRID XMINS=XMIN XMAXS=XMAX NCOL=IXGRID IYTIC=(IYGRID-1)/10+1 IXTIC=(IXGRID-1)/10+1 DO 10 I=1,IYGRID DO 10 J=1,IXGRID 10 GRID(I,J)=BLANK DO 20 I=1,IYGRID GRID(I,1)=STROKE 20 GRID(I,IXGRID)=STROKE DO 30 I=1,IYTIC GRID(1+10*(I-1),1)=PLUS 30 GRID(1+10*(I-1),IXGRID)=PLUS DO 40 J=1,IXGRID GRID(1,J)=DASH 40 GRID(IYGRID,J)=DASH DO 50 J=1,IXTIC GRID(1,1+10*(J-1))=PLUS 50 GRID(IYGRID,1+10*(J-1))=PLUS GRID(1,IXGRID)=PLUS GRID(IYGRID,IXGRID)=PLUS RETURN ENTRY PLOT2(YT,XT,CHAR) I=1+(NROW-1)*(YT-YMINS)/(YMAXS-YMINS) J=1+(NCOL-1)*(XT-XMINS)/(XMAXS-XMINS) IF((I.LT.1).OR.(I.GT.NROW)) RETURN IF((J.LT.1).OR.(J.GT.NCOL)) RETURN GRID(I,J)=CHAR RETURN ENTRY PLOT3(Y,X,N,CHAR) YSCALE=(NROW-1)/(YMAXS-YMINS) XSCALE=(NCOL-1)/(XMAXS-XMINS) DO 55 L=1,N I=1+YSCALE*(Y(L)-YMINS) J=1+XSCALE*(X(L)-XMINS) IF((I.LT.1).OR.(I.GT.NROW)) GO TO 55 IF((J.LT.1).OR.(J.GT.NCOL)) GO TO 55 GRID(I,J)=CHAR 55 CONTINUE RETURN ENTRY PLOT4(IUNIT) DO 60 L=1,NROW I=NROW-(L-1) 60 WRITE(IUNIT,3001) (GRID(I,J),J=1,NCOL) RETURN ENTRY PLOT5(IUNIT) DO 70 L=1,NROW I=NROW-(L-1) ITIC=0 LTEST2(1)=GRID(I,1) IF(ITEST1.EQ.ITEST2) ITIC=1 IF(ITIC.NE.1) WRITE(IUNIT,3002) (GRID(I,J),J=1,NCOL) IF(ITIC.NE.1) GO TO 70 YTIC=YMINS+(YMAXS-YMINS)*(I-1)/(NROW-1) CALL AFC(YTIC,FMT1(2),9,3) WRITE(IUNIT,FMT1) YTIC,(GRID(I,J),J=1,NCOL) 70 CONTINUE DO 80 J=1,IXTIC JGRID=1+10*(J-1) XTIC=XMINS+(XMAXS-XMINS)*(JGRID-1)/(NCOL-1) XTICS(J)=XTIC CALL AFC(XTIC,DFMT,10,3) RFMT(1)=DFMT LFMT(8)=COMMA 80 FMT2(J+1)=RFMT(1) WRITE(IUNIT,FMT2) (XTICS(J),J=1,IXTIC) RETURN 3001 FORMAT(' ',255A1) 3002 FORMAT(' ',9X,255A1) END