Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50210/xyplot.f4
There are no other files named xyplot.f4 in the archive.
00100 C ***DESCRIPTION: PLOTS ANY GIVEN ARRAY OF POINTS IN
00200 C RECTANGULAR COORDINATES.
00300 C
00400 C ***INSTRUCTIONS FOR USE:
00500 C CALL XYPLOT(X,Y,N)
00600 C WHERE X AND Y ARE THE ARRAYS OF THE X AND Y COORDINATES
00700 C OF THE POINTS AND N IS THE NUMBER OF POINTS IN THE
00800 C ARRAY.
00900 C
01000 SUBROUTINE XYPLOT(X,Y,N)
01100 DIMENSION X(N),Y(N)
01200 INTEGER XAXIS,YAXIS,ROW,POINT,POINTS(0/35),POINTER(0/35,0/55)
01300 INC1=60
01400 INC2=36
01500 XMIN=X(1)
01600 XMAX=X(1)
01700 YMIN=Y(1)
01800 YMAX=Y(1)
01900 DO 160 I=2,N
02000 IF (X(I).GT.XMAX) XMAX=X(I)
02100 IF (X(I).LT.XMIN) XMIN=X(I)
02200 IF (Y(I).LT.YMIN) YMIN=Y(I)
02300 160 IF (Y(I).GT.YMAX) YMAX=Y(I)
02400 CALL SETINC(XMIN,XMAX,INC1,XINC)
02500 CALL SETINC(YMIN,YMAX,INC2,YINC)
02600 XAXIS=-1
02700 YAXIS=-1
02800 IF (XMIN.LT.0.AND.XMAX.GT.0) YAXIS=-XMIN/XINC
02900 IF (YMIN.LT.0.AND.YMAX.GT.0) XAXIS=YMAX/YINC
03000 DO 10 ROW=1,INC2
03100 10 POINTS(ROW)=0
03200 DO 20 I=1,N
03300 ROW=(YMAX-Y(I))/YINC
03400 POINTS(ROW)=POINTS(ROW)+1
03500 20 POINTER(ROW,POINTS(ROW))=(X(I)-XMIN)/XINC
03600 DO 30 ROW=0,INC2
03700 IF (POINTS(ROW).LT.2) GO TO 30
03800 DO 40 POINT=2,POINTS(ROW)
03900 DO 50 J=POINT-1,1,-1
04000 IF (POINTER(ROW,J+1).GE.POINTER(ROW,J)) GO TO 40
04100 I1=POINTER(ROW,J+1)
04200 POINTER(ROW,J+1)=POINTER(ROW,J)
04300 50 POINTER(ROW,J)=I1
04400 40 CONTINUE
04500 30 CONTINUE
04600 TYPE 120, XMIN, XMAX, XINC, YMAX, YMIN, YINC
04700 120 FORMAT('3X ='F15.6,' LEFT'/,' TO 'F15.6,' RIGHT'/
04800 1 F19.6,' INCREMENT'//,' Y ='F15.6,' TOP'/, ' TO'
04900 2 F16.6,' BOTTOM'/,F19.6,' INCREMENT'/)
05000 DO 130 I=1,INC1+1
05100 130 CALL CHUCK('-')
05200 TYPE 110
05300 DO 80 ROW=0,INC2
05400 CALL CHUCK('-')
05500 J=1
05600 DO 90 I=0,INC1+1
05700 IF (POINTS(ROW).LT.J) GO TO 170
05800 IF (POINTER(ROW,J).EQ.I) GO TO 100
05900 170 IF (POINTS(ROW).LT.J.AND.ROW.NE.XAXIS.AND.I.GT.YAXIS) GO TO 80
06000 CHAR=' '
06100 IF (XAXIS.EQ.ROW.OR.YAXIS.EQ.I) CHAR='.'
06200 CALL CHUCK(CHAR)
06300 GO TO 90
06400 100 CALL CHUCK('*')
06500 150 J=J+1
06600 IF (POINTER(ROW,J).EQ.POINTER(ROW,J-1)) GO TO 150
06700 90 CONTINUE
06800 80 TYPE 110
06900 110 FORMAT(1H+/,1H )
07000 DO 140 I=1,INC1+1
07100 140 CALL CHUCK('-')
07150 TYPE 1111
07155 1111 FORMAT(///////)
07200 RETURN
07300 END
07400 SUBROUTINE CHUCK(CHAR)
07500 TYPE 10, CHAR
07600 10 FORMAT(1H+A1,$)
07700 RETURN
07800 END
07900 SUBROUTINE SETINC(MIN,MAX,INC,AINC)
08000 REAL MIN, MAX
08100 AINC=(MAX-MIN)/INC
08200 X=AINC/10**(IFIX(ALOG10(AINC)))
08300 J=X/2.5+1
08400 IF (J.EQ.3) J=4
08500 AINC=2.5*10**(IFIX(ALOG10(AINC)))*J
08600 INC=(MAX-MIN)/AINC
08700 RETURN
08800 END