Google
 

Trailing-Edge - PDP-10 Archives - BB-D480C-SB_1981 - forpl1.for
There are 11 other files named forpl1.for in the archive. Click here to see a list.
C	PLOTTER ROUTINES ,6(2031)
C	FORPLT - PART 1, FORTRAN ROUTINES
C
C
c***** Begin Revision History
C
C1100	CKS
C	CREATION.
C
c***** End Revision History

	SUBROUTINE AXIS (X,Y,BCD,NC,SIZE,THETA,YMIN,DY)

C COPYRIGHT (C) 1980,1981 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
C
C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
C ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
C INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
C COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
C OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
C TRANSFERRED.
C
C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
C AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
C CORPORATION.
C
C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
C SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

C ARGS:
C   X,Y	 STARTING POINT OF AXIS, IN INCHES, WHERE THE LOWER LEFT CORNER
C	 OF THE PAGE IS (0,0)
C   BCD	 TEXT LABEL FOR THE AXIS
C   NC	 NUMBER OF CHARACTERS IN BCD
C   SIZE LENGTH OF AXIS, INCHES
C   THETA ANGLE AT WHICH AXIS IS PLOTTED (0=HORIZONTAL, 90=VERTICAL)
C   XMIN X VALUE AT LEFT EDGE OF AXIS
C   DX	 X CHANGE IN 1 INCH

C Revision history:
C
C 1100	CKS
C	Convert back to Fortran, remove arithmetic IFs and Hollerith
C
C end of revision history

	DIMENSION BCD(2)
	SIGN = 1.
	IF (NC .LT. 0) SIGN = -1.
	NAC=IABS(NC)
	N=SIZE+.5
	CTH=COSD(THETA)
	STH=SIND(THETA)
	TN=N
	XB=X
	YB=Y
	XA=X-.1*SIGN*STH
	YA=Y+.1*SIGN*CTH
	CALL PLOT(XA,YA,3)
	DO 20 I=1,N
	CALL PLOT(XB,YB,2)
	XC=XB+CTH
	YC=YB+STH
	CALL PLOT(XC,YC,2)
	XA=XA+CTH
	YA=YA+STH
	CALL PLOT(XA,YA,2)
	XB=XC
20	YB=YC
	EXP=0
	NT=INT(ALOG10(DY)+.001)
	IF (NT .LT. -1 .OR. NT .GT. 1) EXP = NT
	ADY=DY*10.**(-EXP)
	ABSV=YMIN*10.**(-EXP)+TN*ADY
	XA=XB-(.20*SIGN-.05)*STH-.0857*CTH
	YA=YB+(.20*SIGN-.05)*CTH-.0857*STH
	N=N+1
	DO 30 I=1,N
	CALL NUMBER(XA,YA,.1,ABSV,THETA,3)
	ABSV=ABSV-ADY
	XA=XA-CTH
30	YA=YA-STH
	TNC=NAC+7
	XA=X+(SIZE/2.-.06*TNC)*CTH-(-.07+SIGN*.36)*STH
	YA=Y+(SIZE/2.-.06*TNC)*STH+(-.07+SIGN*.36)*CTH
	CALL SYMBOL(XA,YA,.12,BCD,THETA,NAC)
	XA=XA+((TNC-6.)*.12)*CTH
	YA=YA+((TNC-6.)*.12)*STH
	IF (EXP .EQ. 0) GO TO 50
	CALL SYMBOL(XA,YA,.12,'(*10  )',THETA,7)
	XA=XA+.48*CTH-.07*STH
	YA=YA+.48*STH+.07*CTH
	CALL NUMBER(XA,YA,.1,EXP,THETA,-1)
50	RETURN
	END
	SUBROUTINE LINE (X,Y,N,K)
	DIMENSION X(1),Y(1)
	I3=3
	DO 10 I=1,N*K,K
	CALL PLOT(X(I),Y(I),I3)
10	I3=2
	END
	SUBROUTINE SCALE (X, N, S, XMIN, DX)

C ARGS:
C   X	INPUT ARRAY, RETURNED SCALED FOR PLOTTING
C   N   NUMBER OF ELEMENTS IN X
C   S   AXIS LENGTH IN INCHES
C   XMIN,DX  RETURNED SET UP FOR AXIS ROUTINE

	DIMENSION X(N)

	XMIN = X(1);  XMAX = X(1)
	DO 10 I = 2,N
	IF (X(I) .LT. XMIN) XMIN = X(I)
10	IF (X(I) .GT. XMAX) XMAX = X(I)

	IF (XMIN .NE. XMAX) GO TO 20
	XMIN = 0;   XMAX = 2 * XMAX
	IF (XMAX .GT. 0) GO TO 20
	XMIN = XMAX;   XMAX = 0
	IF (XMIN .NE. 0) GO TO 20
	XMIN = -1;  XMAX = 1
20	CONTINUE

	T = (XMAX - XMIN) * 10 / S + XMIN
	D = T - XMIN
	E = ALOG10(D);  IE = E
	IF (E .LT. 0 .AND. E .NE. AINT(E)) IE = IE - 1
	T = D / 10.**IE

22	IF (T .GT. 8) GO TO 25
	IF (T .LE. 8) D = 8
	IF (T .LE. 5) D = 5
	IF (T .LE. 4) D = 4
	IF (T .LE. 2) D = 2
	IF (T .LE. 1) D = 1
	GO TO 30
25	IE = IE + 1;  D = 1
30	CONTINUE

	DX = 10.**(IE-1) * D
	E = XMIN/DX
	IF (E .LT. 0 .AND. E .NE. AINT(E)) E = E - 1
	XMIN1 = DX * AINT(E)
	XMAX1 = XMIN1 + S*DX
	IF (XMIN1 .LE. XMIN .AND. XMAX1 .GE. XMAX) GO TO 40
	T = D*2
	IF (D .EQ. 4) T = 5
	GO TO 22

40	XMIN = XMIN1
	DO 50 I = 1,N
50	X(I) = (X(I) - XMIN) / DX

	END