SUBROUTINE SHADE(IX,IY,ISIZE)
C
C	SUBROUTINE TO PRODUCE SHADED PICTURE (SIMILAR TO VERSATEC TONE)
C
C	IX,IY	= ARRAY OF COORDINATES FORMING A CLOSED POLYGON
C	ISIZE	= NUMBER OF POINTS
C
	INTEGER	IY(ISIZE),IX(ISIZE),IA(50),IC(50)
	DATA	MX/1023/,MY/779/
	CALL	SCTEST(I)
	IF(I .eq. 0) return		! No graphics ?
	MIN	= MX+1			!SET UP TO FIND MIN,MAX
	MAX	= 0
	DO 10 J	= 1,ISIZE		!SEARCH THRU ALL POINTS
	ITEMP	= IX(J)
	IF(ITEMP .LT. MIN) MIN	= ITEMP
	IF(ITEMP .GT. MAX) MAX	= ITEMP
10	CONTINUE
	IF(MIN .LT. 0) MIN	= 0	!LOWEST X VALUE IS 0
	IF(MAX .GT. MX)MAX	= MX	!LARGEST IS MX
	IF(MAX .lt. MIN) RETURN		! Impossible plot ?
	DO 100 II	= MIN,MAX	!SHADE OVER ALL VALUES
	IXP	= (II)
	ISZ	= 0			!WILL BE # OF SEGMENTS
	ITEMP	= 0
	DO 80 J	= 1,ISIZE		!LOOK FOR HORIZ. BOUNDARIES
	K	= J + 1			!J,K DEFINE PT. # AT ENDS OF LINES
	IF(K .GT. ISIZE) K	= 1	!FIRST,LAST POINT JOIN
	IF(IXP .GE. IX(J) .AND. IXP .LT. IX(K)) GO TO 40
	IF(IXP .LT. IX(J) .AND. IXP .GE. IX(K)) GO TO 40
	GO TO 80			!NO HORIZONTAL SEGMENT FOUND, DONE
40	TEMP	= IX(K) - IX(J)
	IF(TEMP .EQ. 0.) GO to 80
	TEMP	= (IY(K) - IY(J))/TEMP
50	TEMP	= IY(J) + (IXP - IX(J)) * TEMP
	IF(TEMP .LT. 0.)TEMP	= 0.	!MINIMUM Y VALUE IS 0
	IF(TEMP .GT. MY)TEMP	= MY	! maximum is MY
	ISZ	= ISZ + 1		!NUMBER OF BOUNDARIES FOUND
	IA(ISZ)	= TEMP			!Y BOUNDARIES
	IF(ISZ .EQ. 50) GO TO 81	!DONE
80	CONTINUE
81	DO 85 I = 1,ISZ		!PUT Y VALUES INTO ASCENDING ORDER
	IC(I)	= IXP
	DO 85	J	= I,ISZ
	IF(IA(J) .GE. IA(I)) GO TO 85	!IF LOWER INDEX VALUE NOT SMALLER
	K	= IA(J)			!SWAP THEM
	IA(J)	= IA(I)
	IA(I)	= K
85	CONTINUE
	DO 90 I	= 1,ISZ,2		!PLOT ALL SEGMENTS
90	IA(I)	= -IA(I)		!2 POINT SEGMENTS
	CALL VECT(IC,IA,-ISZ)		!PLOT THE SEGMENTS
100	CONTINUE
	RETURN
	END

	SUBROUTINE	BOXIT(IX1,IY1,IX2,IY2)
	INTEGER	IA(50),IC(50)
C
C	SUBROUTINE TO MAKE A RECTANGULAR OUTLINE
C
	DATA	MX/1023/,MY/779/
	CALL	SCTEST(I)
	IF(I .eq. 0) return			! No graphics ?
	ITEST	= 1
	LINSAV	= -1
	IXMIN	= MIN(IX1,IX2)			! First line
	IXMAX	= MAX(IX1,IX2)			! Last line
	IF(IXMIN .lt. 0) IXMIN = 0		! Minimum line number
	IF(IXMAX .ge. MX) IXMAX = MX-1		! Maximum line number
	IF(IXMIN .gt. IXMAX) RETURN		! Impossible combination
	DO 200 II	= IXMIN,IXMAX,20
	JMAX	= IXMAX - II + 2
	IF(JMAX .GT. 20) JMAX	= 20
	I	= 0
	DO 190 J = 1,JMAX
	IXP	= (II+J-1)			! Next x position
	I	= I + 1				! Next array element
	IA(I)	= IXP
	IC(I)	= IY1
	I	= I + 1				! Next array element
	IA(I)	= IXP
	IC(I)	= IY2
	IF(ITEST .GT. 0)GO TO 180
	IC(I-1)	= IY2
	IC(I)	= IY1
180	ITEST	= -ITEST
190	CONTINUE
	CALL VECT(IA,IC,-I)
200	CONTINUE
	RETURN
	END
	SUBROUTINE NUMBR2(IX,IY,IVAL)
	ENTRY	NUMBER(IX,IY,IVAL)
	INTEGER*4 IVAL
	CHARACTER IA(12)
	ENCODE(12,1000,IA)IVAL			!TURN NUMBER INTO CHAR STR.
	DO 10 J	= 12,1,-1			!SEARCH THRU 11 CHAR.
	IF(IA(J) .NE. ' ')MIN	= J
10	CONTINUE
	ISIZ	= 13-MIN
	IXN	= IX
	I	= 1023 - 14*(ISIZ)
	IF(IXN .GT. I)IXN	= I
	CALL PLCHAR(IXN,IY,%DESCR(IA(MIN)),ISIZ)		!WRITE THE NUMBER
	RETURN
1000	FORMAT(I12)
	END
	SUBROUTINE NUMBRF(IX,IY,VAL,NSIG)
	CHARACTER	IA(20)
	N	= NSIG
	IF(N .LT. 1 .OR. N .GT. 8)N	= 8
	GO TO(1,2,3,4,5,6,7,8) N
1	ENCODE(20,1001,IA)VAL			!TURN NUMBER INTO CHAR STR.
1001	FORMAT(1P,G20.1)
	GO TO 9
2	ENCODE(20,1002,IA)VAL			!TURN NUMBER INTO CHAR STR.
1002	FORMAT(1P,G20.2)
	GO TO 9
3	ENCODE(20,1003,IA)VAL			!TURN NUMBER INTO CHAR STR.
1003	FORMAT(1P,G20.3)
	GO TO 9
4	ENCODE(20,1004,IA)VAL			!TURN NUMBER INTO CHAR STR.
1004	FORMAT(1P,G20.4)
	GO TO 9
5	ENCODE(20,1005,IA)VAL			!TURN NUMBER INTO CHAR STR.
1005	FORMAT(1P,G20.5)
	GO TO 9
6	ENCODE(20,1006,IA)VAL			!TURN NUMBER INTO CHAR STR.
1006	FORMAT(1P,G20.6)
	GO TO 9
7	ENCODE(20,1007,IA)VAL			!TURN NUMBER INTO CHAR STR.
1007	FORMAT(1P,G20.7)
	GO TO 9
8	ENCODE(20,1008,IA)VAL			!TURN NUMBER INTO CHAR STR.
1008	FORMAT(1P,G20.8)
9	DO 10 I	= 1,20
	MIN	= I
	IF(IA(I) .NE. ' ') GO TO 20
10	CONTINUE
20	DO 30 I = 20,MIN,-1
	MAX	= I
	IF(IA(I) .NE. ' ') GO TO 40
30	CONTINUE
40	MAX	= MAX - MIN + 1
	CALL PLCHAR(IX,IY,IA(MIN),MAX)
	END
	SUBROUTINE	SCPLOT(X,Y,ISIZE)
C
C	THIS SUBROUTINE TAKES AN ARRAY OF X,Y COORDINATES OF SIZE=ISIZE
C	AND PLOTS THEM ON A TERMINAL WITH 1024 BY 780 RESOLUTION.
C	IF ISIZE < 0 THEN THE PLOT BEGINS WITH THE FIRST POINT.
C	IF ISIZE > 0 THEN THE PLOT CONTINUES WHERE THE LAST CALL TO SCPLOT
C	LEFT OFF.  IF THE LINES ARE OUTSIDE OF THE ACTIVE AREA THEY ARE CUT
C	SHORT.  SCALE FACTORS MAY BE ENTERED THROUGH 'PSSCAL'.
C
	REAL X(1),Y(1)
	INTEGER	IX(60),IY(60)
	DATA XMAX / 1023.9/, YMAX / 779.9/	!MAX SCREEN SIZES
	DATA XO,YO,XSCAL,YSCAL/0.,0.,1.,1./	!INITIAL SCALE FACTORS
	ISIZ	= ISIZE
	IF(ISIZE .GT. 0)GO TO 50		!CONTINUE FROM OLD X,Y
	ISIZ	= - ISIZ
	X0	= (X(1) - XO)/XSCAL		!STARTING POINT OF PLOT X
	Y0	= (Y(1) - YO)/YSCAL		!Y STARTING POINT
	IF(ISIZ .LE. 1)RETURN			!IF NO VECT MERELY SAVE X0,Y0
50	IA	= 1
	DO 600 I	= 1,ISIZ
	X0SAV	= X0
	XSAV	= (X(I) - XO)/XSCAL		!SCALED X POSITION
	XT	= XSAV
	YSAV	= (Y(I) - YO)/YSCAL		!SCALED Y POSITION
	YT	= YSAV
C
C	TRUNCATE THE VECTORS
C
	IF(X0 .GT. XT)GO TO 100
	CALL XYTRNK(X0,XT,Y0,YT,XMAX,IGOOD)	!TRUNCATE X
	GO TO 200
100	CALL XYTRNK(XT,X0,YT,Y0,XMAX,IGOOD)	!TRUNCATE X
200	IF(IGOOD .EQ. 0)GO TO 420
	IF(Y0 .GT. YT)GO TO 300
	CALL XYTRNK(Y0,YT,X0,XT,YMAX,IGOOD)	!TRUNCATE Y
	GO TO 400
300	CALL XYTRNK(YT,Y0,XT,X0,YMAX,IGOOD)	!TRUNCATE Y
400	CONTINUE
	IF(IGOOD .EQ. 0)GO TO 420		!DO PLOT SINCE IT IS BROKEN LINE SEGMENT
	IF(IA .EQ. 10)  GO TO 420		!DO PLOT TO EMPTY BUFFER
	IF(X0 .EQ. X0SAV .AND. XT .EQ. X(I))GO TO 450	!NO CHANGES IN XY
420	IF(IA .GT.1 )CALL VECT(IX,IY,-IA)
	IA	= 1
	IF(IGOOD .EQ. 0)GO TO 500
450	CONTINUE
	IF(IA .GT. 1)GO TO 460			!DO NOT DO X0,Y0
	IX(1)	= X0				!SET UP FIRST POINT
	IY(1)	= Y0
460	IA	= IA + 1			!COUNT # OF POINTS TO PLOT
	IX(IA)	= XT
	IY(IA)	= YT
500	CONTINUE
	X0	= XSAV				!SAVE NEXT STARTING POINT
	Y0	= YSAV
600	CONTINUE
	IF(IA .GT. 1)CALL VECT(IX,IY,-IA)	!IF POINTS LEFT OVER PLOT THEM
	RETURN
C
C	HERE IS SEPARATE ENTRY TO DO SCALING
C
	ENTRY	PSSCAL(X1,X2,X3,X4)
C
C	CALL PSSCAL(X0,XSCAL,Y0,YSCAL)
C
C	X0	= OROGIN OF X COORDINATES
C	XSCAL	= # OF USER UNITS /SCREEN STEP
C			SCREEN STEP = .1" APPROXIMATELY
C
	XO	= X1
	XSCAL	= X2
	YO	= X3
	YSCAL	= X4
	IF(XSCAL .EQ. 0.)XSCAL	= 1.		!PREVENT ZERO SCALE VALUES
	IF(YSCAL .EQ. 0.)YSCAL	= 1.
	RETURN

	ENTRY SCTONE(X,Y,ISIZE)
C
C	SUBROUTINE TO PRODUCE SHADED PICTURE (SIMILAR TO VERSATEC TONE)
C
C	X,Y	= ARRAY OF COORDINATES FORMING A CLOSED POLYGON
C	ISIZE	= NUMBER OF POINTS
C
	DATA	MX/1023/,MY/779/
	CALL	SCTEST(I)
	IF(I .eq. 0) return		! No graphics ?
	MIN	= MX+1			!SET UP TO FIND MIN,MAX
	MAX	= -1
	DO 710 J	= 1,ISIZE	!SEARCH THRU ALL POINTS
	I	= (( X(J) - XO )/XSCAL)
	IF(I .LT. MIN) MIN	= I
	IF(I .GT. MAX) MAX	= I
710	CONTINUE
	IF(MIN .lt. 0) MIN = 0		! Minimum value
	IF(MAX .gt. MX) MAX = MX	! Maximum value
	IF(MIN.gt.MAX) RETURN		! Impossible plot ?
	DO 800 II	= MIN,MAX	!SHADE OVER ALL VALUES
	IXP	= II			! Coordinate number
	XPT	= IXP
	ISZ	= 0			!WILL BE # OF SEGMENTS
	DO 780 J	= 1,ISIZE	!LOOK FOR HORIZ. BOUNDARIES
	K	= J - 1			!J,K DEFINE PT. # AT ENDS OF LINES
	IF(K .LT. 1) K	= ISIZE		!FIRST,LAST POINT JOIN
	XA	= ( X(K) - XO )/XSCAL
	XB	= ( X(J) - XO )/XSCAL
	IF(XPT .GE. XA .AND. XPT .LT. XB) GO TO 740
	IF(XPT .LT. XA .AND. XPT .GE. XB) GO TO 740
	GO TO 780			!NO HORIZONTAL SEGMENT FOUND, DONE
740	YB	= ( Y(J) - YO )/YSCAL
	YA	= ( Y(K) - YO )/YSCAL
	TEMP	= XB - XA
	IF(TEMP .EQ. 0.) GO TO 750
	TEMP	= (YB - YA)/TEMP
750	TEMP	= YA + (XPT - XA) * TEMP
	IF(TEMP .LT. 520) GO TO 751
751	CONTINUE
	IF(TEMP .LT. 0.)TEMP	= 0.	!MINIMUM Y VALUE IS 0
	IF(TEMP .GT. MY)TEMP	= MY	! Maximum is MY
	ISZ	= ISZ + 1		!NUMBER OF BOUNDARIES FOUND
	IY(ISZ)	= TEMP			!Y BOUNDARIES
	IF(ISZ .GE. 50) GO TO 781	!DONE
780	X1	= X2
781	IF(ISZ .LE. 0) GO TO 800	!NO DATA TO PLOT
	DO 785	I	= 1,ISZ		!PUT Y VALUES INTO ASCENDING ORDER
	IX(I)	= IXP			!X VALUE CORRESPONDING TO Y
	DO 785	J	= I,ISZ
	IF(IY(J) .GE. IY(I)) GO TO 785	!IF LOWER INDEX VALUE NOT SMALLER
	K	= IY(J)			!SWAP THEM
	IY(J)	= IY(I)
	IY(I)	= K
785	CONTINUE
	DO 790 I	= 1,ISZ,2		!PLOT ALL SEGMENTS
	IY(I)	= - IY(I)			!START NEW VECTOR
790	CONTINUE
	CALL VECT(IX,IY,-ISZ)			!PLOT IT
800	CONTINUE
	END

	SUBROUTINE	XYTRNK(X0,X,Y0,Y,AMAX,IGOOD)
C
C	SPECIAL SUBROUTINE TO TRUNCATE X VALUES OF VECTOR TO THE RANGE
C	0 TO AMAX.  X0 < X IS ASSUMED.
C
	IF(X0 .GT. AMAX)GO TO 500		!NO GOOD
	IF(X  .LT. 0.  )GO TO 500
	IF(X0 .GE. 0.  )GO TO 200		!X0 IS WITHIN RANGE
	IF(X - X0 .LE. 0.1)GO TO 500		!NO GOOD
	Y0	= Y0 - X0 * (Y-Y0) / (X-X0)	!NEW Y0
	X0	= 0.				!NEW X0 WITHIN RANGE
200	CONTINUE
	IF(X  .LE. AMAX)GO TO 400		!X IS AOK
	IF(X - X0 .LE. 0.1)GO TO 500		!DIFFERENCE TOO SMALL
	Y	= Y0 + (AMAX-X0) * (Y-Y0) / (X-X0)	!NEW Y VALUE
	X	= AMAX				!NEW X VALUE
400	IGOOD	= -1				!OK
	RETURN
500	IGOOD	= 0				!NOT GOOD
	END
c
c	This copies plot from screen to Versatek printer/plotter
c
	SUBROUTINE	PLTOLP
	PARAMETER	IBSIZ=264		! Number of plot bytes
	BYTE	IB(IBSIZ)
	COMMON	/SCRAT/IB
	COMMON	/IOCOM/IUNIT,LUNIT,LREC,IOTYPE
	BYTE	ESC
	DATA	ESC/27/
	LUNIT	= 6
	IOTYPE	= 1			! Plot transparent
	DO 5 j	= 1,ibsiz		! Clear buffer
5	IB(J)	= 0
	IF(ITEST .ne. 0) go to 10	! not first time through ?
	CALL	SCTEST(ITEST,,,,,,,,IVERT,IHORIZ)
	IF(ITEST .EQ. 0) RETURN
	HRES	= 512./IHORIZ
	VRES	= 800./IVERT
	MAX	= VRES/HRES + .5
	IOFF	= IBSIZ/2-IHORIZ/8	! Byte offset for plot
	IF(MAX .le. 0) MAX = 1	
	IF(ITEST .eq. 0)return
	TYPE 1000,ESC,ESC		! Initial message
	OTIME	= SECNDS(0.0)		! Current time
	TTIME	= OTIME
	CALL	ATTACH
10	DO 20 J = 1,100
20	CALL	OUTPUT(IB,IBSIZ)
	CALL	OWAIT
	DO 100 j = IVERT-1,0,-1	! do all lines
	CALL	GETSC(J,IB(IOFF+1),IBSIZ-IOFF)	! Get input
	DO 30 K = 1,max
30	CALL	OUTPUT(IB,IBSIZ)	! Start output
	IF(SECNDS(OTIME) .gt. 20.) THEN		! 10 seconds since last message
	  OTIME	= secnds(0.0)		! Current time
	  TYPE 1001,100-(j*100)/IVERT,SECNDS(TTIME)! Type out amount done
	endif
	CALL	OWAIT			! Wait for output
100	CONTINUE
	CALL	OUTPUT(0,0)		! Perform a form feed
	TYPE 1002,ESC,ESC		! Done message
1001	FORMAT(' Please be patient plot is'I3'% done - 'F4.0'sec')
1002	FORMAT(' 'A1'[7mPlot is done'A1'[m')
1000	FORMAT(' 'A1'[5mPlease wait'A1'[m')
	END