728 files changed, 92060 insertions, 0 deletions

diff --git a/sys/gio/README b/sys/gio/README
new file mode 100644
index 00000000..e7db4cdd
--- /dev/null
+++ b/sys/gio/README
@@ -0,0 +1,6 @@
+GIO
+
+    This directory contains the source for the IRAF GIO (graphics i/o)
+interface.  The interface is documented in the file "Gio.hlp".  Source for
+the STDGRAPH kernel will be found in the subdirectory "stdgraph".  Source
+for the NSPP kernel will be found in the subdirectory "nspp".
diff --git a/sys/gio/aelogd.x b/sys/gio/aelogd.x
new file mode 100644
index 00000000..0a3d3b26
--- /dev/null
+++ b/sys/gio/aelogd.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AELOGD -- Inverse of the elogd function.
+
+double procedure aelogd (x)
+
+double	x
+
+begin
+	if (x > 1.0D0)
+	    return (10.0D0 ** x)
+	else if (x >= -1.0D0)
+	    return (x * 10.0D0)
+	else
+	    return (- (10.0D0 ** (-x)))
+end
diff --git a/sys/gio/aelogr.x b/sys/gio/aelogr.x
new file mode 100644
index 00000000..81920a9a
--- /dev/null
+++ b/sys/gio/aelogr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AELOGR -- Inverse of the elogr function.
+
+real procedure aelogr (x)
+
+real	x
+
+begin
+	if (x > 1.0)
+	    return (10.0 ** x)
+	else if (x >= -1.0)
+	    return (x * 10.0)
+	else
+	    return (-(10.0 ** (-x)))
+end
diff --git a/sys/gio/calcomp/README b/sys/gio/calcomp/README
new file mode 100644
index 00000000..c3dd017f
--- /dev/null
+++ b/sys/gio/calcomp/README
@@ -0,0 +1,34 @@
+GIO Calcomp kernel
+
+This directory contains source for the IRAF calcomp graphics kernel.
+Specifications may be found in ccpspecs.hlp.  Installation involves
+building the kernel task, which is accomplished using "make" (Makefile)
+with argument "install" to move the executable into lib$.
+
+In addition to the kernel task routines, the vttest.x routine contains code 
+to simulate calcomp software on standard gio graphics devices.  vttest.x
+contains all the source for the simulation, using parameter file vttest.par.
+Here, the calcomp routines "plot", "plots", "newpen", and "symbol" are
+replaced with appropriate gio calls (violating interfaces) and to be used
+mainly for testing text fonts, line type and width simulation.
+
+TODO:
+
+- super-bold font
+- bold + italic
+
+- multiples of dash, dot for linetypes numbered higher than 4
+
+--------------------------------------------------------------------------------
+FUTURE ENHANCEMENTS (much work):
+
+1)  Sophisticated parallel-tracing algorithm that looks at entire array
+    and merges intersections so that all adjacent segments are parallel
+    to each other and do not cross the acute bisector.  Implemented by
+    parallel array segments rather than drawing each parallel segment
+    individually, to avoid pen overtravel on short choppy lines.
+
+2)  Panelling: when plot width exceeds available paper width, wrap graphics
+    to beyond maximum x so that paper can be cut and pasted.
+
+3)  Versatec extension with area-fill.
diff --git a/sys/gio/calcomp/ccp.com b/sys/gio/calcomp/ccp.com
new file mode 100644
index 00000000..d9e9ac69
--- /dev/null
+++ b/sys/gio/calcomp/ccp.com
@@ -0,0 +1,38 @@
+# CCP common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The kernel data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.
+
+pointer	g_cc				# kernel graphics descriptor
+pointer	g_tty				# graphcap descriptor
+int	g_nframes			# number of frames written
+int	g_maxframes			# max frames per device metafile
+int	g_ndraw				# no draw instr. in current frame
+int	g_in				# input file
+real	g_xres				# x resolution of plotter
+real	g_yres				# y resolution of plotter
+real	g_max_x				# maximum x drawn, in plotter units
+real	g_xndcto_p			# x(pltr) = GKI*g_xndcto_p; final scale
+real	g_yndcto_p			# y(pltr) = GKI*g_yndcto_p; final scale
+real	g_xtask_scale			# x scale determined from task params
+real	g_ytask_scale			# y scale determined from task params
+real	g_xdefault_scale		# x scale from graphcap or compile-time
+real	g_ydefault_scale		# y scale from graphcap or compile-time
+int	g_ltype				# line type
+real	g_dashlen			# length of dash in dashed line, p_units
+real	g_gaplen			# width of gap in dash/dot line, p_units
+real	g_plwsep			# polyline width separation for ntracing
+int	g_txquality			# text quality parameter
+bool	g_ltover			# user override of line-type generator
+bool	g_lwover			# user override of line width simulation
+bool	g_lcover			# user override of line color generator
+char	g_lwtype			# line width mode parameter
+char	g_device[SZ_GDEVICE]		# force output to named device
+
+common	/ccpcom/ g_cc, g_tty, g_nframes, g_maxframes, g_ndraw,
+		 g_in, g_xres, g_yres, g_max_x, g_xndcto_p, g_yndcto_p,
+		 g_xtask_scale, g_ytask_scale, 
+		 g_xdefault_scale, g_ydefault_scale,
+		 g_ltype, g_dashlen, g_gaplen, g_plwsep, g_txquality,
+		 g_ltover, g_lwover, g_lcover, g_lwtype, g_device
diff --git a/sys/gio/calcomp/ccp.h b/sys/gio/calcomp/ccp.h
new file mode 100644
index 00000000..037dbc6a
--- /dev/null
+++ b/sys/gio/calcomp/ccp.h
@@ -0,0 +1,92 @@
+# CCP definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		1024			# initial string buffer size
+define	SZ_GDEVICE	31			# maxsize forced device name
+define	CCP_LDEV	5			# device for "plots(0,0,ldev")
+define	CCP_UP		3			# "pen-up" code
+define	CCP_DOWN	2			# "pen-down" code
+define	PL_SINGLE	1			# rel width of single-width line
+define	MAXTRACES	15			# maximum adjacent bold traces
+define	SEGSIZE		256			# segment buffer size
+define	XSEG		Memr[xseg + $1 - 1]	# segment buffer for ccp_calcseg
+define	YSEG		Memr[yseg + $1 - 1]	# "
+define	DIS		sqrt ((($3)-($1))**2+(($4)-($2))**2) #dis (x1,y1, x2,y2)
+define	XTRAN		($1) * g_xndcto_p	# convert NDC to plotter coords
+define	YTRAN		($1) * g_yndcto_p	# "
+define	FRAME_OFFSET	1.0			# pltr units between [new]frames
+define	MAX_PL_XWIDTH	0.3307			# max pltr x (m) if no graphcap
+define	MAX_PL_YHEIGHT	0.2540			# max pltr y (m) if no graphcap
+define	DEF_MPER_PUNIT	0.0254			# default meters / plotter unit
+define	DEF_DASHLEN	0.1000			# default dash length, pltr unit
+define	DEF_GAPLEN	0.0500			# default gap length, pltr units
+define	DEF_PLWSEP	0.0050			# default ntracing sep. in pu
+
+# CCP state device descriptor:
+
+define	LEN_CCP		81
+
+define	CCP_SBUF	Memi[$1]		# string buffer
+define	CCP_SZSBUF	Memi[$1+1]		# size of string buffer
+define	CCP_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	CCP_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	CCP_POLYLINE	Memi[$1+4]		# device supports polyline
+define	CCP_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	CCP_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	CCP_CELLARRAY	Memi[$1+7]		# device supports cell array
+define	CCP_ZRES	Memi[$1+8]		# device resolution in Z
+define	CCP_FILLSTYLE	Memi[$1+9]		# number of fill styles
+define	CCP_ROAM	Memi[$1+10]		# device supports roam
+define	CCP_ZOOM	Memi[$1+11]		# device supports zoom
+define	CCP_SELERASE	Memi[$1+12]		# device has selective erase
+define	CCP_PIXREP	Memi[$1+13]		# device supports pixel replic.
+define	CCP_STARTFRAME	Memi[$1+14]		# frame advance at metafile BOF
+define	CCP_ENDFRAME	Memi[$1+15]		# frame advance at metafile EOF
+	# extra space
+define	CCP_CURSOR	Memi[$1+20]		# last cursor accessed
+define	CCP_COLOR	Memi[$1+21]		# last color set
+define	CCP_TXSIZE	Memi[$1+22]		# last text size set
+define	CCP_TXFONT	Memi[$1+23]		# last text font set
+define	CCP_LTYPE	Memi[$1+24]		# last line type set
+define	CCP_WIDTH	Memi[$1+25]		# last line width set
+define	CCP_DEVNAME	Memi[$1+26]		# name of open device
+define	CCP_DEVCHAN	Memi[$1+27]		# channel for "plots(0,0,ldev)"
+	# extra space
+define	CCP_CHARHEIGHT	Memi[$1+30+$2-1]	# character height
+define	CCP_CHARWIDTH 	Memi[$1+40+$2-1]	# character width
+define	CCP_CHARSIZE	Memr[P2R($1+50+$2-1)]	# text sizes permitted
+define	CCP_PLAP	($1+60)			# polyline attributes
+define	CCP_PMAP	($1+64)			# polymarker attributes
+define	CCP_FAAP	($1+68)			# fill area attributes
+define	CCP_TXAP	($1+71)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
diff --git a/sys/gio/calcomp/ccpclear.x b/sys/gio/calcomp/ccpclear.x
new file mode 100644
index 00000000..9ff17c20
--- /dev/null
+++ b/sys/gio/calcomp/ccpclear.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"ccp.h"
+
+# CCP_CLEAR -- Advance a frame on the plotter.  All attribute packets are
+# initialized to their default values.  Redundant calls or calls immediately
+# after a workstation open (before anything has been drawn) are ignored.
+
+procedure ccp_clear (dummy)
+
+int	dummy			# not used at present
+include	"ccp.com"
+
+begin
+	# This is a no-op if nothing has been drawn.
+	if (g_cc == NULL || g_ndraw == 0)
+	    return
+
+	# Start a new frame.  This is by resetting the origin to the last
+	# x-position drawn plus a compile-time offset.
+
+	call plot (g_max_x + FRAME_OFFSET, 0.0, -3)
+	g_max_x = 0.0
+
+	# Init kernel data structures.
+	call ccp_reset()
+	g_ndraw = 0
+end
diff --git a/sys/gio/calcomp/ccpclose.x b/sys/gio/calcomp/ccpclose.x
new file mode 100644
index 00000000..3d433eb0
--- /dev/null
+++ b/sys/gio/calcomp/ccpclose.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ccp.h"
+
+# CCP_CLOSE -- Close the calcomp kernel.  Free up storage.
+
+procedure ccp_close()
+
+include	"ccp.com"
+
+begin
+	# Signal end of plot.
+	call plot (0, 0, 999)
+	# call plots (0, 0, CCP_DEVCHAN(g_cc)) #do we really want to do this?
+	# (calcomp may get into funny state without, but may mess up APPEND
+
+	# Free kernel data structures.
+	call mfree (CCP_SBUF(g_cc), TY_CHAR)
+	call mfree (g_cc, TY_STRUCT)
+
+	g_cc = NULL
+end
diff --git a/sys/gio/calcomp/ccpclws.x b/sys/gio/calcomp/ccpclws.x
new file mode 100644
index 00000000..f536d7ab
--- /dev/null
+++ b/sys/gio/calcomp/ccpclws.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# include "ccp.h"
+
+# CCP_CLOSEWS -- Close the named workstation.  
+# If the plot were terminated (plot (0, 0, 999)) APPEND mode would not work.
+
+procedure ccp_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+# include "ccp.com"
+
+begin
+	# noop 
+	return 
+end
diff --git a/sys/gio/calcomp/ccpcolor.x b/sys/gio/calcomp/ccpcolor.x
new file mode 100644
index 00000000..98b701d0
--- /dev/null
+++ b/sys/gio/calcomp/ccpcolor.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ccp.h"
+
+# Calcomp pen colors
+define	BLACK		1
+define	WHITE		2
+define	RED		3
+define	GREEN		4
+define	BLUE		5
+
+# CCP_COLOR  set pen color
+
+procedure ccp_color(index)
+
+int	index		# index for color switch statement
+include	"ccp.com"
+
+begin
+	if (g_lcover) # CL param lcover, line color override is on; noop
+	    return
+
+	switch (index) {
+
+	case WHITE:
+	    call newpen (WHITE)
+	case RED:
+	    call newpen (RED)
+	case GREEN:
+	    call newpen (GREEN)
+	case BLUE:
+	    call newpen (BLUE)
+	default:
+	    call newpen (BLACK)
+	}
+end
diff --git a/sys/gio/calcomp/ccpcseg.x b/sys/gio/calcomp/ccpcseg.x
new file mode 100644
index 00000000..7b55adc7
--- /dev/null
+++ b/sys/gio/calcomp/ccpcseg.x
@@ -0,0 +1,207 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include <mach.h>
+include	"ccp.h"
+
+# CCP_CALCSEG -- Calculate a contiguous line segment; used to return individual
+# line segments under the various options of line type simulation.  (Width is
+# not simulated here).  Each segment returned is actually drawable, guaranteeing
+# constant-length dashes and gaps along the exact length of the input polyline. 
+# Normally called by ccp_polyline.
+
+procedure ccp_calcseg (p, npts, ltype, curpl_pt, segsize, xseg,yseg, nsegpts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+int	ltype			# line type; CCP_CLEAR <= ltype <= CCP_DASHDOT
+int	curpl_pt		# current polyline point; input and output
+int	segsize			# current segment memory size
+pointer	xseg,yseg		# plotter-unit contiguous line segment, output
+int	nsegpts			# number of points in segment, output
+
+int	i, j
+real	lastp_x, lastp_y, x, y, curseglen
+bool	toggle
+
+include	"ccp.com"
+
+begin
+	if (curpl_pt == 1) {	# always start line w/beginning of dash, etc.
+	    lastp_x   = XTRAN(p[1])
+	    lastp_y   = YTRAN(p[2])
+	    curpl_pt  = curpl_pt + 1 
+	    toggle    = false
+	} 
+
+	XSEG(1)   = lastp_x
+	YSEG(1)   = lastp_y
+	nsegpts   = 1
+	curseglen = 0.0
+
+	switch (ltype) {
+	case GL_CLEAR:
+	    nsegpts = 0
+
+	case GL_DASHED:
+	    # Return one contiguous polyline segment worth one dash:
+	    call ccx_dash (p, npts, curpl_pt, curseglen, nsegpts, segsize,
+		xseg,yseg, lastp_x,lastp_y)
+
+	    # Now increment internal counters for gap width for next call
+	    call ccx_gap (p, npts, curpl_pt, curseglen, g_dashlen + g_gaplen,
+		lastp_x,lastp_y)
+
+	case GL_DOTTED:
+	    # Since we already built one point, we need only the following gap:
+	    call ccx_gap (p, npts, curpl_pt, curseglen, g_gaplen,
+		lastp_x,lastp_y)
+
+	case GL_DOTDASH:
+	    # Implement as dash/gap/dot/gap/:
+	    if (toggle) {			# build dot/gap/
+		x = lastp_x #XTRAN(p[i])
+		y = lastp_y #YTRAN(p[i+1])
+		nsegpts = 0
+		call ccx_addsegpt (x,y, xseg,yseg, nsegpts, segsize)
+		toggle = false
+	        call ccx_gap (p, npts, curpl_pt, curseglen, g_gaplen, 
+		    lastp_x,lastp_y)
+
+	    } else {				# build dash/gap/
+	        call ccx_dash (p, npts, curpl_pt, curseglen, nsegpts, 
+		    segsize, xseg,yseg, lastp_x,lastp_y)
+	        call ccx_gap (p, npts, curpl_pt, curseglen,
+		    g_dashlen + g_gaplen, lastp_x,lastp_y)
+		toggle = true
+	    }
+
+	default:				# solid line
+	    do i = curpl_pt, npts {
+		j = (i-1) * 2 + 1
+		x = XTRAN(p[j])
+		y = YTRAN(p[j+1])
+		call ccx_addsegpt (x,y, xseg,yseg, nsegpts, segsize)
+	    }
+	    curpl_pt = npts
+	}
+end
+
+
+# CCX_DASH -- Do the actual work of building a dashed line segment (no gap)
+
+procedure ccx_dash (p, npts, curpl_pt, curseglen, cursegpt, segsize,
+		    xseg,yseg, lastp_x,lastp_y)
+
+short	p[ARB]		# Input:  points defining line
+int	npts		# Input:  number of points, i.e., (x,y) pairs
+int	curpl_pt	# In/Output: current polyline point
+real	curseglen	# Output: length of current simulated ltype unit (._)
+int	cursegpt	# Output: index of current drawable point in segment
+int	segsize		# In/Output: current segment size
+pointer	xseg,yseg	# Output: plotter-units, contiguous line segment
+real	lastp_x,lastp_y	# Output: last point in segment (visible or invisible)
+
+int	i
+real	temppl_dis, x, y, delx, dely
+real	actual_dis, rem_dashlen
+
+include	"ccp.com"
+
+begin
+	rem_dashlen = g_dashlen
+
+	# Build up current "dash" (may be bent any number of times).
+
+	while (curseglen + EPSILON < g_dashlen && curpl_pt <= npts) {
+	    i = (curpl_pt-1) * 2 + 1
+	    x = XTRAN(p[i])
+	    y = YTRAN(p[i+1])
+	    temppl_dis  = DIS(lastp_x, lastp_y, x, y)
+	    if (temppl_dis >= EPSILON) {
+		actual_dis  = min (temppl_dis, rem_dashlen)
+		rem_dashlen = rem_dashlen - actual_dis
+
+		delx = x - lastp_x
+		dely = y - lastp_y
+		x = lastp_x + delx * actual_dis / temppl_dis
+		y = lastp_y + dely * actual_dis / temppl_dis
+
+		call ccx_addsegpt (x,y, xseg,yseg, cursegpt, segsize)
+		curseglen = curseglen + actual_dis
+		lastp_x   = XSEG(cursegpt)
+		lastp_y   = YSEG(cursegpt)
+	    }
+	    if (curseglen + EPSILON < g_dashlen)
+	        curpl_pt = curpl_pt + 1
+	}
+end
+
+
+# CCX_GAP -- Do the actual work of building an invisible gap along original
+# polyline.
+
+procedure ccx_gap (p, npts, curpl_pt, curseglen, matchlen, lastp_x,lastp_y)
+
+short	p[ARB]		# Input: points defining line
+int	npts		# Input: number of points, i.e., (x,y) pairs
+int	curpl_pt	# In/Output: current polyline point
+real	curseglen	# In/Output: length of current simulated ltype unit (._)
+real	matchlen	# Output: length to build curseglen up to
+real	lastp_x,lastp_y	# Output: last point in segment (visible, invisible)
+
+int	i
+real	x, y, delx, dely
+real	temppl_dis, actual_dis, rem_gaplen
+
+include	"ccp.com"
+
+begin
+	rem_gaplen = g_gaplen
+
+	# Build up current "gap" (may be bent any number of times).
+
+	while ((curseglen + EPSILON < (matchlen)) && (curpl_pt <= npts)) {
+	    i = (curpl_pt-1) * 2 + 1
+	    x = XTRAN(p[i])
+	    y = YTRAN(p[i+1])
+
+	    temppl_dis = DIS(lastp_x, lastp_y, x, y)
+	    if (temppl_dis >= EPSILON) {
+		actual_dis = min (temppl_dis, rem_gaplen)
+		rem_gaplen = rem_gaplen - actual_dis
+
+		delx = x - lastp_x
+		dely = y - lastp_y
+		curseglen = curseglen + actual_dis
+		lastp_x = lastp_x + delx * actual_dis / temppl_dis
+		lastp_y = lastp_y + dely * actual_dis / temppl_dis
+	    }
+	    if (curseglen + EPSILON < matchlen)
+		curpl_pt = curpl_pt + 1
+	}
+end
+
+
+# CCX_ADDSEGPT -- add a point to the segment structure; handle memory needs
+
+procedure ccx_addsegpt (x,y, xseg,yseg, cursegpt,segsize)
+
+real	x,y			# point to be added to output segment
+pointer	xseg,yseg		# NDC-coord contiguous line segment, output
+int	cursegpt		# index of current drawable point in segment
+int	segsize			# current segment size
+
+begin
+	cursegpt = cursegpt + 1
+
+	if (cursegpt > segsize) {
+	    segsize = segsize + SEGSIZE
+	    call realloc (xseg, segsize, TY_REAL)
+	    call realloc (yseg, segsize, TY_REAL)
+	}
+
+	XSEG(cursegpt) = x
+	YSEG(cursegpt) = y
+end
diff --git a/sys/gio/calcomp/ccpdrawch.x b/sys/gio/calcomp/ccpdrawch.x
new file mode 100644
index 00000000..dab89158
--- /dev/null
+++ b/sys/gio/calcomp/ccpdrawch.x
@@ -0,0 +1,233 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gki.h>
+include	<gset.h>
+include	"ccp.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+define	MAX_STROKESIZE	32	# max number of vectors making up one stroke
+define	CALCOMP_CHSTART	16	# maximum calcomp special symbol plus 1
+define	SYMBOL_ASPECT	1.17	# calcomp height = 7/6 width for normal spacing.
+define	LOW_REDRAWS	5	# multiple traces for low-quality bold text
+define	HIGH_REDRAWS	9	# multiple traces for high-quality bold text
+
+
+# CCP_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+procedure ccp_drawchar (ch, x, y, xsize, ysize, orien, font, quality)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# char width and height in unscaled GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+int	quality			# quality control -- low(calcomp); other(iraf)
+
+real	px, py, coso, sino, theta, xto_nicesize, yto_nicesize
+real	sx[MAX_STROKESIZE], sy[MAX_STROKESIZE]
+int	stroke, tab1, tab2, i, j, pen
+int	bitupk()
+
+include "ccp.com"
+include	"font.com"
+
+begin
+	# Compute correction factor for absolute physical character size.
+	# This also corrects for distortion of high-qual text if xscale<>yscale.
+	xto_nicesize = g_xdefault_scale / g_xndcto_p
+	yto_nicesize = g_ydefault_scale / g_yndcto_p
+
+	# Set the font.
+	call ccp_font (font)
+
+	if (quality == GT_LOW) {
+	    # If low text quality requested, draw with Calcomp's SYMBOL call.
+	    # We avoid machine-dependency word-size problems by always
+	    # calling SYMBOL only from here, one char per call.
+	    # Calcomp's SYMBOL expects height as only size; aspect is height
+	    # = 7/6 (width) for normal character spacing.
+
+	    call ccx_intersymbol (XTRAN(x),YTRAN(y), real(xsize) * xto_nicesize,
+	        real(ysize) * yto_nicesize, ch, real(orien))
+
+	} else {
+	    # Text quality requested is not low; draw font either with single-
+	    # width line or bold, via ccp_drawseg.
+
+	    if (ch < CHARACTER_START || ch > CHARACTER_END)
+		i = '?' - CHARACTER_START + 1
+	    else
+		i = ch  - CHARACTER_START + 1
+
+	    tab1 = chridx[i]
+	    tab2 = chridx[i+1] - 1
+
+	    if (tab2 - tab1 + 1 > MAX_STROKESIZE) {
+		call eprintf (
+		    "CCP KERNEL WARNING: up-dimension MAX_STROKESIZE\n")
+		call eprintf (
+		    "in module ccp_drawch; new stroke size %d, char %s\n")
+		    call pargi (tab2 - tab1 + 1)
+		    call pargc (ch)
+		tab2 = tab1 + MAX_STROKESIZE - 1
+	    }
+
+	    theta = -DEGTORAD(orien)
+	    coso = cos(theta)
+	    sino = sin(theta)
+
+	    j = 0
+	    do i = tab1, tab2 {
+		stroke = chrtab[i]
+		px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+		py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+		pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+		# Scale size of character in unwarped (xscale == yscale) system.
+		px = px / FONT_WIDTH  * xsize
+		py = py / FONT_HEIGHT * ysize
+
+		# The italic font is implemented applying a tilt.
+		if (font == GT_ITALIC)
+		    px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+		if (pen == 0 && j > 0) {	# new stroke segment; draw last
+		    if (j > 1) 
+			call ccx_interpoly (sx, sy, j, quality)
+		    j = 0
+		} 
+
+		# Rotate, shift (unwarped), then correct for xscale <> yscale.
+		j     = j + 1
+		sx[j] = XTRAN(x + ( px * coso + py * sino) * xto_nicesize)
+		sy[j] = YTRAN(y + (-px * sino + py * coso) * yto_nicesize)
+	    }
+
+	    # last stroke segment:
+	    if (j > 1)
+	        call ccx_interpoly (sx, sy, j, quality)
+	}
+end
+
+
+# CCX_INTERPOLY -- intermediate routine to 1) pass simple draw instruction to 
+# calcomp plot routines if linewidth single or bold method = penchange, or 
+# 2) simulate bold text by offsetting to the four corners and four edges
+# of a box surrounding the character.
+
+procedure ccx_interpoly (x, y, npts, quality)
+
+real	x[ARB],y[ARB] 	# plotter-unit coordinates to be drawn as polyline
+int	npts		# number points in x,y
+int	quality		# text quality (distinguish between medium and high)
+
+int	i, j, num_redraws, twidth
+real	xp, yp
+real	xoff[HIGH_REDRAWS],yoff[HIGH_REDRAWS]
+
+include	"ccp.com"
+
+data	xoff/0., 1., 0., -1.,  0.,    1., -1., -1.,  1./
+data	yoff/0., 0., 1.,  0., -1.,    1.,  1., -1., -1./
+
+begin
+	if (npts <= 0) 
+	    return
+
+	# If line width override is on, or linewidth is single, do simple move
+	# and draws.
+
+	num_redraws = 1
+	twidth = nint(GKI_UNPACKREAL(CCP_WIDTH(g_cc)))
+	if (!g_lwover)
+	    if (g_lwtype == 'p' && twidth >= 1)
+		call ccp_lwidth (twidth)
+	    else if (twidth > 1 && quality == GT_HIGH)
+		num_redraws = HIGH_REDRAWS
+	    else
+		num_redraws = LOW_REDRAWS
+
+	if (num_redraws == 1) {
+	    call plot (x[1], y[1], CCP_UP)
+	    g_max_x = max (x[1], g_max_x)
+
+	    if (npts == 1) {	# single pt is special case; drop pen
+		call plot (x[1], y[1], CCP_DOWN)
+	    } else {		# draw normally
+		do i = 2, npts {
+		    call plot (x[i], y[i], CCP_DOWN)
+		    g_max_x = max (x[i], g_max_x)
+		}
+	    }
+	} else {
+	    do i = 1, num_redraws {
+		xp = x[1] + xoff[i] * g_plwsep
+		yp = y[1] + yoff[i] * g_plwsep
+		call plot (xp, yp, CCP_UP)
+		g_max_x = max (xp, g_max_x)
+
+		if (npts == 1) {	# single pt is special case; drop pen
+		    call plot (xp, yp, CCP_DOWN)
+		} else {		# draw normally
+		    do j = 2, npts {
+			xp = x[j] + xoff[i] * g_plwsep
+			yp = y[j] + yoff[i] * g_plwsep
+			call plot (xp, yp, CCP_DOWN)
+			g_max_x = max (xp, g_max_x)
+		    }
+		}
+	    }
+	}
+end
+
+
+# CCX_INTERSYMBOL -- routine intermediate to Calcomp SYMBOL routine; handles
+# bold text.
+
+procedure ccx_intersymbol (x,y, xsize,ysize, ch, orien)
+
+real	x,y		# plotter-unit coords of lower left of character
+real	xsize,ysize	# char width, height in GKI units scaled to "nice" sizes
+char	ch		# character to be drawn
+real	orien		# degrees counterclockwise from +x axis to text path
+
+int	i, nsym, symchar, num_redraws
+real	xp,yp, xoff[HIGH_REDRAWS],yoff[HIGH_REDRAWS], csize
+
+include	"ccp.com"
+
+data	xoff/0., 1., 0., -1.,  0.,    1., -1., -1.,  1./
+data	yoff/0., 0., 1.,  0., -1.,    1.,  1., -1., -1./
+
+begin
+	symchar = int (ch)
+	nsym    = 1
+
+	if (ch < CALCOMP_CHSTART && ch >= 0) {
+	    nsym = -1
+	} else if (ch < ' ' || ch > '~')
+	    ch = '~'
+
+	# Since we are only called if text_quality == low, implement
+	# bold text with only the center and edge positions (LOW_REDRAWS).
+	num_redraws = 1
+	if (!g_lwover && nint(GKI_UNPACKREAL(CCP_WIDTH(g_cc))) > 1)
+	    num_redraws = LOW_REDRAWS
+
+	# Set the size as the height of the character in device units; we
+	# start with the width to avoid overlapping, and we use the default
+	# scale, which results in reasonable-sized characters; the specified
+	# scale would produce strange results as orien passes from 0 to 90.
+
+	csize = min (xsize * g_xndcto_p * SYMBOL_ASPECT, ysize * g_yndcto_p)
+
+	do i = 1, num_redraws {
+	    xp = x + xoff[i] * g_plwsep
+	    yp = y + yoff[i] * g_plwsep
+	    call symbol (xp, yp, csize, symchar, orien, nsym)
+	    g_max_x = max (xp + csize, g_max_x)
+	}
+end
diff --git a/sys/gio/calcomp/ccpdseg.x b/sys/gio/calcomp/ccpdseg.x
new file mode 100644
index 00000000..2d5d1c76
--- /dev/null
+++ b/sys/gio/calcomp/ccpdseg.x
@@ -0,0 +1,208 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math.h>
+include "ccp.h"
+
+define	DIAGSEP	(g_plwsep / 0.8660254)	# distance to vertex of hexagon
+define	PIOVER3	(PI / 3.0)
+define	PIOVER6 (PI / 6.0)
+define	SIN_MIN_HALFBISECTOR	0.1	# sine of minimum half-bisector
+
+
+# CCP_DRAWSEG -- Draw a polyline segment, optionally simulating variable
+# widths.
+
+procedure ccp_drawseg (xseg, yseg, nsegpts, lwidth)
+
+real	xseg[ARB]		# plotter coordinate array of contiguous points
+real	yseg[ARB]
+int	nsegpts			# number of pts in array
+int	lwidth			# line width relative to single width
+
+int	i, j
+real	pleft_x[MAXTRACES], pleft_y[MAXTRACES]
+real	pright_x[MAXTRACES], pright_y[MAXTRACES], lastp_x,lastp_y
+real	ahp2p1, theta, delx,dely, dx,dy, tx,ty
+real	rptheta4 ()
+include	"ccp.com"
+data	lastp_x/0.0/, lastp_y/0.0/
+
+begin
+	if (nsegpts < 1) 
+	    return
+	if (lwidth > MAXTRACES) {
+	    call eprintf ("WARNING: line width > MAXTRACES in ccp_drawseg\n")
+	    call eprintf ("         line width reset to %d\n")
+		call pargi (MAXTRACES)
+	    lwidth = MAXTRACES
+	}
+
+	if (nsegpts == 1) {					# 1 pt spcl bold
+
+	    # Draw a single point as a hexagon lined up in the direction from 
+	    # the preceding point.  Start bounding hexagon 60 degrees cc from 
+	    # projection of last point drawn (0,0 initially) through current pt.
+	    # 'ahp2p1' = Angle from Horizontal at P1 to line P1 -> P2, etc.
+
+	    ahp2p1  = rptheta4 (xseg[1], yseg[1], lastp_x, lastp_y)
+	    lastp_x = xseg[1]
+	    lastp_y = yseg[1]
+	    theta   = ahp2p1 - PIOVER6
+
+	    # do even a single, interior point as a hexagon, up to lwidth times
+	    do i = 1, lwidth {
+		tx = xseg[1] + (2 + i) * DIAGSEP * cos (theta)
+		ty = yseg[1] + (2 + i) * DIAGSEP * sin (theta)
+		call plot (tx, ty, CCP_UP)
+
+		# draw a bounding hexagon around point:
+		do j = 1, 6 {
+		    theta = theta + PIOVER3
+		    tx = xseg[1] + (2 + i) * DIAGSEP * cos (theta)
+		    ty = yseg[1] + (2 + i) * DIAGSEP * sin (theta)
+		    call plot (tx, ty, CCP_DOWN)
+
+		    # Store maximum-x plotted for a "newframe" in ccp_clear.
+		    g_max_x = max (tx, g_max_x)
+		}
+
+		# fill in a diagonal line across hexagon:
+		tx = xseg[1] + (2 + i) * DIAGSEP * cos (theta + PI)
+		ty = yseg[1] + (2 + i) * DIAGSEP * sin (theta + PI)
+		call plot (tx, ty, CCP_DOWN)
+		theta = theta + PIOVER3				# rotate spokes
+	    }
+
+	} else {						# nsegpts > 1
+
+	    if (g_lwover || lwidth == PL_SINGLE) {
+		call plot (xseg[1], yseg[1], CCP_UP)
+		g_max_x = max (xseg[1], g_max_x)
+
+		do i = 2, nsegpts {
+		    call plot (xseg[i], yseg[i], CCP_DOWN)
+		    g_max_x = max (xseg[i], g_max_x)
+		}
+	    } else if (lwidth > PL_SINGLE) {
+
+		# compute flanking points; by definition +-90 deg. from p1-p2,
+		# so first point is special case; do for all thicknesses:
+
+		call ccx_offsets (xseg[1]-xseg[2]+xseg[1], 
+		    yseg[1]-yseg[2]+yseg[1], xseg[1],yseg[1], 
+		    xseg[2],yseg[2], delx,dely)
+
+		do i = 1, lwidth - 1 {
+		    pleft_x[i]  = xseg[1] + i * delx
+		    pleft_y[i]  = yseg[1] + i * dely
+		    pright_x[i] = xseg[1] - i * delx
+		    pright_y[i] = yseg[1] - i * dely
+		}
+
+		# must draw each segment individually, to make flanks meet.
+	        do i = 1, nsegpts - 2 {
+
+		    # actual line segment in data:
+		    call plot (xseg[i], yseg[i], CCP_UP)
+		    call plot (xseg[i+1], yseg[i+1], CCP_DOWN)
+		    g_max_x = max (xseg[i], g_max_x)
+
+		    call ccx_offsets (xseg[i],yseg[i], xseg[i+1],yseg[i+1],
+			xseg[i+2],yseg[i+2], delx,dely)
+
+		    # for each flanking line; p2 in middle, at temp origin
+		    do j = 1, lwidth - 1 {
+
+			# point to left of p1-p2, facing p2:
+			dx = j * delx
+			dy = j * dely
+			tx = xseg[i+1] + dx
+			ty = yseg[i+1] + dy
+			call plot (pleft_x[j], pleft_y[j], CCP_UP)
+			call plot (tx, ty, CCP_DOWN)
+			pleft_x[j] = tx
+			pleft_y[j] = ty
+
+			# point to right of p1-p2, facing p2:
+			tx = xseg[i+1] - dx
+			ty = yseg[i+1] - dy
+			call plot (pright_x[j], pright_y[j], CCP_UP)
+			call plot (tx, ty, CCP_DOWN)
+			pright_x[j] = tx
+			pright_y[j] = ty
+		    }
+		}
+		
+		# last point:
+		call plot (xseg[nsegpts-1], yseg[nsegpts-1], CCP_UP)
+		call plot (xseg[nsegpts], yseg[nsegpts], CCP_DOWN)
+		g_max_x = max (xseg[nsegpts-1], g_max_x)
+		g_max_x = max (xseg[nsegpts], g_max_x)
+
+		# save this point for a possible following dotted line segment:
+		lastp_x = xseg[nsegpts]
+		lastp_y = yseg[nsegpts]
+
+		# square the flanking lines:
+		call ccx_offsets (xseg[nsegpts-1], yseg[nsegpts-1],
+		    xseg[nsegpts], yseg[nsegpts],
+		    xseg[nsegpts] * 2.0 - xseg[nsegpts-1],
+		    yseg[nsegpts] * 2.0 - yseg[nsegpts-1],
+		    delx, dely)
+
+		do i = 1, lwidth - 1 {
+		    tx = xseg[nsegpts] + i * delx
+		    ty = yseg[nsegpts] + i * dely
+		    call plot (pleft_x[i], pleft_y[i], CCP_UP)
+		    call plot (tx, ty, CCP_DOWN)
+		    tx = xseg[nsegpts] - i * delx
+		    ty = yseg[nsegpts] - i * dely
+		    call plot (pright_x[i], pright_y[i], CCP_UP)
+		    call plot (tx, ty, CCP_DOWN)
+		}
+	    }
+	}
+end
+
+
+# CCX_OFFSETS -- return offsets in x, y from point 2 to one level of line width
+# simulation, given points 1, 2, 3.
+
+procedure ccx_offsets (p1x,p1y, p2x,p2y, p3x,p3y, delx,dely)
+
+real	p1x,p1y		# input:  point 1 is previous point
+real	p2x,p2y		# input:  point 2 is current point (middle of the three)
+real	p3x,p3y		# input:  point 3 is succeeding point
+real	delx,dely	# output: offsets from point 2 to one flanking point
+
+real	ahp2p1		# Angle from Horizontal to line p2-->p1, etc.
+real	ahp2p3, ap1p2p3, ahbisector, sintheta, r
+real	rptheta4 ()
+include	"ccp.com"
+
+begin
+	# convention is that p2 is current point, at temporary origin; p1
+	# is "behind", and p3 is "ahead" of the current point, p2.
+	# "ahp2p1"  = angle from horizontal to segment p2->p1
+	# "ap1p2p3" = angle from p1 to p2 to p3
+	# "ahbisector" = angle from horizontal (+x) to bisector of p1->p2->p3
+
+	ahp2p1     = rptheta4 (p2x,p2y, p1x,p1y)
+	ahp2p3	   = rptheta4 (p2x,p2y, p3x,p3y)
+	ap1p2p3    = ahp2p1 - ahp2p3
+	ahbisector = ahp2p3 + 0.5 * ap1p2p3
+	sintheta   = sin (ahp2p1 - ahbisector)
+
+	# very small angles cause extremely exaggerated vertices; truncate
+	# at arbitrary multiple of plwsep; 10*plwsep is eqv. to 11.5 deg. bisect
+
+	if (abs (sintheta) < SIN_MIN_HALFBISECTOR) {
+	    r = g_plwsep / SIN_MIN_HALFBISECTOR
+	    if (sintheta < 0.0)
+		r = -r
+	} else
+	    r = g_plwsep / sintheta
+	
+	delx = r * cos (ahbisector)
+	dely = r * sin (ahbisector)
+end
diff --git a/sys/gio/calcomp/ccpescape.x b/sys/gio/calcomp/ccpescape.x
new file mode 100644
index 00000000..37e81972
--- /dev/null
+++ b/sys/gio/calcomp/ccpescape.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gescape.h>
+include "ccp.h"
+
+# CCP_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# used for passing exact scaling factors through gki metacode
+
+procedure ccp_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+
+int	ip
+real	tempr
+char	scale_str[SZ_LINE]
+int	ctod ()
+
+include "ccp.com"
+
+string	warnx	"Warning: ccpkern unable to convert gki_escape xscale\n"
+string	warny	"Warning: ccpkern unable to convert gki_escape yscale\n"
+
+begin
+	call achtsc (instruction, scale_str, nwords)
+	scale_str[nwords+1] = EOS
+	ip = 1
+
+	switch (fn) {
+
+	case GSC_X_GKITODEV:
+
+	    # if kernel task scale params were not specified, set actual scale
+	    # params to those passed from metacode if translatable, set to
+	    # default scale from ccp_init/graphcap if untranslatable.  If 
+	    # kernel task did specify scale, this is a no op.
+
+	    if (IS_INDEF (g_xtask_scale)) {
+		if (ctod (scale_str, ip, tempr) < 1) {
+		    g_xndcto_p = g_xdefault_scale
+		    call eprintf (warnx)
+		    call eprintf ("scale string: %s\n")
+			call pargstr (scale_str)
+		    call eprintf ("new (graphcap-default) x scale: %f\n")
+			call pargr (g_xndcto_p)
+		} else 
+		    g_xndcto_p = tempr
+	    }
+
+	case GSC_Y_GKITODEV:
+
+	    if (IS_INDEF (g_ytask_scale)) {
+		if (ctod (scale_str, ip, tempr) < 1) {
+		    g_yndcto_p = g_ydefault_scale
+		    call eprintf (warny)
+		    call eprintf ("scale string: %s\n")
+			call pargstr (scale_str)
+		    call eprintf ("new (graphcap-default) y scale: %f\n")
+			call pargr (g_yndcto_p)
+		} else
+		    g_yndcto_p = tempr
+	    }
+	}
+end
diff --git a/sys/gio/calcomp/ccpfa.x b/sys/gio/calcomp/ccpfa.x
new file mode 100644
index 00000000..cf54861d
--- /dev/null
+++ b/sys/gio/calcomp/ccpfa.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ccp.h"
+
+# CCP_FILLAREA -- Fill a closed area.
+
+procedure ccp_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+include	"ccp.com"
+
+begin
+	# Not implemented yet.
+	call ccp_polyline (p, npts)
+end
diff --git a/sys/gio/calcomp/ccpfaset.x b/sys/gio/calcomp/ccpfaset.x
new file mode 100644
index 00000000..228669f9
--- /dev/null
+++ b/sys/gio/calcomp/ccpfaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_FASET -- Set the fillarea attributes.
+
+procedure ccp_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"ccp.com"
+
+begin
+	fa = CCP_FAAP(g_cc)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/calcomp/ccpfont.x b/sys/gio/calcomp/ccpfont.x
new file mode 100644
index 00000000..0e7ad9a4
--- /dev/null
+++ b/sys/gio/calcomp/ccpfont.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gset.h>
+include	"ccp.h"
+
+# CCP_FONT -- Set the character font.  The roman font is normal.  Bold is
+# implemented by increasing the vector line width; care must be taken to
+# set CCP_WIDTH so that the other vector drawing procedures remember to
+# change the width back.  The italic font is implemented in the character
+# generator by a geometric transformation.
+
+procedure ccp_font (font)
+
+int	font			# code for font to be set
+int	pk1, pk2, width
+include	"ccp.com"
+
+begin
+	pk1 = GKI_PACKREAL(1.0)
+	pk2 = GKI_PACKREAL(2.0)
+
+	width = CCP_WIDTH(g_cc)
+
+	if (font == GT_BOLD) {
+	    if (width != pk2) 
+		width = pk2
+	} else {
+	    if (GKI_UNPACKREAL(width) > 1.5) 
+		width = pk1
+	}
+
+	CCP_WIDTH(g_cc) = width
+end
diff --git a/sys/gio/calcomp/ccpinit.x b/sys/gio/calcomp/ccpinit.x
new file mode 100644
index 00000000..1ae558c7
--- /dev/null
+++ b/sys/gio/calcomp/ccpinit.x
@@ -0,0 +1,165 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_INIT -- Initialize the CCP data structures from the graphcap entry
+# for the plotter.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine CCP_RESET initializes the attribute
+# packets.
+
+procedure ccp_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+int	maxch, i
+real	char_height, char_width, char_size, xres, yres, xwidth, yheight
+real	mper_punit
+bool	ttygetb()
+real	ttygetr()
+int	ttygeti(), btoi(), gstrcpy()
+include	"ccp.com"
+
+begin
+	# Allocate the CCP descriptor, string buffer, and x,y segment buffers.
+	if (g_cc == NULL) {
+	    call calloc (g_cc, LEN_CCP, TY_STRUCT)
+	    call malloc (CCP_SBUF(g_cc), SZ_SBUF, TY_CHAR)
+	}
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	CCP_SZSBUF(g_cc) = SZ_SBUF
+	CCP_NEXTCH(g_cc) = CCP_SBUF(g_cc) + 1
+	Memc[CCP_SBUF(g_cc)] = EOS
+
+	# Get the device resolution, dimensions in meters, and meter-to-pltr
+	# unit conversion factor from graphcap; if none are specified, use
+	# compile-time constants.
+
+	xres = ttygeti (tty, "xr")
+	if (xres <= 0)
+	    xres = GKI_MAXNDC
+	yres = ttygeti (tty, "yr")
+	if (yres <= 0)
+	    yres = GKI_MAXNDC
+
+	xwidth  = ttygetr (tty, "xs")
+	if (xwidth <= 0.0)
+	    xwidth = MAX_PL_XWIDTH
+	yheight = ttygetr (tty, "ys")
+	if (yheight <= 0.0)
+	    yheight = MAX_PL_YHEIGHT
+
+	mper_punit = ttygetr (tty, "MP")
+	if (mper_punit <= 0.0)
+	    mper_punit = DEF_MPER_PUNIT
+	
+	# Set up coordinate transformation if not explicitly specified to 
+	# kernel task at run time.  Scale determined from graphcap is saved 
+	# in case ccp_escape gets a metacode scale it cannot translate.
+	# Set up default scale such that a full max_gki_ndc plot will fit in y.
+
+	g_ydefault_scale = yheight / (mper_punit * GKI_MAXNDC)
+	if (IS_INDEF (g_ytask_scale))
+	    g_yndcto_p = g_ydefault_scale
+
+	g_xdefault_scale = xwidth / (mper_punit * GKI_MAXNDC)
+	if (IS_INDEF (g_xtask_scale)) 
+	    g_xndcto_p = g_xdefault_scale
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the plotter has a set of discrete character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+
+	CCP_NCHARSIZES(g_cc) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = CCP_NEXTCH(g_cc)
+
+	if (CCP_NCHARSIZES(g_cc) <= 0) {
+	    CCP_NCHARSIZES(g_cc) = 1
+	    CCP_CHARSIZE(g_cc,1) = 1.0
+	    CCP_CHARHEIGHT(g_cc,1) = char_height
+	    CCP_CHARWIDTH(g_cc,1)  = char_width
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= CCP_NCHARSIZES(g_cc);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		CCP_CHARSIZE(g_cc,i)   = char_size
+		CCP_CHARHEIGHT(g_cc,i) = char_height * char_size
+		CCP_CHARWIDTH(g_cc,i)  = char_width  * char_size
+	    }
+	}
+
+	# Get dash length, gap length, and n-tracing separation width:
+	if (IS_INDEF (g_dashlen)) {
+	    g_dashlen = ttygetr (tty, "DL")
+	    if (g_dashlen <= 0.0)
+		g_dashlen = DEF_DASHLEN
+	}
+	if (IS_INDEF (g_gaplen)) {
+	    g_gaplen = ttygetr (tty, "GL")
+	    if (g_gaplen <= 0.0)
+		g_gaplen = DEF_GAPLEN
+	}
+	if (IS_INDEF (g_plwsep)) {
+	    g_plwsep = ttygetr (tty, "PW")
+	    if (g_plwsep <= 0.0)
+		g_plwsep = DEF_PLWSEP
+	}
+		
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the CCP
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	CCP_POLYLINE(g_cc)   = btoi (ttygetb (tty, "pl"))
+	CCP_POLYMARKER(g_cc) = btoi (ttygetb (tty, "pm"))
+	CCP_FILLAREA(g_cc)   = btoi (ttygetb (tty, "fa"))
+	CCP_FILLSTYLE(g_cc)  =       ttygeti (tty, "fs")
+	CCP_ROAM(g_cc)	     = btoi (ttygetb (tty, "ro"))
+	CCP_ZOOM(g_cc)	     = btoi (ttygetb (tty, "zo"))
+	CCP_ZRES(g_cc)	     =       ttygeti (tty, "zr")
+	CCP_SELERASE(g_cc)   = btoi (ttygetb (tty, "se"))
+	CCP_PIXREP(g_cc)     = btoi (ttygetb (tty, "pr"))
+
+	# Initialize the input parameters.
+
+	CCP_CURSOR(g_cc)     = 1
+
+	# Save the device string in the descriptor.
+	nextch = CCP_NEXTCH(g_cc)
+	CCP_DEVNAME(g_cc) = nextch
+	CCP_DEVCHAN(g_cc) = CCP_LDEV
+	maxch = CCP_SBUF(g_cc) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+	CCP_NEXTCH(g_cc) = nextch
+
+	# Initialize maximum-x tracker, used for "newframe" in ccp_clear.
+	g_max_x = 0.0
+end
diff --git a/sys/gio/calcomp/ccpltype.x b/sys/gio/calcomp/ccpltype.x
new file mode 100644
index 00000000..e5325ddd
--- /dev/null
+++ b/sys/gio/calcomp/ccpltype.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gset.h>
+include	"ccp.h"
+
+# CCP_LINETYPE -- Set the line type option in the nspp world.
+
+procedure ccp_linetype (index)
+
+int	index		# index for line type switch statement
+
+include	"ccp.com"
+
+begin
+	switch (index) {
+	case GL_CLEAR:
+	    g_ltype = 0
+	case GL_DASHED:
+	    g_ltype = 2
+	case GL_DOTTED:
+	    g_ltype = 3
+	case GL_DOTDASH:
+	    g_ltype = 4
+	default:
+	    g_ltype = 1		# GL_SOLID and default
+	}
+end
diff --git a/sys/gio/calcomp/ccplwidth.x b/sys/gio/calcomp/ccplwidth.x
new file mode 100644
index 00000000..bda9c33b
--- /dev/null
+++ b/sys/gio/calcomp/ccplwidth.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"ccp.h"
+
+# Calcomp pen widths
+define	SINGLE	1	# ***** site dependence!!	[MACHDEP]
+define	DOUBLE	2	# 
+
+# CCP_LWIDTH  set pen width; see ccp_color, which also sets pens.
+# We should only be called if task param "lwtype" was explicitly set to
+# "p" for pen method; normally bold lines are handled by ntracing.
+
+procedure ccp_lwidth (index)
+
+int	index		# index for width switch statement
+include	"ccp.com"
+
+begin
+	if (g_lwover)	# CL param lwover, line width override is on; noop
+	    return
+
+	# ***** site dependence; add other pen numbers here; if pen numbers
+	# for multiple widths are monotonic, make single call to newpen(index).
+
+	switch (index) {
+
+	case DOUBLE:
+	    call newpen (DOUBLE)
+	default:
+	    call newpen (SINGLE)
+	}
+end
diff --git a/sys/gio/calcomp/ccpopen.x b/sys/gio/calcomp/ccpopen.x
new file mode 100644
index 00000000..f900b95b
--- /dev/null
+++ b/sys/gio/calcomp/ccpopen.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_OPEN -- Install the calcomp kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  The table entry for non-implemented procedures is
+# set to zero, causing the interpreter to ignore the instruction.
+
+procedure ccp_open (devname, dd)
+
+char	devname[ARB]		# ignored if only one plotter on system
+int	dd[ARB]			# device table to be initialized
+
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+extern	ccp_openws(), ccp_closews(), ccp_clear()
+extern	ccp_polyline(), ccp_polymarker(), ccp_text()
+extern	ccp_plset()
+extern	ccp_pmset(), ccp_txset()
+extern	ccp_escape()
+include	"ccp.com"
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	# Flag first pass.  Save forced device name in common for OPENWS.
+	# Zero the frame and instruction counters.
+
+	g_cc = NULL
+	g_ndraw = 0 #????? may not need; also used in ccp_openws,ccp_clear,
+		    # ccp_polyline, ccp_polymarker, ccp_text; may want for
+		    # debug etc.
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+
+	dd[GKI_OPENWS]		= locpr (ccp_openws)
+	dd[GKI_CLOSEWS]		= locpr (ccp_closews)
+	dd[GKI_DEACTIVATEWS]	= 0
+	dd[GKI_REACTIVATEWS]	= 0
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (ccp_clear)
+	dd[GKI_CANCEL]		= 0
+	dd[GKI_FLUSH]		= 0
+	dd[GKI_POLYLINE]	= locpr (ccp_polyline)
+	dd[GKI_POLYMARKER]	= locpr (ccp_polymarker)
+	dd[GKI_TEXT]		= locpr (ccp_text)
+	dd[GKI_FILLAREA]	= 0
+	dd[GKI_PUTCELLARRAY]	= 0
+	dd[GKI_SETCURSOR]	= 0
+	dd[GKI_PLSET]		= locpr (ccp_plset)
+	dd[GKI_PMSET]		= locpr (ccp_pmset)
+	dd[GKI_TXSET]		= locpr (ccp_txset)
+	dd[GKI_FASET]		= 0
+	dd[GKI_GETCURSOR]	= 0
+	dd[GKI_GETCELLARRAY]	= 0
+	dd[GKI_ESCAPE]		= locpr (ccp_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call ccp_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/calcomp/ccpopenws.x b/sys/gio/calcomp/ccpopenws.x
new file mode 100644
index 00000000..aec063cf
--- /dev/null
+++ b/sys/gio/calcomp/ccpopenws.x
@@ -0,0 +1,87 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include	<gki.h>
+include	<error.h>
+include	"ccp.h"
+
+# CCP_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, following by initialization of the device itself.
+
+procedure ccp_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+pointer	sp, buf
+pointer	ttygdes()
+bool	streq()
+bool	need_open, same_dev
+include	"ccp.com"
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	# If a particular plotter was named when the kernel was opened then 
+	# output will always go to that plotter (g_device) regardless of the 
+	# plotter named in the OPENWS instruction.  If no plotter was named 
+	# (null string) then unpack the plotter name, passed as a short integer 
+	# array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Find out if first time, and if not, if same device as before
+	# note that if (g_cc == NULL), then same_dev is false.
+
+	same_dev = false
+	need_open = true
+
+	if (g_cc != NULL) {			# not first time
+	    same_dev = (streq (Memc[CCP_DEVNAME(g_cc)], Memc[buf]))
+	    if (!same_dev) {
+		# close previous plotter, initialize new one.
+		call plot (0, 0, 999)
+		call plots (0, 0, CCP_DEVCHAN(g_cc))
+	    } else
+		need_open = false
+	}
+
+	# Initialize the kernel data structures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+	# graphcap entry for device must exist.
+
+	if (need_open) {
+	    if ((g_cc != NULL) && !same_dev)
+		call ttycdes (g_tty)			# close prev tty
+	    if (!same_dev) {
+	        iferr (g_tty = ttygdes (Memc[buf]))
+		    call erract (EA_ERROR)
+		g_ndraw = 0
+	    }
+	}
+
+	# Initialize data structures if we had to open a new device.
+	if (!same_dev) {
+	    call ccp_init (g_tty, Memc[buf])
+	    call ccp_reset()
+	    call plots (0, 0, CCP_DEVCHAN(g_cc))
+	}
+
+	# Advance a frame if device is being opened in new_file mode.
+	# This is a nop if we really opened a new device, but it will advance
+	# the paper if this is just a reopen of the same device in new file
+	# mode.
+
+	if (mode == NEW_FILE)
+	    call ccp_clear (0)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/calcomp/ccppl.x b/sys/gio/calcomp/ccppl.x
new file mode 100644
index 00000000..2b1712bd
--- /dev/null
+++ b/sys/gio/calcomp/ccppl.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include	"ccp.h"
+
+# CCP_POLYLINE -- Set up a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted unless it is the only point, but rather defines the start of
+# the polyline.  The remaining points define line segments to be drawn.
+
+procedure ccp_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl, xseg,yseg
+int	i, curpl_pt, nsegpts
+int	len_p, segsize, lsize
+
+include	"ccp.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of number of drawing instructions since last frame clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polyline attributes if necessary.
+	pl = CCP_PLAP(g_cc)
+
+	if (CCP_LTYPE(g_cc) != PL_LTYPE(pl)) {
+	    call ccp_linetype (PL_LTYPE(pl))		# set g_ltype in ccp.com
+	    CCP_LTYPE(g_cc) = PL_LTYPE(pl)
+	}
+	if (CCP_WIDTH(g_cc) != PL_WIDTH(pl)) {
+	    if (GKI_UNPACKREAL(PL_WIDTH(pl)) < 1.5) {
+		CCP_WIDTH(g_cc) = GKI_PACKREAL(PL_SINGLE)
+	    } else 
+	        CCP_WIDTH(g_cc) = PL_WIDTH(pl)
+	}
+	if (CCP_COLOR(g_cc) != PL_COLOR(pl)) {
+	    call ccp_color (PL_COLOR(pl))
+	    CCP_COLOR(g_cc) = PL_COLOR(pl)
+	}
+
+	# If the overrides are on, or linetype is solid and linewidth is single,
+	# do simple move and draws:
+
+	if ((g_ltover && g_lwover) || (!g_lwover && g_lwtype == 'p') ||
+	    (g_ltype == GL_SOLID && CCP_WIDTH(g_cc) == GKI_PACKREAL(PL_SINGLE))
+	    || (g_ltover && CCP_WIDTH(g_cc) == GKI_PACKREAL(PL_SINGLE)) ||
+	    (g_ltype == GL_SOLID && g_lwover)) {
+
+	    if (g_lwtype == 'p') 
+		call newpen (PL_WIDTH(pl))
+
+	    call plot (XTRAN(p[1]), YTRAN(p[2]), CCP_UP)
+	    if (npts == 1) {
+		call plot (XTRAN(p[1]), YTRAN(p[2]), CCP_DOWN)
+	    } else {		# draw normally
+		do i = 3, len_p, 2 
+		    call plot (XTRAN(p[i]), YTRAN(p[i+1]), CCP_DOWN)
+	    }
+
+	    # Store maximum-x point plotted for a "newframe" in ccp_clear.
+	    do i = 1, len_p, 2
+		g_max_x = max (XTRAN(p[i]), g_max_x)
+
+
+	# Otherwise, must calculate individual segments of dashes and dots,
+	# keeping their lengths constant along polyline (ccp_calcseg), before 
+	# optionally simulating bold and drawing (ccp_drawseg):
+
+	} else {		# vector polyline; simulate linetype, linewidth
+
+	    segsize = SEGSIZE
+	    call malloc (xseg, segsize, TY_REAL)
+	    call malloc (yseg, segsize, TY_REAL)
+
+	    curpl_pt = 1
+	    lsize    = nint(GKI_UNPACKREAL(CCP_WIDTH(g_cc)))
+	    if (!g_ltover && (g_ltype >= GL_DASHED && g_ltype <= GL_DOTDASH)) {
+
+		while (curpl_pt <= npts) {
+		    call ccp_calcseg (p, npts, g_ltype, curpl_pt, segsize,
+		    		      xseg,yseg, nsegpts)
+		    call ccp_drawseg (Memr[xseg],Memr[yseg], nsegpts, lsize)
+		}
+
+	    } else {	# either (ltype override or solid line), not single wid.
+
+		call ccp_calcseg (p, npts, GL_SOLID, curpl_pt, segsize, xseg,
+		    yseg, nsegpts)
+		call ccp_drawseg (Memr[xseg],Memr[yseg], nsegpts, lsize)
+	    }
+
+	    call mfree (xseg, TY_REAL)
+	    call mfree (yseg, TY_REAL)
+	}
+
+end
diff --git a/sys/gio/calcomp/ccpplset.x b/sys/gio/calcomp/ccpplset.x
new file mode 100644
index 00000000..c118f93e
--- /dev/null
+++ b/sys/gio/calcomp/ccpplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure ccp_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"ccp.com"
+
+begin
+	pl = CCP_PLAP(g_cc)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = gki[GKI_PLSET_LW]
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/calcomp/ccppm.x b/sys/gio/calcomp/ccppm.x
new file mode 100644
index 00000000..bb6c783f
--- /dev/null
+++ b/sys/gio/calcomp/ccppm.x
@@ -0,0 +1,73 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <math.h>
+include	"ccp.h"
+
+define	DIAGSEP	(1.0 * g_plwsep / 0.7071068)	# dis at 40 degrees from plwsep
+
+# CCP_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs.
+
+procedure ccp_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+int	i, j, len_p
+real	theta, x, y, tx, ty
+include	"ccp.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polymarker attributes if necessary.
+
+	pm = CCP_PMAP(g_cc)
+
+	if (CCP_LTYPE(g_cc) != PM_LTYPE(pm)) {
+	    call ccp_linetype (PM_LTYPE(pm))
+	    CCP_LTYPE(g_cc) = PM_LTYPE(pm)
+	}
+	if (CCP_WIDTH(g_cc) != PM_WIDTH(pm)) 
+		CCP_WIDTH(g_cc) = PM_WIDTH(pm)
+
+	if (CCP_COLOR(g_cc) != PM_COLOR(pm)) {
+	    call ccp_color (PM_COLOR(pm))
+	    CCP_COLOR(g_cc) = PM_COLOR(pm)
+	}
+
+	# Draw the polymarker.
+	do i = 1, len_p, 2 {
+	    # Draw the single point as a box with a diagonal
+	    # through it.
+
+	    theta = 0.5 * HALFPI
+	    x = XTRAN(p[i])
+	    y = YTRAN(p[i+1])
+	    tx = x + DIAGSEP * cos (theta)
+	    ty = y + DIAGSEP * sin (theta)
+	    call plot (tx, ty, CCP_UP)
+	    g_max_x = max (tx, g_max_x)
+
+	    do j = 1, 4 {
+		theta = theta + HALFPI
+		tx = x + DIAGSEP * cos (theta)
+		ty = y + DIAGSEP * sin (theta)
+		call plot (tx, ty, CCP_DOWN)
+	    }
+
+	    # Fill in diagonal.
+	    tx = x + DIAGSEP * cos (theta + PI)
+	    ty = y + DIAGSEP * sin (theta + PI)
+	    call plot (tx, ty, CCP_DOWN)
+	}
+end
diff --git a/sys/gio/calcomp/ccppmset.x b/sys/gio/calcomp/ccppmset.x
new file mode 100644
index 00000000..2f3f5534
--- /dev/null
+++ b/sys/gio/calcomp/ccppmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_PMSET -- Set the polymarker attributes.
+
+procedure ccp_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"ccp.com"
+
+begin
+	pm = CCP_PMAP(g_cc)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = gki[GKI_PMSET_MW]
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/calcomp/ccpreset.x b/sys/gio/calcomp/ccpreset.x
new file mode 100644
index 00000000..7d4514f6
--- /dev/null
+++ b/sys/gio/calcomp/ccpreset.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	<gset.h>
+include	"ccp.h"
+
+# CCP_RESET -- Reset the state of the transform common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure ccp_reset()
+
+pointer	pl, pm, fa, tx
+include	"ccp.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = CCP_PLAP(g_cc)
+	pm = CCP_PMAP(g_cc)
+	fa = CCP_FAAP(g_cc)
+	tx = CCP_TXAP(g_cc)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	= GL_SOLID
+	PL_WIDTH(pl)	= GKI_PACKREAL(PL_SINGLE)
+	PL_COLOR(pl)	= 1
+	PM_LTYPE(pm)	= GL_SOLID
+	PM_WIDTH(pm)	= GKI_PACKREAL(PL_SINGLE)
+	PM_COLOR(pm)	= 1
+	TX_UP(tx)	= 90
+	TX_SIZE(tx)	= GKI_PACKREAL(1.)
+	TX_PATH(tx)	= GT_RIGHT
+	TX_HJUSTIFY(tx)	= GT_LEFT
+	TX_VJUSTIFY(tx)	= GT_BOTTOM
+	TX_FONT(tx)	= GT_ROMAN
+	TX_COLOR(tx)	= 1
+	TX_SPACING(tx)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	CCP_LTYPE(g_cc)		= -1
+	CCP_WIDTH(g_cc)		= -1
+	CCP_COLOR(g_cc)		= -1
+	CCP_TXSIZE(g_cc)	= -1
+	CCP_TXFONT(g_cc)	= -1
+end
diff --git a/sys/gio/calcomp/ccptx.x b/sys/gio/calcomp/ccptx.x
new file mode 100644
index 00000000..b93b5223
--- /dev/null
+++ b/sys/gio/calcomp/ccptx.x
@@ -0,0 +1,463 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"ccp.h"
+
+define	BASECS_X	12	# Base (size 1.0) char width in GKI coords.
+define	BASECS_Y	12	# Base (size 1.0) char height in GKI coords.
+
+
+# CCP_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.
+
+procedure ccp_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+real	g_dx, g_dy			# scale GKI to window coords
+int	g_x1, g_y1			# origin of device window
+int	g_x2, g_y2			# upper right corner of device window
+real	x, y, dx, dy, tsz, xto_nicesize, yto_nicesize
+int	x1, x2, y1, y2, orien
+int	x0, y0, gki_dx, gki_dy, ch, cw
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen, quality
+pointer	sp, seg, ip, op, tx, first, pl
+int	ccx_segment()
+include	"ccp.com"
+
+data	g_dx /1.0/, g_dy /1.0/
+data	g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Set pointer to the text attribute structure.
+	tx = CCP_TXAP(g_cc)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  The text size was
+	# set by ccp_txset, and is just a scaling factor.
+
+	CCP_TXSIZE(g_cc) = TX_SIZE(tx)
+	if (TX_COLOR(tx) != CCP_COLOR(g_cc)) {
+	    call ccp_color (TX_COLOR(tx))
+	    CCP_COLOR(g_cc) = TX_COLOR(tx)
+	}
+
+	# Set the character-generator quality.  Only low (Calcomp "symbol")
+	# and other (ccp_font; see NSPP doc. on its font) are supported.
+	if (g_txquality == 0) {
+	    quality = TX_QUALITY(tx)	# param was specified "normal" to task
+	} else
+	    quality = g_txquality	# param was explicit to task
+
+	# Set the linetype to a solid line, and invalidate last setting.
+	call ccp_linetype (GL_SOLID)	# for use in ccp_polyline
+	CCP_LTYPE(g_cc) = -1		# PL_LTYPE still contains current settng
+
+	# Set pointer to polyline attribute structure and set line width
+	# if necessary.
+	pl = CCP_PLAP(g_cc)
+
+	if (CCP_WIDTH(g_cc) != PL_WIDTH(pl)) {
+	    if (GKI_UNPACKREAL(PL_WIDTH(pl)) < 1.5) {
+		CCP_WIDTH(g_cc) = GKI_PACKREAL(PL_SINGLE)
+	    } else
+	        CCP_WIDTH(g_cc) = PL_WIDTH(pl)
+	}
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = ccx_segment (text, n, Memc[seg], TX_FONT(tx))
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call ccx_parameters (xc,yc, totlen, x0,y0, gki_dx,gki_dy, polytext,
+	    orien)
+
+	# Scale the base sizes.
+	tsz = GKI_UNPACKREAL(TX_SIZE(tx))	# scale factor
+	ch = CCP_CHARHEIGHT(g_cc,1) * tsz
+	cw = CCP_CHARWIDTH(g_cc,1) * tsz
+
+	# Compute correction factors for absolute physical character sizes.
+	# This also corrects for distortion of high-qual text if xscale<>yscale.
+	xto_nicesize = g_xdefault_scale / g_xndcto_p
+	yto_nicesize = g_ydefault_scale / g_yndcto_p
+
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+
+	x  = x0 * g_dx + g_x1
+	y  = y0 * g_dy + g_y1
+	dx = gki_dx * g_dx
+	dy = gki_dy * g_dy
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x
+		    x2 = x1 + cw * xto_nicesize
+		    y1 = y
+		    y2 = y1 + ch * yto_nicesize
+
+		    if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x
+		    x2 = x1 + cw * xto_nicesize
+		    y1 = y
+		    y2 = y1 + ch * yto_nicesize
+
+		    if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    call ccp_drawchar (Memc[ip], nint(x), nint(y), cw, ch,
+			orien, font, quality)
+		    ip = ip + 1
+		    seglen = seglen - 1
+		    x = x + dx
+		    y = y + dy
+		}
+
+		x = newx
+		y = newy
+		ip = op
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# CCX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure ccx_segment (text, n, out, start_font)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+
+int	ip, op
+int	totlen, font
+
+begin
+	out[1] = start_font
+	totlen = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# CCX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure ccx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+int	up, path
+real	dir, sz, ch, cw, cosv, sinv, space, xto_nicesize, yto_nicesize
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q, xtmp, ytmp
+include	"ccp.com"
+
+begin
+	tx = CCP_TXAP(g_cc)
+
+	# Compute correction factors for absolute physical character sizes.
+	# This also removes any warping due to different xscale, yscale.
+	xto_nicesize = g_xdefault_scale / g_xndcto_p
+	yto_nicesize = g_ydefault_scale / g_yndcto_p
+
+	# Get character sizes in GKI(plotter) coords; scale y (ch) dimension
+	# to that of x for absolute scale systems that are different in x,y.
+
+	sz = GKI_UNPACKREAL (TX_SIZE(tx))
+	ch = CCP_CHARHEIGHT(g_cc,1) * sz
+	cw = CCP_CHARWIDTH(g_cc,1) * sz
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated and unscaled).
+	space = (1.0 + TX_SPACING(tx))
+	if (path == GT_UP || path == GT_DOWN)
+	    p = ch * space
+	else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation, scaling differences, and absolute size.
+	dx = ( p * cosv + q * sinv) * xto_nicesize 
+	dy = (-p * sinv + q * cosv) * yto_nicesize
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	xvlen = dx * (totlen - 1)
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character size in X and Y.
+	xsize = abs ( cw * cosv + ch * sinv) * xto_nicesize
+	ysize = abs (-cw * sinv + ch * cosv) * yto_nicesize
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	xtmp = ( p * cosv + q * sinv) * xto_nicesize 
+	ytmp = (-p * sinv + q * cosv) * yto_nicesize
+
+	x0 = x0 + xtmp
+	y0 = y0 + ytmp
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
diff --git a/sys/gio/calcomp/ccptxset.x b/sys/gio/calcomp/ccptxset.x
new file mode 100644
index 00000000..f2f4f040
--- /dev/null
+++ b/sys/gio/calcomp/ccptxset.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"ccp.h"
+
+# CCP_TXSET -- Set the text drawing attributes.
+
+procedure ccp_txset (gki)
+
+short	gki[ARB]		# attribute structure
+
+pointer	tx
+include	"ccp.com"
+
+begin
+	tx = CCP_TXAP(g_cc)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+	TX_SIZE(tx)     = gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/calcomp/doc/ccpspecs.hlp b/sys/gio/calcomp/doc/ccpspecs.hlp
new file mode 100644
index 00000000..fae12e4e
--- /dev/null
+++ b/sys/gio/calcomp/doc/ccpspecs.hlp
@@ -0,0 +1,384 @@
+.help
+\fBSpecifications for IRAF Calcomp kernel -- (CCP package)\fR
+
+
+The Calcomp kernel (package prefix "ccp") will implement selected GKI 
+instructions, using only calls to the Calcomp routines \fBplots\fR, 
+\fBplot\fR, \fBnewpen\fR and \fBsymbol\fR.
+
+
+There are two sub-components of the CCP package:  1) the kernel driver
+task allowing a user to send a specified graphics metafile to the plotter, and
+2) the low-level kernel routines which implement specific GKI instructions,
+and which make the only calls to the Calcomp library.
+
+
+.nh
+\fBCL interface -- task CALCOMP\fR
+
+
+The driver task, \fBcalcomp\fR, allows a user to direct an existing GKI metacode
+file to a particular Calcomp plotter under control of a set of CL parameters.
+The task is loaded either by being run directly from the CL as a task, or by
+being invoked through inter-process control following a write-to-pseudofile
+containing the GKI_OPENWS metacode instruction.  The task may 
+optionally control certain kinds of debug output.
+
+.nf
+CL parameters to the kernel driver task \fBcalcomp\fR:
+
+input,s,a,,,,"input metacode file"
+device,s,h,"calcomp",,,"output device"
+generic,b,h,no,,,"ignore remaining kernel dependent parameters"
+debug,b,h,no,,,"print decoded graphics instructions during processing"
+verbose,b,h,no,,,"print elements of polylines, etc. in debug mode"
+gkiunits,b,h,no,,,"print coordinates in GKI rather than NDC units"
+xscale,r,h,INDEF,0.0,,"plotter x = GKI_NDC_X * xscale"
+yscale,r,h,INDEF,0.0,,"plotter y = GKI_NDC_Y * yscale"
+txquality,s,h,"normal","normal|low|high",,"character quality; n=from metacode"
+lwtype,s,h,"ntracing","ntracing|penchange",,"bold line/text implementation"
+ltover,b,h,no,,,"override line type simulation"
+lwover,b,h,no,,,"override line width simulation"
+lcover,b,h,no,,,"override line color implementation by penchange"
+dashlen,r,h,INDEF,0.0,,"dashed line dash length, pltr units; 0.5 reasonable"
+gaplen,r,h,INDEF,0.0,,"dashed line gap length, pltr units; 0.1 reasonable"
+plwsep,r,hl,INDEF,0.,,"polyline width separation for ntracing; 0.005 reasonable"
+
+.fi
+
+
+.nh
+\fBSuggested GRAPHCAP entry for calcomp plotter\fR
+
+.nf
+
+    p5|calcomp|calcomp pen plotter:\
+	    :kf=xcalcomp.e:tn=calcomp:co#132:li#66:xr#32767:yr#5375:\
+	    :ch#.0294:cw#.0125:xs#1.664564:ys#0.27305:\
+	    :PU=inches:MP#.0254:DL#.50:GL#.10:PW#.005:\
+	    :DD=plot!calcomp,/tmp/gcaXXXXXX,\
+	    !{ cd /tmp; nice /local/bin/plotX -Tcalcomp -W=1 $F |\
+	    nice /usr/bin/plot  -Tcalcomp; rm $F; }&:
+
+    #xs	1.664564	# maximum x in meters; max at .002 inches step size
+    #ys	.27305000	# maximum y in meters; 10.75 inch paper
+    #xr	32767		# max resolution in x; limited by GKI short int coords
+    #yr	5375		# max resolution in y; 10.75 inches at .002 inches step
+    #PU	inches		# plotter units
+    #MP	0.0254		# meters per plotter unit 
+    #DL	0.5000		# dash length in plotter units
+    #GL	0.1000		# gap length in plotter units
+    #PW	0.0050		# n-tracing (bold line simul.) width sep. in pltr units
+    #if yscale not set by kernel, g_yndcto_p = GKI_MAXNDC/(MP*yr); 32767/10.75"
+    #if xscale not set by kernel, g_xndcto_p = g_yndcto_p; square aspect ratio
+
+.fi
+
+
+.nh
+\fBInterface between CALCOMP task and lower-level kernel routines\fR
+
+
+Two kernel routines will normally be called from outside the GKI
+instruction-stream decoding facility (as from the driver task):
+
+.nf
+     ccp_open (devname, dd)
+
+          devname:    device name of desired Calcomp plotter (must have 
+                      entry in graphcap file)
+
+          dd:         array of entry point addresses to lower-level kernel 
+                      routines 
+
+          discussion: linking to multiple Calcomp plotters is a 
+		      site-dependent function.  Ordinarily devname is 
+		      ignored; if this kernel is called, output will go 
+		      to the device initialized by the Calcomp library.  
+		      See ccp_openws.
+
+
+     ccp_close ()
+
+	  discussion: causes a Calcomp "newframe" -- resets origin to 
+		      right of last previously-plotted point.
+
+
+.fi
+.nh
+\fBLow-level kernel routines\fR
+
+
+All remaining kernel routines will normally be called either by ccp_open or
+by gki_execute, or by each other.  Following are descriptions of the 
+implementation of GKI instructions:
+.nf
+
+     GKI_EOF
+
+          Not implemented; it should be trapped outside the kernel, as in
+          \fBgki_execute\fR.
+
+     GKI_OPENWS
+
+          ccp_openws (devname, len_devname, mode)
+
+               devname; len_devname:
+
+                    name of plotter, name length, if not present in metafile
+
+               mode:
+
+                    file access mode for gki metafile; if NEWFILE, a Calcomp
+		    "newframe" (reorigin to right of previous plot) will
+		    occur; if APPEND mode, no newframe.
+
+               discussion:
+
+                    There is no output metafile; device connection and any 
+		    site-specific spooling is handled below this level.  
+		    Note that there must be a graphcap entry for devname.
+
+     GKI_CLOSEWS
+
+          ccp_closews ()
+
+               discussion:
+
+                    As there is no output metafile, this is a noop.
+
+     GKI_REACTIVATEWS
+
+          Not implemented.
+
+     GKI_DEACTIVATEWS
+
+          Not implemented.
+
+     GKI_MFTITLE
+
+          Not implemented.
+
+     GKI_CLEARWS
+
+          ccp_clear ()
+
+               discussion:
+
+                    Implemented only by a Calcomp "newframe"; there is no 
+		    output metacode file for spooling at this level.
+
+     GKI_CANCEL
+
+          Not implemented, since there is no buffered output.
+
+     GKI_FLUSH
+
+          Not implemented.
+
+     GKI_POLYLINE
+
+          ccp_polyline (p, npts)
+
+               p:          array of points (x1, y1, x2, y2, ...)
+
+               npts:       number of pairs
+
+               discussion: 
+
+		    To GKI, ccp_polyline will appear pretty normal; due to 
+		    the lack of settable parameters like dashed-line in 
+		    Calcomp, such features are implemented in further layers
+		    between ccp_polyline and the actual Calcomp vector-draw 
+		    routine.  See kernel task parameters lwtype, lwover, and
+		    ltover for line width and type control.
+
+     GKI_POLYMARKER
+
+          ccp_polymarker (p, npts)
+
+               arguments:  same as above
+
+               discussion: 
+
+		    Ccp_polymarker will merely dot the location at the
+		    coordinate passed in; more complicated marker 
+		    symbols will be assumed to have been handled above, for 
+		    purposes of clipping, and will be drawn with ccp_polyline 
+		    at this level.
+
+     GKI_TEXT
+
+          ccp_text (x, y, text, nchar)
+
+               x, y:
+
+                    NDC coordinates of text stream; note that the JUSTIFY 
+		    parameters in GSET determine where these coordinates are 
+		    relative to the text characters.
+
+               text: array of type short characters
+
+               nchar: number of chars in text
+
+               discussion:
+
+		    The same levels of text quality will be supported as in
+		    the stdgraph kernel; normal is taken from the metacode
+		    request, medium and high fonts are stroke text, while low 
+		    quality is Calcomp hardware text.  Depending on the
+		    particular plotter controller at each site, low quality
+		    text may or may not be significantly faster than stroke
+		    text.
+		    
+		    The special Calcomp symbols numbered 0 - 15 in the 
+		    Calcomp symbol library are invoked by characters with 
+		    ASCII values 0 - 15.  When using hardware text generation,
+		    the ASCII symbol requested will be mapped to the Calcomp 
+		    set if possible; otherwise, a default "indefinite" character
+		    will appear.
+
+     GKI_FILLAREA
+
+          ccp_fillarea (p, npts)
+
+               p, npts: same as above for ccp_polyline
+
+               discussion:
+
+                    With Calcomp, fillarea could only be implemented by 
+		    simulating with hatching patterns, a time-consuming 
+		    process for a pen plotter.  We may or may not choose 
+		    to do this, depending upon users' needs.  For the 
+		    very similar Versaplot kernel which may follow, it 
+		    should definitely be implemented, using Versaplot's 
+		    \fBtone\fR call.  Initially, it will only be implemented
+		    here with a call to ccp_polyline for the border.
+
+     GKI_PUTCELLARRAY
+
+	  Not implemented.
+
+     GKI_SETCURSOR
+
+          Not implemented.
+
+     GKI_PLSET
+
+          ccp_plset (gki)
+
+               gki: attribute structure decoded by gki
+
+               discussion:
+
+		    Line types documented in the GIO manual will be 
+		    implemented in software except for "erase", unless the 
+		    CL parameter to the CALCOMP task "ltover" is on, in 
+		    which case all lines drawn will be solid.  See task 
+		    parameters dash and gap.  In the future, line types
+		    numbered higher than 4 may be implemented using various
+		    combinations of dashes and dots as in Morse code.  Line
+		    width and color may be similarly implemented or overridden;
+		    if not overridden, line width will be done by default using
+		    n-tracing (n = nearest integer value of line width) or by a
+		    penchange, under control of task parameter "lwtype".
+
+     GKI_PMSET
+
+          ccp_pmset (gki)
+
+               gki, discussion: Same as for ccp_plset.
+
+     GKI_TXSET
+
+          ccp_txset (gki)
+
+               gki, discussion:
+
+                    Internal flags are set from structure gki controlling 
+		    text up vector, path relative to up vector, horizontal 
+		    and vertical justification, font, quality, color, 
+		    spacing, and size.  For high-quality text, all flags are
+		    implemented (color by a pen change, with optional 
+                    override); see GKI_TEXT discussion.
+
+     GKI_FASET
+
+          ccp_faset (gki)
+
+               gki, discussion:
+
+                    Internal flags are set for fill area style and color.  
+		    If we decide to implement fill area in software (the only
+		    way for Calcomp), we will use GKS conventions wherever
+		    possible.
+
+     GKI_GETCURSOR
+
+	  Not implemented.  The Calcomp \fBwhere\fR routine would only 
+	  duplicate GCURPOS in GIO.
+
+     GKI_CURSORVALUE
+
+          Not implemented; not an interactive device.
+
+     GKI_GETCELLARRAY
+
+          Not implemented; not a storage device.
+
+     GKI_CELLARRAY
+
+          Not implemented.
+
+     GKI_ESCAPE
+
+          ccp_escape (fn, instruction, nwords)
+
+               fn: escape function code
+
+               instruction, nwords:
+
+                    Nwords-long array of short integers containing the 
+		    instruction sequence.
+
+               discussion:
+
+		    A high-level task may pass the NDC-to-plotter units
+		    coordinate scaling factor down into the kernel to 
+		    permit exact scaling.  The scale factors will be 
+		    set in common to allow fast access by the ccp_draw 
+		    routine.
+                    
+		    GKI_ESCAPE = BOI 25 L FN N DC
+			
+			L(i)	5 + N
+			FN(i)	escape function code
+			N(i)	number of escape data words
+			DC(i)	escape data words
+
+			1) xndc_to_plotter:
+
+			   FN = ESC_XNDCTO_P (currently = 1 in ccp.h)
+			   N  = number of characters in the scale specification
+			   DC = array of N short integers containing character-
+				packed scale (must be achtsc'd then ctod'd to 
+				get x scale)
+
+			2) yndc_to_plotter:
+
+			   FN = ESC_YNDCTO_P (currently = 2 in ccp.h)
+			   N  = same as in (1)
+			   DC = same as in (1)
+
+		    The macros ESC_*NDCTO_P, currently defined in ccp.h, should
+		    probably be defined in a gki-public place like gki.h.
+
+
+     GKI_SETWCS
+
+          Not implemented.
+
+     GKI_GETWCS
+
+          Not implemented.
+.fi
diff --git a/sys/gio/calcomp/font.com b/sys/gio/calcomp/font.com
new file mode 100644
index 00000000..ec1b0ec9
--- /dev/null
+++ b/sys/gio/calcomp/font.com
@@ -0,0 +1,207 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each character
+# is encoded as a series of strokes.  Each stroke is expressed by a single
+# integer containing the following bitfields:
+#
+#	2                   1
+#	0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 
+#	          | | | |         | |         |
+#		  | | | +---------+ +---------+
+#		  | | |      |           |
+#		  | | |      X           Y
+#		  | | |
+#	          | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#------------------------------------------------------------------------------
+
+# Define the database.
+
+short	chridx[96]		# character index in chrtab
+short	chrtab[800]		# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP).
+
+data    (chridx(i), i=01,05) /   1,   3,  12,  21,  30/
+data    (chridx(i), i=06,10) /  45,  66,  79,  85,  92/
+data    (chridx(i), i=11,15) /  99, 106, 111, 118, 121/
+data    (chridx(i), i=16,20) / 128, 131, 141, 145, 154/
+data    (chridx(i), i=21,25) / 168, 177, 187, 199, 203/
+data    (chridx(i), i=26,30) / 221, 233, 246, 259, 263/
+data    (chridx(i), i=31,35) / 268, 272, 287, 307, 314/
+data    (chridx(i), i=36,40) / 327, 336, 344, 352, 359/
+data    (chridx(i), i=41,45) / 371, 378, 385, 391, 398/
+data    (chridx(i), i=46,50) / 402, 408, 413, 425, 433/
+data    (chridx(i), i=51,55) / 445, 455, 468, 473, 480/
+data    (chridx(i), i=56,60) / 484, 490, 495, 501, 506/
+data    (chridx(i), i=61,65) / 511, 514, 519, 523, 526/
+data    (chridx(i), i=66,70) / 529, 543, 554, 563, 574/
+data    (chridx(i), i=71,75) / 585, 593, 607, 615, 625/
+data    (chridx(i), i=76,80) / 638, 645, 650, 663, 671/
+data    (chridx(i), i=81,85) / 681, 692, 703, 710, 723/
+data    (chridx(i), i=86,90) / 731, 739, 743, 749, 754/
+data    (chridx(i), i=91,95) / 759, 764, 776, 781, 793/
+data    (chridx(i), i=96,96) / 801/
+
+# Stroke data.
+
+data	(chrtab(i), i=001,005) /    36,  1764,   675, 29328,   585/
+data	(chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/
+data	(chrtab(i), i=011,015) /  1764,   355, 29023,   351, 29027/
+data	(chrtab(i), i=016,020) /   931, 29599,   927, 29603,  1764/
+data	(chrtab(i), i=021,025) /   603, 29066,   842, 29723,  1302/
+data	(chrtab(i), i=026,030) / 28886,   143, 29839,  1764,   611/
+data	(chrtab(i), i=031,035) / 29256,    78, 20810, 21322, 21581/
+data	(chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/
+data	(chrtab(i), i=041,045) / 20833, 21345, 29789,  1764,   419/
+data	(chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/
+data	(chrtab(i), i=051,055) / 21022, 21025, 20899,  1187, 28744/
+data	(chrtab(i), i=056,060) /   717, 21194, 21320, 21512, 21642/
+data	(chrtab(i), i=061,065) / 21645, 21519, 21327, 21197,  1764/
+data	(chrtab(i), i=066,070) /  1160, 20700, 20704, 20835, 21027/
+data	(chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/
+data	(chrtab(i), i=076,080) / 21192, 29841,  1764,   611, 21023/
+data	(chrtab(i), i=081,085) / 21087, 21155, 21091,  1764,   739/
+data	(chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/
+data	(chrtab(i), i=091,095) /  1764,   547, 21151, 21210, 21201/
+data	(chrtab(i), i=096,100) / 21132, 29192,  1764,    93, 29774/
+data	(chrtab(i), i=101,105) /   608, 29259,    78, 29789,  1764/
+data	(chrtab(i), i=106,110) /   604, 29260,    84, 29780,  1764/
+data	(chrtab(i), i=111,115) /   516, 21062, 21065, 21001, 21000/
+data	(chrtab(i), i=116,120) / 21064,  1764,    84, 29780,  1764/
+data	(chrtab(i), i=121,125) /   585, 21063, 21191, 21193, 21065/
+data	(chrtab(i), i=126,130) / 21191,  1764,    72, 29859,  1764/
+data	(chrtab(i), i=131,135) /   419, 20573, 20558, 20872, 21320/
+data	(chrtab(i), i=136,140) / 21646, 21661, 21347, 20899,  1764/
+data	(chrtab(i), i=141,145) /   221, 21155, 29320,  1764,    95/
+data	(chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/
+data	(chrtab(i), i=151,155) / 20552, 29832,  1764,    95, 20899/
+data	(chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/
+data	(chrtab(i), i=161,165) /   854,  5266, 21644, 21320, 20872/
+data	(chrtab(i), i=166,170) / 28749,  1764,   904, 21411, 21283/
+data	(chrtab(i), i=171,175) / 20561, 20559, 21391,   911, 13455/
+data	(chrtab(i), i=176,180) /  1764,   136, 21320, 21645, 21652/
+data	(chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/
+data	(chrtab(i), i=186,190) /  1764,    83, 20888, 21336, 21651/
+data	(chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/
+data	(chrtab(i), i=196,200) / 20635, 29347,  1764,    99, 21667/
+data	(chrtab(i), i=201,205) / 29064,  1764,   355, 20575, 20570/
+data	(chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/
+data	(chrtab(i), i=211,215) / 21644, 21650, 21398, 20822,   918/
+data	(chrtab(i), i=216,220) /  5274, 21663, 21411, 20835,  1764/
+data	(chrtab(i), i=221,225) /   648, 21584, 21656, 21662, 21347/
+data	(chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/
+data	(chrtab(i), i=231,235) / 21656,  1764,   602, 21210, 21207/
+data	(chrtab(i), i=236,240) / 21079, 21082, 21207,   592, 21069/
+data	(chrtab(i), i=241,245) / 21197, 21200, 21072, 21197,  1764/
+data	(chrtab(i), i=246,250) /   602, 21146, 21143, 21079, 21082/
+data	(chrtab(i), i=251,255) / 21143,   585, 21132, 21136, 21072/
+data	(chrtab(i), i=256,260) / 21071, 21135,  1764,   988, 20628/
+data	(chrtab(i), i=261,265) / 29644,  1764,  1112, 28824,   144/
+data	(chrtab(i), i=266,270) / 29776,  1764,   156, 21460, 28812/
+data	(chrtab(i), i=271,275) /  1764,   221, 20704, 20899, 21218/
+data	(chrtab(i), i=276,280) / 21471, 21466, 21011, 21007,   521/
+data	(chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/
+data	(chrtab(i), i=286,290) /  1764,   908, 20812, 20560, 20571/
+data	(chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/
+data	(chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/
+data	(chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/
+data	(chrtab(i), i=306,310) /  1764,    72, 20963, 21219, 29768/
+data	(chrtab(i), i=311,315) /   210,  5074,  1764,    99, 21411/
+data	(chrtab(i), i=316,320) / 21663, 21658, 21398, 20566,   918/
+data	(chrtab(i), i=321,325) /  5266, 21644, 21384, 20552, 20579/
+data	(chrtab(i), i=326,330) /  1764,  1165, 21320, 20872, 20557/
+data	(chrtab(i), i=331,335) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=336,340) /    99, 21347, 21662, 21645, 21320/
+data	(chrtab(i), i=341,345) / 20552, 20579,  1764,    99, 20552/
+data	(chrtab(i), i=346,350) / 29832,    86, 13078,    99, 29859/
+data	(chrtab(i), i=351,355) /  1764,    99, 20552,    86, 13078/
+data	(chrtab(i), i=356,360) /    99, 29859,  1764,   722, 21650/
+data	(chrtab(i), i=361,365) / 29832,  1165,  4936, 20872, 20557/
+data	(chrtab(i), i=366,370) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=371,375) /    99, 28744,    85,  5269,  1160/
+data	(chrtab(i), i=376,380) / 29859,  1764,   291, 29603,   611/
+data	(chrtab(i), i=381,385) /  4680,   328, 29576,  1764,    77/
+data	(chrtab(i), i=386,390) / 20872, 21256, 21581, 29795,  1764/
+data	(chrtab(i), i=391,395) /    99, 28744,  1160, 20887,    82/
+data	(chrtab(i), i=396,400) / 13475,  1764,    99, 20552, 29832/
+data	(chrtab(i), i=401,405) /  1764,    72, 20579, 21077, 21603/
+data	(chrtab(i), i=406,410) / 29768,  1764,    72, 20579, 21640/
+data	(chrtab(i), i=411,415) / 29859,  1764,    94, 20899, 21347/
+data	(chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/
+data	(chrtab(i), i=421,425) / 20574,   862, 29859,  1764,    72/
+data	(chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/
+data	(chrtab(i), i=431,435) / 20564,  1764,    94, 20557, 20872/
+data	(chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/
+data	(chrtab(i), i=441,445) / 20574,   536, 29828,  1764,    72/
+data	(chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/
+data	(chrtab(i), i=451,455) / 20566,   918, 13448,  1764,    76/
+data	(chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/
+data	(chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/
+data	(chrtab(i), i=466,470) / 29855,  1764,   648, 21155,    99/
+data	(chrtab(i), i=471,475) / 29923,  1764,    99, 20557, 20872/
+data	(chrtab(i), i=476,480) / 21320, 21645, 29859,  1764,    99/
+data	(chrtab(i), i=481,485) / 21064, 29795,  1764,    99, 20808/
+data	(chrtab(i), i=486,490) / 21141, 21448, 29923,  1764,    99/
+data	(chrtab(i), i=491,495) / 29832,    72, 29859,  1764,    99/
+data	(chrtab(i), i=496,500) / 21079, 29256,   599, 13411,  1764/
+data	(chrtab(i), i=501,505) /    99, 21667, 20552, 29832,  1764/
+data	(chrtab(i), i=506,510) /   805, 20965, 20935, 29447,  1764/
+data	(chrtab(i), i=511,515) /    99, 29832,  1764,   421, 21221/
+data	(chrtab(i), i=516,520) / 21191, 29063,  1764,   288, 21091/
+data	(chrtab(i), i=521,525) / 29600,  1764,     3, 29891,  1764/
+data	(chrtab(i), i=526,530) /   547, 29341,  1764,   279, 21207/
+data	(chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/
+data	(chrtab(i), i=536,540) / 20558, 20753, 21201, 21391,   907/
+data	(chrtab(i), i=541,545) / 13447,  1764,    99, 28744,    76/
+data	(chrtab(i), i=546,550) /  4424, 21256, 21516, 21523, 21271/
+data	(chrtab(i), i=551,555) / 20823, 20563,  1764,   981, 21271/
+data	(chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/
+data	(chrtab(i), i=561,565) / 29642,  1764,  1043,  4887, 20823/
+data	(chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=571,575) /  1032, 29731,  1764,    80,  5136/
+data	(chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/
+data	(chrtab(i), i=581,585) / 20808, 21256, 29707,  1764,   215/
+data	(chrtab(i), i=586,590) / 29591,   456, 20958, 21153, 21409/
+data	(chrtab(i), i=591,595) / 29727,  1764,    67, 20800, 21248/
+data	(chrtab(i), i=596,600) / 21508, 29719,  1043, 21271, 20823/
+data	(chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=606,610) /  1764,    99, 28744,    83,  4439/
+data	(chrtab(i), i=611,615) / 21271, 21523, 29704,  1764,   541/
+data	(chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=621,625) /   533, 21077, 29256,  1764,   541/
+data	(chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=631,635) /   533, 21077, 21058, 20928, 20736/
+data	(chrtab(i), i=636,640) / 28802,  1764,    99, 28744,    84/
+data	(chrtab(i), i=641,645) / 29530,   342, 13320,  1764,   483/
+data	(chrtab(i), i=646,650) / 21089, 21066, 29384,  1764,    87/
+data	(chrtab(i), i=651,655) / 28744,   584, 21076,    84,  4375/
+data	(chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/
+data	(chrtab(i), i=661,665) / 29768,  1764,    87, 28744,    83/
+data	(chrtab(i), i=666,670) / 20823, 21271, 21523, 29704,  1764/
+data	(chrtab(i), i=671,675) /    83, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=676,680) / 21523, 21271, 20823, 20563,  1764/
+data	(chrtab(i), i=681,685) /    87, 28736,    83, 20823, 21271/
+data	(chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/
+data	(chrtab(i), i=691,695) /  1764,  1047, 29696,  1036, 21256/
+data	(chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/
+data	(chrtab(i), i=701,705) / 21523,  1764,    87, 28744,    83/
+data	(chrtab(i), i=706,710) / 20823, 21271, 29716,  1764,    74/
+data	(chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/
+data	(chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/
+data	(chrtab(i), i=721,725) / 21461,  1764,   279, 29591,   970/
+data	(chrtab(i), i=726,730) / 21320, 21128, 21002, 21025,  1764/
+data	(chrtab(i), i=731,735) /    87, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=736,740) /  1032, 29719,  1764,   151, 21064/
+data	(chrtab(i), i=741,745) / 29719,  1764,    87, 20808, 21077/
+data	(chrtab(i), i=746,750) / 21320, 29783,  1764,   151, 29704/
+data	(chrtab(i), i=751,755) /   136, 29719,  1764,    87, 21064/
+data	(chrtab(i), i=756,760) /   320, 29783,  1764,   151, 21527/
+data	(chrtab(i), i=761,765) / 20616, 29704,  1764,   805, 21157/
+data	(chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/
+data	(chrtab(i), i=771,775) / 21011, 21001, 21127, 21255,  1764/
+data	(chrtab(i), i=776,780) /   611, 29273,   594, 29256,  1764/
+data	(chrtab(i), i=781,785) /   485, 21093, 21218, 21209, 21271/
+data	(chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/
+data	(chrtab(i), i=791,795) / 29127,  1764,    83, 20758, 20950/
+data	(chrtab(i), i=796,800) / 21265, 21457, 29844,  1764,     0/
diff --git a/sys/gio/calcomp/font.h b/sys/gio/calcomp/font.h
new file mode 100644
index 00000000..c33dc6ee
--- /dev/null
+++ b/sys/gio/calcomp/font.h
@@ -0,0 +1,29 @@
+# NCAR font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/calcomp/mkpkg b/sys/gio/calcomp/mkpkg
new file mode 100644
index 00000000..f4b7f8b9
--- /dev/null
+++ b/sys/gio/calcomp/mkpkg
@@ -0,0 +1,52 @@
+# Make the CALCOMP GIO graphics kernel.  Requires the host system library
+# LIB_CALCOMP, which must be callable from an IRAF program (which is not the
+# same as a Fortran program).
+
+$checkout libccp.a lib$
+$update   libccp.a
+$checkin  libccp.a lib$
+$call     relink
+$exit
+
+update:					# update lib$x_calcomp.e
+	$call	relink
+	$call	install
+	;
+
+relink:					# make x_calcomp.e in local directory
+	$omake  x_calcomp.x
+	$link	x_calcomp.o -lccp $(LIB_CALCOMP)
+	;
+
+install:				# install in system library
+	$move	x_calcomp.e bin$
+	;
+
+libccp.a:
+	ccpclear.x	ccp.com ccp.h <mach.h>
+	ccpclose.x	ccp.com ccp.h
+	ccpclws.x	ccp.com ccp.h
+	ccpcolor.x	ccp.com ccp.h
+	ccpcseg.x	ccp.com ccp.h <gki.h> <gset.h> <mach.h>
+	ccpdrawch.x	ccp.com ccp.h font.com font.h <gki.h> <gset.h>\
+			<math.h>
+	ccpdseg.x	ccp.com ccp.h <math.h>
+	ccpescape.x	ccp.com ccp.h <gescape.h>
+	ccpfa.x		ccp.com ccp.h
+	ccpfaset.x	ccp.com ccp.h <gki.h>
+	ccpfont.x	ccp.com ccp.h <gki.h> <gset.h>
+	ccpinit.x	ccp.com ccp.h <ctype.h> <gki.h> <mach.h>
+	ccpltype.x	ccp.com ccp.h <gset.h>
+	ccplwidth.x	ccp.com ccp.h
+	ccpopen.x	ccp.com ccp.h <gki.h>
+	ccpopenws.x	ccp.com ccp.h <error.h> <gki.h> <mach.h>
+	ccppl.x		ccp.com ccp.h <gki.h> <gset.h>
+	ccpplset.x	ccp.com ccp.h <gki.h>
+	ccppm.x		ccp.com ccp.h <gki.h> <math.h>
+	ccppmset.x	ccp.com ccp.h <gki.h>
+	ccpreset.x	ccp.com ccp.h <gset.h> <gki.h>
+	ccptx.x		ccp.com ccp.h <gki.h> <gset.h> <math.h>
+	ccptxset.x	ccp.com ccp.h <gki.h> <gset.h>
+	rptheta4.x	<math.h>
+	t_calcomp.x	<error.h> <gki.h> ccp.com ccp.h <gset.h> <mach.h>
+	;
diff --git a/sys/gio/calcomp/rptheta4.x b/sys/gio/calcomp/rptheta4.x
new file mode 100644
index 00000000..b2ee42b7
--- /dev/null
+++ b/sys/gio/calcomp/rptheta4.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math.h>
+
+define	PIOVER4		(0.25 * PI)
+define	THREEPIOVER4	(0.75 * TWOPI)
+
+# RPTHETA4 -- Polar angle, Real precision, 4 arguments; from p1(x,y) to p2(x,y):
+# angle between line segment p1-p2 and horizontal +x axis centered on p1; 
+# returned in radians; single precision (see pdtheta4).
+
+real procedure rptheta4 (p1x, p1y, p2x, p2y)
+
+real	p1x,p1y, p2x,p2y	# x,y of each point
+real	dx, dy, ang
+
+begin
+	dx = p2x - p1x
+	dy = p2y - p1y
+
+	if (dx == 0.0) {
+	    if (dy >= 0.0) {
+		ang = HALFPI
+	    } else {
+		ang = THREEPIOVER4
+	    }
+	} else {
+	    ang = atan (dy / dx)
+	    if (dx < 0.0) {		# 2nd or 3rd quadrant
+		ang = ang + PI
+	    } else if (dy < 0.0) {	# 4th quadrant
+		ang = ang + TWOPI
+	    }
+	}
+
+	return (ang)
+end
diff --git a/sys/gio/calcomp/t_calcomp.x b/sys/gio/calcomp/t_calcomp.x
new file mode 100644
index 00000000..0164d043
--- /dev/null
+++ b/sys/gio/calcomp/t_calcomp.x
@@ -0,0 +1,125 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+include <gset.h>
+include <mach.h>
+include "ccp.h"
+
+define	SZ_TXQUALITY	1
+
+# CALCOMP -- Graphics kernel for Calcomp pen plotter output.  The whole
+# package is copied as much as possible from the NSPP kernel.
+
+procedure t_calcomp()
+
+int	fd, list
+pointer	gki, sp, fname, devname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits
+char	txquality[SZ_TXQUALITY]
+bool	clgetb()
+char	clgetc()
+real	clgetr()
+int	clpopni(), clgfil(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+include "ccp.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+
+	if (clgetb ("generic")) {
+	    debug 	  = NO
+	    verbose 	  = NO
+	    gkiunits 	  = NO
+	    g_xtask_scale = INDEF
+	    g_xndcto_p 	  = INDEF
+	    g_ytask_scale = INDEF
+	    g_yndcto_p 	  = INDEF
+	    g_txquality   = 0
+	    g_lwtype	  = 'n'
+	    g_ltover      = false
+	    g_lwover      = true
+	    g_lcover      = false
+	    g_dashlen     = INDEF
+	    g_gaplen      = INDEF
+	    g_plwsep      = INDEF
+
+	} else {
+	    debug      = btoi (clgetb ("debug"))
+	    verbose    = btoi (clgetb ("verbose"))
+	    gkiunits   = btoi (clgetb ("gkiunits"))
+
+	    # scale precedence: calcomp.par->metacode->graphcap->compile_time
+	    g_xtask_scale = clgetr ("xscale")
+	    if (!IS_INDEF (g_xtask_scale))
+		g_xndcto_p = g_xtask_scale
+	    g_ytask_scale = clgetr ("yscale")
+	    if (!IS_INDEF (g_ytask_scale))
+		g_yndcto_p = g_ytask_scale
+
+	    # Get the quality parameter for the text generator.
+	    call clgstr ("txquality", txquality, SZ_TXQUALITY)
+	    switch (txquality[1]) {
+	    case 'l':
+		g_txquality = GT_LOW
+	    case 'm':
+		g_txquality = GT_MEDIUM
+	    case 'h':
+		g_txquality = GT_HIGH
+	    default:
+		g_txquality = 0			# .par default is "normal"
+	    }
+
+	    # Method of line width implementation:
+	    g_lwtype    = clgetc ("lwtype")
+
+	    # The overrides:
+	    g_ltover    = clgetb ("ltover")
+	    g_lwover    = clgetb ("lwover")
+	    g_lcover    = clgetb ("lcover")
+
+	    # Plotter line type, width control:
+	    g_dashlen   = clgetr ("dashlen")
+	    g_gaplen    = clgetr ("gaplen")
+	    g_plwsep    = clgetr ("plwsep")
+	}
+
+	# Open the graphics kernel.
+	call ccp_open (Memc[devname], dev)
+	call gkp_install (deb, STDERR, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF) {
+		if (debug == YES)
+		    call gki_execute (Mems[gki], deb)
+		call gki_execute (Mems[gki], dev)
+	    }
+
+	    call close (fd)
+	}
+
+	call gkp_close()
+	call ccp_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/calcomp/vttest.par b/sys/gio/calcomp/vttest.par
new file mode 100644
index 00000000..fcbcb2ad
--- /dev/null
+++ b/sys/gio/calcomp/vttest.par
@@ -0,0 +1,10 @@
+lname,s,hl,"ltest1.dat",,,"input polyline test file name"
+tname,s,hl,"ttest3.dat",,,"input text test file name"
+ltype,i,hl,1,1,6,"line type"
+lwidth,i,hl,1,1,15,"line width"
+mtype,i,hl,0,0,1023,"polymarker type code"
+dashlen,r,hl,10000.,0.,,"length of dash in plotter units"
+gaplen,r,hl,5000.,0.,,"width of gap in plotter units"
+plwsep,r,hl,50.,0.,,"polyline width separation for ntracing"
+option,s,hl,"l",,,"test option: {l-line; t-text; m-marker}"
+device,s,hl,"vt640",,,"output device for test program"
diff --git a/sys/gio/calcomp/vttest.x b/sys/gio/calcomp/vttest.x
new file mode 100644
index 00000000..ceff7c7a
--- /dev/null
+++ b/sys/gio/calcomp/vttest.x
@@ -0,0 +1,608 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <gki.h>
+include	<gset.h>
+include	<gio.h>
+include <ctype.h>
+include <math.h>
+include "ccp.h"
+
+define	SZ_BUF 2048
+define	PIOVER4		(0.25 * PI)
+define	THREEPIOVER4	(0.75 * TWOPI)
+define	MAXCH	15
+
+# X_VTTEST -- testing task for simulating calcomp kernel routines on vt640
+
+task vttest = t_vttest
+
+# T_VTTEST -- test low-level Calcomp graphics simulation routines on vt640
+
+procedure t_vttest ()
+
+char	lname[SZ_FNAME], tname[SZ_FNAME], devname[SZ_FNAME]
+int	ltype, lwidth, npts, n, mtype, i
+char	testoption
+pointer	x, y, gp, sim_gp
+short	p[ARB]
+
+pointer	sp, nambuf, pl, pm
+int	clgeti (), strlen ()
+real	clgetr ()
+char	clgetc ()
+pointer	ttygdes (), gopen ()
+
+include "ccp.com"
+common	/simulate/ sim_gp
+
+string	fdevice	"vt640"
+
+begin
+	call smark (sp)
+	call salloc (nambuf, SZ_FNAME, TY_CHAR)
+
+	testoption= clgetc ("option")
+	if (testoption == 'l') {
+	    call clgstr ("lname", lname, SZ_FNAME)
+	    ltype = clgeti ("ltype")
+	    lwidth = clgeti ("lwidth")			# width in rel. units
+	    g_dashlen = clgetr ("dashlen")
+	    g_gaplen  = clgetr ("gaplen")
+	    g_plwsep  = clgetr ("plwsep")
+	} else if (testoption == 't') {
+	    call clgstr ("tname", tname, SZ_FNAME)
+	    g_plwsep  = clgetr ("plwsep")
+	} else if (testoption == 'm') {
+	    mtype  = clgeti ("mtype")
+	}
+	call clgstr ("device", devname, SZ_FNAME)
+
+	n = strlen (devname)
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[nambuf], n)
+	    Memc[nambuf+n] = EOS
+	}
+	iferr (g_tty = ttygdes (Memc[nambuf]))
+	    call erract (EA_ERROR)
+	g_cc = NULL
+	call ccp_init (g_tty, Memc[nambuf])
+	call ccp_reset ()
+
+	g_xndcto_p = 1.0	# for testing, raw data is NDC-space (0-32767)
+	g_yndcto_p = 1.0	# (that is, after passing through to_short())
+	g_ltover   = false
+	g_lwover   = true
+
+	pl = CCP_PLAP(g_cc)
+	pm = CCP_PMAP(g_cc)
+
+	PL_LTYPE(pl) = ltype
+	PL_WIDTH(pl) = GKI_PACKREAL(lwidth)
+	PM_LTYPE(pm) = mtype
+
+	gp = gopen (devname, NEW_FILE, STDGRAPH)
+	sim_gp = gp
+	call gsview (gp, 0.0, 0.63, 0.0, 1.0)		# square viewport
+	call gswind (gp, 0.0, 32767.0, 0.0, 32767.0)
+
+	switch (testoption) {
+
+	case 'l':					# polyline
+
+	    call rddata (lname, x, y, npts)		# range 0.0-1.0
+	    call to_short (Memr[x], Memr[y], npts, p)	# range 0-32767
+	    call ccp_polyline (p, npts)
+
+	case 't':					# text
+
+	    call testtext (gp, tname)			# read, calc, call ccppl
+
+	case 'm':					# polymarker
+
+	    call rddata (lname, x, y, npts)		# x,y array of mrkr pos.
+	    do i = 1, npts {
+		call calcmarker (32767 * Memr[x+i-1], 32767 * Memr[y+i-1], 
+		    mtype, p, npts)
+		call ccp_polymarker (p, npts)
+	    }
+	}
+			 
+	call gclose (gp)
+	call ccp_close ()				# free g descriptors
+	call mfree (x, TY_REAL)
+	call mfree (y, TY_REAL)
+	call sfree (sp)
+end
+
+# TO_SHORT -- convert x, y real arrays to short integers as NDC coords
+
+procedure to_short (x, y, npts, p)
+
+real	x[ARB], y[ARB]
+int	npts
+short	p[ARB]
+
+int	i, j
+
+begin
+	do i = 1, npts, 1 {
+	    j = (i - 1) * 2 + 1
+	    p[j]   = x[i] * 32767
+	    p[j+1] = y[i] * 32767
+	}
+	return
+end
+
+# CALCMARKER -- calculate and return a pattern of points representing a
+# polymarker of the specified type, origined at x, y.
+
+procedure calcmarker (x, y, marktype, p, npts)
+
+real	x,y		# GKI_NDC coordinates of marker origin
+int	marktype	# polymarker type, specified in GIO specs
+short	p[ARB]		# output array of points defining marker, in GKI_NDC
+int	npts		# no. of points; x,y pairs (= 1/2 elements in p)
+
+int	i, j, m, fill
+real	xsize, ysize
+pointer	tx
+int	and()
+
+include "ccp.com"
+include	"/iraf/sys/gio/markers.dat"
+
+begin
+	tx    = CCP_TXAP(g_cc)
+	xsize = CCP_CHARHEIGHT(g_cc,1) * GKI_UNPACKREAL(TX_SIZE(tx))
+	ysize = xsize	# for now
+	# The point marker type cannot be combined with the other types and
+	# is treated as a special case.  The remaining markers are drawn
+	# using GUMARK, which draws marks represented as polygons
+
+	if (marktype == GM_POINT || (xsize == 0 && ysize == 0)) {
+	    p[1] = x
+	    p[2] = y
+	    npts = 1
+
+	} else {
+
+	    # The polylines for the standard marks are stored in MPX and MPY 
+	    # at offsets MXO and MYO.
+	    fill = NO
+	    npts = 0
+	    do i = GM_FIRSTMARK, GM_LASTMARK
+		if (and (marktype, 2 ** i) != 0) {
+		    m = i - GM_FIRSTMARK + 1
+		    do j = 1, mnpts[m] {
+			npts = npts + 1
+			p[npts*2-1] = x - 0.5 * xsize + xsize * mpx[moff[m]+j-1]
+			p[npts*2]   = y - 0.5 * ysize + ysize * mpy[moff[m]+j-1]
+		    }
+		}
+	}
+end
+
+
+procedure rddata (fname, x, y, npts)
+
+char	fname[ARB]
+pointer	x, y
+int	npts
+
+int	buflen, n, fd, ncols, lineno, i, status, testint
+pointer	sp, lbuf, ip
+real	xval, yval, maxy
+int	getline(), nscan(), open()
+errchk	open, sscan, getline, malloc
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	buflen = SZ_BUF
+	iferr {
+	    call malloc (x, buflen, TY_REAL)
+	    call malloc (y, buflen, TY_REAL)
+	} then
+	    call erract (EA_FATAL)
+
+	n = 0
+	ncols = 0
+	lineno = 0
+
+	status = 0
+	while (status != EOF) {
+	    iferr (status = getline (fd, Memc[lbuf])) {
+		call eprintf ("getline error from rddata: status=%d\n")
+		    call pargi (status)
+		call erract (EA_FATAL)
+	    }
+	    if (status == EOF) 
+		next
+	    # Skip comment lines and blank lines.
+	    lineno = lineno + 1
+	    if (Memc[lbuf] == '#')
+		next
+	    for (ip=lbuf;  IS_WHITE(Memc[ip]);  ip=ip+1)
+		;
+	    if (Memc[ip] == '\n' || Memc[ip] == EOS)
+		next
+
+	    # Decode the points to be plotted.
+	    call sscan (Memc[ip])
+		call gargr (xval)
+		call gargr (yval)
+
+	    # The first line determines whether we have an x,y list or a
+	    # y-list.  It is an error if only one value can be decoded when
+	    # processing a two column list.
+
+	    if (ncols == 0 && nscan() > 0)
+		ncols = nscan()
+	    
+	    switch (nscan()) {
+	    case 0:
+		call eprintf ("no args; %s, line %d: %s\n")
+		    call pargstr (fname)
+		    call pargi (lineno)
+		    call pargstr (Memc[lbuf])
+		next
+	    case 1:
+		yval = xval
+	    default:	# normally, ncols=2
+		if (ncols != 2) {
+		    call eprintf ("weird data; file %s, line %d: %s\n")
+			call pargstr (fname)
+			call pargi (lineno)
+			call pargstr (Memc[lbuf])
+		    next
+		}
+	    }
+
+	    n = n + 1
+	    if (n > buflen) {
+		buflen = buflen + SZ_BUF
+		call realloc (x, buflen, TY_REAL)
+		call realloc (y, buflen, TY_REAL)
+	    }
+
+	    Memr[x+n-1] = xval
+	    Memr[y+n-1] = yval
+	    testint = x+n-1
+	}
+
+	if (ncols == 1) {
+	    maxy = 0.0
+	    do i = 1, n 
+		maxy = max (Memr[y+i-1], maxy)
+	    do i = 1, n
+		Memr[x+i-1] = maxy * real(i) / real(n)
+	}
+	call realloc (x, n, TY_REAL)
+	call realloc (y, n, TY_REAL)
+
+	call close (fd)
+	call sfree (sp)
+	npts = n
+end
+
+
+# RPTHETA4 -- Polar angle, Real precision, 4 arguments; from p1(x,y) to p2(x,y):
+# angle between line segment p1-p2 and horizontal +x axis centered on p1; 
+# returned in radians; single precision (see pdtheta4).
+
+real procedure rptheta4 (p1x, p1y, p2x, p2y)
+
+real p1x,p1y, p2x,p2y	# x,y of each point
+
+real	dx, dy, ang
+
+begin
+	dx = p2x - p1x
+	dy = p2y - p1y
+	if (dx == 0.0) {
+	    if (dy >= 0.0) {
+		ang = HALFPI
+	    } else {
+		ang = THREEPIOVER4
+	    }
+	} else {
+	    ang = atan (dy / dx)
+	    if (dx < 0.0) {		# 2nd or 3rd quadrant
+		ang = ang + PI
+	    } else if (dy < 0.0) {	# 4th quadrant
+		ang = ang + TWOPI
+	    }
+	}
+	return (ang)
+end
+
+# PLOT -- simulate Calcomp's PLOT routine for testing development version of
+# calcomp kernel
+
+procedure plot (x, y, pencode)
+
+real	x,y	# plotter coords (ndc in simulation)
+int	pencode
+
+real	lastp_x, lastp_y
+
+pointer	gp
+common	/simulate/ gp
+
+begin
+	if (pencode == CCP_DOWN) 
+	    call gline (gp, lastp_x, lastp_y, x, y)
+	if (pencode == CCP_DOWN || pencode == CCP_UP) {
+	    lastp_x = x
+	    lastp_y = y
+	}
+end
+
+# PLOTS -- simulate calcomp plots routine for testing ccp code on vt640
+
+procedure plots (dum1, dum2, ldev)
+
+int	dum1, dum2, ldev
+
+begin
+	return
+end
+
+
+# NEWPEN -- temporary dummy routine for simulating Calcomp
+
+procedure newpen (whichpen)
+
+int	whichpen
+
+begin
+	return
+end
+
+# SYMBOL -- simulate Calcomp's SYMBOL routine for testing development version of
+# calcomp kernel
+
+procedure symbol (xp, yp, size, ch, orien, nchar)
+
+real	xp,yp	# plotter coords (ndc in simulation)
+real	size	# char size in plotter coords
+char	ch[ARB]	# chars to be drawn
+real	orien	# degrees counterclockwise from +x to rightward vector
+int	nchar	# number of chars
+
+pointer	gp
+common	/simulate/ gp
+
+string	format ""
+
+begin
+	ch[nchar+1] = EOS
+	call gseti (gp, G_TXUP, 90 + int(orien))
+	call gsetr (gp, G_TXSIZE, size)
+	call gtext (gp, xp, yp, ch, format)
+end
+
+
+# TESTTEXT -- read sequential lines from designated file and call ccp_text to
+# draw text at specified coordinates in specified format.
+
+procedure testtext (gp, fname) 
+
+pointer	gp			# graphics device 
+char	fname[SZ_FNAME]		# name of file from which to extract table
+
+int	fd, textlen, restlen, ip, op
+char	lbuf[SZ_LINE], ttext[SZ_LINE], rest[SZ_LINE], tformat[SZ_LINE], quote
+short	sttext[SZ_LINE]
+real	x,y
+int	open (), strlen (), getline (), nscan ()
+
+string	errmsg "unable to open table file                     "
+data	quote/34/
+
+begin
+	iferr (fd = open (fname, READ_ONLY, TEXT_FILE)) {
+	    call sprintf (errmsg[27], SZ_FNAME, "%s")
+		call pargstr (fname)
+	    call fatal (EA_FATAL, errmsg)
+	}
+
+	while (getline (fd, lbuf) != EOF) {
+	    # Skip comment lines and blank lines.
+	    if (lbuf[1] == '#')
+		next
+	    for (ip=1;  IS_WHITE(lbuf[ip]);  ip=ip+1)
+		;
+	    if (lbuf[ip] == '\n' || lbuf[ip] == EOS)
+		next
+
+	    # Decode.
+	    call sscan (lbuf[ip])
+		call gargr (x)
+		call gargr (y)
+		call gargstr (rest, SZ_LINE)
+
+	    if (nscan() < 3)	# insufficient fields; ignore line, not nice.
+		next
+	    
+	    restlen = strlen (rest)
+
+	    # Pull out text buffer:
+	    for (ip=1; rest[ip] != quote && ip < restlen; ip=ip+1)	#->1st "
+		;
+	    op = 0
+	    for (ip=ip+1; rest[ip] != quote && ip < restlen; ip=ip+1) {
+		op        = op + 1
+		ttext[op] = rest[ip];
+	    }
+	    textlen       = op
+	    ttext[op+1]   = EOS
+
+	    # Pull out format string:
+	    for (ip=ip+1; IS_WHITE(rest[ip]); ip=ip+1)		#-> past whitesp
+		;
+	    op = 0
+	    for (; ip <= restlen && !IS_WHITE(rest[ip]); ip=ip+1) {
+		op          = op + 1
+		tformat[op] = rest[ip];
+	    }
+	    tformat[op+1]   = EOS
+		
+	    # set ccp descriptor text attributes if specified:
+	    if (tformat[1] != EOS)
+		call testxset (tformat)
+	    call achtcs (ttext, sttext, textlen) # ccp_text expects short text
+	    sttext[textlen+1] = EOS
+	    call ccp_text (nint(x), nint(y), sttext, textlen)
+	}
+	call close (fd)
+end
+
+
+# TESTXSET -- Parse a text drawing format string and set the values of the text
+# attributes in the TX (g_cc) output structure.
+
+procedure testxset (format)
+
+char	format[ARB]		# text attribute format string
+
+pointer tx
+char	attribute[MAXCH], value[MAXCH]
+real	tempsize
+int	ip, op, tip, temp, ch
+int	h_v[4], v_v[4], f_v[4], q_v[4], p_v[4]
+int	ctoi(), ctor(), stridx()
+
+include	"ccp.com"
+
+define	badformat_ 91
+
+string	h_c	"nclr"
+data	h_v	/GT_NORMAL,	GT_CENTER,	GT_LEFT,	GT_RIGHT/
+string	v_c	"nctb"
+data	v_v	/GT_NORMAL,	GT_CENTER,	GT_TOP,		GT_BOTTOM/
+string	f_c	"rgib"
+data	f_v	/GT_ROMAN,	GT_GREEK,	GT_ITALIC,	GT_BOLD/
+string	q_c	"nlmh"
+data	q_v	/GT_NORMAL,	GT_LOW,		GT_MEDIUM,	GT_HIGH/
+string	p_c	"lrud"
+data	p_v	/GT_LEFT,	GT_RIGHT,	GT_UP,		GT_DOWN/
+
+begin
+	# ccp kernel text descriptor:
+	tx = CCP_TXAP(g_cc)
+
+	# Parse the format string and set the text attributes.  The code is
+	# more general than need be, i.e., the entire attribute name string
+	# is extracted but only the first character is used.  Whitespace is
+	# permitted and ignored.
+
+	for (ip=1;  format[ip] != EOS;  ip=ip+1) {
+	    # Extract the next "attribute=value" construct.
+	    while (IS_WHITE (format[ip]))
+		ip = ip +1
+
+	    op = 1
+	    for (ch=format[ip];  ch != EOS && ch != '=';  ch=format[ip]) {
+		if (op <= MAXCH) {
+		    attribute[op] = format[ip]
+		    op = op + 1
+		}
+		ip = ip + 1
+	    }
+	    attribute[op] = EOS
+
+	    if (ch == '=')
+		ip = ip + 1
+
+	    op = 1
+	    while (IS_WHITE (format[ip]))
+		ip = ip +1
+	    ch = format[ip]
+	    while (ch != EOS && ch != ';' && ch != ',') {
+		if (op <= MAXCH) {
+		    value[op] = format[ip]
+		    op = op + 1
+		}
+		ip = ip + 1
+		ch = format[ip]
+	    }
+	    value[op] = EOS
+
+	    if (attribute[1] == EOS || value[1] == EOS)
+		break
+
+	    # Decode the assignment and set the corresponding text attribute
+	    # in the graphics descriptor.
+
+	    switch (attribute[1]) {
+	    case 'u':				# character up vector
+		tip = 1
+		if (ctoi (value, tip, TX_UP(tx)) <= 0) {
+		    TX_UP(tx) = 90
+		    goto badformat_
+		}
+
+	    case 'p':				# path
+		temp = stridx (value[1], p_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_PATH(tx) = p_v[temp]
+
+	    case 'c':				# color
+		tip = 1
+		if (ctoi (value, tip, TX_COLOR(tx)) <= 0) {
+		    TX_COLOR(tx) = 1
+		    goto badformat_
+		}
+
+	    case 's':				# character size scale factor
+		tip = 1
+		if (ctor (value, tip, tempsize) <= 0) {
+		    TX_SIZE(tx) = GKI_PACKREAL(1.0)
+		    goto badformat_
+		} 
+		TX_SIZE(tx) = GKI_PACKREAL(tempsize)
+
+	    case 'h':				# horizontal justification
+		temp = stridx (value[1], h_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_HJUSTIFY(tx) = h_v[temp]
+
+	    case 'v':				# vertical justification
+		temp = stridx (value[1], v_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_VJUSTIFY(tx) = v_v[temp]
+
+	    case 'f':				# font
+		temp = stridx (value[1], f_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_FONT(tx) = f_v[temp]
+		
+	    case 'q':				# font quality
+		temp = stridx (value[1], q_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_QUALITY(tx) = q_v[temp]
+
+	    default:
+badformat_	call eprintf ("Warning (testtxset): bad gtext format '%s'\n")
+		    call pargstr (format)
+	    }
+
+	    if (format[ip] == EOS)
+		break
+	}
+end
diff --git a/sys/gio/calcomp/x_calcomp.x b/sys/gio/calcomp/x_calcomp.x
new file mode 100644
index 00000000..32c82aa2
--- /dev/null
+++ b/sys/gio/calcomp/x_calcomp.x
@@ -0,0 +1,3 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	calcomp = t_calcomp
diff --git a/sys/gio/cursor/README b/sys/gio/cursor/README
new file mode 100644
index 00000000..6534b497
--- /dev/null
+++ b/sys/gio/cursor/README
@@ -0,0 +1,9 @@
+This directory contains the source for GIOTR and cursor mode, i.e., the code
+required to process the graphics output of a graphics task, spooling and/or
+applying the workstation transformation and passing the transformed metacode
+instructions on to the builtin STDGRAPH kernel or to an external kernel.  The
+procedure RCURSOR is the main entry point for cursor mode.  RCURSOR is called
+by the CL to service a query for a cursor type parameter when query mode is
+in effect.  The workstation transformation is used to zoom and pan on a frame
+buffer and consists of a viewport transformation in GKI coordinates with
+clipping at the viewport boundary.
diff --git a/sys/gio/cursor/doc/cursor.hlp b/sys/gio/cursor/doc/cursor.hlp
new file mode 100644
index 00000000..d9912607
--- /dev/null
+++ b/sys/gio/cursor/doc/cursor.hlp
@@ -0,0 +1,194 @@
+.help GIO Mar85 "Cursor Mode"
+.nh 3
+Cursor Mode
+
+    In cursor mode, i.e., after a call to \fBclgcur\fR or after typing "=gcur",
+a number of special keystrokes shall be recognized for interactive display
+control.  All graphics output to stdgraph and stdimage is routed through the
+CL on the way to the graphics kernel.  The CL will optionally spool in an
+internal buffer all graphics instructions output to an interactive device.
+This internal buffer is emptied whenever the device screen is cleared.
+In cursor mode, special keystrokes may be used to redraw all or any portion
+of the spooled graphics, e.g., one may zoom in on a portion of the plot and
+then roam about on the plot at high magnification.  Since the spooled graphics
+vectors typically contain more information than can be displayed at normal
+magnification, zooming in on a feature may bring out additional detail
+(the maximum resolution is 32768 points in either axis).  Increasing the
+magnification will increase the precision of the cursor by the same factor.
+
+Cursor mode is implemented by performing coordinate transformation and
+clipping on each GKI instruction in the frame buffer, passing the transformed
+and clipped instructions on to the graphics kernel.
+The cursor mode operations perform a simple geometric transformation on
+the spooled graphics frame, mapping a rectangular window of the spooled
+frame onto the device screen.  The graphics frame itself is not modified,
+hence zoom out or reset and redraw will restore the original display.
+
+If the graphics frame is a typical vector plot with drawn and labeled
+axes, magnifying a portion of the plot may cause the axes to be lost.
+If this is not what is desired a keystroke is provided to draw and label
+the axes of the displayed window.  The axes will be overplotted on the
+current display and will not be saved in the frame buffer, hence they
+will be lost when the frame is redrawn.  In cursor mode the viewport is
+the full display area of the output device, hence the tick mark labels
+of the drawn axes will be drawn inside the viewport.  This form of axes
+labeling is used because it is simple and because it is appropriate for
+both vector graphics and image display output devices (and cursor mode
+must serve both).
+
+The cursor mode keystrokes are all upper case letters, reserving lower case
+for applications programs.  The terminal shift lock key may be used to
+minimize typing.  The recognized cursor mode keystrokes are shown below.
+
+
+.ks
+.nf
+(*X* means not yet implemented)
+
+	?	print list of keystrokes
+       *A*	draw and label the axes of current viewport
+	C	print the cursor position as it moves
+       *D*	draw a line by marking the endpoints
+	E	expand plot by setting window corners
+	F	set fast cursor (for HJKL)
+	H	step cursor left
+	J	step cursor down
+	K	step cursor up
+	L	step cursor right
+	M	move point under cursor to center of screen
+	P	zoom out (restore previous expansion)
+       *S*	select WCS at current position of cursor
+       *T*	draw a text string
+       *U*	undo (delete) the last instruction in the frame buffer
+	V	set slow cursor (for HJKL)
+	X	zoom in, X only
+	Y	zoom in, Y only
+	Z	zoom in, both X and Y
+	<	set lower limit of plot to the cursor y value
+	>	set upper limit of plot to the cursor y value
+       *\*	escape next character
+	:	set cursor mode options
+	:!	send a command to the host system
+	0	reset and redraw
+       1-9	roam
+
+.fi
+.ce
+Figure 2. Cursor Mode Keystrokes
+.ke
+
+
+The numeric keypad of the terminal (if it has one) is used for directional
+roaming.  The directional significance of the numeric keys for roaming
+is obvious if the terminal has a keypad, and is illustrated below.
+
+
+.ks
+.nf
+	7   8   9	135 090 045
+
+	4   5   6	180 000 000
+
+	1   2   3	225 -90 -45
+.fi
+.ke
+
+
+If the character : is typed while in cursor mode the alpha cursor will appear
+at the bottom of the screen, allowing a command line to be entered.  If the
+command \fIbegins with a period it is interpreted as a cursor mode command\fR,
+otherwise the command is passed as a string to the applications program.
+Multiple commands may be entered on a line delimited by semicolons.
+The command set currently recognized is shown below.  Minimum match
+abbreviations are permitted.
+
+.ls 4
+.ls 15 help
+Print a list of the cursor mode commands.
+.le
+.ls case[+-]
+Ignore case when interpreting keystrokes.  If this option is selected the cursor
+mode keystrokes may conflict with those of the applications program.  
+.le
+.ls clear
+Clear the alpha screen (but not the graphics screen).  This is done by writing
+sufficient blank lines to scroll any text off the screen.  Does not work if
+terminal has only one memory.
+.le
+.ls markcur[+-]
+Draw a small graphics mark at the position of the cursor whenever the cursor
+is read, i.e., when cursor mode exits.  The default is to not mark.
+.le
+.ls off [keys]
+Disable all cursor mode keystrokes except : (colon).  If followed by a list
+of keys, e.g., ":.off 0-9IC", only the listed keys are disabled.
+.le
+.ls on [keys]
+Renable all cursor mode keystrokes, or just the listed keystrokes.
+.le
+.ls page[+-]
+Clear the screen when large blocks of text are to be printed, e.g., for '?',
+show, and so on.  If paging is disabled the text will overwrite the graphics
+display.
+.le
+.ls read <file>
+Load the graphics frame from the named metafile.
+The current graphics frame is discarded.
+.le
+.ls reset
+Disconnect any connected graphics kernels and free all file descriptors and
+memory used by the graphics system.  Exit cursor mode.
+.le
+.ls show
+Print the values of all cursor mode parameters, show the status of any
+connected graphics kernels, summarize memory utilization, etc.
+.le
+.ls snap [device]
+Dispose of the graphics frame to the standard plotter or to the named device.
+A magnified graph will be plotted as it appears on the screen.
+.le
+.ls txset [size] [up]
+Set the text drawing parameters (character size and character up vector).
+For example, ".tx 2 180" would set the character size to 2.0 and character
+up to 180 degrees for a vertical string drawn upwards.
+.le
+.ls write <file>
+Save the graphics frame in (or append to) the named metafile.
+If an exclamation is appended to the command (e.g., "w! file") the output
+file, if any, will be overwritten.  If a plus sign is appended the entire
+frame will be saved regardless of any plot expansion.
+.le
+.ls xres=N
+Set the (soft) device resolution in X.  A decrease in resolution will generally
+yield an increase in plotting speed.  Only plots generated on the graphics
+terminal are affected.
+.le
+.ls yres=N
+Set the (soft) device resolution in Y.
+.le
+.ls zero
+Equivalent to the numeric key 0, i.e., restore the unitary workstation
+transformation and redraw the screen.
+.le
+.le
+
+
+For example, to set the X and Y resolutions to 250 and 100, respectively,
+one could enter the following command (the computer will type the ':' at
+the bottom of the screen when the ':' key is pressed):
+
+	:.xres=250;yres=100
+
+Cursor mode may be initialized at login time by supplying a CL environment
+variable named "cminit".  For example,
+
+	cl> set cminit = off
+
+would disable cursor mode, and
+
+	cl> set cminit = "mark;case-;xres=100;yres=50"
+
+would enable marking, turn off case sensitivity, and set the plotting
+resolution to 100x50.  Initialization is performed only once, when cursor
+mode is first entered.
+.sh
diff --git a/sys/gio/cursor/doc/giotr.notes b/sys/gio/cursor/doc/giotr.notes
new file mode 100644
index 00000000..a9221445
--- /dev/null
+++ b/sys/gio/cursor/doc/giotr.notes
@@ -0,0 +1,330 @@
+.help GIO Feb85 "Graphics I/O"
+.nh
+Graphics I/O Dataflow
+
+    The GIO procedures are resident in an external applications task which
+does graphics.  GIO writes a GKI instruction stream which, if not sent directly
+to a metafile, is sent to one of the standard graphics streams STDGRAPH,
+STDIMAGE, or STDPLOT, much as output is sent to STDOUT or STDERR.
+The procedure \fBprfilbuf\fR (directory etc$), which reads the command
+stream from a subprocess, is resident in the CL and executes all pseudofile
+i/o instructions from a subprocess.  Note that \fBprfilbuf\fR is part of the
+i/o system of IRAF and operates transparently to the CL.
+
+
+.ks
+.nf
+	     GIO(task) ---ipc--> PRFILBUF(CL) --> file (or pipe)
+				     |
+				     v             external
+				   GIOTR ---ipc--> graphics
+				     |              kernel
+				     v
+			       stdgraph kernel
+				     |
+				     v
+				  (zfioty)
+			      graphics terminal
+
+
+		   task     |        cl       |     task
+.fi
+
+.ce
+Graphics Output Dataflow
+.ke
+
+
+The \fBprfilbuf\fR procedure passes record read or write requests for the
+pseudofiles STDIN, STDOUT or STDERR on to file descriptors assigned by the
+CL with the \fBprredir\fR procedure at task execution time.  The sole function
+of the CL in graphics i/o is to control the redirection of the graphics
+i/o streams with \fBprredir\fR.  The CL may redirect any of the graphics
+streams, i.e., the user may redirect any graphics stream on the command line
+when a command is entered, but by default output is directed to a filter
+resident in the CL process.  This filter is a procedure named \fBgiotr\fR.
+
+	giotr (stream, buffer, nchars)
+
+The primary function of GIOTR is to pass metacode instructions on to a kernel.
+The instruction stream is scanned and special actions are taken for some of
+the GKI control instructions.  In particular, GIOTR must spawn graphics kernel
+subprocesses upon demand.  GIOTR is also capabable of performing an
+additional transformation upon the drawing instructions before they are passed
+to the kernel.  This transformation, known as the \fBworkstation
+transformation\fR, maps a rectangular portion of the NDC space into the full
+device screen, clipping at the boundary of the viewport into NDC space.
+The workstation transformation provides a zoom and pan capability and is
+controlled interactively by the user in \fBcursor mode\fR (section 3.3).
+
+As noted earlier, the \fBstdgraph kernel\fR ("fast" kernel) is resident in
+the CL process.  This is necessary for efficiency reasons and is desirable
+in any case because the CL process owns the graphics device, i.e., the
+graphics terminal.  All devices except the user's graphics terminal are
+controlled by external graphics kernel processes.  The STDGRAPH kernel is
+itself available as an external process and may be called as such to drive
+a graphics terminal other than the user terminal (or even to drive the user
+terminal if one is willing to shuffle output back through IPC).  A graphics
+kernel may support an arbitrary number of devices, and may write to more
+than one device simultaneously.  In addition to being called by GIOTR,
+a graphics kernel may be called directly as a CL task to process metacode from
+either a file or the standard input, e.g., from a pipe.  This offers
+additional flexibility as the CL parameter mechanism may then be used to
+gain control over metacode translation.
+
+.nh 2
+Graphics Stream I/O
+
+    The functions performed by GIOTR are summarized in pseudocode below.
+GIOTR maintains a separate descriptor for each of the three graphics streams
+and is capable of servicing intermixed i/o requests for all streams
+simultaneously.  The information stored in the descriptor
+includes the workstation name, process information, WCS storage for
+the SETWCS and GETWCS instructions, the workstation transformation,
+and the frame buffer, used to spool GKI instructions for cursor mode.
+
+
+.tp 6
+.nf
+procedure giotr (fd, buffer, nchars)
+
+fd		graphics stream (STDGRAPH, etc.)
+buffer[]	buffer containing GKI metacode instructions
+nchars		number of chars to be read or written
+
+begin
+	# Note that a GKI instruction may span a buffer boundary.
+	# The code which gets the next instruction from the buffer
+	# must always return a full instruction, hence some local
+	# buffering is required therein to reconstruct instructions.
+
+	while (get next instruction != buffer empty) {
+
+	    # Handle special instructions.
+	    switch (instruction) {
+
+	    case GKI_OPENWS:
+		if (device not already open) {
+		    read graphcap entry for device
+		    get process name from graphcap entry
+		    if (process not already connected) {
+			if (some other process is connected)
+			    disconnect current kernel process
+			connect new kernel process
+		    }
+		}
+		output instruction
+		flush output
+		clear frame buffer
+
+	    case GKI_CLOSEWS, GKI_FLUSH:
+		output instruction
+		flush output
+
+	    case GKI_CANCEL:
+		output instruction
+		flush output
+		clear frame buffer
+
+	    case GKI_SETWCS:
+		save WCS in descriptor
+
+	    case GKI_GETWCS:
+		write saved WCS to fd
+		flush (fd)
+
+	    default:
+		append unmodified instruction to frame buffer
+		perform workstation transformation upon instruction
+		output transformed instruction
+	    }
+	}
+end
+.fi
+
+
+The action implied by "output instruction" above is the following:
+
+
+.ks
+.nf
+	if (kernel is resident in this process)
+	    call gki_execute to execute the instruction
+	else
+	    call write (process, instruction, nchars)
+.fi
+.ke
+
+
+The frame buffer (required for cursor mode) will be dynamically allocated and
+will be no larger than it has to be, but will have a fixed (user defined)
+upper limit, e.g., 128Kb.  The median size for a plot is typically 5-10Kb.
+Instructions will be silently discarded if the buffer grows too large.
+Buffering can be turned off completely if desired, and will always be turned
+off for STDPLOT.
+
+.nh 2
+Cursor Mode Details
+
+    Most of the functionality required to implement cursor mode is provided
+by GIOTR.  The primary functions of the cursor mode code are to read the
+cursor and keystroke, modify the workstation transformation, and redraw the
+contents of the frame buffer subject to the new workstation transformation.
+Cursor mode does not modify the contents of the frame buffer, except for
+possibly appending new graphics instructions to the frame buffer.
+A workstation transformation set with cursor mode remains in effect until
+the frame buffer is cleared, hence any additional graphics output from the
+task which initiated the cursor read (and cursor mode) will undergo the
+workstation transformation when drawn.
+
+
+.nf
+# PR_FILBUF -- Fill FIO buffer from an IPC channel subject to the CL/IPC
+# protocol for multiplexing pseudofile data streams with the command stream.
+# Each process has an associated set of pseudofile streams.  Each pseudofile
+# stream is connected to one, and only one, file or pseudofile of another
+# process.  I/O requests to XMIT or XFER to an ordinary file are straightforward
+# to satisfy.  An i/o request from one pseudofile to another is satisfied
+# by posting the request (pushing it on a stack) and redirecting our input
+# to the process owning the pseudofile being read or written.  Pseudofile
+# requests are then processed from the second process until a request is
+# received which satisfies the posted request from the original process.
+# When the original request is satisfied it is popped from the stack and input
+# will again be taken from the original process.  Note that we cannot write
+# directly to the output process since that would violate the IPC protocol
+# (the second process may wish to write to its stdout or stderr rather than
+# read, etc.: the process must be allowed to complete the original request
+# itself).
+#
+# Request Packet (pushed onto stack for IPC to IPC i/o).
+# 
+# 	pr		process slot number of process placing the request
+# 	iomode		request is a read or a write
+# 	count		number of chars to be transferred
+# 	ps_server	pseudofile number in server process
+# 	ps_receiver	pseudofile number in receiver process
+#
+# The request packet describes a pending pseudofile i/o request.  The named
+# pseudofile in the server process is either reading from or writing to the
+# named pseudofile in the receiver process.
+
+int procedure pr_filbuf (fd)
+
+begin
+	input = fd (the IPC input channel of a process)
+
+	repeat {
+	    get a line from the input file
+	    if (neither XMIT nor XFER directive)
+		if (request pending)
+		    error: IPC protocol corrupted
+		else
+		    return command
+
+	    if (line is an XMIT directive) {
+		if (destination is a file) {
+		    # Write from pseudofile to an ordinary file.
+		    get data record from input
+		    write data record to file
+
+		} else {
+		    # Write from pseudofile to another pseudofile.
+		    if (XMIT satisfies XFER request on top of stack)
+			get data record from input
+			write record to stacked process
+			restore input to stacked process
+			pop request from stack
+
+		    } else {
+			# If writing to local kernel GIOTR will return a null
+			# length record and we are done.
+
+			get data record from input
+			if (writing to a graphics stream)
+			    call giotr filter to transform record
+			if (anything left to output) {
+			    push request on stack
+			    switch input to IPC input of receiver process
+			}
+		    }
+		}
+
+	    } else if (line is an XFER directive) {
+		if (source is an ordinary file) {
+		    # Read from a file.
+		    read data record from file
+		    write to active process
+
+		} else if (source is another process) {
+		    # Read from another pseudofile.
+		    if (XFER satisfies XMIT request on top of stack) {
+			read record from stacked process
+			write to active process
+			restore input to stacked process
+			pop request from stack
+		    } else {
+			push request on stack
+			switch input to IPC input channel of receiver process
+		    }
+		}
+	    }
+	}
+end
+
+
+# GIOTR -- Graphics i/o filter.
+
+procedure giotr (fd, buffer, nchars)
+
+fd		graphics stream (STDGRAPH, etc.)
+buffer[]	buffer containing GKI metacode instructions
+nchars		number of chars to be read or written
+
+begin
+	# Note that a GKI instruction may span a buffer boundary.
+	# The code which gets the next instruction from the buffer
+	# must always return a full instruction, hence some local
+	# buffering is required therein to reconstruct instructions.
+
+	while (buffer not empty) {
+
+	    # Handle special instructions.
+	    switch (next_instruction) {
+
+	    case GKI_OPENWS:
+		if (device not already open) {
+		    read graphcap entry for device
+		    get process name from graphcap entry
+		    if (process not already connected) {
+			if (some other process is connected)
+			    disconnect current kernel process
+			connect new kernel process
+		    }
+		}
+		output instruction
+		flush output
+		clear frame buffer
+
+	    case GKI_CLOSEWS, GKI_FLUSH:
+		output instruction
+		flush output
+
+	    case GKI_CANCEL:
+		output instruction
+		flush output
+		clear frame buffer
+
+	    case GKI_SETWCS:
+		save WCS in descriptor
+
+	    case GKI_GETWCS:
+		write saved WCS to fd
+		flush (fd)
+
+	    default:
+		append unmodified instruction to frame buffer
+		perform workstation transformation upon instruction
+		output transformed instruction
+	    }
+	}
+end
diff --git a/sys/gio/cursor/giotr.x b/sys/gio/cursor/giotr.x
new file mode 100644
index 00000000..cfc8f706
--- /dev/null
+++ b/sys/gio/cursor/giotr.x
@@ -0,0 +1,183 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<xwhen.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GIOTR -- A graphics filter, called by PR_PSIO (during normal graphics output)
+# and RCURSOR (when in cursor mode) to perform the workstation transformation
+# on a block of metacode instructions, writing the individual instructions to
+# either the inline stdgraph kernel or to an external kernel.  Input is taken
+# from the frame buffer for the stream.  All full instructions starting at the
+# input pointer IP and ending at the output pointer OP are processed, leaving
+# the input pointer positioned to BOI of the last (and incomplete) instruction
+# in the frame buffer.  If output is to an inline kernel the kernel is called
+# to execute each instruction as it is extracted.  If output is to an external
+# kernel instructions are written to the named stream, i.e., into the FIO
+# buffer associated with the stream, and later transferred to the kernel in the
+# external process when the process requests input from the named stream in an
+# XFER directive (see PR_PSIO).
+
+procedure giotr (stream)
+
+int	stream			# graphics stream
+
+pointer	tr, gki
+int	jmpbuf[LEN_JUMPBUF], fn
+int	mode, xint, status, junk, nwords
+common	/gtrvex/ jmpbuf
+
+pointer	gtr_init(), coerce()
+extern	giotr_onint(), gtr_delete()
+int	gtr_fetch_next_instruction(), locpr()
+errchk	gtr_init, gtr_fetch_next_instruction, gki_write
+data	status /OK/, xint /NULL/
+include	"gtr.com"
+
+begin
+	tr = gtr_init (stream)
+
+	# If an interrupt occurs while GIOTR is executing output is cancelled
+	# and further processing is disabled until the next frame begins.
+
+	if (xint == NULL)
+	    call xwhen (X_INT, locpr(giotr_onint), xint)
+
+	call zsvjmp (jmpbuf, status)
+	if (status != OK) {
+	    call gki_cancel (stream)
+	    call gki_deactivatews (stream, 0)
+	}
+
+	# Fetch, optionally transform, and execute each metacode instruction
+	# in the frame buffer.
+
+	while (gtr_fetch_next_instruction (tr, gki) != EOF) {
+	    switch (Mems[gki+GKI_HDR_OPCODE-1]) {
+
+	    case GKI_OPENWS:
+		mode = Mems[gki+GKI_OPENWS_M-1]
+		if (mode != APPEND)
+		    status = OK
+
+		if (status == OK) {
+		    # If the open instruction has already been passed to the
+		    # kernel by gtr_control, do not do so again here.
+
+		    if (TR_SKIPOPEN(tr) == YES)
+			TR_SKIPOPEN(tr) = NO
+		    else
+			call gki_write (stream, Mems[gki])
+
+		    # gtr_control does not call gki_escape so always do this.
+		    call gki_escape (stream, GKI_OPENWS, 0, 0)
+
+		    # Discard frame buffer contents up to and including the
+		    # openws instruction, so that it will only be executed
+		    # once.
+
+		    if (Mems[gki+GKI_OPENWS_M-1] == NEW_FILE)
+			call gtr_frame (tr, TR_IP(tr), stream)
+		}
+
+	    case GKI_CLOSEWS, GKI_DEACTIVATEWS, GKI_REACTIVATEWS:
+		# These instructions are passed directly to the kernel via
+		# the PSIOCTRL stream at runtime, but are ignored in metacode
+		# to avoid unnecessary mode switching of the terminal.
+		;
+
+	    case GKI_CANCEL:
+		# Cancel any buffered graphics data.
+		call gki_write (stream, Mems[gki])
+		call gtr_frame (tr, TR_IP(tr), stream)
+
+	    case GKI_FLUSH, GKI_GETCURSOR, GKI_GETCELLARRAY:
+		# Do not buffer these instructions.
+		call gki_write (stream, Mems[gki])
+		call gtr_delete (tr, gki)
+
+	    case GKI_CLEAR:
+		# Clear is special because it initializes things.
+		if (status != OK) {
+		    call gki_reactivatews (stream, 0)
+		    status = OK
+		}
+		# Execute the instruction.
+		call gki_write (stream, Mems[gki])
+		call gki_escape (stream, GKI_CLEAR, 0, 0)
+
+		# Discard frame buffer contents up to and including the clear.
+		call gtr_frame (tr, TR_IP(tr), stream)
+
+	    case GKI_SETWCS:
+		call gki_write (stream, Mems[gki])
+		nwords = Mems[gki+GKI_SETWCS_N-1]
+		call amovs (Mems[gki+GKI_SETWCS_WCS-1],
+		    Mems[coerce (TR_WCSPTR(tr,1), TY_STRUCT, TY_SHORT)],
+		    min (nwords, LEN_WCS * MAX_WCS * SZ_STRUCT / SZ_SHORT))
+
+	    case GKI_ESCAPE:
+		if (status == OK) {
+		    fn = Mems[gki+GKI_ESCAPE_FN-1]
+
+		    # Execute the escape instruction.
+		    if (wstranset == YES) {
+			call sge_wstran (fn, Mems[gki+GKI_ESCAPE_DC-1],
+			    vx1,vy1, vx2,vy2)
+		    } else
+			call gki_write (stream, Mems[gki])
+
+		    # Allow the kernel escape handling code to preserve,
+		    # delete, or edit the instruction.
+
+		    call sge_spoolesc (tr, gki, fn, Mems[gki+GKI_ESCAPE_DC-1],
+			TR_FRAMEBUF(tr), TR_OP(tr), locpr(gtr_delete))
+		}
+
+	    default:
+		if (status == OK)
+		    if (wstranset == YES) {
+			# Perform the workstation transformation and output the
+			# transformed instruction, if there is anything left.
+			call gtr_wstran (Mems[gki])
+		    } else
+			call gki_write (stream, Mems[gki])
+	    }
+	}
+
+	# Clear the frame buffer if spooling is disabled.  This is done by
+	# moving the upper part of the buffer to the beginning of the buffer,
+	# starting with the word pointed to by the second argument, preserving
+	# the partial instruction likely to be found at the end of the buffer.
+	# Truncate the buffer if it grows too large by the same technique of
+	# shifting data backwards, but in this case without destroying all
+	# of the data.
+
+	if (TR_SPOOLDATA(tr) == NO)
+	    call gtr_frame (tr, TR_IP(tr), stream)
+	else if (TR_OP(tr) - TR_FRAMEBUF(tr) > TR_MAXLENFRAMEBUF(tr))
+	    call gtr_truncate (tr, TR_IP(tr))
+
+	# Pop the interrupt handler.
+	if (xint != NULL) {
+	    call xwhen (X_INT, xint, junk)
+	    xint = NULL
+	}
+end
+
+
+# GIOTR_ONINT -- Interrupt handler for GIOTR.
+
+procedure giotr_onint (vex, next_handler)
+
+int	vex			# virtual exception
+int	next_handler		# next exception handler in chain
+int	jmpbuf[LEN_JUMPBUF]
+common	/gtrvex/ jmpbuf
+
+begin
+	call xer_reset()
+	call zdojmp (jmpbuf, vex)
+end
diff --git a/sys/gio/cursor/grc.h b/sys/gio/cursor/grc.h
new file mode 100644
index 00000000..35af451f
--- /dev/null
+++ b/sys/gio/cursor/grc.h
@@ -0,0 +1,20 @@
+# GRC.H -- Global definitions and data structures for the RCURSOR (cursor read)
+# procedures.
+
+define	KEYSFILE	"lib$scr/cursor.key"
+define	KEYSTROKES	"ABCDEFHJKLMPRTUVWXYZ<>0123456789:="
+define	MAX_KEYS	128
+define	LEN_RCSTRUCT	(10+(128/SZ_STRUCT))
+
+define	RC_CASE		Memi[$1]		# case sensitive
+define	RC_MARKCUR	Memi[$1+1]		# mark cursor
+define	RC_PHYSOPEN	Memi[$1+2]		# physical open by rcursor
+define	RC_AXES		Memi[$1+3]		# draw axes if screen redrawn
+			# (open)
+define	RC_KEYS		Memc[P2C($1+10)+$2]	# keystroke mappings
+
+define	LEN_CT		2,4
+define	CT_TRAN		1
+define	CT_SCALE	2
+define	CT_WORIGIN	3
+define	CT_MORIGIN	4
diff --git a/sys/gio/cursor/grcaxes.x b/sys/gio/cursor/grcaxes.x
new file mode 100644
index 00000000..f2f69e4f
--- /dev/null
+++ b/sys/gio/cursor/grcaxes.x
@@ -0,0 +1,402 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+define	LEN_POLYLINE	128		# polyline for axes and ticks
+define	NTICKS		6		# default rough ticks on an axis
+define	SZ_TICKFORMAT	6		# "%0.Xg"
+define	SZ_TICKLABEL	10		# encoded tick label
+define	TICKLEN		0.03		# tick length, ndc units
+define	LABELOFFSET	1.5		# offset to tick label in ticklen units
+
+
+# GRC_AXES -- Draw and label the axes of the viewport.  This is a simple
+# routine not intended to be competitive with GLABAX.  We draw a box around
+# the edge of the screen, find and label the ticks within the plotting area.
+
+procedure grc_axes (stream, sx, sy, raster, rx, ry)
+
+int	stream			#I graphics stream
+real	sx, sy			#I screen coords of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coords of cursor
+
+char	tickformat[SZ_TICKFORMAT], ticklabel[SZ_TICKLABEL]
+pointer tr, w, ap, save_op
+int	xt, yt, nwords, nticks, wcs, lt_save
+real	xb, xe, x1, dx, x, y, lw_save
+real	yb, ye, y1, dy, aspect_ratio, xticklen, yticklen
+
+int	gt_ndigits()
+pointer	gtr_init()
+real	ttygetr()
+
+errchk	gtr_init, ttygetr, realloc, gax_start
+include	"gtr.com"
+
+begin
+	tr = gtr_init (stream)
+
+	# Draw the axes with a solid polyline of width 2.0.
+	ap = TR_PLAP(tr)
+	lt_save = PL_LTYPE(ap);	PL_LTYPE(ap) = GL_SOLID
+	lw_save = PL_WIDTH(ap);	PL_WIDTH(ap) = 2.0
+
+	# Select a WCS.
+	call grc_scrtowcs (stream, sx, sy, raster, rx, ry, x1, y1, wcs)
+	w = TR_WCSPTR(tr,wcs)
+
+	# Get the coordinates of the axes corners and the tick parameters.
+	call gax_findticks (w, xb,xe,yb,ye, x1,dx,xt, y1,dy,yt)
+
+	# Mark the position in the frame buffer.  The axes drawing instructions
+	# will be appended to the frame buffer by the drawing routines.  When
+	# we get all done we will move these instructions to the scratch buffer
+	# and reset the frame buffer pointers, since we do not want the axes
+	# to be a permanent part of the plot.
+
+	save_op = TR_OP(tr)
+
+	# Compute the X and Y tick lengths in NDC coordinates, corrected for
+	# the aspect ratio and workstation transformation.
+
+	aspect_ratio = ttygetr (TR_TTY(tr), "ar")
+	if (aspect_ratio < .001)
+	    aspect_ratio = 1.0
+	xticklen = TICKLEN / xscale * aspect_ratio
+	yticklen = TICKLEN / yscale
+
+	# Construct the polyline to draw the first two axes and ticks.  We
+	# start at the lower left and draw to the lower right then upper right.
+
+	nticks = int ((xe - xb) / dx)			# Bottom axis.
+	call gax_start (xb, yb)
+	call gax_draw (x1, yb)
+	call gax_tick (0., yticklen)
+
+	for (x=x1+dx;  nticks > 0;  nticks=nticks-1) {
+	    call gax_draw (min(x,xe), yb)
+	    call gax_tick (0., yticklen)
+	    x = x + dx
+	}
+
+	nticks = int ((ye - yb) / dy)			# Right axis.
+	call gax_draw (xe, yb)
+	call gax_draw (xe, y1)
+	call gax_tick (-xticklen, 0.)
+
+	for (y=y1+dy;  nticks > 0;  nticks=nticks-1) {
+	    call gax_draw (xe, min(y,ye))
+	    call gax_tick (-xticklen, 0.)
+	    y = y + dy
+	}
+
+	call gax_draw (xe, ye)
+	call gax_flush (stream)
+
+	# Construct the polyline to draw the second two axes and ticks.  We
+	# start at the lower left and draw to the upper left then upper right.
+
+	nticks = int ((ye - yb) / dy)			# Left axis.
+	call gax_start (xb, yb)
+	call gax_draw (xb, y1)
+	call gax_tick (xticklen, 0.)
+
+	for (y=y1+dy;  nticks > 0;  nticks=nticks-1) {
+	    call gax_draw (xb, min(y,ye))
+	    call gax_tick (xticklen, 0.)
+	    y = y + dy
+	}
+
+	nticks = int ((xe - xb) / dx)			# Top axis.
+	call gax_draw (xb, ye)
+	call gax_draw (x1, ye)
+	call gax_tick (0., -yticklen)
+
+	for (x=x1+dx;  nticks > 0;  nticks=nticks-1) {
+	    call gax_draw (min(x,xe), ye)
+	    call gax_tick (0., -yticklen)
+	    x = x + dx
+	}
+
+	call gax_draw (xe, ye)
+	call gax_flush (stream)
+
+	# Label the ticks on the bottom axis.  The tick labels are centered
+	# just above each tick.
+
+	nticks = int ((xe - xb) / dx) + 1
+	call sprintf (tickformat, SZ_TICKFORMAT, "%%0.%dg")
+	    call pargi (max (1, gt_ndigits (xb, xe, dx)) + 1)
+
+	for (x=x1;  nticks > 0;  nticks=nticks-1) {
+	    call glb_encode (x, ticklabel, SZ_TICKLABEL, tickformat, dx)
+	    call gax_ndc (x, yb, sx, sy)
+	    call gax_text (stream, sx, sy + (yticklen * LABELOFFSET),
+		ticklabel, GT_CENTER, GT_BOTTOM)
+	    x = x + dx
+	}
+
+	# Label the ticks on the left axis.  The tick labels are left justified
+	# just to the right of each tick.
+
+	nticks = int ((ye - yb) / dy) + 1
+	call sprintf (tickformat, SZ_TICKFORMAT, "%%0.%dg")
+	    call pargi (max (1, gt_ndigits (yb, ye, dy)) + 1)
+
+	for (y=y1;  nticks > 0;  nticks=nticks-1) {
+	    call glb_encode (y, ticklabel, SZ_TICKLABEL, tickformat, dy)
+	    call gax_ndc (xb, y, sx, sy)
+	    call gax_text (stream, sx + (xticklen * LABELOFFSET), sy,
+		ticklabel, GT_LEFT, GT_CENTER)
+	    y = y + dy
+	}
+
+	# Restore the default polyline attributes.
+	PL_LTYPE(ap) = lt_save
+	PL_WIDTH(ap) = lw_save
+
+	# Move the axes drawing and labelling instructions to the scratch
+	# buffer and fix up the frame buffer pointers.
+
+	nwords = TR_OP(tr) - save_op
+	if (nwords > TR_LENSCRATCHBUF(tr)) {
+	    call realloc (TR_SCRATCHBUF(tr), nwords, TY_SHORT)
+	    TR_LENSCRATCHBUF(tr) = nwords
+	}
+
+	call amovs (Mems[save_op], Mems[TR_SCRATCHBUF(tr)], nwords)
+	TR_OPSB(tr) = TR_SCRATCHBUF(tr) + nwords
+	TR_OP(tr) = save_op
+	TR_IP(tr) = save_op
+	TR_LASTOP(tr) = save_op
+end
+
+
+# GAX_FINDTICKS -- Get the coordinates of the endpoints of the axes, the first
+# tick on each axis, and the tick spacing on each axis.  If log scaling is in
+# use on an axis we shall work in log coordinate units, which are linear.
+
+procedure gax_findticks (w, wx1,wx2,wy1,wy2, x1,dx,xt, y1,dy,yt)
+
+pointer	w			# window descriptor
+real	wx1,wx2,wy1,wy2		# endpoints of axes
+real	x1,dx			# tick start and spacing in X
+int	xt			# type of scaling in X
+real	y1,dy			# tick start and spacing in Y
+int	yt			# type of scaling in Y
+
+pointer	wp
+real	ct[LEN_CT]
+common	/ftkgcm/ wp, ct
+
+real	sx1, sx2, sy1, sy2
+real	elogr()
+
+begin
+	wp = w
+
+	# Set up WCS/NDC coordinate transformations.
+	call grc_settran (w, ct)
+
+	# Get NDC coords of the corners of the screen.
+	call grc_scrtondc (0.001, 0.001, sx1, sy1)
+	call grc_scrtondc (0.999, 0.999, sx2, sy2)
+
+	# Move in a bit if the graphics viewport lies within the screen area.
+	# This depends upon the workstation transformation, of course.
+	sx1 = max (WCS_SX1(w), sx1)
+	sx2 = min (WCS_SX2(w), sx2)
+	sy1 = max (WCS_SY1(w), sy1)
+	sy2 = min (WCS_SY2(w), sy2)
+
+	# Compute world coordinates of the viewport (of the axes to be drawn).
+	call grc_ndctowcs (ct, sx1, sy1, wx1, wy1)
+	call grc_ndctowcs (ct, sx2, sy2, wx2, wy2)
+
+	# Find the ticks.  If log scaling is in use on an axis we shall find
+	# and draw the ticks in log coordinates.
+
+	switch (WCS_XTRAN(w)) {
+	case GW_LOG:
+	    wx1 = log10 (wx1)
+	    wx2 = log10 (wx2)
+	case GW_ELOG:
+	    wx1 = elogr (wx1)
+	    wx2 = elogr (wx2)
+	}
+	call gtickr (wx1, wx2, NTICKS, NO, x1, dx)
+
+	switch (WCS_YTRAN(w)) {
+	case GW_LOG:
+	    wy1 = log10 (wy1)
+	    wy2 = log10 (wy2)
+	case GW_ELOG:
+	    wy1 = elogr (wy1)
+	    wy2 = elogr (wy2)
+	}
+	call gtickr (wy1, wy2, NTICKS, NO, y1, dy)
+
+	xt = WCS_XTRAN(w)
+	yt = WCS_YTRAN(w)
+end
+
+
+# GAX_NDC -- Convert a pair of world or log-world coordinates to NDC
+# coordinates.  GAX_FINDTICKS must be called first to set up transformation.
+
+procedure gax_ndc (wx, wy, sx, sy)
+
+real	wx, wy			# world coords (input)
+real	sx, sy			# ndc coords (output)
+
+pointer	wp
+real	ct[LEN_CT]
+common	/ftkgcm/ wp, ct
+
+real	x, y
+real	aelogr()
+
+begin
+	# Get X in world coordinates.
+	switch (WCS_XTRAN(wp)) {
+	case GW_LOG:
+	    x = 10.0 ** wx
+	case GW_ELOG:
+	    x = aelogr (wx)
+	default:
+	    x = wx
+	}
+
+	# Get Y in world coordinates.
+	switch (WCS_YTRAN(wp)) {
+	case GW_LOG:
+	    y = 10.0 ** wy
+	case GW_ELOG:
+	    y = aelogr (wy)
+	default:
+	    y = wy
+	}
+
+	# Transform to NDC coordinates and return.
+	call grc_wcstondc (ct, x, y, sx, sy)
+end
+
+
+# GAX_DRAW -- Add a point to the output polyline for an axis.  The polyline
+# is built up in NDC coordinates for output to GTR_POLYLINE.  In addition to
+# the draw routine, entry points are provided for start, flush, and tick
+# drawing.
+
+procedure gax_draw (wx, wy)
+
+real	wx, wy			# world or log-world coords to draw to
+real	sx, sy
+pointer	polyline, op
+common	/gaxdcm/ polyline, op
+
+begin
+	# Transform to NDC coords and add the point to the polyline.
+	call gax_ndc (wx, wy, sx, sy)
+	Memr[op] = sx
+	op = op + 1
+	Memr[op] = sy
+	op = op + 1
+end
+
+
+# GAX_TICK -- Draw a tick at the current position.  The offsets to draw the
+# tick are given in NDC coordinates.
+
+procedure gax_tick (dx, dy)
+
+real	dx, dy			# tick offset in NDC coords for gax_tick
+real	x, y
+pointer	polyline, op
+common	/gaxdcm/ polyline, op
+
+begin
+	x = Memr[op-2]
+	y = Memr[op-1]
+
+	Memr[op] = x + dx
+	op = op + 1
+	Memr[op] = y + dy
+	op = op + 1
+
+	Memr[op] = x
+	op = op + 1
+	Memr[op] = y
+	op = op + 1
+end
+
+
+# GAX_START -- Start a new polyline at the indicated point in world coords.
+# The polyline buffer is of a fixed length with no bounds checking.
+
+procedure gax_start (wx, wy)
+
+real	wx, wy			# world or log-world coords to draw to
+pointer	polyline, op
+
+errchk	malloc
+common	/gaxdcm/ polyline, op
+
+begin
+	call malloc (polyline, LEN_POLYLINE, TY_REAL)
+	op = polyline
+	call gax_draw (wx, wy)
+end
+
+
+# GAX_FLUSH -- Flush the buffered polyline and free space on the heap.
+
+procedure gax_flush (stream)
+
+int	stream			# graphics stream
+pointer	polyline, op
+common	/gaxdcm/ polyline, op
+
+begin
+	call grc_polyline (stream, Memr[polyline], (op - polyline) / 2)
+	call mfree (polyline, TY_REAL)
+end
+
+
+# GAX_TEXT -- Draw a text string (tick label) of size 1.0 with the indicated
+# justification.
+
+procedure gax_text (stream, sx, sy, text, hjustify, vjustify)
+
+int	stream			# graphics stream
+real	sx, sy			# text coordinates, NDC
+char	text[ARB]		# text string to be drawn
+int	hjustify		# horizontal justification
+int	vjustify		# vertical justification
+
+pointer	tr, tx
+int	save_tx[LEN_TX]
+errchk	gtr_init
+pointer	gtr_init()
+
+begin
+	tr = gtr_init (stream)
+	tx = TR_TXAP(tr)
+	call amovi (Memi[tx], save_tx, LEN_TX)
+
+	TX_UP(tx) = 90
+	TX_SIZE(tx) = 1.0
+	TX_PATH(tx) = GT_RIGHT
+	TX_SPACING(tx) = 0
+	TX_HJUSTIFY(tx) = hjustify
+	TX_VJUSTIFY(tx) = vjustify
+	TX_FONT(tx) = GT_BOLD
+	TX_QUALITY(tx) = GT_NORMAL
+	TX_COLOR(tx) = 1
+
+	call grc_text (stream, sx, sy, text)
+	call amovi (save_tx, Memi[tx], LEN_TX)
+end
diff --git a/sys/gio/cursor/grcclose.x b/sys/gio/cursor/grcclose.x
new file mode 100644
index 00000000..304a0904
--- /dev/null
+++ b/sys/gio/cursor/grcclose.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_CLOSE -- Close the workstation (kernel).  Called by RCURSOR to close the
+# kernel after a cursor read.  Note that a cursor read may occur while the
+# workstation is open, i.e., after gopen but before gclose, or after the
+# workstation has been closed, i.e., after a plotting program terminates.
+# If the workstation was already open (GKI_OPENWS) by the application when
+# the cursor read occurred we must leave things as they were.
+
+procedure grc_close (fd, rc)
+
+int	fd			# graphics stream
+pointer	rc			# rcursor descriptor
+
+pointer	tr
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (fd)
+
+	# Decrement the logical OPENWS count and issue the actual CLOSEWS
+	# only if the counter goes to zero.  If the workstation was open
+	# but deactivated when grc_open() was called (WS_ACTIVE == NO),
+	# restore it to its former (deactivated) state.
+
+	TR_WSOPEN(tr) = TR_WSOPEN(tr) - 1
+	if (TR_WSOPEN(tr) <= 0) {
+	    call gki_closews (fd, TR_DEVNAME(tr))
+	    TR_WSOPEN(tr) = 0
+	    TR_WSACTIVE(tr) = NO
+	} else if (TR_WSACTSAVE(tr) == NO) {
+	    call gki_deactivatews (fd, 0)
+	    TR_WSACTIVE(tr) = NO
+	}
+
+	call gki_fflush (fd)
+end
diff --git a/sys/gio/cursor/grccmd.x b/sys/gio/cursor/grccmd.x
new file mode 100644
index 00000000..5aca0f84
--- /dev/null
+++ b/sys/gio/cursor/grccmd.x
@@ -0,0 +1,533 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttyset.h>
+include	<ctype.h>
+include	<mach.h>
+include	<fset.h>
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+define	MAX_KWLEN	10
+
+# Assign opcodes to the recognized keywords.
+
+define	KW_AXES		1
+define	KW_CASE		2
+define	KW_CLEAR	3
+define	KW_CURSOR	4
+define	KW_GFLUSH	5
+define	KW_HELP		6
+define	KW_INIT		7
+define	KW_MARKCUR	8
+define	KW_OFF		9
+define	KW_ON		10
+define	KW_PAGE		11
+define	KW_READ		12
+define	KW_SHOW		13
+define	KW_SNAP		14
+define	KW_TXQUALITY	15
+define	KW_TXSET	16
+define	KW_VIEWPORT	17
+define	KW_WRITE	18
+define	KW_XRES		19
+define	KW_YRES		20
+define	KW_ZERO		21
+
+
+# GRC_COMMAND -- Process a ":." cursor mode option string.  The RC structure
+# contains the current values of the cursor mode options.  Some option strings
+# are commands that do something, others set options, and still others show
+# the status of the program.
+
+int procedure grc_command (rc, stream, sx, sy, raster, rx, ry, opstr)
+
+pointer	rc			#I rcursor descriptor
+int	stream			#I graphics stream
+real	sx, sy			#I screen coords of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coords of cursor
+char	opstr[ARB]		#I options string excluding the leading ":.".
+
+pointer	tr, p_tr, sp, fname, lbuf, tty
+bool	clobber, fullframe, auto_gflush
+int	ip, op, ch, opcode, cursor
+int	save1, save2, i, xres, yres, quality
+char	kwname[MAX_KWLEN]
+
+pointer	gtr_init(), grc_open(), ttyodes()
+int	strdic(), grc_boolval(), ttygeti(), ttystati()
+real	grc_realval()
+string	keywords "|axes|case|clear|cursor|gflush|help|init|markcur|off|on|page|\
+read|show|snap|txquality|txset|viewport|write|xres|yres|zero|"
+errchk	gtr_redraw, gki_flush, gtr_init
+define	exit_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	# The terminal is left in graphics mode when the user types return to
+	# enter the command.  Echo the user command to the terminal without
+	# the newline to leave the terminal in status line mode, so that any
+	# output directly to the terminal from the lower level code in the CL
+	# goes into the status line.
+
+	call strcpy (":.", Memc[lbuf], SZ_LINE)
+	op = lbuf + 2
+	for (ip=1;  opstr[ip] != EOS && opstr[ip] != '\n';  ip=ip+1) {
+	    Memc[op] = opstr[ip]
+	    op = op + 1
+	}
+	Memc[op] = EOS
+	call stg_putline (STDERR, Memc[lbuf])
+
+	tr = gtr_init (stream)
+	ip = 1
+
+	while (ip == 1 || opstr[ip] != EOS) {
+	    while (IS_WHITE(opstr[ip]))
+		ip = ip + 1
+
+	    # If EOS and not first command, all done.  If first command do
+	    # not quit, rather assume ":.help" (see below).
+
+	    if (ip > 1 && opstr[ip] == EOS)
+		break
+
+	    # Extract the keyword into the KWNAME buffer.  Leave the input
+	    # pointer positioned to the first char following the keyword.
+
+	    for (op=1;  opstr[ip] != EOS;  ip=ip+1) {
+		ch = opstr[ip]
+		if (IS_ALNUM(ch)) {
+		    kwname[op] = ch
+		    op = op + 1
+		} else
+		    break
+	    }
+	    kwname[op] = EOS
+
+	    # Look up the keyword in the dictionary.  If not found ring the bell
+	    # but do not return EOF (do not quit cursor mode).
+
+	    if (op == 1)
+		opcode = KW_HELP
+	    else {
+		opcode = strdic (kwname, kwname, MAX_KWLEN, keywords)
+		if (opcode <= 0) {
+		    call fprintf (STDERR, "\7")
+		    goto exit_
+		}
+	    }
+
+	    # Process the command.
+
+	    switch (opcode) {
+	    case KW_AXES:
+		# Set flag to draw axes of viewport when screen readrawn.
+		RC_AXES(rc) = grc_boolval (opstr, ip)
+
+	    case KW_CASE:
+		# Enable/disable case sensitivity.
+		RC_CASE(rc) = grc_boolval (opstr, ip)
+
+	    case KW_CLEAR:
+		# Clear the alpha screen.
+		iferr (tty = ttyodes ("terminal"))
+		    call grc_warn (STDERR)
+		else {
+		    do i = 1, ttystati (tty, TTY_NLINES) {
+			call ttygoto (STDOUT, tty, 1, i)
+			call ttyclearln (STDOUT, tty)
+		    }
+		    call flush (STDOUT)
+		    call ttycdes (tty)
+		}
+
+	    case KW_CURSOR:
+		# Select the cursor to be referenced in all subsequent reads
+		# and writes.
+
+		ip = ip + 1
+		cursor = max (0, nint (grc_realval (opstr, ip)))
+		call stg_lockcursor (cursor)
+
+	    case KW_GFLUSH:
+		# Flush any buffered graphics output (dispose of spooled
+		# plotter output).
+
+		call stg_putline (STDERR, " - ")
+		call gtr_gflush (STDPLOT)
+
+	    case KW_HELP:
+		# Print help text for cursor mode.
+		call gtr_page (STDERR, stream)
+		iferr (call pagefile (KEYSFILE, "cursor mode help"))
+		    call grc_warn (STDERR)
+		ip = ip + 1
+
+	    case KW_INIT:
+		# Disconnect all kernels and free memory.  Exits cursor mode
+		# with an EOF.
+
+		call stg_putline (STDERR, " - ")
+		call gtr_reset (OK)
+		call sfree (sp)
+		return (EOF)
+
+	    case KW_MARKCUR:
+		# Enable marking of the cursor position when the cursor is read.
+		RC_MARKCUR(rc) = grc_boolval (opstr, ip)
+
+	    case KW_OFF:
+		# Disable the listed keys.
+		call grc_keys (rc, opstr, ip, 0)
+
+	    case KW_ON:
+		# Enable or set the listed keys.
+		call grc_keys (rc, opstr, ip, 1)
+
+	    case KW_PAGE:
+		# Enable screen clear when ?, show, etc. print text.
+		TR_PAGE(tr) = grc_boolval (opstr, ip)
+
+	    case KW_READ:
+		# Fill the frame buffer from a metacode spool file.
+
+		call grc_word (opstr, ip, Memc[fname], SZ_FNAME)
+		call grc_read (tr, stream, Memc[fname])
+
+	    case KW_SHOW:
+		# Show status of RCURSOR and GIOTR.
+
+		call gtr_page (STDERR, stream)
+		call fprintf (STDERR, "Cursor Mode Parameters:\n\n")
+		call grc_status (STDERR, rc)
+
+		call fprintf (STDERR, "\n\nGraphics Kernel Status:\n\n")
+		call gtr_status (STDERR)
+
+	    case KW_SNAP:
+		# Write a snapshot of the screen to a plotter.  Open a subkernel
+		# on STDPLOT, redraw the screen into the STDPLOT fio buffer,
+		# flush the buffered metacode to the kernel, then restore
+		# everything.  NOTE: should restore things automatically if an
+		# interrupt occurs.
+
+		call stg_putline (STDERR, " - ")
+		call grc_word (opstr, ip, Memc[fname], SZ_FNAME)
+		iferr (p_tr = grc_open (Memc[fname], NEW_FILE, STDPLOT, rc)) {
+		    call grc_warn (STDERR)
+		    goto exit_
+		}
+
+		call gki_redir (stream, STDPLOT, save1, save2)
+		call fseti (STDPLOT, F_CANCEL, OK)
+
+		iferr {
+		    call gtr_redraw (stream)
+		    call gki_flush (STDPLOT)
+		} then
+		    call grc_warn (STDERR)
+
+		call gki_redir (stream, 0, save1, save2)
+
+		auto_gflush = (ttygeti (TR_TTY(p_tr), "MF") <= 1)
+		call grc_close (STDPLOT, rc)
+
+		if (auto_gflush)
+		    call gtr_gflush (STDPLOT)
+
+		call stg_putline (STDERR, " done")
+
+	    case KW_VIEWPORT:
+		# Set the viewport in world coordinates.
+		call grc_viewport (tr, stream,
+		    sx, sy, raster, rx, ry, opstr, ip)
+
+	    case KW_WRITE:
+		# Save the contents of the frame buffer in a file.
+		# "w!" clobbers any existing file and "w+" writes the
+		# full frame.  By default the frame is appended to the
+		# output file.
+
+		if (opstr[ip] == '!') {
+		    clobber = true
+		    ip = ip + 1
+		} else
+		    clobber = false
+
+		if (opstr[ip] == '+') {
+		    fullframe = true
+		    ip = ip + 1
+		} else
+		    fullframe = false
+
+		# Extract the filename.
+		call grc_word (opstr, ip, Memc[fname], SZ_FNAME)
+
+		# Write to the spoolfile.
+		call grc_write (tr, stream, Memc[fname], clobber, fullframe)
+
+	    case KW_XRES:
+		# Set the stdgraph X resolution.
+		xres = nint (grc_realval (opstr, ip))
+		yres = 0
+		call stg_resolution (xres, yres)
+
+	    case KW_YRES:
+		# Set the stdgraph Y resolution.
+		xres = 0
+		yres = nint (grc_realval (opstr, ip))
+		call stg_resolution (xres, yres)
+
+	    case KW_TXQUALITY:
+		# Set character generator quality.
+
+		while (IS_WHITE(opstr[ip]))
+		    ip = ip + 1
+
+		switch (opstr[ip]) {
+		case 'l':
+		    quality = GT_LOW
+		case 'm':
+		    quality = GT_MEDIUM
+		case 'h':
+		    quality = GT_HIGH
+		default:
+		    quality = 0
+		}
+		call stg_txquality (quality)
+
+	    case KW_TXSET:
+		# Set the text drawing attributes.
+		call gtxset (TR_TXAP(tr), opstr, ip)
+
+	    case KW_ZERO:
+		# Reset and redraw.
+		call gtr_ptran (stream, 0., 1., 0., 1.)
+		call gtr_writecursor (stream, .5, .5)
+		call gtr_redraw (stream)
+	    }
+
+	    # Advance to the next statement or the end of string.  Any unused
+	    # characters in the statement just processed are discarded.
+
+	    while (opstr[ip] != ';' && opstr[ip] != EOS)
+		ip = ip + 1
+	    while (opstr[ip] == ';' || opstr[ip] == '.')
+		ip = ip + 1
+	}
+exit_
+	# Restore the terminal to graphics mode if gtr_page was not called to
+	# deactivate the ws. (this leaves the waitpage flag set).
+
+	if (TR_WAITPAGE(tr) == NO)
+	    call stg_putline (STDERR, "\n")
+
+	# Leave the graphics descriptor set up as we found it.
+	tr = gtr_init (stream)
+
+	call flush (STDERR)
+	call sfree (sp)
+	return (OK)
+end
+
+
+# GRC_WORD -- Extract the next whitespace delimited word from the command line.
+
+procedure grc_word (opstr, ip, outstr, maxch)
+
+char	opstr[ARB]		# input string
+int	ip			# pointer into input string
+char	outstr[ARB]		# output string
+int	maxch			# max chars out
+int	op
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	op = 1
+	while (!IS_WHITE (opstr[ip]) && opstr[ip] != EOS) {
+	    outstr[op] = opstr[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+
+	outstr[op] = EOS
+end
+
+
+# GRC_BOOL -- Get the boolean value of a parameter.  Upon entry, the input
+# pointer is positioned to the first character following the parameter name.
+
+int procedure grc_boolval (opstr, ip)
+
+char	opstr[ARB]			# command string
+int	ip				# input pointer
+int	value
+int	btoi()
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	if (opstr[ip] == '=') {
+	    ip = ip + 1
+	    while (IS_WHITE (opstr[ip]))
+		ip = ip + 1
+	    value = btoi (opstr[ip] != 'n' && opstr[ip] != 'N')
+	    while (IS_ALPHA (opstr[ip]))
+		ip = ip + 1
+	} else
+	    value = btoi (opstr[ip] != '-')
+
+	return (value)
+end
+
+
+# GRC_REALVAL -- Get the real value of a parameter.  Upon entry, the input
+# pointer is positioned to the first character following the parameter name.
+# Zero is returned if no value is given.
+
+real procedure grc_realval (opstr, ip)
+
+char	opstr[ARB]			# command string
+int	ip				# input pointer
+real	value
+int	ctor()
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+	if (opstr[ip] == '=')
+	    ip = ip + 1
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	if (ctor (opstr, ip, value) <= 0)
+	    value = 0
+
+	return (value)
+end
+
+
+# GRC_KEYS -- Enable the listed keys or ranges of keys.  The operation is
+# additive, i.e., only the named keys are affected.
+
+procedure grc_keys (rc, opstr, ip, onoff)
+
+pointer	rc			# rcursor descriptor
+char	opstr[ARB]		# command string
+int	ip			# next char in opstr
+int	onoff			# set keys on (1) or off (0)
+
+int	new_value
+int	ch, ch1, ch2, ip_start, i
+string	keys KEYSTROKES
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	ip_start = ip
+	for (ch=opstr[ip];  ch != EOS;  ch=opstr[ip]) {
+	    if (ch == ';' || ch == '\n' || IS_WHITE(ch))
+		break
+
+	    ch1 = ch
+	    if (opstr[ip+1] == '-' && opstr[ip+2] != EOS) {
+		# Enable a range of keys.
+		ip  = ip + 2
+		ch2 = opstr[ip]
+	    } else if (opstr[ip+1] == '=' && opstr[ip+2] != EOS) {
+		# Assign the value of a key.
+		ip = ip + 3
+		RC_KEYS(rc,ch) = opstr[ip]
+		next
+	    } else
+		ch2 = ch
+
+	    for (ch=ch1;  ch <= ch2;  ch=ch+1) {
+		if (onoff == 0)
+		    new_value = 0
+		else
+		    new_value = ch
+		RC_KEYS(rc,ch) = new_value
+	    }
+
+	    ip = ip + 1
+	}
+
+	# If no keys were listed, set all cursor mode keys.
+	if (ip == ip_start)
+	    for (i=1;  keys[i] != EOS;  i=i+1) {
+		ch = keys[i]
+		if (onoff == 0)
+		    new_value = 0
+		else
+		    new_value = ch
+		RC_KEYS(rc,ch) = new_value
+	    }
+		
+	# The ":" key cannot be mapped or disabled.
+	RC_KEYS(rc,':') = ':'
+end
+
+
+# GRC_VIEWPORT -- Set the viewport in world coordinates.  Use the current
+# cursor position to determine the WCS, then convert the world coordinates
+# of the viewport given by the user into NDC coordinates and set the work-
+# station transformation.
+
+procedure grc_viewport (tr, stream, sx, sy, raster, rx, ry, opstr, ip)
+
+pointer	tr			#I giotr descriptor
+int	stream			#I graphics stream
+real	sx, sy			#I screen coordinates of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coordinates of cursor
+char	opstr[ARB]		#I command string
+int	ip			#I input pointer
+
+pointer	w
+int	i, wcs
+real	wx, wy, value
+real	vn[4], vw[4], ct[LEN_CT]
+int	ctor()
+
+begin
+	# Select a WCS.  We are not otherwise interested in the cursor value.
+	call grc_scrtowcs (stream, sx, sy, raster, rx, ry, wx, wy, wcs)
+	w = TR_WCSPTR(tr,wcs)
+	call grc_settran (w, ct)
+
+	# Start with the current viewport.
+	call gtr_gtran (stream, vn[1], vn[2], vn[3], vn[4])
+
+	# Transform to world coordinates.
+	call grc_ndctowcs (ct, vn[1], vn[3], vw[1], vw[3])
+	call grc_ndctowcs (ct, vn[2], vn[4], vw[2], vw[4])
+
+	# Get the new viewport (world) coordinates.
+	do i = 1, 4
+	    if (ctor (opstr, ip, value) <= 0)
+		break
+	    else
+		vw[i] = value
+
+	# Transform to NDC coordinates.
+	call grc_wcstondc (ct, vw[1], vw[3], vn[1], vn[3])
+	call grc_wcstondc (ct, vw[2], vw[4], vn[2], vn[4])
+
+	# Set the new workstation transformation.
+	call gtr_ptran (stream, vn[1], vn[2], vn[3], vn[4])
+
+	# Redraw the screen.
+	call gtr_redraw (stream)
+end
diff --git a/sys/gio/cursor/grcinit.x b/sys/gio/cursor/grcinit.x
new file mode 100644
index 00000000..3160203c
--- /dev/null
+++ b/sys/gio/cursor/grcinit.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"grc.h"
+
+# GRC_INIT -- Initialize the rcursor descriptor.  Allocate storage for the
+# descriptor and initialize all variables and the keystroke mapping.
+
+procedure grc_init (rc)
+
+pointer	rc			#U grc descriptor (pointer)
+
+int	ip, ch
+string	keys KEYSTROKES
+errchk	malloc
+
+begin
+	if (rc == NULL)
+	    call malloc (rc, LEN_RCSTRUCT, TY_STRUCT)
+	call aclri (Memi[rc], LEN_RCSTRUCT)
+
+	# Initialize variables.
+	RC_CASE(rc) = YES
+	RC_MARKCUR(rc) = NO
+	RC_PHYSOPEN(rc) = NO
+
+	# Initialize keystrokes.
+	for (ip=1;  keys[ip] != EOS;  ip=ip+1) {
+	    ch = keys[ip]
+	    RC_KEYS(rc,keys[ip]) = ch
+	}
+end
diff --git a/sys/gio/cursor/grcopen.x b/sys/gio/cursor/grcopen.x
new file mode 100644
index 00000000..8a39d191
--- /dev/null
+++ b/sys/gio/cursor/grcopen.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_OPEN -- Open the workstation.  Most commonly used to reopen the
+# workstation for a cursor read after plotting.
+
+pointer procedure grc_open (device, mode, stream, rc)
+
+char	device[ARB]		# device name (optional)
+int	mode			# desired access mode
+int	stream			# graphics stream
+pointer	rc			# rcursor descriptor
+
+pointer	sp, devname, envvar, tr
+int	envgets()
+bool	streq()
+pointer	gtr_init()
+
+include	"gtr.com"
+string	stdgraph "stdgraph"
+string	stdimage "stdimage"
+string	stdplot  "stdplot"
+errchk	syserrs, gtr_openws, gki_openws, gtr_init
+
+begin
+	call smark (sp)
+	call salloc (envvar,  SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	tr = gtr_init (stream)
+
+	# If the workstation is already connected and the kernel is open
+	# issue the openws directive if it has not already been issued.
+
+	if (TR_DEVNAME(tr) != EOS)
+	    if (device[1] == EOS || streq (device, TR_DEVNAME(tr))) {
+		# Kernel is already physically open on this stream.  Activate
+		# it if necessary; record whether or not is was active when
+		# we were called, so that we can restore the original state
+		# when grc_close() is called.
+
+		if (TR_WSOPEN(tr) <= 0) {
+		    call gki_openws (stream, TR_DEVNAME(tr), mode)
+		    TR_WSACTIVE(tr) = YES
+		    TR_WSACTSAVE(tr) = NO
+		} else {
+		    TR_WSACTSAVE(tr) = TR_WSACTIVE(tr)
+		    call gki_reactivatews (stream, 0)
+		    TR_WSACTIVE(tr) = YES
+		}
+
+		call gki_fflush (stream)
+
+		TR_WSOPEN(tr) = TR_WSOPEN(tr) + 1
+		call sfree (sp)
+		return (tr)
+	    }
+
+	# If no device name given fetch the device name from the environment.
+
+	if (device[1] == EOS) {
+	    switch (stream) {
+	    case STDGRAPH:
+		call strcpy (stdgraph, Memc[envvar], SZ_FNAME)
+	    case STDIMAGE:
+		call strcpy (stdimage, Memc[envvar], SZ_FNAME)
+	    default:
+		call strcpy (stdplot,  Memc[envvar], SZ_FNAME)
+	    }
+
+	    # Convert environment variable name into device name.  Indirection
+	    # and assumption of the value of "terminal" are allowed.
+
+	    repeat {
+		if (envgets (Memc[envvar], Memc[devname], SZ_FNAME) <= 0)
+		    call syserrs (SYS_ENVNF, Memc[envvar])
+		if (Memc[devname] == '@') {
+		    # Indirection in environment variable name.
+		    call strcpy (Memc[devname+1], Memc[envvar], SZ_FNAME)
+		} else if (streq (Memc[devname], "terminal")) {
+		    call strcpy (Memc[devname], Memc[envvar], SZ_FNAME)
+		} else
+		    break
+	    }
+	} else
+	    call strcpy (device, Memc[devname], SZ_FNAME)
+
+	# Open the workstation (kernel) on stream FD.
+	call gtr_openws (Memc[devname], mode, stream, NULL)
+
+	TR_WSOPEN(tr) = TR_WSOPEN(tr) + 1
+	TR_WSACTSAVE(tr) = NO
+	TR_WSACTIVE(tr) = YES
+
+	call gki_openws (stream, Memc[devname], mode)
+	call gki_fflush (stream)
+
+	call sfree (sp)
+	return (tr)
+end
diff --git a/sys/gio/cursor/grcpl.x b/sys/gio/cursor/grcpl.x
new file mode 100644
index 00000000..7768bf85
--- /dev/null
+++ b/sys/gio/cursor/grcpl.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+include	"gtr.h"
+include "grc.h"
+
+# GRC_POLYLINE -- Draw a solid polyline.  The instruction is encoded and
+# appended to the frame buffer and GIOTR is called to draw the line,
+# possibly applying the workstation transformation in the process.
+
+procedure grc_polyline (stream, v, npts)
+
+int	stream			# graphics stream
+real	v[ARB]			# polyline, NDC units
+int	npts			# number of points (coord pairs) in polyline
+
+pointer	tr, sp, p, pl, op, last_op
+int	nwords, fd, save1, save2, i
+int	stropen()
+pointer	gtr_init(), gtr_writep()
+errchk	gtr_init, gtr_writep, gki_redir
+
+begin
+	call smark (sp)
+	call salloc (p, npts * 2, TY_SHORT)
+
+	tr = gtr_init (stream)
+
+	# Transform the type real, NDC polyline to GKI units, type short.
+	do i = 1, npts * 2, 2 {
+	    Mems[p+i-1] = v[i  ] * GKI_MAXNDC
+	    Mems[p+i  ] = v[i+1] * GKI_MAXNDC
+	}
+
+	# Allocate space in the frame buffer for the polyline set attribute
+	# and line drawing instructions.  Set the last op for undo to undo
+	# the line.  This is also set by writep, hence we must wait to set
+	# TR_LASTOP until after the call to writep.
+
+	last_op = TR_OP(tr)
+	nwords = GKI_PLSET_LEN + GKI_POLYLINE_LEN + (npts * 2)
+	op = gtr_writep (stream, nwords)
+	TR_LASTOP(tr) = last_op
+
+	# Open the frame buffer as a file and redirect the graphics stream
+	# output into the buffer.
+
+	fd = stropen (Mems[op], nwords, NEW_FILE) 
+	call gki_redir (stream, fd, save1, save2)
+
+	# Output a polyline set attribute instruction to ensure that a solid
+	# line is drawn.  Output the polyline.
+
+	pl = TR_PLAP(tr)
+	call gki_plset (stream, pl)
+	call gki_polyline (stream, Mems[p], npts)
+
+	# Restore the normal output for the stream.
+	call gki_redir (stream, 0, save1, save2)
+	call close (fd)
+
+	# Call giotr to send the new instructions off the to the kernel,
+	# optionally applying the workstation transformation in the process.
+
+	call giotr (stream)
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/grcread.x b/sys/gio/cursor/grcread.x
new file mode 100644
index 00000000..ce95fc07
--- /dev/null
+++ b/sys/gio/cursor/grcread.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<gio.h>
+include	"gtr.h"
+
+# GRC_READ -- Fill the frame buffer from a metacode spool file and redraw
+# the screen.  The contents of the frame buffer are overwritten.
+
+procedure grc_read (tr, stream, fname)
+
+pointer	tr			# graphics descriptor
+int	stream			# graphics stream
+char	fname[ARB]		# metacode file
+
+pointer	sp, lbuf, op
+int 	fd, nchars, filelen
+long	fstatl()
+pointer	gtr_writep()
+int	open(), read()
+errchk	read
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	iferr (fd = open (fname, READ_ONLY, BINARY_FILE)) {
+	    call grc_message (stream, " - cannot open file")
+	    call sfree (sp)
+	    return
+	}
+
+	filelen = fstatl (fd, F_FILESIZE)
+	call sprintf (Memc[lbuf], SZ_LINE, " - file size %d chars")
+	    call pargi (filelen)
+	call grc_message (stream, Memc[lbuf])
+
+	# Discard the current frame.
+	call gtr_frame (tr, TR_FRAMEBUF(tr), stream)
+
+	# Read new frame buffer.
+	nchars = filelen
+	if (nchars <= 0)
+	    goto err_
+	op = gtr_writep (stream, nchars)
+	if (read (fd, Mems[op], nchars) < nchars)
+	    goto err_
+
+	# Redraw the new frame buffer.
+	call gtr_redraw (stream)
+
+	call close (fd)
+	call sfree (sp)
+	return
+err_
+	call close (fd)
+	call grc_message (stream, " [READ ERROR]")
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/grcredraw.x b/sys/gio/cursor/grcredraw.x
new file mode 100644
index 00000000..4317db96
--- /dev/null
+++ b/sys/gio/cursor/grcredraw.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"grc.h"
+
+# GRC_REDRAW -- Redraw the screen, and, if the "axes" flag is set, draw the axes
+# of the plot.
+
+procedure grc_redraw (rc, stream, sx, sy, raster, rx, ry)
+
+pointer	rc			#I rcursor descriptor
+int	stream			#I graphics stream
+real	sx, sy			#I screen coords of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coords of cursor
+
+begin
+	call gtr_redraw (stream)
+	if (RC_AXES(rc) == YES)
+	    call grc_axes (stream, sx, sy, raster, rx, ry)
+end
diff --git a/sys/gio/cursor/grcscr.x b/sys/gio/cursor/grcscr.x
new file mode 100644
index 00000000..add322b4
--- /dev/null
+++ b/sys/gio/cursor/grcscr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GRC_SCRTONDC -- Coordinate transformation from screen coordinates to NDC
+# coordinates.  Screen coordinates physically address the device screen and
+# range from 0 to 1 in either axis.  NDC coordinates also range from 0 to 1
+# in either axis but differ from screen coordinates when the workstation
+# transformation is non unitary.  The workstation transformation parameters
+# are cached in the GTR common.  We assume that GTR_INIT has already been
+# called to initialize the common for a graphics stream.
+
+procedure grc_scrtondc (sx, sy, mx, my)
+
+real	sx, sy			# screen coordinates (input)
+real	mx, my			# NDC coordinates (output)
+include	"gtr.com"
+
+begin
+	if (wstranset == YES) {
+	    mx = ((sx * GKI_MAXNDC - xorigin) / xscale + mx1) / GKI_MAXNDC
+	    my = ((sy * GKI_MAXNDC - yorigin) / yscale + my1) / GKI_MAXNDC
+	} else {
+	    mx = sx
+	    my = sy
+	}
+end
+ 
+
+# GRC_NDCTOSCR -- Coordinate transformation from NDC coordinates to screen
+# coordinates.
+
+procedure grc_ndctoscr (mx, my, sx, sy)
+
+real	mx, my			# NDC coordinates (input)
+real	sx, sy			# screen coordinates (output)
+include	"gtr.com"
+
+begin
+	if (wstranset == YES) {
+	    sx = ((mx * GKI_MAXNDC - mx1) * xscale + xorigin) / GKI_MAXNDC
+	    sy = ((my * GKI_MAXNDC - my1) * yscale + yorigin) / GKI_MAXNDC
+	} else {
+	    sx = mx
+	    sy = my
+	}
+end
diff --git a/sys/gio/cursor/grcstatus.x b/sys/gio/cursor/grcstatus.x
new file mode 100644
index 00000000..55f44f18
--- /dev/null
+++ b/sys/gio/cursor/grcstatus.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_STATUS -- Called by ":.show" to print the values of the cursor mode
+# parameters.
+
+procedure grc_status (fd, rc)
+
+int	fd			# output file
+pointer	rc			# rcursor descriptor
+
+int	ip, ch
+string	keys KEYSTROKES
+include	"gtr.com"
+
+begin
+	call fprintf (fd, "\tcase\t= %b\n")
+	    call pargi (RC_CASE(rc))
+	call fprintf (fd, "\tmarkcur\t= %b\n")
+	    call pargi (RC_MARKCUR(rc))
+	call fprintf (fd, "\taxes\t= %b\n")
+	    call pargi (RC_AXES(rc))
+
+	if (wstranset == YES) {
+	    call fprintf (fd, "\tview\t= %5.3f %5.3f %5.3f %5.3f\n")
+		call pargr (vx1)
+		call pargr (vx2)
+		call pargr (vy1)
+		call pargr (vy2)
+	} else
+	    call fprintf (fd, "\tview\t= full screen\n")
+
+	call fprintf (fd, "\tkeys\t= %s\n")
+	    call pargstr (keys)
+	call fprintf (fd, "\t\t->")
+	    
+	for (ip=1;  keys[ip] != EOS;  ip=ip+1) {
+	    ch = RC_KEYS(rc,keys[ip])
+	    if (ch != 0)
+		call putci (fd, ch)
+	    else
+		call putci (fd, ' ')
+	}
+
+	call fprintf (fd, "\n")
+end
diff --git a/sys/gio/cursor/grctext.x b/sys/gio/cursor/grctext.x
new file mode 100644
index 00000000..5bee9b34
--- /dev/null
+++ b/sys/gio/cursor/grctext.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+include	"gtr.h"
+include "grc.h"
+
+# GRC_TEXT -- Draw a text string.  The instruction is encoded and appended to
+# the frame buffer and GIOTR is called to draw the new instructions.
+
+procedure grc_text (stream, x, y, text)
+
+int	stream			# graphics stream
+real	x, y			# NDC coordinates of ll corner of first char
+char	text[ARB]		# text string
+
+pointer	tr, op, last_op
+int	fd, save1, save2, nwords
+int	stropen(), strlen()
+pointer	gtr_init(), gtr_writep()
+errchk	gtr_init, stropen, gki_redir
+
+begin
+	tr = gtr_init (stream)
+
+	# Allocate space in the frame buffer for the text set attribute
+	# and text drawing instructions.  Set the last op for undo to undo
+	# the line.  This is also set by writep, hence we must wait to set
+	# TR_LASTOP until after the call to writep.
+
+	last_op = TR_OP(tr)
+	nwords = GKI_TXSET_LEN + GKI_TEXT_LEN + strlen(text)
+	op = gtr_writep (stream, nwords)
+	TR_LASTOP(tr) = last_op
+
+	# Open the frame buffer as a file and redirect the graphics stream
+	# output into the buffer.
+
+	fd = stropen (Mems[op], nwords, NEW_FILE) 
+	call gki_redir (stream, fd, save1, save2)
+
+	# Output the set text attribute instruction and the text drawing
+	# instruction.
+
+	call gki_txset (stream, TR_TXAP(tr))
+	call gki_text (stream, nint(x*GKI_MAXNDC), nint(y*GKI_MAXNDC), text)
+
+	# Restore the normal output for the stream.
+	call gki_redir (stream, 0, save1, save2)
+	call close (fd)
+
+	# Call giotr to send the new instructions off to the kernel, optionally
+	# applying the workstation transformation in the process.
+
+	call giotr (stream)
+end
diff --git a/sys/gio/cursor/grcwarn.x b/sys/gio/cursor/grcwarn.x
new file mode 100644
index 00000000..ba9fcb0e
--- /dev/null
+++ b/sys/gio/cursor/grcwarn.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GRC_WARN -- Called in an error handler to intercept an error message string
+# and write it to the workstation in the status line.
+
+procedure grc_warn (fd)
+
+int	fd			# output stream
+
+int	errcode
+pointer	sp, msg, ip
+int	errget()
+
+begin
+	call smark (sp)
+	call salloc (msg, SZ_LINE, TY_CHAR)
+
+	errcode = errget (Memc[msg], SZ_LINE)
+	for (ip=msg;  Memc[ip] != EOS && Memc[ip] != '\n';  ip=ip+1)
+	    ;
+	Memc[ip] = EOS
+
+	call stg_putline (fd, " - ")
+	call stg_putline (fd, Memc[msg])
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/grcwcs.x b/sys/gio/cursor/grcwcs.x
new file mode 100644
index 00000000..7c73657a
--- /dev/null
+++ b/sys/gio/cursor/grcwcs.x
@@ -0,0 +1,282 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_SCRTOWCS -- Transform screen coordinates (raw cursor coordinates) to
+# world coordinates.  This is not terribly efficient, but it does not matter
+# for cursor mode applications which do not involve many coordinate
+# transformations.
+
+procedure grc_scrtowcs (stream, sx, sy, raster, rx, ry, wx, wy, wcs)
+
+int	stream			#I graphics stream
+real	sx, sy			#I screen coordinates
+int	raster			#I raster number
+real	rx, ry			#I raster coordinates
+real	wx, wy			#O world coordinates
+int	wcs			#O world coordinate system
+
+pointer	w, tr
+real	mx, my
+real	ct[LEN_CT]
+int	grc_selectwcs()
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+
+	# Convert screen (raster 0) to NDC coordinates, undoing the effects
+	# of the workstation transformation.  This is not done for raster
+	# coordinates since these are already raster-normalized coordinates
+	# as returned by the server.
+
+	if (raster == 0)
+	    call grc_scrtondc (rx, ry, mx, my)
+	else {
+	    mx = rx
+	    my = ry
+	}
+
+	# Select a WCS.  The TR_WCS variable is set only if the user
+	# explicitly fixes the WCS to override automatic selection.  The
+	# best WCS for the raster is used if there is one, otherwise the
+	# best screen WCS is used.
+
+	if (TR_WCS(tr) == NULL) {
+	    wcs = grc_selectwcs (tr, raster, mx, my)
+	    if (wcs == 0) {
+		call grc_scrtondc (sx, sy, mx, my)
+		wcs = grc_selectwcs (tr, 0, mx, my)
+	    }
+	} else
+	    wcs = TR_WCS(tr)
+
+	# Set up the coordinate transformation.
+	w = TR_WCSPTR(tr,wcs)
+	call grc_settran (w, ct)
+
+	# Transform NDC coordinates to WCS coordinates.
+	call grc_ndctowcs (ct, mx, my, wx, wy)
+end
+
+
+# GRC_SETTRAN -- Set up the coordinate transformation parameters for a given
+# world coordinate system.
+
+procedure grc_settran (w, ct)
+
+pointer	w				# window descriptor
+real	ct[LEN_CT]			# transformation descriptor
+
+real	worigin, scale
+real	m1, m2, w1, w2
+int	transformation, ax
+bool	fp_equalr()
+real	elogr()
+
+begin
+	# Compute world -> NDC coordinate transformation.
+
+	do ax = 1, 2 {
+	    if (ax == 1) {
+		transformation = WCS_XTRAN(w)
+		w1 = WCS_WX1(w)
+		w2 = WCS_WX2(w)
+		m1 = WCS_SX1(w)
+		m2 = WCS_SX2(w)
+	    } else {
+		transformation = WCS_YTRAN(w)
+		w1 = WCS_WY1(w)
+		w2 = WCS_WY2(w)
+		m1 = WCS_SY1(w)
+		m2 = WCS_SY2(w)
+	    }
+
+	    if (transformation == LINEAR) {
+		worigin = w1
+		if (fp_equalr (w1, w2))
+		    scale = 1.0
+		else
+		    scale = (m2 - m1) / (w2 - w1)
+	    } else if (transformation == LOG && w1 > 0 && w2 > 0) {
+		worigin = log10 (w1)
+		if (fp_equalr (log10(w2), worigin))
+		    scale = 1.0
+		else
+		    scale = (m2 - m1) / (log10(w2) - worigin)
+	    } else {
+		worigin = elogr (w1)
+		if (fp_equalr (elogr(w2), worigin))
+		    scale = 1.0
+		else
+		    scale = (m2 - m1) / (elogr(w2) - worigin)
+	    }
+
+	    ct[ax,CT_TRAN]    = transformation
+	    ct[ax,CT_SCALE]   = scale
+	    ct[ax,CT_WORIGIN] = worigin
+	    ct[ax,CT_MORIGIN] = m1
+	}
+end
+
+
+# GRC_WCSTONDC -- Transform world coordinates to NDC coordinates using the
+# computed transformation parameters.
+
+procedure grc_wcstondc (ct, wx, wy, mx, my)
+
+real	ct[LEN_CT]		# coordinate transformation descriptor
+real	wx, wy			# world coordinates of point
+real	mx, my			# ndc coordinates of point
+
+real	v
+int	transformation, ax
+real	elogr()
+
+begin
+	do ax = 1, 2 {
+	    transformation = nint (ct[ax,CT_TRAN])
+	    if (ax == 1)
+		v = wx
+	    else
+		v = wy
+
+	    if (transformation == LINEAR)
+		;
+	    else if (transformation == LOG)
+		v = log10 (v)
+	    else
+		v = elogr (v)
+
+	    v = ((v - ct[ax,CT_WORIGIN]) * ct[ax,CT_SCALE]) + ct[ax,CT_MORIGIN]
+	    if (ax == 1)
+		mx = v
+	    else
+		my = v
+	}
+end
+
+
+# GRC_NDCTOWCS -- Transform NDC coordinates to world coordinates using the
+# computed transformation parameters.
+
+procedure grc_ndctowcs (ct, mx, my, wx, wy)
+
+real	ct[LEN_CT]		# coordinate transformation descriptor
+real	mx, my			# ndc coordinates of point
+real	wx, wy			# world coordinates of point
+
+real	v
+int	transformation, ax
+real	aelogr()
+
+begin
+	do ax = 1, 2 {
+	    transformation = nint (ct[ax,CT_TRAN])
+	    if (ax == 1)
+		v = mx
+	    else
+		v = my
+
+	    v = ((v - ct[ax,CT_MORIGIN]) / ct[ax,CT_SCALE]) + ct[ax,CT_WORIGIN]
+	    if (transformation == LINEAR)
+		;
+	    else if (transformation == LOG)
+		v = 10.0 ** v
+	    else
+		v = aelogr (v)
+
+	    if (ax == 1)
+		wx = v
+	    else
+		wy = v
+	}
+end
+
+
+# GRC_SELECTWCS -- Select the WCS nearest to the given position in NDC
+# coordinates.  If the point falls within a single WCS then that WCS is
+# selected.  If the point falls within multiple WCS then the closest WCS
+# is selected.  If multiple (non unitary) WCS are defined at the same
+# distance, e.g., when the WCS share the same viewport, then the highest
+# numbered WCS is selected.
+
+int procedure grc_selectwcs (tr, raster, mx, my)
+
+pointer	tr			#I GTR descriptor
+int	raster			#I raster number
+real	mx, my			#I NDC coordinates of point
+
+pointer	w
+int	wcs, closest_wcs, flags
+real	tol, sx1, sx2, sy1, sy2
+real	distance, old_distance, xcen, ycen
+int	nin, in[MAX_WCS]
+
+begin
+	nin = 0
+	closest_wcs = 0
+	old_distance = 1.0
+	tol = EPSILON * 10.0
+
+	# Inspect each WCS.  All WCS are passed even though only one or two
+	# WCS will be set to nonunitary values for a given plot.  Omitting
+	# the unitary WCS, determine the closest WCS and make a list of the
+	# WCS containing the given point.
+
+	do wcs = 1, MAX_WCS {
+	    w = TR_WCSPTR(tr,wcs)
+
+	    # Cache WCS params in local storage.
+	    sx1 = WCS_SX1(w)
+	    sx2 = WCS_SX2(w)
+	    sy1 = WCS_SY1(w)
+	    sy2 = WCS_SY2(w)
+	    flags = WCS_FLAGS(w)
+	    xcen = (sx1 + sx2) / 2.0
+	    ycen = (sy1 + sy2) / 2.0
+
+	    # Skip to next WCS if the raster number doesn't match.
+	    if (WF_RASTER(flags) != raster)
+		next
+
+	    # Skip to next WCS if this one is not defined.
+	    if (and (flags, WF_NEWFORMAT) == 0) {
+		# Preserve old semantics if passed old format WCS.
+		if (sx1 == 0 && sx2 == 0 || sy1 == 0 && sy2 == 0)
+		    next
+		if (abs ((sx2-sx1) - 1.0) < tol && abs ((sy2-sy1) - 1.0) < tol)
+		    next
+	    } else if (and (flags, WF_DEFINED) == 0)
+		next
+
+	    # Determine closest WCS to point (mx,my).
+	    distance = ((mx - xcen) ** 2) + ((my - ycen) ** 2)
+	    if (distance <= old_distance) {
+		closest_wcs = wcs
+		old_distance = distance
+	    }
+
+	    # Check if point is inside this WCS.
+	    if (mx >= sx1 && mx <= sx2 && my >= sy1 && my <= sy2) {
+		nin = nin + 1
+		in[nin] = wcs
+	    }
+	}
+
+	# If point is inside exactly one non-unitary WCS then select that WCS.
+	if (nin == 1)
+	    return (in[1])
+
+	# If point is inside more than one WCS, or if point is not inside any
+	# WCS, select the closest WCS.  If multiple WCS are at the same
+	# distance we have already selected the higher numbered WCS due to
+	# the way the distance test is conducted, above.
+
+	return (closest_wcs)
+end
diff --git a/sys/gio/cursor/grcwrite.x b/sys/gio/cursor/grcwrite.x
new file mode 100644
index 00000000..c0a602a9
--- /dev/null
+++ b/sys/gio/cursor/grcwrite.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GRC_WRITE -- Write the contents of the frame buffer to a file, with or
+# without applying the workstation transformation, optionally clobbering
+# any existing file of the same name.
+
+procedure grc_write (tr, stream, fname, clobber, fullframe)
+
+pointer	tr			# graphics stream descriptor
+int	stream			# graphics stream
+char	fname[ARB]		# file name
+bool	clobber			# clobber existing file
+bool	fullframe		# write full frame (no workstation transform)
+
+pointer	sp, lbuf
+long	size1, size2
+int	save1, save2, fd, nchars
+long	fstatl()
+int	open()
+errchk	write, gtr_redraw
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	# Delete existing file if clobber requested.
+	if (clobber)
+	    iferr (call delete (fname))
+		;
+
+	# Open metacode spool file for appending.
+	iferr (fd = open (fname, APPEND, BINARY_FILE)) {
+	    call grc_message (stream, " - cannot open file for appending")
+	    call sfree (sp)
+	    return
+	}
+
+	# Write either the full frame or the displayed frame into spool file.
+
+	size1 = fstatl (fd, F_FILESIZE)
+	if (fullframe) {
+	    nchars = (TR_OP(tr) - TR_FRAMEBUF(tr)) * SZ_SHORT
+	    call write (fd, Mems[TR_FRAMEBUF(tr)], nchars)
+	} else {
+	    call gki_redir  (stream, fd, save1, save2)
+	    call gtr_redraw (stream)
+	    call gki_redir  (stream,  0, save1, save2)
+	}
+
+	size2 = fstatl (fd, F_FILESIZE)
+	call sprintf (Memc[lbuf], SZ_LINE, " - %d chars %s")
+	    call pargi (size2 - size1)
+	if (size1 > 0)
+	    call pargstr ("appended")
+	else
+	    call pargstr ("")
+	call grc_message (stream, Memc[lbuf])
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtr.com b/sys/gio/cursor/gtr.com
new file mode 100644
index 00000000..ae5c3ac6
--- /dev/null
+++ b/sys/gio/cursor/gtr.com
@@ -0,0 +1,25 @@
+# GTR.COM -- Polyline clipping common for the workstation transformation.
+# The length of this common in integer units from startcom to endcom inclusive
+# is a defined parameter in giotr.h.  Values within the save area are saved
+# in the TR descriptor for a device and loaded into the common (which serves
+# as a cache) when GIOTR or RCURSOR is called for a device.  LENGTH=28
+
+pointer	trdes[MAX_PSEUDOFILES]	# pointers to giotr descriptors
+int	tr_stream		# graphics stream currently in the cache
+int	startcom		# dummy entry marking start of common
+int	pl_op			# index of next cell in polyline array
+bool	last_point_inbounds	# last point was inbounds
+int	pl_type			# type of instruction (polyline, polymarker,...)
+int	wstranset		# workstation transformation has been set
+real	xscale, yscale		# scale factor, world to GKI, for transform
+real	xorigin, yorigin	# origins in GKI coords, for transform
+long	cx, cy			# current pen position, GKI coords
+long	mx1, mx2, my1, my2	# clipping viewport, GKI coords
+real	vx1, vx2, vy1, vy2	# NDC viewport, may extend beyond boundary
+long	xs[4], ys[4]		# last point plotted (for clipping code)
+int	endcom			# dummy entry marking end of saved area
+short	pl[LEN_PLBUF+5]		# output polyline buffer (plus GKI header)
+
+common	/gtrcom/ trdes, tr_stream, startcom, pl_op, last_point_inbounds,
+	pl_type, wstranset, xscale, yscale, xorigin, yorigin, cx, cy,
+	mx1, mx2, my1, my2, vx1, vx2, vy1, vy2, xs, ys, endcom, pl
diff --git a/sys/gio/cursor/gtr.h b/sys/gio/cursor/gtr.h
new file mode 100644
index 00000000..3fbf93f5
--- /dev/null
+++ b/sys/gio/cursor/gtr.h
@@ -0,0 +1,51 @@
+# GIOTR.H -- Global definitions for the GIOTR graphics i/o workstation
+# transformation and i/o program unit.  Note: requires <gio.h>.
+
+define	DEF_MAXLENFRAMEBUF	128000
+define	DEF_LENFRAMEBUF		8192
+define	INC_LENFRAMEBUF		4096
+define	DEF_LENSCRATCHBUF	256
+define	INC_LENSCRATCHBUF	256
+define	MAX_PSEUDOFILES		10
+define	SZ_TRDEVNAME		229
+define	SZ_KERNFNAME		259
+define	LEN_GTRCOM		28	# see "gtr.com"
+define	KSHIFT			10000	# encode pr ("etc$prpsio.x") such that
+					#
+					#    ((pr*KSHIFT)+stream) > LAST_FD
+					#
+					# see also <gio.h>
+
+define	LEN_TRSTRUCT	(564+204)
+
+define	TR_PID		Memi[$1]		# process id of kernel
+define	TR_IN		Memi[$1+1]		# input from process
+define	TR_OUT		Memi[$1+2]		# output to process
+define	TR_TTY		Memi[$1+3]		# graphcap descriptor
+define	TR_SPOOLDATA	Memi[$1+4]		# spool metacode instructions
+define	TR_FRAMEBUF	Memi[$1+5]		# pointer to frame buffer
+define	TR_LENFRAMEBUF	Memi[$1+6]		# length of the frame buffer
+define	TR_MAXLENFRAMEBUF Memi[$1+7]		# max length of the frame buffer
+define	TR_IP		Memi[$1+8]		# input pointer into frame buf
+define	TR_OP		Memi[$1+9]		# output pointer into frame buf
+define	TR_LASTOP	Memi[$1+10]		# last OP (for undo)
+define	TR_SCRATCHBUF	Memi[$1+11]		# for annotating plots
+define	TR_LENSCRATCHBUF Memi[$1+12]		# length of the scratch buffer
+define	TR_OPSB		Memi[$1+13]		# output pointer, scratch buf
+define	TR_NOPEN	Memi[$1+14]		# number of opens
+define	TR_REDIR	Memi[$1+15]		# redirection information
+define	TR_WCS		Memi[$1+16]		# WCS selected, 0 if none
+define	TR_PAGE		Memi[$1+17]		# clear screen for text
+define	TR_WAITPAGE	Memi[$1+18]		# grc_waitpage flag
+define	TR_WSOPEN	Memi[$1+19]		# workstation open count
+define	TR_SKIPOPEN	Memi[$1+20]		# skip wsopen in metacode
+define	TR_WSACTIVE	Memi[$1+21]		# workstation activated?
+define	TR_WSACTSAVE	Memi[$1+22]		# save old wsactive state
+define	TR_INTERACTIVE	Memi[$1+23]		# the user graphics terminal?
+			# (open)
+define	TR_TXAP		($1+30)			# text drawing attributes
+define	TR_PLAP		($1+40)			# text drawing attributes
+define	TR_DEVNAME	Memc[P2C($1+44)]	# device name
+define	TR_KERNFNAME	Memc[P2C($1+274)]	# name of kernel file (or "cl")
+define	TR_GTRCOM	Memi[$1+534]		# storage for the gtr common
+define	TR_WCSPTR	(($1)+564+($2)*LEN_WCS)	# WCS storage (0=not used)
diff --git a/sys/gio/cursor/gtrbackup.x b/sys/gio/cursor/gtrbackup.x
new file mode 100644
index 00000000..9ab13c0b
--- /dev/null
+++ b/sys/gio/cursor/gtrbackup.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_BACKUP -- Backup one drawing instruction in the frame buffer.  Erase
+# the graphics if possible.  The effects of this function may be undone by
+# the UNDO operator.
+
+procedure gtr_backup (stream)
+
+int	stream				# graphics stream
+
+int	opcode
+pointer	tr, op, bp, sp, ap
+pointer	gtr_init()
+errchk	gtr_init
+include	"gtr.com"
+
+begin
+	call smark (sp)
+	call salloc (ap, LEN_PL, TY_STRUCT)
+
+	tr = gtr_init (stream)
+
+	# Scan backward to the beginning of the last drawing instruction in the
+	# frame buffer.
+
+	op = TR_OP(tr)
+	bp = TR_FRAMEBUF(tr)
+	if (op <= bp) {
+	    call sfree (sp)
+	    return
+	}
+
+	repeat {
+	    op = op - 1
+	    while (Mems[op] != BOI)
+		if (op <= bp) {
+		    TR_OP(tr) = bp
+		    TR_IP(tr) = bp
+		    call sfree (sp)
+		    return
+		} else
+		    op = op - 1
+	    opcode = Mems[op+GKI_HDR_OPCODE-1]
+	} until (opcode >= GKI_POLYLINE && opcode <= GKI_PUTCELLARRAY)
+
+	# Redraw the last instruction to erase it (device permitting).
+	if (opcode == GKI_POLYLINE) {
+	    PL_LTYPE(ap) = GL_CLEAR
+	    PL_WIDTH(ap) = 1.0
+	    PL_COLOR(ap) = 1
+	    call gki_plset (stream, ap)
+
+	    if (wstranset == YES)
+		call gtr_wstran (Mems[op])
+	    else
+		call gki_write (stream, Mems[op])
+
+	    PL_LTYPE(ap) = GL_SOLID
+	    call gki_plset (stream, ap)
+	    call gki_fflush (stream)
+	}
+
+	# Return the space in the buffer.
+	TR_LASTOP(tr) = TR_OP(tr)
+	TR_OP(tr) = op
+	TR_IP(tr) = min (op, TR_IP(tr))
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrconn.x b/sys/gio/cursor/gtrconn.x
new file mode 100644
index 00000000..c2e6fb47
--- /dev/null
+++ b/sys/gio/cursor/gtrconn.x
@@ -0,0 +1,78 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# GTR_CONNECT -- Connect a subprocess containing a graphics kernel task to a
+# graphics stream.  The graphics kernel task is a conventional IRAF task 
+# linked into the kernel process.  After spawning the subprocess, we command
+# the process to run the named kernel task, then service the parameter
+# requests from the task as it begins running.  Graphics i/o will be via one
+# of the graphics streams, leaving STDIN, STDOUT, and STDERR free to access
+# the corresponding streams in the parent (the CL).  A kernel may be opened
+# either to drive a particular device (if devname is specified) or to drive
+# a device selected at runtime.  If the kernel is opened to drive a particular
+# device the device name in the OPENWS instruction will be ignored.  We require
+# that the graphics kernel begin processing metacode immediately after
+# receiving "yes" for the value of the parameter "generic", signifying that
+# the caller wishes a generic kernel, i.e., cannot return the values of any
+# kernel dependent parameters.
+
+int procedure gtr_connect (kernfname, taskname, devname, stream, in, out)
+
+char	kernfname[ARB]		# name of executable kernel file
+char	taskname[ARB]		# name of kernel task
+char	devname[ARB]		# device name or null string
+int	stream			# graphics stream to connect process to
+int	in, out			# input and output streams to process
+
+pointer	sp, lbuf
+int	pid
+bool	streq()
+int	propen(), getline()
+errchk	propen, flush, getline, syserr
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	pid = propen (kernfname, in, out)
+	call fprintf (out, "%s\n")
+	    call pargstr (taskname)
+	call flush (out)
+
+	# Pass values of the kernel parameters.  For a kernel run as
+	# part of the graphics system there are only three parameters,
+	# the input file name (STDGRAPH, etc. for a connected kernel)
+	# the device name if the kernel is to ignore device names in
+	# OPENWS instructions, and "generic=yes", signifying that the
+	# kernel dependent parameters are not to be requested.
+
+	while (getline (in, Memc[lbuf]) != EOF) {
+	    if (streq (Memc[lbuf], "=input\n")) {
+		call fprintf (out, "%s\n")
+		    switch (stream) {
+		    case STDGRAPH:
+			call pargstr ("STDGRAPH")
+		    case STDIMAGE:
+			call pargstr ("STDIMAGE")
+		    case STDPLOT:
+			call pargstr ("STDPLOT")
+		    }
+		call flush (out)
+	    } else if (streq (Memc[lbuf], "=device\n")) {
+		call fprintf (out, "%s\n")
+		    call pargstr (devname)
+		call flush (out)
+	    } else if (streq (Memc[lbuf], "=generic\n")) {
+		call putline (out, "yes\n")
+		call flush (out)
+		break
+	    } else {
+		call putline (STDERR, Memc[lbuf])
+		call syserr (SYS_GKERNPARAM)
+	    }
+	}
+
+	call sfree (sp)
+	return (pid)
+end
diff --git a/sys/gio/cursor/gtrctrl.x b/sys/gio/cursor/gtrctrl.x
new file mode 100644
index 00000000..8de08ccb
--- /dev/null
+++ b/sys/gio/cursor/gtrctrl.x
@@ -0,0 +1,122 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<prstat.h>
+include	<config.h>
+include	<fset.h>
+include	<gset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_CONTROL -- Execute a graphics control instruction, e.g., connect a
+# graphics kernel to a graphics stream and set or get the WCS for a frame.
+# The control instructions are GKI encoded instructions transmitted to the
+# pseudofile GIOCONTROL.  The PR_PSIO procedure (which processes the pseudofile
+# directives from a subprocess) calls us whenever data is sent to this
+# special pseudofile.
+
+procedure gtr_control (stream, gki, source_pid)
+
+int	stream			# graphics stream
+short	gki[ARB]		# encoded graphics control instruction
+int	source_pid		# pid of requesting process
+
+bool	redirected
+pointer	tr, sp, devname, gki_out
+int	flags, mode, nwords, fd, p_fd
+int	prstati(), pr_getredir()
+pointer	gtr_init(), coerce()
+errchk	gtr_init, gtr_openws, write, flush, gki_write
+include	"gtr.com"
+
+begin
+	call smark (sp)
+	call salloc (devname, SZ_TRDEVNAME, TY_CHAR)
+
+	nwords = gki[GKI_HDR_LENGTH]
+	call salloc (gki_out, nwords, TY_SHORT)
+	call amovs (gki, Mems[gki_out], nwords)
+
+	tr = gtr_init (stream)
+	p_fd = abs (pr_getredir (source_pid, stream))
+	redirected = (p_fd >= FIRST_FD && p_fd <= LAST_FD)
+
+	switch (gki[GKI_HDR_OPCODE]) {
+	case GKI_OPENWS:
+	    mode   = gki[GKI_OPENWS_M]
+	    nwords = gki[GKI_OPENWS_N]
+
+	    # Unpack the device name, passed as a short integer array.
+	    call achtsc (gki[GKI_OPENWS_D], Memc[devname], nwords)
+	    Memc[devname+nwords] = EOS
+
+	    # Connect the kernel.
+	    call fseti (stream, F_CANCEL, OK)
+	    call gtr_openws (Memc[devname], mode, stream, source_pid)
+
+	    # Count the logical openws.
+	    TR_WSOPEN(tr) = TR_WSOPEN(tr) + 1
+	    TR_WSACTIVE(tr) = YES
+	    TR_WSACTSAVE(tr) = NO
+
+	    # Due to a call to F_CANCEL in prpsio the openws instruction
+	    # spooled by gki_write below is being lost for subkernels,
+	    # so don't set the skipopen flag.  This causes giotr to pass
+	    # the openws on to the subkernel.  For inline kernels setting
+	    # skipopen prevents the openws from being executed twice.
+
+	    if (TR_INTERACTIVE(tr) == YES)
+		TR_SKIPOPEN(tr) = YES
+
+	    # If opening NEW_FILE, discard any previous WCS and clear the
+	    # frame buffer.
+
+	    if (mode == NEW_FILE) {
+		call aclri (Memi[TR_WCSPTR(tr,1)], LEN_WCS * MAX_WCS)
+		call gtr_frame (tr, TR_FRAMEBUF(tr), stream)
+	    }
+
+	case GKI_CLOSEWS:
+	    # Count the logical closews.
+	    TR_WSOPEN(tr) = TR_WSOPEN(tr) - 1
+	    TR_WSACTIVE(tr) = NO
+
+	case GKI_DEACTIVATEWS:
+	    TR_WSACTIVE(tr) = NO
+	    if (TR_INTERACTIVE(tr) == YES && TR_PAGE(tr) == NO) {
+		flags = gki[GKI_REACTIVATEWS_F]
+		if (and (flags, AW_CLEAR) != 0)
+		    Mems[gki_out+GKI_REACTIVATEWS_F-1] = flags - AW_CLEAR
+	    }
+
+	case GKI_REACTIVATEWS:
+	    TR_WSACTIVE(tr) = YES
+	    if (TR_INTERACTIVE(tr) == YES) {
+		flags = gki[GKI_REACTIVATEWS_F]
+		if (and (flags, AW_PAUSE) != 0)
+		    call gtr_waitpage (STDERR, stream)
+	    }
+
+	case GKI_SETWCS:
+	    nwords = gki[GKI_SETWCS_N]
+	    call amovs (gki[GKI_SETWCS_WCS],
+		Mems[coerce (TR_WCSPTR(tr,1), TY_STRUCT, TY_SHORT)],
+		min (nwords, LEN_WCS * MAX_WCS * SZ_STRUCT / SZ_SHORT))
+
+	case GKI_GETWCS:
+	    nwords = gki[GKI_GETWCS_N]
+	    fd = prstati (source_pid, PR_OUTFD)
+
+	    call write (fd, Memi[TR_WCSPTR(tr,1)], nwords * SZ_SHORT)
+	    call flush (fd)
+	}
+
+	# Pass the (possibly modified) instruction on to the kernel.
+	# We must NOT call gki_flush or gki_fflush here, as this would
+	# result in a reentrant call to prpsio when writing to a subkernel.
+
+	if (!redirected)
+	    call gki_write (stream, Mems[gki_out])
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrdelete.x b/sys/gio/cursor/gtrdelete.x
new file mode 100644
index 00000000..97f418a0
--- /dev/null
+++ b/sys/gio/cursor/gtrdelete.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_DELETE -- Delete an instruction from the frame buffer.  This prevents
+# the instruction from being executed if the frame is redrawn.
+
+procedure gtr_delete (tr, gki)
+
+pointer	tr			#I giotr descriptor
+pointer	gki			#I instruction to be deleted
+
+pointer	inext
+int	nwords, shift, ilen
+
+begin
+	ilen = Mems[gki+GKI_HDR_LENGTH-1]
+	inext = gki + ilen
+
+	if (inext >= TR_OP(tr)) {
+	    # Instruction is the last one in the buffer.
+	    TR_OP(tr) = gki
+	    TR_LASTOP(tr) = TR_OP(tr)
+	    if (TR_IP(tr) >= gki)
+		TR_IP(tr) = gki
+
+	} else {
+	    # If the instruction is small and would be expensive to delete
+	    # just change the opcode to disable it, otherwise shift the
+	    # buffer contents back to overwrite the deleted instruction.
+
+	    nwords = TR_OP(tr) - inext
+	    if (ilen < 32 && nwords > 2048)
+		Mems[gki+GKI_HDR_OPCODE-1] = GKI_UNKNOWN
+	    else {
+		call amovs (Mems[inext], Mems[gki], nwords)
+		shift = inext - gki
+		TR_IP(tr) = TR_IP(tr) - shift
+		TR_OP(tr) = TR_OP(tr) - shift
+		TR_LASTOP(tr) = TR_OP(tr)
+	    }
+	}
+end
diff --git a/sys/gio/cursor/gtrdiscon.x b/sys/gio/cursor/gtrdiscon.x
new file mode 100644
index 00000000..5eba23f4
--- /dev/null
+++ b/sys/gio/cursor/gtrdiscon.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GTR_DISCONNECT -- Disconnect from a kernel subprocess.  To achieve an orderly
+# shutdown we process any outstanding XMIT or XFER requests, then transmit an
+# end of file (zero length record) to the kernel task when it reads from the
+# graphics stream.  The kernel should then shutdown and eventually we will
+# receive "bye" from the process.  We then call PRCLOSE to shutdown the
+# process for good.  Note: we do not expect anything but an XFER (read) request
+# on the graphics stream, but it seems prudent to do something reasonable if
+# some other request is received.
+
+procedure gtr_disconnect (pid, in, out, stream)
+
+int	pid			# process id of subprocess
+int	in, out			# command i/o streams of the subprocess
+int	stream			# graphics stream used by kernel
+
+pointer	sp, sp2, lbuf, buf
+int	pseudofile, nchars, junk
+bool	streq()
+int	getline(), read(), strncmp(), psio_isxmit(), prclose(), pr_findproc()
+errchk	getline, prclose, read, write
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	while (getline (in, Memc[lbuf]) != EOF) {
+	    if (streq (Memc[lbuf], "bye\n") ||
+		strncmp (Memc[lbuf], "ERROR", 5) == 0) {
+
+		junk = prclose (pid)
+		break
+
+	    } else if (Memc[lbuf] == '!') {
+		# OS escape.
+		call proscmd (pr_findproc(pid), Memc[lbuf+1])
+
+	    } else {
+		call smark (sp2)
+
+		switch (psio_isxmit (Memc[lbuf], pseudofile, nchars)) {
+		case XMIT:
+		    call salloc (buf, nchars, TY_CHAR)
+		    nchars = read (in, Memc[buf], nchars)
+		    if (nchars > 0)
+			if (pseudofile == STDOUT || pseudofile == STDERR)
+			    call write (pseudofile, Memc[buf], nchars)
+
+		case XFER:
+		    call salloc (buf, nchars, TY_CHAR)
+		    if (pseudofile == STDIN)
+			nchars = read (pseudofile, Memc[buf], nchars)
+		    else
+			nchars = 0		# this is the EOF
+		    call psio_xfer (out, Memc[buf], nchars)
+		}
+
+		call sfree (sp2)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrfetch.x b/sys/gio/cursor/gtrfetch.x
new file mode 100644
index 00000000..44ccfe60
--- /dev/null
+++ b/sys/gio/cursor/gtrfetch.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_FETCH_NEXT_INSTRUCTION -- Return a pointer to the next GKI metacode
+# instruction in the input buffer.  Only complete instructions resident in
+# a contiguous section of memory are returned.  EOF is returned when the
+# end of the current buffer is reached, or when the last instruction in the
+# frame buffer is not yet complete.  EOF does not signify the end of the
+# metacode stream.
+
+int procedure gtr_fetch_next_instruction (tr, gki)
+
+pointer	tr			# pointer to giotr descriptor
+pointer	gki			# pointer to next instruction (output)
+
+int	nleft, length
+pointer	ip, itop
+
+begin
+	ip   = TR_IP(tr)
+	itop = TR_OP(tr)
+
+	# Search for the beginning of the next instruction.
+	while (Mems[ip] != BOI && ip < itop)
+	    ip = ip + 1
+
+	nleft = itop - ip
+	if (nleft < 3) {
+	    # The length field of the next instruction is not yet present.
+	    TR_IP(tr) = ip
+	    return (EOF)
+	} else {
+	    length = Mems[ip+GKI_HDR_LENGTH-1]
+	    if (length > nleft) {
+		# Entire instruction is not yet present in buffer.
+		TR_IP(tr) = ip
+		return (EOF)
+	    } else {
+		# Entire instruction is present in buffer.
+		TR_IP(tr) = ip + length
+		gki = ip
+		return (length)
+	    }
+	}
+end
diff --git a/sys/gio/cursor/gtrframe.x b/sys/gio/cursor/gtrframe.x
new file mode 100644
index 00000000..baf68ffb
--- /dev/null
+++ b/sys/gio/cursor/gtrframe.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_FRAME -- Clear the frame buffer, used to spool the metacode instructions
+# required to draw a graphics frame.  This is done by moving the metacode data
+# at the end of the buffer (beginning with the word pointed to by gki) to the
+# beginning of the buffer and adjusting the input and output pointers
+# accordingly.  The workstation transformation is also reset to the unitary
+# transformation when the frame is cleared, i.e., zoom is cancelled.
+
+procedure gtr_frame (tr, gki, stream)
+
+pointer	tr			# giotr descriptor
+pointer	gki			# pointer to first word to be preserved
+int	stream			# graphics stream
+
+pointer	bp
+int	nwords, shift
+
+begin
+	bp = TR_FRAMEBUF(tr)
+
+	if (gki > bp) {
+	    nwords = TR_OP(tr) - gki
+	    call amovs (Mems[gki], Mems[bp], nwords)
+	    shift = gki - bp
+	    TR_IP(tr) = TR_IP(tr) - shift
+	    TR_OP(tr) = TR_OP(tr) - shift
+	} else {
+	    TR_IP(tr) = bp
+	    TR_OP(tr) = bp
+	}
+
+	call gtr_ptran (stream, 0., 1., 0., 1.)
+	TR_OPSB(tr) = TR_SCRATCHBUF(tr)
+	TR_LASTOP(tr) = TR_OP(tr)
+	TR_WCS(tr) = NULL
+end
diff --git a/sys/gio/cursor/gtrgflush.x b/sys/gio/cursor/gtrgflush.x
new file mode 100644
index 00000000..5681e234
--- /dev/null
+++ b/sys/gio/cursor/gtrgflush.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gio.h>
+include	"gtr.h"
+
+# GTR_GFLUSH -- Dispose of any buffered output on the stream STDPLOT.  The last
+# plot sent to stdplot cannot be disposed of at CLOSEWS time due to the need
+# to permit APPEND mode in the next OPENWS call.  We are called to dispose
+# of all output to the plotter device.  Logging out or doing a reset will have
+# the same effect.
+
+procedure gtr_gflush (stream)
+
+int	stream
+pointer	tr
+bool	streq()
+include	"gtr.com"
+
+begin
+	tr = trdes[stream]
+	if (tr == NULL)
+	    return
+
+	# Disconnect the kernel.
+	iferr {
+	    if (streq (TR_KERNFNAME(tr), "cl"))
+		call stg_close()
+	    else if (TR_DEVNAME(tr) != EOS && TR_KERNFNAME(tr) != EOS) {
+		call gtr_disconnect (TR_PID(tr), TR_IN(tr), TR_OUT(tr),
+		    stream)
+		TR_PID(tr) = NULL
+	    }
+	} then
+	    call erract (EA_WARN)
+
+	# Free all storage.
+	call mfree (TR_FRAMEBUF(tr), TY_SHORT)
+	call mfree (TR_SCRATCHBUF(tr), TY_SHORT)
+	call mfree (tr, TY_STRUCT)
+
+	trdes[stream] = NULL
+	if (tr_stream == stream)
+	    tr_stream = NULL
+end
diff --git a/sys/gio/cursor/gtrgtran.x b/sys/gio/cursor/gtrgtran.x
new file mode 100644
index 00000000..c83c83aa
--- /dev/null
+++ b/sys/gio/cursor/gtrgtran.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_GTRAN -- Get the workstation transformation.
+
+procedure gtr_gtran (fd, x1, x2, y1, y2)
+
+int	fd			# graphics stream to be set
+real	x1, x2			# range of workstation viewport in X
+real	y1, y2			# range of workstation viewport in Y
+include	"gtr.com"
+
+begin
+	if (wstranset == YES) {
+	    x1 = vx1
+	    x2 = vx2
+	    y1 = vy1
+	    y2 = vy2
+	} else {
+	    x1 = 0
+	    x2 = 1.0
+	    y1 = 0
+	    y2 = 1.0
+	}
+end
diff --git a/sys/gio/cursor/gtrgtty.x b/sys/gio/cursor/gtrgtty.x
new file mode 100644
index 00000000..0e67a1fd
--- /dev/null
+++ b/sys/gio/cursor/gtrgtty.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_GTTY -- Get the graphcap descriptor for a stream.
+
+pointer procedure gtr_gtty (stream)
+
+int	stream			# graphics stream of interest
+
+pointer	tr
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+	return (TR_TTY(tr))
+end
diff --git a/sys/gio/cursor/gtrinit.x b/sys/gio/cursor/gtrinit.x
new file mode 100644
index 00000000..734d8202
--- /dev/null
+++ b/sys/gio/cursor/gtrinit.x
@@ -0,0 +1,136 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_INIT -- Initialize the GIOTR data structures for a graphics stream.  These
+# data structures are initialized only once, when the first i/o occurs on the
+# stream.  Thereafter our only function is to fault the workstation
+# transformation parameters into the cache (the gtr common).
+
+pointer procedure gtr_init (stream)
+
+int	stream			# graphics stream
+
+int	i, len_fb, len_sb
+pointer	tr, tx, ap, w
+bool	first_time
+int	btoi(), envgeti()
+data	first_time /true/
+errchk	calloc, malloc
+include	"gtr.com"
+
+begin
+	if (first_time) {
+	    call amovki (NULL, trdes, MAX_PSEUDOFILES)
+	    tr_stream = NULL
+	    first_time = false
+	}
+
+	tr = trdes[stream]
+
+	if (tr == NULL) {
+	    # This is the first time the stream has been accessed.
+
+	    # Allocate descriptor.
+	    call calloc (tr, LEN_TRSTRUCT, TY_STRUCT)
+
+	    # Don't need a frame buffer for STDPLOT, but make a dummy one
+	    # anyhow so that the stream looks like the interactive ones.
+
+	    if (stream == STDPLOT) {
+		len_fb = 1
+		len_sb = 1
+	    } else {
+		len_fb = DEF_LENFRAMEBUF
+		len_sb = DEF_LENSCRATCHBUF
+	    }
+
+	    call malloc (TR_FRAMEBUF(tr),   len_fb, TY_SHORT)
+	    call malloc (TR_SCRATCHBUF(tr), len_sb, TY_SHORT)
+
+	    trdes[stream] = tr
+	    TR_IP(tr) = TR_FRAMEBUF(tr)
+	    TR_OP(tr) = TR_FRAMEBUF(tr)
+	    TR_OPSB(tr) = TR_SCRATCHBUF(tr)
+	    TR_LENFRAMEBUF(tr) = len_fb
+	    TR_LENSCRATCHBUF(tr) = len_sb
+	    TR_SPOOLDATA(tr) = btoi (stream != STDPLOT)
+	    TR_WAITPAGE(tr) = NO
+	    TR_PAGE(tr) = YES
+
+	    # Set text drawing attributes for annotating plots.
+	    tx = TR_TXAP(tr)
+	    TX_UP(tx) = 90
+	    TX_SIZE(tx) = 1.0
+	    TX_PATH(tx) = GT_RIGHT
+	    TX_SPACING(tx) = 0
+	    TX_HJUSTIFY(tx) = GT_LEFT
+	    TX_VJUSTIFY(tx) = GT_BOTTOM
+	    TX_FONT(tx) = GT_ROMAN
+	    TX_QUALITY(tx) = GT_NORMAL
+	    TX_COLOR(tx) = 1
+
+	    # Set default polyline attributes for axis drawing.
+	    ap = TR_PLAP(tr)
+	    PL_LTYPE(ap) = GL_SOLID
+	    PL_WIDTH(ap) = 1.0
+	    PL_COLOR(ap) = 1
+
+	    # The user can override the default maximum frame buffer length
+	    # if they wish, permitting spooling of frames of any size.
+
+	    iferr (TR_MAXLENFRAMEBUF(tr) = envgeti ("cmbuflen"))
+		TR_MAXLENFRAMEBUF(tr) = DEF_MAXLENFRAMEBUF
+
+	    if (tr_stream != NULL) {
+		# Save the workstation transformation parameters for the
+		# stream currently in the cache, if any.
+
+		call amovi (startcom, TR_GTRCOM(trdes[tr_stream]), LEN_GTRCOM)
+		call amovi (TR_GTRCOM(tr), startcom, LEN_GTRCOM)
+	    }
+
+	    # Initialize the transformation parameters for the new stream.
+	    tr_stream = stream
+	    xscale = 1.0
+	    yscale = 1.0
+	    mx2 = GKI_MAXNDC
+	    my2 = GKI_MAXNDC
+	    vx2 = 1.0
+	    vy2 = 1.0
+
+	    # Initialize the WCS in case someone tries to read the cursor
+	    # before there are any graphics.
+
+	    do i = 1, MAX_WCS {
+		w = TR_WCSPTR(tr,i)
+		WCS_SX1(w) = 0.0
+		WCS_SX2(w) = 1.0
+		WCS_SY1(w) = 0.0
+		WCS_SY2(w) = 1.0
+
+		WCS_WX1(w) = 0.0
+		WCS_WX2(w) = 1.0
+		WCS_WY1(w) = 0.0
+		WCS_WY2(w) = 1.0
+	    }
+
+	} else if (stream != tr_stream) {
+	    # The stream has already been initialized.
+
+	    # If the cache is currently validated for some different stream
+	    # move the data for that stream out into its descriptor.
+
+	    if (tr_stream != NULL)
+		call amovi (startcom, TR_GTRCOM(trdes[tr_stream]), LEN_GTRCOM)
+
+	    # Load the data for the new stream into the cache.
+	    call amovi (TR_GTRCOM(tr), startcom, LEN_GTRCOM)
+	    tr_stream = stream
+	}
+
+	return (tr)
+end
diff --git a/sys/gio/cursor/gtropenws.x b/sys/gio/cursor/gtropenws.x
new file mode 100644
index 00000000..27a3072a
--- /dev/null
+++ b/sys/gio/cursor/gtropenws.x
@@ -0,0 +1,206 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<error.h>
+include	<prstat.h>
+include	<fset.h>
+include	<fio.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_OPENWS -- Called by gtr_control(pr_psio) to connect a kernel to a
+# graphics stream and to initialize the datapath to the kernel.
+# The workstation is not physically opened until the GKI open workstation
+# directive has been sent to the kernel.  There are two types of kernels,
+# the builtin (STDGRAPH) kernel, and all external kernels.  The external
+# kernels reside in connected subprocesses communicating via the central
+# process (the CL process) with the graphics task in another subprocess.
+
+procedure gtr_openws (devspec, mode, stream, source_pid)
+
+char	devspec[ARB]		#I device specification
+int	mode			#I access mode
+int	stream			#I graphics stream
+int	source_pid		#I process which issued the openws directive
+
+int	redir_code, dd[LEN_GKIDD], ip
+pointer	sp, op, tr, tty, kernfname, taskname, device
+
+bool	streq()
+pointer	ttygdes()
+int	pr_getredir(), ttygets(), gtr_connect(), pr_findproc(), locpr()
+extern	gtr_reset(), prpsio()
+
+errchk	syserr, syserrs, fseti, ttygdes, ttycdes, pr_redir, stg_close, stg_open
+errchk	gtr_connect, gtr_disconnect
+include	"gtr.com"
+
+begin
+	call smark (sp)
+	call salloc (kernfname, SZ_FNAME, TY_CHAR)
+	call salloc (taskname, SZ_FNAME, TY_CHAR)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+
+	tr = trdes[stream]
+
+	# Extract the device name field from the device specification.
+	op = device
+	for (ip=1;  devspec[ip] != EOS;  ip=ip+1)
+	    if (devspec[ip] == ',')
+		break
+	    else {
+		Memc[op] = devspec[ip]
+		op = op + 1
+	    }
+	Memc[op] = EOS
+
+	# We only connect up the i/o channels, and do not issue the OPENWS
+	# to the gio kernel, so reset the counter to zero to indicate that
+	# the workstation has not yet been (logically) opened.
+
+	TR_WSOPEN(tr) = 0
+
+	# If the stream has been redirected into a file, do not connect a
+	# kernel.
+
+	redir_code = pr_getredir (source_pid, stream)
+	if (redir_code >= FIRST_FD && redir_code <= LAST_FD) {
+	    call sfree (sp)
+	    return
+	}
+
+	# The graphics stream is a spoolfile in this process (the CL process).
+	# Spoolfiles are files that are fully buffered in memory and never
+	# get written to disk.  Data is written into the spoolfile and then
+	# read back out by a different part of the program.
+
+	call fseti (stream, F_TYPE, SPOOL_FILE)
+	call fseti (stream, F_CANCEL, OK)
+
+	# If the device is already connected to the stream (or we are
+	# appending to a connected device) all we need do is reset the
+	# redirection code for the graphics stream.  This code is reset to
+	# the default value (the code for the stream itself) by the CL when
+	# a task is spawned.
+
+	if (TR_DEVNAME(tr) != EOS && mode == APPEND ||
+		streq (devspec, TR_DEVNAME(tr))) {
+	    call pr_redir (source_pid, stream, TR_REDIR(tr))
+	    call sfree (sp)
+	    return
+	}
+
+	# Connect the named kernel, i.e., disconnect the old kernel if any
+	# and connect the new one.  Set the redirection information for the
+	# named stream of the source process.
+
+	iferr {
+	    # Close device graphcap descriptor.
+	    if (TR_TTY(tr) != NULL)
+		call ttycdes (TR_TTY(tr))
+
+	    # Disconnect old kernel.
+	    if (streq (TR_KERNFNAME(tr), "cl"))
+		call stg_close()
+	    else if (TR_DEVNAME(tr) != EOS && TR_KERNFNAME(tr) != EOS) {
+		call gtr_disconnect (TR_PID(tr), TR_IN(tr), TR_OUT(tr), stream)
+		TR_PID(tr) = NULL
+		TR_IN(tr) = NULL
+		TR_OUT(tr) = NULL
+	    }
+	} then {
+	    TR_DEVNAME(tr) = EOS
+	    call erract (EA_ERROR)
+	} else
+	    TR_DEVNAME(tr) = EOS
+
+	# Get graphcap entry for the new device.  The special device name
+	# "none" indicates that there is no suitable stdgraph device.
+
+	if (streq (devspec, "none")) {
+	    switch (stream) {
+	    case STDGRAPH:
+		call syserr (SYS_GGNONE)
+	    case STDIMAGE:
+		call syserr (SYS_GINONE)
+	    case STDPLOT:
+		call syserr (SYS_GPNONE)
+	    default:
+		call syserr (SYS_GGNONE)
+	    }
+	} else {
+	    tty = ttygdes (Memc[device])
+	    TR_TTY(tr) = tty
+	}
+
+	# Get the name of the executable file containing the kernel for the
+	# device.  The special name "cl" signifies the builtin STDGRAPH kernel.
+
+	if (ttygets (tty, "kf", Memc[kernfname], SZ_FNAME) <= 0) {
+	    call ttycdes (tty)
+	    call syserrs (SYS_GNOKF, Memc[device])
+	} else if (ttygets (tty, "tn", Memc[taskname], SZ_FNAME) <= 0)
+	    ;
+
+	# Connect the new kernel.
+	call strcpy (Memc[kernfname], TR_KERNFNAME(tr), SZ_KERNFNAME)
+
+	if (streq (Memc[kernfname], "cl")) {
+	    # Open the stdgraph kernel.  Connect the referenced GKI stream to
+	    # the stdgraph kernel.  Set a negative redirection code value to
+	    # flag that GIOTR is to be called to filter graphics output from
+	    # the process.
+
+	    call stg_open (devspec, dd, STDIN, STDOUT, 0, 0, 0)
+	    call gki_inline_kernel (stream, dd)
+	    if (source_pid != NULL)
+		call pr_redir (source_pid, stream, -stream)
+	    TR_REDIR(tr) = -stream
+	    TR_INTERACTIVE(tr) = YES
+
+	} else {
+	    # Spawn subprocess and start up kernel task.
+	    TR_PID(tr) = gtr_connect (Memc[kernfname], Memc[taskname],
+		devspec, stream, TR_IN(tr), TR_OUT(tr))
+
+	    # Encode the process slot number of the kernel process in the
+	    # redirection code for the source process (the process which
+	    # issued the openws).  If the stream is STDGRAPH or STDIMAGE
+	    # make the redirection code negative to flag that graphics
+	    # output is to be processed through GIOTR (the workstation
+	    # transformation).
+
+	    if (source_pid != NULL) {
+		redir_code = (pr_findproc(TR_PID(tr)) * KSHIFT) + stream
+		if (stream == STDGRAPH || stream == STDIMAGE)
+		    redir_code = -redir_code
+		call pr_redir (source_pid, stream, redir_code)
+		TR_REDIR(tr) = redir_code
+
+		# Mark the process busy.  This flags it it as busy executing
+		# some subprotocol (in this case processing GKI metacode) and
+		# prevents commands such as chdir/set from being sent to the
+		# process and corrupting the IPC protocol.
+
+		call prseti (TR_PID(tr), PR_STATUS, P_BUSY)
+	    }
+
+	    call gki_subkernel (stream, TR_PID(tr), locpr(prpsio))
+	    TR_INTERACTIVE(tr) = NO
+	}
+
+	# Do not change value of DEVNAME until the new kernel has been
+	# successfully connected, since this variable is used to test if
+	# the kernel is already connected.
+
+	call strcpy (devspec, TR_DEVNAME(tr), SZ_TRDEVNAME)
+
+	# Post the gtr_reset procedure to be executed upon process shutdown,
+	# to close down any connected graphics subkernels in an orderly way.
+
+	call onexit (gtr_reset)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrpage.x b/sys/gio/cursor/gtrpage.x
new file mode 100644
index 00000000..2caa53cb
--- /dev/null
+++ b/sys/gio/cursor/gtrpage.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	"gtr.h"
+
+# GTR_PAGE -- Prepare the workstation for output of one or more pages of text.
+# Whether or not the terminal is paged is optional.  On terminals where the
+# text and graphics are overlaid, it is possible to run the text by beneath
+# the plot without affecting the plot.
+
+procedure gtr_page (fd, stream)
+
+int	fd			# output file
+int	stream			# graphics stream
+
+pointer	tr
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+
+	if (TR_PAGE(tr) == YES)
+	    call gki_deactivatews (stream, AW_CLEAR)
+	else
+	    call gki_deactivatews (stream, 0)
+
+	TR_WAITPAGE(tr) = YES
+end
diff --git a/sys/gio/cursor/gtrptran.x b/sys/gio/cursor/gtrptran.x
new file mode 100644
index 00000000..eba3075e
--- /dev/null
+++ b/sys/gio/cursor/gtrptran.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_PTRAN -- Set the workstation transformation.  The workstation
+# transformation is automatically zeroed whenever the screen is cleared
+# or when a workstation is opened.
+
+procedure gtr_ptran (stream, x1, x2, y1, y2)
+
+int	stream			# graphics stream to be set
+real	x1, x2			# range of workstation viewport in X
+real	y1, y2			# range of workstation viewport in Y
+
+pointer	tr
+real	tol, min_width, dx, dy
+real	cx1, cx2, cy1, cy2
+include	"gtr.com"
+
+begin
+	tr = trdes[stream]
+	tol = 5.0 * EPSILON
+
+	if (abs(x1) < tol && abs (x2 - 1.0) < tol &&
+	    abs(y1) < tol && abs (y2 - 1.0) < tol) {
+
+	    wstranset = NO
+
+	} else {
+	    # Save viewport.
+	    vx1 = x1
+	    vx2 = x2
+	    vy1 = y1
+	    vy2 = y2
+
+	    # Clip viewport at NDC boundary.
+	    cx1 = max (0., min (1., x1))
+	    cx2 = max (0., min (1., x2))
+	    cy1 = max (0., min (1., y1))
+	    cy2 = max (0., min (1., y2))
+
+	    # Make sure the viewport does not have a zero extent in either
+	    # axis after clipping.
+	    min_width = 1E-4
+	    if (cx2 - cx1 < min_width)
+		cx2 = cx1 + min_width
+	    if (cy2 - cy1 < min_width)
+		cy2 = cy1 + min_width
+
+	    # Set clipping viewport in input GKI space.
+	    mx1 = nint (cx1 * GKI_MAXNDC)
+	    mx2 = nint (cx2 * GKI_MAXNDC)
+	    my1 = nint (cy1 * GKI_MAXNDC)
+	    my2 = nint (cy2 * GKI_MAXNDC)
+
+	    # Set transformation upon the clipped GKI coordinates.
+	    dx = max (min_width, (x2 - x1))
+	    dy = max (min_width, (y2 - y1))
+	    xorigin = (cx1 - x1) / dx * GKI_MAXNDC
+	    yorigin = (cy1 - y1) / dy * GKI_MAXNDC
+	    xscale = 1. / dx
+	    yscale = 1. / dy
+
+	    wstranset = YES
+	}
+
+	# Clear the scratch buffer whenever the workstation viewport is
+	# changed.
+
+	TR_OPSB(tr) = TR_SCRATCHBUF(tr)
+end
diff --git a/sys/gio/cursor/gtrrcur.x b/sys/gio/cursor/gtrrcur.x
new file mode 100644
index 00000000..495117a3
--- /dev/null
+++ b/sys/gio/cursor/gtrrcur.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GTR_READCURSOR -- Read the graphics cursor position in NDC coordinates.
+# By the time we are called the plot has already been drawn and the
+# workstation closed, hence we must reopen the workstation to read the
+# cursor (the graphics terminal will not be in graphics mode otherwise).
+
+int procedure gtr_readcursor (fd, key, sx, sy, raster, rx, ry)
+
+int	fd			#I graphics stream
+int	key			#O keystroke value
+real	sx, sy			#O NDC screen coords of cursor
+int	raster			#O raster number
+real	rx, ry			#O NDC raster coords of cursor
+
+int	cn
+int	m_sx, m_sy
+int	m_rx, m_ry
+
+begin
+	call gki_getcursor (fd, 0,
+	    cn, key, m_sx, m_sy, raster, m_rx, m_ry)
+
+	sx = real(m_sx) / GKI_MAXNDC
+	sy = real(m_sy) / GKI_MAXNDC
+	rx = real(m_rx) / GKI_MAXNDC
+	ry = real(m_ry) / GKI_MAXNDC
+
+	return (key)
+end
diff --git a/sys/gio/cursor/gtrredraw.x b/sys/gio/cursor/gtrredraw.x
new file mode 100644
index 00000000..ca2191b3
--- /dev/null
+++ b/sys/gio/cursor/gtrredraw.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	"gtr.h"
+
+# GTR_REDRAW -- Redraw the screen from the metacode spooled in the frame
+# buffer.
+
+procedure gtr_redraw (stream)
+
+int	stream			# graphics stream to be redrawn
+
+pointer	tr, ip_save, op_save
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+
+	if (TR_SPOOLDATA(tr) == YES && TR_OP(tr) > TR_FRAMEBUF(tr)) {
+	    # Rewind the input pointer into the frame buffer.
+	    TR_IP(tr) = TR_FRAMEBUF(tr)
+
+	    # Redraw frame buffer.
+	    call gki_clear (stream)
+	    call giotr (stream)
+
+	    # Redraw scratch buffer (axes).  Set i/o pointers to the scratch
+	    # buffer and draw its contents.  Turn off interrupts to prevent
+	    # an interrupt from leaving the pointers pointing to the wrong
+	    # buffer.
+
+	    if (TR_OPSB(tr) > TR_SCRATCHBUF(tr)) {
+		call intr_disable()
+		ip_save = TR_IP(tr);	TR_IP(tr) = TR_SCRATCHBUF(tr)
+		op_save = TR_OP(tr);	TR_OP(tr) = TR_OPSB(tr)
+
+		call giotr (stream)
+
+		TR_IP(tr) = ip_save
+		TR_OP(tr) = op_save
+		call intr_enable()
+	    }
+
+	    # Flush graphics output.
+	    call gki_flush (stream)
+	}
+end
diff --git a/sys/gio/cursor/gtrreset.x b/sys/gio/cursor/gtrreset.x
new file mode 100644
index 00000000..36c55a9a
--- /dev/null
+++ b/sys/gio/cursor/gtrreset.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gio.h>
+include	"gtr.h"
+
+# GTR_RESET -- Reset the graphics system.  Disconnect all connected subkernels
+# and free all file descriptors and memory.
+
+procedure gtr_reset (status)
+
+int	status				# not used (req. for ONEXIT)
+
+pointer	tr
+int	stream
+bool	streq()
+include	"gtr.com"
+
+begin
+	do stream = STDGRAPH, STDPLOT {
+	    tr = trdes[stream]
+	    if (tr == NULL)
+		next
+
+	    iferr {
+		# Close device graphcap descriptor.
+		if (TR_TTY(tr) != NULL)
+		    call ttycdes (TR_TTY(tr))
+
+		# Disconnect old kernel.
+		if (streq (TR_KERNFNAME(tr), "cl"))
+		    call stg_close()
+		else if (TR_DEVNAME(tr) != EOS && TR_KERNFNAME(tr) != EOS) {
+		    call gtr_disconnect (TR_PID(tr),
+			TR_IN(tr), TR_OUT(tr), stream)
+		    TR_PID(tr) = NULL
+		    TR_IN(tr) = NULL
+		    TR_OUT(tr) = NULL
+		}
+	    } then {
+		TR_DEVNAME(tr) = EOS
+		call erract (EA_WARN)
+	    } else
+		TR_DEVNAME(tr) = EOS
+
+	    # Free all storage.
+	    call mfree (TR_FRAMEBUF(tr), TY_SHORT)
+	    call mfree (TR_SCRATCHBUF(tr), TY_SHORT)
+	    call mfree (tr, TY_STRUCT)
+
+	    trdes[stream] = NULL
+	}
+end
diff --git a/sys/gio/cursor/gtrset.x b/sys/gio/cursor/gtrset.x
new file mode 100644
index 00000000..629ef097
--- /dev/null
+++ b/sys/gio/cursor/gtrset.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTRSET -- Set the workstation transformation.  The workstation transformation
+# is automatically zeroed whenever the screen is cleared or when a workstation
+# is opened.
+
+procedure gtrset (fd, x1, x2, y1, y2)
+
+int	fd			# graphics stream to be set
+real	x1, x2			# range of workstation viewport in X
+real	y1, y2			# range of workstation viewport in Y
+include	"gtr.com"
+
+begin
+	mx1 = x1 * GKI_MAXNDC
+	mx2 = x2 * GKI_MAXNDC
+	my1 = y1 * GKI_MAXNDC
+	my2 = y2 * GKI_MAXNDC
+
+	xscale = GKI_MAXNDC / (mx2 - mx1)
+	yscale = GKI_MAXNDC / (my2 - my1)
+
+	wstranset = YES
+end
diff --git a/sys/gio/cursor/gtrstatus.x b/sys/gio/cursor/gtrstatus.x
new file mode 100644
index 00000000..45b5731c
--- /dev/null
+++ b/sys/gio/cursor/gtrstatus.x
@@ -0,0 +1,100 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<gio.h>
+include	"gtr.h"
+
+define	LEN_NAME	10
+
+
+# GTR_STATUS -- Print information summarizing the utilization of resources
+# by each of the three graphics streams.
+
+procedure gtr_status (fd)
+
+int	fd			# output file
+int	stream, ip
+string	names "STDGRAPH:,STDIMAGE:,STDPLOT: "
+include	"gtr.com"
+
+begin
+	for (ip=1;  names[ip] != EOS;  ip=ip+1)
+	    if (names[ip] == ',')
+		names[ip] = EOS
+
+	do stream = STDGRAPH, STDPLOT {
+	    ip = (stream - STDGRAPH) * LEN_NAME + 1
+	    if (trdes[stream] == NULL) {
+		call fprintf (fd, "\t%s disconnected\n")
+		    call pargstr (names[ip])
+	    } else
+		call gtr_memusage (fd, stream, names[ip])
+	}
+
+	call fprintf (fd, "\n")
+	call flush (fd)
+end
+
+
+# GTR_MEMUSAGE -- Print information summarizing the utilization of memory and
+# other resources by a graphics stream.
+
+procedure gtr_memusage (fd, stream, name)
+
+int	fd			# output file
+int	stream			# graphics stream to be described
+char	name[ARB]		# name of graphics stream
+
+pointer	tr, tx
+int	bufsize
+int	fstati()
+pointer	gtr_init()
+errchk	gtr_init
+
+begin
+	tr = gtr_init (stream)
+
+	call fprintf (fd, "\t%s kernel=%s, device=%s, page %s\n")
+	    call pargstr (name)
+	    call pargstr (TR_KERNFNAME(tr))
+	    call pargstr (TR_DEVNAME(tr))
+	    if (TR_PAGE(tr) == YES)
+		call pargstr ("enabled")
+	    else
+		call pargstr ("disabled")
+
+	bufsize = fstati (stream, F_BUFSIZE)
+	call fprintf (fd,
+	    "\t\tmemory=%d (%dfb+%dsb+%dfio), frame=%d+%d words\n")
+	    call pargi (TR_LENFRAMEBUF(tr) + TR_LENSCRATCHBUF(tr) + bufsize)
+	    call pargi (TR_LENFRAMEBUF(tr))
+	    call pargi (TR_LENSCRATCHBUF(tr))
+	    call pargi (bufsize)
+	    call pargi (TR_OP(tr) - TR_FRAMEBUF(tr))
+	    call pargi (TR_OPSB(tr) - TR_SCRATCHBUF(tr))
+
+	call fprintf (fd,
+	    "\t\tspool=%s, nopen=%d, pid=%d, in=%d, out=%d, redir=%d, wcs=%d\n")
+	    if (TR_SPOOLDATA(tr) == YES)
+		call pargstr ("yes")
+	    else
+		call pargstr ("no")
+	    call pargi (TR_NOPEN(tr))
+	    call pargi (TR_PID(tr))
+	    call pargi (TR_IN(tr))
+	    call pargi (TR_OUT(tr))
+	    call pargi (TR_REDIR(tr))
+	    call pargi (TR_WCS(tr))
+
+	tx = TR_TXAP(tr)
+	call fprintf (fd,
+	    "\t\ttext size=%g, up=%d, path=%s, hj=%s, vj=%s, color=%d\n")
+	    call pargr (TX_SIZE(tx))
+	    call pargi (TX_UP(tx))
+	    call gkp_txparg (TX_PATH(tx))
+	    call gkp_txparg (TX_HJUSTIFY(tx))
+	    call gkp_txparg (TX_VJUSTIFY(tx))
+	    call pargi (TX_COLOR(tx))
+
+	call fprintf (fd, "\n")
+end
diff --git a/sys/gio/cursor/gtrtrunc.x b/sys/gio/cursor/gtrtrunc.x
new file mode 100644
index 00000000..6abda3ba
--- /dev/null
+++ b/sys/gio/cursor/gtrtrunc.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_TRUNCATE -- Truncate the frame buffer, which has grown larger than
+# the limit set by the user (or the system default).  This is done by moving
+# the metacode data at the end of the buffer (beginning with the word pointed
+# to by gki) to the maximum upper limit of the buffer and adjusting the input
+# and output pointers accordingly.
+
+procedure gtr_truncate (tr, gki)
+
+pointer	tr			# giotr descriptor
+pointer	gki			# pointer to first word to be preserved
+pointer	top
+int	nwords
+
+begin
+	# Find the first instruction preceding the soft upper limit on the
+	# size of the buffer.
+
+	top = TR_FRAMEBUF(tr) + TR_MAXLENFRAMEBUF(tr)
+	while (Mems[top] != BOI && top > TR_FRAMEBUF(tr))
+	    top = top - 1
+
+	# Move the partial instruction likely to be at the end of the buffer
+	# to the new "top".  Note that we can only truncate (discard)
+	# instructions which have already been executed, hence the partial
+	# instruction at the end of the buffer must be preserved.
+
+	if (gki != top) {
+	    nwords = TR_OP(tr) - gki
+	    call amovs (Mems[gki], Mems[top], nwords)
+	    TR_IP(tr) = top
+	    TR_OP(tr) = top + nwords
+	}
+end
diff --git a/sys/gio/cursor/gtrundo.x b/sys/gio/cursor/gtrundo.x
new file mode 100644
index 00000000..5b8d3e02
--- /dev/null
+++ b/sys/gio/cursor/gtrundo.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+# GTR_UNDO -- Undo the last frame buffer edit.  Successive pairs of undos leave
+# the frame buffer unchanged.
+
+procedure gtr_undo (stream)
+
+int	stream				# graphics stream
+int	opcode
+pointer	tr, op, new_op, old_op, sp, ap
+
+pointer	gtr_init()
+errchk	gtr_init
+include	"gtr.com"
+
+begin
+	call smark (sp)
+	call salloc (ap, LEN_PL, TY_STRUCT)
+
+	tr = gtr_init (stream)
+
+	old_op = TR_OP(tr)
+	new_op = TR_LASTOP(tr)
+	if (new_op == old_op || new_op <= TR_FRAMEBUF(tr)) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Edit the frame buffer.
+	TR_LASTOP(tr) = old_op
+	TR_OP(tr) = new_op
+	TR_IP(tr) = min (new_op, TR_IP(tr))
+
+	# Redraw the last drawing instruction to erase it (device permitting),
+	# if we are backing up one instruction.  Note that it may be necessary
+	# to skip one or more control instructions.  We assume that the undo
+	# only has to undo one drawing instruction.
+
+	if (new_op < old_op) {
+	    op = new_op
+	    repeat {
+		opcode = Mems[op+GKI_HDR_OPCODE-1]
+		if (opcode == GKI_POLYLINE)
+		    break
+		else
+		    op = op + Mems[op+GKI_HDR_LENGTH-1]
+	    } until (op >= old_op)
+
+	    if (opcode == GKI_POLYLINE && op < old_op) {
+		PL_LTYPE(ap) = GL_CLEAR
+		PL_WIDTH(ap) = 1.0
+		PL_COLOR(ap) = 1
+		call gki_plset (stream, ap)
+
+		if (wstranset == YES)
+		    call gtr_wstran (Mems[op])
+		else
+		    call gki_write (stream, Mems[op])
+
+		PL_LTYPE(ap) = GL_SOLID
+		call gki_plset (stream, ap)
+	    }
+
+	} else if (new_op > old_op) {
+	    # Call giotr to redraw the recovered instructions.
+	    call giotr (stream)
+	}
+
+	call gki_flush (stream)
+	call sfree (sp)
+end
diff --git a/sys/gio/cursor/gtrwaitp.x b/sys/gio/cursor/gtrwaitp.x
new file mode 100644
index 00000000..67f46dd8
--- /dev/null
+++ b/sys/gio/cursor/gtrwaitp.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttyset.h>
+include	<error.h>
+include	<fset.h>
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+# GTR_WAITPAGE -- Print the "hit return to continue" message on the terminal
+# screen and wait for the user to respond before returning to graphics mode.
+# Redrawing of the graphics frame is optional.
+
+procedure gtr_waitpage (fd, stream)
+
+int	fd			# output file
+int	stream			# graphics stream
+
+int	key, i
+pointer	tty, tr
+int	getci(), ttystati()
+pointer	ttyodes(), gtr_init()
+errchk	gtr_init, ttyodes
+
+begin
+	tr = gtr_init (stream)
+	tty = ttyodes ("terminal")
+
+	repeat {
+	    # Print prompt in standout mode.
+	    call ttyclearln (fd, tty)
+	    call ttyso (fd, tty, YES)
+	    call fprintf (fd,
+		"[space=cmhelp,return=quit+redraw,q=quit+noredraw]")
+	    call ttyso (fd, tty, NO)
+	    call flush (fd)
+
+	    # Wait for user to hit a key.  This is done in text mode via
+	    # a raw getc rather than via a cursor read to avoid switching to
+	    # graphics mode.  On some terminals with separate text and
+	    # graphics planes a switch to graphics mode turns off the text
+	    # plane.
+
+	    call fseti (STDIN, F_RAW, YES)
+	    if (getci (STDIN, key) == EOF)
+		key = '\r'
+	    call fseti (STDIN, F_RAW, NO)
+
+	    # Take the action commanded by the user.  At present the morehelp
+	    # option merely prints cursor mode help; this is appropriate
+	    # because the first waitpage call occurs after printing user help
+	    # in response to ? (or after a :.show).
+
+	    switch (key) {
+	    case 'q':
+		# Quit, do not clear graphics and redraw.
+		if (TR_PAGE(tr) == NO) {
+		    # If screen paging is disabled (text drawn underneath
+		    # transparent graphics overlay), clear the text frame
+		    # only, using the clear line function.
+
+		    do i = 1, ttystati (tty, TTY_NLINES) {
+			call ttygoto (fd, tty, 1, i)
+			call ttyclearln (fd, tty)
+		    }
+		} else
+		    call ttyclearln (fd, tty)
+
+		call flush (fd)
+		call gki_reactivatews (stream, 0)
+		break
+
+	    case '\r', '\n':
+		# Quit, clear graphics and redraw.
+		call ttyclearln (fd, tty)
+		call flush (fd)
+		call gki_reactivatews (stream, 0)
+		call gtr_redraw (stream)
+		break
+
+	    case ' ':
+		# Print cursor mode help.
+		iferr (call pagefile (KEYSFILE, "cursor mode help"))
+		    call erract (EA_WARN)
+
+	    default:
+		# Illegal keystroke.
+		call printf ("\007")
+		call flush (STDOUT)
+	    }
+	}
+
+	call ttycdes (tty)
+end
diff --git a/sys/gio/cursor/gtrwcur.x b/sys/gio/cursor/gtrwcur.x
new file mode 100644
index 00000000..9def0a67
--- /dev/null
+++ b/sys/gio/cursor/gtrwcur.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GTR_WRITECURSOR -- Write the graphics cursor position in NDC coordinates.
+
+procedure gtr_writecursor (fd, x, y)
+
+int	fd			# graphics stream
+real	x, y			# NDC coords of cursor
+
+int	mx, my
+
+begin
+	mx = max(0, min(GKI_MAXNDC, nint (x * GKI_MAXNDC)))
+	my = max(0, min(GKI_MAXNDC, nint (y * GKI_MAXNDC)))
+
+	call gki_setcursor (fd, mx, my, 0)
+end
diff --git a/sys/gio/cursor/gtrwritep.x b/sys/gio/cursor/gtrwritep.x
new file mode 100644
index 00000000..d1a3fd4a
--- /dev/null
+++ b/sys/gio/cursor/gtrwritep.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<gio.h>
+include	<gki.h>
+include "gtr.h"
+
+# GTR_WRITEP -- Virtually write (append) to the graphics frame buffer.  Return a
+# pointer to the start of the area reserved for the data and advance the
+# output pointer beyond the new data area.  The use of a buffer pointer here
+# yields a very efficient graphics i/o dataflow.  For the stdgraph kernel,
+# XMIT (pr_psio) places a block of metacode directly in the frame buffer at
+# the memory location we point to.  GIOTR is then called to process the new
+# data block.  GIOTR calls GTR_FETCH, which "fetches" the next instruction
+# by merely returning a pointer into the frame buffer.  The stdgraph kernel
+# is then called to execute the instruction.  Hence in the simple case, there
+# are no memory to memory copies and the contents of an instruction are
+# touched only by the kernel.
+
+pointer procedure gtr_writep (fd, nchars)
+
+int	fd			# graphics stream
+int	nchars			# nchars to reserve at end of buffer
+
+pointer	tr, bufp, top, segp
+int	blen, nwords, ip_offset, op_offset
+errchk	syserr, realloc
+include	"gtr.com"
+
+begin
+	tr = trdes[fd]
+	if (tr == NULL)
+	    call syserr (SYS_GWRITEP)
+
+	nwords = nchars / SZ_SHORT
+	bufp = TR_FRAMEBUF(tr)
+	blen = TR_LENFRAMEBUF(tr)
+	segp = TR_OP(tr)			# pointer to next segment
+	top  = bufp + blen
+
+	# Make space available in the buffer.  We must always allocate the
+	# requested space, even if the result is a buffer larger than the
+	# (soft) maximum size permitted.  Buffer space will be returned
+	# after GIOTR processes the new instructions if the buffer grows
+	# too large.
+
+	if (nwords > top - segp) {
+	    # Note that realloc may move the buffer, hence we must adjust any
+	    # pointers into the buffer after the call to realloc.
+	    
+	    ip_offset = TR_IP(tr) - bufp
+	    op_offset = segp - bufp
+	    blen = blen + max (INC_LENFRAMEBUF, nwords)
+
+	    call realloc (bufp, blen, TY_SHORT)
+
+	    TR_FRAMEBUF(tr) = bufp
+	    TR_LENFRAMEBUF(tr) = blen
+	    TR_IP(tr) = bufp + ip_offset
+	    segp = bufp + op_offset
+	} 
+
+	TR_OP(tr) = segp + nwords
+	TR_LASTOP(tr) = TR_OP(tr)
+
+	return (segp)
+end
diff --git a/sys/gio/cursor/gtrwsclip.x b/sys/gio/cursor/gtrwsclip.x
new file mode 100644
index 00000000..3a0a384b
--- /dev/null
+++ b/sys/gio/cursor/gtrwsclip.x
@@ -0,0 +1,144 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTR_POLYCLIP -- Clip a convex polygon to a box.  If the polygon is entirely
+# outside the box 0 is returned; if the polygon is entirely within the box 1
+# is returned, otherwise the polygon is clipped and a value other than 0 or 1
+# is returned.  This is based on code by Paul Heckbert from Graphics Gems,
+# 1985/1989.
+
+int procedure gtr_polyclip (pv, npts, x1, x2, y1, y2)
+
+short	pv[ARB]			#U polygon to be clipped
+int	npts			#U number of points in polygon
+int	x1,x2,y1,y2		#I clipping box
+
+pointer	sp, p1, p2, pt
+int	x1out, x2out, y1out, y2out, i
+int	gtr_cliptoplane()
+define	nopts_ 91
+
+begin
+	x1out = 0;  x2out = 0
+	y1out = 0;  y2out = 0
+
+	# Count vertices which are outside with respect to each of the
+	# four planes.
+
+	do i = 1, npts*2, 2 {
+	    if (pv[i+0] < x1)  x1out = x1out + 1
+	    if (pv[i+0] > x2)  x2out = x2out + 1
+	    if (pv[i+1] < y1)  y1out = y1out + 1
+	    if (pv[i+1] > y2)  y2out = y2out + 1
+	}
+
+	# Is the polygon entirely inside the clipping box?
+	if (x1out + x2out + y1out + y2out == 0)
+	    return (1)
+
+	# Is the polygon entirely outside the clipping box?
+	if (x1out == npts || x2out == npts || y1out == npts || y2out == npts)
+	    return (0)
+
+	# If we get here the polygon partially intersects the clipping box.
+	# Clip against each of the planes that might cut the polygon, clipping
+	# the previously clipped polygon in each step.  This is done in
+	# floating point to minimize accumulation of error when interpolating
+	# to the clipping plane to compute a new polygon vertex when the plane
+	# is crossed.
+
+	call smark (sp)
+	call salloc (p1, npts * 4, TY_REAL)
+	p2 = p1 + npts * 2
+
+	call achtsr (pv, Memr[p1], npts * 2)
+
+	if (x1out > 0)
+	    if (gtr_cliptoplane (p1, p2, npts, 0, -1.0, real(x1)) == 0)
+		goto nopts_
+	    else {
+		pt = p1;  p1 = p2;  p2 = pt
+	    }
+	if (x2out > 0)
+	    if (gtr_cliptoplane (p1, p2, npts, 0,  1.0, real(x2)) == 0)
+		goto nopts_
+	    else {
+		pt = p1;  p1 = p2;  p2 = pt
+	    }
+	if (y1out > 0)
+	    if (gtr_cliptoplane (p1, p2, npts, 1, -1.0, real(y1)) == 0)
+		goto nopts_
+	    else {
+		pt = p1;  p1 = p2;  p2 = pt
+	    }
+	if (y2out > 0)
+	    if (gtr_cliptoplane (p1, p2, npts, 1,  1.0, real(y2)) == 0)
+		goto nopts_
+	    else {
+		pt = p1;  p1 = p2;  p2 = pt
+	    }
+
+	call achtrs (Memr[p1], pv, npts * 2)
+	call sfree (sp)
+	return (npts)
+
+nopts_
+	call sfree (sp)
+	return (0)
+end
+
+
+# GTR_CLIPTOPLANE --  Clip the convex polygon P1 against a plane, copying
+# the inbounds portion to the output polygon P2.
+
+int procedure gtr_cliptoplane (p1, p2, npts, index, s, ref)
+
+pointer	p1			#I pointer to input polygon
+pointer	p2			#I pointer to output polygon
+int	npts			#U number of polygon points or vertices
+int	index			#I index of coordinate to be tested
+real	s			#I sign for comparison
+real	ref			#I value to compare against
+
+int	nout, i
+pointer	op, u, v
+real	tu, tv, t
+
+begin
+	nout = 0
+	op = p2
+
+	u = p1 + (npts - 1) * 2
+	tu = s * Memr[u+index] - ref
+	v = p1
+
+	do i = 1, npts {
+	    # On old polygon P1, U is previous vertex, V is current vertex,
+	    # TV is negative if vertex V is in.
+
+	    tv = s * Memr[v+index] - ref
+
+	    if (! ((tu <= 0 && tv <= 0) || (tu > 0 && tv > 0))) {
+		# Edge crosses plane; add intersection point to P2.
+		t = tu / (tu - tv)
+		Memr[op+0] = Memr[u+0] + t * (Memr[v+0] - Memr[u+0])
+		Memr[op+1] = Memr[u+1] + t * (Memr[v+1] - Memr[u+1])
+		nout = nout + 1
+		op = op + 2
+	    }
+
+	    if (tv <= 0) {
+		# Vertex V is in, copy it out.
+		Memr[op+0] = Memr[v+0]
+		Memr[op+1] = Memr[v+1]
+		nout = nout + 1
+		op = op + 2
+	    }
+
+	    u = v
+	    tu = tv
+	    v = v + 2
+	}
+
+	npts = nout
+	return (nout)
+end
diff --git a/sys/gio/cursor/gtrwstran.x b/sys/gio/cursor/gtrwstran.x
new file mode 100644
index 00000000..9262e00a
--- /dev/null
+++ b/sys/gio/cursor/gtrwstran.x
@@ -0,0 +1,490 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+
+define	MOVE		0
+define	DRAW		1
+define	LEFT		0
+define	RIGHT		1
+define	BELOW		0
+define	ABOVE		1
+define	INSIDE		2
+define	FIRSTPT		GKI_POLYLINE_P
+
+
+# GTR_WSTRAN -- Apply the workstation transformation to an instruction and
+# write the transformed instruction to the graphics kernel.  The transformation
+# parameters etc. should have been initialized in the gtr common before we
+# are called.
+
+procedure gtr_wstran (gki)
+
+short	gki[ARB]		#I metacode instruction to be spooled
+
+long	x, y
+pointer	sp, buf
+int	length, npts, data
+int	gtr_polyclip()
+bool	sge_wsenable()
+include	"gtr.com"
+
+begin
+	# Check with the graphics kernel to see if scaling of graphics
+	# instructions is enabled (it is disabled if the graphics device is
+	# already doing it for us).
+
+	if (!sge_wsenable()) {
+	    call gki_write (tr_stream, gki)
+	    return
+	}
+
+	switch (gki[GKI_HDR_OPCODE]) {
+	case GKI_FILLAREA:
+	    npts = gki[GKI_FILLAREA_N]
+	    data = GKI_FILLAREA_P
+	    length = gki[GKI_HDR_LENGTH]
+	    call amovs (gki, pl, length)
+
+	    switch (gtr_polyclip (pl[data], npts, mx1, mx2, my1, my2)) {
+	    case 0:
+		# Entire instruction out of bounds.
+	    case 1:
+		# Entire instruction in bounds.
+		pl_op = GKI_POLYLINE_P + npts * 2
+		call gpt_flush()
+	    default:
+		# Instruction has been clipped.
+		pl_op = GKI_POLYLINE_P + npts * 2
+		call gpt_flush()
+	    }
+
+	case GKI_POLYLINE, GKI_POLYMARKER:
+	    call gtr_polytran (gki)
+
+	case GKI_SETCURSOR:
+	    length = gki[GKI_HDR_LENGTH]
+	    call smark (sp)
+	    call salloc (buf, length, TY_SHORT)
+
+	    # Move cursor to edge of screen if point referenced is out of
+	    # bounds.
+
+	    call amovs (gki, Mems[buf], length)
+	    x = gki[GKI_SETCURSOR_POS]
+	    y = gki[GKI_SETCURSOR_POS+1]
+	    call gtr_ctran (x, y, x, y)
+	    Mems[buf+GKI_SETCURSOR_POS-1] = x
+	    Mems[buf+GKI_SETCURSOR_POS]   = y
+	    call gki_write (tr_stream, Mems[buf])
+
+	    call sfree (sp)
+
+	case GKI_TEXT:
+	    length = gki[GKI_HDR_LENGTH]
+	    call smark (sp)
+	    call salloc (buf, length, TY_SHORT)
+
+	    # Discard text drawing instruction if the point referenced is
+	    # out of bounds.  If in bounds, transform coordinates and draw
+	    # at the transformed point.
+
+	    call amovs (gki, Mems[buf], length)
+	    x = gki[GKI_TEXT_P]
+	    y = gki[GKI_TEXT_P+1]
+	    if (x >= mx1 && x <= mx2 && y >= my1 && y <= my2) {
+		call gtr_ctran (x, y, x, y)
+		Mems[buf+GKI_TEXT_P-1] = x
+		Mems[buf+GKI_TEXT_P]   = y
+		call gki_write (tr_stream, Mems[buf])
+	    }
+
+	    call sfree (sp)
+
+	case GKI_PUTCELLARRAY:
+	    # Just filter these out for now.
+
+	default:
+	    call gki_write (tr_stream, gki)
+	}
+end
+
+
+# GTR_CTRAN -- Apply the workstation transform to a set of GKI coordinates,
+# i.e., transform raw GKI coords to screen coords in GKI units.
+
+procedure gtr_ctran (mx, my, sx, sy)
+
+int	mx, my			# raw GKI coordinates
+int	sx, sy			# screen coordinates in GKI units
+include	"gtr.com"
+
+begin
+	sx = max(0, min(GKI_MAXNDC, nint ((mx - mx1) * xscale + xorigin)))
+	sy = max(0, min(GKI_MAXNDC, nint ((my - my1) * yscale + yorigin)))
+end
+
+
+# GTR_POLYTRAN -- Scale a polyline, polymarker, or fill area instruction
+# by applying the workstation transformation.  The workstation transformation
+# scales vectors in a viewport defined in NDC(GKI) space to fit the full
+# device screen.  Vectors or segments of vectors lying outside the viewport
+# are clipped at the screen boundary.
+
+procedure gtr_polytran (gki)
+
+short	gki[ARB]		# gki instruction to be transformed
+long	mx, my
+int	last_ip, opcode, i, ip
+bool	inbounds, otherside, points
+int	gpt_firstpt()
+include	"gtr.com"
+
+begin
+	last_ip = gki[GKI_HDR_LENGTH]
+	opcode  = gki[GKI_HDR_OPCODE]
+	points  = (opcode == GKI_POLYMARKER)
+
+	# In the process of clipping a polyline may be broken into several
+	# smaller polylines (or polymarkers or fillareas, all of which are
+	# very similar at the instruction level).  We store the GKI header
+	# in the first few words of the PL array so that when the transformed
+	# polyline is broken it is ready for execution.
+
+	do i = 1, GKI_POLYLINE_P - 1
+	    pl[i] = gki[i]
+	pl_op = GKI_POLYLINE_P
+
+	# Clip all points until either a point is encountered which is inbounds
+	# or which is on the other side of the viewport (in either axis).  This
+	# is a fast way of clipping polylines which are mostly out of bounds.
+	# Return immediately if the entire vector is out of bounds.
+
+	otherside = true
+	ip = FIRSTPT
+	if (gpt_firstpt (gki, ip, last_ip) <= 0)
+	    return
+
+	# Set initial position.
+	cx = gki[ip]
+	cy = gki[ip+1]
+
+	# Clip the remaining points.  Clipping is performed in GKI coordinates.
+	# The workstation transformation is not applied until the clipped
+	# vector is output.
+
+	for (ip=ip+2;  ip < last_ip;  ip=ip+2) {
+	    mx = gki[ip]
+	    my = gki[ip+1]
+
+	    # Check to see if this is the first point of a new polyline.
+	    # If so we must set the first physical point in the output
+	    # polyline to the current position, making the current point
+	    # the second physical point of the output polyline.
+
+	    if (pl_op <= GKI_POLYLINE_P) {
+		# Place the current pen position in the polyline as the
+		# first point if it is inbounds.
+
+		if (cy <= my2 && cy >= my1 && cx <= mx2 && cx >= mx1) {
+		    last_point_inbounds = true
+		    pl[pl_op] = cx
+		    pl_op = pl_op + 1
+		    pl[pl_op] = cy
+		    pl_op = pl_op + 1
+		} else {
+		    last_point_inbounds = false
+		    do i = 1, 4 {
+			xs[i] = cx
+			ys[i] = cy
+		    }
+		}
+	    }
+
+	    # Update the current position.
+
+	    cx = mx
+	    cy = my
+
+	    # Clip at the edge of the device screen.
+
+	    inbounds = (my <= my2 && my >= my1 && mx <= mx2 && mx >= mx1)
+
+	    if (inbounds && (last_point_inbounds || points)) {
+		# Add point to polyline (the fast way).
+		pl[pl_op] = mx
+		pl_op = pl_op + 1
+		pl[pl_op] = my
+		pl_op = pl_op + 1
+
+	    } else if ((inbounds||last_point_inbounds||otherside) && !points) {
+		# Clip at viewport boundary.
+
+		if (last_point_inbounds) {
+		    # Update coords of last point drawn (necessary since we did
+		    # not use the clipping code for inbounds points).
+		    do i = 1, 4 {
+			xs[i] = pl[pl_op-2]
+			ys[i] = pl[pl_op-1]
+		    }
+		}
+		call gpt_clipl (DRAW, mx, my)
+		otherside = false
+
+	    } else {
+		# Both points are out of bounds.  Scan along until a point is
+		# found which is again in bounds, or which is on the other side
+		# of the viewport, requiring clipping across the viewport.
+
+		if (gpt_firstpt (gki, ip, last_ip) > 0) {
+		    do i = 1, 4 {
+			xs[i] = gki[ip]
+			ys[i] = gki[ip+1]
+		    }
+		    cx = gki[ip]
+		    cy = gki[ip+1]
+		}
+
+		otherside = true
+		inbounds = false
+	    }
+
+	    last_point_inbounds = inbounds
+	}
+
+	call gpt_flush()
+end
+
+
+# GPT_FIRSTPT -- Scan a vector and return the index of the next good point.
+# A good point is a point which is either inbounds or which preceeds a point
+# which is either inbounds or on the other side of the viewport, necessitating
+# clipping across the viewport.
+
+int procedure gpt_firstpt (gki, ip, last_ip)
+
+short	gki[ARB]			# vector being clipped
+int	last_ip				# last legal value of ip
+int	ip				# starting index
+
+int	mx, my, i
+int	first_ip, new_ip
+include	"gtr.com"
+
+begin
+	mx = gki[ip]
+	my = gki[ip+1]
+	first_ip = ip
+	new_ip = last_ip
+
+	if (mx < mx1) {
+	    do i=ip+2, last_ip, 2
+		if (gki[i] >= mx1) {
+		    new_ip = i
+		    break
+		}
+	} else if (mx > mx2) {
+	    do i=ip+2, last_ip, 2
+		if (gki[i] <= mx2) {
+		    new_ip = i
+		    break
+		}
+	} else if (my < my1) {
+	    do i=ip+3, last_ip, 2
+		if (gki[i] >= my1) {
+		    new_ip = i - 1
+		    break
+		}
+	} else if (my > my2) {
+	    do i=ip+3, last_ip, 2
+		if (gki[i] <= my2) {
+		    new_ip = i - 1
+		    break
+		}
+	} else
+	    return (ip)
+
+	if (new_ip >= last_ip)
+	    return (0)			# entire vector is indefinite
+	else
+	    ip = max (first_ip, new_ip - 2)
+
+	return (ip)
+end
+
+
+# GPT_CLIPL -- Clip at left boundary.
+
+procedure gpt_clipl (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+long	new_my
+int	newpen
+include	"gtr.com"
+
+begin
+	# Does line cross boundary?
+	if ((mx >= mx1 && xs[1] < mx1) || (mx <= mx1 && xs[1] > mx1)) {
+	    if (mx >= mx1)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    new_my = real(my - ys[1]) * real(mx1 - mx) / real(mx - xs[1]) +
+		my + 0.5
+	    call gpt_clipr (newpen, mx1, new_my)
+	}
+
+	xs[1] = mx
+	ys[1] = my
+
+	if (mx >= mx1)
+	    call gpt_clipr (pen, mx, my)
+end
+
+
+# GPT_CLIPR -- Clip at right boundary.
+
+procedure gpt_clipr (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+long	new_my
+int	newpen
+include	"gtr.com"
+
+begin
+	# Does line cross boundary?
+	if ((mx <= mx2 && xs[2] > mx2) || (mx >= mx2 && xs[2] < mx2)) {
+	    if (mx <= mx2)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    new_my = real(my - ys[2]) * real(mx2 - mx) / real(mx - xs[2]) +
+		my + 0.5
+	    call gpt_clipb (newpen, mx2, new_my)
+	}
+
+	xs[2] = mx
+	ys[2] = my
+
+	if (mx <= mx2)
+	    call gpt_clipb (pen, mx, my)
+end
+
+
+# GPT_CLIPB -- Clip at bottom boundary.
+
+procedure gpt_clipb (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+long	new_mx
+int	newpen
+include	"gtr.com"
+
+begin
+	# Does line cross boundary?
+	if ((my >= my1 && ys[3] < my1) || (my <= my1 && ys[3] > my1)) {
+	    if (my >= my1)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    new_mx = real(mx - xs[3]) * real(my1 - my) / real(my - ys[3]) +
+		mx + 0.5
+	    call gpt_clipt (newpen, new_mx, my1)
+	}
+
+	xs[3] = mx
+	ys[3] = my
+
+	if (my >= my1)
+	    call gpt_clipt (pen, mx, my)
+end
+
+
+# GPT_CLIPT -- Clip at top boundary and put the final clipped point(s) in
+# the output polyline.  Note that a "move" at this level does not affect
+# the current position (cx,cy), since the vector endpoints have been clipped
+# and the current position vector follows the unclipped vector points input
+# by the user.
+
+procedure gpt_clipt (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+include	"gtr.com"
+
+begin
+	# Does line cross boundary?
+	if ((my <= my2 && ys[4] > my2) || (my >= my2 && ys[4] < my2)) {
+	    if (my <= my2 || pen == MOVE)
+		call gpt_flush()
+	    pl[pl_op] = real(mx - xs[4]) * real(my2 - my) / real(my - ys[4]) +
+		mx + 0.5
+	    pl_op = pl_op + 1
+	    pl[pl_op] = my2
+	    pl_op = pl_op + 1
+	}
+
+	xs[4] = mx
+	ys[4] = my
+
+	if (my <= my2) {
+	    if (pen == MOVE)
+		call gpt_flush()
+	    pl[pl_op] = mx
+	    pl_op = pl_op + 1
+	    pl[pl_op] = my
+	    pl_op = pl_op + 1
+	}
+end
+
+
+# GPT_FLUSH -- Flush the buffered "polyline", i.e., array of transformed and
+# clipped points.  For a polyline or fill area polygon there must be at least
+# two points (4 cells) or it will be discarded.  A single point polymarker is
+# permitted.
+
+procedure gpt_flush()
+
+int	npts, i
+long	mx, my
+include	"gtr.com"
+
+begin
+	if (pl_op >= GKI_POLYLINE_P + 2) {
+	    npts = (pl_op - GKI_POLYLINE_P) / 2
+
+	    # Apply the workstation transformation.
+	    do i = GKI_POLYLINE_P, pl_op, 2 {
+		mx = nint ((pl[i]   - mx1) * xscale + xorigin)
+		my = nint ((pl[i+1] - my1) * yscale + yorigin)
+		pl[i]   = max(0, min(GKI_MAXNDC, mx))
+		pl[i+1] = max(0, min(GKI_MAXNDC, my))
+	    }
+
+	    switch (pl[GKI_HDR_OPCODE]) {
+	    case GKI_POLYMARKER:
+		pl[GKI_POLYMARKER_L] = pl_op - 1
+		pl[GKI_POLYMARKER_N] = npts
+		call gki_write (tr_stream, pl)
+
+	    case GKI_FILLAREA:
+		pl[GKI_FILLAREA_L] = pl_op - 1
+		pl[GKI_FILLAREA_N] = npts
+		call gki_write (tr_stream, pl)
+
+	    default:
+		if (npts >= 2) {
+		    pl[GKI_POLYLINE_L] = pl_op - 1
+		    pl[GKI_POLYLINE_N] = npts
+		    call gki_write (tr_stream, pl)
+		}
+	    }
+
+	    pl_op = GKI_POLYLINE_P
+	}
+end
diff --git a/sys/gio/cursor/mkpkg b/sys/gio/cursor/mkpkg
new file mode 100644
index 00000000..f6a79332
--- /dev/null
+++ b/sys/gio/cursor/mkpkg
@@ -0,0 +1,57 @@
+# Make the CURSOR package.
+
+$checkout libcur.a lib$
+$update   libcur.a
+$checkin  libcur.a lib$
+$exit
+
+libcur.a:
+	# $set xflags = "$(xflags) -qfx"
+
+	giotr.x		gtr.com gtr.h <config.h> <gio.h> <gki.h> <xwhen.h>
+	grcaxes.x	grc.h gtr.com gtr.h <gio.h> <gset.h>
+	grcclose.x	grc.h gtr.h <gio.h>
+	grccmd.x	grc.h gtr.h <ctype.h> <fset.h> <gio.h> <gki.h>\
+			<gset.h> <mach.h> <ttyset.h>
+	grcinit.x	grc.h <gio.h>
+	grcopen.x	grc.h gtr.com gtr.h <gio.h> <gki.h>
+	grcpl.x		gtr.h <gio.h> <gki.h> <gset.h> grc.h
+	grcread.x	gtr.h <fset.h> <gio.h>
+	grcredraw.x	grc.h <gio.h>
+	grcscr.x	gtr.com gtr.h <gio.h> <gki.h>
+	grcstatus.x	grc.h gtr.com gtr.h <gio.h>
+	grctext.x	gtr.h <gio.h> <gki.h> <gset.h> grc.h
+	grcwarn.x	
+	grcwcs.x	grc.h gtr.h <gio.h> <gki.h> <mach.h>
+	grcwrite.x	grc.h gtr.h <fset.h> <gio.h>
+	gtrbackup.x	gtr.com gtr.h <gio.h> <gki.h> <gset.h>
+	gtrconn.x	
+	gtrctrl.x	gtr.com gtr.h <fset.h> <gio.h> <gki.h> <gset.h>\
+			<prstat.h> <config.h>
+	gtrdelete.x	gtr.h <gio.h> <gki.h>
+	gtrdiscon.x	<gio.h>
+	gtrfetch.x	gtr.h <gio.h> <gki.h>
+	gtrframe.x	gtr.h <gio.h> <gki.h>
+	gtrgflush.x	gtr.com gtr.h <error.h> <gio.h>
+	gtrgtran.x	gtr.com gtr.h <gio.h> <gki.h>
+	gtrgtty.x	gtr.h <gio.h> <gki.h>
+	gtrinit.x	gtr.com gtr.h <gio.h> <gki.h> <gset.h>
+	gtropenws.x	gtr.com gtr.h <config.h> <error.h> <fio.h> <prstat.h>\
+			<fset.h> <gio.h> <gki.h>
+	gtrpage.x	gtr.h <gio.h> <gset.h>
+	gtrptran.x	gtr.com gtr.h <gio.h> <gki.h> <mach.h>
+	gtrrcur.x	<gki.h>
+	gtrredraw.x	gtr.h <gio.h>
+	gtrreset.x	gtr.com gtr.h <error.h> <gio.h>
+	gtrset.x	gtr.com gtr.h <gio.h> <gki.h>
+	gtrstatus.x	gtr.com gtr.h <fset.h> <gio.h>
+	gtrtrunc.x	gtr.h <gio.h> <gki.h>
+	gtrundo.x	gtr.com gtr.h <gio.h> <gki.h> <gset.h>
+	gtrwaitp.x	grc.h gtr.h <error.h> <fset.h> <gio.h> <ttyset.h>
+	gtrwcur.x	<gki.h>
+	gtrwritep.x	gtr.com <error.h> <gio.h> <gki.h> gtr.h
+	gtrwstran.x	gtr.com gtr.h <gio.h> <gki.h> <mach.h>
+	gtrwsclip.x
+	prpsinit.x
+	rcursor.x	grc.h gtr.com gtr.h <ctype.h> <gio.h> <gki.h> <ttset.h>
+	;
diff --git a/sys/gio/cursor/prpsinit.x b/sys/gio/cursor/prpsinit.x
new file mode 100644
index 00000000..4959deff
--- /dev/null
+++ b/sys/gio/cursor/prpsinit.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PRPSINIT -- Load the gio.cursor graphics driver for pseudofile i/o to the
+# graphics streams.
+
+procedure prpsinit()
+
+extern	giotr()
+extern	gtr_control(), gtr_gflush(), gtr_writep()
+extern	stg_readtty(), stg_writetty()
+
+begin
+	call prpsload (giotr, gtr_control, gtr_gflush, gtr_writep,
+	    stg_readtty, stg_writetty)
+end
diff --git a/sys/gio/cursor/rcursor.x b/sys/gio/cursor/rcursor.x
new file mode 100644
index 00000000..cc7dc739
--- /dev/null
+++ b/sys/gio/cursor/rcursor.x
@@ -0,0 +1,692 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<ttset.h>
+include	<gio.h>
+include	<gki.h>
+include	"gtr.h"
+include	"grc.h"
+
+define	SZ_CHARCON	5
+define	MARKLEN		0.01
+
+# Cursor step algorithm parameters.
+
+define	MAX_STEP	0.1		# max cursor step size, cursor motions
+define	MIN_STEP	0.002		# min cursor step size, cursor motions
+define	LARGER_STEP	2.0		# factor by which step size is increased
+define	SMALLER_STEP	0.5		# factor by step size is decreased
+define	NSTEP		2		# number of steps before larger step
+define	MANUAL_STEP	5.0		# gear ratio for F/V cursor control
+define	SLOW		1		# for fast/slow algorithm
+define	FAST		2
+
+# Zoom parameters.
+
+define	X_ZOOMFACTOR	0.5		# zoom factors
+define	Y_ZOOMFACTOR	0.5
+#define	X_ZOOMFACTOR	0.666		# zoom factors
+#define	Y_ZOOMFACTOR	0.666
+
+# Roam factors.
+
+define	X_ROAM		0.333		# fraction of the current window
+define	Y_ROAM		0.333		# fraction of the current window
+
+
+# RCURSOR -- Read the position of a cursor.  This is the main entry point to
+# cursor mode/cursor input from the CL; we are called by the QUERY procedure
+# of the CL when a cursor type parameter is read.  The cursor position is
+# returned as a string of the form
+#
+#	x y wcs key stringval
+#
+# where the "stringval" field may be absent if not appropriate for a given key.
+# If EOF is returned the cursor value string is undefined.
+
+int procedure rcursor (stream, outstr, maxch)
+
+int	stream			# graphics stream
+char	outstr[ARB]		# encoded cursor value (output)
+int	maxch
+
+bool	cminit
+int	xroam[9], yroam[9]
+pointer	rc, tr, sp, lbuf, ip
+char	charcon[SZ_CHARCON], ch
+real	x1, x2, y1, y2, xt, yt, v[10]
+real	lx1, lx2, ly1, ly2, aspect_ratio
+real	x, y, rx, ry, xw, yw, dx, dy, xc, yc
+int	junk, key, nukey, last_zoom, i, wcs, ppos, ucasein, raster
+
+bool	ttygetb()
+pointer	grc_open()
+int	envfind(), ctocc(), oscmd(), gtr_readcursor(), grc_readtty()
+int	grc_cursor(), grc_command(), grc_selectwcs(), grc_mapkey(), ttstati()
+real	ttygetr()
+
+errchk	grc_text, grc_readtty, grc_writecursor
+errchk	grc_init, grc_open, grc_command, grc_cursor, grc_message
+errchk	grc_readcursor, grc_mapkey, grc_redraw, envfind
+
+data	xroam /1,0,-1,1,0,-1,1,0,-1/
+data	yroam /1,1,1,0,0,0,-1,-1,-1/
+data	rc /NULL/
+define	done_ 91
+define	coloncmd_ 92
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_COMMAND, TY_CHAR)
+
+	# Allocate and initialize the RCURSOR descriptor.
+	if (rc == NULL) {
+	    call grc_init (rc)
+	    cminit = true
+	} else
+	    cminit = false
+
+	# Open or reopen the graphics kernel.
+	tr = grc_open ("", APPEND, stream, rc)
+
+	# Process CMINIT command string, if present in environment.  This is
+	# only done once.
+
+	if (cminit) {
+	    if (envfind ("cminit", Memc[lbuf], SZ_COMMAND) > 0) {
+		ip = lbuf
+		while (IS_WHITE(Memc[ip]) || Memc[ip] == '.')
+		    ip = ip + 1
+		junk = grc_command (rc, stream, 0.,0.,0,0.,0., Memc[ip])
+	    }
+	    cminit = false
+	}
+
+	# If the graphics device does not permit input, i.e., does not have
+	# a cursor, return EOF.
+
+	if (!ttygetb (TR_TTY(tr), "in")) {
+	    x = 0; y = 0
+	    key = EOF
+	    goto done_
+	}
+
+	# Determine if input keys are to be mapped to lower case by default,
+	# i.e., ucasein mode has been set for the terminal driver.
+
+	ucasein = ttstati (STDIN, TT_UCASEIN)
+
+	last_zoom = 3
+	ppos = NO
+
+	# Enter cursor mode loop.  The loop terminates when a non cursor mode
+	# keystroke is typed.
+
+	while (grc_cursor (rc, stream, key,x,y, raster,rx,ry, ppos) != EOF) {
+	    Memc[lbuf] = EOS
+
+	    # As a rule, no processing is performed on escaped keys.  The only
+	    # exception is when ucasein mode is set in the terminal driver,
+	    # causing upper case input to be mapped to lower case.  This mapping
+	    # is disabled in a raw mode cursor read, hence we must perform the
+	    # mapping explicitly here, returning a lower case key to the
+	    # applications program.  Unescaped upper case input keystrokes will
+	    # be intercepted by cursor mode when ucasein mode is in effect.
+
+	    if (key == '\\') {
+		junk = gtr_readcursor (stream, key, x, y, raster, rx, ry)
+		if (ucasein == YES && IS_UPPER(key))
+		    key = TO_LOWER (key)
+		break
+	    }
+
+	    # Map keystroke.  If the keystroke maps to a null value the key
+	    # is not recognized as a cursor mode keystroke and we exit.
+
+	    if (grc_mapkey (rc, key, nukey) == NULL)
+		break
+
+	    switch (nukey) {
+	    case 'M':
+		# Move the feature under the cursor to the center of the
+		# screen without changing the scaling.
+
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+		xw = (x2 - x1) / 2.
+		yw = (y2 - y1) / 2.
+		call gtr_ptran (stream, xc-xw, xc+xw, yc-yw, yc+yw)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+
+	    case 'Z':
+		# Zoom in in both X and Y.
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+		xw = (x2 - x1) * X_ZOOMFACTOR / 2.
+		yw = (y2 - y1) * Y_ZOOMFACTOR / 2.
+		call gtr_ptran (stream, xc-xw, xc+xw, yc-yw, yc+yw)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+		last_zoom = 3
+
+	    case 'X':
+		# Zoom in in X.
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+		xw = (x2 - x1) * X_ZOOMFACTOR / 2.
+		call gtr_ptran (stream, xc-xw, xc+xw, y1, y2)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+		last_zoom = 1
+
+	    case 'Y':
+		# Zoom in in Y.
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+		yw = (y2 - y1) * Y_ZOOMFACTOR / 2.
+		call gtr_ptran (stream, x1, x2, yc-yw, yc+yw)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+		last_zoom = 2
+
+	    case '>':
+		# Zoom in in Y by setting the upper limit of the viewport
+		# to the cursor Y position.
+
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, lx1, lx2, ly1, ly2)
+		call gtr_ptran (stream, lx1, lx2, ly1,  yc)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call gtr_writecursor (stream, x, 0.5)
+		last_zoom = 'E'
+
+	    case '<':
+		# Zoom in in Y by setting the lower limit of the viewport
+		# to the cursor Y position.
+
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, lx1, lx2, ly1, ly2)
+		call gtr_ptran (stream, lx1, lx2,  yc, ly2)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call gtr_writecursor (stream, x, 0.5)
+		last_zoom = 'E'
+
+	    case 'E':
+		# Expand by marking corners of new viewport.  If the range is
+		# small in either X or Y only the other axis will be expanded.
+
+		call gtr_gtran (stream, lx1, lx2, ly1, ly2)
+		call grc_scrtondc (x, y, x1, y1)
+		call grc_message (stream, "again:")
+		junk = grc_cursor (rc, stream, key,x2,y2, raster,rx,ry, ppos)
+		call grc_scrtondc (x2, y2, x2, y2)
+
+		if (x1 > x2)
+		    { xt = x2;  x2 = x1;  x1 = xt }
+		if (y1 > y2)
+		    { yt = y2;  y2 = y1;  y1 = yt }
+
+		if (abs (x1 - x2) < .01)
+		    call gtr_ptran (stream, lx1, lx2, y1, y2)
+		else if (abs (y1 - y2) < .01)
+		    call gtr_ptran (stream, x1, x2, ly1, ly2)
+		else
+		    call gtr_ptran (stream, x1, x2, y1, y2)
+
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call gtr_writecursor (stream, 0.5, 0.5)
+		last_zoom = 'E'
+
+	    case 'P':
+		# Zoom out.
+		call grc_scrtondc (x, y, xc, yc)
+		call gtr_gtran (stream, x1, x2, y1, y2)
+
+		if (last_zoom == 'E') {
+		    call gtr_ptran (stream, lx1, lx2, ly1, ly2)
+		    lx1 = x1; lx2 = x2; ly1 = y1; ly2 = y2
+		} else {
+		    if (last_zoom == 1 || last_zoom == 3) {
+			xw = (x2 - x1) / X_ZOOMFACTOR / 2.
+			x1 = xc - xw
+			x2 = xc + xw
+		    }
+		    if (last_zoom == 2 || last_zoom == 3) {
+			yw = (y2 - y1) / Y_ZOOMFACTOR / 2.
+			y1 = yc - yw
+			y2 = yc + yw
+		    }
+		    call gtr_ptran (stream, x1, x2, y1, y2)
+		}
+
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		call grc_restorecurpos (stream, xc, yc)
+
+	    case 'W':
+		# Select and fix WCS to be used for scr->wcs coordinate
+		# transformations.
+
+		call grc_scrtondc (x, y, xc, yc)
+		TR_WCS(tr) = grc_selectwcs (tr, raster, xc, yc)
+
+	    case 'C':
+		# Running tally of cursor position.
+		#if (ppos == NO) {
+		#    call grc_pcursor (stream, x, y, raster, rx, ry)
+		#    ppos = YES
+		#} else {
+		#    call grc_message (stream, "\n\n")
+		#    ppos = NO
+		#}
+
+		call grc_pcursor (stream, x, y, raster, rx, ry)
+
+	    case 'D':
+		# Draw a line by marking the endpoints.
+		call grc_scrtondc (x, y, v[1], v[2])
+		call grc_message (stream, "again:")
+		junk = grc_cursor (rc, stream, key,x2,y2, raster,rx,ry, ppos)
+		call grc_scrtondc (x2, y2, v[3], v[4])
+		call grc_polyline (stream, v, 2)
+
+	    case 'T':
+		# Draw a text string.
+		if (grc_readtty (stream, "text: ", Memc[lbuf], SZ_COMMAND) <= 0)
+		    next
+		call grc_scrtondc (x, y, xc, yc)
+		call grc_text (stream, xc, yc, Memc[lbuf])
+
+	    case 'A':
+		# Draw and label the axes of the viewport.
+		call grc_axes (stream, x, y, raster, rx, ry)
+
+	    case 'B':
+		# Backup one instruction in the frame buffer.
+		call gtr_backup (stream)
+
+	    case 'U':
+		# Undo the last frame buffer edit.
+		call gtr_undo (stream)
+
+	    case 'R':
+		# Redraw the screen.
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+
+	    case '0':
+		# Reset and redraw.
+		call gtr_ptran (stream, 0., 1., 0., 1.)
+		call gtr_writecursor (stream, .5, .5)
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+
+	    case '5':
+		# Redraw (null roam request).
+		call grc_redraw (rc, stream, x, y, raster, rx, ry)
+
+	    case '1','2','3','4','6','7','8','9':
+		# Roam.
+		i = TO_INTEG (key)
+		if (xroam[i] != 0 || yroam[i] != 0) {
+		    call gtr_gtran (stream, x1, x2, y1, y2)
+		    dx = (x2 - x1) * X_ROAM * xroam[i]
+		    dy = (y2 - y1) * Y_ROAM * yroam[i]
+		    call gtr_ptran (stream, x1+dx, x2+dx, y1+dy, y2+dy)
+		    call grc_redraw (rc, stream, x, y, raster, rx, ry)
+		}
+
+	    case ':':
+		# Enter a colon command string and terminate cursor mode.
+
+		# Get the string value.
+		if (grc_readtty (stream, ":", Memc[lbuf], SZ_COMMAND) <= 0)
+		    next
+
+		# All cursor mode commands must begin with a ".".  An osescape
+		# begins with an "!".
+
+		if (Memc[lbuf] == '!') {
+		    call gtr_page (STDERR, stream)
+		    if (oscmd (Memc[lbuf+1], "", "", "") == ERR)
+			call fprintf (STDERR, "\7")
+		    call gtr_waitpage (STDERR, stream)
+		    
+		} else if (Memc[lbuf] == '.') {
+		    # Save viewport for 'P'.
+coloncmd_
+		    call gtr_gtran (stream, lx1, lx2, ly1, ly2)
+		    last_zoom = 'E'
+
+		    TR_WAITPAGE(tr) = NO
+		    if (grc_command (rc, stream, x, y, raster, rx, ry,
+			    Memc[lbuf+1]) == EOF) {
+			key = EOF
+			goto done_
+		    }
+
+		    # The following is a no-op for most colon commands.
+		    if (TR_WAITPAGE(tr) == YES)
+			call gtr_waitpage (STDERR, stream)
+		} else
+		    break
+
+	    case '=':
+		# Shorthand for :.snap.  The latter must be used once to
+		# set the plotter device, else the default stdplot device
+		# will be used.
+
+		call strcpy (".snap", Memc[lbuf], SZ_COMMAND)
+		goto coloncmd_
+
+	    default:
+		call fprintf (STDERR, "\007")
+	    }
+	}
+
+	# Mark the cursor position if markcur enabled.
+	if (RC_MARKCUR(rc) == YES && key != EOF) {
+	    call grc_scrtondc (x, y, xc, yc)
+	    aspect_ratio = ttygetr (TR_TTY(tr), "ar")
+	    if (aspect_ratio < .001)
+		aspect_ratio = 1.0
+
+	    v[1]  = xc - MARKLEN * aspect_ratio
+	    v[2]  = yc
+	    v[3]  = xc + MARKLEN * aspect_ratio
+	    v[4]  = yc
+	    v[5]  = xc
+	    v[6]  = yc
+	    v[7]  = xc
+	    v[8]  = yc - MARKLEN
+	    v[9]  = xc
+	    v[10] = yc + MARKLEN
+	    call grc_polyline (stream, v, 5)
+	}
+
+	# Close the workstation, leave graphics mode, position alpha cursor to
+	# lower left corner of graphics terminal.
+
+	call grc_close (stream, rc)
+
+	# Encode the cursor value as a string for the CL.
+done_
+	if (key != EOF) {
+	    if (key == ' ')
+		call strcpy ("\\40", charcon, SZ_CHARCON)
+	    else {
+		ch = char (key)
+		junk = ctocc (ch, charcon, SZ_CHARCON)
+	    }
+	    call grc_scrtowcs (stream, x, y, raster, rx, ry, xc, yc, wcs)
+
+	    call sprintf (outstr, maxch, "%g %g %d %s %s\n")
+		call pargr (xc)
+		call pargr (yc)
+		call pargi (wcs)
+		call pargstr (charcon)
+		call pargstr (Memc[lbuf])
+	} else
+	    outstr[1] = EOS
+
+	call sfree (sp)
+	return (key)
+end
+
+
+# GRC_CURSOR -- Read the position of a cursor in screen coordinates.  Recognizes
+# the cursor movement keystrokes H, J, K, and L, exiting only when some other
+# keystroke is received.  The cursor movement algorithm is initialized upon
+# entry.  Two algorithms are provided for controlling the cursor step size.
+# The first algorithm (automatic control) starts with a large initial step
+# size.  In the vicinity of a feature the cursor will overshoot the feature
+# and the user will step back in the opposite direction, causing the step size
+# to be decreased, rapidly converging to the desired position.  Several steps
+# in the same direction cause the large step size to be restored.  The second
+# algorithm (manual control) uses the F and V keys to directly control the step
+# size.
+
+int procedure grc_cursor (rc, stream, key, x, y, raster, rx, ry, ppos)
+
+pointer	rc			#I rcursor descriptor
+int	stream			#I graphics stream
+int	key			#O keystroke typed
+real	x, y			#O cursor screen coordinates
+int	raster			#O raster number
+real	rx, ry			#O cursor raster coordinates
+int	ppos			#I print cursor position flag
+
+int	speed
+int	xdir, ydir, nukey
+real	xstep, ystep, newx, newy
+
+bool	ttygetb()
+pointer	gtr_gtty()
+int	gtr_readcursor(), grc_mapkey()
+errchk	gtr_readcursor, gtr_writecursor
+
+begin
+	# Reset the cursor step size to the default.
+	xstep = MAX_STEP
+	ystep = MAX_STEP
+	xdir  = 0
+	ydir  = 0
+	speed = 0
+
+	while (gtr_readcursor (stream, key, x, y, raster, rx, ry) != EOF) {
+	    if (grc_mapkey (rc, key, nukey) == NULL)
+		break
+
+	    newx = x
+	    newy = y
+
+	    switch (nukey) {
+	    case 'F':
+		# Faster.
+		xstep = min (MAX_STEP, xstep * MANUAL_STEP)
+		ystep = min (MAX_STEP, ystep * MANUAL_STEP)
+		speed = FAST
+
+	    case 'V':
+		# Slower.
+		xstep = max (MIN_STEP, xstep / MANUAL_STEP)
+		ystep = max (MIN_STEP, ystep / MANUAL_STEP)
+		speed = SLOW
+
+	    case 'H':
+		# Step cursor left.
+		if (speed == 0)
+		    if (xdir < -NSTEP) {
+			xstep = MAX_STEP
+			xdir = -1
+		    } else if (xdir > 0) {
+			xstep = max (MIN_STEP, xstep * SMALLER_STEP)
+			xdir = -1
+		    } else
+			xdir = xdir - 1
+		newx = newx - xstep
+		call gtr_writecursor (stream, newx, newy)
+
+	    case 'J':
+		# Step cursor down.
+		if (speed == 0)
+		    if (ydir < -NSTEP) {
+			ystep = MAX_STEP
+			ydir = -1
+		    } else if (ydir > 0) {
+			ystep = max (MIN_STEP, ystep * SMALLER_STEP)
+			ydir = -1
+		    } else
+			ydir = ydir - 1
+		newy = newy - ystep
+		call gtr_writecursor (stream, newx, newy)
+
+	    case 'K':
+		# Step cursor up.
+		if (speed == 0)
+		    if (ydir > NSTEP) {
+			ystep = MAX_STEP
+			ydir = 1
+		    } else if (ydir < 0) {
+			ystep = max (MIN_STEP, ystep * SMALLER_STEP)
+			ydir = 1
+		    } else
+			ydir = ydir + 1
+		newy = newy + ystep
+		call gtr_writecursor (stream, newx, newy)
+
+	    case 'L':
+		# Step cursor right.
+		if (speed == 0)
+		    if (xdir > NSTEP) {
+			xstep = MAX_STEP
+			xdir = 1
+		    } else if (xdir < 0) {
+			xstep = max (MIN_STEP, xstep * SMALLER_STEP)
+			xdir = 1
+		    } else
+			xdir = xdir + 1
+		newx = newx + xstep
+		call gtr_writecursor (stream, newx, newy)
+	    
+	    default:
+		break
+	    }
+
+	    # We assume the cursor may have moved if the WC capability exists
+	    # for this device.
+
+	    if (ttygetb (gtr_gtty (stream), "WC")) {
+		x = newx
+		y = newy
+	    }
+
+	    # Print the cursor position.
+	    if (ppos == YES)
+		call grc_pcursor (stream, x, y, raster, rx, ry)
+	}
+
+	return (key)
+end
+
+
+# GRC_MAPKEY -- Map keystroke.  If the keystroke maps to a null value the key
+# is not recognized as a cursor mode keystroke and we exit.  Note that if case
+# sensitivity is disabled, KEYS comparisions must be made in upper case but
+# only lower case is to be returned to the calling program.
+
+int procedure grc_mapkey (rc, key, nukey)
+
+pointer	rc			#I rcursor descriptor
+int	key			#U raw key value
+int	nukey			#O mapped key value
+
+begin
+	nukey = max(1, min(MAX_KEYS, key))
+	if (RC_CASE(rc) == NO && IS_LOWER(nukey))
+	    nukey = TO_UPPER(nukey)
+
+	nukey = RC_KEYS(rc,nukey)
+	if (nukey == NULL) {
+	    # Not a cursor mode key.
+	    if (RC_CASE(rc) == NO && IS_UPPER(nukey))
+		key = TO_LOWER(key)
+	} else if (IS_LOWER(nukey))
+	    nukey = TO_UPPER(nukey)
+
+	return (nukey)
+end
+
+
+# GRC_RESTORECURPOS -- Restore the cursor position in NDC coordinates
+# regardless of the current workstation transformation.
+
+procedure grc_restorecurpos (stream, x, y)
+
+int	stream			# graphics stream
+real	x, y			# new cursor position in NDC coords
+real	sx, sy
+include	"gtr.com"
+
+begin
+	call grc_ndctoscr (x, y, sx, sy)
+	call gtr_writecursor (stream, sx, sy)
+end
+
+
+# GRC_READTTY -- Read from the terminal via the graphics kernel.  If the
+# kernel already has message data buffered we merely return that data,
+# otherwise we issue the prompt given and interactively read the data.
+
+int procedure grc_readtty (stream, prompt, obuf, maxch)
+
+int	stream			#I graphics stream
+char	prompt[ARB]		#I prompt, if read is interactive
+char	obuf[ARB]		#O output buffer
+int	maxch			#I max chars out
+
+bool	issue_prompt
+int	nchars, index
+int	stg_msglen(), stg_readtty()
+int	stridxs(), strlen()
+
+begin
+	issue_prompt = (stg_msglen(STDIN) <= 0)
+	if (issue_prompt)
+	    call stg_putline (STDERR, prompt)
+
+	nchars = stg_readtty (STDIN, obuf, maxch)
+	index = stridxs ("\n", obuf)
+	if (index > 0)
+	    obuf[index] = EOS
+	nchars = strlen (obuf)
+
+	if (issue_prompt && nchars == 0)
+	    call grc_message (stream, "\n\n")
+
+	return (nchars)
+end
+
+
+# GRC_MESSAGE -- Write a message on the status line at the bottom of the
+# screen.  If the string is not newline terminated the terminal is left in
+# status line text mode.  To clear the status line and force the terminal
+# back into graphics mode, output the string "\n\n".
+
+procedure grc_message (stream, message)
+
+int	stream			# graphics stream
+char	message[ARB]		# message to be printed
+
+begin
+	call stg_putline (STDERR, message)
+end
+
+
+# GRC_PCURSOR -- Convert the cursor position in screen coordinates to world
+# coordinates and print on the standard output.
+
+procedure grc_pcursor (stream, sx, sy, raster, rx, ry)
+
+int	stream			#I graphics stream
+real	sx, sy			#I screen coords of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coords of cursor
+
+int	wcs
+real	xc, yc
+pointer	sp, lbuf
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	call grc_scrtowcs (stream, sx, sy, raster, rx, ry, xc, yc, wcs)
+	if (abs(xc) > 1 && abs(xc) < 10000 && abs(yc) > 1 && abs(yc) < 10000)
+	    call sprintf (Memc[lbuf], SZ_LINE, "%10.3f %10.3f  \n")
+	else
+	    call sprintf (Memc[lbuf], SZ_LINE, "%12.7g %12.7g  \n")
+	call pargr (xc)
+	call pargr (yc)
+
+	call stg_putline (STDERR, Memc[lbuf])
+	call sfree (sp)
+end
diff --git a/sys/gio/doc/gio.hlp b/sys/gio/doc/gio.hlp
new file mode 100644
index 00000000..f8749c23
--- /dev/null
+++ b/sys/gio/doc/gio.hlp
@@ -0,0 +1,3498 @@
+.help gio Dec84 "Graphics I/O"
+.ce
+\fBGraphics I/O Design\fR
+.ce
+Doug Tody
+.ce
+December 1984
+.ce
+(revised October 1987)
+.sp 3
+.nh
+Introduction
+
+    The graphics i/o (GIO) interface is a library of SPP or Fortran callable
+procedures for interactive vector graphics.  The interface is designed primarily
+for scientific applications (graphing 1-dimensional data vectors).  Limited
+support is also provided for displaying 2-dimensional image data.  GIO is fully
+integrated into the IRAF system and is not intended for use in systems other
+than IRAF.  The principal design objectives of GIO are outlined below.
+
+.ls
+.ls o
+Simple and efficient interactive graphics.  For interactive data analysis
+applications speed is typically much more important than the quality of
+the plot.
+.le
+.ls o
+Ease of use.  The interface must be easy to use for scientific data analysis
+applications.  Ease of use for interactive graphics in scientific applications
+is considered more important than the flexibility required to produce
+publication quality graphics.
+.le
+.ls o
+Compact size.  That portion of the graphics system required for interactive
+graphics must be small enough to be linked into every process which performs
+interactive graphics.
+.le
+.ls o
+Device independence.  The interface must be device independent without
+compromising compactness and speed.  True device independence means that
+an applications program that normally uses interactive graphics can be run
+noninteractively or from a nongraphics workstation.
+.le
+.le
+
+
+IRAF needs its own graphics interface partly because no existing graphics
+interface meets all of the above requirements, and partly because we do not
+want our applications to be dependent upon any particular external graphics
+package.  The existing large graphics interfaces such as GKS and CORE are
+likely to make it easier to interface GIO to new graphics devices, but to
+be completely and directly dependent on any one such interface is unwise since
+implementations are sometimes hard to come by.  Furthermore, packages such
+as GKS and CORE were designed to serve as the kernel of a graphics system
+and are cumbersome to use directly in applications software.  GIO will serve
+as a front end to the graphics kernel, providing a higher level interface
+for applications software and isolating the IRAF applications from the kernel,
+making it possible to switch to a different kernel without rewriting the
+applications packages.
+
+.nh
+Conceptual Design
+
+    GIO is intended to be used either as a self contained interface to a
+graphics device, with GIO writing device instructions directly to the device,
+or as an interface to a more general device independent graphics kernel.
+For maximum speed in interactive applications GIO will use a special builtin
+kernel capable of driving only the interactive graphics devices in use at
+a particular site (e.g., tektronix compatible graphics terminals).
+Other devices will be driven by a device independent graphics kernel resident
+in a separate process.  GIO will select the data path to be used for a
+particular device transparently to the calling program.  Thus, the overhead
+of process initiation and IPC will be eliminated in common interactive
+applications without sacrificing device independence.  The builtin kernel
+will be table driven using a \fBtermcap\fR format graphics device database,
+allowing maximum flexibility for adapting GIO to new graphics devices.
+
+The device independent graphics kernel may be GKS, CORE, NSPP, or any other
+reasonably capable kernel.  GIO will be designed to require only a few simple
+graphics primitives at the bottom end, making it straightforward to interface
+to different graphics kernels.  Any application which requires a more
+sophisticated graphics interface than that provided by GIO may bypass GIO
+and talk directly to the underlying graphics kernel, but doing so will
+render the application usable only with that particular graphics kernel.
+
+Placing the device independent graphics kernel in a separate process makes
+it possible to use a large, sophisticated graphics kernel without linking
+enormous libraries of subroutines into applications processes.  Bugs can be
+fixed and new features and devices added without relinking applications
+processes.  In principle it is even possible to interface simultaneously
+to more than one graphics kernel, e.g., one might drive some devices with
+an NSPP kernel and others with a GKS kernel.  On a different host CORE might
+be the only thing available and GIO would have to be interfaced to CORE on
+such a host.
+
+
+.ks
+.nf
+	        __________
+	       /          \
+	       | graphics |
+	       | terminal |
+	       \__________/
+		   |  ^
+		   |  |(device codes)
+		   v  |                           _________
+		+--------+     +-----------+     /         \
+		|   CL+  |<----| graphics  |<----|         |
+		|  fast  |     |  kernel   |     | gdevice |
+		| kernel |---->|   task    |---->|         |
+		+--------+     +-----------+     \_________/
+		   |  ^                 |
+		   |  |(gki metacode)   |          (core metacode)
+		   v  |                 +--------> (nspp metacode)
+		+--------+                         (gks vdm)
+		|  user  |
+		|  task  |-----------------------> (gki metacode)
+		+--------+
+
+
+	          simple                   plotters
+	  |---  interactive ---|------     metafile    ------|
+		 graphics               special devices
+
+
+.fi
+.ce
+Figure 1. Graphics Task Structure
+.ke
+
+
+The IRAF command language (CL) is the user interface to IRAF programs and
+as such moderates all interaction with the user, including interaction via
+graphics devices.  GIO is primarily a graphics \fIoutput\fR interface;
+graphics input (other than pixel readback) is decoupled from graphics output
+and is controlled by the CL.  Often the task requesting cursor input will
+differ from that which produced the graphics.  The CL, under control of the
+user, may set the default graphics input and output devices, redirect graphics
+input and/or output to devices other than the default, and control whether
+a graphics task is used interactively or in batch mode.
+
+.nh
+Specifications
+
+    The GIO graphics output procedures draw various flavors of vectors and
+fill or color two dimensional areas.  Cursor input is a way of interacting
+with the user and is therefore handled by CLIO (the command language
+interface).  We first define important terms and define the coordinate
+systems used by GIO.  Next follows an overview of the input and output
+procedures.  Finally, we describe in detail the individual procedures and
+the interface to the graphics kernel.
+
+.nh 2
+Coordinate Systems
+
+    The full plotting surface of a device defines the domain of definition
+of the coordinate systems used by GIO.
+GIO supports up to sixteen user defined \fBworld coordinate systems\fR
+(WCS) per open device, numbered 1 through 16.
+One additional coordinate system (WCS 0) with values ranging from 0 to 1 in
+either axis is predefined for every device; this \fBnormalized device
+coordinate system\fR (NDC) spans the full plotting surface of the device.  
+
+The mapping of world coordinates to device coordinates is
+defined by a \fBwindow\fR into world space and a corresponding \fBviewport\fR
+into device space.  Each window-viewport pair defines one of the 16 world
+coordinate systems.  At \fBgopen\fR time GIO is initialized to WCS 1,
+which has both window and viewport set to NDC coordinates.  A subsequent
+call to either \fBgswind\fR or \fBgscale\fR will set the window and a
+subsequent call to \fBgsview\fR will set the viewport.  The WCS is not fixed
+to the device until a plotting operation occurs which requires use of the WCS.
+Hence, multiple calls to \fBgscale\fR to determine the range of data values
+in X and Y for a family of curves are possible before fixing the WCS to the
+device, e.g. in a call to \fBglabax\fR.
+
+A \fBviewport\fR is any rectangular plotting area lying entirely within the
+plotting area of the device.  The viewport defines the area in which data
+can be plotted, i.e., the boundary at which \fBclipping\fR will occur if
+enabled.  The viewport is the area framed by \fBglabax\fR; the tick and axis
+labels will be plotted in the area just outside the viewport.
+A square viewport need not have the same resolution in both X and Y.
+Devices with variable resolution, e.g. pen plotters, have a default
+resolution in either axis which can be overridden when the plot is drawn.
+The aspect ratio of the device is the ratio of the physical size of a
+device pixel in Y to that in X.  Most devices have an aspect ratio of
+unity, but it is common for the resolution to be different in X and Y.
+The aspect ratio of the device is available via a \fBgget\fR inquiry,
+as is the device resolution in either axis.
+
+A \fBwindow\fR is the range of world coordinates which GIO will map to the
+corresponding viewport.  The world coordinates must be cartesian and
+either linear or logarithmic (base 10) in either axis.
+There are no restrictions on the range of world coordinates other than
+those imposed by the single precision floating point hardware of the
+host computer, provided that the WCS is not degenerate
+(zero range in either axis).
+
+Most applications will use only a single WCS, hence the WCS number is not
+included explicitly in the argument lists of the GIO procedures.
+A call to \fBgset\fR is required to change to a different WCS.
+Thereafter all graphics output and cursor input will refer to the new WCS.
+Multiple WCS are useful when plotting in several distinct (nonoverlapping)
+viewports on a device, or when overplotting curves within the same viewport
+but with different world coordinate windows.
+
+.nh 2
+Graphics Output Procedures
+
+    The GIO output procedures range from \fBgplotv\fR and \fBgploto\fR,
+which can draw an entire plot with autoscaling and axis labeling in one call,
+to the polyline, polymarker, move, draw, and text drawing primitives at
+the low end.
+
+
+.ks
+.nf
+	       gplotv (v, npts, x1, x2, title)
+	       gploto (gp, v, npts, x1, x2, title)
+	    gpagefile (gp, fname, prompt)
+		
+	   gp = gopen (device, mode, fd)
+	       gclose (gp)
+	  gdeactivate (gp, flags)
+	  greactivate (gp, flags)
+	      gcancel (gp)
+	       gflush (gp)
+	       gclear (gp)
+	       gframe (gp)
+	       greset (gp, flags)
+	     gmftitle (gp, metafile_title)
+
+	        gscan (gp, text)
+	    gset[irs] (gp, param, value)
+     val = gstat[irs] (gp, param[, outstr, maxch])
+     val = gget[birs] (gp, devcap[, outstr, maxch])
+	    g[sg]view (gp, x1, x2, y1, y2)
+	    g[sg]wind (gp, x1, x2, y1, y2)
+	   g[ar]scale (gp, v, npts, axis)
+	      ggscale (gp, x, y, dx, dy)
+	       gctran (gp, x1, y1, x2, y2, wcs1, wcs2)
+	      gcurpos (gp, x, y)
+	      gescape (gp, fn, instruction, nwords)
+
+	       glabax (gp, title, xlabel, ylabel)
+	        gline (gp, x1, y1, x2, y2)
+	       gpline (gp, x, y, npts)
+	       gvline (gp, v, npts, x1, x2)
+	        gmark (gp, x, y, marktype, xsize, ysize)
+	       gpmark (gp, x, y, npts, marktype, xsize, ysize)
+	       gvmark (gp, v, npts, x1, x2, marktype, xsize, ysize)
+	       gumark (gp, x, y, npts, xcen, ycen, xsize, ysize, fill)
+	    g[ar]move (gp, x, y)
+	    g[ar]draw (gp, x, y)
+		gtext (gp, x, y, text, format)
+		gfill (gp, x, y, npts, style)
+	    g[pg]cell (gp, m, nx, ny, x1, y1, x2, y2)
+
+	        gscur (gp, x, y)
+	 stat = ggcur (gp, x, y, key)
+.fi
+.ke
+
+
+All coordinates are given in world coordinates (user coordinates)
+except the viewport coordinates and the marker sizes, which are given in
+device coordinates.  Low level graphics i/o requires that the graphics
+device first be opened with \fBgopen\fR and later closed with \fBgclose\fR.
+Several graphics devices may be open simultaneously.
+
+When a graphics device is opened with \fBgopen\fR all internal parameters
+are initialized to their default values, unless the device is opened in
+APPEND mode.  The default values of these internal parameters may be changed
+via explicit \fBgset\fR, \fBgswind\fR, \fBgscale\fR, or \fBgscan\fR calls.
+Most powerful is \fBgscan\fR, which interprets graphics commands passed
+either as an explicit string or in a text file.
+
+Much of the flexibility of GIO derives from its parameter defaulting
+mechanism.  The interface may be expanded indefinitely by adding new
+internal parameters accessed via \fBgset\fR calls, without changing the
+basic interface.
+
+.nh 2
+Graphics Input Procedures
+
+    The most commonly used type of graphics input is cursor readback.
+Two forms of cursor input are supported: cursor input via the CLIO procedure
+\fBclgcur\fR, and cursor input via the GIO procedure \fBggcur\fR.
+CLIO based cursor input should be used whenever possible, i.e., when writing
+to \fBstdgraph\fR or \fBstdimage\fR.  The advantage of cursor input via the
+CL is that input may come from a list file or the terminal as well as from
+a physical cursor read, allowing programs to be used either interactively
+or in batch mode.  Furthermore, WCS selection and conversion of NDC cursor
+coordinates to WCS and cursor mode interaction are only available with
+\fBclgcur\fR.  Programs which do not produce any graphics output may read
+the cursor via CLIO without using any part of the GIO interface.
+The lower level GIO cursor read procedure always reads the physical device
+cursor in NDC coordinates and is device dependent (it is what is called by
+\fBclgcur\fR).
+
+Cursors are implemented as abstract datatypes within the CL.  A user task
+accesses a cursor by reading the value of a CL parameter of type \fBgcur\fR
+(stdgraph cursor) or \fBimcur\fR (stdimage cursor).  Multiple cursors may
+be implemented using multiple cursor type parameters.  A cursor parameter
+is assumed to have a \fIlist\fR of values; EOF is returned when the end of
+the list is reached.  Reading the cursor automatically causes any graphics
+output to be flushed.
+
+        stat = clgcur (param, wx, wy, wcs, key, strval, maxch)
+
+The CLIO function \fBclgcur\fR reads the next cursor value from the named
+cursor parameter, returning as output arguments the cursor position in world
+coordinates, the index of the referenced WCS, the keystroke value (character
+typed) of the cursor event, and a string value if the key was ':', the
+cursor mode set option escape character.
+A cursor read sequence begins with a prompt, i.e., the cursor lights up
+or starts blinking.  The user is then free to move the cursor about;
+the cursor position is not read until a key is typed on the user terminal.
+Using a keystroke on the user terminal to terminate both \fBstdgraph\fR
+and \fBstdimage\fR cursor reads provides a rich and device independent set of
+keystroke values for identifying the action to be performed (imaging devices
+are typically very limited in this area).
+
+GIO always returns the cursor position in world coordinates, along with
+the index of the WCS selected.  Typically there will be exactly one world
+coordinate system (excluding WCS 0) and the WCS value may be ignored.
+If no world coordinate systems are defined for the device the cursor
+position will be returned in NDC coordinates with WCS=0.
+
+If multiple world coordinate systems are defined GIO will select the WCS
+closest to the position of the cursor, i.e., the cursor may lie outside the
+viewport and GIO will still return WCS coordinates.  If the cursor lies
+within two or more overlapping viewports GIO will select the WCS with the
+highest number.  The cursor read protocol will allow the user to force
+the selection of a particular viewport by first placing the cursor on a
+nonoverlapping portion of the viewport and typing a special code,
+e.g., W (see next section), and then continuing with the normal cursor read.
+If the application wishes to override the automatic WCS selection it may
+do so by calling \fBgctran\fR to transform the cursor coordinates returned
+by \fBclgcur\fR to a different world coordinate system.
+
+.nh 3
+Cursor Mode
+
+    In cursor mode, i.e., after a call to \fBclgcur\fR or after typing "=gcur",
+a number of special keystrokes shall be recognized for interactive display
+control.  All graphics output to stdgraph and stdimage is routed through the
+CL on the way to the graphics kernel.  The CL will optionally spool in an
+internal buffer all graphics instructions output to an interactive device.
+This internal buffer is emptied whenever the device screen is cleared.
+In cursor mode, special keystrokes may be used to redraw all or any portion
+of the spooled graphics, e.g., one may zoom in on a portion of the plot and
+then roam about on the plot at high magnification.  Since the spooled graphics
+vectors typically contain more information than can be displayed at normal
+magnification, zooming in on a feature may bring out additional detail
+(the maximum resolution is 32768 points in either axis).  Increasing the
+magnification will increase the precision of the cursor by the same factor.
+
+Cursor mode is implemented by performing coordinate transformation and
+clipping on each GKI instruction in the frame buffer, passing the transformed
+and clipped instructions on to the graphics kernel.
+The cursor mode operations perform a simple geometric transformation on
+the spooled graphics frame, mapping a rectangular window of the spooled
+frame onto the device screen.  The graphics frame itself is not modified,
+hence zoom out or reset and redraw will restore the original display.
+
+If the graphics frame is a typical vector plot with drawn and labeled
+axes, magnifying a portion of the plot may cause the axes to be lost.
+If this is not what is desired a keystroke is provided to draw and label
+the axes of the displayed window.  The axes will be overplotted on the
+current display and will not be saved in the frame buffer, hence they
+will be lost when the frame is redrawn.  In cursor mode the viewport is
+the full display area of the output device, hence the tick mark labels
+of the drawn axes will be drawn inside the viewport.  This form of axes
+labeling is used because it is simple and because it is appropriate for
+both vector graphics and image display output devices (and cursor mode
+must serve both).
+
+
+.ks
+.nf
+	A 			draw and label the axes of current viewport
+	B			backup over last instruction in frame buffer
+	C			print the cursor position as it moves
+	D 			draw a line by marking the endpoints
+	E			expand plot by setting window corners
+	F			set fast cursor (for HJKL)
+	H			step cursor left
+	J			step cursor down
+	K			step cursor up
+	L			step cursor right
+	M			move point under cursor to center of screen
+	P			zoom out (restore previous expansion)
+	R			redraw the screen
+	T 			draw a text string
+	U 			undo last frame buffer edit
+	V			set slow cursor (for HJKL)
+	W 			select WCS at current position of cursor
+	X			zoom in, X only
+	Y			zoom in, Y only
+	Z			zoom in, both X and Y
+	<			set lower limit of plot to the cursor y value
+	>			set upper limit of plot to the cursor y value
+	\ 			escape next character
+	:			set cursor mode options
+	:!			send a command to the host system
+	=			shorthand for :.snap (make graphics hardcopy)
+	0			reset and redraw
+       1-9			roam
+.fi
+.ce
+Figure 2. Cursor Mode Keystrokes
+.ke
+
+
+By default the cursor mode keystrokes are all upper case letters, reserving
+lower case for applications programs.  The terminal shift lock key may be
+used to simplify typing in lengthy interactive cursor mode sessions.
+The cursor motions are decoupled from roam since zoom and roam are often used
+merely to increase the precision of a cursor read.  Special keystrokes are
+provided for stepwise cursor motions to increase the speed of cursor setting
+on terminals that do not have fast cursor motions (e.g., the retro-graphics
+enhanced VT100).  The recognized keystrokes are shown in Figure 2.
+
+If the character : is typed while in cursor mode the alpha cursor will appear
+at the bottom of the screen, allowing a command line to be entered.  Commands
+which begin with a period, e.g., ":." are interpreted by the graphics system;
+any other command will terminate the cursor read, returning the character ':'
+as the key value, and the command string as the string value of the cursor
+read.  The commands recognized by the graphics system are summarized in
+figure 3.
+
+
+.ks
+.nf
+	:.axes[+-]		draw axes of viewport whenever screen is redrawn
+	:.case[+-]		enable case sensitivity for keystrokes
+	:.clear			clear alpha memory (e.g, this text)
+	:.cursor n		select cursor (0=normal,1=crosshair,2=lightpen)
+	:.gflush		flush plotter output
+	:.help			print help text for cursor mode
+	:.init			initialize the graphics system
+	:.markcur[+-]		mark cursor position after each cursor read
+	:.off [keys]		disable selected cursor mode keys
+	:.on [keys]		enable selected cursor mode keys
+	:.page[+-]		enable screen clear before printing help text
+	:.read file		fill frame buffer from a file
+	:.show			print cursor mode and graphics kernel status
+	:.snap [device]		make hardcopy of graphics display
+	:.txqual qual		set character generator quality (normal,l,m,h)
+	:.txset format		set text drawing parameters (size,up,hj,vj,etc)
+	:.xres=value		set X resolution (stdgraph only)
+	:.yres=value		set Y resolution (stdgraph only)
+	:.viewport x1 x2 y1 y2	set workstation viewport in world coordinates
+	:.write[!][+] file	save frame buffer in a spool file
+	:.zero			reset viewport and redraw frame
+.fi
+
+
+.ce
+Figure 3. Cursor Mode Commands
+.ke
+
+
+Minimum match abbreviations are permitted for cursor mode command names.
+Multiple commands may be given on one line, delimited by semicolons.
+If the CL environment variable \fBcminit\fR is defined when cursor mode is
+first entered, the string value will be interpreted as a cursor mode command
+and used for initialization.  For example, to disable the numeric keys and
+set the graphics resolution to 200 points in X and 100 points in Y, one
+could add the following \fBset\fR declaration to their "login.cl" file:
+
+	set cminit = "xres=200; yres=150; off 0-9"
+
+The numeric keypad of the terminal (if it has one) is used to roam about
+when the zoom factor is greater than one.  If the magnification is normal
+the numeric keys are not recognized as special keystrokes, i.e., typing
+a numeric key will exit cursor mode, returning the character typed to the
+applications program.  In roam mode a numeric key must be escaped to exit
+cursor mode.  The directional significance of the numeric keys in roam
+mode is obvious if the terminal has a keypad, and is illustrated below.
+
+
+.ks
+.nf
+	7   8   9	135 090 045
+
+	4   5   6	180 000 000
+
+	1   2   3	225 -90 -45
+.fi
+.ke
+
+
+There is a fixed upper limit on the size of the cursor mode frame buffer.
+If the frame data overflows the frame buffer while plotting the plot will
+still come out correctly, but only the final plotting instructions will be
+retained in the buffer.  Redisplay of the frame in cursor mode will thus
+result in only a portion of the full frame being drawn.  If this is a problem
+the user can increase the upper limit on the size of the frame buffer by
+setting the value of the environment variable \fBcmbuflen\fR, e.g.,
+
+	gflush; set cmbuflen = 512000
+
+would initialize the graphics system (freeing the old frame buffer) and set
+the upper limit on the size of the frame buffer to 512K words or 1Mb.
+
+.nh 2
+Example
+
+    At this point a brief example may help to illustrate the use of the GIO
+procedures.  The following procedure will plot a data vector (pixel array)
+and then repeatedly read the cursor, drawing a mark at successive positions
+of the cursor.  The procedure exits if the user types either the character
+'q' or EOF, e.g., <ctrl/z> or carriage return.
+
+
+.ks
+.nf
+	include	<gset.h>
+
+	# MARKPLOT -- Plot a data array and then enter a loop, drawing
+	# circles at successive cursor positions.
+
+	procedure markplot (data, npts, x1, x2)
+
+	real	data[npts]		# data vector to be plotted
+	int	npts			# length of array
+	real	x1, x2			# world X-coords of vector
+
+	pointer	gp
+	int	wcs, key
+	char	str[32]
+	real	wx, wy
+	pointer	gopen()
+	int	clgcur()
+
+	begin
+		gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+
+		call gploto (gp, data, npts, x1, x2, "data")
+
+		while (clgcur ("points", wx, wy, wcs, key, str, 32) != EOF)
+		    if (key == 'q')
+			break
+		    else
+			call gmark (gp, wx, wy, GM_CIRCLE, 1., 1.)
+
+		call gclose (gp)
+	end
+.fi
+.ke
+
+.nh 2
+Graphics Output Devices
+
+    While the graphics output device may be specified explicitly by name,
+more often graphics output devices will be specified by one of the logical
+device names shown below.  Examples of the installation dependent device name
+associated with each logical name are also shown.
+
+
+.ks
+.nf
+	stdgraph	= "gterm"
+	stdimage	= "deanza"
+	stdplot		= "qms"
+	stdvdm		= "uparm$vdm"
+.fi
+.ke
+
+
+Interaction (via the CL) is supported only for \fBstdgraph\fR and
+\fBstdimage\fR.  The standard batch plotter device is \fBstdplot\fR,
+and the standard metafile (for spooling graphics output) is \fBstdvdm\fR.
+
+The user should not normally set the value of \fBstdgraph\fR directly with
+\fIset\fR, rather they should set the terminal type with \fIstty\fR and let
+the latter specify the value of \fBstdgraph\fR.  If the terminal specified
+is not a graphics terminal (no ":gd" capability in the termcap entry for the
+device) the value of \fBstdgraph\fR will be set to "none", otherwise
+\fBstdgraph\fR will be set to the name of the stdgraph device entry for the
+graphics terminal.
+
+The device name associated with a logical graphics output
+device must have an associated entry in the \fBgraphcap\fR file,
+a text file used to describe the characteristics of each device.
+New graphcap entries may easily be added by the user to interface to
+special graphics devices.
+System privledge is not required to modify graphcap, since the name
+of the graphcap file is taken from a CL environment variable of the
+same name (which can be redefined by the user to point to a file in a
+private directory).  The graphcap entries for the most commonly used
+devices at a given site may be precompiled by the system manager to
+eliminate the overhead of searching the graphcap file at \fBgopen\fR time.
+
+The graphcap parameters (device \fIcapabilities\fR) are too involved to
+be presented here and will be described in a later section.
+Examples of device capabilities are the device resolution, whether a frame
+advance is required before or after a plot, indication of device capabilities
+such as the ability to generate text, and the name of the executable
+graphics kernel file associated with the device.  Many additional parameters
+are defined for interactive devices.  The graphcap device capabilities
+may be inspected with the \fBgget[birs]\fR procedures, which resolve into
+calls to the TTY interface, used to access both graphcap and termcap files.
+
+The sequence of actions taken by GIO to access the graphcap entry for a
+device is summarized below.
+
+
+.ks
+.nf
+	if (standard graphics output device)
+	    get device name from environment
+
+	if (device name is actually a filename) {
+	    load graphics device descriptor using the first device entry
+		from the named graphcap format file
+	} else {
+	    get filename of graphcap file from environment
+	    load graphics device descriptor by searching the graphcap file
+		for the named device
+	}
+.fi
+.ke
+
+.nh 2
+Graphics Input Devices
+
+    The technique used to associate an input source with a graphics cursor
+is similar to that used for output devices.  A CL environment variable is
+associated with each cursor type.  The names and default values of the
+environment variables are shown below.
+
+
+.ks
+.nf
+	stdgcur		= "stdgraph"
+	stdimcur	= "stdimage"
+.fi
+.ke
+
+
+The default input source for a cursor is the graphics output device associated
+with the graphics output stream.  If the cursor device is "stdgraph" or
+"stdimage" the graphics kernel is called to read the physical device cursor
+for \fIstdgraph\fR or \fIstdimage\fR.  If the cursor device is "text"
+the cursor value is a line of text read from the user terminal.
+In this mode the user enters at least two of the fields defining
+a cursor value.  Missing fields are assigned the value zero (the user
+presumably will know that the program does not use the extra fields).
+
+
+.ks
+.nf
+	cl> set stdgcur = "text"
+	cl> = gcur
+	gcur: 345.33 23.22 1 c
+	345.33 23.22 1 c
+	cl>
+.fi
+.ke
+
+
+An example of a cursor read request entered interactively by the user,
+taking input from the terminal and sending output to the terminal,
+is shown above (the CL typed the "gcur: " query and the user entered the
+remainder of that line).  If the cursor device were "stdgraph" a real
+cursor read would occur and the equivalent interaction might appear as
+shown below.  The cursor position is returned in world coordinates,
+where the world coordinate system was defined by the last plot output to
+the device.  For an imaging device the world coordinates will typically
+be the pixel coordinates of the image section being displayed.
+
+
+.ks
+.nf
+	cl> = gcur
+	345.33 23.22 1 c
+	cl>
+.fi
+.ke
+
+
+Redirecting cursor input to the terminal is useful when working from a
+nongraphics workstation and when debugging programs.  ASCII cursor queries
+are the only type supported when running an IRAF program outside the CL.
+Cursor input may also be taken from a list file by assigning a filename
+to a cursor parameter, i.e., by assigning a list file to a list structured
+parameter and overriding query mode:
+
+
+.ks
+.nf
+	cl> gcur = filename
+	cl> = gcur
+	345.33 23.22 1 c
+	cl>
+.fi
+.ke
+
+
+This last mechanism is a standard technique used with CL list structured
+parameters and will not be discussed further here.
+
+.NH 2
+Mixed Terminal and Graphics I/O
+
+    Interactive graphics programs are normally (but not necessarily) executed
+on a graphics terminal or workstation supporting both ordinary terminal i/o
+and vector graphics.  IRAF is designed to use a single terminal for both text
+and graphics; text and graphics on separate devices is also supported but is
+not the norm.  By text we refer here to ordinary line or screen oriented
+terminal i/o (e.g., for \fIhelp\fR or \fIeparam\fR), not the use of text in
+the graphics plane to annotate plots.
+
+.NH 3
+Text and Graphics Mode
+
+    Most modern graphics terminals provide separate memory planes for text
+and graphics.  Depending upon the device, these planes may be displayed
+simultaneously, displayed alternately, or only a single memory plane may be
+available for both terminal modes, in which case a mode switch is destructive.
+The graphics device model implemented by GIO and the STDGRAPH kernel is
+flexible enough to deal with all or nearly all such devices.
+
+The normal mode for the terminal or workstation is text mode.  Activating the
+workstation causes a switch to graphics mode; deactivating the workstation
+restores the terminal to text mode.  Activation is implied whenever a device
+is opened with \fBgopen\fR, unless the AW_DEFER mode bit is set to defer the
+activate workstation until graphics i/o is actually done to the device.
+Closing the workstation automatically deactivates the workstation.  The GIO
+procedures \fBgreactivate\fR and \fBgdeactivate\fR are provided to simplify
+mode switching while a device is open on a graphics stream.
+
+Occasionally it is necessary to print out a large amount of text in response
+to a user command entered in a cursor loop while in graphics mode.  If the
+text is in a file this is done most easily by calling \fBgpagefile\fR to page
+the file in text mode, restoring graphics mode when the operation is completed.
+If the application generates the output text dynamically then the workstation
+must be explicitly deactivated and later reactivated before resuming graphics
+i/o, e.g.,
+
+.ks
+.nf
+	while (clgcur (gp, ...) != EOF) {
+	    switch (key) {
+	    case XXX:
+		call gdeactivate (gp, AW_CLEAR)
+		    <write the text to STDOUT>
+		call greactivate (gp, AW_PAUSE)
+	    case YYY:
+		...
+	    }
+	}
+.fi
+.ke
+
+The sequence shown will switch to text mode, clear the screen, output the
+text, and pause for the user to read the text before restoring graphics mode
+and initiating another cursor read.
+
+.NH 3
+Status Line I/O
+
+    The deactivate/reactivate workstation technique is fine for outputting
+large amounts of text, but is not well suited for small amounts of text,
+e.g., single line commands to interactively set internal parameters,
+output of single lines of text to prompt the user, print the value of a
+calculation or some variable, and so on.  The so-called "status line"
+interface is provided for this purpose.  Status line i/o makes it possible
+to interact directly with the user without interfering with the contents of
+the graphics frame, and without leaving graphics mode.
+
+What the status line actually is determined by the graphcap entry for the
+device and the characteristics or limitations of the actual device.
+On most devices, the status line is a single line at the bottom of the screen.
+This only works, however, if the device can dynamically erase the status line;
+if this is not possible the status "line" may actually be the entire screen,
+with successive output lines being drawn on top of the graph.
+
+To output text to the status line while in graphics mode one merely writes to
+STDOUT or STDERR in the usual way, e.g., in a call to \fBprintf\fR.  When
+newline is seen a flag is set which causes the status line to be cleared when
+the next output character is received.  Output lines may be built up in
+successive calls to output procedures, outputting a single newline to terminate
+the line and start a new one.  After a newline delimited line of text has been
+output, output of a single newline (blank line) will clear the status line.
+
+It is also possible to read from the status line.  This is most commonly done
+after writing a prompt string to the status line.  The prompt should be
+terminated with a colon (e.g., "enter value: ") rather than a newline,
+to signal to the user that input is expected, and to avoid having the
+subsequent status line read clear the prompt string.  In many cases such
+explicit prompting and decoding of the return string can be avoided by using
+the standard CLIO parameter prompting mechanism for interactive input.
+CL parameter prompts are also permitted in graphics mode, and will interact
+with the user on the status line in the expected way, without interfering
+with the graphics state of the device.
+
+When mixing status line i/o and graphics i/o one must be careful to flush any
+buffered graphics or textual output before switching modes.  In many cases the
+system will do this for you automatically, but there are exceptions where
+explicitly flushing of buffered output is necessary (e.g., STDOUT and STDERR
+are low level facilities with no knowledge of GIO, and output to one of these
+streams will not automatically cause any graphics output to be flushed).
+
+.NH 2
+User Interface Conventions
+
+    While different interactive (cursor driven) graphics programs will differ
+in many ways, there are certain operations which are common to all such
+programs.  In order to present a more consistent interface to the user,
+conventions have been defined for these common operations.
+
+.NH 3
+On Line Help
+
+    All interactive graphics programs should respond to the key '?' with a
+description of the keystrokes and colon commands recognized by the program
+(or submenu, in the case of a menu structured interface).  This is normally
+done by calling \fBgpagefile\fR to interactively page the ".key" keystrokes
+help file for the program.  The keystroke files for system programs are
+stored in the directory lib$scr; non-system programs keep their keys files
+either in the package directory, or in a global package library.
+
+.NH 3
+Cursor and Device Names
+
+    In general, applications programs should not read directly from \fBgcur\fR
+or \fBimcur\fR (the global cursor parameters), nor should the open the
+"stdgraph", "stdimage", or "stdplot" device directly by these explicit string
+values.  This works, but is inflexible.  To make it easy for the user to
+run an otherwise interactive program in batch mode, taking input from a cursor
+list file, the task should include a cursor type parameter in its parameter
+set.  Likewise, to make it easy for the user to temporarily redirect the
+output of the program to a device other than the current stdgraph, stdplot,
+etc., device, the device name should be parameterized as a string type CL
+parameter.
+
+For example, if task \fBplotit\fR  has cursor and device parameters named
+"cursor" and "device", the command
+
+	cl> plotit cursor=listfile device=qms
+
+would run the task taking cursor input from the text file "listfile", with
+stdgraph graphics output directed to the plotter device "qms".
+
+.NH 3
+Exiting an Interactive Cursor Loop
+
+    The following standards have been defined for dealing with EOF/quit in
+interactive cursor loops.
+.ls
+.ls EOF	
+End of file is indicated for a cursor list either by an actual
+end of file in the case of a true cursor list, or by typing the EOF character
+(e.g., <ctrl/z>, <ctrl/d>, or the interrupt character) in an interactive
+cursor read.  EOF on the cursor list should be taken seriously by the
+applications program, and not treated as just another key, hence it should
+not be something that the user is expected to type routinely to exit a cursor
+loop.  If a program gets EOF back as the value of \fBclgcur\fR it should exit
+immediately, without any verification queries etc, since it may well have
+been run in batch mode with input redirected to a cursor list file.
+.le
+.ls q
+The standard interactive cursor loop exit character is 'q'.  
+All interactive graphics programs should recognize this character
+and take some action to exit the cursor loop, e.g.:
+
+.ks
+.nf
+	while (clgcur (...) != EOF)
+	    switch (key) {
+	    case 'q':
+		break
+	    case ...
+.fi
+.ke
+
+The 'q' character is intended to be handled directly by the application
+program, rather than mapped into EOF by the system (like Q was, and CR and
+the gt_gcur 'q' before that in old versions of IRAF),
+to distinguish this case from a hard-EOF and to provide maximum
+flexibility in how the program treats a request from the user to exit.
+If the user would suffer from an accidental program exit then the 'q' key
+action should do something before exiting, e.g., ask that the user first
+update the database, ask that CR be hit to verify the quit, and so on.
+In general, if it would take the user more than a minute to recover after
+an accidental program exit, one should consider coding some sort of
+verification action to be executed before exiting when 'q' is typed (but not
+when EOF is seen on the list).
+.le
+.le
+
+The GIO procedure \fBgqverify\fR is provided for programming convenience in
+cases where only simple verification is desired.  Note that lightweight tasks
+or submenus which can easily be reentered should not bother even with this,
+but should simply exit.  For example:
+
+.ks
+.nf
+	case 'q':
+	    if (gqverify() == YES)
+		break
+.fi
+.ke
+
+As a more complex example, suppose the program is used to edit or
+create a database which could be lost or damaged in an accidental
+exit, if not updated first.  We do not want to update the database
+automatically because this would overwrite the former contents of
+the database.  The program might be set up as follows.
+
+.ks
+.nf
+	'q'		program prints error message on status line, e.g.,
+			  "No write since last change (:quit! overrides)"
+	:w[rite]	updates the database; q will execute silently
+	:q[uit]!	force a quit w/o an update; discard changes
+.fi
+.ke
+
+.nh 2
+Detailed Procedure Specifications
+
+    The graphics output procedures provided by GIO fall into four main
+groups.  First are the high level "plot at a time" procedures,
+used to plot entire data vectors.  Second are the control procedures,
+used to open and close a device, to flush output and clear the screen,
+and to cancel output in the event of an interrupt.
+Third are the procedures used to set and stat (inquire) the GIO
+internal parameters, e.g. to define a WCS, change pens, select axis labeling
+options, or inquire the device resolution.  Fourth and last are the output
+procedures, used to draw and label the axes of a viewport, set the cursor,
+draw lines or marks, plot text, or fill areas.
+
+.nh 3
+High Level Procedures
+.ls 4
+.tp 8
+.ls gplotv (v, npts, x1, x2, title)
+
+.nf
+real	v[npts]		# data vector
+int	npts		# number of data points
+real	x1, x2		# WC assigned v[1] and v[npts]
+char	title[ARB]	# plot title
+.fi
+
+Open GIO, clear the screen, autoscale and plot the data vector, then close GIO.
+A default viewport is used.  The axes are drawn, tick marks are selected,
+marked, and labeled, and the plot title is printed.  The data is plotted
+using solid line segments.  The X values of the data points are evenly
+distributed from X1 to X2.
+.le
+
+.tp 8
+.ls gploto (gp, v, npts, x1, x2, title)
+
+.nf
+pointer	gp		# graphics descriptor
+real	v[npts]		# data vector
+int	npts		# number of data points
+real	x1, x2		# WC assigned v[1] and v[npts]
+char	title[ARB]	# plot title
+.fi
+
+A more flexible version of \fBgplotv\fR.  The graphics device must already
+have been opened with an explicit call to \fBgopen\fR.  The explicit open
+call makes it possible to append to an existing plot or to change plotting
+options with calls to \fBgset\fR before calling \fBgploto\fR to autoscale,
+draw the axes, and plot the data vector.  Annotation of the plot via calls
+to the low level output primitives is possible before a final call to
+\fBgclose\fR to close the device and free the graphics descriptor.
+.le
+
+.tp 8
+.ls gpagefile (gp, fname, prompt)
+
+.nf
+pointer	gp		# graphics descriptor
+char	fname[ARB]	# file to be paged
+char	prompt[ARB]	# end of page prompt string
+.fi
+
+Interactively page through a file on the terminal in text mode, e.g., to
+display help text in response to the '?' standard help query key.
+The workstation is deactivated, the screen is cleared and the file is paged,
+with the usual file pager prompt being displayed at the bottom of each page
+of text.  When the pager is exited the workstation is reactivated if it was
+active when the pager was called.  If the prompt string is null the file
+name is used.
+.le
+.le
+
+.nh 3
+Control Procedures
+.ls
+.tp 8
+.ls gopen (device, mode, fd)
+
+.nf
+char	device[ARB]	# name of device to be opened
+int	mode		# access mode
+int	fd		# graphics stream to be written
+.fi
+
+The named graphics device is opened for graphics i/o.  A pointer to the GIO
+graphics descriptor assigned to the device is returned as the function value.
+The device name may be the name of one of the standard logical graphics
+devices, i.e., \fBstdgraph\fR, \fBstdimage\fR, \fBstdplot\fR, or \fBstdvdm\fR,
+or the actual name of a physical device.
+
+The only meaningful device access modes at present are NEW_FILE and APPEND.
+In NEW_FILE mode all WCS are initialized to NDC coordinates.
+Opening the stdgraph device in NEW_FILE mode causes a screen clear on the next
+call to \fIgflush\fR.  In APPEND mode the WCS are restored to the values they
+had when the device was last accessed.
+The GIO internal state variables are initialized to their default values
+at \fBgopen\fR time regardless of the access mode for the device.
+
+Opening the stdgraph device causes an implicit reactivate workstation unless
+the AW_DEFER flag (<gset.h>) is set in the access mode, e.g.,
+
+	gp = gopen (device, NEW_FILE+AW_DEFER, fd)
+
+Defer mode allows the graphics descriptor to be opened once, e.g., during task
+startup, before any graphics output is required.  This is sometimes useful in
+applications which switch back and forth between text and graphics mode often,
+by bracketing each graphics sequence with calls to \fIgreactivate\fR to enter
+graphics mode, and \fIgdeactivate\fR to return to text mode.  Defer mode may
+be combined with any normal access mode code.
+
+Graphics output will be written to the stream \fIfd\fR, which may be one
+of the standard streams STDGRAPH, STDIMAGE, or STDPLOT, or to a binary file
+opened explicitly by the user before calling \fBgopen\fR.
+.le
+
+.tp 5
+.ls gclose (gp)
+
+The graphics device associated with graphics descriptor \fBgp\fR is closed,
+freeing all resources allocated to the device.  Any buffered graphics output
+is automatically flushed before closing the device.
+.le
+
+.tp 4
+.ls gdeactivate (gp, flags)
+
+.nf
+pointer	gp		# graphics descriptor
+int	flags		# AW_CLEAR, AW_PAUSE (see <gset.h>)
+.fi
+
+The graphics workstation is deactivated, i.e., restored to the normal terminal
+(text drawing) mode, the state the terminal was in prior to \fIgopen\fR, and to
+which it will be restored after a \fIgclose\fR.  This function is intended for
+interactive graphics applications and may be may be ignored by some graphics
+kernels.  If the AW_PAUSE flag bit is set the user will be asked to type a
+key before the terminal is restored to text mode.  If the AW_CLEAR flag bit
+is set the terminal (text) screen will be cleared after the workstation is
+deactivated.
+
+.le
+
+.tp 4
+.ls greactivate (gp, flags)
+
+.nf
+pointer	gp		# graphics descriptor
+int	flags		# AW_CLEAR, AW_PAUSE (see <gset.h>)
+.fi
+
+The graphics workstation is reactivated, i.e., restored to graphics mode from
+the normal terminal (text drawing) mode.  This function is intended for
+interactive graphics applications and may be may be ignored by some graphics
+kernels.  If the AW_PAUSE flag bit is set the user will be asked to type a
+key before the terminal is restored to graphics mode.  If the AW_CLEAR flag
+bit is set the graphics frame will be cleared.
+.le
+
+.tp 4
+.ls gcancel (gp)
+
+Any buffered graphics output is discarded and any output operation currently
+in progress is aborted.  Used to recover from an interrupt.
+.le
+
+.tp 3
+.ls gflush (gp)
+
+Any buffered graphics output is flushed to the output device.
+.le
+
+.tp 4
+.ls gclear (gp)
+
+If the output device is a CRT the screen is erased (including all viewports).
+If the output device is a plotter a formfeed is issued, advancing to the next
+page of output (whether or not any graphics output has occurred).
+All WCS are initialized to NDC coordinates and the internal state of GIO
+is initialized, i.e., the state of each drawing instruction attribute packet
+is set to UNSET to force retransmission to the graphics kernel as i/o occurs,
+and the current settings of the \fIgset\fR options, e.g., line style and width,
+\fIglabax\fR options, etc., are all initialized to their default (\fBgopen\fR)
+values.
+.le
+
+.tp 4
+.ls gframe (gp)
+
+Issue a screen clear or frame advance.  This call is equivalent to \fBgclear\fR
+except that the internal state of GIO is not initialized.  An application
+might want to call \fBgframe\fR and \fBgreset\fR directly rather than using
+\fBgclear\fR, if the full initialization implied by \fBgclear\fR is not what
+is desired.
+.le
+
+.tp 4
+.ls greset (gp, flags)
+
+.nf
+pointer	gp		# graphics descriptor
+int	flags		# bitflags noting what to reset (0 is a no-op)
+.fi
+
+The \fBgreset\fR may be used to reset all or parts of the internal state of
+GIO, without actually doing any i/o to the graphics device.  The \fIflags\fR
+argument is used to specify what is to be reset.  The bitflags (defined in
+<gset.h>) are enumerated below.
+
+.nf
+	GR_RESETALL		reset everything
+	GR_RESETGIO		reset only GIO drawing parameters
+	GR_RESETWCS		reset the WCS to wcs=1, all NDC
+	GR_RESETGLABAX		reset the GLABAX parameters
+.fi
+
+A \fBgclear\fR is equivalent to a \fBgframe\fR followed by a
+greset(gp,GR_RESETALL).
+.le
+
+.tp 8
+.ls gmftitle (gp, mftitle)
+
+.nf
+pointer	gp		# graphics descriptor
+char	mftitle[ARB]	# comment (metafile title string)
+.fi
+
+Place a comment describing the graphics being generated in the output
+stream.  Useful primarily when the output is expected to be saved in a
+metafile.  No graphics is generated.
+.le
+.le
+
+.nh 3
+Set and Stat Procedures
+.ls
+.tp 8
+.ls gscan (gp, text)  [NOT YET IMPLEMENTED]
+
+.nf
+pointer	gp		# graphics descriptor
+char	text[ARB]	# graphics commands
+.fi
+
+The string \fBtext\fR, consisting of an arbitrary length sequence of
+printable ASCII graphics commands delimited by semicolons or newlines,
+is interpreted and executed by GIO.  Each GIO procedure has a corresponding
+command of the same syntax, minus the parenthesis, commas, and the argument
+\fBgp\fR.  The syntax of a \fBgset\fR command is "param=value".
+File inclusion is provided by the operator "@" followed by the filename
+of the file to be included.
+The include operator may appear anywhere a token is expected and includes
+may be nested up to some maximum depth.
+The sequence "@STDIN" is especially useful for entering commands or data
+interactively.
+.le
+
+.tp 8
+.ls gset[irs] (gp, param, value)
+
+.nf
+pointer	gp		# graphics descriptor
+int	param		# parameter to be set
+[irs]	value		# new value for parameter
+.fi
+
+Set the value of the indicated parameter.  A separate procedure is used for
+integer, real, and string valued parameters, i.e., gseti, gsetr, gsets.
+GIO parameters may be either internal state variables (e.g. the number of
+ticks on an axis) or device parameters (e.g. the number of the pen to be
+used to draw lines).
+The GIO parameters are defined in the global include file \fB<gset.h>\fR.
+.le
+
+.tp 10
+.sp
+.nf
+gstati (gp, param)
+gstatr (gp, param)
+gstats (gp, param, outstr, maxch)
+.fi
+.ls
+.nf
+pointer	gp		# graphics descriptor
+int	param		# parameter to be set
+char	outstr[maxch]	# output string
+.fi
+
+Inquire the value of the indicated GIO internal parameter.
+The integer and real functions \fBgstati\fR and \fBgstatr\fR return
+the parameter value as the function value, whereas \fBgstats\fR is
+a procedure returning the string value of a parameter as an output argument.
+The GIO parameters are defined in the global include file \fB<gset.h>\fR.
+.le
+
+.tp 11
+.sp
+.nf
+ggetb (gp, cap)
+ggeti (gp, cap)
+ggetr (gp, cap)
+ggets (gp, cap, outstr, maxch)
+.fi
+.ls
+.nf
+pointer	gp		# graphics descriptor
+char	cap[2]		# device capability
+char	outstr[maxch]	# output string
+.fi
+
+Inquire the value of the indicated graphics device capability.
+The device capability \fIcap\fR is the two character name of the capability
+as it appears in the \fIgraphcap\fR file.  Aside from the device capabilities
+required by GIO, GIO itself knows nothing about the graphcap device
+capabilities.  New capabilities may be added without modifying GIO.
+The \fBgget\fR procedures call the corresponding procedures in the TTY
+interface.  If more control over device capabilities is required than
+that provided by GIO, the TTY interface may be used directly, following a
+call to \fBgstati\fR to get the pointer to the TTY descriptor for the device.
+
+The boolean function \fBggetb\fR tests whether the device has the named
+capability.  The integer and real functions \fBggeti\fR and \fBggetr\fR return
+the capability value as the function value, or zero if the capability is
+not defined for the device.  String valued capabilities are returned by
+\fBggets\fR as an output argument; the null string is returned if the
+device does not have the indicated capability.
+.le
+
+.tp 8
+.ls g[sg]view (gp, x1, x2, y1, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x1, x2		# range of NDC coordinates in X
+real	y1, y2		# range of NDC coordinates in Y
+.fi
+
+Set or get the NDC coordinates of the viewport associated with the current WCS.
+The default viewport is the full display area of the device.
+.le
+
+.tp 8
+.ls g[sg]wind (gp, x1, x2, y1, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x1, x2		# range of world coordinates in X
+real	y1, y2		# range of world coordinates in Y
+.fi
+
+Set or get the world coordinates of the window associated with the current WCS.
+The default window ranges from 0 to 1 in both X and Y, i.e., the default
+window associates a normalized coordinate system with the associated viewport.
+Any window limits passed as INDEF will be ignored, i.e., those window
+parameters will not be modified.
+.le
+
+.tp 9
+.ls g[ar]scale (gp, v, npts, axis)
+
+.nf
+pointer	gp		# graphics descriptor
+real	v[npts]		# data vector window is to be scaled to
+int	npts		# length of data vector
+int	axis		# axis to be scaled (1=X, 2=Y).
+.fi
+
+Set absolute (\fIgascale\fR) or rescale (\fBgrscale\fR) the minimum and
+maximum world coordinates of the indicated axis of the current window,
+i.e., scale the window to fit a data vector.
+May be called repeatedly if overplotting several curves.  The current minimum
+and maximum values for either axis may be obtained at any time by calling
+\fBggwind\fR.  To scale the window to fit a family of curves,
+call \fBgascale\fR for the first curve and \fBgrscale\fR for the remaining
+curves, thereby computing the range in X and or Y of all curves.
+.le
+
+.tp 9
+.ls ggscale (gp, x, y, dx, dy)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# point at which scale is desired (wc)
+real	dx, dy		# scale, wcs units per ndc unit
+.fi
+
+Determine the scale in world coordinate units at the point (x,y).  Useful
+for computing the size of an object in world coordinates given its size
+in ndc coordinates, or vice versa.  An approximation is used to determine
+the scale if log scaling is in use.  Note that the scale is a function of
+position for the nonlinear coordinate systems.
+.le
+
+.tp 9
+.ls gctran (gp, x1, y1, x2, y2, wcs1, wcs2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x1, y1		# input point in WCS1 coords
+real	x2, y2		# output point in WCS2 coords
+int	wcs1, wcs2	# input, output world coordinate systems
+.fi
+
+Transform a point in world coordinate system \fIwcs1\fR to world coordinate
+system \fIwcs2\fR.  If \fIwcs1\fR is zero the transformation is from NDC
+coordinates to WCS coordinates.  If \fIwcs2\fR is zero the transformation is
+from WCS coordinates to NDC coordinates.  Otherwise the transformation is
+between two user defined world coordinate systems.  The point need not fall
+within the viewports of the two world coordinate systems.  World coordinate
+systems which were never set are equivalent to WCS=0.
+.le
+
+.tp 9
+.ls gcurpos (gp, x, y)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# current pen position in world coordinates
+.fi
+
+Return the "current pen position" in the current world coordinate system.
+The current pen position is the position set by the last move or draw
+command.
+.le
+
+.tp 10
+.ls gescape (gp, fn, instruction, nwords)
+
+.nf
+pointer	gp		# graphics descriptor
+int	fn		# function code
+short	instruction[nwords]	# instruction sequence to be passed
+int	nwords		# length of instruction sequence
+.fi
+
+Send a device dependent instruction sequence to the graphics kernel.
+Escape functions are ignored by GIO and by graphics kernels that do
+not recognize the function code.
+.le
+.le
+
+.nh 3
+Output Procedures
+
+    Data passed to the polyline or polymarker output procedures may contain
+embedded INDEF (indefinite) values in the X, Y, or V arrays.  Indefinite valued
+points appear as gaps in the plot and are ignored when autoscaling.
+Indefinite valued pixels are not permitted in a cell array since GIO does
+not look at the values of the pixels.
+
+.ls
+.tp 9
+.ls glabax (gp, title, xlabel, ylabel)
+
+.nf
+pointer	gp		# graphics descriptor
+char	title[ARB]	# plot title
+char	xlabel[ARB]	# X axis label
+char	ylabel[ARB]	# Y axis label
+.fi
+
+Draw and label the axes of the viewport.
+If the WCS has not yet been fixed it will be fixed by this call.
+If desired, \fBglabax\fR may modify the window slightly to place
+simple values on the tick marks.  Numerous \fBgset\fR options are
+available for controlling the number and sizes of the tick marks,
+the format of tick labels, the axes on which tick labels appear,
+and so on.  If the device viewport has not yet been set and axis labeling
+is enabled, \fBglabax\fR will set a default size viewport which allows room
+for the label text outside the viewport.
+.le
+
+.tp 8
+.ls gline (gp, x1, y1, x2, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x1, y1		# start of line
+real	x2, y2		# end of line
+.fi
+
+Draw a line connecting the point (x1,y1) to the point (x2,y2) (WCS coordinates).
+The linetype, linewidth, and color may be changed beforehand with a call
+to \fBgset\fR.  The relevant parameters and their possible values are shown
+below.  Linetype zero (clear) may be used to erase lines drawn with any of the
+other linetypes (device permitting).
+
+.ks
+.nf
+	G_PLTYPE	0=clear, 1=solid, 2=dashed, 3=dotted,
+			    4=dotdash, >4=device dependent
+	G_PLWIDTH	relative line width (default 1.0)
+	G_PLCOLOR	color index
+.fi
+.ke
+.le
+
+.tp 8
+.ls gpline (gp, x, y, npts)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x[npts]		# X coordinates of the line endpoints
+real	y[npts]		# Y coordinates of the line endpoints
+int	npts		# number of line endpoints
+.fi
+
+Polyline.  Draw a line connecting the points (WCS coordinates).
+The linetype, linewidth, and color may be changed beforehand with a call
+to \fBgset\fR.
+.le
+
+.tp 8
+.ls gvline (gp, v, npts, x1, x2)
+
+.nf
+pointer	gp		# graphics descriptor
+real	v[npts]		# vector to be plotted (Y values)
+int	npts		# number of line endpoints
+real	x1, x2		# range of vector in X 
+.fi
+
+Vector polyline.  Draw a polyline wherein the Y values of the polyline are
+taken from V and the X values are evenly distributed along the X-axis,
+ranging from X1 at point V[1] to X2 at point V[npts] (WCS coordinates).
+.le
+
+.tp 9
+.ls gmark (gp, x, y, marktype, xsize, ysize)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# WCS coordinates of marker
+int	marktype	# marker type
+real	xsize, ysize	# marker sizes
+.fi
+
+Mark drawing primitive.  Draw a mark of type \fImarktype\fR and size
+\fImarksize\fR at the given position in WCS coordinates.
+The marker type codes recognized are shown below and are defined in <gset.h>.
+Marktype codes may be summed to make composite marks, e.g.,
+
+	call gmark (gp, x, y, GM_PLUS+GM_CROSS, 1.)
+
+is an asterisk.  The pseudo-mark GM_FILL may be combined with GM_CIRCLE,
+GM_BOX, or GM_DIAMOND to output the mark as a filled area, using the current
+fill area attributes.  A positive \fImarksize\fR specifies the mark size in NDC
+coordinates, whereas negative signifies WCS coordinates.
+The positive marksizes 1., 2., 3., and 4. signify default size marks of
+increasing size.
+
+.ks
+.nf
+    typecode      name                symbol
+
+	0 	GM_POINT	smallest plottable point
+        1	GM_FILL		fill interior of mark
+	2	GM_BOX		square box
+        4	GM_PLUS		plus
+	8	GM_CROSS	cross
+       16	GM_DIAMOND	diamond
+       32	GM_HLINE	horizontal line
+       64	GM_VLINE	vertical line
+      128	GM_HEBAR	horizontal error bar
+      256	GM_VEBAR	vertical error bar
+      512	GM_CIRCLE	circle
+.fi
+.ke
+
+The linetype for a mark is set by the parameter G_PMLTYPE.  A mark may
+be erased (device permitting) by setting the marker linetype to clear and
+redrawing the mark.  The color index used for marks is controlled by the
+\fBgset\fR parameter G_PMCOLOR.
+.le
+
+.tp 9
+.ls gpmark (gp, x, y, npts, marktype, xsize, ysize)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x[npts]		# WCS X coordinates of markers
+real	y[npts]		# WCS Y coordinates of markers
+int	npts		# number of markers
+int	marktype	# marker type
+real	xsize, ysize	# marker sizes
+.fi
+
+Polymarker.  Plot a sequence of \fInpts\fR markers at the positions given
+by successive WCS coordinate pairs (x[i],y[i]).  All markers will be of
+the same type and size.  The significance of the marker type and size codes
+is the same as for \fBgmark\fR.
+.le
+
+.tp 9
+.ls gvmark (gp, v, npts, x1, x2, marktype, xsize, ysize)
+
+.nf
+pointer	gp		# graphics descriptor
+real	v[npts]		# WCS Y coordinates of markers
+int	npts		# number of markers
+real	x1, x2		# range of WCS X coordinates
+int	marktype	# marker type
+real	xsize, ysize	# marker sizes
+.fi
+
+Vector polymarker.  Plot a sequence of \fInpts\fR markers at the positions given
+by successive WCS coordinate pairs (x[i],y[i]), where the x[i] are evenly
+distributed from X1 at V[1] to X2 at V[npts].  All markers will be of the same
+type and size.  The significance of the marker type and size codes is the same
+as for \fBgmark\fR.
+.le
+
+.tp 11
+.ls gumark (gp, x, y, npts, xcen, ycen, xsize, ysize, fill)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x[npts],y[npts]	# normalized polyline defining marker
+int	npts		# number of points in polyline
+real	xcen, xcen	# world coordinates of center of marker
+real	xsize, ysize	# marker size in X and Y
+int	fill		# draw mark using area fill
+.fi
+
+Draw a user defined marker.  The marker is defined by the polyline (X[i],Y[i]),
+normalized to the unit square.  The marker polyline is scaled to fit the
+window defined by \fIxcen\fR, \fIycen\fR, \fIxsize\fR, and \fIysize\fR,
+where the center is always defined in world coordinates but the marker sizes
+may be defined in any of a number of ways (see \fBgmark\fR).  If \fIfill\fR
+is YES the marker will be drawn using area fill rather than as a polyline.
+.le
+
+.tp 8
+.ls g[ar]move (gp, x, y)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# WCS coordinates to move or shift
+.fi
+
+Move absolute (\fBgamove\fR) or move relative (\fBgrmove\fR),
+with the "pen up".  A move relative should be preceded by a move absolute
+to unambiguously define the "current pen position" in WCS coordinates.
+Only the move, draw, and mark primitives leave the pen in a defined position.
+Calls to \fBgset\fR may be intermixed with move and draw commands without
+affecting the current pen position.
+.le
+
+.tp 8
+.ls g[ar]draw (gp, x, y)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# WCS coordinates to move or shift
+.fi
+
+Move absolute (\fBgadraw\fR) or move relative (\fBgrdraw\fR),
+with the "pen down".  Draws a line segment.
+The type of line drawn (linetype or "pen number") defaults to solid but
+may be changed beforehand with a call to \fBgset\fR.
+Calls to \fBgset\fR may be intermixed with move and draw commands without
+affecting the current pen position.
+.le
+
+.tp 9
+.ls gtext (gp, x, y, text, format)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# WCS coordinates of text string
+char	text[ARB]	# text to be plotted
+char	format[ARB]	# text characteristics
+.fi
+
+Plot the string \fItext\fR at the position (x,y) in WCS coordinates.
+The default size, orientation, and justification of the generated string 
+may be set by a prior call to \fBgset\fR or overridden for the duration
+of the current call by the \fIformat\fR string.  A null format string
+is permtted.
+
+
+.ks
+.nf
+          keyword               values                 default
+
+        up	        degrees ccw, zero = +x          90
+        size            character size scale factor	1.0
+        path	        left,right,up,down              r
+        hjustify        normal,center,left,right	l
+        vjustify        normal,center,top,bottom        b
+	font		roman,greek,italic,bold		r
+	quality		normal,low,medium,high		n
+	color		integers greater than one	1
+.fi
+.ke
+
+
+The attributes controlling how text is generated are shown above.
+The character up vector (attribute \fIup\fR) defines the horizontal and
+vertical axes (the horizontal axis is perpendicular to the character up
+vector).  Directions left and right, up and down are relative to these axes.
+The attribute \fIpath\fR defines the direction in which characters are
+to be plotted.  The attribute \fBquality\fR makes it possible to choose
+between low or medium quality (fast) and high quality (expensive) character
+generation techniques, e.g., hardware versus software character generation.
+This attribute is normally best set to "normal" and then overridden at
+metafile translation time.
+
+The attributes are set in the format string by a semicolon delimited list of
+keyword=value constructs.  Only the first character of keyword and value
+strings is significant, i.e., keywords and values may be abbreviated to as
+little as one character if desired.  For example, the format "p=d;v=c"
+would plot characters downward in a vertical string centered at the position
+given.
+
+The default font is set by the font attribute at the beginning of each call.
+Font changes may also be signaled by placing the sequence "\fF" in the text,
+where F is one of the characters RGIB, denoting the fonts roman, greek,
+italic, and bold.  In this manner the font may change from character
+to character within a single line of text.  Additional escape sequences may
+be added to represent special symbols.
+.le
+
+.tp 10
+.ls gfill (gp, x, y, npts, style)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x[npts]		# X coordinates of polygon
+real	y[npts]		# Y coordinates of polygon
+int	npts		# number of vertices of polygon
+int	style		# type of fill
+.fi
+
+Area fill.  The points (x[i],y[i]) define a closed area which will be filled
+in the indicated \fIstyle\fR.  The recognized style codes, defined in <gset.h>,
+are:
+
+.ks
+.nf
+	0	GF_CLEAR	clear area
+	1	GF_HOLLOW	draw only outline of area
+	2	GF_SOLID	fill area with a color
+       3-6	GF_HATCH[1234]	fill area with a pattern
+       7-N			device dependent
+.fi
+.ke
+
+If the device can support multiple colors the color index for area fill may
+be set beforehand with a call to \fBgset\fR to set the parameter G_FILLCOLOR.
+.le
+
+.tp 10
+.ls gpcell (gp, m, nx, ny, x1, y1, x2, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+short	m[nx,ny]	# greylevels or colors (pixels)
+int	nx, ny		# number of pixels in X and Y
+real	x1, y1		# lower left corner of output area
+real	x2, y2		# upper right corner of output area
+.fi
+
+Output a cell array.
+Map each pixel in the input array into the corresponding area
+of the output device.  For maximum efficiency the resolution of M should
+match that of the area of the output device defined by the window (x1,y1)
+and (x2,y2), otherwise M is subsampled or replicated to best fill the output
+area.  The aspect ratio of a pixel need not be preserved in the mapping.
+The pixel values (greylevels or color indices) are passed on to the kernel
+without modification.
+.le
+
+.tp 7
+.ls gscur (gp, x, y)
+
+.nf
+pointer	gp		# graphics descriptor
+real	x, y		# new cursor position
+.fi
+
+Move the device cursor to the indicated position (WCS coordinates).
+.le
+.le
+
+.nh 3
+Input Procedures
+
+    Input procedures are available for cursor and pixel input.  Inquiry of GIO
+parameters and device capabilities is handled by the \fBgstat\fR and \fBgget\fR
+procedures and is not considered graphics input.
+
+.ls
+.tp 8
+.ls clgcur (param, wx, wy, wcs, key, strval, maxch)
+
+.nf
+char	param[ARB]	# CL parameter to be input
+real	wx, wy		# world coordinates of cursor event
+int	wcs		# index of WCS selected
+int	key		# keystroke value of cursor event
+char	strval[maxch]	# string value if set option (key = ':')
+int	maxch		# max chars to be returned in strval
+.fi
+
+The next value of the list structured CL cursor type parameter \fIparam\fR
+is read and the cursor coordinates in WCS units are decoded and returned
+as output arguments, along with the WCS number and the keystroke value,
+i.e., the character typed by the user causing the cursor to be read.
+The range of keystroke values is the full ASCII character set, minus a system
+dependent subset of control codes (if a physical cursor is read, the read is
+always terminated by the user typing a key on the user terminal).
+No GIO device need be open to read the cursor.  EOF is returned as the
+function value when the end of the cursor list is reached.
+The number of output arguments successfully decoded is returned as the
+function value for a normal read.  Values not converted are set to zero.
+.le
+
+.tp 8
+.ls ggcur (gp, sx, sy, key)
+
+.nf
+pointer	gp		# graphics descriptor
+real	sx, sy		# NDC coordinates of cursor event
+int	key		# keystroke value of cursor event
+.fi
+
+The physical cursor of the graphics device associated with graphics
+descriptor \fIgp\fR is read and the cursor coordinates in NDC units are
+returned as output arguments, along with the keystroke value, i.e.,
+the character typed or button pushed causing the cursor to be read.
+On many devices the cursor read will be instantaneous (the cursor position
+will be sampled), and the keystroke value will always be zero.  The range
+of possible keystroke values is device dependent.  EOF is returned as the
+function value when the end of the cursor list is reached.  An error action
+is taken if the device is not readable.  The GIO device must have previously
+been opened with \fBgopen\fR.
+
+Use of this low level procedure is not recommended since it forces a program
+to be used interactively, operation is device dependent, and cursor mode
+interaction is not supported.  The main uses for \fBggcur\fR are cursor input
+from special graphics devices, i.e., devices other than \fBstdgraph\fR or
+\fBstdimage\fR, and continuous sampling of the cursor position on devices
+which support it.  The characteristics of the device cursors are described
+in the graphcap entry for the device.
+.le
+
+.tp 10
+.ls ggcell (gp, m, nx, ny, x1, y1, x2, y2)
+
+.nf
+pointer	gp		# graphics descriptor
+short	m[nx,ny]	# output pixel array
+int	nx, ny		# number of pixels out in X and Y
+real	x1, y1		# lower left corner of input area
+real	x2, y2		# upper right corner of input area
+.fi
+
+Input a cell array.  The cell array defined by the rectangular window
+from point (x1,y1) to (x2,y2) is read into the output array M of size
+NX columns by NY lines.
+For maximum efficiency the resolution of the output array should match
+that of the device area defined by the input window.
+If the resolution of the output array does not match that of the device
+output lines will be subsampled or replicated to best fit the output array.
+Unaddressable pixels are returned as negative values.  An error action is
+taken if the device is not readable.
+.le
+.le
+
+.nh 2
+GIO Internal Parameters
+
+    The GIO internal parameters may be set with either a \fBgset\fR or
+\fBgscan\fR call, and inspected with a \fBgstat\fR function call.
+Parameters are identified to \fBgset\fR and \fBgscan\fR by an integer
+code.  Each integer code is assigned a symbolic name of the form G_PARAM
+in the include file <gset.h>.  In input to \fBgscan\fR, parameters are
+referred to by name in lower case, without the "g_" prefix.  The parameters
+and their default values are shown below.
+
+
+.tp 5
+.nf
+        \fBparameter     default            description\fR
+
+	wcs		1	index of current WCS
+	xtran		linear	linear, log, or nlog (WCS attribute)
+	ytran		linear	linear, log, or nlog (WCS attribute)
+	clip		yes	clip at viewport boundary (WCS attribute)
+	cursor		1	current cursor number
+	pltype		1	polyline linetype
+	plwidth		1.0	polyline relative line width
+	plcolor		1	polyline color index
+	pmltype		1	polymarker linetype
+	pmcolor		1	polymarker color index
+	szmarker[1-4] (.5:2)*ch	standard marker sizes, NDC coordinates
+	fastyle		1	fill area interior style
+	facolor		1	fill area color index
+	txsize		1.0	relative character size
+	txup		90	character up vector
+	txpath		right	direction in which characters are drawn
+	txspacing	0.0	character spacing relative to height
+	txhjustify	left	horizontal justification (n,c,l,r)
+	txvjustify	bottom	vertical justification (n,c,t,b)
+	txfont		roman	text font (roman,greek,italic,bold)
+	txquality	normal	text generator precision (n,l,m,h)
+	txcolor		1	text color index
+.fi
+
+.tp 9
+.nf
+	    (axis labeling parameters)
+
+	drawtitle	yes	draw plot title if given
+	titlesize	1.0	character size for plot title
+	titlejust	center	horizontal justification of title
+	ntitlelines	1	number of lines in title block
+	aspect		0.0	aspect ratio of viewport (0=dontcare)	
+
+	    (the following are duplicated for the Y axis)
+
+	xdrawaxes	3	draw X axis 1, 2, both (3), none (0)
+	xsetaxispos	no	set world coords of X axes
+	xaxispos1	0.0	world coord of X axis 1 (default wx1)
+	xaxispos2	0.0	world coord of X axis 2 (default wx2)
+	xdrawgrid	yes	draw grid marks connecting X ticks
+	xround		no	extend WCS to end at a tick mark
+	xlabelaxis	yes	draw axis label string if given
+	xaxislabelsize	1.0	character size for X axis label
+	xdrawticks	yes	draw and label X ticks
+	xlabelticks	yes	label X ticks
+	xnmajor		6	number of major ticks in X
+	xnminor		4	number of minor ticks in X
+	xmajorlength	0.8ch	length of a major tick, X
+	xminorlength	0.4ch	length of a minor tick, X
+	xmajorwidth	1.0	linewidth of a major tick, X
+	xminorwidth	1.0	linewidth of a minor tick, X
+	xaxiswidth	1.0	linewidth of the axis
+	xticklabelsize	1.0	character size for X tick labels
+	xtickformat	""	override format for X tick labels
+.fi
+
+.tp 4
+.nf
+	    (read only variables)
+
+	tty		-	pointer to TTY graphcap descriptor
+	fd		-	file descriptor of output stream
+	devname		-	device name as passed to gopen
+.fi
+
+
+The Y axis parameters have names equivalent to those shown with the
+X prefix replaced by a Y.  If the prefix is omitted entirely then the
+parameters for both axes will be set or queried.
+The \fBglabax\fR code and parameters are built upon the GIO graphics
+primitives and may be replaced by a more sophisticated user program
+if desired.
+
+Drawing and labeling of the X and Y axes is parameterized independently
+in X and Y.  If drawing and labeling of an axis is disabled, tick drawing
+and labeling is automatically disabled.  Drawing and labeling of an axis
+may be disabled on only one side of the viewport (useful when a single viewport
+is used simultaneously for two different world coordinate systems).
+If tick drawing is disabled tick labeling is automatically disabled.
+The tick marks, if drawn, may be connected by dotted lines within the
+interior of the plot.
+
+Given the approximate number of major ticks, GIO will compute the nearest
+number of tick marks resulting in round numbers for the tick mark labels.
+If rounding is enabled the window will be enlarged to the nearest tick
+outward on either end of an axis, otherwise an axis will end at the window
+boundary, which need not fall on a tick mark.
+If linear scaling is indicated \fInminor\fR minor ticks will be drawn
+between each pair of major ticks.  If log scaling is indicated the
+\fInmajor\fR and \fInminor\fR parameters are ignored and
+major ticks will be placed at powers of ten with eight minor ticks
+(e.g., 2,3,4,5,6,7,8,9) between each pair of major ticks.
+Tick lengths are given in NDC coordinates.  The default tick lengths
+are parameterized in terms of the character height for the device.
+
+
+.nh 2
+Graphcap Parameters
+
+    Each logical graphics device accessible to GIO must have an entry
+in the \fBgraphcap\fR (graphics capabilities) file.  The name of the
+device entry in the graphcap file must agree with that specified in the
+\fBgopen\fR call when the device is opened.  Multiple logical device
+entries may be given for a single physical device, each with slightly
+different parameters.  The name of the graphcap file is parameterized
+by the CL environment variable "graphcap", making it easy for the user
+to customize or extend the graphcap file.  The graphcap entries for
+common devices may be precompiled by the system manager to eliminate
+the overhead of searching the graphcap file at run time.
+
+The format of the graphcap file is identical to that of a UNIX \fBtermcap\fR
+file, and indeed the same interface (TTY) is used to access both types of files.
+The set of capabilities defined for a graphics device is however quite
+different than that defined for a terminal.  Capabilities are typed 
+parameters referred to by a two character internal name.  The restriction to
+two characters is perhaps unfortunate but is desirable for efficiency reasons
+(as well as for compatablity with the original termcap) and may be alleviated
+at some point in the future by the use of macro defines.
+
+Graphcap parameters fall into two classes, those parameters which are
+common to all devices, and those parameters which are required only for
+devices accessed with a particular graphics kernel.  GIO is capable
+of supporting any number of quite different kernels, each of which may
+support any number of devices.  These kernels are free to add parameters
+to their graphcap entries provided they do not conflict with the standard
+parameters.  An example is the "fast" or \fBstdgraph\fR kernel, discussed
+in detail in a later section.  If a device is to be accessed by more than
+one kernel each kernel must typically have its own graphcap entry for the
+device, with selection of the graphcap entry (logical device name)
+specifying the kernel to be used.
+
+In the discussion which follows the reader is assumed to already be familiar
+with the syntax and usage of \fBtermcap\fR format files.  This is documented,
+for example, in section 5 of the UNIX manuals.  A sample termcap entry for
+the devices "vt100-nam" and "vt100-am" is included below as an example of
+a typical termcap entry.
+
+
+.tp 5
+.nf
+d1|vt100|vt100-nam|vt100 w/no am:\
+	:am@:xn@:tc=vt100-am:
+d0|vt100|vt100-am|vt100|dec vt100:\
+	:cr=^M:do=^J:nl=^J:bl=^G:co#80:li#24:cl=50\E[;H\E[2J:\
+	:le=^H:bs:am:cm=5\E[%i%d;%dH:nd=2\E[C:up=2\E[A:\
+	:ce=3\E[K:cd=50\E[J:so=2\E[7m:se=2\E[m:us=2\E[4m:ue=2\E[m:\
+	:md=2\E[1m:mr=2\E[7m:mb=2\E[5m:me=2\E[m:is=\E[1;24r\E[24;1H:\
+	:rs=\E>\E[?3l\E[?4l\E[?5l\E[?7h\E[?8h:\
+	:if=/usr/lib/tabset/vt100:ku=\EOA:kd=\EOB:kr=\EOC:kl=\EOD:kb=^H:\
+	:ho=\E[H:k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:ta=^I:pt:sr=5\EM:vt#3:xn:\
+	:k5=\EOp:k6=\EOx:k7=\EOr:k8=\EOm:k9=\EOl:k0=\EOq:\
+	:sc=\E7:rc=\E8:cs=\E[%i%d;%dr:ks=\E[?1h\E=:ke=\E[?1l\E>:
+.fi
+
+
+Note that each device may be known by several names.  The device capabilities
+are delimited by colons, e.g., ":xx=...:yy=...:".  The special capability "tc"
+allows an entry to include another entry recursively.  Escape is represented
+as either "\E" or "^[", <ctrl/h> is "^H".  If a delay of so many milliseconds
+is required after transmission of a string, the number of milliseconds
+appears as the first few chars in an entry, e.g., "cl=50..." causes a
+delay of 50 milliseconds following a screen clear.  Numeric capabilities are
+prefaced by a sharp, e.g., ":co#80:" (screen has 80 columns).
+
+
+.nh 3
+Generic GRAPHCAP Parameters
+
+    To make the distinction between the generic and kernel graphcap parameters
+clear and to eliminate the possibility of redefinitions, the generic
+parameters have lower case names and the kernel parameters have upper case
+names.  Only the standard graphcap parameters should be accessed from within
+applications programs.  The standard parameters are listed and defined below.
+These parameters should be included in the graphcap entry for every device.
+
+.ls 4
+.ls 15 ar   real
+Aspect ratio dY/dX, i.e., the ratio of the size of the device screen in Y to
+that in X (equivalent to ys/xs).
+.le
+.ls ca   bool
+Device implements cellarray plotting in hardware, i.e, the \fIzr\fR greylevels
+are displayed by the hardware rather than emulated by software in the kernel.
+.le
+.ls ch   real
+Height in NDC units of a character of size 1.0.
+.le
+.ls co   int
+Number of columns of text displayable on the device screen at character
+size 1.0.
+.le
+.ls cw   real
+Width in NDC units of a character of size 1.0.
+.le
+.ls fa   bool
+Device implements fill area in hardware.
+.le
+.ls fs   int
+Number of fill area styles supported by the device.
+.le
+.ls in   bool
+Device supports at least one input function, i.e., cursor readback or cell
+array input.
+.le
+.ls k1   int
+Minimum possible key value in a cursor read.
+.le
+.ls k2   int
+Maximum possible key value in a cursor read.
+.le
+.ls kf   str
+Filename of the executable graphics kernel file for the device.
+If this is given as "cl", the kernel is assumed to be resident in the
+CL process.  Should be a virtual filename, e.g., "dev$x_device.e".
+See also parameter \fItn\fR.
+.le
+.ls li   int
+Number of lines of text displayable on the device screen at character
+size 1.0.
+.le
+.ls lt   int
+Number of linetypes supported by the device.
+.le
+.ls lw   int
+Number of linewidths supported by the device.
+.le
+.ls nc   int
+Number of cursors supported by the device.
+.le
+.ls nk   int
+Number of possible key values in a cursor read.
+.le
+.ls pl   bool
+Device implements polyline drawing in hardware.
+.le
+.ls pm   bool
+Device implements polymarker drawing in hardware.
+.le
+.ls ro   bool
+Device supports roam at the hardware level (used in cursor mode).
+.le
+.ls se   bool
+Device supports selective erase of portions of the screen.
+.le
+.ls tf   int
+Number of text fonts supported by the device.
+.le
+.ls th   int
+Number of text heights or sizes supported by the device.  If absent or zero
+it is assumed that characters may be freely scaled in size.  If only a number
+of discreet character sizes are available the sizes are given by the
+parameters \fItN\fR.
+.le
+.ls tn   str
+Taskname, i.e., name of the logical task within the kernel file \fIkf\fR
+to be run to exercise a kernel.
+.le
+.ls tq   int
+Number of text quality or precision levels supported by the device.
+.le
+.ls tN   real
+Sizes of the \fIth\fR possible character sizes, relative to a character
+of size 1.0 (expands to the set of parameters t1,t2,...,tN).
+.le
+.ls tx   bool
+Device implements text generation in hardware.
+.le
+.ls wc   bool
+Reading the cursor implies a wait, i.e., a cursor read is triggered by
+the user.
+.le
+.ls xr   int
+Device resolution in X.
+.le
+.ls xs   real
+Device scale in X, i.e., the width of the display area in meters.
+.le
+.ls yr   int
+Device resolution in Y.
+.le
+.ls ys   real
+Device scale in Y, i.e., the height of the display area in meters.
+.le
+.ls zo   bool
+Device supports zoom at the hardware level (used in cursor mode).
+.le
+.ls zr   int
+Device resolution in Z, i.e., the number of greylevels or colors displayable
+at each point using the cell array primitive.
+.le
+.le
+
+
+The graphcap parameters are accessed by name via \fBgget\fR calls.
+For example,
+
+	xr = ggetr (gp, "xr")
+
+would assign the value of the parameter "xr" into the local variable of
+the same name.
+
+.nh 3
+STDGRAPH Graphcap Parameters
+
+    The \fBstdgraph\fR kernel is the "fast" kernel, i.e., the graphics kernel
+resident in the CL process.  This kernel is capable of driving almost any
+modern graphics terminals given only a graphcap entry for the device,
+providing the graphics terminal is data driven and provides both character
+and vector generation in hardware.
+
+.nh 4
+Classes of Parameters
+
+    The stdgraph parameters fall into a number of classes which we shall
+describe separately.  An alphabetical summary of all parameters is given in
+a later section.
+
+The open and close workstation sequences are sent to the device whenever the
+workstation is activated (OW) or deactivated (CW), e.g., when the STDGRAPH
+kernel receives the open workstation or close workstation directive, or when
+the open workstation is explicitly deactivated and later reactivated by the
+applications program.
+
+The primary function of the open and close workstation sequences is to
+effect a mode switch from text mode to graphics mode and back again,
+but the sequences may also contain instructions used only for initialization
+or mode setting.  For example, OW might initialize user defined line types
+or enable the graphics board.  The close string CW might disable the graphics
+board and set the alpha cursor to a standard place on the screen.
+
+The graphics enable and disable strings (GE,GD) are sent to the terminal
+by the STDGRAPH kernel when status line i/o occurs.  The GD sequence should
+clear the status line, leaving the terminal in status line mode, with the
+text cursor positioned to the start of the status line.  The GE sequence
+restores the terminal to graphics mode, and is often the same as the OW
+sequence.  Note that GD should not cause the graphics frame to disappear,
+as the status line is supposed to be visible at the same time as the plot.
+
+The status line is normally the line at the bottom of the screen.  On terminals
+with separate text and graphics memories which can both be displayed at the
+same time, the status line is normally written into the text memory.  If the
+terminal has both text and graphics memories but can only display one at a time
+the graphics memory should be used, provided the status line can be erased in
+the graphics memory.  If the graphics plane must be used but erase is not
+possible, the best approach is probably to write successive lines of status
+line text on top of the plot, starting at the upper left corner and advancing
+downward for each line of output text (see the 4012 entry in dev$graphcap).
+
+The parameters X1, X2, Y1, and Y2 define the range of device coordinates
+to be output.  Normally these will span the full screen of the device,
+but in general they may define any rectangular window on the device screen.
+The fill area and font tables are array valued parameters mapping the GKI
+fill area and font indices into device codes (if the device should happen
+to support such niceties).
+
+
+.ks
+.nf
+	OW		open (reactivate) workstation
+	IF		initialization file, if OW string is large
+	CW		close (deactivate) workstation
+	GE		graphics enable (exit status line mode)
+	GD		graphics disable (enter status line mode)
+	CL		screen clear
+	LR		load registers (see "binary encoding")
+
+	X1,X2		range of device X coordinates
+	Y1,Y2		range of device Y coordinates
+.fi
+.ke
+
+
+The set attribute parameters are format strings used to encode set attribute
+commands, each of which has a single integer argument.  The format string is
+similar to a \fBprintf\fR format string with the addition of a notation for
+binary encoding (described below).
+
+
+.ks
+.nf
+	TH(i)		set text height
+	TC(i)		set text color
+	TF(i)		set text font
+	LT(i)		set line type
+	LC(i)		set line color
+	LW(i)		set line width
+	MC(i)		set marker color
+	FT(i)		set fill area type
+	FC(i)		set fill area color
+.fi
+.ke
+
+
+Polyline generation, i.e., vector drawing, is more difficult to parameterize.
+We assume that polylines, polymarkers, fill areas, etc. are all similar enough
+to be described by the same coordinate encoding format, but we allow each
+such instruction to have different head and tail strings.
+
+.ks
+.nf
+	PL		polyline flag
+	VS		move start
+	VE		move end
+	DS		draw start
+	DE		draw end
+	MS		marker start
+	ME		marker end
+	FS		fillarea start
+	FE		fillarea end
+	XY(i,j)		coord format
+.fi
+.ke
+
+
+A polyline command consists of a number of subcommands, as outlined in the
+drawing below.  The polyline is a move followed by one or more draws.
+The polyline flag PL is set to indicate that multiple coordinate pairs
+can be output between the DS and DE commands.  If PL is false (or omitted)
+each coordinate pair in the GKI polyline will be output surrounded by DS
+and DE commands.  The encoding of each coordinate pair is defined by the
+parameter XY.
+
+
+.ks
+.nf
+	set attributes if necessary
+	move start
+	    x, y
+	move end
+	draw start
+	    x, y
+		...
+	    x, y
+	draw end
+.fi
+.ke
+
+
+The polymarker and fillarea parameters are optional.  The kernel will
+emulate markers and fill area if not supported by the hardware.
+Recall that GIO handles all mark drawing except GM_POINT (point mode),
+hence sophisticated mark drawing facilities are not required.
+
+Text generation is handled by the kernel a character at a time.
+If character up is 90 degrees and the path is to the right, the kernel
+will assume that it can output a number of characters between a TS
+and a TE.  Otherwise each character will be output preceded by a TS
+and followed by a TE.  The TS parameter is a format string with two
+arguments, the device coordinates of the lower left corner of the
+character to be drawn.  The encoding of these coordinates is defined
+by the TS format string.  It is possible to perform a coordinate
+transformation using the binary encoding facilities, if such is necessary.
+If characters are not addressed at the lower left corner an offset
+may be applied to the given coordinates using the binary encoding
+facilities.
+
+
+.ks
+.nf
+	TS(i,j)		text start
+	TE		text end
+.fi
+.ke
+
+
+Cursor output is controlled by the parameter WC.
+Cursor input is initiated by output of the sequence defined by the format RC.
+RC has one integer argument, the number of the cursor to be read.
+The UC capability, if defined, will cause the cursor position to be updated
+(with WC) to the position at the last cursor read.  This is desirable if the
+device cannot maintain the cursor position, i.e., if unrelated graphics
+output commands affect the cursor position as an unwanted side effect.
+
+
+.ks
+.nf
+	UC		update cursor pos before read
+	WC(x,y,i)	write cursor 
+	RC(i)		read cursor start
+	RE		read cursor end
+	CN		cursor value length
+	CD		cursor value delimiter
+	SC		scan cursor (-> x,y,key)
+.fi
+.ke
+
+
+Following transmission of the RC sequence the kernel will read the
+response as defined by the parameters CN and CD.  At least one of CN or CD
+must be given.  If CN is given but not CD exactly CN characters will be
+read.  If CD is given then characters will be read until the delimiter string
+is matched (and until at least CN characters have been read).  If possible
+a delimiter string should be specified to permit recovery from bad cursor
+reads, e.g., when the user types something before the cursor is displayed.
+When a satisfactory cursor response string has been obtained the format SC
+will be used to decode the string into the output values X, Y, and KEY.
+The RE sequence is transmitted once the cursor read has successfully
+completed.
+
+.nh 4
+Binary Encoding
+
+    Graphics devices vary widely in the techniques used to encode numeric
+data such as a line type or color index, or the coordinate pairs of a
+polyline.  Our approach to the encoding problem is a generalization of the
+\fBprintf\fR format string.  The encoder is driven by a format string
+taken from the graphcap entry for the device.  A number of standard formats
+are recognized with encoding provided internally for these standard formats
+by the encoder.  To permit encoding of special formats the encoder provides
+a very general yet efficient RPN virtual machine capable of computing bit
+patterns according to a user supplied program embedded in the format string.
+
+A format string is a sequence of ASCII characters.  Any ASCII character,
+including all control characters, is permitted in the string.
+The significance of a character depends on the context in which it appears.
+Initially characters are simply copied to the output.  Three special
+characters are recognized in \fBcopy mode\fR (excluding the characters
+already counted as special by termcap):
+
+
+.ks
+.nf
+	'	escape next character (literal)
+	%	begin a formatted output string
+	(	begin an executable expression
+.fi
+.ke
+
+
+The encoder is a table driven interpreter which is programmed by the format
+given in the graphcap file.  Programming the encoder is rather
+like programming in assembler or microcode (its fun but easy to screw up).
+The encoder provides a set of 12 integer registers, an integer stack with a
+capacity of 50 values, and a dozen or so instructions.  It is fundamentally
+assumed that the character set is ASCII (this is guaranteed by the IRAF
+programming environment).
+
+Upon entry one or more of the registers 1 through 3 are initialized to the
+values of the input arguments, leaving the remaining registers, i.e., R4-R9
+and R0 (R10) available for general use.  Registers R11 and R12 are reserved
+for internal use.
+The interpreter is activated when an unescaped ( is encountered in the input.
+In \fBexecute mode\fR the following characters have special meanings
+(excluding :, ^, and \, which are special characters to termcap/TTY):
+
+.ks
+.nf
+	'	escape next character (recognized everywhere)
+	%	conventional formatted output
+	)	revert to copy mode
+	#nnn	push signed decimal integer number nnn
+	$ 	switch case construct
+	.	pop number from stack and place in output string
+	,	get next character from input string and push on stack
+	&	modulus (similar to AND of low bits)
+	+	add (similar to OR)
+	-	subtract (similar to AND)
+	*	multiply (shift left if pwr of 2)
+	/	divide (shift right if pwr of 2)
+	<	less than (0=false, 1=true)
+	> 	greater than (0=false, 1=true)
+	=	equals (0=false, 1=true)
+	;	branch if: <bool> <offset> ;.  The ; is at offset=0.
+       0-9	push contents of register 0 through 9
+	!N	pop stack into register N
+	!!	generate a N millisecond delay, where N is on the stack
+.fi
+.ke
+
+
+Any other character encountered in execute mode is interpreted as an integer
+number and pushed on the stack.  Hence, the character "@" is equivalent to
+"#64", i.e., octal 100.  A blank is the integer constant 40B.
+
+The output format directive % will format and output the number on the top
+of the stack, popping the stack in the process.  The format specification
+may be any legal \fBprintf\fR format.  The case construct is used to process
+set attribute commands, e.g., set linetype 0, 1, 2, text size 1, 2, 3, etc,
+and also provides a rudimentary conditional processing capability.  The branch
+if operator ; provides a rudimentary branching and looping capability.
+Beware that sequences like "^N" and "\E" compile as a single character in
+the format string.
+
+.nh 4
+Examples
+
+    As a simple example consider the encoding of the ANSI command to set
+the cursor of a nongraphics terminal.  The required sequence is the
+following:
+
+	ESC [ line ; col H
+
+Assuming that the column number is designated as X and the line number as
+Y, in registers 1 and 2 respectively, the format would be as follows
+(the quotes are not part of the format):
+
+	"\E[(2)%d;(1)%dH"
+
+Now assume that the output sequence is the same but the line and column
+numbers are one-indexed while the terminal requires zero-indexed
+coordinates:
+
+	"\E[(2#1-)%d;(1#1-)%dH"
+
+Thus far the examples have been pretty trivial and do not warrant the
+complexity of the RPN interpreter proposed here.  For our next example
+consider the encoding of a polyline coordinate pair for a Tektronix
+compatible graphics terminal and for an AED512, two quite different
+graphics terminals.  The Tektronix format for encoding an (X,Y) coordinate
+pair is as follows:
+
+
+.ks
+.nf
+	0 1 YA Y9 Y8 Y7 Y6
+	1 1 Y5 Y4 Y3 Y2 Y1
+	0 1 XA X9 X8 X7 X6
+	1 0 X5 X4 X3 X2 X1
+.fi
+.ke
+
+
+Since the Tektronix device is so common the special format %t is provided
+for encoding register 1 and 2 (X and Y) in this format, and writing out
+the result.  The format string
+
+	"%t"
+
+is all that is required.  The more general solution is provided by the
+following format.
+
+	"(2 / +.2 &`+.1 / +.1 &@+."
+
+To understand this last example one must look up the octal values of
+the characters " " (40B), "`" (140B), and "@" (100B).  The notation is
+admittedly rather cryptic but it is also concise and efficient, and works
+for a wide range of devices.
+
+Now consider the AED512 in binary mode (this is courtesy of NCAR; I do not
+have access to such a terminal).  The output encoding of a coordinate pair
+is as follows:
+
+
+.ks
+.nf
+	XA X9 X8 YB YA Y9 Y8
+	X7 X6 X5 X4 X3 X2 X1
+	Y7 Y6 Y5 Y4 Y3 Y2 Y1
+.fi
+.ke
+
+
+The format required to generate this is shown below.  Note the use of
+register 9 to store the constant 200B.  The "^N" signifies <ctrl/n>,
+i.e., 16B, used to effect a left shift of four bits.
+
+	"(#128!919/^N*29/+.19&.29&."
+
+This format could be further optimized by preloading register 9 at
+\fBopenws\fR time by moving the "(#128!9" to parameter LR.  The encoder
+registers maintain their values indefinitely.  Using LR the two parameters
+might appear in the graphcap entry as follows.
+
+	":LR=(#128!9:XY=(19/^N*29/+.19&.29&.:"
+
+The case construct makes it possible to generate output conditionally based
+on the value of an integer switch.  The syntax of a case statement is as
+follows:
+
+	$1 ... $2-5 ... $6 ... $D ... $$
+
+When the first $ is encountered the switch value is popped off the stack
+and converted into a character by addition of the constant '0' (60B).
+The interpreter will then scan forward until it finds the indicated case,
+at which point it resumes execution in case mode.  If the indicated case
+is not found scanning will stop at $D (the default case) or $$, whichever
+comes first.  When the next $ is seen the interpreter skips forward until
+it finds $$, which marks the end of the case.  Case constructs are not
+nestable.
+
+The case construct is used primarily for set attribute formats.
+For example, the GKI linetype codes are integers greater than or equal to zero,
+with case zero being the line clear and the other cases actual linetypes.
+For the VT640 there are nine possible linetypes, i.e., line clear,
+five builtin linetypes, and 3 user defined linetypes.  The strings to be
+output for the cases 0 through 5 are the following:
+
+
+.ks
+.nf
+	linetype		     string
+
+	    0			ESC / 1 d ESC `
+	    1			ESC / 0 d ESC `
+	    2			ESC / 0 d ESC a
+	    3			ESC / 0 d ESC b
+	  (etc)			     (etc)
+.fi
+.ke
+
+
+We could encode linetypes 0, 1 through 5, and everything else with the
+following format (linetype code in register 1):
+
+	"\E/(1$0)0d\E`($1-5)1d\E(1_+.$D)0d\E`($$"
+
+Note that case searching is a simple string matching operation that ignores
+operators such as ( and ).  Only $, ' (escape), and EOS are recognized when
+searching for a case.
+
+.nh 4
+Efficiency
+
+    The interpreter approach to solving the general encoding problem
+presented here is not the only solution to the problem.  Before adopting
+this approach several alternatives were considered.  One such alternative
+was the bitfield packing and unpacking scheme used by NCAR to solve the
+same problem.  The third alternative considered was to hand code a
+subroutine for each encoding required for each device.  Benchmarks run
+to compare the three alternatives yielded the following times in
+cpu seconds required to plot a 1000 point array with Tektronix encoding:
+
+
+.ks
+.nf
+	bitfields	approximately 30 seconds
+	interpreter	0.82 - 2.0 seconds
+	hand coded	0.78 seconds (mostly i/o)
+.fi
+.ke
+
+
+The time required for character output is included in the figures shown.
+The bitfields benchmark is an extrapolation from an actual timing of the
+prototype NCAR software as ported to the UNIX VAX by Cliff Stoll.
+The GBYTE and SBYTE primitives used to implement bitfields in the NCAR
+software were written in portable C by Cliff and did not use the VAX bitfield
+instructions, which would have helped significantly (but which would not
+have yielded a fair test: all IRAF target machines may not have bitfield
+instructions).  The two timings shown for the interpreter are for the "%t"
+format and the general format.  The clock time required by the hardware
+(VT100 with VT640 retrographics board) to draw the vectors was about 7 seconds.
+
+We conclude that the execution time overhead of the interpreter for encoding
+polyline points is acceptable and the use of hand coded, device dependent
+procedures is neither warranted nor desirable.  The bitfields technique
+is too inefficient to use in a production interface.
+
+.nh 4
+Decoding Cursor Input
+
+    Decoding of the cursor value string returned by the device into
+X, Y, and KEY (keystroke) values is carried out using the table driven
+interpreter for decoding rather than for encoding.  In this mode characters
+are input with "," and the decoded output values X, Y, and KEY are returned
+in registers 1 through 3.  The % format encoding operator is not used.
+If the cursor value is returned in ASCII X and Y must be converted to
+binary the hard way (e.g., "ch1 '0' - 100 * ch2 '0' - 10 * +", etc.).
+
+To verify that this scheme will work consider the cursor value returned
+by a Tektronix compatible terminal.  The return value is 6 characters,
+consisting of the character typed followed by the encoded X and Y in
+the next four characters, and lastly a CR terminator:
+
+
+.ks
+.nf
+	C7 C6 C5 C4 C3 C2 C1
+	 0  1 XA X9 X8 X7 X6
+	 0  1 X5 X4 X3 X2 X1
+	 0  1 YA Y9 Y8 Y7 Y6
+	 0  1 Y5 Y4 Y3 Y2 Y1
+	 0  0  0  1  1  0  1
+.fi
+.ke
+
+
+The required decoding format is shown below.
+
+	",!3, & *, &+!1, & *, &+!2"
+
+.nh 4
+Summary of STDGRAPH Graphcap Parameters
+
+    An alphabetical summary of the graphcap parameters used by the STDGRAPH
+kernel is given below.
+
+
+.tp 3
+.nf
+	CD		cursor value delimiter
+	CL		screen clear
+	CN		cursor response length
+	CW		close (deactivate) workstation
+	DE		draw end
+	DS		draw start
+	FC(i)		set fill area color
+	FE		fillarea end
+	FS		fillarea start
+	FT(i)		set fill area type
+	GD		graphics disable (exit status line mode)
+	GE		graphics enable (enter status line mode)
+	IF		initialization file, if OP string is large
+	LC(i)		set line color
+	LR		load registers
+	LT(i)		set line type
+	LW(i)		set line width
+	MC(i)		set marker color
+	ME		marker end
+	MS		marker start
+	OW		open (reactivate) workstation
+	PL		polyline flag
+	RC(i)		read cursor start
+	RE		read cursor end
+	SC		scan cursor (-> x,y,key)
+	TC(i)		set text color
+	TE		text end
+	TF(i)		set text font
+	TH(i)		set text height
+	TS(i,j)		text start
+	VE		move end
+	VS		move start
+	WC(x,y,i)	write cursor 
+	X1		first device X coordinate
+	X2		last device X coordinate
+	XY(i,j)		coordinate format
+	Y1		first device Y coordinate
+	Y2		last device Y coordinate
+.fi
+
+
+As a final example, the actual graphcap entry for the vt640 terminal
+(DEC VT100 with retrographics) is reproduced below.
+
+
+.ks
+.nf
+vt640|vt640g|vt100 with Retrographics:\
+    :RC=(1$2)^X\E[24;65H\E[7mLIGHT PEN READY\E[0m($$)^]\E"(1$2)5($D)4($$)g:\
+    :WC=^]%t\E/f:OW=150^]^_:CW=^X\E[24;0H\E[K:GE=150^]^_:GD=^X\E[24;0H\E[K:\
+    :lt#5:nc#2:se:CL=50^]\E^L:xr#640:yr#480:ar#.57:xs#.23:ys#.13:tc=4012:
+
+4012|tek4012|tektronix 4012:\
+    :ar#.70:ch#.0294:co#80:cw#.0125:in:k1#1:k2#127:kf=cl:li#35:\
+    :lt#5:nc#1:nk#127:pl:pm:th#4:t1#1:t2#2:t3#3:t4#4:tx:\
+    :wc:xr#1024:yr#780:xs#.20:ys#.14:\
+    :CD=^M:CN#6:LT=^]\E/(1$0)1d\E`($1-5)0d\E(1_+.$D)0d\E`($$:\
+    :MS=\034:PL:RC=\E^Z:SC=(,!3, & *, &+!1, & *, &+!2:\
+    :TH=\E(1#47+.:TS=^]%t^_:VS=^]:X1#0:X2#1023:XY=%t:Y1#0:Y2#779:\
+    :OW=^]^_:CW=(#682!2#0!1)^]%t^_:GE=^]^_:\
+    :CL=1000(#32!9)\E^L:\
+    :LR=(#32!9:GD=(9#1-!99$0#31!9$$9#22*!2#0!1)^]%t^_:
+.fi
+.ke
+
+.NH 3
+TERMCAP and GRAPHCAP
+
+    Every graphics terminal entry in the graphcap file should have a
+corresponding terminal capability entry in the termcap file.  When the user
+sets the terminal type with the \fBstty\fR task in the CL, the termcap entry
+tells whether or not the terminal supports vector graphics, and the value
+of the \fBstdgraph\fR environment variable is set to "none" for a non-graphics
+terminal, or to the graphcap name of the device for a graphics terminal.
+For a terminal to be recognized by the system as a graphics terminal the
+termcap entry must include the ":gd" capability.  If the graphcap name for
+the device is different than the termcap name then the form ":gd=gcname:"
+should be used.
+
+For example, the minimal termcap entry for the vt640 graphics terminal would
+be as follows.  Note that it makes no sense to set the terminal type to
+"vt100", since a standard vt100 does not support vector graphics.
+
+.ks
+.nf
+	vt640|Retrographics enhanced VT100:\
+	:gd:tc=vt100:
+.fi
+.ke
+
+The "gd" capability is not standard termcap, but will be ignored by non-IRAF
+programs which do not recognize the capability.
+
+.nh 2
+Graphics Kernel Interface
+
+    The graphics kernel interface (GKI) is the interface between GIO and the
+underlying graphics kernel or kernels.  The GKI is a data driven interface,
+i.e., GIO communicates with the graphics kernel via bidirectional streams
+of control instructions and data.  The functionality assumed by the GKI is
+simple enough to permit use of a variety of graphics kernels, e.g., the builtin
+GIO kernel for interactive graphics terminals, GKS, CORE, NSPP, and so on.
+To understand the level of functionality expected from the kernel we first
+summarize the functions the kernel is \fInot\fR expected to perform, i.e.,
+the functions performed by GIO before output to the kernel:
+
+.ls 4
+.ls o
+All WCS coordinate transformations and clipping at the viewport boundary.
+The kernel sees only NDC coordinates.
+.le
+.ls o
+Axis drawing and labeling.  GIO processes a \fBglabax\fR call into a
+sequence of polylines in NDC coordinates.
+.le
+.ls o
+Mark drawing.  GIO processes all mark drawing commands into polyline
+instructions.
+.le
+.ls o
+Move and draw commands.  GIO processes all absolute and relative move and draw
+commands into sequences of polyline instructions.
+.le
+.le
+
+
+The main functions of the kernel are the control and attribute set functions,
+set cursor, polyline, polymarker (GM_POINT only), text generation, fill area,
+cell array, and cursor read.  A kernel need not implement all such functions,
+but it must at least recognize and ignore the corresponding GKI instructions.
+The GKI kernel instructions are easily implemented for modern intelligent
+graphics terminals.  The fast kernel will let the terminal handle polyline
+drawing, point mode polymarker drawing, dashed lines, and character generation.
+
+The GKI format is a sequence of variable length binary control and
+output instructions.  Each instruction consists of the beginning of instruction
+sentinel (BOI), an integer binary opcode identifying the instruction,
+an integer giving the length of the instruction in metacode words,
+and an arbitrary number of parameter and data words.
+The BOI word aids in the detection of and recovery from botched instructions,
+e.g., if an interrupt occurs while writing an instruction.
+
+
+.ks
+.nf
+	 \fBfield\fR                          \fBdescription\fR
+
+	BOI		beginning of instruction (magic value = 100000B)
+	opcode		unique instruction identification code (1-27)
+	length		length of entire of instruction in metacode
+			    words (includes all four fields)
+	data		variable length part of instruction
+.fi
+
+.ce
+Figure 3. GKI Instruction Format
+.ke
+
+
+The instruction format chosen for GKI is basically a direct mapping of the
+required low level functions into binary opcodes.
+Various standard formats were considered and rejected,
+in particular the GKS VDM (virtual device metafile) format.
+GKS VDM turned out to be far to complex to be worth using at this level
+in the system.  The GKS VDI format might have been better suited,
+but I could not find any information describing this format
+(my understanding was that, although there are numerous implementations of VDI,
+there is no formal standard as yet).
+
+The GKI format may be extended at some point in the future to provide
+a binary instruction for each procedure in the GKS Fortran binding.
+This will make it possible for applications to use either GIO or GKS,
+provided a GKS kernel is available.  This will make it easier to
+import applications which are already written to use GKS (alternatively a
+mini-GKS might be built upon GIO, since the primitive functions are almost
+identical).  Since IRAF itself is transportable and it is desirable for IRAF
+applications to have full access to the IRAF i/o facilities, new IRAF
+applications are not being written with transport to another data reduction
+system in mind.  New IRAF applications will use only GIO whenever the
+facilities provided by GIO are adequate.  Applications which use only GIO
+will continue to be usable with any graphics kernel.
+
+.nh 3
+GKI Instructions
+
+    The GKI instruction stream transmitted between processes on the same or
+compatible machines will be a sequence of SPP short integer metacode words.
+The machine independent GKI metafile format will be the equivalent stream
+encoded as 16 bit twos complement signed integer metacode words, blocked 
+1440 words per block, with conversion between the internal and external
+metacode formats being provided by the IRAF MII (machine independent integer)
+interface (MII takes care of byte swapping, etc.).  GKI metafiles in MII
+format will be easily read and written by different machines, offloading most
+of the work to the graphics kernel on the reader machine.  The GKI instruction
+format is designed for maximum efficiency on modern minicomputers, i.e.,
+the internal format (SPP short integer) is an atomic datatype and no bit
+operations are required to generate or interpret metacode.
+
+NDC coordinates (0.0 to 1.0) will be represented in GKI as integers in the
+range 0-32767.  Character data will be packed one 7 bit ASCII character per
+metacode word.  Floating point is required only for certain output attributes,
+e.g., the linewidth and character height (size) scale factors.
+To avoid the problems of machine dependent floating point formats we shall
+represent the low precision real numbers by converting them to integer
+metacode words scaled according to the following relation:
+
+	I = int (R * 1E2)
+
+Specifications for the GKI metafile instructions follow.  The datatype and
+size of each field of the instruction is given in parenthesis.
+The datatype "p" denotes a coordinate pair (x,y) of type (m,m),
+where "m" denotes an NDC coordinate.
+
+The OPENWS instruction marks the start of an instruction stream or
+\fBmetafile\fR for a particular device.
+A subsequent CLOSEWS (or physical end of file) marks the end of a metafile.
+An OPENWS in APPEND mode requires that GIO recall the WCS defined when the
+device was last accessed.
+A physical file may consist of any number of independent metafiles.
+Although there is no explicit connection between OPENWS and screen clear
+(CLEARWS), a screen clear is implied for some devices when opened in
+new file mode.
+The MFTITLE instruction is optional and is provided only for documenting
+the contents of a metafile.
+
+
+.ks
+.nf
+			GKI_EOF = BOI  0 L
+		     GKI_OPENWS = BOI  1 L M N D
+		    GKI_CLOSEWS = BOI  2 L N D
+	       GKI_REACTIVATEWS = BOI  3 L
+	       GKI_DEACTIVATEWS = BOI  4 L
+		    GKI_MFTITLE = BOI  5 L N T
+		    GKI_CLEARWS = BOI  6 L
+		     GKI_CANCEL = BOI  7 L
+		      GKI_FLUSH = BOI  8 L
+		   GKI_POLYLINE = BOI  9 L N P
+		 GKI_POLYMARKER = BOI 10 L N P
+		       GKI_TEXT = BOI 11 L P N T
+		   GKI_FILLAREA = BOI 12 L N P
+	       GKI_PUTCELLARRAY = BOI 13 L LL UR NC NL P
+		  GKI_SETCURSOR = BOI 14 L CN POS
+		      GKI_PLSET = BOI 15 L LT LW CI
+		      GKI_PMSET = BOI 16 L MT MW CI
+		      GKI_TXSET = BOI 17 L UP SZ SP P HJ VJ F Q CI
+		      GKI_FASET = BOI 18 L FS CI
+		  GKI_GETCURSOR = BOI 19 L CN
+		GKI_CURSORVALUE = BOI 19 L CN POS KEY
+	       GKI_GETCELLARRAY = BOI 20 L LL UR NC NL
+		  GKI_CELLARRAY = BOI 20 L NP P
+		     GKI_ESCAPE = BOI 25 L FN N DC
+		     GKI_SETWCS = BOI 26 L N WCS
+		     GKI_GETWCS = BOI 27 L N
+.fi
+
+.ce
+The GKI Instruction Set
+.ke
+
+.nh 4
+Control Instructions
+
+    The NULL instruction is unique in that it consists of a single metacode
+word with value zero.  The BOI and length fields are omitted.  Any number
+of null words may be inserted between regular metacode instructions, e.g.,
+to pad a block of metacode to be written to an MII format metafile.
+The EOF instruction is used internally by GIO to stop metacode translation
+on a pseudofile stream, as if end of file had been encountered.
+
+The open workstation instruction should start a new frame unless the access
+mode is APPEND, in which case graphics is to be added to the last frame.
+An OPENWS implies an REACTIVATEWS.  CLOSEWS does little more than deactivate
+the workstation, since the last frame must in some sense remain open for
+APPEND mode to be possible.  Normal termination of the kernel process
+will or an open workstation in a mode other than append will cause the last
+frame to be terminated.
+
+
+.ls
+.tp 4
+GKI_EOF = BOI 0 L
+.ls
+.nf
+L(i)		3
+.fi
+.le
+
+
+.tp 6
+GKI_OPENWS = BOI 1 L M N D
+.ls
+.nf
+L(i)		5 + N
+M(i)		access mode (APPEND=4, NEW_FILE=5, TEE=6)
+N(i)		number of characters in field D
+D(Nc)		device name as in \fBgraphcap\fR file
+.fi
+.le
+
+
+.tp 5
+GKI_CLOSEWS = BOI 2 L N D
+.ls
+.nf
+L(i)		4 + N
+N(i)		number of characters in field D
+D(Nc)		device name as in \fBgraphcap\fR file
+.fi
+.le
+
+
+.tp 5
+GKI_REACTIVATEWS = BOI 3 L
+.ls
+.nf
+L(i)		3
+.fi
+.le
+
+
+.tp 5
+GKI_DEACTIVATEWS = BOI 4 L
+.ls
+.nf
+L(i)		3
+.fi
+.le
+
+
+.tp 5
+.rj (optional)
+GKI_MFTITLE = BOI 5 L N T
+.ls
+.nf
+L(i)		4 + N
+N(i)		number of characters in field T
+T(Nc)		title string identifying metafile
+.fi
+.le
+
+
+.tp 3
+GKI_CLEARWS = BOI 6 L
+.ls
+.nf
+L(i)		set to the constant 3 (no data fields)
+.fi
+.le
+
+
+.tp 3
+GKI_CANCEL = BOI 7 L
+.ls
+.nf
+L(i)		set to the constant 3 (no data fields)
+.fi
+.le
+
+
+.tp 3
+GKI_FLUSH = BOI 8 L
+.ls
+.nf
+L(i)		set to the constant 3 (no data fields)
+.fi
+.le
+.le
+
+.nh 4
+Output Instructions
+
+    All data points in the GKI output instructions have been transformed into
+NDC coordinates and clipped at the viewport boundary (if clipping is enabled).
+In the process GIO will translate any INDEF valued points by breaking large
+polylines into smaller polylines, hence the semantics of plotting polylines and
+polymarkers is quite simple at the graphics kernel level.
+
+CELLARRAY is processed into a series of one dimensional cell array instructions,
+one for each line in the two dimensional array supplied by the user.  Fewer or
+shorter lines will be output if clipping is necessary.  Arrays larger than 32767
+pixels may be output since each line is passed as a separate instruction.
+The maximum number of lines and columns in a cell array is 32767 and 32761,
+respectively (more lines can be input but they will not be resolved).
+The kernel is expected to scale cell arrays to fit the output device via some
+combination of pixel replication or subsampling, if there is not a one to one
+correspondence between cell array pixels and device pixels.
+
+.ls
+.tp 5
+GKI_POLYLINE = BOI 9 L N P
+.ls
+.nf
+L(i)		4 + N * 2
+N(i)		number of points in the polyline
+P(Np)		list of points (x,y pairs)
+.fi
+.le
+
+
+.tp 5
+GKI_POLYMARKER = BOI 10 L N P
+.ls
+.nf
+L(i)		4 + N * 2
+N(i)		number of points in the polymarker
+P(Np)		list of points (x,y pairs)
+.fi
+.le
+
+
+.tp 6
+GKI_TEXT = BOI 11 L P N T
+.ls
+.nf
+L(i)		6 + N
+P(p)		starting point of character string
+N(i)		number of characters in string T
+T(Nc)		string of N ASCII characters
+.fi
+.le
+
+
+.tp 5
+GKI_FILLAREA = BOI 12 L N P
+.ls
+.nf
+L(i)		4 + (N * 2)
+N(i)		number of points defining the polygon to be filled
+P(Np)		list of points (x,y pairs)
+.fi
+.le
+
+
+.tp 8
+GKI_PUTCELLARRAY = BOI 13 L LL UR NC NL P
+.ls
+.nf
+L(i)		9 + (N * M)
+LL(p)		coordinates of lower left corner of output area
+UR(p)		coordinates of upper right corner of output area
+NC(i)		number of columns in array
+NL(i)		number of lines in array
+P(NCNLi)	array of color indices (pixels) stored by row
+.fi
+.le
+
+
+.tp 5
+GKI_SETCURSOR = BOI 14 L CN POS
+.ls
+.nf
+L(i)		6
+CN(i)		cursor number
+POS(p)		new cursor position
+.fi
+.le
+.le
+
+.nh 4
+Set Attribute Instructions
+
+    The set polyline, polymarker, text, and fillarea instructions change
+the attributes used to generate graphics output.  These instructions need be
+issued only when one of the attributes in an instruction packet changes, i.e.,
+the kernel is assumed to remember the attributes while a device is open.
+
+.ls
+.tp 6
+GKI_PLSET = BOI 15 L LT LW CI
+.ls
+.nf
+L(i)		6
+LT(i)		linetype number
+LW(r)		linewidth scale factor
+CI(i)		polyline color index
+.fi
+.le
+
+
+.tp 6
+GKI_PMSET = BOI 16 L MT MW CI
+.ls
+.nf
+L(i)		6
+MT(i)		marktype (not used at present)
+MW(i)		marksize, NDC coords (not used at present)
+CI(i)		marker color index
+.fi
+.le
+
+
+.tp 9
+GKI_TXSET = BOI 17 L UP SZ SP P HJ VJ F Q CI
+.ls
+.nf
+L(i)		12
+UP(i)		character up vector (degrees)
+SZ(r)		character size scale factor
+SP(r)		character spacing
+P(i)		path (0,2=left,3=right,4=up,5=down)
+HJ(i)		horizontal justification
+		    (0=normal,1=center,2=left,3=right)
+VJ(i)		vertical justification
+		    (0=normal,1=center,6=top,7=bottom)
+F(i)		font (8=roman,9=greek,10=italic,11=bold)
+Q(i)		quality (0=normal,12=low,13=medium,14=high)
+CI(i)		text color index
+.fi
+.le
+
+
+.tp 5
+GKI_FASET = BOI 18 L FS CI
+.ls
+.nf
+L(i)		5
+FS(i)		fill style (0=clear,1=hollow,2=solid,3-6=hatch)
+CI(i)		fill area color index
+.fi
+.le
+.le
+
+
+The attributes for the output primitives are assumed to be set to their
+default values when OPENWS is issued.
+
+.nh 4
+Input Instructions
+
+    The primary input instruction is the cursor read instruction, used to read
+the cursor position in NDC coordinates.  The device cursor read may be either
+event driven or instantaneous.  If the cursor read is event driven a nonzero
+keystroke value may be returned, the range of possible keystroke values being
+device dependent.  The instantaneous type of cursor read is preferred at the
+GKI level since it offers the maximum flexibility (\fBclgcur\fR may then be
+used to provide an optional device independent keystroke driven cursor read).
+Devices which support both forms of cursor read may provide both as separate
+logical cursors.  The graphics kernel should return a null cursor value if
+the output device does not have a cursor.
+
+.ls
+.tp 6
+GKI_GETCURSOR = BOI 19 L CN
+.ls
+.nf
+L(i)		4
+CN(i)		cursor number
+.fi
+
+The kernel reads graphics cursor number CN and returns the keystroke value
+(if any) and the cursor position in NDC coordinates.  The cursor attributes
+are returned in the following format:
+
+	GKI_CURSORVALUE = BOI 19 L CN POS KEY
+
+where
+
+.nf
+	L(i)		7
+	CN(i)		cursor number
+	POS(r)		NDC coordinates of cursor
+	KEY(i)		keystroke value (>= 0 or EOF)
+.fi
+.le
+
+
+.tp 8
+GKI_GETCELLARRAY = BOI 20 L LL UR NC NL
+.ls
+.nf
+L(i)		9
+LL(p)		coordinates of lower left corner of input area
+UR(p)		coordinates of upper right corner of input area
+NC(i)		number of columns in output array
+NL(i)		number of lines in output array
+.fi
+
+The GETCELLARRAY instruction is the converse of the PUTCELLARRAY instruction.
+The cell array is returned in the following format:
+
+	GKI_CELLARRAY = BOI 20 L NP P
+
+where
+
+.nf
+	L(i)		4 + NP
+	NP(i)		number of pixels (0 if noread)
+	P(NPi)		array of pixels
+.fi
+.le
+
+
+(instruction codes 19-24 are reserved for future use)
+.le
+
+.nh 4
+Escape Instruction
+
+    The escape instruction is used to pass device dependent information or
+commands to the graphics kernel via GKI.  The graphics kernel will ignore
+unrecognized escape functions.  Function codes 1 through 100 are reserved
+for use by GIO.
+
+.ls
+.tp 5
+GKI_ESCAPE = BOI 25 L FN N DC
+.ls
+.nf
+L(i)		5 + N
+FN(i)		escape function code
+N(i)		number of escape data words
+DC(i)		escape data words
+.fi
+.le
+.le
+
+.nh 4
+Pseudo-GKI Instructions
+
+    Since the CL must be able to read the device cursor and convert NDC
+coordinates to WCS coordinates, the WCS must be passed to the CL when they
+are "fixed" to the device.  The most natural and efficient way to do this
+is via the GKI instruction stream, hence several additional instructions
+are used internally in GIO to communicate with the portion of GIO resident
+in the CL process.  These instructions are filtered out and executed by the
+CL process and their existence may therefore be ignored by the graphics kernels.
+
+The SETWCS instruction is used to pass WCS information to the CL process.
+The GETWCS instruction is used to recall the WCS for a device opened in APPEND
+mode (the WCS are returned in SETWCS format).  Since these instructions
+are passed only between two closely coupled processes on a single cpu,
+floating point numbers are passed in machine dependent format.
+The length of this instruction is machine dependent.
+Only the fields L and WCS are truely part of the instruction; the remaining
+fields are a binary copy of the GIO internal WCS structure.
+
+.ls
+.tp 6
+GKI_SETWCS = BOI 26 L N WCS
+.ls
+.nf
+L(i)		4 + 17 * sizeof (struct wcs)
+N(i)		length of WCS structure, words
+WCS		binary copy of the 17 WCS structures, transmitted
+		    in a single call to WRITE
+.fi
+.le
+
+
+.tp 5
+GKI_GETWCS = BOI 27 L N
+.ls
+.nf
+L(i)		4
+N(i)		maximum number of words to read
+.fi
+.le
+.le
+
+.nh 3
+Encoding GKI Instructions
+
+    The GKI instruction opcodes and fields are defined in the global include
+file lib$gki.h.  To avoid direct knowledge of the binary format of the GKI
+instructions, GIO uses a subpackage called GKI to encode the GKI instructions.
+The GKI procedures each encode and transmit a single GKI instruction on the
+output stream.  Although the GIO and GKI procedures have similar names, they
+should not be confused.  The GIO \fBgpline\fR, for example, performs conversion
+from a WCS to GKI coordinates with clipping at the viewport boundary, checking
+that the polyline attributes are up to date before transmitting the polyline
+instruction.  In contrast the GKI \fBgki_polyline\fR merely encodes and
+transmits the GKI_POLYLINE metacode instruction.
+
+The GKI procedures are self contained with the exception of the set attribute
+instructions, which reference attribute packet structures (argument \fIap\fR)
+defined in the include file gio.h.
+The GKI instruction encoding procedures are shown below.
+
+.ks
+.nf
+	     gki_openws (fd, device, mode)
+	    gki_closews (fd, device)
+       gki_reactivatews (fd, flags)
+       gki_deactivatews (fd, flags)
+	    gki_mftitle (fd, title)
+	    gki_clearws (fd)
+	     gki_cancel (fd)
+	      gki_flush (fd)
+	   gki_polyline (fd, points, npts)
+	 gki_polymarker (fd, points, npts)
+	       gki_text (fd, x, y, text)
+	   gki_fillarea (fd, points, npts)
+       gki_getcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+       gki_putcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+              gki_plset (fd, ap)
+              gki_pmset (fd, ap)
+	      gki_txset (fd, ap)
+              gki_faset (fd, ap)
+	  gki_setcursor (fd, x, y, cursor)
+	  gki_getcursor (fd, x, y, key, cursor)
+	     gki_escape (fd, fn, instruction, nwords)
+	     gki_setwcs (fd, wcsdata, len_wcsdata)
+	     gki_getwcs (fd, wcsdata, len_wcsdata)
+
+	     gki_fflush (fd)	# not GKI instruction; flushes GKI stream
+.fi
+.ke
+
+
+.nh 3
+Decoding GKI Instructions
+
+    The following additional procedures are provided for decoding and executing
+GKI metacode, e.g., in a graphics kernel.  In what follows, \fIinstruction\fR
+is a short integer array containing the encoded GKI instruction, and \fIdd\fR
+is the device driver table, i.e., array of \fBzlocpr\fR entry point addresses
+of the standard kernel procedures.
+
+
+.ks
+.nf
+	 stat = gki_fetch_next_instruction (fd, instruction_ptr)
+		gki_execute (instruction, dd)
+		gkp_install (dd, out_fd, verbose_output)
+.fi
+.ke
+
+
+The \fBfetch\fR procedure extracts the next instruction from the input metacode
+stream, returning a short integer pointer to the instruction as an output
+argument.  EOF is returned as the function value when end of file is detected.
+The \fBexecute\fR procedure decodes an instruction and calls a graphics device
+driver procedure to execute the instruction.  If the entry point address
+of the driver procedure is NULL \fBgki_execute\fR will ignore the corresponding
+GKI instruction.  The fields of the metacode instruction are passed to the
+driver procedure as distinct arguments, hence the device driver need not
+understand the GKI format.
+
+A standard kernel is provided for decoding GKI instructions, printing the
+decoded instructions in text form on the output stream.  The driver for this
+kernel is installed with \fBgkp_install\fR, setting the output file and
+verbose output flag in the process.
+
+.nh 3
+Example
+
+    To illustrate the use of GKI as well as the output of the GKI decoding
+kernel, consider the simple \fBgplotv\fR style plot of the following function:
+
+	y = x ** 2
+
+over the range
+
+	x = 1 to 5, y = 1 to 25
+
+The decoded GKI metacode produced by GIO to graph this function is
+shown below.  The "verbose" mode of output (shown) lists the values
+of the data points in the polyline, etc. output functions.  If verbose
+output is disabled only the statistics of the output polylines
+(computed by the decoder) will be printed.  All coordinates are printed
+in NDC units.  The redundant points appearing in the output metacode
+are expected to be filtered out by the kernel, which should not plot
+points separated by less than the device resolution in NDC units.
+
+
+.tp 4
+.nf
+open_workstation 'vt640', mode=new_file
+set_wcs nwords=352
+	 1 1. 5. 1. 25.  0.19 0.81 0.33 0.96  0 0 1
+set_polyline ltype=1, lwidth=2.00, color=1
+polyline np=3, xmin=0.19,xmax=0.19,xavg=0.19, ymin=0.33,ymax=0.37,yavg=0.34
+	0.188 0.334  0.188 0.334  0.188 0.367  
+set_text up=90, path=right, hjustify=center, vjustify=top, font=roman,
+	size=1.00, spacing=0.00, color=1, quality=normal
+text 0.19, 0.31, '1'
+polyline np=15, xmin=0.19,xmax=0.34,xavg=0.27, ymin=0.33,ymax=0.37,yavg=0.34
+	0.188 0.334  0.219 0.334  0.219 0.350  0.219 0.334  0.250 0.334  
+	0.250 0.350  0.250 0.334  0.281 0.334  0.281 0.350  0.281 0.334  
+	0.313 0.334  0.313 0.350  0.313 0.334  0.344 0.334  0.344 0.367  
+text 0.34, 0.31, '2'
+polyline np=15, xmin=0.34,xmax=0.50,xavg=0.43, ymin=0.33,ymax=0.37,yavg=0.34
+	0.344 0.334  0.375 0.334  0.375 0.350  0.375 0.334  0.406 0.334  
+	0.406 0.350  0.406 0.334  0.437 0.334  0.437 0.350  0.437 0.334  
+	0.469 0.334  0.469 0.350  0.469 0.334  0.500 0.334  0.500 0.367  
+text 0.50, 0.31, '3'
+polyline np=15, xmin=0.50,xmax=0.66,xavg=0.58, ymin=0.33,ymax=0.37,yavg=0.34
+	0.500 0.334  0.531 0.334  0.531 0.350  0.531 0.334  0.562 0.334  
+	0.562 0.350  0.562 0.334  0.593 0.334  0.593 0.350  0.593 0.334  
+	0.625 0.334  0.625 0.350  0.625 0.334  0.656 0.334  0.656 0.367  
+text 0.66, 0.31, '4'
+polyline np=15, xmin=0.66,xmax=0.81,xavg=0.74, ymin=0.33,ymax=0.37,yavg=0.34
+	0.656 0.334  0.687 0.334  0.687 0.350  0.687 0.334  0.718 0.334  
+	0.718 0.350  0.718 0.334  0.750 0.334  0.750 0.350  0.750 0.334  
+	0.781 0.334  0.781 0.350  0.781 0.334  0.812 0.334  0.812 0.367  
+text 0.81, 0.31, '5'
+polyline np=2, xmin=0.81,xmax=0.81,xavg=0.81, ymin=0.33,ymax=0.33,yavg=0.33
+	0.812 0.334  0.812 0.334  
+polyline np=77, xmin=0.78,xmax=0.81,xavg=0.81, ymin=0.33,ymax=0.96,yavg=0.65
+	0.812 0.334  0.812 0.334  0.796 0.334  0.812 0.334  0.812 0.360  
+	0.796 0.360  0.812 0.360  0.812 0.386  0.796 0.386  0.812 0.386  
+	0.812 0.412  0.796 0.412  0.812 0.412  0.812 0.438  0.779 0.438  
+	0.812 0.438  0.812 0.464  0.795 0.464  0.812 0.464  0.812 0.490  
+	0.795 0.490  0.812 0.490  0.812 0.516  0.795 0.516  0.812 0.516  
+	0.812 0.542  0.795 0.542  0.812 0.542  0.812 0.568  0.779 0.568  
+	0.812 0.568  0.812 0.594  0.795 0.594  0.812 0.594  0.812 0.620  
+	0.795 0.620  0.812 0.620  0.812 0.646  0.795 0.646  0.812 0.646  
+	0.812 0.672  0.795 0.672  0.812 0.672  0.812 0.698  0.779 0.698  
+	0.812 0.698  0.812 0.724  0.795 0.724  0.812 0.724  0.812 0.750  
+	0.795 0.750  0.812 0.750  0.812 0.776  0.795 0.776  0.812 0.776  
+	0.812 0.802  0.795 0.802  0.812 0.802  0.812 0.828  0.778 0.828  
+	0.812 0.828  0.812 0.854  0.795 0.854  0.812 0.854  0.812 0.880  
+	0.795 0.880  0.812 0.880  0.812 0.906  0.795 0.906  0.812 0.906  
+	0.812 0.932  0.795 0.932  0.812 0.932  0.812 0.958  0.778 0.958  
+	0.812 0.958  0.812 0.958  
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.33,ymax=0.44,yavg=0.38
+	0.188 0.334  0.188 0.334  0.204 0.334  0.188 0.334  0.188 0.360  
+	0.204 0.360  0.188 0.360  0.188 0.386  0.204 0.386  0.188 0.386  
+	0.188 0.412  0.204 0.412  0.188 0.412  0.188 0.438  0.221 0.438  
+set_text up=90, path=right, hjustify=right, vjustify=center, font=roman,
+	size=1.00, spacing=0.00, color=1, quality=normal
+text 0.19, 0.44, '5'
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.44,ymax=0.57,yavg=0.51
+	0.188 0.438  0.188 0.464  0.204 0.464  0.188 0.464  0.188 0.490  
+	0.204 0.490  0.188 0.490  0.188 0.516  0.204 0.516  0.188 0.516  
+	0.188 0.542  0.204 0.542  0.188 0.542  0.188 0.568  0.221 0.568  
+text 0.19, 0.57, '10'
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.57,ymax=0.70,yavg=0.64
+	0.188 0.568  0.188 0.594  0.204 0.594  0.188 0.594  0.188 0.620  
+	0.204 0.620  0.188 0.620  0.188 0.646  0.204 0.646  0.188 0.646  
+	0.188 0.672  0.204 0.672  0.188 0.672  0.188 0.698  0.221 0.698  
+text 0.19, 0.70, '15'
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.70,ymax=0.83,yavg=0.77
+	0.188 0.698  0.188 0.724  0.204 0.724  0.188 0.724  0.188 0.750  
+	0.204 0.750  0.188 0.750  0.188 0.776  0.204 0.776  0.188 0.776  
+	0.188 0.802  0.204 0.802  0.188 0.802  0.188 0.828  0.221 0.828  
+text 0.19, 0.83, '20'
+polyline np=15, xmin=0.19,xmax=0.22,xavg=0.19, ymin=0.83,ymax=0.96,yavg=0.90
+	0.188 0.828  0.188 0.854  0.204 0.854  0.188 0.854  0.188 0.880  
+	0.204 0.880  0.188 0.880  0.188 0.906  0.204 0.906  0.188 0.906  
+	0.188 0.932  0.204 0.932  0.188 0.932  0.188 0.958  0.221 0.958  
+text 0.19, 0.96, '25'
+polyline np=2, xmin=0.19,xmax=0.19,xavg=0.19, ymin=0.96,ymax=0.96,yavg=0.96
+	0.188 0.958  0.188 0.958  
+polyline np=65, xmin=0.19,xmax=0.81,xavg=0.50, ymin=0.92,ymax=0.96,yavg=0.95
+	0.188 0.958  0.188 0.958  0.188 0.925  0.188 0.958  0.219 0.958  
+	0.219 0.942  0.219 0.958  0.250 0.958  0.250 0.942  0.250 0.958  
+	0.281 0.958  0.281 0.941  0.281 0.958  0.313 0.958  0.313 0.941  
+	0.313 0.958  0.344 0.958  0.344 0.925  0.344 0.958  0.375 0.958  
+	0.375 0.941  0.375 0.958  0.406 0.958  0.406 0.941  0.406 0.958  
+	0.437 0.958  0.437 0.941  0.437 0.958  0.469 0.958  0.469 0.941  
+	0.469 0.958  0.500 0.958  0.500 0.925  0.500 0.958  0.531 0.958  
+	0.531 0.941  0.531 0.958  0.562 0.958  0.562 0.941  0.562 0.958  
+	0.593 0.958  0.593 0.941  0.593 0.958  0.625 0.958  0.625 0.941  
+	0.625 0.958  0.656 0.958  0.656 0.924  0.656 0.958  0.687 0.958  
+	0.687 0.941  0.687 0.958  0.718 0.958  0.718 0.941  0.718 0.958  
+	0.750 0.958  0.750 0.941  0.750 0.958  0.781 0.958  0.781 0.941  
+	0.781 0.958  0.812 0.958  0.812 0.924  0.812 0.958  0.812 0.958  
+set_text up=90, path=right, hjustify=center, vjustify=bottom, font=roman,
+	size=1.00, spacing=0.00, color=1, quality=normal
+text 0.50, 0.96, 'title'
+set_polyline ltype=1, lwidth=1.00, color=1
+polyline np=5, xmin=0.19,xmax=0.69,xavg=0.44, ymin=0.33,ymax=0.96,yavg=0.59
+	0.188 0.334  0.313 0.412  0.438 0.542  0.562 0.724  0.687 0.958  
+flush
+close_workstation 'vt640'
+.fi
+
+
+.nh 2
+Graphics Kernel Parameters
+
+    The translation from GKI codes to device codes should ideally be
+parameterized to permit variable device resolution, font substitution,
+and so on at translation time.  In general this is best handled by
+spooling the metacode and later processing it via an explicit call to
+a metacode translator program, using CL parameters to control the translation.
+Some control over translation may also be achieved by modifying the
+\fBgraphcap\fR entry for a device, provided the graphics kernel uses
+the graphics capability database.
+
+One of the most useful translation time parameters is the device resolution.
+On some devices, e.g. pen plotters, it is necessary to be able to change
+the device resolution at translation time to permit plotting of large vectors
+without loss of resolution.  Changing the device resolution is also a valuable
+technique for speeding up graphics when working remotely via a modem.
+
+.nh
+GKS Emulation
+
+    The basic graphics primitives provided by GIO (polyline, polymarker, etc.)
+are functionally identical to those provided by GKS (the Graphics Kernel
+System).  The basic drawing primitives of GKS are therefore easily emulated
+using GIO.  A subset of the Fortran binding of GKS has already been emulated,
+sufficient to run the NCAR utilities recently converted by NCAR for use with
+GKS.  In principle it should be possible to expand the GKS emulation to a
+full level 0b or 1b interface, although we have no plans to do so at present.
diff --git a/sys/gio/elogd.x b/sys/gio/elogd.x
new file mode 100644
index 00000000..b910a80c
--- /dev/null
+++ b/sys/gio/elogd.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ELOGD -- Extended range log function.  Logarithmic scaling function for
+# negative or partially negative data.  The function is piecewise, continuous,
+# monotonic, reasonably smooth, and most importantly, is defined for all x.
+#
+#			     10.0 < X		y = log(x)
+#	       -10.0 <= X <= 10.0		y = x / 10.0
+#	   X < -10.0				y = -log(-x)
+#
+# Axes scaled with this function should have ticks labelled, e.g., 10**3,
+# 10**2, 10**1, 0, -10**1, -10**2, -10**3.  The corresponding ticks for
+# the normal log function would have values like 10**-2 rather than -10**2,
+# hence it is not difficult to distinguish between the two functions.
+
+double procedure elogd (x)
+
+double	x
+
+begin
+	if (x > 10.0D0)
+	    return (log10 (x))
+	else if (x >= -10.0D0)
+	    return (x / 10.0D0)
+	else
+	    return (-log10 (-x))
+end
diff --git a/sys/gio/elogr.x b/sys/gio/elogr.x
new file mode 100644
index 00000000..3dfb26ee
--- /dev/null
+++ b/sys/gio/elogr.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ELOGR -- Extended range log function.  Logarithmic scaling function for
+# negative or partially negative data.  The function is piecewise, continuous,
+# monotonic, reasonably smooth, and most importantly, is defined for all x.
+#
+#			     10.0 < X		y = log(x)
+#	       -10.0 <= X <= 10.0		y = x / 10.0
+#	   X < -10.0				y = -log(-x)
+#
+# Axes scaled with this function should have ticks labelled, e.g., 10**3,
+# 10**2, 10**1, 0, -10**1, -10**2, -10**3.  The corresponding ticks for
+# the normal log function would have values like 10**-2 rather than -10**2,
+# hence it is not difficult to distinguish between the two functions.
+
+real procedure elogr (x)
+
+real	x
+
+begin
+	if (x > 10.0)
+	    return (log10 (x))
+	else if (x >= -10.0)
+	    return (x / 10.0)
+	else
+	    return (-log10 (-x))
+end
diff --git a/sys/gio/fonts/README b/sys/gio/fonts/README
new file mode 100644
index 00000000..8b657b76
--- /dev/null
+++ b/sys/gio/fonts/README
@@ -0,0 +1,42 @@
+
+FONT Generation Utilities  (August 1997)
+----------------------------------------
+
+This directory contains utilities for building font tables for the GIO
+system executables.  For reference we include here the font tables for
+the standard and greek fonts currently installed in the system:
+
+	font.com		standard text font (Roman)
+	greek.com		greek character font
+	
+These table were built from the Hershey stroke data using the following 
+files:
+
+	mkfont.c		task to build font table
+	hershey.dat		Hershey stroke data table
+
+Once compiled the MKFONT task can be used to build the table with a command
+such as
+
+		% mkfont < romant.txt > font.com
+
+Note that by default the tables are created with a "chr" prefix for the
+index, width, and character tables in the .com file.  When building a new
+Greek or other symbolic font these should be changed appropriately.
+	
+
+Addition input files for fonts supplied here include:
+
+	futural.txt	Futura (light)
+	futuram.txt	Futura (medium)
+	gotheng.txt	Gothic (english)
+	gothger.txt	Gothic (german)
+	gothita.txt	Gothic (italian)
+	greekc.txt	Greek (complex)			(current greek.com)
+	greeks.txt	Greek (simple)
+	math.txt	Math symbols
+	meteor.txt	Meteorological symbols
+	romans.txt	Roman (simple)
+	romant.txt	Roman (Times)			(current font.com)
+	scripts.txt	Script text font
+	timesr.txt	Times-Roman
diff --git a/sys/gio/fonts/font.com b/sys/gio/fonts/font.com
new file mode 100644
index 00000000..c26af8d6
--- /dev/null
+++ b/sys/gio/fonts/font.com
@@ -0,0 +1,746 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each
+# character is encoded as a series of strokes.  Each stroke is ex-
+# pressed by a single integer containing the following bitfields:
+#
+#       2                   1
+#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
+#                 | | | |         | |         |
+#                 | | | +---------+ +---------+
+#                 | | |      |           |
+#                 | | |      X           Y
+#                 | | |
+#                 | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#----------------------------------------------------------------------------
+
+# Define the database.
+
+short   chridx[97]	# character index in chrtab
+short   chrwid[97]	# character width table
+short   chrtab[3363]	# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP)
+
+data    (chridx(i), i=001,005) /    1,    3,   32,   49,   58/
+data    (chridx(i), i=006,010) /  110,  140,  207,  228,  253/
+data    (chridx(i), i=011,015) /  278,  309,  322,  343,  350/
+data    (chridx(i), i=016,020) /  365,  372,  418,  438,  494/
+data    (chridx(i), i=021,025) /  563,  583,  632,  696,  733/
+data    (chridx(i), i=026,030) /  803,  867,  896,  931,  935/
+data    (chridx(i), i=031,035) /  948,  952,  999, 1052, 1077/
+data    (chridx(i), i=036,040) / 1139, 1174, 1223, 1281, 1330/
+data    (chridx(i), i=041,045) / 1381, 1436, 1463, 1500, 1547/
+data    (chridx(i), i=046,050) / 1583, 1626, 1653, 1703, 1748/
+data    (chridx(i), i=051,055) / 1818, 1881, 1923, 1962, 1997/
+data    (chridx(i), i=056,060) / 2021, 2060, 2097, 2131, 2160/
+data    (chridx(i), i=061,065) / 2169, 2172, 2181, 2190, 2193/
+data    (chridx(i), i=066,070) / 2214, 2263, 2303, 2335, 2378/
+data    (chridx(i), i=071,075) / 2415, 2447, 2527, 2575, 2606/
+data    (chridx(i), i=076,080) / 2640, 2682, 2704, 2778, 2826/
+data    (chridx(i), i=081,085) / 2868, 2916, 2961, 2994, 3033/
+data    (chridx(i), i=086,090) / 3052, 3086, 3108, 3140, 3173/
+data    (chridx(i), i=091,095) / 3204, 3233, 3271, 3274, 3312/
+data    (chridx(i), i=096,096) / 3335/
+
+
+# Width data.
+
+data    (chrwid(i), i=001,005) /   21,   16,   23,   26,   25/
+data    (chrwid(i), i=006,010) /   29,   31,   16,   19,   19/
+data    (chrwid(i), i=011,015) /   21,   30,   16,   30,   16/
+data    (chrwid(i), i=016,020) /   28,   25,   25,   25,   25/
+data    (chrwid(i), i=021,025) /   25,   25,   25,   25,   25/
+data    (chrwid(i), i=026,030) /   25,   16,   16,   29,   30/
+data    (chrwid(i), i=031,035) /   29,   24,   32,   25,   27/
+data    (chrwid(i), i=036,040) /   26,   27,   26,   25,   28/
+data    (chrwid(i), i=041,045) /   29,   17,   21,   27,   23/
+data    (chrwid(i), i=046,050) /   31,   29,   27,   27,   27/
+data    (chrwid(i), i=051,055) /   27,   25,   25,   29,   25/
+data    (chrwid(i), i=056,060) /   29,   25,   27,   25,   19/
+data    (chrwid(i), i=061,065) /   19,   19,   21,   21,   16/
+data    (chrwid(i), i=066,070) /   25,   26,   24,   26,   24/
+data    (chrwid(i), i=071,075) /   19,   24,   28,   17,   18/
+data    (chrwid(i), i=076,080) /   27,   17,   32,   28,   25/
+data    (chrwid(i), i=081,085) /   26,   25,   22,   22,   20/
+data    (chrwid(i), i=086,090) /   28,   23,   29,   25,   24/
+data    (chrwid(i), i=091,095) /   23,   19,   13,   19,   29/
+data    (chrwid(i), i=096,096) /   19/
+
+
+# Stroke data.
+
+data    (chrtab(i), i=0001,0005) /    35,     0,   220,  4251,  4249/
+data    (chrtab(i), i=0006,0010) /  4305,   220,  4302,  4366,   220/
+data    (chrtab(i), i=0011,0015) /  4380,  4366,   284,  4443,  4441/
+data    (chrtab(i), i=0016,0020) /  4369,   202,  4233,  4232,  4295/
+data    (chrtab(i), i=0021,0025) /  4359,  4424,  4425,  4362,  4298/
+data    (chrtab(i), i=0026,0030) /   201,  4296,  4360,  4361,  4297/
+data    (chrtab(i), i=0031,0035) /     0,   220,  4251,  4245,   219/
+data    (chrtab(i), i=0036,0040) /  4245,   220,  4379,  4245,   796/
+data    (chrtab(i), i=0041,0045) /  4827,  4821,   795,  4821,   796/
+data    (chrtab(i), i=0046,0050) /  4955,  4821,     0,   604,  4224/
+data    (chrtab(i), i=0051,0055) /   988,  4608,   145,  5137,    75/
+data    (chrtab(i), i=0056,0060) /  5067,     0,   416,  4483,   672/
+data    (chrtab(i), i=0061,0065) /  4739,   919,  5016,  4952,  4950/
+data    (chrtab(i), i=0066,0070) /  5078,  5080,  5018,  4955,  4764/
+data    (chrtab(i), i=0071,0075) /  4508,  4315,  4185,  4182,  4244/
+data    (chrtab(i), i=0076,0080) /  4434,  4816,  4943,  5005,  5002/
+data    (chrtab(i), i=0081,0085) /  4936,   150,  4308,  4435,  4817/
+data    (chrtab(i), i=0086,0090) /  4944,  5006,   219,  4249,  4247/
+data    (chrtab(i), i=0091,0095) /  4309,  4436,  4818,  5008,  5070/
+data    (chrtab(i), i=0096,0100) /  5067,  5001,  4936,  4743,  4487/
+data    (chrtab(i), i=0101,0105) /  4296,  4233,  4171,  4173,  4301/
+data    (chrtab(i), i=0106,0110) /  4299,  4235,  4236,     0,  1244/
+data    (chrtab(i), i=0111,0115) /  4167,   412,  4634,  4632,  4566/
+data    (chrtab(i), i=0116,0120) /  4437,  4309,  4183,  4185,  4251/
+data    (chrtab(i), i=0121,0125) /  4380,  4508,  4635,  4826,  5018/
+data    (chrtab(i), i=0126,0130) /  5211,  5340,   974,  4941,  4875/
+data    (chrtab(i), i=0131,0135) /  4873,  4999,  5127,  5256,  5322/
+data    (chrtab(i), i=0136,0140) /  5324,  5198,  5070,     0,  1299/
+data    (chrtab(i), i=0141,0145) /  5396,  5332,  5330,  5458,  5460/
+data    (chrtab(i), i=0146,0150) /  5397,  5333,  5268,  5202,  5069/
+data    (chrtab(i), i=0151,0155) /  4938,  4808,  4679,  4423,  4296/
+data    (chrtab(i), i=0156,0160) /  4234,  4237,  4303,  4691,  4821/
+data    (chrtab(i), i=0161,0165) /  4887,  4889,  4827,  4700,  4571/
+data    (chrtab(i), i=0166,0170) /  4505,  4502,  4563,  4688,  4939/
+data    (chrtab(i), i=0171,0175) /  5128,  5255,  5383,  5449,  5450/
+data    (chrtab(i), i=0176,0180) /   264,  4298,  4301,  4367,  4432/
+data    (chrtab(i), i=0181,0185) /   725,  4889,   791,  4827,   475/
+data    (chrtab(i), i=0186,0190) /  4503,   468,  4689,  4940,  5129/
+data    (chrtab(i), i=0191,0195) /  5256,   455,  4424,  4362,  4365/
+data    (chrtab(i), i=0196,0200) /  4431,  4691,   409,  4565,  4753/
+data    (chrtab(i), i=0201,0205) /  5004,  5193,  5320,  5384,  5449/
+data    (chrtab(i), i=0206,0210) /     0,   346,  4377,  4313,  4250/
+data    (chrtab(i), i=0211,0215) /  4251,  4316,  4380,  4443,  4440/
+data    (chrtab(i), i=0216,0220) /  4374,  4245,   219,  4314,  4378/
+data    (chrtab(i), i=0221,0225) /  4379,  4315,   281,  4440,   346/
+data    (chrtab(i), i=0226,0230) /  4374,     0,   544,  4510,  4379/
+data    (chrtab(i), i=0231,0235) /  4247,  4178,  4174,  4233,  4357/
+data    (chrtab(i), i=0236,0240) /  4482,  4608,   282,  4311,  4243/
+data    (chrtab(i), i=0241,0245) /  4237,  4297,  4358,   414,  4444/
+data    (chrtab(i), i=0246,0250) /  4377,  4307,  4301,  4359,  4420/
+data    (chrtab(i), i=0251,0255) /  4482,     0,   160,  4382,  4507/
+data    (chrtab(i), i=0256,0260) /  4631,  4690,  4686,  4617,  4485/
+data    (chrtab(i), i=0261,0265) /  4354,  4224,   410,  4567,  4627/
+data    (chrtab(i), i=0266,0270) /  4621,  4553,  4486,   286,  4444/
+data    (chrtab(i), i=0271,0275) /  4505,  4563,  4557,  4487,  4420/
+data    (chrtab(i), i=0276,0280) /  4354,     0,   412,  4443,  4561/
+data    (chrtab(i), i=0281,0285) /  4496,   412,  4496,   412,  4571/
+data    (chrtab(i), i=0286,0290) /  4433,  4496,    89,  4249,  4755/
+data    (chrtab(i), i=0291,0295) /  4819,    89,  4819,    89,  4184/
+data    (chrtab(i), i=0296,0300) /  4820,  4819,   729,  4761,  4243/
+data    (chrtab(i), i=0301,0305) /  4179,   729,  4179,   729,  4824/
+data    (chrtab(i), i=0306,0310) /  4180,  4179,     0,   665,  4744/
+data    (chrtab(i), i=0311,0315) /  4808,   665,  4825,  4808,   145/
+data    (chrtab(i), i=0316,0320) /  5329,  5328,   145,  4240,  5328/
+data    (chrtab(i), i=0321,0325) /     0,   328,  4359,  4295,  4232/
+data    (chrtab(i), i=0326,0330) /  4233,  4298,  4362,  4425,  4422/
+data    (chrtab(i), i=0331,0335) /  4356,  4227,   201,  4296,  4360/
+data    (chrtab(i), i=0336,0340) /  4361,  4297,   263,  4422,   328/
+data    (chrtab(i), i=0341,0345) /  4356,     0,   145,  5329,  5328/
+data    (chrtab(i), i=0346,0350) /   145,  4240,  5328,     0,   202/
+data    (chrtab(i), i=0351,0355) /  4233,  4232,  4295,  4359,  4424/
+data    (chrtab(i), i=0356,0360) /  4425,  4362,  4298,   201,  4296/
+data    (chrtab(i), i=0361,0365) /  4360,  4361,  4297,     0,  1184/
+data    (chrtab(i), i=0366,0370) /  4096,  4160,  1184,  5344,  4160/
+data    (chrtab(i), i=0371,0375) /     0,   476,  4379,  4248,  4179/
+data    (chrtab(i), i=0376,0380) /  4176,  4235,  4360,  4551,  4679/
+data    (chrtab(i), i=0381,0385) /  4872,  5003,  5072,  5075,  5016/
+data    (chrtab(i), i=0386,0390) /  4891,  4700,  4572,   282,  4312/
+data    (chrtab(i), i=0391,0395) /  4244,  4239,  4299,  4361,   777/
+data    (chrtab(i), i=0396,0400) /  4939,  5007,  5012,  4952,  4890/
+data    (chrtab(i), i=0401,0405) /   476,  4443,  4377,  4308,  4303/
+data    (chrtab(i), i=0406,0410) /  4362,  4424,  4551,   583,  4808/
+data    (chrtab(i), i=0411,0415) /  4874,  4943,  4948,  4889,  4827/
+data    (chrtab(i), i=0416,0420) /  4700,     0,   474,  4551,   538/
+data    (chrtab(i), i=0421,0425) /  4616,   604,  4679,   604,  4505/
+data    (chrtab(i), i=0426,0430) /  4376,   199,  4935,   456,  4423/
+data    (chrtab(i), i=0431,0435) /   457,  4487,   585,  4743,   584/
+data    (chrtab(i), i=0436,0440) /  4807,     0,   152,  4247,  4311/
+data    (chrtab(i), i=0441,0445) /  4312,  4248,   153,  4313,  4376/
+data    (chrtab(i), i=0446,0450) /  4375,  4310,  4246,  4183,  4184/
+data    (chrtab(i), i=0451,0455) /  4250,  4315,  4508,  4764,  4955/
+data    (chrtab(i), i=0456,0460) /  5018,  5080,  5078,  5012,  4818/
+data    (chrtab(i), i=0461,0465) /  4496,  4367,  4237,  4170,  4167/
+data    (chrtab(i), i=0466,0470) /   858,  5016,  5014,  4948,   668/
+data    (chrtab(i), i=0471,0475) /  4891,  4952,  4950,  4884,  4754/
+data    (chrtab(i), i=0476,0480) /  4496,    73,  4234,  4362,  4681/
+data    (chrtab(i), i=0481,0485) /  4937,  5066,   266,  4680,  4936/
+data    (chrtab(i), i=0486,0490) /  5001,   266,  4679,  4935,  5000/
+data    (chrtab(i), i=0491,0495) /  5066,  5068,     0,   152,  4247/
+data    (chrtab(i), i=0496,0500) /  4311,  4312,  4248,   153,  4313/
+data    (chrtab(i), i=0501,0505) /  4376,  4375,  4310,  4246,  4183/
+data    (chrtab(i), i=0506,0510) /  4184,  4250,  4315,  4508,  4764/
+data    (chrtab(i), i=0511,0515) /  4955,  5017,  5014,  4948,  4755/
+data    (chrtab(i), i=0516,0520) /   795,  4953,  4950,  4884,   604/
+data    (chrtab(i), i=0521,0525) /  4827,  4889,  4886,  4820,  4691/
+data    (chrtab(i), i=0526,0530) /   467,  4755,  4882,  5008,  5070/
+data    (chrtab(i), i=0531,0535) /  5067,  5001,  4936,  4743,  4487/
+data    (chrtab(i), i=0536,0540) /  4296,  4233,  4171,  4172,  4237/
+data    (chrtab(i), i=0541,0545) /  4301,  4364,  4363,  4298,  4234/
+data    (chrtab(i), i=0546,0550) /   848,  5006,  5003,  4937,   595/
+data    (chrtab(i), i=0551,0555) /  4818,  4881,  4942,  4939,  4872/
+data    (chrtab(i), i=0556,0560) /  4743,   140,  4235,  4299,  4300/
+data    (chrtab(i), i=0561,0565) /  4236,     0,   601,  4679,   666/
+data    (chrtab(i), i=0566,0570) /  4744,   732,  4807,   732,  4109/
+data    (chrtab(i), i=0571,0575) /  5133,   391,  4999,   584,  4551/
+data    (chrtab(i), i=0576,0580) /   585,  4615,   713,  4871,   712/
+data    (chrtab(i), i=0581,0585) /  4935,     0,   220,  4178,  4308/
+data    (chrtab(i), i=0586,0590) /  4501,  4693,  4884,  5010,  5071/
+data    (chrtab(i), i=0591,0595) /  5069,  5002,  4872,  4679,  4487/
+data    (chrtab(i), i=0596,0600) /  4296,  4233,  4171,  4172,  4237/
+data    (chrtab(i), i=0601,0605) /  4301,  4364,  4363,  4298,  4234/
+data    (chrtab(i), i=0606,0610) /   850,  5008,  5004,  4938,   597/
+data    (chrtab(i), i=0611,0615) /  4820,  4883,  4944,  4940,  4873/
+data    (chrtab(i), i=0616,0620) /  4808,  4679,   140,  4235,  4299/
+data    (chrtab(i), i=0621,0625) /  4300,  4236,   220,  4956,   219/
+data    (chrtab(i), i=0626,0630) /  4827,   218,  4570,  4827,  4956/
+data    (chrtab(i), i=0631,0635) /     0,   793,  4888,  4952,  4953/
+data    (chrtab(i), i=0636,0640) /  4889,   858,  4890,  4825,  4824/
+data    (chrtab(i), i=0641,0645) /  4887,  4951,  5016,  5017,  4955/
+data    (chrtab(i), i=0646,0650) /  4828,  4636,  4443,  4313,  4247/
+data    (chrtab(i), i=0651,0655) /  4179,  4173,  4234,  4360,  4551/
+data    (chrtab(i), i=0656,0660) /  4679,  4872,  5002,  5069,  5070/
+data    (chrtab(i), i=0661,0665) /  5009,  4883,  4692,  4564,  4435/
+data    (chrtab(i), i=0666,0670) /  4370,  4304,   281,  4311,  4243/
+data    (chrtab(i), i=0671,0675) /  4237,  4298,  4361,   842,  5004/
+data    (chrtab(i), i=0676,0680) /  5007,  4945,   540,  4507,  4442/
+data    (chrtab(i), i=0681,0685) /  4376,  4308,  4301,  4362,  4424/
+data    (chrtab(i), i=0686,0690) /  4551,   583,  4808,  4873,  4940/
+data    (chrtab(i), i=0691,0695) /  4943,  4882,  4819,  4692,     0/
+data    (chrtab(i), i=0696,0700) /    92,  4182,   988,  5081,  5014/
+data    (chrtab(i), i=0701,0705) /  4753,  4687,  4619,  4615,   592/
+data    (chrtab(i), i=0706,0710) /  4622,  4555,  4551,   918,  4689/
+data    (chrtab(i), i=0711,0715) /  4558,  4491,  4487,  4615,    88/
+data    (chrtab(i), i=0716,0720) /  4250,  4380,  4508,  4825,  4953/
+data    (chrtab(i), i=0721,0725) /  5018,  5084,   218,  4379,  4507/
+data    (chrtab(i), i=0726,0730) /  4634,    88,  4249,  4378,  4506/
+data    (chrtab(i), i=0731,0735) /  4825,     0,   412,  4315,  4249/
+data    (chrtab(i), i=0736,0740) /  4246,  4308,  4499,  4755,  4948/
+data    (chrtab(i), i=0741,0745) /  5014,  5017,  4955,  4764,  4508/
+data    (chrtab(i), i=0746,0750) /   283,  4313,  4310,  4372,   788/
+data    (chrtab(i), i=0751,0755) /  4950,  4953,  4891,   412,  4443/
+data    (chrtab(i), i=0756,0760) /  4377,  4374,  4436,  4499,   659/
+data    (chrtab(i), i=0761,0765) /  4820,  4886,  4889,  4827,  4764/
+data    (chrtab(i), i=0766,0770) /   403,  4306,  4241,  4175,  4171/
+data    (chrtab(i), i=0771,0775) /  4233,  4296,  4487,  4743,  4936/
+data    (chrtab(i), i=0776,0780) /  5001,  5067,  5071,  5009,  4946/
+data    (chrtab(i), i=0781,0785) /  4755,   209,  4239,  4235,  4297/
+data    (chrtab(i), i=0786,0790) /   841,  5003,  5007,  4945,   403/
+data    (chrtab(i), i=0791,0795) /  4370,  4303,  4299,  4360,  4487/
+data    (chrtab(i), i=0796,0800) /   647,  4872,  4939,  4943,  4882/
+data    (chrtab(i), i=0801,0805) /  4755,     0,   203,  4298,  4362/
+data    (chrtab(i), i=0806,0810) /  4363,  4299,   851,  4881,  4816/
+data    (chrtab(i), i=0811,0815) /  4687,  4559,  4368,  4242,  4181/
+data    (chrtab(i), i=0816,0820) /  4182,  4249,  4379,  4572,  4700/
+data    (chrtab(i), i=0821,0825) /  4891,  5017,  5078,  5072,  5004/
+data    (chrtab(i), i=0826,0830) /  4938,  4808,  4615,  4423,  4296/
+data    (chrtab(i), i=0831,0835) /  4234,  4235,  4300,  4364,  4427/
+data    (chrtab(i), i=0836,0840) /  4426,  4361,  4297,   210,  4244/
+data    (chrtab(i), i=0841,0845) /  4247,  4313,   794,  4953,  5014/
+data    (chrtab(i), i=0846,0850) /  5008,  4940,  4874,   463,  4432/
+data    (chrtab(i), i=0851,0855) /  4369,  4308,  4311,  4378,  4443/
+data    (chrtab(i), i=0856,0860) /  4572,   604,  4827,  4889,  4950/
+data    (chrtab(i), i=0861,0865) /  4943,  4875,  4809,  4744,  4615/
+data    (chrtab(i), i=0866,0870) /     0,   213,  4244,  4243,  4306/
+data    (chrtab(i), i=0871,0875) /  4370,  4435,  4436,  4373,  4309/
+data    (chrtab(i), i=0876,0880) /   212,  4307,  4371,  4372,  4308/
+data    (chrtab(i), i=0881,0885) /   202,  4233,  4232,  4295,  4359/
+data    (chrtab(i), i=0886,0890) /  4424,  4425,  4362,  4298,   201/
+data    (chrtab(i), i=0891,0895) /  4296,  4360,  4361,  4297,     0/
+data    (chrtab(i), i=0896,0900) /   213,  4244,  4243,  4306,  4370/
+data    (chrtab(i), i=0901,0905) /  4435,  4436,  4373,  4309,   212/
+data    (chrtab(i), i=0906,0910) /  4307,  4371,  4372,  4308,   328/
+data    (chrtab(i), i=0911,0915) /  4359,  4295,  4232,  4233,  4298/
+data    (chrtab(i), i=0916,0920) /  4362,  4425,  4422,  4356,  4227/
+data    (chrtab(i), i=0921,0925) /   201,  4296,  4360,  4361,  4297/
+data    (chrtab(i), i=0926,0930) /   263,  4422,   328,  4356,     0/
+data    (chrtab(i), i=0931,0935) /  1177,  4240,  5255,     0,   149/
+data    (chrtab(i), i=0936,0940) /  5333,  5332,   149,  4244,  5332/
+data    (chrtab(i), i=0941,0945) /   141,  5325,  5324,   141,  4236/
+data    (chrtab(i), i=0946,0950) /  5324,     0,   153,  5264,  4231/
+data    (chrtab(i), i=0951,0955) /     0,   151,  4248,  4312,  4310/
+data    (chrtab(i), i=0956,0960) /  4182,  4184,  4250,  4315,  4444/
+data    (chrtab(i), i=0961,0965) /  4700,  4891,  4954,  5016,  5014/
+data    (chrtab(i), i=0966,0970) /  4948,  4883,  4625,   794,  4953/
+data    (chrtab(i), i=0971,0975) /  4949,  4884,   604,  4827,  4889/
+data    (chrtab(i), i=0976,0980) /  4885,  4819,  4754,   465,  4558/
+data    (chrtab(i), i=0981,0985) /  4622,  4625,  4561,   458,  4489/
+data    (chrtab(i), i=0986,0990) /  4488,  4551,  4615,  4680,  4681/
+data    (chrtab(i), i=0991,0995) /  4618,  4554,   457,  4552,  4616/
+data    (chrtab(i), i=0996,1000) /  4617,  4553,     0,  1044,  5078/
+data    (chrtab(i), i=1001,1005) /  4951,  4759,  4630,  4565,  4498/
+data    (chrtab(i), i=1006,1010) /  4495,  4557,  4684,  4876,  5005/
+data    (chrtab(i), i=1011,1015) /  5071,   663,  4629,  4562,  4559/
+data    (chrtab(i), i=1016,1020) /  4621,  4684,  1047,  5071,  5069/
+data    (chrtab(i), i=1021,1025) /  5196,  5324,  5454,  5521,  5523/
+data    (chrtab(i), i=1026,1030) /  5462,  5400,  5274,  5147,  4956/
+data    (chrtab(i), i=1031,1035) /  4764,  4571,  4442,  4312,  4246/
+data    (chrtab(i), i=1036,1040) /  4179,  4176,  4237,  4299,  4425/
+data    (chrtab(i), i=1041,1045) /  4552,  4743,  4935,  5128,  5257/
+data    (chrtab(i), i=1046,1050) /  5322,  1111,  5135,  5133,  5196/
+data    (chrtab(i), i=1051,1055) /     0,   540,  4168,   473,  4935/
+data    (chrtab(i), i=1056,1060) /   537,  4999,   540,  5063,   205/
+data    (chrtab(i), i=1061,1065) /  4877,     7,  4423,   647,  5191/
+data    (chrtab(i), i=1066,1070) /    72,  4103,    72,  4295,   840/
+data    (chrtab(i), i=1071,1075) /  4807,   841,  4871,   905,  5127/
+data    (chrtab(i), i=1076,1080) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=1081,1085) /   348,  4423,    28,  4892,  5083/
+data    (chrtab(i), i=1086,1090) /  5146,  5208,  5206,  5140,  5075/
+data    (chrtab(i), i=1091,1095) /  4882,   986,  5144,  5142,  5076/
+data    (chrtab(i), i=1096,1100) /   796,  5019,  5081,  5077,  5011/
+data    (chrtab(i), i=1101,1105) /  4882,   338,  4882,  5073,  5136/
+data    (chrtab(i), i=1106,1110) /  5198,  5195,  5129,  5064,  4871/
+data    (chrtab(i), i=1111,1115) /  4103,   976,  5134,  5131,  5065/
+data    (chrtab(i), i=1116,1120) /   786,  5009,  5071,  5066,  5000/
+data    (chrtab(i), i=1121,1125) /  4871,    92,  4315,   156,  4314/
+data    (chrtab(i), i=1126,1130) /   412,  4442,   476,  4443,   200/
+data    (chrtab(i), i=1131,1135) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=1136,1140) /   328,  4551,     0,   985,  5148/
+data    (chrtab(i), i=1141,1145) /  5142,  5081,  4955,  4828,  4636/
+data    (chrtab(i), i=1146,1150) /  4443,  4313,  4247,  4180,  4175/
+data    (chrtab(i), i=1151,1155) /  4236,  4298,  4424,  4615,  4807/
+data    (chrtab(i), i=1156,1160) /  4936,  5066,  5132,   281,  4311/
+data    (chrtab(i), i=1161,1165) /  4244,  4239,  4300,  4362,   540/
+data    (chrtab(i), i=1166,1170) /  4507,  4376,  4308,  4303,  4363/
+data    (chrtab(i), i=1171,1175) /  4488,  4615,     0,   220,  4295/
+data    (chrtab(i), i=1176,1180) /   283,  4360,   348,  4423,    28/
+data    (chrtab(i), i=1181,1185) /  4764,  4955,  5081,  5143,  5204/
+data    (chrtab(i), i=1186,1190) /  5199,  5132,  5066,  4936,  4743/
+data    (chrtab(i), i=1191,1195) /  4103,   921,  5079,  5140,  5135/
+data    (chrtab(i), i=1196,1200) /  5068,  5002,   668,  4891,  5016/
+data    (chrtab(i), i=1201,1205) /  5076,  5071,  5003,  4872,  4743/
+data    (chrtab(i), i=1206,1210) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1211,1215) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1216,1220) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1221,1225) /  4551,     0,   220,  4295,   283/
+data    (chrtab(i), i=1226,1230) /  4360,   348,  4423,    28,  5148/
+data    (chrtab(i), i=1231,1235) /  5142,   338,  4818,   726,  4814/
+data    (chrtab(i), i=1236,1240) /     7,  5127,  5133,    92,  4315/
+data    (chrtab(i), i=1241,1245) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1246,1250) /  4443,   732,  5147,   860,  5146/
+data    (chrtab(i), i=1251,1255) /   924,  5145,   988,  5142,   726/
+data    (chrtab(i), i=1256,1260) /  4754,  4814,   724,  4690,  4816/
+data    (chrtab(i), i=1261,1265) /   723,  4562,  4817,   200,  4167/
+data    (chrtab(i), i=1266,1270) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1271,1275) /  4551,   711,  5128,   839,  5129/
+data    (chrtab(i), i=1276,1280) /   903,  5130,   967,  5133,     0/
+data    (chrtab(i), i=1281,1285) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1286,1290) /  4423,    28,  5148,  5142,   338/
+data    (chrtab(i), i=1291,1295) /  4818,   726,  4814,     7,  4615/
+data    (chrtab(i), i=1296,1300) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1301,1305) /  4442,   476,  4443,   732,  5147/
+data    (chrtab(i), i=1306,1310) /   860,  5146,   924,  5145,   988/
+data    (chrtab(i), i=1311,1315) /  5142,   726,  4754,  4814,   724/
+data    (chrtab(i), i=1316,1320) /  4690,  4816,   723,  4562,  4817/
+data    (chrtab(i), i=1321,1325) /   200,  4167,   201,  4231,   329/
+data    (chrtab(i), i=1326,1330) /  4487,   328,  4551,     0,   985/
+data    (chrtab(i), i=1331,1335) /  5148,  5142,  5081,  4955,  4828/
+data    (chrtab(i), i=1336,1340) /  4636,  4443,  4313,  4247,  4180/
+data    (chrtab(i), i=1341,1345) /  4175,  4236,  4298,  4424,  4615/
+data    (chrtab(i), i=1346,1350) /  4807,  4936,  5064,  5127,  5135/
+data    (chrtab(i), i=1351,1355) /   281,  4311,  4244,  4239,  4300/
+data    (chrtab(i), i=1356,1360) /  4362,   540,  4507,  4376,  4308/
+data    (chrtab(i), i=1361,1365) /  4303,  4363,  4488,  4615,   974/
+data    (chrtab(i), i=1366,1370) /  5065,   911,  5001,  4936,   719/
+data    (chrtab(i), i=1371,1375) /  5327,   783,  5006,   847,  5005/
+data    (chrtab(i), i=1376,1380) /  1103,  5133,  1167,  5134,     0/
+data    (chrtab(i), i=1381,1385) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1386,1390) /  4423,   988,  5063,  1051,  5128/
+data    (chrtab(i), i=1391,1395) /  1116,  5191,    28,  4636,   796/
+data    (chrtab(i), i=1396,1400) /  5404,   338,  5074,     7,  4615/
+data    (chrtab(i), i=1401,1405) /   775,  5383,    92,  4315,   156/
+data    (chrtab(i), i=1406,1410) /  4314,   412,  4442,   476,  4443/
+data    (chrtab(i), i=1411,1415) /   860,  5083,   924,  5082,  1180/
+data    (chrtab(i), i=1416,1420) /  5210,  1244,  5211,   200,  4167/
+data    (chrtab(i), i=1421,1425) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1426,1430) /  4551,   968,  4935,   969,  4999/
+data    (chrtab(i), i=1431,1435) /  1097,  5255,  1096,  5319,     0/
+data    (chrtab(i), i=1436,1440) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1441,1445) /  4423,    28,  4636,     7,  4615/
+data    (chrtab(i), i=1446,1450) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1451,1455) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1456,1460) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1461,1465) /  4551,     0,   476,  4555,  4488/
+data    (chrtab(i), i=1466,1470) /  4423,   539,  4619,  4552,   604/
+data    (chrtab(i), i=1471,1475) /  4683,  4616,  4423,  4295,  4168/
+data    (chrtab(i), i=1476,1480) /  4106,  4108,  4173,  4237,  4300/
+data    (chrtab(i), i=1481,1485) /  4299,  4234,  4170,    76,  4171/
+data    (chrtab(i), i=1486,1490) /  4235,  4236,  4172,   284,  4892/
+data    (chrtab(i), i=1491,1495) /   348,  4571,   412,  4570,   668/
+data    (chrtab(i), i=1496,1500) /  4698,   732,  4699,     0,   220/
+data    (chrtab(i), i=1501,1505) /  4295,   283,  4360,   348,  4423/
+data    (chrtab(i), i=1506,1510) /  1051,  4432,   530,  5063,   594/
+data    (chrtab(i), i=1511,1515) /  5127,   596,  5191,    28,  4636/
+data    (chrtab(i), i=1516,1520) /   860,  5340,     7,  4615,   775/
+data    (chrtab(i), i=1521,1525) /  5319,    92,  4315,   156,  4314/
+data    (chrtab(i), i=1526,1530) /   412,  4442,   476,  4443,   988/
+data    (chrtab(i), i=1531,1535) /  5147,  1180,  5147,   200,  4167/
+data    (chrtab(i), i=1536,1540) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1541,1545) /  4551,   969,  4935,   969,  5255/
+data    (chrtab(i), i=1546,1550) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=1551,1555) /   348,  4423,    28,  4636,     7/
+data    (chrtab(i), i=1556,1560) /  5063,  5069,    92,  4315,   156/
+data    (chrtab(i), i=1561,1565) /  4314,   412,  4442,   476,  4443/
+data    (chrtab(i), i=1566,1570) /   200,  4167,   201,  4231,   329/
+data    (chrtab(i), i=1571,1575) /  4487,   328,  4551,   647,  5064/
+data    (chrtab(i), i=1576,1580) /   775,  5065,   839,  5066,   903/
+data    (chrtab(i), i=1581,1585) /  5069,     0,   220,  4296,   220/
+data    (chrtab(i), i=1586,1590) /  4743,   284,  4746,   348,  4810/
+data    (chrtab(i), i=1591,1595) /  1116,  4743,  1116,  5191,  1179/
+data    (chrtab(i), i=1596,1600) /  5256,  1244,  5319,    28,  4444/
+data    (chrtab(i), i=1601,1605) /  1116,  5532,     7,  4487,   903/
+data    (chrtab(i), i=1606,1610) /  5511,    92,  4315,  1308,  5338/
+data    (chrtab(i), i=1611,1615) /  1372,  5339,   200,  4167,   200/
+data    (chrtab(i), i=1616,1620) /  4423,  1096,  5063,  1097,  5127/
+data    (chrtab(i), i=1621,1625) /  1225,  5383,  1224,  5447,     0/
+data    (chrtab(i), i=1626,1630) /   220,  4296,   220,  5191,   284/
+data    (chrtab(i), i=1631,1635) /  5130,   348,  5194,  1115,  5191/
+data    (chrtab(i), i=1636,1640) /    28,  4444,   924,  5404,     7/
+data    (chrtab(i), i=1641,1645) /  4487,    92,  4315,   988,  5211/
+data    (chrtab(i), i=1646,1650) /  1244,  5211,   200,  4167,   200/
+data    (chrtab(i), i=1651,1655) /  4423,     0,   540,  4443,  4313/
+data    (chrtab(i), i=1656,1660) /  4247,  4179,  4176,  4236,  4298/
+data    (chrtab(i), i=1661,1665) /  4424,  4615,  4743,  4936,  5066/
+data    (chrtab(i), i=1666,1670) /  5132,  5200,  5203,  5143,  5081/
+data    (chrtab(i), i=1671,1675) /  4955,  4764,  4636,   281,  4311/
+data    (chrtab(i), i=1676,1680) /  4244,  4239,  4300,  4362,   906/
+data    (chrtab(i), i=1681,1685) /  5068,  5135,  5140,  5079,  5017/
+data    (chrtab(i), i=1686,1690) /   540,  4507,  4376,  4308,  4303/
+data    (chrtab(i), i=1691,1695) /  4363,  4488,  4615,   647,  4872/
+data    (chrtab(i), i=1696,1700) /  5003,  5071,  5076,  5016,  4891/
+data    (chrtab(i), i=1701,1705) /  4764,     0,   220,  4295,   283/
+data    (chrtab(i), i=1706,1710) /  4360,   348,  4423,    28,  4892/
+data    (chrtab(i), i=1711,1715) /  5083,  5146,  5208,  5205,  5139/
+data    (chrtab(i), i=1716,1720) /  5074,  4881,  4433,   986,  5144/
+data    (chrtab(i), i=1721,1725) /  5141,  5075,   796,  5019,  5081/
+data    (chrtab(i), i=1726,1730) /  5076,  5010,  4881,     7,  4615/
+data    (chrtab(i), i=1731,1735) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1736,1740) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1741,1745) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1746,1750) /  4551,     0,   540,  4443,  4313/
+data    (chrtab(i), i=1751,1755) /  4247,  4179,  4176,  4236,  4298/
+data    (chrtab(i), i=1756,1760) /  4424,  4615,  4743,  4936,  5066/
+data    (chrtab(i), i=1761,1765) /  5132,  5200,  5203,  5143,  5081/
+data    (chrtab(i), i=1766,1770) /  4955,  4764,  4636,   281,  4311/
+data    (chrtab(i), i=1771,1775) /  4244,  4239,  4300,  4362,   906/
+data    (chrtab(i), i=1776,1780) /  5068,  5135,  5140,  5079,  5017/
+data    (chrtab(i), i=1781,1785) /   540,  4507,  4376,  4308,  4303/
+data    (chrtab(i), i=1786,1790) /  4363,  4488,  4615,   647,  4872/
+data    (chrtab(i), i=1791,1795) /  5003,  5071,  5076,  5016,  4891/
+data    (chrtab(i), i=1796,1800) /  4764,   330,  4492,  4621,  4685/
+data    (chrtab(i), i=1801,1805) /  4812,  4874,  4932,  4994,  5122/
+data    (chrtab(i), i=1806,1810) /  5188,  5190,   838,  4996,  5059/
+data    (chrtab(i), i=1811,1815) /  5123,   778,  4997,  5060,  5124/
+data    (chrtab(i), i=1816,1820) /  5189,     0,   220,  4295,   283/
+data    (chrtab(i), i=1821,1825) /  4360,   348,  4423,    28,  4892/
+data    (chrtab(i), i=1826,1830) /  5083,  5146,  5208,  5206,  5140/
+data    (chrtab(i), i=1831,1835) /  5075,  4882,  4434,   986,  5144/
+data    (chrtab(i), i=1836,1840) /  5142,  5076,   796,  5019,  5081/
+data    (chrtab(i), i=1841,1845) /  5077,  5011,  4882,   594,  4817/
+data    (chrtab(i), i=1846,1850) /  4879,  5001,  5063,  5191,  5257/
+data    (chrtab(i), i=1851,1855) /  5259,   907,  5065,  5128,  5192/
+data    (chrtab(i), i=1856,1860) /   721,  4880,  5066,  5129,  5193/
+data    (chrtab(i), i=1861,1865) /  5258,     7,  4615,    92,  4315/
+data    (chrtab(i), i=1866,1870) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1871,1875) /  4443,   200,  4167,   201,  4231/
+data    (chrtab(i), i=1876,1880) /   329,  4487,   328,  4551,     0/
+data    (chrtab(i), i=1881,1885) /   921,  5084,  5078,  5017,  4891/
+data    (chrtab(i), i=1886,1890) /  4700,  4508,  4315,  4185,  4182/
+data    (chrtab(i), i=1891,1895) /  4244,  4434,  4816,  4943,  5005/
+data    (chrtab(i), i=1896,1900) /  5002,  4936,   150,  4308,  4435/
+data    (chrtab(i), i=1901,1905) /  4817,  4944,  5006,   219,  4249/
+data    (chrtab(i), i=1906,1910) /  4247,  4309,  4436,  4818,  5008/
+data    (chrtab(i), i=1911,1915) /  5070,  5067,  5001,  4936,  4743/
+data    (chrtab(i), i=1916,1920) /  4551,  4360,  4234,  4173,  4167/
+data    (chrtab(i), i=1921,1925) /  4234,     0,    28,  4118,   476/
+data    (chrtab(i), i=1926,1930) /  4551,   539,  4616,   604,  4679/
+data    (chrtab(i), i=1931,1935) /  1052,  5142,    28,  5148,   263/
+data    (chrtab(i), i=1936,1940) /  4871,    92,  4118,   156,  4121/
+data    (chrtab(i), i=1941,1945) /   220,  4122,   348,  4123,   732/
+data    (chrtab(i), i=1946,1950) /  5147,   860,  5146,   924,  5145/
+data    (chrtab(i), i=1951,1955) /   988,  5142,   456,  4423,   457/
+data    (chrtab(i), i=1956,1960) /  4487,   585,  4743,   584,  4807/
+data    (chrtab(i), i=1961,1965) /     0,   220,  4301,  4362,  4488/
+data    (chrtab(i), i=1966,1970) /  4679,  4807,  5000,  5130,  5197/
+data    (chrtab(i), i=1971,1975) /  5211,   283,  4364,  4426,   348/
+data    (chrtab(i), i=1976,1980) /  4428,  4489,  4552,  4679,    28/
+data    (chrtab(i), i=1981,1985) /  4636,   924,  5404,    92,  4315/
+data    (chrtab(i), i=1986,1990) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1991,1995) /  4443,   988,  5211,  1244,  5211/
+data    (chrtab(i), i=1996,2000) /     0,    92,  4615,   156,  4618/
+data    (chrtab(i), i=2001,2005) /  4615,   220,  4682,   987,  4615/
+data    (chrtab(i), i=2006,2010) /    28,  4508,   732,  5212,    28/
+data    (chrtab(i), i=2011,2015) /  4250,   284,  4314,   348,  4315/
+data    (chrtab(i), i=2016,2020) /   860,  5083,  1052,  5083,     0/
+data    (chrtab(i), i=2021,2025) /   156,  4487,   220,  4492,  4487/
+data    (chrtab(i), i=2026,2030) /   284,  4556,   668,  4556,  4487/
+data    (chrtab(i), i=2031,2035) /   668,  4999,   732,  5004,  4999/
+data    (chrtab(i), i=2036,2040) /   796,  5068,  1179,  5068,  4999/
+data    (chrtab(i), i=2041,2045) /    28,  4572,   668,  4892,   988/
+data    (chrtab(i), i=2046,2050) /  5468,    28,  4315,    92,  4314/
+data    (chrtab(i), i=2051,2055) /   348,  4378,   412,  4379,  1052/
+data    (chrtab(i), i=2056,2060) /  5275,  1308,  5275,     0,    92/
+data    (chrtab(i), i=2061,2065) /  4935,   156,  4999,   220,  5063/
+data    (chrtab(i), i=2066,2070) /   923,  4232,    28,  4508,   732/
+data    (chrtab(i), i=2071,2075) /  5212,     7,  4423,   647,  5191/
+data    (chrtab(i), i=2076,2080) /    28,  4314,   284,  4314,   348/
+data    (chrtab(i), i=2081,2085) /  4315,   796,  5019,  1052,  5019/
+data    (chrtab(i), i=2086,2090) /   136,  4103,   136,  4359,   840/
+data    (chrtab(i), i=2091,2095) /  4807,   841,  4871,   841,  5127/
+data    (chrtab(i), i=2096,2100) /     0,    92,  4625,  4615,   156/
+data    (chrtab(i), i=2101,2105) /  4689,  4680,   220,  4753,  4743/
+data    (chrtab(i), i=2106,2110) /  1051,  4753,    28,  4508,   860/
+data    (chrtab(i), i=2111,2115) /  5340,   327,  4935,    28,  4251/
+data    (chrtab(i), i=2116,2120) /   348,  4315,   924,  5147,  1180/
+data    (chrtab(i), i=2121,2125) /  5147,   520,  4487,   521,  4551/
+data    (chrtab(i), i=2126,2130) /   649,  4807,   648,  4871,     0/
+data    (chrtab(i), i=2131,2135) /   988,  4188,  4182,   860,  4167/
+data    (chrtab(i), i=2136,2140) /   924,  4231,   988,  4295,    71/
+data    (chrtab(i), i=2141,2145) /  5063,  5069,   156,  4182,   220/
+data    (chrtab(i), i=2146,2150) /  4185,   284,  4186,   412,  4187/
+data    (chrtab(i), i=2151,2155) /   647,  5064,   775,  5065,   839/
+data    (chrtab(i), i=2156,2160) /  5066,   903,  5069,     0,   160/
+data    (chrtab(i), i=2161,2165) /  4224,   224,  4288,   160,  4704/
+data    (chrtab(i), i=2166,2170) /   128,  4672,     0,    28,  4868/
+data    (chrtab(i), i=2171,2175) /     0,   480,  4544,   544,  4608/
+data    (chrtab(i), i=2176,2180) /    96,  4640,    64,  4608,     0/
+data    (chrtab(i), i=2181,2185) /   278,  4505,  4630,    83,  4504/
+data    (chrtab(i), i=2186,2190) /  4819,   408,  4487,     0,     5/
+data    (chrtab(i), i=2191,2195) /  4997,     0,   348,  4315,  4249/
+data    (chrtab(i), i=2196,2200) /  4246,  4309,  4373,  4438,  4439/
+data    (chrtab(i), i=2201,2205) /  4376,  4312,  4247,   215,  4310/
+data    (chrtab(i), i=2206,2210) /  4374,  4375,  4311,   219,  4247/
+data    (chrtab(i), i=2211,2215) /   153,  4312,     0,   210,  4307/
+data    (chrtab(i), i=2216,2220) /  4371,  4369,  4241,  4243,  4308/
+data    (chrtab(i), i=2221,2225) /  4437,  4693,  4820,  4883,  4945/
+data    (chrtab(i), i=2226,2230) /  4938,  5000,  5063,   723,  4881/
+data    (chrtab(i), i=2231,2235) /  4874,  4936,   597,  4756,  4818/
+data    (chrtab(i), i=2236,2240) /  4810,  4872,  5063,  5127,   720/
+data    (chrtab(i), i=2241,2245) /  4751,  4430,  4237,  4171,  4170/
+data    (chrtab(i), i=2246,2250) /  4232,  4423,  4615,  4744,  4810/
+data    (chrtab(i), i=2251,2255) /   205,  4235,  4234,  4296,   655/
+data    (chrtab(i), i=2256,2260) /  4494,  4365,  4299,  4298,  4360/
+data    (chrtab(i), i=2261,2265) /  4423,     0,   220,  4295,  4360/
+data    (chrtab(i), i=2266,2270) /  4488,   283,  4361,    28,  4444/
+data    (chrtab(i), i=2271,2275) /  4424,   338,  4500,  4629,  4757/
+data    (chrtab(i), i=2276,2280) /  4948,  5074,  5135,  5133,  5066/
+data    (chrtab(i), i=2281,2285) /  4936,  4743,  4615,  4488,  4426/
+data    (chrtab(i), i=2286,2290) /   914,  5072,  5068,  5002,   661/
+data    (chrtab(i), i=2291,2295) /  4884,  4947,  5008,  5004,  4937/
+data    (chrtab(i), i=2296,2300) /  4872,  4743,    92,  4315,   156/
+data    (chrtab(i), i=2301,2305) /  4314,     0,   849,  4946,  4882/
+data    (chrtab(i), i=2306,2310) /  4880,  5008,  5010,  4884,  4757/
+data    (chrtab(i), i=2311,2315) /  4565,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2316,2320) /  4234,  4360,  4551,  4679,  4872/
+data    (chrtab(i), i=2321,2325) /  5002,   210,  4240,  4236,  4298/
+data    (chrtab(i), i=2326,2330) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2331,2335) /  4361,  4424,  4551,     0,   796/
+data    (chrtab(i), i=2336,2340) /  4871,  5191,   859,  4936,   604/
+data    (chrtab(i), i=2341,2345) /  5020,  4999,   786,  4820,  4693/
+data    (chrtab(i), i=2346,2350) /  4565,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2351,2355) /  4234,  4360,  4551,  4679,  4808/
+data    (chrtab(i), i=2356,2360) /  4874,   210,  4240,  4236,  4298/
+data    (chrtab(i), i=2361,2365) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2366,2370) /  4361,  4424,  4551,   668,  4891/
+data    (chrtab(i), i=2371,2375) /   732,  4890,   905,  5063,   904/
+data    (chrtab(i), i=2376,2380) /  5127,     0,   207,  5007,  5009/
+data    (chrtab(i), i=2381,2385) /  4947,  4884,  4693,  4565,  4372/
+data    (chrtab(i), i=2386,2390) /  4242,  4175,  4173,  4234,  4360/
+data    (chrtab(i), i=2391,2395) /  4551,  4679,  4872,  5002,   848/
+data    (chrtab(i), i=2396,2400) /  4945,  4883,   210,  4240,  4236/
+data    (chrtab(i), i=2401,2405) /  4298,   783,  4882,  4820,  4693/
+data    (chrtab(i), i=2406,2410) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2411,2415) /  4361,  4424,  4551,     0,   666/
+data    (chrtab(i), i=2416,2420) /  4763,  4699,  4697,  4825,  4827/
+data    (chrtab(i), i=2421,2425) /  4764,  4572,  4443,  4378,  4311/
+data    (chrtab(i), i=2426,2430) /  4295,   346,  4375,  4360,   476/
+data    (chrtab(i), i=2431,2435) /  4507,  4441,  4423,    21,  4693/
+data    (chrtab(i), i=2436,2440) /     7,  4615,   200,  4167,   201/
+data    (chrtab(i), i=2441,2445) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2446,2450) /     0,   852,  5011,  5076,  5013/
+data    (chrtab(i), i=2451,2455) /  4949,  4820,  4755,   405,  4372/
+data    (chrtab(i), i=2456,2460) /  4307,  4241,  4239,  4301,  4364/
+data    (chrtab(i), i=2461,2465) /  4491,  4619,  4748,  4813,  4879/
+data    (chrtab(i), i=2466,2470) /  4881,  4819,  4756,  4629,  4501/
+data    (chrtab(i), i=2471,2475) /   275,  4305,  4303,  4365,   653/
+data    (chrtab(i), i=2476,2480) /  4815,  4817,  4755,   405,  4436/
+data    (chrtab(i), i=2481,2485) /  4370,  4366,  4428,  4491,   523/
+data    (chrtab(i), i=2486,2490) /  4684,  4750,  4754,  4692,  4629/
+data    (chrtab(i), i=2491,2495) /   205,  4236,  4170,  4169,  4231/
+data    (chrtab(i), i=2496,2500) /  4294,  4485,  4741,  4932,  4995/
+data    (chrtab(i), i=2501,2505) /   199,  4486,  4742,  4933,    73/
+data    (chrtab(i), i=2506,2510) /  4232,  4423,  4743,  4934,  4996/
+data    (chrtab(i), i=2511,2515) /  4995,  4929,  4736,  4352,  4161/
+data    (chrtab(i), i=2516,2520) /  4099,  4100,  4166,  4359,   256/
+data    (chrtab(i), i=2521,2525) /  4225,  4163,  4164,  4230,  4359/
+data    (chrtab(i), i=2526,2530) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=2531,2535) /    28,  4444,  4423,   337,  4499/
+data    (chrtab(i), i=2536,2540) /  4564,  4693,  4885,  5012,  5075/
+data    (chrtab(i), i=2541,2545) /  5136,  5127,   915,  5072,  5064/
+data    (chrtab(i), i=2546,2550) /   789,  4948,  5009,  4999,     7/
+data    (chrtab(i), i=2551,2555) /  4615,   711,  5319,    92,  4315/
+data    (chrtab(i), i=2556,2560) /   156,  4314,   200,  4167,   201/
+data    (chrtab(i), i=2561,2565) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2566,2570) /   904,  4871,   905,  4935,  1033/
+data    (chrtab(i), i=2571,2575) /  5191,  1032,  5255,     0,   220/
+data    (chrtab(i), i=2576,2580) /  4314,  4442,  4444,  4316,   284/
+data    (chrtab(i), i=2581,2585) /  4378,   219,  4443,   213,  4295/
+data    (chrtab(i), i=2586,2590) /   276,  4360,    21,  4437,  4423/
+data    (chrtab(i), i=2591,2595) /     7,  4615,    85,  4308,   149/
+data    (chrtab(i), i=2596,2600) /  4307,   200,  4167,   201,  4231/
+data    (chrtab(i), i=2601,2605) /   329,  4487,   328,  4551,     0/
+data    (chrtab(i), i=2606,2610) /   348,  4442,  4570,  4572,  4444/
+data    (chrtab(i), i=2611,2615) /   412,  4506,   347,  4571,   341/
+data    (chrtab(i), i=2616,2620) /  4420,  4353,  4288,   404,  4485/
+data    (chrtab(i), i=2621,2625) /  4418,   149,  4565,  4549,  4482/
+data    (chrtab(i), i=2626,2630) /  4417,  4288,  4096,  4097,  4099/
+data    (chrtab(i), i=2631,2635) /  4163,  4161,  4097,  4098,   213/
+data    (chrtab(i), i=2636,2640) /  4436,   277,  4435,     0,   220/
+data    (chrtab(i), i=2641,2645) /  4295,   283,  4360,    28,  4444/
+data    (chrtab(i), i=2646,2650) /  4423,   916,  4427,   591,  5127/
+data    (chrtab(i), i=2651,2655) /   590,  5063,   526,  4999,   725/
+data    (chrtab(i), i=2656,2660) /  5269,     7,  4615,   711,  5255/
+data    (chrtab(i), i=2661,2665) /    92,  4315,   156,  4314,   789/
+data    (chrtab(i), i=2666,2670) /  5012,  1109,  5012,   200,  4167/
+data    (chrtab(i), i=2671,2675) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=2676,2680) /  4551,   905,  4871,   841,  5191/
+data    (chrtab(i), i=2681,2685) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=2686,2690) /    28,  4444,  4423,     7,  4615/
+data    (chrtab(i), i=2691,2695) /    92,  4315,   156,  4314,   200/
+data    (chrtab(i), i=2696,2700) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=2701,2705) /   328,  4551,     0,   213,  4295/
+data    (chrtab(i), i=2706,2710) /   276,  4360,    21,  4437,  4423/
+data    (chrtab(i), i=2711,2715) /   337,  4499,  4564,  4693,  4885/
+data    (chrtab(i), i=2716,2720) /  5012,  5075,  5136,  5127,   915/
+data    (chrtab(i), i=2721,2725) /  5072,  5064,   789,  4948,  5009/
+data    (chrtab(i), i=2726,2730) /  4999,  1041,  5203,  5268,  5397/
+data    (chrtab(i), i=2731,2735) /  5589,  5716,  5779,  5840,  5831/
+data    (chrtab(i), i=2736,2740) /  1619,  5776,  5768,  1493,  5652/
+data    (chrtab(i), i=2741,2745) /  5713,  5703,     7,  4615,   711/
+data    (chrtab(i), i=2746,2750) /  5319,  1415,  6023,    85,  4308/
+data    (chrtab(i), i=2751,2755) /   149,  4307,   200,  4167,   201/
+data    (chrtab(i), i=2756,2760) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2761,2765) /   904,  4871,   905,  4935,  1033/
+data    (chrtab(i), i=2766,2770) /  5191,  1032,  5255,  1608,  5575/
+data    (chrtab(i), i=2771,2775) /  1609,  5639,  1737,  5895,  1736/
+data    (chrtab(i), i=2776,2780) /  5959,     0,   213,  4295,   276/
+data    (chrtab(i), i=2781,2785) /  4360,    21,  4437,  4423,   337/
+data    (chrtab(i), i=2786,2790) /  4499,  4564,  4693,  4885,  5012/
+data    (chrtab(i), i=2791,2795) /  5075,  5136,  5127,   915,  5072/
+data    (chrtab(i), i=2796,2800) /  5064,   789,  4948,  5009,  4999/
+data    (chrtab(i), i=2801,2805) /     7,  4615,   711,  5319,    85/
+data    (chrtab(i), i=2806,2810) /  4308,   149,  4307,   200,  4167/
+data    (chrtab(i), i=2811,2815) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=2816,2820) /  4551,   904,  4871,   905,  4935/
+data    (chrtab(i), i=2821,2825) /  1033,  5191,  1032,  5255,     0/
+data    (chrtab(i), i=2826,2830) /   469,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2831,2835) /  4234,  4360,  4551,  4679,  4872/
+data    (chrtab(i), i=2836,2840) /  5002,  5069,  5071,  5010,  4884/
+data    (chrtab(i), i=2841,2845) /  4693,  4565,   210,  4240,  4236/
+data    (chrtab(i), i=2846,2850) /  4298,   842,  5004,  5008,  4946/
+data    (chrtab(i), i=2851,2855) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2856,2860) /  4361,  4424,  4551,   583,  4808/
+data    (chrtab(i), i=2861,2865) /  4873,  4940,  4944,  4883,  4820/
+data    (chrtab(i), i=2866,2870) /  4693,     0,   213,  4288,   276/
+data    (chrtab(i), i=2871,2875) /  4353,    21,  4437,  4416,   338/
+data    (chrtab(i), i=2876,2880) /  4500,  4629,  4757,  4948,  5074/
+data    (chrtab(i), i=2881,2885) /  5135,  5133,  5066,  4936,  4743/
+data    (chrtab(i), i=2886,2890) /  4615,  4488,  4426,   914,  5072/
+data    (chrtab(i), i=2891,2895) /  5068,  5002,   661,  4884,  4947/
+data    (chrtab(i), i=2896,2900) /  5008,  5004,  4937,  4872,  4743/
+data    (chrtab(i), i=2901,2905) /     0,  4608,    85,  4308,   149/
+data    (chrtab(i), i=2906,2910) /  4307,   193,  4160,   194,  4224/
+data    (chrtab(i), i=2911,2915) /   322,  4480,   321,  4544,     0/
+data    (chrtab(i), i=2916,2920) /   788,  4864,   851,  4929,   724/
+data    (chrtab(i), i=2921,2925) /  4948,  5013,  4992,   786,  4820/
+data    (chrtab(i), i=2926,2930) /  4693,  4565,  4372,  4242,  4175/
+data    (chrtab(i), i=2931,2935) /  4173,  4234,  4360,  4551,  4679/
+data    (chrtab(i), i=2936,2940) /  4808,  4874,   210,  4240,  4236/
+data    (chrtab(i), i=2941,2945) /  4298,   469,  4436,  4371,  4304/
+data    (chrtab(i), i=2946,2950) /  4300,  4361,  4424,  4551,   576/
+data    (chrtab(i), i=2951,2955) /  5184,   769,  4736,   770,  4800/
+data    (chrtab(i), i=2956,2960) /   898,  5056,   897,  5120,     0/
+data    (chrtab(i), i=2961,2965) /   213,  4295,   276,  4360,    21/
+data    (chrtab(i), i=2966,2970) /  4437,  4423,   787,  4884,  4820/
+data    (chrtab(i), i=2971,2975) /  4818,  4946,  4948,  4885,  4757/
+data    (chrtab(i), i=2976,2980) /  4628,  4498,  4431,     7,  4615/
+data    (chrtab(i), i=2981,2985) /    85,  4308,   149,  4307,   200/
+data    (chrtab(i), i=2986,2990) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=2991,2995) /   328,  4551,     0,   723,  4885/
+data    (chrtab(i), i=2996,3000) /  4881,  4819,  4756,  4629,  4373/
+data    (chrtab(i), i=3001,3005) /  4244,  4179,  4177,  4239,  4366/
+data    (chrtab(i), i=3006,3010) /  4685,  4812,  4873,   148,  4177/
+data    (chrtab(i), i=3011,3015) /   144,  4367,  4686,  4813,   780/
+data    (chrtab(i), i=3016,3020) /  4808,    83,  4241,  4368,  4687/
+data    (chrtab(i), i=3021,3025) /  4814,  4876,  4873,  4808,  4679/
+data    (chrtab(i), i=3026,3030) /  4423,  4296,  4233,  4171,  4167/
+data    (chrtab(i), i=3031,3035) /  4233,     0,   218,  4300,  4361/
+data    (chrtab(i), i=3036,3040) /  4424,  4551,  4679,  4808,  4874/
+data    (chrtab(i), i=3041,3045) /   282,  4363,  4425,   218,  4444/
+data    (chrtab(i), i=3046,3050) /  4427,  4488,  4551,    21,  4693/
+data    (chrtab(i), i=3051,3055) /     0,   213,  4300,  4361,  4424/
+data    (chrtab(i), i=3056,3060) /  4551,  4743,  4872,  4937,  5003/
+data    (chrtab(i), i=3061,3065) /   276,  4363,  4425,    21,  4437/
+data    (chrtab(i), i=3066,3070) /  4427,  4488,  4551,   917,  4999/
+data    (chrtab(i), i=3071,3075) /  5319,   980,  5064,   725,  5141/
+data    (chrtab(i), i=3076,3080) /  5127,    85,  4308,   149,  4307/
+data    (chrtab(i), i=3081,3085) /  1033,  5191,  1032,  5255,     0/
+data    (chrtab(i), i=3086,3090) /    85,  4551,   149,  4553,   213/
+data    (chrtab(i), i=3091,3095) /  4617,   852,  4617,  4551,    21/
+data    (chrtab(i), i=3096,3100) /  4501,   597,  5077,    21,  4307/
+data    (chrtab(i), i=3101,3105) /   341,  4308,   725,  4948,   917/
+data    (chrtab(i), i=3106,3110) /  4948,     0,   149,  4487,   213/
+data    (chrtab(i), i=3111,3115) /  4490,   277,  4554,   661,  4554/
+data    (chrtab(i), i=3116,3120) /  4487,   661,  4999,   725,  5002/
+data    (chrtab(i), i=3121,3125) /   661,  4885,  5066,  1172,  5066/
+data    (chrtab(i), i=3126,3130) /  4999,    21,  4565,   981,  5461/
+data    (chrtab(i), i=3131,3135) /    21,  4308,   405,  4372,  1045/
+data    (chrtab(i), i=3136,3140) /  5268,  1301,  5268,     0,   149/
+data    (chrtab(i), i=3141,3145) /  4871,   213,  4935,   277,  4999/
+data    (chrtab(i), i=3146,3150) /   852,  4296,    21,  4565,   661/
+data    (chrtab(i), i=3151,3155) /  5141,     7,  4487,   583,  5127/
+data    (chrtab(i), i=3156,3160) /    85,  4308,   405,  4372,   725/
+data    (chrtab(i), i=3161,3165) /  4948,   981,  4948,   200,  4167/
+data    (chrtab(i), i=3166,3170) /   200,  4423,   776,  4743,   840/
+data    (chrtab(i), i=3171,3175) /  5063,     0,   149,  4615,   213/
+data    (chrtab(i), i=3176,3180) /  4617,   277,  4681,   916,  4681/
+data    (chrtab(i), i=3181,3185) /  4483,  4353,  4224,  4096,  4097/
+data    (chrtab(i), i=3186,3190) /  4099,  4163,  4161,  4097,  4098/
+data    (chrtab(i), i=3191,3195) /    21,  4565,   661,  5141,    85/
+data    (chrtab(i), i=3196,3200) /  4371,   405,  4372,   789,  5012/
+data    (chrtab(i), i=3201,3205) /   981,  5012,     0,   725,  4167/
+data    (chrtab(i), i=3206,3210) /   789,  4231,   853,  4295,   853/
+data    (chrtab(i), i=3211,3215) /  4181,  4177,    71,  4935,  4939/
+data    (chrtab(i), i=3216,3220) /   149,  4177,   213,  4178,   277/
+data    (chrtab(i), i=3221,3225) /  4179,   405,  4180,   519,  4936/
+data    (chrtab(i), i=3226,3230) /   647,  4937,   711,  4938,   775/
+data    (chrtab(i), i=3231,3235) /  4939,     0,   480,  4447,  4382/
+data    (chrtab(i), i=3236,3240) /  4316,  4314,  4376,  4439,  4501/
+data    (chrtab(i), i=3241,3245) /  4499,  4369,   351,  4381,  4379/
+data    (chrtab(i), i=3246,3250) /  4441,  4504,  4566,  4564,  4498/
+data    (chrtab(i), i=3251,3255) /  4240,  4494,  4556,  4554,  4488/
+data    (chrtab(i), i=3256,3260) /  4423,  4357,  4355,  4417,   271/
+data    (chrtab(i), i=3261,3265) /  4493,  4491,  4425,  4360,  4294/
+data    (chrtab(i), i=3266,3270) /  4292,  4354,  4417,  4544,     0/
+data    (chrtab(i), i=3271,3275) /   160,  4224,     0,   224,  4447/
+data    (chrtab(i), i=3276,3280) /  4510,  4572,  4570,  4504,  4439/
+data    (chrtab(i), i=3281,3285) /  4373,  4371,  4497,   351,  4509/
+data    (chrtab(i), i=3286,3290) /  4507,  4441,  4376,  4310,  4308/
+data    (chrtab(i), i=3291,3295) /  4370,  4624,  4366,  4300,  4298/
+data    (chrtab(i), i=3296,3300) /  4360,  4423,  4485,  4483,  4417/
+data    (chrtab(i), i=3301,3305) /   399,  4365,  4363,  4425,  4488/
+data    (chrtab(i), i=3306,3310) /  4550,  4548,  4482,  4417,  4288/
+data    (chrtab(i), i=3311,3315) /     0,    77,  4175,  4242,  4371/
+data    (chrtab(i), i=3316,3320) /  4499,  4626,  4879,  5006,  5134/
+data    (chrtab(i), i=3321,3325) /  5263,  5329,    79,  4241,  4370/
+data    (chrtab(i), i=3326,3330) /  4498,  4625,  4878,  5005,  5133/
+data    (chrtab(i), i=3331,3335) /  5262,  5329,  5331,     0,   284/
+data    (chrtab(i), i=3336,3340) /  4251,  4185,  4183,  4245,  4372/
+data    (chrtab(i), i=3341,3345) /  4500,  4629,  4695,  4697,  4635/
+data    (chrtab(i), i=3346,3350) /  4508,  4380,   284,  4185,  4245/
+data    (chrtab(i), i=3351,3355) /  4500,  4695,  4635,  4380,   412/
+data    (chrtab(i), i=3356,3360) /  4251,  4183,  4372,  4629,  4697/
+data    (chrtab(i), i=3361,3362) /  4508,     0/
diff --git a/sys/gio/fonts/greek.com b/sys/gio/fonts/greek.com
new file mode 100644
index 00000000..82c5fe34
--- /dev/null
+++ b/sys/gio/fonts/greek.com
@@ -0,0 +1,501 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each
+# character is encoded as a series of strokes.  Each stroke is ex-
+# pressed by a single integer containing the following bitfields:
+#
+#       2                   1
+#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
+#                 | | | |         | |         |
+#                 | | | +---------+ +---------+
+#                 | | |      |           |
+#                 | | |      X           Y
+#                 | | |
+#                 | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#----------------------------------------------------------------------------
+
+# Define the database.
+
+short   gchidx[97]	# character index in gchtab
+short   gchwid[97]	# character width table
+short   gchtab[2140]	# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP)
+
+data    (gchidx(i), i=001,005) /    1,    3,   16,   29,   38/
+data    (gchidx(i), i=006,010) /   77,  107,  154,  162,  181/
+data    (gchidx(i), i=011,015) /  200,  205,  212,  233,  240/
+data    (gchidx(i), i=016,020) /  246,  259,  297,  306,  348/
+data    (gchidx(i), i=021,025) /  392,  402,  437,  483,  510/
+data    (gchidx(i), i=026,030) /  568,  614,  645,  658,  666/
+data    (gchidx(i), i=031,035) /  673,  681,  688,  741,  767/
+data    (gchidx(i), i=036,040) /  793,  795,  806,  821,  863/
+data    (gchidx(i), i=041,045) /  874,  883,  888,  899,  901/
+data    (gchidx(i), i=046,050) /  912,  921,  930,  972,  987/
+data    (gchidx(i), i=051,055) / 1037, 1067, 1083, 1088, 1117/
+data    (gchidx(i), i=056,060) / 1143, 1182, 1207, 1242, 1244/
+data    (gchidx(i), i=061,065) / 1253, 1256, 1265, 1267, 1276/
+data    (gchidx(i), i=066,070) / 1284, 1321, 1373, 1394, 1436/
+data    (gchidx(i), i=071,075) / 1465, 1500, 1525, 1554, 1568/
+data    (gchidx(i), i=076,080) / 1610, 1635, 1655, 1679, 1699/
+data    (gchidx(i), i=081,085) / 1729, 1746, 1788, 1817, 1849/
+data    (gchidx(i), i=086,090) / 1862, 1891, 1893, 1934, 1975/
+data    (gchidx(i), i=091,095) / 2006, 2036, 2074, 2079, 2117/
+data    (gchidx(i), i=096,096) / 2126/
+
+
+# Width data.
+
+data    (gchwid(i), i=001,005) /   21,   15,   15,   26,   25/
+data    (gchwid(i), i=006,010) /   29,   30,   15,   19,   19/
+data    (gchwid(i), i=011,015) /   27,   29,   30,   29,   15/
+data    (gchwid(i), i=016,020) /   31,   25,   25,   25,   25/
+data    (gchwid(i), i=021,025) /   25,   25,   25,   25,   25/
+data    (gchwid(i), i=026,030) /   25,   29,   15,   29,   31/
+data    (gchwid(i), i=031,035) /   29,   31,   32,   25,   30/
+data    (gchwid(i), i=036,040) /   21,   25,   29,   26,   23/
+data    (gchwid(i), i=041,045) /   26,   19,   25,   21,   25/
+data    (gchwid(i), i=046,050) /   21,   21,   27,   29,   27/
+data    (gchwid(i), i=051,055) /   29,   26,   19,   24,   25/
+data    (gchwid(i), i=056,060) /   27,   27,   28,   21,   19/
+data    (gchwid(i), i=061,065) /   19,   19,   21,   31,   27/
+data    (gchwid(i), i=066,070) /   28,   26,   23,   24,   23/
+data    (gchwid(i), i=071,075) /   27,   25,   27,   17,   24/
+data    (gchwid(i), i=076,080) /   25,   25,   28,   25,   23/
+data    (gchwid(i), i=081,085) /   27,   28,   24,   26,   25/
+data    (gchwid(i), i=086,090) /   25,   21,   28,   22,   28/
+data    (gchwid(i), i=091,095) /   23,   19,   19,   19,   31/
+data    (gchwid(i), i=096,096) /   19/
+
+
+# Stroke data.
+
+data    (gchtab(i), i=0001,0005) /    35,     0,   220,  4250,  4302/
+data    (gchtab(i), i=0006,0010) /  4378,  4316,   218,  4308,   201/
+data    (gchtab(i), i=0011,0015) /  4232,  4295,  4360,  4297,     0/
+data    (gchtab(i), i=0016,0020) /   213,  4244,  4307,  4372,  4309/
+data    (gchtab(i), i=0021,0025) /   199,  4232,  4297,  4360,  4358/
+data    (gchtab(i), i=0026,0030) /  4292,  4227,     0,   604,  4224/
+data    (gchtab(i), i=0031,0035) /   988,  4608,   145,  5137,    75/
+data    (gchtab(i), i=0036,0040) /  5067,     0,   416,  4483,   672/
+data    (gchtab(i), i=0041,0045) /  4739,   921,  4952,  5015,  5080/
+data    (gchtab(i), i=0046,0050) /  5081,  4955,  4764,  4508,  4315/
+data    (gchtab(i), i=0051,0055) /  4185,  4183,  4245,  4308,  4435/
+data    (gchtab(i), i=0056,0060) /  4817,  4944,  5070,    87,  4309/
+data    (gchtab(i), i=0061,0065) /  4436,  4818,  4945,  5008,  5070/
+data    (gchtab(i), i=0066,0070) /  5066,  4936,  4743,  4487,  4296/
+data    (gchtab(i), i=0071,0075) /  4170,  4171,  4236,  4299,  4234/
+data    (gchtab(i), i=0076,0080) /     0,  1244,  4167,   412,  4634/
+data    (gchtab(i), i=0081,0085) /  4632,  4566,  4437,  4309,  4183/
+data    (gchtab(i), i=0086,0090) /  4185,  4251,  4380,  4508,  4635/
+data    (gchtab(i), i=0091,0095) /  4826,  5018,  5211,  5340,   974/
+data    (gchtab(i), i=0096,0100) /  4941,  4875,  4873,  4999,  5127/
+data    (gchtab(i), i=0101,0105) /  5256,  5322,  5324,  5198,  5070/
+data    (gchtab(i), i=0106,0110) /     0,  1236,  5267,  5330,  5395/
+data    (gchtab(i), i=0111,0115) /  5396,  5333,  5269,  5204,  5138/
+data    (gchtab(i), i=0116,0120) /  5005,  4874,  4744,  4615,  4423/
+data    (gchtab(i), i=0121,0125) /  4232,  4170,  4173,  4239,  4627/
+data    (gchtab(i), i=0126,0130) /  4757,  4823,  4825,  4763,  4636/
+data    (gchtab(i), i=0131,0135) /  4507,  4441,  4439,  4500,  4625/
+data    (gchtab(i), i=0136,0140) /  4938,  5064,  5255,  5319,  5384/
+data    (gchtab(i), i=0141,0145) /  5385,   327,  4296,  4234,  4237/
+data    (gchtab(i), i=0146,0150) /  4303,  4433,   343,  4501,  5002/
+data    (gchtab(i), i=0151,0155) /  5128,  5255,     0,   218,  4251/
+data    (gchtab(i), i=0156,0160) /  4316,  4379,  4377,  4311,  4246/
+data    (gchtab(i), i=0161,0165) /     0,   608,  4574,  4443,  4311/
+data    (gchtab(i), i=0166,0170) /  4242,  4238,  4297,  4421,  4546/
+data    (gchtab(i), i=0171,0175) /  4672,   478,  4442,  4375,  4306/
+data    (gchtab(i), i=0176,0180) /  4302,  4361,  4422,  4546,     0/
+data    (gchtab(i), i=0181,0185) /    96,  4318,  4443,  4567,  4626/
+data    (gchtab(i), i=0186,0190) /  4622,  4553,  4421,  4290,  4160/
+data    (gchtab(i), i=0191,0195) /   222,  4442,  4503,  4562,  4558/
+data    (gchtab(i), i=0196,0200) /  4489,  4422,  4290,     0,   151/
+data    (gchtab(i), i=0201,0205) /  5129,  1047,  4233,     0,   664/
+data    (gchtab(i), i=0206,0210) /  4743,   144,  5264,   135,  5255/
+data    (gchtab(i), i=0211,0215) /     0,  1227,  5195,  5068,  4942/
+data    (gchtab(i), i=0216,0220) /  4754,  4691,  4564,  4436,  4307/
+data    (gchtab(i), i=0221,0225) /  4241,  4239,  4301,  4428,  4556/
+data    (gchtab(i), i=0226,0230) /  4685,  4750,  4946,  5076,  5205/
+data    (gchtab(i), i=0231,0235) /  5333,     0,   664,  4743,   152/
+data    (gchtab(i), i=0236,0240) /  5272,   144,  5264,     0,   201/
+data    (gchtab(i), i=0241,0245) /  4232,  4295,  4360,  4297,     0/
+data    (gchtab(i), i=0246,0250) /   729,  4760,  4823,  4888,  4825/
+data    (gchtab(i), i=0251,0255) /   144,  5392,   713,  4744,  4807/
+data    (gchtab(i), i=0256,0260) /  4872,  4809,     0,   476,  4379/
+data    (gchtab(i), i=0261,0265) /  4248,  4179,  4176,  4235,  4360/
+data    (gchtab(i), i=0266,0270) /  4551,  4679,  4872,  5003,  5072/
+data    (gchtab(i), i=0271,0275) /  5075,  5016,  4891,  4700,  4572/
+data    (gchtab(i), i=0276,0280) /   476,  4443,  4378,  4312,  4243/
+data    (gchtab(i), i=0281,0285) /  4240,  4299,  4361,  4424,  4551/
+data    (gchtab(i), i=0286,0290) /   583,  4808,  4873,  4939,  5008/
+data    (gchtab(i), i=0291,0295) /  5011,  4952,  4890,  4827,  4700/
+data    (gchtab(i), i=0296,0300) /     0,   280,  4505,  4700,  4679/
+data    (gchtab(i), i=0301,0305) /   539,  4615,   263,  4935,     0/
+data    (gchtab(i), i=0306,0310) /   152,  4311,  4246,  4183,  4184/
+data    (gchtab(i), i=0311,0315) /  4250,  4315,  4508,  4764,  4955/
+data    (gchtab(i), i=0316,0320) /  5018,  5080,  5078,  5012,  4818/
+data    (gchtab(i), i=0321,0325) /  4496,  4367,  4237,  4170,  4167/
+data    (gchtab(i), i=0326,0330) /   668,  4891,  4954,  5016,  5014/
+data    (gchtab(i), i=0331,0335) /  4948,  4754,  4496,    73,  4234/
+data    (gchtab(i), i=0336,0340) /  4362,  4680,  4872,  5001,  5066/
+data    (gchtab(i), i=0341,0345) /   266,  4679,  4935,  5000,  5066/
+data    (gchtab(i), i=0346,0350) /  5068,     0,   152,  4311,  4246/
+data    (gchtab(i), i=0351,0355) /  4183,  4184,  4250,  4315,  4508/
+data    (gchtab(i), i=0356,0360) /  4764,  4955,  5017,  5014,  4948/
+data    (gchtab(i), i=0361,0365) /  4755,  4563,   668,  4891,  4953/
+data    (gchtab(i), i=0366,0370) /  4950,  4884,  4755,   659,  4882/
+data    (gchtab(i), i=0371,0375) /  5008,  5070,  5067,  5001,  4936/
+data    (gchtab(i), i=0376,0380) /  4743,  4487,  4296,  4233,  4171/
+data    (gchtab(i), i=0381,0385) /  4172,  4237,  4300,  4235,   849/
+data    (gchtab(i), i=0386,0390) /  5006,  5003,  4937,  4872,  4743/
+data    (gchtab(i), i=0391,0395) /     0,   666,  4743,   732,  4807/
+data    (gchtab(i), i=0396,0400) /   732,  4109,  5133,   455,  4999/
+data    (gchtab(i), i=0401,0405) /     0,   220,  4178,    82,  4308/
+data    (gchtab(i), i=0406,0410) /  4501,  4693,  4884,  5010,  5071/
+data    (gchtab(i), i=0411,0415) /  5069,  5002,  4872,  4679,  4487/
+data    (gchtab(i), i=0416,0420) /  4296,  4233,  4171,  4172,  4237/
+data    (gchtab(i), i=0421,0425) /  4300,  4235,   597,  4820,  4946/
+data    (gchtab(i), i=0426,0430) /  5007,  5005,  4938,  4808,  4679/
+data    (gchtab(i), i=0431,0435) /   220,  4956,   219,  4635,  4956/
+data    (gchtab(i), i=0436,0440) /     0,   857,  4888,  4951,  5016/
+data    (gchtab(i), i=0441,0445) /  5017,  4955,  4828,  4636,  4443/
+data    (gchtab(i), i=0446,0450) /  4313,  4247,  4179,  4173,  4234/
+data    (gchtab(i), i=0451,0455) /  4360,  4551,  4679,  4872,  5002/
+data    (gchtab(i), i=0456,0460) /  5069,  5070,  5009,  4883,  4692/
+data    (gchtab(i), i=0461,0465) /  4628,  4435,  4305,  4238,   540/
+data    (gchtab(i), i=0466,0470) /  4507,  4377,  4311,  4243,  4237/
+data    (gchtab(i), i=0471,0475) /  4298,  4424,  4551,   583,  4808/
+data    (gchtab(i), i=0476,0480) /  4938,  5005,  5006,  4945,  4819/
+data    (gchtab(i), i=0481,0485) /  4692,     0,    92,  4182,    88/
+data    (gchtab(i), i=0486,0490) /  4250,  4380,  4508,  4825,  4953/
+data    (gchtab(i), i=0491,0495) /  5018,  5084,   154,  4379,  4507/
+data    (gchtab(i), i=0496,0500) /  4825,   988,  5081,  5014,  4753/
+data    (gchtab(i), i=0501,0505) /  4687,  4620,  4615,   918,  4689/
+data    (gchtab(i), i=0506,0510) /  4623,  4556,  4551,     0,   412/
+data    (gchtab(i), i=0511,0515) /  4315,  4249,  4246,  4308,  4499/
+data    (gchtab(i), i=0516,0520) /  4755,  4948,  5014,  5017,  4955/
+data    (gchtab(i), i=0521,0525) /  4764,  4508,   412,  4379,  4313/
+data    (gchtab(i), i=0526,0530) /  4310,  4372,  4499,   659,  4884/
+data    (gchtab(i), i=0531,0535) /  4950,  4953,  4891,  4764,   403/
+data    (gchtab(i), i=0536,0540) /  4306,  4241,  4175,  4171,  4233/
+data    (gchtab(i), i=0541,0545) /  4296,  4487,  4743,  4936,  5001/
+data    (gchtab(i), i=0546,0550) /  5067,  5071,  5009,  4946,  4755/
+data    (gchtab(i), i=0551,0555) /   403,  4370,  4305,  4239,  4235/
+data    (gchtab(i), i=0556,0560) /  4297,  4360,  4487,   647,  4872/
+data    (gchtab(i), i=0561,0565) /  4937,  5003,  5007,  4945,  4882/
+data    (gchtab(i), i=0566,0570) /  4755,     0,   917,  4946,  4816/
+data    (gchtab(i), i=0571,0575) /  4623,  4559,  4368,  4242,  4181/
+data    (gchtab(i), i=0576,0580) /  4182,  4249,  4379,  4572,  4700/
+data    (gchtab(i), i=0581,0585) /  4891,  5017,  5078,  5072,  5004/
+data    (gchtab(i), i=0586,0590) /  4938,  4808,  4615,  4423,  4296/
+data    (gchtab(i), i=0591,0595) /  4234,  4235,  4300,  4363,  4298/
+data    (gchtab(i), i=0596,0600) /   463,  4432,  4306,  4245,  4246/
+data    (gchtab(i), i=0601,0605) /  4313,  4443,  4572,   604,  4827/
+data    (gchtab(i), i=0606,0610) /  4953,  5014,  5008,  4940,  4874/
+data    (gchtab(i), i=0611,0615) /  4744,  4615,     0,  1247,  5278/
+data    (gchtab(i), i=0616,0620) /  5341,  5406,  5407,  5344,  5216/
+data    (gchtab(i), i=0621,0625) /  5087,  4957,  4891,  4824,  4756/
+data    (gchtab(i), i=0626,0630) /  4616,  4548,  4482,   926,  4956/
+data    (gchtab(i), i=0631,0635) /  4888,  4748,  4680,  4613,  4547/
+data    (gchtab(i), i=0636,0640) /  4417,  4288,  4160,  4097,  4098/
+data    (gchtab(i), i=0641,0645) /  4163,  4226,  4161,     0,   213/
+data    (gchtab(i), i=0646,0650) /  4244,  4307,  4372,  4309,   199/
+data    (gchtab(i), i=0651,0655) /  4232,  4297,  4360,  4358,  4292/
+data    (gchtab(i), i=0656,0660) /  4227,     0,  1180,  4245,  5262/
+data    (gchtab(i), i=0661,0665) /   140,  5260,   135,  5255,     0/
+data    (gchtab(i), i=0666,0670) /   149,  5397,   144,  5392,   139/
+data    (gchtab(i), i=0671,0675) /  5387,     0,   156,  5269,  4238/
+data    (gchtab(i), i=0676,0680) /   140,  5260,   135,  5255,     0/
+data    (gchtab(i), i=0681,0685) /  1177,  4359,   147,  5395,   141/
+data    (gchtab(i), i=0686,0690) /  5389,     0,  1044,  5078,  4951/
+data    (gchtab(i), i=0691,0695) /  4759,  4630,  4565,  4498,  4495/
+data    (gchtab(i), i=0696,0700) /  4557,  4684,  4876,  5005,  5071/
+data    (gchtab(i), i=0701,0705) /   663,  4629,  4562,  4559,  4621/
+data    (gchtab(i), i=0706,0710) /  4684,  1047,  5071,  5069,  5196/
+data    (gchtab(i), i=0711,0715) /  5324,  5454,  5521,  5523,  5462/
+data    (gchtab(i), i=0716,0720) /  5400,  5274,  5147,  4956,  4764/
+data    (gchtab(i), i=0721,0725) /  4571,  4442,  4312,  4246,  4179/
+data    (gchtab(i), i=0726,0730) /  4176,  4237,  4299,  4425,  4552/
+data    (gchtab(i), i=0731,0735) /  4743,  4935,  5128,  5257,  5322/
+data    (gchtab(i), i=0736,0740) /  1111,  5135,  5133,  5196,     0/
+data    (gchtab(i), i=0741,0745) /   473,  4167,   601,  5063,   537/
+data    (gchtab(i), i=0746,0750) /  4999,   205,  4877,     7,  4423/
+data    (gchtab(i), i=0751,0755) /   711,  5191,   480,  4447,  4381/
+data    (gchtab(i), i=0756,0760) /  4379,  4441,  4568,  4696,  4825/
+data    (gchtab(i), i=0761,0765) /  4891,  4893,  4831,  4704,  4576/
+data    (gchtab(i), i=0766,0770) /     0,  1295,  5325,  5196,  5068/
+data    (gchtab(i), i=0771,0775) /  4941,  4878,  4690,  4627,  4500/
+data    (gchtab(i), i=0776,0780) /  4372,  4243,  4177,  4175,  4237/
+data    (gchtab(i), i=0781,0785) /  4364,  4492,  4621,  4686,  4882/
+data    (gchtab(i), i=0786,0790) /  4947,  5076,  5204,  5331,  5393/
+data    (gchtab(i), i=0791,0795) /  5391,     0,    35,     0,   540/
+data    (gchtab(i), i=0796,0800) /  4103,   540,  5127,   537,  5063/
+data    (gchtab(i), i=0801,0805) /    72,  5064,     7,  5127,     0/
+data    (gchtab(i), i=0806,0810) /  1176,  4824,  4567,  4438,  4308/
+data    (gchtab(i), i=0811,0815) /  4241,  4239,  4300,  4426,  4553/
+data    (gchtab(i), i=0816,0820) /  4808,  5256,   144,  5008,     0/
+data    (gchtab(i), i=0821,0825) /   540,  4615,   604,  4679,   407/
+data    (gchtab(i), i=0826,0830) /  4310,  4245,  4179,  4176,  4238/
+data    (gchtab(i), i=0831,0835) /  4301,  4492,  4812,  5005,  5070/
+data    (gchtab(i), i=0836,0840) /  5136,  5139,  5077,  5014,  4823/
+data    (gchtab(i), i=0841,0845) /  4503,   407,  4374,  4309,  4243/
+data    (gchtab(i), i=0846,0850) /  4240,  4302,  4365,  4492,   716/
+data    (gchtab(i), i=0851,0855) /  4941,  5006,  5072,  5075,  5013/
+data    (gchtab(i), i=0856,0860) /  4950,  4823,   348,  4892,   327/
+data    (gchtab(i), i=0861,0865) /  4871,     0,   220,  4295,   284/
+data    (gchtab(i), i=0866,0870) /  4359,    28,  5084,  5078,  5020/
+data    (gchtab(i), i=0871,0875) /     7,  4551,     0,   608,  4224/
+data    (gchtab(i), i=0876,0880) /   992,  4608,   147,  5139,    77/
+data    (gchtab(i), i=0881,0885) /  5069,     0,   160,  4224,   544/
+data    (gchtab(i), i=0886,0890) /  4608,     0,    28,  4615,    92/
+data    (gchtab(i), i=0891,0895) /  4617,  1052,  4615,    28,  5148/
+data    (gchtab(i), i=0896,0900) /    91,  5083,     0,    35,     0/
+data    (gchtab(i), i=0901,0905) /   540,  4167,   540,  5063,   537/
+data    (gchtab(i), i=0906,0910) /  4999,     7,  4423,   711,  5191/
+data    (gchtab(i), i=0911,0915) /     0,   278,  4505,  4630,    83/
+data    (gchtab(i), i=0916,0920) /  4504,  4819,   408,  4487,     0/
+data    (gchtab(i), i=0921,0925) /   266,  4487,  4618,    77,  4488/
+data    (gchtab(i), i=0926,0930) /  4813,   409,  4488,     0,   540/
+data    (gchtab(i), i=0931,0935) /  4443,  4313,  4247,  4179,  4176/
+data    (gchtab(i), i=0936,0940) /  4236,  4298,  4424,  4615,  4743/
+data    (gchtab(i), i=0941,0945) /  4936,  5066,  5132,  5200,  5203/
+data    (gchtab(i), i=0946,0950) /  5143,  5081,  4955,  4764,  4636/
+data    (gchtab(i), i=0951,0955) /   540,  4507,  4377,  4311,  4243/
+data    (gchtab(i), i=0956,0960) /  4240,  4300,  4362,  4488,  4615/
+data    (gchtab(i), i=0961,0965) /   647,  4872,  5002,  5068,  5136/
+data    (gchtab(i), i=0966,0970) /  5139,  5079,  5017,  4891,  4764/
+data    (gchtab(i), i=0971,0975) /     0,   220,  4295,   284,  4359/
+data    (gchtab(i), i=0976,0980) /  1052,  5127,  1116,  5191,    28/
+data    (gchtab(i), i=0981,0985) /  5404,     7,  4551,   839,  5383/
+data    (gchtab(i), i=0986,0990) /     0,   540,  4443,  4313,  4247/
+data    (gchtab(i), i=0991,0995) /  4179,  4176,  4236,  4298,  4424/
+data    (gchtab(i), i=0996,1000) /  4615,  4743,  4936,  5066,  5132/
+data    (gchtab(i), i=1001,1005) /  5200,  5203,  5143,  5081,  4955/
+data    (gchtab(i), i=1006,1010) /  4764,  4636,   540,  4507,  4377/
+data    (gchtab(i), i=1011,1015) /  4311,  4243,  4240,  4300,  4362/
+data    (gchtab(i), i=1016,1020) /  4488,  4615,   647,  4872,  5002/
+data    (gchtab(i), i=1021,1025) /  5068,  5136,  5139,  5079,  5017/
+data    (gchtab(i), i=1026,1030) /  4891,  4764,   405,  4494,   789/
+data    (gchtab(i), i=1031,1035) /  4878,   402,  4882,   401,  4881/
+data    (gchtab(i), i=1036,1040) /     0,  1244,  4167,   412,  4634/
+data    (gchtab(i), i=1041,1045) /  4632,  4566,  4437,  4309,  4183/
+data    (gchtab(i), i=1046,1050) /  4185,  4251,  4380,  4508,  4635/
+data    (gchtab(i), i=1051,1055) /  4826,  5018,  5211,  5340,   974/
+data    (gchtab(i), i=1056,1060) /  4941,  4875,  4873,  4999,  5127/
+data    (gchtab(i), i=1061,1065) /  5256,  5322,  5324,  5198,  5070/
+data    (gchtab(i), i=1066,1070) /     0,    92,  4626,  4103,    28/
+data    (gchtab(i), i=1071,1075) /  4562,    28,  5084,  5142,  5020/
+data    (gchtab(i), i=1076,1080) /    72,  5000,     7,  5063,  5133/
+data    (gchtab(i), i=1081,1085) /  4999,     0,   160,  4224,   544/
+data    (gchtab(i), i=1086,1090) /  4608,     0,    23,  4121,  4187/
+data    (gchtab(i), i=1091,1095) /  4252,  4380,  4443,  4505,  4565/
+data    (gchtab(i), i=1096,1100) /  4551,    25,  4251,  4379,  4505/
+data    (gchtab(i), i=1101,1105) /   983,  5081,  5019,  4956,  4828/
+data    (gchtab(i), i=1106,1110) /  4763,  4697,  4629,  4615,   985/
+data    (gchtab(i), i=1111,1115) /  4955,  4827,  4697,   263,  4807/
+data    (gchtab(i), i=1116,1120) /     0,   473,  4167,   601,  5063/
+data    (gchtab(i), i=1121,1125) /   537,  4999,   205,  4877,     7/
+data    (gchtab(i), i=1126,1130) /  4423,   711,  5191,   480,  4447/
+data    (gchtab(i), i=1131,1135) /  4381,  4379,  4441,  4568,  4696/
+data    (gchtab(i), i=1136,1140) /  4825,  4891,  4893,  4831,  4704/
+data    (gchtab(i), i=1141,1145) /  4576,     0,    74,  4231,  4487/
+data    (gchtab(i), i=1146,1150) /  4363,  4239,  4178,  4182,  4249/
+data    (gchtab(i), i=1151,1155) /  4379,  4572,  4828,  5019,  5145/
+data    (gchtab(i), i=1156,1160) /  5206,  5202,  5135,  5003,  4871/
+data    (gchtab(i), i=1161,1165) /  5127,  5194,   267,  4302,  4242/
+data    (gchtab(i), i=1166,1170) /  4246,  4313,  4443,  4572,   732/
+data    (gchtab(i), i=1171,1175) /  4955,  5081,  5142,  5138,  5070/
+data    (gchtab(i), i=1176,1180) /  5003,   136,  4424,   840,  5128/
+data    (gchtab(i), i=1181,1185) /     0,   157,  4184,  1117,  5144/
+data    (gchtab(i), i=1186,1190) /   404,  4431,   852,  4879,   139/
+data    (gchtab(i), i=1191,1195) /  4166,  1099,  5126,   155,  5147/
+data    (gchtab(i), i=1196,1200) /   154,  5146,   402,  4882,   401/
+data    (gchtab(i), i=1201,1205) /  4881,   137,  5129,   136,  5128/
+data    (gchtab(i), i=1206,1210) /     0,   604,  4679,   668,  4743/
+data    (gchtab(i), i=1211,1215) /    21,  4182,  4309,  4369,  4431/
+data    (gchtab(i), i=1216,1220) /  4494,  4621,    86,  4245,  4305/
+data    (gchtab(i), i=1221,1225) /  4367,  4430,  4621,  4813,  5006/
+data    (gchtab(i), i=1226,1230) /  5071,  5137,  5205,  5270,   717/
+data    (gchtab(i), i=1231,1235) /  4942,  5007,  5073,  5141,  5270/
+data    (gchtab(i), i=1236,1240) /  5333,   412,  4956,   391,  4935/
+data    (gchtab(i), i=1241,1245) /     0,    35,     0,   160,  4224/
+data    (gchtab(i), i=1246,1250) /   224,  4288,   160,  4704,   128/
+data    (gchtab(i), i=1251,1255) /  4672,     0,    28,  4868,     0/
+data    (gchtab(i), i=1256,1260) /   480,  4544,   544,  4608,    96/
+data    (gchtab(i), i=1261,1265) /  4640,    64,  4608,     0,    35/
+data    (gchtab(i), i=1266,1270) /     0,  1106,  5392,  5198,   917/
+data    (gchtab(i), i=1271,1275) /  5328,  5003,   144,  5328,     0/
+data    (gchtab(i), i=1276,1280) /    85,  4437,  4809,   277,  4807/
+data    (gchtab(i), i=1281,1285) /  1312,  4807,     0,   533,  4436/
+data    (gchtab(i), i=1286,1290) /  4306,  4240,  4173,  4170,  4232/
+data    (gchtab(i), i=1291,1295) /  4423,  4551,  4680,  4875,  5006/
+data    (gchtab(i), i=1296,1300) /  5138,  5205,   533,  4500,  4370/
+data    (gchtab(i), i=1301,1305) /  4304,  4237,  4234,  4296,  4423/
+data    (gchtab(i), i=1306,1310) /   533,  4757,  4884,  4946,  5066/
+data    (gchtab(i), i=1311,1315) /  5128,  5191,   661,  4820,  4882/
+data    (gchtab(i), i=1316,1320) /  5002,  5064,  5191,  5255,     0/
+data    (gchtab(i), i=1321,1325) /   732,  4635,  4505,  4373,  4306/
+data    (gchtab(i), i=1326,1330) /  4238,  4168,  4096,   732,  4699/
+data    (gchtab(i), i=1331,1335) /  4569,  4437,  4370,  4302,  4232/
+data    (gchtab(i), i=1336,1340) /  4160,   732,  4956,  5083,  5146/
+data    (gchtab(i), i=1341,1345) /  5143,  5077,  5012,  4819,  4563/
+data    (gchtab(i), i=1346,1350) /   860,  5082,  5079,  5013,  4948/
+data    (gchtab(i), i=1351,1355) /  4819,   467,  4818,  4944,  5006/
+data    (gchtab(i), i=1356,1360) /  5003,  4937,  4872,  4679,  4551/
+data    (gchtab(i), i=1361,1365) /  4424,  4361,  4300,   467,  4754/
+data    (gchtab(i), i=1366,1370) /  4880,  4942,  4939,  4873,  4808/
+data    (gchtab(i), i=1371,1375) /  4679,     0,    21,  4245,  4372/
+data    (gchtab(i), i=1376,1380) /  4434,  4739,  4801,  4864,   149/
+data    (gchtab(i), i=1381,1385) /  4308,  4370,  4675,  4737,  4864/
+data    (gchtab(i), i=1386,1390) /  4992,   981,  5011,  4880,  4229/
+data    (gchtab(i), i=1391,1395) /  4098,  4096,     0,   724,  4693/
+data    (gchtab(i), i=1396,1400) /  4565,  4372,  4241,  4174,  4171/
+data    (gchtab(i), i=1401,1405) /  4233,  4296,  4423,  4551,  4744/
+data    (gchtab(i), i=1406,1410) /  4875,  4942,  4945,  4883,  4632/
+data    (gchtab(i), i=1411,1415) /  4570,  4572,  4637,  4765,  4892/
+data    (gchtab(i), i=1416,1420) /  5018,   469,  4436,  4305,  4238/
+data    (gchtab(i), i=1421,1425) /  4234,  4296,   455,  4680,  4811/
+data    (gchtab(i), i=1426,1430) /  4878,  4882,  4820,  4695,  4633/
+data    (gchtab(i), i=1431,1435) /  4635,  4700,  4828,  5018,     0/
+data    (gchtab(i), i=1436,1440) /   850,  4820,  4693,  4437,  4308/
+data    (gchtab(i), i=1441,1445) /  4306,  4432,  4623,   341,  4372/
+data    (gchtab(i), i=1446,1450) /  4370,  4496,  4623,   527,  4302/
+data    (gchtab(i), i=1451,1455) /  4172,  4170,  4232,  4423,  4615/
+data    (gchtab(i), i=1456,1460) /  4744,  4874,   527,  4366,  4236/
+data    (gchtab(i), i=1461,1465) /  4234,  4296,  4423,     0,   404/
+data    (gchtab(i), i=1466,1470) /  4371,  4241,  4174,  4171,  4233/
+data    (gchtab(i), i=1471,1475) /  4296,  4423,  4615,  4808,  5002/
+data    (gchtab(i), i=1476,1480) /  5133,  5200,  5203,  5077,  4949/
+data    (gchtab(i), i=1481,1485) /  4819,  4687,  4554,  4352,    75/
+data    (gchtab(i), i=1486,1490) /  4297,  4424,  4616,  4809,  5003/
+data    (gchtab(i), i=1491,1495) /  5133,  1107,  5076,  4948,  4818/
+data    (gchtab(i), i=1496,1500) /  4687,  4553,  4416,     0,    18/
+data    (gchtab(i), i=1501,1505) /  4180,  4309,  4437,  4564,  4627/
+data    (gchtab(i), i=1506,1510) /  4688,  4684,  4616,  4416,    19/
+data    (gchtab(i), i=1511,1515) /  4244,  4500,  4627,  1045,  5074/
+data    (gchtab(i), i=1516,1520) /  5008,  4681,  4484,  4352,   981/
+data    (gchtab(i), i=1521,1525) /  5010,  4944,  4681,     0,    17/
+data    (gchtab(i), i=1526,1530) /  4115,  4245,  4437,  4500,  4498/
+data    (gchtab(i), i=1531,1535) /  4430,  4295,   277,  4436,  4434/
+data    (gchtab(i), i=1536,1540) /  4366,  4231,   334,  4562,  4692/
+data    (gchtab(i), i=1541,1545) /  4821,  4949,  5076,  5139,  5136/
+data    (gchtab(i), i=1546,1550) /  5067,  4864,   853,  5075,  5072/
+data    (gchtab(i), i=1551,1555) /  5003,  4800,     0,   277,  4238/
+data    (gchtab(i), i=1556,1560) /  4170,  4168,  4231,  4423,  4553/
+data    (gchtab(i), i=1561,1565) /  4619,   341,  4302,  4234,  4232/
+data    (gchtab(i), i=1566,1570) /  4295,     0,   848,  4883,  4820/
+data    (gchtab(i), i=1571,1575) /  4693,  4565,  4372,  4241,  4174/
+data    (gchtab(i), i=1576,1580) /  4171,  4233,  4296,  4423,  4551/
+data    (gchtab(i), i=1581,1585) /  4744,  4874,  4941,  5010,  5015/
+data    (gchtab(i), i=1586,1590) /  4954,  4891,  4764,  4572,  4443/
+data    (gchtab(i), i=1591,1595) /  4378,  4377,  4441,  4442,   469/
+data    (gchtab(i), i=1596,1600) /  4436,  4305,  4238,  4234,  4296/
+data    (gchtab(i), i=1601,1605) /   455,  4680,  4810,  4877,  4946/
+data    (gchtab(i), i=1606,1610) /  4951,  4890,  4764,     0,   277/
+data    (gchtab(i), i=1611,1615) /  4103,   341,  4167,   917,  5076/
+data    (gchtab(i), i=1616,1620) /  5140,  5077,  4949,  4820,  4560/
+data    (gchtab(i), i=1621,1625) /  4431,  4303,   335,  4558,  4680/
+data    (gchtab(i), i=1626,1630) /  4743,   335,  4494,  4616,  4679/
+data    (gchtab(i), i=1631,1635) /  4807,  4936,  5067,     0,    92/
+data    (gchtab(i), i=1636,1640) /  4316,  4443,  4506,  4568,  4938/
+data    (gchtab(i), i=1641,1645) /  5000,  5063,   220,  4442,  4504/
+data    (gchtab(i), i=1646,1650) /  4874,  4936,  5063,  5127,   533/
+data    (gchtab(i), i=1651,1655) /  4103,   533,  4167,     0,   341/
+data    (gchtab(i), i=1656,1660) /  4096,   405,  4096,   338,  4364/
+data    (gchtab(i), i=1661,1665) /  4361,  4487,  4615,  4744,  4874/
+data    (gchtab(i), i=1666,1670) /  5005,  1045,  4938,  4936,  4999/
+data    (gchtab(i), i=1671,1675) /  5191,  5321,  5387,  1109,  5002/
+data    (gchtab(i), i=1676,1680) /  5000,  5063,     0,   277,  4231/
+data    (gchtab(i), i=1681,1685) /   341,  4367,  4298,  4231,   981/
+data    (gchtab(i), i=1686,1690) /  5009,  4877,  1045,  5074,  5008/
+data    (gchtab(i), i=1691,1695) /  4877,  4747,  4553,  4424,  4231/
+data    (gchtab(i), i=1696,1700) /    85,  4437,     0,   469,  4372/
+data    (gchtab(i), i=1701,1705) /  4241,  4174,  4171,  4233,  4296/
+data    (gchtab(i), i=1706,1710) /  4423,  4551,  4744,  4875,  4942/
+data    (gchtab(i), i=1711,1715) /  4945,  4883,  4820,  4693,  4565/
+data    (gchtab(i), i=1716,1720) /   469,  4436,  4305,  4238,  4234/
+data    (gchtab(i), i=1721,1725) /  4296,   455,  4680,  4811,  4878/
+data    (gchtab(i), i=1726,1730) /  4882,  4820,     0,   468,  4295/
+data    (gchtab(i), i=1731,1735) /   468,  4359,   852,  4935,   852/
+data    (gchtab(i), i=1736,1740) /  4999,    18,  4244,  4437,  5269/
+data    (gchtab(i), i=1741,1745) /    18,  4243,  4436,  5268,     0/
+data    (gchtab(i), i=1746,1750) /    17,  4115,  4245,  4437,  4500/
+data    (gchtab(i), i=1751,1755) /  4498,  4429,  4426,  4488,  4551/
+data    (gchtab(i), i=1756,1760) /   277,  4436,  4434,  4365,  4362/
+data    (gchtab(i), i=1761,1765) /  4424,  4551,  4679,  4808,  4938/
+data    (gchtab(i), i=1766,1770) /  5069,  5136,  5205,  5209,  5147/
+data    (gchtab(i), i=1771,1775) /  5020,  4892,  4762,  4760,  4821/
+data    (gchtab(i), i=1776,1780) /  4946,  5072,  5262,   712,  4939/
+data    (gchtab(i), i=1781,1785) /  5005,  5072,  5141,  5145,  5083/
+data    (gchtab(i), i=1786,1790) /  5020,     0,   140,  4297,  4360/
+data    (gchtab(i), i=1791,1795) /  4487,  4615,  4808,  4939,  5006/
+data    (gchtab(i), i=1796,1800) /  5009,  4947,  4884,  4757,  4629/
+data    (gchtab(i), i=1801,1805) /  4436,  4305,  4238,  4096,   519/
+data    (gchtab(i), i=1806,1810) /  4744,  4875,  4942,  4946,  4884/
+data    (gchtab(i), i=1811,1815) /   533,  4500,  4369,  4302,  4096/
+data    (gchtab(i), i=1816,1820) /     0,  1109,  4565,  4372,  4241/
+data    (gchtab(i), i=1821,1825) /  4174,  4171,  4233,  4296,  4423/
+data    (gchtab(i), i=1826,1830) /  4551,  4744,  4875,  4942,  4945/
+data    (gchtab(i), i=1831,1835) /  4883,  4820,  4693,   469,  4436/
+data    (gchtab(i), i=1836,1840) /  4305,  4238,  4234,  4296,   455/
+data    (gchtab(i), i=1841,1845) /  4680,  4811,  4878,  4882,  4820/
+data    (gchtab(i), i=1846,1850) /   724,  5204,     0,   596,  4487/
+data    (gchtab(i), i=1851,1855) /   596,  4551,    18,  4244,  4437/
+data    (gchtab(i), i=1856,1860) /  5141,    18,  4243,  4436,  5140/
+data    (gchtab(i), i=1861,1865) /     0,    17,  4115,  4245,  4437/
+data    (gchtab(i), i=1866,1870) /  4500,  4498,  4364,  4361,  4487/
+data    (gchtab(i), i=1871,1875) /   277,  4436,  4434,  4300,  4297/
+data    (gchtab(i), i=1876,1880) /  4360,  4487,  4551,  4744,  4874/
+data    (gchtab(i), i=1881,1885) /  5005,  5072,  5075,  5013,  4948/
+data    (gchtab(i), i=1886,1890) /  5011,  5072,   909,  5075,     0/
+data    (gchtab(i), i=1891,1895) /    35,     0,   145,  4371,  4564/
+data    (gchtab(i), i=1896,1900) /  4501,  4372,  4241,  4174,  4171/
+data    (gchtab(i), i=1901,1905) /  4232,  4295,  4423,  4552,  4683/
+data    (gchtab(i), i=1906,1910) /  4750,    75,  4233,  4296,  4424/
+data    (gchtab(i), i=1911,1915) /  4553,  4683,   590,  4683,  4744/
+data    (gchtab(i), i=1916,1920) /  4807,  4935,  5064,  5195,  5262/
+data    (gchtab(i), i=1921,1925) /  5265,  5204,  5141,  5076,  5203/
+data    (gchtab(i), i=1926,1930) /  5265,   587,  4745,  4808,  4936/
+data    (gchtab(i), i=1931,1935) /  5065,  5195,     0,   604,  4571/
+data    (gchtab(i), i=1936,1940) /  4506,  4505,  4568,  4759,  4951/
+data    (gchtab(i), i=1941,1945) /   663,  4502,  4373,  4307,  4305/
+data    (gchtab(i), i=1946,1950) /  4431,  4622,  4814,   663,  4566/
+data    (gchtab(i), i=1951,1955) /  4437,  4371,  4369,  4495,  4622/
+data    (gchtab(i), i=1956,1960) /   526,  4365,  4236,  4170,  4168/
+data    (gchtab(i), i=1961,1965) /  4294,  4612,  4675,  4673,  4544/
+data    (gchtab(i), i=1966,1970) /  4416,   526,  4429,  4300,  4234/
+data    (gchtab(i), i=1971,1975) /  4232,  4358,  4612,     0,   860/
+data    (gchtab(i), i=1976,1980) /  4544,   924,  4480,    17,  4115/
+data    (gchtab(i), i=1981,1985) /  4245,  4437,  4500,  4498,  4429/
+data    (gchtab(i), i=1986,1990) /  4426,  4552,  4744,  4873,  5068/
+data    (gchtab(i), i=1991,1995) /  5199,   277,  4436,  4434,  4365/
+data    (gchtab(i), i=1996,2000) /  4362,  4424,  4551,  4743,  4872/
+data    (gchtab(i), i=2001,2005) /  5002,  5133,  5199,  5333,     0/
+data    (gchtab(i), i=2006,2010) /   604,  4571,  4506,  4505,  4568/
+data    (gchtab(i), i=2011,2015) /  4759,  5079,  5080,  4887,  4629/
+data    (gchtab(i), i=2016,2020) /  4435,  4240,  4173,  4171,  4233/
+data    (gchtab(i), i=2021,2025) /  4423,  4613,  4675,  4673,  4608/
+data    (gchtab(i), i=2026,2030) /  4480,  4417,   662,  4499,  4304/
+data    (gchtab(i), i=2031,2035) /  4237,  4235,  4297,  4423,     0/
+data    (gchtab(i), i=2036,2040) /   480,  4447,  4382,  4316,  4314/
+data    (gchtab(i), i=2041,2045) /  4376,  4439,  4501,  4499,  4369/
+data    (gchtab(i), i=2046,2050) /   351,  4381,  4379,  4441,  4504/
+data    (gchtab(i), i=2051,2055) /  4566,  4564,  4498,  4240,  4494/
+data    (gchtab(i), i=2056,2060) /  4556,  4554,  4488,  4423,  4357/
+data    (gchtab(i), i=2061,2065) /  4355,  4417,   271,  4493,  4491/
+data    (gchtab(i), i=2066,2070) /  4425,  4360,  4294,  4292,  4354/
+data    (gchtab(i), i=2071,2075) /  4417,  4544,     0,   160,  4224/
+data    (gchtab(i), i=2076,2080) /   544,  4608,     0,   224,  4447/
+data    (gchtab(i), i=2081,2085) /  4510,  4572,  4570,  4504,  4439/
+data    (gchtab(i), i=2086,2090) /  4373,  4371,  4497,   351,  4509/
+data    (gchtab(i), i=2091,2095) /  4507,  4441,  4376,  4310,  4308/
+data    (gchtab(i), i=2096,2100) /  4370,  4624,  4366,  4300,  4298/
+data    (gchtab(i), i=2101,2105) /  4360,  4423,  4485,  4483,  4417/
+data    (gchtab(i), i=2106,2110) /   399,  4365,  4363,  4425,  4488/
+data    (gchtab(i), i=2111,2115) /  4550,  4548,  4482,  4417,  4288/
+data    (gchtab(i), i=2116,2120) /     0,   338,  4240,  4430,   533/
+data    (gchtab(i), i=2121,2125) /  4304,  4619,   208,  5392,     0/
+data    (gchtab(i), i=2126,2130) /   284,  4251,  4185,  4183,  4245/
+data    (gchtab(i), i=2131,2135) /  4372,  4500,  4629,  4695,  4697/
+data    (gchtab(i), i=2136,2139) /  4635,  4508,  4380,     0/
diff --git a/sys/gio/fonts/greekc.txt b/sys/gio/fonts/greekc.txt
new file mode 100644
index 00000000..3dbbf454
--- /dev/null
+++ b/sys/gio/fonts/greekc.txt
@@ -0,0 +1,96 @@
+2199
+2214
+2213
+2275
+2274
+2271
+2272
+2251
+2221
+2222
+8004
+8002
+8063
+8003
+2210
+8089
+2200
+2201
+2202
+2203
+2204
+2205
+2206
+2207
+2208
+2209
+8081
+2213
+8007
+8033
+8008
+8032
+2273
+2078
+8064
+2199
+2030
+8073
+2047
+2029
+733
+8090
+8079
+2199
+2037
+8075
+8077
+2041
+2042
+2034
+2271
+2044
+8090
+2046
+2078
+2050
+2040
+2049
+2199
+2223
+804
+2224
+2199
+8074
+8067
+2127
+2128
+2148
+2130
+2131
+2147
+2129
+2133
+2135
+8078
+2136
+2137
+2138
+2139
+2141
+2142
+2134
+2143
+2144
+2145
+2146
+2199
+2150
+2140
+2149
+2132
+2225
+8090
+2226
+8076
+2218
diff --git a/sys/gio/fonts/mkfont.c b/sys/gio/fonts/mkfont.c
new file mode 100644
index 00000000..841d99f5
--- /dev/null
+++ b/sys/gio/fonts/mkfont.c
@@ -0,0 +1,199 @@
+#include <stdio.h>
+
+#define	DEBUG		0
+#define	MASK		0x3F
+#define	SCALE		1.0
+
+#define max(a,b)		(a > b ? a : b)
+#define min(a,b)		(a < b ? a : b)
+/*
+#define	XCOORD()		((*dp - 'R') + 9)
+#define	YCOORD()		(('R' - *dp) + 14)
+#define	XCOORD()	(max(0,min(20,((int)(((*dp - 'R') + 9)*SCALE+0.5)))))
+#define	XCOORD()	(max(0,min(20,((int)(((*dp - 'R') - minx)*SCALE+0.5)))))
+#define	YCOORD()	((int)((('R' - *dp) + 13) * SCALE + 0.5))
+#define	XCOORD()	((int)(((*dp - 'R') - minx) * SCALE + 0.5))
+#define	YCOORD()	(max(0,min(32,(((int)(('R' - *dp) + 13)*SCALE+0.5)))))
+*/
+#define	XCOORD()	(max(0,((int)(((*dp - 'R') - minx - 2) * SCALE + 0.5))))
+#define	YCOORD()	(max(0,min(35,(((int)(('R' - *dp) + 16)*SCALE+0.5)))))
+#define ENCODE(pen,x,y) ((int)(((pen<<12)|((x&MASK)<<6))|(y&MASK)))
+
+int 	chridx[200];		/* Character index table	*/
+int 	chrwid[200];		/* Character width table	*/
+int 	chrtab[5000];		/* Character stroke table	*/
+
+
+struct hershey_tab {
+    int   num;                  /* hershey number       */
+    int   length;               /* length               */
+    char  *code;                /* stroke data string   */
+} htab[] = {
+#include "hershey.dat"
+};
+
+int	encode();
+
+
+main (argc, argv)
+int	argc;
+char 	*argv[];
+{
+	register int i=0;
+	int	minx, maxx, charnum=0, idx=0, hnum, hindex, hlength;
+	short	x, y, pen, xspace, yspace;
+	char 	ch, *dp, *data;
+
+	/* Read all the hershey numbers from standard input and build up a
+	 * table of stroke data.
+	 */
+	ch = 32;
+	while (scanf ("%d", &hnum) != EOF) {
+
+	    chridx[charnum] = idx + 1;
+
+	    /* Get the index for the given number. */
+	    for (hindex=0; hnum != htab[hindex].num; hindex++)
+		;
+
+	    hlength = htab[hindex].length;
+	    dp = data = htab[hindex].code;
+
+	    if (DEBUG)
+		printf ("'%c' %4d: index=%4d len=%3d dlen=%3d %s\n",
+		    ch, hnum, hindex, hlength, strlen(data),
+		    (strlen(data) % 2) ? "ERROR" : "");
+
+	    /* Now decode the stroke data into X-Y pairs, first pair is for
+	     * proportional spacing.
+	     */
+	    minx = (*dp - 'R'); dp++;
+	    maxx = (*dp - 'R'); dp++;
+	    chrwid[charnum++] = min (32, maxx - minx + 5);
+
+	    if (DEBUG) printf("\twidth (%02d) (%d,%d)\n", maxx-minx,minx,maxx);
+
+	    /* Next pair is the initial move.  The Y coords are flipped
+	     * for what we need so fix that every place we get a Yval.
+	     */
+	    pen = 0;
+	    x = XCOORD(); dp++;
+x = (ch == '1' ? x-3: x);
+	    y = YCOORD(); dp++;
+	    chrtab[idx++] = ENCODE(pen, x, y);
+
+	    if (DEBUG) printf ("\tmove (%3d,%3d) '%s'\n", x, y, dp);
+
+	    /* The remainder of the codes are move/draw strokes.
+	     */
+	    for (i=0; i < (hlength-2); i++) {
+		if (*dp == ' ') {
+		    pen = 0;
+		    x = XCOORD(); dp++;	/* skip pen-up coords */
+x = (ch == '1' ? x-3: x);
+		    y = YCOORD(); dp++;
+		    i++;
+		} else
+		    pen = 1;
+		x = XCOORD(); dp++;
+x = (ch == '1' ? x-3: x);
+		y = YCOORD(); dp++;
+
+		chrtab[idx++] = ENCODE(pen, x, y);
+
+	        if (DEBUG) 
+		    printf("\t%s (%3d,%3d) => %6d\n",
+			pen?"draw":"move", x, y, ENCODE(pen,x,y));
+	    }
+	    chrtab[idx++] = ENCODE(0, 0, 0);
+	    ch++;
+	}
+
+	print_prologue (charnum, idx);
+	print_index (chridx, charnum);
+	printf ("\n\n# Width data.\n\n");
+	print_widths (chrwid, charnum);
+	printf ("\n\n# Stroke data.\n\n");
+	print_strokes (chrtab, idx);
+}
+
+
+print_index (idxtab, N)
+int	*idxtab, N;
+{
+	register int i, j, start=1, end=5;
+
+	for (i=0; i < N; ) {
+	    printf ("data    (chridx(i), i=%03d,%03d) /", start, min(N,end));
+	    for (j=0; j < 5 && i < N; j++)
+		printf ("%5d%c", idxtab[i++], (j<4 && i<N ? ',' : '/'));
+	    printf ("\n");
+	    start = end + 1;
+	    end += 5;
+	}
+}
+
+
+print_widths (wtab, N)
+int	*wtab, N;
+{
+	register int i, j, start=1, end=5;
+
+	for (i=0; i < N; ) {
+	    printf ("data    (chrwid(i), i=%03d,%03d) /", start, min(N,end));
+	    for (j=0; j < 5 && i < N; j++)
+		printf ("%5d%c", wtab[i++], (j<4 && i<N ? ',' : '/'));
+	    printf ("\n");
+	    start = end + 1;
+	    end += 5;
+	}
+}
+
+
+print_strokes (strtab, N)
+int	*strtab, N;
+{
+	register int i, j, start=1, end=5;
+
+	for (i=0; i < N; ) {
+	    printf ("data    (chrtab(i), i=%04d,%04d) /", start, min(N,end));
+	    for (j=0; j < 5 && i < N; j++)
+		printf ("%6d%c", strtab[i++], (j<4 && i<N ? ',' : '/'));
+	    printf ("\n");
+	    start = end + 1;
+	    end += 5;
+	}
+}
+
+
+print_prologue(nidx, nchar)
+int	nidx;
+int	nchar;
+{
+
+printf ("# CHRTAB -- Table of strokes for the printable ASCII characters.  Each\n");
+printf ("# character is encoded as a series of strokes.  Each stroke is ex-\n");
+printf ("# pressed by a single integer containing the following bitfields:\n");
+printf ("#\n");
+printf ("#       2                   1\n");
+printf ("#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1\n");
+printf ("#                 | | | |         | |         |\n");
+printf ("#                 | | | +---------+ +---------+\n");
+printf ("#                 | | |      |           |\n");
+printf ("#                 | | |      X           Y\n");
+printf ("#                 | | |\n");
+printf ("#                 | | +-- pen up/down\n");
+printf ("#                 | +---- begin paint (not used at present)\n");
+printf ("#                 +------ end paint (not used at present)\n");
+printf ("#\n");
+printf ("#----------------------------------------------------------------------------\n");
+printf ("\n");
+printf ("# Define the database.\n");
+printf ("\n");
+printf ("short   chridx[%d]\t# character index in chrtab\n", nidx+1);
+printf ("short   chrwid[%d]\t# character width table\n", nidx+1);
+printf ("short   chrtab[%d]\t# stroke data to draw the characters\n", nchar+1);
+printf ("\n");
+printf ("# Index into CHRTAB of each printable character (starting with SP)\n");
+printf ("\n");
+}
diff --git a/sys/gio/fpequald.x b/sys/gio/fpequald.x
new file mode 100644
index 00000000..ba6f75a2
--- /dev/null
+++ b/sys/gio/fpequald.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_EQUALD -- The following procedure is used to compare two double precision
+# numbers for equality to within the machine precision for doubles.  A simple
+# comparison of the difference of the two numbers with the machine epsilon
+# does not suffice unless the numbers are first normalized to near 1.0, the
+# constant used to compute the machine epsilon (epsilon is the smallest number
+# such that 1.0 + epsilon > 1.0).
+
+bool procedure fp_equald (x, y)
+
+double	x, y
+double	x1, x2, normx, normy, tol
+int	ex, ey
+
+begin
+	# Check for the obvious first.
+	if (x == y)
+	    return (true)
+
+	# We can't normalize zero, so handle the zero operand cases first.
+	# Note that the case 0 equals 0 is handled above.
+
+	if (x == 0.0D0 || y == 0.0D0)
+	    return (false)
+
+	# Normalize operands and do an epsilon compare.
+	call fp_normd (x, normx, ex)
+	call fp_normd (y, normy, ey)
+
+	if (ex != ey)
+	    return (false)
+	else {
+	    tol = EPSILOND * 32.0D0
+	    x1 = 1.0D0 + abs (normx - normy)
+	    x2 = 1.0D0 + tol
+	    return (x1 <= x2)
+	}
+end
diff --git a/sys/gio/fpequalr.x b/sys/gio/fpequalr.x
new file mode 100644
index 00000000..8e9a9354
--- /dev/null
+++ b/sys/gio/fpequalr.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_EQUALR -- The following procedure is used to compare two single precision
+# numbers for equality to within the machine precision for single.  A simple
+# comparison of the difference of the two numbers with the machine epsilon
+# does not suffice unless the numbers are first normalized to near 1.0, the
+# constant used to compute the machine epsilon (epsilon is the smallest number
+# such that 1.0 + epsilon > 1.0).
+
+bool procedure fp_equalr (x, y)
+
+real	x, y
+real	x1, x2, normx, normy, tol
+int	ex, ey
+
+begin
+	# Check for the obvious first.
+	if (x == y)
+	    return (true)
+
+	# We can't normalize zero, so handle the zero operand cases first.
+	# Note that the case 0 equals 0 is handled above.
+
+	if (x == 0.0D0 || y == 0.0D0)
+	    return (false)
+
+	# Normalize operands and do an epsilon compare.
+	call fp_normr (x, normx, ex)
+	call fp_normr (y, normy, ey)
+
+	if (ex != ey)
+	    return (false)
+	else {
+	    tol = EPSILONR * 32.0
+	    x1 = 1.0E0 + abs (normx - normy)
+	    x2 = 1.0E0 + tol
+	    return (x1 <= x2)
+	}
+end
diff --git a/sys/gio/fpfixd.x b/sys/gio/fpfixd.x
new file mode 100644
index 00000000..64a2f544
--- /dev/null
+++ b/sys/gio/fpfixd.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_FIXD -- The following procedure is equivalent to "int(x)", except that
+# it preserves the most significant digits of x, when x is greater than the
+# largest integer.  For example, if an integer is 32 bits and X has a 58 bit
+# mantissa, "int(x)" would cause nearly half the precision to be lost.
+# 
+# Algorithm (x is assumed nonnegative):
+#    (1) find high, low x such that  x = highx + lowx
+#	and highx contains the extra digits of precision.
+#    (2) subtract highx from x, and truncate the residual by assignment
+#	into a long integer.
+#    (3) add truncated lowx and highx to get high precision truncated
+#	double result.
+
+double procedure fp_fixd (x)
+
+double	x
+double	absx, highx, scaledx
+int	expon
+long	longx, lowx
+
+begin
+	absx = abs (x)
+	scaledx = absx
+	expon = 0
+
+	while (scaledx > MAX_LONG) {
+	    scaledx = scaledx / 10.0D0
+	    expon = expon + 1
+	}
+
+	longx = scaledx
+	highx = longx * (10.0D0 ** expon)
+	lowx = absx - highx
+
+	if (x > 0)
+	    return (highx + lowx)
+	else
+	    return (-highx - lowx)
+end
diff --git a/sys/gio/fpfixr.x b/sys/gio/fpfixr.x
new file mode 100644
index 00000000..fe67c5b8
--- /dev/null
+++ b/sys/gio/fpfixr.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_FIXR -- The following procedure is equivalent to "int(x)", except that
+# it preserves the most significant digits of x, when x is greater than the
+# largest integer.  For example, if an integer is 32 bits and X has a 58 bit
+# mantissa, "int(x)" would cause nearly half the precision to be lost.
+# 
+# Algorithm (x is assumed nonnegative):
+#    (1) find high, low x such that  x = highx + lowx
+#	and highx contains the extra digits of precision.
+#    (2) subtract highx from x, and truncate the residual by assignment
+#	into a long integer.
+#    (3) add truncated lowx and highx to get high precision truncated
+#	real or double result.
+
+real procedure fp_fixr (x)
+
+real	x
+real	absx, highx, scaledx
+int	expon
+long	longx, lowx
+
+begin
+	absx = abs (x)
+	scaledx = absx
+	expon = 0
+
+	while (scaledx > MAX_LONG) {
+	    scaledx = scaledx / 10.0E0
+	    expon = expon + 1
+	}
+
+	longx = scaledx
+	highx = longx * (10.0E0 ** expon)
+	lowx = absx - highx
+
+	if (x > 0)
+	    return (highx + lowx)
+	else
+	    return (-highx - lowx)
+end
diff --git a/sys/gio/fpndgr.x b/sys/gio/fpndgr.x
new file mode 100644
index 00000000..ae471e34
--- /dev/null
+++ b/sys/gio/fpndgr.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# FP_NONDEGENR -- If two floating point numbers are equivalent to within the
+# machine epsilon, adjust their values until a nondegenerate range is obtained.
+# The boolean function returns true if it has to MAKE the range nondegenerate,
+# i.e., if it modifies their values.
+
+bool procedure fp_nondegenr (x1, x2)
+
+real	x1, x2			# range to be adjusted
+int	n
+bool	fp_equalr()
+
+begin
+	for (n=0;  fp_equalr(x1,x2);  n=n+1) {
+	    x1 = x1 - max (abs(x1) * 0.01, 0.01)
+	    x2 = x2 + max (abs(x2) * 0.01, 0.01)
+	}
+
+	return (n > 0)
+end
diff --git a/sys/gio/fpnormd.x b/sys/gio/fpnormd.x
new file mode 100644
index 00000000..067ef1e0
--- /dev/null
+++ b/sys/gio/fpnormd.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_NORMD -- Normalize a double precision number x to the value NORMX, in the
+# range [1-10).  EXPON is returned such that  x = normx * (10.0d0 ** expon).
+
+procedure fp_normd (x, normx, expon)
+
+double	x			# number to be normalized
+double	normx			# X normalized to the range 1-10 (output)
+int	expon			# exponent of normalized X
+double	absx, tol
+
+begin
+	tol = EPSILOND * 10.0D0
+	absx = abs (x)
+	expon = 0
+
+	if (absx > 0) {
+	    while (absx < (1.0D0 - tol)) {
+		absx = absx * 10.0D0
+		expon = expon - 1
+		if (absx == 0.0D0) {	# check for underflow to zero
+		    normx = 0
+		    expon = 0
+		    return
+		}
+	    }
+	    while (absx >= (10.0D0 + tol)) {
+		absx = absx / 10.0D0
+		expon = expon + 1
+	    }
+	}
+
+	if (x < 0)
+	    normx = -absx
+	else
+	    normx = absx
+end
diff --git a/sys/gio/fpnormr.x b/sys/gio/fpnormr.x
new file mode 100644
index 00000000..45ad3f2a
--- /dev/null
+++ b/sys/gio/fpnormr.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# FP_NORMR -- Normalize a single precision number x to the value NORMX, in the
+# range [1-10).  EXPON is returned such that  x = normx * (10.0E0 ** expon).
+
+procedure fp_normr (x, normx, expon)
+
+real	x			# number to be normalized
+real	normx			# X normalized to the range 1-10 (output)
+int	expon			# exponent of normalized X
+real	absx, tol
+
+begin
+	tol = EPSILONR * 10.0
+	absx = abs (x)
+	expon = 0
+
+	if (absx > 0) {
+	    while (absx < (1.0E0 - tol)) {
+		absx = absx * 10.0E0
+		expon = expon - 1
+		if (absx == 0.0) {	# check for underflow to zero
+		    normx = 0
+		    expon = 0
+		    return
+		}
+	    }
+	    while (absx >= (10.0E0 + tol)) {
+		absx = absx / 10.0E0
+		expon = expon + 1
+	    }
+	}
+
+	if (x < 0)
+	    normx = -absx
+	else
+	    normx = absx
+end
diff --git a/sys/gio/gactivate.x b/sys/gio/gactivate.x
new file mode 100644
index 00000000..6d3c8da7
--- /dev/null
+++ b/sys/gio/gactivate.x
@@ -0,0 +1,72 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<fset.h>
+include <gset.h>
+include <gio.h>
+
+# GACTIVATE -- Perform the initial activation of the workstation, i.e.,
+# connect to the graphics kernel and issue the GKI_OPENWS instruction to
+# the kernel to physically open the workstation.
+
+procedure gactivate (gp, flags)
+
+pointer	gp			# graphics descriptor
+int	flags			# AW_ bit flags; zero if no flags
+
+int	junk, fd
+pointer	w, sp, devname
+
+extern	zardbf()
+int	fstati(), grdwcs(), and(), locpr()
+errchk	gki_openws, gki_getwcs, gki_reactivatews
+
+begin
+	# If WS has already been opened, just make sure it is activated.
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    if (and (GP_GFLAGS(gp), GF_WSACTIVE) == 0) {
+		call gki_reactivatews (GP_FD(gp), flags)
+		GP_GFLAGS(gp) = GP_GFLAGS(gp) + GF_WSACTIVE
+	    }
+	    return
+	}
+
+	call smark (sp)
+	call salloc (devname, SZ_PATHNAME, TY_CHAR)
+
+	fd = GP_FD(gp)
+
+	# Physically open and activate the workstation.  NOTE - the flags
+	# argument is currently ignored; this should be fixed at some point.
+	# The UI specification file name, if any, is passed as part of the
+	# logical device specification (a bit of a kludge, but it avoids
+	# changing the GKI datastream prototcol and hence obsoleting all the
+	# old graphics kernels).
+
+	if (GP_UIFNAME(gp) != EOS) {
+	    # gki_openws device = devname,uifname.
+	    call sprintf (Memc[devname], SZ_PATHNAME, "%s,%s")
+		call pargstr (GP_DEVNAME(gp))
+		call pargstr (GP_UIFNAME(gp))
+	} else
+	    call strcpy (GP_DEVNAME(gp), Memc[devname], SZ_PATHNAME)
+
+	call gki_openws (fd, Memc[devname], GP_ACMODE(gp))
+
+	# If the device is being opened in APPEND mode retrieve the WCS
+	# from either the GIO code in the CL process (if talking to a
+	# process the FIO driver will not be the standard binary file
+	# driver) or from an auxiliary file if the device output is being
+	# spooled in a metafile.
+
+	if (GP_ACMODE(gp) == APPEND) {
+	    w = GP_WCSPTR(gp,1)
+	    if (fstati (fd, F_DEVICE) != locpr (zardbf))
+		call gki_getwcs (fd, Memi[w], LEN_WCSARRAY)
+	    else iferr (junk = grdwcs(GP_DEVNAME(gp), Memi[w], LEN_WCSARRAY))
+		;
+	}
+
+	GP_GFLAGS(gp) = GP_GFLAGS(gp) + (GF_WSOPEN+GF_WSACTIVE)
+	call sfree (sp)
+end
diff --git a/sys/gio/gadraw.x b/sys/gio/gadraw.x
new file mode 100644
index 00000000..4d8ac8b8
--- /dev/null
+++ b/sys/gio/gadraw.x
@@ -0,0 +1,284 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+define	MOVE		0
+define	DRAW		1
+
+# GADRAW -- Draw absolute.  This is the primary line drawing primitive, used
+# to transform and clip polylines, polymarkers, and polygons (fill area).
+# Our function is to handle INDEFS, the normalization transformation, and
+# clipping, building up a polyline in GKI coordinates.  Each call processes
+# a point of the input polyline, adding zero, one, or two points to the output
+# clipped polyline, which is buffered internally in the static polyline buffer
+# PL.  Plotting an INDEF terminates the polyline and starts a new one, causing
+# a gap to appear in the plotted polyline.  Long polylines are broken up into
+# shorter polylines to simplify buffering.  The transformation parameters are
+# computed and cached in the GPL common for maximum efficiency.
+
+procedure gadraw (gp, wx, wy)
+
+pointer	gp			# graphics descriptor
+real	wx, wy			# absolute world coordinates of next point
+
+int	i
+real	x, y
+long	mx, my
+bool	inbounds
+include	"gpl.com"
+
+begin
+	# Update cached transformation parameters if device changes or cache
+	# is invalidated by setting gp_out to null.  If the WCS changes it
+	# is not necessary to flush the polyline but we must update the
+	# cached transformation parameters.
+
+	if (gp != gp_out) {
+	    call gpl_flush()
+	    call gpl_cache (gp)
+	} else if (GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+
+	# Break polyline (visible break in the plotted line) if point is
+	# indefinite.
+
+	if (IS_INDEFR(wx) || IS_INDEFR(wy)) {
+	    call gamove (gp, wx, wy)
+	    return
+	}
+
+	# Transform point (wx,wy) to long integer NDC coordinates in the range
+	# 0 to GKI_MAXNDC.  This combines the WCS->NDC->GKI transformations into
+	# a single transformation and permits use of integer arithmetic for
+	# clipping.  Long integer arithmetic is necessary to provide sufficient
+	# precision to represent GKI_MAXNDC**2, the largest possible integer
+	# value in an expression.
+
+	if (xtran == LINEAR && ytran == LINEAR) {
+	    # Optimize the case linear.
+            x = max (0.0, min (real(GKI_MAXNDC),
+                ((wx - wxorigin) * xscale) + mxorigin))
+            y = max (0.0, min (real(GKI_MAXNDC),
+                ((wy - wyorigin) * yscale) + myorigin))
+	} else {
+	    # General case.
+	    call gpl_wcstogki (gp, wx, wy, x, y)
+	}
+
+	# Check to see if this is the first point of a new polyline.  If so we
+	# must set the first physical point in the output polyline to the
+	# current position, making the current point the second physical point
+	# of the output polyline.  If the current position is indefinite
+	# then we take the current point to define the current position and
+	# it is put into the polyline on the next call.
+
+	if (op == 1) {
+	    if (IS_INDEF(cx) || IS_INDEF(cy)) {
+		cx = x
+		cy = y
+		return
+
+	    } else {
+		# Place the current pen position in the polyline as the
+		# first point if it is inbounds.
+
+		mx = cx
+		my = cy
+		if (my <= my2 && my >= my1 && mx <= mx2 && mx >= mx1) {
+		    last_point_inbounds = true
+		    pl[op] = mx
+		    op = op + 1
+		    pl[op] = my
+		    op = op + 1
+		} else {
+		    last_point_inbounds = false
+		    do i = 1, 4 {
+			xs[i] = cx
+			ys[i] = cy
+		    }
+		}
+	    }
+	}
+
+	# Update the current position, maintained in GKI coordinates to make
+	# the current position invariant with respect to changes in the
+	# current WCS.  The current position is maintained in floating point
+	# to minimize the accumulation of errors in relative moves and draws.
+
+	cx = x
+	cy = y
+
+	# Convert to long integer metacode coords for clipping.
+
+	mx = x
+	my = y
+
+	# Clip at either the viewport boundary or the edge of the device screen,
+	# if clipping is "disabled".  Clipping is performed in NDC space rather
+	# than world space because NDC space is simpler (mx1 < mx2, my1 < my2,
+	# no log scaling), and because we need to clip at the device screen
+	# boundary anyhow.  If the boundary is crossed the polyline is broken.
+	# A line segment may lie entirely outside the viewport, entirely inside,
+	# may cross from inside to outside, from outside to inside, or may
+	# cross twice (cross two different boundaries).  The clipping algorithm
+	# used (Harrington, 1983; Sutherland and Hodgman, 1974) clips at each
+	# of the four boundaries in sequence, using the clipped point from the
+	# previous iteration as input to the next.  It isn't simple but neither
+	# is the problem.  The code is optimized for the usual inbounds case.
+	# Clipped points are discarded.
+
+	inbounds = (my <= my2 && my >= my1 && mx <= mx2 && mx >= mx1)
+
+	if (inbounds && (last_point_inbounds || pl_pointmode == YES)) {
+	    # Add point to polyline (the fast way).
+	    pl[op] = mx
+	    op = op + 1
+	    pl[op] = my
+	    op = op + 1
+
+	} else if (pl_pointmode == NO)  {
+	    if (last_point_inbounds) {
+		# Update coords of last point drawn (necessary since we did
+		# not use the clipping code for inbounds points).
+		do i = 1, 4 {
+		    xs[i] = pl[op-2]
+		    ys[i] = pl[op-1]
+		}
+	    }
+	    call gpl_clipl (DRAW, mx, my)
+	}
+
+	last_point_inbounds = inbounds
+
+	# Break long polylines to avoid overflowing the polyline output
+	# buffer.  The output buffer contains two cells for each output
+	# point (x,y pair).  There must be space for at least two points
+	# (four cells) left in the buffer, since a single clip operation
+	# can add up to two points to the polyline.  OP points to the next
+	# available cell.
+
+	if (op > LEN_PLBUF - 2)
+	    call gpl_flush()
+end
+
+
+# GPL_CLIPL -- Clip at left boundary.
+
+procedure gpl_clipl (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+int	newpen
+include	"gpl.com"
+
+begin
+	# Does line cross boundary?
+	if ((mx >= mx1 && xs[1] < mx1) || (mx <= mx1 && xs[1] > mx1)) {
+	    if (mx >= mx1)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    call gpl_clipr (newpen, mx1,
+		(my - ys[1]) * (mx1 - mx) / (mx - xs[1]) + my)
+	}
+
+	xs[1] = mx
+	ys[1] = my
+
+	if (mx >= mx1)
+	    call gpl_clipr (pen, mx, my)
+end
+
+
+# GPL_CLIPR -- Clip at right boundary.
+
+procedure gpl_clipr (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+int	newpen
+include	"gpl.com"
+
+begin
+	# Does line cross boundary?
+	if ((mx <= mx2 && xs[2] > mx2) || (mx >= mx2 && xs[2] < mx2)) {
+	    if (mx <= mx2)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    call gpl_clipb (newpen, mx2,
+		(my - ys[2]) * (mx2 - mx) / (mx - xs[2]) + my)
+	}
+
+	xs[2] = mx
+	ys[2] = my
+
+	if (mx <= mx2)
+	    call gpl_clipb (pen, mx, my)
+end
+
+
+# GPL_CLIPB -- Clip at bottom boundary.
+
+procedure gpl_clipb (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+int	newpen
+include	"gpl.com"
+
+begin
+	# Does line cross boundary?
+	if ((my >= my1 && ys[3] < my1) || (my <= my1 && ys[3] > my1)) {
+	    if (my >= my1)
+		newpen = MOVE
+	    else
+		newpen = pen
+	    call gpl_clipt (newpen, 
+		(mx - xs[3]) * (my1 - my) / (my - ys[3]) + mx, my1)
+	}
+
+	xs[3] = mx
+	ys[3] = my
+
+	if (my >= my1)
+	    call gpl_clipt (pen, mx, my)
+end
+
+
+# GPL_CLIPT -- Clip at top boundary and put the final clipped point(s) in
+# the output polyline.  Note that a "move" at this level does not affect
+# the current position (cx,cy), since the vector endpoints have been clipped
+# and the current position vector follows the unclipped vector points input
+# by the user.
+
+procedure gpl_clipt (pen, mx, my)
+
+int	pen			# move or draw
+long	mx, my			# point to be clipped
+include	"gpl.com"
+
+begin
+	# Does line cross boundary?
+	if ((my <= my2 && ys[4] > my2) || (my >= my2 && ys[4] < my2)) {
+	    if (my <= my2 || pen == MOVE)
+		call gpl_flush()
+	    pl[op] = (mx - xs[4]) * (my2 - my) / (my - ys[4]) + mx
+	    op = op + 1
+	    pl[op] = my2
+	    op = op + 1
+	}
+
+	xs[4] = mx
+	ys[4] = my
+
+	if (my <= my2) {
+	    if (pen == MOVE)
+		call gpl_flush()
+	    pl[op] = mx
+	    op = op + 1
+	    pl[op] = my
+	    op = op + 1
+	}
+end
diff --git a/sys/gio/gamove.x b/sys/gio/gamove.x
new file mode 100644
index 00000000..7c40d1b7
--- /dev/null
+++ b/sys/gio/gamove.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GAMOVE -- Absolute move.  Move the pen to the indicated position in
+# preparation for a draw.
+
+procedure gamove (gp, x, y)
+
+pointer	gp			# graphics descriptor
+real	x, y			# new position of pen
+include	"gpl.com"
+
+begin
+	if (op > 1)
+	    call gpl_flush()
+
+	if (IS_INDEF(x) || IS_INDEF(y)) {
+	    # Set current position to indefinite.
+	    cx = INDEF
+	    cy = INDEF
+	} else {
+	    # Set current position to (x,y) in GKI coordinates.
+	    call gpl_wcstogki (gp, x, y, cx, cy)
+	}
+end
diff --git a/sys/gio/gascale.x b/sys/gio/gascale.x
new file mode 100644
index 00000000..f2b29926
--- /dev/null
+++ b/sys/gio/gascale.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gio.h>
+
+# GASCALE -- Scale the world coordinates of either the X or Y axis to fit the
+# data vector.  This is done by setting the WCS limits to the minimum and
+# maximum pixel values of the data vector.  The original WCS limits are
+# overwritten.
+
+procedure gascale (gp, v, npts, axis)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# data vector
+int	npts			# length of data vector
+int	axis			# asis to be scaled (1=X, 2=Y)
+
+int	start, i
+real	minval, maxval, pixval
+pointer	w
+
+begin
+	# Find first definite valued pixel.  If entire data vector is
+	# indefinite we cannot perform our function and must abort.
+
+	for (start=1;  start <= npts;  start=start+1)
+	    if (!IS_INDEF (v[start]))
+		break
+	if (start > npts)
+	    call syserr (SYS_GINDEF)
+
+	minval = v[start]
+	maxval = minval
+
+	# Compute min and max values of data vector.
+	do i = start+1, npts {
+	    pixval = v[i]
+	    if (!IS_INDEF(pixval))
+		if (pixval < minval)
+		    minval = pixval
+		else if (pixval > maxval)
+		    maxval = pixval
+	}
+
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Set the window limits.
+	switch (axis) {
+	case 1:
+	    WCS_WX1(w) = minval
+	    WCS_WX2(w) = maxval
+	case 2:
+	    WCS_WY1(w) = minval
+	    WCS_WY2(w) = maxval
+	default:
+	    call syserr (SYS_GSCALE)
+	}
+
+	WCS_FLAGS(w) = or (WCS_FLAGS(w), WF_DEFINED)
+	GP_WCSSTATE(gp) = MODIFIED
+	call gpl_reset()
+end
diff --git a/sys/gio/gcancel.x b/sys/gio/gcancel.x
new file mode 100644
index 00000000..30e53ce5
--- /dev/null
+++ b/sys/gio/gcancel.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GCANCEL -- Cancel any buffered graphics output (as far as possible).  Should
+# be called by interrupt handlers to avoid leaving GIO in a funny state
+# following an interrupt.
+#
+# As far as possible, GKI instructions are built up in internal storage and
+# written to the output file in a single write.  This decreases the likliehood
+# of leaving a botched instruction in the output stream in response to an
+# interrupt.  Do not call FSETI to cancel the file output because that will
+# almost certainly guarantee a botched instruction.  Instead, we discard any
+# partially built polylines still in GPL storage and append the GKI_CANCEL to
+# the output instruction stream.  The cancel instruction is passed on to the
+# graphics kernel which eventually calls FSETI to cancel its output file
+# buffer (containing device instructions).  If a metacode reader does detect
+# a botched instruction it will scan forward for the next BOI to try to resync
+# the instruction stream.
+
+procedure gcancel (gp)
+
+pointer	gp			# graphics descriptor
+int	and()
+
+begin
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    call gki_cancel (GP_FD(gp))
+	    call gki_fflush (GP_FD(gp))
+	}
+	call gfrinit (gp)
+end
diff --git a/sys/gio/gclear.x b/sys/gio/gclear.x
new file mode 100644
index 00000000..a3a5d895
--- /dev/null
+++ b/sys/gio/gclear.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gset.h>
+
+# GCLEAR -- Clear the screen and initialize all internal state variables to
+# the original GOPEN state.  Plots separated by calls to GCLEAR cannot affect
+# each other.  See also GFRAME and GRESET if a full state reset is not
+# desired.
+
+procedure gclear (gp)
+
+pointer	gp			# graphics descriptor
+
+begin
+	call gactivate (gp, 0)
+	call gpl_flush()
+	call gki_clear (GP_FD(gp))
+	call greset (gp, GR_RESETALL)
+end
diff --git a/sys/gio/gclose.x b/sys/gio/gclose.x
new file mode 100644
index 00000000..a6802a0a
--- /dev/null
+++ b/sys/gio/gclose.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GCLOSE -- Close a graphics stream previously opened with GOPEN.  Flush any
+# buffered polyline output, output the close worstation metacode instruction,
+# close the output stream, close the graphcap descriptor, and return all
+# buffer space.
+
+procedure gclose (gp)
+
+pointer	gp			# graphics descriptor
+
+int	fd
+int	and()
+
+begin
+	fd = GP_FD(gp)
+
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    call gflush (gp)
+	    call gki_closews (fd, GP_DEVNAME(gp))
+
+	    # If the output stream is a file rather than a standard graphics
+	    # stream, write a WCS savefile to permit restoration of the WCS if
+	    # the device is subsequently opened in APPEND mode.
+
+	    if (fd > STDPLOT)
+		call gwrwcs (GP_DEVNAME(gp),
+		    Memi[GP_WCSPTR(gp,1)], LEN_WCSARRAY)
+
+	    # If the output file was opened by GOPEN (as indicated by the
+	    # CLOSEFD flag), close the file.
+
+	    if (and (GP_GFLAGS(gp), GF_CLOSEFD) != 0)
+		call close (fd)
+	    else
+		call flush (fd)
+	}
+
+	call ttycdes (GP_TTY(gp))
+	call mfree (gp, TY_STRUCT)
+	call gki_redir (fd, NULL, NULL, NULL)
+	call gexfls_clear (fd)
+end
diff --git a/sys/gio/gctran.x b/sys/gio/gctran.x
new file mode 100644
index 00000000..3c804dc8
--- /dev/null
+++ b/sys/gio/gctran.x
@@ -0,0 +1,138 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GCTRAN -- Transform a point in world coordinate system WCS_A to world
+# coordinate system WCS_B.  The transformation is performed by transforming
+# from WCS_A to NDC, followed by a transformation from NDC to WCS_B.  The
+# transformation parameters are cached for efficiency when transforming
+# multiple points in the same pairs of coordinate systems.  Three types of
+# transformations are supported: linear, log, and "elog".  The latter is
+# a logarithmic function defined for all X, i.e., for negative as well as
+# positive X.
+
+procedure gctran (gp, x1,y1, x2,y2, wcs_a, wcs_b)
+
+pointer	gp			# graphics descriptor
+real	x1, y1			# coords of point in WCS_A (input)
+real	x2, y2			# coords of point in WCS_B (output)
+int	wcs_a			# input WCS
+int	wcs_b			# output WCS
+
+int	w, a
+int	wcsord, tran[2,2], wcs[2]
+real	morigin[2,2], worigin[2,2], scale[2,2], ds
+real	w1[2,2], w2[2,2], s1[2,2], s2[2,2], p1[2], p2[2]
+pointer	wp
+
+bool	fp_nondegenr()
+real	elogr(), aelogr()
+
+begin
+	# Verify that the WCS has not changed since we were last called.
+	# WCSORD is a unique integer (ordinal) assigned by GIO each time a
+	# WCS is fixed.
+
+	if (GP_WCSSTATE(gp) != FIXED || GP_WCSORD(gp) != wcsord)
+	    wcs[1] = -1
+
+	# Verify that cached transformation parameters are up to date, and if
+	# not, recompute them.
+
+	if (wcs[1] != wcs_a || wcs[2] != wcs_b) {
+	    wcsord = GP_WCSORD(gp)
+	    wcs[1] = wcs_a
+	    wcs[2] = wcs_b
+
+	    # Copy the WCS parameters into 2-dim arrays so that we can use the
+	    # same code for both axes.
+
+	    do w = 1, 2 {
+		wp = GP_WCSPTR (gp, wcs[w])
+		tran[1,w] = WCS_XTRAN(wp)
+		tran[2,w] = WCS_YTRAN(wp)
+
+		# If the window is degenerate enlarge the window until there
+		# is enough range to make a plot.
+
+		if (fp_nondegenr (WCS_WX1(wp), WCS_WX2(wp)))
+		    GP_WCSSTATE(gp) = MODIFIED
+		if (fp_nondegenr (WCS_WY1(wp), WCS_WY2(wp)))
+		    GP_WCSSTATE(gp) = MODIFIED
+
+		w1[1,w] = WCS_WX1(wp)
+		w2[1,w] = WCS_WX2(wp)
+		w1[2,w] = WCS_WY1(wp)
+		w2[2,w] = WCS_WY2(wp)
+
+		s1[1,w] = WCS_SX1(wp)
+		s2[1,w] = WCS_SX2(wp)
+		s1[2,w] = WCS_SY1(wp)
+		s2[2,w] = WCS_SY2(wp)
+	    }
+
+	    # Compute the transformation parameters for both axes and both
+	    # world coordinate systems.
+
+	    do w = 1, 2				# w = wcs index
+		do a = 1, 2 {			# a = axis
+		    morigin[a,w] = s1[a,w]
+		    ds = s2[a,w] - s1[a,w]
+
+		    if (tran[a,w] == LINEAR) {
+			worigin[a,w] = w1[a,w]
+			scale[a,w] = ds / (w2[a,w] - w1[a,w])
+		    } else if (tran[a,w] == LOG && w1[a,w] > 0 && w2[a,w] > 0) {
+			worigin[a,w] = log10 (w1[a,w])
+			scale[a,w] = ds / (log10(w2[a,w]) - worigin[a,w])
+		    } else {
+			worigin[a,w] = elogr (w1[a,w])
+			scale[a,w] = ds / (elogr(w2[a,w]) - worigin[a,w])
+		    }
+		}
+	}
+
+	p1[1] = x1
+	p1[2] = y1
+
+	# Forward Transformation.  Transform P1 (point-A) in wcs_a to NDC
+	# coordinates, if the input WCS is not number zero (the NDC coordinate
+	# system).
+
+	if (wcs_a != 0)
+	    do a = 1, 2 {
+		if (tran[a,1] != LINEAR)
+		    if (tran[a,1] == LOG) {
+			if (p1[a] <= 0)
+			    p1[a] = INDEF
+			else
+			    p1[a] = log10 (p1[a])
+		    } else
+			p1[a] = elogr (p1[a])
+		p1[a] = ((p1[a] - worigin[a,1]) * scale[a,1]) + morigin[a,1]
+	    }
+
+	# Inverse Transformation.  Transform point P1, now in NDC coordinates,
+	# to WCS-B.  If WCS-B is zero (NDC), we need only copy the points.
+
+	if (wcs_b == 0) {
+	    p2[1] = p1[1]
+	    p2[2] = p1[2]
+	} else {
+	    do a = 1, 2 {
+		if (IS_INDEF (p1[a]))
+		    p2[a] = INDEF
+		else {
+		    p2[a] = (p1[a] - morigin[a,2]) / scale[a,2] + worigin[a,2]
+		    if (tran[a,2] != LINEAR)
+			if (tran[a,2] == LOG)
+			    p2[a] = 10.0 ** p2[a]
+			else
+			    p2[a] = aelogr (p2[a])
+		}
+	    }
+	}
+
+	x2 = p2[1]
+	y2 = p2[2]
+end
diff --git a/sys/gio/gcurpos.x b/sys/gio/gcurpos.x
new file mode 100644
index 00000000..a0d4cb4d
--- /dev/null
+++ b/sys/gio/gcurpos.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GCURPOS -- Get the current position in world coordinates.  The current
+# position is maintained internally in GKI coordinates to make it invariant
+# with respect to changes in the current WCS.
+
+procedure gcurpos (gp, x, y)
+
+pointer	gp			# graphics descriptor
+real	x, y			# current position in current WCS (output)
+
+real	aelogr()
+include	"gpl.com"
+
+begin
+	if (gp != gp_out || GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+
+	if (IS_INDEF(cx) || IS_INDEF(cy)) {
+	    x = INDEF
+	    y = INDEF
+
+	} else {
+	    x = (cx - mxorigin) / xscale + wxorigin
+	    if (xtran != LINEAR)
+		if (xtran == LOG)
+		    x = 10.0 ** x
+		else
+		    x = aelogr (x)
+
+	    y = (cy - myorigin) / yscale + wyorigin
+	    if (ytran != LINEAR)
+		if (ytran == LOG)
+		    y = 10.0 ** y
+		else
+		    y = aelogr (y)
+	}
+end
diff --git a/sys/gio/gdeact.x b/sys/gio/gdeact.x
new file mode 100644
index 00000000..f61f4133
--- /dev/null
+++ b/sys/gio/gdeact.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gset.h>
+
+# GDEACTIVATE -- Deactivate the workstation, i.e., for an interactive device
+# (graphics terminal) restore the terminal to text mode.  This is similar to
+# closing the workstation will gclose, except that the graphics state is
+# retained and graphics i/o may be resumed following a subsequent call to
+# greactivate.  These calls are generally no-ops for noninteractive devices.
+
+procedure gdeactivate (gp, flags)
+
+pointer	gp			# graphics descriptor
+int	flags			# action flags
+
+int	and()
+errchk	gflush
+errchk	gki_deactivatews
+
+begin
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    call gflush (gp)
+	    call gki_deactivatews (GP_FD(gp), flags)
+	    if (and (GP_GFLAGS(gp), GF_WSACTIVE) != 0)
+		GP_GFLAGS(gp) = GP_GFLAGS(gp) - GF_WSACTIVE
+	}
+end
diff --git a/sys/gio/gescape.x b/sys/gio/gescape.x
new file mode 100644
index 00000000..c6a1bf63
--- /dev/null
+++ b/sys/gio/gescape.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GESCAPE -- Pass a device dependent instruction on to the graphics kernel.
+# A unique function code should be assigned each escape function.  The graphics
+# kernel will ignore escapes with unrecognized function codes.
+
+procedure gescape (gp, fn, instruction, nwords)
+
+pointer	gp			# graphics descriptor
+int	fn			# function code (1 - 32767)
+short	instruction[ARB]	# instruction to be transmitted
+int	nwords			# length of instruction
+
+begin
+	call gpl_flush()
+	call gki_escape (GP_FD(gp), fn, instruction, nwords)
+end
diff --git a/sys/gio/gfill.x b/sys/gio/gfill.x
new file mode 100644
index 00000000..4db5d117
--- /dev/null
+++ b/sys/gio/gfill.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GFILL -- Fill area.  Fill the area defined by the polygon (X[i],Y[i]) in the
+# indicated style.
+
+procedure gfill (gp, x, y, npts, style)
+
+pointer gp			# graphics descriptor
+real	x[ARB], y[ARB]		# polygon
+int	npts			# npts in polygon
+int	style			# style for area fill
+
+pointer	ap
+
+begin
+	call gpl_flush()
+
+	ap = GP_FAAP(gp)
+	if (style != FA_STYLE(ap) || FA_STATE(ap) != FIXED) {
+	    FA_STYLE(ap) = style
+	    call gki_faset (GP_FD(gp), ap)
+	    FA_STATE(ap) = FIXED
+	}
+
+	call gpl_settype (gp, FILLAREA)
+	call gpline (gp, x, y, npts)
+	call gpl_settype (gp, POLYLINE)
+end
diff --git a/sys/gio/gflush.x b/sys/gio/gflush.x
new file mode 100644
index 00000000..ef597da8
--- /dev/null
+++ b/sys/gio/gflush.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GFLUSH -- Flush the graphics output.  A simple call to the FIO flush does not
+# suffice since the graphics data stream may be spread over three or more
+# processes.  Flush any buffered polyline output, append the GKI_FLUSH metacode
+# instruction, and flush the FIO buffered metacode output.  The other processes
+# will take similar actions upon receipt of the GKI_FLUSH instruction.
+
+procedure gflush (gp)
+
+pointer	gp			# graphics descriptor
+
+begin
+	call gpl_flush()
+	call gki_flush (GP_FD(gp))
+end
diff --git a/sys/gio/gframe.x b/sys/gio/gframe.x
new file mode 100644
index 00000000..02a1e41e
--- /dev/null
+++ b/sys/gio/gframe.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GFRAME -- Clear the screen, but do not modify the internal state of GIO,
+# other than to reset the WCS and attribute packet states to UNSET, to force
+# retranmission to the graphics kernel.
+
+procedure gframe (gp)
+
+pointer	gp			# graphics descriptor
+
+begin
+	call gactivate (gp, 0)
+	call gpl_flush()
+	call gki_clear (GP_FD(gp))
+	call gfrinit (gp)
+end
diff --git a/sys/gio/gfrinit.x b/sys/gio/gfrinit.x
new file mode 100644
index 00000000..bf8181ed
--- /dev/null
+++ b/sys/gio/gfrinit.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GFRINIT -- Initialize the internal state variables of GIO for a new frame.
+# The state of all the attribute packets is set to UNSET to force them to be
+# retransmitted to the graphics kernel when i/o occurs.
+
+procedure gfrinit (gp)
+
+pointer gp			# graphics descriptor
+pointer	ap
+
+begin
+	# Force retransmission of the WCS.
+	GP_WCSSTATE(gp) = UNSET
+
+	# Force retransmission of the attribute packets.
+	ap = GP_PLAP(gp);	PL_STATE(ap) = UNSET
+	ap = GP_PMAP(gp);	PM_STATE(ap) = UNSET
+	ap = GP_FAAP(gp);	FA_STATE(ap) = UNSET
+	ap = GP_TXAP(gp);	TX_STATE(ap) = UNSET
+	ap = GP_TXAPCUR(gp);	TX_STATE(ap) = UNSET
+
+	call gpl_reset()
+end
diff --git a/sys/gio/ggcell.x b/sys/gio/ggcell.x
new file mode 100644
index 00000000..1dfd7a40
--- /dev/null
+++ b/sys/gio/ggcell.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGCELL -- Get a cell array, i.e., a two dimensional array of pixels.  If the
+# resolution of the graphics device does not match that of the cell array the
+# kernel is expected to compute the coordinates of each cell array pixel in 
+# device coordinates and return the value of the nearest device pixel as the
+# cell array value.  This equates to either subsampling or block replication
+# depending on the relative scale of the two devices.  See put cell array for
+# additional information.
+
+procedure ggcell (gp, m, nx, ny, x1, y1, x2, y2)
+
+pointer	gp			# device descriptor
+int	nx, ny			# size of pixel array
+short	m[nx,ny]		# pixels
+real	x1, y1			# lower left corner of input window
+real	x2, y2			# upper right corner of input window
+
+real	dy
+int	ly1, ly2, i
+int	sx1, sx2, sy1, sy2
+include	"gpl.com"
+
+begin
+	# Flush any buffered polyline output.  Make sure the wcs transformation
+	# in the cache is up to date.
+
+	if (op > 1)
+	    call gpl_flush()
+	else if (gp != gp_out || GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+
+	# Transform cell window to GKI coordinates.  The coordinate
+	# transformation must be linear.
+
+	sx1 = (x1 - wxorigin) * xscale + mxorigin
+	sx2 = (x2 - wxorigin) * xscale + mxorigin
+	sy1 = (y1 - wyorigin) * yscale + myorigin
+	sy2 = (y2 - wyorigin) * yscale + myorigin
+
+	dy = real (sy2 - sy1) / ny	# height of a line in GKI coords
+
+	# Read the cell array into M, one line at a time.  Take care that the
+	# GKI integer value of ly1 of one line is the same as the ly2 value
+	# of the previous line, or there will be a blank line in the output
+	# image.
+
+	do i = 1, ny {
+	    ly1 = (i-1) * dy + sy1
+	    ly2 = (i  ) * dy + sy1
+	    call gki_getcellarray (GP_FD(gp), m[1,i], nx,1, sx1,ly1, sx2,ly2)
+	}
+end
diff --git a/sys/gio/ggcur.x b/sys/gio/ggcur.x
new file mode 100644
index 00000000..40da0a0f
--- /dev/null
+++ b/sys/gio/ggcur.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GGCUR -- Perform a graphics cursor read.  The current graphics cursor is
+# read and the cursor value is returned.  On output, CN is the cursor number
+# which was read, KEY is the key typed to terminate the cursor read, SX,SY
+# are the NDC screen coordinates of the cursor, RASTER is the raster number
+# or zero, and RX,RY are the raster-relative coordinates of the cursor.  If
+# the device does not support rasters or if the cursor is not in a rasters
+# when read, RASTER is zero on output and RX,RY are the same as SX,SY.
+
+int procedure ggcur (gp, cn, key, sx, sy, raster, rx, ry)
+
+pointer gp			#I graphics descriptor
+int	cn			#O cursor which was read
+int	key			#O key typed or EOF
+real	sx, sy			#O screen position of cursor in NDC coordinates
+int	raster			#O raster number
+real	rx, ry			#O raster position of cursor in NDC coordinates
+
+int	m_sx, m_sy
+int	m_rx, m_ry
+
+begin
+	call gflush (gp)
+	call gki_getcursor (GP_FD(gp), GP_CURSOR(gp),
+	    cn, key, m_sx, m_sy, raster, m_rx, m_ry)
+
+	sx = real(m_sx) / GKI_MAXNDC
+	sy = real(m_sy) / GKI_MAXNDC
+	rx = real(m_rx) / GKI_MAXNDC
+	ry = real(m_ry) / GKI_MAXNDC
+
+	return (key)
+end
diff --git a/sys/gio/ggetb.x b/sys/gio/ggetb.x
new file mode 100644
index 00000000..790da996
--- /dev/null
+++ b/sys/gio/ggetb.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGETB -- Get a boolean device parameter from the graphcap entry for the
+# device.  A boolean graphcap query tests if the named parameter exists.
+# Boolean queries are permitted for any capability, regardless of its actual
+# datatype.
+
+bool procedure ggetb (gp, cap)
+
+pointer	gp			# graphics descriptor
+char	cap[ARB]		# name of device capability
+bool	ttygetb()
+
+begin
+	return (ttygetb (GP_TTY(gp), cap))
+end
diff --git a/sys/gio/ggeti.x b/sys/gio/ggeti.x
new file mode 100644
index 00000000..31f81bb2
--- /dev/null
+++ b/sys/gio/ggeti.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGETI -- Get the integer value of an device parameter from the graphcap
+# entry for the device.  Zero is returned if the device does not have the
+# named parameter.
+
+int procedure ggeti (gp, cap)
+
+pointer	gp			# graphics descriptor
+char	cap[ARB]		# name of device capability
+int	ttygeti()
+
+begin
+	return (ttygeti (GP_TTY(gp), cap))
+end
diff --git a/sys/gio/ggetr.x b/sys/gio/ggetr.x
new file mode 100644
index 00000000..b595793c
--- /dev/null
+++ b/sys/gio/ggetr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGETR -- Get the real value of an device parameter from the graphcap entry
+# for the device.  Zero is returned if the device does not have the
+# named parameter.
+
+real procedure ggetr (gp, cap)
+
+pointer	gp			# graphics descriptor
+char	cap[ARB]		# name of device capability
+real	ttygetr()
+
+begin
+	return (ttygetr (GP_TTY(gp), cap))
+end
diff --git a/sys/gio/ggets.x b/sys/gio/ggets.x
new file mode 100644
index 00000000..d82c7090
--- /dev/null
+++ b/sys/gio/ggets.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGETS -- Get the string value of a device parameter from the graphcap entry
+# for the device.  The null string is returned if no entry is found for the
+# named capability, or if the capability exists but the value field is null.
+# The value of any parameter may be returned as a string, regardless of its
+# datatype.  Escape sequences are converted to control codes in the output
+# string.
+
+int procedure ggets (gp, cap, outstr, maxch)
+
+pointer	gp			# graphics descriptor
+char	cap[ARB]		# name of device capability
+char	outstr[ARB]		# output string
+int	maxch
+int	ttygets()
+
+begin
+	return (ttygets (GP_TTY(gp), cap, outstr, maxch))
+end
diff --git a/sys/gio/ggscale.x b/sys/gio/ggscale.x
new file mode 100644
index 00000000..76dffa2a
--- /dev/null
+++ b/sys/gio/ggscale.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGSCALE -- Get the WCS scale in world coords per NDC at the point (x,y).
+# Used to convert offsets or sizes in NDC coordinates into world coordinates,
+# and vice versa.  If log scaling is in use we can only locally approximate
+# the scale.
+
+procedure ggscale (gp, x, y, dx, dy)
+
+pointer	gp			# graphics descriptor
+real	x, y			# point for which scale is desired
+real	dx, dy			# scale wcs/nds (output)
+
+pointer	w
+real	x1, x2, y1, y2, xs, ys, elog_scale
+real	log10e, elogr()
+data	log10e /0.434294482/
+
+begin
+	w = GP_WCSPTR(gp,GP_WCS(gp))
+
+	x1 = WCS_WX1(w)
+	x2 = WCS_WX2(w)
+	y1 = WCS_WY1(w)
+	y2 = WCS_WY2(w)
+	xs = WCS_SX2(w) - WCS_SX1(w)
+	ys = WCS_SY2(w) - WCS_SY1(w)
+
+	switch (WCS_XTRAN(w)) {
+	case LOG:
+	    dx = (x / log10e) * log10 (x2 / x1) / xs
+	case ELOG:
+	    # The following is an approximation.
+	    elog_scale = (elogr(x2) - elogr(x1)) / xs
+	    if (x < 10.0)
+		dx = (-x / log10e) * elog_scale
+	    else if (x > 10.0)
+		dx = (x / log10e) * elog_scale
+	    else
+		dx = (10. / log10e) * elog_scale
+	default:
+	    # LINEAR
+	    dx = (x2 - x1) / xs
+	}
+
+	switch (WCS_YTRAN(w)) {
+	case LOG:
+	    dy = (y / log10e) * log10 (y2 / y1) / ys
+	case ELOG:
+	    # The following is an approximation.
+	    elog_scale = (elogr(y2) - elogr(y1)) / ys
+	    if (y < 10.0)
+		dy = (-y / log10e) * elog_scale
+	    else if (y > 10.0)
+		dy = (y / log10e) * elog_scale
+	    else
+		dy = (10. / log10e) * elog_scale
+	default:
+	    # LINEAR
+	    dy = (y2 - y1) / ys
+	}
+end
diff --git a/sys/gio/ggview.x b/sys/gio/ggview.x
new file mode 100644
index 00000000..486035b6
--- /dev/null
+++ b/sys/gio/ggview.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGVIEW -- Get the viewport of the current WCS.
+
+procedure ggview (gp, x1, x2, y1, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, x2			# range of NDC in X (output)
+real	y1, y2			# range of NDC in Y (output)
+pointer	w
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	x1 = WCS_SX1(w)
+	x2 = WCS_SX2(w)
+	y1 = WCS_SY1(w)
+	y2 = WCS_SY2(w)
+end
diff --git a/sys/gio/ggwind.x b/sys/gio/ggwind.x
new file mode 100644
index 00000000..4972fb75
--- /dev/null
+++ b/sys/gio/ggwind.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GGWIND -- Get the window into world coordinates of the current WCS.
+
+procedure ggwind (gp, x1, x2, y1, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, x2			# range of world coords in X (output)
+real	y1, y2			# range of world coords in Y (output)
+pointer	w
+
+begin
+	call gactivate (gp, 0)
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	x1 = WCS_WX1(w)
+	x2 = WCS_WX2(w)
+	y1 = WCS_WY1(w)
+	y2 = WCS_WY2(w)
+end
diff --git a/sys/gio/gim/README b/sys/gio/gim/README
new file mode 100644
index 00000000..3c98b736
--- /dev/null
+++ b/sys/gio/gim/README
@@ -0,0 +1,215 @@
+GIM -- GIO graphics imaging library.  This is a developmental library based
+on GIO escapes, providing IRAF applications with access to the Gterm widget
+imaging functions.  This library is tied directly to the Gterm widget and is
+expected to be replaced by a more general imaging library in the future.
+
+This library is intended only for clients that need to directly access the
+imaging functions in the Gterm widget for full control over the imaging
+capabilities of the Gterm widget.  Applications which merely need to display
+an image as part of a more complex graphic would probably be better off
+using the more device independent gpcell (put cell-array) and gpcmap (put
+colormap) calls.
+
+
+The following functions are direct RPC calls to the corresponding Gt-prefixed
+imaging functions in the Gterm widget.
+
+            gim_rasterinit (gp)
+          gim_createraster (gp, raster, type, width, height, depth)
+         gim_destroyraster (gp, raster)
+  exists = gim_queryraster (gp, raster, type, width, height, depth)
+	     gim_setraster (gp, raster)		# see gseti(gp,G_RASTER,n)
+
+           gim_writepixels (gp, raster, data, nbits, x1, y1, nx, ny)
+            gim_readpixels (gp, raster, data, nbits, x1, y1, nx, ny)
+	    gim_refreshpix (gp, raster, ct, x1, y1, nx, ny)
+	     gim_setpixels (gp, raster, ct, x1, y1, nx, ny, color, rop)
+
+         gim_writecolormap (gp, colormap, first, nelem, r, g, b)
+  nelem = gim_readcolormap (gp, colormap, first, maxelem, r, g, b)
+          gim_loadcolormap (gp, colormap, offset, slope)
+          gim_freecolormap (gp, colormap)
+	    gim_iomapwrite (gp, iomap, first, nelem)
+	     gim_iomapread (gp, iomap, first, nelem)
+
+          gim_initmappings (gp)
+	   gim_freemapping (gp, mapping)
+            gim_copyraster (gp, rop, src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+            gim_setmapping (gp, mapping, rop, 
+				src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+   status = gim_getmapping (gp, mapping, rop,
+			        src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+         gim_enablemapping (gp, mapping, refresh)
+        gim_disablemapping (gp, mapping, erase)
+        gim_refreshmapping (gp, mapping)
+
+The following Gterm widget imaging functions have no analogue in the GIM
+imaging interface, but can be called from within GUI code.  These functions
+are not implemented at the GIM level either because they are not essential
+and would be too inefficient to be worth using via RPC, or because they
+access resources available only to GUI code.
+
+            GtAssignRaster (gt, raster, drawable)
+  pixmap = GtExtractPixmap (gt, src, ct, x, y, width, height)
+            GtInsertPixmap (gt, pixmap, dst, ct, x, y, width, height)
+   raster = GtSelectRaster (gt, dras, dt, dx, dy, rt, rx, ry, mapping)
+     raster = GtNextRaster (gt)
+      raster = GtGetRaster (gt)
+            n = GtNRasters (gt)
+  pixel = GtGetClientPixel (gt, gterm_pixel)
+   mapping = GtNextMapping (gt)
+  active = GtActiveMapping (gt, mapping)
+
+
+The following messaging routines are also defined by the GIO interface.
+These are used to set the values of UI parameters (i.e., send messages to
+the user interface).
+
+		      gmsg (gp, object, message)
+	    gmsg[bcsilrdx] (gp, object, value)
+		  gmprintf (gp, object, format)
+
+
+The imaging model of the Gterm widget defines the following key object or
+data types: rasters, mappings, and colors.
+
+    raster	A raster is a MxN array of pixels.  At present pixels are 8
+		bits deep but hooks are built in to the interface to expand
+		this in the future.  Pixel values are indices into the Gterm
+		virtual colormap, with values starting at zero.  A raster
+		may be any size.  A raster is merely a two-dimensional array
+		in the graphics server; it is not displayed unless mapped.
+		An exception is raster zero, which is the graphics window.
+		Rasters are referred to by number, starting with zero.
+		Initially only raster zero exists; new rasters are created
+		with gim_createraster.  Space for rasters may be allocated
+		either in the graphics server, or in the X server.  This has
+		implications on performance but is otherwise transparent to
+		the client.  By default rasters are allocated in the
+		graphics server, i.e., in the X client.
+
+    mapping	A mapping defines a projection of a rectangle of the source
+		raster onto a rectangle of the destination raster.  Mappings
+		may be either enabled (active) or disabled.  When a mapping
+		is enabled, any change to a pixel in the source rect will
+		cause the corresponding pixels in the destination rect to be
+		updated.  Mappings are referred to by number starting with
+		one.  Initially no mappings are defined.  If the size of the
+		input and output rect is not the same the input rect will be
+		scaled by pixel replication or subsampling to fill the
+		output rect.  If the argument DW or DH of the destination
+		rect is negative, the image will be flipped around the
+		corresponding axis when copied to the destination; the
+		region of the destination drawn into is the same in either
+		case.  Multiple mappings may reference the same source or
+		destination raster.  Mappings are refreshed in order by the
+		mapping number.  Modifying a mapping causes the changed
+		regions of the destination rect to be refreshed.
+
+    color	The gterm widget provides a fixed number of preassigned colors
+		corresponding to pixel values 0 through 9.  0 is the background
+		color, 1 is the foreground color, and 2-9 (8 colors) are
+		arbitrary colors defined by Gterm widget resources.  These
+		static colors are normally used to draw the background, frame,
+		axes, titles, etc. of a plot, or to draw color graphics within
+		the drawing area.  The advantage of static colors is that they
+		are shared with other X clients, and the values of these
+		colors may be assigned by the user to personalize the way
+		plots look.
+
+		The gterm widget also allows any number (up to about 200 or
+		so) additional colors to be defined at runtime by the client
+		application.  These color values start at pixel value 10 and
+		go up to the maximum pixel value assigned by the client.  The
+		client application allocates colors with gim_writecolormap.
+		Attempts to overwrite the values of the static colors are
+		ignored.  The values of already allocated colors may be
+		changed dynamically at runtime using gim_writecolormap to
+		write the desired range of color values.
+
+		Applications should not assume that there are 10 static
+		colors and 200 or so allocatable colors.  The graphcap entry
+		for the logical device in use defines these parameters for
+		the device.  Alternatively, the readcolormap call may be
+		used to dynamically determine how many colors the server has
+		preallocated when the application starts up.
+
+		An image may use either static and dyamic pixel values or
+		both types of values, but in most cases imaging applications
+		involve smoothly shaded surfaces hence will require
+		dyamically assigned private colors.
+
+		If for some reason the client application cannot use the
+		gterm widget color model, the IOMAP feature can be used to
+		make the widget appear to have some externally defined
+		(i.e., client defined) color model.
+
+
+The maximum number of rasters and maximum number of mappings is defined by
+Gterm widget resources (e.g. in the GUI file) when the graphics application
+starts up.  The maximum values should be much larger than most applications
+require.  Applications should allocate raster or mapping numbers
+sequentially starting at 1 (more or less) to avoid running out of raster or
+mapping descriptors.
+
+The {read|write}pixels routines in the GIM interface operate directly on
+raster pixels.  The mapping routines support two alternative coordinate
+systems, raster pixels and NDC (normalized device coordinates), as indicated
+by the ST or DT argument (source or destination coordinate type).  Note
+that the origin of the pixel coordinate system is the upper left corner of
+the display window (consistent with most graphics systems), whereas the origin
+of the NDC coordinate system is the lower left corner (consistent with IRAF).
+
+Pixel coordinates allow precise control of imaging but require the
+application to know the window size, and may result in complications e.g. if
+the window is resized.  NDC coordinates pretty much guarantee that a mapping
+will involve sampling, hence are not the most efficient, but the graphics
+will be drawn correctly no matter how the window is resized and for most
+applications the performance difference is negligible.  Most applications
+should use NDC coordinates for raster 0 (the display window), and pixel
+coordinates for rasters 1-N.
+
+Although the size of rasters 1 and higher are defined by the client
+application, the size of raster zero, the actual gterm display window, is
+subject to the constraints of the window system.  The client can attempt to
+reset the size of the gterm window using gim_createraster with raster=0,
+however the Gterm widget, UI containing the gterm widget, and the window
+manager are all free to deny such a request.  gim_queryraster should be
+called to determine the actual size of the window one will be drawing into.
+
+
+EXAMPLE
+
+    A simple example of an imaging application might download an image and
+display it in the gterm window, filling the window.  This could be done as
+follows (following a GOPEN and other GIO calls to prepare the drawing surface).
+
+	gim_createraster	Create raster 1 the size of the pixel array
+				to be displayed.  This need not be the same
+				as the size of the gterm display window.
+
+	gim_setmapping		Define a mapping between raster 1 and raster 0,
+				the display window, using NDC coordinates to
+				define the region of the display window to be
+				filled.  The mapping number is arbitrary but
+				mappings should normally be allocated starting
+				with 1.  The mapping is automatically enabled
+				when first defined.
+
+	gim_writecolormap	(Optional).  Define the pixel value to RGB
+				color assignments for the image pixels.
+
+	gim_writepixels		This routine is called one or more times to
+				write pixels into raster 1.  At most 32K
+				pixels (minus a bit for the GKI headers) can
+				be written in each call.  As each write is
+				made the affected region of the display
+				window will be updated.
+
+Alternatively, one could write the pixels and then define the mapping, to
+cause the entire image to be displayed at once.
+
+Note that the GIM calls can be combined with normal GIO graphics to draw text
+and graphics around or on top of an image region.  The order in which drawing
+operations occur is important, e.g., to draw graphics or text on top of an
+image the image should be drawn first.
diff --git a/sys/gio/gim/gimcpras.x b/sys/gio/gim/gimcpras.x
new file mode 100644
index 00000000..ea1ab32f
--- /dev/null
+++ b/sys/gio/gim/gimcpras.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+include	<gki.h>
+include	<gim.h>
+
+# GIM_COPYRASTER -- Copy a portion of the source raster to a rectangular
+# region of the destination raster.
+
+procedure gim_copyraster (gp, rop, src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+
+pointer	gp			#I graphics descriptor
+int	rop			#I rasterop
+int	src			#I source raster
+int	st			#I coordinate type for source raster
+real	sx,sy,sw,sh		#I source rect
+int	dst			#I destination raster
+int	dt			#I coordinate type for destination raster
+real	dx,dy,dw,dh		#I destination rect
+
+short	gim[GIM_COPYRASTER_LEN]
+
+begin
+	gim[GIM_COPYRASTER_OP] = rop
+	gim[GIM_COPYRASTER_SR] = src
+	gim[GIM_COPYRASTER_ST] = st
+
+	if (st == CT_PIXEL) {
+	    gim[GIM_COPYRASTER_SX] = sx
+	    gim[GIM_COPYRASTER_SY] = sy
+	    gim[GIM_COPYRASTER_SW] = sw
+	    gim[GIM_COPYRASTER_SH] = sh
+	} else {
+	    gim[GIM_COPYRASTER_SX] = sx * GKI_MAXNDC
+	    gim[GIM_COPYRASTER_SY] = sy * GKI_MAXNDC
+	    gim[GIM_COPYRASTER_SW] = nint (sw * GKI_MAXNDC)
+	    gim[GIM_COPYRASTER_SH] = nint (sh * GKI_MAXNDC)
+	}
+
+	gim[GIM_COPYRASTER_DR] = dst
+	gim[GIM_COPYRASTER_DT] = dt
+
+	if (dt == CT_PIXEL) {
+	    gim[GIM_COPYRASTER_DX] = dx
+	    gim[GIM_COPYRASTER_DY] = dy
+	    gim[GIM_COPYRASTER_DW] = dw
+	    gim[GIM_COPYRASTER_DH] = dh
+	} else {
+	    gim[GIM_COPYRASTER_DX] = dx * GKI_MAXNDC
+	    gim[GIM_COPYRASTER_DY] = dy * GKI_MAXNDC
+	    gim[GIM_COPYRASTER_DW] = nint (dw * GKI_MAXNDC)
+	    gim[GIM_COPYRASTER_DH] = nint (dh * GKI_MAXNDC)
+	}
+
+	call gescape (gp, GIM_COPYRASTER, gim, GIM_COPYRASTER_LEN)
+end
diff --git a/sys/gio/gim/gimcrras.x b/sys/gio/gim/gimcrras.x
new file mode 100644
index 00000000..9372f85f
--- /dev/null
+++ b/sys/gio/gim/gimcrras.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_CREATERASTER -- Create, recreate, or resize a raster.
+
+procedure gim_createraster (gp, raster, type, width, height, depth)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+int	type			#I raster type (normal,ximage,pixmap)
+int	width			#I raster width in pixels
+int	height			#I raster height in pixels
+int	depth			#I raster depth, bits per pixel
+
+short	gim[GIM_CREATERASTER_LEN]
+
+begin
+	gim[GIM_CREATERASTER_RN] = raster
+	gim[GIM_CREATERASTER_RT] = type
+	gim[GIM_CREATERASTER_NX] = width
+	gim[GIM_CREATERASTER_NY] = height
+	gim[GIM_CREATERASTER_BP] = depth
+
+	call gescape (gp, GIM_CREATERASTER, gim, GIM_CREATERASTER_LEN)
+end
diff --git a/sys/gio/gim/gimderas.x b/sys/gio/gim/gimderas.x
new file mode 100644
index 00000000..9a492759
--- /dev/null
+++ b/sys/gio/gim/gimderas.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_DESTROYRASTER -- Destroy a raster.
+
+procedure gim_destroyraster (gp, raster)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+
+short	gim[GIM_DESTROYRASTER_LEN]
+
+begin
+	gim[GIM_DESTROYRASTER_RN] = raster
+	call gescape (gp, GIM_DESTROYRASTER, gim, GIM_DESTROYRASTER_LEN)
+end
diff --git a/sys/gio/gim/gimdsmap.x b/sys/gio/gim/gimdsmap.x
new file mode 100644
index 00000000..a1618413
--- /dev/null
+++ b/sys/gio/gim/gimdsmap.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_DISABLEMAPPING -- Disable a previously defined mapping.  Disabling a
+# mapping does not automatically erase the mapping unless the erase flag
+# is set.
+
+procedure gim_disablemapping (gp, mapping, erase)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be defined or edited
+int	erase			#I erase flag
+
+short	gim[GIM_DISABLEMAPPING_LEN]
+
+begin
+	gim[GIM_DISABLEMAPPING_MP] = mapping
+	gim[GIM_DISABLEMAPPING_FL] = erase
+	call gescape (gp, GIM_DISABLEMAPPING, gim, GIM_DISABLEMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimenmap.x b/sys/gio/gim/gimenmap.x
new file mode 100644
index 00000000..02e9af3b
--- /dev/null
+++ b/sys/gio/gim/gimenmap.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_ENABLEMAPPING -- Enable a previously defined mapping.  Enabling a 
+# mapping does not automatically refresh the destination unless the refresh
+# flag is set (refresh=YES).
+
+procedure gim_enablemapping (gp, mapping, refresh)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be defined or edited
+int	refresh			#I refresh flag
+
+short	gim[GIM_ENABLEMAPPING_LEN]
+
+begin
+	gim[GIM_ENABLEMAPPING_MP] = mapping
+	gim[GIM_ENABLEMAPPING_FL] = refresh
+	call gescape (gp, GIM_ENABLEMAPPING, gim, GIM_ENABLEMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimfcmap.x b/sys/gio/gim/gimfcmap.x
new file mode 100644
index 00000000..9194e9bf
--- /dev/null
+++ b/sys/gio/gim/gimfcmap.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_FREECOLORMAP -- Free a colormap.
+
+procedure gim_freecolormap (gp, colormap)
+
+pointer	gp			#I graphics descriptor
+int	colormap		#I colormap number
+
+short	gim[GIM_FREECMAP_LEN]
+
+begin
+	gim[GIM_FREECMAP_MP] = colormap
+	call gescape (gp, GIM_FREECMAP, gim, GIM_FREECMAP_LEN)
+end
diff --git a/sys/gio/gim/gimfmap.x b/sys/gio/gim/gimfmap.x
new file mode 100644
index 00000000..f69355a4
--- /dev/null
+++ b/sys/gio/gim/gimfmap.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_FREEMAPPING -- Free a mapping.
+
+procedure gim_freemapping (gp, mapping)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping number
+
+short	gim[GIM_FREEMAPPING_LEN]
+
+begin
+	gim[GIM_FREEMAPPING_MP] = mapping
+	call gescape (gp, GIM_FREEMAPPING, gim, GIM_FREEMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimgetmap.x b/sys/gio/gim/gimgetmap.x
new file mode 100644
index 00000000..c58bae0d
--- /dev/null
+++ b/sys/gio/gim/gimgetmap.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gescape.h>
+include	<fset.h>
+include	<gio.h>
+include	<gki.h>
+include	<gim.h>
+
+# GIM_GETMAPPING -- Get the parameters defining a mapping.  The function value
+# is YES if the mapping is defined and enabled and NO if the mapping is
+# defined but not enabled.  If the mapping is not defined ERR is returned.
+
+int procedure gim_getmapping (gp, mapping, rop,
+	src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be queried
+int	rop			#O rasterop
+int     src			#O source raster
+int     st			#O coordinate type for source raster
+int     sx,sy,sw,sh		#O source rect
+int     dst			#O destination raster
+int     dt			#O coordinate type for destination raster
+int     dx,dy,dw,dh		#O destination rect
+
+int	nchars, nread
+short	gim[GIM_GETMAPPING_LEN]
+short	retval[GIM_RET_GMAP_LEN]
+errchk	gescape, flush, read, syserrs
+int	read(), btoi()
+
+begin
+	call gpl_flush()
+	gim[GIM_GETMAPPING_MP] = mapping
+	call gescape (gp, GIM_GETMAPPING, gim, GIM_GETMAPPING_LEN)
+	call flush (GP_FD(gp))
+
+	# This assumes a normal stream type GKI connection.
+	nchars = GIM_RET_GMAP_LEN * SZ_SHORT
+	nread = read (GP_FD(gp), retval, nchars)
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	if (nread != nchars)
+	    call syserrs (SYS_FREAD, "gim_getmapping")
+
+	# EN=0 not defined, EN=1 defined not enabled, EN=2 defined enabled.
+	if (retval[GIM_RET_GMAP_EN] == 0)
+	    return (ERR)
+	else {
+	    rop = retval[GIM_RET_GMAP_OP]
+
+	    src = retval[GIM_RET_GMAP_SR]
+	    st  = retval[GIM_RET_GMAP_ST]
+
+	    if (st == CT_PIXEL) {
+		sx = retval[GIM_RET_GMAP_SX]
+		sy = retval[GIM_RET_GMAP_SY]
+		sw = retval[GIM_RET_GMAP_SW]
+		sh = retval[GIM_RET_GMAP_SH]
+	    } else {
+		sx = real (retval[GIM_RET_GMAP_SX]) / GKI_MAXNDC
+		sy = real (retval[GIM_RET_GMAP_SY]) / GKI_MAXNDC
+		sw = real (retval[GIM_RET_GMAP_SW]) / GKI_MAXNDC
+		sh = real (retval[GIM_RET_GMAP_SH]) / GKI_MAXNDC
+	    }
+
+	    dst = retval[GIM_RET_GMAP_SR]
+	    dt  = retval[GIM_RET_GMAP_DT]
+
+	    if (dt == CT_PIXEL) {
+		dx = retval[GIM_RET_GMAP_DX]
+		dy = retval[GIM_RET_GMAP_DY]
+		dw = retval[GIM_RET_GMAP_DW]
+		dh = retval[GIM_RET_GMAP_DH]
+	    } else {
+		dx = real (retval[GIM_RET_GMAP_DX]) / GKI_MAXNDC
+		dy = real (retval[GIM_RET_GMAP_DY]) / GKI_MAXNDC
+		dw = real (retval[GIM_RET_GMAP_DW]) / GKI_MAXNDC
+		dh = real (retval[GIM_RET_GMAP_DH]) / GKI_MAXNDC
+	    }
+
+	}
+
+	return (btoi (retval[GIM_RET_GMAP_EN] == 2))
+end
diff --git a/sys/gio/gim/gimimap.x b/sys/gio/gim/gimimap.x
new file mode 100644
index 00000000..2c4a5d28
--- /dev/null
+++ b/sys/gio/gim/gimimap.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_INITMAPPINGS -- Initialize the Gterm widget raster mappings.
+
+procedure gim_initmappings (gp)
+
+pointer	gp			#I graphics descriptor
+
+begin
+	call gescape (gp, GIM_INITMAPPINGS, 0, GIM_INITMAPPINGS_LEN)
+end
diff --git a/sys/gio/gim/gimlcmap.x b/sys/gio/gim/gimlcmap.x
new file mode 100644
index 00000000..afcd9045
--- /dev/null
+++ b/sys/gio/gim/gimlcmap.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+include	<mach.h>
+include	<gim.h>
+include	<gki.h>
+
+# GIM_LOADCOLORMAP -- Load a colormap into the display (hardware) colormap.
+# Any number of colormaps may be defined, but only one may be loaded at a
+# time.  A linear transformation may optionally be applied to the (normalized)
+# colormap when it is loaded.  Set offset=0.5, slope=1.0 to load the colormap
+# without scaling.  A negative slope inverts the image.
+#
+# The offset refers to the center of the mapped region of the transfer
+# function, which is why the center value is at 0.5.  For example, if the
+# range of raster pixel intensities is normalized to the range 0.0 to 1.0,
+# then a transfer function of [offset=0.3,slope=3.0] will display the region
+# of intenstities centered around the normalized intenstity of 0.3, with a
+# contrast of 3.0 (the screen intensity changes 3 units for a unit change in
+# raster pixel intensity).  The transfer function [offset=0.3,slope=-3.0]
+# will display the same range of pixel intensitites, but with a negative
+# contrast.  The transfer function [offset=0.5,slope=1.0] has intercepts
+# of [0,0] and [1,1] hence it displays the full range of raster pixel
+# intensities - the input colormap is used as is, without resampling.
+
+procedure gim_loadcolormap (gp, colormap, offset, slope)
+
+pointer	gp			#I graphics descriptor
+int	colormap		#I colormap number (0 is display colormap)
+real	offset, slope		#I linear transformation on colormap
+
+real	veclen, scale
+short	gim[GIM_LOADCMAP_LEN]
+
+begin
+	scale = GIM_LOADCMAP_SCALE
+	gim[GIM_LOADCMAP_MP] = colormap
+	gim[GIM_LOADCMAP_OF] = ((GKI_MAXNDC + 1) / scale) *
+	    max(-scale, min(scale, offset))
+
+	if (abs(slope) < EPSILONR)
+	    veclen = GKI_MAXNDC
+	else {
+	    veclen = GKI_MAXNDC + 1
+	    veclen = min (veclen / 2, veclen / abs(slope) / 2)
+	}
+	gim[GIM_LOADCMAP_DX] = veclen
+	gim[GIM_LOADCMAP_DY] = veclen * slope
+
+	call gescape (gp, GIM_LOADCMAP, gim, GIM_LOADCMAP_LEN)
+end
diff --git a/sys/gio/gim/gimqras.x b/sys/gio/gim/gimqras.x
new file mode 100644
index 00000000..fa8f5909
--- /dev/null
+++ b/sys/gio/gim/gimqras.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gescape.h>
+include	<fset.h>
+include	<gio.h>
+
+# GIM_QUERYRASTER -- Query a raster.  The function value (YES/NO) indicates
+# whether or not the raster exists.  If the raster exists, the raster type
+# and size are returned as output arguments.
+
+int procedure gim_queryraster (gp, raster, type, width, height, depth)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+int	type			#O raster type (ximage,pixmap)
+int	width			#O raster width in pixels
+int	height			#O raster height in pixels
+int	depth			#O raster depth, bits per pixel
+
+int	nchars, nread
+short	gim[GIM_QUERYRASTER_LEN]
+short	retval[GIM_RET_QRAS_LEN]
+errchk	gescape, flush, read, syserrs
+int	read()
+
+begin
+	call gpl_flush()
+	gim[GIM_QUERYRASTER_RN] = raster
+	call gescape (gp, GIM_QUERYRASTER, gim, GIM_QUERYRASTER_LEN)
+	call flush (GP_FD(gp))
+
+	# This assumes a normal stream type GKI connection.
+	nchars = GIM_RET_QRAS_LEN * SZ_SHORT
+	nread = read (GP_FD(gp), retval, nchars)
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	if (nread != nchars)
+	    call syserrs (SYS_FREAD, "gim_queryraster")
+
+	type   = retval[GIM_RET_QRAS_RT]
+	width  = retval[GIM_RET_QRAS_NX]
+	height = retval[GIM_RET_QRAS_NY]
+	depth  = retval[GIM_RET_QRAS_BP]
+
+	return (retval[GIM_RET_QRAS_EX])
+end
diff --git a/sys/gio/gim/gimrasini.x b/sys/gio/gim/gimrasini.x
new file mode 100644
index 00000000..56914746
--- /dev/null
+++ b/sys/gio/gim/gimrasini.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_RASTERINIT -- Initialize the Gterm widget imaging subsystem.  Destroys
+# any existing rasters, mappings, and dynamic colors.
+
+procedure gim_rasterinit (gp)
+
+pointer	gp			#I graphics descriptor
+
+begin
+	call gescape (gp, GIM_RASTERINIT, 0, GIM_RASTERINIT_LEN)
+end
diff --git a/sys/gio/gim/gimrcmap.x b/sys/gio/gim/gimrcmap.x
new file mode 100644
index 00000000..8fb9f4d2
--- /dev/null
+++ b/sys/gio/gim/gimrcmap.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gescape.h>
+include	<fset.h>
+include	<gio.h>
+
+# GIM_READCOLORMAP -- Read a segment of a colormap.  The number of cells
+# read is returned.  The number of cells read may be less than the request
+# size if the cells have not yet been allocated.
+
+int procedure gim_readcolormap (gp, colormap, first, maxelem, r, g, b)
+
+pointer	gp			#I graphics descriptor
+int	colormap		#I colormap number (0=screen)
+int	first			#I first colormap entry to be read
+int	maxelem			#I number of elements to read
+int	r[ARB],g[ARB],b[ARB]	#O RGB color values (0-255)
+
+pointer	sp, cm, ip
+int	ncells, nret, nchars, i
+short	gim[GIM_READCMAP_LEN]
+short	retval[GIM_RET_RCMAP_LEN]
+int	read()
+
+string	s_readcmap "gim_readcolormap"
+errchk	flush, read, syserrs
+
+begin
+	call smark (sp)
+	call gpl_flush()
+
+	gim[GIM_READCMAP_MP] = colormap
+	gim[GIM_READCMAP_FC] = first
+	gim[GIM_READCMAP_NC] = maxelem
+	call gescape (gp, GIM_READCMAP, gim, GIM_READCMAP_LEN)
+	call flush (GP_FD(gp))
+
+        # Get return value instruction header.
+        nchars = GIM_RET_RCMAP_LEN * SZ_SHORT
+        if (read (GP_FD(gp), retval, nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readcmap)
+	}
+
+        ncells = retval[GIM_RET_RCMAP_NC]
+	call salloc (cm, ncells * 3, TY_SHORT)
+	nret = min (ncells, maxelem)
+
+	# Get the colormap data.
+	nchars = (ncells * 3) * SZ_SHORT
+        if (read (GP_FD(gp), Mems[cm], nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readcmap)
+	}
+	
+	do i = 1, nret {
+	    ip = cm + (i - 1) * 3
+	    r[i] = Mems[ip+0]
+	    g[i] = Mems[ip+1]
+	    b[i] = Mems[ip+2]
+	}
+
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	call sfree (sp)
+
+	return (nret)
+end
diff --git a/sys/gio/gim/gimref.x b/sys/gio/gim/gimref.x
new file mode 100644
index 00000000..dd3085d4
--- /dev/null
+++ b/sys/gio/gim/gimref.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_REFRESHMAPPING -- Refresh a previously defined mapping, i.e., repaint
+# the destination rect.
+
+procedure gim_refreshmapping (gp, mapping)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be defined or edited
+
+short	gim[GIM_REFRESHMAPPING_LEN]
+
+begin
+	gim[GIM_REFRESHMAPPING_MP] = mapping
+	call gescape (gp, GIM_REFRESHMAPPING, gim, GIM_REFRESHMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimrefpix.x b/sys/gio/gim/gimrefpix.x
new file mode 100644
index 00000000..1d906a1a
--- /dev/null
+++ b/sys/gio/gim/gimrefpix.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+include	<gim.h>
+include	<gki.h>
+
+# GIM_REFRESHPIX -- Update any mappings defined upon the given region of
+# the given source raster, as if the pixel values had been set with a write
+# pixels call.
+
+procedure gim_refreshpix (gp, raster, ct, x1, y1, width, height)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+int	ct			#I coordinate type
+real	x1, y1			#I region to be refreshed
+real	width, height		#I region to be refreshed
+
+short	gim[GIM_REFRESHPIXELS_LEN]
+
+begin
+	gim[GIM_REFRESHPIXELS_RN] = raster
+	gim[GIM_REFRESHPIXELS_CT] = ct
+
+        if (ct == CT_PIXEL) {
+            gim[GIM_REFRESHPIXELS_X1] = x1
+            gim[GIM_REFRESHPIXELS_Y1] = y1
+            gim[GIM_REFRESHPIXELS_NX] = width
+            gim[GIM_REFRESHPIXELS_NY] = height
+        } else {
+            gim[GIM_REFRESHPIXELS_X1] = x1 * GKI_MAXNDC
+            gim[GIM_REFRESHPIXELS_Y1] = y1 * GKI_MAXNDC
+            gim[GIM_REFRESHPIXELS_NX] = nint (width * GKI_MAXNDC)
+            gim[GIM_REFRESHPIXELS_NY] = nint (height * GKI_MAXNDC)
+        }
+
+	call gescape (gp, GIM_REFRESHPIXELS, gim, GIM_REFRESHPIXELS_LEN)
+end
diff --git a/sys/gio/gim/gimriomap.x b/sys/gio/gim/gimriomap.x
new file mode 100644
index 00000000..0f152ca5
--- /dev/null
+++ b/sys/gio/gim/gimriomap.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gescape.h>
+include	<fset.h>
+include	<gio.h>
+
+# GIM_IOMAPREAD -- Read a segment of the gterm widget iomap.
+
+procedure gim_iomapread (gp, iomap, first, nelem)
+
+pointer	gp			#I graphics descriptor
+int	iomap[ARB]		#o iomap data
+int	first			#I first iomap cell to be read
+int	nelem			#I number of elements to read
+
+int	nchars
+pointer	sp, data
+short	gim[GIM_READIOMAP_LEN]
+short	retval[GIM_RET_RIOMAP_LEN]
+int	read()
+
+string	s_readiomap "gim_iomapread"
+errchk	flush, read, syserrs
+
+begin
+	call smark (sp)
+	call gpl_flush()
+
+	gim[GIM_READIOMAP_FC] = first
+	gim[GIM_READIOMAP_NC] = nelem
+	call gescape (gp, GIM_READIOMAP, gim, GIM_READIOMAP_LEN)
+	call flush (GP_FD(gp))
+
+        # Get return value instruction header.
+        nchars = GIM_RET_RIOMAP_LEN * SZ_SHORT
+        if (read (GP_FD(gp), retval, nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readiomap)
+	}
+
+        if (retval[GIM_RET_RIOMAP_NC] != nelem)
+            call syserrs (SYS_FREAD, s_readiomap)
+
+	# Get the iomap data.
+	call salloc (data, nelem, TY_SHORT)
+	nchars = nelem * SZ_SHORT
+        if (read (GP_FD(gp), Mems[data], nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readiomap)
+	} else
+	    call achtsi (Mems[data], iomap, nelem)
+
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	call sfree (sp)
+end
diff --git a/sys/gio/gim/gimrpix.x b/sys/gio/gim/gimrpix.x
new file mode 100644
index 00000000..4b6c7e9b
--- /dev/null
+++ b/sys/gio/gim/gimrpix.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	<gio.h>
+include	<fset.h>
+include	<gescape.h>
+
+# GIM_READPIXELS -- Read from a rectangular region of a raster.
+
+procedure gim_readpixels (gp, raster, data, nbits, x1, y1, nx, ny)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+short	data[ARB]		#O returned pixel data
+int	nbits			#I nbits per raster pixel (1,8,16,32)
+int	x1, y1			#I first pixel to be written
+int	nx, ny			#I size of region to be written
+
+int	npix, nchars, nwords
+short	gim[GIM_READPIXELS_LEN]
+short	retval[GIM_RET_RPIX_LEN]
+errchk	gpl_flush, gflush, read, syserrs
+string	s_readpixels "gim_readpixels"
+int	read()
+
+begin
+	call gpl_flush()
+	npix = nx * ny
+	nchars = (npix * nbits / NBITS_BYTE + SZB_CHAR-1) / SZB_CHAR
+	nwords = (nchars + SZ_SHORT-1) / SZ_SHORT
+
+	gim[GIM_READPIXELS_RN] = raster
+	gim[GIM_READPIXELS_EC] = 0
+	gim[GIM_READPIXELS_X1] = x1
+	gim[GIM_READPIXELS_Y1] = y1
+	gim[GIM_READPIXELS_NX] = nx
+	gim[GIM_READPIXELS_NY] = ny
+	gim[GIM_READPIXELS_BP] = nbits
+
+	call gki_escape (gp, GIM_READPIXELS, gim, GIM_READPIXELS_LEN)
+	call flush (GP_FD(gp))
+
+        # Get return value instruction header.
+        nchars = GIM_RET_RPIX_LEN * SZ_SHORT
+        if (read (GP_FD(gp), retval, nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readpixels)
+	}
+
+	# Get the pixel data.
+        npix = retval[GIM_RET_RPIX_NP]
+	nchars = (npix * nbits / NBITS_BYTE + SZB_CHAR-1) / SZB_CHAR
+        if (read (GP_FD(gp), data, nchars) != nchars) {
+	    call fseti (GP_FD(gp), F_CANCEL, OK)
+            call syserrs (SYS_FREAD, s_readpixels)
+	}
+
+	call fseti (GP_FD(gp), F_CANCEL, OK)
+	if (npix != nx * ny)
+            call syserrs (SYS_IMNOPIX, s_readpixels)
+end
diff --git a/sys/gio/gim/gimsetmap.x b/sys/gio/gim/gimsetmap.x
new file mode 100644
index 00000000..2cf5f7b6
--- /dev/null
+++ b/sys/gio/gim/gimsetmap.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gescape.h>
+include	<gki.h>
+include	<gim.h>
+
+# GIM_SETMAPPING -- Define a mapping between a source rect and a destination
+# rect.  While the mapping is enabled, any changes to the source rect will
+# be automatically propagated to the destination rect.  If the source and
+# destination rects are not the same size the source rect will be scaled to
+# fit the output rect.  A negative DW or DH causes the X or Y axis to be
+# flipped during the mapping.  Setmapping automatically enables a new
+# mapping, but no data is copied until the source rect is subsequently
+# modified or the mapping is modified or refreshed.  Setmapping may be called
+# on an already existing mapping to edit the mapping.  If the mapping is
+# enabled the effect of the edit will be visible immediately.  Only the
+# modified regions of the destination rect will be updated by a mapping.
+
+procedure gim_setmapping (gp, mapping, rop,
+	src,st,sx,sy,sw,sh, dst,dt,dx,dy,dw,dh)
+
+pointer	gp			#I graphics descriptor
+int	mapping			#I mapping to be defined or edited
+int	rop			#I rasterop
+int	src			#I source raster
+int	st			#I coordinate type for source raster
+real	sx,sy,sw,sh		#I source rect
+int	dst			#I destination raster
+int	dt			#I coordinate type for destination raster
+real	dx,dy,dw,dh		#I destination rect
+
+short	gim[GIM_SETMAPPING_LEN]
+errchk	gpl_flush, gpl_cache
+include "../gpl.com"
+
+begin
+        # Flush any buffered polyline output.  Make sure the wcs transformation
+        # in the cache is up to date.
+
+        if (op > 1)
+            call gpl_flush()
+        else if (gp != gp_out || GP_WCS(gp) != wcs)
+            call gpl_cache (gp)
+
+	# Output the setmapping escape.
+	gim[GIM_SETMAPPING_MP] = mapping
+	gim[GIM_SETMAPPING_OP] = rop
+	gim[GIM_SETMAPPING_SR] = src
+	gim[GIM_SETMAPPING_ST] = st
+
+	if (st == CT_PIXEL) {
+	    gim[GIM_SETMAPPING_SX] = sx
+	    gim[GIM_SETMAPPING_SY] = sy
+	    gim[GIM_SETMAPPING_SW] = sw
+	    gim[GIM_SETMAPPING_SH] = sh
+	} else {
+	    gim[GIM_SETMAPPING_SX] = sx * GKI_MAXNDC
+	    gim[GIM_SETMAPPING_SY] = sy * GKI_MAXNDC
+	    gim[GIM_SETMAPPING_SW] = nint (sw * GKI_MAXNDC)
+	    gim[GIM_SETMAPPING_SH] = nint (sh * GKI_MAXNDC)
+	}
+
+	gim[GIM_SETMAPPING_DR] = dst
+	gim[GIM_SETMAPPING_DT] = dt
+
+	if (dt == CT_PIXEL) {
+	    gim[GIM_SETMAPPING_DX] = dx
+	    gim[GIM_SETMAPPING_DY] = dy
+	    gim[GIM_SETMAPPING_DW] = dw
+	    gim[GIM_SETMAPPING_DH] = dh
+	} else {
+	    gim[GIM_SETMAPPING_DX] = dx * GKI_MAXNDC
+	    gim[GIM_SETMAPPING_DY] = dy * GKI_MAXNDC
+	    gim[GIM_SETMAPPING_DW] = nint (dw * GKI_MAXNDC)
+	    gim[GIM_SETMAPPING_DH] = nint (dh * GKI_MAXNDC)
+	}
+
+	call gescape (gp, GIM_SETMAPPING, gim, GIM_SETMAPPING_LEN)
+end
diff --git a/sys/gio/gim/gimsetpix.x b/sys/gio/gim/gimsetpix.x
new file mode 100644
index 00000000..09250221
--- /dev/null
+++ b/sys/gio/gim/gimsetpix.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+include	<gim.h>
+include	<gki.h>
+
+# GIM_SETPIX -- Set the pixels in a region of a raster to a solid color.
+# If width=height=0 the entire raster will be written.
+
+procedure gim_setpix (gp, raster, ct, x1, y1, width, height, color, rop)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+int	ct			#I coordinate type
+real	x1, y1			#I region to be refreshed
+real	width, height		#I region to be refreshed
+int	color			#I pixel value
+int	rop			#I rasterop
+
+short	gim[GIM_SETPIXELS_LEN]
+
+begin
+	gim[GIM_SETPIXELS_RN] = raster
+	gim[GIM_SETPIXELS_CT] = ct
+	gim[GIM_SETPIXELS_CO] = color
+	gim[GIM_SETPIXELS_OP] = rop
+
+        if (ct == CT_PIXEL) {
+            gim[GIM_SETPIXELS_X1] = x1
+            gim[GIM_SETPIXELS_Y1] = y1
+            gim[GIM_SETPIXELS_NX] = width
+            gim[GIM_SETPIXELS_NY] = height
+        } else {
+            gim[GIM_SETPIXELS_X1] = x1 * GKI_MAXNDC
+            gim[GIM_SETPIXELS_Y1] = y1 * GKI_MAXNDC
+            gim[GIM_SETPIXELS_NX] = nint (width * GKI_MAXNDC)
+            gim[GIM_SETPIXELS_NY] = nint (height * GKI_MAXNDC)
+        }
+
+	call gescape (gp, GIM_SETPIXELS, gim, GIM_SETPIXELS_LEN)
+end
diff --git a/sys/gio/gim/gimsetras.x b/sys/gio/gim/gimsetras.x
new file mode 100644
index 00000000..efb5add5
--- /dev/null
+++ b/sys/gio/gim/gimsetras.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gescape.h>
+
+# GIM_SETRASTER -- Set the raster to be used as the coordinate system for
+# graphics drawing operations.  A setraster for raster N causes subsequent
+# drawing operations to be drawn using any raster-to-screen mappings defined
+# for raster N.  A setraster to raster=0 restores the normal semantics of
+# drawing directly to the screen with no additional transformations.
+# Applications which use gim_setraster to draw graphics or text overlays on
+# a raster should always restore the raster to zero when done so that
+# subsequent drawing operations (e.g., in cursor mode) behave normally.
+# The setraster is not reset automatically except in a screen clear.
+#
+# NOTE - Most applications should use gseti(gp,G_RASTER,n) instead of the
+# lower level gim_setraster.
+
+procedure gim_setraster (gp, raster)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number
+
+short	gim[GIM_SETRASTER_LEN]
+
+begin
+	gim[GIM_SETRASTER_RN] = raster
+	call gescape (gp, GIM_SETRASTER, gim, GIM_SETRASTER_LEN)
+end
diff --git a/sys/gio/gim/gimwcmap.x b/sys/gio/gim/gimwcmap.x
new file mode 100644
index 00000000..54a6d3f2
--- /dev/null
+++ b/sys/gio/gim/gimwcmap.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gescape.h>
+
+# GIM_WRITECOLORMAP -- Write to a colormap.
+
+procedure gim_writecolormap (gp, colormap, first, nelem, r, g, b)
+
+pointer	gp			#I graphics descriptor
+int	colormap		#I colormap number (0=screen)
+int	first			#I first colormap entry to be written
+int	nelem			#I number of elements to write
+int	r[ARB],g[ARB],b[ARB]	#I RGB color values (0-255)
+
+int	i
+pointer	sp, cm, op
+short	gim[GIM_WRITECMAP_LEN]
+errchk	gpl_flush
+
+begin
+	call gpl_flush()
+
+	call smark (sp)
+	call salloc (cm, nelem * 3, TY_SHORT)
+
+	gim[GIM_WRITECMAP_MP] = colormap
+	gim[GIM_WRITECMAP_FC] = first
+	gim[GIM_WRITECMAP_NC] = nelem
+
+	do i = 1, nelem {
+	    op = cm + (i - 1) * 3
+	    Mems[op+0] = r[i]
+	    Mems[op+1] = g[i]
+	    Mems[op+2] = b[i]
+	}
+
+	call gki_wescape (GP_FD(gp), GIM_WRITECMAP,
+	    gim, GIM_WRITECMAP_LEN, Mems[cm], nelem * 3)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gim/gimwiomap.x b/sys/gio/gim/gimwiomap.x
new file mode 100644
index 00000000..a756a235
--- /dev/null
+++ b/sys/gio/gim/gimwiomap.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<gescape.h>
+
+# GIM_IOMAPWRITE -- Write to the iomap.  The iomap maps client pixel values
+# (colors) to gterm widget pixel value (widget colormap indices).  The iomap
+# should be set only if the client application does not use the gterm widget
+# color model.  iomap[i] gives the widget colormap index corresponding to
+# client pixel I.
+
+procedure gim_iomapwrite (gp, iomap, first, nelem)
+
+pointer	gp			#I graphics descriptor
+int	iomap[ARB]		#I iomap data
+int	first			#I first iomap entry to be written
+int	nelem			#I number of elements to write
+
+pointer	sp, data
+short	gim[GIM_WRITEIOMAP_LEN]
+errchk	gpl_flush
+
+begin
+	call gpl_flush()
+
+	call smark (sp)
+	call salloc (data, nelem, TY_SHORT)
+
+	gim[GIM_WRITEIOMAP_FC] = first
+	gim[GIM_WRITEIOMAP_NC] = nelem
+
+	call achtis (iomap, Mems[data], nelem)
+	call gki_wescape (GP_FD(gp), GIM_WRITEIOMAP,
+	    gim, GIM_WRITEIOMAP_LEN, Mems[data], nelem)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gim/gimwpix.x b/sys/gio/gim/gimwpix.x
new file mode 100644
index 00000000..fc55a55b
--- /dev/null
+++ b/sys/gio/gim/gimwpix.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	<gescape.h>
+
+# GIM_WRITEPIXELS -- Write to a rectangular region of a raster.
+
+procedure gim_writepixels (gp, raster, data, nbits, x1, y1, nx, ny)
+
+pointer	gp			#I graphics descriptor
+int	raster			#I raster number (0 is display window)
+short	data[ARB]		#I output pixel data
+int	nbits			#I nbits per raster pixel (1,8,16,32)
+int	x1, y1			#I first pixel to be written
+int	nx, ny			#I size of region to be written
+
+int	npix, nchars, nwords
+short	gim[GIM_WRITEPIXELS_LEN]
+errchk	gpl_flush, gpl_cache
+include "../gpl.com"
+
+begin
+        # Flush any buffered polyline output.  Make sure the wcs transformation
+        # in the cache is up to date.
+
+        if (op > 1)
+            call gpl_flush()
+        else if (gp != gp_out || GP_WCS(gp) != wcs)
+            call gpl_cache (gp)
+
+	# Output the writepixels escape.
+	npix = nx * ny
+	nchars = (npix * nbits / NBITS_BYTE + SZB_CHAR-1) / SZB_CHAR
+	nwords = (nchars + SZ_SHORT-1) / SZ_SHORT
+
+	gim[GIM_WRITEPIXELS_RN] = raster
+	gim[GIM_WRITEPIXELS_EC] = 0
+	gim[GIM_WRITEPIXELS_X1] = x1
+	gim[GIM_WRITEPIXELS_Y1] = y1
+	gim[GIM_WRITEPIXELS_NX] = nx
+	gim[GIM_WRITEPIXELS_NY] = ny
+	gim[GIM_WRITEPIXELS_BP] = nbits
+
+	call gki_wescape (GP_FD(gp), GIM_WRITEPIXELS,
+	    gim, GIM_WRITEPIXELS_LEN, data, nwords)
+end
diff --git a/sys/gio/gim/mkpkg b/sys/gio/gim/mkpkg
new file mode 100644
index 00000000..9aab719b
--- /dev/null
+++ b/sys/gio/gim/mkpkg
@@ -0,0 +1,32 @@
+# Make the GIM (graphics imaging) interface.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	gimcpras.x	<gescape.h> <gim.h> <gki.h>
+	gimcrras.x	<gescape.h>
+	gimderas.x	<gescape.h>
+	gimdsmap.x	<gescape.h>
+	gimenmap.x	<gescape.h>
+	gimfcmap.x	<gescape.h>
+	gimfmap.x	<gescape.h>
+	gimgetmap.x	<fset.h> <gescape.h> <gim.h> <gio.h> <gki.h>
+	gimimap.x	<gescape.h>
+	gimlcmap.x	<gescape.h> <gim.h> <gki.h> <mach.h>
+	gimqras.x	<fset.h> <gescape.h> <gio.h>
+	gimrasini.x	<gescape.h>
+	gimrcmap.x	<fset.h> <gescape.h> <gio.h>
+	gimref.x	<gescape.h>
+	gimrefpix.x	<gescape.h> <gim.h> <gki.h>
+	gimriomap.x	<fset.h> <gescape.h> <gio.h>
+	gimrpix.x	<fset.h> <gescape.h> <gio.h> <mach.h>
+	gimsetmap.x	<gescape.h> <gim.h> <gio.h> <gki.h> ../gpl.com
+	gimsetpix.x	<gescape.h> <gim.h> <gki.h>
+	gimsetras.x	<gescape.h>
+	gimwcmap.x	<gescape.h> <gio.h>
+	gimwiomap.x	<gescape.h> <gio.h>
+	gimwpix.x	<gescape.h> <gio.h> <mach.h> ../gpl.com
+	;
diff --git a/sys/gio/gki/README b/sys/gio/gki/README
new file mode 100644
index 00000000..171de8d9
--- /dev/null
+++ b/sys/gio/gki/README
@@ -0,0 +1,84 @@
+GKI -- The graphics kernel interface.
+
+    The GKI package is used to encode and decode the GKI instructions used to
+communicate with a graphics kernel.  The kernel may be resident in the same
+process, in the CL process, or in a subprocess of the CL.  Output may also
+be spooled in a metafile.  The purposes of the GKI interface are to isolate GIO
+from the kernel, to hide the details of packing and unpacking GKI metacode
+from both GIO and the kernels, and to hide the details of the communications
+protocols required to communicate with the different types of kernels.
+
+    Before any i/o can be done on a GKI graphics stream, GKI must be informed
+of the residency of the kernel associated with the stream.  Three calls are
+provided for this purpose:
+
+	    gki_redir (stream, fd, old_type, old_fd)		[1]
+	   gki_inline (stream, dd)				[2]
+	gki_subkernel (stream, pid, epa_prpsio)			[3]
+
+Use [1] in the normal case of GIO talking to the CL or to a metafile.  The
+first call will set, rather than redirect, the FD for a stream.  Subsequent
+calls may be made to truely redirect a stream and then restore its normal
+dataflow.  Use [2] when the graphics kernel is in the same process.  The
+kernel must already have been opened with the driver for the kernel in the
+DD array.  This is the most efficient mode of operation if a high data
+bandwidth is required.  Kernel type [2] is used by GIOTR in the CL process
+to communicate with external kernels.  A slightly different protocol is
+required in this case since the input must be switched to the subprocess
+before it can read or write the graphics stream.
+
+
+			Summary Of Procedures
+
+1. Initialize GKI
+
+		      gki_redir (stream, fd, old_fd, old_type)
+	      gki_inline_kernel (stream, dd)
+		  gki_subkernel (stream, pid, prpsio_epa)
+
+
+2. Metacode interpretation
+
+     gki_fetch_next_instruction (fd, instruction)		(EOF|nwords)
+		    gki_execute (gki, dd)
+		      gki_write (fd, gki)
+
+
+3. Instructions
+
+		     gki_cancel (fd)
+		      gki_clear (fd)
+		    gki_closews (fd, device)
+	       gki_deactivatews (fd)
+		        gki_eof (fd)
+		     gki_escape (fd, fn, instruction, nwords)
+		      gki_faset (fd, ap)
+		   gki_fillarea (fd, points, npts)
+		      gki_flush (fd)
+	       gki_getcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+		  gki_getcursor (fd, x, y, key, cursor)
+		     gki_getwcs (fd, wcs, len_wcs)
+		    gki_mftitle (fd, title)
+		     gki_openws (fd, device, mode)
+		      gki_plset (fd, ap)
+		      gki_pmset (fd, ap)
+		   gki_polyline (fd, points, npts)
+		 gki_polymarker (fd, points, npts)
+	       gki_putcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+	       gki_reactivatews (fd)
+		  gki_setcursor (fd, x, y, cursor)
+		     gki_setwcs (fd, wcs, len_wcs)
+		       gki_text (fd, x, y, text)
+		      gki_txset (fd, ap)
+
+
+4. Instructions for encoding return values
+
+	       gki_retcellarray (fd, m, np)
+	     gki_retcursorvalue (fd, x, y, key, cursor)
+
+
+5. Initialization of the GKIPRINT kernel
+
+		    gkp_install (dd, out_fd, verbose_output)
+		      gkp_close ()
diff --git a/sys/gio/gki/gki.com b/sys/gio/gki/gki.com
new file mode 100644
index 00000000..4c5e3152
--- /dev/null
+++ b/sys/gio/gki/gki.com
@@ -0,0 +1,8 @@
+# Common for the GKI (graphics kernel interface) package.
+
+int	gk_type[LAST_FD]		# type of output
+int	gk_fd[LAST_FD]			# output file descriptor
+int	gk_dd[LEN_GKIDD]		# local device driver
+int	gk_prpsio			# EPA of pr_psio procedure
+
+common	/gkicom/ gk_type, gk_fd, gk_dd, gk_prpsio
diff --git a/sys/gio/gki/gkicancel.x b/sys/gio/gki/gkicancel.x
new file mode 100644
index 00000000..ff2bc5f4
--- /dev/null
+++ b/sys/gio/gki/gkicancel.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_CANCEL -- Cancel graphics output and reset internal parameters.
+#
+# BOI GKI_CANCEL 0
+#    
+#        L(i)            set to the constant 3 (no data fields)
+
+procedure gki_cancel (fd)
+
+int	fd			# output file
+
+int	epa
+short	gki[GKI_CANCEL_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_CANCEL/, gki[3] /LEN_GKIHDR/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_CANCEL]
+	    if (epa != 0)
+		call zcall1 (epa, 0)
+	} else
+	    call write (gk_fd[fd], gki, GKI_CANCEL_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiclear.x b/sys/gio/gki/gkiclear.x
new file mode 100644
index 00000000..ac1e5961
--- /dev/null
+++ b/sys/gio/gki/gkiclear.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_CLEAR -- Clear the workstation screen.
+#
+# BOI GKI_CLEAR 0
+#    
+#        L(i)            set to the constant 3 (no data fields)
+
+procedure gki_clear (fd)
+
+int	fd			# output file
+
+int	epa
+short	gki[GKI_CLEAR_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_CLEAR/, gki[3] /LEN_GKIHDR/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_CLEAR]
+	    if (epa != 0)
+		call zcall1 (epa, 0)
+	} else
+	    call write (gk_fd[fd], gki, GKI_CLEAR_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiclose.x b/sys/gio/gki/gkiclose.x
new file mode 100644
index 00000000..e7ceea15
--- /dev/null
+++ b/sys/gio/gki/gkiclose.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_CLOSEWS -- Close workstation.
+#
+# BOI GKI_CLOSEWS L N D
+#    
+#        L(i)            4 + N
+#        N(i)            number of characters in field D
+#        D(Nc)           device name as in graphcap file
+
+procedure gki_closews (fd, device)
+
+int	fd			# output file
+char	device[ARB]		# device name
+
+int	epa
+int	ip, nchars, n
+pointer	sp, gki, op
+int	strlen()
+include	"gki.com"
+
+begin
+	call smark (sp)
+
+	n = strlen (device)
+	call salloc (gki, GKI_CLOSEWS_LEN + n, TY_SHORT)
+
+	# Pack the device name as a SHORT integer array.
+	op = gki + GKI_CLOSEWS_D - 1
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    Mems[op] = device[ip]
+	    op = op + 1
+	}
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_CLOSEWS]
+	    if (epa != 0)
+		call zcall2 (epa, Mems[gki+GKI_CLOSEWS_D-1], n)
+	} else {
+	    Mems[gki  ] = BOI
+	    Mems[gki+1] = GKI_CLOSEWS
+	    Mems[gki+2] = GKI_CLOSEWS_LEN + n
+	    Mems[gki+GKI_CLOSEWS_N-1] = n
+
+	    # Send a copy of the close workstation directive to PSIOCTRL in
+	    # the CL process to connect the graphics stream to a kernel,
+	    # before writing to the graphics stream.  The GKI instruction
+	    # must be preceded by the integer value of the stream number.
+
+	    nchars = (GKI_CLOSEWS_LEN + n) * SZ_SHORT
+	    if (IS_FILE(fd) && (fd >= STDGRAPH && fd <= STDPLOT)) {
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, Mems[gki], nchars)
+		call flush (PSIOCTRL)
+	    }
+
+	    # Now send a copy to the graphics kernel.
+	    call write (gk_fd[fd], Mems[gki], nchars)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gki/gkideact.x b/sys/gio/gki/gkideact.x
new file mode 100644
index 00000000..b742f7ed
--- /dev/null
+++ b/sys/gio/gki/gkideact.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_DEACTIVATEWS -- Deactivate the workstation (disable graphics).
+#
+# BOI GKI_DEACTIVATEWS L F
+#    
+#        L(i)            4
+#        F               flags (0,AW_PAUSE,AW_CLEAR)
+
+procedure gki_deactivatews (fd, flags)
+
+int	fd			# output file
+int	flags			# action modifier flags
+
+int	epa, nchars
+short	gki[GKI_DEACTIVATEWS_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_DEACTIVATEWS/, gki[3] /GKI_DEACTIVATEWS_LEN/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_DEACTIVATEWS]
+	    if (epa != 0)
+		call zcall1 (epa, flags)
+
+	} else {
+	    # Send a copy to the pseudofile i/o controller.
+	    gki[GKI_DEACTIVATEWS_F] = flags
+	    nchars = GKI_DEACTIVATEWS_LEN * SZ_SHORT
+	    if (IS_FILE(fd) && (fd >= STDGRAPH && fd <= STDPLOT)) {
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, gki, nchars)
+		call flush (PSIOCTRL)
+	    }
+
+	    # Now send a copy to the graphics kernel.
+	    call write (gk_fd[fd], gki, nchars)
+	}
+end
diff --git a/sys/gio/gki/gkieof.x b/sys/gio/gki/gkieof.x
new file mode 100644
index 00000000..05700156
--- /dev/null
+++ b/sys/gio/gki/gkieof.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_EOF -- Signal end of file on a metacode stream.
+#
+# BOI GKI_EOF 0
+#    
+#        L(i)            set to the constant 3 (no data fields)
+
+procedure gki_eof (fd)
+
+int	fd			# output file
+
+short	gki[GKI_EOF_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_EOF/, gki[3] /LEN_GKIHDR/
+include	"gki.com"
+
+begin
+	if (!IS_INLINE(fd))
+	    call write (gk_fd[fd], gki, GKI_EOF_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiesc.x b/sys/gio/gki/gkiesc.x
new file mode 100644
index 00000000..a33c769d
--- /dev/null
+++ b/sys/gio/gki/gkiesc.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_ESCAPE -- Pass a device dependent instruction on to the kernel.
+#
+# BOI GKI_ESCAPE L FN N DC
+#
+#        L(i)            5 + N
+#        FN(i)           escape function code
+#        N(i)            number of escape data words
+#        DC(i)           escape data words
+
+procedure gki_escape (fd, fn, instruction, nwords)
+
+int	fd			# output file
+int	fn			# function code
+short	instruction[ARB]	# instruction sequence of unknown format
+int	nwords			# number of shorts in instruction
+
+int	epa
+short	gki[GKI_ESCAPE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_ESCAPE/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_ESCAPE]
+	    if (epa != 0)
+		call zcall3 (epa, fn, instruction, nwords)
+	} else {
+	    gki[GKI_ESCAPE_L]  = GKI_ESCAPE_LEN + nwords
+	    gki[GKI_ESCAPE_N]  = nwords
+	    gki[GKI_ESCAPE_FN] = fn
+
+	    call write (gk_fd[fd], gki, GKI_ESCAPE_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], instruction, nwords * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkiexe.x b/sys/gio/gki/gkiexe.x
new file mode 100644
index 00000000..05e8ec8d
--- /dev/null
+++ b/sys/gio/gki/gkiexe.x
@@ -0,0 +1,178 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GKI_EXECUTE -- Execute a metacode instruction.  The instruction is decoded
+# and a graphics kernel driver subroutine is called to execute the instruction.
+# If the device driver does not include a procedure for the instruction the
+# instruction is discarded.  Integer and real parameters are unpacked from
+# their short integer metacode representation.  Character data is passed by
+# reference, i.e., as a SHORT integer array (not EOS delimited char!!), along
+# with the character count.  Attribute packets are passed to the set attribute
+# procedure by reference as a short integer array.
+
+procedure gki_execute (gki, dd)
+
+short	gki[ARB]		# graphics kernel instruction
+int	dd[ARB]			# device driver
+
+int	kp			# kernel procedure
+int	m, n, cn, fn, dummy, flags
+int	x, y, x1, y1, x2, y2
+
+begin
+	switch (gki[GKI_HDR_OPCODE]) {
+
+	case GKI_OPENWS:
+	    kp = dd[GKI_OPENWS]
+	    if (kp != NULL) {
+		m = gki[GKI_OPENWS_M]
+		n = gki[GKI_OPENWS_N]
+		call zcall3 (kp, gki[GKI_OPENWS_D], n, m)
+	    }
+	case GKI_CLOSEWS:
+	    kp = dd[GKI_CLOSEWS]
+	    if (kp != NULL) {
+		n = gki[GKI_CLOSEWS_N]
+		call zcall2 (kp, gki[GKI_CLOSEWS_D], n)
+	    }
+	case GKI_REACTIVATEWS:
+	    kp = dd[GKI_REACTIVATEWS]
+	    if (kp != NULL) {
+		flags = gki[GKI_REACTIVATEWS_F]
+		call zcall1 (kp, flags)
+	    }
+	case GKI_DEACTIVATEWS:
+	    kp = dd[GKI_DEACTIVATEWS]
+	    if (kp != NULL) {
+		flags = gki[GKI_DEACTIVATEWS_F]
+		call zcall1 (kp, flags)
+	    }
+	case GKI_MFTITLE:
+	    kp = dd[GKI_MFTITLE]
+	    if (kp != NULL) {
+		n = gki[GKI_MFTITLE_N]
+		call zcall2 (kp, gki[GKI_MFTITLE_T], n)
+	    }
+	case GKI_CLEAR:
+	    kp = dd[GKI_CLEAR]
+	    if (kp != NULL) {
+		call zcall1 (kp, dummy)
+	    }
+	case GKI_CANCEL:
+	    kp = dd[GKI_CANCEL]
+	    if (kp != NULL) {
+		call zcall1 (kp, dummy)
+	    }
+	case GKI_FLUSH:
+	    kp = dd[GKI_FLUSH]
+	    if (kp != NULL) {
+		call zcall1 (kp, dummy)
+	    }
+	case GKI_POLYLINE:
+	    kp = dd[GKI_POLYLINE]
+	    if (kp != 0) {
+		n = gki[GKI_POLYLINE_N]
+		call zcall2 (kp, gki[GKI_POLYLINE_P], n)
+	    }
+	case GKI_POLYMARKER:
+	    kp = dd[GKI_POLYMARKER]
+	    if (kp != 0) {
+		n = gki[GKI_POLYMARKER_N]
+		call zcall2 (kp, gki[GKI_POLYMARKER_P], n)
+	    }
+	case GKI_TEXT:
+	    kp = dd[GKI_TEXT]
+	    if (kp != NULL) {
+		x = gki[GKI_TEXT_P]
+		y = gki[GKI_TEXT_P+1]
+		n = gki[GKI_TEXT_N]
+		call zcall4 (kp, x, y, gki[GKI_TEXT_T], n)
+	    }
+	case GKI_FILLAREA:
+	    kp = dd[GKI_FILLAREA]
+	    if (kp != 0) {
+		n = gki[GKI_FILLAREA_N]
+		call zcall2 (kp, gki[GKI_FILLAREA_P], n)
+	    }
+	case GKI_PUTCELLARRAY:
+	    kp = dd[GKI_PUTCELLARRAY]
+	    if (kp != NULL) {
+		x1 = gki[GKI_PUTCELLARRAY_LL]
+		y1 = gki[GKI_PUTCELLARRAY_LL+1]
+		x2 = gki[GKI_PUTCELLARRAY_UR]
+		y2 = gki[GKI_PUTCELLARRAY_UR+1]
+		m  = gki[GKI_PUTCELLARRAY_NC]
+		n  = gki[GKI_PUTCELLARRAY_NL]
+		call zcall7 (kp, gki[GKI_PUTCELLARRAY_P], m, n, x1,y1, x2,y2)
+	    }
+	case GKI_SETCURSOR:
+	    kp = dd[GKI_SETCURSOR]
+	    if (kp != NULL) {
+		cn = gki[GKI_SETCURSOR_CN]
+		x  = gki[GKI_SETCURSOR_POS]
+		y  = gki[GKI_SETCURSOR_POS+1]
+		call zcall3 (kp, x, y, cn)
+	    }
+	case GKI_PLSET:
+	    kp = dd[GKI_PLSET]
+	    if (kp != NULL) {
+		call zcall1 (kp, gki)
+	    }
+	case GKI_PMSET:
+	    kp = dd[GKI_PMSET]
+	    if (kp != NULL) {
+		call zcall1 (kp, gki)
+	    }
+	case GKI_TXSET:
+	    kp = dd[GKI_TXSET]
+	    if (kp != NULL) {
+		call zcall1 (kp, gki)
+	    }
+	case GKI_FASET:
+	    kp = dd[GKI_FASET]
+	    if (kp != NULL) {
+		call zcall1 (kp, gki)
+	    }
+	case GKI_GETCURSOR:
+	    kp = dd[GKI_GETCURSOR]
+	    if (kp != NULL) {
+		cn = gki[GKI_GETCURSOR_CN]
+		call zcall1 (kp, cn)
+	    }
+	case GKI_GETCELLARRAY:
+	    kp = dd[GKI_GETCELLARRAY]
+	    if (kp != NULL) {
+		x1 = gki[GKI_GETCELLARRAY_LL]
+		y1 = gki[GKI_GETCELLARRAY_LL+1]
+		x2 = gki[GKI_GETCELLARRAY_UR]
+		y2 = gki[GKI_GETCELLARRAY_UR+1]
+		m  = gki[GKI_GETCELLARRAY_NC]
+		n  = gki[GKI_GETCELLARRAY_NL]
+		call zcall6 (kp, m, n, x1,y1, x2,y2)
+	    }
+	case GKI_ESCAPE:
+	    kp = dd[GKI_ESCAPE]
+	    if (kp != NULL) {
+		fn = gki[GKI_ESCAPE_FN]
+		n  = gki[GKI_ESCAPE_N]
+		call zcall3 (kp, fn, gki[GKI_ESCAPE_DC], n)
+	    }
+	case GKI_SETWCS:
+	    kp = dd[GKI_SETWCS]
+	    if (kp != NULL) {
+		n = gki[GKI_SETWCS_N]
+		call zcall2 (kp, gki[GKI_SETWCS_WCS], n)
+	    }
+	case GKI_GETWCS:
+	    kp = dd[GKI_SETWCS]
+	    if (kp != NULL) {
+		n = gki[GKI_SETWCS_N]
+		call zcall2 (kp, gki[GKI_SETWCS_WCS], n)
+	    }
+	default:
+	    kp = dd[GKI_UNKNOWN]
+	    if (kp != NULL)
+		call zcall1 (kp, gki)
+	}
+end
diff --git a/sys/gio/gki/gkifa.x b/sys/gio/gki/gkifa.x
new file mode 100644
index 00000000..328ec7cc
--- /dev/null
+++ b/sys/gio/gki/gkifa.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_FILLAREA -- Output the fill area instruction.
+#
+# BOI GKI_FILLAREA L N P
+#    
+#        L(i)            4 + (N * 2)
+#        N(i)            number of points defining the polygon to be filled
+#        P(Np)           list of points (x,y pairs)
+
+procedure gki_fillarea (fd, points, npts)
+
+int	fd			# output file
+short	points[ARB]		# polygon defining area to be filled
+int	npts			# number of (x,y) points in polygon
+
+int	epa
+short	gki[GKI_FILLAREA_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_FILLAREA/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_FILLAREA]
+	    if (epa != 0)
+		call zcall2 (epa, points, npts)
+	} else {
+	    gki[GKI_FILLAREA_L] = GKI_FILLAREA_LEN + (npts * 2)
+	    gki[GKI_FILLAREA_N] = npts
+
+	    call write (gk_fd[fd], gki, GKI_FILLAREA_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], points, (npts * 2) * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkifaset.x b/sys/gio/gki/gkifaset.x
new file mode 100644
index 00000000..7531be73
--- /dev/null
+++ b/sys/gio/gki/gkifaset.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+include	<gio.h>
+
+# GKI_FASET -- Set the fill area attributes.
+#
+# BOI GKI_FASET L FS CI
+#
+#        L(i)            5
+#        FS(i)           fill style (0=clear,1=hollow,2=solid,3-6=hatch)
+#        CI(i)           fill area color index
+
+procedure gki_faset (fd, ap)
+
+int	fd			# output file
+pointer	ap			# pointer to fillarea attribute structure
+
+int	epa
+short	gki[GKI_FASET_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_FASET/, gki[3] /GKI_FASET_LEN/
+include	"gki.com"
+
+begin
+	gki[GKI_FASET_FS] = FA_STYLE(ap)
+	gki[GKI_FASET_CI] = FA_COLOR(ap)
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_FASET]
+	    if (epa != 0)
+		call zcall1 (epa, gki)
+	} else
+	    call write (gk_fd[fd], gki, GKI_FASET_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkifetch.x b/sys/gio/gki/gkifetch.x
new file mode 100644
index 00000000..53fa315b
--- /dev/null
+++ b/sys/gio/gki/gkifetch.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+define	LEN_DEFIBUF	2048
+define	ONEWORD		SZ_SHORT
+define	TWOWORDS	(2*SZ_SHORT)
+
+# Header fields of a GKI instruction.
+define	I_BOI		Mems[$1+GKI_HDR_BOI-1]
+define	I_OPCODE	Mems[$1+GKI_HDR_OPCODE-1]
+define	I_LENGTH	Mems[$1+GKI_HDR_LENGTH-1]
+define	I_DATA		Mems[$1+GKI_DATAFIELDS-1]
+
+# GKI_FETCH_NEXT_INSTRUCTION -- Fetch the next GKI metacode instruction from the
+# input stream.  A pointer to a short integer buffer containing the instruction
+# is returned as an output argument.  EOF is returned as the function value
+# when EOF is seen on the input stream.  The instruction buffer may be
+# deallocated by our caller at any time, if desired.  A new buffer will be
+# created automatically when next we are called.
+
+int procedure gki_fetch_next_instruction (fd, instruction)
+
+int	fd			# input file containing metacode
+pointer	instruction		# pointer to instruction (output)
+
+int	len_ibuf, nchars
+pointer	ibuf
+int	read()
+errchk	read, malloc, realloc
+data	ibuf /NULL/
+
+begin
+	# Allocate a default sized instruction buffer.  We can reallocate
+	# a larger buffer later if necessary.
+
+	if (ibuf == NULL) {
+	    call malloc (ibuf, LEN_DEFIBUF, TY_SHORT)
+	    len_ibuf = LEN_DEFIBUF
+	}
+
+	# Advance to the next instruction.  Nulls and botched portions of
+	# instructions are ignored.  Read the instruction header to determine
+	# the length of the instruction, and then read the rest of instruction
+	# into buffer.  If the entire instruction cannot be read we have a
+	# botched instruction and must try again.
+
+	repeat {
+	    repeat {
+		if (read (fd, I_BOI(ibuf), ONEWORD) == EOF)
+		    return (EOF)
+	    } until (I_BOI(ibuf) == BOI)
+
+	    if (read (fd, I_OPCODE(ibuf), TWOWORDS) == EOF)
+		return (EOF)
+	    
+	    # Make instruction buffer large enough to hold instruction.
+	    # Compute length of remainder of instruction in chars.
+
+	    if (I_LENGTH(ibuf) > len_ibuf) {
+		len_ibuf = I_LENGTH(ibuf)
+		call realloc (ibuf, len_ibuf, TY_SHORT)
+	    }
+
+	    nchars = (I_LENGTH(ibuf) - LEN_GKIHDR) * SZ_SHORT
+	    if (nchars == 0)
+		break
+
+	} until (read (fd, I_DATA(ibuf), nchars) == nchars)
+
+	instruction = ibuf
+
+	# Check for a soft end of file, otherwise return the length of the
+	# instruction as the function value.
+
+	if (I_OPCODE(ibuf) == GKI_EOF)
+	    return (EOF)
+	else
+	    return (I_LENGTH(ibuf))
+end
diff --git a/sys/gio/gki/gkifflush.x b/sys/gio/gki/gkifflush.x
new file mode 100644
index 00000000..9eebf406
--- /dev/null
+++ b/sys/gio/gki/gkifflush.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+include	<gki.h>
+
+# GKI_FFLUSH -- Flush a graphics stream.  This does not issue the GKI_FLUSH
+# graphics instruction to the graphics kernel, it merely flushes any buffered
+# data in the output stream, and is a no-op in the case of an inline kernel.
+
+procedure gki_fflush (fd)
+
+int	fd			# output file
+
+errchk	seek
+include	"gki.com"
+
+begin
+	if (IS_SUBKERNEL(fd)) {
+	    call seek (fd, BOFL)
+	    call zcall3 (gk_prpsio, KERNEL_PID(fd), fd, FF_WRITE)
+	} else if (!IS_INLINE(fd))
+	    call flush (gk_fd[fd])
+end
diff --git a/sys/gio/gki/gkiflush.x b/sys/gio/gki/gkiflush.x
new file mode 100644
index 00000000..878502d4
--- /dev/null
+++ b/sys/gio/gki/gkiflush.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<fio.h>
+include	<gki.h>
+
+# GKI_FLUSH -- Flush any buffered output.
+#
+# BOI GKI_FLUSH 0
+#    
+#        L(i)            set to the constant 3 (no data fields)
+
+procedure gki_flush (fd)
+
+int	fd			# output file
+
+int	epa
+short	gki[GKI_FLUSH_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_FLUSH/, gki[3] /LEN_GKIHDR/
+errchk	write, seek
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_FLUSH]
+	    if (epa != 0)
+		call zcall1 (epa, 0)
+	} else {
+	    call write (gk_fd[fd], gki, GKI_FLUSH_LEN * SZ_SHORT)
+
+	    # If writing to a subkernel we must call PR_PSIO to give the
+	    # kernel a chance to read the spooled metacode.
+
+	    if (IS_SUBKERNEL(fd)) {
+		call seek (fd, BOFL)
+		call zcall3 (gk_prpsio, KERNEL_PID(fd), fd, FF_WRITE)
+	    } else
+		call flush (gk_fd[fd])
+	}
+end
diff --git a/sys/gio/gki/gkigca.x b/sys/gio/gki/gkigca.x
new file mode 100644
index 00000000..07abf9d3
--- /dev/null
+++ b/sys/gio/gki/gkigca.x
@@ -0,0 +1,87 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fset.h>
+include	<fio.h>
+include	<gki.h>
+
+# GKI_GETCELLARRAY -- Input a cell array (pixel array).
+#
+# BOI GKI_GETCELLARRAY L LL UR NC NL
+#    
+#        L(i)            9
+#        LL(p)           coordinates of lower left corner of input area
+#        UR(p)           coordinates of upper right corner of input area
+#        NC(i)           number of columns in array
+#        NL(i)           number of lines in array
+
+procedure gki_getcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+
+int	fd			# output file
+int	nx, ny			# number of columns and lines in M
+short	m[nx,ny]		# output array
+int	x1, y1			# lower left corner of window to be read
+int	x2, y2			# upper right corner of window to be read
+
+int	epa, nchars, npts
+short	ca[GKI_CELLARRAY_LEN]
+short	gki[GKI_GETCELLARRAY_LEN]
+int	read()
+data	gki[1] /BOI/, gki[2] /GKI_GETCELLARRAY/, gki[3] /GKI_GETCELLARRAY_LEN/
+errchk	write, seek, flush, read
+include	"gki.com"
+
+begin
+	# If the kernel is inline it will return the cell array value in the
+	# graphics stream FIO buffer just as if the kernel were resident
+	# in another process.  We rewind the buffer after the kernel writes
+	# into it in preparation for the read below.
+
+	if (IS_INLINE(fd)) {
+	    call fseti (fd, F_CANCEL, OK)
+	    epa = gk_dd[GKI_GETCELLARRAY]
+	    if (epa != 0)
+		call zcall6 (epa, nx,ny, x1,y1, x2,y2)
+	    call seek (fd, BOFL)
+
+	} else {
+	    # Write get cell array instruction to the kernel.
+
+	    gki[GKI_GETCELLARRAY_LL]   = x1
+	    gki[GKI_GETCELLARRAY_LL+1] = y1
+	    gki[GKI_GETCELLARRAY_UR]   = x2
+	    gki[GKI_GETCELLARRAY_UR+1] = y2
+	    gki[GKI_GETCELLARRAY_NC]   = nx
+	    gki[GKI_GETCELLARRAY_NL]   = ny
+
+	    call write (gk_fd[fd], gki, GKI_GETCELLARRAY_LEN)
+
+	    # If the kernel is a subprocess we must call PR_PSIO to allow the
+	    # kernel to read the instruction and return the cell array value.
+
+	    if (IS_SUBKERNEL(fd)) {
+		call seek (fd, BOFL)
+		call zcall3 (gk_prpsio, KERNEL_PID(fd), fd, FF_READ)
+		call seek (fd, BOFL)
+	    } else
+		call flush (gk_fd[fd])
+	}
+
+	# Read and decode the cell array value.
+
+	nchars = GKI_CELLARRAY_LEN * SZ_SHORT
+	if (read (fd, ca, nchars) < nchars) {
+	    call syserr (SYS_GGCELL)
+	} else if (ca[1] != BOI || ca[2] != GKI_CELLARRAY ||
+	    ca[GKI_CELLARRAY_NP] <= 0) {
+	    call syserr (SYS_GGCELL)
+	} else {
+	    npts = ca[GKI_CELLARRAY_NP]
+	    nchars = min (nx * ny, npts) * SZ_SHORT
+	    if (read (fd, m, nchars) < nchars)
+		call syserr (SYS_GGCELL)
+	}
+
+	call fseti (fd, F_CANCEL, OK)
+end
diff --git a/sys/gio/gki/gkigcur.x b/sys/gio/gki/gkigcur.x
new file mode 100644
index 00000000..e87e030e
--- /dev/null
+++ b/sys/gio/gki/gkigcur.x
@@ -0,0 +1,106 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<fset.h>
+include	<fio.h>
+include	<gki.h>
+
+# GKI_GETCURSOR -- Read the cursor position in device coordinates.
+#
+# BOI GKI_GETCURSOR L CN
+#
+#        L(i)            4
+#        CN(i)           cursor number
+#
+#        The kernel reads graphics  cursor  number  CN  and  returns  the
+#        keystroke  value  (if  any)  and  the  cursor  position  in  NDC 
+#        coordinates.   The  cursor  attributes  are  returned   in   the 
+#        following format:
+#
+#                BOI GKI_CURSORVALUE L CN KEY SX SY RN RX RY
+#
+#        where
+#
+#                L(i)            10
+#                CN(i)           cursor number
+#                KEY(i)          keystroke value (>= 0 or EOF)
+#                SX(i)           NDC X screen coordinate of cursor
+#                SY(i)           NDC Y screen coordinate of cursor
+#                RN(i)           raster number or zero
+#                RX(i)           NDC X raster coordinate of cursor
+#                RY(i)           NDC Y raster coordinate of cursor
+#
+# The screen or display window coordinates SX and SY of the cursor are
+# returned for all devices.  Only some devices support multiple rasters.
+# If the device supports rasters and the cursor is in a rasters when read, the
+# rasters number and rasters coordinates are returned in RN,RX,RY.  This is in
+# addition to the screen coordinates SX,SY.  If rasters coordinates are not
+# returned, the rasters number will be set to zero and RX,RY will be the same
+# as SX,SY.
+
+procedure gki_getcursor (fd, cursor, cn, key, sx, sy, raster, rx, ry)
+
+int	fd			#I output file
+int	cursor			#I cursor to be read
+int	cn			#O cursor number actually read
+int	key			#O keystroke value or EOF
+int	sx, sy			#O screen coordinates of cursor
+int	raster			#O raster number
+int	rx, ry			#O raster coordinates of cursor
+
+int	epa
+int	nchars, read()
+short	gki[GKI_GETCURSOR_LEN]
+short	cur[GKI_CURSORVALUE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_GETCURSOR/, gki[3] /GKI_GETCURSOR_LEN/
+include	"gki.com"
+errchk	write, flush, read
+
+begin
+	# If the kernel is inline it will return the cursor value in the
+	# graphics stream FIO buffer just as if the kernel were resident
+	# in another process.  We rewind the buffer after the kernel writes
+	# into it in preparation for the read below.
+
+	if (IS_INLINE(fd)) {
+	    call fseti (fd, F_CANCEL, OK)
+	    epa = gk_dd[GKI_GETCURSOR]
+	    if (epa != 0)
+		call zcall1 (epa, cursor)
+	    call seek (fd, BOFL)
+
+	} else {
+	    # Write cursor read instruction to the kernel.
+	    gki[GKI_GETCURSOR_CN] = cursor
+	    call write (gk_fd[fd], gki, GKI_GETCURSOR_LEN * SZ_SHORT)
+
+	    # If the kernel is a subprocess we must call PR_PSIO to allow the
+	    # kernel to read the instruction and return the cursor value.
+
+	    if (IS_SUBKERNEL(fd)) {
+		call seek (fd, BOFL)
+		call zcall3 (gk_prpsio, KERNEL_PID(fd), fd, FF_READ)
+		call seek (fd, BOFL)
+	    } else
+		call flush (gk_fd[fd])
+	}
+
+	# Read and decode the cursor value instruction.
+	nchars = GKI_CURSORVALUE_LEN * SZ_SHORT
+	if (read (fd, cur, nchars) < nchars)
+	    key = EOF
+	else if (cur[1] != BOI || cur[2] != GKI_CURSORVALUE)
+	    call syserr (SYS_GGCUR)
+	else {
+	    cn     = cur[GKI_CURSORVALUE_CN]
+	    key    = cur[GKI_CURSORVALUE_KEY]
+	    sx     = cur[GKI_CURSORVALUE_SX]
+	    sy     = cur[GKI_CURSORVALUE_SY]
+	    raster = cur[GKI_CURSORVALUE_RN]
+	    rx     = cur[GKI_CURSORVALUE_RX]
+	    ry     = cur[GKI_CURSORVALUE_RY]
+	}
+
+	call fseti (fd, F_CANCEL, OK)
+end
diff --git a/sys/gio/gki/gkigetwcs.x b/sys/gio/gki/gkigetwcs.x
new file mode 100644
index 00000000..f6aa07c2
--- /dev/null
+++ b/sys/gio/gki/gkigetwcs.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<gki.h>
+
+# GKI_GETWCS -- Retrieve the WCS from the CL process.  Used when opening a
+# (non-metafile) device in append mode.
+#
+# BOI GKI_GETWCS L N
+#
+#        L(i)           3
+#	 N(i)		number of words of WCS data to be read
+
+procedure gki_getwcs (fd, wcs, len_wcs)
+
+int	fd			# input/output file
+int	wcs[ARB]		# array of WCS structures (output)
+int	len_wcs			# number of ints (struct units) in array
+
+int	nchars, nwords, read()
+short	gki[GKI_GETWCS_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_GETWCS/, gki[3] /GKI_GETWCS_LEN/
+errchk	syserr, read, write, flush
+include	"gki.com"
+
+begin
+	nwords = (len_wcs * SZ_INT / SZ_SHORT)
+	gki[GKI_GETWCS_N] = nwords
+
+	# Request CL to send SETWCS instruction back to us.  The directive
+	# must be sent on the pseudofile control stream.
+
+	call write (PSIOCTRL, fd, SZ_INT32)
+	call write (PSIOCTRL, gki, GKI_GETWCS_LEN * SZ_SHORT)
+	call flush (PSIOCTRL)
+
+	# Read the wcs data.  This is returned on the process CLIN channel 
+	# by the CL.
+
+	nchars = nwords * SZ_SHORT
+	if (read (CLIN, wcs, nchars) != nchars)
+	    call syserr (SYS_GGETWCS)
+end
diff --git a/sys/gio/gki/gkiinit.x b/sys/gio/gki/gkiinit.x
new file mode 100644
index 00000000..0813a708
--- /dev/null
+++ b/sys/gio/gki/gkiinit.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_INIT -- Initialize GKI i/o on a graphics stream.  Called by GOPEN to
+# make the connection to either a metacode stream file or an inline kernel.
+# If the stream has already been directed to a kernel we do nothing, else
+# we initialize the stream as for a metacode file or remote kernel.  If
+# gki_inline is called before gopen then this procedure is a nop.
+
+procedure gki_init (stream)
+
+int	stream			# graphics stream to be redirected
+include	"gki.com"
+
+begin
+	if (gk_type[stream] == NULL) {
+	    gk_type[stream] = TY_FILE
+	    gk_fd[stream] = stream
+	}
+end
diff --git a/sys/gio/gki/gkiinline.x b/sys/gio/gki/gkiinline.x
new file mode 100644
index 00000000..87fc1f29
--- /dev/null
+++ b/sys/gio/gki/gkiinline.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_INLINE_KERNEL -- Identify a graphics stream for use with an inline
+# kernel, i.e., with a kernel linked into the same process as the high level
+# code which calls the GKI procedures.  At present there may be at most one
+# inline kernel at a time.  The entry point addresses of the kernel procedures
+# are passed in the array DD.  Subsequent GKI calls for the named stream will
+# result in direct calls to the inline kernel without encoding and decoding
+# GKI instructions, hence this is the most efficient mode of operation.
+
+procedure gki_inline_kernel (stream, dd)
+
+int	stream			# graphics stream to be redirected
+int	dd[ARB]			# device driver for the kernel
+include	"gki.com"
+
+begin
+	gk_type[stream] = TY_INLINE
+	call amovi (dd, gk_dd, LEN_GKIDD)
+end
diff --git a/sys/gio/gki/gkikern.x b/sys/gio/gki/gkikern.x
new file mode 100644
index 00000000..95c8e648
--- /dev/null
+++ b/sys/gio/gki/gkikern.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_SUBKERNEL -- Identify a graphics stream for use with a kernel in a
+# connected subprocess of the current process.  This type of kernel is
+# equivalent to a file for all of the output instructions, but the input
+# instructions (e.g., read cursor) must fiddle with process i/o and need
+# additional information to do so, i.e., the process id number of the kernel
+# process, and the entry point address of the PR_PSIO procedure.  We do not
+# wish to directly reference the latter procedure as this would require
+# all processes which use GKI to link in the process control code, even if
+# they never talk directly to a process.  Note that processes which talk to
+# an external kernel via the CL do so with the normal file interface, hence
+# do not need to call us.  We are called by the GIOTR (cursor mode) code in
+# the CL process when an external kernel is spawned.
+
+procedure gki_subkernel (stream, pid, prpsio_epa)
+
+int	stream			# graphics stream to be redirected
+int	pid			# process id of kernel process
+int	prpsio_epa		# epa of the etc$prpsio procedure.
+include	"gki.com"
+
+begin
+	gk_type[stream] = pid
+	gk_fd[stream] = stream
+	gk_prpsio = prpsio_epa
+end
diff --git a/sys/gio/gki/gkiopen.x b/sys/gio/gki/gkiopen.x
new file mode 100644
index 00000000..562ed8c3
--- /dev/null
+++ b/sys/gio/gki/gkiopen.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_OPENWS -- Open workstation.
+#
+# BOI GKI_OPENWS L M N D
+#    
+#        L(i)            5 + N
+#        M(i)            access mode (APPEND=4, NEW_FILE=5, TEE=6)
+#        N(i)            number of characters in field D
+#        D(Nc)           device name as in graphcap file
+
+procedure gki_openws (fd, device, mode)
+
+int	fd			# output file
+char	device[ARB]		# device name
+int	mode			# access mode
+
+int	ip, n, epa, nchars
+pointer	sp, gki, op
+int	strlen()
+include	"gki.com"
+
+begin
+	call smark (sp)
+
+	n = strlen (device)
+	call salloc (gki, GKI_OPENWS_LEN + n, TY_SHORT)
+
+	# Pack the device name as a SHORT integer array.
+	op = gki + GKI_OPENWS_D - 1
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    Mems[op] = device[ip]
+	    op = op + 1
+	}
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_OPENWS]
+	    if (epa != 0)
+		call zcall3 (epa, Mems[gki+GKI_OPENWS_D-1], n, mode)
+	} else {
+	    Mems[gki  ] = BOI
+	    Mems[gki+1] = GKI_OPENWS
+	    Mems[gki+2] = GKI_OPENWS_LEN + n
+	    Mems[gki+GKI_OPENWS_M-1] = mode
+	    Mems[gki+GKI_OPENWS_N-1] = n
+
+	    # Send a copy of the open workstation directive to PSIOCTRL in
+	    # the CL process to connect the graphics stream to a kernel,
+	    # before writing to the graphics stream.  The GKI instruction
+	    # must be preceded by the integer value of the stream number.
+
+	    nchars = (GKI_OPENWS_LEN + n) * SZ_SHORT
+	    if (IS_FILE(fd) && (fd >= STDGRAPH && fd <= STDPLOT)) {
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, Mems[gki], nchars)
+		call flush (PSIOCTRL)
+	    }
+
+	    # Now send a copy to the graphics kernel.
+	    call write (gk_fd[fd], Mems[gki], nchars)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gki/gkipca.x b/sys/gio/gki/gkipca.x
new file mode 100644
index 00000000..b2cf30ab
--- /dev/null
+++ b/sys/gio/gki/gkipca.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_PUTCELLARRAY -- Output a cell array (pixel array).
+#
+# BOI GKI_PUTCELLARRAY L LL UR NC NL P
+#    
+#        L(i)            9 + (NC * NL)
+#        LL(p)           coordinates of lower left corner of output area
+#        UR(p)           coordinates of upper right corner of output area
+#        NC(i)           number of columns in array
+#        NL(i)           number of lines in array
+#        P(NCNLi)        array of color indices (pixels) stored by row
+
+procedure gki_putcellarray (fd, m, nx, ny, x1,y1, x2,y2)
+
+int	fd			# output file
+int	nx, ny			# number of columns and lines in M
+short	m[nx,ny]		# pixel array
+int	x1, y1			# lower left corner of window to be written
+int	x2, y2			# upper right corner of window to be written
+
+int	epa
+short	gki[GKI_PUTCELLARRAY_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_PUTCELLARRAY/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_PUTCELLARRAY]
+	    if (epa != 0)
+		call zcall7 (epa, m, nx,ny, x1,y1, x2,y2)
+	} else {
+	    gki[GKI_PUTCELLARRAY_L]    = GKI_PUTCELLARRAY_LEN + (nx * ny)
+	    gki[GKI_PUTCELLARRAY_LL]   = x1
+	    gki[GKI_PUTCELLARRAY_LL+1] = y1
+	    gki[GKI_PUTCELLARRAY_UR]   = x2
+	    gki[GKI_PUTCELLARRAY_UR+1] = y2
+	    gki[GKI_PUTCELLARRAY_NC]   = nx
+	    gki[GKI_PUTCELLARRAY_NL]   = ny
+
+	    call write (gk_fd[fd], gki, GKI_PUTCELLARRAY_LEN)
+	    call write (gk_fd[fd], m, (nx * ny) * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkipl.x b/sys/gio/gki/gkipl.x
new file mode 100644
index 00000000..7d36b749
--- /dev/null
+++ b/sys/gio/gki/gkipl.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_POLYLINE -- Output a polyline.
+#
+# BOI GKI_POLYLINE L N P
+#    
+#        L(i)            4 + (N * 2)
+#        N(i)            number of points in the polyline
+#        P(Np)           list of points (x,y pairs)
+
+procedure gki_polyline (fd, points, npts)
+
+int	fd			# output file
+short	points[ARB]		# polyline
+int	npts			# number of (x,y) points in polyline
+
+int	epa
+short	gki[GKI_POLYLINE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_POLYLINE/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_POLYLINE]
+	    if (epa != 0)
+		call zcall2 (epa, points, npts)
+	} else {
+	    gki[GKI_POLYLINE_L] = GKI_POLYLINE_LEN + (npts * 2)
+	    gki[GKI_POLYLINE_N] = npts
+
+	    call write (gk_fd[fd], gki, GKI_POLYLINE_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], points, (npts * 2) * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkiplset.x b/sys/gio/gki/gkiplset.x
new file mode 100644
index 00000000..1a7b092f
--- /dev/null
+++ b/sys/gio/gki/gkiplset.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+include	<gio.h>
+
+# GKI_PLSET -- Set the polyline attributes.
+#
+# BOI GKI_PLSET L LT LW CI
+#
+#        L(i)            6
+#        LT(i)           linetype number
+#        LW(r)           linewidth scale factor
+#        CI(i)           polyline color index
+
+procedure gki_plset (fd, ap)
+
+int	fd			# output file
+pointer	ap			# pointer to polyline attribute structure
+
+int	epa
+short	gki[GKI_PLSET_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_PLSET/, gki[3] /GKI_PLSET_LEN/
+include	"gki.com"
+
+begin
+	gki[GKI_PLSET_LT] = PL_LTYPE(ap)
+	gki[GKI_PLSET_LW] = GKI_PACKREAL (PL_WIDTH(ap))
+	gki[GKI_PLSET_CI] = PL_COLOR(ap)
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_PLSET]
+	    if (epa != 0)
+		call zcall1 (epa, gki)
+	} else
+	    call write (gk_fd[fd], gki, GKI_PLSET_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkipm.x b/sys/gio/gki/gkipm.x
new file mode 100644
index 00000000..ea493b54
--- /dev/null
+++ b/sys/gio/gki/gkipm.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_POLYMARKER -- Output a polymarker.
+#
+# BOI GKI_POLYMARKER L N P
+#    
+#        L(i)            4 + (N * 2)
+#        N(i)            number of points in the polymarker
+#        P(Np)           list of points (x,y pairs)
+
+procedure gki_polymarker (fd, points, npts)
+
+int	fd			# output file
+short	points[ARB]		# polymarker
+int	npts			# number of (x,y) points in polymarker
+
+int	epa
+short	gki[GKI_POLYMARKER_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_POLYMARKER/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_POLYMARKER]
+	    if (epa != 0)
+		call zcall2 (epa, points, npts)
+	} else {
+	    gki[GKI_POLYMARKER_L] = GKI_POLYMARKER_LEN + (npts * 2)
+	    gki[GKI_POLYMARKER_N] = npts
+
+	    call write (gk_fd[fd], gki, GKI_POLYMARKER_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], points, (npts * 2) * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkipmset.x b/sys/gio/gki/gkipmset.x
new file mode 100644
index 00000000..7bdc27ac
--- /dev/null
+++ b/sys/gio/gki/gkipmset.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+include	<gio.h>
+
+# GKI_PMSET -- Set the polymarker attributes.
+#
+# BOI GKI_PMSET L MT MW CI
+#
+#        L(i)            6
+#        MT(i)           marktype (not used at present)
+#        MW(i)           marksize, NDC coords (not used at present)
+#        CI(i)           marker color index
+
+procedure gki_pmset (fd, ap)
+
+int	fd			# output file
+pointer	ap			# pointer to polymarker attribute structure
+
+int	epa
+short	gki[GKI_PMSET_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_PMSET/, gki[3] /GKI_PMSET_LEN/
+include	"gki.com"
+
+begin
+	gki[GKI_PMSET_MT] = PM_LTYPE(ap)
+	gki[GKI_PMSET_MW] = GKI_PACKREAL (PM_WIDTH(ap))
+	gki[GKI_PMSET_CI] = PM_COLOR(ap)
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_PMSET]
+	    if (epa != 0)
+		call zcall1 (epa, gki)
+	} else
+	    call write (gk_fd[fd], gki, GKI_PMSET_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiprint.x b/sys/gio/gki/gkiprint.x
new file mode 100644
index 00000000..14e623bd
--- /dev/null
+++ b/sys/gio/gki/gkiprint.x
@@ -0,0 +1,820 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<mach.h>
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+
+.help gkiprint
+.nf __________________________________________________________________________
+GKIPRINT -- Graphics kernel for decoding metacode.  This graphics kernel
+formats metacode instructions into readable form and prints them on the output
+file.  The gkiprint kernel is useful for examining metafiles and for
+debugging kernels which drive specific devices.  The driver consists of the
+following procedures:
+
+	     gkp_openws (devname, n, mode)
+	    gkp_closews (devname, n)
+       gkp_deactivatews (flags)
+       gkp_reactivatews (flags)
+	    gkp_mftitle (title, n)			**
+	      gkp_clear (dummy)
+	     gkp_cancel (dummy)
+	      gkp_flush (dummy)
+	   gkp_polyline (p, npts)
+	 gkp_polymarker (p, npts)
+	       gkp_text (x, y, text, n)
+	   gkp_fillarea (p, npts)
+       gkp_getcellarray (m, nx, ny, x1,y1, x2,y2)
+       gkp_putcellarray (m, nx, ny, x1,y1, x2,y2)
+	  gkp_setcursor (x, y, cursor)
+	      gkp_plset (gki)
+	      gkp_pmset (gki)
+	      gkp_txset (gki)
+	      gkp_faset (gki)
+	  gkp_getcursor (cursor)
+	     gkp_escape (fn, instruction, nwords)	**
+	     gkp_setwcs (wcs, nwords)			**
+	     gkp_getwcs (wcs, nwords)			**
+	    gkp_unknown (gki)				**
+
+A GKI driven device driver may implement any subset of these procedures.
+The starred procedures should be omitted by most drivers.  In particular,
+the SETWCS and GETWCS instructions are internal instructions which should
+be ignored by ordinary device drivers.  The procedure names may be anything,
+but the arguments lists must be as shown.  All coordinates are in GKI units,
+0 to 32767.  Character strings are passed in ASCII, one character per metacode
+word.  Whenever a GKI character string appears as an array argument in the
+argument list of a procedure, the count N of the number of characters in the
+string follows as the next argument.  GKI character strings are not EOS
+delimited.  Polyline, polymarker, and fillarea data is passed as an array
+of (x,y) points P, in GKI coordinates, defining the polyline or polygon to
+be plotted.
+
+One additional procedure, GKP_INSTALL, is called by the main program of the
+graphics kernel task to install the debugging driver, i.e., to fill the DD
+array with the entry point addresses of the driver procedures.  For a normal
+driver this function is performed by a user supplied procedure named
+GKOPEN (graphics kernel open).  The user supplied kernel procedures will
+be called to execute each instruction as the instructions are decoded by the
+main routine.  The user supplied procedure GKCLOSE will be called when
+interpretation ends and the task is about to exit.
+
+		 gkopen (dd)
+		gkclose ()
+
+Do not confuse GKOPEN and GKCLOSE, which open and close the graphics kernel,
+with GKI_OPENWS and GKI_CLOSEWS, the metacode instructions used to direct
+an opened kernel to open and close workstations.
+.endhelp ___________________________________________________________________
+
+
+# GKP_INSTALL -- Install the GKI debugging kernel as a graphics kernel
+# device driver.  The device table DD consists of an array of the entry
+# point addresses for the driver procedures.  If a driver does not implement
+# a particular instruction the table entry for that procedure may be set
+# to zero, causing the interpreter to ignore the instruction.
+
+procedure gkp_install (dd, out_fd, verbose_output, use_gkiunits)
+
+int	dd[ARB]			# device table to be initialized
+int	out_fd			# output file
+int	verbose_output		# verbose output desired
+int	use_gkiunits		# print coords in GKI units rather than NDC
+
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+extern	gkp_openws(), gkp_closews(), gkp_mftitle(), gkp_clear(), gkp_cancel()
+extern	gkp_flush(), gkp_polyline(), gkp_polymarker(), gkp_text()
+extern	gkp_fillarea(), gkp_putcellarray(), gkp_setcursor(), gkp_plset()
+extern	gkp_pmset(), gkp_txset(), gkp_faset(), gkp_getcursor()
+extern	gkp_getcellarray(), gkp_escape(), gkp_setwcs(), gkp_getwcs()
+extern	gkp_unknown(), gkp_reactivatews(), gkp_deactivatews()
+
+begin
+	# Set the GDC internal parameters.
+	fd = out_fd
+	stream = NULL
+	gkiunits = use_gkiunits
+	verbose = verbose_output
+
+	# Install the device driver.
+	call zlocpr (gkp_openws,	dd[GKI_OPENWS])
+	call zlocpr (gkp_closews,	dd[GKI_CLOSEWS])
+	call zlocpr (gkp_reactivatews,	dd[GKI_REACTIVATEWS])
+	call zlocpr (gkp_deactivatews,	dd[GKI_DEACTIVATEWS])
+	call zlocpr (gkp_mftitle,	dd[GKI_MFTITLE])
+	call zlocpr (gkp_clear,		dd[GKI_CLEAR])
+	call zlocpr (gkp_cancel,	dd[GKI_CANCEL])
+	call zlocpr (gkp_flush,		dd[GKI_FLUSH])
+	call zlocpr (gkp_polyline,	dd[GKI_POLYLINE])
+	call zlocpr (gkp_polymarker,	dd[GKI_POLYMARKER])
+	call zlocpr (gkp_text,		dd[GKI_TEXT])
+	call zlocpr (gkp_fillarea,	dd[GKI_FILLAREA])
+	call zlocpr (gkp_putcellarray,	dd[GKI_PUTCELLARRAY])
+	call zlocpr (gkp_setcursor,	dd[GKI_SETCURSOR])
+	call zlocpr (gkp_plset,		dd[GKI_PLSET])
+	call zlocpr (gkp_pmset,		dd[GKI_PMSET])
+	call zlocpr (gkp_txset,		dd[GKI_TXSET])
+	call zlocpr (gkp_faset,		dd[GKI_FASET])
+	call zlocpr (gkp_getcursor,	dd[GKI_GETCURSOR])
+	call zlocpr (gkp_getcellarray,	dd[GKI_GETCELLARRAY])
+	call zlocpr (gkp_escape,	dd[GKI_ESCAPE])
+	call zlocpr (gkp_setwcs,	dd[GKI_SETWCS])
+	call zlocpr (gkp_getwcs,	dd[GKI_GETWCS])
+	call zlocpr (gkp_unknown,	dd[GKI_UNKNOWN])
+end
+
+
+# GKP_CLOSE -- Close the GKP kernel.
+
+procedure gkp_close()
+begin
+end
+
+
+# GKP_GRSTREAM -- Set the FD of the graphics stream, from which we shall read
+# metacode instructions and to which we shall return cell arrays and cursor
+# values.
+
+procedure gkp_grstream (graphics_stream)
+
+int	graphics_stream		# FD of the new graphics stream
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	stream = graphics_stream
+end
+
+
+# GKP_OPENWS -- Open the named workstation.
+
+procedure gkp_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+int	junk
+pointer	sp, buf
+int	itoc()
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_FNAME, n), TY_CHAR)
+
+	call achtsc (devname, Memc[buf], n)
+	Memc[buf+n] = EOS
+
+	call fprintf (fd, "open_workstation '%s', mode=%s\n")
+	    call pargstr (Memc[buf])
+	    switch (mode) {
+	    case NEW_FILE:
+		call pargstr ("new_file")
+	    case APPEND:
+		call pargstr ("append")
+	    default:
+		junk = itoc (mode, Memc[buf], SZ_FNAME)
+	    }
+	
+	call sfree (sp)
+end
+
+
+# GKP_CLOSEWS -- Close the named workstation.
+
+procedure gkp_closews (devname, n)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+pointer	sp, buf
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (buf, n, TY_CHAR)
+
+	call achtsc (devname, Memc[buf], n)
+	Memc[buf+n] = EOS
+
+	call fprintf (fd, "close_workstation '%s'\n")
+	    call pargstr (Memc[buf])
+	call flush (fd)
+	
+	call sfree (sp)
+end
+
+
+# GKP_REACTIVATEWS -- Reactivate the workstation (enable graphics).
+
+procedure gkp_reactivatews (flags)
+
+int	flags			# action flags
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "reactivatews %d\n")
+	    call pargi (flags)
+end
+
+
+# GKP_DEACTIVATEWS -- Deactivate the workstation (disable graphics).
+
+procedure gkp_deactivatews (flags)
+
+int	flags			# action flags
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "deactivatews %d\n")
+	    call pargi (flags)
+	call flush (fd)
+end
+
+
+# GKP_MFTITLE -- Metafile title or comment.  A nonfunctional instruction used
+# to document a metafile.
+
+procedure gkp_mftitle (title, n)
+
+short	title[ARB]		# title string
+int	n			# length of title string
+pointer	sp, buf
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (buf, n, TY_CHAR)
+
+	call achtsc (title, Memc[buf], n)
+	Memc[buf+n] = EOS
+
+	call fprintf (fd, "title '%s'\n")
+	    call pargstr (Memc[buf])
+	
+	call sfree (sp)
+end
+
+
+# GKP_CLEAR -- Clear the workstation screen.
+
+procedure gkp_clear (dummy)
+
+int	dummy			# not used at present
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "clear\n")
+end
+
+
+# GKP_CANCEL -- Cancel output.
+
+procedure gkp_cancel (dummy)
+
+int	dummy			# not used at present
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "cancel\n")
+	call flush (fd)
+end
+
+
+# GKP_FLUSH -- Flush output.
+
+procedure gkp_flush (dummy)
+
+int	dummy			# not used at present
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "flush\n")
+	call flush (fd)
+end
+
+
+# GKP_POLYLINE -- Draw a polyline.
+
+procedure gkp_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	# Print statistics on polyline.
+	call gkp_pstat (fd, p, npts, "polyline", verbose, gkiunits)
+end
+
+
+# GKP_POLYMARKER -- Draw a polymarker.
+
+procedure gkp_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	# Print statistics on polymarker.
+	call gkp_pstat (fd, p, npts, "polymarker", verbose, gkiunits)
+end
+
+
+# GKP_FILLAREA -- Fill a closed area.
+
+procedure gkp_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	# Print statistics on the fillarea polygon.
+	call gkp_pstat (fd, p, npts, "fillarea", verbose, gkiunits)
+end
+
+
+# GKP_TEXT -- Draw a text string.
+
+procedure gkp_text (x, y, text, n)
+
+int	x, y			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+pointer	sp, buf
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (buf, n, TY_CHAR)
+
+	call achtsc (text, Memc[buf], n)
+	Memc[buf+n] = EOS
+
+	if (gkiunits == YES) {
+	    call fprintf (fd, "text %5d, %5d, '%s'\n")
+		call pargi (x)
+		call pargi (y)
+		call pargstr (Memc[buf])
+	} else {
+	    call fprintf (fd, "text %4.2f, %4.2f, '%s'\n")
+		call pargr (real(x) / GKI_MAXNDC)
+		call pargr (real(y) / GKI_MAXNDC)
+		call pargstr (Memc[buf])
+	}
+	
+	call sfree (sp)
+end
+
+
+# GKP_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure gkp_putcellarray (m, nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+short	m[nx,ny]		# cell array
+int	x1, y1			# lower left corner of output window
+int	x2, y2			# lower left corner of output window
+
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "put_cellarray nx=%d, ny=%d, ")
+	    call pargi (nx)
+	    call pargi (ny)
+
+	if (gkiunits == YES) {
+	    call fprintf (fd, "x1=%5d, y1=%5d, x2=%5d, y2=%5d\n")
+		call pargi (x1)
+		call pargi (y1)
+		call pargi (x2)
+		call pargi (y2)
+	} else {
+	    call fprintf (fd, "x1=%4.2f, y1=%4.2f, x2=%4.2f, y2=%4.2f\n")
+		call pargr (real(x1) / GKI_MAXNDC)
+		call pargr (real(y1) / GKI_MAXNDC)
+		call pargr (real(x2) / GKI_MAXNDC)
+		call pargr (real(y2) / GKI_MAXNDC)
+	}
+
+	if (verbose == YES)
+	    call gkp_dump (fd, m, (nx * ny))
+end
+
+
+# GKP_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure gkp_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+pointer	sp, buf
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "get_cellarray nx=%d, ny=%d, ")
+	    call pargi (nx)
+	    call pargi (ny)
+
+	if (gkiunits == YES) {
+	    call fprintf (fd, "x1=%5d, y1=%5d, x2=%5d, y2=%5d\n")
+		call pargi (x1)
+		call pargi (y1)
+		call pargi (x2)
+		call pargi (y2)
+	} else {
+	    call fprintf (fd, "x1=%4.2f, y1=%4.2f, x2=%4.2f, y2=%4.2f\n")
+		call pargr (real(x1) / GKI_MAXNDC)
+		call pargr (real(y1) / GKI_MAXNDC)
+		call pargr (real(x2) / GKI_MAXNDC)
+		call pargr (real(y2) / GKI_MAXNDC)
+	}
+
+	if (stream == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (buf, nx * ny, TY_SHORT)
+	call amovks (short(-1), Mems[buf], nx * ny)
+
+	call flush (fd)
+	iferr {
+	    call gki_retcellarray (stream, Mems[buf], nx * ny) 
+	    call flush (stream)
+	} then
+	    ;
+	
+	call sfree (sp)
+end
+
+
+# GKP_SETCURSOR -- Set the position of a cursor.
+
+procedure gkp_setcursor (x, y, cursor)
+
+int	x, y			# new position of cursor
+int	cursor			# cursor to be set
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	if (gkiunits == YES) {
+	    call fprintf (fd, "set_cursor %5d, %5d, cursor=%d\n")
+		call pargi (x)
+		call pargi (y)
+		call pargi (cursor)
+	} else {
+	    call fprintf (fd, "set_cursor %4.2f, %4.2f, cursor=%d\n")
+		call pargr (real(x) / GKI_MAXNDC)
+		call pargr (real(y) / GKI_MAXNDC)
+		call pargi (cursor)
+	}
+end
+
+
+# GKP_GETCURSOR -- Get the position of a cursor.
+
+procedure gkp_getcursor (cursor)
+
+int	cursor
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "get_cursor cursor=%d\n")
+	    call pargi (cursor)
+	call flush (fd)
+
+	if (stream != NULL)
+	    iferr {
+		# gki_retcursorvalue (stream, cn, key, sx, sy, rn, rx, ry)
+		call gki_retcursorvalue (stream, 0, EOF, 0, 0, 0, 0, 0)
+		call flush (stream)
+	    } then
+		;
+end
+
+
+# GKP_PLSET -- Set the polyline attributes.
+
+procedure gkp_plset (gki)
+
+short	gki[ARB]		# attribute structure
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "set_polyline ltype=%d, lwidth=%0.2f, color=%d\n")
+	    call pargs (gki[GKI_PLSET_LT])
+	    call pargr (GKI_UNPACKREAL (gki[GKI_PLSET_LW]))
+	    call pargs (gki[GKI_PLSET_CI])
+end
+
+
+# GKP_PMSET -- Set the polymarker attributes.
+
+procedure gkp_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "set_polymarker mtype=%d, mwidth=%0.2f, color=%d\n")
+	    call pargs (gki[GKI_PMSET_MT])
+	    call pargr (GKI_UNPACKREAL (gki[GKI_PMSET_MW]))
+	    call pargs (gki[GKI_PMSET_CI])
+end
+
+
+# GKP_FASET -- Set the fillarea attributes.
+
+procedure gkp_faset (gki)
+
+short	gki[ARB]		# attribute structure
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "set_fillarea style=%d, color=%d\n")
+	    call pargs (gki[GKI_FASET_FS])
+	    call pargs (gki[GKI_FASET_CI])
+end
+
+
+# GKP_TXSET -- Set the text drawing attributes.
+
+procedure gkp_txset (gki)
+
+short	gki[ARB]		# attribute structure
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "set_text up=%d, path=%d, hjustify=%s, ")
+	    call pargs (gki[GKI_TXSET_UP])
+	    call gkp_txparg (gki[GKI_TXSET_P])
+	    call gkp_txparg (gki[GKI_TXSET_HJ])
+	call fprintf (fd, "vjustify=%s, font=%s,\n")
+	    call gkp_txparg (gki[GKI_TXSET_VJ])
+	    call gkp_txparg (gki[GKI_TXSET_F])
+
+	call fprintf (fd, "\tsize=%0.2f, spacing=%0.2f, color=%d, quality=%s\n")
+	    call pargr (GKI_UNPACKREAL (gki[GKI_TXSET_SZ]))
+	    call pargr (GKI_UNPACKREAL (gki[GKI_TXSET_SP]))
+	    call pargs (gki[GKI_TXSET_CI])
+	    call gkp_txparg (gki[GKI_TXSET_Q])
+end
+
+
+# GKP_ESCAPE -- Device dependent instruction.
+
+procedure gkp_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "escape %d, nwords=%d\n")
+	    call pargi (fn)
+	    call pargi (nwords)
+
+	# Dump the instruction.
+	if (verbose == YES)
+	    call gkp_dump (fd, instruction, nwords)
+end
+
+
+# GKP_SETWCS -- Set the world coordinate systems.  Internal GIO instruction.
+
+procedure gkp_setwcs (wcs, nwords)
+
+short	wcs[ARB]		# WCS data
+int	nwords			# number of words of data
+
+int	i, nwcs
+pointer	sp, wcs_temp, w
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call smark (sp)
+	call salloc (wcs_temp, LEN_WCSARRAY, TY_STRUCT)
+
+	call fprintf (fd, "set_wcs nwords=%d\n")
+	    call pargi (nwords)
+
+	nwcs = nwords * SZ_SHORT / SZ_STRUCT / LEN_WCS
+	if (verbose == YES && nwcs > 1) {
+	    call amovi (wcs, Memi[wcs_temp], nwcs * LEN_WCS)
+
+	    do i = 1, nwcs {
+		w = ((i - 1) * LEN_WCS) + wcs_temp
+		if ((WCS_WX1(w) > EPSILON) ||
+		    (abs(1.0 - WCS_WX2(w)) > EPSILON) ||
+		    (WCS_WY1(w) > EPSILON) ||
+		    (abs(1.0 - WCS_WY2(w)) > EPSILON)) {
+
+		    call fprintf (fd, "\t%2d %g %g %g %g  ")
+			call pargi (i)
+			call pargr (WCS_WX1(w))
+			call pargr (WCS_WX2(w))
+			call pargr (WCS_WY1(w))
+			call pargr (WCS_WY2(w))
+
+		    call fprintf (fd, "%4.2f %4.2f %4.2f %4.2f  ")
+			call pargr (WCS_SX1(w))
+			call pargr (WCS_SX2(w))
+			call pargr (WCS_SY1(w))
+			call pargr (WCS_SY2(w))
+
+		    call fprintf (fd, "%d %d %d\n")
+			call pargi (WCS_XTRAN(w))
+			call pargi (WCS_YTRAN(w))
+			call pargi (WCS_CLIP(w))
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# GKP_GETWCS -- Get the world coordinate systems.  Internal GIO instruction.
+
+procedure gkp_getwcs (wcs, nwords)
+
+short	wcs[ARB]		# WCS data
+int	nwords			# number of words of data
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "get_wcs nwords=%d\n")
+	    call pargi (nwords)
+end
+
+
+# GKP_UNKNOWN -- The unknown instruction.  Called by the interpreter whenever
+# an unrecognized opcode is encountered.  Should never be called.
+
+procedure gkp_unknown (gki)
+
+short	gki[ARB]		# the GKI instruction
+int	fd, stream, verbose, gkiunits
+common	/gkpcom/ fd, stream, verbose, gkiunits
+
+begin
+	call fprintf (fd, "unknown\n")
+end
+
+
+# GKP_PSTAT -- Compute and print on the standard error output a statistical
+# summary of a sequence of (x,y) points.  If verbose mode is enabled, follow
+# this by the values of the points themselves.
+
+procedure gkp_pstat (fd, p, npts, label, verbose, gkiunits)
+
+int	fd			# output file
+short	p[npts]			# array of points, i.e., (x,y) pairs
+int	npts			# number of points
+char	label[ARB]		# type of instruction
+int	verbose			# verbose output desired
+int	gkiunits		# print coords in GKI rather than NDC units
+
+int	i
+real	x, y, xsum, xmin, xmax, ysum, ymin, ymax, scale
+
+begin
+	if (gkiunits == YES)
+	    scale = 1.0
+	else
+	    scale = 1.0 / GKI_MAXNDC
+
+	xsum = 0
+	xmin = 1.0
+	xmax = 0
+	ysum = 0
+	ymin = 1.0
+	ymax = 0
+
+	# Compute mean, minimum, and maximum values.
+	do i = 1, npts * 2, 2 {
+	    x = real (p[i]) * scale
+	    xsum = xsum + x
+	    if (x < xmin)
+		xmin = x
+	    if (x > xmax)
+		xmax = x
+
+	    y = real (p[i+1]) * scale
+	    ysum = ysum + y
+	    if (y < ymin)
+		ymin = y
+	    if (y > ymax)
+		ymax = y
+	}
+
+	# Print summary of statistics.
+	call fprintf (fd, "%s np=%d, ")
+	    call pargstr (label)
+	    call pargi (npts)
+
+	if (gkiunits == YES)
+	    call fprintf (fd, "xmin=%d,xmax=%d,xavg=%d, ")
+	else
+	    call fprintf (fd, "xmin=%4.2f,xmax=%4.2f,xavg=%4.2f, ")
+	    if (npts == 0) {
+		do i = 1, 3
+		    call pargr (INDEF)
+	    } else {
+		call pargr (xmin)
+		call pargr (xmax)
+		call pargr (xsum / npts)
+	    }
+
+	if (gkiunits == YES)
+	    call fprintf (fd, "ymin=%d,ymax=%d,yavg=%d\n")
+	else
+	    call fprintf (fd, "ymin=%4.2f,ymax=%4.2f,yavg=%4.2f\n")
+	    if (npts == 0) {
+		do i = 1, 3
+		    call pargr (INDEF)
+	    } else {
+		call pargr (ymin)
+		call pargr (ymax)
+		call pargr (ysum / npts)
+	    }
+
+	# Dump the points if verbose output is enabled.
+	if (verbose == NO && npts > 0)
+	    return
+
+	call fprintf (fd, "\t")
+	for (i=1;  i <= npts * 2;  i=i+2) {
+	    if (i > 1 && mod (i-1, 10) == 0)
+		call fprintf (fd, "\n\t")
+	    if (gkiunits == YES)
+		call fprintf (fd, "%5d %5d  ")
+	    else
+		call fprintf (fd, "%5.3f %5.3f  ")
+		call pargr (real(p[i])   * scale)
+		call pargr (real(p[i+1]) * scale)
+	}
+	call fprintf (fd, "\n")
+end
+
+
+# GKP_DUMP -- Print a sequence of metacode words as a table, formatted eight
+# words per line, in decimal.
+
+procedure gkp_dump (fd, data, nwords)
+
+int	fd			# output file
+short	data[ARB]		# metacode data
+int	nwords			# number of words of data
+int	i
+
+begin
+	if (nwords <= 0)
+	    return
+
+	call fprintf (fd, "\t")
+
+	for (i=1;  i <= nwords;  i=i+1) {
+	    if (i > 1 && mod (i-1, 8) == 0)
+		call fprintf (fd, "\n\t")
+	    call fprintf (fd, "%7d")
+		call pargs (data[i])
+	}
+
+	call fprintf (fd, "\n")
+end
diff --git a/sys/gio/gki/gkirca.x b/sys/gio/gki/gkirca.x
new file mode 100644
index 00000000..54b38813
--- /dev/null
+++ b/sys/gio/gki/gkirca.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GKI_RETCELLARRAY -- Return a cell array (pixel array).  Used by a graphics
+# kernel to return a cell array to GIO in response to a GETCELLARRAY
+# instruction.
+#
+# BOI GKI_CELLARRAY L NP P
+#    
+#        L(i)            4 + NP
+#        NP(i)           number of pixels in cell array
+#        P(NPi)          cell array
+
+procedure gki_retcellarray (fd, m, np)
+
+int	fd			# output file
+short	m[ARB]			# cell array
+int	np			# number of pixels in cell array
+
+short	gki[GKI_CELLARRAY_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_CELLARRAY/
+
+begin
+	gki[GKI_CELLARRAY_L] = GKI_CELLARRAY_LEN + np
+	gki[GKI_CELLARRAY_NP] = np
+
+	call write (fd, gki, GKI_CELLARRAY_LEN * SZ_SHORT)
+	call write (fd, m, np * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkircval.x b/sys/gio/gki/gkircval.x
new file mode 100644
index 00000000..9bfb3052
--- /dev/null
+++ b/sys/gio/gki/gkircval.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+
+# GKI_RETCURSORVALUE -- Return a cursor value.  Used by a graphics kernel to
+# return a cursor value to GIO in response to a GETCURSOR instruction.
+#
+#                BOI GKI_CURSORVALUE L CN KEY SX SY RN RX RY
+#
+#        where
+#
+#                L(i)            10
+#                CN(i)           cursor number
+#                KEY(i)          keystroke value (>= 0 or EOF)
+#                SX(i)           NDC X screen coordinate of cursor
+#                SY(i)           NDC Y screen coordinate of cursor
+#                RN(i)           raster number or zero
+#                RX(i)           NDC X raster coordinate of cursor
+#                RY(i)           NDC Y raster coordinate of cursor
+#
+# The screen or display window coordinates SX and SY of the cursor are
+# returned for all devices.  Only some devices support multiple rasters.
+# If the device supports rasters and the cursor is in a raster when read, the
+# raster number and raster coordinates are returned in RN,RX,RY.  This is in
+# addition to the screen coordinates SX,SY.  If raster coordinates are not
+# returned, the raster number will be set to zero and RX,RY will be the same
+# as SX,SY.
+
+procedure gki_retcursorvalue (fd, cn, key, sx, sy, raster, rx, ry)
+
+int	fd			#I output file
+int	cn			#I cursor number
+int	key			#I keystroke value
+int	sx, sy			#I screen coordinates of cursor (GKI coords)
+int	raster			#I raster number
+int	rx, ry			#I raster coordinates of cursor (GKI coords)
+
+short	gki[GKI_CURSORVALUE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_CURSORVALUE/, gki[3] /GKI_CURSORVALUE_LEN/
+
+begin
+	gki[GKI_CURSORVALUE_CN ] = cn
+	gki[GKI_CURSORVALUE_KEY] = key
+	gki[GKI_CURSORVALUE_SX ] = sx
+	gki[GKI_CURSORVALUE_SY ] = sy
+	gki[GKI_CURSORVALUE_RN ] = raster
+	gki[GKI_CURSORVALUE_RX ] = rx
+	gki[GKI_CURSORVALUE_RY ] = ry
+
+	call write (fd, gki, GKI_CURSORVALUE_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkireact.x b/sys/gio/gki/gkireact.x
new file mode 100644
index 00000000..a84ad95d
--- /dev/null
+++ b/sys/gio/gki/gkireact.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_REACTIVATEWS -- Reactivate the workstation (enable graphics).
+#
+# BOI GKI_REACTIVATEWS L F
+#    
+#        L(i)            4
+#        F               flags (0,AW_PAUSE,AW_CLEAR)
+
+procedure gki_reactivatews (fd, flags)
+
+int	fd			# output file
+int	flags			# action modifier flags
+
+int	epa, nchars
+short	gki[GKI_REACTIVATEWS_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_REACTIVATEWS/, gki[3] /GKI_REACTIVATEWS_LEN/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_REACTIVATEWS]
+	    if (epa != 0)
+		call zcall1 (epa, flags)
+
+	} else {
+	    # Send a copy to the pseudofile i/o controller.
+	    gki[GKI_REACTIVATEWS_F] = flags
+	    nchars = GKI_REACTIVATEWS_LEN * SZ_SHORT
+	    if (IS_FILE(fd) && (fd >= STDGRAPH && fd <= STDPLOT)) {
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, gki, nchars)
+		call flush (PSIOCTRL)
+	    }
+
+	    # Now send a copy to the graphics kernel.
+	    call write (gk_fd[fd], gki, nchars)
+	}
+end
diff --git a/sys/gio/gki/gkiredir.x b/sys/gio/gki/gkiredir.x
new file mode 100644
index 00000000..3e204bf0
--- /dev/null
+++ b/sys/gio/gki/gkiredir.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_REDIR -- Redirect (or set) a graphics stream.  All i/o will be to the
+# file FD until the graphics stream is reset in another call to GKI_REDIR.
+# The current encoded value for a stream is retured so that a subsequent call
+# (with FD=0) may be made to undo the redirection.  A call with FD<0 may be
+# used to stat the stream without changing anything.  NOTE: This procedure
+# (or either GKI_INLINE_KERNEL or GKI_SUBKERNEL) must be called before using
+# the GKI package for a graphics stream.
+
+procedure gki_redir (stream, fd, old_fd, old_type)
+
+int	stream			# graphics stream to be redirected
+int	fd			# file to be connected to the stream
+int	old_fd, old_type	# old values for later restoration
+
+include	"gki.com"
+
+begin
+	if (fd == NULL) {
+	    gk_type[stream] = old_type
+	    gk_fd[stream]   = old_fd
+	} else {
+	    old_type = gk_type[stream]
+	    old_fd   = gk_fd[stream]
+	    if (fd > 0) {
+		gk_type[stream] = TY_FILE
+		gk_fd[stream] = fd
+	    }
+	}
+end
diff --git a/sys/gio/gki/gkiscur.x b/sys/gio/gki/gkiscur.x
new file mode 100644
index 00000000..f3ca7c53
--- /dev/null
+++ b/sys/gio/gki/gkiscur.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_SETCURSOR -- Set the position of a device cursor.
+#
+# BOI GKI_SETCURSOR L CN POS
+#
+#        L(i)            6
+#        CN(i)           cursor number
+#        POS(p)          new cursor position
+
+procedure gki_setcursor (fd, x, y, cursor)
+
+int	fd			# output file
+int	x, y			# new cursor position
+int	cursor			# cursor to be set
+
+int	epa
+short	gki[GKI_SETCURSOR_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_SETCURSOR/, gki[3] /GKI_SETCURSOR_LEN/
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_SETCURSOR]
+	    if (epa != 0)
+		call zcall3 (epa, x, y, cursor)
+	} else {
+	    gki[GKI_SETCURSOR_CN]    = cursor
+	    gki[GKI_SETCURSOR_POS]   = x
+	    gki[GKI_SETCURSOR_POS+1] = y
+
+	    call write (gk_fd[fd], gki, GKI_SETCURSOR_LEN * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkisetwcs.x b/sys/gio/gki/gkisetwcs.x
new file mode 100644
index 00000000..f8d0e896
--- /dev/null
+++ b/sys/gio/gki/gkisetwcs.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_SETWCS -- Copy the set of 16 WCS to the graphics controller in the CL
+# process.  The WCS are transmitted as a binary array of WCS structures.
+#
+# BOI GKI_SETWCS L N WCS
+#
+#        L(i)            4 + N
+#	 N(i)		 length of WCS field in words
+#        WCS             binary copy of the 16 WCS structures, transmitted
+#                            in a single call to WRITE
+
+procedure gki_setwcs (fd, wcs, len_wcs)
+
+int	fd			# output file
+int	wcs[ARB]		# array of WCS structures
+int	len_wcs			# number of ints (struct units) in array
+
+int	nshorts
+short	gki[GKI_SETWCS_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_SETWCS/
+include	"gki.com"
+
+begin
+	if (IS_FILE(fd)) {
+	    nshorts = (len_wcs * SZ_INT) / SZ_SHORT
+	    gki[GKI_SETWCS_L] = GKI_SETWCS_LEN + nshorts
+	    gki[GKI_SETWCS_N] = nshorts
+
+	    if (fd >= STDGRAPH && fd <= STDPLOT) {
+		# Send a copy of the WCS information to the PSIO control
+		# stream if the graphics output is a standard graphics stream.
+
+		call write (PSIOCTRL, fd, SZ_INT32)
+		call write (PSIOCTRL, gki, GKI_SETWCS_LEN * SZ_SHORT)
+		call write (PSIOCTRL, wcs, nshorts * SZ_SHORT)
+		call flush (PSIOCTRL)
+	    }
+
+	    call write (gk_fd[fd], gki, GKI_SETWCS_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], wcs, nshorts * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkititle.x b/sys/gio/gki/gkititle.x
new file mode 100644
index 00000000..397bd50a
--- /dev/null
+++ b/sys/gio/gki/gkititle.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_MFTITLE -- Write the metafile title.
+#
+# BOI GKI_MFTITLE L N T
+#    
+#        L(i)            4 + N
+#        N(i)            number of characters in field T
+#        T(Nc)           title string identifying metafile
+
+procedure gki_mftitle (fd, title)
+
+int	fd			# output file
+char	title[ARB]		# title string
+
+int	epa
+int	ip, n
+pointer	sp, gki, op
+int	strlen()
+include	"gki.com"
+
+begin
+	call smark (sp)
+
+	n = strlen (title)
+	call salloc (gki, GKI_MFTITLE_LEN + n, TY_SHORT)
+
+	# Pack the title name as a SHORT integer array.
+	op = gki + GKI_MFTITLE_T - 1
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    Mems[op] = title[ip]
+	    op = op + 1
+	}
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_MFTITLE]
+	    if (epa != 0)
+		call zcall2 (epa, Mems[gki+GKI_MFTITLE_T-1], n)
+	} else {
+	    Mems[gki  ] = BOI
+	    Mems[gki+1] = GKI_MFTITLE
+	    Mems[gki+2] = GKI_MFTITLE_LEN + n
+	    Mems[gki+3] = n
+	    call write (gk_fd[fd], Mems[gki], (GKI_MFTITLE_LEN + n) * SZ_SHORT)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gki/gkitx.x b/sys/gio/gki/gkitx.x
new file mode 100644
index 00000000..7cc616ba
--- /dev/null
+++ b/sys/gio/gki/gkitx.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_TEXT -- Text drawing instruction.
+#
+# BOI GKI_TEXT L P N T
+#    
+#        L(i)            6 + N
+#        P(p)            starting point of character string
+#        N(i)            number of characters in string T
+#        T(Nc)           string of N ASCII characters
+
+procedure gki_text (fd, x, y, text)
+
+int	fd			# output file
+int	x, y			# position at which text is to be drawn
+char	text[ARB]		# text string to be drawn
+
+int	epa
+int	ip, n
+pointer	sp, gki, op
+int	strlen()
+include	"gki.com"
+
+begin
+	call smark (sp)
+
+	n = strlen (text)
+	call salloc (gki, GKI_TEXT_LEN + n, TY_SHORT)
+
+	# Pack the text string as a SHORT integer array.
+	op = gki + GKI_TEXT_T - 1
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    Mems[op] = text[ip]
+	    op = op + 1
+	}
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_TEXT]
+	    if (epa != 0)
+		call zcall4 (epa, x, y, Mems[gki+GKI_TEXT_T-1], n)
+	} else {
+	    Mems[gki  ] = BOI
+	    Mems[gki+1] = GKI_TEXT
+	    Mems[gki+2] = GKI_TEXT_LEN + n
+	    Mems[gki+GKI_TEXT_L-1]   = GKI_TEXT_LEN + n
+	    Mems[gki+GKI_TEXT_P-1]   = x
+	    Mems[gki+GKI_TEXT_P-1+1] = y
+	    Mems[gki+GKI_TEXT_N-1]   = n
+
+	    call write (gk_fd[fd], Mems[gki], (GKI_TEXT_LEN + n) * SZ_SHORT)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gki/gkitxset.x b/sys/gio/gki/gkitxset.x
new file mode 100644
index 00000000..93f427b9
--- /dev/null
+++ b/sys/gio/gki/gkitxset.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+include	<gio.h>
+
+# GKI_TXSET -- Set the text drawing attributes.
+#
+# BOI GKI_TXSET L UP SZ SP P HJ VJ F Q CI
+#
+#        L(i)            12
+#        UP(i)           character up vector (degrees)
+#        SZ(r)           character size scale factor
+#        SP(r)           character spacing
+#        P(i)            path (0,1=right,2=left,3=up,4=down)
+#        HJ(i)           horizontal justification
+#                            (0=normal,1=center,2=left,3=right)
+#        VJ(i)           vertical justification
+#                            (0=normal,1=center,2=up,3=down)
+#        F(i)            font (0,1=roman,2=greek,3=italic,4=bold)
+#        Q(i)            quality (0=normal,1=low,2=medium,3=high)
+#        CI(i)           text color index
+
+procedure gki_txset (fd, ap)
+
+int	fd			# output file
+pointer	ap			# pointer to attribute structure
+
+int	epa
+short	gki[GKI_TXSET_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_TXSET/, gki[3] /GKI_TXSET_LEN/
+include	"gki.com"
+
+begin
+	gki[GKI_TXSET_UP] = TX_UP(ap)
+	gki[GKI_TXSET_SZ] = GKI_PACKREAL (TX_SIZE(ap))
+	gki[GKI_TXSET_SP] = GKI_PACKREAL (TX_SPACING(ap))
+	gki[GKI_TXSET_P ] = TX_PATH(ap)
+	gki[GKI_TXSET_HJ] = TX_HJUSTIFY(ap)
+	gki[GKI_TXSET_VJ] = TX_VJUSTIFY(ap)
+	gki[GKI_TXSET_F ] = TX_FONT(ap)
+	gki[GKI_TXSET_Q ] = TX_QUALITY(ap)
+	gki[GKI_TXSET_CI] = TX_COLOR(ap)
+
+	if (IS_INLINE(fd)) {
+	    epa = gk_dd[GKI_TXSET]
+	    if (epa != 0)
+		call zcall1 (epa, gki)
+	} else
+	    call write (gk_fd[fd], gki, GKI_TXSET_LEN * SZ_SHORT)
+end
diff --git a/sys/gio/gki/gkiwesc.x b/sys/gio/gki/gkiwesc.x
new file mode 100644
index 00000000..bd4c8571
--- /dev/null
+++ b/sys/gio/gki/gkiwesc.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_WESCAPE -- Write a GKI escape instruction, used to pass device
+# dependent instructions on to a graphics kernel.  This version of gki_escape
+# is used in cases where the escape instruction consists of the escape header
+# followed by a block of data, and it is inconvenient to have to combine the
+# header and the data into one array.
+#
+# BOI GKI_ESCAPE L FN N DC
+#
+#        L(i)            5 + N
+#        FN(i)           escape function code
+#        N(i)            number of escape data words
+#        DC(i)           escape data words
+
+procedure gki_wescape (fd, fn, hdr, hdrlen, data, datalen)
+
+int	fd		#I output file
+int	fn		#I escape function code
+short	hdr[ARB]	#I escape instruction header
+int	hdrlen		#I header length, shorts
+short	data[ARB]	#I escape instruction data
+int	datalen		#I data length, shorts
+
+pointer	sp, buf
+int	epa, nwords
+short	gki[GKI_ESCAPE_LEN]
+data	gki[1] /BOI/, gki[2] /GKI_ESCAPE/
+include	"gki.com"
+
+begin
+	nwords = hdrlen + datalen
+
+	if (IS_INLINE(fd)) {
+	    call smark (sp)
+	    call salloc (buf, nwords, TY_SHORT)
+
+	    call amovs (hdr, Mems[buf], hdrlen)
+	    call amovs (data, Mems[buf+hdrlen], datalen)
+
+	    epa = gk_dd[GKI_ESCAPE]
+	    if (epa != 0)
+		call zcall3 (epa, fn, Mems[buf], nwords)
+
+	    call sfree (sp)
+
+	} else {
+	    gki[GKI_ESCAPE_L]  = GKI_ESCAPE_LEN + nwords
+	    gki[GKI_ESCAPE_N]  = nwords
+	    gki[GKI_ESCAPE_FN] = fn
+
+	    call write (gk_fd[fd], gki, GKI_ESCAPE_LEN * SZ_SHORT)
+	    call write (gk_fd[fd], hdr, hdrlen * SZ_SHORT)
+	    call write (gk_fd[fd], data, datalen * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkiwrite.x b/sys/gio/gki/gkiwrite.x
new file mode 100644
index 00000000..65d911b1
--- /dev/null
+++ b/sys/gio/gki/gkiwrite.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<gki.h>
+
+# GKI_WRITE -- Write a GKI metacode instruction to a graphics kernel.  If the
+# kernel is inline the kernel is directly called to execute the instruction,
+# otherwise the instruction is written into the graphics stream for the
+# kernel.  This procedure is functionally equivalent to GKI_EXECUTE, but works
+# for both inline and external kernels.
+
+procedure gki_write (fd, gki)
+
+int	fd			# graphics stream
+short	gki[ARB]		# encoded instruction
+int	length
+include	"gki.com"
+
+begin
+	if (IS_INLINE(fd))
+	    call gki_execute (gki, gk_dd)
+	else {
+	    length = gki[GKI_HDR_LENGTH]
+	    call write (gk_fd[fd], gki, length * SZ_SHORT)
+	}
+end
diff --git a/sys/gio/gki/gkptxparg.x b/sys/gio/gki/gkptxparg.x
new file mode 100644
index 00000000..75d7325a
--- /dev/null
+++ b/sys/gio/gki/gkptxparg.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GKP_TXPARG -- Convert a short integer text attribute code into a string
+# and pass the string to FMTIO.
+
+procedure gkp_txparg (code)
+
+short	code			# defined in <gset.h>
+
+begin
+	switch (code) {
+	case GT_NORMAL:
+	    call pargstr ("normal")
+	case GT_CENTER:
+	    call pargstr ("center")
+	case GT_LEFT:
+	    call pargstr ("left")
+	case GT_RIGHT:
+	    call pargstr ("right")
+	case GT_UP:
+	    call pargstr ("up")
+	case GT_DOWN:
+	    call pargstr ("down")
+	case GT_TOP:
+	    call pargstr ("top")
+	case GT_BOTTOM:
+	    call pargstr ("bottom")
+	case GT_ROMAN:
+	    call pargstr ("roman")
+	case GT_GREEK:
+	    call pargstr ("greek")
+	case GT_ITALIC:
+	    call pargstr ("italic")
+	case GT_BOLD:
+	    call pargstr ("bold")
+	case GT_LOW:
+	    call pargstr ("low")
+	case GT_MEDIUM:
+	    call pargstr ("medium")
+	case GT_HIGH:
+	    call pargstr ("high")
+	default:
+	    call pargstr ("??")
+	}
+end
diff --git a/sys/gio/gki/mkpkg b/sys/gio/gki/mkpkg
new file mode 100644
index 00000000..c71f2e71
--- /dev/null
+++ b/sys/gio/gki/mkpkg
@@ -0,0 +1,46 @@
+# Make the GKI (graphics kernel interface) package.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	gkicancel.x	gki.com <config.h> <gki.h>
+	gkiclear.x	gki.com <config.h> <gki.h>
+	gkiclose.x	gki.com <config.h> <gki.h>
+	gkideact.x	gki.com <config.h> <gki.h>
+	gkieof.x	gki.com <config.h> <gki.h>
+	gkiesc.x	gki.com <config.h> <gki.h>
+	gkiexe.x	<gki.h>
+	gkifa.x		gki.com <config.h> <gki.h>
+	gkifaset.x	gki.com <config.h> <gio.h> <gki.h>
+	gkifetch.x	<gki.h>
+	gkifflush.x	gki.com <config.h> <fio.h> <gki.h>
+	gkiflush.x	gki.com <config.h> <fio.h> <gki.h>
+	gkigca.x	gki.com <config.h> <fio.h> <fset.h> <gki.h>
+	gkigcur.x	gki.com <config.h> <fio.h> <fset.h> <gki.h>
+	gkigetwcs.x	gki.com <config.h> <gki.h>
+	gkiinit.x	gki.com <config.h> <gki.h>
+	gkiinline.x	gki.com <config.h> <gki.h>
+	gkikern.x	gki.com <config.h> <gki.h>
+	gkiopen.x	gki.com <config.h> <gki.h>
+	gkipca.x	gki.com <config.h> <gki.h>
+	gkipl.x		gki.com <config.h> <gki.h>
+	gkiplset.x	gki.com <config.h> <gio.h> <gki.h>
+	gkipm.x		gki.com <config.h> <gki.h>
+	gkipmset.x	gki.com <config.h> <gio.h> <gki.h>
+	gkiprint.x	<config.h> <gio.h> <gki.h> <gset.h> <mach.h>
+	gkirca.x	<gki.h>
+	gkircval.x	<gki.h>
+	gkireact.x	gki.com <config.h> <gki.h>
+	gkiredir.x	gki.com <config.h> <gki.h>
+	gkiscur.x	gki.com <config.h> <gki.h>
+	gkisetwcs.x	gki.com <config.h> <gki.h>
+	gkititle.x	gki.com <config.h> <gki.h>
+	gkitx.x		gki.com <config.h> <gki.h>
+	gkitxset.x	gki.com <config.h> <gio.h> <gki.h>
+	gkiwesc.x	gki.com <config.h> <gki.h>
+	gkiwrite.x	gki.com <config.h> <gki.h>
+	gkptxparg.x	<gset.h>
+	;
diff --git a/sys/gio/gki/zzdebug.x b/sys/gio/gki/zzdebug.x
new file mode 100644
index 00000000..e56c5cc0
--- /dev/null
+++ b/sys/gio/gki/zzdebug.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <fset.h>
+include <fio.h>
+include <gki.h>
+
+task	ggcur	= t_ggcur
+
+
+# GGCUR -- Debug cursor read in inline graphics kernel.
+
+procedure t_ggcur()
+
+pointer	gp
+char	device[SZ_FNAME]
+
+real	cx, cy
+int	key, xres, yres, hardchar
+int	dd[LEN_GKIDD]
+pointer	gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	hardchar = YES
+	xres = 0
+	yres = 0
+
+	call fseti (STDGRAPH, F_TYPE, SPOOL_FILE)
+	call fseti (STDGRAPH, F_CANCEL, OK)
+
+	call stg_open (device, dd, STDIN, STDOUT, xres, yres, hardchar)
+	call gki_inline_kernel (STDGRAPH, dd)
+
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call ggcur (gp, cx, cy, key)
+
+	call gclose (gp)
+	call stg_close()
+
+	call printf ("cx=%f, cy=%f, key=%d\n")
+	    call pargr (cx)
+	    call pargr (cy)
+	    call pargi (key)
+end
diff --git a/sys/gio/gks/README b/sys/gio/gks/README
new file mode 100644
index 00000000..fc3307c7
--- /dev/null
+++ b/sys/gio/gks/README
@@ -0,0 +1,50 @@
+GKS - This directory contains code for a partial implementation of the Fortran
+binding of GKS level OA.  The GKS functions are layered upon GIO.  The functions
+provided are:
+
+	gacwk	---	activate workstation
+	gca	---	output (integer) cell array
+	gcas	---	output (short) cell array
+	gclks	---	close GKS
+	gclrwk	---	clear workstation
+	gclwk	---	close workstation
+	gdawk	---	deactivate workstation
+	gfa	---	fill area
+	gopks	---	open GKS
+	gopwk	---	open workstation
+	gpl	---	polyline
+	gpm	---	polymarker
+	gqasf	---	query aspect source flag
+	gqchh	---	query character height
+	gqchup	---	query character up vector
+	gqcntn	---	query current transformation number
+	gqnt	---	query normalization transformation (window and viewport)
+	gqopwk	---	query open workstations
+	gqplci	---	query polyline color index
+	gqpmi   ---     query polymarker index
+	gqtxal	---	query text alignment
+	gqtxci	---	query text color index
+	gqtxp	---	query text path
+	gqwks	---	query workstation state
+	qsasf	--- 	query aspect source flag
+	gschh	---	set character height
+	gschup	---	set character up vector
+	gscr    ---     set color representation
+	gselnt	---	set normalization transformation
+	gsfaci  ---     set fill area color index
+	gsfais	---	set fill area interior style
+	gslwsc  ---     set line width scale factor
+	gsmk	---	set marker type
+	gsplci	---	set polyline color index
+	gspmci	---	set polymarker color index
+	gspmi   ---     set polymarker index
+	gstxal	---	set text alignment
+	gstxci	---	set text color index
+	gstxp	---	set text path
+	gsvp	---	set viewport
+	gswn	---	set window
+	gtx	---	text (gtx.f, gxgtx.x)
+
+Two functions were added 8Sep86:
+	gsclip	---	set clipping flag
+	gqclip	---	query clipping flag
diff --git a/sys/gio/gks/gacwk.x b/sys/gio/gks/gacwk.x
new file mode 100644
index 00000000..c9393d07
--- /dev/null
+++ b/sys/gio/gks/gacwk.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GACWK -- Activate workstation.
+
+procedure gacwk (wkid)
+
+int	wkid 		# Workstation identifier
+include	"gks.com"
+
+begin
+	# This procedure sets the active flag for a particular workstation.
+	gk_status[wkid] = ACTIVE
+
+	# Also, set gk_std to be the first activated workstation.  Once
+	# gk_std has been set, it will no longer = NULL.
+	if (gk_std == NULL)
+	    gk_std = wkid
+end
diff --git a/sys/gio/gks/gca.x b/sys/gio/gks/gca.x
new file mode 100644
index 00000000..918c3e37
--- /dev/null
+++ b/sys/gio/gks/gca.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GCA -- Cell array.  Output a cell array to the specified output device
+# area.
+
+procedure gca (px, py, qx, qy, dimx, dimy, ncs, nrs, dx, dy, colia)
+
+real	px, py, qx, qy		# Two points (P, Q) in world coordinates
+int	dx, dy			# Number of columns, number of rows 
+int	dimx, dimy		# Dimensions of color index array
+int	ncs, nrs		# Starting column, row of color array
+int	colia[dimx,dimy]	# Colour index array
+
+int	i, j, off
+pointer	sp, pixels
+include	"gks.com"
+
+begin
+	# Extract subraster and convert to type short.
+	call smark (sp)
+	call salloc (pixels, dx * dy, TY_SHORT)
+	do j = 1, dy {
+	    off = (j - 1) * dx
+	    call achtis (colia[ncs,nrs+j-1], Mems[pixels+off], dx)
+	}
+
+	# Output color array to all active workstations.
+	do i = 1, NDEV 
+	    if (gk_status[i] == ACTIVE)
+		call gpcell (gp[i], Mems[pixels], dx, dy, px, py, qx, qy)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gks/gcas.x b/sys/gio/gks/gcas.x
new file mode 100644
index 00000000..3ab44f99
--- /dev/null
+++ b/sys/gio/gks/gcas.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GCAS -- Cell array.  Output a cell array to the specified output device
+# area.  This version of GCA intended for input color array of type short.
+
+procedure gcas (px, py, qx, qy, dimx, dimy, ncs, nrs, dx, dy, colia)
+
+real	px, py, qx, qy		# Two points (P, Q) in world coordinates
+int	dx, dy			# Number of columns, number of rows 
+int	dimx, dimy		# Dimensions of color index array
+int	ncs, nrs		# Starting column, row of color array
+short	colia[dimx, dimy]	# Colour index array
+
+int	i, j, off
+pointer	sp, pixels
+include	"gks.com"
+
+begin
+	if (ncs == 1 && nrs == 1) {
+	    # Output color array to all active workstations.
+	    do i = 1, NDEV 
+	        if (gk_status[i] == ACTIVE)
+		    call gpcell (gp[i], Mems[pixels], dx, dy, px, py, qx, qy)
+	
+	} else {
+	    # Cell array is subraster of a larger array
+	    call smark (sp)
+	    call salloc (pixels, dx * dy, TY_SHORT)
+
+	    # Extract subraster
+	    do j = 1, dy {
+		off = (j - 1) * dx
+		call amovs (colia[ncs,nrs+j-1], Mems[off], dx)
+	    }
+
+	    # Output color array to all active workstations.
+	    do i = 1, NDEV 
+	        if (gk_status[i] == ACTIVE)
+		    call gpcell (gp[i], Mems[pixels], dx, dy, px, py, qx, qy)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/gio/gks/gclks.x b/sys/gio/gks/gclks.x
new file mode 100644
index 00000000..a82b760d
--- /dev/null
+++ b/sys/gio/gks/gclks.x
@@ -0,0 +1,9 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GCLKS -- Close GKS.
+
+procedure gclks ()
+
+begin
+	# This procedure performs no function in the GKS emulator.
+end
diff --git a/sys/gio/gks/gclrwk.x b/sys/gio/gks/gclrwk.x
new file mode 100644
index 00000000..7f92bc91
--- /dev/null
+++ b/sys/gio/gks/gclrwk.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GCLRWK -- Clear workstation.
+
+procedure gclrwk (wkid, cofl)
+
+int	wkid		# Workstation identifier
+int	cofl		# Control flags (GCONDI, GALWAY)
+include	"gks.com"
+
+begin
+	# Clear the screen or advance film on the specified workstation.  GKS
+	# allows this to be done conditionally, dependent on whether or not
+	# something has been drawn.
+
+	call gclear (gp[wkid])
+end
diff --git a/sys/gio/gks/gclwk.x b/sys/gio/gks/gclwk.x
new file mode 100644
index 00000000..6fc3c16a
--- /dev/null
+++ b/sys/gio/gks/gclwk.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GCLWK -- Close workstation.
+
+procedure gclwk (wkid)
+
+int	wkid		# Workstation identifier
+include	"gks.com"
+
+begin
+	call gclose (gp[wkid])
+end
diff --git a/sys/gio/gks/gdawk.x b/sys/gio/gks/gdawk.x
new file mode 100644
index 00000000..23eaff14
--- /dev/null
+++ b/sys/gio/gks/gdawk.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GDAWK -- Deactivate workstation.
+
+procedure gdawk (wkid)
+
+int	wkid		# Workstation identifier
+int	i
+include	"gks.com"
+
+begin
+	# This procedure sets the status flag to INACTIVE for a particular
+	# device.  Because this workstation may have been the reference
+	# workstation, gk_std, it may also necessary to update gk_std.
+	# In this case, the reference workstation will be the one with the
+	# lowest workstation id number.
+
+	gk_status[wkid] = INACTIVE
+
+	if (wkid == gk_std) {
+	    gk_std = NULL
+	    # Find next activated workstation, if any
+	    do i = 1, NDEV {
+	        if (gk_status[i] == ACTIVE) {
+		    gk_std = i
+		    break
+		}
+	    }
+	}
+end
diff --git a/sys/gio/gks/gfa.x b/sys/gio/gks/gfa.x
new file mode 100644
index 00000000..9eb612b2
--- /dev/null
+++ b/sys/gio/gks/gfa.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GFA -- Fill area.  The style of fill has already been set and is read
+# from gio.com.
+
+procedure gfa (n, px, py)
+
+int	n		# Number of points
+real	px[n], py[n]	# Coordinates of points in world coordinates
+
+int	i
+include "gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gfill (gp[i], px, py, n, gk_style)
+	}
+end
diff --git a/sys/gio/gks/gks.com b/sys/gio/gks/gks.com
new file mode 100644
index 00000000..63c20568
--- /dev/null
+++ b/sys/gio/gks/gks.com
@@ -0,0 +1,10 @@
+# Common for GKS emulator.
+
+pointer	gp[NDEV]	# Graphics file descriptor for gio calls
+int	gk_status[NDEV]	# Active bit = INACTIVE or ACTIVE
+int	gk_std		# Index of gp array used for reference in set/get calls
+int	gk_style	# Fill area type of fill - set by GSFAIS
+int	gk_marker	# Marker type for use by GPM
+int	gk_asf[NASF]	# Array for maintaining aspect source flags
+
+common /gksemu/ gp, gk_status, gk_std, gk_style, gk_marker, gk_asf
diff --git a/sys/gio/gks/gks.h b/sys/gio/gks/gks.h
new file mode 100644
index 00000000..2373c55f
--- /dev/null
+++ b/sys/gio/gks/gks.h
@@ -0,0 +1,40 @@
+# Definitions for the gks emulator.
+
+define	NDEV		10	# Maximum number of open devices possible
+define	INACTIVE	0
+define	ACTIVE		1
+define	MAX_WCS		16	# Maximum number of world coordinate systems
+define	NASF		13	# Number of aspect source flags
+
+# Following are emuneration types used by the GKS emulator.
+define	GRIGHT		0
+define	GLEFT		1
+define	GUP		2
+define	GDOWN		3
+define	GAHNOR		0
+define	GALEFT		1
+define	GACENT		2
+define	GARITE		3
+define	GAVNOR		0
+define	GATOP		1
+define	GACAP		2
+define	GAHALF		3
+define	GABASE		4
+define	GABOTT		5
+define	GPOINT		1
+define	GPLUS		2
+define	GAST		3
+define	GOMARK		4
+define	GXMARK		5
+define	GHOLLO		0
+define	GSOLID		1
+define	GPATTR		2
+define	GHATCH		3
+define	GBUNDL		0
+define	GINDIV		1
+define	GRIGHT		0
+define	GLEFT		1
+define	GUP		2
+define	GDOWN		3
+define	GCONDI		0
+define	GALWAY		1
diff --git a/sys/gio/gks/gopks.x b/sys/gio/gks/gopks.x
new file mode 100644
index 00000000..48f39de0
--- /dev/null
+++ b/sys/gio/gks/gopks.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GOPKS -- Open GKS.  In the GIO implementation, this routine sets the
+# file to receive error output to STDERR and initializes all possible
+# workstations to inactive.  It also initializes the ASF array to GINDIV.
+
+procedure gopks (errfil)
+
+int	errfil		# Unit number for error output
+int	i
+include	"gks.com"
+
+begin
+	# This procedure initializes the gk_status and gk_std variables.
+	do i = 1, NDEV 
+	    gk_status[i] = INACTIVE
+	
+	gk_std = NULL
+
+	do i = 1, NASF
+	    gk_asf[i] = GINDIV
+end
diff --git a/sys/gio/gks/gopwk.x b/sys/gio/gks/gopwk.x
new file mode 100644
index 00000000..baa040e3
--- /dev/null
+++ b/sys/gio/gks/gopwk.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GOPWK -- Open workstation.
+
+procedure gopwk (wkid, conid, wtype)
+
+int	wkid		# Workstation identifier
+int	conid		# Connection identifier, not used.
+int	wtype		# Workstation type 
+
+include	"gks.com"
+
+
+begin
+	# This procedure sets "gp[wkid]" to be the "gp" of workstation "wkid".
+	# Procedure gopen has been called by the calling routine.  The wkid
+	# runs sequentially from 1 to the maximum allowable number of open
+	# workstations.  Parameter wtype is the gp returned from gopen.
+
+	gp[wkid] = wtype
+end
diff --git a/sys/gio/gks/gpl.x b/sys/gio/gks/gpl.x
new file mode 100644
index 00000000..ea5b880f
--- /dev/null
+++ b/sys/gio/gks/gpl.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GPL -- Polyline.  Draw a line connecting the points.
+
+procedure gpl (n, px, py)
+
+int	n	 	# Number of points
+real	px[n], py[n]	# Coordinates of points in world coordinates
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gpline (gp[i], px, py, n)
+	}
+end
diff --git a/sys/gio/gks/gpm.x b/sys/gio/gks/gpm.x
new file mode 100644
index 00000000..1a7d8ac7
--- /dev/null
+++ b/sys/gio/gks/gpm.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GPM -- Polymarker.  Draw marks of type "gk_marker" and size 2.0
+# at the given positions.  Marker type has already been set.
+
+procedure gpm (n, px, py)
+
+int	n		# Number of points
+real	px[n], py[n]	# Coordinates of points in world coordinates
+
+int	i
+real	size
+include	"gks.com"
+
+begin
+	# Marker size is a constant.
+	size = 2.0
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+    	        call gpmark (gp[i], px, py, n, gk_marker, size, size)
+	}
+end
diff --git a/sys/gio/gks/gqasf.x b/sys/gio/gks/gqasf.x
new file mode 100644
index 00000000..828ddef0
--- /dev/null
+++ b/sys/gio/gks/gqasf.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GQASF -- Inquire aspect source flags. 
+
+procedure gqasf (ierror, lasf)
+
+int	lasf[13]		# Array of source aspect flags
+int	ierror			# Error indicator, where ierror = 0 for no error
+int	i
+include	"gks.com"
+
+begin
+	ierror = 0
+	do i = 1, NASF
+	    lasf[i] = gk_asf[i]
+end
diff --git a/sys/gio/gks/gqchh.x b/sys/gio/gks/gqchh.x
new file mode 100644
index 00000000..733d0a2a
--- /dev/null
+++ b/sys/gio/gks/gqchh.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCHH - Inquire character height.
+
+procedure gqchh (ierror, chh)
+
+int	ierror			# Error indicator
+real	chh			# Character height, in world coordinates
+
+real	dx, dy
+real	gstatr()
+include	"gks.com"
+errchk	gstatr, ggscale
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    chh = -1.0
+	    return
+	} else 
+	    ierror = 0
+
+	iferr {
+	    chh = gstatr (gp[gk_std], G_CHARSIZE)
+
+	    # The character height is expressed in NDC units.  It must be 
+	    # converted to world coordinates before returning.
+
+	    call ggscale (gp[gk_std], 0., 0., dx, dy)
+	    chh = chh * dy
+	} then {
+	    ierror = 1
+	    chh = -1.0
+	}
+end
diff --git a/sys/gio/gks/gqchup.x b/sys/gio/gks/gqchup.x
new file mode 100644
index 00000000..3f12d8c4
--- /dev/null
+++ b/sys/gio/gks/gqchup.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCHUP -- Inquire character up vector.
+
+procedure gqchup (ierror, chupx, chupy)
+
+int	ierror			# Error code; ierror = 0 for no error 
+real	chupx, chupy		# Character up vector x and y components
+
+int	angle
+real	txup
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    chupx = 0.0
+	    chupy = 0.0
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    angle = gstati (gp[gk_std], G_TXUP) 
+
+	    txup = real (angle) * 3.1415926 / 180.
+	    chupx = cos (txup)
+	    chupy = sin (txup)
+	} then {
+	    ierror = 1
+	    chupx = 0.0
+	    chupy = 0.0
+	}
+end
diff --git a/sys/gio/gks/gqclip.x b/sys/gio/gks/gqclip.x
new file mode 100644
index 00000000..5694b353
--- /dev/null
+++ b/sys/gio/gks/gqclip.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCLIP -- Inquire value of clipping flag
+
+procedure gqclip (errind, iclip, iar)
+
+int	errind			# Error indicator
+int	iclip			# Clipping flag - returned value
+real	iar[4]			# Clipping array 
+
+int	gstati()
+include	"gks.com"
+
+begin
+	# Until I know what this argument is, set iar to full viewport.  
+	# Consulting with NCAR was not enlightning.  This argument (iar) 
+	# is not documented in the GKS level 0A standard.
+	iar[1] = 0.0
+	iar[2] = 1.0
+	iar[3] = 0.0
+	iar[4] = 1.0
+
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    iclip = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    iclip = gstati (gp[gk_std], G_CLIP)
+	} then {
+	    errind = 1
+	    iclip = -1
+	}
+end
diff --git a/sys/gio/gks/gqcntn.x b/sys/gio/gks/gqcntn.x
new file mode 100644
index 00000000..aaaa79bf
--- /dev/null
+++ b/sys/gio/gks/gqcntn.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCNTN -- Inquire current normalization transformation number (WCS).
+
+procedure gqcntn (errind, cntr)
+
+int	errind		# Error indicator; errind = 0 means no error
+int	cntr		# Current normalization transformation  number
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    cntr = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    cntr = gstati (gp[gk_std], G_WCS)
+	} then {
+	    errind = 1
+	    cntr = -1
+	}
+end
diff --git a/sys/gio/gks/gqmk.x b/sys/gio/gks/gqmk.x
new file mode 100644
index 00000000..0e90fbe7
--- /dev/null
+++ b/sys/gio/gks/gqmk.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQMK -- Query marker type.  Integer variable "marker" is read from
+# "gks.com" and returned.  
+
+procedure gqmk (ierr, mtype)
+
+int	ierr			# Error indicator - no way it can be set
+int	mtype			# Marker type for polymarker
+include	"gks.com"
+
+begin
+	ierr = 0
+	switch (gk_marker) {
+	case GM_POINT:
+	    mtype = GPOINT
+	case GM_PLUS:
+	    mtype = GPLUS
+	case GM_BOX:
+	    mtype = GAST
+	case GM_DIAMOND:
+	    mtype = GOMARK
+	case GM_CROSS:
+	    mtype = GXMARK
+	default:
+	    mtype = GPOINT
+	}
+end
diff --git a/sys/gio/gks/gqnt.x b/sys/gio/gks/gqnt.x
new file mode 100644
index 00000000..c172647f
--- /dev/null
+++ b/sys/gio/gks/gqnt.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQNT -- Inquire normalization transformation (window and vport).  Note
+# that this procedure gets the information for WCS ntnr, then resets to
+# the current WCS before returning.
+
+procedure gqnt (ntnr, errind, window, vport)
+
+int	ntnr			# Normalization transformation number to query
+int	errind			# Error indicator; errind = 0 means no error
+real	window[4]		# Window coordinates for WCS ntnr
+real	vport[4]		# Viewport coordinates for WCS ntnr
+
+int	current_wcs
+int	gstati()
+include	"gks.com"
+errchk	gstati, gseti, ggwind, ggview
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    window[1] = 0.0
+	    window[2] = 0.0
+	    window[3] = 0.0
+	    window[4] = 0.0
+	    vport[1] = -1.0
+	    vport[2] = -1.0
+	    vport[3] = -1.0
+	    vport[4] = -1.0
+	    return
+	} else
+	    errind = 0
+
+	if (ntnr < 0 || ntnr > MAX_WCS) {
+	    errind = 50
+	    window[1] = 0.0
+	    window[2] = 0.0
+	    window[3] = 0.0
+	    window[4] = 0.0
+	    vport[1] = -1.0
+	    vport[2] = -1.0
+	    vport[3] = -1.0
+	    vport[4] = -1.0
+	    return
+	}
+
+	iferr {
+	    current_wcs = gstati (gp[gk_std], G_WCS)
+
+	    call gseti  (gp[gk_std], G_WCS, ntnr)
+	    call ggwind (gp[gk_std], window[1], window[2], window[3], window[4])
+	    call ggview (gp[gk_std], vport[1], vport[2], vport[3], vport[4])
+
+	    call gseti  (gp[gk_std], G_WCS, current_wcs)
+	} then {
+	    errind = 1
+	    window[1] = 0.0
+	    window[2] = 0.0
+	    window[3] = 0.0
+	    window[4] = 0.0
+	    vport[1] = -1.0
+	    vport[2] = -1.0
+	    vport[3] = -1.0
+	    vport[4] = -1.0
+	}
+end
diff --git a/sys/gio/gks/gqopwk.x b/sys/gio/gks/gqopwk.x
new file mode 100644
index 00000000..cf297f45
--- /dev/null
+++ b/sys/gio/gks/gqopwk.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GQOPWK -- Inquire number of open work stations.  From looking at how this
+# procedure is called, it seems to have two functions, depending on the value
+# of "n".  It returns either the number of active workstations (n=0), or the
+# wkid for nth open workstation.
+
+procedure gqopwk (n, errind, ol, wkid)
+
+int	n			# Number of workstation to query
+int	errind			# Error indicator; errind = 0 means no error
+int	ol			# Returned value (number of open workstations)
+int	wkid			# WKID of nth open workstation - returned
+
+int	i, this_wkstation
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    wkid = -1
+	    return
+	} else
+	    errind = 0
+
+	if (n < 0 || n > NDEV) {
+	    # Invalid workstation identifier
+	    wkid = -1
+	    errind = 502
+	    return
+	} else {
+	    ol = 0
+	    if (n == 0) {
+	        # return the number of active workstations
+	        do i = 1, NDEV {
+		    if (gk_status[i] == ACTIVE)
+		        ol = ol + 1
+	        }
+	    } else {
+	        # Find the nth open workstation and return its wkid
+	        this_wkstation = 0
+	        do i = 1, NDEV {
+		    if (gk_status[i] == ACTIVE) {
+		        this_wkstation = this_wkstation + 1
+		        if (this_wkstation == n) {
+			    wkid = i
+			    break
+		        }
+		    }
+	        }
+	    }
+	}
+end
diff --git a/sys/gio/gks/gqplci.x b/sys/gio/gks/gqplci.x
new file mode 100644
index 00000000..23858491
--- /dev/null
+++ b/sys/gio/gks/gqplci.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQPLCI -- Inquire Polyline color index.
+
+procedure gqplci (errind, coli)
+
+int	coli			# Color index - returned value
+int	errind			# Error indicator
+real	gstatr()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    coli = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    coli = int (gstatr (gp[gk_std], G_PLWIDTH))
+	} then {
+	    errind = 1
+	    coli = -1
+	}
+end
diff --git a/sys/gio/gks/gqpmci.x b/sys/gio/gks/gqpmci.x
new file mode 100644
index 00000000..d1760d15
--- /dev/null
+++ b/sys/gio/gks/gqpmci.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQPMCI -- Inquire Polymarker color index.
+
+procedure gqpmci (errind, coli)
+
+int	coli			# Color index - returned value
+int	errind			# Error indicator
+real	gstatr()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    coli = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    coli = int (gstatr (gp[gk_std], G_PMWIDTH))
+	} then {
+	    errind = 1
+	    coli = -1
+	}
+end
diff --git a/sys/gio/gks/gqpmi.x b/sys/gio/gks/gqpmi.x
new file mode 100644
index 00000000..b1332b54
--- /dev/null
+++ b/sys/gio/gks/gqpmi.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQPMI -- Inquire Polymarker index.
+
+procedure gqpmi (errind, index)
+
+real	index                   # Polymarker index - returned value.
+int	errind			# Error indicator
+include	"gks.com"
+
+begin
+	errind = 0
+	index = 1.0
+end
diff --git a/sys/gio/gks/gqtxal.x b/sys/gio/gks/gqtxal.x
new file mode 100644
index 00000000..36a90186
--- /dev/null
+++ b/sys/gio/gks/gqtxal.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQTXAL -- Inquire text alignment.
+
+procedure gqtxal (ierror, txalh, txalv)
+
+int	ierror			# Error indicator; ierror = 0 means no error
+int	txalh			# Horizontal text alignment
+int	txalv			# Vertical text alignment
+
+int	justify
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    txalh = -1
+	    txalv = -1
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    # Get value of horizontal text justification
+	    justify = gstati (gp[gk_std], G_TXHJUSTIFY)
+
+	    switch (justify) {
+	    case GT_NORMAL:
+	        txalh = GAHNOR
+	    case GT_CENTER:
+	        txalh = GACENT
+	    case GT_LEFT:
+	        txalh = GALEFT
+	    case GT_RIGHT:
+	        txalh = GARITE
+	    default:
+	        txalh = GAHNOR
+	    }
+
+	    # Get value of vertical text justification
+	    justify =  gstati (gp[gk_std], G_TXVJUSTIFY)
+
+	    switch (justify) {
+	    case GT_NORMAL:
+		txalv = GAVNOR
+	    case GT_CENTER:
+		txalv = GAHALF
+	    case GT_TOP:
+		txalv = GATOP
+	    case GT_BOTTOM:
+		txalv = GABOTT
+	    default:
+		txalv = GAVNOR
+	    }
+	} then {
+	    ierror = 1
+	    txalv = -1
+	    txalh = -1
+	}
+end
diff --git a/sys/gio/gks/gqtxci.x b/sys/gio/gks/gqtxci.x
new file mode 100644
index 00000000..e327660b
--- /dev/null
+++ b/sys/gio/gks/gqtxci.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQTXCI -- Inquire text color index.
+
+procedure gqtxci (ierror, coli)
+
+int	ierror			# Error indicator
+int	coli			# Color index - returned value.
+int	gstati ()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    coli = -1
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    coli = gstati (gp[gk_std], G_TXCOLOR)
+	} then {
+	    ierror = 1
+	    coli = -1
+	}
+end
diff --git a/sys/gio/gks/gqtxp.x b/sys/gio/gks/gqtxp.x
new file mode 100644
index 00000000..53dfd1af
--- /dev/null
+++ b/sys/gio/gks/gqtxp.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQTXP -- Inquire text path.
+
+procedure gqtxp (ierror, path)
+
+int	ierror			# Error indicator
+int	path			# Text path - returned value.
+
+int	text_path
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    path = -1
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    text_path =  gstati (gp[gk_std], G_TXPATH)
+
+	    switch (text_path) {
+	    case (GT_LEFT):
+	        path = GLEFT
+	    case (GT_RIGHT):
+	        path = GRIGHT
+	    case (GT_UP):
+	        path = GUP
+	    case (GT_DOWN):
+	        path = GDOWN
+	    default:
+	        path = GRIGHT
+	    }
+	} then {
+	    ierror = 1
+	    path = -1
+	}
+end
diff --git a/sys/gio/gks/gqwks.x b/sys/gio/gks/gqwks.x
new file mode 100644
index 00000000..b555fee0
--- /dev/null
+++ b/sys/gio/gks/gqwks.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GQWKS -- Inquire workstation state.  State is either ACTIVE or INACTIVE;
+# this information has been stored in gks.com by GACWK.
+
+procedure gqwks (wkid, errind, state)
+
+int	wkid			# Workstation id for inquire
+int	errind			# Error indicator
+int	state			# Returned state value: ACTIVE or INACTIVE
+include	"gks.com"
+
+begin
+	errind = 0
+	if (wkid > NDEV)
+	    errind = 1
+	else
+	    state = gk_status[wkid]
+end
diff --git a/sys/gio/gks/gsasf.x b/sys/gio/gks/gsasf.x
new file mode 100644
index 00000000..be321060
--- /dev/null
+++ b/sys/gio/gks/gsasf.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "gks.h"
+
+# GSASF -- Set aspect source flags.  Aspect source flags allow the following 
+# elements to be set to either GBUNDL or GINDIV:
+#	 1	linetype ASF
+#	 2	linewidth scale factor ASF
+#	 3	polyline colour index ASF
+#	 4	marker type ASF
+#	 5	marker size scale factor ASF
+#	 6	polymarker colout index ASF
+#	 7	text font and precision factor ASF
+#	 8	character expansion factor ASF
+#	 9	character spacing ASF
+#	 10	text colour index ASF
+#	 11	fill area interior style ASF
+#	 12	fill area style index ASF
+#	 13	fill area colout index ASF
+
+procedure gsasf (lasf)
+
+int	lasf[13]	# List of aspect source flags
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NASF
+	    gk_asf[i] = lasf[i]
+end
diff --git a/sys/gio/gks/gsaw.x b/sys/gio/gks/gsaw.x
new file mode 100644
index 00000000..dbbc0190
--- /dev/null
+++ b/sys/gio/gks/gsaw.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSAW[IR] -- Sets integer or real parameters for all active workstations.
+
+procedure gsawi (param, value)
+
+int	param		# Parameter to be set
+int	value		# New value for parameter
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gseti (gp[i], param, value)
+	}
+end
+
+
+procedure gsawr (param, value)
+
+int	param		# Parameter to be set
+real	value		# New value for parameter
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gsetr (gp[i], param, value)
+	}
+end
diff --git a/sys/gio/gks/gschh.x b/sys/gio/gks/gschh.x
new file mode 100644
index 00000000..172af231
--- /dev/null
+++ b/sys/gio/gks/gschh.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSCHH -- Set character height.
+
+procedure gschh (chh)
+
+real	chh		# Character height in world coordinates
+
+real	dx, dy, ndc_chh
+include	"gks.com"
+
+begin
+	# Input chh is in world coordinates; it must be transformed to NDC.
+	# Assuming spatial transformation is linear, input coordinates to
+	# ggscale are not used and so are set to 0.0.
+
+	call ggscale (gp[gk_std], 0.0, 0.0, dx, dy)
+	if (dy != 0) {
+	    ndc_chh = chh / dy
+	    call gsawr (G_CHARSIZE, ndc_chh)
+	} else
+	    call gsawr (G_CHARSIZE, chh)
+end
diff --git a/sys/gio/gks/gschup.x b/sys/gio/gks/gschup.x
new file mode 100644
index 00000000..d7698c41
--- /dev/null
+++ b/sys/gio/gks/gschup.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSCHUP -- Set character up vector.
+
+procedure gschup (chux, chuy)
+
+real	chux, chuy		# Character up vector, in world coordinates
+int	char_up
+bool	fp_equalr()
+
+begin
+	# Find the angle normal to the text baseline.  The angle is stored
+	# in degrees between -180 and +180.
+
+	if (fp_equalr (chux, 0.0))
+	    char_up = 90
+	else
+	    char_up = nint (atan2 (chuy, chux) * 180. / 3.1415926)
+
+	call gsawi (G_TXUP, char_up)
+end
diff --git a/sys/gio/gks/gsclip.x b/sys/gio/gks/gsclip.x
new file mode 100644
index 00000000..80fe32c0
--- /dev/null
+++ b/sys/gio/gks/gsclip.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSCLIP -- Set clipping flag.
+
+procedure gsclip (iclip)
+
+int	iclip		# New value of clipping flag
+
+begin
+	call gsawi (G_CLIP, iclip)
+end
diff --git a/sys/gio/gks/gscr.x b/sys/gio/gks/gscr.x
new file mode 100644
index 00000000..39a248e1
--- /dev/null
+++ b/sys/gio/gks/gscr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSCR -- Set color representation.  Currently implemented as a no-op.
+
+procedure gscr (wkstation, color_index, rgb)
+
+int	wkstation		# Workstation id
+int	color_index
+real	rgb[3]
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gselnt.x b/sys/gio/gks/gselnt.x
new file mode 100644
index 00000000..dfe39a3b
--- /dev/null
+++ b/sys/gio/gks/gselnt.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSELNT -- Select normalization transformation (same as world coord sys)
+
+procedure gselnt (wcs)
+
+int	wcs		# Transformation number
+
+begin
+	call gsawi (G_WCS, wcs)
+end
diff --git a/sys/gio/gks/gsfaci.x b/sys/gio/gks/gsfaci.x
new file mode 100644
index 00000000..620b0bca
--- /dev/null
+++ b/sys/gio/gks/gsfaci.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSFACI -- Set fill area color index.  Currently implemented as a no-op.
+
+procedure gsfaci (index)
+
+int	index		# Fill area color index.
+
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gsfais.x b/sys/gio/gks/gsfais.x
new file mode 100644
index 00000000..461cab8d
--- /dev/null
+++ b/sys/gio/gks/gsfais.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSFAIS -- Set fill area interior style.  Integer variable "gk_style" is
+# set and stored in "gks.com".  Procedure GFA will use this value.
+
+procedure gsfais (ints)
+
+int	ints		# Fill area interior style
+
+include	"gks.com"
+
+begin
+	switch (ints) {
+	case GHOLLO:
+	    gk_style = GF_HOLLOW
+	case GSOLID:
+	    gk_style = GF_SOLID
+	case GPATTR:
+	    gk_style = GF_HATCH4
+	case GHATCH:
+	    gk_style = GF_HATCH1
+	default:
+	    gk_style = GF_HOLLOW
+	}
+end
diff --git a/sys/gio/gks/gslwsc.x b/sys/gio/gks/gslwsc.x
new file mode 100644
index 00000000..b6f75963
--- /dev/null
+++ b/sys/gio/gks/gslwsc.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSLWSC -- Set linewidth scale.  Currently implemented as a no-op.
+
+procedure gslwsc (width)
+
+real	width		# Linewidth scale width.
+
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gsmk.x b/sys/gio/gks/gsmk.x
new file mode 100644
index 00000000..41a7b05d
--- /dev/null
+++ b/sys/gio/gks/gsmk.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSMK -- Set marker type.  Integer variable "marker" is set and
+# stored in "gks.com".  Procedure gpm uses this value.
+
+procedure gsmk (mtype)
+
+int	mtype			# Marker type for polymarker
+include	"gks.com"
+
+begin
+	switch (mtype) {
+	case GPOINT:
+	    gk_marker = GM_POINT
+	case GPLUS:
+	    gk_marker = GM_PLUS
+	case GAST:
+	    gk_marker = GM_BOX
+	case GOMARK:
+	    gk_marker = GM_DIAMOND
+	case GXMARK:
+	    gk_marker = GM_CROSS
+	default:
+	    gk_marker = GM_POINT
+	}
+end
diff --git a/sys/gio/gks/gsmksc.x b/sys/gio/gks/gsmksc.x
new file mode 100644
index 00000000..4936d7ea
--- /dev/null
+++ b/sys/gio/gks/gsmksc.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSMKSC -- Set marker scale.  Currently implemented as a no-op.
+
+procedure gsmksc (width)
+
+real	width		# Marker scale width.
+
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gsplci.x b/sys/gio/gks/gsplci.x
new file mode 100644
index 00000000..afb74b4d
--- /dev/null
+++ b/sys/gio/gks/gsplci.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSPLC -- Set polyline colour index.  This function is currently 
+# implemented as setting the polyline width, not color.
+
+procedure gsplci (coli)
+
+int	coli		# Polyline colour index
+
+begin
+	call gsawr (G_PLWIDTH, real (coli))
+end
diff --git a/sys/gio/gks/gspmci.x b/sys/gio/gks/gspmci.x
new file mode 100644
index 00000000..909800cf
--- /dev/null
+++ b/sys/gio/gks/gspmci.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSPMCI -- Set polymarker colour index.  This function is currently
+# implemented as setting the polymarker width, not color.
+
+procedure gspmci (coli)
+
+int	coli		# Polymarker colour index.
+
+begin
+	call gsawr (G_PMCOLOR, real (coli))
+end
diff --git a/sys/gio/gks/gspmi.x b/sys/gio/gks/gspmi.x
new file mode 100644
index 00000000..e238fc10
--- /dev/null
+++ b/sys/gio/gks/gspmi.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSPMI -- Set polymarker index.  This function is currently
+# implemented as a no-op.
+
+procedure gspmi (index)
+
+int	index		# Polymarker index. (whatever that is)
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gstxal.x b/sys/gio/gks/gstxal.x
new file mode 100644
index 00000000..aecae88f
--- /dev/null
+++ b/sys/gio/gks/gstxal.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSTXAL -- Set format alignment.  
+
+procedure gstxal (txalh, txalv)
+
+int	txalh		# Horizontal alignment
+int	txalv		# Vertical alignment
+
+begin
+	switch (txalh) {
+	case GAHNOR:
+	    call gsawi (G_TXHJUSTIFY, GT_NORMAL)
+	case GALEFT:
+	    call gsawi (G_TXHJUSTIFY, GT_LEFT)
+	case GACENT:
+	    call gsawi (G_TXHJUSTIFY, GT_CENTER)
+	case GARITE:
+	    call gsawi (G_TXHJUSTIFY, GT_RIGHT)
+	default:
+	    call gsawi (G_TXHJUSTIFY, GT_NORMAL)
+	}
+
+	switch (txalv) {
+	case GAVNOR:
+	    call gsawi (G_TXVJUSTIFY, GT_NORMAL)
+	case GATOP:
+	    call gsawi (G_TXVJUSTIFY, GT_TOP)
+	case GACAP:
+	    call gsawi (G_TXVJUSTIFY, GT_TOP)
+	case GAHALF:
+	    call gsawi (G_TXVJUSTIFY, GT_CENTER)
+	case GABASE:
+	    call gsawi (G_TXVJUSTIFY, GT_BOTTOM)
+	case GABOTT:
+	    call gsawi (G_TXVJUSTIFY, GT_BOTTOM)
+	default:
+	    call gsawi (G_TXVJUSTIFY, GT_NORMAL)
+	}
+end
diff --git a/sys/gio/gks/gstxci.x b/sys/gio/gks/gstxci.x
new file mode 100644
index 00000000..ec04132c
--- /dev/null
+++ b/sys/gio/gks/gstxci.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSTXCI -- Set colour index.  This function is currently implemented
+# by setting the text font to bold when the color index > 1, and to
+# the default (roman) otherwise.
+
+procedure gstxci (coli)
+
+int	coli		# Text colour index
+
+begin
+	if (coli > 1)
+	    call gsawi (G_TXFONT, GT_BOLD)
+	else 
+	    call gsawi (G_TXFONT, GT_ROMAN)
+end
diff --git a/sys/gio/gks/gstxp.x b/sys/gio/gks/gstxp.x
new file mode 100644
index 00000000..cf87e4f2
--- /dev/null
+++ b/sys/gio/gks/gstxp.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSTXP -- Set text path.
+
+procedure gstxp (txp)
+
+int	txp		# Text path to be set
+
+begin
+	switch (txp) {
+	case GRIGHT:
+	    call gsawi (G_TXPATH, GT_RIGHT)
+	case GLEFT:
+	    call gsawi (G_TXPATH, GT_LEFT)
+	case GUP:
+	    call gsawi (G_TXPATH, GT_UP)
+	case GDOWN:
+	    call gsawi (G_TXPATH, GT_DOWN)
+	default:
+	    call gsawi (G_TXPATH, GT_RIGHT)
+	}
+end
diff --git a/sys/gio/gks/gsvp.x b/sys/gio/gks/gsvp.x
new file mode 100644
index 00000000..f2a61711
--- /dev/null
+++ b/sys/gio/gks/gsvp.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSVP -- Set viewport.  This procedure sets the viewport for world coord
+# sys "wcs", which may not be the current WCS.
+
+procedure gsvp (wcs, x1, x2, y1, y2)
+
+int	wcs		# Number of world coordinate system
+real	x1, x2		# Range of viewport coordinate in x (NDC)
+real	y1, y2		# Range of viewport coordinate in y (NDC)
+
+int	current_wcs, i
+int	gstati()
+include	"gks.com"
+
+begin
+	current_wcs = gstati (gp[gk_std], G_WCS)
+	call gsawi (G_WCS, wcs)
+
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gsview (gp[i], x1, x2, y1, y2)
+	}
+
+	# Now return to the current WCS
+	call gsawi (G_WCS, current_wcs)
+end
diff --git a/sys/gio/gks/gswn.x b/sys/gio/gks/gswn.x
new file mode 100644
index 00000000..713ae487
--- /dev/null
+++ b/sys/gio/gks/gswn.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSWN -- Set window.  Window of world coord system "wcs" is set, which
+# is not necessarily the current WCS.
+
+procedure gswn (wcs, x1, x2, y1, y2)
+
+int	wcs		# Number of world coordinate system (transformation)
+real	x1, x2		# Range of world coordinates in x
+real	y1, y2		# Range of world coordinates in y
+
+int	current_wcs, i
+int	gstati()
+include	"gks.com"
+
+begin
+	current_wcs = gstati (gp[gk_std], G_WCS)
+	call gsawi (G_WCS, wcs)
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+	    call gswind (gp[i], x1, x2, y1, y2)
+	}
+
+	# Now return to current WCS before returning
+	call gsawi (G_WCS, current_wcs)
+end
diff --git a/sys/gio/gks/gtx.f b/sys/gio/gks/gtx.f
new file mode 100644
index 00000000..c09ef7c4
--- /dev/null
+++ b/sys/gio/gks/gtx.f
@@ -0,0 +1,16 @@
+c GTX -- Text.  Unpack an f77 string and call gx_gtx to output the string.
+c
+	subroutine gtx (px, py, f77chars)
+c
+	real		px, py
+	character*(*) 	f77chars
+	integer*2     	sppchars(161)
+c
+c
+c	Unpack characters from packed input array
+c
+	call f77upk (f77chars, sppchars, min (len(f77chars), 161))
+	call gxgtx (px, py, sppchars)
+c
+c
+	end
diff --git a/sys/gio/gks/gxgtx.x b/sys/gio/gks/gxgtx.x
new file mode 100644
index 00000000..0ca39bb5
--- /dev/null
+++ b/sys/gio/gks/gxgtx.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GXGTX -- Text.  Ouptut an spp string with gtext.  The string has already
+# been unpacked from an f77 to spp string.
+
+procedure gxgtx (px, py, chars)
+
+real	px, py		# Text position in world coordinates
+char	chars[ARB]	# String of characters
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gtext (gp[i], px, py, chars, "")
+	}
+end
diff --git a/sys/gio/gks/mkpkg b/sys/gio/gks/mkpkg
new file mode 100644
index 00000000..864c3ba7
--- /dev/null
+++ b/sys/gio/gks/mkpkg
@@ -0,0 +1,58 @@
+# Make the GKS emulator.
+
+$checkout libgks.a lib$
+$update	  libgks.a
+$checkin  libgks.a lib$
+$exit
+
+libgks.a:
+	gacwk.x		gks.com gks.h
+	gca.x		gks.com gks.h <gset.h>
+	gcas.x		gks.com gks.h <gset.h>
+	gclks.x
+	gclrwk.x	gks.com gks.h
+	gclwk.x		gks.com gks.h
+	gdawk.x		gks.com gks.h
+	gfa.x		gks.h <gset.h> gks.com
+	gopks.x		gks.com gks.h
+	gopwk.x		gks.com gks.h
+	gpl.x		gks.com gks.h
+	gpm.x		gks.com gks.h <gset.h>
+	gqasf.x		gks.com gks.h
+	gqchh.x		gks.com gks.h <gset.h>
+	gqchup.x	gks.com gks.h <gset.h>
+	gqclip.x 	gks.com gks.h <gset.h> 
+	gqcntn.x	gks.com gks.h <gset.h>
+	gqmk.x		gks.com gks.h <gset.h>
+	gqnt.x		gks.com gks.h <gset.h>
+	gqopwk.x	gks.com gks.h
+	gqplci.x	gks.com gks.h <gset.h>
+	gqpmci.x	gks.com gks.h <gset.h>
+	gqpmi.x		gks.com gks.h <gset.h>
+	gqtxal.x	gks.com gks.h <gset.h>
+	gqtxci.x	gks.com gks.h <gset.h>
+	gqtxp.x		gks.com gks.h <gset.h>
+	gqwks.x		gks.com gks.h
+	gsasf.x		gks.com gks.h
+	gsaw.x		gks.com gks.h <gset.h>
+	gschh.x		gks.com gks.h <gset.h>
+	gschup.x	<gset.h>
+	gsclip.x	<gset.h>
+	gscr.x		gks.com gks.h <gset.h>
+	gselnt.x	<gset.h>
+	gsfaci.x	gks.com gks.h <gset.h>
+	gsfais.x	gks.com gks.h <gset.h>
+	gslwsc.x	gks.com gks.h <gset.h>
+	gsmk.x		gks.com gks.h <gset.h>
+	gsmksc.x	gks.com gks.h <gset.h>
+	gsplci.x	<gset.h>
+	gspmci.x	<gset.h>
+	gspmi.x		<gset.h>
+	gstxal.x	gks.h <gset.h>
+	gstxci.x	<gset.h>
+	gstxp.x		gks.h <gset.h>
+	gsvp.x		gks.com gks.h <gset.h>
+	gswn.x		gks.com gks.h <gset.h>
+	gtx.f
+	gxgtx.x		gks.com gks.h <gset.h>
+	;
diff --git a/sys/gio/glabax/README b/sys/gio/glabax/README
new file mode 100644
index 00000000..4c9f9ad5
--- /dev/null
+++ b/sys/gio/glabax/README
@@ -0,0 +1 @@
+GLABAX -- GIO axis drawing and labelling package.
diff --git a/sys/gio/glabax/glabax.h b/sys/gio/glabax/glabax.h
new file mode 100644
index 00000000..070918ec
--- /dev/null
+++ b/sys/gio/glabax/glabax.h
@@ -0,0 +1,46 @@
+# GLABAX.H -- Axis drawing and labelling.
+
+define	SZ_FORMAT		19
+define	SZ_LABEL		19
+define	MAX_LINEARITY		1.0			# no log scaling if gt
+define	LEFT_BORDER		9			# nchars at l|r edge
+define	BOTTOM_BORDER		5			# nlines at bottom edge
+define	Y_LABELOFFSET		7			# Y label dist from axis
+define	MAX_SZTITLEBLOCK	0.5			# max sztitleblock, NDC
+define	MIN_NTITLELINES		2			# min lines in titleblk
+define	TOL			(EPSILONR*10.0)
+
+define	LEN_AX			85
+define	AX_POS			Memd[P2D($1)+$2-1]	# tick coords
+define	AX_DRAWME		Memi[$1+4]		# draw this axis
+define	AX_HORIZONTAL		Memi[$1+5]		# axis is horizontal
+define	AX_SCALING		Memi[$1+6]		# type of scaling
+define	AX_DRAWTICKS		Memi[$1+7]		# draw the ticks
+define	AX_START		Memr[P2R($1+8+$2-1)]	# axis starts here
+define	AX_END			Memr[P2R($1+10+$2-1)]	# axis ends here
+define	AX_TICK1		Memr[P2R($1+12+$2-1)]	# first tick is here
+define	AX_STEP			Memr[P2R($1+14+$2-1)]	# offset between ticks
+define	AX_ISTEP		Memr[P2R($1+16+$2-1)]	# intial offset
+define	AX_KSTEP		Memr[P2R($1+18)]	# step scalar at majors
+define	AX_IKSTEP		Memr[P2R($1+19)]	# initial kstep
+define	AX_NMINOR		Memi[$1+20]		# nminor ticks
+define	AX_NLEFT		Memi[$1+21]		# nminor to next major
+define	AX_INLEFT		Memi[$1+22]		# initial nleft
+define	AX_NDIGITS		Memi[$1+23]		# ndigits of precision
+define	AX_MINORTICK		Memr[P2R($1+24+$2-1)]	# offset to draw minor
+define	AX_MAJORTICK		Memr[P2R($1+26+$2-1)]	# offset to draw major
+define	AX_MINORWIDTH		Memr[P2R($1+28)]	# minor tick linewidth
+define	AX_MAJORWIDTH		Memr[P2R($1+29)]	# major tick linewidth
+define	AX_LABELTICKS		Memi[$1+30]		# draw tick labels
+define	AX_TICKLABELOFFSET	Memr[P2R($1+31+$2-1)]	# offset to ticklabel
+define	AX_TICKLABELSIZE	Memr[P2R($1+33)]	# char size of ticklabel
+define	AX_TICKLABELCOLOR	Memi[$1+34]		# char size of ticklabel
+define	AX_TICKCOLOR		Memi[$1+35]		# grid between ticks
+define	AX_AXISLABELSIZE	Memr[P2R($1+36)]	# char size axislabel
+define	AX_AXISLABELCOLOR	Memi[$1+37]		# char size axislabel
+define	AX_AXISWIDTH		Memr[P2R($1+38)]	# axis linewidth
+define	AX_AXISCOLOR		Memi[$1+39]		# axis linewidth
+define	AX_GRIDCOLOR		Memi[$1+40]		# grid between ticks
+
+define	AX_TICKLABELPOS		Memc[P2C($1+45)]	# gtext format
+define	AX_TICKFORMAT		Memc[P2C($1+65)]	# numeric format
diff --git a/sys/gio/glabax/glabax.x b/sys/gio/glabax/glabax.x
new file mode 100644
index 00000000..0c30021b
--- /dev/null
+++ b/sys/gio/glabax/glabax.x
@@ -0,0 +1,264 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLABAX -- Draw and label the axes of the plot (normally the viewport
+# boundary).  This is done in two steps.  First we compute all the required
+# parameters, and then we draw and label the axes.  Up to four axes can be
+# drawn.  To simplify matters, all four axes are treated equally and
+# independently.  The axes are drawn a tick at a time in world coordinates.
+
+procedure glabax (gp, title, xlabel, ylabel)
+
+pointer	gp			# graphics descriptor
+char	title[ARB]		# plot title (may be more than one line)
+char	xlabel[ARB]		# X axis label
+char	ylabel[ARB]		# Y axis label
+
+char	label[SZ_LABEL]
+int	axis, wcs, ntitlelines, ip, major_tick
+int	save_plcolor, save_txcolor, save_facolor
+int	save_pltype, save_clip, save_txfont
+real	xv[4], yv[4], x1, x2, y1, y2
+real	save_plwidth, save_txsize
+real	dx, dy, x, y, sx, sy, scalar, wc, wstep
+pointer	sp, axes[4], ax, w
+
+real	gstatr()
+bool	ttygetb()
+int	gstati(), glb_gettick()
+errchk	glb_setup, gadraw, grdraw, gamove, gtext
+errchk	glb_label_axis, glb_plot_title, glb_gettick
+
+begin
+	call smark (sp)
+	call salloc (axes[1], LEN_AX, TY_STRUCT)
+	call salloc (axes[2], LEN_AX, TY_STRUCT)
+	call salloc (axes[3], LEN_AX, TY_STRUCT)
+	call salloc (axes[4], LEN_AX, TY_STRUCT)
+
+	wcs = GP_WCS(gp)
+	w   = GP_WCSPTR(gp,wcs)
+
+	# Count the number of lines in the title block.
+	ntitlelines = 0
+	if (title[1] != EOS) {
+	    for (ip=1;  title[ip] != EOS;  ip=ip+1)
+		if (title[ip] == '\n' && title[ip+1] != EOS)
+		    ntitlelines = ntitlelines + 1
+	    ntitlelines = ntitlelines + 1
+	}
+	ntitlelines = max (ntitlelines, GP_NTITLELINES(gp))
+
+	# Fix the coordinates systems and set the axis drawing parameters.
+	# The number of lines in the title block is needed to determine how
+	# much space to allow at the top of the screen.
+
+	call glb_setup (gp, axes, ntitlelines, xlabel, ylabel)
+
+	# Save the values of any user parameters we must change while drawing
+	# the axes.
+
+	save_pltype  = gstati (gp, G_PLTYPE)
+	save_plwidth = gstatr (gp, G_PLWIDTH)
+	save_plcolor = gstati (gp, G_PLCOLOR)
+	save_txfont  = gstati (gp, G_TXFONT)
+	save_txsize  = gstatr (gp, G_TXSIZE)
+	save_txcolor = gstati (gp, G_TXCOLOR)
+	save_facolor = gstati (gp, G_FACOLOR)
+	save_clip    = WCS_CLIP(w)
+
+	# Prepare the background.
+	if (ttygetb (GP_TTY(gp), "fa") &&
+	    GP_FRAMECOLOR(gp) != 0 && GP_FRAMEDRAWN(gp) == NO) {
+
+	    call ggview (gp, x1, x2, y1, y2)
+	    call gseti (gp, G_WCS, 0)
+	    call gseti (gp, G_CLIP, NO)
+
+	    xv[1] = 0.0;  yv[1] = 0.0
+	    xv[2] = 1.0;  yv[2] = 0.0
+	    xv[3] = 1.0;  yv[3] = 1.0
+	    xv[4] = 0.0;  yv[4] = 1.0
+	    call gseti (gp, G_FACOLOR, GP_FRAMECOLOR(gp))
+	    call gfill (gp, xv, yv, 4, GF_SOLID)
+
+	    xv[1] = x1;  yv[1] = y1
+	    xv[2] = x2;  yv[2] = y1
+	    xv[3] = x2;  yv[3] = y2
+	    xv[4] = x1;  yv[4] = y2
+	    call gseti (gp, G_FACOLOR, 0)
+	    call gfill (gp, xv, yv, 4, GF_SOLID)
+
+	    call gseti (gp, G_CLIP, save_clip)
+	    call gseti (gp, G_WCS, wcs)
+	    GP_FRAMEDRAWN(gp) = YES
+	}
+
+	# Draw and label the four axes.  First set the linetype and linewidth
+	# to be used to draw the axes and ticks; these may be different than
+	# that used to plot the data.  Draws are preferred to moves to minimize
+	# the number of polylines needed to draw the axis.  An axis is drawn
+	# by moving to the start of the axis, drawing each tick in sequence,
+	# and then moving to the end of the axis.  Tick labels are drawn at
+	# the major ticks if required.  The axes and ticks must be drawn in
+	# world coords to get the proper scaling.  Clipping is turned off while
+	# drawing the axes to avoid clipping portions of the axes due to small
+	# floating point errors.
+
+	call gseti (gp, G_PLTYPE, 1)
+	call gseti (gp, G_CLIP, NO)
+	call gseti (gp, G_TXFONT, GT_BOLD)
+
+	do axis = 1, 4 {
+	    ax = axes[axis]
+	    if (AX_DRAWME(ax) == NO)
+		next
+
+#  call eprintf ("axis %d: tick1=(%g,%g) istep=(%g,%g) kstep=%g\n")
+#  call pargi (axis)
+#  call pargr (AX_TICK1(ax,1)); call pargr (AX_TICK1(ax,2))
+#  call pargr (AX_ISTEP(ax,1)); call pargr (AX_ISTEP(ax,2))
+#  call pargr (AX_IKSTEP(ax))
+#  call eprintf ("\tstart=(%g,%g) end=(%g,%g)\n")
+#  call pargr (AX_START(ax,1)); call pargr (AX_START(ax,2))
+#  call pargr (AX_END(ax,1)); call pargr (AX_END(ax,2))
+#  call eprintf ("nminor=%d, inleft=%d, minortick=(%g,%g), majortick=(%g,%g)\n")
+#  call pargi (AX_NMINOR(ax)); call pargi (AX_INLEFT(ax))
+#  call pargr (AX_MINORTICK(ax,1)); call pargr (AX_MINORTICK(ax,2))
+#  call pargr (AX_MAJORTICK(ax,1)); call pargr (AX_MAJORTICK(ax,2))
+
+	    # Set the axis linewidth and move to the start of the axis.
+	    call gsetr (gp, G_PLWIDTH, AX_AXISWIDTH(ax))
+	    call gseti (gp, G_PLCOLOR, AX_AXISCOLOR(ax))
+	    call gamove (gp, AX_START(ax,1), AX_START(ax,2))
+
+	    # Draw the axis and label the major ticks if so indicated.
+	    # First set flag to initialize glb_gettick.
+
+	    AX_NLEFT(ax) = -1
+	    while (glb_gettick (gp, ax, x, y, major_tick) != EOF) {
+
+		# Advance to the next tick.
+		call gsetr (gp, G_PLWIDTH, AX_AXISWIDTH(ax))
+		call gseti (gp, G_PLCOLOR, AX_AXISCOLOR(ax))
+		call gadraw (gp, x, y)
+
+		if (major_tick == YES) {
+		    # Draw a major tick.
+
+		    call gsetr (gp, G_PLWIDTH, AX_MAJORWIDTH(ax))
+		    call gseti (gp, G_PLCOLOR, AX_TICKCOLOR(ax))
+		    dx = AX_MAJORTICK(ax,1)
+		    dy = AX_MAJORTICK(ax,2)
+		    call grdraw (gp, dx, dy)
+		    call grdraw (gp, -dx, -dy)
+
+		    if (AX_LABELTICKS(ax) == YES) {
+			# Get the tick label position in NDC coords.  World
+			# coords cannot be used for an offset outside the
+			# viewport as the coords might be indefinite if log
+			# scaling.
+
+			call gseti (gp, G_WCS, 0)
+			call gcurpos (gp, sx, sy)
+			dx = AX_TICKLABELOFFSET(ax,1)
+			dy = AX_TICKLABELOFFSET(ax,2)
+
+			# Format the numeric tick label string.  The scalar
+			# multiplier is used to compute the step size between
+			# major ticks.
+
+			scalar = AX_NMINOR(ax) + 1.0
+			if (AX_HORIZONTAL(ax) == YES) {
+			    wc = x
+			    wstep = AX_STEP(ax,1) * scalar
+			} else {
+			    wc = y
+			    wstep = AX_STEP(ax,2) * scalar
+			}
+
+			# Draw the label string.
+			call gsetr (gp, G_TXSIZE, AX_TICKLABELSIZE(ax))
+			call gseti (gp, G_TXCOLOR, AX_TICKLABELCOLOR(ax))
+
+			# If log scaling, label the ticks in log units.
+			if (AX_SCALING(ax) == LINEAR) {
+			    call glb_encode (wc, label, SZ_LABEL,
+				AX_TICKFORMAT(ax), wstep)
+			    call gtext (gp, sx + dx, sy + dy, label,
+				AX_TICKLABELPOS(ax))
+			} else {
+			    call glb_loglab (gp, sx+dx, sy+dy, wc,
+				AX_TICKLABELPOS(ax), AX_SCALING(ax))
+			}
+
+			# Leave the pen back at the base of the tick.
+			call gamove (gp, sx, sy)
+			call gseti (gp, G_WCS, wcs)
+		    } 
+
+		} else {
+		    # Draw a minor tick.
+
+		    dx = AX_MINORTICK(ax,1)
+		    dy = AX_MINORTICK(ax,2)
+
+		    call gsetr (gp, G_PLWIDTH, AX_MINORWIDTH(ax))
+		    call gseti (gp, G_PLCOLOR, AX_TICKCOLOR(ax))
+		    call grdraw (gp, dx, dy)
+		    call grdraw (gp, -dx, -dy)
+		}
+	    }
+
+	    # Draw line segment from last tick to the end of the axis.
+	    call gadraw (gp, AX_END(ax,1), AX_END(ax,2))
+
+	    # Flush the graphics output.  When working interactively, this
+	    # gives the user something to watch while we generate the rest
+	    # of the plot.
+
+	    if (AX_NMINOR(ax) > 0)
+		call gflush (gp)
+	}
+
+	# Draw grid between major ticks.
+	if (GL_DRAWGRID (GP_XAP(gp)) == YES) {
+	    call gseti (gp, G_PLCOLOR, AX_GRIDCOLOR(axes[3]))
+	    call glb_drawgrid (gp, axes[3], axes[2])
+	}
+	if (GL_DRAWGRID (GP_YAP(gp)) == YES) {
+	    call gseti (gp, G_PLCOLOR, AX_GRIDCOLOR(axes[1]))
+	    call glb_drawgrid (gp, axes[1], axes[4])
+	}
+
+	# Label the X and Y axes.
+	do axis = 1, 4 {
+	    ax = axes[axis]
+	    if (AX_DRAWME(ax) == YES && AX_LABELTICKS(ax) == YES) {
+		call gseti (gp, G_TXCOLOR, AX_AXISLABELCOLOR(ax))
+		call glb_label_axis (gp, ax, xlabel, ylabel)
+	    }
+	}
+
+	# Draw plot title block.
+	call gseti (gp, G_TXCOLOR, GP_TITLECOLOR(gp))
+	call glb_plot_title (gp, title, ntitlelines)
+
+	# Restore the parameters we were originally called with.
+	call gseti (gp, G_WCS, wcs)
+	call gseti (gp, G_CLIP,    save_clip)
+	call gseti (gp, G_PLTYPE,  save_pltype)
+	call gsetr (gp, G_PLWIDTH, save_plwidth)
+	call gseti (gp, G_PLCOLOR, save_plcolor)
+	call gsetr (gp, G_TXSIZE,  save_txsize)
+	call gseti (gp, G_TXFONT,  save_txfont)
+	call gseti (gp, G_TXCOLOR, save_txcolor)
+	call gseti (gp, G_FACOLOR, save_facolor)
+
+	call gflush (gp)
+	call sfree (sp)
+end
diff --git a/sys/gio/glabax/glbencode.x b/sys/gio/glabax/glbencode.x
new file mode 100644
index 00000000..cbed6875
--- /dev/null
+++ b/sys/gio/glabax/glbencode.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"glabax.h"
+
+# GLB_ENCODE -- Encode a floating point number as a character string for a
+# tick label.  We have to be careful how we do this, since on the one hand
+# we want the most concise label possible (e.g., 500 not 500.00) but on the
+# other we must provide enough precision to discriminate between ticks that
+# are close together (e.g., 500.02 and 500.04).  The extra information is
+# given by the "ndigits" argument, which was calculated knowing the range
+# and step at setup time.
+
+procedure glb_encode (x, out, maxch, format, step)
+
+real	x			# number to be encoded
+char	out[ARB]		# output string
+int	maxch			# max chars out
+char	format[ARB]		# sprintf format
+real	step			# tick spacing
+
+int	ip, op
+real	nicex
+define	trim_ 91
+
+begin
+	# Test for the zero tick, to avoid tick labels that look like the
+	# machine epsilon.
+
+	if (abs (x / step) < TOL)
+	    nicex = 0
+	else
+	    nicex = x
+
+	# Encode number.
+	call sprintf (out, maxch, format)
+	    call pargr (nicex)
+
+	# Lop off any insignificant trailing zeros or periods.  Watch out for
+	# trailing zeros in exponential format, e.g., "1.0E10".
+
+	for (ip=1;  out[ip] != EOS;  ip=ip+1)
+	    if (out[ip] == 'E' || out[ip] == 'D')
+		goto trim_
+
+	for (ip=ip-1;  ip > 1 && out[ip] == '0';  ip=ip-1)
+	    ;
+	if (ip > 1 && out[ip] == '.')
+	    ip = ip - 1
+	if (ip >= 1)
+	    out[ip+1] = EOS
+
+	# Lop off any insignificant leading zeros, but be sure to leave at
+	# least one digit.
+trim_
+	for (op=1;  out[op] == '-' || out[op] == '+';  op=op+1)
+	    ;
+	for (ip=op;  out[ip] == '0' && out[ip+1] != EOS;  ip=ip+1)
+	    ;
+	while (out[ip] != EOS) {
+	    out[op] = out[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	out[op] = EOS
+end
diff --git a/sys/gio/glabax/glbfind.x b/sys/gio/glabax/glbfind.x
new file mode 100644
index 00000000..b9ff3975
--- /dev/null
+++ b/sys/gio/glabax/glbfind.x
@@ -0,0 +1,339 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_FIND_TICKS -- Find the optimal positions for the tick marks on an axis.
+# If rounding is enabled, extend the WCS out to the next tick outside the
+# boundary on either end of the axis.  Since this routine may modify the WCS
+# it must be called before any other routines (e.g., glb_setaxes).  Our task
+# is to position the major ticks in world coordinates at round numbers, e.g.,
+# 10, 20, 30 for a linear scale or 10, 100, 1000 for a log scale.  The minor
+# ticks are evenly distributed over the range between the major ticks.  If
+# log scaling is in use the step size between ticks will change by an order
+# of magnitude (by the factor KSTEP) in each decade of the log scale, i.e.,
+# at each major tick.  All tick positions and offsets are output in world
+# coordinates.
+
+procedure glb_find_ticks (gp, ap, ax1, ax2, angle)
+
+pointer	gp			# graphics descriptor
+pointer	ap			# axis parameters (from graphics descriptor)
+pointer	ax1, ax2		# axis descriptors (output)
+int	angle			# axis orientation, 0 or 90 degrees
+
+pointer	w
+int	logflag, nminor, scaling, t1, t2
+real	char_height, char_width, wctick, tval
+real	p1, p2, tp1, tp2, wcp1, tick1, step, minor_step, length
+
+bool	fp_equalr()
+int	gt_ndigits()
+real	ggetr(), elogr(), aelogr(), glb_minorstep()
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Start by zeroing the AX structures so that we do not have to zero
+	# fields explicitly.  This is a bit tricky because we are implicitly
+	# setting fields that are not named, but it saves time and space.
+
+	call aclri (Memi[ax1], LEN_AX)
+	call aclri (Memi[ax2], LEN_AX)
+
+	# If ticks are not to be drawn or if there are fewer than 2 ticks then
+	# we are done.
+
+	if (GL_NMAJOR(ap) <= 2)
+	    return
+
+	# Call the tick placement algorithm to determine where to put the major
+	# tick marks.  The output of this block are the variables P1 and P1,
+	# the world coords of the ends of the axis, and TICK1 and STEP, the
+	# world coords of the first tick and separation in world coords between
+	# major ticks.
+
+	if (angle == 0) {
+	    p1 = WCS_WX1(w)
+	    p2 = WCS_WX2(w)
+	    scaling = WCS_XTRAN(w)
+	} else {
+	    p1 = WCS_WY1(w)
+	    p2 = WCS_WY2(w)
+	    scaling = WCS_YTRAN(w)
+	}
+
+	AX_SCALING(ax1) = scaling
+	AX_SCALING(ax2) = scaling
+
+	if (scaling == LOG) {
+	    p1 = log10 (p1)
+	    p2 = log10 (p2)
+	    logflag = YES
+	} else if (scaling == ELOG) {
+	    p1 = elogr (p1)
+	    p2 = elogr (p2)
+	    logflag = YES
+	} else
+	    logflag = NO
+
+	# Call the tick placement algorithm.
+	call gtickr (p1, p2, GL_NMAJOR(ap), logflag, tick1, step)
+
+	# If rounding is enabled, extend the WCS out to the next major tick
+	# position outward on either end.  Always round if log scaling.
+
+	if (GL_ROUND(ap) == YES || scaling != LINEAR) {
+	    if (!fp_equalr (p1, tick1)) {
+		tick1 = tick1 - step
+		p1 = tick1
+	    }
+
+	    length = (p2 - p1) / step
+	    if (!fp_equalr (p1 + int(length) * step, p2))
+		p2 = p1 + (int(length) + 1) * step
+
+	    if (scaling == ELOG) {
+		tp1 = aelogr (p1)
+		tp2 = aelogr (p2)
+	    } else if (scaling == LOG) {
+		tp1 = 10.0 ** p1
+		tp2 = 10.0 ** p2
+	    } else {
+		tp1 = p1
+		tp2 = p2
+	    }
+
+	    if (angle == 0) {
+		WCS_WX1(w) = tp1
+		WCS_WX2(w) = tp2
+	    } else {
+		WCS_WY1(w) = tp1
+		WCS_WY2(w) = tp2
+	    }
+
+	    GP_WCSSTATE(gp) = MODIFIED
+	}
+
+	# Compute the coords of the axis endpoint and of the first tick in world
+	# coords.
+
+	if (scaling == LINEAR) {
+	    wctick = tick1
+	    wcp1 = p1
+	} else if (scaling == LOG) {
+	    wctick = 10.0 ** tick1
+	    wcp1 = 10.0 ** p1
+	} else {
+	    wctick = aelogr (tick1)
+	    wcp1 = aelogr (p1)
+	}
+
+	# Compute the number of minor ticks.  If we are log scaling there
+	# are either no minor ticks or 8 minor ticks.  If the scaling is
+	# linear the tick placement algorithm is used to compute the best
+	# number of minor ticks, using GL_NMINOR as a close estimate.  If
+	# NMINOR is negative automatic tick selection is disabled and exactly
+	# abs(NMINOR) ticks will be drawn.  If NMINOR is zero no minor ticks
+	# are drawn.
+
+	if (GL_NMINOR(ap) == 0)			# no minor ticks
+	    nminor = 0
+	else if (logflag == YES)		# log scaling
+	    nminor = 8
+	else {
+	    minor_step = glb_minorstep (tick1, tick1+step, GL_NMINOR(ap))
+	    nminor = nint (abs (step / minor_step)) - 1
+	}
+
+	AX_NMINOR(ax1) = nminor
+	AX_NMINOR(ax2) = nminor
+
+	# Compute the step size in world coords between minor ticks and the
+	# number of minor ticks to be drawn initially until the first major
+	# tick (tick1) is reached.  Note that for ELOG scaling the minor
+	# step size and number of minor ticks are different in the range
+	# +-10 (which is linear) than elsewhere, but we ignore that here.
+
+	if (scaling == LINEAR) {
+	    minor_step = step / (nminor + 1)
+	    AX_INLEFT(ax1) = abs (int ((wctick - wcp1) / minor_step))
+	} else {
+	    t1 = nint (tick1)
+	    t2 = nint (tick1 + step)
+	    if (scaling == LOG)
+		minor_step = (10.0 ** t2 - 10.0 ** t1) / 9.
+	    else
+		minor_step = (aelogr(real(t2)) - aelogr(real(t1))) / 9.
+	    if (nminor == 0)
+		minor_step = minor_step * 9.
+	    AX_INLEFT(ax1) = 0
+	}
+
+	AX_INLEFT(ax2) = AX_INLEFT(ax1)
+
+	# Set KSTEP, the adjustment to the step size at each major tick.  This
+	# is always 1.0 if the scale is linear.  Set KSTEP to negative if ELOG
+	# scaling, to tell the drawing code to invert kstep (.1->10 or 10->.1)
+	# when passing through the origin (necessary for ELOG scaling).  The
+	# sign is not otherwise significant.  If heading toward the origin
+	# initially then KSTEP is inverted for ELOG scaling vs LOG scaling.
+
+	if (scaling == LINEAR) {
+	    AX_IKSTEP(ax1) = 1.0
+	} else if (scaling == ELOG) {
+	    tval = p1
+	    if (abs (tval + step) > abs(t1))
+		AX_IKSTEP(ax1) = -10.0
+	    else
+		AX_IKSTEP(ax1) = -0.1
+	} else
+	    AX_IKSTEP(ax1) = 10.0 ** step
+	AX_IKSTEP(ax2) = AX_IKSTEP(ax1)
+
+	# Set those parameters which differ depending on whether the axis is
+	# horizontal or vertical.
+
+	if (angle == 0) {
+	    AX_TICK1(ax1,1) = wctick - (AX_INLEFT(ax1) * minor_step)
+	    AX_TICK1(ax2,1) = wctick - (AX_INLEFT(ax2) * minor_step)
+
+	    if (GL_SETAXISPOS(ap) == YES) {
+		AX_TICK1(ax1,2) = GL_AXISPOS1(ap)
+		AX_TICK1(ax2,2) = GL_AXISPOS2(ap)
+	    } else {
+		AX_TICK1(ax1,2) = WCS_WY1(w)
+		AX_TICK1(ax2,2) = WCS_WY2(w)
+	    }
+
+	    AX_ISTEP(ax1,1) = minor_step
+	    AX_ISTEP(ax2,1) = minor_step
+
+	    char_height = ggetr (gp, "ch")
+	    if (char_height < EPSILON)
+		char_height = DEF_CHARHEIGHT
+	    char_height = char_height * GL_TICKLABELSIZE(ap)
+
+	    AX_TICKLABELOFFSET(ax2,2) = 0.5 * char_height
+	    AX_TICKLABELOFFSET(ax1,2) = -AX_TICKLABELOFFSET(ax2,2)
+
+	    # Set gtext format for tick labels.
+	    call strcpy ("hj=c,vj=t", AX_TICKLABELPOS(ax1), SZ_FORMAT)
+	    call strcpy ("hj=c,vj=b", AX_TICKLABELPOS(ax2), SZ_FORMAT)
+
+	} else {
+	    if (GL_SETAXISPOS(ap) == YES) {
+		AX_TICK1(ax1,1) = GL_AXISPOS1(ap)
+		AX_TICK1(ax2,1) = GL_AXISPOS2(ap)
+	    } else {
+		AX_TICK1(ax1,1) = WCS_WX1(w)
+		AX_TICK1(ax2,1) = WCS_WX2(w)
+	    }
+
+	    AX_TICK1(ax1,2) = wctick - (AX_INLEFT(ax1) * minor_step)
+	    AX_TICK1(ax2,2) = wctick - (AX_INLEFT(ax2) * minor_step)
+
+	    AX_ISTEP(ax1,2) = minor_step
+	    AX_ISTEP(ax2,2) = minor_step
+
+	    char_width = ggetr (gp, "cw")
+	    if (char_width < EPSILON)
+		char_width = DEF_CHARWIDTH
+	    char_width = char_width * GL_TICKLABELSIZE(ap)
+
+	    AX_TICKLABELOFFSET(ax2,1) = 0.5 * char_width
+	    AX_TICKLABELOFFSET(ax1,1) = -AX_TICKLABELOFFSET(ax2,1)
+
+	    call strcpy ("hj=r,vj=c", AX_TICKLABELPOS(ax1), SZ_FORMAT)
+	    call strcpy ("hj=l,vj=c", AX_TICKLABELPOS(ax2), SZ_FORMAT)
+	}
+
+	# Set the tick parameters that are identical for the two axes and
+	# which do not depend on whether the axis is horizontal or vertical.
+
+	AX_DRAWTICKS(ax1)	= GL_DRAWTICKS(ap)
+	AX_DRAWTICKS(ax2)	= GL_DRAWTICKS(ap)
+	AX_TICKLABELSIZE(ax1)	= GL_TICKLABELSIZE(ap)
+	AX_TICKLABELSIZE(ax2)	= GL_TICKLABELSIZE(ap)
+	AX_TICKLABELCOLOR(ax1)	= GL_TICKLABELCOLOR(ap)
+	AX_TICKLABELCOLOR(ax2)	= GL_TICKLABELCOLOR(ap)
+	AX_TICKCOLOR(ax1)	= GL_TICKCOLOR(ap)
+	AX_TICKCOLOR(ax2)	= GL_TICKCOLOR(ap)
+	AX_GRIDCOLOR(ax1)	= GL_GRIDCOLOR(ap)
+	AX_GRIDCOLOR(ax2)	= GL_GRIDCOLOR(ap)
+	AX_AXISLABELSIZE(ax1)	= GL_AXISLABELSIZE(ap)
+	AX_AXISLABELSIZE(ax2)	= GL_AXISLABELSIZE(ap)
+	AX_AXISLABELCOLOR(ax1)	= GL_AXISLABELCOLOR(ap)
+	AX_AXISLABELCOLOR(ax2)	= GL_AXISLABELCOLOR(ap)
+	AX_AXISWIDTH(ax1)	= GL_AXISWIDTH(ap)
+	AX_AXISWIDTH(ax2)	= GL_AXISWIDTH(ap)
+	AX_AXISCOLOR(ax1)	= GL_AXISCOLOR(ap)
+	AX_AXISCOLOR(ax2)	= GL_AXISCOLOR(ap)
+	AX_MINORWIDTH(ax1)	= GL_MINORWIDTH(ap)
+	AX_MINORWIDTH(ax2)	= GL_MINORWIDTH(ap)
+	AX_MAJORWIDTH(ax1)	= GL_MAJORWIDTH(ap)
+	AX_MAJORWIDTH(ax2)	= GL_MAJORWIDTH(ap)
+
+	# Compute the number of digits of precision needed for the tick labels.
+	AX_NDIGITS(ax1) = max (1, gt_ndigits (p1, p2, step))
+	AX_NDIGITS(ax2) = AX_NDIGITS(ax1)
+
+	# If both axes are to be drawn label ticks if enabled.  If only one
+	# axis is to be drawn that is the axis that must be labelled.
+
+	if (GL_DRAWAXES(ap) > 0) {
+	    AX_LABELTICKS(ax1) = GL_LABELTICKS(ap)
+	    AX_LABELTICKS(ax2) = GL_LABELTICKS(ap)
+	}
+	if (GL_DRAWAXES(ap) == 1 || GL_DRAWAXES(ap) == 3)
+	    AX_LABELTICKS(ax2) = NO
+	else if (GL_DRAWAXES(ap) == 2)
+	    AX_LABELTICKS(ax1) = NO
+
+	# The user may override the tick label format if desired.
+	if (GL_TICKFORMAT(ap) == EOS) {
+	    call sprintf (AX_TICKFORMAT(ax1), SZ_FORMAT, "%%0.%dg")
+		call pargi (AX_NDIGITS(ax1) + 1)
+	} else
+	    call strcpy (GL_TICKFORMAT(ap), AX_TICKFORMAT(ax1), SZ_FORMAT)
+	call strcpy (AX_TICKFORMAT(ax1), AX_TICKFORMAT(ax2), SZ_FORMAT)
+end
+
+
+# GLB_MINORSTEP -- Determine the step size for the minor ticks.  Adapted
+# from a routine by J. Eisenhamer (STScI) which was based on some MONGO code.
+
+real procedure glb_minorstep (x1, x2, nminor)
+
+real	x1, x2		#I interval between major ticks
+int	nminor		#I suggested number of minor ticks, or actual# if neg
+
+int	iexp
+real	amant, diff, num, range
+
+begin
+	range = abs (x2 - x1)
+	if (nminor < 0)
+	    return (range / real (-nminor + 1))
+	else {
+	    # Determine magnitude of the intervals.
+	    diff = log10 (range / nminor)
+	    iexp = int (diff)
+	    if (diff < 0)
+		iexp = iexp - 1
+	    amant = diff - real(iexp)
+
+	    # Determine an appropriate step size.
+	    if (amant < 0.15)
+		num = 1.0
+	    else if (amant < 0.50)
+		num = 2.0
+	    else if (amant < 0.85)
+		num = 5.0
+	    else
+		num = 10.0
+
+	    return (num * 10.0**iexp)
+	}
+end
diff --git a/sys/gio/glabax/glbgrid.x b/sys/gio/glabax/glbgrid.x
new file mode 100644
index 00000000..ecb24ffb
--- /dev/null
+++ b/sys/gio/glabax/glbgrid.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_DRAWGRID -- Draw a grid across the plotting surface, i.e., draw
+# dotted lines between the major tick marks.
+
+procedure glb_drawgrid (gp, ax1, ax2)
+
+pointer	gp			# graphics descriptor
+pointer	ax1			# descriptor for first axis
+pointer	ax2			# descriptor for second axis
+
+int	wcs, major_tick
+real	x, y, tolerance
+real	x1, y1, x2, y2, sx, sy
+int	glb_gettick()
+errchk	glb_gettick, gseti, gsetr, gline, gctran
+
+begin
+	tolerance = TOL
+	wcs = GP_WCS(gp)
+
+	# Cache the NDC coordinates of the ends of an axis.
+	call gctran (gp, AX_START(ax1,1), AX_START(ax1,2), x1,y1, wcs, 0)
+	call gctran (gp,   AX_END(ax1,1),   AX_END(ax1,2), x2,y2, wcs, 0)
+
+	# Set polyline linetype for a dotted line.
+	call gseti (gp, G_PLTYPE, GL_DOTTED)
+	call gsetr (gp, G_PLWIDTH, 1.0)
+
+	AX_NLEFT(ax1) = -1
+	while (glb_gettick (gp, ax1, x, y, major_tick) != EOF) {
+	    if (major_tick == NO)
+		next
+
+	    # Draw grid line if we are at a major tick, provided the tick
+	    # is not at the end of the axis.
+
+	    call gctran (gp, x,y, sx,sy, wcs, 0)
+	    if (AX_HORIZONTAL(ax1) == YES) {
+		if (sx - x1 > tolerance && sx - x2 < tolerance)
+		    call gline (gp, x, AX_END(ax1,2), x, AX_END(ax2,2))
+	    } else {
+		if (sy - y1 > tolerance && sy - y2 < tolerance)
+		    call gline (gp, AX_END(ax1,1), y, AX_END(ax2,1), y)
+	    }
+	}
+
+	call gseti (gp, G_PLTYPE, GL_SOLID)
+end
diff --git a/sys/gio/glabax/glbgtick.x b/sys/gio/glabax/glbgtick.x
new file mode 100644
index 00000000..cc70fd3a
--- /dev/null
+++ b/sys/gio/glabax/glbgtick.x
@@ -0,0 +1,252 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_GETTICK -- Get the position and type of the next tick on an axis.
+# Ticks are accessed sequentially.  There are three types of tick scalings,
+# LINEAR, LOG, and ELOG.  The tick scaling need not necessarily agree with
+# the WCS scaling, hence linear tick scaling might be used on a nonlinear
+# coordinate system.  If the scaling is linear then the first tick need not
+# fall at the endpoint of the axis.  If log (or elog) scaling is in use then
+# the axis will have been rounded out to a decade and the first tick will
+# necessarily fall on the axis endpoint.  The scalings are described by the
+# following parameters:
+#
+#			(variables)
+#	nleft			number of minor ticks left to next major tick
+#	step(x,y)		displacement between minor ticks (world coords)
+#
+#			(constants)
+#	tick1(x,y)		world coords of the first tick on an axis
+#	nminor			number of minor ticks between major ticks
+#	istep(x,y)		initial step (actual step may differ)
+#	kstep(x,y)		adjustment to step at major ticks
+# 
+# KSTEP is unity if the scaling is linear.  The log scalings have a KSTEP of
+# either 10.0 or 0.1.  A negative KSTEP value is used to flag ELOG scaling.
+# ELOG, or extended range log scaling, is a log scaling which is defined for
+# X <=0 as well as x > 0.  This function is logarithmic for values less than
+# -10 or greater than 10, and linear in the range [-10:+10].  This complicates
+# tick computation because the usual 8 minor ticks per decade characteristic
+# of log scaling are not appropriate in the linear regime.  If the scaling
+# is ELOG then we ignore NMINOR and ISTEP in the linear range, changing the
+# values of these parameters temporarily to reflect 4 minor ticks with a tick
+# spacing of 2.0.
+#
+# (Note to the reader: don't feel discouraged if you don't understand this
+# (stuff, it is so complicated I don't understand it either!  Having to deal
+# (with linear, log, and elog scaling with both major and minor ticks,
+# (sometimes no minor ticks, with the axis starting at any part of the scale
+# (seems an inherently difficult problem to program compactly.  Barring
+# (programming each case separately, the best approach I could come up with was
+# (to walkthrough the code separately for each case, from all initial
+# (conditions, until it works for all cases.  If you have problems determine
+# (the initial conditions (the case) and do a similar walkthough.  Of course,
+# (if you make a change affecting one case, you may well make the code fail for
+# (a different case.
+
+int procedure glb_gettick (gp, ax, x, y, major_tick)
+
+pointer	gp			# graphics descriptor
+pointer	ax			# axis descriptor
+real	x, y			# coordinates of next tick (output)
+int	major_tick		# YES if next tick is a major tick
+
+int	i, axis, wcs, w, scaling, nminor, expon
+real	kstep, step, astep, ten, sx, sy, tolerance, pos, norm_pos
+bool	glb_eq()
+define	logscale_ 91
+
+begin
+	if (AX_DRAWTICKS(ax) == NO)
+	    return (EOF)
+
+	tolerance = TOL
+	scaling = AX_SCALING(ax)
+	nminor  = AX_NMINOR(ax)
+	kstep   = AX_KSTEP(ax)
+
+	if (AX_HORIZONTAL(ax) == YES)
+	    axis = 1
+	else
+	    axis = 2
+
+	# Count down a minor tick.  If nleft is negative then we are being
+	# called for the first time for this axis.
+
+	if (AX_NLEFT(ax) < 0) {
+
+	    # Initialize everything and return coords of the first tick.
+	    AX_KSTEP(ax) = AX_IKSTEP(ax)
+	    AX_NLEFT(ax) = AX_INLEFT(ax)
+	    do i = 1, 2 {
+		AX_POS(ax,i)  = AX_TICK1(ax,i)
+		AX_STEP(ax,i) = AX_ISTEP(ax,i)
+	    }
+
+	    step  = AX_STEP(ax,axis)
+	    astep = abs (step)
+
+	    if (AX_NLEFT(ax) == 0) {
+		# Note that there may not be any minor ticks.
+		major_tick = YES
+		AX_NLEFT(ax) = nminor
+		if (nminor > 0)
+		    if (scaling == ELOG && (astep >= .99 && astep < 2.0)) {
+			# Elog scaling in linear region.
+			AX_NLEFT(ax) = 4
+			if (step < 0)
+			    step = -2.0
+			else
+			    step =  2.0
+			AX_STEP(ax,axis) = step
+		    }
+	    } else {
+		AX_NLEFT(ax) = AX_NLEFT(ax) - 1
+		major_tick = NO
+	    }
+
+	    # Elog scaling in linear region.  KSTEP must be inverted as we
+	    # pass through the origin.  This normally occurs upon entry to the
+	    # linear region, but if we start out at +/- 10 we must set KSTEP
+	    # to its linear value during setup.
+
+	    if (scaling == ELOG && glb_eq(step,2.0))
+		AX_KSTEP(ax) = -10.0
+
+	} else {
+	    # All ticks after the first tick.
+	    do i = 1, 2
+		AX_POS(ax,i) = AX_POS(ax,i) + AX_STEP(ax,i)
+	    AX_NLEFT(ax) = AX_NLEFT(ax) - 1
+
+	    # If we are log scaling the ticks will never have more than 2
+	    # digits of precision.  Try to correct for the accumulation of
+	    # error by rounding.  When log scaling the error increases by
+	    # a factor of ten in each decade and can get quite large if
+	    # the log scale covers a large range.
+
+	    if (scaling != LINEAR) {
+		pos = AX_POS(ax,axis)
+		call fp_normr (pos, norm_pos, expon)
+		pos = nint (norm_pos * 10.0) / 10.0
+		pos = pos * (10.0 ** expon)
+		AX_POS(ax,axis) = pos
+	    }
+
+	    if (AX_NLEFT(ax) < 0) {
+		# Next tick is a major tick.  If log scaling we must reset
+		# the tick parameters for the next decade.
+
+		major_tick = YES
+		AX_NLEFT(ax) = nminor
+
+		# The following handles the special case of ELOG scaling in
+		# the linear regime when the number of minor ticks is zero.
+		# The step size in such a case is 9 to some power in the log
+		# region and +/- 10 in the linear region.
+
+		if (scaling == ELOG && nminor == 0) {
+		    pos = AX_POS(ax,axis)
+		    if (step < 0)
+			ten = -10.
+		    else
+			ten = 10.
+
+		    if (glb_eq (pos, 10.0)) {
+			if (glb_eq (step, 10.0)) {
+			    if (step < 0)
+				AX_STEP(ax,axis) = -9.
+			    else
+				AX_STEP(ax,axis) = 9.
+			    goto logscale_
+			} else
+			    step = ten
+		    } else if (glb_eq (pos, 0.0)) {
+			step = ten
+			if (pos / step < 0)
+			    AX_KSTEP(ax) = -0.1
+			else
+			    AX_KSTEP(ax) = -10.0
+		    } else
+			goto logscale_
+		    AX_STEP(ax,axis) = step
+
+		} else if (scaling != LINEAR) {
+		    # Adjust the tick step by the kstep factor, provided we
+		    # are not at the origin in ELOG scaling (the step is 1
+		    # on either side of the origin for ELOG scaling).  Reset
+		    # the step size to 1.0 if ELOG scaling and just coming out
+		    # of the linear regime.
+logscale_
+		    step = AX_STEP(ax,axis)
+		    if (scaling != ELOG || abs(AX_POS(ax,axis)) > 0.1) {
+			if (scaling == ELOG && glb_eq (step, 2.0))
+			    AX_STEP(ax,axis) = step / 2.0
+
+			do i = 1, 2
+			    AX_STEP(ax,i) = AX_STEP(ax,i) * abs (AX_KSTEP(ax))
+		    }
+
+		    # Adjust the step size to 2.0 if ELOG scaling and in the
+		    # linear regime (initial step size of 1).
+
+		    step = AX_STEP(ax,axis)
+		    if (scaling == ELOG && glb_eq(step,1.0)) {
+			if (step < 0)
+			    step = -2.0
+			else
+			    step =  2.0
+			AX_STEP(ax,axis) = step
+		    }
+
+		    # If elog scaling and we have just entered the linear
+		    # regime, adjust the number of ticks and the KSTEP factor.
+
+		    if (scaling == ELOG && glb_eq(step,2.0)) {
+			# Elog scaling in linear region.  KSTEP must be
+			# inverted as we pass through the origin.
+
+			if (abs(AX_POS(ax,axis)) > 0.1)
+			    AX_KSTEP(ax) = -10.0
+
+			if (nminor > 0)
+			    AX_NLEFT(ax) = 4
+		    }
+		}
+	    } else
+		major_tick = NO
+	}
+
+	x = AX_POS(ax,1)
+	y = AX_POS(ax,2)
+
+	# Return EOF if tick falls beyond end of axis.  The comparison is made
+	# in NDC coords to avoid having to check if the WCS is increasing or
+	# decreasing and to avoid the problems of comparing unnormalized
+	# floating point numbers.
+
+	wcs = GP_WCS(gp)
+	w = GP_WCSPTR(gp,wcs)
+
+	call gctran (gp, x,y, sx,sy, wcs, 0)
+	if (sx - WCS_SX2(w) > tolerance || sy - WCS_SY2(w) > tolerance)
+	    return (EOF)
+	else
+	    return (OK)
+end
+
+
+# GLB_EQ -- Compare two (near normalized) floating point numbers for
+# equality, using the absolute value of the first argument.
+
+bool procedure glb_eq (a, b)
+
+real	a			# compare absolute value of this number
+real	b			# to this positive number
+
+begin
+	return (abs (abs(a) - b) < 0.1)
+end
diff --git a/sys/gio/glabax/glblabel.x b/sys/gio/glabax/glblabel.x
new file mode 100644
index 00000000..ecf57c94
--- /dev/null
+++ b/sys/gio/glabax/glblabel.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_LABEL_AXIS -- Label an axis.  If both axes were drawn only the first is
+# labelled, otherwise the label is placed on withever axis was drawn.  This is
+# done by drawing the axis labels just outside the tick mark labels, wherever
+# those happened to be.  The axis label offset is in the same direction as the
+# tick label offset and is centered on each axis.  The distance from the axis
+# is a function of the size of the tick labels.
+
+procedure glb_label_axis (gp, ax, xlabel, ylabel)
+
+pointer	gp			# graphics descriptor
+pointer	ax			# axis descriptor
+char	xlabel[ARB]		# X axis label
+char	ylabel[ARB]		# Y axis label
+
+int	wcs
+real	x1, x2, y1, y2, x, y, dx, dy
+real	char_height, char_width
+int	strlen()
+real	ggetr()
+
+begin
+	wcs = GP_WCS(gp)
+
+	# Get character height and width in NDC coords.
+	char_height = ggetr (gp, "ch")
+	char_width  = ggetr (gp, "cw")
+
+	if (char_height < EPSILON)
+	    char_height = DEF_CHARHEIGHT
+	if (char_width < EPSILON)
+	    char_width = DEF_CHARWIDTH
+
+	# Compute axis center in NDC coords.
+	call gctran (gp, AX_START(ax,1), AX_START(ax,2), x1,y1, wcs, 0)
+	call gctran (gp,   AX_END(ax,1),   AX_END(ax,2), x2,y2, wcs, 0)
+	x = (x1 + x2) / 2.0
+	y = (y1 + y2) / 2.0
+
+	# Set relative text size and get device character size for a text
+	# size of 1.0.  Set WCS to NDC coords since the offset to the
+	# tick label is in NDC coordinates.
+
+	call gsetr (gp, G_TXSIZE, AX_AXISLABELSIZE(ax))
+	call gseti (gp, G_WCS, 0)
+
+	# Draw the axis label.
+
+	if (AX_HORIZONTAL(ax) == YES) {
+	    # Axis is horizontal.  Tick label vector tells us whether to
+	    # draw axis label above or below axis.
+
+	    if (strlen (xlabel) > 0) {
+		dy = 2.0 * AX_TICKLABELSIZE(ax) * char_height +
+		     0.5 * AX_AXISLABELSIZE(ax) * char_height
+		if (AX_TICKLABELOFFSET(ax,2) < 0)
+		    dy = -dy
+		call gtext (gp, x, y + dy, xlabel, "hj=c;vj=c")
+	    }
+	} else {
+	    # Axis is vertical.  Always put label fixed distance from axis
+	    # regardless of size of tick labels (for consistency and to
+	    # avoid clipping at the device screen boundary).  Label runs
+	    # bottom to top in a vertical field with char up pointing to
+	    # the left.
+
+	    if (strlen (ylabel) > 0) {
+		dx = (Y_LABELOFFSET * char_width * AX_TICKLABELSIZE(ax)) + 
+		    0.5 * AX_AXISLABELSIZE(ax) * char_height
+		    
+		if (AX_TICKLABELOFFSET(ax,1) < 0)
+		    dx = -dx
+		call gtext (gp, x + dx, y, ylabel, "up=180;hj=c;vj=c")
+	    }
+	}
+
+	call gseti (gp, G_WCS, wcs)
+end
diff --git a/sys/gio/glabax/glbloglab.x b/sys/gio/glabax/glbloglab.x
new file mode 100644
index 00000000..6e7ec1cc
--- /dev/null
+++ b/sys/gio/glabax/glbloglab.x
@@ -0,0 +1,139 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+define	SZ_MANTISSA	3		# "10" or "-10"
+define	SZ_EXPONENT	4		# largest is "-999"
+
+
+# GLB_LOGLAB -- Draw a tick label in log units at the given position.
+# A log tick is a power of ten, e.g.  10^2, where the ^ signifies that
+# the 2 is to be drawn one half character height higher than the 10.
+
+procedure glb_loglab (gp, sx, sy, val, fmt, scaling)
+
+pointer	gp			# graphics descriptor
+real	sx, sy			# NDC coords of label
+real	val			# value to be encoded (not the log of)
+char	fmt[ARB]		# tick label gtext format (justification)
+int	scaling			# type of scaling on axis
+
+bool	zero
+char	mantissa[SZ_MANTISSA]
+char	exponent[SZ_EXPONENT]
+int	len_mantissa, len_exponent, ip, hj, vj
+real	logval, char_height, char_width, left, xpos, ypos, txsize
+
+bool	fp_equalr()
+real	elogr(), gstatr(), ggetr()
+int	strlen(), strmatch(), itoc()
+
+begin
+	# Compute the log value to be encoded.
+	if (scaling == LOG)
+	    logval = log10 (val)
+	else {
+	    logval = elogr (val)
+	    zero = fp_equalr (logval, 0.0)
+	}
+
+	txsize = gstatr (gp, G_TXSIZE)
+
+	# Get char height and width in NDC coords.
+	char_height = ggetr (gp, "ch")
+	if (char_height < EPSILON)
+	    char_height = DEF_CHARHEIGHT
+	char_height = char_height * txsize
+
+	char_width = ggetr (gp, "cw")
+	if (char_width < EPSILON)
+	    char_width = DEF_CHARWIDTH
+	char_width = char_width * txsize
+
+	# Encode the mantissa and exponent strings.
+	if (zero) {
+	    call strcpy ("0", mantissa, SZ_MANTISSA)
+	} else if (logval < 0 && scaling == ELOG) {
+	    call strcpy ("-10", mantissa, SZ_MANTISSA)
+	    logval = abs (logval)
+	} else
+	    call strcpy ("10", mantissa, SZ_MANTISSA)
+
+	len_mantissa = strlen (mantissa)
+	if (zero)
+	    len_exponent = 0
+	else
+	    len_exponent = itoc (nint(logval), exponent, SZ_EXPONENT)
+
+	# Determine type of horizontal justification required.
+	ip = strmatch (fmt, "hj=")
+	if (ip <= 0)
+	    hj = 'c'
+	else
+	    hj = fmt[ip]
+
+	# Determine type of vertical justification required.
+	ip = strmatch (fmt, "vj=")
+	if (ip <= 0)
+	    vj = 'c'
+	else
+	    vj = fmt[ip]
+
+	# On devices with adjustable character sizes the most pleasing results
+	# are obtained if the digits "10" are nicely aligned on the vertical
+	# axis, regardless of the actual number of characters in the exponent
+	# string, minus signs etc (this type of alignment is more natural
+	# because the exponent is printed at half size).  Hence if we are on
+	# a vertical axis (hj != c) fix the number of characters in the two
+	# strings so that the alignment comes out the same regardless of the
+	# actual number of chars in either field.  The length of the exponent
+	# field is not completely fixed, rather we allow a little more space
+	# if the exponent is large.  For small exponents len_exponent=1.
+
+	if (hj != 'c') {
+	    len_mantissa = 2
+	    len_exponent = (len_exponent + 1) / 2
+	}
+
+	# Compute XPOS, the NDC X coord of the point halfway between the
+	# last char of the mantissa and the first char of the exponent.
+
+	switch (hj) {
+	case 'l':
+	    left = sx
+	case 'r':
+	    left = sx - (len_mantissa + len_exponent) * char_width
+	default:
+	    left = sx - ((len_mantissa + len_exponent) * char_width) / 2.0
+	}
+
+	xpos = left + len_mantissa * char_width
+
+	# Compute YPOS, the NDC Y coord of the center of a mantissa character
+	# and of the bottom of an exponent character.  Using the same coordinate
+	# to address both positions makes the label come out the same regardless
+	# of the plot magnification, even on a device where the character size
+	# is fixed by the hardware.
+
+	switch (vj) {
+	case 'b':
+	    ypos = sy + char_height / 2.0
+	case 't':
+	    ypos = sy - char_height / 2.0
+	default:
+	    ypos = sy
+	}
+
+	# Draw the mantissa.
+	call gtext (gp, xpos, ypos, mantissa, "hj=r,vj=c")
+
+	# Draw the exponent if there is one.
+	if (!zero) {
+	    call gsetr (gp, G_TXSIZE, txsize / 2.0)
+	    call gtext (gp, xpos, ypos, exponent, "hj=l;vj=b")
+	    call gsetr (gp, G_TXSIZE, txsize)
+	}
+end
diff --git a/sys/gio/glabax/glbsetax.x b/sys/gio/glabax/glbsetax.x
new file mode 100644
index 00000000..f0c9aa29
--- /dev/null
+++ b/sys/gio/glabax/glbsetax.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_SET_AXES -- Set all axis descriptor parameters not pertaining to the
+# ticks.  The WCS has already been fixed by the time we get here.
+
+procedure glb_set_axes (gp, ap, ax1, ax2, angle)
+
+pointer	gp			# graphics descriptor
+pointer	ap			# axis parameters (from graphics descriptor)
+pointer	ax1, ax2		# axis descriptors (output)
+int	angle			# axis orientation, 0 or 90 degrees
+
+pointer	w
+int	axis
+real	p1, p2
+real	x1, x2, y1, y2
+real	glb_ticklen()
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# If the window was rounded in Y in the second call to find_ticks,
+	# then the Y positions of the first ticks set in the first call will
+	# be in error and must be corrected.  If the user has elected to set
+	# the axis position explicitly, however, then we must leave it alone.
+
+	if (angle == 0 && GL_SETAXISPOS(GP_XAP(gp)) == NO) {
+	    AX_TICK1(ax1,2) = WCS_WY1(w)
+	    AX_TICK1(ax2,2) = WCS_WY2(w)
+	}
+
+	# Set the tick lengths.  This is done here rather than in findticks
+	# due to rounding, as noted above.  The tick offsets in world
+	# coordinates.  The GL values are given in NDC coordinates.
+
+	if (angle == 0) {
+	    axis = 2
+	    AX_HORIZONTAL(ax1) = YES
+	    AX_HORIZONTAL(ax2) = YES
+	} else {
+	    axis = 1
+	    AX_HORIZONTAL(ax1) = NO
+	    AX_HORIZONTAL(ax2) = NO
+	}
+
+	AX_MAJORTICK(ax1,axis) = glb_ticklen (gp, ax1,  GL_MAJORLENGTH(ap))
+	AX_MINORTICK(ax1,axis) = glb_ticklen (gp, ax1,  GL_MINORLENGTH(ap))
+	AX_MAJORTICK(ax2,axis) = glb_ticklen (gp, ax2, -GL_MAJORLENGTH(ap))
+	AX_MINORTICK(ax2,axis) = glb_ticklen (gp, ax2, -GL_MINORLENGTH(ap))
+
+	# Select none, either, or both axes to be drawn.  If only the second
+	# axis is drawn then that is the side we must draw the tick and axis
+	# labels on.
+
+	switch (GL_DRAWAXES(ap)) {
+	case 0:
+	    AX_DRAWME(ax1) = NO
+	    AX_DRAWME(ax2) = NO
+	    return
+	case 1:
+	    AX_DRAWME(ax1) = YES
+	    AX_DRAWME(ax2) = NO
+	case 2:
+	    AX_DRAWME(ax1) = NO
+	    AX_DRAWME(ax2) = YES
+	default:
+	    AX_DRAWME(ax1) = YES
+	    AX_DRAWME(ax2) = YES
+	}
+
+	# Determine the endpoints of the axis.  These default to the corners of
+	# the viewport (in world coordinates), but the positions may be
+	# overriden by the user if desired.
+
+	# First get the positions of the two axes.
+	if (GL_SETAXISPOS(ap) == YES) {
+	    p1 = GL_AXISPOS1(ap)
+	    p2 = GL_AXISPOS2(ap)
+	} else if (angle == 0) {
+	    p1 = WCS_WY1(w)
+	    p2 = WCS_WY2(w)
+	} else {
+	    p1 = WCS_WX1(w)
+	    p2 = WCS_WX2(w)
+	}
+
+	# Convert these positions into the world coordinates of the endpoints.
+	if (angle == 0) {
+	    x1 = WCS_WX1(w)
+	    x2 = WCS_WX2(w)
+	    y1 = p1
+	    y2 = p2
+	} else {
+	    x1 = p1
+	    x2 = p2
+	    y1 = WCS_WY1(w)
+	    y2 = WCS_WY2(w)
+	}
+
+	if (angle == 0) {
+	    # Set the left and right endpoints of the axes.
+
+	    AX_START(ax1,1) = x1
+	    AX_START(ax1,2) = y1
+	    AX_END(ax1,1)   = x2
+	    AX_END(ax1,2)   = y1
+
+	    AX_START(ax2,1) = x1
+	    AX_START(ax2,2) = y2
+	    AX_END(ax2,1)   = x2
+	    AX_END(ax2,2)   = y2
+
+	} else {
+	    # Set the lower and upper endpoints of the axes.
+
+	    AX_START(ax1,1) = x1
+	    AX_START(ax1,2) = y1
+	    AX_END(ax1,1)   = x1
+	    AX_END(ax1,2)   = y2
+
+	    AX_START(ax2,1) = x2
+	    AX_START(ax2,2) = y1
+	    AX_END(ax2,1)   = x2
+	    AX_END(ax2,2)   = y2
+	}
+end
diff --git a/sys/gio/glabax/glbsetup.x b/sys/gio/glabax/glbsetup.x
new file mode 100644
index 00000000..a609d2ad
--- /dev/null
+++ b/sys/gio/glabax/glbsetup.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GLB_SETUP -- Set up the axis drawing and labelling parameters.  These are
+# the coordinate transformations, i.e., log scaling, window and viewport
+# coordinates, plus the parameters which pertain only to axis drawing and
+# labelling.  The order in which the subprocedures are called is significant.
+
+procedure glb_setup (gp, axes, ntitlelines, xlabel, ylabel)
+
+pointer	gp			# graphics descriptor
+pointer	axes[4]			# array of pointers to axis descriptors
+int	ntitlelines		# number of lines in title block
+char	xlabel[ARB]		# x axis label
+char	ylabel[ARB]		# y axis label
+
+pointer	w
+bool	fp_nondegenr()
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Verify that there is sufficient range in the wcs X and Y.
+	if (fp_nondegenr (WCS_WX1(w), WCS_WX2(w)))
+	    GP_WCSSTATE(gp) = MODIFIED
+	if (fp_nondegenr (WCS_WY1(w), WCS_WY2(w)))
+	    GP_WCSSTATE(gp) = MODIFIED
+
+	# If log scaling is in effect on either axis, verify that log scaling
+	# is sensible and if so select either LOG or ELOG scaling.
+
+	call glb_verify_log_scaling (gp)
+
+	# Set the viewport if not already set.
+	call glb_set_viewport (gp, ntitlelines, xlabel, ylabel)
+
+	# Find the best positions for the tick marks, and if rounding is
+	# enabled, extend the WCS outward to the next tick mark on either
+	# end.
+
+	call glb_find_ticks (gp, GP_XAP(gp), axes[1], axes[4],  0)
+	call glb_find_ticks (gp, GP_YAP(gp), axes[3], axes[2], 90)
+
+	# Set the remaining parameters in the axis drawing descriptors.
+	# Must not be called until the window and viewport coordinates are
+	# fixed.
+
+	call glb_set_axes (gp, GP_XAP(gp), axes[1], axes[4],  0)
+	call glb_set_axes (gp, GP_YAP(gp), axes[3], axes[2], 90)
+end
diff --git a/sys/gio/glabax/glbsview.x b/sys/gio/glabax/glbsview.x
new file mode 100644
index 00000000..1b099b1a
--- /dev/null
+++ b/sys/gio/glabax/glbsview.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_SET_VIEWPORT -- If the viewport has not yet been set, i.e., if the
+# viewport is still [0:1,0:1], compute the size of the largest viewport which
+# leaves sufficient room around the border for the axis labels and plot title.
+# If a nonzero aspect ratio is specified make the viewport have that aspect
+# ratio.
+
+procedure glb_set_viewport (gp, ntitlelines, xlabel, ylabel)
+
+pointer	gp			# graphics descriptor
+int	ntitlelines		# number of lines to reserve for title block
+char	xlabel[ARB]		# x axis label
+char	ylabel[ARB]		# y axis label
+
+pointer	w, xap, yap
+bool	draw_title, draw_xlabel, draw_ylabel, draw_xticks, draw_yticks
+real	char_height, char_width
+real	aspect, cur_aspect, dev_aspect, dx, dy
+real	xwidth, ywidth, yreserve
+real	ggetr()
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+	xap = GP_XAP(gp)
+	yap = GP_YAP(gp)
+
+	if ((WCS_SX1(w) > EPSILON) || (abs(1.0 - WCS_SX2(w)) > EPSILON) ||
+	    (WCS_SY1(w) > EPSILON) || (abs(1.0 - WCS_SY2(w)) > EPSILON))
+	    return
+
+	draw_title  = (ntitlelines > 0 && GP_DRAWTITLE(gp) == YES)
+	draw_xticks = (GL_DRAWAXES(xap) > 0 && GL_LABELTICKS(xap) == YES)
+	draw_xlabel =
+	    (draw_xticks && xlabel[1] != EOS && GL_LABELAXIS(xap) == YES)
+	draw_yticks = (GL_DRAWAXES(yap) > 0 && GL_LABELTICKS(yap) == YES)
+	draw_ylabel =
+	    (draw_yticks && ylabel[1] != EOS && GL_LABELAXIS(yap) == YES)
+
+	char_width  = ggetr (gp, "cw")
+	char_height = ggetr (gp, "ch")
+
+	if (char_width < EPSILON)
+	    char_width = DEF_CHARWIDTH
+	if (char_height < EPSILON)
+	    char_height = DEF_CHARHEIGHT
+
+	# X axis.
+	if (draw_yticks && draw_ylabel)
+	    xwidth = max (4, LEFT_BORDER + 2)
+	else if (draw_yticks)
+	    xwidth = max (4, LEFT_BORDER)
+	else
+	    xwidth = 0
+	xwidth = xwidth * char_width * GL_TICKLABELSIZE(xap)
+	    
+	# Y axis.
+	if (draw_xticks && draw_xlabel)
+	    ywidth = BOTTOM_BORDER
+	else if (draw_xticks)
+	    ywidth = max (2, (BOTTOM_BORDER - 2))
+	else
+	    ywidth = 0
+	ywidth = ywidth * char_height * GL_TICKLABELSIZE(yap)
+
+	# Compute amount of extra space to allow for the title block, which
+	# may contain more than one line.
+
+	if (!draw_title && !draw_xticks && !draw_yticks)
+	    yreserve = 0
+	else if (!draw_title && GP_ASPECT(gp) > 0.9)
+	    yreserve = 0
+	else {
+	    yreserve = min (MAX_SZTITLEBLOCK,
+		max (MIN_NTITLELINES, ntitlelines + 1) *
+		char_height * GP_TITLESIZE(gp))
+	}
+
+	# Set the viewport.  The viewport is the largest area yielding the
+	# desired borders.  The viewport is centered in X and positioned just
+	# below the title block in Y.
+
+	WCS_SX1(w) = xwidth
+	WCS_SX2(w) = 1.0 - xwidth
+	WCS_SY1(w) = ywidth
+	WCS_SY2(w) = 1.0 - yreserve
+
+	# Adjust the viewport to achieve the specified aspect ratio, if a
+	# nonzero aspect ratio was given.
+
+	dev_aspect = GP_DEVASPECT(gp)		# device aspect ratio
+	aspect     = GP_ASPECT(gp)		# user desired aspect ratio
+
+	if (aspect > EPSILON) {
+	    dx = WCS_SX2(w) - WCS_SX1(w)
+	    dy = WCS_SY2(w) - WCS_SY1(w)
+	    cur_aspect = dy / dx * dev_aspect
+
+	    if (cur_aspect > aspect) {
+		# Viewport is taller than desired.
+		dy = aspect / dev_aspect * dx
+		WCS_SY1(w) = (1.0 - dy) / 2.0
+		WCS_SY2(w) = 1.0 - WCS_SY1(w)
+	    } else {
+		# Viewport is not as wide as desired.
+		dx = dev_aspect * dy / aspect
+		WCS_SX1(w) = (1.0 - dx) / 2.0
+		WCS_SX2(w) = 1.0 - WCS_SX1(w)
+	    }
+	}
+
+	GP_WCSSTATE(gp) = MODIFIED
+end
diff --git a/sys/gio/glabax/glbticlen.x b/sys/gio/glabax/glbticlen.x
new file mode 100644
index 00000000..de557757
--- /dev/null
+++ b/sys/gio/glabax/glbticlen.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_TICKLEN -- Compute the length of a tick in world coordinates.  All tick
+# drawing is performed in world coordinates since the ticks show the world
+# coordinate system.  The position of a tick must be computed in world coords
+# when the axis is drawn to reflect log scaling (or any other nonlinear
+# scaling.  Less obviously, the tick offset should be given in world coords
+# so that when the tick is drawn by a GRDRAW the tick will follow a line of
+# constant X or Y in world coordinates, and this line will not necessarily be
+# a line of constant X or Y in NDC coordinates.
+
+real procedure glb_ticklen (gp, ax, ndc_length)
+
+pointer	gp			# graphics descriptor
+pointer	ax			# axis descriptor
+real	ndc_length		# length of tick in NDC units
+
+int	wcs
+real	x, y, wx, wy
+
+begin
+	wcs = GP_WCS(gp)
+	call gctran (gp, AX_TICK1(ax,1), AX_TICK1(ax,2), x, y, wcs, 0)
+
+	if (AX_HORIZONTAL(ax) == YES)
+	    y = y + ndc_length
+	else
+	    x = x + ndc_length
+
+	call gctran (gp, x, y, wx, wy, 0, wcs)
+	if (AX_HORIZONTAL(ax) == YES) {
+	    call pargr (wy - AX_TICK1(ax,2))
+	    return (wy - AX_TICK1(ax,2))
+	} else {
+	    call pargr (wx - AX_TICK1(ax,1))
+	    return (wx - AX_TICK1(ax,1))
+	}
+end
diff --git a/sys/gio/glabax/glbtitle.x b/sys/gio/glabax/glbtitle.x
new file mode 100644
index 00000000..d8c43c67
--- /dev/null
+++ b/sys/gio/glabax/glbtitle.x
@@ -0,0 +1,76 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_PLOT_TITLE -- Draw plot title block.  The block may contain several lines.
+# Lines are plotted with center, left, or right justification, immediately
+# above the top viewport boundary (not immediately above the drawn axis,
+# which need not be at the viewport boundary).
+
+procedure glb_plot_title (gp, title, ntitlelines)
+
+pointer	gp			# graphics descriptor
+char	title[ARB]		# title block
+int	ntitlelines		# number of lines in title block
+
+int	lineno, ip, wcs
+real	char_height, x, y, dy
+pointer sp, op, lbuf, format, w
+real	ggetr()
+
+begin
+	if (title[1] == EOS || ntitlelines < 1)
+	    return
+
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (format, SZ_FORMAT, TY_CHAR)
+
+	char_height = ggetr (gp, "ch")
+	if (char_height < EPSILON)
+	    char_height = DEF_CHARHEIGHT * GP_TITLESIZE(gp)
+
+	wcs = GP_WCS(gp)
+	w = GP_WCSPTR (gp, wcs)
+	y = min (1.0 - char_height,
+	    WCS_SY2(w) + (ntitlelines - 1 + 0.5) * char_height)
+
+	call sprintf (Memc[format], SZ_FORMAT, "hj=%c,vj=b")
+	    switch (GP_TITLEJUST(gp)) {
+	    case GT_LEFT:
+		call pargi ('l')
+		x = WCS_SX1(w)
+	    case GT_RIGHT:
+		call pargi ('r')
+		x = WCS_SX2(w)
+	    default:
+		call pargi ('c')
+		x = (WCS_SX1(w) + WCS_SX2(w)) / 2.0
+	    }
+
+	call gsetr (gp, G_TXSIZE, GP_TITLESIZE(gp))
+	call gseti (gp, G_WCS, 0)
+	lineno = 1
+	op = lbuf
+
+	for (ip=1;  title[ip] != EOS;  ip=ip+1)
+	    if (title[ip] == '\n' || (title[ip+1] == EOS && op > lbuf)) {
+		if (title[ip] != '\n') {
+		    Memc[op] = title[ip]
+		    op = op + 1
+		}
+		Memc[op] = EOS
+		dy = (lineno - 1) * char_height
+		call gtext (gp, x, y - dy, Memc[lbuf], Memc[format])
+		lineno = lineno + 1
+		op = lbuf
+	    } else {
+		Memc[op] = title[ip]
+		op = op + 1
+	    }
+	
+	call sfree (sp)
+end
diff --git a/sys/gio/glabax/glbverify.x b/sys/gio/glabax/glbverify.x
new file mode 100644
index 00000000..6666b06a
--- /dev/null
+++ b/sys/gio/glabax/glbverify.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+include	"glabax.h"
+
+# GLB_VERIFY_LOG_SCALING -- Verify that log scaling makes sense, i.e., that
+# the range covered by an axis compared to its distance from the origin is
+# large enough to permit log scaling.  If log scaling is reasonable check if
+# the window goes negative, and switch to ELOG scaling if such is the case.
+
+procedure glb_verify_log_scaling (gp)
+
+pointer	gp			# graphics descriptor
+pointer	w
+
+begin
+	w  = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Force ELOG scaling if any data <= 0.
+
+	if (WCS_XTRAN(w) != LINEAR)
+	    if (WCS_WX1(w) <= 0 || WCS_WX2(w) <= 0)
+		WCS_XTRAN(w) = ELOG
+
+	if (WCS_YTRAN(w) != LINEAR)
+	    if (WCS_WY1(w) <= 0 || WCS_WY2(w) <= 0)
+		WCS_YTRAN(w) = ELOG
+
+	# Set the WCS state to modified even if it wasn't.  This is safe
+	# and in any case the WCS is changed in the main glabax routine
+	# shortly after we are called.
+
+	GP_WCSSTATE(gp) = MODIFIED
+end
diff --git a/sys/gio/glabax/mkpkg b/sys/gio/glabax/mkpkg
new file mode 100644
index 00000000..c8990e1a
--- /dev/null
+++ b/sys/gio/glabax/mkpkg
@@ -0,0 +1,22 @@
+# Make the GLABAX axis drawing and labelling package.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	glabax.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbencode.x	glabax.h <mach.h>
+	glbfind.x	glabax.h <gio.h> <mach.h>
+	glbgrid.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbgtick.x	glabax.h <gio.h> <mach.h>
+	glblabel.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbloglab.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbsetax.x	glabax.h <gio.h> <mach.h>
+	glbsetup.x	<gio.h>
+	glbsview.x	glabax.h <gio.h> <mach.h>
+	glbticlen.x	glabax.h <gio.h> <mach.h>
+	glbtitle.x	glabax.h <gio.h> <gset.h> <mach.h>
+	glbverify.x	glabax.h <gio.h> <gset.h> <mach.h>
+	;
diff --git a/sys/gio/gline.x b/sys/gio/gline.x
new file mode 100644
index 00000000..ee346527
--- /dev/null
+++ b/sys/gio/gline.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GLINE -- Draw a line connecting two points.
+
+procedure gline (gp, x1, y1, x2, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, y1			# first point
+real	x2, y2			# second point
+
+begin
+	call gamove (gp, x1, y1)
+	call gadraw (gp, x2, y2)
+end
diff --git a/sys/gio/gmark.x b/sys/gio/gmark.x
new file mode 100644
index 00000000..a9517b79
--- /dev/null
+++ b/sys/gio/gmark.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+
+# GMARK -- Draw a marker of the indicated type and size.  A mark is represented
+# as a polyline normalized to the unit square.  Drawing a mark is a simple
+# matter of drawing this normalized polyline in a window the size and position
+# of the mark.  While the mark window defines the transformation upon the
+# normalized marker polyline, clipping is performed on the WCS viewport boundary
+# (if enabled), independently of the size and position of the mark.  Redrawing
+# a mark with a linetype of clear will erase the mark, device permitting.
+# Drawing is carried out in world coordinates, hence the marker shape will
+# relect logarithmic scaling if in effect.
+
+procedure gmark (gp, x, y, marktype, xsize, ysize)
+
+pointer	gp			# graphics descriptor
+real	x, y			# world coordinates of center of marker
+int	marktype		# type of marker to be drawn
+real	xsize, ysize		# marker size in X and Y
+
+int	i, m, fill
+int	and()
+include	"markers.inc"
+
+begin
+	# The point marker type cannot be combined with the other types and
+	# is treated as a special case.  The remaining markers are drawn
+	# using GUMARK, which draws marks represented as polygons
+
+	if (marktype == GM_POINT || (xsize == 0 && ysize == 0)) {
+	    call gpl_settype (gp, POLYMARKER)
+	    call gamove (gp, x, y)
+	    call gadraw (gp, x, y)
+	    call gpl_settype (gp, POLYLINE)
+
+	} else {
+	    # Some marks can be drawn using area fill.
+	    if (and (marktype, GM_FILL) != 0)
+		fill = YES
+	    else
+		fill = NO
+
+	    # Draw and overlay each mark.  The polylines for the standard
+	    # marks are stored in MPX and MPY at offsets MXO and MYO.
+
+	    do i = GM_FIRSTMARK, GM_LASTMARK
+		if (and (marktype, 2 ** i) != 0) {
+		    m = i - GM_FIRSTMARK + 1
+		    call gumark (gp, mpx[moff[m]], mpy[moff[m]], mnpts[m],
+			x, y, xsize, ysize, fill)
+		}
+	}
+end
diff --git a/sys/gio/gmftitle.x b/sys/gio/gmftitle.x
new file mode 100644
index 00000000..0e7d0322
--- /dev/null
+++ b/sys/gio/gmftitle.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GMFTITLE -- Insert a title (comment) into the output metacode instruction
+# stream.  No graphics output is generated.  The purpose of the metafile
+# title is to document the contents of metafiles.
+
+procedure gmftitle (gp, mftitle)
+
+pointer	gp			# graphics descriptor
+char	mftitle[ARB]		# metafile title
+
+begin
+	call gpl_flush()
+	call gki_mftitle (GP_FD(gp), mftitle)
+end
diff --git a/sys/gio/gmprintf.x b/sys/gio/gmprintf.x
new file mode 100644
index 00000000..9353b483
--- /dev/null
+++ b/sys/gio/gmprintf.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GMPRINTF -- Formatted write a string value to a UI (user interface)
+# parameter.
+#
+# NOTE - I don't think this code works yet.  Don't use it, use gmsg.
+
+procedure gmprintf (gp, object, format)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+char	format[ARB]		#I print format
+
+pointer	sp, fmt
+
+begin
+	call smark (sp)
+	call salloc (fmt, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[fmt], SZ_LINE, "\031%s %s\035\037")
+	    call pargstr (object)
+	    call pargstr (format)
+
+	call flush (STDOUT)
+	call printf (Memc[fmt])
+	call sfree (sp)
+end
diff --git a/sys/gio/gmsg.x b/sys/gio/gmsg.x
new file mode 100644
index 00000000..360996be
--- /dev/null
+++ b/sys/gio/gmsg.x
@@ -0,0 +1,232 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<fset.h>
+include	<chars.h>
+include	<mach.h>
+
+# GMSG -- Write a string value to a UI (user interface) parameter.  Another
+# way to look at this is that we are sending a message to a UI object, hence
+# this is called a message facility.
+#
+# NOTE -- This routine quotes the string with curly braces { } and prefaces
+# the string with a "setValue", as required to set the value of a GUI client
+# state variable.  This is done here rather than build knowledge into the
+# lower level i/o system about the requirements for sending messages to UI
+# parameters.  The low level i/o system just sends arbitrary messages to
+# named UI objects; setting the value of a UI parameter object is a higher
+# level abstraction layered upon the general i/o mechanism.
+#
+# One limitation of the UI parameter mechanism as it currently stands is that
+# if the message contains curly braces, they must match up to avoid having
+# the message be prematurely delimited (fortunately curly braces tend to
+# match up in any valid text that uses them).  So far I haven't found a way
+# around this.  The problem is that while Tcl allows braces to be backslash
+# escaped to avoid being treated as delimiters, the backslashes are not
+# removed, they are left in the message as data.  Hence they cannot be
+# inserted in an arbitrary string without changing the string.
+#
+# Messages may be arbitrarily large and may extend over multiple lines.  The
+# only restriction is that if the messages contain curly braces they must
+# match up.
+
+procedure gmsg (gp, object, message)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+char	message[ARB]		#I message text
+
+int	flushnl, control_stream
+int	fstati()
+bool	ttygetb()
+
+begin
+	call gflush (gp)
+	call flush (STDOUT)
+	call flush (STDERR)
+
+	control_stream = STDERR
+
+	if (ttygetb (GP_TTY(gp), "EM")) {
+	    flushnl = fstati (control_stream, F_FLUSHNL)
+	    if (flushnl == YES)
+		call fseti (control_stream, F_FLUSHNL, NO)
+
+	    call putci (control_stream, EM)
+	    call putline (control_stream, object)
+	    call putci (control_stream, ' ')
+	    call putline (control_stream, "setValue ")
+
+	    call putci (control_stream, '{')
+	    call putline (control_stream, message)
+	    call putci (control_stream, '}')
+
+	    call putci (control_stream, GS)
+	    call putci (control_stream, US)
+	    call flush (control_stream)
+
+	    if (flushnl == YES)
+		call fseti (control_stream, F_FLUSHNL, YES)
+	}
+end
+
+
+# GMSGB -- Set the value of a boolean UI parameter.
+
+procedure gmsgb (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+bool	value			#I value
+
+begin
+	if (value)
+	    call gmsg (gp, object, "yes")
+	else
+	    call gmsg (gp, object, "no")
+end
+
+
+# GMSGC -- Set the value of a character UI parameter.
+
+procedure gmsgc (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+char	value			#I value
+
+char	buf[10]
+int	junk, ctocc()
+
+begin
+	junk = ctocc (value, buf, 10)
+	call gmsg (gp, object, buf)
+end
+
+
+# GMSGS -- Set the value of a short integer UI parameter.
+
+procedure gmsgs (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+short	value			#I value
+
+long	val
+char	buf[32]
+int	junk, ltoc()
+
+begin
+	if (IS_INDEFS (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    val = value
+	    junk = ltoc (val, buf, 32)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGI -- Set the value of an integer UI parameter.
+
+procedure gmsgi (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+int	value			#I value
+
+long	val
+char	buf[32]
+int	junk, ltoc()
+
+begin
+	if (IS_INDEFI (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    val = value
+	    junk = ltoc (val, buf, 32)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGL -- Set the value of a long integer UI parameter.
+
+procedure gmsgl (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+long	value			#I value
+
+char	buf[32]
+int	junk, ltoc()
+
+begin
+	if (IS_INDEFL (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    junk = ltoc (value, buf, 32)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGR -- Set the value of a type real UI parameter.
+
+procedure gmsgr (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+real	value			#I value
+
+double	dval
+char	buf[MAX_DIGITS]
+int	junk, dtoc()
+
+begin
+	if (IS_INDEFR (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    dval = value
+	    junk = dtoc (dval, buf, MAX_DIGITS, NDIGITS_RP, 'g', MAX_DIGITS)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGD -- Set the value of a type double UI parameter.
+
+procedure gmsgd (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+double	value			#I value
+
+char	buf[MAX_DIGITS]
+int	junk, dtoc()
+
+begin
+	if (IS_INDEFR (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    junk = dtoc (value, buf, MAX_DIGITS, NDIGITS_DP, 'g', MAX_DIGITS)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGX -- Set the value of a type complex UI parameter.
+
+procedure gmsgx (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+complex	value			#I value
+
+char	buf[MAX_DIGITS]
+int	junk, xtoc()
+
+begin
+	junk = xtoc (value, buf, MAX_DIGITS, NDIGITS_RP, 'g', MAX_DIGITS/2)
+	call gmsg (gp, object, buf)
+end
diff --git a/sys/gio/gopen.x b/sys/gio/gopen.x
new file mode 100644
index 00000000..7f973016
--- /dev/null
+++ b/sys/gio/gopen.x
@@ -0,0 +1,187 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<knet.h>
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+
+# GOPENUI -- Open a graphics stream for output to the named device on file FD.
+# If a logical device name is given the actual device name is fetched from the
+# environment.   If a UI file is specified the named user interface definition
+# file is downloaded to the graphics server.  The device parameters are then
+# retrieved from the graphcap entry for the device.  GIO is initialized, and
+# if the device is being opened in APPEND mode, the WCS set when the device
+# was last read are retrieved from the CL (if output is to a standard stream)
+# or from the WCS savefile for the device.
+
+pointer procedure gopenui (device, mode, uifname, fd)
+
+char	device[ARB]		#I logical or physical device name
+int	mode			#I access mode: NEW_FILE or APPEND
+char	uifname[ARB]		#I user interface specification file
+int	fd			#I metacode output file
+
+pointer	gp, tty
+int	outfd, stream_type, junk
+bool	close_at_end, kf_ok, vdm_device, std_stream
+pointer	sp, devname, envname, kfname
+
+bool	streq()
+extern	gflush()
+pointer	ttygdes()
+int	envgets(), envfind(), open(), locpr(), access(), ttygets()
+errchk	syserr, syserrs, ttygdes
+errchk	greset, gki_openws, calloc
+
+string	stdgraph "stdgraph"
+string	stdimage "stdimage"
+string	stdplot  "stdplot"
+string	vdm 	 "vdm"
+string	stdvdm 	 "stdvdm"
+
+begin
+	call smark (sp)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+	call salloc (envname, SZ_FNAME, TY_CHAR)
+	call salloc (kfname,  SZ_FNAME, TY_CHAR)
+
+	call flush (STDOUT)
+
+	# If one of the logical devices STDGRAPH, STDIMAGE, or STDPLOT is
+	# named look up the actual device name in the environment.  The
+	# standard metafile "device", STDVDM, is implemented as an actual
+	# device with an actual graphcap entry, so we do not have to map
+	# its name.
+
+	if (streq (device, stdgraph) || streq (device, stdimage) ||
+	    streq (device, stdplot)) {
+	    if (envgets (device, Memc[devname], SZ_FNAME) <= 0)
+		call syserrs (SYS_ENVNF, device)
+	} else
+	    call strcpy (device, Memc[devname], SZ_FNAME)
+
+	# The special name "none" indicates that graphics is not supported
+	# on this stream for the local site or workstation (e.g., when using
+	# a nongraphics terminal).
+
+	if (streq (Memc[devname], "none"))
+	    switch (fd) {
+	    case STDGRAPH:
+		call syserr (SYS_GGNONE)
+	    case STDIMAGE:
+		call syserr (SYS_GINONE)
+	    case STDPLOT:
+		call syserr (SYS_GPNONE)
+	    default:
+		call syserr (SYS_GPNONE)
+	    }
+
+	# Fetch the graphcap entry for the device.
+	tty = ttygdes (Memc[devname])
+
+	# If the output device is "stdvdm" or "vdm" and the FD supplied by the
+	# user is that of a standard stream, open the standard metafile and
+	# append output directly to that.  The metafile is always opened in
+	# APPEND mode regardless of the mode in which the graphics device is
+	# opened.
+
+	outfd = fd
+	close_at_end = false
+	call gki_redir (fd, -1, junk, stream_type)
+	std_stream = (fd == STDGRAPH || fd == STDIMAGE || fd == STDPLOT)
+	vdm_device = (streq(device,stdvdm) || streq(device,vdm))
+
+	if (vdm_device && std_stream) {
+	    # Get filename of virtual device metafile.
+	    call strcpy (stdvdm, Memc[devname], SZ_DEVNAME)
+	    if (envfind (stdvdm, Memc[envname], SZ_FNAME) <= 0)
+		call strcpy ("uparm$vdm", Memc[envname], SZ_FNAME)
+
+	    # Open VDM for appending.
+	    iferr (outfd = open (Memc[envname], APPEND, BINARY_FILE)) {
+		call ttycdes (tty)
+		call erract (EA_ERROR)
+	    }
+	    close_at_end = true
+
+	} else if (std_stream && stream_type != TY_INLINE) {
+	    # Verify that there is a GIO kernel specified for the device before
+	    # trying to open it via PSIOCTRL, since the latter does not return
+	    # an error status if it fails to connect a kernel, causing the error
+	    # to go undetected until the CL fails to connect a kernel, which
+	    # causes an error which cannot be caught in an IFERR in the current
+	    # process.  Catching the error here is faster and works with IFERR.
+	    # No checking for a kernel is performed if the metacode output is
+	    # being directed to a user opened stream.
+
+	    kf_ok = false
+	    if (ttygets (tty, "kf", Memc[kfname], SZ_FNAME) > 0)
+		if (streq (Memc[kfname], "cl"))
+		    kf_ok = true
+		else if (access (Memc[kfname], 0,0) == YES)
+		    kf_ok = true
+
+	    if (!kf_ok) {
+		call ttycdes (tty)
+		call syserrs (SYS_GNOKF, Memc[devname])
+	    }
+	}
+
+	# Allocate and initialize the GIO graphics descriptor.  Initialize
+	# GKI (the graphics kernel interface) on the stream, if the stream
+	# has not already been directed to a kernel.
+
+	call calloc (gp, LEN_GDES, TY_STRUCT)
+
+	GP_FD(gp) = outfd
+	GP_TTY(gp) = tty
+	if (close_at_end)
+	    GP_GFLAGS(gp) = GF_CLOSEFD
+
+	# Set the access mode; default to NEW_FILE if not specified.
+	GP_ACMODE(gp) = mod (mode, AW_DEFER)
+	if (GP_ACMODE(gp) == 0)
+	    GP_ACMODE(gp) = NEW_FILE
+
+	call greset (gp, GR_RESETALL)
+	call gki_init (outfd)
+	call strcpy (Memc[devname], GP_DEVNAME(gp), SZ_DEVNAME)
+	call strcpy (uifname, GP_UIFNAME(gp), SZ_UIFNAME)
+
+	# Set up info for GEXFLS, called by CLGCUR to flush the graphics
+	# output prior to a cursor read.
+
+	call gexfls_set (outfd, gp, locpr(gflush))
+
+	# Activate (physically open) the workstation, unless the defer flag
+	# is set, eg., mode = NEW_FILE+AW_DEFER.
+
+	if (mode < AW_DEFER)
+	    iferr (call gactivate (gp, 0)) {
+		call ttycdes (tty)
+		call gexfls_clear (outfd)
+		call mfree (gp, TY_STRUCT)
+		call erract (EA_ERROR)
+	    }
+
+	call sfree (sp)
+	return (gp)
+end
+
+
+# GOPEN -- Open a graphics stream for output to the named device on file FD.
+# Identical to GOPENUI except that the default UI is used.
+
+pointer procedure gopen (device, mode, fd)
+
+char	device[ARB]		#I logical or physical device name
+int	mode			#I access mode: NEW_FILE or APPEND
+int	fd			#I metacode output file
+
+pointer	gopenui()
+
+begin
+	return (gopenui (device, mode, "", fd))
+end
diff --git a/sys/gio/gpagefile.x b/sys/gio/gpagefile.x
new file mode 100644
index 00000000..df950e71
--- /dev/null
+++ b/sys/gio/gpagefile.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gset.h>
+include	<gio.h>
+
+# GPAGEFILE -- File pager which works in or out of cursor mode.  If in graphics
+# mode, the workstation is deactivated, the file paged, and graphics mode later
+# restored.
+
+procedure gpagefile (gp, fname, prompt)
+
+pointer	gp			# graphics descriptor
+char	fname[ARB]		# name of file to be paged
+char	prompt[ARB]		# user prompt string
+
+bool	wsactive
+int	and()
+
+begin
+	wsactive = (and (GP_GFLAGS(gp), GF_WSACTIVE) != 0)
+
+	if (wsactive)
+	    call gdeactivate (gp, 0)
+	iferr (call pagefile (fname, prompt))
+	    call erract (EA_WARN)
+	if (wsactive)
+	    call greactivate (gp, AW_PAUSE)
+end
diff --git a/sys/gio/gpcell.x b/sys/gio/gpcell.x
new file mode 100644
index 00000000..17588647
--- /dev/null
+++ b/sys/gio/gpcell.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GPCELL -- Put a cell array.  Display a two dimensional array of pixels in the
+# given window, scaling as necessary to fit the window.  For maximum efficiency
+# no clipping is performed.  Only linear coordinate transformations are
+# permitted.  The cell array is defined by (x1,y1) and (x2,y2), the NDC coords
+# of the corners of the display area.  The graphics kernel is expected to
+# map cell array pixels into device pixels by mapping the coordinates of a
+# device pixel into the cell array and assigning the value of the nearest
+# cell array pixel to the device pixel.  In other words, the cell array is
+# sampled or block replicated as necessary to fit the device window.  The kernel
+# is not expected to perform area integration or filtering (interpolation)
+# to map cell array pixels into device pixels.  In the limiting case M may
+# contain a single pixel which will be replicated to fill the specified window,
+# e.g., nx=ny=1, (x1,y1)=(0,0), and (x2,y2)=(1,1).
+#
+#		+--+--+--+--Q (x2,y2)
+#	      4	|  |  |  |  |
+#		+--+--+--+--+
+#	      3	|  |  |  |  |		Sample Cell Array
+#	  Y	+--+--+--+--+		   nx = ny = 4
+#	      2	|  |  |  |  |
+#		+--+--+--+--+
+#	      1	|  |  |  |  |
+#	(x1,y1)	P--+--+--+--+
+#
+#	         1  2  3  4	X
+#
+# A sample 4 by 4 cell array is shown above.  The coordinates of the device
+# window into which the cell array is to be mapped refer to the corners P and
+# Q of the first and last pixels in the cell array.
+
+procedure gpcell (gp, m, nx, ny, x1, y1, x2, y2)
+
+pointer	gp			# device descriptor
+short	m[nx,ny]		# pixels
+int	nx, ny			# size of pixel array
+real	x1, y1			# lower left corner of output window
+real	x2, y2			# upper right corner of output window
+
+real	dy
+int	ly1, ly2, i
+int	sx1, sx2, sy1, sy2
+include	"gpl.com"
+
+begin
+	# Flush any buffered polyline output.  Make sure the wcs transformation
+	# in the cache is up to date.
+
+	if (op > 1)
+	    call gpl_flush()
+	else if (gp != gp_out || GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+
+	# Transform cell window to GKI coordinates.  The coordinate
+	# transformation must be linear.
+
+	sx1 = (x1 - wxorigin) * xscale + mxorigin
+	sx2 = (x2 - wxorigin) * xscale + mxorigin
+	sy1 = (y1 - wyorigin) * yscale + myorigin
+	sy2 = (y2 - wyorigin) * yscale + myorigin
+
+	dy = real (sy2 - sy1) / ny	# height of a line in GKI coords
+
+	# Write out the cell array, one line at a time.  Take care that the
+	# GKI integer value of ly1 of one line is the same as the ly2 value
+	# of the previous line, or there will be a blank line in the output
+	# image.
+
+	do i = 1, ny {
+	    ly1 = (i-1) * dy + sy1
+	    ly2 = (i  ) * dy + sy1
+	    call gki_putcellarray (GP_FD(gp), m[1,i], nx,1, sx1,ly1, sx2,ly2)
+	}
+end
diff --git a/sys/gio/gpl.com b/sys/gio/gpl.com
new file mode 100644
index 00000000..76d0d5c7
--- /dev/null
+++ b/sys/gio/gpl.com
@@ -0,0 +1,20 @@
+# GPL.COM -- Polyline generator common.
+
+bool	last_point_inbounds	# last point was inbounds
+int	xtran, ytran		# scaling function for X, Y axes (linear,log,,)
+int	op			# index of next cell in polyline array
+int	pl_type			# type of instruction (polyline, polymarker,...)
+int	pl_pointmode		# plotting points (polymarker), not vectors
+int	wcs			# WCS for which cache is valid
+long	mxorigin, myorigin	# origin in world coordinates for transform
+real	wxorigin, wyorigin	# origin in world coordinates for transform
+real	xscale, yscale		# scale factor, world to GKI, for transform
+real	cx, cy			# current pen position, world coords
+long	mx1, mx2, my1, my2	# clipping viewport, GKI coords
+long	xs[4], ys[4]		# last point plotted (for clipping code)
+pointer	gp_out			# device which owns current polyline
+short	pl[LEN_PLBUF]		# output polyline buffer
+
+common	/gplcom/ last_point_inbounds, xtran, ytran, op, pl_type, pl_pointmode,
+	mxorigin, myorigin, wxorigin, wyorigin, xscale, yscale, cx, cy,
+	mx1, mx2, my1, my2, xs, ys, gp_out, wcs, pl
diff --git a/sys/gio/gplcache.x b/sys/gio/gplcache.x
new file mode 100644
index 00000000..88201365
--- /dev/null
+++ b/sys/gio/gplcache.x
@@ -0,0 +1,101 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GPL_CACHE -- Cache the transformation parameters for a device in the GADRAW
+# common.  Must be called whenever the current WCS changes.  We need only
+# check that the WCS has not changed because anything more serious than a
+# change current WCS call will cause the cache to be invalidated.
+
+procedure gpl_cache (gp)
+
+pointer	gp			# graphics descriptor
+pointer	w
+real	wx1, wx2, wy1, wy2
+bool	fp_nondegenr()
+real	elogr()
+
+int	wcsord
+data	wcsord /0/
+include	"gpl.com"
+
+begin
+	gp_out = gp
+	wcs = GP_WCS(gp)
+	w = GP_WCSPTR (gp, wcs)
+
+	# The WCS must be fixed to the output device (kernel) when used for
+	# coordinate transformations in metacode output.
+
+	if (GP_WCSSTATE(gp) != FIXED) {
+	    call gactivate (gp, 0)
+	    call gpl_flush()
+	    call gki_setwcs (GP_FD(gp), Memi[GP_WCSPTR(gp,1)],
+		LEN_WCS * MAX_WCS)
+	    GP_WCSSTATE(gp) = FIXED
+	    wcsord = wcsord + 1
+	    GP_WCSORD(gp) = wcsord
+	}
+
+	mx1 = WCS_SX1(w) * GKI_MAXNDC
+	mx2 = WCS_SX2(w) * GKI_MAXNDC
+	my1 = WCS_SY1(w) * GKI_MAXNDC
+	my2 = WCS_SY2(w) * GKI_MAXNDC
+
+	# Compute world -> GKI coordinate transformation.  If log scaling is
+	# indicated but one or both window coords are negative, use ELOG
+	# scaling instead.
+
+	mxorigin = mx1
+	xtran = WCS_XTRAN(w)
+
+	wx1 = WCS_WX1(w)
+	wx2 = WCS_WX2(w)
+
+	# Ensure that the window is nondegenerate.
+	if (fp_nondegenr (wx1, wx2))
+	    ;
+
+	if (xtran == LINEAR) {
+	    wxorigin = wx1
+	    xscale = (mx2 - mx1) / (wx2 - wx1)
+	} else if (xtran == LOG && wx1 > 0 && wx2 > 0) {
+	    wxorigin = log10 (wx1)
+	    xscale = (mx2 - mx1) / (log10(wx2) - wxorigin)
+	} else {
+	    wxorigin = elogr (wx1)
+	    xscale = (mx2 - mx1) / (elogr(wx2) - wxorigin)
+	}
+
+	myorigin = my1
+	ytran = WCS_YTRAN(w)
+
+	wy1 = WCS_WY1(w)
+	wy2 = WCS_WY2(w)
+
+	# Ensure that the window is nondegenerate.
+	if (fp_nondegenr (wy1, wy2))
+	    ;
+
+	if (ytran == LINEAR) {
+	    wyorigin = wy1
+	    yscale = (my2 - my1) / (wy2 - wy1)
+	} else if (ytran == LOG && wy1 > 0 && wy2 > 0) {
+	    wyorigin = log10 (wy1)
+	    yscale = (my2 - my1) / (log10(wy2) - wyorigin)
+	} else {
+	    wyorigin = elogr (wy1)
+	    yscale = (my2 - my1) / (elogr(wy2) - wyorigin)
+	}
+
+	# If clipping is disabled move the clipping viewport out to the
+	# boundary of the device.
+
+	if (and (WCS_FLAGS(w), WF_CLIP) == 0) {
+	    mx1 = 0
+	    mx2 = GKI_MAXNDC
+	    my1 = 0
+	    my2 = GKI_MAXNDC
+	}
+end
diff --git a/sys/gio/gplcancel.x b/sys/gio/gplcancel.x
new file mode 100644
index 00000000..416bd787
--- /dev/null
+++ b/sys/gio/gplcancel.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GPL_CANCEL -- Cancel any buffered polyline output.
+
+procedure gpl_cancel()
+
+include	"gpl.com"
+
+begin
+	op = 1
+end
diff --git a/sys/gio/gplflush.x b/sys/gio/gplflush.x
new file mode 100644
index 00000000..403adc9c
--- /dev/null
+++ b/sys/gio/gplflush.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GPL_FLUSH -- Flush the buffered "polyline", i.e., array of transformed and
+# clipped points.  For a polyline or fill area polygon there must be at least
+# two points (4 cells) or it will be discarded.  A single point polymarker is
+# permitted.
+
+procedure gpl_flush()
+
+int	fd
+pointer	ap
+include	"gpl.com"
+
+begin
+	if (op > 2 && gp_out != NULL) {
+	    fd = GP_FD(gp_out)
+
+	    switch (pl_type) {
+	    case POLYMARKER:
+		ap = GP_PMAP(gp_out)
+		if (PM_STATE(ap) != FIXED) {
+		    call gki_pmset (fd, ap)
+		    PM_STATE(ap) = FIXED
+		}
+		call gki_polymarker (fd, pl, op / 2)
+
+	    case FILLAREA:
+		ap = GP_FAAP(gp_out)
+		if (FA_STATE(ap) != FIXED) {
+		    call gki_faset (fd, ap)
+		    FA_STATE(ap) = FIXED
+		}
+		if (op > 4)
+		    call gki_fillarea (fd, pl, op / 2)
+
+	    default:					# (case POLYLINE)
+		ap = GP_PLAP(gp_out)
+		if (PL_STATE(ap) != FIXED) {
+		    call gki_plset (fd, ap)
+		    PL_STATE(ap) = FIXED
+		}
+		if (op > 4)
+		    call gki_polyline (fd, pl, op / 2)
+	    }
+
+	    op = 1
+	}
+end
diff --git a/sys/gio/gpline.x b/sys/gio/gpline.x
new file mode 100644
index 00000000..ed0e8439
--- /dev/null
+++ b/sys/gio/gpline.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GPLINE -- Polyline.  Draw a line connecting the points (X[i],Y[i]), i.e.,
+# move to the first point and draw a straight line from there to the second
+# point, from the second to the third, and so on.
+
+procedure gpline (gp, x, y, npts)
+
+pointer	gp			# graphics descriptor
+real	x[ARB], y[ARB]		# points defining the polyline
+int	npts
+int	i
+
+begin
+	call gamove (gp, x[1], y[1])
+	do i = 2, npts
+	    call gadraw (gp, x[i], y[i])
+end
diff --git a/sys/gio/gploto.x b/sys/gio/gploto.x
new file mode 100644
index 00000000..a76de4fd
--- /dev/null
+++ b/sys/gio/gploto.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GPLOTV -- Plot a vector on an open graphics device.  This routine is
+# provided for the convenience of the user who does not need to exercise
+# fine control over the details of how the plot is generated, but who may
+# wish to select an output device other than stdgraph or who may wish to
+# leave the device open for annotation.
+
+procedure gploto (gp, v, npts, x1, x2, title)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# data vector
+int	npts			# number of data points
+real	x1, x2			# range of X in data vector
+char	title[ARB]		# plot title
+errchk	gswind, gascale, glabax
+
+begin
+	call gswind (gp, x1, x2, INDEF, INDEF)
+	call gascale (gp, v, npts, 2)
+	call glabax (gp, title, "", "")
+	call gvline (gp, v, npts, x1, x2)
+end
diff --git a/sys/gio/gplotv.x b/sys/gio/gplotv.x
new file mode 100644
index 00000000..1d9239e5
--- /dev/null
+++ b/sys/gio/gplotv.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GPLOTV -- Plot a vector.  This routine is provided for the convenience of
+# the user who does not need to exercise fine control over the details of
+# how the plot is generated.
+
+procedure gplotv (v, npts, x1, x2, title)
+
+real	v[ARB]			# data vector
+int	npts			# number of data points
+real	x1, x2			# range of X in data vector
+char	title[ARB]		# plot title
+
+pointer	gp
+pointer	gopen()
+errchk	gopen, gploto
+
+begin
+	gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+	call gploto (gp, v, npts, x1, x2, title)
+	call gclose (gp)
+end
diff --git a/sys/gio/gplreset.x b/sys/gio/gplreset.x
new file mode 100644
index 00000000..888fd99e
--- /dev/null
+++ b/sys/gio/gplreset.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GPL_RESET -- Reset the state of the GPL common, forcing a call to
+# re-initialize the cache in the next GADRAW call.  Should be called at
+# GOPEN time and thereafter whenever the a WCS is modified or an polyline,
+# polymarker, etc. attribute is set.
+
+procedure gpl_reset()
+
+bool	first_time
+include	"gpl.com"
+data	first_time /true/
+
+begin
+	if (first_time) {
+	    op = 1
+	    first_time = false
+	} else
+	    call gpl_flush()
+
+	wcs = -1
+	gp_out = NULL
+	pl_type = POLYLINE
+	last_point_inbounds = false
+end
diff --git a/sys/gio/gplstype.x b/sys/gio/gplstype.x
new file mode 100644
index 00000000..68056abd
--- /dev/null
+++ b/sys/gio/gplstype.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GPL_SETTYPE -- Set type (polyline, polymarker, fillarea) of point array PL.
+# Determines instruction type generated when PL is flushed.
+
+procedure gpl_settype (gp, type)
+
+pointer	gp			# graphics descriptor
+int	type			# type of instruction
+include	"gpl.com"
+
+begin
+	if (op > 1 && pl_type != type)
+	    call gpl_flush()
+
+	if (type == POINTMODE) {
+	    pl_type = POLYMARKER
+	    pl_pointmode = YES
+	} else {
+	    pl_type = type
+	    pl_pointmode = NO
+	}
+end
diff --git a/sys/gio/gpmark.x b/sys/gio/gpmark.x
new file mode 100644
index 00000000..dbe0b362
--- /dev/null
+++ b/sys/gio/gpmark.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+
+# GPMARK -- Polymarker.  Output at sequence of markers at the vertices of a
+# polygon, all markers the same type and size.  The marker type GM_POINT is
+# a special case.
+
+procedure gpmark (gp, x, y, npts, marktype, xsize, ysize)
+
+pointer	gp			# graphics descriptor
+real	x[ARB], y[ARB]		# vertices of polygon
+int	npts			# number of points
+int	marktype		# marker type
+real	xsize, ysize		# marker size
+int	i
+
+begin
+	if (marktype == GM_POINT) {
+	    call gpl_settype (gp, POINTMODE)
+	    call gpline (gp, x, y, npts)
+	    call gpl_settype (gp, POLYLINE)
+	} else {
+	    do i = 1, npts
+		call gmark (gp, x[i], y[i], marktype, xsize, ysize)
+	}
+end
diff --git a/sys/gio/gqverify.x b/sys/gio/gqverify.x
new file mode 100644
index 00000000..7f081f3b
--- /dev/null
+++ b/sys/gio/gqverify.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <fset.h>
+
+define	QUERY	"Type `q' to verify quit, `return' to return to cursor loop:"
+
+# GQVERIFY -- Print a message in the status line asking the user if they really
+# want to quit, returning YES if they really want to quit, NO otherwise.
+
+int procedure gqverify()
+
+int	ch
+int	getci()
+
+begin
+	call printf (QUERY)
+	call flush (STDOUT)
+
+	call fseti (STDIN, F_RAW, YES)
+	while (getci (STDIN, ch) != EOF)
+	    if (ch == 'q' || ch == '\r' || ch == '\n')
+		break
+
+	call printf ("\n\n")
+	call flush (STDOUT)
+	call fseti (STDIN, F_RAW, NO)
+
+	if (ch == 'q')
+	    return (YES)
+	else
+	    return (NO)
+end
diff --git a/sys/gio/grdraw.x b/sys/gio/grdraw.x
new file mode 100644
index 00000000..7cd44a74
--- /dev/null
+++ b/sys/gio/grdraw.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GRDRAW -- Relative draw, i.e., move the pen to the specified offset from the
+# current position.
+
+procedure grdraw (gp, x, y)
+
+pointer	gp			# graphics descriptor
+real	x, y			# offset from current position
+real	cx, cy
+
+begin
+	if (IS_INDEF(x) || IS_INDEF(y))
+	    call gadraw (gp, x, y)
+	else {
+	    call gcurpos (gp, cx, cy)
+	    if (IS_INDEF(cx) || IS_INDEF(cy))
+		call gadraw (gp, INDEF, INDEF)
+	    else
+		call gadraw (gp, cx + x, cy + y)
+	}
+end
diff --git a/sys/gio/grdwcs.x b/sys/gio/grdwcs.x
new file mode 100644
index 00000000..3ded4e9e
--- /dev/null
+++ b/sys/gio/grdwcs.x
@@ -0,0 +1,106 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+.help savewcs
+.nf __________________________________________________________________________
+SAVEWCS -- A package for saving the WCS in a file for later restoration when
+a device is opened in append mode.
+
+	gwrwcs (devname, wcs, len_wcs)		save wcs in file
+  len = grdwcs (devname, wcs, len_wcs)		read wcs from file
+
+Only the 16+1 WCS structures are currently saved.  There is no provision for
+saving the WCSSTATE and the index of the current WCS.
+.endhelp _____________________________________________________________________
+
+
+# GWRWCS -- Save the WCS in a binary file in the user directory UPARM.
+# Any existing file is overwritten.
+
+procedure gwrwcs (devname, wcs, len_wcs)
+
+char	devname[ARB]			# device name
+int	wcs[ARB]			# array to be saved
+int	len_wcs
+
+pointer	sp, fname
+int	fd
+int	open()
+errchk	open, write
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	call gwcs_mkfilename (devname, Memc[fname], SZ_FNAME)
+	iferr (call delete (Memc[fname]))
+	    ;
+	fd = open (Memc[fname], NEW_FILE, BINARY_FILE)
+	call write (fd, wcs, len_wcs * SZ_INT)
+	call close (fd)
+
+	call sfree (sp)
+end
+
+
+# GRDWCS -- Read the WCS from a binary file in the user directory UPARM.
+# The actual number of size int elements read is returned as the function
+# value.  It is not an error if there is no file or the file cannot be read.
+
+int procedure grdwcs (devname, wcs, len_wcs)
+
+char	devname[ARB]			# device name
+int	wcs[ARB]			# array to be returned
+int	len_wcs				# max ints to read
+
+pointer	sp, fname
+int	fd, nchars
+int	open(), read()
+errchk	read
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	call gwcs_mkfilename (devname, Memc[fname], SZ_FNAME)
+	iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE))
+	    nchars = 0
+	else {
+	    nchars = read (fd, wcs, len_wcs * SZ_INT)
+	    call close (fd)
+	}
+
+	call sfree (sp)
+	return (nchars / SZ_INT)
+end
+
+
+# GWCS_MKFILENAME -- Make the filename of the WCS savefile for the named
+# device.  The filename is "uparm$fname.gd", where the "fname" is the
+# device name with any illegal filename characters deleted.  The mapping
+# is not necessarily unique.
+
+procedure gwcs_mkfilename (devname, fname, maxch)
+
+char	devname[ARB]		# device name
+char	fname[ARB]		# generated filename (output)
+int	maxch
+
+int	ip, op, ch
+int	gstrcpy()
+
+begin
+	# Leave OP pointing to last char output.
+	op = gstrcpy ("uparm$", fname, maxch)
+
+	for (ip=1;  devname[ip] != EOS;  ip=ip+1) {
+	    ch = devname[ip]
+	    if (IS_ALNUM(ch) || ch == '.' || ch == '_') {
+		op = min (maxch, op + 1)
+		fname[op] = ch
+	    }
+	}
+
+	fname[op+1] = EOS
+end
diff --git a/sys/gio/greact.x b/sys/gio/greact.x
new file mode 100644
index 00000000..e201d543
--- /dev/null
+++ b/sys/gio/greact.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+
+# GREACTIVATE -- Reactivate the workstation, i.e., for an interactive device
+# (graphics terminal) restore the terminal to graphics mode, following a call
+# to gdeactivate to do some normal terminal mode text i/o.
+
+procedure greactivate (gp, flags)
+
+pointer	gp			# graphics descriptor
+int	flags			# action flags
+
+int	and()
+errchk	gki_reactivatews, gactivate
+
+begin
+	call flush (STDOUT)
+	if (and (GP_GFLAGS(gp), GF_WSOPEN) != 0) {
+	    # The workstation is already open - just reactivate it.
+	    call gki_reactivatews (GP_FD(gp), flags)
+	    if (and (GP_GFLAGS(gp), GF_WSACTIVE) == 0)
+		GP_GFLAGS(gp) = GP_GFLAGS(gp) + GF_WSACTIVE
+	} else {
+	    # Open the workstation (implies an automatic reactivatews).
+	    call gactivate (gp, flags)
+	}
+
+	if (and (flags, AW_CLEAR) != 0)
+	    call gfrinit (gp)
+end
diff --git a/sys/gio/greset.x b/sys/gio/greset.x
new file mode 100644
index 00000000..1002e2b9
--- /dev/null
+++ b/sys/gio/greset.x
@@ -0,0 +1,238 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+
+# GRESET -- Initialize the internal state variables of GIO to their default
+# values.  Called upon startup and by GCANCEL and GCLEAR.
+
+procedure greset (gp, flags)
+
+pointer gp			#I graphics descriptor
+int	flags			#I flags indicating what to reset
+
+int	color, ch, i
+real	char_height, aspect
+bool	reset_wcs, reset_gio, reset_glabax
+pointer	sp, glbcolor, param, w, ap, ax, ax1, ax2, ip, op
+
+bool	streq()
+real	ggetr()
+int	envfind(), ctoi(), strncmp()
+define	next_ 91
+errchk	ggetr
+
+begin
+	call smark (sp)
+	call salloc (glbcolor, SZ_LINE, TY_CHAR)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+
+	# Initialize for a new frame; this is always done.
+	call gfrinit (gp)
+
+	reset_glabax = (and (flags, GR_RESETGLABAX) != 0)
+	reset_wcs    = (and (flags, GR_RESETWCS)    != 0)
+	reset_gio    = (and (flags, GR_RESETGIO)    != 0)
+
+	# Reset general GIO device and drawing parameters?
+	if (reset_gio) {
+	    GP_CURSOR(gp) = 1
+
+	    # All default sizes in NDC units are scaled to the height of a
+	    # device character.
+
+	    char_height = ggetr (gp, "ch")
+	    if (char_height < EPSILON)
+		char_height = DEF_CHARHEIGHT
+	    aspect = ggetr (gp, "ar")
+	    if (aspect < EPSILON)
+		aspect = 1.0
+	    GP_DEVASPECT(gp) = aspect
+
+	    # Set default marker sizes.
+	    do i = 1, 4
+		GP_SZMARKER(gp,i) = (char_height * i) / 4.0
+
+	    # Set polyline attributes.
+	    ap = GP_PLAP(gp)
+	    PL_LTYPE(ap) = 1
+	    PL_WIDTH(ap) = 1.0
+	    PL_COLOR(ap) = 1
+
+	    # Set polymarker attributes.
+	    ap = GP_PMAP(gp)
+	    PM_LTYPE(ap) = 1
+	    PM_WIDTH(ap) = 1.0
+	    PM_COLOR(ap) = 1
+
+	    # Set fill area attributes.
+	    ap = GP_FAAP(gp)
+	    FA_STYLE(ap) = 1
+	    FA_COLOR(ap) = 1
+
+	    # Set default text attributes.
+	    ap = GP_TXAP(gp)
+	    TX_UP(ap) = 90
+	    TX_SIZE(ap) = 1.0
+	    TX_PATH(ap) = GT_RIGHT
+	    TX_SPACING(ap) = 0.0
+	    TX_HJUSTIFY(ap) = GT_LEFT
+	    TX_VJUSTIFY(ap) = GT_DOWN
+	    TX_FONT(ap) = GT_ROMAN
+	    TX_QUALITY(ap) = GT_NORMAL
+	    TX_COLOR(ap) = 1
+	}
+
+	# Reset GLABAX parameters?
+	if (reset_glabax) {
+	    # Set general GLABAX parameters.
+	    GP_DRAWTITLE(gp) = YES
+	    GP_TITLESIZE(gp) = 1.0
+	    GP_TITLECOLOR(gp) = 1
+	    GP_TITLEJUST(gp) = GT_CENTER
+	    GP_NTITLELINES(gp) = 0
+	    GP_FRAMECOLOR(gp) = 0
+	    GP_FRAMEDRAWN(gp) = 0
+
+	    # Set GLABAX parameters for the X and Y axes.
+	    do i = 1, 2 {
+		if (i == 1)
+		    ax = GP_XAP(gp)
+		else
+		    ax = GP_YAP(gp)
+
+		GL_DRAWAXES(ax) = 3
+		GL_SETAXISPOS(ax) = NO 
+		GL_AXISPOS1(ax) = 0.0
+		GL_AXISPOS2(ax) = 0.0
+		GL_DRAWGRID(ax) = NO
+		GL_GRIDCOLOR(ax) = 1
+		GL_ROUND(ax) = NO
+		GL_LABELAXIS(ax) = YES
+		GL_AXISLABELSIZE(ax) = 1.0
+		GL_AXISLABELCOLOR(ax) = 1
+		GL_DRAWTICKS(ax) = YES
+		GL_LABELTICKS(ax) = YES
+		GL_NMAJOR(ax) = 6
+		GL_NMINOR(ax) = 4
+		GL_MAJORLENGTH(ax) = 0.6 * char_height
+		GL_MINORLENGTH(ax) = 0.3 * char_height
+		GL_MAJORWIDTH(ax) = 2.0
+		GL_MINORWIDTH(ax) = 2.0
+		GL_AXISWIDTH(ax) = 2.0
+		GL_AXISCOLOR(ax) = 1
+		GL_TICKLABELSIZE(ax) = 1.0
+		GL_TICKLABELCOLOR(ax) = 1
+		GL_TICKCOLOR(ax) = 1
+		GL_TICKFORMAT(ax) = EOS
+	    }
+
+	    # Correct the default tick length for the aspect ratio.
+	    ax = GP_XAP(gp)
+	    GL_MAJORLENGTH(ax) = GL_MAJORLENGTH(ax) / aspect
+	    GL_MINORLENGTH(ax) = GL_MINORLENGTH(ax) / aspect
+
+	    # Set user color defaults if specified.  This is a simple string
+	    # parameter of the form "pt=i,fr=i,ax=i,..." where I is the color
+	    # index.  The actual color corresponding to this index is defined
+	    # externally, e.g. by the graphics server.
+
+	    if (envfind ("glbcolor", Memc[glbcolor], SZ_LINE) > 0) {
+		ax1 = GP_XAP(gp)
+		ax2 = GP_YAP(gp)
+
+		for (ip=glbcolor;  Memc[ip] != EOS;  ) {
+		    # Get color parameter code.
+		    for (op=param;  Memc[ip] != EOS &&
+			Memc[ip] != '=' && Memc[ip] != ':';  ip=ip+1) {
+			Memc[op] = Memc[ip]
+			op = op + 1
+		    }
+		    Memc[op] = EOS
+		    ch = Memc[param+2]
+
+		    # Get color index.
+		    if (Memc[ip] == '=' || Memc[ip] == ':')
+			ip = ip + 1
+		    if (ctoi (Memc, ip, color) <= 0)
+			goto next_
+
+		    # Set parameter.  The two character parameter name may
+		    # have an "x" or "y" appended to set only one axis.  For
+		    # example, "pt=4,fr=3,ax=1,tk=1,al=5,tl=6".  The color
+		    # parameter code names are as follows:
+		    #
+		    #   pt	plot title
+		    #   fr	viewport frame
+		    #   gr[xy]	grid between tick marks
+		    #	ax[xy]	axis
+		    #	al[xy]	axis label
+		    #	tk[xy]	tick
+		    #	tl[xy]	tick label
+		    #
+		    # The color codes are simple integers corresponding to
+		    # graphics device color codes, e.g. 0, 1, 2, and so on.
+
+		    if (streq (Memc[param], "pt")) {
+			GP_TITLECOLOR(gp) = color
+		    } else if (streq (Memc[param], "fr")) {
+			GP_FRAMECOLOR(gp) = color
+		    } else if (strncmp (Memc[param], "gr", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_GRIDCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_GRIDCOLOR(ax2) = color
+		    } else if (strncmp (Memc[param], "ax", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_AXISCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_AXISCOLOR(ax2) = color
+		    } else if (strncmp (Memc[param], "al", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_AXISLABELCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_AXISLABELCOLOR(ax2) = color
+		    } else if (strncmp (Memc[param], "tk", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_TICKCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_TICKCOLOR(ax2) = color
+		    } else if (strncmp (Memc[param], "tl", 2) == 0) {
+			if (ch == EOS || ch == 'x')
+			    GL_TICKLABELCOLOR(ax1) = color
+			if (ch == EOS || ch == 'y')
+			    GL_TICKLABELCOLOR(ax2) = color
+		    }
+next_
+		while (Memc[ip] != EOS && Memc[ip] != ',')
+		    ip = ip + 1
+		if (Memc[ip] == ',')
+		    ip = ip + 1
+		}
+	    }
+	}
+
+	# Reset the WCS?
+	if (reset_wcs) {
+	    GP_WCS(gp) = 1
+
+	    # Initialize the WCS to NDC coordinates.
+	    do i = 0, MAX_WCS {
+		w = GP_WCSPTR(gp,i)
+		WCS_WX1(w) = 0.0
+		WCS_WX2(w) = 1.0
+		WCS_WY1(w) = 0.0
+		WCS_WY2(w) = 1.0
+		WCS_SX1(w) = 0.0
+		WCS_SX2(w) = 1.0
+		WCS_SY1(w) = 0.0
+		WCS_SY2(w) = 1.0
+		WCS_XTRAN(w) = LINEAR
+		WCS_YTRAN(w) = LINEAR
+		WCS_FLAGS(w) = WF_NEWFORMAT+WF_CLIP
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/grmove.x b/sys/gio/grmove.x
new file mode 100644
index 00000000..aa4e5b45
--- /dev/null
+++ b/sys/gio/grmove.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GRMOVE -- Relative move, i.e., move the pen to the specified offset from the
+# current position (without generating any output).
+
+procedure grmove (gp, x, y)
+
+pointer	gp			# graphics descriptor
+real	x, y			# offset from current position
+real	cx, cy
+
+begin
+	call gpl_flush()
+	if (IS_INDEF(x) || IS_INDEF(y))
+	    call gadraw (gp, x, y)
+	else {
+	    call gcurpos (gp, cx, cy)
+	    if (!(IS_INDEF(cx) || IS_INDEF(cy)))
+		call gamove (gp, cx + x, cy + y)
+	}
+end
diff --git a/sys/gio/grscale.x b/sys/gio/grscale.x
new file mode 100644
index 00000000..76c06ebc
--- /dev/null
+++ b/sys/gio/grscale.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gio.h>
+
+# GRSCALE -- Rescale the world coordinates of either the X or Y axis to fit the
+# data vector.  This is done by taking the minimum and maximum of the current
+# WCS limits and the data vector.  May be called repeatedly to find the range
+# of a family of vectors.
+
+procedure grscale (gp, v, npts, axis)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# data vector
+int	npts			# length of data vector
+int	axis			# asis to be scaled (1=X, 2=Y)
+
+int	start, i
+real	minval, maxval, pixval
+pointer	w
+
+begin
+	# Find first definite valued pixel.  If entire data vector is
+	# indefinite we merely ignore it, since the window is presumably
+	# already set.
+
+	for (start=1;  start <= npts;  start=start+1)
+	    if (!IS_INDEF (v[start]))
+		break
+	if (start > npts)
+	    return
+
+	minval = v[start]
+	maxval = minval
+
+	# Compute min and max values of data vector.
+	do i = start+1, npts {
+	    pixval = v[i]
+	    if (!IS_INDEF(pixval))
+		if (pixval < minval)
+		    minval = pixval
+		else if (pixval > maxval)
+		    maxval = pixval
+	}
+
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	# Update the window limits.
+	switch (axis) {
+	case 1:
+	    WCS_WX1(w) = min (WCS_WX1(w), minval)
+	    WCS_WX2(w) = max (WCS_WX2(w), maxval)
+	case 2:
+	    WCS_WY1(w) = min (WCS_WY1(w), minval)
+	    WCS_WY2(w) = max (WCS_WY2(w), maxval)
+	default:
+	    call syserr (SYS_GSCALE)
+	}
+
+	WCS_FLAGS(w) = or (WCS_FLAGS(w), WF_DEFINED)
+	GP_WCSSTATE(gp) = MODIFIED
+	call gpl_reset()
+end
diff --git a/sys/gio/gscan.x b/sys/gio/gscan.x
new file mode 100644
index 00000000..ac8f82bd
--- /dev/null
+++ b/sys/gio/gscan.x
@@ -0,0 +1,11 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSCAN -- Scan commands from a string or a file.
+
+procedure gscan (gp, command)
+
+pointer	gp			# graphics descriptor
+char	command[ARB]		# command to be scanned
+
+begin
+end
diff --git a/sys/gio/gscur.x b/sys/gio/gscur.x
new file mode 100644
index 00000000..2892e397
--- /dev/null
+++ b/sys/gio/gscur.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GSCUR -- Set the current graphics cursor to the position (x,y) in world
+# coordinates.
+
+procedure gscur (gp, x, y)
+
+pointer gp			# graphics descriptor
+real	x, y			# new position for cursor
+real	mx, my
+
+begin
+	call gpl_flush()
+	call gpl_wcstogki (gp, x, y, mx, my)
+	call gki_setcursor (GP_FD(gp), nint(mx), nint(my), GP_CURSOR(gp))
+end
diff --git a/sys/gio/gseti.x b/sys/gio/gseti.x
new file mode 100644
index 00000000..f3517358
--- /dev/null
+++ b/sys/gio/gseti.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSETI -- Set any GIO parameter of type integer or real.  Precision may be
+# lost if the actual parameter is of type real (call GSETR instead in such
+# a case).
+
+procedure gseti (gp, param, value)
+
+pointer	gp			# graphics descriptor
+int	param			# parameter to be set
+int	value			# new value for parameter
+
+begin
+	call gsetr (gp, param, real(value))
+end
diff --git a/sys/gio/gsetr.x b/sys/gio/gsetr.x
new file mode 100644
index 00000000..9358f046
--- /dev/null
+++ b/sys/gio/gsetr.x
@@ -0,0 +1,276 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+
+# GSETR -- Set any GIO parameter of type integer or real.  Real values are
+# silently coerced to integer if the actual parameter value is integer.
+
+procedure gsetr (gp, param, rval)
+
+pointer	gp			# graphics descriptor
+int	param			# parameter to be set
+real	rval			# new value for parameter
+
+real	char_height
+int	wcs, axes, field, ax[2], wflags, i
+pointer	w, p, pl, pm, tx, fa
+real	ggetr()
+
+begin
+	# Compute pointers to substructures once, here, to save space later.
+	wcs = GP_WCS(gp)
+	w = GP_WCSPTR(gp,wcs)
+	wflags = WCS_FLAGS(w)
+
+	pl = GP_PLAP(gp)
+	pm = GP_PMAP(gp)
+	tx = GP_TXAP(gp)
+	fa = GP_FAAP(gp)
+
+	switch (param) {
+
+	# General GIO parameters.
+
+	case G_FD:
+	    GP_FD(gp) = nint(rval)
+	case G_TTY:
+	    GP_TTY(gp) = nint(rval)
+	case G_WCS:
+	    GP_WCS(gp) = nint(rval)
+	case G_CURSOR:
+	    GP_CURSOR(gp) = nint(rval)
+
+	# These parameters affect the current WCS.
+
+	case G_XTRAN:
+	    WCS_XTRAN(w) = nint(rval)
+	    GP_WCSSTATE(gp) = MODIFIED
+	    call gpl_reset()
+	case G_YTRAN:
+	    WCS_YTRAN(w) = nint(rval)
+	    GP_WCSSTATE(gp) = MODIFIED
+	    call gpl_reset()
+	case G_CLIP:
+	    if (nint(rval) == 0)
+		WCS_FLAGS(w) = and (wflags, not(WF_CLIP))
+	    else
+		WCS_FLAGS(w) = or (wflags, WF_CLIP)
+	    GP_WCSSTATE(gp) = MODIFIED
+	    call gpl_reset()
+	case G_RASTER:
+	    WCS_FLAGS(w) = WF_SETRASTER (wflags, nint(rval))
+	    GP_WCSSTATE(gp) = MODIFIED
+	    call gpl_reset()
+
+	# Default marker sizes (NDC coords).
+
+	case G_SZMARKER1:
+	    GP_SZMARKER(gp,1) = rval
+	case G_SZMARKER2:
+	    GP_SZMARKER(gp,2) = rval
+	case G_SZMARKER3:
+	    GP_SZMARKER(gp,3) = rval
+	case G_SZMARKER4:
+	    GP_SZMARKER(gp,4) = rval
+
+	# Polyline attributes.
+
+	case G_PLTYPE:
+	    call gst_set_attribute_i (nint(rval), PL_LTYPE(pl), PL_STATE(pl))
+	case G_PLWIDTH:
+	    call gst_set_attribute_r (rval, PL_WIDTH(pl), PL_STATE(pl))
+	case G_PLCOLOR:
+	    call gst_set_attribute_i (nint(rval), PL_COLOR(pl), PL_STATE(pl))
+
+	# Polymarker attributes.
+
+	case G_PMLTYPE:
+	    call gst_set_attribute_i (nint(rval), PM_LTYPE(pm), PM_STATE(pm))
+	case G_PMWIDTH:
+	    call gst_set_attribute_r (rval, PM_WIDTH(pm), PM_STATE(pm))
+	case G_PMCOLOR:
+	    call gst_set_attribute_i (nint(rval), PM_COLOR(pm), PM_STATE(pm))
+
+	# Text drawing attributes.
+
+	case G_TXUP:
+	    call gst_set_attribute_i (nint(rval), TX_UP(tx), TX_STATE(tx))
+	case G_TXSIZE:
+	    call gst_set_attribute_r (rval, TX_SIZE(tx), TX_STATE(tx))
+	case G_TXPATH:
+	    call gst_set_attribute_i (nint(rval), TX_PATH(tx), TX_STATE(tx))
+	case G_TXSPACING:
+	    call gst_set_attribute_r (rval, TX_SPACING(tx), TX_STATE(tx))
+	case G_TXHJUSTIFY:
+	    call gst_set_attribute_i (nint(rval), TX_HJUSTIFY(tx), TX_STATE(tx))
+	case G_TXVJUSTIFY:
+	    call gst_set_attribute_i (nint(rval), TX_VJUSTIFY(tx), TX_STATE(tx))
+	case G_TXFONT:
+	    call gst_set_attribute_i (nint(rval), TX_FONT(tx), TX_STATE(tx))
+	case G_TXQUALITY:
+	    call gst_set_attribute_i (nint(rval), TX_QUALITY(tx), TX_STATE(tx))
+	case G_TXCOLOR:
+	    call gst_set_attribute_i (nint(rval), TX_COLOR(tx), TX_STATE(tx))
+
+	# Fill area attributes.
+
+	case G_FASTYLE:
+	    call gst_set_attribute_i (nint(rval), FA_STYLE(fa), FA_STATE(fa))
+	case G_FACOLOR:
+	    call gst_set_attribute_i (nint(rval), FA_COLOR(fa), FA_STATE(fa))
+
+	# Axis labelling parameters affecting more than one axis.
+
+	case G_DRAWTITLE:
+	    GP_DRAWTITLE(gp) = nint(rval)
+	case G_TITLESIZE:
+	    GP_TITLESIZE(gp) = rval
+	case G_TITLECOLOR:
+	    GP_TITLECOLOR(gp) = nint(rval)
+	case G_TITLEJUST:
+	    GP_TITLEJUST(gp) = nint(rval)
+	case G_NTITLELINES:
+	    GP_NTITLELINES(gp) = nint(rval)
+	case G_FRAMECOLOR:
+	    GP_FRAMECOLOR(gp) = nint(rval)
+	case G_ASPECT:
+	    GP_ASPECT(gp) = rval
+
+	case G_CHARSIZE:
+	    # Set the character size (height) in NDC units.  This can also be
+	    # done by querying for "ch" and setting the relative size, but the
+	    # function is fundamental enough to be worth implementing as a
+	    # single call.
+
+	    char_height = ggetr (gp, "ch")
+	    if (char_height < EPSILON)
+		char_height = DEF_CHARHEIGHT
+	    call gst_set_attribute_r (rval / char_height, TX_SIZE(tx),
+		TX_STATE(tx))
+
+	default:
+	    # The GLABAX parameters for the X and Y axes may be set separately
+	    # for each axis or simultaneously for both.  The parameter codes
+	    # are encoded as 100 (X only) 200 (Y only) or 300 (both) plus the
+	    # code for the field in the lower digits.
+
+	    if (param < FIRST_GLABAX_PARAM || param > LAST_GLABAX_PARAM)
+		call syserr (SYS_GSET)
+
+	    axes = param / 100
+	    field = mod (param, 100) + 300
+
+	    ax[1] = 0
+	    ax[2] = 0
+	    if (axes == 1 || axes == 3)
+		ax[1] = YES
+	    if (axes == 2 || axes == 3)
+		ax[2] = YES
+
+	    do i = 1, 2 {
+		if (ax[i] == YES) {
+		    if (i == 1)
+			p = GP_XAP(gp)
+		    else
+			p = GP_YAP(gp)
+
+		    switch (field) {
+		    case G_DRAWAXES:
+			GL_DRAWAXES(p) = nint(rval)
+		    case G_SETAXISPOS:
+			GL_SETAXISPOS(p) = nint(rval)
+		    case G_AXISPOS1:
+			GL_AXISPOS1(p) = rval
+		    case G_AXISPOS2:
+			GL_AXISPOS2(p) = rval
+		    case G_DRAWGRID:
+			GL_DRAWGRID(p) = nint(rval)
+		    case G_GRIDCOLOR:
+			GL_GRIDCOLOR(p) = nint(rval)
+		    case G_ROUND:
+			GL_ROUND(p) = nint(rval)
+		    case G_LABELAXIS:
+			GL_LABELAXIS(p) = nint(rval)
+		    case G_AXISLABELSIZE:
+			GL_AXISLABELSIZE(p) = rval
+		    case G_AXISLABELCOLOR:
+			GL_AXISLABELCOLOR(p) = nint(rval)
+		    case G_DRAWTICKS:
+			GL_DRAWTICKS(p) = nint(rval)
+		    case G_LABELTICKS:
+			GL_LABELTICKS(p) = nint(rval)
+		    case G_NMAJOR:
+			GL_NMAJOR(p) = nint(rval)
+		    case G_NMINOR:
+			GL_NMINOR(p) = nint(rval)
+		    case G_MAJORLENGTH:
+			GL_MAJORLENGTH(p) = rval
+		    case G_MINORLENGTH:
+			GL_MINORLENGTH(p) = rval
+		    case G_MAJORWIDTH:
+			GL_MAJORWIDTH(p) = rval
+		    case G_MINORWIDTH:
+			GL_MINORWIDTH(p) = rval
+		    case G_AXISWIDTH:
+			GL_AXISWIDTH(p) = rval
+		    case G_AXISCOLOR:
+			GL_AXISCOLOR(p) = nint(rval)
+		    case G_TICKLABELSIZE:
+			GL_TICKLABELSIZE(p) = rval
+		    case G_TICKLABELCOLOR:
+			GL_TICKLABELCOLOR(p) = nint(rval)
+		    case G_TICKCOLOR:
+			GL_TICKCOLOR(p) = nint(rval)
+		    # case G_TICKFORMAT:
+			# not a real parameter
+		    default:
+			call syserr (SYS_GSET)
+		    }
+		}
+	    }
+	}
+end
+
+
+# GST_SET_ATTRIBUTE_I -- Compare the new value of an attribute to the current
+# value.  If the new value is not different, exit without modifying the
+# attribute packet, making no-op GSET calls efficient.  If the packet must
+# be modified, flush any buffered polyline output first else it will be
+# written using the new attribute (this is not necessary for text attributes,
+# but is harmless and it is unlikely that GSET will be called to modify a
+# text attribute while in the midst of building a polyline).  Set the
+# parameter and flag the attribute packet as modified.
+
+procedure gst_set_attribute_i (new_value, value, state)
+
+int	new_value		# value in GSET argument list
+int	value			# current value in GP struct
+int	state			# packet state
+
+begin
+	if (new_value != value) {
+	    call gpl_flush()
+	    value = new_value
+	    state = MODIFIED
+	}
+end
+
+
+# GST_SET_ATTRIBUTE_R -- Ditto, for real valued parameters.
+
+procedure gst_set_attribute_r (new_value, value, state)
+
+real	new_value		# value in GSET argument list
+real	value			# current value in GP struct
+int	state			# packet state
+
+begin
+	if (abs (new_value - value) > EPSILON) {
+	    call gpl_flush()
+	    value = new_value
+	    state = MODIFIED
+	}
+end
diff --git a/sys/gio/gsets.x b/sys/gio/gsets.x
new file mode 100644
index 00000000..ad72d000
--- /dev/null
+++ b/sys/gio/gsets.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gset.h>
+include	<gio.h>
+
+# GSETS -- Set a string valued GIO parameter.
+
+procedure gsets (gp, param, value)
+
+pointer	gp			# graphics descriptor
+int	param			# parmeter to be set
+char	value[ARB]		# new value of parameter
+int	i
+pointer	gl[2]
+
+begin
+	gl[1] = GP_XAP(gp)
+	gl[2] = GP_YAP(gp)
+
+	switch (param) {
+	case G_XTICKFORMAT:
+	    call strcpy (value, GL_TICKFORMAT(gl[1]), SZ_TICKFORMAT)
+	case G_YTICKFORMAT:
+	    call strcpy (value, GL_TICKFORMAT(gl[2]), SZ_TICKFORMAT)
+	case G_TICKFORMAT:
+	    do i = 1, 2
+		call strcpy (value, GL_TICKFORMAT(gl[i]), SZ_TICKFORMAT)
+	default:
+	    call syserr (SYS_GSET)
+	}
+end
diff --git a/sys/gio/gstati.x b/sys/gio/gstati.x
new file mode 100644
index 00000000..2298b39b
--- /dev/null
+++ b/sys/gio/gstati.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSTATI -- Get any GIO parameter of type integer or real.  Precision may be
+# lost if the actual parameter is of type real (call GSTATR instead in such
+# a case).
+
+int procedure gstati (gp, param)
+
+pointer	gp			# graphics descriptor
+int	param			# parameter to be inspected
+
+real	gstatr()
+
+begin
+	return (gstatr (gp, param))
+end
diff --git a/sys/gio/gstatr.x b/sys/gio/gstatr.x
new file mode 100644
index 00000000..d0ba3d8b
--- /dev/null
+++ b/sys/gio/gstatr.x
@@ -0,0 +1,215 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mach.h>
+include	<gset.h>
+include	<gio.h>
+
+# GSTATR -- Get any GIO parameter of type integer or real.  Integer values are
+# silently coerced to real if the actual parameter value is integer.
+
+real procedure gstatr (gp, param)
+
+pointer	gp			# graphics descriptor
+int	param			# parameter to be set
+
+real	char_height
+int	wcs, axes, field, ax[2], i
+pointer	w, p, pl, pm, tx, fa
+real	ggetr()
+
+begin
+	# Compute pointers to substructures once, here, to save space later.
+	wcs = GP_WCS(gp)
+	w   = GP_WCSPTR(gp,wcs)
+	pl  = GP_PLAP(gp)
+	pm  = GP_PMAP(gp)
+	tx  = GP_TXAP(gp)
+	fa  = GP_FAAP(gp)
+
+	switch (param) {
+
+	# General GIO parameters.
+
+	case G_FD:
+	    return (GP_FD(gp))
+	case G_TTY:
+	    return (GP_TTY(gp))
+	case G_WCS:
+	    return (GP_WCS(gp))
+	case G_CURSOR:
+	    return (GP_CURSOR(gp))
+
+	# These parameters affect the current WCS.
+
+	case G_XTRAN:
+	    return (WCS_XTRAN(w))
+	case G_YTRAN:
+	    return (WCS_YTRAN(w))
+	case G_CLIP:
+	    return (and (WCS_FLAGS(w), WF_CLIP))
+	case G_RASTER:
+	    return (WF_RASTER (WCS_FLAGS(w)))
+
+	# Default marker sizes (NDC coords).
+
+	case G_SZMARKER1:
+	    return (GP_SZMARKER(gp,1))
+	case G_SZMARKER2:
+	    return (GP_SZMARKER(gp,2))
+	case G_SZMARKER3:
+	    return (GP_SZMARKER(gp,3))
+	case G_SZMARKER4:
+	    return (GP_SZMARKER(gp,4))
+
+	# Polyline attributes.
+
+	case G_PLTYPE:
+	    return (PL_LTYPE(pl))
+	case G_PLWIDTH:
+	    return (PL_WIDTH(pl))
+	case G_PLCOLOR:
+	    return (PL_COLOR(pl))
+
+	# Polymarker attributes.
+
+	case G_PMLTYPE:
+	    return (PM_LTYPE(pm))
+	case G_PMWIDTH:
+	    return (PM_WIDTH(pm))
+	case G_PMCOLOR:
+	    return (PM_COLOR(pm))
+
+	# Text drawing attributes.
+
+	case G_TXUP:
+	    return (TX_UP(tx))
+	case G_TXSIZE:
+	    return (TX_SIZE(tx))
+	case G_TXPATH:
+	    return (TX_PATH(tx))
+	case G_TXSPACING:
+	    return (TX_SPACING(tx))
+	case G_TXHJUSTIFY:
+	    return (TX_HJUSTIFY(tx))
+	case G_TXVJUSTIFY:
+	    return (TX_VJUSTIFY(tx))
+	case G_TXFONT:
+	    return (TX_FONT(tx))
+	case G_TXQUALITY:
+	    return (TX_QUALITY(tx))
+	case G_TXCOLOR:
+	    return (TX_COLOR(tx))
+
+	# Fill area attributes.
+
+	case G_FASTYLE:
+	    return (FA_STYLE(fa))
+	case G_FACOLOR:
+	    return (FA_COLOR(fa))
+
+	# Axis labelling parameters affecting more than one axis.
+
+	case G_DRAWTITLE:
+	    return (GP_DRAWTITLE(gp))
+	case G_TITLESIZE:
+	    return (GP_TITLESIZE(gp))
+	case G_TITLECOLOR:
+	    return (GP_TITLECOLOR(gp))
+	case G_NTITLELINES:
+	    return (GP_NTITLELINES(gp))
+	case G_FRAMECOLOR:
+	    return (GP_FRAMECOLOR(gp))
+	case G_ASPECT:
+	    return (GP_ASPECT(gp))
+
+	case G_CHARSIZE:
+	    # Return the current character size in NDC units.
+
+	    char_height = ggetr (gp, "ch")
+	    if (char_height < EPSILON)
+		char_height = DEF_CHARHEIGHT
+	    return (char_height * TX_SIZE(tx))
+
+	default:
+	    # The GLABAX parameters for the X and Y axes may be set separately
+	    # for each axis or simultaneously for both.  The parameter codes
+	    # are encoded as 100 (X only) 200 (Y only) or 300 (both) plus the
+	    # code for the field in the lower digits.
+
+	    if (param < FIRST_GLABAX_PARAM || param > LAST_GLABAX_PARAM)
+		call syserr (SYS_GSTAT)
+
+	    axes = param / 100
+	    field = mod (param, 100) + 300
+
+	    ax[1] = 0
+	    ax[2] = 0
+	    if (axes == 1 || axes == 3)
+		ax[1] = YES
+	    if (axes == 2 || axes == 3)
+		ax[2] = YES
+
+	    do i = 1, 2 {
+		if (ax[i] == YES) {
+		    if (i == 1)
+			p = GP_XAP(gp)
+		    else
+			p = GP_YAP(gp)
+
+		    switch (field) {
+		    case G_DRAWAXES:
+			return (GL_DRAWAXES(p))
+		    case G_SETAXISPOS:
+			return (GL_SETAXISPOS(p))
+		    case G_AXISPOS1:
+			return (GL_AXISPOS1(p))
+		    case G_AXISPOS2:
+			return (GL_AXISPOS2(p))
+		    case G_DRAWGRID:
+			return (GL_DRAWGRID(p))
+		    case G_GRIDCOLOR:
+			return (GL_GRIDCOLOR(p))
+		    case G_ROUND:
+			return (GL_ROUND(p))
+		    case G_LABELAXIS:
+			return (GL_LABELAXIS(p))
+		    case G_AXISLABELSIZE:
+			return (GL_AXISLABELSIZE(p))
+		    case G_AXISLABELCOLOR:
+			return (GL_AXISLABELCOLOR(p))
+		    case G_DRAWTICKS:
+			return (GL_DRAWTICKS(p))
+		    case G_LABELTICKS:
+			return (GL_LABELTICKS(p))
+		    case G_NMAJOR:
+			return (GL_NMAJOR(p))
+		    case G_NMINOR:
+			return (GL_NMINOR(p))
+		    case G_MAJORLENGTH:
+			return (GL_MAJORLENGTH(p))
+		    case G_MINORLENGTH:
+			return (GL_MINORLENGTH(p))
+		    case G_MAJORWIDTH:
+			return (GL_MAJORWIDTH(p))
+		    case G_MINORWIDTH:
+			return (GL_MINORWIDTH(p))
+		    case G_AXISWIDTH:
+			return (GL_AXISWIDTH(p))
+		    case G_AXISCOLOR:
+			return (GL_AXISCOLOR(p))
+		    case G_TICKLABELSIZE:
+			return (GL_TICKLABELSIZE(p))
+		    case G_TICKLABELCOLOR:
+			return (GL_TICKLABELCOLOR(p))
+		    case G_TICKCOLOR:
+			return (GL_TICKCOLOR(p))
+		    # case G_TICKFORMAT:
+			# not a real parameter
+		    default:
+			call syserr (SYS_GSTAT)
+		    }
+		}
+	    }
+	}
+end
diff --git a/sys/gio/gstats.x b/sys/gio/gstats.x
new file mode 100644
index 00000000..14fd7c35
--- /dev/null
+++ b/sys/gio/gstats.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<gset.h>
+include	<gio.h>
+
+# GSTATS -- Get the value of a string valued GIO parameter.
+
+int procedure gstats (gp, param, outstr, maxch)
+
+pointer	gp			# graphics descriptor
+int	param			# parmeter to be set
+char	outstr[ARB]		# output string
+int	maxch
+int	gstrcpy()
+
+int	i, value
+pointer	p[2]
+
+begin
+	p[1] = GP_XAP(gp)
+	p[2] = GP_XAP(gp)
+
+	switch (param) {
+	case G_XTICKFORMAT:
+	    return (gstrcpy (GL_TICKFORMAT(p[1]), value, maxch))
+	case G_YTICKFORMAT:
+	    return (gstrcpy (GL_TICKFORMAT(p[2]), value, maxch))
+	case G_TICKFORMAT:
+	    do i = 1, 2
+		return (gstrcpy (GL_TICKFORMAT(p[i]), value, maxch))
+	default:
+	    call syserr (SYS_GSTAT)
+	}
+end
diff --git a/sys/gio/gsview.x b/sys/gio/gsview.x
new file mode 100644
index 00000000..7ed83b31
--- /dev/null
+++ b/sys/gio/gsview.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GSVIEW -- Set the viewport of the current WCS.
+
+procedure gsview (gp, x1, x2, y1, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, x2			# range of NDC in X
+real	y1, y2			# range of NDC in Y
+pointer	w
+
+begin
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	WCS_SX1(w) = x1
+	WCS_SX2(w) = x2
+	WCS_SY1(w) = y1
+	WCS_SY2(w) = y2
+
+	WCS_FLAGS(w) = or (WCS_FLAGS(w), WF_DEFINED)
+	GP_WCSSTATE(gp) = MODIFIED
+	call gpl_reset()
+end
diff --git a/sys/gio/gswind.x b/sys/gio/gswind.x
new file mode 100644
index 00000000..81f7b6a3
--- /dev/null
+++ b/sys/gio/gswind.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GSWIND -- Set the window into world coordinates of the current WCS.
+
+procedure gswind (gp, x1, x2, y1, y2)
+
+pointer	gp			# graphics descriptor
+real	x1, x2			# range of world coords in X
+real	y1, y2			# range of world coords in Y
+pointer	w
+
+begin
+	call gpl_flush()
+	w = GP_WCSPTR (gp, GP_WCS(gp))
+
+	if (!IS_INDEF(x1))
+	    WCS_WX1(w) = x1
+	if (!IS_INDEF(x2))
+	    WCS_WX2(w) = x2
+	if (!IS_INDEF(y1))
+	    WCS_WY1(w) = y1
+	if (!IS_INDEF(y2))
+	    WCS_WY2(w) = y2
+
+	WCS_FLAGS(w) = or (WCS_FLAGS(w), WF_DEFINED)
+	GP_WCSSTATE(gp) = MODIFIED
+	call gpl_reset()
+end
diff --git a/sys/gio/gtext.x b/sys/gio/gtext.x
new file mode 100644
index 00000000..abb26ef4
--- /dev/null
+++ b/sys/gio/gtext.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+
+# GTEXT -- Draw text.  All textual output via GIO is via this primitive.  Unlike
+# polyline, polymarker, fill area, and cell array output, textual output is not
+# subjected to clipping by GIO.  Clipping may be performed at the kernel level
+# if a workstation viewport is defined.  Our task here is principally to parse
+# the format string and set up the text attributes, then insert the text drawing
+# instruction into the GKI instruction stream.  The real work of text generation
+# is very device dependent and is therefore left to the kernel.
+
+procedure gtext (gp, x, y, text, format)
+
+pointer	gp			# graphics descriptor
+real	x, y			# position at which text is to be drawn
+char	text[ARB]		# text to be drawn
+char	format[ARB]		# text drawing parameters
+
+int	ip, i
+real	mx, my
+pointer	sp, ap, tx
+bool	text_attributes_modified
+
+begin
+	call smark (sp)
+	call salloc (ap, LEN_TX, TY_STRUCT)
+
+	# Set up pointers to text attribute packets and initialize the
+	# new packet to the default values.  Two text attribute packets
+	# are maintained in GP: TXAP, the default packet, and TXAPCUR,
+	# the packet last sent to the device.  In what follows, AP is
+	# the new packet and TX is the packet last sent to the device.
+	# We start by initializing the new packet at AP to the default
+	# text drawing parameters.
+
+	call amovi (Memi[GP_TXAP(gp)], Memi[ap], LEN_TX)
+	tx = GP_TXAPCUR(gp)
+
+	# Parse the format string and set the text attributes.  The code is
+	# more general than need be, i.e., the entire attribute name string
+	# is extracted but only the first character is used.  Whitespace is
+	# permitted and ignored.
+
+	ip = 1
+	call gtxset (ap, format, ip)
+
+	# If the old text attribute packet was never fixed always fix the
+	# new packet, otherwise determine whether or not any text attributes
+	# were actually modified and only fix the new packet if it is
+	# different.
+
+	text_attributes_modified = false
+	for (i=2;  i <= LEN_TX;  i=i+1)
+	    if (Memi[ap+i-1] != Memi[tx+i-1]) {
+		text_attributes_modified = true
+		break
+	    }
+
+	# Flush any buffered polyline output, and transform the text coordinates
+	# to GKI device coordinates.
+
+	call gpl_flush()
+	call gpl_wcstogki (gp, x, y, mx, my)
+
+	# Update text attributes if necessary.
+	if (text_attributes_modified || TX_STATE(tx) != FIXED) {
+	    call amovi (Memi[ap], Memi[tx], LEN_TX)
+	    call gki_txset (GP_FD(gp), tx)
+	    TX_STATE(tx) = FIXED
+	}
+
+	# Output text drawing instruction.
+	call gki_text (GP_FD(gp), nint(mx), nint(my), text)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gtick.gx b/sys/gio/gtick.gx
new file mode 100644
index 00000000..157fae1e
--- /dev/null
+++ b/sys/gio/gtick.gx
@@ -0,0 +1,192 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# GTICK -- Determine the best number and placement of ticks for the interval
+# [x1:x2].  If log scaling is in use we try to put the ticks at positions which
+# are 1.0 times some power of ten, otherwise we divide the interval an integral
+# number of times and place the ticks at the interval boundaries.  The basic
+# algorithm is simple, but implementation is tricky due to the quirks of
+# floating point computations and the desire to have the algorithm work for all
+# X, and all ranges of X.  For example, we might want to plot a large range
+# near zero, or a small range where both X1 and X2 have a very large exponent.
+#
+# N.B.: this is a generic source; it may be preprocessed with the IRAF "generic"
+# preprocessor to produce either a single or double precision SPP source file.
+
+procedure gtick$t (x1, x2, rough_nticks, logflag, x_tick1, step)
+
+PIXEL	x1, x2			# range for which ticks are desired
+int	rough_nticks		# approximate number of ticks desired
+int	logflag			# nonzero if log scaling in use
+PIXEL	x_tick1			# x coord of first tick (output)
+PIXEL	step			# tick spacing along X (output)
+
+PIXEL	x, tol
+int	ndiv
+int	log
+#int	nticks
+int	expon
+PIXEL	gt_distance()
+
+begin
+	log = logflag
+	tol = EPSILON$T * 10.0
+
+	# If log, decrease ndiv until an x of 1.0 is obtained.  If an x of 1.0
+	# cannot be produced, repeat the calculation once more with ndiv fixed.
+
+	repeat {
+	    ndiv = max (1, rough_nticks - 1)
+
+	    repeat {
+		if (log == YES)
+		    x = 1.0
+		else
+		    x = abs ((x2 - x1) / ndiv)
+
+		# Scale approximate tick spacing to the range [1-10).  Select
+		# a logical tick spacing, given calculated and scaled spacing.
+
+		call fp_norm$t (x, x, expon)
+		if (x < 1.5)
+		    x = 1.0
+		else if (x < 2.5)
+		    x = 2.0
+		else if (x < 4.0)
+		    x = 2.5
+		else if (x < 7.5)
+		    x = 5.0
+		else {
+		    x = 1.0
+		    expon = expon + 1
+		}
+
+		# Calculate the first tick and the tick increment (step size).
+		if (log == YES)
+		    step = 1.0
+		else
+		    step = x * (10.0 ** expon)
+
+		if (gt_distance (x1, step, x_tick1) / step < tol)
+		    # x_tick1 = x1
+		else if (x1 < x2 && x_tick1 < x1)
+		    x_tick1 = x_tick1 + step
+		else if (x1 > x2 && x_tick1 > x1)
+		    x_tick1 = x_tick1 - step
+
+		if (x1 > x2)
+		    step = -step
+		ndiv = ndiv - 1
+
+	    } until (abs(abs(x) - 1.0) < tol || log == NO || ndiv == 0)
+
+	    # Terminate if not in log mode, if the tick separation is a power
+	    # of ten and there are ndivisions tick marks, or if the tick
+	    # separation is one magnitude and there are at least two tick marks
+	    # within the range x1:x2.
+
+		#    if (log == NO) {
+		#	return
+		#    } else if (step == 1.0 || x == 1.0) {
+		#	if (step == 1.0)
+		#	    nticks = 1
+		#	else
+		#	    nticks = max (2, rough_nticks - 1)
+
+		#	if (x1 > x2 && x_tick1 + nticks * step >= x2)
+		#	    return
+		#	else if (x1 < x2 && x_tick1 + nticks * step <= x2)
+		#	    return
+		#	else
+		#	    log = NO
+		#    } else
+		#	log = NO
+
+	    return
+	}
+end
+
+
+# GT_NDIGITS -- Calculate the number of digits of precision needed to label
+# ticks in the range x1 to x2 (i.e., if x1=100000 and x2=100001, 7 digits
+# will be required, whereas in many cases 1 or 2 is enough).
+
+int procedure gt_ndigits (x1, x2, step)
+
+PIXEL	x1, x2			# range covered by numbers
+PIXEL	step			# tick separation
+PIXEL	ratio
+int	n
+
+begin
+	if (x1 == x2)
+	    n = 2
+	else {
+	    ratio = abs ((x1+x2) / (x1-x2)) 
+	    n = log10 (max (1.0, ratio)) + 2.0
+	}
+
+	return (n)
+end
+
+
+# GT_LINEARITY -- The following function returns a large number if there is
+# little difference between a log scale and a linear scale for the range X1
+# to X2.  if the linearity of the interval is large, there is no point in
+# using a logarithmic scale.
+
+PIXEL procedure gt_linearity (x1, x2)
+
+PIXEL	x1, x2
+PIXEL	linearity, difflog
+PIXEL	elog$t()
+
+begin
+	if (x1 <= 0 || x2 <= 0)
+	    difflog = abs (elog$t(x1) - elog$t(x2))
+	else
+	    difflog = abs (log10(x1) - log10(x2))
+
+	if (difflog == 0.0)
+	    linearity = 1E10
+	else
+	    linearity =  1.0 / difflog
+
+	return (linearity)
+end
+
+
+# GT_DISTANCE -- Compute the distance of X from the nearest integral multiple
+# of "step".
+
+PIXEL procedure gt_distance (x, step, nearest_tick)
+
+PIXEL	x			# number to be tested
+PIXEL	step			# tick separation
+PIXEL	nearest_tick		# X coord of tick nearest X
+
+PIXEL	ltick, rtick, absx
+PIXEL	fp_fix$t()
+
+begin
+	absx = abs (x)
+
+	ltick = fp_fix$t (absx / step) * step
+	rtick = ltick + step
+
+	if (abs(absx - ltick) < abs(rtick - absx)) {
+	    if (x < 0)
+		nearest_tick = -ltick
+	    else
+		nearest_tick = ltick
+	    return (absx - ltick)
+
+	} else {
+	    if (x < 0)
+		nearest_tick = -rtick
+	    else
+		nearest_tick = rtick
+	    return (rtick - absx)
+	}
+end
diff --git a/sys/gio/gtickr.x b/sys/gio/gtickr.x
new file mode 100644
index 00000000..cd227363
--- /dev/null
+++ b/sys/gio/gtickr.x
@@ -0,0 +1,192 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# GTICK -- Determine the best number and placement of ticks for the interval
+# [x1:x2].  If log scaling is in use we try to put the ticks at positions which
+# are 1.0 times some power of ten, otherwise we divide the interval an integral
+# number of times and place the ticks at the interval boundaries.  The basic
+# algorithm is simple, but implementation is tricky due to the quirks of
+# floating point computations and the desire to have the algorithm work for all
+# X, and all ranges of X.  For example, we might want to plot a large range
+# near zero, or a small range where both X1 and X2 have a very large exponent.
+#
+# N.B.: this is a generic source; it may be preprocessed with the IRAF "generic"
+# preprocessor to produce either a single or double precision SPP source file.
+
+procedure gtickr (x1, x2, rough_nticks, logflag, x_tick1, step)
+
+real	x1, x2			# range for which ticks are desired
+int	rough_nticks		# approximate number of ticks desired
+int	logflag			# nonzero if log scaling in use
+real	x_tick1			# x coord of first tick (output)
+real	step			# tick spacing along X (output)
+
+real	x, tol
+int	ndiv
+int	log
+#int	nticks
+int	expon
+real	gt_distance()
+
+begin
+	log = logflag
+	tol = EPSILONR * 10.0
+
+	# If log, decrease ndiv until an x of 1.0 is obtained.  If an x of 1.0
+	# cannot be produced, repeat the calculation once more with ndiv fixed.
+
+	repeat {
+	    ndiv = max (1, rough_nticks - 1)
+
+	    repeat {
+		if (log == YES)
+		    x = 1.0
+		else
+		    x = abs ((x2 - x1) / ndiv)
+
+		# Scale approximate tick spacing to the range [1-10).  Select
+		# a logical tick spacing, given calculated and scaled spacing.
+
+		call fp_normr (x, x, expon)
+		if (x < 1.5)
+		    x = 1.0
+		else if (x < 2.5)
+		    x = 2.0
+		else if (x < 4.0)
+		    x = 2.5
+		else if (x < 7.5)
+		    x = 5.0
+		else {
+		    x = 1.0
+		    expon = expon + 1
+		}
+
+		# Calculate the first tick and the tick increment (step size).
+		if (log == YES)
+		    step = 1.0
+		else
+		    step = x * (10.0 ** expon)
+
+		if (gt_distance (x1, step, x_tick1) / step < tol)
+		    # x_tick1 = x1
+		else if (x1 < x2 && x_tick1 < x1)
+		    x_tick1 = x_tick1 + step
+		else if (x1 > x2 && x_tick1 > x1)
+		    x_tick1 = x_tick1 - step
+
+		if (x1 > x2)
+		    step = -step
+		ndiv = ndiv - 1
+
+	    } until (abs(abs(x) - 1.0) < tol || log == NO || ndiv == 0)
+
+	    # Terminate if not in log mode, if the tick separation is a power
+	    # of ten and there are ndivisions tick marks, or if the tick
+	    # separation is one magnitude and there are at least two tick marks
+	    # within the range x1:x2.
+
+		#    if (log == NO) {
+		#	return
+		#    } else if (step == 1.0 || x == 1.0) {
+		#	if (step == 1.0)
+		#	    nticks = 1
+		#	else
+		#	    nticks = max (2, rough_nticks - 1)
+
+		#	if (x1 > x2 && x_tick1 + nticks * step >= x2)
+		#	    return
+		#	else if (x1 < x2 && x_tick1 + nticks * step <= x2)
+		#	    return
+		#	else
+		#	    log = NO
+		#    } else
+		#	log = NO
+
+	    return
+	}
+end
+
+
+# GT_NDIGITS -- Calculate the number of digits of precision needed to label
+# ticks in the range x1 to x2 (i.e., if x1=100000 and x2=100001, 7 digits
+# will be required, whereas in many cases 1 or 2 is enough).
+
+int procedure gt_ndigits (x1, x2, step)
+
+real	x1, x2			# range covered by numbers
+real	step			# tick separation
+real	ratio
+int	n
+
+begin
+	if (x1 == x2)
+	    n = 2
+	else {
+	    ratio = abs ((x1+x2) / (x1-x2)) 
+	    n = log10 (max (1.0, ratio)) + 2.0
+	}
+
+	return (n)
+end
+
+
+# GT_LINEARITY -- The following function returns a large number if there is
+# little difference between a log scale and a linear scale for the range X1
+# to X2.  if the linearity of the interval is large, there is no point in
+# using a logarithmic scale.
+
+real procedure gt_linearity (x1, x2)
+
+real	x1, x2
+real	linearity, difflog
+real	elogr()
+
+begin
+	if (x1 <= 0 || x2 <= 0)
+	    difflog = abs (elogr(x1) - elogr(x2))
+	else
+	    difflog = abs (log10(x1) - log10(x2))
+
+	if (difflog == 0.0)
+	    linearity = 1E10
+	else
+	    linearity =  1.0 / difflog
+
+	return (linearity)
+end
+
+
+# GT_DISTANCE -- Compute the distance of X from the nearest integral multiple
+# of "step".
+
+real procedure gt_distance (x, step, nearest_tick)
+
+real	x			# number to be tested
+real	step			# tick separation
+real	nearest_tick		# X coord of tick nearest X
+
+real	ltick, rtick, absx
+real	fp_fixr()
+
+begin
+	absx = abs (x)
+
+	ltick = fp_fixr (absx / step) * step
+	rtick = ltick + step
+
+	if (abs(absx - ltick) < abs(rtick - absx)) {
+	    if (x < 0)
+		nearest_tick = -ltick
+	    else
+		nearest_tick = ltick
+	    return (absx - ltick)
+
+	} else {
+	    if (x < 0)
+		nearest_tick = -rtick
+	    else
+		nearest_tick = rtick
+	    return (rtick - absx)
+	}
+end
diff --git a/sys/gio/gtxset.x b/sys/gio/gtxset.x
new file mode 100644
index 00000000..de386a69
--- /dev/null
+++ b/sys/gio/gtxset.x
@@ -0,0 +1,144 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<gset.h>
+include	<gio.h>
+
+define	MAXCH	15
+
+# GTXSET -- Parse a text drawing format string and set the values of the text
+# attributes in the TX output structure.
+
+procedure gtxset (tx, format, ip)
+
+pointer	tx			# text attribute structure
+char	format[ARB]		# text attribute format string
+int	ip			# pointer into format string
+
+char	attribute[MAXCH], value[MAXCH]
+int	op, tip, temp, ch
+int	h_v[4], v_v[4], f_v[4], q_v[4], p_v[4]
+int	ctoi(), ctor(), stridx()
+define	badformat_ 91
+
+string	h_c	"nclr"
+data	h_v	/GT_NORMAL,	GT_CENTER,	GT_LEFT,	GT_RIGHT/
+string	v_c	"nctb"
+data	v_v	/GT_NORMAL,	GT_CENTER,	GT_TOP,		GT_BOTTOM/
+string	f_c	"rgib"
+data	f_v	/GT_ROMAN,	GT_GREEK,	GT_ITALIC,	GT_BOLD/
+string	q_c	"nlmh"
+data	q_v	/GT_NORMAL,	GT_LOW,		GT_MEDIUM,	GT_HIGH/
+string	p_c	"lrud"
+data	p_v	/GT_LEFT,	GT_RIGHT,	GT_UP,		GT_DOWN/
+
+begin
+	# Parse the format string and set the text attributes.  The code is
+	# more general than need be, i.e., the entire attribute name string
+	# is extracted but only the first character is used.  Whitespace is
+	# permitted and ignored.
+
+	for (;  format[ip] != EOS;  ip=ip+1) {
+	    # Extract the next "attribute=value" construct.
+	    while (IS_WHITE (format[ip]))
+		ip = ip +1
+
+	    op = 1
+	    for (ch=format[ip];  ch != EOS && ch != '=';  ch=format[ip]) {
+		if (op <= MAXCH) {
+		    attribute[op] = format[ip]
+		    op = op + 1
+		}
+		ip = ip + 1
+	    }
+	    attribute[op] = EOS
+
+	    if (ch == '=')
+		ip = ip + 1
+
+	    op = 1
+	    while (IS_WHITE (format[ip]))
+		ip = ip +1
+	    ch = format[ip]
+	    while (ch != EOS && ch != ';' && ch != ',') {
+		if (op <= MAXCH) {
+		    value[op] = format[ip]
+		    op = op + 1
+		}
+		ip = ip + 1
+		ch = format[ip]
+	    }
+	    value[op] = EOS
+
+	    if (attribute[1] == EOS || value[1] == EOS)
+		break
+
+	    # Decode the assignment and set the corresponding text attribute
+	    # in the graphics descriptor.
+
+	    switch (attribute[1]) {
+	    case 'u':				# character up vector
+		tip = 1
+		if (ctoi (value, tip, TX_UP(tx)) <= 0) {
+		    TX_UP(tx) = 90
+		    goto badformat_
+		}
+
+	    case 'p':				# path
+		temp = stridx (value[1], p_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_PATH(tx) = p_v[temp]
+
+	    case 'c':				# color
+		tip = 1
+		if (ctoi (value, tip, TX_COLOR(tx)) <= 0) {
+		    TX_COLOR(tx) = 1
+		    goto badformat_
+		}
+
+	    case 's':				# character size scale factor
+		tip = 1
+		if (ctor (value, tip, TX_SIZE(tx)) <= 0) {
+		    TX_SIZE(tx) = 1.0
+		    goto badformat_
+		}
+
+	    case 'h':				# horizontal justification
+		temp = stridx (value[1], h_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_HJUSTIFY(tx) = h_v[temp]
+
+	    case 'v':				# vertical justification
+		temp = stridx (value[1], v_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_VJUSTIFY(tx) = v_v[temp]
+
+	    case 'f':				# font
+		temp = stridx (value[1], f_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_FONT(tx) = f_v[temp]
+		
+	    case 'q':				# font quality
+		temp = stridx (value[1], q_c)
+		if (temp <= 0)
+		    goto badformat_
+		else
+		    TX_QUALITY(tx) = q_v[temp]
+
+	    default:
+badformat_	call eprintf ("Warning (GIO): bad gtext format '%s'\n")
+		    call pargstr (format)
+	    }
+
+	    if (format[ip] == EOS)
+		break
+	}
+end
diff --git a/sys/gio/gumark.x b/sys/gio/gumark.x
new file mode 100644
index 00000000..cafb42bc
--- /dev/null
+++ b/sys/gio/gumark.x
@@ -0,0 +1,108 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gio.h>
+
+# GUMARK -- Draw a user defined mark.  The mark is defined by the polygon
+# (x[i],y[i], i=1,npts), normalized to the unit square.  This mark is mapped
+# into the window at (XCEN,YCEN) of size XSIZE, YSIZE, where the mark center
+# is always given in world coordinates but the size may be given in any of a
+# number of ways, independently in X and Y.
+
+procedure gumark (gp, x, y, npts, xcen, ycen, xsize, ysize, fill)
+
+pointer	gp			# graphics descriptor
+real	x[ARB]			# X coordinates of marker polygon (unit square)
+real	y[ARB]			# Y coordinates of marker polygon (unit square)
+int	npts			# number of points in marker polygon
+real	xcen, ycen		# world coordinates of center of marker
+real	xsize, ysize		# marker size in X and Y
+int	fill			# draw marker using area fill
+
+pointer	plap, pmap
+bool	scale_unset
+int	save_linetype, index, i
+real	x1, y1, xs, ys, dx, dy
+real	size[2], ndc_size[2], wcs_size[2]
+
+begin
+	plap = GP_PLAP(gp)
+	pmap = GP_PMAP(gp)
+
+	# Determine the marker size in world coordinates.  Marksizes 1:4 are
+	# "standard size" markers.  A marksize of [0-1) is an explicit marker
+	# size in NDC coordinates, while a negative marksize is an explicit
+	# marker size in world coordinates.
+
+	size[1] = xsize
+	size[2] = ysize
+	scale_unset = true
+
+	do i = 1, 2
+	    if (size[i] > 0) {
+		if (size[i] - 1.0 > -EPSILON) {
+		    # Use a default marker size.
+		    index = min (MAX_SZMARKER, int(size[i]))
+		    ndc_size[i] = GP_SZMARKER (gp, index)
+
+		    # Correct for the aspect ratio.
+		    if (i == 1)
+			ndc_size[1] = ndc_size[1] * GP_DEVASPECT(gp)
+		} else
+		    ndc_size[i] = size[i]
+
+		# Convert to size in world coords.
+		if (scale_unset) {
+		    # Get the scale in wcs units per ndc unit at (x,y).
+		    call ggscale (gp, xcen, ycen, dx, dy)
+		    scale_unset = false
+		}
+		if (i == 1)
+		    wcs_size[1] = ndc_size[1] * abs(dx)
+		else
+		    wcs_size[2] = ndc_size[2] * abs(dy)
+
+	    } else
+		wcs_size[i] = -size[i]
+
+	# Set fill area instruction type if filling, otherwise set linetype
+	# if marker will be drawn as a polyline.  Do nothing if polymarker
+	# linetype is same as polyline linetype.
+
+	if (fill == YES)
+	    call gpl_settype (gp, FILLAREA)
+	else {
+	    save_linetype = PL_LTYPE(plap)
+	    if (save_linetype != PM_LTYPE(pmap)) {
+		call gpl_flush()
+		PL_LTYPE(plap) = PM_LTYPE(pmap)
+		PL_STATE(plap) = MODIFIED
+	    }
+	}
+
+	# Draw the marker, scaling as necessary to fit the mark window.  Final
+	# mark need not have the same aspect ratio as the normalized mark.
+	# Leave the pen positioned to the center of the marker.
+
+	xs = wcs_size[1]
+	ys = wcs_size[2]
+	x1 = xcen - (xs / 2.0)
+	y1 = ycen - (ys / 2.0)
+
+	call gamove (gp, x[1] * xs + x1, y[1] * ys + y1)
+	do i = 2, npts
+	    call gadraw (gp, x[i] * xs + x1, y[i] * ys + y1)
+	call gamove (gp, xcen, ycen)
+
+	# If the polyline linetype was modified restore the original value.
+	# Do not need to do anything if polymarker linetype was same as
+	# polyline linetype.
+
+	if (fill == YES)
+	    call gpl_settype (gp, POLYLINE)
+	else if (save_linetype != PM_LTYPE(pmap)) {
+	    call gpl_flush()
+	    PL_LTYPE(plap) = save_linetype
+	    PL_STATE(plap) = MODIFIED
+	}
+end
diff --git a/sys/gio/gvline.x b/sys/gio/gvline.x
new file mode 100644
index 00000000..929fab44
--- /dev/null
+++ b/sys/gio/gvline.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GVLINE -- Vector polyline.  Draw a line connecting the points (X[i],V[i]),
+# where the X[i] are evenly distributed from X1 to X2.
+
+procedure gvline (gp, v, npts, x1, x2)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# Y coordinates of the polyline
+int	npts			# number of polyline points
+real	x1, x2			# range of X coordinates of the polyline
+
+int	i
+real	dx
+
+begin
+	if (npts > 1) {
+	    dx = (x2 - x1) / (npts - 1)
+	    call gamove (gp, x1, v[1])
+	    do i = 2, npts
+		call gadraw (gp, (i-1) * dx + x1, v[i])
+	}
+end
diff --git a/sys/gio/gvmark.x b/sys/gio/gvmark.x
new file mode 100644
index 00000000..219f8bae
--- /dev/null
+++ b/sys/gio/gvmark.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+
+# GVMARK -- Vector polymarker.  Output at sequence of markers at the vertices
+# of a polygon, all markers the same type and size.  The polygon is given by
+# the set of points (X[i],V[i]), where the X[i] are evenly distributed from X1
+# to X2.  The marker type GM_POINT is a special case.
+
+procedure gvmark (gp, v, npts, x1, x2, marktype, xsize, ysize)
+
+pointer	gp			# graphics descriptor
+real	v[ARB]			# Y[i] polygon
+int	npts			# number of points
+real	x1, x2			# range of X[i]
+int	marktype		# marker type
+real	xsize, ysize		# marker size
+
+int	i
+real	dx
+
+begin
+	if (npts > 1)
+	    if (marktype == GM_POINT) {
+		call gpl_settype (gp, POLYMARKER)
+		call gvline (gp, v, npts, x1, x2)
+		call gpl_settype (gp, POLYLINE)
+	    } else {
+		dx = (x2 - x1) / (npts - 1)
+		do i = 1, npts
+		    call gmark (gp, (i-1) * dx + x1, v[i], marktype,
+			xsize, ysize)
+	    }
+end
diff --git a/sys/gio/imdkern/README b/sys/gio/imdkern/README
new file mode 100644
index 00000000..da041be0
--- /dev/null
+++ b/sys/gio/imdkern/README
@@ -0,0 +1,85 @@
+IMDKERN -
+
+This directory contains the source for the simple GIO/IMD kernel, used to
+draw graphics in a display frame buffer.  It uses the data stream
+interface to open the frame buffer and uses code from SGI to rasterize
+the graphics.
+
+Special graphcap entries used by this kernel:
+
+	CI	Color index of graphics pixels
+	FN	Display frame buffer
+	LO	Width in pixels of line size 1.0
+	LS	Difference in pixels between line sizes
+	DB	Print debug messages?
+
+
+Revision notes...
+----------------
+IMDKERN notes		20 December 1989	Z. G. Levay, STScI
+
+
+  o Make private copy idskern of gio/sgikern.
+
+  o Change "sgi" filename and procedure prefixes to "imd" throughout
+    the code.  Change sgk.x to idk.x.  Changed imd_open to imd_fopen to
+    aviod conflict with a procedure in libds.  The files are:
+
+    font.com, font.h, idk.com, idk.h, idk.x, imd.com, imd.h,
+    imdcancel.x, imdclear.x, imdclose.x, imdclws.x, imdcolor.x,
+    imddrawch.x, imdescape.x, imdfa.x, imdfaset.x, imdflush.x,
+    imdfont.x, imdfopen.x, imdgcell.x, imdinit.x, imdipl.x,
+    imdkern.par, imdline.x, imdopenws.x, imdpcell.x, imdpl.x,
+    imdplset.x, imdpm.x, imdpmset.x, imdreset.x, imdtx.x, imdtxset.x,
+    ltype.dat, mkpkg, t_imdkern.x, x_imdkern.x,
+
+  o Modify mkpkg to build the task locally without updating the system
+    library or install the task.
+
+  o Add global parameters "frame" and "color" to task imdkern.
+    Modified imd_fopen to read task parameters and pass as arguments to
+    imd_openws.  Added these parameters to imd_openws and the call to
+    idk_open.
+
+  o In idk_open, added frame and color to the calling sequence.  Added
+    a call to imd_mapframe to open the frame buffer as an image,
+    changed setting the bitmap size to use the frame buffer size (via
+    IMIO) instead of graphcap parameters.  Set the bits per bitmap word
+    to 8.  Set the maximum bitmap size to 2048x2048 pixels.  Ripped out
+    the code for opening the SGI metacode file, DD string manipulation,
+    etc.  Added ttygeti calls to read the frame and color from the
+    graphcap in case they were passed as INDEF.
+
+    In idk_frame, changed the code to map an input and output section
+    of the frame buffer (via IMIO), read the bitmap line by line,
+    testing each word for any on bits, and writing the color index
+    value to the frame buffer pixel for each on bitmap bit.  Set the
+    I/O buffer sizes to 64 lines (somewhat arbitrarily).
+
+    In idk_open, Changed the code to compute the x and y max (right and
+    top edges) of the bitmap by one pixel to draw to the edge.  In
+    idk_linewidth, changed the code to compute the gap at the frame
+    edges by one pixel.
+
+    Removed sections of code dealing with non-bitmap format, rotated or
+    flipped bitmaps.
+
+
+----------------
+Installation and checkout.  (12/21/89 dct)
+
+Installed code in gio/imdkern.
+Put hooks for new task IMDKERN in the PLOT package.
+Moved imdkern.par to plot, moved frame,color params to after "generic".
+Deleted file imdipl.x, identical to imdpl.x.
+Renamed imdfopen.x to imdopen.x for consistency with other kernels;
+    changed procedure name to imd_opendev to avoid name collision with imdopen.
+Deleted idk.h, contains only SGI metecode defs not used in idk.x.
+In t_imdkern.x, moved the clgeti's for color,frame to after the clgeti for
+    "generic" (required by startup protocol for graphics subkernel).  For the
+    generic case, added initializers to set values to -1 to flag not set.
+    Got rid of the IS_INDEFs in idk.x.  Nothing wrong with these, I just try
+    to avoid using INDEF in low level system code.
+mkpkg - link xx_imdkern.e, not x_imdkern.e, rename in the install (this is
+    necessary to permit local testing of new versions, else the installed BIN
+    version is used).
diff --git a/sys/gio/imdkern/font.com b/sys/gio/imdkern/font.com
new file mode 100644
index 00000000..ec1b0ec9
--- /dev/null
+++ b/sys/gio/imdkern/font.com
@@ -0,0 +1,207 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each character
+# is encoded as a series of strokes.  Each stroke is expressed by a single
+# integer containing the following bitfields:
+#
+#	2                   1
+#	0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 
+#	          | | | |         | |         |
+#		  | | | +---------+ +---------+
+#		  | | |      |           |
+#		  | | |      X           Y
+#		  | | |
+#	          | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#------------------------------------------------------------------------------
+
+# Define the database.
+
+short	chridx[96]		# character index in chrtab
+short	chrtab[800]		# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP).
+
+data    (chridx(i), i=01,05) /   1,   3,  12,  21,  30/
+data    (chridx(i), i=06,10) /  45,  66,  79,  85,  92/
+data    (chridx(i), i=11,15) /  99, 106, 111, 118, 121/
+data    (chridx(i), i=16,20) / 128, 131, 141, 145, 154/
+data    (chridx(i), i=21,25) / 168, 177, 187, 199, 203/
+data    (chridx(i), i=26,30) / 221, 233, 246, 259, 263/
+data    (chridx(i), i=31,35) / 268, 272, 287, 307, 314/
+data    (chridx(i), i=36,40) / 327, 336, 344, 352, 359/
+data    (chridx(i), i=41,45) / 371, 378, 385, 391, 398/
+data    (chridx(i), i=46,50) / 402, 408, 413, 425, 433/
+data    (chridx(i), i=51,55) / 445, 455, 468, 473, 480/
+data    (chridx(i), i=56,60) / 484, 490, 495, 501, 506/
+data    (chridx(i), i=61,65) / 511, 514, 519, 523, 526/
+data    (chridx(i), i=66,70) / 529, 543, 554, 563, 574/
+data    (chridx(i), i=71,75) / 585, 593, 607, 615, 625/
+data    (chridx(i), i=76,80) / 638, 645, 650, 663, 671/
+data    (chridx(i), i=81,85) / 681, 692, 703, 710, 723/
+data    (chridx(i), i=86,90) / 731, 739, 743, 749, 754/
+data    (chridx(i), i=91,95) / 759, 764, 776, 781, 793/
+data    (chridx(i), i=96,96) / 801/
+
+# Stroke data.
+
+data	(chrtab(i), i=001,005) /    36,  1764,   675, 29328,   585/
+data	(chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/
+data	(chrtab(i), i=011,015) /  1764,   355, 29023,   351, 29027/
+data	(chrtab(i), i=016,020) /   931, 29599,   927, 29603,  1764/
+data	(chrtab(i), i=021,025) /   603, 29066,   842, 29723,  1302/
+data	(chrtab(i), i=026,030) / 28886,   143, 29839,  1764,   611/
+data	(chrtab(i), i=031,035) / 29256,    78, 20810, 21322, 21581/
+data	(chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/
+data	(chrtab(i), i=041,045) / 20833, 21345, 29789,  1764,   419/
+data	(chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/
+data	(chrtab(i), i=051,055) / 21022, 21025, 20899,  1187, 28744/
+data	(chrtab(i), i=056,060) /   717, 21194, 21320, 21512, 21642/
+data	(chrtab(i), i=061,065) / 21645, 21519, 21327, 21197,  1764/
+data	(chrtab(i), i=066,070) /  1160, 20700, 20704, 20835, 21027/
+data	(chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/
+data	(chrtab(i), i=076,080) / 21192, 29841,  1764,   611, 21023/
+data	(chrtab(i), i=081,085) / 21087, 21155, 21091,  1764,   739/
+data	(chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/
+data	(chrtab(i), i=091,095) /  1764,   547, 21151, 21210, 21201/
+data	(chrtab(i), i=096,100) / 21132, 29192,  1764,    93, 29774/
+data	(chrtab(i), i=101,105) /   608, 29259,    78, 29789,  1764/
+data	(chrtab(i), i=106,110) /   604, 29260,    84, 29780,  1764/
+data	(chrtab(i), i=111,115) /   516, 21062, 21065, 21001, 21000/
+data	(chrtab(i), i=116,120) / 21064,  1764,    84, 29780,  1764/
+data	(chrtab(i), i=121,125) /   585, 21063, 21191, 21193, 21065/
+data	(chrtab(i), i=126,130) / 21191,  1764,    72, 29859,  1764/
+data	(chrtab(i), i=131,135) /   419, 20573, 20558, 20872, 21320/
+data	(chrtab(i), i=136,140) / 21646, 21661, 21347, 20899,  1764/
+data	(chrtab(i), i=141,145) /   221, 21155, 29320,  1764,    95/
+data	(chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/
+data	(chrtab(i), i=151,155) / 20552, 29832,  1764,    95, 20899/
+data	(chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/
+data	(chrtab(i), i=161,165) /   854,  5266, 21644, 21320, 20872/
+data	(chrtab(i), i=166,170) / 28749,  1764,   904, 21411, 21283/
+data	(chrtab(i), i=171,175) / 20561, 20559, 21391,   911, 13455/
+data	(chrtab(i), i=176,180) /  1764,   136, 21320, 21645, 21652/
+data	(chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/
+data	(chrtab(i), i=186,190) /  1764,    83, 20888, 21336, 21651/
+data	(chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/
+data	(chrtab(i), i=196,200) / 20635, 29347,  1764,    99, 21667/
+data	(chrtab(i), i=201,205) / 29064,  1764,   355, 20575, 20570/
+data	(chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/
+data	(chrtab(i), i=211,215) / 21644, 21650, 21398, 20822,   918/
+data	(chrtab(i), i=216,220) /  5274, 21663, 21411, 20835,  1764/
+data	(chrtab(i), i=221,225) /   648, 21584, 21656, 21662, 21347/
+data	(chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/
+data	(chrtab(i), i=231,235) / 21656,  1764,   602, 21210, 21207/
+data	(chrtab(i), i=236,240) / 21079, 21082, 21207,   592, 21069/
+data	(chrtab(i), i=241,245) / 21197, 21200, 21072, 21197,  1764/
+data	(chrtab(i), i=246,250) /   602, 21146, 21143, 21079, 21082/
+data	(chrtab(i), i=251,255) / 21143,   585, 21132, 21136, 21072/
+data	(chrtab(i), i=256,260) / 21071, 21135,  1764,   988, 20628/
+data	(chrtab(i), i=261,265) / 29644,  1764,  1112, 28824,   144/
+data	(chrtab(i), i=266,270) / 29776,  1764,   156, 21460, 28812/
+data	(chrtab(i), i=271,275) /  1764,   221, 20704, 20899, 21218/
+data	(chrtab(i), i=276,280) / 21471, 21466, 21011, 21007,   521/
+data	(chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/
+data	(chrtab(i), i=286,290) /  1764,   908, 20812, 20560, 20571/
+data	(chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/
+data	(chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/
+data	(chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/
+data	(chrtab(i), i=306,310) /  1764,    72, 20963, 21219, 29768/
+data	(chrtab(i), i=311,315) /   210,  5074,  1764,    99, 21411/
+data	(chrtab(i), i=316,320) / 21663, 21658, 21398, 20566,   918/
+data	(chrtab(i), i=321,325) /  5266, 21644, 21384, 20552, 20579/
+data	(chrtab(i), i=326,330) /  1764,  1165, 21320, 20872, 20557/
+data	(chrtab(i), i=331,335) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=336,340) /    99, 21347, 21662, 21645, 21320/
+data	(chrtab(i), i=341,345) / 20552, 20579,  1764,    99, 20552/
+data	(chrtab(i), i=346,350) / 29832,    86, 13078,    99, 29859/
+data	(chrtab(i), i=351,355) /  1764,    99, 20552,    86, 13078/
+data	(chrtab(i), i=356,360) /    99, 29859,  1764,   722, 21650/
+data	(chrtab(i), i=361,365) / 29832,  1165,  4936, 20872, 20557/
+data	(chrtab(i), i=366,370) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=371,375) /    99, 28744,    85,  5269,  1160/
+data	(chrtab(i), i=376,380) / 29859,  1764,   291, 29603,   611/
+data	(chrtab(i), i=381,385) /  4680,   328, 29576,  1764,    77/
+data	(chrtab(i), i=386,390) / 20872, 21256, 21581, 29795,  1764/
+data	(chrtab(i), i=391,395) /    99, 28744,  1160, 20887,    82/
+data	(chrtab(i), i=396,400) / 13475,  1764,    99, 20552, 29832/
+data	(chrtab(i), i=401,405) /  1764,    72, 20579, 21077, 21603/
+data	(chrtab(i), i=406,410) / 29768,  1764,    72, 20579, 21640/
+data	(chrtab(i), i=411,415) / 29859,  1764,    94, 20899, 21347/
+data	(chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/
+data	(chrtab(i), i=421,425) / 20574,   862, 29859,  1764,    72/
+data	(chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/
+data	(chrtab(i), i=431,435) / 20564,  1764,    94, 20557, 20872/
+data	(chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/
+data	(chrtab(i), i=441,445) / 20574,   536, 29828,  1764,    72/
+data	(chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/
+data	(chrtab(i), i=451,455) / 20566,   918, 13448,  1764,    76/
+data	(chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/
+data	(chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/
+data	(chrtab(i), i=466,470) / 29855,  1764,   648, 21155,    99/
+data	(chrtab(i), i=471,475) / 29923,  1764,    99, 20557, 20872/
+data	(chrtab(i), i=476,480) / 21320, 21645, 29859,  1764,    99/
+data	(chrtab(i), i=481,485) / 21064, 29795,  1764,    99, 20808/
+data	(chrtab(i), i=486,490) / 21141, 21448, 29923,  1764,    99/
+data	(chrtab(i), i=491,495) / 29832,    72, 29859,  1764,    99/
+data	(chrtab(i), i=496,500) / 21079, 29256,   599, 13411,  1764/
+data	(chrtab(i), i=501,505) /    99, 21667, 20552, 29832,  1764/
+data	(chrtab(i), i=506,510) /   805, 20965, 20935, 29447,  1764/
+data	(chrtab(i), i=511,515) /    99, 29832,  1764,   421, 21221/
+data	(chrtab(i), i=516,520) / 21191, 29063,  1764,   288, 21091/
+data	(chrtab(i), i=521,525) / 29600,  1764,     3, 29891,  1764/
+data	(chrtab(i), i=526,530) /   547, 29341,  1764,   279, 21207/
+data	(chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/
+data	(chrtab(i), i=536,540) / 20558, 20753, 21201, 21391,   907/
+data	(chrtab(i), i=541,545) / 13447,  1764,    99, 28744,    76/
+data	(chrtab(i), i=546,550) /  4424, 21256, 21516, 21523, 21271/
+data	(chrtab(i), i=551,555) / 20823, 20563,  1764,   981, 21271/
+data	(chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/
+data	(chrtab(i), i=561,565) / 29642,  1764,  1043,  4887, 20823/
+data	(chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=571,575) /  1032, 29731,  1764,    80,  5136/
+data	(chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/
+data	(chrtab(i), i=581,585) / 20808, 21256, 29707,  1764,   215/
+data	(chrtab(i), i=586,590) / 29591,   456, 20958, 21153, 21409/
+data	(chrtab(i), i=591,595) / 29727,  1764,    67, 20800, 21248/
+data	(chrtab(i), i=596,600) / 21508, 29719,  1043, 21271, 20823/
+data	(chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=606,610) /  1764,    99, 28744,    83,  4439/
+data	(chrtab(i), i=611,615) / 21271, 21523, 29704,  1764,   541/
+data	(chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=621,625) /   533, 21077, 29256,  1764,   541/
+data	(chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=631,635) /   533, 21077, 21058, 20928, 20736/
+data	(chrtab(i), i=636,640) / 28802,  1764,    99, 28744,    84/
+data	(chrtab(i), i=641,645) / 29530,   342, 13320,  1764,   483/
+data	(chrtab(i), i=646,650) / 21089, 21066, 29384,  1764,    87/
+data	(chrtab(i), i=651,655) / 28744,   584, 21076,    84,  4375/
+data	(chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/
+data	(chrtab(i), i=661,665) / 29768,  1764,    87, 28744,    83/
+data	(chrtab(i), i=666,670) / 20823, 21271, 21523, 29704,  1764/
+data	(chrtab(i), i=671,675) /    83, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=676,680) / 21523, 21271, 20823, 20563,  1764/
+data	(chrtab(i), i=681,685) /    87, 28736,    83, 20823, 21271/
+data	(chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/
+data	(chrtab(i), i=691,695) /  1764,  1047, 29696,  1036, 21256/
+data	(chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/
+data	(chrtab(i), i=701,705) / 21523,  1764,    87, 28744,    83/
+data	(chrtab(i), i=706,710) / 20823, 21271, 29716,  1764,    74/
+data	(chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/
+data	(chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/
+data	(chrtab(i), i=721,725) / 21461,  1764,   279, 29591,   970/
+data	(chrtab(i), i=726,730) / 21320, 21128, 21002, 21025,  1764/
+data	(chrtab(i), i=731,735) /    87, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=736,740) /  1032, 29719,  1764,   151, 21064/
+data	(chrtab(i), i=741,745) / 29719,  1764,    87, 20808, 21077/
+data	(chrtab(i), i=746,750) / 21320, 29783,  1764,   151, 29704/
+data	(chrtab(i), i=751,755) /   136, 29719,  1764,    87, 21064/
+data	(chrtab(i), i=756,760) /   320, 29783,  1764,   151, 21527/
+data	(chrtab(i), i=761,765) / 20616, 29704,  1764,   805, 21157/
+data	(chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/
+data	(chrtab(i), i=771,775) / 21011, 21001, 21127, 21255,  1764/
+data	(chrtab(i), i=776,780) /   611, 29273,   594, 29256,  1764/
+data	(chrtab(i), i=781,785) /   485, 21093, 21218, 21209, 21271/
+data	(chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/
+data	(chrtab(i), i=791,795) / 29127,  1764,    83, 20758, 20950/
+data	(chrtab(i), i=796,800) / 21265, 21457, 29844,  1764,     0/
diff --git a/sys/gio/imdkern/font.h b/sys/gio/imdkern/font.h
new file mode 100644
index 00000000..eb2e72f4
--- /dev/null
+++ b/sys/gio/imdkern/font.h
@@ -0,0 +1,29 @@
+# FONT.H -- Font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/imdkern/idk.com b/sys/gio/imdkern/idk.com
new file mode 100644
index 00000000..62e4eaf7
--- /dev/null
+++ b/sys/gio/imdkern/idk.com
@@ -0,0 +1,50 @@
+# IDK.COM -- The common for the IDK kernel.  A common is used here for maximum
+# efficiency (minimum indirection) when rasterizing vectors and encoding
+# metacode.  The maximum bitmap size is set at compile time in idk.h.
+
+# Booleans put here to avoid possible alignment problems.
+
+bool	mf_bitmap			# metafile type, metacode or bitmap
+bool	mf_rotate			# rotate (swap x and y)
+bool	mf_yflip			# flip y axis end for end
+bool	mf_update			# update bitmap
+bool	mf_delete			# delete metacode file after dispose
+bool	mf_debug			# print kernel debugging messages
+bool	mf_swap2			# swap every 2 bytes on output
+bool	mf_swap4			# swap every 4 bytes on output
+bool	mf_oneperfile			# store each frame in a new file
+
+common	/idkboo/ mf_bitmap, mf_rotate, mf_yflip, mf_update, mf_delete, mf_debug,
+	mf_swap2, mf_swap4, mf_oneperfile
+
+# Everything else goes here.
+
+int	mf_fd				# image descriptor of frame buffer
+int	mf_frame			# frame counter
+char	mf_fname[SZ_PATHNAME]		# metafile filename
+char	mf_dispose[SZ_OSCMD]		# host dispose command
+
+int	mf_op				# [MCODE] index into obuf
+short	mf_obuf[LEN_OBUF]		# metacode buffer
+
+int	mf_cx, mf_cy			# [BITMAPS] current pen position
+int	mf_nbpb				# packing factor, bits per byte
+int	mf_pxsize, mf_pysize		# physical x, y size of bitmap, bits
+int	mf_wxsize, mf_wysize		# x, y size of bitmap window, bits
+int	mf_xorigin, mf_yorigin		# origin of bitmap window
+real	mf_xscale, mf_yscale		# to convert from NDC to device coords
+int	mf_xmin, mf_xmax		# x clipping limits
+int	mf_ymin, mf_ymax		# y clipping limits
+int	mf_lenframe			# frame size, words
+int	mf_linewidth			# relative line width
+int	mf_lworigin			# device width of line size 1.0
+real	mf_lwslope			# device pixels per line size increment
+int	mf_fbuf[LEN_FBUF]		# frame buffer (BIG)
+int	mf_bitmask[BPW]			# bit mask table
+int	mf_color			# color index
+
+common	/idkcom/ mf_fd, mf_frame, mf_op, mf_cx, mf_cy, mf_nbpb, mf_pxsize,
+	mf_pysize, mf_wxsize, mf_wysize, mf_xorigin, mf_yorigin, mf_xscale,
+	mf_yscale, mf_xmin, mf_xmax, mf_ymin, mf_ymax, mf_lenframe,
+	mf_linewidth, mf_lworigin, mf_lwslope, mf_fbuf, mf_bitmask, mf_color,
+	mf_obuf, mf_fname, mf_dispose
diff --git a/sys/gio/imdkern/idk.x b/sys/gio/imdkern/idk.x
new file mode 100644
index 00000000..4d711e12
--- /dev/null
+++ b/sys/gio/imdkern/idk.x
@@ -0,0 +1,509 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <chars.h>
+include <imhdr.h>
+include <gki.h>
+
+.help idk
+.nf ---------------------------------------------------------------------------
+IDK -- Simple image display graphics interface.  The purpose of this
+interface is to provide a means of drawing into a graphics overlay in
+an image display server via the IRAF data stream interface.  The
+interface works by rasterizing the GKI metacode, reading the display
+frame buffer, merging the graphics raster with the frame buffer, and
+writing back the raster to the frame buffer.
+
+       g_out = idk_open (frame, color, tty)	# device open
+	      idk_close (g_out)			# device close
+	      idk_flush (g_out)			# flush output
+
+	      idk_frame (g_out)			# start a new frame
+	       idk_move (g_out, x, y)		# move to (x,y)
+	       idk_draw (g_out, x, y)		# draw a vector to (x,y)
+	  idk_linewidth (g_out, width)		# set line width (>=1)
+
+The procedures comprising the top end of the IDK interface are summarized
+above and the code is included in this file.  These procedures could be
+rewritten by the user to talk directly to a graphics device if desired,
+although the metacode file interface is likely to be simpler in most cases.
+
+The size of the bitmap is taken from the size of the display frame
+buffer.  Values of the frame buffer are set to the specified color index
+for each set bitmap pixel.  The final displayed color depends on the
+display server.
+
+The following graphcap fields apply:
+
+	DB	have the kernel print debug messages during execution
+	LO	width in device pixels of a line of size 1.0
+	LS	difference in device pixels between line sizes
+	CI	color index, i.e., the frame buffer pixel value
+	FN	display frame number
+
+.endhelp ----------------------------------------------------------------------
+
+# NOTE -- The mf_physbit lookup table, used to map logical screen bits into
+# physical bits in the bitmap (for NB != 8) is equivalenced to the mf_obuf
+# array which is not otherwise used for bitmap devices.  The length of the
+# mf_obuf array must therefore be >= PX.
+
+define	mf_physbit	mf_obuf		# union these two arrays [[[NOTE]]]
+define	BPW		32		# nbits in an integer
+define	LEN_FBUF	(8192*8192/BPW)	# max size bitmap / frame buffer
+define	LEN_OBUF	8192		# max size of buffer line
+define	SZ_DDSTR	256		# max size graphcap.DD
+define	SZ_OSCMD	256		# OS dispose command from graphcap.DD
+define	IOLINES		64		# image lines per i/o transfer
+
+
+# IDK_OPEN -- Open the metacode file.  Open the frame buffer as an image.
+# Initialize the bitmap based on the size of the frame.
+
+int procedure idk_open (a_frame, a_color, tty)
+
+int	a_color			#I display device color index
+int	a_frame			#I display buffer frame number
+pointer	tty			#I pointer to graphcap descriptor
+
+real	x, y
+char	strval[1]
+int	byte, off, i, j
+int	wcs, key, frame, color
+
+bool	ttygetb()
+real	ttygetr()
+int	imd_mapframe(), ttygeti(), shifti(), imdrcur()
+errchk	imd_mapframe, ttygetr, ttygeti, ttygetb
+include	"idk.com"
+
+begin
+	frame = a_frame
+	color = a_color
+
+	# The DB flag may be set in the graphcap entry for an IMD device to
+	# print debug messages during execution.
+
+	mf_debug = ttygetb (tty, "DB")
+	if (mf_debug) {
+	    call eprintf ("idk: open frame %d, color = %d\n")
+		call pargi (frame)
+		call pargi (color)
+	}
+
+	mf_update = false
+	
+	# If the frame number was not specified as a parameter see if it is
+	# specified in the graphcap, else try to query the display to determine
+	# the current display frame and plot into that.
+
+	if (frame <= 0)
+	    iferr (frame = ttygeti (tty, "FN"))
+		frame = 0
+	if (frame <= 0)
+	    if (imdrcur ("stdimage", x, y, wcs, key, strval, 1, 0, NO) >= 0)
+		frame = max (1, wcs / 100)
+	    else
+		frame = 1
+
+	# Find the color index in graphcap?
+	if (color < 0)
+	    color = max(0, ttygeti (tty, "CI"))
+
+	# Map the frame buffer as an image.
+	mf_fd = imd_mapframe (frame, READ_WRITE, YES)
+
+	# Initialize bitmap parameters.
+	mf_pxsize   = IM_LEN(mf_fd, 1)
+	mf_pysize   = IM_LEN(mf_fd, 2)
+	mf_xorigin  = 0
+	mf_yorigin  = 0
+	mf_wxsize   = IM_LEN(mf_fd, 1) - 1
+	mf_wysize   = IM_LEN(mf_fd, 2) - 1
+	mf_nbpb     = 8
+
+	# Line width parameters.
+	mf_lworigin = max (1, ttygeti (tty, "LO"))
+	mf_lwslope  = ttygetr (tty, "LS")
+
+	# Size of the frame buffer.
+	mf_lenframe = (mf_pxsize * mf_pysize + BPW-1) / BPW
+
+	mf_color = color
+	mf_linewidth = mf_lworigin
+
+	# Initial "pen" position.
+	mf_cx = 0
+	mf_cy = 0
+
+	mf_xmin = mf_xorigin
+	mf_ymin = mf_yorigin
+	mf_xmax = mf_xmin + mf_wxsize
+	mf_ymax = mf_ymin + mf_wysize
+
+	mf_xscale = real(mf_wxsize) / real(GKI_MAXNDC)
+	mf_yscale = real(mf_wysize) / real(GKI_MAXNDC)
+
+	if (mf_lenframe > LEN_FBUF)
+	    call error (1, "imdkern: bitmap too large")
+
+	# Initialize the bit mask table.
+	do j = 1, (BPW/NBITS_BYTE)
+	    do i = 1, NBITS_BYTE {
+		off = (j - 1) * NBITS_BYTE
+		mf_bitmask[off+i] = shifti (1, off + NBITS_BYTE - i)
+	    }
+
+	# Initialize the bit offset lookup table.  This gives the physical
+	# x-offset into the lookup table of each addressable x-coordinate
+	# on the device.  If NB is NBITS_BYTE the mapping is one-to-one.
+	# Note that the table contains zero-indexed bit offsets.
+
+	do i = 1, mf_pxsize {
+	    byte = (i - 1) / mf_nbpb
+	    mf_physbit[i] = min (mf_pxsize,
+		byte * NBITS_BYTE + (i - (byte * mf_nbpb))) - 1
+	}
+
+	if (mf_debug) {
+	    call eprintf ("bitmap [%d,%d] origin=[%d,%d] wsize=[%d,%d]\n")
+		call pargi (mf_pxsize);  call pargi (mf_pysize)
+		call pargi (mf_xorigin); call pargi (mf_yorigin)
+		call pargi (mf_wxsize);  call pargi (mf_wysize)
+	}
+
+	return (mf_fd)
+end
+
+
+# IDK_CLOSE -- Update the display frame buffer and close the display.
+
+procedure idk_close (fd)
+
+int	fd			# output stream [NOT USED]
+
+errchk	idk_frame, imunmap
+include	"idk.com"
+
+begin
+	if (mf_debug)
+	    call eprintf ("close device\n")
+
+	call idk_frame (mf_fd)
+
+	if (mf_fd != NULL) {
+	    call imunmap (mf_fd)
+	    mf_fd = NULL
+	}
+end
+
+
+# IDK_FLUSH -- Flush any buffered metacode output.
+
+procedure idk_flush (fd)
+
+int	fd			# output stream [NOT USED]
+include	"idk.com"
+
+begin
+	if (mf_fd != NULL)
+	    call imflush (mf_fd)
+end
+
+
+# IDK_FRAME -- Output a frame.  Overlay the bitmap on the frame buffer.
+# Map the display frame as an image section and process the bitmap line by
+# line.
+
+procedure idk_frame (fd)
+
+int	fd			# output stream [NOT USED]
+
+int	x1, x2, y1, y2
+int	bmw			# Bitmap word offset
+int	npix			# Pixels in local I/O buffer
+int	fbp			# Frame buffer section offset
+int	fbp0
+int	i, j
+int	line
+pointer	ob, ib
+
+pointer	imps2s(), imgs2s()
+include	"idk.com"
+
+begin
+	# Ignore frame commands if frame is empty.
+	if (!mf_update)
+	    return
+
+	if (mf_debug) {
+	    call eprintf ("Write the frame, color = %d\n")
+		call pargi (mf_color)
+	}
+
+	# Write the bitmap to the output frame buffer.
+
+	y2 = 0
+	for (y1=1;  y2 < mf_pysize;  y1=y1+IOLINES) {
+	    # For each buffer section of the frame.
+	    y2 = min (y1 + IOLINES-1, mf_pysize)
+	    x1 = 1
+	    x2 = mf_pxsize
+
+	    # Map the frame section.
+	    ob = imps2s (mf_fd, x1, x2, y1, y2)
+	    ib = imgs2s (mf_fd, x1, x2, y1, y2)
+
+	    npix = mf_pxsize * (y2 - y1 + 1)
+
+	    if (ob != ib)
+		# Copy the input buffer to the output buffer
+		call amovs (Mems[ib], Mems[ob], npix)
+
+	    do line = y1, y2 {
+		# Each line in the local frame buffer section
+		fbp0 = (line - y1) * mf_pxsize
+
+		do i = 1, mf_pxsize / BPW {
+		    # Each word in the bitmap line.
+		    bmw = (line - 1) * mf_pxsize / BPW + i
+
+		    if (mf_fbuf[bmw] != 0) {
+			do j = 1, BPW {
+			    # Each bit in the bitmap word.
+
+			    if (and (mf_fbuf[bmw], mf_bitmask[j]) != 0) {
+				# An ON bit.
+				fbp = fbp0 + (i-1) * BPW + j
+				Mems[ob+fbp-1] = mf_color
+			    }
+			}
+		    }
+		}
+	    }
+	}
+
+	mf_update = false
+end
+
+
+# IDK_MOVE -- Output a pen move instruction.
+
+procedure idk_move (fd, x, y)
+
+int	fd			# output stream [NOT USED]
+int	x, y			# point to move to
+
+include	"idk.com"
+
+begin
+	mf_cx = x
+	mf_cy = y
+
+	# Convert to zero indexed coordinates and clip at boundary.
+	# Allow room for line width shift near boundary.
+
+	mf_cx = max (mf_xmin, min (mf_xmax,
+	    int (mf_cx * mf_xscale) + mf_xorigin))
+	mf_cy = max (mf_ymin, min (mf_ymax,
+	    int (mf_cy * mf_yscale) + mf_yorigin))
+end
+
+
+# IDK_DRAW -- Output a pen draw instruction.
+
+procedure idk_draw (fd, a_x, a_y)
+
+int	fd			# output stream [NOT USED]
+int	a_x, a_y		# point to draw to
+
+int	xshift, yshift, dx, dy
+int	new_x, new_y, x1, y1, x2, y2, n, i
+include	"idk.com"
+
+begin
+	new_x = a_x
+	new_y = a_y
+
+	if (!mf_update) {
+	    # We are called when the first drawing instruction is output for a
+	    # new frame.  We clear the bitmap.
+
+	    # Zero out all the bits in a bitmap.
+	    call aclri (mf_fbuf, mf_lenframe)
+
+	    mf_update = true
+	}
+
+	# Convert to zero indexed coordinates and clip at boundary.
+	# Allow room for line width shift near boundary.
+
+	new_x = max (mf_xmin, min (mf_xmax,
+	    int (new_x * mf_xscale) + mf_xorigin))
+	new_y = max (mf_ymin, min (mf_ymax,
+	    int (new_y * mf_yscale) + mf_yorigin))
+
+	if (mf_linewidth <= 1)
+	    call idk_vector (mf_cx, mf_cy, new_x, new_y)
+	else {
+	    # Redraw the vector several times with small normal shifts to
+	    # produce a wider line.
+
+	    xshift = 0
+	    yshift = 0
+
+	    if (abs (new_x - mf_cx) > abs (new_y - mf_cy)) {
+		dx = 0
+		dy = 1
+	    } else {
+		dx = 1
+		dy = 0
+	    }
+
+	    do i = 1, mf_linewidth {
+		x1 = mf_cx + xshift
+		y1 = mf_cy + yshift
+		x2 = new_x + xshift
+		y2 = new_y + yshift
+
+		call idk_vector (x1, y1, x2, y2)
+
+		n = (i + 1) / 2
+		if (and (i, 1) == 0) {
+		    xshift =  dx * n
+		    yshift =  dy * n
+		} else {
+		    xshift = -dx * n
+		    yshift = -dy * n
+		}
+	    }
+	}
+
+	# Update the current pen position, and set the update flag so that
+	# the bitmap will be written to the output file.
+
+	mf_cx = new_x
+	mf_cy = new_y
+end
+
+
+# IDK_VECTOR -- Write a vector (line) of unit width into the bitmap.  The line
+# endpoints are expressed in physical device coordinates.
+
+procedure idk_vector (a_x1, a_y1, a_x2, a_y2)
+
+int	a_x1, a_y1			# start point of line
+int	a_x2, a_y2			# end point of line
+
+real	dydx, dxdy
+long	fbit, wbit, word
+int	wpln, mask, dx, dy, x, y, x1, y1, x2, y2, or()
+include	"idk.com"
+
+begin
+	x1 = a_x1; y1 = a_y1
+	x2 = a_x2; y2 = a_y2
+
+	dx = x2 - x1
+	dy = y2 - y1
+
+	if (abs(dx) > abs(dy)) {
+	    if (x1 > x2) {
+		x1 = a_x2; x2 = a_x1; dx = -dx
+		y1 = a_y2; y2 = a_y1; dy = -dy
+	    }
+
+	    if (dy == 0 && mf_nbpb == NBITS_BYTE) {
+		# Somewhat optimized code for the case of a horiz. vector.
+
+		fbit = y1 * mf_pxsize + x1
+		word = fbit / BPW
+		wbit = and (fbit, BPW-1)
+
+		do x = x1, x2 {
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		    wbit = wbit + 1
+		    if (wbit >= BPW) {
+			wbit = 0
+			word = word + 1
+		    }
+		}
+
+	    } else {
+		# The general case for a mostly-X vector.
+
+		dydx = real(dy) / real(dx)
+		do x = x1, x2 {
+		    y = int ((x - x1) * dydx) + y1
+		    fbit = y * mf_pxsize + mf_physbit[x+1]
+		    word = fbit / BPW
+		    wbit = and (fbit, BPW-1)
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		}
+	    }
+
+	} else if (dy != 0) {
+	    if (y1 > y2) {
+		x1 = a_x2; x2 = a_x1; dx = -dx
+		y1 = a_y2; y2 = a_y1; dy = -dy
+	    }
+
+	    if (dx == 0) {
+		# Optimized code for the case of a vertical vector.
+
+		fbit = y1 * mf_pxsize + mf_physbit[x1+1]
+		word = fbit / BPW + 1
+		wbit = and (fbit, BPW-1)
+		wpln = (mf_pxsize + BPW-1) / BPW
+		mask = mf_bitmask[wbit+1]
+
+		do y = y1, y2 {
+		    mf_fbuf[word] = or (mf_fbuf[word], mask)
+		    word = word + wpln
+		}
+
+	    } else {
+		# The general case of a mostly-Y vector.
+
+		dxdy = real(dx) / real(dy)
+		do y = y1, y2 {
+		    x = int ((y - y1) * dxdy) + x1
+		    fbit = y * mf_pxsize + mf_physbit[x+1]
+		    word = fbit / BPW
+		    wbit = and (fbit, BPW-1)
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		}
+	    }
+
+	} else {
+	    # Plot a single point (dx=dy=0).
+
+	    fbit = y1 * mf_pxsize + mf_physbit[x1+1]
+	    word = fbit / BPW
+	    wbit = and (fbit, BPW-1)
+	    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+	}
+end
+
+
+# IDK_LINEWIDTH -- Output a line width set instruction.
+
+procedure idk_linewidth (fd, width)
+
+int	fd			# output stream [NOT USED]
+int	width			# new line width
+
+int	gap
+include	"idk.com"
+
+begin
+	# Set the line width in device pixels.
+	mf_linewidth = max (1, mf_lworigin + int ((width-1) * mf_lwslope))
+
+	# Set the clipping limits.  Allow for shifting to widen lines.
+	gap = mf_linewidth / 2
+	mf_xmin = mf_xorigin + gap
+	mf_ymin = mf_yorigin + gap
+	mf_xmax = mf_xorigin + mf_wxsize - gap
+	mf_ymax = mf_yorigin + mf_wysize - gap
+end
diff --git a/sys/gio/imdkern/imd.com b/sys/gio/imdkern/imd.com
new file mode 100644
index 00000000..12cba65e
--- /dev/null
+++ b/sys/gio/imdkern/imd.com
@@ -0,0 +1,18 @@
+# IMD common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The stdgraph data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.
+
+pointer	g_kt				# kernel transform graphics descriptor
+pointer	g_tty				# graphcap descriptor
+int	g_nframes			# number of frames written
+int	g_maxframes			# max frames per device metafile
+int	g_ndraw				# no draw instr. in current frame
+int	g_in, g_out			# input, output files
+int	g_xres, g_yres			# desired device resolution
+int	g_frame, g_color		# display frame and graphics color
+char	g_device[SZ_GDEVICE]		# force output to named device
+
+common	/gioimd/ g_kt, g_tty, g_nframes, g_maxframes, g_ndraw,
+	g_in, g_out, g_xres, g_yres, g_frame, g_color, g_device
diff --git a/sys/gio/imdkern/imd.h b/sys/gio/imdkern/imd.h
new file mode 100644
index 00000000..a0e5d2d5
--- /dev/null
+++ b/sys/gio/imdkern/imd.h
@@ -0,0 +1,77 @@
+# IMD global definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		1024			# initial string buffer size
+define	SZ_GDEVICE	31			# maxsize forced device name
+define	DEF_MAXFRAMES	16			# maximum frames/metafile
+
+# The IMD state/device descriptor.
+
+define	LEN_IMD		81
+
+define	IMD_SBUF	Memi[$1]		# string buffer
+define	IMD_SZSBUF	Memi[$1+1]		# size of string buffer
+define	IMD_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	IMD_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	IMD_POLYLINE	Memi[$1+4]		# device supports polyline
+define	IMD_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	IMD_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	IMD_CELLARRAY	Memi[$1+7]		# device supports cell array
+define	IMD_XRES	Memi[$1+8]		# device resolution in X
+define	IMD_YRES	Memi[$1+9]		# device resolution in Y
+define	IMD_ZRES	Memi[$1+10]		# device resolution in Z
+define	IMD_FILLSTYLE	Memi[$1+11]		# number of fill styles
+define	IMD_ROAM	Memi[$1+12]		# device supports roam
+define	IMD_ZOOM	Memi[$1+13]		# device supports zoom
+define	IMD_SELERASE	Memi[$1+14]		# device has selective erase
+define	IMD_PIXREP	Memi[$1+15]		# device supports pixel replic.
+define	IMD_STARTFRAME	Memi[$1+16]		# frame advance at metafile BOF
+define	IMD_ENDFRAME	Memi[$1+17]		# frame advance at metafile EOF
+	# extra space
+define	IMD_CURSOR	Memi[$1+20]		# last cursor accessed
+define	IMD_COLOR	Memi[$1+21]		# last color set
+define	IMD_TXSIZE	Memi[$1+22]		# last text size set
+define	IMD_TXFONT	Memi[$1+23]		# last text font set
+define	IMD_TYPE	Memi[$1+24]		# last line type set
+define	IMD_WIDTH	Memi[$1+25]		# last line width set
+define	IMD_DEVNAME	Memi[$1+26]		# name of open device
+define	IMD_FRAME	Memi[$1+27]		# frame buffer number
+	# extra space
+define	IMD_CHARHEIGHT	Memi[$1+30+$2-1]	# character height
+define	IMD_CHARWIDTH 	Memi[$1+40+$2-1]	# character width
+define	IMD_CHARSIZE	Memr[P2R($1+50+$2-1)]	# text sizes permitted
+define	IMD_PLAP	($1+60)			# polyline attributes
+define	IMD_PMAP	($1+64)			# polymarker attributes
+define	IMD_FAAP	($1+68)			# fill area attributes
+define	IMD_TXAP	($1+71)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
diff --git a/sys/gio/imdkern/imdcancel.x b/sys/gio/imdkern/imdcancel.x
new file mode 100644
index 00000000..68832ae4
--- /dev/null
+++ b/sys/gio/imdkern/imdcancel.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_CANCEL -- Cancel any buffered output.
+
+procedure imd_cancel (dummy)
+
+int	dummy			# not used at present
+include	"imd.com"
+
+begin
+	if (g_kt == NULL)
+	    return
+	call imd_reset()
+end
diff --git a/sys/gio/imdkern/imdclear.x b/sys/gio/imdkern/imdclear.x
new file mode 100644
index 00000000..bf471998
--- /dev/null
+++ b/sys/gio/imdkern/imdclear.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"imd.h"
+
+# IMD_CLEAR -- Advance a frame on the plotter.  All attribute packets are
+# initialized to their default values.  Redundant calls or calls immediately
+# after a workstation open (before anything has been drawn) are ignored.
+
+procedure imd_clear (dummy)
+
+int	dummy			# not used at present
+
+int	idk_open()
+errchk	idk_open
+include	"imd.com"
+
+begin
+	# This is a no-op if nothing has been drawn.
+	if (g_kt == NULL || g_ndraw == 0)
+	    return
+
+	# Start a new frame.  This is done either by issuing the frame advance
+	# instruction or by starting a new metafile.  Close the output file and 
+	# start a new metafile if the maximum frame count has been reached.
+	# This disposes of the metafile to the system, causing the actual
+	# plots to be drawn.  Open a new metafile ready to receive next frame.
+
+	g_nframes = g_nframes + 1
+	if (g_nframes >= g_maxframes) {
+
+	    # Does this device require a frame advance at end of metafile?
+	    if (IMD_ENDFRAME(g_kt) == YES)
+		call idk_frame (g_out)
+
+	    g_nframes = 0
+	    call idk_close (g_out)
+	    #g_out = idk_open (Memc[IMD_DEVNAME(g_kt)], g_tty)
+	    g_out = idk_open (g_frame, g_color, g_tty)
+
+	    # Does this device require a frame advance at beginning of metafile?
+	    if (IMD_STARTFRAME(g_kt) == YES)
+		call idk_frame (g_out)
+
+	} else {
+	    # Merely output frame instruction to start a new frame in the same
+	    # metafile.
+
+	    call idk_frame (g_out)
+	}
+
+	# Init kernel data structures.
+	call imd_reset()
+	g_ndraw = 0
+end
diff --git a/sys/gio/imdkern/imdclose.x b/sys/gio/imdkern/imdclose.x
new file mode 100644
index 00000000..7283f5db
--- /dev/null
+++ b/sys/gio/imdkern/imdclose.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_CLOSE -- Close the IMD translation kernel.  Close the spool file so
+# the output is finally plotted.  Free up storage.
+
+procedure imd_close()
+
+include	"imd.com"
+
+begin
+	# Check for a redundant imd_close call.
+	if (g_kt == NULL)
+	    return
+
+	# If there is anything in the metafile, flush it and add a frame
+	# advance if required for the device.
+
+	if (g_ndraw > 0 || g_nframes > 0) {
+	    # Does this device require a frame advance at end of metafile?
+	    if (IMD_ENDFRAME(g_kt) == YES)
+		call idk_frame (g_out)
+	}
+
+	# Close output metafile, disposing of it to the host system.
+	call idk_close (g_out)
+
+	# Return tty descriptor.
+	call ttycdes (g_tty)
+
+	# Free kernel data structures.
+	call mfree (IMD_SBUF(g_kt), TY_CHAR)
+	call mfree (g_kt, TY_STRUCT)
+
+	g_kt = NULL
+end
diff --git a/sys/gio/imdkern/imdclws.x b/sys/gio/imdkern/imdclws.x
new file mode 100644
index 00000000..45072697
--- /dev/null
+++ b/sys/gio/imdkern/imdclws.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_CLOSEWS -- Close the named workstation.  Flush the output.
+# The spool file is closed only on the next plot or at gktclose time.
+# If the spool file is closed here, APPEND mode would not work.
+
+procedure imd_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+include "imd.com"
+
+begin
+	# For the IMD kernel, all display graphics writes are in append mode,
+	# so we may as well shutdown completely for closews (this also ensures
+	# that the display is updated at closews time).
+
+	#call idk_flush (g_out)
+	call imd_close()
+end
diff --git a/sys/gio/imdkern/imdcolor.x b/sys/gio/imdkern/imdcolor.x
new file mode 100644
index 00000000..581af9a2
--- /dev/null
+++ b/sys/gio/imdkern/imdcolor.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_COLOR -- Set line drawing color.
+
+procedure imd_color (index)
+
+int	index		# index for color switch statement
+include	"imd.com"
+
+begin
+	# switch (index) {
+	# case WHITE:
+	# case RED:
+	# case GREEN:
+	# case BLUE:
+	# default:
+	# }
+end
diff --git a/sys/gio/imdkern/imddrawch.x b/sys/gio/imdkern/imddrawch.x
new file mode 100644
index 00000000..17327563
--- /dev/null
+++ b/sys/gio/imdkern/imddrawch.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gki.h>
+include	<gset.h>
+include	"imd.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+
+
+# IMD_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+procedure imd_drawchar (ch, x, y, xsize, ysize, orien, font)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# width, height of char in GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+
+int	mx, my
+real	px, py, coso, sino, theta
+int	stroke, tab1, tab2, i, pen
+int	bitupk()
+include	"font.com"
+include	"imd.com"
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	# Set the font.
+	call imd_font (font)
+
+	tab1 = chridx[i]
+	tab2 = chridx[i+1] - 1
+
+	theta = -DEGTORAD(orien)
+	coso = cos(theta)
+	sino = sin(theta)
+
+	do i = tab1, tab2 {
+	    stroke = chrtab[i]
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    # Scale size of character.
+	    px = px / FONT_WIDTH  * xsize
+	    py = py / FONT_HEIGHT * ysize
+
+	    # The italic font is implemented applying a tilt.
+	    if (font == GT_ITALIC)
+		px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+	    # Rotate and shift.
+	    mx = x + px * coso + py * sino
+	    my = y - px * sino + py * coso
+
+	    # Draw the line segment or move pen.
+	    if (pen == 0)
+		call idk_move (g_out, mx, my)
+	    else
+		call idk_draw (g_out, mx, my)
+	}
+end
diff --git a/sys/gio/imdkern/imdescape.x b/sys/gio/imdkern/imdescape.x
new file mode 100644
index 00000000..2c2c3a26
--- /dev/null
+++ b/sys/gio/imdkern/imdescape.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMD_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# The IDK kernel does not have any escape functions at present.
+
+procedure imd_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+
+begin
+end
diff --git a/sys/gio/imdkern/imdfa.x b/sys/gio/imdkern/imdfa.x
new file mode 100644
index 00000000..03bf446e
--- /dev/null
+++ b/sys/gio/imdkern/imdfa.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_FILLAREA -- Fill a closed area.
+
+procedure imd_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+include	"imd.com"
+
+begin
+	# Not implemented yet.
+	call imd_polyline (p, npts)
+end
diff --git a/sys/gio/imdkern/imdfaset.x b/sys/gio/imdkern/imdfaset.x
new file mode 100644
index 00000000..b790cef9
--- /dev/null
+++ b/sys/gio/imdkern/imdfaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+# IMD_FASET -- Set the fillarea attributes.
+
+procedure imd_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"imd.com"
+
+begin
+	fa = IMD_FAAP(g_kt)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/imdkern/imdflush.x b/sys/gio/imdkern/imdflush.x
new file mode 100644
index 00000000..d22f04c9
--- /dev/null
+++ b/sys/gio/imdkern/imdflush.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imd.h"
+
+# IMD_FLUSH -- Flush output.
+
+procedure imd_flush (dummy)
+
+int	dummy			# not used at present
+include	"imd.com"
+
+begin
+	call idk_flush (g_out)
+end
diff --git a/sys/gio/imdkern/imdfont.x b/sys/gio/imdkern/imdfont.x
new file mode 100644
index 00000000..3117258b
--- /dev/null
+++ b/sys/gio/imdkern/imdfont.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gset.h>
+include	"imd.h"
+
+# IMD_FONT -- Set the character font.  The roman font is normal.  Bold is
+# implemented by increasing the vector line width; care must be taken to
+# set IMD_WIDTH so that the other vector drawing procedures remember to
+# change the width back.  The italic font is implemented in the character
+# generator by a geometric transformation.
+
+procedure imd_font (font)
+
+int	font			# code for font to be set
+int	pk2, width
+include	"imd.com"
+
+begin
+	width = IMD_WIDTH(g_kt)
+	pk2   = GKI_PACKREAL(2.0)
+
+	if (font == GT_BOLD) {
+	    if (width != pk2) {
+		call idk_linewidth (g_out, 2)
+		width = pk2
+	    }
+	} else
+	    call idk_linewidth (g_out, nint (GKI_UNPACKREAL(width)))
+
+	IMD_WIDTH(g_kt) = width
+end
diff --git a/sys/gio/imdkern/imdgcell.x b/sys/gio/imdkern/imdgcell.x
new file mode 100644
index 00000000..0c384d70
--- /dev/null
+++ b/sys/gio/imdkern/imdgcell.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMD_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure imd_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+begin
+	# Not implemented yet.
+end
diff --git a/sys/gio/imdkern/imdinit.x b/sys/gio/imdkern/imdinit.x
new file mode 100644
index 00000000..ceed3948
--- /dev/null
+++ b/sys/gio/imdkern/imdinit.x
@@ -0,0 +1,162 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	"imd.h"
+
+# IMD_INIT -- Initialize the gkt data structures from the graphcap entry
+# for the device.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine IMD_RESET initializes the attribute
+# packets when the frame is flushed.
+
+procedure imd_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+int	maxch, i
+real	char_height, char_width, char_size
+
+bool	ttygetb()
+real	ttygetr()
+int	ttygeti(), btoi(), gstrcpy()
+include	"imd.com"
+
+begin
+	# Allocate the gkt descriptor and the string buffer.
+	if (g_kt == NULL) {
+	    call calloc (g_kt, LEN_IMD, TY_STRUCT)
+	    call malloc (IMD_SBUF(g_kt), SZ_SBUF, TY_CHAR)
+	}
+
+	# Get the maximum frame count and the flags controlling frame advance
+	# at start and end of metafile.
+
+	g_maxframes = ttygeti (tty, "MF")
+	if (g_maxframes == 0)
+	    g_maxframes = DEF_MAXFRAMES
+	IMD_STARTFRAME(g_kt) = btoi (ttygetb (tty, "FS"))
+	IMD_ENDFRAME(g_kt)   = btoi (ttygetb (tty, "FE"))
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	IMD_SZSBUF(g_kt) = SZ_SBUF
+	IMD_NEXTCH(g_kt) = IMD_SBUF(g_kt) + 1
+	Memc[IMD_SBUF(g_kt)] = EOS
+
+	# Get the device resolution from the graphcap entry.
+
+	g_xres = ttygeti (tty, "xr")
+	if (g_xres <= 0)
+	    g_xres = 1024
+	g_yres = ttygeti (tty, "yr")
+	if (g_yres <= 0)
+	    g_yres = 1024
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the device has a set of discreet character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+
+	IMD_NCHARSIZES(g_kt) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = IMD_NEXTCH(g_kt)
+
+	if (IMD_NCHARSIZES(g_kt) <= 0) {
+	    IMD_NCHARSIZES(g_kt) = 1
+	    IMD_CHARSIZE(g_kt,1) = 1.0
+	    IMD_CHARHEIGHT(g_kt,1) = char_height
+	    IMD_CHARWIDTH(g_kt,1)  = char_width
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= IMD_NCHARSIZES(g_kt);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		IMD_CHARSIZE(g_kt,i)   = char_size
+		IMD_CHARHEIGHT(g_kt,i) = char_height * char_size
+		IMD_CHARWIDTH(g_kt,i)  = char_width  * char_size
+	    }
+	}
+
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the gkt
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	IMD_POLYLINE(g_kt)   = btoi (ttygetb (tty, "pl"))
+	IMD_POLYMARKER(g_kt) = btoi (ttygetb (tty, "pm"))
+	IMD_FILLAREA(g_kt)   = btoi (ttygetb (tty, "fa"))
+	IMD_FILLSTYLE(g_kt)  =       ttygeti (tty, "fs")
+	IMD_ROAM(g_kt)	     = btoi (ttygetb (tty, "ro"))
+	IMD_ZOOM(g_kt)	     = btoi (ttygetb (tty, "zo"))
+	IMD_XRES(g_kt)	     =       ttygeti (tty, "xr")
+	IMD_YRES(g_kt)	     =       ttygeti (tty, "yr")
+	IMD_ZRES(g_kt)	     =       ttygeti (tty, "zr")
+	IMD_CELLARRAY(g_kt)  = btoi (ttygetb (tty, "ca"))
+	IMD_SELERASE(g_kt)   = btoi (ttygetb (tty, "se"))
+	IMD_PIXREP(g_kt)     = btoi (ttygetb (tty, "pr"))
+
+	# Initialize the input parameters.
+
+	IMD_CURSOR(g_kt)     = 1
+
+	# Save the device string in the descriptor.
+	nextch = IMD_NEXTCH(g_kt)
+	IMD_DEVNAME(g_kt) = nextch
+	maxch = IMD_SBUF(g_kt) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+	IMD_NEXTCH(g_kt) = nextch
+end
+
+
+# IMD_GSTRING -- Get a string value parameter from the graphcap table,
+# placing the string at the end of the string buffer.  If the device does
+# not have the named capability return a pointer to the null string,
+# otherwise return a pointer to the string.  Since pointers are used,
+# rather than indices, the string buffer is fixed in size.  The additional
+# degree of indirection required with an index was not considered worthwhile
+# in this application since the graphcap entries are never very large.
+
+pointer procedure imd_gstring (cap)
+
+char	cap[ARB]		# device capability to be fetched
+pointer	strp, nextch
+int	maxch, nchars
+int	ttygets()
+include	"imd.com"
+
+begin
+	nextch = IMD_NEXTCH(g_kt)
+	maxch = IMD_SBUF(g_kt) + SZ_SBUF - nextch + 1
+
+	nchars = ttygets (g_tty, cap, Memc[nextch], maxch)
+	if (nchars > 0) {
+	    strp = nextch
+	    nextch = nextch + nchars + 1
+	} else
+	    strp = IMD_SBUF(g_kt)
+
+	IMD_NEXTCH(g_kt) = nextch
+	return (strp)
+end
diff --git a/sys/gio/imdkern/imdline.x b/sys/gio/imdkern/imdline.x
new file mode 100644
index 00000000..86f32c0a
--- /dev/null
+++ b/sys/gio/imdkern/imdline.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gset.h>
+include	"imd.h"
+
+# IMD_LINETYPE -- Set the line type option.
+
+procedure imd_linetype (index)
+
+int	index		# index for line type switch statement
+
+int	linetype
+include	"imd.com"
+
+begin
+	switch (index) {
+	case GL_CLEAR:
+	    linetype = 0
+	case GL_DASHED:
+	    linetype = 2
+	case GL_DOTTED:
+	    linetype = 3
+	case GL_DOTDASH:
+	    linetype = 4
+	default:
+	    linetype = 1		# solid
+	}
+
+	# This will be done in software in a future version of the IMD kernel.
+	# call idk_linetype (g_out, linetype)
+end
diff --git a/sys/gio/imdkern/imdopen.x b/sys/gio/imdkern/imdopen.x
new file mode 100644
index 00000000..2a563360
--- /dev/null
+++ b/sys/gio/imdkern/imdopen.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+# IMD_OPENDEV -- Install the IMD kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  If a driver does not implement a particular
+# instruction the table entry for that procedure may be set to zero, causing
+# the interpreter to ignore the instruction.
+
+procedure imd_opendev (devname, frame, color, dd)
+
+char	devname[ARB]		# nonnull for forced output to a device
+int	frame			# display frame buffer number
+int	color			# graphics overlay color index
+int	dd[ARB]			# device table to be initialized
+
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+extern	imd_openws(), imd_closews(), imd_clear(), imd_cancel()
+extern	imd_flush(), imd_polyline(), imd_polymarker(), imd_text()
+extern	imd_fillarea(), imd_putcellarray(), imd_plset()
+extern	imd_pmset(), imd_txset(), imd_faset()
+extern	imd_escape()
+include	"imd.com"
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	# Flag first pass.  Save forced device name in common for OPENWS.
+	# Zero the frame and instruction counters.
+
+	g_kt = NULL
+	g_nframes = 0
+	g_ndraw = 0
+	g_frame = frame
+	g_color = color
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+
+	dd[GKI_OPENWS]		= locpr (imd_openws)
+	dd[GKI_CLOSEWS]		= locpr (imd_closews)
+	dd[GKI_DEACTIVATEWS]	= 0
+	dd[GKI_REACTIVATEWS]	= 0
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (imd_clear)
+	dd[GKI_CANCEL]		= locpr (imd_cancel)
+	dd[GKI_FLUSH]		= locpr (imd_flush)
+	dd[GKI_POLYLINE]	= locpr (imd_polyline)
+	dd[GKI_POLYMARKER]	= locpr (imd_polymarker)
+	dd[GKI_TEXT]		= locpr (imd_text)
+	dd[GKI_FILLAREA]	= locpr (imd_fillarea)
+	dd[GKI_PUTCELLARRAY]	= locpr (imd_putcellarray)
+	dd[GKI_SETCURSOR]	= 0
+	dd[GKI_PLSET]		= locpr (imd_plset)
+	dd[GKI_PMSET]		= locpr (imd_pmset)
+	dd[GKI_TXSET]		= locpr (imd_txset)
+	dd[GKI_FASET]		= locpr (imd_faset)
+	dd[GKI_GETCURSOR]	= 0
+	dd[GKI_GETCELLARRAY]	= 0
+	dd[GKI_ESCAPE]		= locpr (imd_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call imd_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/imdkern/imdopenws.x b/sys/gio/imdkern/imdopenws.x
new file mode 100644
index 00000000..cdfaeee0
--- /dev/null
+++ b/sys/gio/imdkern/imdopenws.x
@@ -0,0 +1,98 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include	<gki.h>
+include	<error.h>
+include	"imd.h"
+
+# IMD_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, following by initialization of the device itself.
+
+procedure imd_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+pointer	sp, buf
+pointer	ttygdes()
+bool	streq()
+int	idk_open()
+bool	need_open, same_dev
+include	"imd.com"
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_FNAME, n), TY_CHAR)
+
+	# If a device was named when the kernel was opened then output will
+	# always go to that device (g_device) regardless of the device named
+	# in the OPENWS instruction.  If no device was named (null string)
+	# then unpack the device name, passed as a short integer array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Find out if first time, and if not, if same device as before
+	# note that if (g_kt == NULL), then same_dev is false.
+
+	same_dev = false
+	need_open = true
+
+	if (g_kt != NULL) {
+	    same_dev = (streq (Memc[IMD_DEVNAME(g_kt)], Memc[buf]))
+	    if (!same_dev) {
+		# Does this device require a frame advance at end of metafile?
+		if (IMD_ENDFRAME(g_kt) == YES)
+		    call idk_frame (g_out)
+		call idk_close (g_out)
+	    } else
+		need_open = false
+	}
+
+	# Initialize the kernel data structures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+	# graphcap entry for device must exist.
+
+	if (need_open) {
+	    if (!same_dev) {
+		if (g_kt != NULL)
+		    call ttycdes (g_tty)
+	        iferr (g_tty = ttygdes (Memc[buf]))
+		    call erract (EA_ERROR)
+
+		# Initialize data structures if we had to open a new device.
+		call imd_init (g_tty, Memc[buf])
+		call imd_reset()
+	    }
+
+	    # Open the output file.  Metacode output to the device will be
+	    # spooled and then disposed of to the device at CLOSEWS time.
+
+	    iferr (g_out = idk_open (g_frame, g_color, g_tty)) {
+	        call ttycdes (g_tty)
+	        call erract (EA_ERROR)
+	    } else {
+		# Does this device require a frame advance at start of metafile?
+		if (IMD_STARTFRAME(g_kt) == YES)
+		    call idk_frame (g_out)
+		g_nframes = 0
+		g_ndraw = 0
+	    }
+	}
+
+	# Clear the screen if device is being opened in new_file mode.
+	# This is a nop if we really opened a new device, but it will clear
+	# the screen if this is just a reopen of the same device in new file
+	# mode.
+
+	if (mode == NEW_FILE)
+	    call imd_clear (0)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/imdkern/imdpcell.x b/sys/gio/imdkern/imdpcell.x
new file mode 100644
index 00000000..deb61d18
--- /dev/null
+++ b/sys/gio/imdkern/imdpcell.x
@@ -0,0 +1,195 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+define	DEF_YRES	8192	# default height of device pixel in GKI units
+define	ZSTEP		4	# bit to be tested (step function width)
+
+
+# IMD_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).  The algorithm used here maps 8 bits in into 1 bit
+# out, using a step function lookup table.  The result is a band-contoured
+# image, where the spacing and width of the contour bands decreases as the
+# rate of change of intensity in the input cell array increases.
+
+procedure imd_putcellarray (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+bool	ttygetb()
+include	"imd.com"
+
+begin
+	if (ttygetb (g_tty, "BI"))
+	    call imd_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+	else
+	    call imd_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+end
+
+
+# IMD_BCELL -- Put cell array, optimized for a bitmap device.  In this case,
+# to get the maximum resolution at maximum efficiency it is desirable for the
+# main loop to be over device pixels, mapping the device pixel into the
+# nearest line of the input cell array.
+
+procedure imd_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	my, i1, i2, v, i, j, k
+include	"imd.com"
+int	and()
+
+begin
+	# Count drawing instruction, set polyline width to 1 for max y-res.
+	g_ndraw = g_ndraw + 1
+	call idk_linewidth (g_out, 1)
+	IMD_WIDTH(g_kt) = 0
+
+	# Determine the width of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+
+	# Determine the height of a device pixel in GKI units.
+	if (IMD_YRES(g_kt) <= 0)
+	    dy = GKI_MAXNDC / DEF_YRES
+	else
+	    dy = max (1.0, real(GKI_MAXNDC) / real(IMD_YRES(g_kt)))
+
+	# Process the cell array.  The outer loop runs over device pixels in Y;
+	# each iteration writes one line of the output raster.  The inner loop
+	# runs down a line of the cell array.
+
+	k = 0
+	for (my = ay1 + dy/2;  my < ay2;  my = k * dy + ay1) {
+	    j = max(1, min(ny, int (real(my-ay1) / real(ay2-ay1) * (ny-1)) + 1))
+	    my = min (my, int (ay2 - dy/2))
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i1 + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call idk_move (g_out, int ((i1-1) * dx + ax1), my)
+		    call idk_draw (g_out, int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+
+	    k = k + 1
+	}
+end
+
+
+# IMD_MCELL -- Put cell array, optimized for a metafile device.  In this case,
+# it is prohibitively expensive to draw into each resolvable line of the
+# output device.  It is better to set the linewidth to the width of a cell
+# array pixel, output the minimum number of drawing instructions, and let the
+# metafile device widen the lines.
+
+procedure imd_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	yres, my, i1, i2, v, i, j
+include	"imd.com"
+int	and()
+
+begin
+	# Count drawing instruction, clobber saved polyline width.
+	g_ndraw = g_ndraw + 1
+	IMD_WIDTH(g_kt) = 0
+
+	# Determine the width and height of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+	dy = real (ay2 - ay1) / ny
+
+	# Set the IDK line width to the height of a pixel in the cell array.
+	yres = IMD_YRES(g_kt)
+	if (yres <= 0)
+	    yres = DEF_YRES
+	call idk_linewidth (g_out,
+	    max (1, nint (dy / (real(GKI_MAXNDC) / real(yres)))))
+
+	# Process the cell array.  The outer loop runs over lines of the input
+	# cell array; each iteration writes only one line of the output raster,
+	# but the width of the line is adjusted to the height of a pixel in
+	# the cell array (the resolution of the cell array should not exceed
+	# that of the device).
+
+	for (j=1;  j <= ny;  j=j+1) {
+	    my = int ((j - 0.5) * dy) + ay1
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call idk_move (g_out, int ((i1-1) * dx + ax1), my)
+		    call idk_draw (g_out, int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+	}
+end
diff --git a/sys/gio/imdkern/imdpl.x b/sys/gio/imdkern/imdpl.x
new file mode 100644
index 00000000..7c94f7d2
--- /dev/null
+++ b/sys/gio/imdkern/imdpl.x
@@ -0,0 +1,183 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include	"imd.h"
+
+define	MAX_LTYPES	3	# max software line type patterns (excl. solid)
+define	MAX_LSEGMENTS	4	# max line segments per pattern
+define	LT_OFFSET	1	# offset to be subtracted from ltype code
+
+
+# IMD_POLYLINE -- Draw a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted but rather defines the start of the polyline.  The remaining
+# points define line segments to be drawn.
+
+procedure imd_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl
+int	x, y
+int	len_p, i
+include	"imd.com"
+
+begin
+	if (npts < 2)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polyline attributes if necessary.
+	pl = IMD_PLAP(g_kt)
+
+	if (IMD_WIDTH(g_kt) != PL_WIDTH(pl)) {
+	    call idk_linewidth (g_out, nint (GKI_UNPACKREAL(PL_WIDTH(pl))))
+	    IMD_WIDTH(g_kt) = PL_WIDTH(pl)
+	}
+	if (IMD_COLOR(g_kt) != PL_COLOR(pl)) {
+	    call imd_color (PL_COLOR(pl))
+	    IMD_COLOR(g_kt) = PL_COLOR(pl)
+	}
+
+	if (PL_LTYPE(pl) == GL_CLEAR) {
+	    # Ignore clear (erase) polylines.
+	    ;
+
+	} else if (PL_LTYPE(pl) != GL_SOLID) {
+	    # Draw a dashed or dotted polyline of the indicated type.
+	    call imd_dashline (g_out, p, npts, PL_LTYPE(pl))
+
+	} else {
+	    # Draw a solid polyline (usual case, optimized).
+
+	    # Move to the first point.
+	    x = p[1]
+	    y = p[2]
+	    call idk_move (g_out, x, y)
+
+	    # Draw the polyline.
+	    for (i=3;  i <= len_p;  i=i+2) {
+		x = p[i]
+		y = p[i+1]
+		call idk_draw (g_out, x, y)
+	    }
+	}
+end
+
+
+# IMD_DASHLINE -- Draw a dashed or dotted polyline using the indicated line
+# style.
+
+procedure imd_dashline (g_out, p, npts, ltype)
+
+int	g_out			# output file
+short	p[ARB]			# the polyline points
+int	npts			# number of points, i.e., (x,y) pairs
+int	ltype			# desired line type
+
+bool	penup
+int	len_p, i
+real	vlen, vpos, seglen, dx, dy
+int	oldx, oldy, newx, newy, penx, peny
+int	imd_getseg()
+
+begin
+	len_p = npts * 2
+
+	oldx = p[1]; oldy = p[2]
+	call idk_move (g_out, oldx, oldy)
+
+	# Process each line segment in the polyline.
+	do i = 3, len_p, 2 {
+	    newx = p[i]
+	    newy = p[i+1]
+
+	    # Compute VLEN, the length of the polyline line segment to be
+	    # drawn, VPOS, the relative position along the line segment,
+	    # and DX and DY, the scale factors to be applied to VPOS to get
+	    # the x and y coordinates of a point along the line segment.
+
+	    dx = newx - oldx
+	    dy = newy - oldy
+	    vlen = sqrt (dx*dx + dy*dy)
+	    if (vlen < 1.0)			# GKI units
+		next
+
+	    dx = dx / vlen
+	    dy = dy / vlen
+	    vpos = 0.0
+
+	    # For each line segment, get segments of the line type pattern
+	    # until all of the current line segment has been drawn.  The pattern
+	    # wraps around indefinitely, following the polyline around the
+	    # vertices with concern only for the total length traversed.
+
+	    while (vlen - vpos >= 1.0) {
+		seglen = imd_getseg (int (vlen - vpos), penup, ltype)
+		if (seglen < 1.0)
+		    break
+
+		vpos = vpos + seglen
+		penx = oldx + vpos * dx
+		peny = oldy + vpos * dy
+
+		if (penup)
+		    call idk_move (g_out, penx, peny)
+		else
+		    call idk_draw (g_out, penx, peny)
+	    }
+
+	    oldx = newx
+	    oldy = newy
+	}
+end
+
+
+# IMD_GETSEG -- Get a segment of a line style pattern.  The segment extends
+# from the current position in the pattern to either the next penup/pendown
+# breakpoint in the pattern, or to the point MAXLEN units further along in
+# the pattern.  When the end of the pattern is reached wrap around and
+# duplicate the pattern indefinitely.
+
+int procedure imd_getseg (maxlen, penup, ltype)
+
+int	maxlen			# max length segment to be returned
+bool	penup			# [out] pen up or pen down type segment?
+int	ltype			# line type code
+
+int	seglen, seg, lt
+int	p_seg[MAX_LTYPES]
+int	p_nseg[MAX_LTYPES]
+int	p_segleft[MAX_LTYPES]
+bool	p_penup[MAX_LTYPES,MAX_LSEGMENTS]
+int	p_seglen[MAX_LTYPES,MAX_LSEGMENTS]
+include	"ltype.dat"
+
+begin
+	lt = max (1, min (MAX_LTYPES, ltype - LT_OFFSET))
+	seg = p_seg[lt]
+	penup = p_penup[lt,seg]
+
+	repeat {
+	    if (maxlen < p_segleft[lt]) {
+		seglen = maxlen
+		p_segleft[lt] = p_segleft[lt] - seglen
+	    } else {
+		seglen = p_segleft[lt]
+		seg = seg + 1
+		if (seg > p_nseg[lt])
+		    seg = 1
+		p_seg[lt] = seg
+		p_segleft[lt] = p_seglen[lt,seg]
+	    }
+	} until (seglen > 0)
+
+	return (seglen)
+end
diff --git a/sys/gio/imdkern/imdplset.x b/sys/gio/imdkern/imdplset.x
new file mode 100644
index 00000000..22743178
--- /dev/null
+++ b/sys/gio/imdkern/imdplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+# IMD_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure imd_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"imd.com"
+
+begin
+	pl = IMD_PLAP(g_kt)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = gki[GKI_PLSET_LW]
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/imdkern/imdpm.x b/sys/gio/imdkern/imdpm.x
new file mode 100644
index 00000000..d7bcddac
--- /dev/null
+++ b/sys/gio/imdkern/imdpm.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	"imd.h"
+
+# IMD_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs.
+
+procedure imd_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+int	i, len_p
+int	x, y, oldx, oldy
+include	"imd.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polymarker attributes if necessary.
+
+	pm = IMD_PMAP(g_kt)
+
+	if (IMD_TYPE(g_kt) != PM_LTYPE(pm)) {
+	    call imd_linetype (PM_LTYPE(pm))
+	    IMD_TYPE(g_kt) = PM_LTYPE(pm)
+	}
+	if (IMD_WIDTH(g_kt) != PM_WIDTH(pm)) {
+	    call idk_linewidth (g_out, nint (GKI_UNPACKREAL(PM_WIDTH(pm))))
+	    IMD_WIDTH(g_kt) = PM_WIDTH(pm)
+	}
+	if (IMD_COLOR(g_kt) != PM_COLOR(pm)) {
+	    call imd_color (PM_COLOR(pm))
+	    IMD_COLOR(g_kt) = PM_COLOR(pm)
+	}
+
+	# Draw the polymarker.
+	oldx = 0; oldy = 0
+	for (i=1;  i <= len_p;  i=i+2) {
+	    x = p[i]; y = p[i+1]
+	    if (x != oldx || y != oldy) {
+		call idk_move (g_out, x, y)
+		call idk_draw (g_out, x, y)
+	    }
+	    oldx = x; oldy = y
+	}
+end
diff --git a/sys/gio/imdkern/imdpmset.x b/sys/gio/imdkern/imdpmset.x
new file mode 100644
index 00000000..6912ef97
--- /dev/null
+++ b/sys/gio/imdkern/imdpmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"imd.h"
+
+# IMD_PMSET -- Set the polymarker attributes.
+
+procedure imd_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"imd.com"
+
+begin
+	pm = IMD_PMAP(g_kt)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = gki[GKI_PMSET_MW]
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/imdkern/imdreset.x b/sys/gio/imdkern/imdreset.x
new file mode 100644
index 00000000..fa830e4d
--- /dev/null
+++ b/sys/gio/imdkern/imdreset.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	<gset.h>
+include	"imd.h"
+
+# IMD_RESET -- Reset the state of the transform common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure imd_reset()
+
+pointer	pl, pm, fa, tx
+include	"imd.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = IMD_PLAP(g_kt)
+	pm = IMD_PMAP(g_kt)
+	fa = IMD_FAAP(g_kt)
+	tx = IMD_TXAP(g_kt)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	= 1
+	PL_WIDTH(pl)	= GKI_PACKREAL(1.)
+	PL_COLOR(pl)	= 1
+	PM_LTYPE(pm)	= 1
+	PM_WIDTH(pm)	= GKI_PACKREAL(1.)
+	PM_COLOR(pm)	= 1
+	FA_STYLE(fa)	= 1
+	FA_COLOR(fa)	= 1
+	TX_UP(tx)	= 90
+	TX_SIZE(tx)	= GKI_PACKREAL(1.)
+	TX_PATH(tx)	= GT_RIGHT
+	TX_HJUSTIFY(tx)	= GT_LEFT
+	TX_VJUSTIFY(tx)	= GT_BOTTOM
+	TX_FONT(tx)	= GT_ROMAN
+	TX_COLOR(tx)	= 1
+	TX_SPACING(tx)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	IMD_TYPE(g_kt)		= -1
+	IMD_WIDTH(g_kt)		= -1
+	IMD_COLOR(g_kt)		= -1
+	IMD_TXSIZE(g_kt)	= -1
+	IMD_TXFONT(g_kt)	= -1
+end
diff --git a/sys/gio/imdkern/imdtx.x b/sys/gio/imdkern/imdtx.x
new file mode 100644
index 00000000..afe6c50c
--- /dev/null
+++ b/sys/gio/imdkern/imdtx.x
@@ -0,0 +1,430 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"imd.h"
+
+define	BASECS_X	12	# Base (size 1.0) char width in GKI coords.
+define	BASECS_Y	12	# Base (size 1.0) char height in GKI coords.
+
+
+# IMD_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.
+
+procedure imd_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+real	x, y, dx, dy, tsz
+int	x1, x2, y1, y2, orien
+int	x0, y0, gki_dx, gki_dy, ch, cw
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen 
+pointer	sp, seg, ip, op, tx, first
+int	stx_segment()
+include	"imd.com"
+
+real	g_dx, g_dy		# scale GKI to window coords
+int	g_x1, g_y1		# origin of device window
+int	g_x2, g_y2		# upper right corner of device window
+data	g_dx /1.0/, g_dy /1.0/
+data	g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Set pointer to the text attribute structure.
+	tx = IMD_TXAP(g_kt)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  The text size was
+	# set by imd_txset, and is just a scaling factor.
+
+	IMD_TXSIZE(g_kt) = TX_SIZE(tx)
+	if (TX_COLOR(tx) != IMD_COLOR(g_kt)) {
+	    call imd_color (TX_COLOR(tx))
+	    IMD_COLOR(g_kt) = TX_COLOR(tx)
+	}
+
+	# Set the linetype to a solid line.
+	if (IMD_TYPE(g_kt) != GL_SOLID) {
+	    call imd_linetype (GL_SOLID)
+	    IMD_TYPE(g_kt) = GL_SOLID
+	}
+
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx))
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call stx_parameters (xc,yc, totlen, x0,y0, gki_dx,gki_dy, polytext,
+	    orien)
+
+	# No discreet character sizes, so just scale the base sizes.
+	tsz = GKI_UNPACKREAL(TX_SIZE(tx))	# scale factor
+	ch = IMD_CHARHEIGHT(g_kt,1) * tsz
+	cw = IMD_CHARWIDTH(g_kt,1) * tsz
+
+	# Draw the segments, setting the font at the beginning of each segment.
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+
+	x  = x0 * g_dx + g_x1
+	y  = y0 * g_dy + g_y1
+	dx = gki_dx * g_dx
+	dy = gki_dy * g_dy
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    call imd_drawchar (Memc[ip], nint(x), nint(y), cw, ch,
+			orien, font)
+		    ip = ip + 1
+		    seglen = seglen - 1
+		    x = x + dx
+		    y = y + dy
+		}
+
+		x = newx
+		y = newy
+		ip = op
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure stx_segment (text, n, out, start_font)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+
+int	ip, op
+int	totlen, font
+
+begin
+	out[1] = start_font
+	totlen = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+int	up, path
+real	dir, sz, ch, cw, cosv, sinv, space
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q
+include	"imd.com"
+
+begin
+	tx = IMD_TXAP(g_kt)
+
+	# Get character sizes in GKI coords.
+	sz = GKI_UNPACKREAL (TX_SIZE(tx))
+	ch = IMD_CHARHEIGHT(g_kt,1) * sz
+	cw = IMD_CHARWIDTH(g_kt,1) * sz
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated).
+	space = (1.0 + TX_SPACING(tx))
+	if (path == GT_UP || path == GT_DOWN)
+	    p = ch * space
+	else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation.
+	dx =  p * cosv + q * sinv
+	dy = -p * sinv + q * cosv
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	xvlen = dx * (totlen - 1)
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character in size X and Y.
+	xsize = abs ( cw * cosv + ch * sinv)
+	ysize = abs (-cw * sinv + ch * cosv)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	x0 = x0 + ( p * cosv + q * sinv)
+	y0 = y0 + (-p * sinv + q * cosv)
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
diff --git a/sys/gio/imdkern/imdtxset.x b/sys/gio/imdkern/imdtxset.x
new file mode 100644
index 00000000..9479fbdd
--- /dev/null
+++ b/sys/gio/imdkern/imdtxset.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"imd.h"
+
+# IMD_TXSET -- Set the text drawing attributes.
+
+procedure imd_txset (gki)
+
+short	gki[ARB]		# attribute structure
+
+pointer	tx
+include	"imd.com"
+
+begin
+	tx = IMD_TXAP(g_kt)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+	TX_SIZE(tx)     = gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/imdkern/ltype.dat b/sys/gio/imdkern/ltype.dat
new file mode 100644
index 00000000..caae0c18
--- /dev/null
+++ b/sys/gio/imdkern/ltype.dat
@@ -0,0 +1,28 @@
+# LTYPE.DAT -- Initialize the builtin line types for the IMD kernel.  Data
+# is given in GKI units (1.0 = 32768 units).  A segment of 32 GKI units is
+# resolved on a device with 1024 resolved pixels.
+
+data	p_seg		/1, 1, 1/
+data	p_segleft	/320, 32, 512/
+
+data	p_nseg[1]	/2/		# PL_DASHED
+data	p_penup[1,1]	/false/
+data	p_penup[1,2]	/true/
+data	p_seglen[1,1]	/320/
+data	p_seglen[1,2]	/128/
+
+data	p_nseg[2]	/2/		# PL_DOTTED
+data	p_penup[2,1]	/false/
+data	p_penup[2,2]	/true/
+data	p_seglen[2,1]	/32/
+data	p_seglen[2,2]	/128/
+
+data	p_nseg[3]	/4/		# PL_DOTDASH
+data	p_penup[3,1]	/false/
+data	p_penup[3,2]	/true/
+data	p_penup[3,3]	/false/
+data	p_penup[3,4]	/true/
+data	p_seglen[3,1]	/512/
+data	p_seglen[3,2]	/128/
+data	p_seglen[3,3]	/32/
+data	p_seglen[3,4]	/128/
diff --git a/sys/gio/imdkern/mkpkg b/sys/gio/imdkern/mkpkg
new file mode 100644
index 00000000..03581bff
--- /dev/null
+++ b/sys/gio/imdkern/mkpkg
@@ -0,0 +1,50 @@
+# Make the GIO/IMDKERN image display device graphics kernel.
+
+$checkout libimd.a lib$
+$update   libimd.a
+$checkin  libimd.a lib$
+$call     relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:	
+	$omake  x_imdkern.x
+	$link	x_imdkern.o -limd -lds -lstg -o xx_imdkern.e
+	;
+
+install:
+	$move	xx_imdkern.e bin$x_imdkern.e
+	;
+
+libimd.a:
+	idk.x		idk.com <chars.h> <gki.h> <imhdr.h> <mach.h>
+	imdcancel.x	imd.com imd.h
+	imdclear.x	imd.com imd.h <mach.h>
+	imdclose.x	imd.com imd.h
+	imdclws.x	imd.h imd.com
+	imdcolor.x	imd.com imd.h
+	imddrawch.x	font.com font.h imd.com imd.h <gki.h> <gset.h> <math.h>
+	imdescape.x	
+	imdfa.x		imd.com imd.h
+	imdfaset.x	imd.com imd.h <gki.h>
+	imdflush.x	imd.com imd.h
+	imdfont.x	imd.com imd.h <gki.h> <gset.h>
+	imdgcell.x	
+	imdinit.x	imd.com imd.h <ctype.h> <gki.h> <mach.h>
+	imdline.x	imd.com imd.h <gset.h>
+	imdopen.x	imd.com imd.h <gki.h>
+	imdopenws.x	imd.com imd.h <error.h> <gki.h> <mach.h>
+	imdpcell.x	imd.com imd.h <gki.h>
+	imdpl.x		imd.com imd.h ltype.dat <gki.h> <gset.h>
+	imdplset.x	imd.com imd.h <gki.h>
+	imdpm.x		imd.com imd.h <gki.h>
+	imdpmset.x	imd.com imd.h <gki.h>
+	imdreset.x	imd.com imd.h <gset.h> <gki.h>
+	imdtx.x		imd.com imd.h <gki.h> <gset.h> <math.h>
+	imdtxset.x	imd.com imd.h <gki.h> <gset.h>
+	t_imdkern.x	<error.h> <gki.h>
+	;
diff --git a/sys/gio/imdkern/t_imdkern.x b/sys/gio/imdkern/t_imdkern.x
new file mode 100644
index 00000000..ebca44bf
--- /dev/null
+++ b/sys/gio/imdkern/t_imdkern.x
@@ -0,0 +1,89 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+
+# IMDKERN -- Graphics kernel for an image display frame buffer using the
+# data stream interface.  The package is based on the SGI kernel.
+
+procedure t_imdkern()
+
+int	fd, list, dbfd
+pointer	gki, sp, fname, devname, dbfname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits
+int	color, frame
+
+bool	clgetb()
+int	clgeti(), envfind()
+int	clpopni(), clgfil(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+	call salloc (dbfname, SZ_PATHNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Set parameter defaults.
+	debug = NO
+	verbose = NO
+	gkiunits = NO
+	frame = -1
+	color = -1
+
+	# Check for global kernel debug flag.
+	if (envfind ("idkdebug", Memc[dbfname], SZ_PATHNAME) > 0)
+	    iferr (dbfd = open (Memc[dbfname], APPEND, TEXT_FILE)) {
+		debug = NO
+		dbfd = 0
+	    } else
+		debug = YES
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+	if (!clgetb ("generic")) {
+	    debug   = btoi (clgetb ("debug"))
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	    frame = clgeti ("frame")
+	    color = clgeti ("color")
+	}
+
+	if (debug == YES && dbfd == 0)
+	    dbfd = STDERR
+
+	# Open the graphics kernel.
+	call imd_opendev (Memc[devname], frame, color, dev)
+	call gkp_install (deb, dbfd, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF) {
+		if (debug == YES) {
+		    call gki_execute (Mems[gki], deb)
+		    call flush (dbfd)
+		}
+		call gki_execute (Mems[gki], dev)
+	    }
+
+	    call close (fd)
+	}
+
+	call gkp_close()
+	call imd_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/imdkern/x_imdkern.x b/sys/gio/imdkern/x_imdkern.x
new file mode 100644
index 00000000..3cc14388
--- /dev/null
+++ b/sys/gio/imdkern/x_imdkern.x
@@ -0,0 +1,3 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	imdkern		= t_imdkern
diff --git a/sys/gio/markers.inc b/sys/gio/markers.inc
new file mode 100644
index 00000000..ef3a540f
--- /dev/null
+++ b/sys/gio/markers.inc
@@ -0,0 +1,71 @@
+# Data declarations for the standard markers.
+
+real	mpx[86], mpy[86]	# marker polyline points
+int	moff[9]	 		# offsets of the markers in mpx and mpy
+int	mnpts[9]		# number of points in each polyline
+int	k			# implied do-loop dummy index
+
+# Box.
+data	(mpx(k),k=01,05) /0.0, 1.0, 1.0, 0.0, 0.0/
+data	(mpy(k),k=01,05) /0.0, 0.0, 1.0, 1.0, 0.0/
+data	moff[1] /1/, mnpts[1] /5/
+
+# Plus.
+data	(mpx(k),k=06,10) /0.5, 0.5, 0.5, 0.0, 1.0/
+data	(mpy(k),k=06,10) /0.0, 1.0, 0.5, 0.5, 0.5/
+data	moff[2] /6/, mnpts[2] /5/
+
+# Cross.
+data	(mpx(k),k=11,15) /0.0, 1.0, 0.5, 0.0, 1.0/
+data	(mpy(k),k=11,15) /0.0, 1.0, 0.5, 1.0, 0.0/
+data	moff[3] /11/, mnpts[3] /5/
+
+# Diamond.
+data	(mpx(k),k=16,20) /0.5, 1.0, 0.5, 0.0, 0.5/
+data	(mpy(k),k=16,20) /0.0, 0.5, 1.0, 0.5, 0.0/
+data	moff[4] /16/, mnpts[4] /5/
+
+# Horizonal line.
+data	(mpx(k),k=21,22) /0.0, 1.0/
+data	(mpy(k),k=21,22) /0.5, 0.5/
+data	moff[5] /21/, mnpts[5] /2/
+
+# Vertical line.
+data	(mpx(k),k=23,24) /0.5, 0.5/
+data	(mpy(k),k=23,24) /0.0, 1.0/
+data	moff[6] /23/, mnpts[6] /2/
+
+# Horizontal error bar.
+data	(mpx(k),k=25,30) /0.0, 0.0, 0.0, 1.0, 1.0, 1.0/
+data	(mpy(k),k=25,30) /0.0, 1.0, 0.5, 0.5, 1.0, 0.0/
+data	moff[7] /25/, mnpts[7] /6/
+
+# Vertical error bar.
+data	(mpx(k),k=31,36) /0.0, 1.0, 0.5, 0.5, 1.0, 0.0/
+data	(mpy(k),k=31,36) /0.0, 0.0, 0.0, 1.0, 1.0, 1.0/
+data	moff[8] /31/, mnpts[8] /6/
+
+# Circle.
+data	(mpx(k),k=37,41) /1.000, 0.996, 0.984, 0.963, 0.936/	# X
+data	(mpx(k),k=42,46) /0.901, 0.859, 0.812, 0.759, 0.702/
+data	(mpx(k),k=47,51) /0.642, 0.580, 0.516, 0.452, 0.389/
+data	(mpx(k),k=52,56) /0.327, 0.269, 0.214, 0.164, 0.119/
+data	(mpx(k),k=57,61) /0.081, 0.050, 0.025, 0.009, 0.001/
+data	(mpx(k),k=62,66) /0.001, 0.009, 0.025, 0.050, 0.081/
+data	(mpx(k),k=67,71) /0.119, 0.164, 0.214, 0.269, 0.327/
+data	(mpx(k),k=72,76) /0.389, 0.452, 0.516, 0.580, 0.642/
+data	(mpx(k),k=77,81) /0.702, 0.759, 0.812, 0.859, 0.901/
+data	(mpx(k),k=82,86) /0.936, 0.963, 0.984, 0.996, 1.000/
+
+data	(mpy(k),k=37,41) /0.500, 0.564, 0.627, 0.688, 0.745/	# Y
+data	(mpy(k),k=42,46) /0.799, 0.848, 0.891, 0.928, 0.957/
+data	(mpy(k),k=47,51) /0.979, 0.994, 1.000, 0.998, 0.987/
+data	(mpy(k),k=52,56) /0.969, 0.943, 0.910, 0.870, 0.824/
+data	(mpy(k),k=57,61) /0.773, 0.717, 0.658, 0.596, 0.532/
+data	(mpy(k),k=62,66) /0.468, 0.404, 0.342, 0.283, 0.227/
+data	(mpy(k),k=67,71) /0.176, 0.130, 0.090, 0.057, 0.031/
+data	(mpy(k),k=72,76) /0.013, 0.002, 0.000, 0.006, 0.021/
+data	(mpy(k),k=77,81) /0.043, 0.072, 0.109, 0.152, 0.201/
+data	(mpy(k),k=82,86) /0.255, 0.312, 0.373, 0.436, 0.500/
+
+data	moff[9] /37/, mnpts[9] /50/
diff --git a/sys/gio/mkpkg b/sys/gio/mkpkg
new file mode 100644
index 00000000..b09ae3cd
--- /dev/null
+++ b/sys/gio/mkpkg
@@ -0,0 +1,140 @@
+# Make the GIO package.
+
+$checkout libex.a lib$			# default: update libex.a
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+# UPDATE --  Relink and install all graphics kernels.
+
+update:
+	@stdgraph
+	@sgikern
+	@imdkern
+	$ifeq (USE_NSPP,    yes) @nsppkern $endif
+	$ifeq (USE_CALCOMP, yes) @calcomp  $endif
+	;
+
+
+# The following redirect sys$mkpkg to the appropriate subdirectories to
+# update the libraries therein.
+
+libcur.a:
+	@cursor
+	;
+libgks.a:
+	@gks
+	;
+libncar.a:
+	@ncarutil
+	;
+libnspp.a:
+	@nspp
+	;
+libstg.a:
+	@stdgraph
+	;
+libsgi.a:
+	@sgikern
+	;
+libimd.a:
+	@imdkern
+	;
+libgkt.a:
+	@nsppkern
+	;
+libccp.a:
+	@calcomp
+	;
+
+
+# GIO portion of LIBEX.
+
+libex.a:
+	$ifeq (USE_GENERIC, yes)
+	    $ifolder (gtickr.x, gtick.gx)
+		$generic -k -t r gtick.gx
+	    $endif
+	$endif
+
+	@glabax
+	@gki
+	@gim
+
+	aelogd.x	
+	aelogr.x	
+	elogd.x	
+	elogr.x	
+	fpequald.x	<mach.h>
+	fpequalr.x	<mach.h>
+	fpfixd.x	<mach.h>
+	fpfixr.x	<mach.h>
+	fpndgr.x	
+	fpnormd.x	<mach.h>
+	fpnormr.x	<mach.h>
+	gactivate.x	<fset.h> <knet.h> <gio.h> <gset.h>
+	gadraw.x	gpl.com <gio.h> <gki.h>
+	gamove.x	gpl.com <gio.h> <gki.h>
+	gascale.x	<gio.h>
+	gcancel.x	<gio.h>
+	gclear.x	<gio.h> <gset.h>
+	gclose.x	<gio.h>
+	gctran.x	<gio.h>
+	gcurpos.x	gpl.com <gio.h> <gki.h>
+	gdeact.x	<gio.h> <gset.h>
+	gescape.x	<gio.h>
+	gfill.x		<gio.h>
+	gflush.x	<gio.h>
+	gframe.x	<gio.h>
+	gfrinit.x	<gio.h>
+	ggcell.x	gpl.com <gio.h>
+	ggcur.x		<gio.h> <gki.h>
+	ggetb.x		<gio.h>
+	ggeti.x		<gio.h>
+	ggetr.x		<gio.h>
+	ggets.x		<gio.h>
+	ggscale.x	<gio.h>
+	ggview.x	<gio.h>
+	ggwind.x	<gio.h>
+	gline.x	
+	gmark.x		markers.inc <gio.h> <gset.h>
+	gmftitle.x	<gio.h>
+	gmprintf.x
+	gmsg.x		<gio.h> <chars.h> <fset.h> <mach.h>
+	gopen.x		<error.h> <gio.h> <gset.h> <knet.h> <gki.h>
+	gpagefile.x	<error.h> <gset.h> <gio.h>
+	gpcell.x	gpl.com <gio.h>
+	gplcache.x	gpl.com <gio.h> <gki.h>
+	gplcancel.x	gpl.com <gio.h>
+	gplflush.x	gpl.com <gio.h> <gki.h>
+	gpline.x	
+	gploto.x	
+	gplotv.x	
+	gplreset.x	gpl.com <gio.h>
+	gplstype.x	gpl.com <gio.h>
+	gpmark.x	<gio.h> <gset.h>
+	gqverify.x	<fset.h>
+	grdraw.x	<gio.h>
+	grdwcs.x	<ctype.h>
+	greact.x	<gio.h> <gset.h>
+	greset.x	<gio.h> <gset.h> <mach.h>
+	grmove.x	<gio.h>
+	grscale.x	<gio.h>
+	gscan.x	
+	gscur.x		<gio.h>
+	gseti.x	
+	gsetr.x		<gio.h> <gset.h> <mach.h>
+	gsets.x		<gio.h> <gset.h>
+	gstati.x	
+	gstatr.x	<gio.h> <gset.h> <mach.h>
+	gstats.x	<gio.h> <gset.h>
+	gsview.x	<gio.h>
+	gswind.x	<gio.h>
+	gtext.x		<gio.h>
+	gtickr.x	<mach.h>
+	gtxset.x	<ctype.h> <gio.h> <gset.h>
+	gumark.x	<gio.h> <mach.h>
+	gvline.x	
+	gvmark.x	<gio.h> <gset.h>
+	wcstogki.x	gpl.com <gio.h> <gki.h>
+	;
diff --git a/sys/gio/ncarutil/README b/sys/gio/ncarutil/README
new file mode 100644
index 00000000..6ae35023
--- /dev/null
+++ b/sys/gio/ncarutil/README
@@ -0,0 +1,219 @@
+Directory gio$ncarutil, with subdirectories conlib, autograph and sysint, 
+contains the source code for the GKS based NCAR plotting utilities library.
+The first public release of this software was installed in IRAF 10SEP86.
+(The 3 previous installations of the NCAR Utilities were the result of NOAO
+serving as a Beta release test site.)  What follows is the Notes files from
+the installation :
+
+******************************************************************************
+Notes for installation of the NCAR GKS based plotting utilities.  This
+release marks the end of NCAR's beta testing and is the first public release
+of the new software.  The changes made at NOAO have been merged into the
+new source code; these changes have are marked with "+/- NOAO."  The IRAF
+installed NCAR library differs from the version released on tape as documented
+below.  Installation was begun September 2, 1986.  (S. Hammond)
+
+Subdirectory AUTOGRAPH --
+
+autograph/agback.f:
+    Calls blockdata agdflt as run time subroutine.
+autograph/agcurv.f:
+    Calls blockdata agdflt as run time subroutine.
+autograph/agdflt.f:
+    This is the block data, which has been completely rewritten as
+    initialization statements instead of data statements.
+autograph/agexax.f:
+    A ftn write statement has been commented out.
+autograph/agppid.f:
+    A string is written with f77upk/pstr instead of a ftn write statement.
+autograph/agrstr.f:
+    Binary read, completely commented out.
+autograph/agsave.f:
+    Binary write (opposite of agrstr.f), completely commented out.
+autograph/agscan.f:
+    Calls blockdata agdflt as run time subroutine.
+    A ftn write statement has been commented out.
+autograph/agsetp.f:
+    Calls blockdata agdflt as run time subroutine.
+autograph/agstup.f:
+    Calls blockdata agdflt as run time subroutine.
+autograph/ezmxy.f, ezmy.f, ezxy.f, ezy.f:
+    These four subroutines require identical changes:
+	Call blockdata agdflt as run time subroutine upon entering;
+	Call subroutine initag before returning.
+autograph/idiot.f:
+    Call blockdata adgflt as run time subroutine.
+    Call plotit and initut to reinitialize before returning.
+autograph/pstr.x:
+    This file is not on the distribution tape, it was written to
+    output strings that have been unpacked by f77upk.
+
+Subdirectory CONLIB --
+
+conlib/conecd.f:
+    Character variables IT and CHTMP are not used and so are commented out.
+    The FTN internal writes are rewritten as calls to encode.
+conlib/congen.f:
+    FTN internal write replaced with call to encode.
+conlib/conop1.f,conop2.f,conop3.f,conop4.f:
+    These four routines now call blockdata conbdn as run time initialization.
+conlib/conout.f, conot2.f:
+    Both these routines are no-ops in IRAF.  All statements have been commented
+    out.
+conlib/conpdv.f:
+    FTN internal write replaced with a call to encode.
+conlib/conssd.f:
+    FTN write and format statement commented out.
+conlib/contng.f:
+    FTN internal writes rewritten as calls to encode.
+
+
+Directory NCARUTIL --
+
+conran.f:
+    Changed values of iabove, ibelow and ibel2 to improve label placement.
+    Blockdata condbn rewritten as run time initialization. (conbdn.f)
+    Internal writes rewritten as calls to encode.
+
+conrec.f:
+    Value of NCRT changed from 4 to 2.
+    The contour plot labelling has been improved, with the titles being
+    centered in the current viewport, and the large spaces between
+    fields eliminated.  This change involves:
+	1. common block noaolb added; also used in spp calling routine.
+	2. Values of LNGTHS array modified.
+	3. Character*25 variable string[5] added.
+	4. Default plot position is centered on current viewport.
+    All internal writes have been replaced with calls to encode.
+    Error message concerning "overflow in STLINE" is now written only
+        to stderr, not to stdgraph as well.
+    EZCNTR no longer calls frame.
+    Block data CONBD deleted from conrec.f source, rewritten as conbd.f
+
+dashsmth.f:
+    In two places, the blockdata DASHBD is called as an initializing subroutine.
+    Subroutines kurv1s and kurv2s are used for both the dashsmth and
+    isosrf utilities.  The code is duplicated in the two fortran files.  I
+    have put it in a separate file (kurv.f) and deleted it from both original
+    locations.
+
+gridal.f:
+    In two places, blockdata GRIDT is called as an initializing subroutine.
+    All internal FTN writes changed to calls to encode.
+    FTN write and format statements for error reporting deleted - used seter.
+    Blockdata deleted from gridal.f; rewritten in gridt.f.
+
+hafton.f:
+    Blockdata hfinit rewritten and called as run time initializing subroutine.
+    One internal write rewritten as call to encode.
+    Call to FRAME removed from EZHFTN.
+
+isosrf.f:
+    Call to FRAME removed from EZISOS
+    Blockdata isosrb was rewritten as run time initialization isosrb.f
+    Source for subroutines kurv1s and kurv2s has been deleted from isosrf.f.
+    (It is shared with the dashsmth utility, and has been moved to kurv.f.)
+
+pwrity.f:
+    Blockdata PWRYBD rewritten as subroutine.
+    FTN writes and format statements commented out.
+
+pwrzs.f:
+    Common block noaovp added, so user can control viewport.  Calls to
+    plotit and set had to be changed because they assumed the full
+    viewport [1-1024] was being used for srface plots.
+
+srface.f:
+    Because user changes viewport when labelling is selected, mods had
+    to be made.  Common block noaovp has been added, and calls to set
+    and plotit no longer assume the full viewport [1-1024] is being used.
+    Blockdata SRFABD has been rewritten as a run time initialization.
+
+strmln.f:
+    The value of uvmsg changed from 1.0E+36 to 1.0E+16 in an attempt
+    to make this routine run on a VAX.
+
+threed.f:
+    Blockdata threbd rewritten as run time initialization.
+    Subroutine pwrz completely commented out.
+
+velvct.f:
+    Blockdata veldat rewritten as run time initialization.
+    FTN internal write rewritten as call to encode.
+
+
+Subdirectory SYSINT (system interface) --
+
+sysint/support.f:
+    1. The character size calculated by WTSTR is doubled to be readable
+       with the IRAF font.
+    2. Subroutines SETER and E9RIN both used FTN write statements to
+       output information.  This is now handled by passing the error 
+       message to ULIBER, where the string gets unpacked with f77upk
+       and written to stderr.
+    3. Blockdata UERRBD was rewritten as a run time initialization.
+    4. Block data UTILBD was rewritten as a run time initialization.
+       A logical flag (first) was added to insure that the internal
+       parameters were initialized only once per load; subroutine
+       utilbd can be called at several points.  An entry point 'utinit'
+       was added to reset the 'first' flag to true.
+    5. In an attempt to mimic the organization of the release tape, file
+       support.f contains the following fortran subroutines: 
+       SUBROUTINE ENCD (VALU,ASH,IOUT,NC,IOFFD)
+       SUBROUTINE ENCODE (NCHARS, FTNFMT, FTNOUT, RVAL)
+       SUBROUTINE ENTSR(IROLD,IRNEW)
+       SUBROUTINE RETSR(IROLD)
+       SUBROUTINE ERROF
+       SUBROUTINE SETER(MESSG,NERR,IOPT)
+       SUBROUTINE EPRIN
+       SUBROUTINE E9RIN(MESSG,NERR,SAVE)
+       SUBROUTINE FDUM
+       SUBROUTINE Q8QST4(NAME,LBRARY,ENTRY,VRSION)
+       INTEGER FUNCTION NERRO(NERR)
+       INTEGER FUNCTION I8SAV(ISW,IVALUE,SET)
+       SUBROUTINE WTSTR (PX,PY,CH,IS,IO,IC)
+       subroutine uerrbd
+       subroutine uliber (errcode, pkerrmsg, msglen)
+
+sysint/spps.f:
+    1. Subroutine FLUSH has been renamed MCFLSH because of a name conflict.
+    2. FRAME calls initut to initialize the 'first' flag in utilbd.
+    3. Subroutines OPNGKS and CLSGKS have been commented out.
+    4. In PLOTIT and PLOTIF the block data utilbd is called as a run time 
+       initialization subroutine.
+
+****************************************************************************
+
+gio$ncarutil/conrec.f Dec 23, 1986 S. Hammond
+        Moved the call to gsplci that set up major contours.  This
+    statement was not being executed until after the first major line
+    had been drawn, resulting in the first major line not being bold.
+
+
+***************************************************************************
+On June 1, 1987 the following copywright notice was inserted into all 
+FORTRAN files in the ncarutil directory tree.  
+
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+February 12, 1988.  During Steve Rooke's port of IRAF to the HP RISC computer
+several Fortran errors were caught by the HP compiler.  These have been
+fixed as shown:
+sys/gio/ncarutil/conbdn.f
+    The data statement at line 244 had not been commented out.  It is now.
+
+June 10, 1988.  Made a mod to conbd.f (and in the comments to conrec.f) that
+resets the point at which contour decides an image aspect ratio is "extreme".
+Previously if the image axes ratio exceeded 1:4 the contour plot was square.
+This limit was too restrictive and has been changed to 1:16.  See related 
+change in pkg$plot.vport.x.  
diff --git a/sys/gio/ncarutil/autograph/README b/sys/gio/ncarutil/autograph/README
new file mode 100644
index 00000000..befb5e42
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/README
@@ -0,0 +1,46 @@
+AUTOGRAPH -- This directory contains the contents of the NCAR file
+autograph.f, unpacked one subroutine per file.  Here is the revision file 
+supplied by NCAR for the autograph package.  For NOAO specific enhancements, 
+see gio$ncarutil/README.
+
+ Revision history:
+
+ February, 1979   Added a revision history and enhanced machine
+                  independency.
+
+ September, 1979  Fixed a couple of problems which caused the code to
+                  bomb when core was pre-set to indefinites and the
+                  1st graph drawn was peculiar in some way and another
+                  which caused it to set the default dashed-line-speci-
+                  fier length wrong.  Added new documentation.
+
+ October, 1979    Changed the way IDIOT behaves when NPTS is negative.
+
+ March, 1980      Fixed a couple of small errors, one which prevented
+                  an error exit in AGSETP from ever being reached and
+                  another which caused AUTOGRAPH to blow up when given
+                  a zero or negative on a logarithmic axis.  Changed
+                  the way in which NBPF is computed by AGSTR1.
+
+ August, 1981     Removed all calls setting the plotter intensity and
+                  made the computation of the variable SMRL portable.
+
+ April, 1984      Made the code strictly FORTRAN-77 compatible, taking
+                  out all dependency on support routines (such as LOC).
+                  This required some changes in the user interface.
+
+ February, 1985   Put code in AGSETP to reclaim character-store space
+                  used by character-string dash patterns when they are
+                  redefined using binary patterns.  Also changed AGGTCH
+                  to return a single blank for a non-existent string.
+
+ August, 1985     Put code in AGGETP so that the label-name identifier
+                  is now returned properly.  Among other things, this
+                  cures a problem which caused the character-storage
+                  space to be eaten up.
+
+ December, 1985   Fixed AGSETP to zero the current-line pointer when
+                  the current-label pointer is changed.
+
+ January, 1986    Fixed AGAXIS to respond properly to the zeroing of
+                  NCIM by AGCHNL.
diff --git a/sys/gio/ncarutil/autograph/agaxis.f b/sys/gio/ncarutil/autograph/agaxis.f
new file mode 100644
index 00000000..4c3bec73
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agaxis.f
@@ -0,0 +1,1851 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C A   B R I E F   D E S C R I P T I O N   O F   A U T O G R A P H
+C ---------------------------------------------------------------------
+C
+C Following is a brief description of the AUTOGRAPH package.  For a
+C complete write-up, see the document "AUTOGRAPH - THE UNABRIDGED
+C WRITE-UP".
+C
+C
+C PACKAGE AUTOGRAPH
+C
+C LATEST REVISION        January, 1986
+C
+C PURPOSE                To draw graphs, each with a labelled background
+C                        and each displaying one or more curves.
+C
+C ACCESS (ON THE CRAY)   To use AUTOGRAPH routines on the Cray, simply
+C                        call them; they are in the binary library
+C                        $NCARLB, which is automatically searched.
+C
+C                        To get smoother curves, drawn using spline
+C                        interpolation, compile DASHSMTH, from ULIB,
+C                        to replace DASHCHAR, from $NCARLB:
+C
+C                          GETSRC,LIB=ULIB,FILE=DASHSMTH,L=DSMTH.
+C                          CFT,I=DSMTH,L=0.
+C
+C                        AUTOGRAPH contains a routine AGPWRT, which it
+C                        calls to draw labels.  This routine just passes
+C                        its arguments on to the system-plot-package
+C                        routine PWRIT.  To use one of the fancier
+C                        character-drawers, like PWRITX or PWRITY,
+C                        just compile a routine AGPWRT to replace the
+C                        default version; it has the same arguments as
+C                        PWRIT and may either draw the character string
+C                        itself, or just pass the arguments on to a
+C                        desired character-drawer.  The AUTOGRAPH
+C                        specialist has some "standard" versions of
+C                        AGPWRT and should be consulted for help in
+C                        avoiding pitfalls.  One standard version,
+C                        which calls PWRITX, may be obtained using the
+C                        following JCL:
+C
+C                          GETSRC,LIB=XLIB,FILE=AGUPWRITX,L=UPWRTX.
+C                          CFT,I=UPWRTX,L=0.
+C
+C USAGE                  Following this indented preamble are given two
+C                        lists:  one describing the AUTOGRAPH routines
+C                        and another describing the arguments of those
+C                        routines.
+C
+C                        "AUTOGRAPH - THE UNABRIDGED WRITE-UP" gives
+C                        a complete write-up of AUTOGRAPH, in great
+C                        detail and with a set of helpful examples.
+C
+C ENTRY POINTS           Except for seven routines which are included
+C                        in the package for historical reasons (EZY,
+C                        EZXY, EZMY, EZMXY, IDIOT, ANOTAT, and DISPLA),
+C                        the AUTOGRAPH routines have six-character names
+C                        beginning with the characters 'AG'.  An alpha-
+C                        betized list follows:
+C
+C                          AGAXIS AGBACK AGBNCH AGCHAX AGCHCU AGCHIL
+C                          AGCHNL AGCTCS AGCTKO AGCURV AGDASH AGDFLT
+C                          AGDLCH AGDSHN AGEXAX AGEXUS AGEZSU AGFPBN
+C                          AGFTOL AGGETC AGGETF AGGETI AGGETP AGGTCH
+C                          AGINIT AGKURV AGLBLS AGMAXI AGMINI AGNUMB
+C                          AGPPID AGPWRT AGQURV AGRPCH AGRSTR AGSAVE
+C                          AGSCAN AGSETC AGSETF AGSETI AGSETP AGSRCH
+C                          AGSTCH AGSTUP AGUTOL
+C
+C                        NOTE:  The "routine" AGDFLT is a block-data
+C                        routine specifying the default values of
+C                        AUTOGRAPH control parameters.
+C
+C SPECIAL CONDITIONS     Under certain conditions, AUTOGRAPH may print
+C                        an error message (via the routine SETER) and
+C                        stop.  Each error message includes the name of
+C                        the routine which issued it.  A description of
+C                        the condition which caused the error may be
+C                        found in the AUTOGRAPH write-up in the NCAR
+C                        graphics manual; look in the write-up of the
+C                        routine which issued the error message, under
+C                        the heading 'SPECIAL CONDITIONS'.
+C
+C                        For error messages issued by the routine
+C                        AGNUMB, see the write-up of the routine AGSTUP.
+C
+C                        If you get an error in the routine ALOG10, it
+C                        probably means that you are using a logarithmic
+C                        axis and some of the coordinate data along that
+C                        axis are zero or negative.
+C
+C COMMON BLOCKS          The AUTOGRAPH common blocks are AGCONP, AGORIP,
+C                        AGOCHP, AGCHR1, and AGCHR2.  AGCONP contains
+C                        the AUTOGRAPH "control parameters", primary and
+C                        secondary, all of which are real, AGORIP other
+C                        real and/or integer parameters, AGOCHP other
+C                        character parameters, AGCHR1 and AGCHR2 the
+C                        variables implementing the character-storage-
+C                        and-retrieval scheme of AUTOGRAPH.
+C
+C I/O                    Lower-level plotting routines are called to
+C                        produce graphical output and, when errors
+C                        occur, error messages may be written to the
+C                        system error file, as defined by I1MACH(4),
+C                        either directly or by way of a call to SETER.
+C
+C REQUIRED ULIB          AUTOGRAPH uses the software dashed-line package
+C ROUTINES               DASHCHAR.  Of course, either of the packages
+C                        DASHSMTH or DASHSUPR may be used instead, to
+C                        get smoother curves.
+C
+C SPECIALIST             Dave Kennison, Scientific Computing Division,
+C                        National Center for Atmospheric Research
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                Dave Robertson wrote the original routine
+C                        IDIOT, which was intended to provide a simple,
+C                        quick-and-dirty, x-y graph-drawing capability.
+C                        In time, as it became obvious that many users
+C                        were adapting IDIOT to more sophisticated
+C                        tasks, Dan Anderson wrote the first AUTOGRAPH
+C                        package, based on IDIOT.  It allowed the user
+C                        to put more than one curve on a graph, to use
+C                        more sophisticated backgrounds, to specify
+C                        coordinate data in a variety of ways, and to
+C                        more easily control the scaling and positioning
+C                        of graphs.  Eventually, this package, too, was
+C                        found wanting.  In 1977, Dave Kennison entirely
+C                        re-wrote AUTOGRAPH, with the following goals:
+C                        to maintain the ease of use for simple graphs
+C                        which had been the principal virtue of the
+C                        package, to provide the user with as much
+C                        control as possible, to incorporate desirable
+C                        new features, and to make the package as
+C                        portable as possible.  In 1984, the package
+C                        was again worked over by Dave Kennison, to
+C                        make it compatible with FORTRAN-77 and
+C                        to remove any dependency on the LOC function,
+C                        which had proved to cause difficulties on
+C                        certain machines.  The user interface was
+C                        changed somewhat and some new features were
+C                        added.  A GKS-compatible version was written.
+C
+C SPACE REQUIRED         AUTOGRAPH is big; one pays a price for its
+C                        capabilities.  On the Cray, it occupies a
+C                        little under 30000 (octal) locations.  The
+C                        required plot package routines take about
+C                        another 7000 (octal), the (modified) PORT
+C                        support routines about another 1000 (octal),
+C                        and system routines (math, I/O, miscellany)
+C                        another 30000 (octal).
+C
+C PORTABILITY            AUTOGRAPH may be ported with few modifications
+C                        to most systems having a FORTRAN-77 compiler.
+C
+C                        The labelled common blocks may have to be
+C                        declared in a part of the user program which
+C                        is always core-resident so that variables
+C                        in them will maintain their values from one
+C                        AUTOGRAPH-routine call to the next.  Such a
+C                        problem may arise when AUTOGRAPH is placed in
+C                        an overlay or when some sort of memory-paging
+C                        scheme is used.
+C
+C REQUIRED RESIDENT      AUTOGRAPH uses the DASHCHAR routines DASHDB,
+C ROUTINES               DASHDC, FRSTD, LASTD, LINED, AND VECTD, the
+C                        system-plot-package routines FRAME, GETSET,
+C                        GETSI, LINE, PWRIT, and SET, the support
+C                        routines ISHIFT and IOR, the (modified)
+C                        PORT utilities SETER and I1MACH, and the
+C                        FORTRAN-library routines ALOG10, ATAN2, COS,
+C                        SIN, AND SQRT.
+C
+C ---------------------------------------------------------------------
+C U S E R - C A L L A B L E   A U T O G R A P H   R O U T I N E S
+C ---------------------------------------------------------------------
+C
+C Following is a list of AUTOGRAPH routines to be called by the user
+C (organized by function).  Each routine is described briefly.  The
+C arguments of the routines are described in the next section.
+C
+C Each of the following routines draws a complete graph with one call.
+C Each is implemented by a set of calls to the lower-level AUTOGRAPH
+C routines AGSTUP, AGCURV, and AGBACK (which see, below).
+C
+C -- EZY (YDRA,NPTS,GLAB) - draws a graph of the curve defined by the
+C    data points ((I,YDRA(I)),I=1,NPTS), with a graph label specified
+C    by GLAB.
+C
+C -- EZXY (XDRA,YDRA,NPTS,GLAB) - draws a graph of the curve defined by
+C    the data points ((XDRA(I),YDRA(I)),I=1,NPTS), with a graph label
+C    specified by GLAB.
+C
+C -- EZMY (YDRA,IDXY,MANY,NPTS,GLAB) - draws a graph of the family of
+C    curves defined by data points (((I,YDRA(I,J)),I=1,NPTS),J=1,MANY),
+C    with a graph label specified by GLAB.  The order of the subscripts
+C    of YDRA may be reversed - see the routine DISPLA, argument LROW.
+C
+C -- EZMXY (XDRA,YDRA,IDXY,MANY,NPTS,GLAB) - draws a graph of the
+C    family of curves defined by the data points (((XDRA(I),YDRA(I,J)),
+C    I=1,NPTS),J=1,MANY), with a graph label specified by GLAB.  XDRA
+C    may be doubly-subscripted and the order of the subscripts of XDRA
+C    and YDRA may be reversed - see the routine DISPLA, argument LROW.
+C
+C -- IDIOT (XDRA,YDRA,NPTS,LTYP,LDSH,LABX,LABY,LABG,LFRA) - implements
+C    the routine from which AUTOGRAPH grew - not recommended - provided
+C    for antique lovers.
+C
+C The following routines provide user access to the AUTOGRAPH control
+C parameters (in the labelled common block AGCONP).
+C
+C -- ANOTAT (XLAB,YLAB,LBAC,LSET,NDSH,DSHL) - may be used to change the
+C    x- and y-axis (non-numeric) labels, the background type, the way
+C    in which graphs are positioned and scaled, and the type of dash
+C    patterns to be used in drawing curves.
+C
+C -- DISPLA (LFRA,LROW,LTYP) - may be used to specify when, if ever,
+C    the EZ... routines do a frame advance, how input arrays for EZMY
+C    and EZMXY are dimensioned, and the linear/log nature of graphs.
+C
+C -- AGSETP (TPGN,FURA,LURA) - a general-purpose parameter-setting
+C    routine, used to set the group of parameters specified by TPGN,
+C    using values obtained from the array (FURA(I),I=1,LURA).
+C
+C -- AGSETF (TPGN,FUSR) - used to set the single parameter specified by
+C    TPGN, giving it the floating-point value FUSR.
+C
+C -- AGSETI (TPGN,IUSR) - used to set the single parameter specified by
+C    TPGN, giving it the floating-point value FLOAT(IUSR).
+C
+C -- AGSETC (TPGN,CUSR) - the character string CUSR is stashed in an
+C    array inside AUTOGRAPH and the floating-point equivalent of an
+C    identifier which may be used for later retrieval of the string is
+C    stored as the value of the single parameter specified by TPGN.  The
+C    single parameter must be a label name, a dash pattern, the text of
+C    a label line, or the line-terminator character.
+C
+C -- AGGETP (TPGN,FURA,LURA) - a general-purpose parameter-getting
+C    routine, used to get the group of parameters specified by TPGN,
+C    putting the result in the array (FURA(I),I=1,LURA).
+C
+C -- AGGETF (TPGN,FUSR) - used to get, in FUSR, the floating-point
+C    value of the single parameter specified by TPGN.
+C
+C -- AGGETI (TPGN,IUSR) - used to get, in IUSR, the integer equivalent
+C    of the value of the single parameter specified by TPGN.
+C
+C -- AGGETC (TPGN,CUSR) - used to get, in CUSR, the character string
+C    whose identifier is specified by the integer equivalent of the
+C    single parameter specified by TPGN.  The single parameter must
+C    be a label name, a dash pattern, the text of a label line, or the
+C    line-terminator character.
+C
+C The following are lower-level routines, which may be used to draw
+C graphs of many different kinds.  The EZ... routines call these.  They
+C are intended to be called by user programs, as well.
+C
+C -- AGSTUP (XDRA,NVIX,IIVX,NEVX,IIEX,YDRA,NVIY,IIVY,NEVY,IIEY) - this
+C    routine must be called prior to the first call to either of the
+C    two routines AGBACK and AGCURV, to force the set-up of secondary
+C    parameters controlling the behavior of those routines.  After any
+C    parameter-setting call, AGSTUP must be called again before calling
+C    either AGBACK or AGCURV again.  AGSTUP calls the routine "SET", in
+C    the plot package, so that user x/y coordinates in subsequent calls
+C    will map properly into the plotter space.
+C
+C -- AGBACK - draws the background defined by the current state of the
+C    AUTOGRAPH control parameters.
+C
+C -- AGCURV (XVEC,IIEX,YVEC,IIEY,NEXY,KDSH) - draws the curve defined
+C    by the arguments, positioning it as specified by the current state
+C    of the AUTOGRAPH control parameters.
+C
+C The following utility routines are called by the user.
+C
+C -- AGSAVE (IFNO) - used to save the current state of AUTOGRAPH by
+C    writing the appropriate information to a specified file.  Most
+C    commonly used to save the default state for later restoration.
+C    This routine should be used instead of AGGETP when the object
+C    is to save the whole state of AUTOGRAPH, since it saves not only
+C    the primary control parameters, but all of the character strings
+C    pointed to by the primary control parameters.  It is the user's
+C    responsibility to position the file before calling AGSAVE.
+C
+C -- AGRSTR (IFNO) - used to restore a saved state of AUTOGRAPH by
+C    reading the appropriate information from a specified file.  Most
+C    commonly used to restore AUTOGRAPH to its default state.  It is
+C    the user's responsibility to position the file before calling
+C    AGRSTR.
+C
+C -- AGBNCH (IDSH) - a function, of type CHARACTER*16 (it must be
+C    declared as such in a user routine referencing it), whose value,
+C    given a 16-bit binary dash pattern, is the equivalent character
+C    dash pattern.
+C
+C -- AGDSHN (IDSH) - a function, of type CHARACTER*16 (it must be
+C    declared as such in a user routine referencing it), whose value,
+C    given an integer "n" (typically between 1 and 26) is the character
+C    string 'DASH/ARRAY/nnnn.', which is the name of the nth dash
+C    pattern parameter.  To set the 13th dash pattern, for example,
+C    one might use "CALL AGSETC (AGDSHN(13),'$$$$$$CURVE 13$$$$$$')".
+C
+C The following utility routines are called by AUTOGRAPH.  The versions
+C included in AUTOGRAPH itself are dummies; they do nothing but RETURN.
+C The user may replace one or more of these routines with versions to
+C accomplish specific purposes.
+C
+C -- AGUTOL (IAXS,FUNS,IDMA,VINP,VOTP) - called by AUTOGRAPH to perform
+C    the mapping from user-system values along an axis to label-system
+C    values along the axis and vice-versa.  This routine may be replaced
+C    by the user to create a desired graph.
+C
+C -- AGCHAX (IFLG,IAXS,IPRT,VILS) - called by AUTOGRAPH just before and
+C    just after the various parts of the axes are drawn.
+C
+C -- AGCHCU (IFLG,KDSH) - called by AUTOGRAPH just before and just after
+C    each curve is drawn.
+C
+C -- AGCHIL (IFLG,LBNM,LNNO) - called by AUTOGRAPH just before and just
+C    after each line of an informational label is drawn.
+C
+C -- AGCHNL (IAXS,VILS,CHRM,MCIM,NCIM,IPXM,CHRE,MCIE,NCIE) - called by
+C    AUTOGRAPH just after the character strings defining a numeric label
+C    have been generated.
+C
+C ---------------------------------------------------------------------
+C D E S C R I P T I O N S   O F   A R G U M E N T S
+C ---------------------------------------------------------------------
+C
+C In calls to the routines EZY, EZXY, EZMY, and EZMXY:
+C
+C -- XDRA is an array of x coordinates, dimensioned as implied by the
+C    current value of the AUTOGRAPH control parameter 'ROW.' (see the
+C    description of the argument LROW, below).  The value of the
+C    AUTOGRAPH parameter 'NULL/1.' (1.E36, by default) when used as an
+C    x coordinate, implies a missing data point; the curve segments
+C    on either side of such a point are not drawn.
+C
+C -- YDRA is an array of y coordinates, dimensioned as implied by the
+C    current value of the AUTOGRAPH control parameter 'ROW.' (see the
+C    description of the argument LROW, below).  The value of the
+C    AUTOGRAPH parameter 'NULL/1.' (1.E36, by default) when used as a
+C    y coordinate, implies a missing data point; the curve segments
+C    on either side of such a point are not drawn.
+C
+C -- IDXY is the first dimension of the arrays XDRA (if it has two
+C    dimensions) and YDRA.
+C
+C -- MANY is the number of curves to be drawn by the call to EZ... -
+C    normally, the second dimension of XDRA (if it has two dimensions)
+C    and YDRA.
+C
+C -- NPTS is the number of points defining each curve to be drawn by
+C    the routine EZ... - normally, the first (or only) dimension of
+C    XDRA and YDRA.
+C
+C -- GLAB is a character constant or a character variable, defining a
+C    label to be placed at the top of the graph.  The string may not be
+C    more than 40 characters long - if it is fewer than 40 characters
+C    long, its last character must be a dollar sign.  (The dollar sign
+C    is not a part of the label - it is stripped off.)  The character
+C    string "CHAR(0)" may be used to indicate that the previous label,
+C    whatever it was, should continue to be used.  The initial graph
+C    label consists of blanks.
+C
+C In calls to the routine ANOTAT:
+C
+C -- XLAB and YLAB resemble GLAB (see above) and define labels for the
+C    x and y axes.  The default x-axis label is the single character
+C    X, the default y-axis label the single character Y.  Note that one
+C    may use the string "CHAR(0)" to indicate that the x-axis (y-axis)
+C    label is not to be changed from what it was previously.
+C
+C -- LBAC, if non-zero, specifies a new value for the AUTOGRAPH control
+C    parameter 'BACKGROUND.', as follows:
+C
+C       1 - a perimeter background
+C
+C       2 - a grid background
+C
+C       3 - an axis background
+C
+C       4 - no background
+C
+C    The default value of 'BACKGROUND.' is 1.
+C
+C -- LSET, if non-zero, specifies a new value for the AUTOGRAPH control
+C    parameter 'SET.'.  This parameter may be negated to suspend the
+C    drawing of curves by the EZ... routines, so that a call to one of
+C    them will produce only a background.  The absolute value of 'SET.'
+C    affects the way in which AUTOGRAPH determines the position and
+C    shape of the graph and the scaling of the axes, as follows:
+C
+C       1 - Restores the default values of the AUTOGRAPH parameters
+C           in question.  AUTOGRAPH will set up an appropriate call
+C           to the plot-package routine "SET", over-riding any prior
+C           call to that routine.
+C
+C       2 - Tells AUTOGRAPH to use arguments 1-4 and 9 of the last
+C           "SET" call.  Arguments 1-4 specify where the graph should
+C           fall on the plotter frame, argument 9 whether the graph
+C           is linear/linear, linear/log, etc.
+C
+C       3 - Tells AUTOGRAPH to use arguments 5-8 and 9 of the last
+C           "SET" call.  Arguments 5-8 specify the scaling of the
+C           axes, argument 9 whether the graph is linear/linear,
+C           linear/log, etc.
+C
+C       4 - A combination of 2 and 3.  Arguments 1-4 of the last "SET"
+C           call specify the position, arguments 5-8 the scaling, and
+C           argument 9 the linear/log nature, of the graph.
+C
+C    (The plot-package routine "SET" is described in the NCAR Graphics
+C    Manual; it is not a part of AUTOGRAPH.)
+C
+C    If the routine DISPLA is called with its argument LTYP non-zero,
+C    the linear/log nature of the graph will be that specified by LTYP,
+C    not that specified by the last "SET" call, no matter what the value
+C    of the control parameter 'SET.'.
+C
+C    The default value of 'SET.' is 1.
+C
+C -- NDSH, if non-zero, specifies a new value of the AUTOGRAPH control
+C    parameter 'DASH/SELECTOR.' (and therefore a new set of dashed-line
+C    patterns), as described below.  Note:  The default value of the
+C    dashed-line parameters is such that all curves will be drawn using
+C    solid lines; if that is what you want, use a zero for NDSH.
+C
+C       If the value of 'DASH/SELECTOR.' is negative, curves produced
+C       by subsequent calls to EZMY or EZMXY will be drawn using a
+C       set of alphabetic dashed-line patterns.  The first curve drawn
+C       by a given call will be labelled 'A', the second 'B', ..., the
+C       twenty-sixth 'Z', the twenty-seventh 'A' again, and so on.
+C       Curves drawn by calls to EZY and EZXY will be unaffected.
+C
+C       If the value of 'DASH/SELECTOR.' is positive, it must be less
+C       than or equal to 26.  The next argument, DSHL, is an array
+C       containing NDSH dashed-line patterns.  All curves produced by
+C       subsequent calls to EZY, EZXY, EZMY, and EZMXY will be drawn
+C       using the dashed-line patterns in (DSHL(I),I=1,NDSH) - the
+C       first curve produced by a given call will have the pattern
+C       specified by DSHL(1), the second that specified by DSHL(2),
+C       the third that specified by DSHL(3), . . . the NDSH+1st that
+C       specified by DSHL(1), . . . etc.  Each element of DSHL must
+C       be a character string, in which a dollar sign stands for a
+C       solid-line segment, a quote stands for a gap, and other
+C       characters stand for themselves.  See the write-up of the
+C       package "DASHCHAR".  Binary dashed-line patterns may not be
+C       defined by means of a call to ANOTAT, only by means of calls
+C       to lower-level routines.
+C
+C -- DSHL (if NDSH is greater than zero) is an array of dashed-line
+C    patterns, as described above.
+C
+C In calls to the routine DISPLA:
+C
+C -- LFRA, if non-zero, specifies a new value for the AUTOGRAPH control
+C    parameter 'FRAME.'.  Possible values are as follows:
+C
+C       1 - The EZ... routines do a frame advance after drawing.
+C
+C       2 - No frame advance is done by the EZ... routines.
+C
+C       3 - The EZ... routines do a frame advance before drawing.
+C
+C    The default value of 'FRAME.' is 1.
+C
+C -- LROW, if non-zero, specifies a new value for the AUTOGRAPH control
+C    parameter 'ROW.'.  This parameter tells AUTOGRAPH how the argument
+C    arrays XDRA and YDRA, in calls to the routines EZMY and EZMXY, are
+C    subscripted, as follows:
+C
+C       If 'ROW.' is positive, this implies that the first subscript
+C       of YDRA is a point number and the second subscript is a curve
+C       number.  If 'ROW.' is negative, the order is reversed.
+C
+C       If the absolute value of 'ROW.' is 1, this implies that XDRA
+C       is singly-subscripted, by point number only.  If the absolute
+C       value of 'ROW.' is 2 or greater, this implies that XDRA is
+C       doubly-subscripted, just like YDRA.
+C
+C    The default value of 'ROW.' is 1, spicifying that XDRA is singly-
+C    subscripted and that YDRA is doubly-subscripted by point number
+C    and curve number, in that order.
+C
+C -- LTYP, if non-zero, specifies new values for the AUTOGRAPH control
+C    parameters 'X/LOGARITHMIC.' and 'Y/LOGARITHMIC.', which determine
+C    whether the X and Y axes are linear or logarithmic.  Possible
+C    values are as follows:
+C
+C       1 - x axis linear, y axis linear
+C
+C       2 - x axis linear, y axis logarithmic
+C
+C       3 - x axis logarithmic, y axis linear
+C
+C       4 - x axis logarithmic, y axis logarithmic
+C
+C    The default values of these parameters make both axes linear.
+C
+C    If the parameters 'X/LOGARITHMIC.' and 'Y/LOGARITHMIC.' are reset
+C    by the routine DISPLA, they are given values which make them
+C    immune to being reset when 'SET.' = 2, 3, or 4 (see the discussion
+C    of the argument LSET, above).
+C
+C In calls to the routines AGSETP, AGSETF, AGSETI AGSETC, AGGETP,
+C AGGETF, AGGETI, and AGGETC:
+C
+C -- TPGN is a character string identifying a group of AUTOGRAPH
+C    control parameters.  It is of the form 'K1/K2/K3/ . . . /Kn.'.
+C    Each Ki is a keyword.  The keyword K1 specifies a group of control
+C    parameters, K2 a subgroup of that group, K3 a subgroup of that
+C    subgroup, etc.  See the AUTOGRAPH write-up in the graphics manual
+C    for a more complete description of these parameter-group names and
+C    the ways in which they may be abbreviated.
+C
+C -- FURA is an array, from which control-parameter values are to be
+C    taken (the routine AGSETP) or into which they are to be stored
+C    (the routine AGGETP).  Note that the array is real; all of the
+C    AUTOGRAPH parameters are stored internally as reals.
+C
+C -- LURA is the length of the user array FURA.
+C
+C -- FUSR is a variable, from which a single control parameter value is
+C    to be taken (the routine AGSETF) or in which it is to be returned
+C    (the routine AGGETF).  Note that the variable is real.
+C
+C -- IUSR is a variable, from which a single-control parameter value is
+C    to be taken (the routine AGSETI) or in which it is to be returned
+C    (the routine AGGETI).  Note that, since the control parameters are
+C    stored internally as reals, each of the routines AGSETI and AGGETI
+C    does a conversion - from integer to real or vice-versa.  Note also
+C    that AGSETI and AGGETI should only be used for parameters which
+C    have intrinsically integral values.
+C
+C -- CUSR is a character variable from which a character string is to
+C    be taken (the routine AGSETC) or into which it is to be retrieved
+C    (the routine AGGETC).  The control parameter affected by the call
+C    contains the floating-point equivalent of an integer identifier
+C    returned by the routine which stashes the character string and
+C    tendered to the routine which retrieves it (sort of the automated
+C    equivalent of a hat check).  Note that AGSETC and AGGETC should
+C    only be used for parameters which intrinsically represent character
+C    strings.
+C
+C In calls to the routine AGSTUP:
+C
+C -- XDRA is an array of x coordinates of user data - usually, but not
+C    necessarily, the same data which will later be used in calls to
+C    the routine AGCURV.
+C
+C -- NVIX is the number of vectors of data in XDRA - if XDRA is doubly-
+C    dimensioned, NVIX would normally have the value of its second
+C    dimension, if XDRA is singly-dimensioned, a 1.
+C
+C -- IIVX is the index increment between vectors in XDRA - if XDRA is
+C    doubly-dimensioned, IIVX would normally have the value of its
+C    first dimension, if XDRA is singly-dimensioned, a dummy value.
+C
+C -- NEVX is the number of elements in each data vector in XDRA - if
+C    XDRA is doubly-dimensioned, NEVX would normally have the value of
+C    its first dimension, if XDRA is singly-dimensioned, the value of
+C    that single dimension.
+C
+C -- IIEX is the index increment between elements of a data vector in
+C    XDRA - normally a 1.
+C
+C -- YDRA, NVIY, IIVY, NEVY, and IIEY are analogous to XDRA, NVIX,
+C    IIVX, NEVX, and IIEX, but define y-coordinate data.
+C
+C In calls to the routine AGCURV:
+C
+C -- XVEC is a vector of x coordinate data.
+C
+C -- IIEX is the index increment between elements in XVEC.  AGCURV will
+C    use XVEC(1), XVEC(1+IIEX), XVEC(1+2*IIEX), etc.
+C
+C -- YVEC is a vector of y coordinate data.
+C
+C -- IIEY is the index increment between elements in YVEC.  AGCURV will
+C    use YVEC(1), YVEC(1+IIEY), YVEC(1+2*IIEY), etc.
+C
+C -- NEXY is the number of points defining the curve to be drawn.
+C
+C -- KDSH is a dashed-line selector.  Possible values are as follows:
+C
+C       If KDSH is zero, AUTOGRAPH will assume that the user has
+C       called the routine DASHD (in the DASHCHAR package, which see)
+C       to define the dashed-line pattern to be used.
+C
+C       If KDSH is less than zero and has absolute value M, AUTOGRAPH
+C       will use the Mth (modulo 26) alphabetic dashed-line pattern.
+C       Each of these patterns defines a solid line interrupted every
+C       so often by a letter of the alphabet.
+C
+C       If KDSH is greater than zero and has the value M, AUTOGRAPH
+C       will use the Mth (modulo N) dashed-line pattern in the group
+C       of N dashed-line patterns defined by the AUTOGRAPH control
+C       parameters in the group named 'DASH/PATTERNS.'.  The default
+C       values of these parameters specify solid lines.
+C
+C In calls to the routines AGSAVE and AGRSTR:
+C
+C -- IFNO is the unit number associated with a file to which a single
+C    unformatted logical record of data is to be written, or from which
+C    such a record is to be read, by AUTOGRAPH.  The file is not rewound
+C    before being written or read; positioning it properly is the user's
+C    responsibility.
+C
+C In calls to the function AGBNCH:
+C
+C -- IDSH is a 16-bit binary dash pattern, the character equivalent of
+C    which is to be returned as the value of AGBNCH.
+C
+C In calls to the function AGDSHN:
+C
+C -- IDSH is the number of the dash pattern parameter whose name is to
+C    be returned as the value of the function AGDSHN.
+C
+C In calls to the routine AGUTOL:
+C
+C -- IAXS is the number of the axis.  The values 1, 2, 3, and 4 imply
+C    the left, right, bottom, and top axes, respectively.
+C
+C -- FUNS is the value of the parameter 'AXIS/s/FUNCTION.' which may be
+C    used to select the desired mapping function for axis IAXS.  It is
+C    recommended that the default value (zero) be used to specify the
+C    identity mapping.  A non-zero value may be integral (1., 2., etc.)
+C    and serve purely to select the code to be executed or it may be the
+C    value of a real parameter in the equations defining the mapping.
+C
+C -- IDMA specifies the direction of the mapping.  A value greater than
+C    zero indicates that VINP is a value in the user system and that
+C    VOTP is to be a value in the label system, a value less than zero
+C    the opposite.
+C
+C -- VINP is an input value in one coordinate system along the axis.
+C
+C -- VOTP is an output value in the other coordinate system along the
+C    axis.
+C
+C In calls to the routine AGCHAX:
+C
+C -- IFLG is zero if a particular object is about to be drawn, non-zero
+C    if it has just been drawn.
+C
+C -- IAXS is the number of the axis being drawn.  The values 1, 2, 3,
+C    and 4 indicate the left, right, bottom, and top axes, respectively.
+C
+C -- IPRT indicates the part of the axis being drawn.  Possible values
+C    are as follows:
+C
+C    -- 1 implies the line of the axis.
+C
+C    -- 2 implies a major tick.
+C
+C    -- 3 implies a minor tick.
+C
+C    -- 4 implies the mantissa of a numeric label.
+C
+C    -- 5 implies the exponent of a numeric label.
+C
+C -- VILS is the value in the label system at the point where the part
+C    is being drawn.  For IPRT = 1, VILS is zero.
+C
+C In calls to the routine AGCHCU:
+C
+C -- IFLG is zero if a particular object is about to be drawn, non-zero
+C    if it has just been drawn.
+C
+C -- KDSH is the value with which AGCURV was called, as follows:
+C
+C       AGCURV called by   Value of KDSH
+C       ----------------   ----------------------------------------
+C       EZY                1
+C       EZXY               1
+C       EZMY               "n" or "-n", where n is the curve number
+C       EZMXY              "n" or "-n", where n is the curve number
+C       the user program   the user value
+C
+C In calls to the routine AGCHIL:
+C
+C -- IFLG is zero if a particular object is about to be drawn, non-zero
+C    if it has just been drawn.
+C
+C -- LBNM is a character variable containing the name of the label being
+C    drawn.
+C
+C -- LNNO is the number of the line being drawn.
+C
+C In calls to the routine AGCHNL:
+C
+C -- IAXS is the number of the axis being drawn.  The values 1, 2, 3,
+C    and 4 imply the left, right, bottom, and top axes, respectively.
+C
+C -- VILS is the value to be represented by the numeric label, in the
+C    label system for the axis.  The value of VILS must not be altered.
+C
+C -- CHRM, on entry, is a character string containing the mantissa of
+C    the numeric label, as it will appear if AGCHNL makes no changes.
+C    If the numeric label includes a "times" symbol, it is represented
+C    by a blank in CHRM.  (See IPXM, below.)  CHRM may be modified.
+C
+C -- MCIM is the length of CHRM - the maximum number of characters that
+C    it will hold.  The value of MCIM must not be altered.
+C
+C -- NCIM, on entry, is the number of meaningful characters in CHRM.  If
+C    CHRM is changed, NCIM should be changed accordingly.
+C
+C -- IPXM, on entry, is zero if there is no "times" symbol in CHRM; if
+C    it is non-zero, it is the index of a character position in CHRM.
+C    If AGCHNL changes the position of the "times" symbol in CHRM,
+C    removes it, or adds it, the value of IPXM must be changed.
+C
+C -- CHRE, on entry, is a character string containing the exponent of
+C    the numeric label, as it will appear if AGCHNL makes no changes.
+C    CHRE may be modified.
+C
+C -- MCIE is the length of CHRE - the maximum number of characters that
+C    it will hold.  The value of MCIE must not be altered.
+C
+C -- NCIE, on entry, is the number of meaningful characters in CHRE.  If
+C    CHRE is changed, NCIE should be changed accordingly.
+C
+C ---------------------------------------------------------------------
+C T H E   A U T O G R A P H   C O D E
+C ---------------------------------------------------------------------
+C
+C Following is the AUTOGRAPH code.  Routines appear in alphabetic order.
+C
+      SUBROUTINE AGAXIS (IAXS,QTST,QSPA,WCWP,HCWP,XBGA,YBGA,XNDA,YNDA,
+     +                   QLUA,UBGA,UNDA,FUNS,QBTP,BASE,QJDP,WMJL,WMJR,
+     +                   QMNT,QNDP,WMNL,WMNR,QLTP,QLEX,QLFL,QLOF,QLOS,
+     +                   DNLA,WCLM,WCLE,RFNL,QCIM,QCIE,WNLL,WNLR,WNLB,
+     +                                                           WNLE)
+C
+C The routine AGAXIS is used to draw, tick-mark, and label an axis or,
+C if ITST is non-zero, to pre-compute the amount of space which will be
+C required for numeric labels when the axis is actually drawn.  AGAXIS
+C assumes that the last call to the plot-package routine SET was as
+C follows (or the equivalent thereof):
+C
+C    CALL SET (XLCW,XRCW,YBCW,YTCW,0.,1.,0.,1.,1)
+C
+C where XLCW, XRCW, YBCW, and YTCW are the coordinates of the left,
+C right, bottom, and top edges of the curve window, stated as fractions
+C of the appropriate edge of the plotter frame.
+C
+C The arguments of AGAXIS are as follows:
+C
+C -- IAXS is the number of the axis being drawn - 1, 2, 3, or 4, meaning
+C    the left, right, bottom, and top axes, respectively.
+C
+C -- ITST is an integer specifying what the caller wishes AGAXIS to do,
+C    as follows:
+C
+C    -- If ITST .LT. 0, AGAXIS is to draw only the axis, nothing else.
+C
+C    -- If ITST .EQ. 0, AGAXIS is to draw, tick, and label the axis.
+C
+C    -- If ITST .GT. 0, AGAXIS is to pre-compute the amount of space
+C       which will be required for numeric labels.  If the labels will
+C       not fit in the space provided, AGAXIS is instructed to take
+C       action as follows:
+C
+C       -- ITST .EQ. 1 - no action.
+C
+C       -- ITST .EQ. 2 - shrink the labels.
+C
+C       -- ITST .EQ. 3 - re-orient the labels.
+C
+C       -- ITST .EQ. 4 - shrink and/or re-orient the labels.
+C
+C -- ISPA is a 0 or a 1, specifying whether or not the axis itself is
+C    to be drawn.  If ISPA .NE. 0, the axis is suppressed.  Tick marks
+C    and/or labels may still be drawn.
+C
+C -- WCWP is the width of the curve window, in plotter units.
+C
+C -- HCWP is the height of the curve window, in plotter units.
+C
+C -- XBGA, YBGA, XNDA, and YNDA are the x and y coordinates of the ends
+C    of the axis.  X coordinates are stated as fractions of the width,
+C    y coordinates as fractions of the height, of the curve window.  The
+C    axis to be drawn must be either horizontal or vertical (at an angle
+C    of 0, 90, 180, or 270 degrees).  The left side, right side, begin-
+C    ning, and end of the axis are defined from the viewpoint of a demon
+C    standing at (XBGA,YBGA) and staring balefully toward (XNDA,YNDA).
+C
+C -- LLUA, UBGA, and UNDA define the mapping of the "user" coordinate
+C    system (used for data-point coordinates) onto the axis.  If LLUA
+C    is zero, the mapping is linear; if LLUA is non-zero, the mapping
+C    is logarithmic.  UBGA is the user-system value at the beginning of
+C    the axis, UNDA the value at the end of the axis.  The subroutine
+C    AGFTOL, which needs these parameters, is actually passed LLUA,
+C    UBEG=F(UBGA), and UDIF=F(UNDA)-F(UBGA), where F is the function
+C    F(X)=X or the function F(X)=ALOG10(X), depending on LLUA.
+C
+C -- FUNS is a function-selector, to be used in calls to AGUTOL, which
+C    defines the mappings from the user system to the label system and
+C    vice-versa for each of the four axes.  The functions defined must
+C    be continuous, monotonic, and bounded within the user-system range
+C    (UBGA,UNDA) and a little bit outside that range.  The positions
+C    of numeric labels and tick marks are chosen in the label system,
+C    mapped to the user system, and then onto the axis.
+C
+C -- NBTP and BASE specify how major ticks are to be positioned in the
+C    label coordinate system.  See the routine AGNUMB (arguments NBTP,
+C    SBSE, and EXMU) for a description of these arguments.  Note that
+C    NBTP .EQ. 0 or BASE .EQ. 0. suppresses both major tick marks and
+C    their labels.  Note:  SBSE .EQ. +BASE or -BASE, as needed.
+C
+C -- QJDP is the major-tick-mark dash pattern (0. .LE. QJDP .LE. 65535.)
+C    QJDP .LE. 0 suppresses major ticks.
+C
+C -- WMJL and WMJR are the distances to the left and right ends of the
+C    major tick marks, stated as fractions of the shortest side of the
+C    curve window.  Values .EQ. 0 may be used to suppress one or both
+C    portions.  Values .GE. 1 may be used to extend a given portion all
+C    the way to the edge of the curve window.  (See routine AGCTKO.)
+C
+C -- NMNT is the number of minor tick marks to be placed between each
+C    pair of consecutive major tick marks.  NMNT .EQ. 0 suppresses them.
+C
+C -- QNDP, WMNL, and WMNR are analogous to QJDP, WMJL, and WMJR, but
+C    specify minor-tick-mark characteristics.
+C
+C -- NLTP, NLEX, and NLFL specify the graphic form of numeric labels, as
+C    described in the routine AGNUMB (which see).  Note that NLTP .LE. 0
+C    suppresses numeric labels.
+C
+C -- NLOF and NLOS are first and second choices for the numeric label
+C    orientation.  Both must be multiples of 90, specifying an angle
+C    measured in degrees counter-clockwise from a vector running from
+C    left to right in the curve window.  If ITST .EQ. 0, AGAXIS uses
+C    NLOF if it is .GE. 0, NLOS otherwise, for the label orientation.
+C    If ITST .NE. 0, AGAXIS initially makes both NLOF and NLOS positive.
+C    Then, if ITST .GE. 3, NLOF may or may not be made negative.  (To
+C    set the sign of NLOF or NLOS, AGAXIS adds or subtracts 360*K.)
+C
+C -- DNLA is the desired distance of numeric labels from the axis,
+C    positive to the left, negative to the right, of the axis.  The
+C    magnitude of DNLA is the size of the gap between the axis and the
+C    nearest edge of a label, expressed as a fraction of the smaller
+C    dimension of the curve window.  See also RFNL, below.
+C
+C -- WCLM and WCLE are the desired widths of characters in the mantissa
+C    or the exponent, respectively, of numeric labels, expressed as a
+C    fraction of the smaller dimension of the curve window.  See also
+C    RFNL, below.
+C
+C -- RFNL is a reduction factor, used as a multiplier for DNLA, WCLM,
+C    and WCLE.  If ITST .NE. 0, RFNL is initially set to 1. - then, if
+C    ITST .EQ. 2 or 4, it is reset as necessary to shrink the labels.
+C
+C -- MCIM and MCIE specify the maximum number of characters in the
+C    mantissa and exponent, respectively, of a numeric label.  These
+C    are input parameters if ITST .EQ. 0, output parameters otherwise.
+C
+C -- WNLL, WNLR, WNLB, and WNLE are the widths of numeric-label strips
+C    on the left side, on the right side, at the beginning, and at the
+C    end, of the axis.  These are both input and output parameters of
+C    AGAXIS.  On input, they specify the amount of space available for
+C    numeric labels - on output, they specify the amount of space used
+C    (if ITST .EQ. 0) or required (if ITST .NE. 0).  Each is stated as
+C    a fraction of either the width or the height of the curve window,
+C    depending on the orientation of the axis in the curve window.
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.  The only ones
+C actually used here are ISLD, MWCM, MWCE, and MDLA.  ISLD is a solid-
+C line dash pattern (sixteen one bits).  MWCM, MWCE, and MDLA specify
+C the minimum allowed values of the width of a character in a label
+C mantissa, the width of a character in a label exponent, and the
+C distance of a label from the axis.  All are in plotter coordinate
+C units.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The AUTOGRAPH function AGFPBN is of type integer.
+C
+      INTEGER AGFPBN
+C
+C Local data required are as follows:
+C
+C BFRM is a buffer in which the routine AGNUMB returns the characters of
+C a label mantissa.  CTMP holds a sub-string from an AGPWRT call.
+C
+      CHARACTER*40 BFRM
+      CHARACTER*40 CTMP
+C
+C BFRE is a buffer in which the routine AGNUMB returns the characters of
+C a label exponent.
+C
+      CHARACTER*5 BFRE
+C
+C XMJT, YMJT, XMNT, and YMNT are used to hold x and y offsets to the
+C endpoints of left-of-label and right-of-label portions of major and
+C minor tick marks.
+C
+      DIMENSION XMJT(4),YMJT(4),XMNT(4),YMNT(4)
+C
+C SMJP is the minimum distance allowed between major tick marks, in
+C plotter coordinate units.
+C
+      DATA SMJP / 4. /
+C
+C FBGM, FBGP, FNDM, and FNDP are the coordinates of points a little on
+C either side of the beginning and end of the axis, as fractions of the
+C distance along the axis.
+C
+      DATA FBGM / -0.000001 /
+      DATA FBGP / +0.000001 /
+      DATA FNDM / +0.999999 /
+      DATA FNDP / +1.000001 /
+C
+C HCFW is an arithmetic statement function specifying the height of a
+C character as a function of its width (not counting "white space").
+C The value of the multiplier was determined heuristically, by trying
+C various values and seeing which gave the best results.
+C
+      HCFW(WDTH)=1.25*WDTH
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This is the initialization section of AGAXIS.
+C
+C Unpack integer values from floating-point arguments.
+C
+      ITST=IFIX(QTST)
+      ISPA=IFIX(QSPA)
+      LLUA=IFIX(QLUA)
+      NBTP=IFIX(QBTP)
+      NMNT=IFIX(QMNT)
+      NLTP=IFIX(QLTP)
+      NLEX=IFIX(QLEX)
+      NLFL=IFIX(QLFL)
+      NLOF=IFIX(QLOF)
+      NLOS=IFIX(QLOS)
+      MCIM=IFIX(QCIM)
+      MCIE=IFIX(QCIE)
+C
+C Initialize the local flags which specify what entities to draw, using
+C values appropriate for the following quick exit.
+C
+      LDAX=1-ISPA
+      LDNL=0
+      LDMN=0
+C
+C If AGAXIS is to draw only the axis, exit immediately.
+C
+      IF (ITST.LT.0) GO TO 800
+C
+C If either NBTP or BASE is zeroed, exit immediately.
+C
+      IF (NBTP.EQ.0.OR.BASE.EQ.0.) GO TO 800
+C
+C Re-initialize the flag controlling the drawing of numeric labels.
+C
+      IF (NLTP.NE.0) LDNL=1
+C
+C If this is not a test run, skip.
+C
+      IF (ITST.EQ.0) GO TO 101
+C
+C This is a test run - exit if there are no numeric labels.
+C
+      IF (LDNL.EQ.0) GO TO 800
+C
+C This is a test run and the axis is to have numeric labels - initialize
+C the numeric-label orientation and sizing parameters.  Clobber drawing.
+C
+      NLOF=MOD(NLOF+3600,360)
+      NLOS=MOD(NLOS+3600,360)
+      RFNL=1.
+      MCIM=0
+      MCIE=0
+      LDMJ=0
+      LDMN=0
+C
+C The main body of the initialization follows.
+C
+C Compute the length of the smaller side of the curve window, in the
+C plotter coordinate system.
+C
+  101 SCWP=AMIN1(WCWP,HCWP)
+C
+C Compute a set of direction numbers for the axis, in the curve-window
+C coordinate system (the change in x and y from the beginning to the
+C end of the axis).
+C
+      XDNA=XNDA-XBGA
+      YDNA=YNDA-YBGA
+C
+C Compute the length of the axis in the plotter coordinate system and
+C its direction cosines.
+C
+      XDNP=XDNA*WCWP
+      YDNP=YDNA*HCWP
+      AXLP=SQRT(XDNP*XDNP+YDNP*YDNP)
+      XDCA=XDNP/AXLP
+      YDCA=YDNP/AXLP
+C
+C Compute the axis orientation angle, in degrees counter-clockwise.
+C
+      IAOR=MOD(IFIX(57.2957795130823*ATAN2(YDCA,XDCA)+3600.5),360)
+C
+C Compute the multiplicative constants required to convert a fraction of
+C the axis length to a fraction of the width or height of the curve
+C window (a distance in x or y).
+C
+      CFAX=AXLP/WCWP
+      CFAY=AXLP/HCWP
+C
+C Compute the multiplicative constants required to convert a fraction of
+C the axis length to a fraction of the along-axis and perpendicular-to-
+C axis sides of the curve window.
+C
+      CFAA=ABS(XDCA*CFAX+YDCA*CFAY)
+      CFAP=ABS(XDCA*CFAY+YDCA*CFAX)
+C
+C Compute the quantities (UBEG) and (UDIF) for AGFTOL.
+C
+      IF (LLUA.NE.0) GO TO 102
+C
+      UBEG=UBGA
+      UDIF=UNDA-UBGA
+      GO TO 103
+C
+  102 UBEG=ALOG10(UBGA)
+      UDIF=ALOG10(UNDA)-UBEG
+C
+C SMJT and SMNT are fractions of the axis length and specify the minimum
+C space which must be available between two major ticks before the major
+C ticks themselves or the minor ticks between them, respectively, may be
+C drawn.
+C
+  103 SMJT=SMJP/AXLP
+      SMNT=SMJT*FLOAT(NMNT+1)
+C
+C Initialize the fractional numeric-label character heights.
+C
+      FHCM=0.
+      FHCE=0.
+C
+C If the axis has no numeric labels, skip the following code.
+C
+      IF (LDNL.EQ.0) GO TO 104
+C
+C Zero the numeric-label offset.
+C
+      FNLO=0.
+C
+C The numeric-label parameters are computed by an internal procedure
+C (which see, below).
+C
+      ASSIGN 104 TO JMP3
+      GO TO 500
+C
+C If this is a test run, skip the following code.
+C
+  104 IF (ITST.NE.0) GO TO 200
+C
+C This is not a test run.  First, set up the tick-mark parameters.
+C
+C Compute the multiplicative constant required to convert a fraction of
+C the smaller dimension of the grid to a fraction of the axis length.
+C
+      CSFA=SCWP/AXLP
+C
+C Compute the widths of the left and right portions of the numeric-label
+C space as fractions of the axis length, affixing an appropriate sign.
+C
+      FNLL=-WNLL/CFAP
+      FNLR=+WNLR/CFAP
+C
+C Compute a jump parameter to sort out the axis orientations.
+C
+      JAOR=1+IAOR/90
+C
+C The routine AGCTKO is used to compute the rest of the tick parameters.
+C
+      CALL AGCTKO (XBGA,YBGA,XDCA,YDCA,CFAX,CFAY,CSFA,JAOR,   1,QJDP,
+     +             WMJL,WMJR,FNLL,FNLR,MJ12,MJ34,XMJT,YMJT)
+C
+      CALL AGCTKO (XBGA,YBGA,XDCA,YDCA,CFAX,CFAY,CSFA,JAOR,NMNT,QNDP,
+     +             WMNL,WMNR,FNLL,FNLR,MN12,MN34,XMNT,YMNT)
+C
+C Set the flags controlling the drawing of tick marks.
+C
+      LDMJ=MJ12+MJ34
+      LDMN=MN12+MN34
+      LDLR=-(LDMJ+LDMN)
+C
+C If no numeric labels are to be drawn, skip the following code.
+C
+      IF (LDNL.EQ.0) GO TO 117
+C
+C Numeric labels are to be drawn.  Precompute parameters which will be
+C used to position labels relative to the axis.
+C
+C Compute the widths and heights of the longest possible label mantissa
+C and exponent, as fractions of the length of the axis.
+C
+      FWLM=FLOAT(MCIM)*FWCM
+      FWLE=FLOAT(MCIE)*FWCE
+      FHLM=FHCM
+      FHLE=FHCE
+      IF (MCIE.EQ.0) FHLE=0.
+C
+C Jump on the label-to-axis orientation.
+C
+      GO TO (105,106,107,108) , JLAO
+C
+C Label is at a 0-degree angle to the axis.
+C
+  105 FBLP=-FHLM
+      GO TO 109
+C
+C Label is at a 90-degree angle to the axis.
+C
+  106 FBLA=0.
+      FBLQ=-FWLM-FWLE
+      GO TO 110
+C
+C Label is at a 180-degree angle to the axis.
+C
+  107 FBLP=FHLM+FHLE
+      GO TO 109
+C
+C Label is at a 270-degree angle to the axis.
+C
+  108 FBLA=0.
+      FBLQ=FWLM+FWLE
+      GO TO 110
+C
+C Label is parallel to the axis.
+C
+  109 FNLW=FHLM+.5*FHLE
+      FBLQ=0.
+      GO TO 111
+C
+C Label is perpendicular to the axis.
+C
+  110 FNLW=FWLM+FWLE
+      FBLP=0.
+C
+C If the labels will not fit in the space provided, clobber them.
+C
+  111 IF (.999999*FNLW.LT.FNLR-FNLL) GO TO 112
+C
+      LDNL=0
+      GO TO 117
+C
+C Jump on the signed value of the numeric-label distance from the axis.
+C
+  112 IF (DNLA) 113,114,115
+C
+C Labels are to the right of the axis.
+C
+  113 FNLC=FDLA+.5*FNLW
+      FBLP=FDLA+.5*ABS(FBLP-FHLE)
+      FBLQ=FDLA+.5*ABS(FBLQ+FWLM-FWLE)
+      GO TO 116
+C
+C Labels are centered on the axis.
+C
+  114 FNLC=0.
+      FBLP=0.
+      FBLQ=0.
+      GO TO 116
+C
+C Labels are to the left of the axis.
+C
+  115 FNLC=-(FDLA+.5*FNLW)
+      FBLP=-(FDLA+.5*ABS(FBLP))
+      FBLQ=-(FDLA+.5*ABS(FBLQ-FWLM+FWLE))
+C
+  116 FNLO=.5*(FNLL+FNLR)-FNLC
+C
+C If the axis would pass through the offset labels, clobber it.
+C
+      IF (FNLL*FNLR.LT.0.) LDAX=0
+C
+C Jump to draw numeric labels and/or tick marks.
+C
+      GO TO 200
+C
+C No numeric labels are to be drawn.  If no tick marks are to be drawn
+C either, exit.
+C
+  117 IF (LDLR.EQ.0) GO TO 800
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following code directs the process of tick-marking and labelling
+C the axis, using the internal procedures which follow it.  If the
+C label-coordinate-system value 0 maps onto the axis, tick-marking and
+C labelling are done in two passes, one starting at 0 and proceeding
+C in a positive direction and the other starting at 0 and proceeding
+C in a negative direction.  If the label-coordinate-system value 0 does
+C not map onto the axis, only one pass is required.
+C
+C First, determine the label-coordinate-system values VBGM and VNDP at
+C the points FBGM and FNDP, a little beyond the ends of the axis.
+C
+  200 CALL AGFTOL (IAXS,1,FBGM,VBGM,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,BASE)
+      CALL AGFTOL (IAXS,1,FNDP,VNDP,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,BASE)
+C
+C If zero falls on the axis, jump to the two-pass section of the code.
+C
+      IF (VBGM*VNDP.LE.0.) GO TO 201
+C
+C We may tick-mark and label the axis in a single pass.  Compute an
+C appropriate starting value for the exponent/multiplier EXMU.
+C
+      SBSE=SIGN(BASE,VBGM)
+      CALL AGFTOL (IAXS,2,FBGM,EBGM,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+      CALL AGFTOL (IAXS,2,FNDP,ENDP,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+      EXMU=AMIN1(EBGM,ENDP)
+      EXMU=EXMU-AMOD(EXMU,1.)+.5+SIGN(.5,EXMU)
+C
+C Set the numeric-label-space limits for the beginning and end of the
+C axis.
+C
+      FNLB=FBGM-WNLB/CFAA-.5*(FHCM+FHCE)
+      FNLE=FNDP+WNLE/CFAA+.5*(FHCM+FHCE)
+C
+C Jump to an internal procedure to tick-mark and label the axis.  Return
+C from there to the termination section of AGAXIS.
+C
+      ASSIGN 800 TO JMP1
+      GO TO 300
+C
+C Tick marks and labels must be done in two passes.  First, draw the
+C tick mark and/or label at the zero position in the label system, using
+C an internal procedure below.  A number of parameters must be preset.
+C
+  201 CALL AGFTOL (IAXS,-1,0.,FRAX,VLCS,LLUA,UBEG,UDIF,FUNS,NBTP,BASE)
+C
+C Determine whether label is to be drawn or not.
+C
+      LDLB=0
+      IF (LDNL.EQ.0) GO TO 202
+      LDLB=1
+C
+C The mantissa portion of the label consists of the single character 0.
+C
+      BFRM(1:1)='0'
+      NCIM=1
+      IPXM=0
+C
+C The label has no exponent portion.
+C
+      NCIE=0
+C
+C Allow the user to change the numeric label.
+C
+      CALL AGCHNL (IAXS,VLCS,BFRM,40,NCIM,IPXM,BFRE,5,NCIE)
+C
+C Compute the length of the mantissa, the exponent, and the whole label.
+C
+      FLLM=FLOAT(NCIM)*FWCM
+      FLLE=FLOAT(NCIE)*FWCE
+      FLLB=FLLM+FLLE
+C
+C The numeric-label space begins and ends at impossible values.
+C
+      FNLB=-10.
+      FNLE=+10.
+C
+C Force the labeler to update FNLB, rather than FNLE.
+C
+      FDIR=1.
+C
+C Jump to an internal procedure to draw the label and/or the tick mark.
+C
+  202 ASSIGN 203 TO JMP2
+      GO TO 400
+C
+C Save the position of the zero-point (FRAX, expressed as a fraction of
+C the axis length) and preset the parameter DZRT, which is the minimum
+C distance from the zero-point at which a major tick mark could occur,
+C and the parameter DZRL, which is the minimum distance from the zero-
+C point at which a label could occur.  Set the label-space limit FNLE.
+C Preset the internal-procedure exit parameter JMP1.
+C
+  203 ASSIGN 205 TO JMP1
+      FZRO=FRAX
+      DZRT=AMAX1(SMJT,1.6*FLOAT(LDNL)*FHCM)
+      IF (LDNL.EQ.0) GO TO 204
+      DZRL=FNLB-FZRO
+      FNLE=FNDP+WNLE/CFAA+.5*(FHCM+FHCE)
+C
+C Do the portion of the axis lying in the direction specified by DZRT.
+C If it is too short, skip it entirely.
+C
+  204 FRAX=FZRO+DZRT
+      IF (FRAX.LT.FBGM.OR.FRAX.GT.FNDP) GO TO JMP1 , (205,800)
+C
+C Find out whether BASE must be negated for this portion.
+C
+      CALL AGFTOL (IAXS,1,FRAX,VLCS,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,BASE)
+      SBSE=SIGN(BASE,VLCS)
+C
+C Compute a starting value of the exponent/multiplier EXMU.
+C
+      CALL AGFTOL (IAXS,2,FRAX,EXMU,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+      EXMU=EXMU-AMOD(EXMU,1.)+.5+SIGN(.5,EXMU)
+C
+C Jump to an internal procedure to draw the tick marks and/or labels.
+C
+      GO TO 300
+C
+C Set up to do the second portion of the axis, then go do it.
+C
+  205 ASSIGN 800 TO JMP1
+      DZRT=-DZRT
+      IF (LDNL.EQ.0) GO TO 204
+      FNLB=FBGM-WNLB/CFAA-.5*(FHCM+FHCE)
+      FNLE=FZRO-DZRL
+      GO TO 204
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following is an internal procedure, exited via the assigned-go-to
+C variable JMP1.  Its purpose is to tick-mark and label a portion of the
+C axis (perhaps the entire axis) at positions determined by consecutive
+C values of the parameter EXMU.  It prevents tick marks from piling up
+C or passing through the label space and prevents overlapping of labels.
+C Tick marks are drawn alternately from left to right or vice-versa.
+C
+C The caller has provided an initial value of EXMU, but we must consider
+C possible minor tick marks in the interval (EXMU-1.,EXMU).
+C
+  300 EXMU=EXMU-1.
+C
+C Compute FRAX, which is the fractional distance along the axis, and
+C VLCS, which is the value in the label coordinate system corresponding
+C to the current value of EXMU.
+C
+      CALL AGFTOL (IAXS,-2,EXMU,FRAX,VLCS,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+C
+C Move the current values of EXMU, FRAX, and VLCS to ELST, FLST, and
+C VLST, specifying the last values of these parameters.  Then increment
+C EXMU by 1. and recompute FRAX and VLCS.  (The loop through consecutive
+C values of EXMU begins here.)
+C
+  301 ELST=EXMU
+      FLST=FRAX
+      VLST=VLCS
+C
+      EXMU=EXMU+1.
+      CALL AGFTOL (IAXS,-2,EXMU,FRAX,VLCS,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE)
+C
+C FDIR indicates the direction, FDST the magnitude, of step along axis.
+C
+      FDIR=FRAX-FLST
+      FDST=ABS(FDIR)
+C
+C Draw minor tick marks, if any, in the interval (FLST,FRAX).
+C
+      IF (LDMN.EQ.0.OR.FDST.LT.SMNT) GO TO 304
+C
+C Use the dashed-line pattern for minor tick marks.
+C
+      CALL DASHDB (AGFPBN(QNDP))
+C
+C Minor tick marks are equally spaced in the label-coordinate system.
+C
+      VINC=(VLCS-VLST)/FLOAT(NMNT+1)
+C
+      DO 303 I=1,NMNT
+        VMNT=VLST+VINC*FLOAT(I)
+        CALL AGFTOL (IAXS,-1,VMNT,FMNT,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,
+     +                                                             SBSE)
+        IF (FMNT.LT.FBGP.OR.FMNT.GT.FNDM) GO TO 303
+        XPAX=XBGA+FMNT*XDNA
+        YPAX=YBGA+FMNT*YDNA
+        LDLR=-LDLR
+        IF (LDLR.LT.0) GO TO 302
+        CALL AGCHAX (0,IAXS,3,VMNT)
+        IF (MN12.NE.0) CALL LINED (XPAX+XMNT(1),YPAX+YMNT(1),
+     +                             XPAX+XMNT(2),YPAX+YMNT(2))
+        IF (MN34.NE.0) CALL LINED (XPAX+XMNT(3),YPAX+YMNT(3),
+     +                             XPAX+XMNT(4),YPAX+YMNT(4))
+        CALL AGCHAX (1,IAXS,3,VMNT)
+        GO TO 303
+  302   CALL AGCHAX (0,IAXS,3,VMNT)
+        IF (MN34.NE.0) CALL LINED (XPAX+XMNT(4),YPAX+YMNT(4),
+     +                             XPAX+XMNT(3),YPAX+YMNT(3))
+        IF (MN12.NE.0) CALL LINED (XPAX+XMNT(2),YPAX+YMNT(2),
+     +                             XPAX+XMNT(1),YPAX+YMNT(1))
+        CALL AGCHAX (1,IAXS,3,VMNT)
+  303 CONTINUE
+C
+C If the end of the axis has been reached, return to caller.
+C
+  304 IF (FRAX.LT.FBGM.OR.FRAX.GT.FNDP) GO TO JMP1 , (205,800)
+C
+C Draw the major tick mark and/or the numeric label at FRAX.
+C
+      IF (FDST.LT.SMJT) GO TO 301
+      LDLB=0
+      IF (LDNL.EQ.0) GO TO 305
+      CALL AGNUMB (NBTP,SBSE,EXMU,NLTP,NLEX,NLFL,BFRM,40,NCIM,IPXM,BFRE,
+     +                                                           5,NCIE)
+      CALL AGCHNL (IAXS,VLCS,BFRM,40,NCIM,IPXM,BFRE,5,NCIE)
+C
+C If this is not a test run, mantissa and exponent length are checked.
+C
+      IF (ITST.EQ.0.AND.(NCIM.GT.MCIM.OR.NCIE.GT.MCIE)) GO TO 305
+      LDLB=1
+      FLLM=FLOAT(NCIM)*FWCM
+      FLLE=FLOAT(NCIE)*FWCE
+      FLLB=FLLM+FLLE
+C
+C Use the next internal procedure to draw the major tick and/or label.
+C
+  305 ASSIGN 301 TO JMP2
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following is an internal procedure, exited via the assigned-go-to
+C variable JMP2.  Its purpose is to draw the major tick mark and/or the
+C numeric label at a specified point on the axis or, if ITST is .NE. 0,
+C to predict the amount of space which will be required for such items.
+C
+C Jump if no label is to be drawn.
+C
+  400 IF (LDLB.EQ.0.OR.NCIM.LE.0) GO TO 410
+C
+C See if the label will fit without overlapping another label.  To do
+C this, first compute its fractional length along the axis (FLAA).
+C
+      GO TO (401,402,401,402) , JLAO
+C
+C Label is parallel to the axis.  Allow for inter-label spacing.
+C
+  401 FLAA=FLLB+FWCM
+      GO TO 403
+C
+C Label is perpendicular to the axis.  Ignore exponent portion.
+C
+  402 FLAA=1.6*FHCM
+C
+C Compute the fractional coordinates of the endpoints of the label
+C (along the axis) and see if it will fit in the available label space.
+C
+  403 FLBB=FRAX-.5*FLAA
+      FLBE=FRAX+.5*FLAA
+C
+      IF (FLBB.GE.FNLB.AND.FLBE.LE.FNLE) GO TO 407
+C
+C Label will not fit.  Omit it or, if this is a test run, see if any
+C remedial action is to be taken.
+C
+      LDLB=0
+      IF (ITST.EQ.0) GO TO 411
+C
+C This is a test run and we have two consecutive labels which overlap.
+C See what can be done about it.
+C
+      GO TO (424,404,406,404) , ITST
+C
+C We are allowed to shrink the labels.  See if they are minimum-size
+C already.  If so, the only other possibility is to re-orient them.
+C
+  404 IF (IWCM.LE.MWCM.AND.IWCE.LE.MWCE.AND.IDLA.LE.MDLA) GO TO 405
+C
+C If not, shrink them by an amount based on the extent of the overlap,
+C reset the parameters affected, and start from square one.
+C
+      RFNL=AMIN1(.9,FDST/(FDST+AMAX1(FNLB-FLBB,FLBE-FNLE)))*RFNL
+      MCIM=0
+      MCIE=0
+      ASSIGN 200 TO JMP3
+      GO TO 500
+C
+C If labels have already been shrunk to minimum size, see if we can
+C re-orient them.  If not, at least continue with finding the maximum
+C mantissa and exponent lengths.
+C
+  405 IF (ITST.NE.4) GO TO 424
+C
+C Try re-orienting the labels.  If this has already been tried, or it it
+C would be pointless, skip it, but continue with finding the maximum
+C mantissa and exponent lengths.
+C
+  406 IF (NLOF.LT.0.OR.NLOS.EQ.NLOF.OR.JLAO.EQ.2.OR.JLAO.EQ.4) GO TO 424
+C
+C If re-orienting makes sense, reset the appropriate parameters and
+C start from square one.
+C
+      NLOF=NLOF-360
+      RFNL=1.
+      MCIM=0
+      MCIE=0
+      ASSIGN 200 TO JMP3
+      GO TO 500
+C
+C Label will fit.  Update the label space limits for next time.
+C
+  407 IF (FDIR.GE.0.) GO TO 408
+      FNLE=FLBB
+      GO TO 409
+  408 FNLB=FLBE
+C
+C If this is not just a test shot, go off and draw the tick mark/label.
+C
+  409 IF (ITST.EQ.0) GO TO 411
+C
+C If this is a test shot, update the maximum mantissa and exponent
+C lengths being generated and exit from this internal procedure.
+C
+      MCIM=MAX0(MCIM,NCIM)
+      MCIE=MAX0(MCIE,NCIE)
+      GO TO 424
+C
+C No label is to be drawn.  If this is a test shot, exit from this
+C internal procedure without drawing the tick mark.
+C
+  410 IF (ITST.NE.0) GO TO 424
+C
+C Compute x and y coordinates of current axis point.
+C
+  411 XPAX=XBGA+FRAX*XDNA
+      YPAX=YBGA+FRAX*YDNA
+C
+C Jump if no major tick-mark is to be drawn.  Otherwise, set up the
+C dash pattern for major tick-marks.
+C
+      IF (LDMJ.EQ.0) GO TO 414
+      CALL DASHDB (AGFPBN(QJDP))
+C
+C Flip the left-to-right/right-to-left direction flag.
+C
+      LDLR=-LDLR
+C
+C Draw the first portion of the tick mark.
+C
+      IF (LDLR) 413,414,412
+C
+  412 IF (MJ12.NE.0) THEN
+        CALL AGCHAX (0,IAXS,2,VLCS)
+        CALL LINED (XPAX+XMJT(1),YPAX+YMJT(1),XPAX+XMJT(2),YPAX+YMJT(2))
+        CALL AGCHAX (1,IAXS,2,VLCS)
+      END IF
+      GO TO 414
+C
+  413 IF (MJ34.NE.0) THEN
+        CALL AGCHAX (0,IAXS,2,VLCS)
+        CALL LINED (XPAX+XMJT(4),YPAX+YMJT(4),XPAX+XMJT(3),YPAX+YMJT(3))
+        CALL AGCHAX (1,IAXS,2,VLCS)
+      END IF
+C
+C Draw the label, if any.
+C
+  414 IF (LDLB.EQ.0.OR.NCIM.LE.0) GO TO 421
+C
+C Compute the distances from (XPAX,YPAX) to the beginning of the label -
+C along the axis (FBLA) and perpendicular to the axis (FBLP).  Each is a
+C directed distance whose magnitude represents a fraction of the length
+C of the axis.  The values depend on the label/axis orientation and the
+C distance of the label from the axis.  In some cases, these quantities,
+C or portions of them, have already been computed.
+C
+      GO TO (415,416,417,418) , JLAO
+C
+C Label is at a 0-degree angle to the axis.
+C
+  415 FBLA=-.5*FLLB
+      GO TO 419
+C
+C Label is at a 90-degree angle to the axis.
+C
+  416 FBLP=FBLQ+FLLM
+      IF (DNLA.EQ.0.) FBLP=.5*FLLB
+      GO TO 419
+C
+C Label is at a 180-degree angle to the axis.
+C
+  417 FBLA=.5*FLLB
+      GO TO 419
+C
+C Label is at a 270-degree angle to the axis.
+C
+  418 FBLP=FBLQ-FLLM
+      IF (DNLA.EQ.0.) FBLP=-.5*FLLB
+C
+C Draw the mantissa portion of the label (excluding the "X", if any).
+C
+  419 DEEX=FBLA*XDCA+(FBLP+FNLO)*YDCA
+      DEEY=FBLA*YDCA-(FBLP+FNLO)*XDCA
+      CALL AGCHAX (0,IAXS,4,VLCS)
+      IF (IPXM.EQ.0) THEN
+        CALL AGPWRT (XPAX+CFAX*DEEX,
+     +               YPAX+CFAY*DEEY,BFRM,NCIM,IWCM,NLOR,-1)
+      ELSE
+        CALL AGPWRT (XPAX+CFAX*(DEEX+(FLLM-3.*FWCM)*XDCL),
+     +               YPAX+CFAY*(DEEY+(FLLM-3.*FWCM)*YDCL),
+     +               BFRM,IPXM-1,IWCM,NLOR,+1)
+        CTMP=BFRM(IPXM+1:NCIM)
+        CALL AGPWRT (XPAX+CFAX*(DEEX+(FLLM-2.*FWCM)*XDCL),
+     +               YPAX+CFAY*(DEEY+(FLLM-2.*FWCM)*YDCL),
+     +               CTMP,NCIM-IPXM,IWCM,NLOR,-1)
+      END IF
+      DEEX=DEEX+FLLM*XDCL
+      DEEY=DEEY+FLLM*YDCL
+C
+C Draw the "X" portion of the mantissa, if it was left out above.
+C
+      IF (IPXM.EQ.0) GO TO 420
+      DEEX=DEEX-2.5*FWCM*XDCL
+      DEEY=DEEY-2.5*FWCM*YDCL
+      CALL LINE (XPAX+CFAX*(DEEX-.3*FWCM*(XDCL-YDCL)),
+     +           YPAX+CFAY*(DEEY-.3*FWCM*(YDCL+XDCL)),
+     +           XPAX+CFAX*(DEEX+.3*FWCM*(XDCL-YDCL)),
+     +           YPAX+CFAY*(DEEY+.3*FWCM*(YDCL+XDCL)))
+      CALL LINE (XPAX+CFAX*(DEEX-.3*FWCM*(XDCL+YDCL)),
+     +           YPAX+CFAY*(DEEY-.3*FWCM*(YDCL-XDCL)),
+     +           XPAX+CFAX*(DEEX+.3*FWCM*(XDCL+YDCL)),
+     +           YPAX+CFAY*(DEEY+.3*FWCM*(YDCL-XDCL)))
+      DEEX=DEEX+2.5*FWCM*XDCL
+      DEEY=DEEY+2.5*FWCM*YDCL
+  420 CALL AGCHAX (1,IAXS,4,VLCS)
+C
+C Draw the exponent portion of the label (if it has one).
+C
+      IF (NCIE.EQ.0) GO TO 421
+      DEEX=DEEX-.5*FHCM*YDCL
+      DEEY=DEEY+.5*FHCM*XDCL
+      CALL AGCHAX (0,IAXS,5,VLCS)
+      CALL AGPWRT (XPAX+CFAX*DEEX,YPAX+CFAY*DEEY,BFRE,NCIE,IWCE,NLOR,-1)
+      CALL AGCHAX (1,IAXS,5,VLCS)
+C
+C Draw the second portion of the tick mark, if any.
+C
+  421 IF (LDLR) 423,424,422
+C
+  422 IF (MJ34.NE.0) THEN
+        CALL AGCHAX (0,IAXS,2,VLCS)
+        CALL LINED (XPAX+XMJT(3),YPAX+YMJT(3),XPAX+XMJT(4),YPAX+YMJT(4))
+        CALL AGCHAX (1,IAXS,2,VLCS)
+      END IF
+      GO TO 424
+C
+  423 IF (MJ12.NE.0) THEN
+        CALL AGCHAX (0,IAXS,2,VLCS)
+        CALL LINED (XPAX+XMJT(2),YPAX+YMJT(2),XPAX+XMJT(1),YPAX+YMJT(1))
+        CALL AGCHAX (1,IAXS,2,VLCS)
+      END IF
+C
+C Exit from internal procedure.
+C
+  424 GO TO JMP2 , (203,301)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following is an internal procedure, exited via the assigned-go-to
+C variable JMP3.  Its purpose is to compute all numeric-label parameters
+C required by AGAXIS.
+C
+C Compute the desired label orientation and its direction cosines.
+C
+  500 NLOR=NLOF
+      IF (NLOR.LT.0) NLOR=NLOS
+C
+      XDCL=COS(.017453292519943*FLOAT(NLOR))
+      YDCL=SIN(.017453292519943*FLOAT(NLOR))
+C
+C Compute JLAO, which is a computed-go-to jump parameter specifying the
+C label-to-axis orientation.
+C
+      JLAO=1+MOD(NLOR-IAOR+3600,360)/90
+C
+C Compute the width of a character in the label mantissa, the width of a
+C character in the label exponent, and the distance of a label from the
+C axis, in the plotter coordinate system.
+C
+      IWCM=MAX0(MWCM,IFIX(RFNL*ABS(WCLM)*SCWP+.5))
+      IWCE=MAX0(MWCE,IFIX(RFNL*ABS(WCLE)*SCWP+.5))
+      IDLA=MAX0(MDLA,IFIX(RFNL*ABS(DNLA)*SCWP+.5))
+C
+C Compute the same quantities as fractions of the axis length.
+C
+      FWCM=FLOAT(IWCM)/AXLP
+      FWCE=FLOAT(IWCE)/AXLP
+      FDLA=FLOAT(IDLA)/AXLP
+C
+C Compute character heights as fractions of the axis length.
+C
+      FHCM=HCFW(FWCM)
+      FHCE=HCFW(FWCE)
+C
+C Return to internal-procedure caller.
+C
+      GO TO JMP3 , (104,200,801)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This is the termination section of AGAXIS.
+C
+C Update the parameters WNLL and WNLR to reflect the amount of space
+C used/needed for numeric labels to the left and right of the axis.
+C
+  800 IF (LDNL.NE.0) GO TO 801
+C
+C No numeric labels occur on the axis.  Zero WNLL and WNLR and jump.
+C
+      WNLL=0.
+      WNLR=0.
+      GO TO 815
+C
+C Numeric labels do occur on the axis.  Compute the space required.
+C
+  801 GO TO (802,803,802,803) , JLAO
+C
+C Labels are parallel to the axis.
+C
+  802 FNLW=FHCM
+      IF (MCIE.NE.0) FNLW=FNLW+.5*FHCE
+      GO TO 804
+C
+C Labels are perpendicular to the axis.
+C
+  803 FNLW=FLOAT(MCIM)*FWCM+FLOAT(MCIE)*FWCE
+C
+C Jump on the numeric-label-distance-from-axis parameter DNLA.
+C
+  804 IF (DNLA) 805,806,807
+C
+C Labels are to the right of the axis.
+C
+  805 FNLL=-FDLA
+      FNLR=+FDLA+FNLW
+      GO TO 808
+C
+C Labels are centered on the axis.
+C
+  806 FNLL=+.5*FNLW
+      FNLR=+.5*FNLW
+      GO TO 808
+C
+C Labels are to the left of the axis.
+C
+  807 FNLL=+FDLA+FNLW
+      FNLR=-FDLA
+C
+C Adjust FNLL and FNLR as implied by the numeric-label offset.
+C
+  808 FNLL=FNLL-FNLO
+      FNLR=FNLR+FNLO
+C
+C If this is not a test run, jump to reset WNLL and WNLR.
+C
+      IF (ITST.EQ.0) GO TO 814
+C
+C If this is a test run, see if the labels will fit.  Jump if so.
+C
+      IF (CFAP*FNLL.LE.WNLL.AND.CFAP*FNLR.LE.WNLR) GO TO 814
+C
+C If the labels will not fit, we have a problem.  We may or may not be
+C able to do anything about it, depending on ITST.
+C
+      GO TO (814,809,813,809) , ITST
+C
+C We are allowed to shrink the labels.  See if they are minimum-size
+C already.  If so, the only other possibility is to re-orient them.
+C
+  809 IF (IWCM.LE.MWCM.AND.IWCE.LE.MWCE.AND.IDLA.LE.MDLA) GO TO 812
+C
+C If not, shrink them by an amount based on the extent of the problem,
+C reset the parameters affected and see if the problem is solved.
+C
+      IF (WNLR+WNLL.GT.0.) GO TO 810
+C
+      RFNL=.000001*RFNL
+      GO TO 811
+C
+  810 RFNL=AMIN1(.9,(WNLL+WNLR)/(CFAP*(FNLL+FNLR)))*RFNL
+C
+  811 ASSIGN 801 TO JMP3
+      GO TO 500
+C
+C If labels have already been shrunk to minimum size, see if we can
+C re-orient them.  If not, give up.
+C
+  812 IF (ITST.NE.3) GO TO 814
+C
+C Try re-orienting the labels.  If this has already been tried, or if it
+C would be pointless, give up.
+C
+  813 IF (NLOF.LT.0.OR.NLOS.EQ.NLOF.OR.JLAO.EQ.1.OR.JLAO.EQ.3) GO TO 814
+C
+C If re-orienting makes sense, reset the parameters affected and see if
+C the problem is solved.
+C
+      NLOF=NLOF-360
+      RFNL=1.
+      ASSIGN 801 TO JMP3
+      GO TO 500
+C
+C Reset WNLL and WNLR for caller.
+C
+  814 WNLL=FNLL*CFAP
+      WNLR=FNLR*CFAP
+C
+C If this is a test run, we are now done.
+C
+  815 IF (ITST.GT.0) GO TO 816
+C
+C Draw the axis, if it is to be drawn.
+C
+      IF (LDAX.EQ.0) GO TO 816
+C
+      CALL DASHDB (ISLD)
+      CALL AGCHAX (0,IAXS,1,0.)
+      CALL LINED (XBGA,YBGA,XNDA,YNDA)
+      CALL AGCHAX (1,IAXS,1,0.)
+C
+C Pack up integer values which might have been changed into the
+C corresponding floating-point arguments.
+C
+  816 QLOF=FLOAT(NLOF)
+      QLOS=FLOAT(NLOS)
+      QCIM=FLOAT(MCIM)
+      QCIE=FLOAT(MCIE)
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agback.f b/sys/gio/ncarutil/autograph/agback.f
new file mode 100644
index 00000000..108d2b66
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agback.f
@@ -0,0 +1,152 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGBACK
+C
+C The subroutine AGBACK is used to draw a graph background, as directed
+C by the current contents of the parameter list.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Declare the block data routine external to force it to load.
+C
+C +NOAO - Block data replaced with run time initialization subroutine.
+C
+C     EXTERNAL AGDFLT
+      call agdflt
+C     
+C -NOAO
+C
+C Do an appropriate SET call for the following routines.  The call is
+C equivalent to "CALL SET (XLCW,XRCW,YBCW,YTCW,0.,1.,0.,1.,1)", but
+C makes the viewport cover the whole plotter frame, which avoids the
+C problems resulting from clipping by GKS.
+C
+      CALL SET (0.,1.,0.,1.,-XLCW/(XRCW-XLCW),(1.-XLCW)/(XRCW-XLCW),
+     +                      -YBCW/(YTCW-YBCW),(1.-YBCW)/(YTCW-YBCW),1)
+C
+C Draw the labels, if any, first.
+C
+      IDLB=IFIX(QDLB)
+      IF (IDLB.EQ.0) GO TO 101
+C
+      LBIM=IFIX(QBIM)
+      CALL AGLBLS (IDLB,WCWP,HCWP,FLLB,LBIM,FLLN,DBOX,SBOX,RBOX)
+C
+C Now draw each of the four axes.
+C
+  101 I=0
+C
+  102 I=I+1
+C
+      IF (I.EQ.5) GO TO 108
+C
+      IF (QDAX(I).EQ.0.) GO TO 102
+C
+      GO TO (103,104,105,106) , I
+C
+C Y axis - left.
+C
+  103 WNLB(1)=0.-YBGW
+      IF (XBGA(1)-WNLL(1).LT.DBOX(3,2).AND.
+     +                XBGA(1)+WNLR(1).GT.DBOX(3,1)) WNLB(1)=0.-DBOX(3,4)
+C
+      WNLE(1)=YTGW-1.
+      IF (XBGA(1)-WNLL(1).LT.DBOX(4,2).AND.
+     +                XBGA(1)+WNLR(1).GT.DBOX(4,1)) WNLE(1)=DBOX(4,3)-1.
+C
+      GO TO 107
+C
+C Y axis - right.
+C
+  104 WNLB(2)=YTGW-1.
+      IF (XBGA(2)-WNLR(2).LT.DBOX(4,2).AND.
+     +                XBGA(2)+WNLL(2).GT.DBOX(4,1)) WNLB(2)=DBOX(4,3)-1.
+C
+      WNLE(2)=0.-YBGW
+      IF (XBGA(2)-WNLR(2).LT.DBOX(3,2).AND.
+     +                XBGA(2)+WNLL(2).GT.DBOX(3,1)) WNLE(2)=0.-DBOX(3,4)
+C
+      GO TO 107
+C
+C X axis - bottom.
+C
+  105 WNLB(3)=XRGW-1.
+      IF (YBGA(3)-WNLL(3).LT.DBOX(2,4).AND.
+     +                YBGA(3)+WNLR(3).GT.DBOX(2,3)) WNLB(3)=DBOX(2,1)-1.
+C
+      WNLE(3)=0.-XLGW
+      IF (YBGA(3)-WNLL(3).LT.DBOX(1,4).AND.
+     +                YBGA(3)+WNLR(3).GT.DBOX(1,3)) WNLE(3)=0.-DBOX(1,2)
+C
+      GO TO 107
+C
+C X axis - top.
+C
+  106 WNLB(4)=0.-XLGW
+      IF (YBGA(4)-WNLR(4).LT.DBOX(1,4).AND.
+     +                YBGA(4)+WNLL(4).GT.DBOX(1,3)) WNLB(4)=0.-DBOX(1,2)
+C
+      WNLE(4)=XRGW-1.
+      IF (YBGA(4)-WNLR(4).LT.DBOX(2,4).AND.
+     +                YBGA(4)+WNLL(4).GT.DBOX(2,3)) WNLE(4)=DBOX(2,1)-1.
+C
+  107 Q=AMIN1(0.,QDAX(I))
+C
+      CALL AGAXIS (I,Q,
+     +             QSPA(I),WCWP,HCWP,XBGA(I),YBGA(I),XNDA(I),YNDA(I),
+     +             QLUA(I),UBGA(I),UNDA(I),FUNS(I),QBTP(I),BASE(I),
+     +             QJDP(I),WMJL(I),WMJR(I),QMNT(I),QNDP(I),WMNL(I),
+     +             WMNR(I),QLTP(I),QLEX(I),QLFL(I),QLOF(I),QLOS(I),
+     +             DNLA(I),WCLM(I),WCLE(I),RFNL(I),QCIM(I),QCIE(I),
+     +             WNLL(I),WNLR(I),WNLB(I),WNLE(I))
+C
+      GO TO 102
+C
+C Do set call for user and return.
+C
+  108 CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,
+     +                            1+IABS(IFIX(QLUX))*2+IABS(IFIX(QLUY)))
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agbnch.f b/sys/gio/ncarutil/autograph/agbnch.f
new file mode 100644
index 00000000..4aee636a
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agbnch.f
@@ -0,0 +1,35 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      CHARACTER*16 FUNCTION AGBNCH (IDSH)
+C
+C The value of this function is the character-dash-pattern equivalent of
+C the integer dash pattern IDSH, a string of quotes and/or dollar signs.
+C Note that the support routines IAND and ISHIFT are used.
+C
+      KDSH=IDSH
+C
+      DO 101 I=16,1,-1
+        IF (IAND(KDSH,1).EQ.0) THEN
+          AGBNCH(I:I)=''''
+        ELSE
+          AGBNCH(I:I)='$'
+        END IF
+        KDSH=ISHIFT(KDSH,-1)
+  101 CONTINUE
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agchax.f b/sys/gio/ncarutil/autograph/agchax.f
new file mode 100644
index 00000000..451bce5c
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agchax.f
@@ -0,0 +1,41 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCHAX (IFLG,IAXS,IPRT,VILS)
+C
+C The routine AGCHAX is called by AGAXIS just before and just after each
+C of a selected set of objects on the axes are drawn.  A user may supply
+C a version to change the appearance of these objects.  The arguments
+C are as follows:
+C
+C - IFLG is zero if a particular object is about to be drawn, non-zero
+C   if it has just been drawn.
+C
+C - IAXS is the number of the axis in question.  The values 1, 2, 3, and
+C   4 imply the right, left, bottom, and top axes, respectively.
+C
+C - IPRT is an integer implying which part of the axis is being drawn.
+C   The value 1 implies the line itself, 2 a major tick, 3 a minor tick,
+C   4 the mantissa of a label, and 5 the exponent of a label.
+C
+C - VILS is the value, in the label coordinate system along the axis,
+C   associated with the position of the object being drawn.  IPRT=1
+C   implies VILS=0.
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agchcu.f b/sys/gio/ncarutil/autograph/agchcu.f
new file mode 100644
index 00000000..1364ad28
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agchcu.f
@@ -0,0 +1,44 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCHCU (IFLG,KDSH)
+C
+C The routine AGCHCU is called by AGCURV just before and just after each
+C curve is drawn.  The default version does nothing.  A user may supply
+C a version to change the appearance of the curves.  The arguments are
+C as follows:
+C
+C - IFLG is zero if a curve is about to be drawn, non-zero if a curve
+C   has just been drawn.
+C
+C - KDSH is the last argument of AGCURV, as follows:
+C
+C      AGCURV called by   Value of KDSH
+C      ----------------   ----------------------------------------
+C      EZY                1
+C      EZXY               1
+C      EZMY               "n" or "-n", where n is the curve number
+C      EZMXY              "n" or "-n", where n is the curve number
+C      the user program   the user value
+C
+C   The sign of KDSH, when AGCURV is called by EZMY or EZMXY, indicates
+C   whether the "user" dash patterns or the "alphabetic" dash patterns
+C   were selected for use.
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agchil.f b/sys/gio/ncarutil/autograph/agchil.f
new file mode 100644
index 00000000..1952cf68
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agchil.f
@@ -0,0 +1,36 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCHIL (IFLG,LBNM,LNNO)
+C
+      CHARACTER*(*) LBNM
+C
+C The routine AGCHIL is called by AGLBLS just before and just after each
+C informational-label line of text is drawn.  The default version does
+C nothing.  A user may supply a version to change the appearance of the
+C text lines.  The arguments are as follows:
+C
+C - IFLG is zero if a text line is about to be drawn, non-zero if one
+C   has just been drawn.
+C
+C - LBNM is the name of the label containing the line in question.
+C
+C - LNNO is the number of the line.
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agchnl.f b/sys/gio/ncarutil/autograph/agchnl.f
new file mode 100644
index 00000000..3b42a5f6
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agchnl.f
@@ -0,0 +1,65 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCHNL (IAXS,VILS,CHRM,MCIM,NCIM,IPXM,CHRE,MCIE,NCIE)
+C
+      CHARACTER*(*) CHRM,CHRE
+C
+C The routine AGCHNL is called by AGAXIS just after it has set up the
+C character strings comprising a numeric label along an axis.  The
+C default version does nothing.  A user may supply his own version to
+C change the numeric labels.  For each numeric label, this routine is
+C called twice by AGAXIS - once to determine how much space will be
+C required when the label is actually drawn and once just before it
+C is actually drawn.  The arguments are as follows:
+C
+C - IAXS is the number of the axis being drawn.  Its value is 1, 2, 3,
+C   or 4, implying the left, right, bottom, or top axes, respectively.
+C   The value of IAXS must not be altered.
+C
+C - VILS is the value to be represented by the numeric label, in the
+C   label system for the axis.  The value of VILS must not be altered.
+C
+C - CHRM, on entry, is a character string containing the mantissa of the
+C   numeric label, as it will appear if AGCHNL makes no changes.  If the
+C   numeric label includes a "times" symbol, it will be represented by
+C   a blank in CHRM.  (See IPXM, below.)  CHRM may be modified.
+C
+C - MCIM is the length of CHRM - the maximum number of characters that
+C   it will hold.  The value of MCIM must not be altered.
+C
+C - NCIM, on entry, is the number of meaningful characters in CHRM.  If
+C   CHRM is changed, NCIM should be changed accordingly.
+C
+C - IPXM, on entry, is zero if there is no "times" symbol in CHRM; if it
+C   is non-zero, it is the index of the appropriate character position
+C   in CHRM.  If AGCHNL changes the position of the "times" symbol in
+C   CHRM, removes it, or adds it, the value of IPXM must be changed.
+C
+C - CHRE, on entry, is a character string containing the exponent of the
+C   numeric label, as it will appear if AGCHNL makes no changes.  CHRE
+C   may be modified.
+C
+C - MCIE is the length of CHRE - the maximum number of characters that
+C   it will hold.  The value of MCIE must not be altered.
+C
+C - NCIE, on entry, is the number of meaningful characters in CHRE.  If
+C   CHRE is changed, NCIE should be changed accordingly.
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agctcs.f b/sys/gio/ncarutil/autograph/agctcs.f
new file mode 100644
index 00000000..d9f67d5f
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agctcs.f
@@ -0,0 +1,79 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCTCS (TPID,ITCS)
+C
+      CHARACTER*(*) TPID
+C
+C The routine AGCTCS is called by the routines AGGETC and AGSETC to
+C check what type of character-string parameter is implied by the
+C parameter identifier TPID and return an appropriate value of ITCS, as
+C follows:
+C
+C -- ITCS = 0 implies that the parameter is not intrinsically of type
+C    character and that AGGETC/AGSETC should not have been called in
+C    the way that it was.
+C
+C -- ITCS = 1 implies a dash-pattern parameter.
+C
+C -- ITCS = 2 implies a label name.
+C
+C -- ITCS = 3 implies the line-end character.
+C
+C -- ITCS = 4 implies the text of some line of some label.
+C
+C Find out where in the parameter list the requested parameter lies.
+C
+      CALL AGSCAN (TPID,LOPA,NIPA,IIPA)
+C
+C See if it's a dash pattern.
+C
+      CALL AGSCAN ('DASH/PATT.',LODP,NIDP,IIDP)
+      IF (LOPA.GE.LODP.AND.LOPA.LE.LODP+NIDP-1) THEN
+        ITCS=1
+        RETURN
+      END IF
+C
+C See if it's a label name.
+C
+      CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN)
+      IF (LOPA.EQ.LOLN) THEN
+        ITCS=2
+        RETURN
+      END IF
+C
+C See if it's the line-end character.
+C
+      CALL AGSCAN ('LINE/END .',LOLE,NILE,IILE)
+      IF (LOPA.EQ.LOLE) THEN
+        ITCS=3
+        RETURN
+      END IF
+C
+C See if it's the text of some label line.
+C
+      CALL AGSCAN ('LINE/BUFF/CONT.',LOLB,NILB,IILB)
+      IF (LOPA.GE.LOLB.AND.LOPA.LE.LOLB+NILB-1.AND.
+     +                                       MOD(LOPA-LOLB,6).EQ.3) THEN
+        ITCS=4
+        RETURN
+      END IF
+C
+C Error - type not recognizable.
+C
+      ITCS=0
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agctko.f b/sys/gio/ncarutil/autograph/agctko.f
new file mode 100644
index 00000000..105438cc
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agctko.f
@@ -0,0 +1,150 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCTKO (XBGA,YBGA,XDCA,YDCA,CFAX,CFAY,CSFA,JAOR,NMMT,
+     +                   QMDP,WMML,WMMR,FNLL,FNLR,MM12,MM34,XMMT,YMMT)
+C
+      DIMENSION XMMT(4),YMMT(4)
+C
+C The routine AGCTKO is used to compute the x and y offsets to the end-
+C points of the left-of-label and right-of-label portions of the major
+C and minor tick marks.  See AGAXIS for definitions of the arguments.
+C
+C A note about WMML and WMMR:  Each is a positive number, of the form
+C (E) or (1+E), where E (=EPSILON) is .LT. 1. and is expressed as a
+C fraction of the smaller side of the curve window.  If the form (E) is
+C used, it implies just a tick of length E; if the form (1+E) is used,
+C it implies a tick long enough to reach the edge of the curve window,
+C plus the length E.
+C
+C If the tick-mark count NMMT .EQ. 0 or the tick-mark dash pattern QMDP
+C .EQ. 0 or both the left-of-axis and right-of-axis tick-mark lengths
+C WMML and WMMR .EQ. 0, then no tick marks are to be drawn.
+C
+      IF (NMMT.EQ.0.OR.QMDP.EQ.0..OR.(WMML.EQ.0..AND.WMMR.EQ.0.))
+     *                                                         GO TO 115
+C
+C Compute the distances of the tick mark ends from the axis as fractions
+C of the axis length, using only the (EPSILON) portion of WMML and WMMR.
+C
+      FMML=-CSFA*AMOD(WMML,1.)
+      FMMR=+CSFA*AMOD(WMMR,1.)
+C
+C If the labels overlap the axis and the (EPSILON) form was used for
+C WMML or WMMR, move the tick mark to the end of the label.
+C
+      IF (FNLL*FNLR.GE.0.) GO TO 101
+C
+      IF (WMML.LT.1.) FMML=FMML+FNLL
+C
+      IF (WMMR.LT.1.) FMMR=FMMR+FNLR
+C
+C Compute the x and y offsets to the ends of the tick mark.
+C
+  101 XMML=+CFAX*FMML*YDCA
+      YMML=-CFAY*FMML*XDCA
+      XMMR=+CFAX*FMMR*YDCA
+      YMMR=-CFAY*FMMR*XDCA
+C
+C If the (1+EPSILON) form was used for WMML or WMMR, adjust XMML, YMML,
+C XMMR, and YMMR as implied by the current axis orientation.
+C
+      IF (WMML.LT.1.) GO TO 107
+C
+      GO TO (102,103,104,105) , JAOR
+C
+C Axis at 0 degrees (left to right).
+C
+  102 YMML=YMML+1.-YBGA
+      GO TO 106
+C
+C Axis at 90 degrees (bottom to top).
+C
+  103 XMML=XMML-XBGA
+      GO TO 106
+C
+C Axis at 180 degrees (right to left).
+C
+  104 YMML=YMML-YBGA
+      GO TO 106
+C
+C Axis at 270 degrees (top to bottom).
+C
+  105 XMML=XMML+1.-XBGA
+C
+  106 FMML=(XMML+YMML)/(CFAX*YDCA-CFAY*XDCA)
+C
+  107 IF (WMMR.LT.1.) GO TO 113
+C
+      GO TO (108,109,110,111) , JAOR
+C
+C Axis at 0 degrees (left to right).
+C
+  108 YMMR=YMMR-YBGA
+      GO TO 112
+C
+C Axis at 90 degrees (bottom to top).
+C
+  109 XMMR=XMMR+1.-XBGA
+      GO TO 112
+C
+C Axis at 180 degrees (right to left).
+C
+  110 YMMR=YMMR+1.-YBGA
+      GO TO 112
+C
+C Axis at 270 degrees (top to bottom).
+C
+  111 XMMR=XMMR-XBGA
+C
+  112 FMMR=(XMMR+YMMR)/(CFAX*YDCA-CFAY*XDCA)
+C
+C Now split the tick mark into two portions - one to the left, and one
+C to the right, of the numeric label space.
+C
+  113 XMMT(1)=XMML
+      YMMT(1)=YMML
+      XMMT(2)=XMMR
+      YMMT(2)=YMMR
+      MM12=1
+      MM34=0
+      IF (FMMR.LE.FNLL.OR.FNLL.GE.FNLR) RETURN
+C
+      MM12=0
+      IF (FMML.GE.FNLL) GO TO 114
+      MM12=1
+      XMMT(2)=+CFAX*(FNLL-.005*CSFA)*YDCA
+      YMMT(2)=-CFAY*(FNLL-.005*CSFA)*XDCA
+C
+  114 IF (FMMR.LE.FNLR) RETURN
+C
+      MM34=1
+      XMMT(4)=XMMR
+      YMMT(4)=YMMR
+      XMMT(3)=XMML
+      YMMT(3)=YMML
+C
+      IF (FMML.GE.FNLR) RETURN
+      XMMT(3)=+CFAX*(FNLR+.005*CSFA)*YDCA
+      YMMT(3)=-CFAY*(FNLR+.005*CSFA)*XDCA
+      RETURN
+C
+C No ticks to be drawn - zero the flags MM12 and MM34 to indicate this.
+C
+  115 MM12=0
+      MM34=0
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agcurv.f b/sys/gio/ncarutil/autograph/agcurv.f
new file mode 100644
index 00000000..47624321
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agcurv.f
@@ -0,0 +1,149 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGCURV (XVEC,IIEX,YVEC,IIEY,NEXY,KDSH)
+C
+      DIMENSION XVEC(1),YVEC(1)
+C
+C AGCURV plots the curve defined by the points ((X(I),Y(I)),I=1,NEXY),
+C where, if the primary parameter 'INVERT.' is zero,
+C
+C    X(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case X(I)=I), and
+C    Y(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case Y(I)=I).
+C
+C If 'INVERT.' is non-zero, the definitions are interchanged, so that
+C
+C    X(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case X(I)=I), and
+C    Y(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case Y(I)=I).
+C
+C If, for some I, X(I)=SVAL or Y(I)=SVAL, curve line segments having
+C (X(I),Y(I)) as an endpoint are omitted.
+C
+C If the primary parameter 'WINDOW.' is zero, AGKURV is called; it does
+C no windowing.  If 'WINDOW.' is non-zero, AGQURV is called; it omits
+C portions of the curve which fall outside the current curve window.
+C
+C The argument KDSH specifies the dash pattern to be used.  If KDSH is
+C negative, the function MOD(IABS(KDSH),26) is used to select a solid
+C line interrupted by one of the alphabetic characters.  If KDSH is
+C zero, the user is assumed to have done his own DASHD call.  If KDSH
+C is positive, the function MOD(KDSH,NODP) is used to select one of the
+C dash patterns in the parameter group 'DASH/PATTERNS.'.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C Declare the block data routine external to force it to load.
+C
+C +NOAO
+C     EXTERNAL AGDFLT
+C -NOAO
+C
+C DASH receives alphabetic dash patterns.
+C
+      CHARACTER*10 DASH
+C
+C ALPH contains an alphabet.
+C
+      CHARACTER*26 ALPH
+C
+      DATA ALPH / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
+C
+C +NOAO - replace blockdata with run time initialization.
+      call agdflt
+C -NOAO
+C
+C Check for an alphabetic dash pattern.
+C
+      IF (KDSH.LT.0) THEN
+        IDSH=MOD(-KDSH-1,26)+1
+        IPSN=MOD(3*IDSH-1,10)+1
+        DASH='$$$$$$$$$$'
+        DASH(IPSN:IPSN)=ALPH(IDSH:IDSH)
+        CALL AGSTCH (DASH,10,IDCS)
+        CALL AGDASH (FLOAT(IDCS),WODQ,WOCD,SCWP)
+        CALL AGDLCH (IDCS)
+C
+C Check for a dash pattern from the group "DASH/PATTERNS."
+C
+      ELSE IF (KDSH.GT.0) THEN
+        IDSH=MOD(KDSH-1,IFIX(QODP))+1
+        CALL AGDASH (QDSH(IDSH),WODQ,WOCD,SCWP)
+C
+      END IF
+C
+C Now that the dash pattern is determined, do the SET call.
+C
+      CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,
+     +                            1+IABS(IFIX(QLUX))*2+IABS(IFIX(QLUY)))
+C
+C Give the user a chance to modify the curve (by changing line style,
+C color, etc.).
+C
+      CALL AGCHCU (0,KDSH)
+C
+C Decide whether AGKURV or AGQURV is to draw the curve.
+C
+      IF (QWND.EQ.0.) THEN
+C
+C No windowing requested - AGKURV is used.
+C
+        IF (QIXY.EQ.0.) THEN
+          CALL AGKURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL(1))
+        ELSE
+          CALL AGKURV (YVEC,IIEY,XVEC,IIEX,NEXY,SVAL(1))
+        END IF
+C
+      ELSE
+C
+C Windowing requested - AGQURV is used.
+C
+        IF (QIXY.EQ.0.) THEN
+          CALL AGQURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL(1))
+        ELSE
+          CALL AGQURV (YVEC,IIEY,XVEC,IIEX,NEXY,SVAL(1))
+        END IF
+C
+      END IF
+C
+C Give the user a chance to change back what he changed above.
+C
+      CALL AGCHCU (1,KDSH)
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agdash.f b/sys/gio/ncarutil/autograph/agdash.f
new file mode 100644
index 00000000..243eb808
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdash.f
@@ -0,0 +1,69 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGDASH (DASH,WODQ,WOCD,SCWP)
+C
+C AGDASH sets up the DASHD call required to establish the dash pattern
+C desired for the next curve.  The arguments are as follows:
+C
+C -- DASH specifies the desired dash pattern.  A positive value implies
+C    that a binary dash pattern is to be used, a negative value that a
+C    character-string dash pattern is to be used.
+C
+C -- WODQ is the width of the solid-line segment specified by a dollar
+C    sign and the gap specified by a quote, expressed as a fraction of
+C    the smaller side of the curve window.
+C
+C -- WOCD is the width of a character which is to be a part of the dash
+C    pattern, expressed in the same units as WODQ.
+C
+C -- SCWP is the length of the smaller side of the curve window, in
+C    plotter coordinate units.
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.  The only ones
+C used here are MWCD and MWDQ - the minimum widths of characters and
+C spaces, respectively, in the dash pattern.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of type
+C character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+c+noao
+c     CHARACTER*504 CHS1,CHS2
+      CHARACTER*500 CHS1,CHS2
+c-noao
+C
+C The AUTOGRAPH function AGFPBN is of type integer.
+C
+      INTEGER AGFPBN
+C
+      IWCD=MAX0(MWCD,IFIX(WOCD*SCWP))
+      IWDQ=MAX0(MWDQ,IFIX(WODQ*SCWP))
+C
+      IF (DASH.GE.0.) THEN
+        CALL DASHDB (AGFPBN(DASH))
+      ELSE
+        CALL AGGTCH (IFIX(DASH),CHS1,LNC1)
+        CALL DASHDC (CHS1(1:LNC1),IWDQ,IWCD)
+      END IF
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agdflt.bd b/sys/gio/ncarutil/autograph/agdflt.bd
new file mode 100644
index 00000000..ddbde9a1
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdflt.bd
@@ -0,0 +1,414 @@
+C +NOAO  
+C         This block data has been rewritten as a run time initialization
+C         subroutine (see file agdflt.f).  This original block data file
+C         is retained for reference only.
+C -NOAO
+C
+C ---------------------------------------------------------------------
+C
+      BLOCK DATA AGDFLT
+C
+C The block data subroutine AGDFLT defines the default values of those
+C AUTOGRAPH parameters which can be declared in a DATA statement.  See
+C AGINIT for code initializing other AUTOGRAPH parameters.
+C
+C Following are declarations of all the AUTOGRAPH common blocks.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of
+C type character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+      CHARACTER*504 CHS1,CHS2
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C ---------------------------------------------------------------------
+C
+C Following are declarations of default values of variables in the
+C AUTOGRAPH common blocks.
+C
+C ---------------------------------------------------------------------
+C
+C QFRA defines the control parameter 'FRAME.', which specifies when, if
+C ever, the EZ... routines are to call FRAME to advance to a new frame.
+C
+      DATA QFRA / 1. /
+C
+C QSET defines the control parameter 'SET.', which determines how the
+C last call to the plot-package routine "SET" is to affect AUTOGRAPH.
+C
+      DATA QSET / 1. /
+C
+C QROW defines the control parameter 'ROW.', which determines how the x
+C and y input arrays (in calls to AGSTUP and AGCURV) are to be used.
+C
+      DATA QROW / 1. /
+C
+C QIXY defines the control parameter 'INVERT.', which, if set non-zero,
+C causes the routines AGSTUP and AGCURV to behave as if the arguments
+C defining the x and y data had been interchanged.
+C
+      DATA QIXY / 0. /
+C
+C QWND defines the control parameter 'WINDOW.', which, if set non-zero,
+C causes curves drawn to be scissored by the edge of the curve window.
+C
+      DATA QWND / 0. /
+C
+C QBAC defines the control parameter 'BACKGROUND.', which can be given
+C any of four values to set up four specific types of plot background.
+C
+      DATA QBAC / 1. /
+C
+C SVAL defines the control parameters 'NULL/1.' and 'NULL/2.', which are
+C used in various ways by AUTOGRAPH.
+C
+      DATA SVAL(1) / 1E36 / , SVAL(2) / 2E36 /
+C
+C XLGF, XRGF, YBGF, and YTGF define the parameter-group 'GRAPH.'; they
+C specify the position of the graph window within the plotter frame.
+C
+      DATA XLGF / 0. / , XRGF / 1. / , YBGF / 0. / , YTGF / 1. /
+C
+C XLGD, XRGD, YBGD, and YTGD define the first four parameters in the
+C group 'GRID.'; they specify the position of the grid window within
+C the graph window.
+C
+      DATA XLGD / .15 / , XRGD / .95 / , YBGD / .15 / , YTGD / .95 /
+C
+C SOGD defines the control parameter 'GRID/SHAPE.', which defines the
+C shape of the grid window.
+C
+      DATA SOGD / 0. /
+C
+C XMIN and XMAX define the control parameters 'X/MIN.' and 'X/MAX.',
+C which determine how minimum and maximum values of x are to be chosen.
+C Null values imply that AUTOGRAPH is to choose real values; non-null
+C values are the actual values to be used (perhaps after rounding).
+C
+      DATA XMIN / 1E36 / , XMAX / 1E36 /
+C
+C QLUX defines the control parameter 'X/LOG.', which is set non-zero to
+C specify that the horizontal axis is to be logarithmic.
+C
+      DATA QLUX / 0. /
+C
+C QOVX defines the control parameter 'X/ORDER.', which is set non-zero
+C to flip the horizontal axis end-for-end.
+C
+      DATA QOVX / 0. /
+C
+C QCEX defines the control parameter 'X/NICE.', which determines which,
+C if either, of the horizontal axes is to have "nice" (rounded) values
+C at its ends.
+C
+      DATA QCEX / -1. /
+C
+C XLOW and XHGH define the control parameters 'X/SMALLEST.' and
+C 'X/LARGEST.'; they come into play only when XMIN and/or XMAX are null
+C and they are non-null, in which case they set limits on the range of
+C x data to be considered when choosing the minimum and/or maximum.
+C
+      DATA XLOW / 1E36 / , XHGH / 1E36 /
+C
+C YMIN and YMAX define the control parameters 'Y/MIN.' and 'Y/MAX.',
+C which determine how minimum and maximum values of y are to be chosen.
+C Null values imply that AUTOGRAPH is to choose real values; non-null
+C values are the actual values to be used (perhaps after rounding).
+C
+      DATA YMIN / 1E36 / , YMAX / 1E36 /
+C
+C QLUY defines the control parameter 'Y/LOG.', which is set non-zero to
+C specify that the horizontal axis is to be logarithmic.
+C
+      DATA QLUY / 0. /
+C
+C QOVY defines the control parameter 'Y/ORDER.', which is set non-zero
+C to flip the horizontal axis end-for-end.
+C
+      DATA QOVY / 0. /
+C
+C QCEY defines the control parameter 'Y/NICE.', which determines which,
+C if either, of the horizontal axes is to have "nice" (rounded) values
+C at its ends.
+C
+      DATA QCEY / -1. /
+C
+C YLOW and YHGH define the control parameters 'Y/SMALLEST.' and
+C 'Y/LARGEST.'; they come into play only when YMIN and/or YMAX are null
+C and they are non-null, in which case they set limits on the range of
+C y data to be considered when choosing the minimum and/or maximum.
+C
+      DATA YLOW / 1E36 / , YHGH / 1E36 /
+C
+C QDAX(i) defines the control parameters 'AXIS/s/CONTROL.' (i=1 implies
+C s='LEFT', i=2 implies s='RIGHT', i=3 implies s='BOTTOM', i=4 implies
+C s='TOP').  Each of these specifies whether or not a given axis will
+C be drawn or not and what liberties may be taken with numeric labels
+C on the axis.
+C
+      DATA QDAX(1)/ 4. / , QDAX(2)/ 4. / , QDAX(3)/ 4. / , QDAX(4)/ 4. /
+C
+C Each QSPA(i) defines a control parameter 'AXIS/s/LINE.', which says
+C whether or not the line portion of a particular axis is to be drawn.
+C
+      DATA QSPA(1)/ 0. / , QSPA(2)/ 0. / , QSPA(3)/ 0. / , QSPA(4)/ 0. /
+C
+C Each PING(i) defines a control parameter 'AXIS/s/INTERSECTION/GRID.',
+C which may be used to move a particular axis to a specified position.
+C
+      DATA PING(1)/1E36/ , PING(2)/1E36/ , PING(3)/1E36/ , PING(4)/1E36/
+C
+C Each PINU(i) defines a control parameter 'AXIS/s/INTERSECTION/USER.',
+C which may be used to move a particular axis to a specified position.
+C
+      DATA PINU(1)/1E36/ , PINU(2)/1E36/ , PINU(3)/1E36/ , PINU(4)/1E36/
+C
+C Each FUNS(i) defines a control parameter 'AXIS/s/FUNCTION.', which is
+C used within a user-supplied version of AGUTOL to select a particular
+C uset-system-to-label-system mapping for a particular axis.  The
+C default value selects the identity mapping.
+C
+      DATA FUNS(1)/ 0. / , FUNS(2)/ 0. / , FUNS(3)/ 0. / , FUNS(4)/ 0. /
+C
+C The values of QBTD(i), BASD(i), QMJD(i), QJDP(i), WMJL(i), and WMJR(i)
+C together define the control-parameter group 'AXIS/s/TICKS/MAJOR.',
+C which determines the positioning and appearance of the major ticks on
+C a particular axis.
+C
+      DATA QBTD(1)/1E36/ , QBTD(2)/1E36/ , QBTD(3)/1E36/ , QBTD(4)/1E36/
+      DATA BASD(1)/1E36/ , BASD(2)/1E36/ , BASD(3)/1E36/ , BASD(4)/1E36/
+      DATA QMJD(1)/ 6. / , QMJD(2)/ 6. / , QMJD(3)/ 6. / , QMJD(4)/ 6. /
+      DATA QJDP(1)/1E36/ , QJDP(2)/1E36/ , QJDP(3)/1E36/ , QJDP(4)/1E36/
+      DATA WMJL(1)/ 0. / , WMJL(2)/ 0. / , WMJL(3)/ 0. / , WMJL(4)/ 0. /
+      DATA WMJR(1)/.015/ , WMJR(2)/.015/ , WMJR(3)/.015/ , WMJR(4)/.015/
+C
+C The values of QMND(i), QNDP(i), WMNL(i), and WMNR(i) together define
+C the control-parameter group 'AXIS/s/TICKS/MINOR.', which determines
+C the positioning and appearance of the major ticks on a particular
+C axis.
+C
+      DATA QMND(1)/1E36/ , QMND(2)/1E36/ , QMND(3)/1E36/ , QMND(4)/1E36/
+      DATA QNDP(1)/1E36/ , QNDP(2)/1E36/ , QNDP(3)/1E36/ , QNDP(4)/1E36/
+      DATA WMNL(1)/ 0. / , WMNL(2)/ 0. / , WMNL(3)/ 0. / , WMNL(4)/ 0. /
+      DATA WMNR(1)/.010/ , WMNR(2)/.010/ , WMNR(3)/.010/ , WMNR(4)/.010/
+C
+C The values of QLTD(i), QLED(i), QLFD(i), QLOF(i), QLOS(i), DNLA(i),
+C WCLM(i), and WCLE(i) together define the control-parameter group
+C 'AXIS/s/NUMERIC.', which determines the positioning and appearance of
+C the numeric labels on a particular axis.
+C
+      DATA QLTD(1)/1E36/ , QLTD(2)/  0./ , QLTD(3)/1E36/ , QLTD(4)/  0./
+      DATA QLED(1)/1E36/ , QLED(2)/1E36/ , QLED(3)/1E36/ , QLED(4)/1E36/
+      DATA QLFD(1)/1E36/ , QLFD(2)/1E36/ , QLFD(3)/1E36/ , QLFD(4)/1E36/
+      DATA QLOF(1)/ 0. / , QLOF(2)/ 0. / , QLOF(3)/ 0. / , QLOF(4)/ 0. /
+      DATA QLOS(1)/ 90./ , QLOS(2)/ 90./ , QLOS(3)/ 90./ , QLOS(4)/ 90./
+      DATA DNLA(1)/.015/ , DNLA(2)/.015/ , DNLA(3)/.015/ , DNLA(4)/.015/
+      DATA WCLM(1)/.015/ , WCLM(2)/.015/ , WCLM(3)/.015/ , WCLM(4)/.015/
+      DATA WCLE(1)/.010/ , WCLE(2)/.010/ , WCLE(3)/.010/ , WCLE(4)/.010/
+C
+C QODP defines the control parameter 'DASH/SELECTOR.', the sign of which
+C determines which set of dash patterns is used by EZMY and EZMXY (the
+C alphabetic set or the user-specified set); if the user-specified set
+C is selected, the magnitude of QODP determines how many of them are to
+C be used.
+C
+      DATA QODP / 1. /
+C
+C QCDP defines the control parameter 'DASH/LENGTH.', which specifies the
+C assumed length of dash patterns tendered to AUTOGRAPH.
+C
+      DATA QCDP / 8. /
+C
+C WOCD and WODQ define the control parameters 'DASH/CHARACTER.' and
+C 'DASH/DOLLAR-QUOTE.', which specify the widths of characters used in
+C character-string dash patterns.
+C
+      DATA WOCD / .010 / , WODQ / .010 /
+C
+C QDSH defines the control-parameter group 'DASH/PATTERN.'.  Each value,
+C if positive, defines a binary dash pattern, and, if negative, serves
+C as an identifier in retrieving a character-string dash pattern.
+C
+      DATA QDSH / 26*65535. /
+C
+C QDLB defines the control parameter 'LABEL/CONTROL.', which specifies
+C what may be done with informational labels in response to overlap
+C problems.
+C
+      DATA QDLB /2./
+C
+C QBIM defines the control parameter 'LABEL/BUFFER/LENGTH.' and must
+C be equal to the second dimension of the array FLLB.
+C
+      DATA QBIM / 8. /
+C
+C QBAN defines the control parameter 'LABEL/NAME.'; its value is really
+C a pointer into the label list.  The default value, zero, means that
+C the pointer has not been set.
+C
+      DATA QBAN / 0. /
+C
+C QLLN defines the control parameter 'LINE/MAXIMUM.' - the assumed
+C maximum length of character strings intended for use as the text of a
+C line of a label.
+C
+      DATA QLLN /40./
+C
+C TCLN defines the control parameter 'LINE/TERMINATOR.' - which is used
+C to mark the end of character strings intended for use as the text of a
+C line of a label.  It is initialized in AGINIT.
+C
+C QNIM defines the control parameter 'LINE/BUFFER/LENGTH.' and must be
+C equal to the second dimension of FLLN.
+C
+      DATA QNIM / 16. /
+C
+C QNAN defines the control parameter 'LINE/NUMBER.'; its value is really
+C a pointer into the line list.  The default value, zero, says that the
+C pointer has not been set.
+C
+      DATA QNAN / 0. /
+C
+C (FLLB(I,1),I=1,10) and (FLLN(I,1),I=1,6) define the label to the left
+C of the grid.  The name, in FLLB(1,1), and the line text, in FLLN(4,1),
+C must be filled in by AGINIT.
+C
+      DATA FLLB( 1,1)/   0./ , FLLB( 2,1)/   0./ , FLLB( 3,1)/   0./ ,
+     +     FLLB( 4,1)/   .5/ , FLLB( 5,1)/-.015/ , FLLB( 6,1)/   0./ ,
+     +     FLLB( 7,1)/  90./ , FLLB( 8,1)/   0./ , FLLB( 9,1)/   1./ ,
+     +     FLLB(10,1)/   1./ , FLLN( 1,1)/+100./ , FLLN( 2,1)/   0./ ,
+     +     FLLN( 3,1)/ .015/ , FLLN( 4,1)/  -2./ , FLLN( 5,1)/   1./ ,
+     +     FLLN( 6,1)/   0./
+C
+C (FLLB(I,2),I=1,10) and (FLLN(I,2),I=1,6) define the label to the right
+C of the grid.  The name, in FLLB(1,2), and the line text, in FLLN(4,2),
+C must be filled in by AGINIT.
+C
+      DATA FLLB( 1,2)/   0./ , FLLB( 2,2)/   0./ , FLLB( 3,2)/   1./ ,
+     +     FLLB( 4,2)/   .5/ , FLLB( 5,2)/+.015/ , FLLB( 6,2)/   0./ ,
+     +     FLLB( 7,2)/  90./ , FLLB( 8,2)/   0./ , FLLB( 9,2)/   1./ ,
+     +     FLLB(10,2)/   2./ , FLLN( 1,2)/-100./ , FLLN( 2,2)/   0./ ,
+     +     FLLN( 3,2)/ .015/ , FLLN( 4,2)/  -3./ , FLLN( 5,2)/   0./ ,
+     +     FLLN( 6,2)/   0./
+C
+C (FLLB(I,3),I=1,10) and (FLLN(I,3),I=1,6) define the label below the
+C grid.  The name, in FLLB(1,3), and the line text, in FLLN(4,3), must
+C be filled in by AGINIT.
+C
+      DATA FLLB( 1,3)/   0./ , FLLB( 2,3)/   0./ , FLLB( 3,3)/   .5/ ,
+     +     FLLB( 4,3)/   0./ , FLLB( 5,3)/   0./ , FLLB( 6,3)/-.015/ ,
+     +     FLLB( 7,3)/   0./ , FLLB( 8,3)/   0./ , FLLB( 9,3)/   1./ ,
+     +     FLLB(10,3)/   3./ , FLLN( 1,3)/-100./ , FLLN( 2,3)/   0./ ,
+     +     FLLN( 3,3)/ .015/ , FLLN( 4,3)/  -1./ , FLLN( 5,3)/   1./ ,
+     +     FLLN( 6,3)/   0./
+C
+C (FLLB(I,4),I=1,10) and (FLLN(I,4),I=1,6) define the label above the
+C grid.  The name, in FLLB(1,4), and the line text, in FLLN(4,4), must
+C be filled in by AGINIT.
+C
+      DATA FLLB( 1,4)/   0./ , FLLB( 2,4)/   0./ , FLLB( 3,4)/   .5/ ,
+     +     FLLB( 4,4)/   1./ , FLLB( 5,4)/   0./ , FLLB( 6,4)/+.020/ ,
+     +     FLLB( 7,4)/   0./ , FLLB( 8,4)/   0./ , FLLB( 9,4)/   1./ ,
+     +     FLLB(10,4)/   4./ , FLLN( 1,4)/+100./ , FLLN( 2,4)/   0./ ,
+     +     FLLN( 3,4)/ .020/ , FLLN( 4,4)/  -3./ , FLLN( 5,4)/   0./ ,
+     +     FLLN( 6,4)/   0./
+C
+C Certain secondary parameters must be initialized to prevent bombing.
+C
+      DATA QBTP(1)/  0./ , QBTP(2)/  0./ , QBTP(3)/  0./ , QBTP(4)/  0./
+      DATA BASE(1)/  0./ , BASE(2)/  0./ , BASE(3)/  0./ , BASE(4)/  0./
+      DATA QMNT(1)/  0./ , QMNT(2)/  0./ , QMNT(3)/  0./ , QMNT(4)/  0./
+      DATA QLTP(1)/  0./ , QLTP(2)/  0./ , QLTP(3)/  0./ , QLTP(4)/  0./
+      DATA QLEX(1)/  0./ , QLEX(2)/  0./ , QLEX(3)/  0./ , QLEX(4)/  0./
+      DATA QLFL(1)/  0./ , QLFL(2)/  0./ , QLFL(3)/  0./ , QLFL(4)/  0./
+      DATA QCIM(1)/  0./ , QCIM(2)/  0./ , QCIM(3)/  0./ , QCIM(4)/  0./
+      DATA QCIE(1)/  0./ , QCIE(2)/  0./ , QCIE(3)/  0./ , QCIE(4)/  0./
+      DATA RFNL(1)/  0./ , RFNL(2)/  0./ , RFNL(3)/  0./ , RFNL(4)/  0./
+      DATA QLUA(1)/  0./ , QLUA(2)/  0./ , QLUA(3)/  0./ , QLUA(4)/  0./
+C
+C SMRL and ISLD are set by the routine AGINIT (which see, below).
+C
+C MWCL, MWCM, MWCE, MDLA, MWCD, and MWDQ are the minimum widths of label
+C characters, mantissa characters, exponent characters, label-to-axis
+C distances, dash-pattern characters, and dash-pattern spaces, respect-
+C ively (in the plotter coordinate system).
+C
+      DATA MWCL /8/, MWCM /8/, MWCE /8/, MDLA /8/, MWCD /8/, MWDQ /8/
+C
+C INIF is an initialization flag, set non-zero to indicate that the
+C routine AGINIT has been executed to set the values of AUTOGRAPH
+C parameters which, for one reason or another, cannot be preset by
+C this block data routine.
+C
+      DATA INIF / 0 /
+C
+C CHS1 and CHS2 are used within AUTOGRAPH when manipulating character
+C strings retrieved by calls to AGGTCH.  They need not be preset.
+C
+C LNIC is the second dimension of the array (INCH) which holds an index
+C of the character strings stored by AGSTCH.
+C
+      DATA LNIC / 50 /
+C
+C INCH is an index of character strings currently stored in CHRA.  Each
+C entry has the following format:
+C
+C    INCH(1,I), if non-zero, is the index, in the array CHRA, of the
+C    first character of the Ith character string.
+C
+C    INCH(2,I) is the length of the Ith character string.
+C
+      DATA (INCH(1,I),I=1,50) / 50*0 /
+      DATA (INCH(2,I),I=1,50) / 50*0 /
+C
+C LNCA is the size of the array (CHRA) in which AGSTCH stores character
+C strings.
+C
+      DATA LNCA / 2000 /
+C
+C INCA is the index of the last character used in CHRA.
+C
+      DATA INCA / 0 /
+C
+C CHRA holds character strings stored by AGSTCH.  It need not be pre-set
+C to anything.
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agdflt.f b/sys/gio/ncarutil/autograph/agdflt.f
new file mode 100644
index 00000000..87b0ca45
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdflt.f
@@ -0,0 +1,690 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+c +noao:  blockdata rewritten to be run time initialization
+c     BLOCK DATA AGDFLT
+      subroutine agdflt
+C
+C The block data subroutine AGDFLT defines the default values of those
+C AUTOGRAPH parameters which can be declared in a DATA statement.  See
+C AGINIT for code initializing other AUTOGRAPH parameters.
+C
+C Following are declarations of all the AUTOGRAPH common blocks.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of
+C type character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+c+noao
+c     CHARACTER*504 CHS1,CHS2
+      CHARACTER*500 CHS1,CHS2
+c-noao
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+c +noao:  logical flag added to prevent "over-initialization"
+      logical first
+      data first /.true./
+      call utilbd
+      if (.not. first) return
+      first = .false.
+c -noao
+C ---------------------------------------------------------------------
+C
+C Following are declarations of default values of variables in the
+C AUTOGRAPH common blocks.
+C
+C ---------------------------------------------------------------------
+C
+C QFRA defines the control parameter 'FRAME.', which specifies when, if
+C ever, the EZ... routines are to call FRAME to advance to a new frame.
+C
+c     DATA QFRA / 1. /
+      QFRA = 1. 
+C
+C QSET defines the control parameter 'SET.', which determines how the
+C last call to the plot-package routine "SET" is to affect AUTOGRAPH.
+C
+c     DATA QSET / 1. /
+      QSET = 1.
+C
+C QROW defines the control parameter 'ROW.', which determines how the x
+C and y input arrays (in calls to AGSTUP and AGCURV) are to be used.
+C
+c     DATA QROW / 1. /
+      QROW = 1.
+C
+C QIXY defines the control parameter 'INVERT.', which, if set non-zero,
+C causes the routines AGSTUP and AGCURV to behave as if the arguments
+C defining the x and y data had been interchanged.
+C
+c     DATA QIXY / 0. /
+      QIXY = 0.
+C
+C QWND defines the control parameter 'WINDOW.', which, if set non-zero,
+C causes curves drawn to be scissored by the edge of the curve window.
+C
+c     DATA QWND / 0. /
+      QWND = 0.
+C
+C QBAC defines the control parameter 'BACKGROUND.', which can be given
+C any of four values to set up four specific types of plot background.
+C
+c     DATA QBAC / 1. /
+      QBAC = 1.
+C
+C SVAL defines the control parameters 'NULL/1.' and 'NULL/2.', which are
+C used in various ways by AUTOGRAPH.
+C
+c     DATA SVAL(1) / 1E36 / , SVAL(2) / 2E36 /
+      SVAL(1) = 1E36 
+      SVAL(2) = 2E36
+C
+C XLGF, XRGF, YBGF, and YTGF define the parameter-group 'GRAPH.'; they
+C specify the position of the graph window within the plotter frame.
+C
+c     DATA XLGF / 0. / , XRGF / 1. / , YBGF / 0. / , YTGF / 1. /
+      XLGF = 0. 
+      XRGF = 1.
+      YBGF = 0.
+      YTGF = 1.
+C
+C XLGD, XRGD, YBGD, and YTGD define the first four parameters in the
+C group 'GRID.'; they specify the position of the grid window within
+C the graph window.
+C
+c     DATA XLGD / .15 / , XRGD / .95 / , YBGD / .15 / , YTGD / .95 /
+      XLGD = .15
+      XRGD = .95 
+      YBGD = .15 
+      YTGD = .95
+C
+C SOGD defines the control parameter 'GRID/SHAPE.', which defines the
+C shape of the grid window.
+C
+c     DATA SOGD / 0. /
+      SOGD = 0.
+C
+C XMIN and XMAX define the control parameters 'X/MIN.' and 'X/MAX.',
+C which determine how minimum and maximum values of x are to be chosen.
+C Null values imply that AUTOGRAPH is to choose real values; non-null
+C values are the actual values to be used (perhaps after rounding).
+C
+c     DATA XMIN / 1E36 / , XMAX / 1E36 /
+      XMIN = 1E36
+      XMAX = 1E36
+C
+C QLUX defines the control parameter 'X/LOG.', which is set non-zero to
+C specify that the horizontal axis is to be logarithmic.
+C
+c     DATA QLUX / 0. /
+      QLUX = 0.
+C
+C QOVX defines the control parameter 'X/ORDER.', which is set non-zero
+C to flip the horizontal axis end-for-end.
+C
+c     DATA QOVX / 0. /
+      QOVX = 0.
+C
+C QCEX defines the control parameter 'X/NICE.', which determines which,
+C if either, of the horizontal axes is to have "nice" (rounded) values
+C at its ends.
+C
+c     DATA QCEX / -1. /
+      QCEX = -1.
+C
+C XLOW and XHGH define the control parameters 'X/SMALLEST.' and
+C 'X/LARGEST.'; they come into play only when XMIN and/or XMAX are null
+C and they are non-null, in which case they set limits on the range of
+C x data to be considered when choosing the minimum and/or maximum.
+C
+c     DATA XLOW / 1E36 / , XHGH / 1E36 /
+      XLOW = 1E36
+      XHGH = 1E36
+C
+C YMIN and YMAX define the control parameters 'Y/MIN.' and 'Y/MAX.',
+C which determine how minimum and maximum values of y are to be chosen.
+C Null values imply that AUTOGRAPH is to choose real values; non-null
+C values are the actual values to be used (perhaps after rounding).
+C
+c     DATA YMIN / 1E36 / , YMAX / 1E36 /
+      YMIN = 1E36
+      YMAX = 1E36
+C
+C QLUY defines the control parameter 'Y/LOG.', which is set non-zero to
+C specify that the horizontal axis is to be logarithmic.
+C
+c     DATA QLUY / 0. /
+      QLUY = 0.
+C
+C QOVY defines the control parameter 'Y/ORDER.', which is set non-zero
+C to flip the horizontal axis end-for-end.
+C
+c     DATA QOVY / 0. /
+      QOVY = 0.
+C
+C QCEY defines the control parameter 'Y/NICE.', which determines which,
+C if either, of the horizontal axes is to have "nice" (rounded) values
+C at its ends.
+C
+c     DATA QCEY / -1. /
+      QCEY = -1.
+C
+C YLOW and YHGH define the control parameters 'Y/SMALLEST.' and
+C 'Y/LARGEST.'; they come into play only when YMIN and/or YMAX are null
+C and they are non-null, in which case they set limits on the range of
+C y data to be considered when choosing the minimum and/or maximum.
+C
+c     DATA YLOW / 1E36 / , YHGH / 1E36 /
+      YLOW = 1E36
+      YHGH = 1E36
+C
+C QDAX(i) defines the control parameters 'AXIS/s/CONTROL.' (i=1 implies
+C s='LEFT', i=2 implies s='RIGHT', i=3 implies s='BOTTOM', i=4 implies
+C s='TOP').  Each of these specifies whether or not a given axis will
+C be drawn or not and what liberties may be taken with numeric labels
+C on the axis.
+C
+c     DATA QDAX(1)/ 4. / , QDAX(2)/ 4. / , QDAX(3)/ 4. / , QDAX(4)/ 4. /
+      QDAX(1) = 4.
+      QDAX(2) = 4.
+      QDAX(3) = 4.
+      QDAX(4) = 4.
+C
+C Each QSPA(i) defines a control parameter 'AXIS/s/LINE.', which says
+C whether or not the line portion of a particular axis is to be drawn.
+C
+c     DATA QSPA(1)/ 0. / , QSPA(2)/ 0. / , QSPA(3)/ 0. / , QSPA(4)/ 0. /
+      QSPA(1) = 0.
+      QSPA(2) = 0.
+      QSPA(3) = 0.
+      QSPA(4) = 0.
+C
+C Each PING(i) defines a control parameter 'AXIS/s/INTERSECTION/GRID.',
+C which may be used to move a particular axis to a specified position.
+C
+c     DATA PING(1)/1E36/ , PING(2)/1E36/ , PING(3)/1E36/ , PING(4)/1E36/
+      PING(1) = 1E36
+      PING(2) = 1E36
+      PING(3) = 1E36
+      PING(4) = 1E36
+C
+C Each PINU(i) defines a control parameter 'AXIS/s/INTERSECTION/USER.',
+C which may be used to move a particular axis to a specified position.
+C
+c     DATA PINU(1)/1E36/ , PINU(2)/1E36/ , PINU(3)/1E36/ , PINU(4)/1E36/
+      PINU(1) = 1E36
+      PINU(2) = 1E36
+      PINU(3) = 1E36
+      PINU(4) = 1E36
+C
+C Each FUNS(i) defines a control parameter 'AXIS/s/FUNCTION.', which is
+C used within a user-supplied version of AGUTOL to select a particular
+C uset-system-to-label-system mapping for a particular axis.  The
+C default value selects the identity mapping.
+C
+c     DATA FUNS(1)/ 0. / , FUNS(2)/ 0. / , FUNS(3)/ 0. / , FUNS(4)/ 0. /
+      FUNS(1) =  0.
+      FUNS(2) =  0.
+      FUNS(3) =  0.
+      FUNS(4) =  0.
+C
+C The values of QBTD(i), BASD(i), QMJD(i), QJDP(i), WMJL(i), and WMJR(i)
+C together define the control-parameter group 'AXIS/s/TICKS/MAJOR.',
+C which determines the positioning and appearance of the major ticks on
+C a particular axis.
+C
+c     DATA QBTD(1)/1E36/ , QBTD(2)/1E36/ , QBTD(3)/1E36/ , QBTD(4)/1E36/
+c     DATA BASD(1)/1E36/ , BASD(2)/1E36/ , BASD(3)/1E36/ , BASD(4)/1E36/
+c     DATA QMJD(1)/ 6. / , QMJD(2)/ 6. / , QMJD(3)/ 6. / , QMJD(4)/ 6. /
+c     DATA QJDP(1)/1E36/ , QJDP(2)/1E36/ , QJDP(3)/1E36/ , QJDP(4)/1E36/
+c     DATA WMJL(1)/ 0. / , WMJL(2)/ 0. / , WMJL(3)/ 0. / , WMJL(4)/ 0. /
+c     DATA WMJR(1)/.015/ , WMJR(2)/.015/ , WMJR(3)/.015/ , WMJR(4)/.015/
+      QBTD(1) = 1E36
+      QBTD(2) = 1E36
+      QBTD(3) = 1E36
+      QBTD(4) = 1E36
+      BASD(1) = 1E36
+      BASD(2) = 1E36
+      BASD(3) = 1E36
+      BASD(4) = 1E36
+      QMJD(1) =  6. 
+      QMJD(2) =  6. 
+      QMJD(3) =  6. 
+      QMJD(4) =  6. 
+      QJDP(1) = 1E36
+      QJDP(2) = 1E36
+      QJDP(3) = 1E36
+      QJDP(4) = 1E36
+      WMJL(1) =  0. 
+      WMJL(2) =  0. 
+      WMJL(3) =  0. 
+      WMJL(4) =  0. 
+      WMJR(1) = .015
+      WMJR(2) = .015
+      WMJR(3) = .015
+      WMJR(4) = .015
+C
+C The values of QMND(i), QNDP(i), WMNL(i), and WMNR(i) together define
+C the control-parameter group 'AXIS/s/TICKS/MINOR.', which determines
+C the positioning and appearance of the major ticks on a particular
+C axis.
+C
+c     DATA QMND(1)/1E36/ , QMND(2)/1E36/ , QMND(3)/1E36/ , QMND(4)/1E36/
+c     DATA QNDP(1)/1E36/ , QNDP(2)/1E36/ , QNDP(3)/1E36/ , QNDP(4)/1E36/
+c     DATA WMNL(1)/ 0. / , WMNL(2)/ 0. / , WMNL(3)/ 0. / , WMNL(4)/ 0. /
+c     DATA WMNR(1)/.010/ , WMNR(2)/.010/ , WMNR(3)/.010/ , WMNR(4)/.010/
+      QMND(1) = 1E36
+      QMND(2) = 1E36
+      QMND(3) = 1E36
+      QMND(4) = 1E36
+      QNDP(1) = 1E36
+      QNDP(2) = 1E36
+      QNDP(3) = 1E36
+      QNDP(4) = 1E36
+      WMNL(1) =  0. 
+      WMNL(2) =  0. 
+      WMNL(3) =  0. 
+      WMNL(4) =  0. 
+      WMNR(1) = .010
+      WMNR(2) = .010
+      WMNR(3) = .010
+      WMNR(4) = .010
+C
+C The values of QLTD(i), QLED(i), QLFD(i), QLOF(i), QLOS(i), DNLA(i),
+C WCLM(i), and WCLE(i) together define the control-parameter group
+C 'AXIS/s/NUMERIC.', which determines the positioning and appearance of
+C the numeric labels on a particular axis.
+C
+c     DATA QLTD(1)/1E36/ , QLTD(2)/  0./ , QLTD(3)/1E36/ , QLTD(4)/  0./
+c     DATA QLED(1)/1E36/ , QLED(2)/1E36/ , QLED(3)/1E36/ , QLED(4)/1E36/
+c     DATA QLFD(1)/1E36/ , QLFD(2)/1E36/ , QLFD(3)/1E36/ , QLFD(4)/1E36/
+c     DATA QLOF(1)/ 0. / , QLOF(2)/ 0. / , QLOF(3)/ 0. / , QLOF(4)/ 0. /
+c     DATA QLOS(1)/ 90./ , QLOS(2)/ 90./ , QLOS(3)/ 90./ , QLOS(4)/ 90./
+c     DATA DNLA(1)/.015/ , DNLA(2)/.015/ , DNLA(3)/.015/ , DNLA(4)/.015/
+c     DATA WCLM(1)/.015/ , WCLM(2)/.015/ , WCLM(3)/.015/ , WCLM(4)/.015/
+c     DATA WCLE(1)/.010/ , WCLE(2)/.010/ , WCLE(3)/.010/ , WCLE(4)/.010/
+      QLTD(1) = 1E36
+      QLTD(2) =   0.
+      QLTD(3) = 1E36
+      QLTD(4) =   0.
+      QLED(1) = 1E36
+      QLED(2) = 1E36
+      QLED(3) = 1E36
+      QLED(4) = 1E36
+      QLFD(1) = 1E36
+      QLFD(2) = 1E36
+      QLFD(3) = 1E36
+      QLFD(4) = 1E36
+      QLOF(1) =  0. 
+      QLOF(2) =  0. 
+      QLOF(3) =  0. 
+      QLOF(4) =  0. 
+      QLOS(1) =  90.
+      QLOS(2) =  90.
+      QLOS(3) =  90.
+      QLOS(4) =  90.
+      DNLA(1) = .015
+      DNLA(2) = .015
+      DNLA(3) = .015
+      DNLA(4) = .015
+      WCLM(1) = .015
+      WCLM(2) = .015
+      WCLM(3) = .015
+      WCLM(4) = .015
+      WCLE(1) = .010
+      WCLE(2) = .010
+      WCLE(3) = .010
+      WCLE(4) = .010
+C
+C QODP defines the control parameter 'DASH/SELECTOR.', the sign of which
+C determines which set of dash patterns is used by EZMY and EZMXY (the
+C alphabetic set or the user-specified set); if the user-specified set
+C is selected, the magnitude of QODP determines how many of them are to
+C be used.
+C
+c     DATA QODP / 1. /
+      QODP = 1. 
+C
+C QCDP defines the control parameter 'DASH/LENGTH.', which specifies the
+C assumed length of dash patterns tendered to AUTOGRAPH.
+C
+c     DATA QCDP / 8. /
+      QCDP =  8. 
+C
+C WOCD and WODQ define the control parameters 'DASH/CHARACTER.' and
+C 'DASH/DOLLAR-QUOTE.', which specify the widths of characters used in
+C character-string dash patterns.
+C
+c     DATA WOCD / .010 / , WODQ / .010 /
+      WOCD = .010 
+      WODQ = .010
+C
+C QDSH defines the control-parameter group 'DASH/PATTERN.'.  Each value,
+C if positive, defines a binary dash pattern, and, if negative, serves
+C as an identifier in retrieving a character-string dash pattern.
+C
+c     DATA QDSH / 26*65535. /
+      do 20, ijk = 1, 26
+  20      QDSH(ijk) = 65535.
+C
+C QDLB defines the control parameter 'LABEL/CONTROL.', which specifies
+C what may be done with informational labels in response to overlap
+C problems.
+C
+c     DATA QDLB /2./
+      QDLB = 2.
+C
+C QBIM defines the control parameter 'LABEL/BUFFER/LENGTH.' and must
+C be equal to the second dimension of the array FLLB.
+C
+c     DATA QBIM / 8. /
+      QBIM =  8.
+C
+C QBAN defines the control parameter 'LABEL/NAME.'; its value is really
+C a pointer into the label list.  The default value, zero, means that
+C the pointer has not been set.
+C
+c     DATA QBAN / 0. /
+      QBAN =  0.
+C
+C QLLN defines the control parameter 'LINE/MAXIMUM.' - the assumed
+C maximum length of character strings intended for use as the text of a
+C line of a label.
+C
+c     DATA QLLN /40./
+      QLLN = 40.
+C
+C TCLN defines the control parameter 'LINE/TERMINATOR.' - which is used
+C to mark the end of character strings intended for use as the text of a
+C line of a label.  It is initialized in AGINIT.
+C
+C QNIM defines the control parameter 'LINE/BUFFER/LENGTH.' and must be
+C equal to the second dimension of FLLN.
+C
+c     DATA QNIM / 16. /
+      QNIM =  16.
+C
+C QNAN defines the control parameter 'LINE/NUMBER.'; its value is really
+C a pointer into the line list.  The default value, zero, says that the
+C pointer has not been set.
+C
+c     DATA QNAN / 0. /
+      QNAN =  0.
+C
+C (FLLB(I,1),I=1,10) and (FLLN(I,1),I=1,6) define the label to the left
+C of the grid.  The name, in FLLB(1,1), and the line text, in FLLN(4,1),
+C must be filled in by AGINIT.
+C
+c     DATA FLLB( 1,1)/   0./ , FLLB( 2,1)/   0./ , FLLB( 3,1)/   0./ ,
+c    +     FLLB( 4,1)/   .5/ , FLLB( 5,1)/-.015/ , FLLB( 6,1)/   0./ ,
+c    +     FLLB( 7,1)/  90./ , FLLB( 8,1)/   0./ , FLLB( 9,1)/   1./ ,
+c    +     FLLB(10,1)/   1./ , FLLN( 1,1)/+100./ , FLLN( 2,1)/   0./ ,
+c    +     FLLN( 3,1)/ .015/ , FLLN( 4,1)/  -2./ , FLLN( 5,1)/   1./ ,
+c    +     FLLN( 6,1)/   0./
+           FLLB( 1,1) = 0.
+           FLLB( 2,1) = 0.
+           FLLB( 3,1) = 0.
+           FLLB( 4,1) = .5
+           FLLB( 5,1) = -.015
+           FLLB( 6,1) = 0.
+           FLLB( 7,1) = 90.
+           FLLB( 8,1) = 0.
+           FLLB( 9,1) = 1.
+           FLLB(10,1) = 1.
+           FLLN( 1,1) = +100.
+           FLLN( 2,1) = 0.
+           FLLN( 3,1) = .015
+           FLLN( 4,1) = -2.
+           FLLN( 5,1) = 1.
+           FLLN( 6,1) = 0.
+C
+C (FLLB(I,2),I=1,10) and (FLLN(I,2),I=1,6) define the label to the right
+C of the grid.  The name, in FLLB(1,2), and the line text, in FLLN(4,2),
+C must be filled in by AGINIT.
+C
+c     DATA FLLB( 1,2)/   0./ , FLLB( 2,2)/   0./ , FLLB( 3,2)/   1./ ,
+c    +     FLLB( 4,2)/   .5/ , FLLB( 5,2)/+.015/ , FLLB( 6,2)/   0./ ,
+c    +     FLLB( 7,2)/  90./ , FLLB( 8,2)/   0./ , FLLB( 9,2)/   1./ ,
+c    +     FLLB(10,2)/   2./ , FLLN( 1,2)/-100./ , FLLN( 2,2)/   0./ ,
+c    +     FLLN( 3,2)/ .015/ , FLLN( 4,2)/  -3./ , FLLN( 5,2)/   0./ ,
+c    +     FLLN( 6,2)/   0./
+           FLLB( 1,2) =  0.
+           FLLB( 2,2) =  0.
+           FLLB( 3,2) =  1.
+           FLLB( 4,2) =  .5
+           FLLB( 5,2) = +.015
+           FLLB( 6,2) =  0.
+           FLLB( 7,2) = 90.
+           FLLB( 8,2) =  0.
+           FLLB( 9,2) =  1.
+           FLLB(10,2) =  2.
+           FLLN( 1,2) = -100.
+           FLLN( 2,2) =  0.
+           FLLN( 3,2) =  .015
+           FLLN( 4,2) =  -3.
+           FLLN( 5,2) =  0.
+           FLLN( 6,2) =  0.
+C
+C (FLLB(I,3),I=1,10) and (FLLN(I,3),I=1,6) define the label below the
+C grid.  The name, in FLLB(1,3), and the line text, in FLLN(4,3), must
+C be filled in by AGINIT.
+C
+c     DATA FLLB( 1,3)/   0./ , FLLB( 2,3)/   0./ , FLLB( 3,3)/   .5/ ,
+c    +     FLLB( 4,3)/   0./ , FLLB( 5,3)/   0./ , FLLB( 6,3)/-.015/ ,
+c    +     FLLB( 7,3)/   0./ , FLLB( 8,3)/   0./ , FLLB( 9,3)/   1./ ,
+c    +     FLLB(10,3)/   3./ , FLLN( 1,3)/-100./ , FLLN( 2,3)/   0./ ,
+c    +     FLLN( 3,3)/ .015/ , FLLN( 4,3)/  -1./ , FLLN( 5,3)/   1./ ,
+c    +     FLLN( 6,3)/   0./
+           FLLB( 1,3) =  0.
+           FLLB( 2,3) =  0.
+           FLLB( 3,3) = .5
+           FLLB( 4,3) =  0.
+           FLLB( 5,3) =  0.
+           FLLB( 6,3) = -.015
+           FLLB( 7,3) =  0.
+           FLLB( 8,3) =  0.
+           FLLB( 9,3) =  1.
+           FLLB(10,3) =  3.
+           FLLN( 1,3) = -100.
+           FLLN( 2,3) =  0.
+           FLLN( 3,3) =  .015
+           FLLN( 4,3) =   -1.
+           FLLN( 5,3) =  1.
+           FLLN( 6,3) =  0.
+C
+C (FLLB(I,4),I=1,10) and (FLLN(I,4),I=1,6) define the label above the
+C grid.  The name, in FLLB(1,4), and the line text, in FLLN(4,4), must
+C be filled in by AGINIT.
+C
+c     DATA FLLB( 1,4)/   0./ , FLLB( 2,4)/   0./ , FLLB( 3,4)/   .5/ ,
+c    +     FLLB( 4,4)/   1./ , FLLB( 5,4)/   0./ , FLLB( 6,4)/+.020/ ,
+c    +     FLLB( 7,4)/   0./ , FLLB( 8,4)/   0./ , FLLB( 9,4)/   1./ ,
+c    +     FLLB(10,4)/   4./ , FLLN( 1,4)/+100./ , FLLN( 2,4)/   0./ ,
+c    +     FLLN( 3,4)/ .020/ , FLLN( 4,4)/  -3./ , FLLN( 5,4)/   0./ ,
+c    +     FLLN( 6,4)/   0./
+           FLLB( 1,4) =  0.
+           FLLB( 2,4) =  0.
+           FLLB( 3,4) =  .5
+           FLLB( 4,4) =  1.
+           FLLB( 5,4) =  0.
+           FLLB( 6,4) = +.020
+           FLLB( 7,4) =  0.
+           FLLB( 8,4) =  0.
+           FLLB( 9,4) =  1.
+           FLLB(10,4) =  4.
+           FLLN( 1,4) = +100.
+           FLLN( 2,4) =  0.
+           FLLN( 3,4) =  .020
+           FLLN( 4,4) =  -3.
+           FLLN( 5,4) =  0.
+           FLLN( 6,4) =  0.
+C
+C Certain secondary parameters must be initialized to prevent bombing.
+C
+c     DATA QBTP(1)/  0./ , QBTP(2)/  0./ , QBTP(3)/  0./ , QBTP(4)/  0./
+c     DATA BASE(1)/  0./ , BASE(2)/  0./ , BASE(3)/  0./ , BASE(4)/  0./
+c     DATA QMNT(1)/  0./ , QMNT(2)/  0./ , QMNT(3)/  0./ , QMNT(4)/  0./
+c     DATA QLTP(1)/  0./ , QLTP(2)/  0./ , QLTP(3)/  0./ , QLTP(4)/  0./
+c     DATA QLEX(1)/  0./ , QLEX(2)/  0./ , QLEX(3)/  0./ , QLEX(4)/  0./
+c     DATA QLFL(1)/  0./ , QLFL(2)/  0./ , QLFL(3)/  0./ , QLFL(4)/  0./
+c     DATA QCIM(1)/  0./ , QCIM(2)/  0./ , QCIM(3)/  0./ , QCIM(4)/  0./
+c     DATA QCIE(1)/  0./ , QCIE(2)/  0./ , QCIE(3)/  0./ , QCIE(4)/  0./
+c     DATA RFNL(1)/  0./ , RFNL(2)/  0./ , RFNL(3)/  0./ , RFNL(4)/  0./
+c     DATA QLUA(1)/  0./ , QLUA(2)/  0./ , QLUA(3)/  0./ , QLUA(4)/  0./
+      QBTP(1) =   0.
+      QBTP(2) =   0.
+      QBTP(3) =   0.
+      QBTP(4) =   0.
+      BASE(1) =   0.
+      BASE(2) =   0.
+      BASE(3) =   0.
+      BASE(4) =   0.
+      QMNT(1) =   0.
+      QMNT(2) =   0.
+      QMNT(3) =   0.
+      QMNT(4) =   0.
+      QLTP(1) =   0.
+      QLTP(2) =   0.
+      QLTP(3) =   0.
+      QLTP(4) =   0.
+      QLEX(1) =   0.
+      QLEX(2) =   0.
+      QLEX(3) =   0.
+      QLEX(4) =   0.
+      QLFL(1) =   0.
+      QLFL(2) =   0.
+      QLFL(3) =   0.
+      QLFL(4) =   0.
+      QCIM(1) =   0.
+      QCIM(2) =   0.
+      QCIM(3) =   0.
+      QCIM(4) =   0.
+      QCIE(1) =   0.
+      QCIE(2) =   0.
+      QCIE(3) =   0.
+      QCIE(4) =   0.
+      RFNL(1) =   0.
+      RFNL(2) =   0.
+      RFNL(3) =   0.
+      RFNL(4) =   0.
+      QLUA(1) =   0.
+      QLUA(2) =   0.
+      QLUA(3) =   0.
+      QLUA(4) =   0.
+C
+C SMRL and ISLD are set by the routine AGINIT (which see, below).
+C
+C MWCL, MWCM, MWCE, MDLA, MWCD, and MWDQ are the minimum widths of label
+C characters, mantissa characters, exponent characters, label-to-axis
+C distances, dash-pattern characters, and dash-pattern spaces, respect-
+C ively (in the plotter coordinate system).
+C
+c     DATA MWCL /8/, MWCM /8/, MWCE /8/, MDLA /8/, MWCD /8/, MWDQ /8/
+      MWCL = 8
+      MWCM = 8
+      MWCE = 8
+      MDLA = 8
+      MWCD = 8
+      MWDQ = 8
+C
+C INIF is an initialization flag, set non-zero to indicate that the
+C routine AGINIT has been executed to set the values of AUTOGRAPH
+C parameters which, for one reason or another, cannot be preset by
+C this block data routine.
+C
+c     DATA INIF / 0 /
+      INIF =  0 
+C
+C CHS1 and CHS2 are used within AUTOGRAPH when manipulating character
+C strings retrieved by calls to AGGTCH.  They need not be preset.
+C
+C LNIC is the second dimension of the array (INCH) which holds an index
+C of the character strings stored by AGSTCH.
+C
+c     DATA LNIC / 50 /
+      LNIC = 50 
+C
+C INCH is an index of character strings currently stored in CHRA.  Each
+C entry has the following format:
+C
+C    INCH(1,I), if non-zero, is the index, in the array CHRA, of the
+C    first character of the Ith character string.
+C
+C    INCH(2,I) is the length of the Ith character string.
+C
+c     DATA (INCH(1,I),I=1,50) / 50*0 /
+c     DATA (INCH(2,I),I=1,50) / 50*0 /
+      do 10, ijk = 1, 50
+        inch (1, ijk) = 0
+        inch (2, ijk) = 0
+  10  continue
+C
+C LNCA is the size of the array (CHRA) in which AGSTCH stores character
+C strings.
+C
+c     DATA LNCA / 2000 /
+      LNCA =  2000 
+C
+C INCA is the index of the last character used in CHRA.
+C
+c     DATA INCA / 0 /
+      INCA =  0 
+C
+C CHRA holds character strings stored by AGSTCH.  It need not be pre-set
+C to anything.
+C
+      return
+c 
+      entry initag
+      first = .true.
+      END
diff --git a/sys/gio/ncarutil/autograph/agdlch.f b/sys/gio/ncarutil/autograph/agdlch.f
new file mode 100644
index 00000000..78a96c8f
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdlch.f
@@ -0,0 +1,60 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGDLCH (IDCS)
+C
+C This routine deletes character strings previously stored by the
+C routine AGSTCH (which see).  It has the following argument:
+C
+C -- IDCS is the identifying integer returned by AGSTCH when the string
+C    was stored.
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C Only if the identifier is between -LNIC and -1, inclusive, was the
+C string ever stored, so that it needs to be deleted.  If the string is
+C the last one in CHRA, we can just set INCA to point to the position
+C preceding it; otherwise, we zero out the string but don't bother to
+C collapse CHRA, which will happen in AGSTCH when the space is needed
+C again.  In either case, the index entry in INCH is zeroed.
+C
+      IF (IDCS.GE.(-LNIC).AND.IDCS.LE.(-1)) THEN
+        I=-IDCS
+        J=INCH(1,I)
+        IF (J.GT.0) THEN
+          K=J+INCH(2,I)-1
+          IF (K.EQ.INCA) THEN
+            INCA=J-1
+          ELSE
+            DO 101 L=J,K
+              CHRA(L)=CHAR(0)
+  101       CONTINUE
+          END IF
+          INCH(1,I)=0
+        END IF
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agdshn.f b/sys/gio/ncarutil/autograph/agdshn.f
new file mode 100644
index 00000000..a20a5dfd
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agdshn.f
@@ -0,0 +1,34 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      CHARACTER*16 FUNCTION AGDSHN (IDSH)
+C
+C The value of this function is the name of the dash pattern numbered
+C IDSH - that is to say, the character string 'DASH/PATTERN/n.', where
+C n is an integer between 1 and 99, equal to MAX0(1,MIN0(99,IDSH)).
+C
+      AGDSHN='DASH/PATTERN/  .'
+C
+      KDSH=MAX0(1,MIN0(99,IDSH))
+C
+      DO 101 I=15,14,-1
+        AGDSHN(I:I)=CHAR(ICHAR('0')+MOD(KDSH,10))
+        IF (KDSH.LE.9) GO TO 102
+        KDSH=KDSH/10
+  101 CONTINUE
+C
+  102 RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agexax.f b/sys/gio/ncarutil/autograph/agexax.f
new file mode 100644
index 00000000..b16e2319
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agexax.f
@@ -0,0 +1,415 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGEXAX (IAXS,SVAL,UMIN,UMAX,NICE,QLUA,FUNS,QBTP,BASD,
+     +                   BASE,QMJD,QMND,QMNT,QLTD,QLTP,QLED,QLEX,QLFD,
+     +                   QLFL,QMIN,QMAX)
+C
+      DIMENSION SVAL(2)
+C
+C The routine AGEXAX is used by AGSTUP to examine the parameters which
+C determine how a given axis is tick-marked and labelled and to provide
+C default values for missing ones.  Its arguments are as follows:
+C
+C -- IAXS is the number of the axis being drawn - 1, 2, 3, or 4.
+C
+C -- SVAL is the array of special values.
+C
+C -- UMIN and UMAX are the minimum and maximum values along the axis, in
+C    the user coordinate system.  Rounded values of UMIN and UMAX are
+C    returned in QMIN and QMAX if the following argument (NICE) is zero.
+C
+C -- NICE is a flag indicating whether rounded values of UMIN and UMAX
+C    are to be returned (NICE.EQ.0) or not (NICE.NE.0).
+C
+C -- LLUA and FUNS specify the user-system-to-label-system mapping along
+C    the axis.  See the routine AGAXIS for a discussion of them.
+C
+C -- NBTP, BASD, BASE, and NMJD are used to determine the positioning of
+C    major tick marks in the label coordinate system.  NBTP and BASE are
+C    described in the routine AGNUMB.  BASD is the desired value of BASE
+C    supplied by the user.  If BASD has a null value, BASE is computed
+C    by AGEXAX.  NMJD is a user-supplied-or-defaulted parameter giving
+C    the approximate number of major ticks (and therefore the number of
+C    numeric labels) to be placed on the axis.
+C
+C -- NMND and NMNT are the desired and actual (to be determined) number
+C    of minor ticks per major division.  See discussion in AGAXIS.
+C
+C -- NLTD, NLTP, NLED, NLEX, NLFD, and NLFL are desired and actual (to
+C    be determined) values of the parameters describing the form to be
+C    used for numeric labels.  See discussion in AGNUMB.
+C
+C -- QMIN and QMAX are rounded values of UMIN and UMAX, returned only if
+C    NICE.EQ.0.
+C
+C The following common block contains AUTOGRAPH variables which are
+C not control parameters.  The only one used here is SMRL, which is a
+C (machine-dependent) small real which, when added to a number in the
+C range (1,10), will round it upward without seriously affecting the
+C leading significant digits.  The object of this is to get rid of
+C strings of nines.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The arrays BASP and NMNP specify possible default values for BASE and
+C NMNT when NBTP.EQ.1.
+C
+      DIMENSION BASP(5),NMNP(5)
+C
+      DATA BASP(1) / 10. / , NMNP(1) / 1 / ,
+     *     BASP(2) /  5. / , NMNP(2) / 4 / ,
+     *     BASP(3) /  2. / , NMNP(3) / 1 / ,
+     *     BASP(4) /  1. / , NMNP(4) / 1 / ,
+     *     BASP(5) /  .5 / , NMNP(5) / 4 /
+C
+C If the parameter NBTP is zero, tick marks and labels are suppressed.
+C
+      NBTP=IFIX(QBTP)
+      IF (NBTP.EQ.0) RETURN
+C
+C Unpack integer values from floating-point arguments.
+C
+      LLUA=IFIX(QLUA)
+      NMJD=IFIX(QMJD)
+      IF (QMND.NE.SVAL(1).AND.QMND.NE.SVAL(2)) NMND=IFIX(QMND)
+      NMNT=0
+      IF (QLTD.NE.SVAL(1).AND.QLTD.NE.SVAL(2)) NLTD=IFIX(QLTD)
+      NLTP=0
+      IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2)) NLED=IFIX(QLED)
+      NLEX=0
+      IF (QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)) NLFD=IFIX(QLFD)
+      NLFL=0
+C
+C Compute label-coordinate-system values at the ends of the axis.
+C
+      CALL AGUTOL (IAXS,FUNS,1,UMIN,VMIN)
+      CALL AGUTOL (IAXS,FUNS,1,UMAX,VMAX)
+C
+C Error if the label-coordinate-system values are equal.
+C
+      IF (VMIN.EQ.VMAX) GO TO 901
+C
+C If a special value is specified for the parameter BASD, AGEXAX must
+C pick a value for the parameter BASE.
+C
+      IF (BASD.EQ.SVAL(1).OR.BASD.EQ.SVAL(2)) GO TO 101
+C
+C The user has specified a value for the parameter BASE.  If that value
+C is less than or equal to zero, tick marks and labels are suppressed.
+C
+      BASE=AMAX1(0.,BASD)
+      IF (BASE.EQ.0.) RETURN
+      NMNT=0
+      GO TO 108
+C
+C Pick a value for the parameter BASE, depending on the number type.
+C
+  101 GO TO (102,105,106) , NBTP
+C
+C Major ticks and labels are at numbers of the form (-) BASE * EXMU.
+C
+  102 NMJD=MAX0(0,NMJD)
+C
+C Compute an approximate value for BASE.
+C
+      FTMP=ABS(VMAX-VMIN)/FLOAT(NMJD+1)
+C
+C Reduce the approximate value to the form FTMP * 10 ** ITMP.
+C
+      ASSIGN 103 TO JMP1
+      GO TO 200
+C
+C Pick a reasonable value for BASE (1., 2., OR 5. * 10**ITMP).
+C
+  103 DO 104 I=1,5
+        IF (FTMP.LT.BASP(I)) GO TO 104
+        BASE=BASP(I)*SNGL(10.D0**ITMP)
+        NMNT=NMNP(I)
+        GO TO 107
+  104 CONTINUE
+C
+C Major ticks and labels are at numbers of the form (-) BASE * 10**EXMU.
+C
+  105 BASE=1.
+      NMNT=8
+      GO TO 107
+C
+C Major ticks and labels are at numbers of the form (-) BASE**EXMU.
+C
+  106 BASE=10.
+      NMNT=8
+C
+  107 IF (BASD.EQ.SVAL(2)) BASD=BASE
+C
+  108 IF (QMND.NE.SVAL(1).AND.QMND.NE.SVAL(2)) NMNT=MAX0(0,NMND)
+      IF (QMND.EQ.SVAL(2)) QMND=FLOAT(NMNT)
+C
+C If the user wants nice values at the axis ends, reset UMIN and UMAX.
+C
+      IF (NICE.NE.0) GO TO 115
+C
+      LOOP=0
+C
+      WMIN=VMIN
+      WMAX=VMAX
+C
+      GO TO (109,110,112) , NBTP
+C
+  109 EMIN=VMIN/BASE+.5+SIGN(.5,VMIN-VMAX)
+      EMIN=EMIN-.5+SIGN(.5,EMIN)-SIGN(SMRL*EMIN,VMIN-VMAX)
+      WMIN=BASE*(EMIN-AMOD(EMIN,1.))
+      EMAX=VMAX/BASE+.5+SIGN(.5,VMAX-VMIN)
+      EMAX=EMAX-.5+SIGN(.5,EMAX)-SIGN(SMRL*EMAX,VMAX-VMIN)
+      WMAX=BASE*(EMAX-AMOD(EMAX,1.))
+      GO TO 114
+C
+  110 IF (VMIN.EQ.0.) GO TO 111
+      EMIN=ALOG10(ABS(VMIN)/BASE)+.5+SIGN(.5,VMIN*(VMIN-VMAX))
+      EMIN=EMIN-.5+SIGN(.5,EMIN)-SIGN(SMRL*EMIN,VMIN*(VMIN-VMAX))
+      WMIN=SIGN(BASE,VMIN)*10.**(EMIN-AMOD(EMIN,1.))
+  111 IF (VMAX.EQ.0.) GO TO 114
+      EMAX=ALOG10(ABS(VMAX)/BASE)+.5+SIGN(.5,VMAX*(VMAX-VMIN))
+      EMAX=EMAX-.5+SIGN(.5,EMAX)-SIGN(SMRL*EMAX,VMAX*(VMAX-VMIN))
+      WMAX=SIGN(BASE,VMAX)*10.**(EMAX-AMOD(EMAX,1.))
+      GO TO 114
+C
+  112 IF (BASE.EQ.1.) GO TO 115
+      IF (VMIN.EQ.0.) GO TO 113
+      EMIN=ALOG10(ABS(VMIN))/ALOG10(BASE)+.5+SIGN(.5,VMIN*(VMIN-VMAX))
+      EMIN=EMIN-.5+SIGN(.5,EMIN)-SIGN(SMRL*EMIN,VMIN*(VMIN-VMAX))
+      WMIN=SIGN(1.,VMIN)*BASE**(EMIN-AMOD(EMIN,1.))
+  113 IF (VMAX.EQ.0.) GO TO 114
+      EMAX=ALOG10(ABS(VMAX))/ALOG10(BASE)+.5+SIGN(.5,VMAX*(VMAX-VMIN))
+      EMAX=EMAX-.5+SIGN(.5,EMAX)-SIGN(SMRL*EMAX,VMAX*(VMAX-VMIN))
+      WMAX=SIGN(1.,VMAX)*BASE**(EMAX-AMOD(EMAX,1.))
+C
+C Re-compute the user-coordinate-system minimum and maximum values.
+C
+  114 CALL AGUTOL (IAXS,FUNS,-1,WMIN,QMIN)
+      CALL AGUTOL (IAXS,FUNS,-1,WMAX,QMAX)
+C
+C Test for problems with nice values chosen.
+C
+      IF (QMIN.LT.QMAX) GO TO 140
+      IF (QMIN.GT.QMAX) GO TO 901
+C
+C We have a pathological case - user values are clustered very close to
+C a label position.  See what can be done about it.
+C
+      LOOP=LOOP+1
+      IF (LOOP.GT.1) GO TO 901
+C
+      GO TO (137,138,139) , NBTP
+C
+  137 VMIN=VMIN+SIGN(BASE,VMIN-VMAX)
+      VMAX=VMAX+SIGN(BASE,VMAX-VMIN)
+      GO TO 109
+C
+  138 VMIN=VMIN*10.**SIGN(1.,VMIN*(VMIN-VMAX))
+      VMAX=VMAX*10.**SIGN(1.,VMAX*(VMAX-VMIN))
+      GO TO 110
+C
+  139 VMIN=VMIN*BASE**SIGN(1.,VMIN*(VMIN-VMAX))
+      VMAX=VMAX*BASE**SIGN(1.,VMAX*(VMAX-VMIN))
+      GO TO 112
+C
+  140 VMIN=WMIN
+      VMAX=WMAX
+C
+C Now we examine the parameters defining the appearance of the numeric
+C labels.  If the numeric-label type is zero, there is no more to do.
+C
+  115 IF (QLTD.EQ.SVAL(1).OR.QLTD.EQ.SVAL(2)) GO TO 116
+      NLTP=MAX0(0,MIN0(3,NLTD))
+      IF (NLTP.EQ.0) GO TO 136
+C
+C The numeric-label type (NLTP) is specified.  If both the numeric-label
+C exponent and numeric-label fraction-length are also specified, quit.
+C
+      NLEX=NLED
+      NLFL=NLFD
+      IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2).AND.
+     +    QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)       ) GO TO 136
+      GO TO 117
+C
+C We must pick a value for the numeric-label type.  Start with the dummy
+C value 4 so as to jump to the proper piece of code.
+C
+  116 NLTP=4
+C
+C Reduce the value of BASE to the form RBSE * 10**KBSE, where RBSE is
+C in the range (1,10) and KBSE is an integer.
+C
+  117 FTMP=BASE
+      ASSIGN 118 TO JMP1
+      GO TO 200
+C
+  118 RBSE=FTMP
+      KBSE=ITMP
+C
+C Compute LBSE = the number of significant digits in RBSE.
+C
+      ASSIGN 119 TO JMP2
+      GO TO 300
+C
+  119 LBSE=1+ITMP
+C
+C Jump depending on the value of the numeric-label type.
+C
+      GO TO (120,128,131,132) , NLTP
+C
+C Scientific notation is to be used.  Estimate the number of significant
+C digits that are likely to be required, depending on the number type.
+C
+  120 GO TO (121,123,124) , NBTP
+C
+  121 FTMP=AMAX1(ABS(VMIN),ABS(VMAX))/BASE
+      ASSIGN 122 TO JMP1
+      GO TO 200
+C
+  122 NSIG=MAX0(1,ITMP+1+LBSE)
+      GO TO 125
+C
+  123 NSIG=LBSE
+      GO TO 125
+C
+  124 NSIG=10
+C
+C NLEX + NLFL should be equal to NSIG.  Make that the case.
+C
+  125 IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2)) GO TO 127
+      IF (QLFD.EQ.SVAL(1).OR. QLFD.EQ.SVAL(2)) GO TO 126
+      NLEX=NSIG-MAX0(0,NLFL)
+      GO TO 135
+  126 NLEX=1
+  127 NLFL=NSIG-NLEX
+      IF (NLFL.LE.0) NLFL=-1
+      GO TO 135
+C
+C Exponential notation is to be used.  Compute the exponent NEXP such
+C that BASE / 10**NEXP is an integer.
+C
+  128 NEXP=KBSE-LBSE+1
+C
+C NLEX - NLFL should be equal to NEXP.  Make that the case.  (Note that,
+C if NBTP is 3, NLEX is forced to zero.)
+C
+      IF (NBTP.EQ.3) NLEX=0
+C
+      IF (QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)) GO TO 129
+      IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2)) GO TO 130
+      NLFL=-1
+  129 NLEX=MAX0(0,NLFL)+NEXP
+      GO TO 135
+  130 NLFL=NLEX-NEXP
+      IF (NLFL.LE.0) NLFL=-1
+      GO TO 135
+C
+C No-exponent notation is to be used.  NLFL is the only parameter we
+C need to worry about.  If it is already set, quit.
+C
+  131 IF (QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)) GO TO 136
+C
+C Set NLFL to the actual number of digits in the fractional portion of
+C BASE.
+C
+      NLFL=LBSE-KBSE-1
+      IF (NLFL.LE.0) NLFL=-1
+      GO TO 135
+C
+C We must pick a value for the numeric-label type, depending on the
+C number type.
+C
+  132 GO TO (133,134,134) , NBTP
+C
+C Nunbers are of the form (-) BASE * EXMU.  Use labels with no exponent
+C unless the use of an exponent would result in shorter labels.
+C
+  133 IF (MAX0(KBSE+1-LBSE,-KBSE-1).GT.4) GO TO 134
+      NLTP=3
+      NLFL=LBSE-KBSE-1
+      IF (NLFL.LE.0) NLFL=-1
+      GO TO 135
+C
+C Exponential notation is used.
+C
+  134 NLTP=2
+      NLEX=KBSE-LBSE+1
+      NLFL=-1
+C
+C Back-store the computed parameters, if requested, and return.
+C
+  135 IF (QLTD.EQ.SVAL(2)) QLTD=FLOAT(NLTP)
+      IF (QLED.EQ.SVAL(2)) QLED=FLOAT(NLEX)
+      IF (QLFD.EQ.SVAL(2)) QLFD=FLOAT(NLFL)
+C
+C Pack up integer values to floating-point arguments and return.
+C
+  136 QMNT=FLOAT(NMNT)
+      QLTP=FLOAT(NLTP)
+      QLEX=FLOAT(NLEX)
+      QLFL=FLOAT(NLFL)
+      RETURN
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This internal procedure reduces the number (FTMP) to the range (1,10),
+C returning (FTMP) and (ITMP) such that (FTMP) * 10**(ITMP) is equal to
+C the original value of (FTMP).  (FTMP) must be positive.
+C
+  200 FTM1=ALOG10(FTMP+SMRL*FTMP)
+      IF (FTM1.LT.0.) FTM1=FTM1-1.
+      ITMP=IFIX(FTM1)
+      FTMP=AMAX1(1.,FTMP*SNGL(10.D0**(-ITMP)))
+      GO TO JMP1 , (103,118,122)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This internal procedure counts the number of digits in the fractional
+C portion of (FTMP), returning the count as the value of (ITMP).
+C
+  300 FTM1=AMOD(FTMP+SMRL*FTMP,1.)
+      FTM2=10.*SMRL*FTMP
+      ITMP=0
+C
+  301 IF (FTM1.LT.FTM2) GO TO 302
+      ITMP=ITMP+1
+      IF (ITMP.GE.10) GO TO 302
+      FTM1=AMOD(10.*FTM1,1.)
+      FTM2=10.*FTM2
+      GO TO 301
+C
+  302 GO TO JMP2 , (119)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C Error exit.
+C
+C +NOAO - Comment out FTN write and format statement, SETER is okay.
+C
+  901 CONTINUE
+C 901 WRITE (I1MACH(4),9001) IAXS
+      CALL SETER ('AGEXAX (CALLED BY AGSTUP) - USER-SYSTEM-TO-LABEL-SYST
+     +EM MAPPING IS NOT MONOTONIC',1,2)
+C
+C Formats.
+C
+C9001 FORMAT ('0PROBLEM WITH AXIS NUMBER',I2,
+C    +        ' (1, 2, 3, AND 4 IMPLY LEFT, RIGHT, BOTTOM, AND TOP)')
+C
+C -NOAO
+      END
diff --git a/sys/gio/ncarutil/autograph/agexus.f b/sys/gio/ncarutil/autograph/agexus.f
new file mode 100644
index 00000000..7d4a274e
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agexus.f
@@ -0,0 +1,89 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGEXUS (SVAL,ZMIN,ZMAX,ZLOW,ZHGH,
+     +                               ZDRA,NVIZ,IIVZ,NEVZ,IIEZ,UMIN,UMAX)
+C
+      DIMENSION SVAL(2),ZDRA(1)
+C
+C The routine AGEXUS is used by AGSTUP to determine tentative values of
+C the user-window edge coordinates.  Its arguments are as follows:
+C
+C -- SVAL is the array of special values.
+C
+C -- ZMIN and ZMAX are user-supplied minimum and maximum values of the
+C    data x (or y) coordinates.
+C
+C -- ZLOW and ZHGH are, respectively, the smallest and largest data
+C    values to be considered in choosing the minimum and maximum, if
+C    those values, as given by the user, are null.
+C
+C -- ZDRA, NVIZ, IIVZ, NEVZ, and IIEZ specify the array of x (or y)
+C    data coordinates (see AGMAXI or AGMINI for complete description).
+C
+C -- UMIN and UMAX are returned with tentative minimum and maximum
+C    values for use at the appropriate user-window edges (left/right
+C    or bottom/top).
+C
+C The following common block contains AUTOGRAPH variables which are
+C not control parameters.  The only one used here is SMRL, which is a
+C (machine-dependent) small real which, when added to a number in the
+C range (1,10), will round it upward without seriously affecting the
+C leading significant digits.  The object of this is to get rid of
+C strings of nines.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Assume initially that the user has provided actual values to be used.
+C
+      UMIN=ZMIN
+      UMAX=ZMAX
+C
+C If either of the values is null, replace it by a data-based value.
+C
+      IF (UMIN.EQ.SVAL(1).OR.UMIN.EQ.SVAL(2))
+     +                UMIN=AGMINI(SVAL(1),ZLOW,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ)
+      IF (UMAX.EQ.SVAL(1).OR.UMAX.EQ.SVAL(2))
+     +                UMAX=AGMAXI(SVAL(1),ZHGH,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ)
+C
+C Either or both values might still be null (if the user data was null).
+C
+      IF (UMIN.EQ.SVAL(1)) UMIN=UMAX
+      IF (UMAX.EQ.SVAL(1)) UMAX=UMIN
+C
+C Check the relative values of UMIN and UMAX for problems.
+C
+      IF (ABS(UMIN-UMAX).LT.50.*SMRL*(ABS(UMIN)+ABS(UMAX))) GO TO 102
+      IF (UMAX-UMIN) 101,102,103
+  101 IF (ZMIN.NE.SVAL(1).AND.ZMIN.NE.SVAL(2)) UMAX=UMIN
+      IF (ZMAX.NE.SVAL(1).AND.ZMAX.NE.SVAL(2)) UMIN=UMAX
+C
+  102 UMIN=UMIN-.5*ABS(UMIN)
+      UMAX=UMAX+.5*ABS(UMAX)
+      IF (UMIN.NE.UMAX) GO TO 103
+      UMIN=-1.
+      UMAX=+1.
+C
+C If the user wanted these values back-stored, do it.
+C
+  103 IF (ZMIN.EQ.SVAL(2)) ZMIN=UMIN
+      IF (ZMAX.EQ.SVAL(2)) ZMAX=UMAX
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agezsu.f b/sys/gio/ncarutil/autograph/agezsu.f
new file mode 100644
index 00000000..535e1811
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agezsu.f
@@ -0,0 +1,104 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGEZSU (ITOC,XDRA,YDRA,IDXY,MANY,NPTS,LABG,IIVX,IIEX,
+     +                                                      IIVY,IIEY)
+C
+      REAL XDRA(1),YDRA(1)
+      CHARACTER*(*) LABG
+C
+C The routine AGEZSU is used by the AUTOGRAPH routines EZY, EZXY, EZMY,
+C EZMXY, and IDIOT to examine those parameters which are peculiar to the
+C old version of AUTOGRAPH and to do the appropriate call to AGSTUP.
+C The arguments are as follows:
+C
+C -- ITOC indicates which routine is calling AGEZSU, as follows:
+C
+C     -- ITOC .EQ. 1 - call by EZY
+C     -- ITOC .EQ. 2 - call by EZXY
+C     -- ITOC .EQ. 3 - call by EZMY
+C     -- ITOC .EQ. 4 - call by EZMXY
+C     -- ITOC .EQ. 5 - call by IDIOT
+C
+C -- XDRA is an array of x-coordinate data.
+C
+C -- YDRA is an array of y-coordinate data.
+C
+C -- IDXY is the first dimension of YDRA.
+C
+C -- MANY is the number of curves defined by XDRA and YDRA.
+C
+C -- NPTS is the number of points per curve.
+C
+C -- LABG is a new header label (or the single character CHAR(0), if the
+C    header label is to be unchanged).
+C
+C -- IIVX, IIEX, IIVY, and IIEY are indexing controls for the x and y
+C    data arrays, computed and returned by AGEZSU for use in setting up
+C    calls to the routine AGCURV.
+C
+C Examine the frame-advance parameter.  Do frame advance as appropriate.
+C
+      CALL AGGETI ('FRAM.',IFRA)
+      IFRA=MAX0(1,MIN0(3,IFRA))
+C
+      IF (IFRA.EQ.3) CALL FRAME
+C
+C Set up the header label.
+C
+      IF (ICHAR(LABG(1:1)).NE.0) THEN
+        CALL AGSETC ('LABE/NAME.', 'T')
+        CALL AGSETI ('LINE/NUMB.', 100)
+        CALL AGSETC ('LINE/TEXT.',LABG)
+      END IF
+C
+C Set up the AGSTUP arguments defining the coordinate-data arrays.
+C
+      CALL AGGETI ('ROW .',IROW)
+      IROW=MAX0(-2,MIN0(+2,IROW))
+C
+      NVIY=MANY
+      IIVY=IDXY
+      NEVY=NPTS
+      IIEY=1
+C
+      IF (IROW.LE.0.AND.ITOC.GE.3.AND.ITOC.LE.4) THEN
+        IIVY=1
+        IIEY=IDXY
+      END IF
+C
+      NVIX=NVIY
+      IIVX=IIVY
+      NEVX=NEVY
+      IIEX=IIEY
+C
+      IF (IABS(IROW).LE.1) THEN
+        NVIX=1
+        IIVX=0
+        NEVX=NPTS
+        IIEX=1
+      END IF
+C
+      IF (ITOC.EQ.1.OR.ITOC.EQ.3) IIEX=0
+C
+C Do the AGSTUP call.
+C
+      CALL AGSTUP (XDRA,NVIX,IIVX,NEVX,IIEX,YDRA,NVIY,IIVY,NEVY,IIEY)
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agfpbn.f b/sys/gio/ncarutil/autograph/agfpbn.f
new file mode 100644
index 00000000..f4900b60
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agfpbn.f
@@ -0,0 +1,37 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      INTEGER FUNCTION AGFPBN (FPDP)
+C
+C The value of AGFPBN(FPDP) is a binary dash pattern, obtained from the
+C floating-point dash pattern FPDP.  On machines having a word length
+C greater than 16 bits, AGFPBN(FPDP) = IFIX(FPDP).  On machines having
+C a word length of 16 bits, this is not true.  For example, when FPDP =
+C 65535. (2 to the 16th minus 1), the equivalent binary dash pattern
+C does not have the value 65535, but the value -1 (assuming integers
+C are represented in a ones' complement format).  So, the functions
+C ISHIFT and IOR must be used to generate the dash pattern.
+C
+      TEMP=FPDP
+      AGFPBN=0
+C
+      DO 101 I=1,16
+        IF (AMOD(TEMP,2.).GE.1.) AGFPBN=IOR(AGFPBN,ISHIFT(1,I-1))
+        TEMP=TEMP/2.
+  101 CONTINUE
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agftol.f b/sys/gio/ncarutil/autograph/agftol.f
new file mode 100644
index 00000000..b685f913
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agftol.f
@@ -0,0 +1,119 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGFTOL (IAXS,IDMA,VINP,VOTP,VLCS,LLUA,UBEG,UDIF,FUNS,
+     +                                                        NBTP,SBSE)
+C
+C The routine AGFTOL is used by AGAXIS to map a fractional distance
+C along the axis to a value in the label coordinate system or vice-
+C versa.  Its arguments are as follows:
+C
+C -- IAXS specifies which axis is being drawn.  It is passed to the
+C    routine AGUTOL.  See AGAXIS for a complete description of IAXS.
+C
+C -- IDMA specifies the direction of the mapping - from the fractional
+C    system to the label system if IDMA .GT. 0 or from the label system
+C    to the fractional system if IDMA .LT. 0.  IDMA also specifies how
+C    the label-system value is given to or returned by AGFTOL.
+C
+C     -- If ABSV(IDMA) .EQ. 1, an actual value in the label coordinate
+C        system (VLCS) is given to or returned by AGFTOL.
+C
+C     -- If ABSV(IDMA) .NE. 1, a value of the exponent/multiplier EXMU
+C        corresponding to VLCS is given to or returned by AGFTOL.
+C
+C -- VINP is an input value in one coordinate system.
+C
+C -- VOTP is an output value in the other coordinate system.
+C
+C -- VLCS is an output value in the label coordinate system, returned
+C    no matter what the value of IDMA.
+C
+C -- LLUA, UBGA, and UDFA specify the mapping from the user coordinate
+C    system to the fractional system and vice-versa.  See the routine
+C    AGAXIS for a complete description of these parameters.
+C
+C -- FUNS is a function-selector, to be used in calls to AGUTOL.  It
+C    selects the mapping from the user coordinate system to the label
+C    coordinate system and vice-versa.  See the routine AGAXIS for a
+C    complete description of this parameter.
+C
+C -- NBTP and SBSE specify the mapping of label-coordinate-system values
+C    to exponent/multiplier values and vice-versa.  See the routine
+C    AGNUMB for a complete dexcription of these parameters.
+C
+C Determine desired direction of mapping.
+C
+      IF (IDMA.GT.0) THEN
+C
+C Map axis fraction VINP to a label-coordinate-system value VLCS.
+C
+        VUCS=UBEG+VINP*UDIF
+        IF (LLUA.NE.0) VUCS=10.**VUCS
+        CALL AGUTOL (IAXS,FUNS,1,VUCS,VLCS)
+C
+C If IDMA .EQ. 1, caller wants VLCS - otherwise, map VLCS to the
+C appropriate exponent/multiplier value EXMU - return value in VOTP.
+C
+        IF (IDMA.EQ.1) THEN
+          VOTP=VLCS
+          RETURN
+        END IF
+C
+        GO TO (101,102,103) , NBTP
+C
+  101   VOTP=VLCS/SBSE
+        RETURN
+C
+  102   VOTP=ALOG10(VLCS/SBSE)
+        RETURN
+C
+  103   VOTP=ALOG10(ABS(VLCS))/ALOG10(ABS(SBSE))
+        RETURN
+C
+      ELSE
+C
+C If IDMA .EQ. -1, caller has provided VINP .EQ. VLCS, a value in the
+C label coordinate system - otherwise, VINP .EQ. EXMU, the exponent/
+C multiplier needed to generate VLCS.
+C
+        IF (IDMA.EQ.(-1)) THEN
+          VLCS=VINP
+          GO TO 107
+        END IF
+C
+        GO TO (104,105,106) , NBTP
+C
+  104   VLCS=SBSE*VINP
+        GO TO 107
+C
+  105   VLCS=SBSE*10.**VINP
+        GO TO 107
+C
+  106   VLCS=SIGN(1.,SBSE)*ABS(SBSE)**VINP
+C
+C Map label-system value VLCS to a user-system value VUCS.
+C
+  107   CALL AGUTOL (IAXS,FUNS,-1,VLCS,VUCS)
+C
+C Map user-system value VUCS to an axis fraction VOTP and return.
+C
+        IF (LLUA.NE.0) VUCS=ALOG10(VUCS)
+        VOTP=(VUCS-UBEG)/UDIF
+        RETURN
+C
+      END IF
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggetc.f b/sys/gio/ncarutil/autograph/aggetc.f
new file mode 100644
index 00000000..caf9f357
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggetc.f
@@ -0,0 +1,51 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGETC (TPID,CUSR)
+C
+      CHARACTER*(*) TPID,CUSR
+C
+      DIMENSION FURA(1)
+C
+C The routine AGGETC is used to get the character strings represented
+C by the values of certain individual AUTOGRAPH parameters.  TPID is a
+C parameter identifier (from the caller).  CUSR is a character string
+C (returned to the caller).
+C
+C See what kind of parameter is being gotten.
+C
+      CALL AGCTCS (TPID,ITCS)
+C
+C If the parameter is not intrinsically of type character, log an error.
+C
+      IF (ITCS.EQ.0) GO TO 901
+C
+C Otherwise, get the integer value of the parameter and use that to get
+C the desired character string.
+C
+      CALL AGGETP (TPID,FURA,1)
+      CALL AGGTCH (IFIX(FURA(1)),CUSR,LNCS)
+C
+C Done.
+C
+      RETURN
+C
+C Error exit.
+C
+  901 CALL AGPPID (TPID)
+      CALL SETER ('AGGETC - PARAMETER TO GET IS NOT INTRINSICALLY OF TYP
+     +E CHARACTER',2,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggetf.f b/sys/gio/ncarutil/autograph/aggetf.f
new file mode 100644
index 00000000..6391222b
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggetf.f
@@ -0,0 +1,28 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGETF (TPID,FUSR)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGGETF may be used to get the real (floating-point) value
+C of any single AUTOGRAPH control parameter.
+C
+      CALL AGGETP (TPID,FURA,1)
+      FUSR=FURA(1)
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggeti.f b/sys/gio/ncarutil/autograph/aggeti.f
new file mode 100644
index 00000000..31841826
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggeti.f
@@ -0,0 +1,28 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGETI (TPID,IUSR)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGGETI may be used to get the integer-equivalent value of
+C any single AUTOGRAPH control parameter.
+C
+      CALL AGGETP (TPID,FURA,1)
+      IUSR=IFIX(FURA(1))
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggetp.f b/sys/gio/ncarutil/autograph/aggetp.f
new file mode 100644
index 00000000..ac44085e
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggetp.f
@@ -0,0 +1,104 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGETP (TPID,FURA,LURA)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGGETP returns to the user the AUTOGRAPH parameter(s)
+C specified by the parameter identifier TPID.  The arguments are as
+C follows:
+C
+C -- TPID is the parameter identifier, a string of keywords separated
+C    from each other by slashes and followed by a period.
+C
+C -- FURA is the user array which is to receive the desired parameter(s)
+C    specified by TPID.
+C
+C -- LURA is the length of the user array FURA.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Define the array DUMI, which allows access to the parameter list as
+C an array.
+C
+      DIMENSION DUMI(1)
+      EQUIVALENCE (QFRA,DUMI)
+C
+C If initialization has not yet been done, do it.
+C
+      IF (INIF.EQ.0) THEN
+        CALL AGINIT
+      END IF
+C
+C The routine AGSCAN is called to scan the parameter identifier and to
+C return three quantities describing the AUTOGRAPH parameters desired.
+C
+      CALL AGSCAN (TPID,LOPA,NIPA,IIPA)
+C
+C Determine the number of elements to transfer.
+C
+      NURA=MAX0(1,MIN0(LURA,NIPA))
+C
+C Transfer the desired parameters to the user array.
+C
+      IDMI=LOPA-IIPA
+C
+      DO 101 IURA=1,NURA
+        IDMI=IDMI+IIPA
+        FURA(IURA)=DUMI(IDMI)
+  101 CONTINUE
+C
+C If the current label name is being gotten, return its identifier.
+C
+      CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN)
+      IF (LOPA.EQ.LOLN.AND.NIPA.EQ.NILN.AND.QBAN.NE.0.) THEN
+        LBAN=IFIX(QBAN)
+        FURA(1)=FLLB(1,LBAN)
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aggtch.f b/sys/gio/ncarutil/autograph/aggtch.f
new file mode 100644
index 00000000..7591c670
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aggtch.f
@@ -0,0 +1,78 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGGTCH (IDCS,CHST,LNCS)
+C
+      CHARACTER*(*) CHST
+C
+C This routine gets character strings previously stored by the routine
+C AGSTCH (which see).  It has the following arguments:
+C
+C -- IDCS is the identifying integer returned by AGSTCH when the string
+C    was stored.
+C
+C -- CHST is the character string returned.
+C
+C -- LNCS is the length of the character string returned in CHST.
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C First, blank-fill the character variable to be returned.
+C
+      CHST=' '
+C
+C If the identifier is less than -LNIC, the (one-character) string is
+C retrieved from it.
+C
+      IF (IDCS.LT.(-LNIC)) THEN
+        CHST=CHAR(-IDCS-LNIC-1)
+        LNCS=1
+C
+C If the identifier is between -LNIC and -1, its absolute value is the
+C index, in INCH, of the descriptor of the character string stored in
+C CHRA.
+C
+      ELSE IF (IDCS.LE.(-1)) THEN
+        I=-IDCS
+        J=INCH(1,I)-1
+        IF (J.GE.0) THEN
+          LNCS=MIN0(LEN(CHST),INCH(2,I))
+          DO 101 K=1,LNCS
+            J=J+1
+            CHST(K:K)=CHRA(J)
+  101     CONTINUE
+        ELSE
+          LNCS=0
+        END IF
+C
+C In all other cases, return a single blank.
+C
+      ELSE
+        LNCS=1
+C
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aginit.f b/sys/gio/ncarutil/autograph/aginit.f
new file mode 100644
index 00000000..e863e01f
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aginit.f
@@ -0,0 +1,113 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGINIT
+C
+C This routine is called to initialize some machine-dependent constants.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Fill in the names of the four pre-defined labels.
+C
+      CALL AGSTCH ('L',1,IDCS)
+      FLLB(1,1)=FLOAT(IDCS)
+      CALL AGSTCH ('R',1,IDCS)
+      FLLB(1,2)=FLOAT(IDCS)
+      CALL AGSTCH ('B',1,IDCS)
+      FLLB(1,3)=FLOAT(IDCS)
+      CALL AGSTCH ('T',1,IDCS)
+      FLLB(1,4)=FLOAT(IDCS)
+C
+C Declare the rest of the label-definition slots to be available.
+C
+      LBIM=IFIX(QBIM)
+C
+      DO 101 J=5,LBIM
+        FLLB(1,J)=0.
+  101 CONTINUE
+C
+C Fill in the text of the four pre-defined lines.
+C
+      CALL AGSTCH ('Y',1,IDCS)
+      FLLN(4,1)=FLOAT(IDCS)
+      CALL AGSTCH (' ',1,IDCS)
+      FLLN(4,2)=FLOAT(IDCS)
+      CALL AGSTCH ('X',1,IDCS)
+      FLLN(4,3)=FLOAT(IDCS)
+      CALL AGSTCH (' ',1,IDCS)
+      FLLN(4,4)=FLOAT(IDCS)
+C
+C Declare the rest of the line-definition slots to be available.
+C
+      LNIM=IFIX(QNIM)
+C
+      DO 102 J=5,LNIM
+        FLLN(1,J)=SVAL(1)
+  102 CONTINUE
+C
+C Set the value of 'LINE/TERMINATOR.'
+C
+      CALL AGSTCH ('$',1,IDCS)
+      TCLN=FLOAT(IDCS)
+C
+C SMRL is used by AUTOGRAPH for rounding operations.
+C
+      SMRL=10.**(3-IFIX(ALOG10(FLOAT(I1MACH(10)))*FLOAT(I1MACH(11))))
+C
+C ISLD is an integer containing 16 one bits (right-justified with zero
+C fill to the left).  It is used to direct the DASHCHAR package to draw
+C solid lines.  To generate it, we start with a 15-bit mask and then
+C add another bit.
+C
+      ISLD = 32767
+      ISLD = ISHIFT(ISLD,1)
+      ISLD = IOR(ISLD,1)
+C
+C Set the initialization flag to indicate initialization has been done.
+C
+      INIF=1
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agkurv.f b/sys/gio/ncarutil/autograph/agkurv.f
new file mode 100644
index 00000000..d93f0659
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agkurv.f
@@ -0,0 +1,145 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGKURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL)
+C
+      DIMENSION XVEC(1),YVEC(1)
+C
+C AGKURV plots the curve defined by the points ((X(I),Y(I)),I=1,NEXY),
+C where
+C
+C    X(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case X(I)=I), and
+C    Y(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case Y(I)=I).
+C
+C If, for some I, X(I)=SVAL or Y(I)=SVAL, curve line segments having
+C (X(I),Y(I)) as an endpoint are omitted.
+C
+C No windowing is performed.
+C
+C Check first whether the number of curve points is properly specified.
+C
+      IF (NEXY.LE.0) GO TO 901
+C
+C Initialization.  Pretend that the last point was point number zero.
+C Set the indices for the x and y vectors accordingly.  Clear the line-
+C drawn-to-last-point flag.
+C
+      INDP=0
+      INDX=1-IIEX
+      INDY=1-IIEY
+      LDLP=0
+C
+C Initialization.  Retrieve the current curve window, user window, and
+C x/y linear/logarithmic flags.
+C
+      CALL GETSET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP)
+C
+C Initialization.  Set linear/log flag and linear-window limits for
+C x-axis values.
+C
+      IF (LTYP.EQ.1.OR.LTYP.EQ.2) THEN
+        LLUX=0
+        XLLW=XLUW
+        XRLW=XRUW
+      ELSE
+        LLUX=1
+        XLLW=ALOG10(XLUW)
+        XRLW=ALOG10(XRUW)
+      END IF
+C
+C Initialization.  Set linear/log flag and linear-window limits for
+C y-axis values.
+C
+      IF (LTYP.EQ.1.OR.LTYP.EQ.3) THEN
+        LLUY=0
+        YBLW=YBUW
+        YTLW=YTUW
+      ELSE
+        LLUY=1
+        YBLW=ALOG10(YBUW)
+        YTLW=ALOG10(YTUW)
+      END IF
+C
+C Initialization.  Call SET, if necessary, to define a linear mapping.
+C
+      IF (LTYP.NE.1)
+     +              CALL SET (XLCW,XRCW,YBCW,YTCW,XLLW,XRLW,YBLW,YTLW,1)
+C
+C Beginning of loop through points.  Update indices and determine the
+C user-space coordinates of the next point.
+C
+  101 IF (INDP.EQ.NEXY) GO TO 102
+      INDP=INDP+1
+C
+      INDX=INDX+IIEX
+      XNXT=XVEC(INDX)
+      IF (IIEX.EQ.0) XNXT=FLOAT(INDP)
+      IF (LLUX.NE.0.AND.XNXT.LE.0.) XNXT=SVAL
+C
+      INDY=INDY+IIEY
+      YNXT=YVEC(INDY)
+      IF (IIEY.EQ.0) YNXT=FLOAT(INDP)
+      IF (LLUY.NE.0.AND.YNXT.LE.0.) YNXT=SVAL
+C
+C Check whether (XNXT,YNXT) is a special-value point.  Handle that case.
+C
+      IF (XNXT.EQ.SVAL.OR.YNXT.EQ.SVAL) THEN
+        IF (LDLP.EQ.0) GO TO 101
+        IF (LDLP.EQ.1) CALL VECTD (XLST,YLST)
+        CALL LASTD
+        LDLP=0
+        GO TO 101
+      END IF
+C
+C If user space is not linear/linear, modify XNXT and YNXT accordingly.
+C
+      IF (LLUX.NE.0) XNXT=ALOG10(XNXT)
+      IF (LLUY.NE.0) YNXT=ALOG10(YNXT)
+C
+C Start or continue line.
+C
+      IF (LDLP.EQ.0) THEN
+        CALL FRSTD (XNXT,YNXT)
+        XLST=XNXT
+        YLST=YNXT
+      ELSE
+        CALL VECTD (XNXT,YNXT)
+      END IF
+C
+      LDLP=LDLP+1
+      GO TO 101
+C
+C Last point was final point.  Finish up.
+C
+  102 IF (LDLP.NE.0) THEN
+        IF (LDLP.EQ.1) CALL VECTD (XLST,YLST)
+        CALL LASTD
+      END IF
+C
+C Restore logarithmic mapping, if appropriate.
+C
+      IF (LTYP.NE.1)
+     +           CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP)
+C
+C Return to caller.
+C
+      RETURN
+C
+C Error exit.
+C
+  901 CALL SETER ('AGKURV - NUMBER OF POINTS IS LESS THAN OR EQUAL TO ZE
+     +RO',3,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/aglbls.f b/sys/gio/ncarutil/autograph/aglbls.f
new file mode 100644
index 00000000..d99b038d
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/aglbls.f
@@ -0,0 +1,616 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGLBLS (ITST,WCWP,HCWP,FLLB,LBIM,FLLN,DBOX,SBOX,RBOX)
+C
+      DIMENSION FLLB(10,8),FLLN(6,16),DBOX(6,4),SBOX(6,4),RBOX(6)
+C
+C The routine AGLBLS is used (if ITST .LE. 0) to predict the amount of
+C space which will be required for graph labels (excluding the numeric
+C labels on the axes, which are handled by AGAXIS) or (if ITST .GT. 0)
+C to actually draw the graph labels.
+C
+C The labels in question are defined by the label list (FLLB array) and
+C the line list (FLLN array).  Each label is assumed to lie in one of
+C five boxes, as follows:
+C
+C    Box 1 is to the left of the curve window.
+C    Box 2 is to the right of the curve window.
+C    Box 3 is below the curve window.
+C    Box 4 is above the curve window.
+C    Box 5 is the curve window itself.
+C    Box 6 is the entire plot (graph) window.
+C
+C A test run of AGLBLS returns two sets of box dimensions to the caller.
+C DBOX contains the dimensions required if all labels are to have their
+C desired sizes, SBOX the dimensions required if all labels are to have
+C their smallest sizes.  The caller is expected to use this information
+C to determine a final set of box dimensions (stored in DBOX), and then
+C call AGLBLS again to actually draw the labels in those boxes.
+C
+C The arguments of AGLBLS are as follows:
+C
+C -- ITST specifies whether the call is a test call (ITST .LE. 0) or a
+C    real call (ITST .GT. 0).  If ABSV(ITST) .GT. 1, AGLBLS is allowed
+C    to shrink the labels if they would not otherwise fit in their box.
+C    If ABSV(ITST) .EQ. 1, shrinkage of labels is prohibited.  If ITST
+C    .EQ. 0, labels are suppressed.
+C
+C -- WCWP and HCWP are the width and height of the curve window, in
+C    plotter-coordinate-system units.  AGLBLS assumes that the last call
+C    to the plot package routine "SET" had arguments XLCW, XRCW, YBCW,
+C    YTCW, 0., 1., 0., 1., and 1 - defining the most convenient system
+C    of coordinates for it.
+C
+C -- FLLB is the array in which the label list is stored.  The array is
+C    doubly-dimensioned.  The first subscript specifies one of ten label
+C    attributes, the second a particular label.  The attributes are as
+C    follows (the name ILLB(M,N) refers to a label attribute which is
+C    intrinsically an integer, despite being stored as a real):
+C
+C    -- ILLB(1,N) specifies the name of label N.  If ILLB(1,N) is zero,
+C       no label is defined.  Otherwise, ILLB(1,N) is an identifier
+C       returned by AGSTCH when the name of the label (a character
+C       string) was stored away.
+C
+C    -- ILLB(2,N) may be set non-zero to suppress label N.
+C
+C    -- FLLB(3,N) and FLLB(4,N) are the x and y coordinates of a base-
+C       point relative to which label N is positioned, as fractions of
+C       the width and height, respectively, of the curve window.  The
+C       position of the base-point determines the box in which label N
+C       is considered to lie.
+C
+C    -- FLLB(5,N) and FLLB(6,N) are small offsets (typically about the
+C       size of a character width), stated as fractions of the smaller
+C       side of the curve window.  They are used to offset the label
+C       base-point (after the box number is determined).  Typically,
+C       this provides a minimum spacing between the label and one side
+C       of the curve window.
+C
+C    -- ILLB(7,N) is the orientation angle of the label, in degrees
+C       counter-clockwise from horizontal.  The base-line for label N
+C       is a vector emanating from the base-point at this angle.  The
+C       specified angle must be a multiple of 90 degrees.
+C
+C    -- ILLB(8,N) is the centering option for the label.  It specifies
+C       how each line of the label is to be positioned relative to a
+C       line perpendicular to the base-line at the base-point.
+C
+C       -- If ILLB(8,N) .LT. 0, the left edge of each line lies on
+C          the perpendicular.
+C
+C       -- If ILLB(8,N) .EQ. 0, the center of each line lies on the
+C          perpendicular.
+C
+C       -- If ILLB(8,N) .GT. 0, the right edge of each line lies on
+C          the perpendicular.
+C
+C    -- ILLB(9,N) is the number of lines in label N.
+C
+C    -- ILLB(10,N) is the second subscript (in the line list) of the
+C       first line of label N.
+C
+C -- LBIM is the maximum number of labels the label list will hold.
+C
+C -- FLLN is the array in which the line list is stored.  The array is
+C    doubly-dimensioned.  The first subscript specifies one of six line
+C    attributes, the second a particular line.  The attributes are as
+C    follows (the name ILLN(M,N) refers to a line attribute which is
+C    intrinsically an integer, despite being stored as a real):
+C
+C    -- ILLN(1,N) is the position number of line N.  The lines of a
+C       label are ordered according to their position numbers, the one
+C       having the largest position number being top-most.  Moreover,
+C       lines having position numbers .GT. 0 are placed above the label
+C       base-line, those having position numbers .EQ. 0 (of which there
+C       should be but one) are placed on the label base-line, and those
+C       having position numbers .LT. 0 are placed below the label base-
+C       line.  The magnitudes of the position numbers have nothing to
+C       do with inter-line spacing - that is up to AGLBLS to determine.
+C
+C    -- ILLN(2,N) may be set non-zero to suppress line N.
+C
+C    -- FLLN(3,N) is the desired width of characters in the line, as a
+C       fraction of the smaller side of the curve window.
+C
+C    -- ILLN(4,N) is the identifier of the character string comprising
+C       the text of the line, as returned by AGSTCH at the time the
+C       string was stored.
+C
+C    -- ILLN(5,N) is the number of characters in the line.
+C
+C    -- ILLN(6,N) is the index of the next line of the label.  The
+C       lines of a label must be ordered by position number (largest
+C       to smallest).
+C
+C -- DBOX and SBOX, dimensioned 6 X 4, contain box dimensions, as dis-
+C    cussed above.  D/SBOX(M,N) is the Nth edge-coordinate of box M,
+C    where N .EQ. 1 for the left edge, 2 for the right edge, 3 for the
+C    bottom edge, and 4 for the top edge, of the box.  The first two are
+C    stated as fractions of the width, the second two as fractions of
+C    the height, of the curve window.
+C
+C    RBOX, dimensioned 6, holds reduction factors for the sizes of the
+C    characters in labels in each of the six boxes.  Each RBOX(M) is
+C
+C    -- negative to specify smallest-size characters, or
+C
+C    -- zero to specify that no reduction factor has been chosen, or
+C
+C    -- positive, between 0. and 1. (an actual reduction factor).
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.  The only one of
+C interest here is MWCL, which is the minimum usable character width,
+C in plotter units.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of type
+C character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+c+noao
+c     CHARACTER*504 CHS1,CHS2
+      CHARACTER*500 CHS1,CHS2
+c-noao
+C
+C HCFW(WDTH) specifies the height of a character as a function of width.
+C
+      HCFW(WDTH)=2.*WDTH
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This is the main section of AGLBLS.
+C
+C Compute the length of the smallest side of the curve window.
+C
+      SCWP=AMIN1(WCWP,HCWP)
+C
+C Preset certain jumps in the internal procedure which follows.
+C
+      ASSIGN 211 TO JMP1
+      ASSIGN 216 TO JMP2
+      ASSIGN 221 TO JMP3
+C
+C Jump if this is a test run.
+C
+      IF (ITST.LE.0) GO TO 101
+C
+C This is not a test run.  If the reduction factors for the six boxes
+C are already set, jump directly to the plotting section; otherwise, we
+C must first compute the coordinates of the six smallest-size boxes.
+C
+      IF (RBOX(1).NE.0.) GO TO 115
+      GO TO 105
+C
+C This is a test run.  Compute the coordinates of the edges of the six
+C desired-size boxes.
+C
+  101 RWCL=1.
+      NBOX=0
+      ASSIGN 102 TO JMP4
+      GO TO 200
+C
+  102 DBOX(NBOX,1)=XLBX
+      DBOX(NBOX,2)=XRBX
+      DBOX(NBOX,3)=YBBX
+      DBOX(NBOX,4)=YTBX
+C
+      IF (NBOX.LT.6) GO TO 200
+C
+C This is a test run.  Compute the coordinates of the edges of the six
+C smallest-size boxes, in one of two ways.
+C
+      IF (IABS(ITST).GT.1) GO TO 105
+C
+C This is a test run.  Determine smallest-size boxes (no shrinking).
+C
+      DO 104 J=1,4
+        DO 103 I=1,6
+          SBOX(I,J)=DBOX(I,J)
+  103   CONTINUE
+  104 CONTINUE
+      RETURN
+C
+C Determine smallest-size boxes (shrinking allowed).
+C
+  105 RWCL=0.
+      NBOX=0
+      ASSIGN 106 TO JMP4
+      GO TO 200
+C
+  106 SBOX(NBOX,1)=XLBX
+      SBOX(NBOX,2)=XRBX
+      SBOX(NBOX,3)=YBBX
+      SBOX(NBOX,4)=YTBX
+C
+      IF (NBOX.LT.6) GO TO 200
+C
+C If this is not a test run, jump to compute reduction factors for each
+C of the six boxes and then plot the labels.  Otherwise, return.
+C
+      IF (ITST.GT.0) GO TO 107
+      RETURN
+C
+C This is not a test run.  Compute reduction factors for each of the
+C six boxes.
+C
+  107 NBOX=1
+      ASSIGN 110 TO JMP4
+C
+C (DBOX(NBOX,I),I=1,4) specifies the box in which the labels are to be
+C drawn, (SBOX(NBOX,I),I=1,4) the minimum box in which they can be drawn
+C if shrunk.  Check first whether the latter is contained in the former.
+C If so, we have a chance.  If not, the best we can do is shrink the
+C labels to minimum size and hope for the best.
+C
+  108 IF (SBOX(NBOX,1).LT.SBOX(NBOX,2).AND.
+     +    DBOX(NBOX,1)-SBOX(NBOX,1).LT..0001.AND.
+     +    SBOX(NBOX,2)-DBOX(NBOX,2).LT..0001.AND.
+     +    DBOX(NBOX,3)-SBOX(NBOX,3).LT..0001.AND.
+     +    SBOX(NBOX,4)-DBOX(NBOX,4).LT..0001      ) GO TO 109
+C
+      RBOX(NBOX)=-1.
+      GO TO 114
+C
+C Mimimum-size labels will fit.  Find the largest value of RBOX(NBOX)
+C for which the labels will fit.
+C
+  109 RWCL=1.
+      DWCL=.5
+      SWCL=0.
+      GO TO 201
+C
+C See if the last value of RBOX(NBOX) gave us labels which would fit or
+C not and adjust the value accordingly.
+C
+  110 IF (DBOX(NBOX,1)-XLBX.LT..0001.AND.
+     +    XRBX-DBOX(NBOX,2).LT..0001.AND.
+     +    DBOX(NBOX,3)-YBBX.LT..0001.AND.
+     +    YTBX-DBOX(NBOX,4).LT..0001      ) GO TO 111
+C
+C Labels did not fit.  Adjust RBOX(NBOX) downward.
+C
+      RWCL=RWCL-DWCL
+      DWCL=.5*DWCL
+      IF (DWCL.LT..001) RWCL=SWCL
+      GO TO 201
+C
+C Labels did fit.  Adjust RBOX(NBOX) upward, unless it is equal to 1.
+C
+  111 IF (RWCL.EQ.1.) GO TO 113
+      SWCL=RWCL
+      RWCL=RWCL+DWCL
+      DWCL=.5*DWCL
+      IF (DWCL.GT..001) GO TO 201
+C
+C The current value of RBOX(NBOX) is acceptable.  Do next box, if any.
+C
+  113 IF (NBOX.GE.5) GO TO 114
+C
+C Return updated box-edge coordinates for boxes 1 through 4.
+C
+      DBOX(NBOX,1)=XLBX
+      DBOX(NBOX,2)=XRBX
+      DBOX(NBOX,3)=YBBX
+      DBOX(NBOX,4)=YTBX
+C
+  114 NBOX=NBOX+1
+      IF (NBOX.LE.6) GO TO 108
+C
+C We have done all we can to make the labels fit.  Plot them now.
+C
+  115 NBOX=0
+      LBIN=0
+      ASSIGN 117 TO JMP3
+      ASSIGN 120 TO JMP4
+C
+C Get a label to chew on.
+C
+  116 ASSIGN 211 TO JMP1
+      ASSIGN 216 TO JMP2
+      GO TO 202
+C
+C We have a label.  Initialize the re-loop through the lines in it.
+C
+  117 XPLN=XPLB-DTLB*YDLB/WCWP
+      YPLN=YPLB+DTLB*XDLB/HCWP
+      PHCL=0.
+      LNIN=LNII
+      ASSIGN 118 TO JMP1
+      ASSIGN 116 TO JMP2
+      GO TO 210
+C
+C Get ready to plot the label line.
+C
+  118 XPLN=XPLN+.5*(PHCL+FHCL)*YDLB/WCWP
+      YPLN=YPLN-.5*(PHCL+FHCL)*XDLB/HCWP
+      PHCL=FHCL
+      CALL AGGTCH (IFIX(FLLN(4,LNIN)),CHS2,LNC2)
+C
+C Give the user a chance to change the appearance of the label line.
+C
+      CALL AGCHIL (0,CHS1(1:LNC1),IFIX(FLLN(1,LNIN)))
+C
+C Plot the label line.
+C
+      CALL AGPWRT (XPLN,YPLN,CHS2,LNC2,IWCL,LBOR,LBCN)
+C
+C Give the user a chance to undo the changes he made above.
+C
+      CALL AGCHIL (1,CHS1(1:LNC1),IFIX(FLLN(1,LNIN)))
+C
+C Go get the next line, if any.
+C
+      GO TO 215
+C
+C All labels are drawn.  Return.
+C
+  120 RETURN
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+C This internal procedure, which may be entered and exited in a number
+C of different ways, is used to scan the label list and the line list
+C and to return information about the labels and lines defined there.
+C
+C Entry occurs here to bump the box number, store away a reduction
+C factor for the sizes of labels in that box, and then compute the edge
+C coordinates of the box required to hold labels of the size implied by
+C that reduction factor.
+C
+  200 NBOX=NBOX+1
+C
+C Entry occurs here to do all of the above except the bumping of the box
+C number.
+C
+  201 RBOX(NBOX)=RWCL
+C
+C Initialize the label-list index and the box-edge parameters.
+C
+      LBIN=0
+      XLBX=+1000.
+      XRBX=-1000.
+      YBBX=+1000.
+      YTBX=-1000.
+      IF (ITST.EQ.0) GO TO 222
+C
+C This is the beginning of the loop through the labels.  Entry occurs
+C here to find the next label in the list and return positioning info.
+C
+C Increment the label index and test for end of label list.
+C
+  202 LBIN=LBIN+1
+      IF (LBIN.GT.LBIM) GO TO 222
+C
+C Skip this label if it is non-existent, suppressed, or empty.
+C
+      IF (FLLB(1,LBIN).EQ.0..OR.FLLB(2,LBIN).NE.0.
+     +                      .OR.FLLB(9,LBIN).EQ.0.) GO TO 202
+C
+C Unpack the parameters specifying the label-base-point position.
+C
+      XBLB=FLLB(3,LBIN)
+      YBLB=FLLB(4,LBIN)
+      XOLB=FLLB(5,LBIN)
+      YOLB=FLLB(6,LBIN)
+C
+C Determine in which of five boxes the label lies:
+C
+C in the box to the left of the curve window.
+C
+      LBBX=1
+      IF (XBLB.EQ.0..AND.XOLB.LE.0.) GO TO 203
+C
+C in the box to the right of the curve window,
+C
+      LBBX=2
+      IF (XBLB.EQ.1..AND.XOLB.GE.0.) GO TO 203
+C
+C in the box below the curve window,
+C
+      LBBX=3
+      IF (YBLB.EQ.0..AND.YOLB.LE.0.) GO TO 203
+C
+C in the box above the curve window,
+C
+      LBBX=4
+      IF (YBLB.EQ.1..AND.YOLB.GE.0.) GO TO 203
+C
+C in the curve window,
+C
+      LBBX=5
+      IF ( (XBLB.EQ.0..AND.XOLB.GT.0.).OR.
+     +     (XBLB.EQ.1..AND.XOLB.LT.0.).OR.
+     +     (YBLB.EQ.0..AND.YOLB.GT.0.).OR.
+     +     (YBLB.EQ.1..AND.YOLB.LT.0.)    ) GO TO 203
+C
+C or elsewhere.
+C
+      LBBX=6
+C
+C If we are interested in a particular box and this label is not in that
+C box, skip it.
+C
+  203 IF (NBOX.NE.0.AND.LBBX.NE.NBOX) GO TO 202
+C
+C On a non-test run, get the label name and length for call to AGCHIL.
+C
+      IF (ITST.GT.0) CALL AGGTCH (IFIX(FLLB(1,LBIN)),CHS1,LNC1)
+C
+C Unpack the label orientation and compute its direction cosines.
+C
+      LBOR=IFIX(FLLB(7,LBIN))
+C
+      XDLB=COS(.017453292519943*FLLB(7,LBIN))
+      YDLB=SIN(.017453292519943*FLLB(7,LBIN))
+C
+C Unpack the label-centering option.
+C
+      LBCN=IFIX(FLLB(8,LBIN))
+C
+C Unpack the index of the initial line of the label and save it.
+C
+      LNIN=IFIX(FLLB(10,LBIN))
+      LNII=LNIN
+C
+C If this is not a test run, modify the label-base-point position as
+C needed to move the label into the actual box in which it must fit.
+C
+      IF (ITST.LE.0) GO TO 209
+C
+      GO TO (204,205,206,207,208,209) , LBBX
+C
+  204 XBLB=XBLB+DBOX(1,2)
+      GO TO 209
+C
+  205 XBLB=XBLB+DBOX(2,1)-1.
+      GO TO 209
+C
+  206 YBLB=YBLB+DBOX(3,4)
+      GO TO 209
+C
+  207 YBLB=YBLB+DBOX(4,3)-1.
+      GO TO 209
+C
+  208 IF (XBLB.EQ.0.) XBLB=XBLB+DBOX(5,1)
+      IF (XBLB.EQ.1.) XBLB=XBLB+DBOX(5,2)-1.
+      IF (YBLB.EQ.0.) YBLB=YBLB+DBOX(5,3)
+      IF (YBLB.EQ.1.) YBLB=YBLB+DBOX(5,4)-1.
+C
+C Compute the final label-base-point position.
+C
+  209 XPLB=XBLB+XOLB*SCWP/WCWP
+      YPLB=YBLB+YOLB*SCWP/HCWP
+C
+C Before entering the loop through the line list, initialize the label-
+C dimension parameters.
+C
+      DLLB=0.
+      DRLB=0.
+      DBLB=0.
+      DTLB=0.
+C
+C This is the beginning of the loop through the lines in a given label.
+C Entry may occur here to find the next line and return info about it.
+C
+C If the line is suppressed or of zero length, skip it.
+C
+  210 IF (FLLN(2,LNIN).NE.0..OR.FLLN(5,LNIN).LE.0.) GO TO 215
+C
+C Unpack the position-number, character-width, and character-count
+C parameters for the line.
+C
+      LNPN=IFIX(FLLN(1,LNIN))
+      WCLN=FLLN(3,LNIN)
+      LNCC=IFIX(FLLN(5,LNIN))
+C
+C Compute the integer width (IWCL) and the floating-point width and
+C height (FWCL and FHCL) of characters in the label.  All are expressed
+C in plotter-coordinate-system units.
+C
+      IWCL=MAX0(MWCL,IFIX(RBOX(LBBX)*WCLN*SCWP+.5))
+      FWCL=FLOAT(IWCL)
+      FHCL=HCFW(FWCL)
+C
+C Jump back with line information or drop through, as directed.
+C
+      GO TO JMP1 , (118,211)
+C
+C Update the label-dimension parameters.
+C
+  211 DRLB=AMAX1(DRLB,FLOAT(LNCC)*FWCL)
+C
+      IF (LNPN) 212,213,214
+C
+  212 DBLB=DBLB+FHCL
+      GO TO 215
+C
+  213 DBLB=DBLB+.5*FHCL
+      DTLB=DTLB+.5*FHCL
+      GO TO 215
+C
+  214 DTLB=DTLB+FHCL
+C
+C Go to the next line in the label, if there is one.
+C
+  215 LNIN=IFIX(FLLN(6,LNIN))
+      IF (LNIN.NE.0) GO TO 210
+C
+C Jump back on end of lines or drop through, as directed.
+C
+      GO TO JMP2 , (116,216)
+C
+C If all the lines in the label were either suppressed or of zero
+C length, skip this label.
+C
+  216 IF (DRLB.EQ.0.) GO TO 202
+C
+C Complete the computation of the label dimensions.  The four parameters
+C DLLB, DRLB, DBLB, and DTLB represent the distances from the base-point
+C to the left edge, right edge, bottom edge, and top edge of the label,
+C in plotter-coordinate-system units, where left, right, etc., are as
+C viewed by a reader of the label.
+C
+      IF (LBCN) 217,218,219
+C
+C Left edges of lines are aligned.
+C
+  217 GO TO 220
+C
+C Centers of lines are aligned.
+C
+  218 DLLB=.5*(DLLB+DRLB)
+      DRLB=DLLB
+      GO TO 220
+C
+C Right edges of lines are aligned.
+C
+  219 SWAP=DLLB
+      DLLB=DRLB
+      DRLB=SWAP
+C
+C Jump back with label information or drop through, as directed.
+C
+  220 GO TO JMP3 , (117,221)
+C
+C Update the x and y coordinates of the label box edges.
+C
+  221 XLBX=AMIN1(XLBX,XBLB,
+     +     XPLB-AMAX1(+DLLB*XDLB,-DRLB*XDLB,-DBLB*YDLB,+DTLB*YDLB)/WCWP)
+      XRBX=AMAX1(XRBX,XBLB,
+     +     XPLB+AMAX1(-DLLB*XDLB,+DRLB*XDLB,+DBLB*YDLB,-DTLB*YDLB)/WCWP)
+      YBBX=AMIN1(YBBX,YBLB,
+     +     YPLB-AMAX1(+DLLB*YDLB,-DRLB*YDLB,+DBLB*XDLB,-DTLB*XDLB)/HCWP)
+      YTBX=AMAX1(YTBX,YBLB,
+     +     YPLB+AMAX1(-DLLB*YDLB,+DRLB*YDLB,-DBLB*XDLB,+DTLB*XDLB)/HCWP)
+C
+C Go back for the next label.
+C
+      GO TO 202
+C
+C End of label list.  Jump as directed.
+C
+  222 GO TO JMP4 , (102,106,110,120)
+C
+C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agmaxi.f b/sys/gio/ncarutil/autograph/agmaxi.f
new file mode 100644
index 00000000..9c981e0d
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agmaxi.f
@@ -0,0 +1,60 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      FUNCTION AGMAXI (SVAL,ZHGH,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ)
+C
+      DIMENSION ZDRA(1)
+C
+C The routine AGMAXI returns the maximum value of the elements in ZDRA
+C specified by NVIZ, IIVZ, NEVZ, and IIEZ, skipping elements having the
+C special value SVAL (or more than ZHGH, if ZHGH is not equal to SVAL).
+C
+C -- NVIZ is the number of vectors of data stored in ZDRA.
+C
+C -- IIVZ is the index increment from one data vector to the next.
+C
+C -- NEVZ is the number of elements per vector to be examined.
+C
+C -- IIEZ is the index increment from one vector element to the next.
+C    If IIEZ is 0, the array is ignored and NEVZ is returned.
+C
+      AGMAXI=FLOAT(NEVZ)
+      IF (IIEZ.EQ.0) RETURN
+C
+      AGMAXI=SVAL
+      INDZ=1-IIEZ
+C
+      DO 103 I=1,NVIZ
+        IF (ZHGH.EQ.SVAL) THEN
+          DO 101 J=1,NEVZ
+            INDZ=INDZ+IIEZ
+            IF (ZDRA(INDZ).EQ.SVAL) GO TO 101
+            IF (AGMAXI.EQ.SVAL) AGMAXI=ZDRA(INDZ)
+            AGMAXI=AMAX1(AGMAXI,ZDRA(INDZ))
+  101     CONTINUE
+        ELSE
+          DO 102 J=1,NEVZ
+            INDZ=INDZ+IIEZ
+            IF (ZDRA(INDZ).EQ.SVAL.OR.ZDRA(INDZ).GT.ZHGH) GO TO 102
+            IF (AGMAXI.EQ.SVAL) AGMAXI=ZDRA(INDZ)
+            AGMAXI=AMAX1(AGMAXI,ZDRA(INDZ))
+  102     CONTINUE
+        END IF
+        INDZ=INDZ-NEVZ*IIEZ+IIVZ
+  103 CONTINUE
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agmini.f b/sys/gio/ncarutil/autograph/agmini.f
new file mode 100644
index 00000000..be4b6d2c
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agmini.f
@@ -0,0 +1,60 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      FUNCTION AGMINI (SVAL,ZLOW,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ)
+C
+      DIMENSION ZDRA(1)
+C
+C The routine AGMINI returns the mimimum value of the elements in ZDRA
+C specified by NVIZ, IIVZ, NEVZ, and IIEZ, skipping elements having the
+C special value SVAL (or less than ZLOW, if ZLOW is not equal to SVAL).
+C
+C -- NVIZ is the number of vectors of data stored in ZDRA.
+C
+C -- IIVZ is the index increment from one data vector to the next.
+C
+C -- NEVZ is the number of elements per vector to be examined.
+C
+C -- IIEZ is the index increment from one vector element to the next.
+C    If IIEZ is 0, the array is ignored and 1. is returned.
+C
+      AGMINI=1.
+      IF (IIEZ.EQ.0) RETURN
+C
+      AGMINI=SVAL
+      INDZ=1-IIEZ
+C
+      DO 103 I=1,NVIZ
+        IF (ZLOW.EQ.SVAL) THEN
+          DO 101 J=1,NEVZ
+            INDZ=INDZ+IIEZ
+            IF (ZDRA(INDZ).EQ.SVAL) GO TO 101
+            IF (AGMINI.EQ.SVAL) AGMINI=ZDRA(INDZ)
+            AGMINI=AMIN1(AGMINI,ZDRA(INDZ))
+  101     CONTINUE
+        ELSE
+          DO 102 J=1,NEVZ
+            INDZ=INDZ+IIEZ
+            IF (ZDRA(INDZ).EQ.SVAL.OR.ZDRA(INDZ).LT.ZLOW) GO TO 102
+            IF (AGMINI.EQ.SVAL) AGMINI=ZDRA(INDZ)
+            AGMINI=AMIN1(AGMINI,ZDRA(INDZ))
+  102     CONTINUE
+        END IF
+        INDZ=INDZ-NEVZ*IIEZ+IIVZ
+  103 CONTINUE
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agnumb.f b/sys/gio/ncarutil/autograph/agnumb.f
new file mode 100644
index 00000000..24469772
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agnumb.f
@@ -0,0 +1,491 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGNUMB (NBTP,SBSE,EXMU , NLTP,NLEX,NLFL ,
+     +                             BFRM,MCIM,NCIM,IPXM , BFRE,MCIE,NCIE)
+C
+      CHARACTER*(*) BFRM,BFRE
+C
+C The routine AGNUMB converts the number specified by the arguments
+C NBTP, SBSE, and EXMU to the label format specified by the arguments
+C NLTP, NLEX, and NLFL, returning the characters of the mantissa in the
+C buffer BFRM and the characters of the exponent in the buffer BFRE,
+C ready for plotting.  The arguments of AGNUMB are as follows:
+C
+C -- NBTP is an integer specifying the type of number to be converted.
+C    There are three possibilities:
+C
+C        NBTP = 1 - number of the form SBSE * EXMU.
+C
+C        NBTP = 2 - number of the form SBSE * 10**EXMU.
+C
+C        NBTP = 3 - number of the form SIGN(SBSE) * ABSV(SBSE)**EXMU.
+C
+C -- SBSE is a base value for a set of labels.  See NBTP description.
+C
+C -- EXMU is an exponent or a multiplier for a given label.  Although it
+C    is a floating-point number, its value should be integral, unless
+C    NBTP equals 1 and/or NLTP equals 1.  Using a non-integral EXMU in
+C    other cases will have undesirable effects.  See NBTP description.
+C
+C -- NLTP is an integer specifying the type of label to be generated.
+C    There are three possibilities:
+C
+C      -- NLTP = 1 - label is to have an exponent portion and is to be
+C         expressed in scientific notation.
+C
+C      -- NLTP = 2 - label is to have an exponent portion and is to be
+C         expressed in a form determined by the number type NBTP.
+C
+C      -- NLTP = 3 - label is to have no exponent portion and is to be
+C         expressed in a form determined by the number type NBTP.
+C
+C    The possible label types will be described in greater detail below.
+C
+C -- NLEX (when used) is an integer specifying (in a manner depending on
+C    the values of other parameters) the value of the exponent portion
+C    of the label.  See the detailed discussion of label types, below.
+C
+C -- NLFL (when used) is an integer specifying (in a manner depending on
+C    the values of other parameters) the length of the fractional por-
+C    tion of the mantissa of the label.  See the detailed discussion of
+C    label types, below.
+C
+C -- BFRM is a character variable in which the mantissa portion of the
+C    label is to be returned.
+C
+C -- MCIM specifies the maximum number of characters BFRM can hold.
+C
+C -- NCIM is the number of characters returned in BFRM by AGNUMB.
+C
+C -- IPXM is the position of the character X in the mantissa.  If IPXM
+C    is zero, the character X does not occur in the mantissa.
+C
+C -- BFRE, MCIE, and NCIE are analogous to BFRM, MCIM, and NCIM, but
+C    pertain to the exponent portion of the label.
+C
+C Label types:  AGNUMB will produce many different types of labels, as
+C directed by the various input parameters.  Each of these is described
+C below.  The general form of a label is
+C
+C    (-) (1/) (I) (.) (F) (X 10) (E)
+C
+C where the parentheses are used to mark portions which may either be
+C present or absent.  The minus sign is included only if the label value
+C is negative.  I is the integer portion of the mantissa, included only
+C if its value is non-zero.  The decimal point is included if the input
+C parameter NLFL does not specifically direct that it should be omitted
+C or if the fractional portion of the mantissa (F) is present.  F is the
+C fractional portion of the mantissa.  The "X 10" is included if it is
+C appropriate, and is considered to be a part of the mantissa; if it is
+C included, a blank is actually returned for the character X, so the
+C routine which plots the label should construct this character by
+C drawing two short lines.  E is the exponent, returned in a separate
+C buffer so that it may be plotted in a superscript form.  The possible
+C label types are, then, as follows:
+C
+C -- Scientific notation - if the label type NLTP equals 1, the form
+C
+C        (-) (I) (.) (F) X 10 (E)
+C
+C    is used.  NLEX specifies the length of I (thus also specifying the
+C    value of the exponent E).  If NLEX is .LE. 0, I is omitted.  If
+C    NLEX is .LT. 0 and has the absolute value N, the fraction F is
+C    forced to have N leading zeroes.  NLFL specifies the length of F.
+C    If NLFL is .LE. 0, F is omitted.  If NLFL is .LT. 0, the decimal
+C    point is omitted.  If (I.F) has the value 1, (I.F X) is omitted.
+C    If the entire label has zero value, the character 0 is used.
+C
+C -- Exponential, but non-scientific notation - if the label type NLTP
+C    equals 2, the form used depends on the argument NBTP, as follows:
+C
+C     -- If NBTP equals 1 (number of the form SBSE * EXMU), the form
+C
+C            (-) (I) (.) (F) X 10 (E)
+C
+C        is used.  NLEX specifies the value of the exponent E.  The
+C        length of F is specified by NLFL.  If NLFL is .LE. 0, F is
+C        omitted.  If NLFL is .LT. 0, the decimal point is omitted.  If
+C        the label value is exactly 0, the character 0 is used.
+C
+C     -- If NBTP equals 2 (number of the form SBSE*10**EXMU), the form
+C
+C            (-) (I) (.) (F) X 10 (E)
+C
+C        is used.  The exponent E has the value NLEX+EXMU.  The length
+C        of F is specified by NLFL.  If NLFL is .LE. 0, F is omitted.
+C        If NLFL is .LT. 0, the decimal point is omitted.  If the label
+C        value is exactly 0, the character 0 is used.  If (I.F) has the
+C        value 1., then (I.F X) is omitted.
+C
+C     -- If NBTP equals 3, specifying that the number is of the form
+C        SIGN(SBSE) * ABSV(SBSE)**EXMU, the form
+C
+C            (-) (I) (.) (F) (E)
+C
+C        is used.  The exponent E has the value EXMU.  The length of F
+C        is specified by NLFL.  If NLFL is .LE. 0, F is omitted.  If
+C        NLFL is .LT. 0, the decimal point is omitted.
+C
+C -- No-exponent notation - if the label type NLTP equals 3, the form
+C    used depends on the argument NBTP, as follows:
+C
+C     -- If NBTP equals 1 (number of the form SBSE * EXMU), the form
+C
+C            (-) (I) (.) (F)
+C
+C        is used.  NLFL specifies the length of F.  If NLFL is .LE. 0,
+C        F is omitted.  If NLFL is .LT. 0, the decimal point is omitted.
+C        If the entire label has zero value, the character 0 is used.
+C
+C     -- If NBTP equals 2 (number of the form SBSE*10**EXMU), the form
+C
+C            (-) (I) (.) (F)
+C
+C        is used.  The length of F is specified by the function
+C
+C            MAX(NLFL,0)-EXMU  (if EXMU is .LT. MAX(NLFL,0))
+C            MIN(NLFL,0)       (if EXMU is .GE. MAX(NLFL,0))
+C
+C        which may appear somewhat formidable, but produces a simple,
+C        desirable result.  Suppose, for example, that SBSE = 3.6,
+C        NLFL = 1, and EXMU ranges from -3 to +3 - the labels produced
+C        are as follows:
+C
+C            .0036   .036   .36   3.6   36.   360.   3600.
+C
+C        NLFL may be viewed as specifying the length of F if EXMU is 0.
+C        If the value of the function is .LE. 0, F is omitted - if its
+C        value is .LT. 0, the decimal point is omitted.
+C
+C     -- If NBTP equals 3, specifying that the number is of the form
+C        SIGN(SBSE) * ABSV(SBSE)**EXMU, the form
+C
+C            (-) (I) (.) (F)
+C
+C        is used if EXMU is positive (or zero), and the form
+C
+C            (-) 1 / (I) (.) (F)
+C
+C        is used if EXMU is negative.  The length of F is specified by
+C        the function
+C
+C            NLFL * ABSV(EXMU)  (if EXMU is .NE. 0)
+C            MIN(NLFL,0)        (if EXMU is .EQ. 0)
+C
+C        Again, this function produces a simple result.  Suppose that
+C        SBSE = 1.1, NLFL = 1, and EXMU ranges from -3 to +3 - the
+C        labels produced are as follows:
+C
+C            1/1.331   1/1.21   1/1.1   1.   1.1   1.21   1.331
+C
+C        NLFL may be viewed as specifying the length of F if EXMU is 1.
+C        If the value of the function is .LE. 0, F is omitted - if its
+C        value is .LT. 0, the decimal point is omitted.  As another
+C        example, suppose that SBSE = 2., NLFL = -1, and EXMU ranges
+C        from -4 to +4.  The labels produced are as follows:
+C
+C            1/16   1/8   1/4   1/2   1   2   4   8   16
+C
+C The following common block contains AUTOGRAPH variables which are
+C not control parameters.  The only one used here is SMRL, which is a
+C (machine-dependent) small real which, when added to a number in the
+C range (1,10), will round it upward without seriously affecting the
+C leading significant digits.  The object of this is to get rid of
+C strings of nines.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C KHAR holds single characters to be stored away in BFRM or BFRE.
+C
+      CHARACTER*1 KHAR
+C
+C Zero character counters and pointers.
+C
+      NCIM=0
+      NCIE=0
+      IPXM=0
+C
+C Compute a jump parameter to allow a quick sorting-out of the possible
+C number-type/label-type combinations below.
+C
+      NTLT=NBTP+3*(NLTP-1)
+C
+C Compute the value (XMAN) from which the characters of the mantissa
+C will be generated.
+C
+      GO TO (101,102,103,101,102,104,101,102,105) , NTLT
+C
+  101 XMAN=SBSE*EXMU
+      GO TO 106
+C
+  102 XMAN=SBSE*SNGL(10.D0**DBLE(EXMU))
+      GO TO 106
+C
+  103 XMAN=SIGN(1.,SBSE)*SNGL(DBLE(ABS(SBSE))**DBLE(EXMU))
+      GO TO 106
+C
+  104 XMAN=SBSE
+      GO TO 106
+C
+  105 XMAN=SIGN(1.,SBSE)*SNGL(DBLE(ABS(SBSE))**DBLE(ABS(EXMU)))
+C
+C If the mantissa-generator is negative, make it positive and put a
+C minus sign in the mantissa buffer.
+C
+  106 IF (XMAN.LT.0.) THEN
+        NCIM=NCIM+1
+        IF (NCIM.GT.MCIM) GO TO 901
+        BFRM(NCIM:NCIM)='-'
+        XMAN=-XMAN
+      END IF
+C
+C If the number is zero, put a zero in the mantissa buffer and quit.
+C
+      IF (XMAN.EQ.0.) THEN
+        NCIM=NCIM+1
+        IF (NCIM.GT.MCIM) GO TO 901
+        BFRM(NCIM:NCIM)='0'
+        RETURN
+      END IF
+C
+C Reduce the mantissa-generator to the range (1.,10.), keeping track of
+C the power of 10 required to do it.  Round the result, keeping in mind
+C that the rounding may kick the value past 10. .
+C
+      IMAN=IFIX(ALOG10(XMAN))
+      IF (XMAN.LT.1.) IMAN=IMAN-1
+      XMAN=XMAN*SNGL(10.D0**(-IMAN))+SMRL
+      IF (XMAN.GE.10.) THEN
+        XMAN=XMAN/10.
+        IMAN=IMAN+1
+      END IF
+C
+C Jump (depending on the number-type/label-type combination) to set up
+C the label-generation control parameters, as follows:
+C
+C    NDPD - number of digits to precede decimal point - if NDPD .LT. 0,
+C           ABS(NDPD) leading zeroes follow the decimal point, preceding
+C           the first digit generated from XMAN.
+C    NDFD - number of digits to follow decimal point - if NDFD .LT. 0,
+C           the decimal point is suppressed.
+C    IF10 - flag, set non-zero to force generation of the (X 10) portion
+C           of the label.
+C    IFEX - flag, set non-zero to force generation of an exponent.
+C    IVEX - value of exponent (if any) - always equals (IMAN+1) - NDPD.
+C
+      GO TO (107,107,107,108,109,110,111,112,113) , NTLT
+C
+C Scientific notation.
+C
+  107 NDPD=NLEX
+      NDFD=NLFL
+      IF10=1
+      IFEX=1
+      GO TO 114
+C
+C Non-scientific exponential notation for SBSE * EXMU.
+C
+  108 NDPD=IMAN+1-NLEX
+      NDFD=NLFL
+      IF10=1
+      IFEX=1
+      GO TO 114
+C
+C Non-scientific exponential notation for SBSE * 10**EXMU.
+C
+  109 NDPD=IMAN+1-(NLEX+IFIX(EXMU+SMRL*EXMU))
+      NDFD=NLFL
+      IF10=1
+      IFEX=1
+      GO TO 114
+C
+C Non-scientific exponential notation for SIGN(SBSE) * ABSV(SBSE)**EXMU.
+C
+  110 NDPD=IMAN+1
+      IMAN=IMAN+IFIX(EXMU+SMRL*EXMU)
+      NDFD=NLFL
+      IF10=0
+      IFEX=1
+      GO TO 115
+C
+C No-exponent notation for SBSE * EXMU.
+C
+  111 NDPD=IMAN+1
+      NDFD=NLFL
+      IF10=0
+      IFEX=0
+      GO TO 115
+C
+C No-exponent notation for SBSE * 10**EXMU.
+C
+  112 NDPD=IMAN+1
+      NDFD=MAX0(NLFL,0)-IFIX(EXMU+SMRL*EXMU)
+      IF (NDFD.LE.0) NDFD=MIN0(NLFL,0)
+      IF10=0
+      IFEX=0
+      GO TO 115
+C
+C No-exponent notation for SIGN(SBSE) * ABSV(SBSE)**EXMU
+C
+  113 IF (EXMU.LT.0.) THEN
+        NCIM=NCIM+1
+        IF (NCIM.GT.MCIM) GO TO 901
+        BFRM(NCIM:NCIM)='1'
+        NCIM=NCIM+1
+        IF (NCIM.GT.MCIM) GO TO 901
+        BFRM(NCIM:NCIM)='/'
+      END IF
+C
+      NDPD=IMAN+1
+      NDFD=NLFL*IFIX(ABS(EXMU+SMRL*EXMU))
+      IF (NDFD.EQ.0) NDFD=MIN0(NLFL,0)
+      IF10=0
+      IFEX=0
+      GO TO 115
+C
+C If there is an exponent of 10 and the mantissa is precisely 1, omit
+C the (I.F X) portion of the mantissa.
+C
+  114 IF (NDPD.NE.1) GO TO 115
+      IF (IFIX(XMAN).NE.1) GO TO 115
+      IF (((XMAN-1.)*10.**MAX0(0,NDFD)).GE.1.) GO TO 115
+      IVEX=IMAN+1-NDPD
+      GO TO 123
+C
+C Generate the characters of the mantissa (I.F).  Check first for zero-
+C or-negative-length error.
+C
+  115 LMAN=MAX0(NDPD,0)+1+MAX0(NDFD,-1)
+      IF (LMAN.LE.0) GO TO 903
+C
+C Make sure the mantissa buffer is big enough to hold (I.F).
+C
+      IF (NCIM+LMAN.GT.MCIM) GO TO 901
+C
+C Compute the value of the parameter IVEX before changing NDPD.
+C
+      IVEX=IMAN+1-NDPD
+C
+C Generate the digits preceding the decimal point, if any.
+C
+      IF (NDPD.LE.0) GO TO 117
+C
+      ASSIGN 116 TO JUMP
+      GO TO 121
+C
+  116 NDPD=NDPD-1
+      IF (NDPD.NE.0) GO TO 121
+C
+C Generate the decimal point.
+C
+  117 KHAR='.'
+      ASSIGN 118 TO JUMP
+      GO TO 122
+C
+C Generate leading zeroes, if any, after the decimal point.
+C
+  118 IF (NDPD.EQ.0) GO TO 120
+      KHAR='0'
+      ASSIGN 119 TO JUMP
+      GO TO 122
+C
+  119 NDPD=NDPD+1
+      IF (NDPD.NE.0) GO TO 122
+C
+C Generate remaining fractional digits.
+C
+  120 ASSIGN 121 TO JUMP
+C
+C Generate a digit from the mantissa-generator.  It is assumed that, for
+C n between 1 and 9, ICHAR('n') = ICHAR('n-1') + 1 .
+C
+  121 IDGT=IFIX(XMAN)
+      KHAR=CHAR(ICHAR('0')+IDGT)
+      XMAN=XMAN-FLOAT(IDGT)
+      XMAN=XMAN*10.
+C
+C Store a digit from KHAR into the mantissa buffer.
+C
+  122 NCIM=NCIM+1
+      BFRM(NCIM:NCIM)=KHAR
+C
+C Check whether (I.F) is complete.
+C
+      LMAN=LMAN-1
+      IF (LMAN.NE.0) GO TO JUMP , (116,118,119,121)
+C
+C If appropriate, leave space in the mantissa buffer for the "X" .
+C
+      IF (IF10.EQ.0) GO TO 124
+      NCIM=NCIM+1
+      IF (NCIM.GT.MCIM) GO TO 901
+      IPXM=NCIM
+      BFRM(IPXM:IPXM)=' '
+C
+C If appropriate, put a "10" in the mantissa buffer.
+C
+  123 NCIM=NCIM+1
+      IF (NCIM.GT.MCIM) GO TO 901
+      BFRM(NCIM:NCIM)='1'
+      NCIM=NCIM+1
+      IF (NCIM.GT.MCIM) GO TO 901
+      BFRM(NCIM:NCIM)='0'
+C
+C If appropriate, generate an exponent in the exponent buffer.
+C
+  124 IF (IFEX.EQ.0) RETURN
+C
+      IF (IVEX) 126,125,127
+C
+  125 NCIE=NCIE+1
+      IF (NCIE.GT.MCIE) GO TO 902
+      BFRE(NCIE:NCIE)='0'
+      RETURN
+C
+  126 NCIE=NCIE+1
+      IF (NCIE.GT.MCIE) GO TO 902
+      BFRE(NCIE:NCIE)='-'
+      IVEX=-IVEX
+C
+  127 NCIE=NCIE+1
+      IF (IVEX.GE.10) NCIE=NCIE+1
+      IF (IVEX.GE.100) NCIE=NCIE+1
+      IF (IVEX.GE.1000) NCIE=NCIE+1
+      IF (NCIE.GT.MCIE) GO TO 902
+C
+      DO 128 I=1,4
+        J=NCIE+1-I
+        BFRE(J:J)=CHAR(ICHAR('0')+MOD(IVEX,10))
+        IVEX=IVEX/10
+        IF (IVEX.EQ.0) RETURN
+  128 CONTINUE
+C
+      IF (IVEX.NE.0) GO TO 902
+C
+C Done.
+C
+      RETURN
+C
+C Error exits.
+C
+  901 CALL SETER ('AGNUMB - MANTISSA TOO LONG',4,2)
+C
+  902 CALL SETER ('AGNUMB - EXPONENT TOO LARGE',5,2)
+C
+  903 CALL SETER ('AGNUMB - ZERO-LENGTH MANTISSA',6,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agppid.f b/sys/gio/ncarutil/autograph/agppid.f
new file mode 100644
index 00000000..145d98d3
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agppid.f
@@ -0,0 +1,65 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGPPID (TPID)
+C
+      CHARACTER*(*) TPID
+C
+C The object of this routine is to print out a parameter identifier
+C which has caused some kind of problem.
+C
+C Define a character variable to hold the print line.
+C
+      CHARACTER*124 TEMP
+C
+C +NOAO
+      integer*2 itemp(124)
+C -NOAO
+C
+C Set up the print line.
+C
+      TEMP='0PARAMETER IDENTIFIER - '
+C
+C Transfer characters of the parameter identifier, one at a time, until
+C 100 have been transferred or a period is encountered, whichever occurs
+C first.  This is done so as to allow for old programs on the Cray which
+C used Hollerith strings as parameter identifiers.
+C
+      I=24
+C
+      DO 101 J=1,100
+        I=I+1
+        TEMP(I:I)=TPID(J:J)
+        IF (TEMP(I:I).EQ.'.') GO TO 102
+  101 CONTINUE
+C
+C Print the line.
+C
+C +NOAO - replace FTN write and format statement.
+C 102 WRITE (I1MACH(4),1001) TEMP
+  102 CONTINUE
+      call f77upk (temp, itemp, 125)
+      call pstr (itemp)
+C
+C Done.
+C
+      RETURN
+C
+C Format.
+C
+C1001 FORMAT (A124)
+C -NOAO
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agpwrt.f b/sys/gio/ncarutil/autograph/agpwrt.f
new file mode 100644
index 00000000..25cc2e52
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agpwrt.f
@@ -0,0 +1,31 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGPWRT (XPOS,YPOS,CHRS,NCHS,ISIZ,IORI,ICEN)
+C
+      CHARACTER*(*) CHRS
+C
+C This routine just passes its arguments along to the character-drawing
+C routine PWRIT, in the system plot package.  By substituting his/her
+C own version of AGPWRT, the user can cause a fancier character-drawer
+C to be used.
+C
+      CALL PWRIT (XPOS,YPOS,CHRS,NCHS,ISIZ,IORI,ICEN)
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agqurv.f b/sys/gio/ncarutil/autograph/agqurv.f
new file mode 100644
index 00000000..dc70fc43
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agqurv.f
@@ -0,0 +1,322 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGQURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL)
+C
+      DIMENSION XVEC(1),YVEC(1)
+C
+C AGQURV plots the curve defined by the points ((X(I),Y(I)),I=1,NEXY),
+C where
+C
+C    X(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case X(I)=I), and
+C    Y(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case Y(I)=I).
+C
+C If, for some I, X(I)=SVAL or Y(I)=SVAL, curve line segments having
+C (X(I),Y(I)) as an endpoint are omitted.
+C
+C The curve drawn is windowed.  Portions of the curve which would fall
+C outside the current curve window, as defined by the last SET call,
+C are not drawn.
+C
+C Check first whether the number of curve points is properly specified.
+C
+      IF (NEXY.LE.0) GO TO 901
+C
+C Initialization.  Pretend that the last point was point number zero.
+C Set the indices for the x and y vectors accordingly.  Clear the line-
+C drawn-to-last-point and last-point-outside-window flags.
+C
+      INDP=0
+      INDX=1-IIEX
+      INDY=1-IIEY
+      LDLP=0
+      LPOW=0
+C
+C Initialization.  Retrieve the current curve window, user window, and
+C x/y linear/logarithmic flags.
+C
+      CALL GETSET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP)
+C
+C Initialization.  Set linear/log flag and linear-window limits for
+C x-axis values.
+C
+      IF (LTYP.EQ.1.OR.LTYP.EQ.2) THEN
+        LLUX=0
+        XLLW=XLUW
+        XRLW=XRUW
+      ELSE
+        LLUX=1
+        XLLW=ALOG10(XLUW)
+        XRLW=ALOG10(XRUW)
+      END IF
+C
+C Initialization.  Set linear/log flag and linear-window limits for
+C y-axis values.
+C
+      IF (LTYP.EQ.1.OR.LTYP.EQ.3) THEN
+        LLUY=0
+        YBLW=YBUW
+        YTLW=YTUW
+      ELSE
+        LLUY=1
+        YBLW=ALOG10(YBUW)
+        YTLW=ALOG10(YTUW)
+      END IF
+C
+C Initialization.  Call SET, if necessary, to define a linear mapping.
+C (This greatly simplifies the windowing code.)
+C
+      IF (LTYP.NE.1)
+     +              CALL SET (XLCW,XRCW,YBCW,YTCW,XLLW,XRLW,YBLW,YTLW,1)
+C
+C Initialization.  Compute mimimum and maximum values of x which are
+C slightly outside the linear window.  (Note:  XLLW and XRLW will not
+C be used after this.)
+C
+      IF (XLLW.GT.XRLW) THEN
+        TEMP=XLLW
+        XLLW=XRLW
+        XRLW=TEMP
+      END IF
+      XEPS=.000001*(XRLW-XLLW)
+      XMIN=XLLW-XEPS
+      XMAX=XRLW+XEPS
+C
+C Initialization.  Compute minimum and maximum values of y which are
+C slightly outside the linear window.  (Note:  YBLW and YTLW will not
+C be used after this.)
+C
+      IF (YBLW.GT.YTLW) THEN
+        TEMP=YBLW
+        YBLW=YTLW
+        YTLW=TEMP
+      END IF
+      YEPS=.000001*(YTLW-YBLW)
+      YMIN=YBLW-YEPS
+      YMAX=YTLW+YEPS
+C
+C Beginning of loop through points.  Update indices and determine the
+C user-space coordinates of the next point.
+C
+  101 IF (INDP.EQ.NEXY) GO TO 120
+      INDP=INDP+1
+C
+      INDX=INDX+IIEX
+      XNXT=XVEC(INDX)
+      IF (IIEX.EQ.0) XNXT=FLOAT(INDP)
+      IF (LLUX.NE.0.AND.XNXT.LE.0.) XNXT=SVAL
+C
+      INDY=INDY+IIEY
+      YNXT=YVEC(INDY)
+      IF (IIEY.EQ.0) YNXT=FLOAT(INDP)
+      IF (LLUY.NE.0.AND.YNXT.LE.0.) YNXT=SVAL
+C
+C Check whether (XNXT,YNXT) is a special-value point.  Handle that case.
+C
+      IF (XNXT.EQ.SVAL.OR.YNXT.EQ.SVAL) THEN
+        LPOW=0
+        IF (LDLP.EQ.0) GO TO 101
+        IF (LDLP.EQ.1) CALL VECTD (XLST,YLST)
+        CALL LASTD
+        LDLP=0
+        GO TO 101
+      END IF
+C
+C If user space is not linear/linear, modify XNXT and YNXT accordingly.
+C
+      IF (LLUX.NE.0) XNXT=ALOG10(XNXT)
+      IF (LLUY.NE.0) YNXT=ALOG10(YNXT)
+C
+C Set the next-point-outside-window flag to a value between -4 and +4,
+C inclusive.  A non-zero value indicates that the next point is outside
+C the window and indicates which of eight possible areas it falls in.
+C
+      NPOW=IFIX(3.*(SIGN(.51,XNXT-XMIN)+SIGN(.51,XNXT-XMAX))+
+     +             (SIGN(.51,YNXT-YMIN)+SIGN(.51,YNXT-YMAX)))
+C
+C There are now various possible cases, depending on whether the line-
+C drawn-to-last-point flag is set or not, whether the next point is in
+C the window or not, and whether the last point was in the window, not
+C in the window, or non-existent (point 0 or a special-value point).
+C
+      IF (LDLP.EQ.0) GO TO 102
+      IF (NPOW.NE.0) GO TO 103
+C
+C Line drawn to last point, next point inside, last point inside.
+C
+      CALL VECTD (XNXT,YNXT)
+      LDLP=LDLP+1
+      GO TO 119
+C
+  102 IF (NPOW.NE.0) GO TO 109
+      IF (LPOW.NE.0) GO TO 105
+C
+C No line drawn to last point, next point inside, no last point.
+C
+      CALL FRSTD (XNXT,YNXT)
+      LDLP=1
+      GO TO 119
+C
+C Line drawn to last point, next point outside, last point inside.
+C
+  103 XPIW=XLST
+      YPIW=YLST
+      XPOW=XNXT
+      YPOW=YNXT
+      ASSIGN 104 TO JUMP
+      GO TO 107
+  104 CALL VECTD (XPEW,YPEW)
+      CALL LASTD
+      LDLP=0
+      GO TO 119
+C
+C No line drawn to last point, next point inside, last point outside.
+C
+  105 XPIW=XNXT
+      YPIW=YNXT
+      XPOW=XLST
+      YPOW=YLST
+      ASSIGN 106 TO JUMP
+      GO TO 107
+  106 CALL FRSTD (XPEW,YPEW)
+      CALL VECTD (XNXT,YNXT)
+      LDLP=2
+      GO TO 119
+C
+C The following local procedure, given a point (XPIW,YPIW) inside the
+C window and a point (XPOW,YPOW) outside the window, finds the point of
+C intersection (XPEW,YPEW) of a line joining them with the window edge.
+C
+  107 XPEW=XPIW
+      YPEW=YPIW
+      XDIF=XPOW-XPIW
+      YDIF=YPOW-YPIW
+C
+      IF (ABS(XDIF).GT.XEPS) THEN
+        XPEW=XMIN
+        IF (XDIF.GE.0.) XPEW=XMAX
+        YPEW=YPIW+(XPEW-XPIW)*YDIF/XDIF
+        IF (YPEW.GE.YMIN.AND.YPEW.LE.YMAX) GO TO 108
+      END IF
+C
+      IF (ABS(YDIF).GT.YEPS) THEN
+        YPEW=YMIN
+        IF (YDIF.GE.0.) YPEW=YMAX
+        XPEW=XPIW+(YPEW-YPIW)*XDIF/YDIF
+      END IF
+C
+  108 GO TO JUMP , (104,106)
+C
+C No line drawn to last point, next point outside.  Jump if no last
+C point.
+C
+  109 IF (LPOW.EQ.0) GO TO 119
+C
+C No line drawn to last point, next point outside, last point outside.
+C Check whether a portion of the line joining them lies in the window.
+C
+      MPOW=9*LPOW+NPOW+41
+C
+      GO TO (119,119,119,119,119,110,119,110,110,
+     +       119,119,119,111,119,110,111,110,110,
+     +       119,119,119,111,119,119,111,111,119,
+     +       119,113,113,119,119,110,119,110,110,
+     +       119,119,119,119,119,119,119,119,119,
+     +       112,112,119,112,119,119,111,111,119,
+     +       119,113,113,119,119,113,119,119,119,
+     +       112,112,113,112,119,113,119,119,119,
+     +       112,112,119,112,119,119,119,119,119) , MPOW
+C
+  110 XPE1=XMIN
+      YPT1=YMIN
+      XPE2=XMAX
+      YPT2=YMAX
+      GO TO 114
+C
+  111 XPE1=XMIN
+      YPT1=YMAX
+      XPE2=XMAX
+      YPT2=YMIN
+      GO TO 114
+C
+  112 XPE1=XMAX
+      YPT1=YMAX
+      XPE2=XMIN
+      YPT2=YMIN
+      GO TO 114
+C
+  113 XPE1=XMAX
+      YPT1=YMIN
+      XPE2=XMIN
+      YPT2=YMAX
+C
+  114 XDIF=XNXT-XLST
+      YDIF=YNXT-YLST
+C
+      IF (ABS(XDIF).LE.XEPS) GO TO 116
+      YPE1=YLST+(XPE1-XLST)*YDIF/XDIF
+      YPE2=YLST+(XPE2-XLST)*YDIF/XDIF
+C
+      IF (ABS(YDIF).LE.YEPS) GO TO 118
+      IF (YPE1.GE.YMIN.AND.YPE1.LE.YMAX) GO TO 115
+      YPE1=YPT1
+      XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
+      IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 119
+C
+  115 IF (YPE2.GE.YMIN.AND.YPE2.LE.YMAX) GO TO 118
+      GO TO 117
+C
+  116 YPE1=YPT1
+      XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
+      IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 119
+C
+  117 YPE2=YPT2
+      XPE2=XLST+(YPE2-YLST)*XDIF/YDIF
+      IF (XPE2.LT.XMIN.OR.XPE2.GT.XMAX) GO TO 119
+C
+  118 CALL FRSTD (XPE1,YPE1)
+      CALL VECTD (XPE2,YPE2)
+      CALL LASTD
+C
+C Processing of next point is done.  It becomes the last point and we
+C go back for a new next point.
+C
+  119 LPOW=NPOW
+      XLST=XNXT
+      YLST=YNXT
+      GO TO 101
+C
+C Last point was final point.  Finish up.
+C
+  120 IF (LDLP.NE.0) THEN
+        IF (LDLP.EQ.1) CALL VECTD (XLST,YLST)
+        CALL LASTD
+      END IF
+C
+C Restore logarithmic mapping, if appropriate.
+C
+      IF (LTYP.NE.1)
+     +           CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP)
+C
+C Return to caller.
+C
+      RETURN
+C
+C Error exit.
+C
+  901 CALL SETER ('AGQURV - NUMBER OF POINTS IS LESS THAN OR EQUAL TO ZE
+     +RO',7,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agrpch.f b/sys/gio/ncarutil/autograph/agrpch.f
new file mode 100644
index 00000000..c37a7ae4
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agrpch.f
@@ -0,0 +1,86 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGRPCH (CHST,LNCS,IDCS)
+C
+      CHARACTER*(*) CHST
+C
+C This routine is used to replace a character string previously stored
+C by the routine AGSTCH (which see).  This could be done by an AGDLCH
+C followed by an AGSTCH, and, in fact, under certain conditions, does
+C exactly that.  Only when it is easy to do so does AGRPCH operate more
+C efficiently.  Nevertheless, a user who (for example) repeatedly and
+C perhaps redundantly defines x-axis labels of the same length may
+C greatly benefit thereby; repeated deletes and stores would lead to
+C frequent garbage collection by AGSTCH.
+C
+C AGRPCH has the following arguments:
+C
+C -- CHST is the new character string, to replace what was originally
+C    stored.
+C
+C -- LNCS is the length of the character string in CHST.
+C
+C -- IDCS is the identifier returned by AGSTCH when the original string
+C    was stored.  The value of IDCS may be changed by the call.
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C If the identifier is positive or is negative but less than -LNIC, the
+C original string was never stored in CHRA; just treat the replacement
+C as a store and return a new value of IDCS.
+C
+      IF (IDCS.GT.(-1).OR.IDCS.LT.(-LNIC)) THEN
+        CALL AGSTCH (CHST,LNCS,IDCS)
+C
+      ELSE
+C
+C The absolute value of the identifier is the index, in INCH, of the
+C descriptor of the character string stored in CHRA.  If the new string
+C is shorter than the old one, store it and zero remaining character
+C positions.  Otherwise, treat the replacement as a delete followed by
+C a store.
+C
+        I=-IDCS
+        IF (LNCS.LE.INCH(2,I)) THEN
+          J=INCH(1,I)-1
+          DO 101 K=1,LNCS
+            J=J+1
+            CHRA(J)=CHST(K:K)
+  101     CONTINUE
+          DO 102 K=LNCS+1,INCH(2,I)
+            J=J+1
+            CHRA(J)=CHAR(0)
+  102     CONTINUE
+          INCH(2,I)=LNCS
+        ELSE
+          CALL AGDLCH (IDCS)
+          CALL AGSTCH (CHST,LNCS,IDCS)
+        END IF
+C
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agrstr.f b/sys/gio/ncarutil/autograph/agrstr.f
new file mode 100644
index 00000000..72afc643
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agrstr.f
@@ -0,0 +1,88 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C +NOAO - this subroutine is a no-op in IRAF.
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGRSTR (IFNO)
+C
+C This subroutine is called to restore the current state of AUTOGRAPH by
+C reading all of its important variables from a record on the file which
+C is associated with the unit number IFNO.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C Read the record.
+C
+C     READ (IFNO,ERR=901,END=902)
+C    1 BASD,BASE,DBOX,DNLA,FLLB,FLLN,FUNS,HCWP,PING,PINU,QBAC,QBAN,QBIM,
+C    2 QBTD,QBTP,QCDP,QCEX,QCEY,QCIE,QCIM,QDAX,QDLB,QDSH,QFRA,QIXY,QJDP,
+C    3 QLED,QLEX,QLFD,QLFL,QLLN,QLOF,QLOS,QLTD,QLTP,QLUA,QLUX,QLUY,QMJD,
+C    4 QMND,QMNT,QNAN,QNDP,QNIM,QODP,QOVX,QOVY,QROW,QSET,QSPA,QWND,RBOX,
+C    5 RFNL,SBOX,SCWP,SOGD,SVAL,TCLN,UBGA,UNDA,WCLE,WCLM,WCWP,WMJL,WMJR,
+C    6 WMNL,WMNR,WNLB,WNLE,WNLL,WNLR,WOCD,WODQ,XBGA,XHGH,XLCW,XLGD,XLGF,
+C    7 XLGW,XLOW,XLUW,XMAX,XMIN,XNDA,XRCW,XRGD,XRGF,XRGW,XRUW,YBCW,YBGA,
+C    8 YBGD,YBGF,YBGW,YBUW,YHGH,YLOW,YMAX,YMIN,YNDA,YTCW,YTGD,YTGF,YTGW,
+C    9 YTUW,
+C    + INIF,ISLD,MDLA,MWCD,MWCE,MWCL,MWCM,MWDQ,SMRL,
+C    1 INCA,INCH,LNCA,LNIC,
+C    2 CHRA
+C
+C Done.
+C
+      RETURN
+C
+C Error exits.
+C
+C 901 CALL SETER ('AGRSTR - ERROR ON READ',8,2)
+C
+C 902 CALL SETER ('AGRSTR - END-OF-FILE ON READ',9,2)
+C
+C -NOAO
+      END
diff --git a/sys/gio/ncarutil/autograph/agsave.f b/sys/gio/ncarutil/autograph/agsave.f
new file mode 100644
index 00000000..ef0feb7d
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsave.f
@@ -0,0 +1,93 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C +NOAO - This routine is a no-op in IRAF.
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSAVE (IFNO)
+C
+C This subroutine is called to save the current state of AUTOGRAPH by
+C writing all of its important variables as a record on the file which
+C is associated with the unit number IFNO.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C If initialization has not yet been done, do it.
+C
+      IF (INIF.EQ.0) THEN
+        CALL AGINIT
+      END IF
+C
+C Write the record.  Variables from each COMMON block are together, in
+C alphabetical order.
+C
+C     WRITE (IFNO,ERR=901)
+C    1 BASD,BASE,DBOX,DNLA,FLLB,FLLN,FUNS,HCWP,PING,PINU,QBAC,QBAN,QBIM,
+C    2 QBTD,QBTP,QCDP,QCEX,QCEY,QCIE,QCIM,QDAX,QDLB,QDSH,QFRA,QIXY,QJDP,
+C    3 QLED,QLEX,QLFD,QLFL,QLLN,QLOF,QLOS,QLTD,QLTP,QLUA,QLUX,QLUY,QMJD,
+C    4 QMND,QMNT,QNAN,QNDP,QNIM,QODP,QOVX,QOVY,QROW,QSET,QSPA,QWND,RBOX,
+C    5 RFNL,SBOX,SCWP,SOGD,SVAL,TCLN,UBGA,UNDA,WCLE,WCLM,WCWP,WMJL,WMJR,
+C    6 WMNL,WMNR,WNLB,WNLE,WNLL,WNLR,WOCD,WODQ,XBGA,XHGH,XLCW,XLGD,XLGF,
+C    7 XLGW,XLOW,XLUW,XMAX,XMIN,XNDA,XRCW,XRGD,XRGF,XRGW,XRUW,YBCW,YBGA,
+C    8 YBGD,YBGF,YBGW,YBUW,YHGH,YLOW,YMAX,YMIN,YNDA,YTCW,YTGD,YTGF,YTGW,
+C    9 YTUW,
+C    + INIF,ISLD,MDLA,MWCD,MWCE,MWCL,MWCM,MWDQ,SMRL,
+C    1 INCA,INCH,LNCA,LNIC,
+C    2 CHRA
+C
+C Done.
+C
+      RETURN
+C
+C Error exit.
+C
+C 901 CALL SETER ('AGSAVE - ERROR ON WRITE',10,2)
+C
+C -NOAO
+      END
diff --git a/sys/gio/ncarutil/autograph/agscan.f b/sys/gio/ncarutil/autograph/agscan.f
new file mode 100644
index 00000000..222db6c4
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agscan.f
@@ -0,0 +1,628 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSCAN (TPID,LOPA,NIPA,IIPA)
+C
+      CHARACTER*(*) TPID
+C
+C The routine AGSCAN is used by AGGETP and AGSETP to scan a parameter
+C identifier and return a description of the parameter-list items which
+C are specified by that parameter identifier.  It has the following
+C arguments:
+C
+C -- TPID is the parameter identifier.
+C
+C -- LOPA is the index of the first parameter-list item specified.
+C
+C -- NIPA is the number of parameter-list items specified.
+C
+C -- IIPA is the index increment between one of the parameter-list items
+C    specified and the next (meaningless if NIPA=1).
+C
+C
+C BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE
+C
+C Originally, this routine used the function "LOC" to return, in LOPA,
+C the base address, in core, of the specified parameter group.  To some
+C degree, it was thereby insulated from changes in the labelled common
+C block AGCONP.  With the demise of "LOC", LOPA has been re-defined and
+C that insulation no longer exists.  In the following code, there are
+C integers which represent the indices of desired quantities in common.
+C
+C BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE
+C
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C Declare the block data routine EXTERNAL to force loading of it.
+C
+C +NOAO - call agdflt as run time initialization
+C
+C     EXTERNAL AGDFLT
+      call agdflt
+C -NOAO
+C
+C Initialize the parameter-identifier character index.
+C
+      IPID=0
+C
+C Initialize the value of the index increment to be returned.
+C
+      IIPA=1
+C
+C Find the first keyword in the parameter identifier.
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'PRIMFRAMSET ROW INVEWINDNULLGRAPGRIDX
+     +   Y   AXISLEFTRIGHBOTTTOP DASHLABELINESECOBACK')
+C
+      GO TO (101,102,103,104,105,106,107,108,109,110,
+     +       111,113,114,114,114,114,132,133,147,155,166,901) , IKWL
+C
+C PRIMARY CONTROL PARAMETERS.
+C
+  101 LOPA=1
+      NIPA=336
+      GO TO 203
+C
+C FRAME PARAMETER.
+C
+  102 LOPA=1
+      GO TO 202
+C
+C SET PARAMETER.
+C
+  103 LOPA=2
+      GO TO 202
+C
+C ROW PARAMETER.
+C
+  104 LOPA=3
+      GO TO 202
+C
+C X/Y INVERSION PARAMETER.
+C
+  105 LOPA=4
+      GO TO 202
+C
+C WINDOWING PARAMETER.
+C
+  106 LOPA=5
+      GO TO 202
+C
+C BACKGROUND PARAMETER.
+C
+  166 LOPA=6
+      GO TO 202
+C
+C NULL PARAMETER(S).
+C
+  107 LOPA=7
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'1   2   ')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C PLOT (GRAPH) WINDOW PARAMETERS.
+C
+  108 LOPA=9
+      NIPA=4
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP ')
+C
+      IF (IKWL.EQ.5) GO TO 901
+      GO TO 201
+C
+C GRID WINDOW PARAMETERS.
+C
+  109 LOPA=13
+      NIPA=5
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP SHAP')
+C
+      IF (IKWL.EQ.6) GO TO 901
+      GO TO 201
+C
+C X DATA PARAMETERS.
+C
+  110 LOPA=18
+      GO TO 112
+C
+C Y DATA PARAMETERS.
+C
+  111 LOPA=25
+C
+C X OR Y DATA PARAMETERS.
+C
+  112 NIPA=7
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'MINIMAXILOGAORDENICESMALLARG')
+C
+      IF (IKWL.EQ.8) GO TO 901
+      GO TO 201
+C
+C AXIS PARAMETERS.
+C
+  113 LOPA=32
+      NIPA=92
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP ')
+C
+      IF (IKWL.EQ.5) GO TO 901
+      IKWL=IKWL+12
+C
+C LEFT, RIGHT, BOTTOM, OR TOP AXIS PARAMETERS.
+C
+  114 LOPA=19+IKWL
+      NIPA=23
+      IIPA=4
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +       'CONTLINEINTEFUNCTICKMAJOMINONUMETYPEEXPOFRACANGLOFFSWIDT')
+C
+      GO TO (202,201,115,167,116,117,123,126,127,127,127,
+     +       127,127,127,901) , IKWL
+C
+C AXIS INTERSECTION PARAMETERS.
+C
+  115 LOPA=LOPA+8
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'GRIDUSER')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C AXIS MAPPING FUNCTION.
+C
+  167 LOPA=LOPA+16
+      GO TO 202
+C
+C AXIS TICK PARAMETERS.
+C
+  116 LOPA=LOPA+20
+      NIPA=10
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'MAJOMINO')
+C
+      LOPA=LOPA-20
+      GO TO (117,123,901) , IKWL
+C
+C AXIS MAJOR-TICK PARAMETERS.
+C
+  117 LOPA=LOPA+20
+      NIPA=6
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'SPACTYPEBASECOUNPATTLENGOUTWINWA')
+C
+      GO TO (118,119,119,119,120,121,122,122,901) , IKWL
+C
+C AXIS MAJOR-TICK SPACING PARAMETERS.
+C
+  118 NIPA=3
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'TYPEBASECOUN')
+C
+      IF (IKWL.EQ.4) GO TO 901
+C
+      GO TO 201
+C
+  119 IKWL=IKWL-1
+      GO TO 201
+C
+C AXIS MAJOR-TICK DASH PATTERN.
+C
+  120 LOPA=LOPA+12
+      GO TO 202
+C
+C AXIS MAJOR-TICK LENGTH PARAMETERS.
+C
+  121 LOPA=LOPA+16
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'OUTWINWA')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+  122 LOPA=LOPA+16
+      IKWL=IKWL-6
+      GO TO 201
+C
+C AXIS MINOR-TICK PARAMETERS.
+C
+  123 LOPA=LOPA+44
+      NIPA=4
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'SPACPATTLENGOUTWINWA')
+C
+      GO TO (202,201,124,125,125,901) , IKWL
+C
+C AXIS MINOR-TICK LENGTH PARAMETERS.
+C
+  124 LOPA=LOPA+8
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'OUTWINWA')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+  125 LOPA=LOPA+8
+      IKWL=IKWL-3
+      GO TO 201
+C
+C AXIS NUMERIC-LABEL PARAMETERS.
+C
+  126 LOPA=LOPA+60
+      NIPA=8
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'TYPEEXPOFRACANGLOFFSWIDT')
+C
+      GO TO 128
+C
+  127 LOPA=LOPA+60
+      IKWL=IKWL-8
+C
+  128 GO TO (202,201,201,129,130,131,901) ,IKWL
+C
+C AXIS NUMERIC-LABEL ORIENTATION ANGLE.
+C
+  129 LOPA=LOPA+12
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'1ST 2ND ')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C AXIS NUMERIC-LABEL OFFSET.
+C
+  130 LOPA=LOPA+20
+      GO TO 202
+C
+C AXIS NUMERIC-LABEL WIDTH PARAMETERS.
+C
+  131 LOPA=LOPA+24
+      NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'MANTEXPO')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C DASH-PATTERN PARAMETERS.
+C
+  132 LOPA=124
+      NIPA=30
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+      JPID=IPID
+      CALL AGSRCH (TPID,IPID,IKWL,'SELELENGCHARDOLLPATT')
+      IF (IKWL.EQ.6) THEN
+        IPID=JPID
+        GO TO 168
+      END IF
+      IF (IKWL.NE.5) GO TO 201
+  168 LOPA=LOPA+4
+      NIPA=26
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +'1   2   3   4   5   6   7   8   9   10  11  12  13  14  15  16  1
+     +7  18  19  20  21  22  23  24  25  26  ')
+      IF (IKWL.EQ.27) GO TO 901
+      GO TO 201
+C
+C LABEL PARAMETERS.
+C
+  133 LBIM=IFIX(QBIM)
+      LBAN=IFIX(QBAN)
+C
+      LOPA=154
+      NIPA=3+LBIM*10
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +                   'CONTBUFFNAMEDEFISUPPBASEOFFSANGLCENTLINEINDE')
+C
+      GO TO (202,136,139,140,141,141,141,141,141,141,141,901) , IKWL
+C
+C LABEL BUFFER PARAMETERS.
+C
+  136 LOPA=155
+      NIPA=1+LBIM*10
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LENGCONTNAME')
+C
+      GO TO (202,137,138,901) , IKWL
+C
+C LABEL BUFFER CONTENTS.
+C
+  137 LOPA=156
+      NIPA=LBIM*10
+      GO TO 203
+C
+C LABEL BUFFER NAMES.
+C
+  138 LOPA=156
+      NIPA=LBIM
+      IIPA=10
+      GO TO 203
+C
+C LABEL NAME.
+C
+  139 LOPA=236
+      GO TO 202
+C
+C LABEL DEFINITION.
+C
+  140 IF (LBAN.LT.1.OR.LBAN.GT.LBIM) GO TO 902
+C
+      LOPA=157+(LBAN-1)*10
+      NIPA=9
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'SUPPBASEOFFSANGLCENTLINEINDE')
+C
+      GO TO 142
+C
+  141 IF (LBAN.LT.1.OR.LBAN.GT.LBIM) GO TO 902
+C
+      LOPA=157+(LBAN-1)*10
+      IKWL=IKWL-4
+C
+  142 GO TO (202,143,144,146,146,146,146,901) , IKWL
+C
+C LABEL POSITION.
+C
+  143 LOPA=LOPA+1
+      GO TO 145
+C
+C LABEL OFFSET.
+C
+  144 LOPA=LOPA+3
+C
+C LABEL POSITION OR OFFSET.
+C
+  145 NIPA=2
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'X   Y   ')
+C
+      IF (IKWL.EQ.3) GO TO 901
+      GO TO 201
+C
+C OTHER LABEL ATTRIBUTES.
+C
+  146 LOPA=LOPA+5
+      IKWL=IKWL-3
+      GO TO 201
+C
+C LINE PARAMETERS.
+C
+  147 LNIM=IFIX(QNIM)
+      LNAN=IFIX(QNAN)
+C
+      LOPA=237
+      NIPA=4+LNIM*6
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +                       'MAXIEND BUFFNUMBDEFISUPPCHARTEXTLENGINDE')
+C
+      GO TO (202,201,150,152,153,154,154,154,154,154,901) , IKWL
+C
+C LINE BUFFER PARAMETERS.
+C
+  150 LOPA=239
+      NIPA=1+LNIM*6
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LENGCONT')
+C
+      GO TO (202,151,901) , IKWL
+C
+C LINE BUFFER CONTENTS.
+C
+  151 LOPA=240
+      NIPA=LNIM*6
+      GO TO 203
+C
+C LINE NUMBER.
+C
+  152 LOPA=336
+      GO TO 202
+C
+C LINE DEFINITION.
+C
+  153 IF (LNAN.LT.1.OR.LNAN.GT.LNIM) GO TO 903
+C
+      LOPA=241+(LNAN-1)*6
+      NIPA=5
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'SUPPCHARTEXTLENGINDE')
+C
+      IF (IKWL.EQ.6) GO TO 901
+      GO TO 201
+C
+  154 IF (LNAN.LT.1.OR.LNAN.GT.LNIM) GO TO 903
+      LOPA=241+(LNAN-1)*6
+      IKWL=IKWL-5
+      GO TO 201
+C
+C SECONDARY CONTROL PARAMETERS.
+C
+  155 LOPA=337
+      NIPA=149
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,
+     +                       'GRAPUSERCURVDIMEAXISLEFTRIGHBOTTTOP LABE')
+C
+      GO TO (156,157,158,159,160,161,161,161,161,165,901) , IKWL
+C
+C PLOT (GRAPH) WINDOW EDGES.
+C
+  156 LOPA=337
+      NIPA=4
+      GO TO 203
+C
+C USER WINDOW PARAMETERS.
+C
+  157 LOPA=341
+      NIPA=4
+      GO TO 203
+C
+C CURVE WINDOW PARAMETERS.
+C
+  158 LOPA=345
+      NIPA=4
+      GO TO 203
+C
+C CURVE WINDOW DIMENSIONS.
+C
+  159 LOPA=349
+      NIPA=3
+      GO TO 203
+C
+C AXIS PARAMETERS.
+C
+  160 LOPA=352
+      NIPA=80
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP ')
+C
+      IF (IKWL.EQ.5) GO TO 901
+C
+      IKWL=IKWL+5
+C
+C LEFT, RIGHT, BOTTOM, OR TOP AXIS PARAMETERS.
+C
+  161 LOPA=346+IKWL
+      NIPA=20
+      IIPA=4
+      IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'POSITICKNUME')
+C
+      GO TO (162,163,164,901) , IKWL
+C
+C AXIS POSITIONING PARAMETERS.
+C
+  162 NIPA=6
+      GO TO 203
+C
+C AXIS TICK PARAMETERS.
+C
+  163 LOPA=LOPA+24
+      NIPA=3
+      GO TO 203
+C
+C AXIS NUMERIC-LABEL PARAMETERS.
+C
+  164 LOPA=LOPA+36
+      NIPA=11
+      GO TO 203
+C
+C LABEL BOXES.
+C
+  165 LOPA=432
+      NIPA=54
+      IF (TPID(IPID:IPID).EQ.'.') GO TO 203
+C
+      CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP CENTGRAP')
+C
+      IF (IKWL.EQ.7) GO TO 901
+C
+      LOPA=LOPA+IKWL-1
+      NIPA=9
+      IIPA=6
+      GO TO 203
+C
+C Normal exits.
+C
+  201 LOPA=LOPA+(IKWL-1)*IIPA
+C
+  202 NIPA=1
+C
+  203 IF (TPID(IPID:IPID).EQ.'.') RETURN
+C
+      CALL AGPPID (TPID)
+C +NOAO - following FTN write and fmt statements commented out, SETER is okay.
+C
+C     WRITE (I1MACH(4),1001)
+      RETURN
+C
+C Error exits.
+C
+  901 CALL AGPPID (TPID)
+      CALL SETER ('AGGETP OR AGSETP - ILLEGAL KEYWORD USED IN PARAMETER
+     +IDENTIFIER',11,2)
+C
+  902 CALL AGPPID (TPID)
+      CALL SETER ('AGGETP OR AGSETP - ATTEMPT TO ACCESS LABEL ATTRIBUTES
+     + BEFORE SETTING LABEL NAME',12,2)
+C
+  903 CALL AGPPID (TPID)
+      CALL SETER ('AGGETP OR AGSETP - ATTEMPT TO ACCESS LINE ATTRIBUTES
+     +BEFORE SETTING LINE NUMBER',13,2)
+C
+C Formats.
+C
+C1001 FORMAT (' WARNING - ABOVE PARAMETER IDENTIFIER HAS TOO MANY KEYWOR
+C    +DS')
+C
+C -NOAO
+      END
diff --git a/sys/gio/ncarutil/autograph/agsetc.f b/sys/gio/ncarutil/autograph/agsetc.f
new file mode 100644
index 00000000..bced8458
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsetc.f
@@ -0,0 +1,100 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSETC (TPID,CUSR)
+C
+      CHARACTER*(*) TPID,CUSR
+C
+      DIMENSION FURA(1)
+C
+C The routine AGSETC is used to set the values of individual AUTOGRAPH
+C parameters which intrinsically represent character strings.  TPID is a
+C parameter identifier.  CUSR is a character string.  The situation is
+C complicated by the fact that the character string may be either a dash
+C pattern, the name of a label, the line-end character, or the text of a
+C line, all of which are treated differently.
+C
+C Define a local variable to hold the "line-end" character.
+C
+      CHARACTER*1 LEND
+C
+C See what kind of parameter is being set.
+C
+      CALL AGCTCS (TPID,ITCS)
+C
+C If the parameter is not intrinsically of type character, log an error.
+C
+      IF (ITCS.EQ.0) GO TO 901
+C
+C Find the length of the string, which may or may not actually be used.
+C (On the Cray, at least, it may be zero if the wrong type of argument
+C was used.)
+C
+      ILEN=LEN(CUSR)
+C
+C Retrieve the current (integer) value of the parameter.
+C
+      CALL AGGETI (TPID,ITMP)
+C
+C Check for a dash pattern.
+C
+      IF (ITCS.EQ.1) THEN
+        CALL AGGETI ('DASH/LENG.',NCHR)
+        IF (ILEN.GT.0.AND.ILEN.LT.NCHR) NCHR=ILEN
+        CALL AGRPCH (CUSR,NCHR,ITMP)
+C
+C Check for a label name.
+C
+      ELSE IF (ITCS.EQ.2) THEN
+        CALL AGRPCH (CUSR,MAX0(1,ILEN),ITMP)
+C
+C Check for the line-end character.
+C
+      ELSE IF (ITCS.EQ.3) THEN
+        CALL AGRPCH (CUSR,1,ITMP)
+C
+C Check for the text of a label.
+C
+      ELSE IF (ITCS.EQ.4) THEN
+        CALL AGGETI ('LINE/MAXI.',NCHR)
+        IF (ILEN.GT.0) NCHR=MIN0(NCHR,ILEN)
+        CALL AGGETC ('LINE/END .',LEND)
+        DO 101 I=1,NCHR
+          IF (CUSR(I:I).EQ.LEND) THEN
+            NCHR=I-1
+            GO TO 102
+          END IF
+  101   CONTINUE
+C
+  102   CALL AGRPCH (CUSR,NCHR,ITMP)
+C
+      END IF
+C
+C Transfer the generated value to the list of AUTOGRAPH parameters.
+C
+      FURA(1)=FLOAT(ITMP)
+      CALL AGSETP (TPID,FURA,1)
+C
+C Done.
+C
+      RETURN
+C
+C Error exit.
+C
+  901 CALL AGPPID (TPID)
+      CALL SETER ('AGSETC - PARAMETER TO SET IS NOT INTRINSICALLY OF TYP
+     +E CHARACTER',14,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agsetf.f b/sys/gio/ncarutil/autograph/agsetf.f
new file mode 100644
index 00000000..36fca46e
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsetf.f
@@ -0,0 +1,28 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSETF (TPID,FUSR)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGSETF may be used to set the real (floating-point) value
+C of any single AUTOGRAPH control parameter.
+C
+      FURA(1)=FUSR
+      CALL AGSETP (TPID,FURA,1)
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agseti.f b/sys/gio/ncarutil/autograph/agseti.f
new file mode 100644
index 00000000..06e3b3f1
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agseti.f
@@ -0,0 +1,28 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSETI (TPID,IUSR)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(1)
+C
+C The routine AGSETI may be used to set the integer-equivalent value of
+C any single AUTOGRAPH control parameter.
+C
+      FURA(1)=FLOAT(IUSR)
+      CALL AGSETP (TPID,FURA,1)
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agsetp.f b/sys/gio/ncarutil/autograph/agsetp.f
new file mode 100644
index 00000000..95e98a6d
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsetp.f
@@ -0,0 +1,447 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSETP (TPID,FURA,LURA)
+C
+      CHARACTER*(*) TPID
+      DIMENSION FURA(LURA)
+C
+C The routine AGSETP stores user-provided values of the AUTOGRAPH
+C parameters specified by the parameter identifier TPID.  The arguments
+C are as follows:
+C
+C -- TPID is the parameter identifier, a string of keywords separated
+C    from each other by slashes and followed by a period.
+C
+C -- FURA is the user array from which parameter values are to be taken.
+C
+C -- LURA is the length of the user array.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C The following common block contains other AUTOGRAPH variables, of type
+C character.
+C
+      COMMON /AGOCHP/ CHS1,CHS2
+C
+c+noao
+c     CHARACTER*504 CHS1,CHS2
+      CHARACTER*500 CHS1,CHS2
+c-noao
+C
+C Define the array DUMI, which allows access to the control-parameter
+C list as an array.
+C
+      DIMENSION DUMI(1)
+      EQUIVALENCE (QFRA,DUMI)
+C
+C +NOAO - Make sure common has been initialized. 
+C
+      call agdflt
+C
+C -NOAO
+C If initialization has not yet been done, do it.
+C
+      IF (INIF.EQ.0) THEN
+        CALL AGINIT
+      END IF
+C
+C The routine AGSCAN is called to scan the parameter identifier and to
+C return three quantities describing the AUTOGRAPH parameters affected.
+C
+      CALL AGSCAN (TPID,LOPA,NIPA,IIPA)
+C
+C Determine the number of values to transfer.
+C
+      NURA=MAX0(1,MIN0(LURA,NIPA))
+C
+C If character-string dash patterns are being replaced by integer dash
+C patterns, reclaim the space used in the character-storage arrays.
+C
+      CALL AGSCAN ('DASH/PATT.',LODP,NIDP,IIDP)
+      IF (LOPA.LE.LODP+NIDP-1.AND.LOPA+NURA-1.GE.LODP) THEN
+        MINI=MAX0(LOPA,LODP)-LOPA+1
+        MAXI=MIN0(LOPA+NURA-1,LODP+NIDP-1)-LOPA+1
+        DO 100 I=MINI,MAXI
+          IF (FURA(I).GT.0.) CALL AGDLCH (IFIX(DUMI(LOPA+I-1)))
+  100   CONTINUE
+      END IF
+C
+C Save the current values of special values 1 and 2.
+C
+      SVL1=SVAL(1)
+      SVL2=SVAL(2)
+C
+C Transfer the user-provided values to the parameter list.
+C
+      IDMI=LOPA-IIPA
+C
+      DO 101 IURA=1,NURA
+        IDMI=IDMI+IIPA
+        DUMI(IDMI)=FURA(IURA)
+  101 CONTINUE
+C
+C If a specific item was changed, we may have a bit more work to do;
+C otherwise, return to the user.
+C
+      IF (NIPA.NE.1) RETURN
+C
+C If the specific item was special value 1 or 2, scan the primary list
+C of parameters for other occurrences of the special value and change
+C them to the new value.
+C
+      IF (SVAL(1).NE.SVL1) THEN
+        SVLO=SVL1
+        SVLN=SVAL(1)
+        GO TO 102
+      END IF
+C
+      IF (SVAL(2).NE.SVL2) THEN
+        SVLO=SVL2
+        SVLN=SVAL(2)
+        GO TO 102
+      END IF
+C
+      GO TO 104
+C
+  102 CALL AGSCAN ('PRIM.',LOPR,NIPR,IIPR)
+C
+      IDMI=LOPR-IIPR
+C
+      DO 103 I=1,NIPR
+        IDMI=IDMI+IIPR
+        IF (DUMI(IDMI).EQ.SVLO) DUMI(IDMI)=SVLN
+  103 CONTINUE
+C
+      RETURN
+C
+C If the specific item was the label control flag and it was set
+C negative, delete all labels and lines.
+C
+  104 CALL AGSCAN ('LABE/CONT.',LOLC,NILC,IILC)
+      IF (LOPA.NE.LOLC) GO TO 107
+      IF (QDLB.GE.0.) RETURN
+C
+      QBAN=0.
+      QNAN=0.
+C
+      LBIM=IFIX(QBIM)
+C
+      DO 105 I=1,LBIM
+        IF (FLLB(1,I).NE.0.) THEN
+          CALL AGDLCH (IFIX(FLLB(1,I)))
+          FLLB(1,I)=0.
+        END IF
+  105 CONTINUE
+C
+      LNIM=IFIX(QNIM)
+C
+      DO 106 I=1,LNIM
+        IF (FLLN(1,I).NE.SVAL(1)) THEN
+          CALL AGDLCH (IFIX(FLLN(4,I)))
+          FLLN(1,I)=SVAL(1)
+        END IF
+  106 CONTINUE
+C
+      RETURN
+C
+C If the specific item was the label name, reset it to an appropriate
+C index in the label list, providing initial values if appropriate.
+C
+  107 CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN)
+      IF (LOPA.NE.LOLN) GO TO 109
+C
+      LBAN=0
+      LBIM=IFIX(QBIM)
+      QNAN=0.
+C
+      CALL AGGTCH (IFIX(FURA(1)),CHS1,LCS1)
+C
+      DO 108 I=1,LBIM
+        IF (LBAN.EQ.0.AND.FLLB(1,I).EQ.0.) LBAN=I
+        CALL AGGTCH (IFIX(FLLB(1,I)),CHS2,LCS2)
+        IF (LCS1.NE.LCS2) GO TO 108
+        IF (CHS1(1:LCS1).NE.CHS2(1:LCS2)) GO TO 108
+        QBAN=FLOAT(I)
+        RETURN
+  108 CONTINUE
+C
+      IF (LBAN.EQ.0) GO TO 901
+C
+      QBAN=FLOAT(LBAN)
+C
+      FLLB( 1,LBAN)=FURA(1)
+      FLLB( 2,LBAN)=0.
+      FLLB( 3,LBAN)=.5
+      FLLB( 4,LBAN)=.5
+      FLLB( 5,LBAN)=0.
+      FLLB( 6,LBAN)=0.
+      FLLB( 7,LBAN)=0.
+      FLLB( 8,LBAN)=0.
+      FLLB( 9,LBAN)=0.
+      FLLB(10,LBAN)=0.
+C
+      RETURN
+C
+C If the label access name is not set, skip.
+C
+  109 IF (QBAN.LE.0.) GO TO 122
+C
+      LBAN=IFIX(QBAN)
+      LBIM=IFIX(QBIM)
+      LNAN=IFIX(QNAN)
+      LNIM=IFIX(QNIM)
+C
+C If the specific item was the suppression flag for the current label
+C and it was set negative, delete the label and/or its lines.
+C
+      CALL AGSCAN ('LABE/SUPP.',LOLS,NILS,IILS)
+      IF (LOPA.NE.LOLS) GO TO 111
+      IF (FLLB(2,LBAN).GE.0.) RETURN
+C
+      ITMP=IFIX(FLLB(2,LBAN))
+      FLLB(2,LBAN)=0.
+      FLLB(9,LBAN)=0.
+      LNIN=IFIX(FLLB(10,LBAN))
+      FLLB(10,LBAN)=0.
+      QNAN=0.
+      IF (ITMP.EQ.(-1)) GO TO 110
+      CALL AGDLCH (IFIX(FLLB(1,LBAN)))
+      FLLB(1,LBAN)=0.
+      QBAN=0.
+C
+  110 IF (LNIN.LT.1.OR.LNIN.GT.LNIM) RETURN
+      FLLN(1,LNIN)=SVAL(1)
+      CALL AGDLCH (IFIX(FLLN(4,LNIN)))
+      LNIN=IFIX(FLLN(6,LNIN))
+      GO TO 110
+C
+C If the specific item was the line number, reset it to an appropriate
+C index in the line list, providing initial values if appropriate.
+C
+  111 CALL AGSCAN ('LINE/NUMB.',LOLN,NILN,IILN)
+      IF (LOPA.NE.LOLN) GO TO 118
+C
+      LNIL=0
+      LNIN=IFIX(FLLB(10,LBAN))
+C
+  112 IF (LNIN.LT.1.OR.LNIN.GT.LNIM) GO TO 115
+      IF (LNAN-IFIX(FLLN(1,LNIN))) 113,114,115
+C
+  113 LNIL=LNIN
+      LNIN=IFIX(FLLN(6,LNIN))
+      GO TO 112
+C
+  114 QNAN=FLOAT(LNIN)
+      RETURN
+C
+  115      DO 116 I=1,LNIM
+           LNIT=I
+           IF (FLLN(1,I).EQ.SVAL(1)) GO TO 117
+  116      CONTINUE
+C
+      GO TO 903
+C
+  117 CALL AGSTCH (' ',1,ITMP)
+C
+      FLLN(1,LNIT)=FLOAT(LNAN)
+      FLLN(2,LNIT)=0.
+      FLLN(3,LNIT)=.015
+      FLLN(4,LNIT)=ITMP
+      FLLN(5,LNIT)=1.
+      FLLN(6,LNIT)=FLOAT(LNIN)
+C
+      LNAN=LNIT
+      IF (LNIL.EQ.0) FLLB(10,LBAN)=FLOAT(LNAN)
+      IF (LNIL.NE.0) FLLN( 6,LNIL)=FLOAT(LNAN)
+C
+      FLLB(9,LBAN)=FLLB(9,LBAN)+1.
+C
+      QNAN=FLOAT(LNAN)
+      RETURN
+C
+C If the line access number is not set, skip.
+C
+  118 IF (LNAN.LE.0) GO TO 122
+C
+C If the specific item was the suppression flag for the current line and
+C it was set negative, delete the line.
+C
+      CALL AGSCAN ('LINE/SUPP.',LOLS,NILS,IILS)
+      IF (LOPA.NE.LOLS) GO TO 121
+      IF (FLLN(2,LNAN).GE.0.) RETURN
+C
+      LNIL=0
+      LNIN=IFIX(FLLB(10,LBAN))
+C
+  119 IF (LNIN.LT.1.OR.LNIN.GT.LNIM) RETURN
+      IF (LNAN.EQ.LNIN) GO TO 120
+      LNIL=LNIN
+      LNIN=IFIX(FLLN(6,LNIN))
+      GO TO 119
+C
+  120 IF (LNIL.EQ.0) FLLB(10,LBAN)=FLLN(6,LNAN)
+      IF (LNIL.NE.0) FLLN( 6,LNIL)=FLLN(6,LNAN)
+      FLLN(1,LNAN)=SVAL(1)
+      CALL AGDLCH (IFIX(FLLN(4,LNAN)))
+      QNAN=0.
+      RETURN
+C
+C If the specific item was the text of a line, set the length of the
+C line, as well.
+C
+  121 CALL AGSCAN ('LINE/TEXT.',LOLT,NILT,IILT)
+      IF (LOPA.NE.LOLT) GO TO 123
+      CALL AGGTCH (IFIX(FURA(1)),CHS1,LCS1)
+      FLLN(5,LNAN)=FLOAT(LCS1)
+      RETURN
+C
+C See if the user is trying to get at a line of a non-existent label.
+C
+  122 CALL AGSCAN ('LINE/NUMB.',LOLN,NILN,IILN)
+      IF (LOPA.EQ.LOLN) GO TO 902
+C
+C If the specific item was the background parameter, set up the back-
+C ground requested by the user.
+C
+  123 CALL AGSCAN ('BACK.',LOBG,NIBG,IIBG)
+      IF (LOPA.NE.LOBG) GO TO 130
+C
+      QBAC=AMAX1(1.,AMIN1(4.,QBAC))
+      IBAC=IFIX(QBAC)
+      GO TO (124,125,126,127) , IBAC
+C
+C Perimeter background.
+C
+  124 QLBC=4.
+      QRTC=4.
+      WMJI=.015
+      WMNI=.010
+      GO TO 128
+C
+C Grid background.
+C
+  125 QLBC=4.
+      QRTC=-1.
+      WMJI=1.
+      WMNI=1.
+      GO TO 128
+C
+C Half-axis background.
+C
+  126 QLBC=4.
+      QRTC=0.
+      WMJI=.015
+      WMNI=.010
+      GO TO 128
+C
+C No background.
+C
+  127 QLBC=0.
+      QRTC=0.
+      WMJI=.015
+      WMNI=.010
+C
+  128 QDAX(1)=QLBC
+      QDAX(2)=QRTC
+      QDAX(3)=QLBC
+      QDAX(4)=QRTC
+C
+      DO 129 I=1,4
+        WMJR(I)=WMJI
+        WMNR(I)=WMNI
+  129 CONTINUE
+C
+      QDLB=FLOAT(2-2*(IBAC/4))
+      RETURN
+C
+C If the specific item was the get-limits-from-last-SET-call parameter,
+C do what is necessary.
+C
+  130 CALL AGSCAN ('SET .',LOSE,NISE,IISE)
+      IF (LOPA.NE.LOSE) GO TO 131
+C
+      QSET=SIGN(AMAX1(1.,AMIN1(4.,ABS(QSET))),QSET)
+C
+      XLGD=.15
+      XRGD=.95
+      YBGD=.15
+      YTGD=.95
+      SOGD=0.
+C
+      XMIN=SVAL(1)
+      XMAX=SVAL(1)
+      QLUX=AMIN1(QLUX,0.)
+      QOVX=0.
+      QCEX=-1.
+      XLOW=SVAL(1)
+      XHGH=SVAL(1)
+C
+      YMIN=SVAL(1)
+      YMAX=SVAL(1)
+      QLUY=AMIN1(QLUY,0.)
+      QOVY=0.
+      QCEY=-1.
+      YLOW=SVAL(1)
+      YHGH=SVAL(1)
+C
+      RETURN
+C
+C Return to caller.
+C
+  131 RETURN
+C
+C Error exits.
+C
+  901 CALL AGPPID (TPID)
+      CALL SETER ('AGSETP - LABEL LIST OVERFLOW - SEE AUTOGRAPH SPECIALI
+     +ST',15,2)
+C
+  902 CALL AGPPID (TPID)
+      CALL SETER ('AGSETP - ATTEMPT TO DEFINE LINE OF NON-EXISTENT LABEL
+     +',16,2)
+C
+  903 CALL AGPPID (TPID)
+      CALL SETER ('AGSETP - LINE LIST OVERFLOW - SEE AUTOGRAPH SPECIALIS
+     +T',17,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agsrch.f b/sys/gio/ncarutil/autograph/agsrch.f
new file mode 100644
index 00000000..366c46cc
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agsrch.f
@@ -0,0 +1,96 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSRCH (TPID,IPID,IKWL,TKWL)
+C
+      CHARACTER*(*) TPID,TKWL
+C
+C The routine AGSRCH is used by AGSCAN to search a parameter identifier
+C for the next keyword and return the index of that keyword in a list of
+C keywords.  It has the following arguments.
+C
+C -- TPID is the parameter identifier, a character string.
+C
+C -- IPID is the index of the last character examined in TPID.  It is
+C    updated by AGSRCH to point to the first slash or period following
+C    the next keyword.
+C
+C -- IKWL is returned containing the index (in the keyword list) of the
+C    next keyword in the parameter identifier (list length, plus one,
+C    if the keyword is not found in the list).
+C
+C -- TKWL is the keyword list - 4*LKWL characters in all.
+C
+C ICHR is used to hold up to four characters of a keyword.
+C
+      CHARACTER*4 ICHR
+C
+C LPID is the assumed maximum length of a parameter identifier.
+C
+      DATA LPID / 100 /
+C
+C Compute the number of 4-character keywords in the keyword list.
+C
+      LKWL=LEN(TKWL)/4
+C
+C Find the next non-blank in the parameter identifier.
+C
+  101 IPID=IPID+1
+      IF (IPID.GT.LPID) GO TO 107
+      IF (TPID(IPID:IPID).EQ.' ') GO TO 101
+C
+C Pick up at most four characters of the keyword, stopping on the first
+C blank, slash, or period encountered.
+C
+      NCHR=0
+C
+  102 IF (TPID(IPID:IPID).EQ.' '.OR.
+     +    TPID(IPID:IPID).EQ.'/'.OR.
+     +    TPID(IPID:IPID).EQ.'.') GO TO 103
+C
+      NCHR=NCHR+1
+      ICHR(NCHR:NCHR)=TPID(IPID:IPID)
+C
+      IPID=IPID+1
+C
+      IF (NCHR.LT.4) GO TO 102
+C
+C If the keyword found has zero length, error.
+C
+  103 IF (NCHR.EQ.0) GO TO 107
+C
+C Scan ahead for the next slash or period.
+C
+  104 IF (TPID(IPID:IPID).EQ.'/'.OR.TPID(IPID:IPID).EQ.'.') GO TO 105
+C
+      IPID=IPID+1
+      IF (IPID.GT.LPID) GO TO 107
+      GO TO 104
+C
+C Search the keyword list for the keyword found.
+C
+  105 DO 106 I=1,LKWL
+        IKWL=I
+        ISTR=(I-1)*4+1
+        IEND=(I-1)*4+NCHR
+        IF (ICHR(1:NCHR).EQ.TKWL(ISTR:IEND)) RETURN
+  106 CONTINUE
+C
+C Keyword not found - set IKWL to impossible value and return.
+C
+  107 IKWL=LKWL+1
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agstch.f b/sys/gio/ncarutil/autograph/agstch.f
new file mode 100644
index 00000000..2b2906bd
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agstch.f
@@ -0,0 +1,124 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSTCH (CHST,LNCS,IDCS)
+C
+      CHARACTER*(*) CHST
+C
+C This routine stores strings of characters for later retrieval and/or
+C modification by the routines AGGTCH, AGRPCH, and AGDLCH.  It has the
+C following arguments:
+C
+C -- CHST is the character string to be stored.
+C
+C -- LNCS is the length of the character string in CHST.  LNCS must be
+C    less than or equal to the value of the FORTRAN function LEN(CHST).
+C
+C -- IDCS is an identifying integer, returned to the caller by AGSTCH
+C    for later use in calls to AGGTCH, AGRPCH, and AGDLCH.  If CHST is
+C    more than one character long, it is stashed in the array CHRA, and
+C    the value returned in IDCS is a negative number between -LNIC and
+C    -1, inclusive, the absolute value of which is the index of an entry
+C    in the array INCH describing where in the array CHRA the string was
+C    stored.  If CHST is only one character long, IDCS is returned as
+C    the value of the FORTRAN expression -(LNIC+1+ICHAR(CHST(1:1))).
+C
+C The following common blocks contain variables which are required for
+C the character-storage-and-retrieval scheme of AUTOGRAPH.
+C
+      COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA
+C
+      COMMON /AGCHR2/ CHRA(2000)
+C
+      CHARACTER*1 CHRA
+C
+C If the string is short enough, just embed it in a negative integer
+C and return that value to the caller as the identifier of the string.
+C
+      IF (LNCS.LE.1) THEN
+        IDCS=-(LNIC+1+ICHAR(CHST(1:1)))
+        RETURN
+      END IF
+C
+C Otherwise, the string must be stashed in CHRA and the negative of the
+C index, in INCH, of its descriptor returned to the caller.  Loop, on I,
+C through the index of character strings.
+C
+      DO 104 I=1,LNIC
+C
+C If the next entry in the index is zeroed, use it for the new string.
+C
+        IF (INCH(1,I).EQ.0) THEN
+C
+C Zeroed entry found.  Return the negative of its index to the user.
+C
+          IDCS=-I
+C
+C If there isn't enough room for the character string at the end of the
+C character-storage array, do some garbage-collecting, eliminating all
+C strings of all-zero characters.
+C
+          IF (LNCS.GT.LNCA-INCA) THEN
+            J=0
+            K=0
+            DO 102 L=1,INCA
+              IF (CHRA(L).EQ.CHAR(0)) THEN
+                IF (J.EQ.0) J=L
+              ELSE
+                IF (J.NE.0) THEN
+                  DO 101 M=1,LNIC
+                    IF (INCH(1,M).GT.K) INCH(1,M)=INCH(1,M)+J-L
+  101             CONTINUE
+                  J=0
+                END IF
+                K=K+1
+                CHRA(K)=CHRA(L)
+              END IF
+  102       CONTINUE
+            INCA=K
+          END IF
+C
+C If there still isn't enough room for the character string at the end
+C of the character-storage array, take an error exit.  Otherwise, stash
+C it and return.  All-zero characters are changed to blanks.
+C
+          IF (LNCS.GT.LNCA-INCA) GO TO 901
+          INCH(1,I)=INCA+1
+          INCH(2,I)=LNCS
+          DO 103 J=1,LNCS
+            INCA=INCA+1
+            CHRA(INCA)=CHST(J:J)
+            IF (ICHAR(CHRA(INCA)).EQ.0) CHRA(INCA)=' '
+  103     CONTINUE
+          RETURN
+C
+        END IF
+C
+  104 CONTINUE
+C
+C If no zeroed entry was found in the index of character strings, jump
+C to log an error and quit.
+C
+      GO TO 902
+C
+C Error exits.
+C
+  901 CALL SETER ('AGSTCH - CHARACTER-STRING BUFFER OVERFLOW - SEE CONSU
+     +LTANT',18,2)
+C
+  902 CALL SETER ('AGSTCH - CHARACTER-STRING INDEX OVERFLOW - SEE CONSUL
+     +TANT',19,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agstup.f b/sys/gio/ncarutil/autograph/agstup.f
new file mode 100644
index 00000000..41a97674
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agstup.f
@@ -0,0 +1,543 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGSTUP (XDRA,NVIX,IIVX,NEVX,IIEX,
+     +                   YDRA,NVIY,IIVY,NEVY,IIEY)
+C
+      DIMENSION XDRA(1),YDRA(1)
+C
+C The routine AGSTUP is called to examine the parameter list, to provide
+C default values for missing parameters, and to check for and cope with
+C label overlap problems.
+C
+C The arguments describe the x and y data arrays to be used for the next
+C graph.  See the routine AGEXUS for a description of them.
+C
+C The following common block contains the AUTOGRAPH control parameters,
+C all of which are real.  If it is changed, all of AUTOGRAPH (especially
+C the routine AGSCAN) must be examined for possible side effects.
+C
+      COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) ,
+     +                XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD ,
+     +                XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH ,
+     +                YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH ,
+     +                QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4),
+     +                BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4),
+     +                QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4),
+     +                QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) ,
+     +                QODP,QCDP,WOCD,WODQ,QDSH(26) ,
+     +                     QDLB,QBIM,FLLB(10,8),QBAN ,
+     +                QLLN,TCLN,QNIM,FLLN(6,16),QNAN ,
+     +                XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW ,
+     +                XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP ,
+     +                XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4),
+     +                QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4),
+     +                QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4),
+     +                WNLE(4),QLUA(4) ,
+     +                RBOX(6),DBOX(6,4),SBOX(6,4)
+C
+C The following common block contains other AUTOGRAPH variables, both
+C real and integer, which are not control parameters.
+C
+      COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ ,
+     +                INIF
+C
+C Declare the block data routine external to force it to load.
+C
+C     EXTERNAL AGDFLT
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','AGSTUP','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO - Block data replaced with run time initialization
+C
+      call agdflt
+C 
+C -NOAO
+C If initialization has not yet been done, do it.
+C
+      IF (INIF.EQ.0) THEN
+        CALL AGINIT
+      END IF
+C
+C Compute the width and height of the plotter frame.
+C
+      CALL GETSI (IWFP,IHFP)
+      WOFP=2.**IWFP-1.
+      HOFP=2.**IHFP-1.
+C
+C Examine the get-limits-from-last-set-call parameter.
+C
+      IF (ABS(QSET).EQ.1.) GO TO 141
+C
+      CALL GETSET (XLCW,XRCW,YBCW,YTCW,XMNT,XMXT,YMNT,YMXT,LILO)
+C
+      QLUX=FLOAT((1-LILO)/2)
+      QLUY=FLOAT(MOD(1-LILO,2))
+C
+      IF (ABS(QSET).EQ.3.) GO TO 140
+C
+      XLGD=(XLCW-XLGF)/(XRGF-XLGF)
+      XRGD=(XRCW-XLGF)/(XRGF-XLGF)
+      YBGD=(YBCW-YBGF)/(YTGF-YBGF)
+      YTGD=(YTCW-YBGF)/(YTGF-YBGF)
+      SOGD=0.
+C
+      IF (ABS(QSET).EQ.2.) GO TO 141
+C
+  140 XMIN=AMIN1(XMNT,XMXT)
+      XMAX=AMAX1(XMNT,XMXT)
+      QOVX=0.
+      IF (XMNT.GT.XMXT) QOVX=1.
+      QCEX=0.
+C
+      YMIN=AMIN1(YMNT,YMXT)
+      YMAX=AMAX1(YMNT,YMXT)
+      QOVY=0.
+      IF (YMNT.GT.YMXT) QOVY=1.
+      QCEY=0.
+C
+  141 CONTINUE
+C
+C Examine the graph-window parameters.
+C
+      XLGF=AMAX1(0.,AMIN1(1.,XLGF))
+      XRGF=AMAX1(0.,AMIN1(1.,XRGF))
+      YBGF=AMAX1(0.,AMIN1(1.,YBGF))
+      YTGF=AMAX1(0.,AMIN1(1.,YTGF))
+C
+      IF (XLGF.GE.XRGF.OR.YBGF.GE.YTGF) GO TO 901
+C
+C Examine the grid-window parameters.
+C
+      XLGD=AMAX1(0.,AMIN1(1.,XLGD))
+      XRGD=AMAX1(0.,AMIN1(1.,XRGD))
+      YBGD=AMAX1(0.,AMIN1(1.,YBGD))
+      YTGD=AMAX1(0.,AMIN1(1.,YTGD))
+C
+      IF (XLGD.GE.XRGD.OR.YBGD.GE.YTGD) GO TO 902
+C
+C Examine the user-window minima and maxima for special values.  Compute
+C tentative values of the user-window edge parameters.
+C
+      QIXY=AMAX1(0.,AMIN1(1.,QIXY))
+C
+      IF (QIXY.NE.0.) GO TO 142
+C
+      CALL AGEXUS (SVAL,XMIN,XMAX,XLOW,XHGH,
+     +                               XDRA,NVIX,IIVX,NEVX,IIEX,XLUW,XRUW)
+      CALL AGEXUS (SVAL,YMIN,YMAX,YLOW,YHGH,
+     +                               YDRA,NVIY,IIVY,NEVY,IIEY,YBUW,YTUW)
+      GO TO 143
+C
+  142 CALL AGEXUS (SVAL,XMIN,XMAX,XLOW,XHGH,
+     +                               YDRA,NVIY,IIVY,NEVY,IIEY,XLUW,XRUW)
+      CALL AGEXUS (SVAL,YMIN,YMAX,YLOW,YHGH,
+     +                               XDRA,NVIX,IIVX,NEVX,IIEX,YBUW,YTUW)
+C
+  143 CONTINUE
+C
+C Examine the user-window nice-value-at-ends parameters.  INAX and INAY
+C specify which axis has the nice values (if any).
+C
+      QCEX=AMAX1(-1.,AMIN1(+1.,QCEX))
+      INAX=IFIX(QCEX)
+      IF (INAX.NE.0) INAX=(INAX+7)/2
+C
+      QCEY=AMAX1(-1.,AMIN1(+1.,QCEY))
+      INAY=IFIX(QCEY)
+      IF (INAY.NE.0) INAY=(INAY+3)/2
+C
+C Examine the user-window linear-log flags.
+C
+      QLUX=AMAX1(-1.,AMIN1(1.,QLUX))
+      QLUY=AMAX1(-1.,AMIN1(1.,QLUY))
+C
+C Examine the axis parameters.
+C
+      QLUD=ABS(QLUY)
+      INAD=INAY
+      UMIN=YBUW
+      UMAX=YTUW
+      QMIN=YBUW
+      QMAX=YTUW
+C
+      I=0
+C
+  101 I=I+1
+      IF (I.EQ.5) GO TO 104
+C
+      IF (I.EQ.3) THEN
+        QLUD=ABS(QLUX)
+        INAD=INAX
+        UMIN=XLUW
+        UMAX=XRUW
+        QMIN=XLUW
+        QMAX=XRUW
+      END IF
+C
+      QDAX(I)=AMAX1(-1.,AMIN1(4.,QDAX(I)))
+      IF (QDAX(I).LE.0.) GO TO 102
+      QLUA(I)=QLUD
+      QBTP(I)=QBTD(I)
+      IF (QBTD(I).EQ.SVAL(1).OR.QBTD(I).EQ.SVAL(2)) QBTP(I)=1.+QLUD
+      QBTP(I)=AMAX1(0.,AMIN1(3.,QBTP(I)))
+      IF (QBTD(I).EQ.SVAL(2)) QBTD(I)=QBTP(I)
+C
+      CALL AGEXAX (I,SVAL,UMIN,UMAX,INAD-I,QLUD,FUNS(I),QBTP(I),BASD(I),
+     +             BASE(I),QMJD(I),QMND(I),QMNT(I),QLTD(I),QLTP(I),
+     +             QLED(I),QLEX(I),QLFD(I),QLFL(I),QMIN,QMAX)
+C
+      QSPA(I)=AMAX1(0.,AMIN1(1.,QSPA(I)))
+      IF (QJDP(I).EQ.SVAL(1).OR.QJDP(I).EQ.SVAL(2)) QJDP(I)=65535.
+      IF (QNDP(I).EQ.SVAL(1).OR.QNDP(I).EQ.SVAL(2)) QNDP(I)=65535.
+C
+  102 IF (I.EQ.2) THEN
+        YBUW=QMIN
+        YTUW=QMAX
+      ELSE IF (I.EQ.4) THEN
+        XLUW=QMIN
+        XRUW=QMAX
+      END IF
+C
+      GO TO 101
+C
+C Examine the user-window min-max/max-min ordering parameters.  Compute
+C final values of the user-window edge parameters.
+C
+  104 QOVX=AMAX1(0.,AMIN1(1.,QOVX))
+      IF (QOVX.EQ.0.) GO TO 105
+      TEMP=XLUW
+      XLUW=XRUW
+      XRUW=TEMP
+C
+  105 QOVY=AMAX1(0.,AMIN1(1.,QOVY))
+      IF (QOVY.EQ.0.) GO TO 106
+      TEMP=YBUW
+      YBUW=YTUW
+      YTUW=TEMP
+C
+C Determine the exact size and shape of the curve window.
+C
+  106 XLGW=XLGF*WOFP
+      XRGW=XRGF*WOFP
+      YBGW=YBGF*HOFP
+      YTGW=YTGF*HOFP
+C
+      XLCW=XLGW+XLGD*(XRGW-XLGW)
+      XRCW=XLGW+XRGD*(XRGW-XLGW)
+      YBCW=YBGW+YBGD*(YTGW-YBGW)
+      YTCW=YBGW+YTGD*(YTGW-YBGW)
+C
+      WCWP=XRCW-XLCW
+      HCWP=YTCW-YBCW
+C
+      ARWH=WCWP/HCWP
+C
+      IF (SOGD) 107,115,108
+C
+  107 DRWH=ABS(SOGD)
+      GO TO 111
+C
+  108 DRWH=ABS((XRUW-XLUW)/(YTUW-YBUW))
+      IF (SOGD-1.) 109,110,110
+C
+  109 IF (DRWH.LT.SOGD.OR.(1./DRWH).LT.SOGD) GO TO 115
+      GO TO 111
+C
+  110 IF (DRWH.GT.SOGD.OR.(1./DRWH).GT.SOGD) DRWH=1.
+C
+  111 IF (DRWH-ARWH) 112,115,113
+C
+  112 XLCW=XLCW+.5*(WCWP-HCWP*DRWH)
+      XRCW=XRCW-.5*(WCWP-HCWP*DRWH)
+      GO TO 114
+C
+  113 YBCW=YBCW+.5*(HCWP-WCWP/DRWH)
+      YTCW=YTCW-.5*(HCWP-WCWP/DRWH)
+C
+  114 WCWP=XRCW-XLCW
+      HCWP=YTCW-YBCW
+C
+  115 SCWP=AMIN1(WCWP,HCWP)
+C
+      XLGW=(XLGW-XLCW)/WCWP
+      XRGW=(XRGW-XLCW)/WCWP
+      YBGW=(YBGW-YBCW)/HCWP
+      YTGW=(YTGW-YBCW)/HCWP
+C
+      XLCW=XLCW/WOFP
+      XRCW=XRCW/WOFP
+      YBCW=YBCW/HOFP
+      YTCW=YTCW/HOFP
+C
+C Make sure the number of dash patterns is in range.
+C
+      QODP=AMAX1(-26.,AMIN1(+26.,QODP))
+      IF (QODP.EQ.0.) QODP=-1.
+C
+C Examine the windowing parameter.
+C
+      QWND=AMAX1(0.,AMIN1(1.,QWND))
+C
+C Do a test run of the routine AGLBLS to find out how much space will be
+C required for labels in each of the six label boxes.
+C
+      QDLB=AMAX1(0.,AMIN1(2.,QDLB))
+      IDLB=IFIX(QDLB)
+      LBIM=IFIX(QBIM)
+C
+      CALL AGLBLS (-IDLB,WCWP,HCWP,FLLB,LBIM,FLLN,DBOX,SBOX,RBOX)
+C
+C Compute the desired and smallest-possible widths of the labels in
+C boxes 1 and 2.
+C
+      DWB1=AMAX1(0.,DBOX(1,2)-DBOX(1,1))
+      SWB1=AMAX1(0.,SBOX(1,2)-SBOX(1,1))
+      DWB2=AMAX1(0.,DBOX(2,2)-DBOX(2,1))
+      SWB2=AMAX1(0.,SBOX(2,2)-SBOX(2,1))
+C
+C Compute the desired and smallest-possible heights of the labels in
+C boxes 3 and 4.
+C
+      DHB3=AMAX1(0.,DBOX(3,4)-DBOX(3,3))
+      SHB3=AMAX1(0.,SBOX(3,4)-SBOX(3,3))
+      DHB4=AMAX1(0.,DBOX(4,4)-DBOX(4,3))
+      SHB4=AMAX1(0.,SBOX(4,4)-SBOX(4,3))
+C
+C Do test runs of AGAXIS for each of the four axes to see how much space
+C will be required for numeric labels.
+C
+      I=0
+C
+  118 I=I+1
+      IF (I.EQ.5) GO TO 128
+C
+      XYPI=FLOAT(1-MOD(I,2))
+      IF (QDAX(I).EQ.0.) GO TO 121
+      IF (PING(I).NE.SVAL(1)) XYPI=PING(I)
+C
+      IF (I.GE.3) GO TO 119
+C
+      XYMN=XLGW
+      XYMX=XRGW
+      IF (PINU(I).EQ.SVAL(1)) GO TO 120
+      XYPI=(PINU(I)-XLUW)/(XRUW-XLUW)
+      IF (QLUX.NE.0.) XYPI=(ALOG10(PINU(I))-ALOG10(XLUW))/
+     +                                       (ALOG10(XRUW)-ALOG10(XLUW))
+      GO TO 120
+C
+  119 XYMN=YBGW
+      XYMX=YTGW
+      IF (PINU(I).EQ.SVAL(1)) GO TO 120
+      XYPI=(PINU(I)-YBUW)/(YTUW-YBUW)
+      IF (QLUY.NE.0.) XYPI=(ALOG10(PINU(I))-ALOG10(YBUW))/
+     +                                       (ALOG10(YTUW)-ALOG10(YBUW))
+C
+  120 XYPI=AMAX1(XYMN,AMIN1(XYMX,XYPI))
+C
+  121 GO TO (122,123,124,125) , I
+C
+C Left y axis.
+C
+  122 XBGA(1)=XYPI
+      YBGA(1)=0.
+      UBGA(1)=YBUW
+      XNDA(1)=XYPI
+      YNDA(1)=1.
+      UNDA(1)=YTUW
+      WNLL(1)=XYPI-XLGW-DWB1
+      WNLR(1)=XRGW-XYPI-DWB2
+      GO TO 126
+C
+C Right y axis.
+C
+  123 XBGA(2)=XYPI
+      YBGA(2)=1.
+      UBGA(2)=YTUW
+      XNDA(2)=XYPI
+      YNDA(2)=0.
+      UNDA(2)=YBUW
+      WNLL(2)=XRGW-XYPI-DWB2
+      WNLR(2)=XYPI-XLGW-DWB1
+      GO TO 126
+C
+C Bottom x axis.
+C
+  124 XBGA(3)=1.
+      YBGA(3)=XYPI
+      UBGA(3)=XRUW
+      XNDA(3)=0.
+      YNDA(3)=XYPI
+      UNDA(3)=XLUW
+      WNLL(3)=XYPI-YBGW-DHB3
+      WNLR(3)=YTGW-XYPI-DHB4
+      GO TO 126
+C
+C Top x axis.
+C
+  125 XBGA(4)=0.
+      YBGA(4)=XYPI
+      UBGA(4)=XLUW
+      XNDA(4)=1.
+      YNDA(4)=XYPI
+      UNDA(4)=XRUW
+      WNLL(4)=YTGW-XYPI-DHB4
+      WNLR(4)=XYPI-YBGW-DHB3
+C
+  126 IF (QDAX(I).GT.0.) THEN
+        CALL AGAXIS (I,QDAX(I),QSPA(I),WCWP,HCWP,XBGA(I),YBGA(I),
+     +               XNDA(I),YNDA(I),QLUA(I),UBGA(I),UNDA(I),FUNS(I),
+     +               QBTP(I),BASE(I),QJDP(I),WMJL(I),WMJR(I),QMNT(I),
+     +               QNDP(I),WMNL(I),WMNR(I),QLTP(I),QLEX(I),QLFL(I),
+     +               QLOF(I),QLOS(I),DNLA(I),WCLM(I),WCLE(I),RFNL(I),
+     +               QCIM(I),QCIE(I),WNLL(I),WNLR(I),10.,11.)
+      ELSE
+        WNLL(I)=0.
+        WNLR(I)=0.
+      END IF
+      GO TO 118
+C
+C If no labels are to be drawn, AGSTUP is now done.
+C
+  128 IF (IDLB.EQ.0) GO TO 138
+C
+C Check the label boxes, moving and/or shrinking them to prevent the
+C labels in them from overlapping any portion of any axis.  The labels
+C on an axis may have to be moved, as well.
+C
+C Box 1 - to the left of the curve window.
+C
+      IF (DBOX(1,2).GT.0.) GO TO 903
+      DBOX(1,2)=AMIN1(0.,XBGA(1)-WNLL(1),XBGA(2)-WNLR(2))
+      DBOX(1,1)=DBOX(1,2)-DWB1
+      IF (DBOX(1,1).LT.XLGW) DBOX(1,1)=AMIN1(DBOX(1,2)-SWB1,XLGW)
+      IF (DBOX(1,1).GE.XLGW) GO TO 130
+      DBOX(1,1)=XLGW
+      DBOX(1,2)=XLGW+SWB1
+      TEMP=XBGA(1)-WNLL(1)-DBOX(1,2)
+      IF (TEMP.GE.0.) GO TO 129
+      WNLL(1)=WNLL(1)+TEMP
+      WNLR(1)=WNLR(1)-TEMP
+  129 TEMP=XBGA(2)-WNLR(2)-DBOX(1,2)
+      IF (TEMP.GE.0.) GO TO 130
+      WNLL(2)=WNLL(2)-TEMP
+      WNLR(2)=WNLR(2)+TEMP
+C
+C Box 2 - to the right of the curve window.
+C
+  130 IF (DBOX(2,1).LT.1.) GO TO 904
+      DBOX(2,1)=AMAX1(1.,XBGA(1)+WNLR(1),XBGA(2)+WNLL(2))
+      DBOX(2,2)=DBOX(2,1)+DWB2
+      IF (DBOX(2,2).GT.XRGW) DBOX(2,2)=AMAX1(DBOX(2,1)+SWB2,XRGW)
+      IF (DBOX(2,2).LE.XRGW) GO TO 132
+      DBOX(2,1)=XRGW-SWB2
+      DBOX(2,2)=XRGW
+      TEMP=XBGA(1)+WNLR(1)-DBOX(2,1)
+      IF (TEMP.LE.0.) GO TO 131
+      WNLL(1)=WNLL(1)+TEMP
+      WNLR(1)=WNLR(1)-TEMP
+  131 TEMP=XBGA(2)+WNLL(2)-DBOX(2,1)
+      IF (TEMP.LE.0.) GO TO 132
+      WNLL(2)=WNLL(2)-TEMP
+      WNLR(2)=WNLR(2)+TEMP
+C
+C Box 3 - below the curve window.
+C
+  132 IF (DBOX(3,4).GT.0.) GO TO 905
+      DBOX(3,4)=AMIN1(0.,YBGA(3)-WNLL(3),YBGA(4)-WNLR(4))
+      DBOX(3,3)=DBOX(3,4)-DHB3
+      IF (DBOX(3,3).LT.YBGW) DBOX(3,3)=AMIN1(DBOX(3,4)-SHB3,YBGW)
+      IF (DBOX(3,3).GE.YBGW) GO TO 134
+      DBOX(3,3)=YBGW
+      DBOX(3,4)=YBGW+SHB3
+      TEMP=YBGA(3)-WNLL(3)-DBOX(3,4)
+      IF (TEMP.GE.0.) GO TO 133
+      WNLL(3)=WNLL(3)+TEMP
+      WNLR(3)=WNLR(3)-TEMP
+  133 TEMP=YBGA(4)-WNLR(4)-DBOX(3,4)
+      IF (TEMP.GE.0.) GO TO 134
+      WNLL(4)=WNLL(4)-TEMP
+      WNLR(4)=WNLR(4)+TEMP
+C
+C Box 4 - above the curve window.
+C
+  134 IF (DBOX(4,3).LT.1.) GO TO 906
+      DBOX(4,3)=AMAX1(1.,YBGA(3)+WNLR(3),YBGA(4)+WNLL(4))
+      DBOX(4,4)=DBOX(4,3)+DHB4
+      IF (DBOX(4,4).GT.YTGW) DBOX(4,4)=AMAX1(DBOX(4,3)+SHB4,YTGW)
+      IF (DBOX(4,4).LE.YTGW) GO TO 136
+      DBOX(4,3)=YTGW-SHB4
+      DBOX(4,4)=YTGW
+      TEMP=YBGA(3)+WNLR(3)-DBOX(4,3)
+      IF (TEMP.LE.0.) GO TO 135
+      WNLL(3)=WNLL(3)+TEMP
+      WNLR(3)=WNLR(3)-TEMP
+  135 TEMP=YBGA(4)+WNLL(4)-DBOX(4,3)
+      IF (TEMP.LE.0.) GO TO 136
+      WNLL(4)=WNLL(4)-TEMP
+      WNLR(4)=WNLR(4)+TEMP
+C
+C Box 5 - the curve window itself.
+C
+  136 IF (DBOX(5,1).LT.0..OR.DBOX(5,2).GT.1..OR.
+     +                     DBOX(5,3).LT.0..OR.DBOX(5,4).GT.1.) GO TO 907
+C
+      DBOX(5,1)=AMAX1(XLGW,XBGA(1)+WNLR(1))
+      DBOX(5,2)=AMIN1(XRGW,XBGA(2)-WNLR(2))
+      DBOX(5,3)=AMAX1(YBGW,YBGA(3)+WNLR(3))
+      DBOX(5,4)=AMIN1(YTGW,YBGA(4)-WNLR(4))
+C
+C Do a final check on all boxes for labels running outside the graph
+C window.
+C
+           DO 137 NBOX=1,6
+           DBOX(NBOX,1)=AMAX1(XLGW,DBOX(NBOX,1))
+           DBOX(NBOX,2)=AMIN1(XRGW,DBOX(NBOX,2))
+           DBOX(NBOX,3)=AMAX1(YBGW,DBOX(NBOX,3))
+           DBOX(NBOX,4)=AMIN1(YTGW,DBOX(NBOX,4))
+  137      CONTINUE
+C
+C Do a "SET" call for the user and return.
+C
+  138 CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,
+     +                            1+IABS(IFIX(QLUX))*2+IABS(IFIX(QLUY)))
+C
+      RETURN
+C
+C Error exits.
+C
+  901 CALL SETER ('AGSTUP - GRAPH WINDOW IMPROPERLY SPECIFIED',20,2)
+C
+  902 CALL SETER ('AGSTUP - GRID WINDOW IMPROPERLY SPECIFIED',21,2)
+C
+  903 CALL SETER ('AGSTUP - LEFT LABELS IMPROPERLY SPECIFIED',22,2)
+C
+  904 CALL SETER ('AGSTUP - RIGHT LABELS IMPROPERLY SPECIFIED',23,2)
+C
+  905 CALL SETER ('AGSTUP - BOTTOM LABELS IMPROPERLY SPECIFIED',24,2)
+C
+  906 CALL SETER ('AGSTUP - TOP LABELS IMPROPERLY SPECIFIED',25,2)
+C
+  907 CALL SETER ('AGSTUP - INTERIOR LABELS IMPROPERLY SPECIFIED',26,2)
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/agutol.f b/sys/gio/ncarutil/autograph/agutol.f
new file mode 100644
index 00000000..02dbf64c
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agutol.f
@@ -0,0 +1,49 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE AGUTOL (IAXS,FUNS,IDMA,VINP,VOTP)
+C
+C This routine is called to perform the mapping from the "user system"
+C along an axis to the "label system" along that axis or vice-versa.  It
+C may be replaced by the user in order to create a desired graph.  The
+C arguments are as follows:
+C
+C -- IAXS is the index of the axis being drawn.  Its value is 1, 2, 3,
+C    or 4, implying the left, right, bottom, or top axis, respectively.
+C
+C -- FUNS is the value of the parameter 'AXIS/s/FUNCTION.', which may be
+C    used to select the desired mapping function for axis IAXS.  It is
+C    recommended that the default value (zero) be used to specify the
+C    identity mapping.  A non-zero value may be integral (1., 2., etc.)
+C    and serve purely to select the code to be executed or it may be the
+C    value of a real parameter in the equations defining the mapping.
+C
+C -- IDMA specifies the direction of the mapping.  A value greater than
+C    zero indicates that VINP is a value in the user system and that
+C    VOTP is to be a value in the label system, a value less than zero
+C    the opposite.
+C
+C -- VINP is an input value in one coordinate system along the axis.
+C
+C -- VOTP is an output value in the other coordinate system along the
+C    axis.
+C
+C The default routine simply defines the identity mapping for all axes.
+C
+      VOTP=VINP
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/anotat.f b/sys/gio/ncarutil/autograph/anotat.f
new file mode 100644
index 00000000..ed46025b
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/anotat.f
@@ -0,0 +1,63 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE ANOTAT (LABX,LABY,LBAC,LSET,NDSH,DSHL)
+C
+      CHARACTER*(*) LABX,LABY,DSHL(*)
+C
+C The routine ANOTAT resets background annotation.
+C
+C Declare the type of the dash-pattern-parameter-name generator.
+C
+      CHARACTER*16 AGDSHN
+C
+C Set up the x-axis label.
+C
+      IF (ICHAR(LABX(1:1)).NE.0) THEN
+        CALL AGSETC ('LABE/NAME.', 'B')
+        CALL AGSETI ('LINE/NUMB.',-100)
+        CALL AGSETC ('LINE/TEXT.',LABX)
+      END IF
+C
+C Set up the y-axis label.
+C
+      IF (ICHAR(LABY(1:1)).NE.0) THEN
+        CALL AGSETC ('LABE/NAME.', 'L')
+        CALL AGSETI ('LINE/NUMB.', 100)
+        CALL AGSETC ('LINE/TEXT.',LABY)
+      END IF
+C
+C Set up the background the user wants.
+C
+      IF (LBAC.GT.0) CALL AGSETI ('BACK.',LBAC)
+C
+C Set the parameter ISET.
+C
+      IF (LSET.NE.0) CALL AGSETI ('SET .',LSET)
+C
+C Set up the dash patterns the user wants.
+C
+      IF (NDSH.NE.0) THEN
+        IDSH=MIN0(26,NDSH)
+        CALL AGSETI ('DASH/SELE.',IDSH)
+        IF (IDSH.LT.0) RETURN
+        DO 101 I=1,IDSH
+          CALL AGSETC (AGDSHN(I),DSHL(I))
+  101   CONTINUE
+      END IF
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/displa.f b/sys/gio/ncarutil/autograph/displa.f
new file mode 100644
index 00000000..0749b29b
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/displa.f
@@ -0,0 +1,33 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE DISPLA (LFRA,LROW,LTYP)
+C
+C The subroutine DISPLA resets the parameters IFRA, IROW, and/or LLUX
+C and LLUY.
+C
+      IF (LFRA.NE.0) CALL AGSETI ('FRAM.', MAX0(1,MIN0(3,LFRA)))
+C
+      IF (LROW.NE.0) CALL AGSETI ('ROW .',LROW)
+C
+      IF (LTYP.EQ.0) RETURN
+C
+      ITYP=MAX0(1,MIN0(4,LTYP))
+      CALL AGSETI ('X/LOGA.',   (1-ITYP)/2)
+      CALL AGSETI ('Y/LOGA.',MOD(1-ITYP,2))
+C
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/ezmxy.f b/sys/gio/ncarutil/autograph/ezmxy.f
new file mode 100644
index 00000000..bc8f6352
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/ezmxy.f
@@ -0,0 +1,67 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE EZMXY (XDRA,YDRA,IDXY,MANY,NPTS,LABG)
+C
+      REAL XDRA(*),YDRA(*)
+C
+      CHARACTER*(*) LABG
+C
+C The routine EZMXY draws many curves, each of them defined by points of
+C the form (XDRA(I,J),YDRA(I,J)) or (XDRA(J,I),YDRA(J,I)) or, possibly,
+C (XDRA(I),YDRA(I,J)) or (XDRA(I),YDRA(J,I)), for I = 1, 2, ... NPTS and
+C for J = 1, 2, ... MANY.  (YDRA is actually dimensioned IDXY by * .)
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','EZMXY','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C 
+C -NOAO
+      CALL AGGETI ('SET .',ISET)
+      CALL AGGETI ('FRAM.',IFRA)
+      CALL AGGETI ('DASH/SELE.',IDSH)
+C
+      CALL AGEZSU (4,XDRA,YDRA,IDXY,MANY,NPTS,LABG,IIVX,IIEX,IIVY,IIEY)
+      CALL AGBACK
+C
+      IF (ISET.LT.0) GO TO 102
+C
+           DO 101 I=1,MANY
+           INXD=1+(I-1)*IIVX
+           INYD=1+(I-1)*IIVY
+           KDSH=ISIGN(I,IDSH)
+           CALL AGCURV (XDRA(INXD),IIEX,YDRA(INYD),IIEY,NPTS,KDSH)
+  101      CONTINUE
+C
+  102 IF (IFRA.EQ.1) CALL FRAME
+C
+C +NOAO
+C
+      call initag
+C
+C -NOAO
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/ezmy.f b/sys/gio/ncarutil/autograph/ezmy.f
new file mode 100644
index 00000000..e406465b
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/ezmy.f
@@ -0,0 +1,65 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE EZMY (YDRA,IDXY,MANY,NPTS,LABG)
+C
+      REAL XDRA(1),YDRA(*)
+C
+      CHARACTER*(*) LABG
+C
+C The routine EZMY draws many curves, each of them defined by points of
+C the form (I,YDRA(I,J)) or (I,YDRA(J,I)), for I = 1, 2, ... NPTS and
+C for J = 1, 2, ... MANY.  (YDRA is actually dimensioned IDXY by * .)
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','EZMY','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C
+C -NOAO
+      CALL AGGETI ('SET .',ISET)
+      CALL AGGETI ('FRAM.',IFRA)
+      CALL AGGETI ('DASH/SELE.',IDSH)
+C
+      CALL AGEZSU (3,XDRA,YDRA,IDXY,MANY,NPTS,LABG,IIVX,IIEX,IIVY,IIEY)
+      CALL AGBACK
+C
+      IF (ISET.LT.0) GO TO 102
+C
+           DO 101 I=1,MANY
+           INYD=1+(I-1)*IIVY
+           KDSH=ISIGN(I,IDSH)
+           CALL AGCURV (XDRA,0,YDRA(INYD),IIEY,NPTS,KDSH)
+  101      CONTINUE
+C
+  102 IF (IFRA.EQ.1) CALL FRAME
+C
+C +NOAO
+C
+      call initag
+C
+C -NOAO
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/ezxy.f b/sys/gio/ncarutil/autograph/ezxy.f
new file mode 100644
index 00000000..e6ef3b5e
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/ezxy.f
@@ -0,0 +1,57 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE EZXY (XDRA,YDRA,NPTS,LABG)
+C
+      REAL XDRA(*),YDRA(*)
+C
+      CHARACTER*(*) LABG
+C
+C The routine EZXY draws one curve through the points (XDRA(I),YDRA(I)),
+C for I = 1, 2, ... NPTS.
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','EZXY','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C
+C -NOAO
+      CALL AGGETI ('SET .',ISET)
+      CALL AGGETI ('FRAM.',IFRA)
+C
+      CALL AGEZSU (2,XDRA,YDRA,NPTS,1,NPTS,LABG,IIVX,IIEX,IIVY,IIEY)
+      CALL AGBACK
+C
+      IF (ISET.GE.0) CALL AGCURV (XDRA,1,YDRA,1,NPTS,1)
+C
+      IF (IFRA.EQ.1) CALL FRAME
+C
+C +NOAO
+C
+      call initag
+C
+C -NOAO
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/ezy.f b/sys/gio/ncarutil/autograph/ezy.f
new file mode 100644
index 00000000..3be54a03
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/ezy.f
@@ -0,0 +1,57 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE EZY (YDRA,NPTS,LABG)
+C
+      REAL XDRA(1),YDRA(*)
+C
+      CHARACTER*(*) LABG
+C
+C The subroutine EZY draws one curve through the points (I,YDRA(I)), for
+C I = 1, 2, ... NPTS.
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','EZY','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C
+C -NOAO
+      CALL AGGETI ('SET .',ISET)
+      CALL AGGETI ('FRAM.',IFRA)
+C
+      CALL AGEZSU (1,XDRA,YDRA,NPTS,1,NPTS,LABG,IIVX,IIEX,IIVY,IIEY)
+      CALL AGBACK
+C
+      IF (ISET.GE.0) CALL AGCURV (XDRA,0,YDRA,1,NPTS,1)
+C
+      IF (IFRA.EQ.1) CALL FRAME
+C
+C +NOAO
+C
+      call initag
+C
+C -NOAO
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/autograph/idiot.f b/sys/gio/ncarutil/autograph/idiot.f
new file mode 100644
index 00000000..0e2ce5e5
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/idiot.f
@@ -0,0 +1,64 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C ---------------------------------------------------------------------
+C
+      SUBROUTINE IDIOT (XDRA,YDRA,NPTS,LTYP,LDSH,LABX,LABY,LABG,LFRA)
+C
+      REAL XDRA(*),YDRA(*)
+C
+      INTEGER LDSH(*)
+C
+      CHARACTER*(*) LABX,LABY,LABG
+C
+      CHARACTER*16 AGBNCH
+C
+C This is an implementation of the routine from which AUTOGRAPH grew.
+C It should work pretty much as the original did (if you can figure out
+C what that was).
+C
+C Do statistics-gathering call.
+C
+      LOGICAL Q8Q4
+      SAVE Q8Q4
+      DATA Q8Q4 /.TRUE./
+      IF (Q8Q4) THEN
+        CALL Q8QST4('GRAPHX','AUTOGRAPH','IDIOT','VERSION 07')
+        Q8Q4 = .FALSE.
+      ENDIF
+C
+C +NOAO
+C
+      call agdflt
+C 
+C -NOAO
+      CALL ANOTAT (LABX,LABY,1,2-ISIGN(1,NPTS),1,AGBNCH(LDSH))
+C
+      CALL DISPLA (2-MAX0(-1,MIN0(1,LFRA)),1,LTYP)
+C
+      CALL AGEZSU (5,XDRA,YDRA,IABS(NPTS),1,IABS(NPTS),LABG,IIVX,IIEX,
+     +                                                        IIVY,IIEY)
+      CALL AGBACK
+C
+      CALL AGCURV (XDRA,1,YDRA,1,IABS(NPTS),1)
+C
+      IF (LFRA.GT.0) CALL FRAME
+C
+C +NOAO
+C
+      call plotit (0, 0, 2)
+      call initut
+C
+C -NOAO
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/autograph/mkpkg b/sys/gio/ncarutil/autograph/mkpkg
new file mode 100644
index 00000000..8af0a0d4
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/mkpkg
@@ -0,0 +1,62 @@
+# Make the NCAR AUTOGRAPH library.
+
+$checkout libncar.a lib$
+$update   libncar.a
+$checkin  libncar.a lib$
+$exit
+
+libncar.a:
+	agdflt.f  
+	agaxis.f
+	agback.f
+	agbnch.f
+	agchax.f
+	agchcu.f
+	agchil.f
+	agchnl.f
+	agctcs.f
+	agctko.f
+	agcurv.f
+	agdash.f
+	agdlch.f
+	agdshn.f
+	agexax.f
+	agexus.f
+	agezsu.f
+	agfpbn.f
+	agftol.f
+	aggetc.f
+	aggetf.f
+	aggeti.f
+	aggetp.f
+	aggtch.f
+	aginit.f
+	agkurv.f
+	aglbls.f
+	agmaxi.f
+	agmini.f
+	agnumb.f
+	agppid.f
+	agpwrt.f
+	agqurv.f
+	agrpch.f
+	agrstr.f
+	agsave.f
+	agscan.f
+	agsetc.f
+	agsetf.f
+	agseti.f
+	agsetp.f
+	agsrch.f
+	agstch.f
+	agstup.f
+	agutol.f
+	anotat.f
+	displa.f
+	ezmxy.f
+	ezmy.f
+	ezxy.f
+	ezy.f
+	idiot.f
+	pstr.x
+	;
diff --git a/sys/gio/ncarutil/autograph/pstr.x b/sys/gio/ncarutil/autograph/pstr.x
new file mode 100644
index 00000000..a40c9fc1
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/pstr.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PSTR -- Print a character string from a fortran program.  The string is
+# passed as an unpacked spp string, the result of f77upk in the calling
+# program.  PSTR is called by agppid.f in the autograph package.
+
+procedure pstr (spp_string)
+
+char 	spp_string[ARB]
+
+begin
+	call eprintf ("%s\n")
+	    call pargstr (spp_string)
+end
diff --git a/sys/gio/ncarutil/conbd.f b/sys/gio/ncarutil/conbd.f
new file mode 100644
index 00000000..eaaf2df5
--- /dev/null
+++ b/sys/gio/ncarutil/conbd.f
@@ -0,0 +1,111 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C     BLOCKDATA CONBD
+      subroutine conbd
+      integer first, temp
+      common /conflg/ first
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+      COMMON /CONRE2/ IX         ,IY         ,IDX  ,IDY ,
+     1                IS         ,ISS        ,NP         ,CV ,
+     2                INX(8)     ,INY(8)     ,IR(80000)    ,NR
+c +noao: dimension of stline ir array increased from 20000 to 80000 6-93
+      COMMON /CONRE4/ ISIZEL     ,ISIZEM     ,ISIZEP     ,NREP,
+     1                NCRT       ,ILAB       ,NULBLL     ,IOFFD,
+     2                EXT        ,IOFFM      ,ISOLID     ,NLA,
+     3                NLM        ,XLT        ,YBT        ,SIDE
+      COMMON /RECINT/ IRECMJ     ,IRECMN          ,IRECTX
+C
+      SAVE
+C
+C     DATA IOFFP,SPVAL/0,0.0/
+      data temp /1/
+      first = temp
+      IOFFP  = 0
+      SPVAL  = 0.0
+C     DATA ISIZEL,ISIZEM,ISIZEP,NLA,NLM,XLT,YBT,SIDE,ISOLID,NREP,NCRT/
+C    1       1,  2,   0, 16, 40,.05,.05,  .9,  1023,   6,   4 /
+      if (first .ne. 1) then
+        return
+      endif
+
+      temp = 0
+
+c     ISIZEL = 1
+c noao: size of contour labels seemed too large.  Changed from 1 to 0
+      isizel = 0
+      ISIZEM = 2
+      ISIZEP = 0
+      NLA    = 16
+      NLM    = 40
+      XLT    = .05
+      YBT    = .05
+      SIDE   = .9
+      ISOLID = 1023
+      NREP   = 4
+      NCRT   = 2 
+C     DATA EXT,IOFFD,NULBLL,IOFFM,ILAB/.25,0,3,0,1/
+C +noao value of "extreme" axes ratios changed from 1/4 to 1/16 (ShJ 6-10-88)
+C     EXT    = .25
+      EXT    = .0625
+C -noao
+      IOFFD  = 0
+      NULBLL = 3
+      IOFFM  = 0
+      ILAB   = 1
+C     DATA INX(1),INX(2),INX(3),INX(4),INX(5),INX(6),INX(7),INX(8)/
+C    1        -1 ,   -1 ,    0 ,    1 ,    1 ,          1 ,      0 ,   -1 /
+      INX(1) = -1 
+      INX(2) = -1
+      INX(3) = 0 
+      INX(4) = 1 
+      INX(5) = 1 
+      INX(6) = 1
+      INX(7) = 0
+      INX(8) = -1
+C     DATA INY(1),INY(2),INY(3),INY(4),INY(5),INY(6),INY(7),INY(8)/
+C    1         0 ,    1 ,    1 ,    1 ,    0 ,   -1 ,   -1 ,   -1 /
+      INY(1) = 0 
+      INY(2) = 1
+      INY(3) = 1
+      INY(4) = 1 
+      INY(5) = 0
+      INY(6) = -1
+      INY(7) = -1
+      INY(8) = -1
+C     DATA NR/500/
+c +noao: dimension of stline array increased from 500 to 5000 6March87
+c +noao: dimension of stline array increased from 5000 to 20000 Jan90
+c +noao: dimension of stline array increased from 20000 to 80000 6-93
+      NR     = 80000
+C     DATA IRECMJ,IRECMN,IRECTX/ 1 ,   1 ,   1/
+c +noao: value of irecmj changed so major divisions are high intensity
+      IRECMJ = 2 
+      IRECMN = 1
+      IRECTX = 1
+C
+C - noao
+C
+C REVISION HISTORY---
+C
+C JANUARY 1980     ADDED REVISION HISTORY AND CHANGED LIBRARY NAME
+C                  FROM CRAYLIB TO PORTLIB FOR MOVE TO PORTLIB
+C
+C MAY 1980         ARRAYS IWORK AND ENCSCR, PREVIOUSLY TOO SHORT FOR
+C                  SHORT-WORD-LENGTH MACHINES, LENGTHENED.  SOME
+C                  DOCUMENTATION CLARIFIED AND CORRECTED.
+C
+C JUNE 1984        CONVERTED TO FORTRAN 77 AND TO GKS
+C-------------------------------------------------------------------
+C
+      END
diff --git a/sys/gio/ncarutil/conbdn.f b/sys/gio/ncarutil/conbdn.f
new file mode 100644
index 00000000..cd7ca00d
--- /dev/null
+++ b/sys/gio/ncarutil/conbdn.f
@@ -0,0 +1,342 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data conbdn changed to run time initialization
+c     BLOCKDATA CONBDN
+      subroutine conbdn
+C
+C
+C
+C COMMON DATA
+C
+C NOTE THE COMMON BLOCKS LISTED INCLUDE ALL THE COMMON USED BY
+C      THE ENTIRE CONRAN FAMILY, NOT ALL MEMBERS WILL USE ALL
+C      THE COMMON DATA.
+C
+C   CONRA1
+C       CL-ARRAY OF CONTOUR LEVELS
+C       NCL-NUMBER OF CONTOUR LEVELS
+C       OLDZ-Z VALUE OF LEFT NEIGHBOR TO CURRENT LOCATION
+C       PV-ARRAY OF PREVIOUS ROW VALUES
+C       HI-LARGEST CONTOUR PLOTTED
+C       FLO-LOWEST CONTOUR PLOTTED
+C       FINC-INCREMENT LEVEL BETWEEN EQUALLY SPACED CONTOURS
+C   CONRA2
+C       REPEAT-FLAG TO TRIANGULATE AND DRAW OR JUST DRAW
+C       EXTRAP-PLOT DATA OUTSIDE OF CONVEX DATA HULL
+C       PER-PUT PERIMETER ARROUND PLOT
+C       MESS-FLAG TO INDICATE MESSAGE OUTPUT
+C       ISCALE-SCALING SWITCH
+C       LOOK-PLOT TRIANGLES FLAG
+C       PLDVLS-PLOT THE DATA VALUES FLAG
+C       GRD-PLOT GRID FLAG
+C       CON-USER SET OR PROGRAM SET CONTOURS FLAG
+C       CINC-USER OR PROGRAM SET INCREMENT FLAG
+C       CHILO-USER OR PROGRAM SET HI LOW CONTOURS
+C       LABON-FLAG TO CONTROL LABELING OF CONTOURS
+C       PMIMX-FLAG TO CONTROL THE PLOTTING OF MIN"S
+C               AND MAX"S
+C       SCALE-THE SCALE FACTOR FOR CONTOUR LINE VALUES
+C               AND MIN ,       MAX PLOTTED VALUES
+C       FRADV-ADVANCE FRAME BEFORE PLOTTING TRIANGUALTION
+C       EXTRI-ONLY PLOT TRIANGULATION
+C       BPSIZ-BREAKPOINT SIZE FOR DASHPATTERNS
+C       LISTOP-LIST OPTIONS ON UNIT6 FLAG
+C   CONRA3
+C       IREC-PORT RECOVERABLE ERROR FLAG
+C   CONRA4
+C       NCP-NUMBER OF DATA POINTS USED AT EACH POINT FOR
+C           POLYNOMIAL CONSTRUCTION.
+C       NCPSZ-MAX SIZE ALLOWED FOR NCP
+C   CONRA5
+C       NIT-FLAG TO INDICATE STATUS OF SEARCH DATA BASE
+C       ITIPV-LAST TRIANGLE INTERPOLATION OCCURRED IN
+C  CONRA6
+C       XST-X COORDINATE START POINT FOR CONTOURING
+C       YST-Y COORDINATE START POINT FOR CONTOURING
+C       XED-X COORDINATE END POINT FOR CONTOURING
+C       YED-Y COORDINATE END POINT FOR CONTOURING
+C       STPSZ-STEP SIZE FOR X,Y CHANGE WHEN CONTOURING
+C       IGRAD-NUMBER OF GRADUATIONS FOR CONTOURING(STEP SIZE)
+C       IG-RESET VALUE FOR IGRAD
+C       XRG-X RANGE OF COORDINATES
+C       YRG-Y RANGE OF COORDINATES
+C       BORD-PERCENT OF FRAME USED FOR CONTOUR PLOT
+C       PXST-X PLOTTER START ADDRESS FOR CONTOURS
+C       PYST-Y PLOTTER START ADDRESS FOR CONTOURS
+C       PXED-X PLOTTER END ADDRESS FOR CONTOURS
+C       PYED-Y PLOTTER END ADDRESS FOR CONTOURS
+C       ITICK-NUMBER OF TICK MARKS FOR GRIDS AND PERIMETERS
+C CONRA7
+C       TITLE-SWITCH TO INDICATE IF TITLE OPTION ON OR OFF
+C       ISTRNG-CHARACTER STRING OF TITLE
+C       ICNT-CHARACTER COUNT OF ISTRNG
+C       ITLSIZ-SIZE OF TITLE IN PWRIT UNITS
+C CONRA8
+C       IHIGH-DEFAULT COLOR (INTENSITY) INDEX SETTING
+C       INMAJ-CONTOUR LEVEL COLOR (INTENSITY) INDEX FOR MAJOR LINES
+C       INMIN-CONTOUR LEVEL COLOR (INTENSITY) INDEX FOR MINOR LINES
+C       INLAB-TITLE AND MESSAGE COLOR (INTENSITY) INDEX
+C       INDAT-DATA VALUE COLOR (INTENSITY) INDEX
+C       FORM-THE FORMAT FOR PLOTTING THE DATA VALUES
+C       LEN-THE NUMBER OF CHARACTERS IN THE FORMAT
+C       IFMT-SIZE OF THE FORMAT FIELD
+C       LEND-DEFAULT FORMAT LENGTH
+C       IFMTD-DEFAULT FORMAT FIELD SIZE
+C       ISIZEP-SIZE OF THE PLOTTED DATA VALUES
+C  CONRA9
+C       X-ARRAY OF X COORDINATES OF CONTOURS DRAWN AT CURRENT CONTOUR
+C          LEVEL
+C       Y-ARRAY OF Y COORDINATES OF CONTOURS DRAWN AT CURRENT CONTOUR
+C          LEVEL
+C       NP-COUNT IN X AND Y
+C       MXXY-SIZE OF X AND Y
+C       TR-TOP RIGHT CORNER VALUE OF CURRENT CELL
+C       BR-BOTTOM RIGHT CORNER VALUE OF CURRENT CELL
+C       TL-TOP LEFT CORNER VALUE OF CURRENT CELL
+C       BL-BOTTOM LEFT CORNER VALUE OF CURRENT CELL
+C       CONV-CURRENT CONTOUR VALUE
+C       XN-X POSITION WHERE CONTOUR IS BEING DRAWN
+C       YN-Y POSITION WHERE CONTOUR IS BEING DRAWN
+C       ITLL-TRIANGLE WHERE TOP LEFT CORNER OF CURRENT CELL LIES
+C       IBLL-TRIANGLE OF BOTTOM LEFT CORNER
+C       ITRL-TRIANGLE OF TOP RIGHT CORNER
+C       IBRL-TRIANGLE OF BOTTOM LEFT CORNER
+C       XC-X COORDINATE OF CURRENT CELL
+C       YC-Y CORRDINATE OF CURRENT CELL
+C       ITLOC-IN CONJUNCTION WITH PV STORES THE TRIANGLE WHERE PV
+C               VALUE CAME FROM
+C CONR10
+C       NT-NUMBER OF TRIANGLES GENERATED
+C       NL-NUMBER OF LINE SEGMENTS
+C       NTNL-NT+NL
+C       JWIPT-POINTER INTO IWK WHERE WHERE TRIANGLE POINT NUMBERS
+C               ARE STORED
+C       JWIWL-IN IWK THE LOCATION OF A SCRATCH SPACE
+C       JWIWP-IN IWK THE LOCATION OF A SCRATCH SPACE
+C       JWIPL-IN IWK THE LOCATION OF END POINTS FOR BORDER LINE
+C               SEGMENTS
+C       IPR-IN WK THE LOCATION OF THE PARTIAL DERIVITIVES AT EACH
+C           DATA POINT
+C       ITPV-THE TRIANGLE WHERE THE PREVIOUS VALUE CAME FROM
+C CONR11
+C       NREP-NUMBER OF REPETITIONS OF DASH PATTERN BEFORE A LABEL
+C       NCRT-NUMBER OF CRT UNITS FOR A DASH MARK OR BLANK
+C       ISIZEL-SIZE OF CONTOUR LINE LABELS
+C       NDASH-ARRAY CONTAINING THE NEGATIVE VALUED CONTOUR DASH
+C               PATTERN
+C       MINGAP-NUMBER OF UNLABELED LINES BETWEEN EACH LABELED ONE
+C       IDASH-POSITIVE VALUED CONTOUR DASH PATTERN
+C       ISIZEM-SIZE OF PLOTTED MINIMUMS AND MAXIMUMS
+C       EDASH-EQUAL VALUED CONTOUR DASH PATTERN
+C       TENS-DEFAULT TENSION SETTING FOR SMOOTHING
+C CONR12
+C       IXMAX,IYMAX-MAXINUM X AND Y COORDINATES RELATIVE TO THE
+C                 SCRATCH ARRAY, SCRARR
+C       XMAX,YMAX-MAXIMUM X AND Y COORDINATES RELATIVE TO USERS
+C                 COORDINATE SPACE
+C CONR13
+C       XVS-ARRAY OF THE X COORD FOR SHIELDING
+C       YVS-ARRAY OF THE Y COORD FOR SHIELDING
+C       IXVST-POINTER (VIA LOC) TO THE USERS X ARRAY FOR SHIELDING
+C       IYVST-POINTER (VIA LOC) TO THE USERS Y ARRAY FOR SHIELDING
+C       ICOUNT-COUNT OF THE SHIELD ELEMENTS
+C       SPVAL-SPECIAL VALUE USED TO HALT CONTOURING AT THE SHIELD
+C               BOUNDRY
+C       SHIELD-LOGICAL FLAG TO SIGNAL STATUS OF SHIELDING
+C       SLDPLT-LOGICAL FLAG TO INDICTE STATUS OF SHIEDL PLOTTING
+C CONR14
+C       LINEAR-C1 LINAER INTERPOLATIN FLAG
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ    ,PV(210),
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER   ,MESS,
+     1                ISCALE     ,LOOK           ,PLDVLS  ,GRD,
+     2                CINC       ,CHILO         ,CON     ,LABON,
+     3                PMIMX      ,SCALE          ,FRADV  ,EXTRI,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED,
+     1                STPSZ      ,IGRAD          ,IG     ,XRG,
+     2                YRG        ,BORD       ,PXST       ,PYST,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ          ,INLAB  ,INDAT,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP         ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP              ,MXXY  ,TR,
+     1                BR         ,TL               ,BL   ,CONV,
+     2                XN         ,YN               ,ITLL      ,IBLL,
+     3                ITRL       ,IBRL       ,XC         ,YC,
+     4                ITLOC(210) ,JX              ,JY    ,ILOC ,
+     5                ISHFCT     ,XO         ,YO         ,IOC    ,NC
+      COMMON /CONR10/ NT         ,NL               ,NTNL       ,JWIPT,
+     1                JWIWL      ,JWIWP          ,JWIPL  ,IPR  ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX          ,XMAX   ,YMAX
+      LOGICAL         REPEAT       ,EXTRAP      ,PER     ,MESS,
+     1                LOOK       ,PLDVLS        ,GRD     ,LABON,
+     2                PMIMX      ,FRADV          ,EXTRI  ,CINC,
+     3                TITLE      ,LISTOP         ,CHILO  ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      logical first
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+        COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
+C
+        SAVE
+C
+C
+c +noao:  parameter added to avoid clobbering initialization done
+c by conop[1-4].  
+        data first /.true./
+        if (.not. first) return
+        first = .false.
+c -noao
+C
+c       DATA ICOUNT,SHIELD,SLDPLT,LINEAR/0,.FALSE.,.FALSE.,.FALSE./
+        ICOUNT = 0
+        SHIELD = .FALSE.
+        SLDPLT = .FALSE.
+        LINEAR = .FALSE.
+c
+c       DATA REPEAT,EXTRAP,PER/.FALSE.,.FALSE.,.TRUE./
+        REPEAT = .FALSE.
+        EXTRAP = .FALSE.
+        PER = .TRUE.
+c
+c       DATA FRADV,EXTRI,BPSIZ/.TRUE.,.FALSE.,0.0/
+        FRADV = .TRUE.
+        EXTRI = .FALSE.
+        BPSIZ = 0.0
+c
+c       DATA TITLE,MESS,LOOK/.FALSE.,.TRUE.,.FALSE./
+        TITLE = .FALSE.
+        MESS  = .TRUE.
+        LOOK  = .FALSE.
+c
+c       DATA PLDVLS,GRD/.FALSE.,.FALSE./
+        PLDVLS = .FALSE.
+        GRD     = .FALSE.
+c
+c       DATA CON,CINC,CHILO/.FALSE.,.FALSE.,.FALSE./
+        CON   = .FALSE.
+        CINC  = .FALSE.
+        CHILO = .FALSE.
+c
+c       DATA SCALE,PMIMX/1.,.FALSE./
+        SCALE = 1.
+        PMIMX = .FALSE.
+c
+c       DATA ISIZEP,ISIZEM,TENS/8,15,2.5/
+        ISIZEP = 8
+        ISIZEM = 15
+        TENS    = 2.5
+c
+c       DATA INMAJ,INMIN,INLAB,INDAT/1, 1, 1, 1/
+        INMAJ = 2
+        INMIN = 1
+        INLAB = 2
+        INDAT = 1
+c
+c       DATA IRANMJ, IRANMN, IRANTX /1, 1, 1/
+        IRANMJ = 2
+        IRANMN = 1
+        IRANTX = 1
+c
+c       DATA IRASMJ, IRASMN, IRASTX /1, 1, 1/
+        IRASMJ = 2
+        IRASMN = 1
+        IRASTX = 1
+c
+c       DATA IRAQMJ, IRAQMN, IRAQTX /1, 1, 1/
+        IRAQMJ = 2
+        IRAQMN = 1
+        IRAQTX = 1
+c
+c       DATA LABON/.TRUE./,LISTOP/.FALSE./
+        LABON   = .TRUE.
+        LISTOP = .FALSE.
+c
+c       DATA BORD,ITICK/.9,10/
+        BORD  = .9
+        ITICK = 10
+c
+c       DATA ISCALE,ITLSIZ/0,16/
+        ISCALE = 0
+        ITLSIZ = 16
+c
+c       DATA ITIPV,NIT,NCL/0,0,0/
+        ITIPV = 0
+        NIT   = 0
+        NCL   = 0
+c
+c       DATA NCPSZ/25/
+        NCPSZ = 25
+c
+c       DATA IHIGH/255/
+        IHIGH = 255
+c
+c       DATA NCP /4/
+        NCP  = 4
+c
+c       DATA IREC /1/
+        IREC  = 1
+c
+c       DATA LEN,IFMT,LEND,IFMTD/0,0,7,10/
+        LEN = 0
+        IFMT = 0
+        LEND = 7
+        IFMTD = 10
+c
+c       DATA IGRAD,IG/40,40/
+        IGRAD = 40
+        IG    = 40
+c
+c       DATA NREP,NCRT,ISIZEL,MXXY,MINGAP/6,3,9,500,3/
+        NREP = 6
+        NCRT = 3
+        ISIZEL = 9
+        MXXY = 500
+        MINGAP = 3
+c
+c       DATA IDASH(1:1)/' '/
+        IDASH(1:1) = ' '
+c
+c       DATA NDASH(1:1)/' '/
+        NDASH(1:1) = ' '
+c
+c       DATA EDASH(1:1)/' '/
+        EDASH(1:1) = ' '
+c
+c       DATA ISHFCT/9/
+        ISHFCT = 9
+c
+c - noao
+      END
diff --git a/sys/gio/ncarutil/conlib/README b/sys/gio/ncarutil/conlib/README
new file mode 100644
index 00000000..69f73877
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/README
@@ -0,0 +1,3 @@
+CONLIB -- This directory contains the contents of the NCAR files concom.f and
+conterp.f, unpacked one subroutine per file.  The unpacking operation is
+necessary to permit topological ordering of the library.
diff --git a/sys/gio/ncarutil/conlib/concal.f b/sys/gio/ncarutil/conlib/concal.f
new file mode 100644
index 00000000..e021fa30
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/concal.f
@@ -0,0 +1,340 @@
+      SUBROUTINE CONCAL (XD,YD,ZD,NT,IPT,NL,IPL,PDD,ITI,XII,YII,ZII,
+     1                   ITPV)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS SUBROUTINE PERFORMS PUNCTUAL INTERPOLATION OR EXTRAPO-
+C LATION, I.E., DETERMINES THE Z VALUE AT A POINT.
+C THE INPUT PARAMETERS ARE
+C
+C     XD,YD,ZD = ARRAYS CONTAINING THE X, Y, AND Z
+C                COORDINATES OF DATA POINTS,
+C     NT  = NUMBER OF TRIANGLES,
+C     IPT = INTEGER ARRAY CONTAINING THE POINT NUMBERS OF
+C           THE VERTEXES OF THE TRIANGLES,
+C     NL  = NUMBER OF BORDER LINE SEGMENTS,
+C     IPL = INTEGER ARRAY CONTAINING THE POINT NUMBERS OF
+C           THE END POINTS OF THE BORDER LINE SEGMENTS AND
+C           THEIR RESPECTIVE TRIANGLE NUMBERS,
+C     PDD = ARRAY CONTAINING THE PARTIAL DERIVATIVES AT
+C           THE DATA POINTS,
+C     ITI = TRIANGLE NUMBER OF THE TRIANGLE IN WHICH LIES
+C           THE POINT FOR WHICH INTERPOLATION IS TO BE
+C           PERFORMED,
+C     XII,YII = X AND Y COORDINATES OF THE POINT FOR WHICH
+C               INTERPOLATION IS TO BE PERFORMED.
+C THE OUTPUT PARAMETER IS
+C
+C     ZII = INTERPOLATED Z VALUE.
+C
+C DECLARATION STATEMENTS
+C
+C
+      DIMENSION       XD(1)      ,YD(1)      ,ZD(1)      ,IPT(1)     ,
+     1                IPL(1)     ,PDD(1)
+      DIMENSION       X(3)       ,Y(3)       ,Z(3)       ,PD(15)     ,
+     1                ZU(3)      ,ZV(3)      ,ZUU(3)     ,ZUV(3)     ,
+     2                ZVV(3)
+      REAL            LU         ,LV
+      EQUIVALENCE     (P5,P50)
+C
+        SAVE
+C
+C PRELIMINARY PROCESSING
+C
+      IT0 = ITI
+      NTL = NT+NL
+      IF (IT0 .LE. NTL) GO TO  100
+      IL1 = IT0/NTL
+      IL2 = IT0-IL1*NTL
+      IF (IL1 .EQ. IL2) GO TO  150
+      GO TO  200
+C
+C CALCULATION OF ZII BY INTERPOLATION.
+C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
+C
+  100 IF (IT0 .EQ. ITPV) GO TO  140
+C
+C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE
+C IPI 102 VERTEXES.
+C IPI 103
+C
+      JIPT = 3*(IT0-1)
+      JPD = 0
+      DO  120 I=1,3
+         JIPT = JIPT+1
+         IDP = IPT(JIPT)
+         X(I) = XD(IDP)
+         Y(I) = YD(IDP)
+         Z(I) = ZD(IDP)
+         JPDD = 5*(IDP-1)
+         DO  110 KPD=1,5
+            JPD = JPD+1
+            JPDD = JPDD+1
+            PD(JPD) = PDD(JPDD)
+  110    CONTINUE
+  120 CONTINUE
+C
+C DETERMINES THE COEFFICIENTS FOR THE COORDINATE SYSTEM
+C TRANSFORMATION FROM THE X-Y SYSTEM TO THE U-V SYSTEM
+C AND VICE VERSA.
+C
+      X0 = X(1)
+      Y0 = Y(1)
+      A = X(2)-X0
+      B = X(3)-X0
+      C = Y(2)-Y0
+      D = Y(3)-Y0
+      AD = A*D
+      BC = B*C
+      DLT = AD-BC
+      AP = D/DLT
+      BP = -B/DLT
+      CP = -C/DLT
+      DP = A/DLT
+C
+C CONVERTS THE PARTIAL DERIVATIVES AT THE VERTEXES OF THE
+C TRIANGLE FOR THE U-V COORDINATE SYSTEM.
+C
+      AA = A*A
+      ACT2 = 2.0*A*C
+      CC = C*C
+      AB = A*B
+      ADBC = AD+BC
+      CD = C*D
+      BB = B*B
+      BDT2 = 2.0*B*D
+      DD = D*D
+      DO  130 I=1,3
+         JPD = 5*I
+         ZU(I) = A*PD(JPD-4)+C*PD(JPD-3)
+         ZV(I) = B*PD(JPD-4)+D*PD(JPD-3)
+         ZUU(I) = AA*PD(JPD-2)+ACT2*PD(JPD-1)+CC*PD(JPD)
+         ZUV(I) = AB*PD(JPD-2)+ADBC*PD(JPD-1)+CD*PD(JPD)
+         ZVV(I) = BB*PD(JPD-2)+BDT2*PD(JPD-1)+DD*PD(JPD)
+  130 CONTINUE
+C
+C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL.
+C
+      P00 = Z(1)
+      P10 = ZU(1)
+      P01 = ZV(1)
+      P20 = 0.5*ZUU(1)
+      P11 = ZUV(1)
+      P02 = 0.5*ZVV(1)
+      H1 = Z(2)-P00-P10-P20
+      H2 = ZU(2)-P10-ZUU(1)
+      H3 = ZUU(2)-ZUU(1)
+      P30 = 10.0*H1-4.0*H2+0.5*H3
+      P40 = -15.0*H1+7.0*H2-H3
+      P50 = 6.0*H1-3.0*H2+0.5*H3
+      H1 = Z(3)-P00-P01-P02
+      H2 = ZV(3)-P01-ZVV(1)
+      H3 = ZVV(3)-ZVV(1)
+      P03 = 10.0*H1-4.0*H2+0.5*H3
+      P04 = -15.0*H1+7.0*H2-H3
+      P05 = 6.0*H1-3.0*H2+0.5*H3
+      LU = SQRT(AA+CC)
+      LV = SQRT(BB+DD)
+      THXU = ATAN2(C,A)
+      THUV = ATAN2(D,B)-THXU
+      CSUV = COS(THUV)
+      P41 = 5.0*LV*CSUV/LU*P50
+      P14 = 5.0*LU*CSUV/LV*P05
+      H1 = ZV(2)-P01-P11-P41
+      H2 = ZUV(2)-P11-4.0*P41
+      P21 = 3.0*H1-H2
+      P31 = -2.0*H1+H2
+      H1 = ZU(3)-P10-P11-P14
+      H2 = ZUV(3)-P11-4.0*P14
+      P12 = 3.0*H1-H2
+      P13 = -2.0*H1+H2
+      THUS = ATAN2(D-C,B-A)-THXU
+      THSV = THUV-THUS
+      AA = SIN(THSV)/LU
+      BB = -COS(THSV)/LU
+      CC = SIN(THUS)/LV
+      DD = COS(THUS)/LV
+      AC = AA*CC
+      AD = AA*DD
+      BC = BB*CC
+      G1 = AA*AC*(3.0*BC+2.0*AD)
+      G2 = CC*AC*(3.0*AD+2.0*BC)
+      H1 = -AA*AA*AA*(5.0*AA*BB*P50+(4.0*BC+AD)*P41)-
+     1     CC*CC*CC*(5.0*CC*DD*P05+(4.0*AD+BC)*P14)
+      H2 = 0.5*ZVV(2)-P02-P12
+      H3 = 0.5*ZUU(3)-P20-P21
+      P22 = (G1*H2+G2*H3-H1)/(G1+G2)
+      P32 = H2-P22
+      P23 = H3-P22
+      ITPV = IT0
+C
+C CONVERTS XII AND YII TO U-V SYSTEM.
+C
+  140 DX = XII-X0
+      DY = YII-Y0
+      U = AP*DX+BP*DY
+      V = CP*DX+DP*DY
+C
+C EVALUATES THE POLYNOMIAL.
+C
+      P0 = P00+V*(P01+V*(P02+V*(P03+V*(P04+V*P05))))
+      P1 = P10+V*(P11+V*(P12+V*(P13+V*P14)))
+      P2 = P20+V*(P21+V*(P22+V*P23))
+      P3 = P30+V*(P31+V*P32)
+      P4 = P40+V*P41
+      ZII = P0+U*(P1+U*(P2+U*(P3+U*(P4+U*P5))))
+      RETURN
+C
+C CALCULATION OF ZII BY EXTRATERPOLATION IN THE RECTANGLE.
+C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
+C
+  150 IF (IT0 .EQ. ITPV) GO TO  190
+C
+C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE END
+C POINTS OF THE BORDER LINE SEGMENT.
+C
+      JIPL = 3*(IL1-1)
+      JPD = 0
+      DO  170 I=1,2
+         JIPL = JIPL+1
+         IDP = IPL(JIPL)
+         X(I) = XD(IDP)
+         Y(I) = YD(IDP)
+         Z(I) = ZD(IDP)
+         JPDD = 5*(IDP-1)
+         DO  160 KPD=1,5
+            JPD = JPD+1
+            JPDD = JPDD+1
+            PD(JPD) = PDD(JPDD)
+  160    CONTINUE
+  170 CONTINUE
+C
+C DETERMINES THE COEFFICIENTS FOR THE COORDINATE SYSTEM
+C TRANSFORMATION FROM THE X-Y SYSTEM TO THE U-V SYSTEM
+C AND VICE VERSA.
+C
+      X0 = X(1)
+      Y0 = Y(1)
+      A = Y(2)-Y(1)
+      B = X(2)-X(1)
+      C = -B
+      D = A
+      AD = A*D
+      BC = B*C
+      DLT = AD-BC
+      AP = D/DLT
+      BP = -B/DLT
+      CP = -BP
+      DP = AP
+C
+C CONVERTS THE PARTIAL DERIVATIVES AT THE END POINTS OF THE
+C BORDER LINE SEGMENT FOR THE U-V COORDINATE SYSTEM.
+C
+      AA = A*A
+      ACT2 = 2.0*A*C
+      CC = C*C
+      AB = A*B
+      ADBC = AD+BC
+      CD = C*D
+      BB = B*B
+      BDT2 = 2.0*B*D
+      DD = D*D
+      DO  180 I=1,2
+         JPD = 5*I
+         ZU(I) = A*PD(JPD-4)+C*PD(JPD-3)
+         ZV(I) = B*PD(JPD-4)+D*PD(JPD-3)
+         ZUU(I) = AA*PD(JPD-2)+ACT2*PD(JPD-1)+CC*PD(JPD)
+         ZUV(I) = AB*PD(JPD-2)+ADBC*PD(JPD-1)+CD*PD(JPD)
+         ZVV(I) = BB*PD(JPD-2)+BDT2*PD(JPD-1)+DD*PD(JPD)
+  180 CONTINUE
+C
+C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL.
+C
+      P00 = Z(1)
+      P10 = ZU(1)
+      P01 = ZV(1)
+      P20 = 0.5*ZUU(1)
+      P11 = ZUV(1)
+      P02 = 0.5*ZVV(1)
+      H1 = Z(2)-P00-P01-P02
+      H2 = ZV(2)-P01-ZVV(1)
+      H3 = ZVV(2)-ZVV(1)
+      P03 = 10.0*H1-4.0*H2+0.5*H3
+      P04 = -15.0*H1+7.0*H2-H3
+      P05 = 6.0*H1-3.0*H2+0.5*H3
+      H1 = ZU(2)-P10-P11
+      H2 = ZUV(2)-P11
+      P12 = 3.0*H1-H2
+      P13 = -2.0*H1+H2
+      P21 = 0.0
+      P23 = -ZUU(2)+ZUU(1)
+      P22 = -1.5*P23
+      ITPV = IT0
+C
+C CONVERTS XII AND YII TO U-V SYSTEM.
+C
+  190 DX = XII-X0
+      DY = YII-Y0
+      U = AP*DX+BP*DY
+      V = CP*DX+DP*DY
+C
+C EVALUATES THE POLYNOMIAL.
+C
+      P0 = P00+V*(P01+V*(P02+V*(P03+V*(P04+V*P05))))
+      P1 = P10+V*(P11+V*(P12+V*P13))
+      P2 = P20+V*(P21+V*(P22+V*P23))
+      ZII = P0+U*(P1+U*P2)
+      RETURN
+C
+C CALCULATION OF ZII BY EXTRATERPOLATION IN THE TRIANGLE.
+C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
+C
+  200 IF (IT0 .EQ. ITPV) GO TO  220
+C
+C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE VERTEX
+C OF THE TRIANGLE.
+C
+      JIPL = 3*IL2-2
+      IDP = IPL(JIPL)
+      X(1) = XD(IDP)
+      Y(1) = YD(IDP)
+      Z(1) = ZD(IDP)
+      JPDD = 5*(IDP-1)
+      DO  210 KPD=1,5
+         JPDD = JPDD+1
+         PD(KPD) = PDD(JPDD)
+  210 CONTINUE
+C
+C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL.
+C
+      P00 = Z(1)
+      P10 = PD(1)
+      P01 = PD(2)
+      P20 = 0.5*PD(3)
+      P11 = PD(4)
+      P02 = 0.5*PD(5)
+      ITPV = IT0
+C
+C CONVERTS XII AND YII TO U-V SYSTEM.
+C
+  220 U = XII-X(1)
+      V = YII-Y(1)
+C
+C EVALUATES THE POLYNOMIAL.
+C
+      P0 = P00+V*(P01+V*P02)
+      P1 = P10+V*P11
+      ZII = P0+U*(P1+U*P20)
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/concld.f b/sys/gio/ncarutil/conlib/concld.f
new file mode 100644
index 00000000..6829d5fe
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/concld.f
@@ -0,0 +1,314 @@
+      SUBROUTINE CONCLD (ICASE,IOOP)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      INTEGER GOOP
+C
+        SAVE
+        DATA GOOP/0/
+C
+C  STATEMENT FUNCTIONS FOR CONTOUR PLACEMENT WITHIN CELLS
+C
+      CX(W1,W2) = STPSZ*( (W1-CONV)/(W1-W2) )
+      CY(W1,W2) = STPSZ*( (W1-CONV)/(W1-W2) )
+      IC = ICASE
+      ICASE = 0
+C
+C  SPECIAL PROCESSING IF SHIELDING ACTIVATED
+C
+      IF (.NOT.SHIELD) GO TO 1
+C
+C  CHECK IF ANY CELL CORNER CONTAINS A SPECIAL VALUE
+C       IF SO THEN FLAG AND RETURN
+C
+      IF (TR.NE.SPVAL.AND.BR.NE.SPVAL.AND.TL.NE.SPVAL.AND.BL.NE.SPVAL)
+     1      GO TO 1
+C
+C  SPECIAL VALUE IN CELL FLAG AND RETURN
+C
+      ICASE = -1
+      RETURN
+C
+C  IF CURRENT BR VALUE LESS THAN CONTOUR THEN NEIGHBOR WILL BE WHERE
+C  CONTOUR IS DRAWN.
+C
+ 1    CONTINUE
+C
+      IF (BR.LT.CONV) GO TO    90
+C
+C  CURRENT LOCATION IS WHERE CONTOUR WILL BE DRAWN
+C
+C  TEST FOR VERTICAL CONTOUR BREAK
+C
+      IF (BL.GE.CONV) GO TO    60
+C
+C  VERTICAL CONTOUR BREAK
+C
+C  CASE 1 LEFT NEIGHBOR LESS THAN CONTOUR LEVEL AND CURRENT
+C  LOCATION GE CONTOUR VALUE
+C
+      IF (TR.GE.CONV) GO TO    40
+C
+C  CASE 1A CONTOUR LOWER RIGHT
+C
+C
+C  CONTOUR FROM UPPER RIGHT
+C
+      XO = XC-CX(BR,TR)
+      YO = YC
+      YN = YC-CY(BR,BL)
+      XN = XC
+      NC = 1
+      IOC = 4
+      IF (IC.NE.3) GO TO    10
+      ICASE = IOC
+      XN = XO
+      YN = YO
+      RETURN
+   10 IF (IOOP.NE.GOOP) GO TO    20
+      IF (IC.NE.2) GO TO    30
+   20 ICASE = NC
+      RETURN
+C
+C CASE 1B  CONTOR UPPER LEFT
+C
+   30 XN = XC-STPSZ
+      YN = YC-STPSZ+CY(TL,TR)
+      XO = XC-STPSZ+CX(TL,BL)
+      YO = YC-STPSZ
+      IOC = 2
+      NC = 3
+      GO TO   180
+C
+C  CONTOURS FROM ABOVE AND UPPER LEFT
+C
+   40 IF (TL.LT.CONV) GO TO    50
+C
+C  CASE 1C CONTOUR LOWER LEFT
+C
+      XO = XC-STPSZ+CX(TL,BL)
+      YO = YC-STPSZ
+      YN = YC-CY(BR,BL)
+      XN = XC
+      NC = 1
+      IOC = 2
+      GO TO   180
+C
+C CASE 1D CONTOUR FROM ABOVE
+C
+   50 XO = XC-STPSZ
+      YO = YC-CY(TR,TL)
+      YN = YC-CY(BR,BL)
+      XN = XC
+      NC = 1
+      IOC = 3
+      GO TO   180
+C
+C
+C  TEST FOR HORIZONTAL CONTOUR BREAK
+C
+   60 IF (TR.LT.CONV) GO TO    70
+      IF (TL.GE.CONV) GO TO   200
+C
+C  CASE 2A CONTOUR UPPER LEFT
+C
+      XO = XC-STPSZ
+      YO = YC-CY(TR,TL)
+      XN = XC-CX(BL,TL)
+      YN = YC-STPSZ
+      NC = 2
+      IOC = 3
+      GO TO   180
+C
+   70 IF (TL.LT.CONV) GO TO    80
+C
+C  CASE 2B CONTOUR FROM UPPER RIGHT
+C
+      XO = XC-STPSZ
+      YO = YC-STPSZ+CY(TL,TR)
+      XN = XC-CX(BR,TR)
+      YN = YC
+      NC = 4
+      IOC = 3
+      GO TO   180
+C
+C  CASE 2C CONTOUR FROM LEFT TO RIGHT
+C
+   80 XO = XC-CX(BL,TL)
+      YO = YC-STPSZ
+      XN = XC-CX(BR,TR)
+      YN = YC
+      NC = 4
+      IOC = 2
+      GO TO   180
+C
+C
+C  CURRENT BR VALUE LESS THAN CONTOUR
+C
+C
+   90 IF (BL.LT.CONV) GO TO   150
+C
+C  VERTICAL CONTOUR BREAK
+C
+C  CASE 3 CURRENT SPACE LESS THAN CONTOUR LEVEL AND LEFT
+C  NEIGHBOR GE CONTOUR LEVEL
+C
+      IF (TL.GE.CONV) GO TO   130
+C
+C  CASE 3A CONTOUR LOWER LEFT
+C
+      XO = XC-CX(BL,TL)
+      YO = YC-STPSZ
+      YN = YC-STPSZ+CY(BL,BR)
+      XN = XC
+      NC = 1
+      IOC = 2
+      IF (IC.NE.3) GO TO   100
+      ICASE = IOC
+      XN = XO
+      YN = YO
+      RETURN
+  100 IF (IOOP.NE.GOOP) GO TO   110
+      IF (IC.NE.4) GO TO   120
+  110 ICASE = NC
+      RETURN
+C
+C  CASE 3B CONTOUR UPPERRIGHT
+C
+  120 XO = XC-STPSZ
+      YO = YC-CY(TR,TL)
+      XN = XC-STPSZ+CX(TR,BR)
+      YN = YC
+      NC = 4
+      IOC = 3
+      GO TO   180
+C
+  130 IF (TR.GE.CONV) GO TO   140
+C
+C  CASE 3C CONTOUR FROM ABOVE
+C
+      XO = XC-STPSZ
+      YO = YC-STPSZ+CY(TL,TR)
+      YN = YC-STPSZ+CY(BL,BR)
+      XN = XC
+      NC = 1
+      IOC = 3
+      GO TO   180
+C
+C  CASE 3D CONTOUR LOWER RIGHT
+C
+  140 XO = XC-STPSZ+CX(TR,BR)
+      YO = YC
+      YN = YC-STPSZ+CY(BL,BR)
+      XN = XC
+      NC = 1
+      IOC = 4
+      GO TO   180
+C
+C
+C
+C  TEST FOR HORIZONTAL BREAK POINT
+C
+  150 IF (TR.GE.CONV) GO TO   160
+C
+      IF (TL.LT.CONV) GO TO   200
+C
+C  CASE 4A CONTOUR UPPER LEFT
+C
+      XN = XC-STPSZ+CX(TL,BL)
+      YN = YC-STPSZ
+      XO = XC-STPSZ
+      YO = YC-STPSZ+CY(TL,TR)
+      NC = 2
+      IOC = 3
+      GO TO   180
+C
+  160 IF (TL.GE.CONV) GO TO   170
+C
+C  CASE 4B CONTOUR UPPER RIGHT
+C
+      XO = XC-STPSZ
+      YO = YC-CY(TR,TL)
+      XN = XC-STPSZ+CX(TR,BR)
+      YN = YC
+      NC = 4
+      IOC = 3
+      GO TO   180
+C
+C  CASE 4C CONTOUR FROM LEFT TO RIGHT
+C
+  170 YO = YC-STPSZ
+      XO = XC-STPSZ+CX(TL,BL)
+      XN = XC-STPSZ+CX(TR,BR)
+      YN = YC
+      NC = 4
+      IOC = 2
+C
+C  DRAW THE CONTOUR LINES NOT ALREADY TAKEN CARE OF
+C
+  180 IF (IABS(IC-NC).NE.2) GO TO   190
+      ICASE = IOC
+      XN = XO
+      YN = YO
+      RETURN
+  190 ICASE = NC
+  200 RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/concls.f b/sys/gio/ncarutil/conlib/concls.f
new file mode 100644
index 00000000..02d97a4d
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/concls.f
@@ -0,0 +1,177 @@
+      SUBROUTINE CONCLS (ZD,NDP)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  GENERATE CONTOUR LEVELS BASED ON THE INPUT DATA
+C
+      DIMENSION       ZD(1)
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      SAVE
+C
+C  IF NOT USER SET COMPUTE CONTOUR LEVELS
+C
+      IF (.NOT.CON) GO TO  150
+C
+C  OTHERWISE GET HI AND LOW CONTOURS FOR MESSAGE
+C
+      HI = CL(1)
+      FLO = CL(1)
+      DO  110 I=1,NCL
+         IF (HI .GE. CL(I)) GO TO  100
+         HI = CL(I)
+         GO TO  110
+  100    IF (FLO .LE. CL(I)) GO TO  110
+         FLO = CL(I)
+  110 CONTINUE
+C
+C GET INCREMENT IF EQUAL SPACED CONTOURS
+C
+      IF (NCL .NE. 1) GO TO  120
+      FINC = 0.
+      RETURN
+  120 FINC = ABS(CL(1)-CL(2))
+      IF (NCL .EQ. 2) RETURN
+      DO  130 I=3,NCL
+         IF (FINC .NE. ABS(CL(I-1)-CL(I))) GO TO  140
+  130 CONTINUE
+      RETURN
+  140 FINC = -1.
+      RETURN
+C
+C  FIND HIGHEST AND LOWEST INPUT VALUES
+C
+  150 IF (CHILO) GO TO  180
+      FLO = ZD(1)
+      HI = ZD(1)
+      DO  170 I=2,NDP
+         IF (FLO .LE. ZD(I)) GO TO  160
+         FLO = ZD(I)
+         GO TO  170
+  160    IF (HI .GE. ZD(I)) GO TO  170
+         HI = ZD(I)
+  170 CONTINUE
+C
+C  CALCULATE THE CONTOUR LEVEL INTERVAL
+C
+  180 IF (CINC) GO TO  200
+      FINC = (HI-FLO)/15.
+      IF (FINC .NE. 0.) GO TO  190
+      CALL SETER (' CONCLS - CONSTANT INPUT FIELD',1,1)
+      RETURN
+C
+C  ROUND FINC TO NICE NUMBER
+C
+  190 P = 10.**(IFIX(ALOG10(FINC)+500.)-500)
+      FINC = AINT(FINC/P+0.1)*P
+C
+C  ROUND THE LOW VALUE TO START AT A NICE NUMBER
+C
+  200 IF (CHILO) GO TO  210
+      FLO = AINT(FLO/FINC)*FINC
+C
+C  COMPUTE THE CONTOUR LEVELS
+C
+C  TEST IF BREAK POINT WITHIN RANGE OF HI TO FLO
+C
+  210 IF (BPSIZ.GE.FLO .AND. BPSIZ.LE.HI) GO TO  240
+C
+C  BREAK POINT OUT OF RANGE SO GENERATE CONTOURS BASED ON FLO
+C
+      DO  220 I=1,30
+         CV = FLO+FLOAT(I-1)*FINC
+         ICUR = I
+         CL(I) = CV
+         IF (CV .GE. HI) GO TO  230
+  220 CONTINUE
+  230 NCL = ICUR
+      HI = CV
+      RETURN
+C
+C  BREAK POINT WITHIN RANGE SO BASE CONTOURS ON IT
+C
+  240 DO  250 I=1,30
+         CV = BPSIZ-FLOAT(I-1)*FINC
+         IND = (30-I)+1
+         CL(IND) = CV
+         ICUR = I
+         IF (CV .LE. FLO) GO TO  260
+  250 CONTINUE
+C
+C  PUT THE CONTOURS IN THE CORRECT ORDER
+C
+  260 DO  270 I=1,ICUR
+         IND = (30-ICUR)+I
+         CL(I) = CL(IND)
+  270 CONTINUE
+C
+C  ADD THE GREATER THAN BREAK POINT CONTOURS
+C
+      IEND = 30-ICUR
+      ISAV = ICUR+1
+      DO  280 I=1,IEND
+         CV = BPSIZ+FLOAT(I)*FINC
+         CL(ISAV) = CV
+         ISAV = ISAV+1
+         IF (CV .GE. HI) GO TO  290
+  280 CONTINUE
+C
+C  SET NUMBER OF CONTOUR LEVELS AND UPDATE THE HIGH VALUE
+C
+  290 NCL = ISAV-1
+      HI = CV
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/concom.f b/sys/gio/ncarutil/conlib/concom.f
new file mode 100644
index 00000000..8a5041df
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/concom.f
@@ -0,0 +1,78 @@
+      FUNCTION CONCOM (XQ,YQ,XD,YD,ZD,NDP,WK,IWK,LOC)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  INTERPOLATE A GIVEN X,Y PAIR AND RETURN ITS LOCATION
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      DIMENSION       XD(1)      ,YD(1)      ,ZD(1)      ,WK(1)      ,
+     1                IWK(1)
+C
+        SAVE
+C
+C LOCATE PROPER TRIANGLE
+C
+      CALL CONLOC (NDP,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),XQ,YQ,LOC,
+     1             IWK(JWIWL),WK)
+C
+C  INTERPOLATE THE LOCATION
+C
+      CALL CONCAL (XD,YD,ZD,NT,IWK(JWIPT),NL,IWK(JWIPL),WK(IPR),LOC,XQ,
+     1             YQ,TEMP,ITPV)
+      CONCOM = TEMP
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/condet.f b/sys/gio/ncarutil/conlib/condet.f
new file mode 100644
index 00000000..6b3a3077
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/condet.f
@@ -0,0 +1,128 @@
+      SUBROUTINE CONDET (NDP,XD,YD,NCP,IPC)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C******************************************************************
+C*                                                                *
+C*   THIS FILE IS A PACKAGE OF SUPPORT ROUTINES FOR THE ULIB      *
+C*   FILES CONRAN , CONRAQ AND CONRAS.  SEE THOSE FILES FOR AN    *
+C*   EXPLAINATION OF THE ENTRY POINTS.                            *
+C*                                                                *
+C******************************************************************
+C
+C THIS SUBROUTINE SELECTS SEVERAL DATA POINTS THAT ARE CLOSEST
+C TO EACH OF THE DATA POINT.
+C THE INPUT PARAMETERS ARE
+C     NDP = NUMBER OF DATA POINTS,
+C     XD,YD = ARRAYS CONTAINING THE X AND Y COORDINATES
+C             OF DATA POINTS,
+C     NCP = NUMBER OF DATA POINTS CLOSEST TO EACH DATA
+C           POINTS.
+C THE OUTPUT PARAMETER IS
+C     IPC = INTEGER ARRAY OF DIMENSION NCP*NDP, WHERE THE
+C           POINT NUMBERS OF NCP DATA POINTS CLOSEST TO
+C           EACH OF THE NDP DATA POINTS ARE TO BE STORED.
+C THIS SUBROUTINE ARBITRARILY SETS A RESTRICTION THAT NCP MUST
+C NOT EXCEED 25 WITHOUT MODIFICATION TO THE ARRAYS DSQ0 AND IPC0.
+C DECLARATION STATEMENTS
+C
+      COMMON /CONRA3/ IREC
+      DIMENSION       XD(NDP)    ,YD(NDP)    ,IPC(1)
+      DIMENSION       DSQ0(25)   ,IPC0(25)
+C
+        SAVE
+C
+C STATEMENT FUNCTION
+C
+      DSQF(U1,V1,U2,V2) = (U2-U1)**2+(V2-V1)**2
+C
+C CALCULATION
+C
+      DO  220 IP1=1,NDP
+C
+C - SELECTS NCP POINTS.
+C
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+         J1 = 0
+         DSQMX = 0.0
+         DO  110 IP2=1,NDP
+            IF (IP2 .EQ. IP1) GO TO  110
+            DSQI = DSQF(X1,Y1,XD(IP2),YD(IP2))
+            J1 = J1+1
+            DSQ0(J1) = DSQI
+            IPC0(J1) = IP2
+            IF (DSQI .LE. DSQMX) GO TO  100
+            DSQMX = DSQI
+            JMX = J1
+  100       IF (J1 .GE. NCP) GO TO  120
+  110    CONTINUE
+  120    IP2MN = IP2+1
+         IF (IP2MN .GT. NDP) GO TO  150
+         DO  140 IP2=IP2MN,NDP
+            IF (IP2 .EQ. IP1) GO TO  140
+            DSQI = DSQF(X1,Y1,XD(IP2),YD(IP2))
+            IF (DSQI .GE. DSQMX) GO TO  140
+            DSQ0(JMX) = DSQI
+            IPC0(JMX) = IP2
+            DSQMX = 0.0
+            DO  130 J1=1,NCP
+               IF (DSQ0(J1) .LE. DSQMX) GO TO  130
+               DSQMX = DSQ0(J1)
+               JMX = J1
+  130       CONTINUE
+  140    CONTINUE
+C
+C - CHECKS IF ALL THE NCP+1 POINTS ARE COLLINEAR.
+C
+  150    IP2 = IPC0(1)
+         DX12 = XD(IP2)-X1
+         DY12 = YD(IP2)-Y1
+         DO  160 J3=2,NCP
+            IP3 = IPC0(J3)
+            DX13 = XD(IP3)-X1
+            DY13 = YD(IP3)-Y1
+            IF ((DY13*DX12-DX13*DY12) .NE. 0.0) GO TO  200
+  160    CONTINUE
+C
+C - SEARCHES FOR THE CLOSEST NONCOLLINEAR POINT.
+C
+         NCLPT = 0
+         DO  190 IP3=1,NDP
+            IF (IP3 .EQ. IP1) GO TO  190
+            DO  170 J4=1,NCP
+               IF (IP3 .EQ. IPC0(J4)) GO TO  190
+  170       CONTINUE
+            DX13 = XD(IP3)-X1
+            DY13 = YD(IP3)-Y1
+            IF ((DY13*DX12-DX13*DY12) .EQ. 0.0) GO TO  190
+            DSQI = DSQF(X1,Y1,XD(IP3),YD(IP3))
+            IF (NCLPT .EQ. 0) GO TO  180
+            IF (DSQI .GE. DSQMN) GO TO  190
+  180       NCLPT = 1
+            DSQMN = DSQI
+            IP3MN = IP3
+  190    CONTINUE
+         DSQMX = DSQMN
+         IPC0(JMX) = IP3MN
+C
+C - REPLACES THE LOCAL ARRAY FOR THE OUTPUT ARRAY.
+C
+  200    J1 = (IP1-1)*NCP
+         DO  210 J2=1,NCP
+            J1 = J1+1
+            IPC(J1) = IPC0(J2)
+  210    CONTINUE
+  220 CONTINUE
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/condrw.f b/sys/gio/ncarutil/conlib/condrw.f
new file mode 100644
index 00000000..df47eae9
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/condrw.f
@@ -0,0 +1,253 @@
+      SUBROUTINE CONDRW (SCRARR)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  DRAW ALL CONTOURS AT THIS LEVEL
+C  IF NOT EXTRAPOLATING
+C         SEARCH CONVEX HULL FOR CONTOURS INTERSECTING IT AND DRAW THEM
+C         SEARCH INTERIOR AND DRAW ALL REMAINING UNDRAWN CONTOURS
+C
+C  IF EXTRAPOLATING
+C         SEARCH FROM X START TO X END AND Y START TO Y END FOR ALL
+C         CONTOURS AT THIS LEVEL
+C
+C  INPUT
+C       SCRARR SCRATCH ARRAY USED FOR FAST CONTOURING
+C       VIA COMMON BLOCKS BELOW
+C           CONV-THE CURRENT CONTOUR LEVEL
+C           ITLOC-THE CONVEX HULL BOUNDRIES RELATIVE TO THE SCRATCH
+C                 ARRAY, SCRARR
+C           PV-REAL Y COOORDINATES OF THE CONVEX HULL RELATIVE TO THE
+C                 USERS COORDINATE SPACE
+C           IXMAX,IYMAX-MAXINUM X AND Y COORDINATES RELATIVE TO THE
+C                 SCRATCH ARRAY, SCRARR
+C           XMAX,YMAX-MAXIMUM X AND Y COORDINATES RELATIVE TO USERS
+C                 COORDINATE SPACE
+C
+C  OUTPUT
+C    CONTOUR LINES OUTPUT TO PLOTTER FILE
+C
+C  NOTE
+C       THIS ROUTINE WILL DETECT AND CORRECT FOR CONRAN ERROR 9
+C
+      DIMENSION       SCRARR(1)
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+        SAVE
+C
+C
+C  FLAGS TO ALLOW COMPRESSION OF CONTOUR STORAGE IF IT IS EXAUSTED
+C
+        DATA ICOMP,NOCOMP/1,0/
+C
+C  STATEMENT FUNCTION TO MAKE ARRAY ACCESS SEEM LIKE MATRIX ACCESS
+C
+      SCRTCH(IXX,IYY) = SCRARR(IYY+(IXX-1)*IYMAX)
+C
+C  CLEAR THE CONTOUR STORAGE LIST
+C
+      NP = 0
+C
+C  SCAN X BOARDERS FOR INTERSECTIONS
+C
+      JX = 2
+      ICASE = 1
+      X = XST+STPSZ
+C
+C  IF NOT EXTRAPOLATING BRANCH
+C
+   10 IF (.NOT.EXTRAP) GO TO    20
+      JY = 2
+      JYE = IYMAX
+      Y = YST+STPSZ
+      GO TO    30
+C
+C  NOT EXTRAPOLATING
+C
+   20 JY = ITLOC(JX*2-1)
+      IF (JY.EQ.0) GO TO    60
+      JYE = ITLOC(JX*2)+1
+      IF (JYE.GT.IYMAX) JYE = IYMAX
+      Y = PV(JX*2-1)
+      IF (JY.GE.2) GO TO 30
+      JY = 2
+      Y = YST+STPSZ
+   30 TL = SCRTCH(JX-1,JY-1)
+      BL = SCRTCH(JX,JY-1)
+   40 TR = SCRTCH(JX-1,JY)
+      BR = SCRTCH(JX,JY)
+      CALL CONGEN (X,Y,NOCOMP,SCRARR,ICASE)
+C
+C  TEST IF CONTOUR STORAGE EXAUSTED
+C
+      IF (NERRO(NERR).NE.10) GO TO    50
+      CALL EPRIN
+      CALL ERROF
+      RETURN
+C
+C  MOVE TO NEW CELL
+C
+   50 TL = TR
+      BL = BR
+      JY = JY+1
+      Y = Y+STPSZ
+      IF (JY.LE.JYE) GO TO    40
+   60 IF (JX.EQ.IXMAX) GO TO    70
+      JX = IXMAX
+      ICASE = 3
+      X = XMAX
+      GO TO    10
+C
+C  SCAN Y BOARDERS
+C
+   70 IPOS = 1
+      ICASE = 4
+   80 JX = 3
+      X = XST+STPSZ+STPSZ
+C
+C  IF NOT EXTRAPOLATING BRANCH
+C
+   90 IF (.NOT.EXTRAP) GO TO   100
+      JY = 2
+      Y = YST+STPSZ
+      IF (IPOS.NE.0) GO TO   110
+      JY = IYMAX
+      Y = YED
+      GO TO   110
+C
+C  NOT EXTRAPOLATING
+C
+ 100    JY = ITLOC(JX*2 - IPOS )
+      IF (JY.EQ.0) GO TO   120
+        JY = JY + IPOS
+      Y = PV(JX*2 - IPOS) + STPSZ*(1*IPOS)
+  110 TL = SCRTCH(JX-1,JY-1)
+      BL = SCRTCH(JX,JY-1)
+      TR = SCRTCH(JX-1,JY)
+      BR = SCRTCH(JX,JY)
+      CALL CONGEN (X,Y,NOCOMP,SCRARR,ICASE)
+C
+C  TEST IF CONTOUR STORAGE EXAUSTED
+C
+      IF (NERRO(NERR).NE.10) GO TO   120
+      CALL EPRIN
+      CALL ERROF
+      RETURN
+C
+C  MOVE TO NEW CELL
+C
+  120 JX = JX+1
+      X = X+STPSZ
+      IF (JX.LE.IXMAX-1) GO TO    90
+      IF (IPOS.EQ.0) GO TO   130
+      IPOS = 0
+      ICASE = 2
+      GO TO    80
+C
+C  BOARDER SEARCH DONE CONTOUR INTERIOR
+C
+C  INITIALIZE THE SEARCH
+C
+  130 JX = 3
+      ICASE = 0
+      X = XST+STPSZ+STPSZ
+      JXE = IXMAX-1
+C
+C  IF EXTRAPOLATING GO FROM BORDER TO BORDER
+C
+  140 IF (.NOT.EXTRAP) GO TO   150
+      JY = 3
+      JYE = IYMAX-1
+      Y = YST+STPSZ+STPSZ
+      GO TO   160
+C
+C  NOT EXTRAPOLATING STAY IN HULL
+C
+  150 JY = ITLOC(JX*2 - 1)+2
+      IF (JY.EQ.2) GO TO   190
+      JYE = ITLOC(JX*2)-1
+      Y = PV(JX*2 - 1)+STPSZ+STPSZ
+C
+  160 IF (JY.GT.JYE) GO TO   190
+      TL = SCRTCH(JX-1,JY-1)
+      BL = SCRTCH(JX,JY-1)
+  170 TR = SCRTCH(JX-1,JY)
+      BR = SCRTCH(JX,JY)
+      CALL CONGEN (X,Y,ICOMP,SCRARR,ICASE)
+C
+C  TEST IF CONTOUR STORAGE EXAUSTED
+C
+      IF (NERRO(NERR).NE.10) GO TO   180
+      CALL EPRIN
+      CALL ERROF
+      RETURN
+C
+C  MOVE TO NEW CELL
+C
+  180 JY = JY+1
+      Y = Y+STPSZ
+      TL = TR
+      BL = BR
+      IF (JY.LE.JYE) GO TO   170
+C
+C  PROCESS EACH ROW OF INTERIOR
+C
+  190 X = X+STPSZ
+      JX = JX+1
+      IF (JX.LE.JXE) GO TO   140
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/condsd.f b/sys/gio/ncarutil/conlib/condsd.f
new file mode 100644
index 00000000..0ea5fb43
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/condsd.f
@@ -0,0 +1,54 @@
+      SUBROUTINE CONDSD
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  DRAW THE OUTLINE OF THE SHIELD ON THE PLOT
+C
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+C
+        SAVE
+C
+C  GET THE START POINT
+C
+      XS = XVS(1)
+      YS = YVS(1)
+C
+C  MOVE TO THE START OF THE OUTLINE
+C
+      CALL FL2INT(XS,YS,IX,IY)
+      CALL PLOTIT(IX,IY,0)
+C
+C  LOOP FOR ALL SHIELD ELEMENTS
+C
+      DO 100 IC = 2,ICOUNT
+C
+C       DRAW THE OUTLINE OF THE SHIELD
+C
+        CALL FL2INT(XVS(IC),YVS(IC),IX,IY)
+        CALL PLOTIT(IX,IY,1)
+C
+ 100  CONTINUE
+C
+C  DRAW TO THE START
+C
+      CALL FL2INT(XS,YS,IX,IY)
+      CALL PLOTIT(IX,IY,1)
+C
+C  FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/conecd.f b/sys/gio/ncarutil/conlib/conecd.f
new file mode 100644
index 00000000..56d8a934
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conecd.f
@@ -0,0 +1,178 @@
+      SUBROUTINE CONECD (VAL,IOUT,NUSED)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  ENCODE A NUMBER IN THE LEAST AMOUNT OF SPACE
+C  ON INPUT
+C       VAL THE NUMBER TO BE ENCODED
+C  ON OUTPUT
+C       IOUT CHARACTER STRING FILLED WITH THE ENCODED RESULT, MUST BE ABLE TO
+C            HOLD UP TO 9 CHARACTERS.
+C
+C     NUSED NUMBER OF CHARACTERS IN IOUT
+C
+C  VALUE INPUT WILL BE SCALED BY SCALE IN CONRA2
+C
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+        CHARACTER*(*)   IOUT
+        CHARACTER*6     IFMT1
+C
+C +NOAO - Variables CHTMP and IT are not used.
+C
+C       CHARACTER*9     CHTMP
+C       CHARACTER*1     IT
+C
+C -NOAO
+C
+        SAVE
+C
+      V = VAL
+C
+C  IF VAL EQUALS ZERO EASY PROCESSING
+C
+      IF (V.NE.0.) GO TO    20
+        IOUT = '0.0'
+      NUSED = 3
+      RETURN
+C
+C  SCALE VALUE
+C
+   20 V = V*SCALE
+C
+C  GET SIZE OF NUMBER
+C
+      LOG = IFIX(ALOG10(ABS(V))+.1)
+      IF (IABS(LOG).GT.4) GO TO    60
+C
+C  COMPUTE FLOATING POINT FIELD
+C
+      NS = IABS(LOG)+3
+      ND = 1
+      IF (LOG.GT.0) GO TO    40
+C
+C  LOG = 0 TEST FOR FRACTIONAL PART ONLY
+C
+      IF (ALOG10( ABS(V) ).GE.0.) GO TO    30
+C
+C  NUMBER LT 1 BUT GREATER THAN ZERO IN ABSOLUTE VALUE
+C
+      NS = 4
+      ND = 1
+      GO TO    40
+C
+C  NUMBER LESS THAN 10 BUT GE 1
+C
+   30 ND = 1
+      NS = 4
+C
+C  BUILD THE FORMAT
+C
+   40 IF (V.LT.0) NS = NS+1
+        IFMT1 = '(F . )'
+C
+C  INSERT THE FLOATING POINT FORMAT SIZE
+C
+C +NOAO - Scheme for creating format has been modified because it uses
+C         FTN internal writes.  NOAO mods are written in lower case.
+C
+C       WRITE(IT,'(I1)')NS
+C       IFMT1(3:3) = IT
+C       WRITE(IT,'(I1)')ND
+C       IFMT1(5:5) = IT
+C
+	ifmt1(1:6) = '(f . )'
+	ifmt1(3:3) = char (ns + ichar ('0') + 1)
+	ifmt1(5:5) = char (nd + ichar ('0'))
+C
+C  ENCODE THE DESIRED NUMBER
+C
+C       WRITE(CHTMP,IFMT1)V
+C       IOUT = CHTMP
+C
+        call encode (ns, ifmt1, iout, v)
+
+      NUSED = NS
+      RETURN
+C
+C  DATA LARGER THAN A NICE SIZE FORCE IT TO BE ENCODED
+C
+C 60  WRITE(CHTMP,'(E8.3)')V
+C     IOUT = CHTMP
+C
+  60  call encode (8, '(E8.3)', iout, v)
+C
+C -NOAO
+      NUSED = 8
+      RETURN
+C
+C******************************************************************
+C*                                                                *
+C*                   REVISION HISTORY                             *
+C*                                                                *
+C*  JUNE 1980   ADDED CONCOM TO ULIB                              *
+C*  AUGUST 1980 FIXED BOARDER CONTOUR DETECTION                   *
+C*  DECEMBER 1980 FIXED ERROR TRAP, CONTOUR REORDERING ALGORITHM  *
+C*                AND ERROR MESSAGE 10                            *
+C*  AUGUST 1983 ADDED LINEAR INTERPOLATION AND SHIELDING          *
+C*  JULY 1984 CONVERTED TO FORTRAN77 AND GKS                      *
+C*  AUGUST 1985 DELETED (MACHINE DEPENDENT) FUNCTION LOC; CHANGED *
+C*              COMMON /CONR13/                                   *
+C*                                                                *
+C******************************************************************
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/congen.f b/sys/gio/ncarutil/conlib/congen.f
new file mode 100644
index 00000000..c70cfe05
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/congen.f
@@ -0,0 +1,454 @@
+      SUBROUTINE CONGEN (XI,YI,IPACK,SCRARR,ICA)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  DRAW A CONTOUR AT THE CURRENT LEVEL
+C
+C  INPUT
+C       XI YI LOWER RIGHT CORNER OF CELL
+C       IPACK-FLAG TO ALLOW REDUCTION OF COORDINATE PAIR STORAGE
+C             IF REQUIRED
+C       SCRARR-SCRATCH ARRAY OF CONTOUR VALUES
+C       ICA-ENTERING CASE CONDITIONS IF ANY REQUIRED
+C
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C
+      DIMENSION       SCRARR(1)  ,IXMOV(2)   ,IYMOV(2)
+        CHARACTER*64    IHOLD
+        CHARACTER*23    IVOUT
+      INTEGER         GOOP
+C
+        SAVE
+        DATA NOOP,GOOP/1,0/
+C
+C  STATEMENT FUNCTIONS FOR MAPPING GRAPHICS OUTPUT
+C
+      FX(XXX,YYY) = XXX
+      FY(XXX,YYY) = YYY
+C
+C  STATEMENT FUNCTION TO MAKE ARRAY ACCESS SEEM LIKE MATRIX ACCESS
+C
+      SCRTCH(IXX,IYY) = SCRARR(IYY+(IXX-1)*IYMAX)
+C
+C  DRAW AN ENTIRE CONTOUR LINE WHEN A POTENTIAL START POINT IS
+C  PROVIDED
+C
+C  SAVE STARTING CELL
+C
+      XCS = XI
+      YCS = YI
+C
+C  TEST IF VALID START POINT
+C
+      ICASE = ICA
+      XC = XI
+      YC = YI
+      CALL CONCLD (ICASE,NOOP)
+C
+C  IF NO CONTOUR RETURN
+C
+      IF (ICASE.EQ.-1) RETURN
+      IF (ICASE.EQ.0) RETURN
+C
+C  IF CONTOUR ALREADY DRAWN RETURN
+C
+      ILOC = IOR(ISHIFT(JX,ISHFCT),JY)
+      IF (NP.EQ.0) GO TO    20
+C
+C TEST IF CONTOUR FOUND
+C
+          DO    10 I=1,NP
+          IF (ILOC.NE.ICOORD(I)) GO TO    10
+          RETURN
+   10     CONTINUE
+C
+C  GET CORRECT OLD CASE
+C
+   20 IC = IOC
+      IF (ICASE.EQ.IOC) IC = NC
+C
+C  SET UP STRUCTURE TO START IN OTHER DIRECTION FROM HERE IF CONTOUR
+C  UNEXPECTLY ENDS IN THIS DIRECTION
+C
+      IFCASE = IC
+      IFOCSE = ICASE
+      FXO = XO
+      FYO = YO
+      LOOP = 1
+C
+C  SET UP IC TO SIMULATE EXIT FROM A PREVIOUS CELL
+C
+      IC = MOD(IC+2,4)
+C
+C  IF EXTRAPOLATING PASS ON
+C
+      IF (EXTRAP) GO TO    60
+C
+C  TEST IF CONTOUR EXCEEDED BORDER LIMITS
+C  NOTE THAT ICASER CANNOT EQUAL 3 AT THIS POINT
+C
+      GO TO (   30,   40,   30,   50),ICASE
+C
+C  EXIT FROM BOTTOM
+C
+   30 IF (JX.GE.IXMAX) RETURN
+      GO TO    60
+C
+C  EXIT FROM LEFT
+C
+   40 IF (JY.LE.ITLOC(JX*2 - 1)) RETURN
+      GO TO    60
+C
+C  EXIT FROM RIGHT
+C
+   50 IF (JY.GE.ITLOC(JX*2 - 1)) RETURN
+C
+C  SAVE CELL INFO IF COMMING BACK
+C
+   60 TRT = TR
+      BRT = BR
+      TLT = TL
+      BLT = BL
+      IX = JX
+      IY = JY
+C
+C  VALID CONTOUR START FOUND
+C
+      XX = FX(XO,YO)
+      CALL FRSTD (XX,FY(XO,YO))
+C
+C  DRAW CONTOUR IN THIS CELL
+C
+   70 XX = FX(XN,YN)
+      CALL VECTD (XX,FY(XN,YN))
+      XCSTOR = XC
+      YCSTOR = YC
+      IXSTOR = IX
+      IYSTOR = IY
+      IOLDC = IC
+      IC = ICASE
+C
+C  ENTER COORDINATE PAIR OF CONTOUR IN LIST
+C
+      NP = NP+1
+      IF (NP.GT.MXXY) GO TO   180
+      ICOORD(NP) = ILOC
+C
+C  BRANCH TO APPROPIATE CODE DEPENDING ON CONTOUR EXIT FROM THE CELL
+C
+   80 GO TO (   90,  110,  130,  150),IC
+C
+C  EXIT FORM BOTTOM
+C  END CONTOUR IF ON CONVEX HULL
+C
+   90 IF (EXTRAP) GO TO   100
+      IF (IY.LT.ITLOC(IX*2 - 1) .OR. IY-1.GT.ITLOC(IX*2)) GO TO   360
+  100 TR = BR
+      TL = BL
+      XC = XC+STPSZ
+C
+C  IF ON BORDER END CONTOUR
+C
+      IX = IX+1
+      IF (IX.GT.IXMAX) GO TO   360
+      BR = SCRTCH(IX,IY)
+      BL = SCRTCH(IX,IY-1)
+      ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+C
+C  BRANCH IF CONTOUR CLOSED
+C
+      IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+      CALL CONCLD (ICASE,GOOP)
+      IF (ICASE.EQ.-1) GO TO 360
+      IF (ICASE.NE.0) GO TO    70
+      GO TO   230
+C
+C  EXIT FROM LEFT SIDE
+C  TEST IF IN CONVEX HULL
+C
+  110 IF (EXTRAP) GO TO   120
+      IF (IY-1.LT.ITLOC( (IX-1)*2 - 1 ) .AND. IY-1.LT.ITLOC(IX*2 - 1))
+     1    GO TO   360
+  120 TR = TL
+      BR = BL
+      YC = YC-STPSZ
+C
+C  IF ON BORDER END CONTOUR
+C
+      IY = IY-1
+      IF (IY.LT.2) GO TO   360
+      TL = SCRTCH(IX-1,IY-1)
+      BL = SCRTCH(IX,IY-1)
+C
+C  BRANCH IF CONTOUR CLOSED
+C
+      IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+      ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+      CALL CONCLD (ICASE,GOOP)
+      IF (ICASE.EQ.-1) GO TO 360
+      IF (ICASE.NE.0) GO TO    70
+      GO TO   230
+C
+C  EXIT FROM TOP
+C  END CONTOUR IF OUT OF CONVEX HULL
+C
+  130 IF (EXTRAP) GO TO   140
+      IF (IY.LT.ITLOC( (IX-1)*2 - 1 ) .OR. IY-1.GT.ITLOC( (IX-1)*2 ))
+     1    GO TO   360
+  140 BR = TR
+      BL = TL
+      XC = XC-STPSZ
+C
+C  END CONTOUR IF OUTSIDE OF BORDER
+C
+      IX = IX-1
+      IF (IX.LT.2) GO TO   360
+      TR = SCRTCH(IX-1,IY)
+      TL = SCRTCH(IX-1,IY-1)
+      ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+C
+C  BRANCH IF CONTOUR CLOSED
+C
+      IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+      CALL CONCLD (ICASE,GOOP)
+      IF (ICASE.EQ.-1) GO TO 360
+      IF (ICASE.NE.0) GO TO    70
+      GO TO   230
+C
+C  EXIT FROM RIGHT SIDE
+C  TEST IF ON CONVEX HULL
+C
+  150 IF (EXTRAP) GO TO   160
+      IF (IY.GT.ITLOC( (IX-1)*2 ) .AND. IY.GT.ITLOC(IX*2)) GO TO   360
+  160 TL = TR
+      BL = BR
+      YC = YC+STPSZ
+C
+C  IF ON BORDER END CONTOUR
+C
+      IY = IY+1
+      IF (IY.GT.IYMAX) GO TO   360
+      TR = SCRTCH(IX-1,IY)
+      BR = SCRTCH(IX,IY)
+      ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+C
+C  BRANCH IF CONTOUR CLOSED
+C
+      IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+      CALL CONCLD (ICASE,GOOP)
+      IF (ICASE.EQ.-1) GO TO 360
+      IF (ICASE.NE.0) GO TO    70
+      GO TO   230
+C
+C  END THE CONTOUR
+C
+  170 CALL LASTD
+      TR = TRT
+      BR = BRT
+      TL = TLT
+      BL = BLT
+      RETURN
+C
+C  CONTOUR STORAGE EXCEEDED TRY PACKING
+C
+  180 IF (IPACK.EQ.0) GO TO   200
+      NP = 0
+      ITEST = IOR(ISHIFT(JX,ISHFCT),JY)
+          DO   190 K=1,MXXY
+          IF (ICOORD(K).LE.ITEST) GO TO   190
+          NP = NP+1
+          ICOORD(NP) = ICOORD(K)
+  190     CONTINUE
+      IF (NP.LT.MXXY) GO TO    80
+C
+C  FAILURE NO MORE SPACE ABORT THIS CONTOUR LEVEL
+C
+  200 IHOLD(1:39) = ' CONDRW-CONTOUR STORAGE EXAUSTED LEVEL='
+C
+C  BLANK FILL THE ENCODE ARRAY
+C
+        IVOUT = '                       '
+C +NOAO - FTN internal write rewritten as encode for IRAF.
+C
+C     WRITE(IVOUT,'(G13.5)')CONV
+      call encode (13, '(g13.5)', ivout, conv)
+C
+C -NOAO
+        IHOLD(40:62) = IVOUT
+      CALL SETER (IHOLD,10,IREC)
+      RETURN
+C
+C  BAD TIME THE CONTOUR EXITED A CORNER OF THE CELL MUST SEARCH FOR
+C  NEW CELL
+C
+  230 IXSTP = IXSTOR
+      IYSTP = IYSTOR
+      GO TO (  240,  250,  260,  270),IOLDC
+C
+C PREVIOUS CELL BOTTOM EXIT
+C
+  240 IXSTP = IXSTP-1
+      GO TO   280
+C
+C  PREVIOUS CELL LEFT EXIT
+C
+  250 IYSTP = IYSTP+1
+      GO TO   280
+C
+C  PREVIOUS CELL TOP EXIT
+C
+  260 IXSTP = IXSTP+1
+      GO TO   280
+C
+C  PREVIOUS CELL RIGHT EXIT
+C
+  270 IYSTP = IYSTP-1
+C
+C  BRANCH TO CURRENT CELL CASE
+C
+  280 GO TO (  290,  300,  310,  320),IC
+C
+C  APPARENT BOTTOM EXIT
+C
+  290 IXMOV(1) = 0
+      IXMOV(2) = 1
+      IYMOV(1) = -1
+      IYMOV(2) = 1
+      GO TO   330
+C
+C  APPARENT LEFT EXIT
+C
+  300 IXMOV(1) = 1
+      IXMOV(2) = -1
+      IYMOV(1) = 0
+      IYMOV(2) = -1
+      GO TO   330
+C
+C  APPARENT TOP EXIT
+C
+  310 IXMOV(1) = 0
+      IXMOV(2) = -1
+      IYMOV(1) = -1
+      IYMOV(2) = 1
+      GO TO   330
+C
+C  APPARENT RIGHT EXIT
+C
+  320 IXMOV(1) = 1
+      IXMOV(2) = -1
+      IYMOV(1) = 0
+      IYMOV(2) = 1
+C
+C  SEARCH THE POSSIBLE CELLS
+C
+  330     DO   350 K=1,2
+              DO   340 L=1,2
+              XC = XCSTOR + STPSZ*FLOAT( IXMOV(K) )
+              YC = YCSTOR + STPSZ*FLOAT( IYMOV(L) )
+              IX = IXSTOR+IXMOV(K)
+              IY = IYSTOR+IYMOV(L)
+              ILOC = IOR(ISHIFT(IX,ISHFCT),IY)
+C
+C  IF BACK TO START END CONTOUR
+C
+              IF (IX.EQ.JX .AND. IY.EQ.JY) GO TO   170
+C
+C  IF AT PREVIOUS CELL SKIP PROCESSING
+C
+              IF (IX.EQ.IXSTP .AND. IY.EQ.IYSTP) GO TO   340
+C
+C  COMPUTE CELL VALUES
+C
+              TL = SCRTCH(IX-1,IY-1)
+              BL = SCRTCH(IX,IY-1)
+              TR = SCRTCH(IX-1,IY)
+              BL = SCRTCH(IX,IY)
+              ICASE = IC
+              CALL CONCLD (ICASE,NOOP)
+              IF (ICASE.EQ.-1) GO TO 360
+              IF (ICASE.NE.0) GO TO    70
+C
+C  FAILURE TRY AGAIN
+C
+  340         CONTINUE
+  350     CONTINUE
+C
+C  NO MORE CONTOUR TRY OTHER END OF LINE
+C
+  360 IF (LOOP.EQ.0) GO TO   170
+      LOOP = 0
+      IX = JX
+      IY = JY
+      TR = TRT
+      TL = TLT
+      BR = BRT
+      BL = BLT
+      IC = IFCASE
+      ICASE = IC
+      IOLDC = IFOCSE
+      XC = XI
+      YC = YI
+      IXSTOR = IX
+      IYSTOR = IY
+      YCSTOR = YI
+      XCSTOR = XI
+      XX = FX(FXO,FYO)
+      CALL LASTD
+      CALL FRSTD (XX,FY(FXO,FYO))
+      GO TO (   90,  110,  130,  150),IC
+      END
diff --git a/sys/gio/ncarutil/conlib/conint.f b/sys/gio/ncarutil/conlib/conint.f
new file mode 100644
index 00000000..84a1be82
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conint.f
@@ -0,0 +1,147 @@
+      SUBROUTINE CONINT (NDP,XD,YD,ZD,NCP,IPC,PD)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS SUBROUTINE ESTIMATES PARTIAL DERIVATIVES OF THE FIRST AND
+C SECOND ORDER AT THE DATA POINTS.
+C THE INPUT PARAMETERS ARE
+C
+C     NDP = NUMBER OF DATA POINTS,
+C     XD,YD,ZD = ARRAYS CONTAINING THE X, Y, AND Z COORDI-
+C                NATES OF DATA POINTS,
+C     NCP = NUMBER OF DATA POINTS TO BE USED FOR ESTIMATION
+C           OF PARTIAL DERIVATIVES AT EACH DATA POINT,
+C     IPC = INTEGER ARRAY CONTAINING THE POINT NUMBERS OF
+C           NCP DATA POINTS CLOSEST TO EACH OF THE NDP DATA
+C           POINT.
+C THE OUTPUT PARAMETER IS
+C
+C     PD  = ARRAY OF DIMENSION 5*NDP, WHERE THE ESTIMATED
+C
+C           ZX, ZY, ZXX, ZXY, AND ZYY VALUES AT THE DATA
+C           POINTS ARE TO BE STORED.
+C DECLARATION STATEMENTS
+C
+C
+      DIMENSION       XD(NDP)    ,YD(NDP)    ,ZD(NDP)    ,IPC(1)     ,
+     1                PD(1)
+      REAL            NMX        ,NMY        ,NMZ        ,NMXX       ,
+     1                NMXY        ,NMYX       ,NMYY
+C
+      SAVE
+C
+C PRELIMINARY PROCESSING
+C
+C
+      NCPM1 = NCP-1
+C
+C ESTIMATION OF ZX AND ZY
+C
+C
+      DO  130 IP0=1,NDP
+         X0 = XD(IP0)
+         Y0 = YD(IP0)
+         Z0 = ZD(IP0)
+         NMX = 0.0
+         NMY = 0.0
+         NMZ = 0.0
+         JIPC0 = NCP*(IP0-1)
+         DO  120 IC1=1,NCPM1
+            JIPC = JIPC0+IC1
+            IPI = IPC(JIPC)
+            DX1 = XD(IPI)-X0
+            DY1 = YD(IPI)-Y0
+            DZ1 = ZD(IPI)-Z0
+            IC2MN = IC1+1
+            DO  110 IC2=IC2MN,NCP
+               JIPC = JIPC0+IC2
+               IPI = IPC(JIPC)
+               DX2 = XD(IPI)-X0
+               DY2 = YD(IPI)-Y0
+               DNMZ = DX1*DY2-DY1*DX2
+               IF (DNMZ .EQ. 0.0) GO TO  110
+               DZ2 = ZD(IPI)-Z0
+               DNMX = DY1*DZ2-DZ1*DY2
+               DNMY = DZ1*DX2-DX1*DZ2
+               IF (DNMZ .GE. 0.0) GO TO  100
+               DNMX = -DNMX
+               DNMY = -DNMY
+               DNMZ = -DNMZ
+  100          NMX = NMX+DNMX
+               NMY = NMY+DNMY
+               NMZ = NMZ+DNMZ
+  110       CONTINUE
+  120    CONTINUE
+         JPD0 = 5*IP0
+         PD(JPD0-4) = -NMX/NMZ
+         PD(JPD0-3) = -NMY/NMZ
+  130 CONTINUE
+C
+C ESTIMATION OF ZXX, ZXY, AND ZYY
+C
+C
+      DO  170 IP0=1,NDP
+         JPD0 = JPD0+5
+         X0 = XD(IP0)
+         JPD0 = 5*IP0
+         Y0 = YD(IP0)
+         ZX0 = PD(JPD0-4)
+         ZY0 = PD(JPD0-3)
+         NMXX = 0.0
+         NMXY = 0.0
+         NMYX = 0.0
+         NMYY = 0.0
+         NMZ = 0.0
+         JIPC0 = NCP*(IP0-1)
+         DO  160 IC1=1,NCPM1
+            JIPC = JIPC0+IC1
+            IPI = IPC(JIPC)
+            DX1 = XD(IPI)-X0
+            DY1 = YD(IPI)-Y0
+            JPD = 5*IPI
+            DZX1 = PD(JPD-4)-ZX0
+            DZY1 = PD(JPD-3)-ZY0
+            IC2MN = IC1+1
+            DO  150 IC2=IC2MN,NCP
+               JIPC = JIPC0+IC2
+               IPI = IPC(JIPC)
+               DX2 = XD(IPI)-X0
+               DY2 = YD(IPI)-Y0
+               DNMZ = DX1*DY2-DY1*DX2
+               IF (DNMZ .EQ. 0.0) GO TO  150
+               JPD = 5*IPI
+               DZX2 = PD(JPD-4)-ZX0
+               DZY2 = PD(JPD-3)-ZY0
+               DNMXX = DY1*DZX2-DZX1*DY2
+               DNMXY = DZX1*DX2-DX1*DZX2
+               DNMYX = DY1*DZY2-DZY1*DY2
+               DNMYY = DZY1*DX2-DX1*DZY2
+               IF (DNMZ .GE. 0.0) GO TO  140
+               DNMXX = -DNMXX
+               DNMXY = -DNMXY
+               DNMYX = -DNMYX
+               DNMYY = -DNMYY
+               DNMZ = -DNMZ
+  140          NMXX = NMXX+DNMXX
+               NMXY = NMXY+DNMXY
+               NMYX = NMYX+DNMYX
+               NMYY = NMYY+DNMYY
+               NMZ = NMZ+DNMZ
+  150       CONTINUE
+  160    CONTINUE
+         PD(JPD0-2) = -NMXX/NMZ
+         PD(JPD0-1) = -(NMXY+NMYX)/(2.0*NMZ)
+         PD(JPD0) = -NMYY/NMZ
+  170 CONTINUE
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conlcm.f b/sys/gio/ncarutil/conlib/conlcm.f
new file mode 100644
index 00000000..80791d49
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conlcm.f
@@ -0,0 +1,65 @@
+      FUNCTION CONLCM(X,Y,XD,YD,ZD,NDP,WK,IWK,LOC)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  COMPUTE A Z VALUE FOR A GIVEN X,Y VALUE
+C  NOTE THAT X,Y MUST BE INSIDE THE CONVEX HULL OF THE INPUT DATA
+C  INORDER FOR THIS FUNCTION TO WORK.
+C
+C  INPUT
+C       X-X COORDINATE OF REQUESTED POINT
+C       Y-Y COORDINATE OF REQUESTED POINT
+C       WK-LIST OF COEFICENTS FOR LINEAR INTERPOLATION  FUNCTIONS
+C             LOCATED BY A = WK((TRI-1)*3+1)
+C                        B = WK((TRI-2)*3+1)
+C                        C = WK((TRI-3)*3+1)
+C
+C  OUTPUT
+C       LOC-TRIANGLE NUMBER OF REQUESTED POINT
+C       Z VALUE AS FUNCTION RESULT
+C
+      DIMENSION WK(1),IWK(1),XD(1),YD(1),ZD(1)
+C
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+C
+        SAVE
+C
+C  LOCATE THE TRIANGLE
+C
+      CALL CONLOC(NDP,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),X,Y,LOC,
+     1            IWK(JWIWL),WK)
+C
+C  IF OUTSIDE CONVEX HULL THEN DON'T COMPUTE A VALUE
+C
+      IF (LOC.GT.NT) RETURN
+C
+C  GET THE VECTOR 1 VALUES FOR THE TRIANGLE
+C
+      IVEC = (LOC-1)*3 + JWIPT
+      IV = IWK(IVEC)
+      X1 = X - XD(IV)
+      Y1 = Y - YD(IV)
+      Z1 = ZD(IV)
+C
+C  COMPUT THE Z VALUE
+C
+      IPOINT = (LOC-1)*3 + IPR
+C
+      Z = (WK(IPOINT)*X1+WK(IPOINT+1)*Y1)/WK(IPOINT+2) + Z1
+C
+      CONLCM = Z
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conlin.f b/sys/gio/ncarutil/conlib/conlin.f
new file mode 100644
index 00000000..f940d48c
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conlin.f
@@ -0,0 +1,68 @@
+      SUBROUTINE CONLIN(XD,YD,ZD,NT,IWK,WK)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  THIS ROUTINE GENERATES THE COORDINATES USED IN A LINEAR INTERPOLATION
+C  OF THE TRIANGLES CREATED FROM IRREGULARLY DISTRIBUTED DATA.
+C
+C  INPUT
+C       XD-X INPUT COORDINATES]
+C       YD-Y INPUT COORDINATES
+C       ZD-Z VALUE AT INPUT X,Y
+C       NT-NUMBER OF TRIANGLES GENERATED
+C       IWK-LIST OF TRIANGLE POINTS, RELATIVE TO XD,YD
+C               GROUPED 3 PER TRIANGLE I.E. TRIANGLE 1 IWK(1,2,3),
+C               TRIANGLE 2 IWK(4,5,6)  ETC.
+C
+C  OUTPUT
+C       WK ARRAY OF COEFICENTS FOR LINEATION FORMUALS
+C               GROUPED 3 PER TRIANGLE
+C               POINTS ARE (TRI-1)*3 + 1,2,3
+C
+      DIMENSION IWK(1),WK(1),XD(1),YD(1),ZD(1)
+C
+        SAVE
+C
+C   LOOP FOR ALL TRIANGLES
+C
+      DO 1000 ITRI = 1,NT
+C
+C       GET THE POINTS OF THE TRIANGLE
+C
+        IPOINT = (ITRI-1)*3
+        IP1 = IWK(IPOINT+1)
+        IP2 = IWK(IPOINT+2)
+        IP3 = IWK(IPOINT+3)
+C
+C       GET THE VALUES AT THE TRIANBGLE POINTS
+C
+        X1 = XD(IP1)
+        Y1 = YD(IP1)
+        Z1 = ZD(IP1)
+        X2 = XD(IP2)
+        Y2 = YD(IP2)
+        Z2 = ZD(IP2)
+        X3 = XD(IP3)
+        Y3 = YD(IP3)
+        Z3 = ZD(IP3)
+C
+C  COMPUTE THE INTERPLOATING COEFICIENTS
+C
+        WK(IPOINT+1) = (Y2-Y1)*(Z3-Z1)-(Y3-Y1)*(Z2-Z1)
+        WK(IPOINT+2) = (X3-X1)*(Z2-Z1)-(X2-X1)*(Z3-Z1)
+        WK(IPOINT+3) = (X3-X1)*(Y2-Y1)-(X2-X1)*(Y3-Y1)
+C
+ 1000 CONTINUE
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conloc.f b/sys/gio/ncarutil/conlib/conloc.f
new file mode 100644
index 00000000..5907c9df
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conloc.f
@@ -0,0 +1,256 @@
+      SUBROUTINE CONLOC (NDP,XD,YD,NT,IPT,NL,IPL,XII,YII,ITI,IWK,WK)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS SUBROUTINE LOCATES A POINT, I.E., DETERMINES TO WHAT TRI-
+C ANGLE A GIVEN POINT (XII,YII) BELONGS.  WHEN THE GIVEN POINT
+C DOES NOT LIE INSIDE THE DATA AREA, THIS SUBROUTINE DETERMINES
+C THE BORDER LINE SEGMENT WHEN THE POINT LIES IN AN OUTSIDE
+C RECTANGULAR AREA, AND TWO BORDER LINE SEGMENTS WHEN THE POINT
+C LIES IN AN OUTSIDE TRIANGULAR AREA.
+C THE INPUT PARAMETERS ARE
+C     NDP = NUMBER OF DATA POINTS,
+C     XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y
+C           COORDINATES OF THE DATA POINTS,
+C     NT  = NUMBER OF TRIANGLES,
+C     IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE
+C           POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES,
+C     NL  = NUMBER OF BORDER LINE SEGMENTS,
+C     IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE
+C           POINT NUMBERS OF THE END POINTS OF THE BORDER
+C           LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE
+C           NUMBERS,
+C     XII,YII = X AND Y COORDINATES OF THE POINT TO BE
+C           LOCATED.
+C THE OUTPUT PARAMETER IS
+C     ITI = TRIANGLE NUMBER, WHEN THE POINT IS INSIDE THE
+C           DATA AREA, OR
+C           TWO BORDER LINE SEGMENT NUMBERS, IL1 AND IL2,
+C           CODED TO IL1*(NT+NL)+IL2, WHEN THE POINT IS
+C           OUTSIDE THE DATA AREA.
+C THE OTHER PARAMETERS ARE
+C     IWK = INTEGER ARRAY OF DIMENSION 18*NDP USED INTER-
+C           NALLY AS A WORK AREA,
+C     WK  = ARRAY OF DIMENSION 8*NDP USED INTERNALLY AS A
+C           WORK AREA.
+C DECLARATION STATEMENTS
+C
+      DIMENSION       XD(1)      ,YD(1)      ,IPT(1)     ,IPL(1)     ,
+     1                IWK(1)     ,WK(1)
+C
+C
+C
+      DIMENSION       NTSC(9)    ,IDSC(9)
+      COMMON /CONRA5/ NIT        ,ITIPV
+C
+        SAVE
+C
+C STATEMENT FUNCTIONS
+C
+      SIDE(U1,V1,U2,V2,U3,V3) = (U1-U3)*(V2-V3)-(V1-V3)*(U2-U3)
+      SPDT(U1,V1,U2,V2,U3,V3) = (U1-U2)*(U3-U2)+(V1-V2)*(V3-V2)
+C
+C PRELIMINARY PROCESSING
+C
+      NT0 = NT
+      NL0 = NL
+      NTL = NT0+NL0
+      X0 = XII
+      Y0 = YII
+C
+C PROCESSING FOR A NEW SET OF DATA POINTS
+C
+      IF (NIT .NE. 0) GO TO  170
+      NIT = 1
+C
+C - DIVIDES THE X-Y PLANE INTO NINE RECTANGULAR SECTIONS.
+C
+      XMN = XD(1)
+      XMX = XMN
+      YMN = YD(1)
+      YMX = YMN
+      DO  100 IDP=2,NDP
+         XI = XD(IDP)
+         YI = YD(IDP)
+         XMN = AMIN1(XI,XMN)
+         XMX = AMAX1(XI,XMX)
+         YMN = AMIN1(YI,YMN)
+         YMX = AMAX1(YI,YMX)
+  100 CONTINUE
+      XS1 = (XMN+XMN+XMX)/3.0
+      XS2 = (XMN+XMX+XMX)/3.0
+      YS1 = (YMN+YMN+YMX)/3.0
+      YS2 = (YMN+YMX+YMX)/3.0
+C
+C - DETERMINES AND STORES IN THE IWK ARRAY TRIANGLE NUMBERS OF
+C - THE TRIANGLES ASSOCIATED WITH EACH OF THE NINE SECTIONS.
+C
+      DO  110 ISC=1,9
+         NTSC(ISC) = 0
+         IDSC(ISC) = 0
+  110 CONTINUE
+      IT0T3 = 0
+      JWK = 0
+      DO  160 IT0=1,NT0
+         IT0T3 = IT0T3+3
+         I1 = IPT(IT0T3-2)
+         I2 = IPT(IT0T3-1)
+         I3 = IPT(IT0T3)
+         XMN = AMIN1(XD(I1),XD(I2),XD(I3))
+         XMX = AMAX1(XD(I1),XD(I2),XD(I3))
+         YMN = AMIN1(YD(I1),YD(I2),YD(I3))
+         YMX = AMAX1(YD(I1),YD(I2),YD(I3))
+         IF (YMN .GT. YS1) GO TO  120
+         IF (XMN .LE. XS1) IDSC(1) = 1
+         IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(2) = 1
+         IF (XMX .GE. XS2) IDSC(3) = 1
+  120    IF (YMX.LT.YS1 .OR. YMN.GT.YS2) GO TO  130
+         IF (XMN .LE. XS1) IDSC(4) = 1
+         IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(5) = 1
+         IF (XMX .GE. XS2) IDSC(6) = 1
+  130    IF (YMX .LT. YS2) GO TO  140
+         IF (XMN .LE. XS1) IDSC(7) = 1
+         IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(8) = 1
+         IF (XMX .GE. XS2) IDSC(9) = 1
+  140    DO  150 ISC=1,9
+            IF (IDSC(ISC) .EQ. 0) GO TO  150
+            JIWK = 9*NTSC(ISC)+ISC
+            IWK(JIWK) = IT0
+            NTSC(ISC) = NTSC(ISC)+1
+            IDSC(ISC) = 0
+  150    CONTINUE
+C
+C - STORES IN THE WK ARRAY THE MINIMUM AND MAXIMUM OF THE X AND
+C - Y COORDINATE VALUES FOR EACH OF THE TRIANGLE.
+C
+         JWK = JWK+4
+         WK(JWK-3) = XMN
+         WK(JWK-2) = XMX
+         WK(JWK-1) = YMN
+         WK(JWK) = YMX
+  160 CONTINUE
+      GO TO  200
+C
+C CHECKS IF IN THE SAME TRIANGLE AS PREVIOUS.
+C
+  170 IT0 = ITIPV
+      IF (IT0 .GT. NT0) GO TO  180
+      IT0T3 = IT0*3
+      IP1 = IPT(IT0T3-2)
+      X1 = XD(IP1)
+      Y1 = YD(IP1)
+      IP2 = IPT(IT0T3-1)
+      X2 = XD(IP2)
+      Y2 = YD(IP2)
+      IF (SIDE(X1,Y1,X2,Y2,X0,Y0) .LT. 0.0) GO TO  200
+      IP3 = IPT(IT0T3)
+      X3 = XD(IP3)
+      Y3 = YD(IP3)
+      IF (SIDE(X2,Y2,X3,Y3,X0,Y0) .LT. 0.0) GO TO  200
+      IF (SIDE(X3,Y3,X1,Y1,X0,Y0) .LT. 0.0) GO TO  200
+      GO TO  260
+C
+C CHECKS IF ON THE SAME BORDER LINE SEGMENT.
+C
+  180 IL1 = IT0/NTL
+      IL2 = IT0-IL1*NTL
+      IL1T3 = IL1*3
+      IP1 = IPL(IL1T3-2)
+      X1 = XD(IP1)
+      Y1 = YD(IP1)
+      IP2 = IPL(IL1T3-1)
+      X2 = XD(IP2)
+      Y2 = YD(IP2)
+      IF (IL2 .NE. IL1) GO TO  190
+      IF (SPDT(X1,Y1,X2,Y2,X0,Y0) .LT. 0.0) GO TO  200
+      IF (SPDT(X2,Y2,X1,Y1,X0,Y0) .LT. 0.0) GO TO  200
+      IF (SIDE(X1,Y1,X2,Y2,X0,Y0) .GT. 0.0) GO TO  200
+      GO TO  260
+C
+C CHECKS IF BETWEEN THE SAME TWO BORDER LINE SEGMENTS.
+C
+  190 IF (SPDT(X1,Y1,X2,Y2,X0,Y0) .GT. 0.0) GO TO  200
+      IP3 = IPL(3*IL2-1)
+      X3 = XD(IP3)
+      Y3 = YD(IP3)
+      IF (SPDT(X3,Y3,X2,Y2,X0,Y0) .LE. 0.0) GO TO  260
+C
+C LOCATES INSIDE THE DATA AREA.
+C - DETERMINES THE SECTION IN WHICH THE POINT IN QUESTION LIES.
+C
+  200 ISC = 1
+      IF (X0 .GE. XS1) ISC = ISC+1
+      IF (X0 .GE. XS2) ISC = ISC+1
+      IF (Y0 .GE. YS1) ISC = ISC+3
+      IF (Y0 .GE. YS2) ISC = ISC+3
+C
+C - SEARCHES THROUGH THE TRIANGLES ASSOCIATED WITH THE SECTION.
+C
+      NTSCI = NTSC(ISC)
+      IF (NTSCI .LE. 0) GO TO  220
+      JIWK = -9+ISC
+      DO  210 ITSC=1,NTSCI
+         JIWK = JIWK+9
+         IT0 = IWK(JIWK)
+         JWK = IT0*4
+         IF (X0 .LT. WK(JWK-3)) GO TO  210
+         IF (X0 .GT. WK(JWK-2)) GO TO  210
+         IF (Y0 .LT. WK(JWK-1)) GO TO  210
+         IF (Y0 .GT. WK(JWK)) GO TO  210
+         IT0T3 = IT0*3
+         IP1 = IPT(IT0T3-2)
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+         IP2 = IPT(IT0T3-1)
+         X2 = XD(IP2)
+         Y2 = YD(IP2)
+         IF (SIDE(X1,Y1,X2,Y2,X0,Y0) .LT. 0.0) GO TO  210
+         IP3 = IPT(IT0T3)
+         X3 = XD(IP3)
+         Y3 = YD(IP3)
+         IF (SIDE(X2,Y2,X3,Y3,X0,Y0) .LT. 0.0) GO TO  210
+         IF (SIDE(X3,Y3,X1,Y1,X0,Y0) .LT. 0.0) GO TO  210
+         GO TO  260
+  210 CONTINUE
+C
+C LOCATES OUTSIDE THE DATA AREA.
+C
+  220 DO  240 IL1=1,NL0
+         IL1T3 = IL1*3
+         IP1 = IPL(IL1T3-2)
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+         IP2 = IPL(IL1T3-1)
+         X2 = XD(IP2)
+         Y2 = YD(IP2)
+         IF (SPDT(X2,Y2,X1,Y1,X0,Y0) .LT. 0.0) GO TO  240
+         IF (SPDT(X1,Y1,X2,Y2,X0,Y0) .LT. 0.0) GO TO  230
+         IF (SIDE(X1,Y1,X2,Y2,X0,Y0) .GT. 0.0) GO TO  240
+         IL2 = IL1
+         GO TO  250
+  230    IL2 = MOD(IL1,NL0)+1
+         IP3 = IPL(3*IL2-1)
+         X3 = XD(IP3)
+         Y3 = YD(IP3)
+         IF (SPDT(X3,Y3,X2,Y2,X0,Y0) .LE. 0.0) GO TO  250
+  240 CONTINUE
+      IT0 = 1
+      GO TO  260
+  250 IT0 = IL1*NTL+IL2
+C
+C NORMAL EXIT
+C
+  260 ITI = IT0
+      ITIPV = IT0
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conlod.f b/sys/gio/ncarutil/conlib/conlod.f
new file mode 100644
index 00000000..d7fc3804
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conlod.f
@@ -0,0 +1,194 @@
+      SUBROUTINE CONLOD (XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C******************************************************************
+C*                                                                *
+C*   THIS FILE IS A PACKAGE OF SUPPORT ROUTINES FOR THE ULIB      *
+C*   FILES CONRAN AND CONRAS.  SEE THOSE FILES FOR AN             *
+C*   EXPLAINATION OF THE ENTRY POINTS.                            *
+C*                                                                *
+C******************************************************************
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      DIMENSION       SCRARR(1)
+C
+        SAVE
+C
+C  IFR - FLAG TO REGISTER FIRST PASS IN Y DIRECTION
+C
+C  LOAD THE SCRATCH SPACE AND CONVEX HULL POINTERS
+C  ITLOC IS THE LIST OF CONVEX HULL POINTERS RELATIVE TO THE SCARTCH
+C  SPACE.
+C  PV IS THE LIST OF CONVEX HULL POINTERS RELATIVE TO USER COORDINATES
+C
+C  INITALIZE THE SPECIAL VALUE FEATURE
+C
+      X = (XED-XST)/2. + XST
+      Y = (YED-YST)/2. + YST
+      IF(LINEAR) GO TO 1
+      SPVAL = CONCOM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+        GO TO 2
+ 1    SPVAL = CONLCM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+ 2    CONTINUE
+C
+C  INITIALIZE THE SEARCH
+C
+      IYMAX = 0
+      IFR = 1
+      JX = 1
+      X = XST
+   10 JY = 1
+      Y = YST
+C
+C  SET HULL POINTERS FOR THIS COLUMN TO NULL
+C
+      ITLOC(JX*2-1) = 0
+      ITLOC(JX*2) = 0
+C
+C  FLAG START OF COLUMN
+C
+      LOOP = 1
+C
+C  GET INTERPOLATED VALUE
+C
+  20  IF (LINEAR) GO TO 3
+      RVAL = CONCOM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+      GO TO 4
+  3   RVAL = CONLCM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+  4   CONTINUE
+      SCRARR(JY+(JX-1)*IYMAX) = RVAL
+      IF (RVAL.GT.SPVAL) SPVAL = RVAL
+C
+C  IF OUTSIDE CONVEX HULL BRANCH
+C
+      IF (IT.GT.NTNL) GO TO    30
+C
+C  IF OUTSIDE TRIANGLES AND USING LINEAR INTERPLOATION THEN BRANCH
+C
+      IF(LINEAR.AND.IT.GT.NT) GO TO 30
+C
+C  IF FIRST OF COLUMN IN HULL CONTINUE THROUGH
+C
+      IF (LOOP.NE.1) GO TO    40
+C
+C  SET HULL POINTERS
+C
+      PV(JX*2-1) = Y
+      ITLOC(JX*2-1) = JY
+C
+C  SET FLAG TO LOOK FOR END OF HULL IN COLUMN
+C
+      LOOP = 2
+C
+C  GO FOR NEXT ENTRY
+C
+      GO TO    40
+C
+C  TEST FOR END OF CONVEX HULL ON THIS ROW
+C
+   30 IF (LOOP.NE.2) GO TO    40
+C
+C  END OF HULL SET POINTERS FOR END OF HULL AND FLAG IT VIA LOOP
+C
+      LOOP = 0
+      ITLOC(JX*2) = JY-1
+      PV(JX*2) = Y-STPSZ
+C
+C  GET NEXT ELEMENT IN ROW IF NOT OUTSIDE ENCLOSING RECTANGULAR
+C  BOARDER
+C
+   40 Y = Y+STPSZ
+      JY = JY+1
+      IF (Y.LE.YED) GO TO    20
+C
+C  TEST FOR FIRST COLUMN
+C
+      IF (IFR.NE.1) GO TO    50
+C
+C  FIRST COLUMN OVER SET MAX Y VALUES
+C
+      IYMAX = JY-1
+      YMAX = Y-STPSZ
+      IFR = 0
+C
+C  IF HULL WENT TO EDGE OF RECTANGULAR BOARDER SET HULL POINTERS HERE
+C
+   50 IF (LOOP.NE.2) GO TO    60
+      PV(JX*2) = Y-STPSZ
+      ITLOC(JX*2) = JY-1
+C
+C  END OF COLUMN GET NEXT ONE
+C
+   60 X = X+STPSZ
+      JX = JX+1
+C
+C  IF NOT END OF WORK CONTINUE WITH NEXT COLUMN
+C
+      IF (X.LE.XED) GO TO    10
+C
+C  END OF WORK SET MAX X VALUES
+C
+      IXMAX = JX-1
+      XMAX = X-STPSZ
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conop1.f b/sys/gio/ncarutil/conlib/conop1.f
new file mode 100644
index 00000000..fc61872d
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conop1.f
@@ -0,0 +1,465 @@
+      SUBROUTINE CONOP1 (IOPT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SET THE CONTRAN OPTIONS
+C
+C INPUT
+C     IOPT-CHARACTER STRING OF OPTION VALUE
+C
+C  SET COMMON DATA EQUAL TO INPUT DATA
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+        COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
+C
+C
+C
+C  INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE
+C  NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF
+C  CONFLICT
+C
+      COMMON /INTPR/  IPAU       ,FPART      ,TENSN      ,NP11       ,
+     1                SMALL      ,L1         ,ADDLR      ,ADDTB      ,
+     2                MLLINE     ,ICLOSE
+        CHARACTER*7  IOPT
+        CHARACTER*2  TAG, OPT
+C
+C
+        SAVE
+C
+c +NOAO - initialize block data before changing any values
+        call conbdn
+c -NOAO
+C  DETERMINE OPTION AND ITS VALUE
+C
+        TAG = IOPT(1:2)
+        IF (IOPT(3:3) .EQ. '=') THEN
+                OPT = IOPT(4:5)
+        ELSE
+            OPT = IOPT(5:6)
+        ENDIF
+C
+C  REP FOUND CHECK VALUE OF SWITCH
+C
+      IF (TAG .EQ. 'RE') THEN
+C
+C  SWITCH = ON CONTOUR SAME DATA
+C
+            IF (OPT .EQ. 'ON') THEN
+              REPEAT = .TRUE.
+              RETURN
+C
+C  SWITCH = OFF CONTOUR NEW DATA
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              REPEAT = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  EXTRAPOLATION FLAG
+C
+      ELSEIF (TAG .EQ. 'EX') THEN
+C
+C  SWITCH = ON EXTRAPOLATE WHEN CONTOURING
+C
+            IF (OPT .EQ. 'ON') THEN
+              EXTRAP = .TRUE.
+              RETURN
+C
+C  SWITCH = OFF INTERPOLATE ONLY
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              EXTRAP = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  PER FOUND SET PERIMETER
+C
+      ELSEIF (TAG .EQ. 'PE') THEN
+C
+C  SWITCH = ON DRAW PERIMETERS
+C
+            IF (OPT .EQ. 'ON') THEN
+              PER = .TRUE.
+C
+C  TURN GRID OFF, USER WANTS PERIMETER
+C
+             GRD = .FALSE.
+             RETURN
+C
+C  SWITCH = OFF DO NOT DRAW PERIMETERS
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+             PER = .FALSE.
+             RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  DEF FOUND SET ALL OPTIONS TO DEFAULT (NO SWITCHES)
+C
+        ELSEIF (TAG .EQ. 'DE') THEN
+      PER = .TRUE.
+      LISTOP = .FALSE.
+      PMIMX = .FALSE.
+      SCALE = 1.
+      TENSN = TENS
+      EXTRAP = .FALSE.
+      TITLE = .FALSE.
+      ITLSIZ = 16
+      REPEAT = .FALSE.
+      MESS = .TRUE.
+      CON = .FALSE.
+      CINC = .FALSE.
+      CHILO = .FALSE.
+      IGRAD = IG
+      ISCALE = 0
+      NCP = 4
+      LOOK = .FALSE.
+      GRD = .FALSE.
+      PLDVLS = .FALSE.
+      INMAJ = 1
+      INMIN = 1
+      INDAT = 1
+      INLAB = 1
+      IRANMJ = 1
+      IRANMN = 1
+      IRANTX = 1
+      IRASMJ = 1
+      IRASMN = 1
+      IRASTX = 1
+      IRAQMJ = 1
+      IRAQMN = 1
+      IRAQTX = 1
+      BPSIZ = 0.
+      LABON = .TRUE.
+      ISIZEL = 9
+      ISIZEP = 8
+      ISIZEM = 15
+      FRADV = .TRUE.
+      EXTRI = .FALSE.
+      MINGAP = 3
+      LINEAR = .FALSE.
+      ICOUNT = 0
+      SHIELD = .FALSE.
+      SLDPLT = .FALSE.
+C
+C  SET DEFAULT DASH PATTERN
+C
+         IDASH = '$$$$$$$$$$'
+         NDASH = '$$$$$$$$$$'
+         EDASH = '$$$$$$$$$$'
+C
+C  SET DEFAULT FORMAT
+C
+         FORM = '(G10.3)'
+      RETURN
+C
+C  MES FOUND TEST VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'ME') THEN
+C
+C  ACTIVATE CONRAN MESSAGE
+C
+            IF (OPT .EQ. 'ON') THEN
+              MESS = .TRUE.
+              RETURN
+C
+C  TURN OFF CONRAN MESSAGE
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              MESS = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+          ENDIF
+C
+C  SCALING OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'SC') THEN
+C
+C  SET VALUE OF SCALE FLAG
+C
+            IF (OPT .EQ. 'ON') THEN
+                  ISCALE = 0
+                  RETURN
+            ELSEIF (OPT .EQ. 'OF') THEN
+                  ISCALE = 1
+                  RETURN
+            ELSEIF (OPT .EQ. 'PR') THEN
+                  ISCALE = 2
+                  RETURN
+            ELSE
+                  GOTO 120
+            ENDIF
+C
+C  TRIANGLE FLAG GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'TR') THEN
+C
+C  SWITCH ON
+C
+            IF (OPT .EQ. 'ON') THEN
+              LOOK = .TRUE.
+              RETURN
+C
+C  SWITCH OFF
+C
+          ELSEIF (OPT .EQ. 'OF') THEN
+              LOOK = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+          ENDIF
+C
+C  PLOT DATA VALUES FLAG GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'PD') THEN
+C
+C SWITCH ON
+C
+            IF (OPT .EQ. 'ON') THEN
+              PLDVLS = .TRUE.
+              RETURN
+C
+C  SWITCH OFF
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              PLDVLS = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  GRID OPTION ACTIVATED GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'GR') THEN
+C
+C  SWITCH ON SET GRID FLAG
+C
+            IF (OPT .EQ. 'ON') THEN
+              GRD = .TRUE.
+C
+C  TURN PER OFF USER WANTS GRID
+C
+              PER = .FALSE.
+              RETURN
+C
+C  SWITCH OFF CLEAR GRID FLAG
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              GRD = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  LABEL PLOTTING FLAG GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'LA') THEN
+C
+C  SWITCH ON LABEL CONTOURS
+C
+            IF (OPT .EQ. 'ON') THEN
+              LABON = .TRUE.
+                RETURN
+C
+C  SWITCH OFF DON"T LABEL CONTOURS
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              LABON = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  PLOT THE RELATIVE MIN"S AND MAX"S
+C
+      ELSEIF (TAG .EQ. 'PM') THEN
+C
+C  SWTICH ON PLOT THE INFO
+C
+            IF (OPT .EQ. 'ON') THEN
+              PMIMX = .TRUE.
+                RETURN
+C
+C  SWTICH OFF DO NOT PLOT THE INFO
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              PMIMX = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  ADVANCE FRAME BEFORE TRIANGULATION PLOT
+C
+      ELSEIF (TAG .EQ. 'TF') THEN
+C
+C  SWITCH ON ADVANCE FRAME
+C
+          IF (OPT .EQ. 'ON') THEN
+                FRADV = .TRUE.
+                RETURN
+C
+C  SWITCH OFF DO NOT ADVANCE FRAME
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                FRADV = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  EXIT AFTER TRIANGULATION
+C
+      ELSEIF (TAG .EQ. 'TO') THEN
+C
+C  SWITCH ON EXIT AFTER TRIANGULATION
+C
+          IF (OPT .EQ. 'ON') THEN
+                EXTRI = .TRUE.
+                LOOK = .TRUE.
+                FRADV = .FALSE.
+                RETURN
+C
+C  SWITCH OFF DO NOT EXIT AFTER TRIANGULATION
+C
+          ELSEIF (OPT .EQ. 'OF') THEN
+                FRADV = .TRUE.
+                LOOK = .FALSE.
+                EXTRI = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  LIST OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'LO') THEN
+C
+C  ON SET LIST OPTIONS FLAG
+C
+            IF (OPT .EQ. 'ON') THEN
+              LISTOP = .TRUE.
+                RETURN
+C
+C  TURN OFF LIST OPTIONS FLAG
+C
+          ELSEIF (OPT .EQ. 'OF') THEN
+              LISTOP = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET THE INTERPOLATION SCHEME
+C
+      ELSEIF (TAG .EQ. 'IT') THEN
+C
+C  SET TO C1 SURFACE
+C
+            IF (OPT .EQ. 'C1') THEN
+              LINEAR = .FALSE.
+                RETURN
+C
+C  SET TO LINEAR INTERPOLATION
+C
+            ELSEIF (OPT .EQ. 'LI') THEN
+                LINEAR = .TRUE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET THE SHIELD PLOT FLAG
+C
+      ELSEIF (TAG .EQ. 'PS') THEN
+C
+C  TURN ON SHIELD PLOT
+C
+            IF (OPT .EQ. 'ON') THEN
+                SLDPLT = .TRUE.
+                RETURN
+C
+C  TURN OFF SHIELD PLOT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                SLDPLT = .FALSE.
+                RETURN
+            ELSE
+                  GOTO 120
+            ENDIF
+        ELSE
+            GOTO 120
+        ENDIF
+C
+C  ERROR UNDEFINED OPTION DETECTED
+C
+  120 CALL SETER (' CONOP1 -- UNDEFINED OPTION',1,1)
+      RETURN
+C
+        END
diff --git a/sys/gio/ncarutil/conlib/conop2.f b/sys/gio/ncarutil/conlib/conop2.f
new file mode 100644
index 00000000..41dc27c3
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conop2.f
@@ -0,0 +1,316 @@
+      SUBROUTINE CONOP2 (IOPT,ISIZE)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SET THE CONTRAN OPTIONS
+C
+C INPUT
+C     IOPT-CHARACTER STRING OF OPTION VALUE
+C     ISIZE-  INTEGER INPUT
+C
+C  SET COMMON DATA EQUAL TO INPUT DATA
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+        COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
+C
+C
+C
+C  INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE
+C  NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF
+C  CONFLICT
+C
+      COMMON /INTPR/  IPAU       ,FPART      ,TENSN      ,NP11       ,
+     1                SMALL      ,L1         ,ADDLR      ,ADDTB      ,
+     2                MLLINE     ,ICLOSE
+        CHARACTER*7  IOPT
+        CHARACTER*2  TAG, OPT
+C
+        SAVE
+C +NOAO - initialize block data before changing any values
+        call conbdn
+c -NOAO
+C  DETERMINE THE OPTION DESIRED
+C
+      TAG = IOPT(1:2)
+        IF (IOPT(3:3) .EQ. '=') THEN
+            OPT = IOPT(4:5)
+        ELSE
+            OPT = IOPT(5:6)
+        ENDIF
+C
+C  SET RESOLUTION OF VIRTUAL GRID
+C
+      IF (TAG .EQ. 'SS') THEN
+C
+C  SWITCH = ON SET RESOLUTION OF VIRTUAL GRID
+C
+            IF (OPT .EQ. 'ON') THEN
+              IGRAD = ISIZE
+              RETURN
+C
+C  SWITCH = OFF RESET RESOLUTION TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              IGRAD = IG
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  NCP OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'NC') THEN
+C
+C  SWITCH ON GET VALUE FOR NUMBER OF SURROUNDING DATA POINTS TO USE
+C
+            IF (OPT .EQ. 'ON') THEN
+              NCP = ISIZE
+              RETURN
+C
+C  SWITCH OFF SET TO DEFAULT VALUE
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              NCP = 4
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  INTENSITY OPTION FOUND GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'IN') THEN
+C
+C  SWITCH OFF SET DEFAULT VALUES
+C
+            IF (OPT .EQ. 'OF') THEN
+                  IRANMJ = 1
+                  IRANMN = 1
+                  IRANTX = 1
+                  IRASMJ = 1
+                  IRASMN = 1
+                  IRASTX = 1
+                  IRAQMJ = 1
+                  IRAQMN = 1
+                  IRAQTX = 1
+              INMAJ = 1
+              INMIN = 1
+              INDAT = 1
+              INLAB = 1
+              RETURN
+C
+C  SET PLOTTED DATA INTENSITY
+C
+            ELSEIF (OPT .EQ. 'DA') THEN
+              INDAT = ISIZE
+              RETURN
+C
+C SET TITLE AND MESSAGE INTENSITY
+C
+            ELSEIF (OPT .EQ. 'LA') THEN
+              INLAB = ISIZE
+                  IRANTX = ISIZE
+                  IRASTX = ISIZE
+                  IRAQTX = ISIZE
+              RETURN
+C
+C  SET ALL INTENSITIES TO THE SAME VALUE
+C
+            ELSEIF (OPT .EQ. 'AL') THEN
+                  IRANMJ = ISIZE
+                  IRANMN = ISIZE
+                  IRANTX = ISIZE
+                  IRASMJ = ISIZE
+                  IRASMN = ISIZE
+                  IRASTX = ISIZE
+                  IRAQMJ = ISIZE
+                  IRAQMN = ISIZE
+                  IRAQTX = ISIZE
+              INMAJ = ISIZE
+                INMIN = ISIZE
+              INLAB = ISIZE
+              INDAT = ISIZE
+              RETURN
+C
+C  SET MAJOR LINE INTENSITY
+C
+            ELSEIF (OPT .EQ. 'MA') THEN
+                  IRANMJ = ISIZE
+                  IRASMJ = ISIZE
+                  IRAQMJ = ISIZE
+              INMAJ = ISIZE
+              RETURN
+C
+C  SET MINOR LINE INTENSITY
+C
+            ELSEIF (OPT .EQ. 'MI') THEN
+                  IRANMN = ISIZE
+                  IRASMN = ISIZE
+                  IRAQMN = ISIZE
+                INMIN = ISIZE
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  LABEL SIZE OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'LS') THEN
+C
+C  SWITCH ON GET USER LABEL SIZE
+C
+            IF (OPT .EQ. 'ON') THEN
+                ISIZEL = ISIZE
+                RETURN
+C
+C  SWITCH OFF SET LABEL SIZE TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                ISIZEL = 9
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET SIZES OF MINIMUM AND MAXIMUM LABELS
+C
+      ELSEIF (TAG .EQ. 'SM') THEN
+C
+C  SWTICH ON GET USERS SIZE
+C
+            IF (OPT .EQ. 'ON') THEN
+                ISIZEM = ISIZE
+                RETURN
+C
+C  SWTICH OFF SET TO DEFAULT VALUE
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                ISIZEM = 15
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET SIZE OF THE PLOTTED DATA
+C
+      ELSEIF (TAG .EQ. 'SP') THEN
+C
+C  SWTICH ON GET USERS SIZE
+C
+            IF (OPT .EQ. 'ON') THEN
+                ISIZEP = ISIZE
+                RETURN
+C
+C  SWTICH OFF SET TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                ISIZEP = 8
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  TITLE SIZE SWITCH
+C
+      ELSEIF (TAG .EQ. 'ST') THEN
+C
+C  SWITCH ON SET THE TITLE SIZE
+C
+            IF (OPT .EQ. 'ON') THEN
+                ITLSIZ = ISIZE
+                RETURN
+C
+C  SWITCH OFF SET TITLE SIZE TO DEFAULT VALUE
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                ITLSIZ = 16
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  MINOR LINE COUNT OPTION
+C
+      ELSEIF (TAG .EQ. 'MI') THEN
+C
+C  SET MINOR LINE COUNT
+C
+            IF (OPT .EQ. 'ON') THEN
+                MINGAP = ISIZE+1
+                RETURN
+C
+C  SET MINOR LINE COUNT TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                MINGAP = 3
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+        ELSE
+            GOTO 120
+        ENDIF
+C
+C  ERROR UNDEFINED OPTION DETECTED
+C
+  120 CALL SETER (' CONOP2 - UNDEFINED OPTION',1,1)
+      RETURN
+        END
diff --git a/sys/gio/ncarutil/conlib/conop3.f b/sys/gio/ncarutil/conlib/conop3.f
new file mode 100644
index 00000000..e4632478
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conop3.f
@@ -0,0 +1,266 @@
+      SUBROUTINE CONOP3 (IOPT,ARRAY,ISIZE)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SET THE CONTRAN OPTIONS
+C
+C INPUT
+C     IOPT-CHARACTER STRING OF OPTION VALUE
+C     ARRAY-   REAL ARRAY OF DIMENSION ISIZE
+C     ISIZE-   SIZE OF ARRAY
+C
+C  SET COMMON DATA EQUAL TO INPUT DATA
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C
+C  INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE
+C  NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF
+C  CONFLICT
+C
+      COMMON /INTPR/  IPAU       ,FPART      ,TENSN      ,NP11       ,
+     1                SMALL      ,L1         ,ADDLR      ,ADDTB      ,
+     2                MLLINE     ,ICLOSE
+        DIMENSION ARRAY(ISIZE)
+        CHARACTER*7  IOPT
+        CHARACTER*2  TAG, OPT
+C
+C
+        SAVE
+C
+C +NOAO - initialize block data before changing any values
+        call conbdn
+c -NOAO
+C  DETERMINE THE OPTION DESIRED
+C
+      TAG = IOPT(1:2)
+        IF (IOPT(3:3) .EQ. '=') THEN
+            OPT = IOPT(4:5)
+        ELSE
+            OPT = IOPT(5:6)
+        ENDIF
+C
+C  CON CONTOUR LEVELS  CHECK VALUE OF SWITCH
+C
+      IF (TAG .EQ. 'CO') THEN
+C
+C  SWITCH = ON SET CONTOUR LEVELS
+C
+          IF (OPT .EQ. 'ON') THEN
+              IF (CHILO .OR. CINC) GOTO  140
+C
+C  TEST IF NUMBER OF CONTOURS IS ACCEPTABLE
+C
+              IF (ISIZE .GT. 30)
+     1    CALL SETER (' CONOP3-NUMBER OF CONTOUR LEVELS EXCEEDS 30',
+     2                 1,1)
+      DO  200 I=1,ISIZE
+       CL(I) = ARRAY(I)
+  200 CONTINUE
+      CON = .TRUE.
+      NCL = ISIZE
+      RETURN
+C
+C  SWITCH = OFF CLEAR CONTOUR LEVEL ARRAY (PROGRAM SELECTS)
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              CON = .FALSE.
+              RETURN
+            ELSE
+                  GOTO 120
+          ENDIF
+C
+C  CONTOUR HI LO OPTION FOUND GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'CH') THEN
+C
+C  SWITCH ON SET HI AND FLO
+C
+            IF (OPT .EQ. 'ON') THEN
+              IF (CON) GOTO  140
+                  HI = ARRAY(1)
+                  FLO = ARRAY(2)
+                  CHILO = .TRUE.
+                  RETURN
+C
+C  SWITCH OFF CLEAR FLAG
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                CHILO = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  CONTOUR INCREMENT OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'CI') THEN
+C
+C  SWITCH ON SET INCREMENT
+C
+          IF (OPT .EQ. 'ON') THEN
+              IF (CON) GOTO  140
+              CINC = .TRUE.
+              FINC = ARRAY(1)
+              RETURN
+C
+C  SWITCH OFF CLEAR FLAG
+C
+          ELSEIF (OPT .EQ. 'OF') THEN
+              CINC = .FALSE.
+              RETURN
+        ELSE
+                GOTO 120
+          ENDIF
+C
+C  SCALE THE DATA PLOTTED ON THE CONTOURS AND MIN MAX POINTS
+C
+      ELSEIF (TAG .EQ. 'SD') THEN
+C
+C  SWTICH ON GET SCALE FACTOR
+C
+            IF (OPT .EQ. 'ON') THEN
+                SCALE = ARRAY(1)
+                RETURN
+C
+C  SWTICH OFF SET FOR NO SCALING
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                SCALE = 1.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET THE TENSION VALUE FOR SMOOTHING
+C
+      ELSEIF (TAG .EQ. 'TE') THEN
+C
+C  SWTICH ON SET TENSION FACTOR
+C
+            IF (OPT .EQ. 'ON') THEN
+                TENSN = ARRAY(1)
+                RETURN
+C
+C  SWTICH OFF SET TO DEFAULT TENSION
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                TENSN = TENS
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  DASH PATTERN BREAK POINT SWITCH
+C
+      ELSEIF (TAG .EQ. 'DB') THEN
+C
+C  SWITCH ON GET USERS BREAKPOINT
+C
+            IF (OPT .EQ. 'ON') THEN
+                BPSIZ = ARRAY(1)
+                RETURN
+C
+C  SWITCH OFF SET TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                BPSIZ = 0.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SHIELD OPTION
+C
+        ELSEIF (TAG .EQ. 'SL') THEN
+C
+C  TURN SHIELDING ON AND SET THE SHIELD COORD POINTERS
+C
+            IF (OPT .EQ. 'ON') THEN
+                  NISIZE = ISIZE/2
+                  CALL CONSSD(ARRAY(1),ARRAY(NISIZE+1),NISIZE)
+                  RETURN
+C
+C  DEACTIVATE SHIELDING
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                  ICOUNT = 0
+                  SHIELD = .FALSE.
+                  RETURN
+            ELSE
+                  GOTO 120
+            ENDIF
+        ELSE
+            GOTO 120
+        ENDIF
+C
+C  ERROR UNDEFINED OPTION DETECTED
+C
+  120 CALL SETER (' CONOP3-UNDEFINED OPTION',1,1)
+      RETURN
+C
+C  ILLEGAL USE OF CON WITH CIL OR CHL
+C
+  140 CALL SETER
+     1('CONOP3-ILLEGAL USE OF CON OPTION WITH CIL OR CHL OPTION',
+     2 1,1)
+      RETURN
+        END
diff --git a/sys/gio/ncarutil/conlib/conop4.f b/sys/gio/ncarutil/conlib/conop4.f
new file mode 100644
index 00000000..f963dcf9
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conop4.f
@@ -0,0 +1,197 @@
+      SUBROUTINE CONOP4 (IOPT,ARRAY,ISIZE,IFORT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SET THE CONTRAN OPTIONS
+C
+C INPUT
+C     IOPT  --  CHARACTER STRING OF OPTION VALUE
+C     ARRAY --  CHARACTER INPUT DATA
+C     ISIZE --  INTEGER INPUT
+C     IFORT --  INTEGER.  THIS VALUE IS USED ONLY WHEN IOPT IS
+C               "FMT=ON".  IN THIS CASE, IFORT IS THE TOTAL NUMBER
+C               OF CHARACTERS TO BE PROCESSED BY THE FORMAT
+C               STATEMENT.  FOR EXAMPLE, FOR THE FORMAT "F10.3",
+C               IFORT SHOULD BE SET TO 10.
+C
+C  SET COMMON DATA EQUAL TO INPUT DATA
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C
+C  INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE
+C  NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF
+C  CONFLICT
+C
+      COMMON /INTPR/  IPAU       ,FPART      ,TENSN      ,NP11       ,
+     1                SMALL      ,L1         ,ADDLR      ,ADDTB      ,
+     2                MLLINE     ,ICLOSE
+        CHARACTER*(*)  ARRAY
+        CHARACTER*7  IOPT
+        CHARACTER*2  TAG, OPT
+C
+        SAVE
+C
+C +NOAO - initialize block data before changing any values
+        call conbdn
+c -NOAO
+C  DETERMINE THE OPTION DESIRED
+C
+      TAG = IOPT(1:2)
+        IF (IOPT(3:3) .EQ. '=') THEN
+            OPT = IOPT(4:5)
+        ELSE
+            OPT = IOPT(5:6)
+        ENDIF
+C
+C  TITLE OPTION GET VALUE OF SWITCH
+C
+      IF (TAG .EQ. 'TL') THEN
+C
+C  SWITCH ON GET TITLE AND COUNT FROM INPUT
+C
+            IF (OPT .EQ. 'ON') THEN
+              TITLE = .TRUE.
+                ISTRNG = ARRAY
+                  ICNT = ISIZE
+              RETURN
+C
+C  SWITCH OFF OPTION DEACTIVATED
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              TITLE = .FALSE.
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  CHANGE DATA VALUE FORMAT
+C
+      ELSEIF (TAG .EQ. 'FM') THEN
+C
+C  SWITCH ON GET USER FORMAT
+C
+          IF (OPT .EQ. 'ON') THEN
+                FORM = ARRAY
+              LEN = ISIZE
+              IFMT = IFORT
+              RETURN
+C
+C SWITCH OFF SET FORMAT TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                FORM = '(G10.3)'
+                  LEN = LEND
+              IFMT = IFMTD
+              RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  DASH PATTERN OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'DA') THEN
+C
+C  SWITCH OFF DEFAULT PATTERNS
+C
+          IF (OPT .EQ. 'OF') THEN
+                  NDASH = '$$$$$$$$$$'
+                  EDASH = '$$$$$$$$$$'
+                  IDASH = '$$$$$$$$$$'
+                  RETURN
+C
+C  SWITCH ALL SET GTR,LSS,AND EQU TO SAME VALUE
+C
+          ELSEIF (OPT .EQ. 'AL') THEN
+                  IDASH = ARRAY
+                  EDASH = ARRAY
+                  NDASH = ARRAY
+                  RETURN
+C
+C  SWITCH SET TO POS CHANGE POS DASH PATTERN
+C
+          ELSEIF (OPT .EQ. 'GT') THEN
+                  IDASH = ARRAY
+                  RETURN
+C
+C  SWITCH SET TO NEG SET NEG DASH PATTERN
+C
+          ELSEIF (OPT .EQ. 'LS') THEN
+                  NDASH = ARRAY
+                  RETURN
+C
+C  SWITCH SET TO EQU SET EQUAL DASH PATTERN
+C
+          ELSEIF (OPT .EQ. 'EQ') THEN
+                EDASH = ARRAY
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+        ELSE
+            GOTO 120
+        ENDIF
+C
+C  ERROR UNDEFINED OPTION DETECTED
+C
+  120 CALL SETER (' CONOP4-UNDEFINED OPTION',1,1)
+      RETURN
+        END
diff --git a/sys/gio/ncarutil/conlib/conot2.f b/sys/gio/ncarutil/conlib/conot2.f
new file mode 100644
index 00000000..f2bc6aed
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conot2.f
@@ -0,0 +1,178 @@
+      SUBROUTINE CONOT2 (IVER,IUNIT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C + NOAO - This routine is a no-op in IRAF.
+C - NOAO
+C
+C  OUTPUT THE OPTION VALUES TO THE LINE PRINTER
+C
+C  CONTINUE FOR CONRAN AND CONRAS
+C
+C
+C
+C      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+C     1                FINC       ,HI         ,FLO
+C      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+C     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+C     2                CINC       ,CHILO      ,CON        ,LABON      ,
+C     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+C     4                BPSIZ      ,LISTOP
+C      COMMON /CONRA3/ IREC
+C      COMMON /CONRA4/ NCP        ,NCPSZ
+C      COMMON /CONRA5/ NIT        ,ITIPV
+C      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+C     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+C     2                YRG        ,BORD       ,PXST       ,PYST       ,
+C     3                PXED       ,PYED       ,ITICK
+C      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+C      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+C     1              LEN      ,IFMT       ,LEND       ,
+C     2                IFMTD      ,ISIZEP     ,INMIN
+C      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+C     1                BR         ,TL         ,BL         ,CONV       ,
+C     2                XN         ,YN         ,ITLL       ,IBLL       ,
+C     3                ITRL       ,IBRL       ,XC         ,YC         ,
+C     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+C     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+C      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+C     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+C     2                ITPV
+C      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+C     1                MINGAP     ,ISIZEM         ,
+C     2                TENS
+C      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+C      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+C     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+C     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+C     3                TITLE      ,LISTOP     ,CHILO      ,CON
+C      COMMON /CONR15/ ISTRNG
+C        CHARACTER*64 ISTRNG
+C        COMMON /CONR16/ FORM
+C        CHARACTER*10 FORM
+C        COMMON /CONR17/ NDASH, IDASH, EDASH
+C        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C      SAVE
+C
+C  LABEL THE CONTOURS
+C
+C      WRITE (IUNIT,1001)
+C      IF (LABON) GO TO  100
+C      WRITE (IUNIT,1002)
+C      GO TO  110
+C  100 WRITE (IUNIT,1003)
+C
+C  LABEL SIZE
+C
+C  110 WRITE (IUNIT,1004) ISIZEL
+C
+C  SCALE DATA ON CONTOURS
+C
+C      WRITE (IUNIT,1005)
+C      IF (SCALE .NE. 1.) GO TO  120
+C      WRITE (IUNIT,1006)
+C      GO TO  130
+C  120 WRITE (IUNIT,1007) SCALE
+C
+C  TENSION FACTOR
+C
+C  130 WRITE (IUNIT,1008) TENS
+C
+C  PLOT RELATIVE MINS AND MAXS
+C
+C      WRITE (IUNIT,1009)
+C      IF (PMIMX) GO TO  140
+C      WRITE (IUNIT,1010)
+C      GO TO  150
+C  140 WRITE (IUNIT,1011)
+C
+C  SIZE OF MINIMUM AND MAXIMUM LABELS
+C
+C  150 WRITE (IUNIT,1012) ISIZEM
+C
+C  DASH PATTERN
+C
+C      WRITE (IUNIT,1013)
+C      IF (IDASH(1:1) .EQ. ' ') GO TO  170
+C      WRITE (IUNIT,1014) IDASH
+C      GO TO  180
+C  170 WRITE (IUNIT,1015)
+C  180 IF (EDASH(1:1) .EQ. ' ') GO TO  200
+C      WRITE (IUNIT,1016) EDASH
+C      GO TO  210
+C  200 WRITE (IUNIT,1017)
+C  210 IF (NDASH(1:1) .EQ. ' ') GO TO  230
+C      WRITE (IUNIT,1018) NDASH
+C      GO TO  240
+C  230 WRITE (IUNIT,1019)
+C
+C  DASH PATTERN BREAK POINT
+C
+C  240 WRITE (IUNIT,1020) BPSIZ
+C
+C  PRINT MINOR LINE GAP
+C
+C      ITT = MINGAP-1
+C      WRITE (IUNIT,1021) ITT
+C      RETURN
+C
+C 1001 FORMAT (5X,'LABEL THE CONTOURS, LAB=')
+C 1002 FORMAT ('+',28X,'OFF')
+C 1003 FORMAT ('+',28X,'ON')
+C 1004 FORMAT (5X,'CONTOUR LABEL SIZE IN PWRIT UNITS, LSZ=',I4)
+C 1005 FORMAT (5X,'SCALE THE DATA ON CONTOUR LINES, SDC=')
+C 1006 FORMAT ('+',41X,'OFF')
+C 1007 FORMAT ('+','ON, SCALE FACTOR=',G10.3)
+C 1008 FORMAT (5X,'TENSION FACTOR (USED FOR SMOOTH AND SUPER), TEN=',
+C     1        F6.2)
+C 1009 FORMAT (5X,'PLOT RELATIVE MINIMUMS AND MAXIMUMS, PMM=')
+C 1010 FORMAT ('+',45X,'OFF')
+C 1011 FORMAT ('+',45X,'ON')
+C 1012 FORMAT (5X,'SIZE OF MIN AND MAX LABELS IN PWRIT UNITS SML=',
+C     1        I4)
+C 1013 FORMAT (5X,'DASH PATTERN GTR=GREATER, EQU=EQUAL, LSS=LESS')
+C 1014 FORMAT (10X,'GTR=',A10)
+C 1015 FORMAT (10X,'GTR=$$$$$$$$$$')
+C 1016 FORMAT (10X,'EQU=',A10)
+C 1017 FORMAT (10X,'EQU=$$$$$$$$$$')
+C 1018 FORMAT (10X,'LSS=',A10)
+C 1019 FORMAT (10X,'LSS=$$$$$$$$$$')
+C 1020 FORMAT (5X,'DASH PATTERN BREAK POINT, DBP=',G10.3)
+C 1021 FORMAT (5X,'MINOR LINE COUNT=',I3)
+C
+C
+C******************************************************************
+C*                                                                *
+C*                   REVISION HISTORY                             *
+C*                                                                *
+C*  JUNE 1980   ADDED CONTERP TO ULIB                             *
+C*  AUGUST 1980 FIXED THE FOLLOWING PROBLEMS                      *
+C*              1.PLOTTING OF INPUT DATA VALUES                   *
+C*              2.SETTING OF MINIMUM INTENSITY IN ALL OPTION      *
+C*              3.SETTING OF EQU FLAG IN CONTOUR DASH PATTERN     *
+C*              4.TURNING OFF OF SIZE OF PLOTTED DATA OPTION      *
+C*  DECEMBER 1980 FIXED CONTOUR SELECTION ALGORITHM  AND MOVED IN *
+C*                DASH PACKAGE COMMON BLOCK INTPR
+C*  MARCH 1981  FIXED NON-PORTABLE STATEMENT ORDERING IN CONSET   *
+C*  APRIL 1981  FIXED OPTION LISTING ROUTINE                      *
+C*              ADDED MINOR LINE COUNT OPTION                     *
+C*  JULY 1983   ADDED LINEAR INTERPOLATION AND SHIELDING          *
+C*  JULY 1984     CONVERTED TO STANDARD FORTRAN77 AND GKS         *
+C*  AUGUST 1985 DELETED LOC (MACHINE DEPENDENT FUNCTION), CHANGED *
+C*              COMMON /CONR13/                                   *
+C*                                                                *
+C******************************************************************
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/conout.f b/sys/gio/ncarutil/conlib/conout.f
new file mode 100644
index 00000000..c2684de9
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conout.f
@@ -0,0 +1,350 @@
+      SUBROUTINE CONOUT (IVER)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C + NOAO - This routine is a no-op in IRAF.
+C - NOAO
+C
+C  LIST OUT ALL THE CONRAN OPTION VALUES ON THE LINE PRINTER
+C
+C  THE VALUE OF IVER DETERMINES WHICH ENTRY POINT CALLED THIS ROUTINE
+C
+C 1. CONRAQ
+C 2. CONRAN
+C 3. CONRAS
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+      SAVE
+C
+C  GET THE STANDARD OUTPUT UNIT TO WRITE THE OPTION VALUE LIST
+C
+      IUNIT = I1MACH(2)
+C
+C  PRINT OUT HEADER AND ALL OPTIONS WHICH APPLY TO CALLING VERSION
+C
+C     GO TO ( 100, 110, 120),IVER
+C 100 WRITE (IUNIT,1001)
+C     GO TO  130
+C 110 WRITE (IUNIT,1002)
+C     GO TO  130
+C 120 WRITE (IUNIT,1003)
+C 130 WRITE (IUNIT,1004)
+C
+C  PERIMETER
+C
+C     WRITE (IUNIT,1005)
+C     IF (PER) GO TO  140
+C     WRITE (IUNIT,1006)
+C     GO TO  150
+C 140 WRITE (IUNIT,1007)
+C
+C  GRID
+C
+C 150 WRITE (IUNIT,1008)
+C     IF (GRD) GO TO  160
+C     WRITE (IUNIT,1009)
+C     GO TO  170
+C 160 WRITE (IUNIT,1010)
+C
+C  SCALING OF DATA ON FRAME
+C
+C 170 WRITE (IUNIT,1011)
+C     GO TO ( 180, 190, 200),ISCALE+1
+C 180 WRITE (IUNIT,1012)
+C     GO TO  210
+C 190 WRITE (IUNIT,1013)
+C     GO TO  210
+C 200 WRITE (IUNIT,1014)
+C
+C  SAME DATA ANOTHER PLOT
+C
+C 210 WRITE (IUNIT,1015)
+C     IF (REPEAT) GO TO  220
+C     WRITE (IUNIT,1016)
+C     GO TO  230
+C 220 WRITE (IUNIT,1017)
+C
+C  SHIELDING
+C
+C 230 WRITE(IUNIT,2000)
+C     IF (SHIELD) GO TO 231
+C     WRITE(IUNIT,2001)
+C     GO TO 232
+C 231 WRITE(IUNIT,2002)
+C
+C  INTERPOLATION
+C
+C 232 WRITE(IUNIT,2003)
+C     IF (LINEAR) GO TO 233
+C     WRITE(IUNIT,2004)
+C     GO TO 234
+C 233 WRITE(IUNIT,2005)
+C
+C  PLOT THE SHIELD
+C
+C 234 WRITE(IUNIT,2006)
+C     IF (SLDPLT) GO TO 235
+C     WRITE(IUNIT,2007)
+C     GO TO 236
+C 235 WRITE(IUNIT,2008)
+C
+C  EXTRAPOLATION
+C
+C 236 WRITE (IUNIT,1018)
+C     IF (EXTRAP) GO TO  240
+C     WRITE (IUNIT,1019)
+C     GO TO  250
+C 240 WRITE (IUNIT,1020)
+C
+C  STEP SIZE OR RESOLUTION OF THE GRID
+C
+C 250 WRITE (IUNIT,1021) IGRAD
+C
+C  MESSAGE AT BOTTOM OF PLOT
+C
+C     WRITE (IUNIT,1022)
+C     IF (MESS) GO TO  260
+C     WRITE (IUNIT,1023)
+C     GO TO  270
+C 260 WRITE (IUNIT,1024)
+C
+C  TITLE AT TOP OF PLOT
+C
+C 270 WRITE (IUNIT,1025)
+C     IF (TITLE) GO TO  280
+C     WRITE (IUNIT,1026)
+C     GO TO  290
+C 280 WRITE (IUNIT,1027)
+C
+C  SIZE OF TITLE
+C
+C 290 WRITE (IUNIT,1028) ITLSIZ
+C
+C  PRINT TITLE
+C
+C     IF (ICNT.EQ.0 .OR. .NOT.TITLE) GO TO  310
+C     ICC = 100
+C     IF (ICC .GT. ICNT) ICC = ICNT
+C     WRITE (IUNIT,1029) ISTRNG
+C
+C  DATA POINTS USED FOR PARTIAL DERIVATIVE ESTIMATION
+C
+C 310 WRITE (IUNIT,1030) NCP
+C
+C  LOOK AT TRIANGLES SWITCH
+C
+C     WRITE (IUNIT,1031)
+C     IF (LOOK) GO TO  320
+C     WRITE (IUNIT,1032)
+C     GO TO  330
+C 320 WRITE (IUNIT,1033)
+C
+C  ADVANCE FRAME BEFORE PLOTTING TRIANGULATION
+C
+C 330 WRITE (IUNIT,1034)
+C     IF (FRADV) GO TO  340
+C     WRITE (IUNIT,1035)
+C     GO TO  350
+C 340 WRITE (IUNIT,1036)
+C
+C  TRIANGLES ONLY PLOT
+C
+C 350 WRITE (IUNIT,1037)
+C     IF (EXTRI) GO TO  360
+C     WRITE (IUNIT,1038)
+C     GO TO  370
+C 360 WRITE (IUNIT,1039)
+C
+C  PLOT THE INPUT DATA VALUES
+C
+C 370 WRITE (IUNIT,1040)
+C     IF (PLDVLS) GO TO  380
+C     WRITE (IUNIT,1041)
+C     GO TO  390
+C 380 WRITE (IUNIT,1042)
+C
+C  FORMAT OF THE PLOTTED INPUT DATA
+C
+C 390 WRITE (IUNIT,1043)
+C     IF (LEN .NE. 0) GO TO  400
+C     WRITE (IUNIT,1044)
+C     GO TO  420
+C 400 WRITE (IUNIT,1045) FORM
+C
+C  SIZE OF THE PLOTTED DATA VALUES
+C
+C 420 WRITE (IUNIT,1046) ISIZEP
+C
+C  INTENSITY SETTINGS
+C
+C     WRITE (IUNIT,1047)
+C     WRITE (IUNIT,1048) INMAJ,INMIN,INLAB,INDAT
+C
+C  DISTLAY CONTOUR SETTING
+C
+C     WRITE (IUNIT,1049)
+C     IF (CON) GO TO  430
+C     WRITE (IUNIT,1050)
+C     GO TO  440
+C 430 WRITE (IUNIT,1051) NCL,(CL(I),I=1,NCL)
+C
+C  CONTOUR INCREMENT
+C
+C 440 WRITE (IUNIT,1052)
+C     IF (CINC) GO TO  450
+C     WRITE (IUNIT,1053)
+C     GO TO  460
+C 450 WRITE (IUNIT,1054) FINC
+C
+C  CONTOUR HIGH AND LOW VALUES
+C
+C 460 WRITE (IUNIT,1055)
+C     IF (CHILO) GO TO  470
+C     WRITE (IUNIT,1056)
+C     GO TO  480
+C 470 WRITE (IUNIT,1057) HI,FLO
+C
+C  CALL CONOT2 IF NOT QUICK VERSION
+C
+C 480 IF (IVER .NE. 1) CALL CONOT2 (IVER,IUNIT)
+C
+C  THE ROUTINE CONOT2 WAS GENERATED TO ELIMINATE COMPILER ERRORS
+C  RESULTING FROM TOO MANY FORMAT STATEMENTS IN ONE SUBROUTINE
+C
+C     RETURN
+C
+C
+C1001 FORMAT (1X,'CONRAQ')
+C1002 FORMAT (1X,'CONRAN')
+C1003 FORMAT (1X,'CONRAS')
+C1004 FORMAT ('+',6X,'-OPTION VALUE SETTINGS',/
+C    1        ,7X,'ALL NON-PWRIT VALUES APPLY TO THE UNSCALED DATA')
+C1005 FORMAT (5X,'PERIMETER, PER=')
+C1006 FORMAT ('+',19X,'OFF')
+C1007 FORMAT ('+',19X,'ON')
+C1008 FORMAT (5X,'GRID, GRD=')
+C1009 FORMAT ('+',14X,'OFF')
+C1010 FORMAT ('+',14X,'ON')
+C1011 FORMAT (5X,'SCALING OF PLOT ON FRAME, SCA=')
+C1012 FORMAT ('+',34X,'ON')
+C1013 FORMAT ('+',34X,'OFF')
+C1014 FORMAT ('+',34X,'PRI')
+C1015 FORMAT (5X,'SAME DATA FOR ANOTHER PLOT, REP=')
+C1016 FORMAT ('+',36X,'OFF')
+C1017 FORMAT ('+',36X,'ON')
+C1018 FORMAT (5X,'EXTRAPOLATION, EXT=')
+C1019 FORMAT ('+',23X,'OFF')
+C1020 FORMAT ('+',23X,'ON')
+C1021 FORMAT (5X,'RESOLUTION, SSZ=',I4)
+C1022 FORMAT (5X,'MESSAGE, MES=')
+C1023 FORMAT ('+',17X,'OFF')
+C1024 FORMAT ('+',17X,'ON')
+C1025 FORMAT (5X,'TITLE, TLE=')
+C1026 FORMAT ('+',15X,'OFF')
+C1027 FORMAT ('+',15X,'ON')
+C1028 FORMAT (5X,'TITLE SIZE IN PWRIT UNITS, STL=',I4)
+C1029 FORMAT (5X,'TITLE=',A64)
+C1030 FORMAT (5X,'DATA POINTS USED FOR PARTIAL DERIVATIVE',
+C    1' ESTIMATION,  NCP=',I4)
+C1031 FORMAT (5X,'LOOK AT TRIANGLES, TRI=')
+C1032 FORMAT ('+',27X,'OFF')
+C1033 FORMAT ('+',27X,'ON')
+C1034 FORMAT (5X,'ADVANCE FRAME BEFORE PLOTTING TRIANGULATION,',
+C    1' TFR=')
+C1035 FORMAT ('+',53X,'OFF')
+C1036 FORMAT ('+',53X,'ON')
+C1037 FORMAT (5X,'TRIANGULATION ONLY PLOT, TOP=')
+C1038 FORMAT ('+',33X,'OFF')
+C1039 FORMAT ('+',33X,'ON')
+C1040 FORMAT (5X,'PLOT THE INPUT DATA VALUES, PDV=')
+C1041 FORMAT ('+',36X,'OFF')
+C1042 FORMAT ('+',36X,'ON')
+C1043 FORMAT (5X,'FORMAT OF THE PLOTTED INPUT DATA, FMT=')
+C1044 FORMAT ('+',42X,'(G10.3)')
+C1045 FORMAT ('+',42X,A10)
+C1046 FORMAT (5X,'SIZE OF THE PLOTTED DATA VALUES IN PWRIT',
+C    1' UNITS, SPD=',I4)
+C1047 FORMAT (5X,'COLOR (INTENSITY) INDICES FOLLOW.',
+C    1' FOR CONRAQ MAJOR CONTOURS ARE ONLY USED')
+C1048 FORMAT (10X,'MAJOR CONTOUR LINES, MAJ=',I4,/
+C    1        ,10X,'MINOR CONTOUR LINES, MIN=',I4,/
+C    2        ,10X,'TITLE AND MESSAGE, LAB=',I4,/
+C    3        ,10X,'PLOTTED DATA VALUES, DAT=',I4)
+C1049 FORMAT (5X,'CONTOUR LEVELS,  CON=')
+C1050 FORMAT ('+',25X,'OFF')
+C1051 FORMAT ('+',25X,'ON, NCL=',I4,' ARRAY='/(10(2X,F10.3)))
+C1052 FORMAT (5X,'CONTOUR INCREMENT, CIL=')
+C1053 FORMAT ('+',27X,'OFF')
+C 1054 FORMAT ('+',27X,'ON, INCREMENT=',G10.3)
+C 1055 FORMAT (5X,'CONTOUR HIGH AND LOW VALUES, CHL=')
+C 1056 FORMAT ('+',37X,'OFF')
+C 1057 FORMAT ('+',37X,'ON, HI=',G10.3,' FLO=',G10.3)
+C 2000 FORMAT (5X,'SHIELDING, SLD=')
+C 2001 FORMAT ('+',19X,'OFF')
+C 2002 FORMAT ('+',19X,'ON')
+C 2003 FORMAT (5X,'INTERPOLATION, ITP=')
+C 2004 FORMAT ('+',23X,'C1 SURFACE')
+C 2005 FORMAT ('+',23X,'LINEAR')
+C 2006 FORMAT (5X,'PLOT THE SHIELD, SPT=')
+C 2007 FORMAT ('+',25X,'OFF')
+C 2008 FORMAT ('+',25X,'ON')
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/conpdv.f b/sys/gio/ncarutil/conlib/conpdv.f
new file mode 100644
index 00000000..49c1f61f
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conpdv.f
@@ -0,0 +1,118 @@
+      SUBROUTINE CONPDV (XD,YD,ZD,NDP)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  PLOT THE DATA VALUES ON THE CONTOUR MAP
+C  CURRENTLY UP TO 10 CHARACTERS FOR EACH VALUE ARE DISPLAYED
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+        COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
+C
+C
+      CHARACTER*10  ISTR
+      DIMENSION       XD(1)      ,YD(1)      ,ZD(1)
+C
+        SAVE
+C
+C  DATA TO CONVERT 0-32767 COORIDNATES TO 1-1024 VALUES
+C
+        DATA TRANS/32./
+C
+C  SET INTENSITY
+C
+        IF (INDAT .NE. 1) THEN
+          CALL GSTXCI (INDAT)
+        ELSE
+            CALL GSTXCI (IRANTX)
+      ENDIF
+C
+C  SET FORMAT IF NONE SPECIFIED
+C
+      IF (LEN .NE. 0) GO TO  110
+        FORM = '(G10.3)'
+      LEN = LEND
+      IFMT = IFMTD
+C
+C  LOOP AND PLOT ALL VALUES
+C
+  110 DO  120 K=1,NDP
+         CALL FL2INT (XD(K),YD(K),MX,MY)
+         MX = IFIX(FLOAT(MX)/TRANS)+1
+         MY = IFIX(FLOAT(MY)/TRANS)+1
+C
+C + NOAO - FTN internal write rewritten as call to encode for IRAF
+C
+C      WRITE(ISTR,FORM)ZD(K)
+       call encode (len, form, istr, zd(k))
+C
+C - NOAO
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = CPUX(MX)
+      YC = CPUY(MY)
+C
+         CALL WTSTR(XC,YC,ISTR,ISIZEP,0,0)
+      CALL GSELNT(ICN)
+  120 CONTINUE
+        IF (INDAT .NE. 1) THEN
+            CALL GSTXCI (IRANTX)
+        ENDIF
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conreo.f b/sys/gio/ncarutil/conlib/conreo.f
new file mode 100644
index 00000000..c029c0bb
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conreo.f
@@ -0,0 +1,129 @@
+      SUBROUTINE CONREO (MAJLNS)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS ROUTINE PUTS THE MAJOR (LABELED) LEVELS IN THE BEGINNING OF CL
+C AND THE MINOR (UNLABELED) LEVELS IN END OF CL.  THE NUMBER OF MAJOR
+C LEVELS IS RETURNED IN MAJLNS.  PV IS USED AS A WORK SPACE.  MINGAP IS
+C THE NUMBER OF MINOR GAPS (ONE MORE THAN THE NUMBER OF MINOR LEVELS
+C BETWEEN MAJOR LEVELS).
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10    NDASH, IDASH, EDASH
+C
+        SAVE
+C
+      NL = NCL
+      IF (NL.LE.4 .OR. MINGAP.LE.1) GO TO   160
+      NML = MINGAP-1
+      IF (NL.LE.10) NML = 1
+C
+C CHECK FOR BREAK POINT IN THE LIST OF CONTOURS FOR A MAJOR LINE
+C
+      NMLP1 = NML+1
+          DO    10 I=1,NL
+          ISAVE = I
+          IF (CL(I).EQ.BPSIZ) GO TO    40
+   10     CONTINUE
+C
+C  NO BREAKPOINT FOUND SO TRY FOR A NICE NUMBER
+C
+      L = NL/2
+      L = ALOG10( ABS( CL(L) ) )+1.
+      Q = 10.**L
+          DO    30 J=1,3
+          Q = Q/10.
+              DO    20 I=1,NL
+              ISAVE = I
+              IF (AMOD( ABS( CL(I) + 1.E-9*CL(I) )/Q,FLOAT(NMLP1) ).LE.
+     1            .0001) GO TO    40
+   20         CONTINUE
+   30     CONTINUE
+      ISAVE = NL/2
+C
+C PUT MAJOR LEVELS IN PV
+C
+   40 ISTART = MOD(ISAVE,NMLP1)
+      IF (ISTART.EQ.0) ISTART = NMLP1
+      NMAJL = 0
+          DO    50 I=ISTART,NL,NMLP1
+          NMAJL = NMAJL+1
+          PV(NMAJL) = CL(I)
+   50     CONTINUE
+      MAJLNS = NMAJL
+      L = NMAJL
+C
+C PUT MINOR LEVELS IN PV
+C
+      IC = NML/2 + 1
+      L = MAJLNS+1
+          DO   100 LOOP=1,NML
+          IC1 = IC
+              DO    90 IWCH=1,2
+              IF (LOOP.EQ.1) GO TO    60
+              IC1 = IC+(LOOP-1)
+              IF (IWCH.EQ.2) IC1 = IC-(LOOP-1)
+              IF (IC1.GE.NMLP1) GO TO    90
+              IF (IC1.LE.0) GO TO    90
+   60             DO    70 K=ISTART,NL,NMLP1
+                  IND = K+IC1
+                  IF (IND.GT.NL) GO TO    80
+                  PV(L) = CL(IND)
+                  L = L+1
+   70             CONTINUE
+   80         IF (LOOP.EQ.1) GO TO   100
+   90         CONTINUE
+  100     CONTINUE
+C
+C  IF MAJOR LINES DID NOT START ON THE FIRST ENTRY PICK UP THE MISSING
+C  LEVELS
+C
+      IF (ISTART.EQ.1) GO TO   140
+          DO   130 LOOP=1,NML
+          IC1 = IC
+              DO   120 IWCH=1,2
+              IF (LOOP.EQ.1) GO TO   110
+              IC1 = IC+(LOOP-1)
+              IF (IWCH.EQ.2) IC1 = IC-(LOOP-1)
+  110         IF (IC1.GE.ISTART) GO TO   120
+              IF (IC1.LE.0) GO TO   120
+              PV(L) = CL(IC1)
+              L = L+1
+              IF (LOOP.EQ.1) GO TO   130
+  120         CONTINUE
+  130     CONTINUE
+C
+C PUT REORDERED ARRAY BACK IN ORIGINAL PLACE
+C
+  140     DO   150 I=1,NL
+          CL(I) = PV(I)
+  150     CONTINUE
+      RETURN
+  160 MAJLNS = NL
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/consld.f b/sys/gio/ncarutil/conlib/consld.f
new file mode 100644
index 00000000..fd40e10d
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/consld.f
@@ -0,0 +1,165 @@
+        SUBROUTINE CONSLD (SCRARR)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  THIS ROUTINE IS USED TO GENERATE A SHIELD WHERE CONTOUR
+C  DRAWING IS ALLOWED.
+C
+C  THE ROUTINE TAKES THE SILHOUETTE INFORMATION FROM COMMON BLOCK
+C  CONR13 AND TRANSFORMS THIS INTO A SHIELD TO BE USED IN THE
+C  SCRATCH ARRAY PASSED IN BY THE USER (THE SCRATCH ARRAY HOLDS THE
+C  GRIDED DATA FROM THE INTERPOLATION).
+C
+C  INPUT
+C       SCRARR-THE SCRATCH ARRAY HOLDING THE INTERPOLATED DATA
+C
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA9/ ICOORD(500),  NP       ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+C
+C  INCREASE THE RESOLUTION OF THE SHIELD PROFILE
+C
+      DIMENSION SCRARR(1)
+C
+      SAVE
+      DATA RESINC/8.0/
+C
+C  STATEMENT FUNCTION TO MAKE ARRAY ACCESS SEEM LIKE MATRIX ACCESS
+C
+C +NOAO
+C  These statement functions are never called.
+C     SCRTCH(IXX,IYY) = SCRARR(IYY+(IXX-1)*IYMAX)
+C     IARVL(IXX,IYY) = IYY+(IXX-1)*IYMAX
+C -NOAO
+      IGADDR(XXX,YYY) =
+     1 IFIX((YYY-YST)/STPSZ+.5)+(IFIX((XXX-XST)/STPSZ+.5))*IYMAX
+C
+C  SET THE SPECIAL VALUE
+C
+      SPVAL = SPVAL * 2.
+C
+C  SET THE USER ARRAY LOCATIONS TO TEMPORARY POINTERS
+C
+C  LOOP FOR ALL SHIELD ELEMENTS
+C
+      DO 100 IC = 1,ICOUNT
+C
+C       ASSIGN LINE SEGMENT END POINTS
+C
+        X1 = XVS(IC)
+        Y1 = YVS(IC)
+        IF (IC .EQ. ICOUNT) GO TO 10
+                X2 = XVS(IC+1)
+                Y2 = YVS(IC+1)
+                GO TO 15
+ 10             CONTINUE
+                X2 = XVS(1)
+                Y2 = YVS(1)
+ 15     CONTINUE
+C
+C  INSURE THAT ALL POINTS ARE IN THE CONVEX HULL
+C
+      IF (X1.GT.XED) X1 = XED
+      IF (X1.LT.XST) X1 = XST
+      IF (X2.GT.XED) X2 = XED
+      IF (X2.LT.XST) X2 = XST
+      IF (Y1.GT.YED) Y1 = YED
+      IF (Y1.LT.YST) Y1 = YST
+      IF (Y2.GT.YED) Y2 = YED
+      IF (Y2.LT.YST) Y2 = YST
+C
+C       SET THE START OF THE LINE SEGMENT SCRATCH LOCATION TO
+C       THE SPECIAL VALUE
+C
+        II = IGADDR(X1,Y1)
+        SCRARR(II) = SPVAL
+C
+C       FIND THE LENGTH OF THE LINE SEGMENT
+C
+        DIST = SQRT(((X2-X1)**2)+((Y2-Y1)**2))
+C
+C       IF LENGTH SHORTER THAN STEP SIZE THEN THERE IS NOTHING TO DO
+C
+        IF (DIST .LE. STPSZ) GO TO 100
+C
+C       SET UP LOOP TO SET ALL CELLS ON THE LINE SEGMENT
+C
+        NSTPS = (DIST/STPSZ)*RESINC
+        XSTP = (X2-X1)/FLOAT(NSTPS)
+        YSTP = (Y2-Y1)/FLOAT(NSTPS)
+        X = X1
+        Y = Y1
+        DO 20 K = 1,NSTPS
+                X = X + XSTP
+                Y = Y + YSTP
+                II = IGADDR(X,Y)
+                SCRARR(II) = SPVAL
+ 20     CONTINUE
+C
+ 100  CONTINUE
+C
+C  FILL THE SHIELDED AREAS
+C       FOR EACH COLUMN THE ELEMENTS ARE SET TO SPVAL IF FILL IS TRUE.
+C       THE VALUE OF FILL IS NEGATED EVERY TIME A SPVAL IS ENCOUNTERED,
+C       AND THAT CELL REMAINS UNCHANGED.
+C
+C       LOOP THROUGH THE GRID
+C
+        DO 39 I = 1,IXMAX
+C
+C               GET THE START AND END FOR THE COLUMN
+C
+                IYS = (I-1)*IYMAX+1
+                IYE = I*IYMAX
+C
+C               ADVANCE IN THE FORWARD DIRECTION
+C
+                DO 32 J = IYS,IYE
+C
+C                       IF NOT SPVAL THEN SET CELL AS APPROPIATE
+C
+                        IF (SCRARR(J).EQ.SPVAL) GO TO 33
+                                SCRARR(J) = SPVAL
+ 32             CONTINUE
+                GO TO 39
+C
+C               ADVANCE IN THE BACKWARD DIRECTION
+C
+ 33             CONTINUE
+                DO 34 J = 1,IYMAX
+                        NJ =IYE+1-J
+C                       IF NOT SPVAL THEN SET CELL AS APPROPIATE
+C
+                        IF (SCRARR(NJ).EQ.SPVAL) GO TO 39
+                                SCRARR(NJ) = SPVAL
+ 34             CONTINUE
+ 39     CONTINUE
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conssd.f b/sys/gio/ncarutil/conlib/conssd.f
new file mode 100644
index 00000000..26ac20d1
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conssd.f
@@ -0,0 +1,61 @@
+      SUBROUTINE CONSSD(X,Y,IC)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  THIS SUBROUTINE SETS THE SHIELDING FLAG AND CONNECTS THE
+C  USERS SHIELD ARRAYS TO SOME INTERNAL POINTERS
+C
+C  INPUT
+C       X-X COORDINATE STRING
+C       Y-Y COORDINATE STRING
+C       IC-NUMBER OF COORDINATES
+C
+C  NOTE THE USERS ARRAYS CANNOT BE MUCKED WITH DURING EXECUTION
+C       THOSE ARRAYS ARE USED DURING CONRAN EXECUTION
+C
+      DIMENSION X(1),Y(1)
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+C
+        SAVE
+C
+C  SET COUNTER
+C
+      ICOUNT = IC
+C
+C  CHECK THE DIMENSION OF SHIELD ARRAYS
+C
+      IERUNT = I1MACH(4)
+      IF (ICOUNT .GT. 50) THEN
+        CALL SETER (' CONSSD -- NUMBER OF SHIELD POINTS .GT. 50',1,1)
+C
+C + NOAO - FTN write and format statement commented out; SETER is enough.
+C       WRITE(IERUNT,1001)
+        ICOUNT = 50
+      ENDIF
+C1001 FORMAT(' ERROR 1 IN CONSSD -- NUMBER OF SHIELD POINTS .GT. 50')
+C - NOAO
+C
+C  SET THE SHIELDING FLAG TO TRUE
+C
+      SHIELD = .TRUE.
+C
+C  COMPUTE POINTERS FOR THE USERS SHIELDING ARRAYS
+C
+      DO 300 I = 1,ICOUNT
+        XVS(I) = X(I)
+ 300  YVS(I) = Y(I)
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/constp.f b/sys/gio/ncarutil/conlib/constp.f
new file mode 100644
index 00000000..8df0e23b
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/constp.f
@@ -0,0 +1,135 @@
+      SUBROUTINE CONSTP (XD,YD,NDP)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  COMPUTE STEP SIZE IN X AND Y DIRECTION
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      DIMENSION       XD(1)      ,YD(1)
+C
+        SAVE
+C
+C  FIND SMALLEST AND LARGST X AND Y
+C
+      XST = XD(1)
+      XED = XD(1)
+      YST = YD(1)
+      YED = YD(1)
+      DO  130 I=2,NDP
+         IF (XST .LE. XD(I)) GO TO  100
+         XST = XD(I)
+         GO TO  110
+  100    IF (XED .GE. XD(I)) GO TO  110
+         XED = XD(I)
+  110    IF (YST .LE. YD(I)) GO TO  120
+         YST = YD(I)
+         GO TO  130
+  120    IF (YED .GE. YD(I)) GO TO  130
+         YED = YD(I)
+  130 CONTINUE
+C
+C  COMPUTE STEP SIZE
+C
+      XRG = (ABS(XED-XST))
+      YRG = (ABS(YED-YST))
+      SQRG = XRG
+      IF (SQRG .LT. YRG) SQRG = YRG
+      STPSZ = SQRG/FLOAT(IGRAD-1)
+C
+C  COMPUTE PARAMETERS FOR SET CALL
+C
+      DIFX = XRG/SQRG
+      DIFY = YRG/SQRG
+      PXST = .5-(BORD*DIFX)/2.
+      PXED = .5+(BORD*DIFX)/2.
+      PYST = .5-(BORD*DIFY)/2.
+      PYED = .5+(BORD*DIFY)/2.
+      XRG = XRG/FLOAT(ITICK)
+      YRG = YRG/FLOAT(ITICK)
+C
+C  TEST IF THE ASPECT RATIO FOR THE COORDINATES IS REASONABLE.
+C     REASONABLE IS CURRENTLY DEFINED AS 5 TO 1.
+C     IF IT IS NOT REASONABLE THEN A POOR PLOT MAY BE GENERATED
+C     SO IT IS NICE THE WARN THE USER WHEN THIS HAPPENS.
+C
+      TEST = XRG/YRG
+      IF (TEST.LE.5. .AND. TEST.GE.0.2) RETURN
+C
+C  WARN THE USER ON THE STANDARD OUTPUT UNIT THAT THE PLOT MAY
+C  NOT BE TOO GOOD.
+C
+C  SET RECOVERY MODE
+C
+      CALL ENTSR(IROLD,IREC)
+C
+C  FLAG THE ERROR
+C
+      CALL SETER(' ASPECT RATIO OF X AND Y GREATER THAN 5 TO 1',
+     1           1,1)
+C
+      CALL EPRIN
+C
+C  CLEAR THE ERROR
+C
+      CALL ERROF
+C
+C  RESET USER ERROR MODE
+C
+      CALL ENTSR(IDUM,IROLD)
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/contlk.f b/sys/gio/ncarutil/conlib/contlk.f
new file mode 100644
index 00000000..201b4d07
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/contlk.f
@@ -0,0 +1,98 @@
+      SUBROUTINE CONTLK (XD,YD,NDP,IPT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C  DRAW THE TRIANGLES CREATED BY CONTNG
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+      DIMENSION       XD(1)      ,YD(1)      ,IPT(1)
+C
+        SAVE
+C
+C  STATEMENT FUNCTIONS TO SCALE DATA FOR OVERLAYS
+C
+      FX(XXX,YYY) = XXX
+      FY(XXX,YYY) = YYY
+C
+C   ADVANCE PICTURE IF DESIRED
+C
+      IF (FRADV) CALL FRAME
+C
+C  DRAW TRIANGLES
+C
+      DO  100 K=1,NT
+         I = K*3
+         I1 = IPT(I)
+         I2 = IPT(I-1)
+         I3 = IPT(I-2)
+         XX = FX(XD(I1),YD(I1))
+         CALL FL2INT (XX,FY(XD(I1),YD(I1)),MX1,MY1)
+         CALL PLOTIT (MX1,MY1,0)
+         XX = FX(XD(I2),YD(I2))
+         CALL FL2INT (XX,FY(XD(I2),YD(I2)),MX,MY)
+         CALL PLOTIT (MX,MY,1)
+         XX = FX(XD(I3),YD(I3))
+         CALL FL2INT (XX,FY(XD(I3),YD(I3)),MX,MY)
+         CALL PLOTIT (MX,MY,1)
+         CALL PLOTIT (MX1,MY1,1)
+  100 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/contng.f b/sys/gio/ncarutil/conlib/contng.f
new file mode 100644
index 00000000..7ebad596
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/contng.f
@@ -0,0 +1,432 @@
+      SUBROUTINE CONTNG (NDP,XD,YD,NT,IPT,NL,IPL,IWL,IWP,WK)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS SUBROUTINE PERFORMS TRIANGULATION.  IT DIVIDES THE X-Y
+C PLANE INTO A NUMBER OF TRIANGLES ACCORDING TO GIVEN DATA
+C POINTS IN THE PLANE, DETERMINES LINE SEGMENTS THAT FORM THE
+C BORDER OF DATA AREA, AND DETERMINES THE TRIANGLE NUMBERS
+C CORRESPONDING TO THE BORDER LINE SEGMENTS.
+C AT COMPLETION, POINT NUMBERS OF THE VERTEXES OF EACH TRIANGLE
+C ARE LISTED COUNTER-CLOCKWISE.  POINT NUMBERS OF THE END POINTS
+C OF EACH BORDER LINE SEGMENT ARE LISTED COUNTER-CLOCKWISE,
+C LISTING ORDER OF THE LINE SEGMENTS BEING COUNTER-CLOCKWISE.
+C THE INPUT PARAMETERS ARE
+C     NDP = NUMBER OF DATA POINTS,
+C     XD  = ARRAY OF DIMENSION NDP CONTAINING THE
+C           X COORDINATES OF THE DATA POINTS,
+C     YD  = ARRAY OF DIMENSION NDP CONTAINING THE
+C           Y COORDINATES OF THE DATA POINTS.
+C THE OUTPUT PARAMETERS ARE
+C     NT  = NUMBER OF TRIANGLES,
+C     IPT = ARRAY OF DIMENSION 6*NDP-15, WHERE THE POINT
+C           NUMBERS OF THE VERTEXES OF THE (IT)TH TRIANGLE
+C           ARE TO BE STORED AS THE (3*IT-2)ND, (3*IT-1)ST,
+C           AND (3*IT)TH ELEMENTS, IT=1,2,...,NT,
+C     NL  = NUMBER OF BORDER LINE SEGMENTS,
+C     IPL = ARRAY OF DIMENSION 6*NDP, WHERE THE POINT
+C           NUMBERS OF THE END POINTS OF THE (IL)TH BORDER
+C           LINE SEGMENT AND ITS RESPECTIVE TRIANGLE NUMBER
+C           ARE TO BE STORED AS THE (3*IL-2)ND, (3*IL-1)ST,
+C           AND (3*IL)TH ELEMENTS, IL=1,2,..., NL.
+C THE OTHER PARAMETERS ARE
+C     IWL = INTEGER ARRAY OF DIMENSION 18*NDP USED
+C           INTERNALLY AS A WORK AREA,
+C     IWP = INTEGER ARRAY OF DIMENSION NDP USED
+C           INTERNALLY AS A WORK AREA,
+C     WK  = ARRAY OF DIMENSION NDP USED INTERNALLY AS A
+C           WORK AREA.
+C DECLARATION STATEMENTS
+C
+      SAVE
+C
+      INTEGER         CONXCH
+      COMMON /CONRA3/ IREC
+      DIMENSION       XD(*)      ,YD(*)      ,IPT(*)     ,IPL(*)     ,
+     1                IWL(*)     ,IWP(*)     ,WK(*)
+      DIMENSION       ITF(2)
+        CHARACTER*4  IP1C, IP2C
+        CHARACTER*64  ITEMP
+      DATA  RATIO/1.0E-6/, NREP/100/
+C
+C STATEMENT FUNCTIONS
+C
+      DSQF(U1,V1,U2,V2) = (U2-U1)**2+(V2-V1)**2
+      SIDE(U1,V1,U2,V2,U3,V3) = (V3-V1)*(U2-U1)-(U3-U1)*(V2-V1)
+C
+C PRELIMINARY PROCESSING
+C
+      NDPM1 = NDP-1
+C
+C DETERMINES THE CLOSEST PAIR OF DATA POINTS AND THEIR MIDPOINT.
+C
+      DSQMN = DSQF(XD(1),YD(1),XD(2),YD(2))
+      IPMN1 = 1
+      IPMN2 = 2
+      DO  140 IP1=1,NDPM1
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+         IP1P1 = IP1+1
+         DO  130 IP2=IP1P1,NDP
+            DSQI = DSQF(X1,Y1,XD(IP2),YD(IP2))
+            IF (DSQI .NE. 0.) GO TO  120
+C
+C  ERROR, IDENTICAL INPUT DATA POINTS
+C
+          ITEMP = ' CONTNG-IDENTICAL INPUT DATA POINTS FOUND
+     1 AT      AND      '
+C 
+C + NOAO - FTN internal writes rewritten as calls to encode for IRAF
+C
+C         WRITE(IP1C,'(I4)')IP1
+C         WRITE(IP2C,'(I4)')IP2
+          call encode (4, '(I4)', ip1c, ip1)
+	  call encode (4, '(I4)', ip2c, ip2)
+C - NOAO
+C
+            CALL SETER (ITEMP,1,1)
+            ITEMP(46:49) = IP1C
+            ITEMP(55:58) = IP2C
+            RETURN
+  120       IF (DSQI .GE. DSQMN) GO TO  130
+            DSQMN = DSQI
+            IPMN1 = IP1
+            IPMN2 = IP2
+  130    CONTINUE
+  140 CONTINUE
+      DSQ12 = DSQMN
+      XDMP = (XD(IPMN1)+XD(IPMN2))/2.0
+      YDMP = (YD(IPMN1)+YD(IPMN2))/2.0
+C
+C SORTS THE OTHER (NDP-2) DATA POINTS IN ASCENDING ORDER OF
+C DISTANCE FROM THE MIDPOINT AND STORES THE SORTED DATA POINT
+C NUMBERS IN THE IWP ARRAY.
+C
+      JP1 = 2
+      DO  150 IP1=1,NDP
+         IF (IP1.EQ.IPMN1 .OR. IP1.EQ.IPMN2) GO TO  150
+         JP1 = JP1+1
+         IWP(JP1) = IP1
+         WK(JP1) = DSQF(XDMP,YDMP,XD(IP1),YD(IP1))
+  150 CONTINUE
+      DO  170 JP1=3,NDPM1
+         DSQMN = WK(JP1)
+         JPMN = JP1
+         DO  160 JP2=JP1,NDP
+            IF (WK(JP2) .GE. DSQMN) GO TO  160
+            DSQMN = WK(JP2)
+            JPMN = JP2
+  160    CONTINUE
+         ITS = IWP(JP1)
+         IWP(JP1) = IWP(JPMN)
+         IWP(JPMN) = ITS
+         WK(JPMN) = WK(JP1)
+  170 CONTINUE
+C
+C IF NECESSARY, MODIFIES THE ORDERING IN SUCH A WAY THAT THE
+C FIRST THREE DATA POINTS ARE NOT COLLINEAR.
+C
+      AR = DSQ12*RATIO
+      X1 = XD(IPMN1)
+      Y1 = YD(IPMN1)
+      DX21 = XD(IPMN2)-X1
+      DY21 = YD(IPMN2)-Y1
+      DO  180 JP=3,NDP
+         IP = IWP(JP)
+         IF (ABS((YD(IP)-Y1)*DX21-(XD(IP)-X1)*DY21) .GT. AR) GO TO  190
+  180 CONTINUE
+      CALL SETER (' CONTNG - ALL COLLINEAR DATA POINTS',1,1)
+  190 IF (JP .EQ. 3) GO TO  210
+      JPMX = JP
+      JP = JPMX+1
+      DO  200 JPC=4,JPMX
+         JP = JP-1
+         IWP(JP) = IWP(JP-1)
+  200 CONTINUE
+      IWP(3) = IP
+C
+C FORMS THE FIRST TRIANGLE.  STORES POINT NUMBERS OF THE VER-
+C TEXES OF THE TRIANGLE IN THE IPT ARRAY, AND STORES POINT NUM-
+C BERS OF THE BORDER LINE SEGMENTS AND THE TRIANGLE NUMBER IN
+C THE IPL ARRAY.
+C
+  210 IP1 = IPMN1
+      IP2 = IPMN2
+      IP3 = IWP(3)
+      IF (SIDE(XD(IP1),YD(IP1),XD(IP2),YD(IP2),XD(IP3),YD(IP3)) .GE.
+     1    0.0) GO TO  220
+      IP1 = IPMN2
+      IP2 = IPMN1
+  220 NT0 = 1
+      NTT3 = 3
+      IPT(1) = IP1
+      IPT(2) = IP2
+      IPT(3) = IP3
+      NL0 = 3
+      NLT3 = 9
+      IPL(1) = IP1
+      IPL(2) = IP2
+      IPL(3) = 1
+      IPL(4) = IP2
+      IPL(5) = IP3
+      IPL(6) = 1
+      IPL(7) = IP3
+      IPL(8) = IP1
+      IPL(9) = 1
+C
+C ADDS THE REMAINING (NDP-3) DATA POINTS, ONE BY ONE.
+C
+      DO  400 JP1=4,NDP
+         IP1 = IWP(JP1)
+         X1 = XD(IP1)
+         Y1 = YD(IP1)
+C
+C - DETERMINES THE VISIBLE BORDER LINE SEGMENTS.
+C
+         IP2 = IPL(1)
+         JPMN = 1
+         DXMN = XD(IP2)-X1
+         DYMN = YD(IP2)-Y1
+         DSQMN = DXMN**2+DYMN**2
+         ARMN = DSQMN*RATIO
+         JPMX = 1
+         DXMX = DXMN
+         DYMX = DYMN
+         DSQMX = DSQMN
+         ARMX = ARMN
+         DO  240 JP2=2,NL0
+            IP2 = IPL(3*JP2-2)
+            DX = XD(IP2)-X1
+            DY = YD(IP2)-Y1
+            AR = DY*DXMN-DX*DYMN
+            IF (AR .GT. ARMN) GO TO  230
+            DSQI = DX**2+DY**2
+            IF (AR.GE.(-ARMN) .AND. DSQI.GE.DSQMN) GO TO  230
+            JPMN = JP2
+            DXMN = DX
+            DYMN = DY
+            DSQMN = DSQI
+            ARMN = DSQMN*RATIO
+  230       AR = DY*DXMX-DX*DYMX
+            IF (AR .LT. (-ARMX)) GO TO  240
+            DSQI = DX**2+DY**2
+            IF (AR.LE.ARMX .AND. DSQI.GE.DSQMX) GO TO  240
+            JPMX = JP2
+            DXMX = DX
+            DYMX = DY
+            DSQMX = DSQI
+            ARMX = DSQMX*RATIO
+  240    CONTINUE
+         IF (JPMX .LT. JPMN) JPMX = JPMX+NL0
+         NSH = JPMN-1
+         IF (NSH .LE. 0) GO TO  270
+C
+C - SHIFTS (ROTATES) THE IPL ARRAY TO HAVE THE INVISIBLE BORDER
+C - LINE SEGMENTS CONTAINED IN THE FIRST PART OF THE IPL ARRAY.
+C
+         NSHT3 = NSH*3
+         DO  250 JP2T3=3,NSHT3,3
+            JP3T3 = JP2T3+NLT3
+            IPL(JP3T3-2) = IPL(JP2T3-2)
+            IPL(JP3T3-1) = IPL(JP2T3-1)
+            IPL(JP3T3) = IPL(JP2T3)
+  250    CONTINUE
+         DO  260 JP2T3=3,NLT3,3
+            JP3T3 = JP2T3+NSHT3
+            IPL(JP2T3-2) = IPL(JP3T3-2)
+            IPL(JP2T3-1) = IPL(JP3T3-1)
+            IPL(JP2T3) = IPL(JP3T3)
+  260    CONTINUE
+         JPMX = JPMX-NSH
+C
+C - ADDS TRIANGLES TO THE IPT ARRAY, UPDATES BORDER LINE
+C - SEGMENTS IN THE IPL ARRAY, AND SETS FLAGS FOR THE BORDER
+C - LINE SEGMENTS TO BE REEXAMINED IN THE IWL ARRAY.
+C
+  270    JWL = 0
+         DO  310 JP2=JPMX,NL0
+            JP2T3 = JP2*3
+            IPL1 = IPL(JP2T3-2)
+            IPL2 = IPL(JP2T3-1)
+            IT = IPL(JP2T3)
+C
+C - - ADDS A TRIANGLE TO THE IPT ARRAY.
+C
+            NT0 = NT0+1
+            NTT3 = NTT3+3
+            IPT(NTT3-2) = IPL2
+            IPT(NTT3-1) = IPL1
+            IPT(NTT3) = IP1
+C
+C - - UPDATES BORDER LINE SEGMENTS IN THE IPL ARRAY.
+C
+            IF (JP2 .NE. JPMX) GO TO  280
+            IPL(JP2T3-1) = IP1
+            IPL(JP2T3) = NT0
+  280       IF (JP2 .NE. NL0) GO TO  290
+            NLN = JPMX+1
+            NLNT3 = NLN*3
+            IPL(NLNT3-2) = IP1
+            IPL(NLNT3-1) = IPL(1)
+            IPL(NLNT3) = NT0
+C
+C - - DETERMINES THE VERTEX THAT DOES NOT LIE ON THE BORDER
+C - - LINE SEGMENTS.
+C
+  290       ITT3 = IT*3
+            IPTI = IPT(ITT3-2)
+            IF (IPTI.NE.IPL1 .AND. IPTI.NE.IPL2) GO TO  300
+            IPTI = IPT(ITT3-1)
+            IF (IPTI.NE.IPL1 .AND. IPTI.NE.IPL2) GO TO  300
+            IPTI = IPT(ITT3)
+C
+C - - CHECKS IF THE EXCHANGE IS NECESSARY.
+C
+  300       IF (CONXCH(XD,YD,IP1,IPTI,IPL1,IPL2) .EQ. 0) GO TO  310
+C
+C - - MODIFIES THE IPT ARRAY WHEN NECESSARY.
+C
+            IPT(ITT3-2) = IPTI
+            IPT(ITT3-1) = IPL1
+            IPT(ITT3) = IP1
+            IPT(NTT3-1) = IPTI
+            IF (JP2 .EQ. JPMX) IPL(JP2T3) = IT
+            IF (JP2.EQ.NL0 .AND. IPL(3).EQ.IT) IPL(3) = NT0
+C
+C - - SETS FLAGS IN THE IWL ARRAY.
+C
+            JWL = JWL+4
+            IWL(JWL-3) = IPL1
+            IWL(JWL-2) = IPTI
+            IWL(JWL-1) = IPTI
+            IWL(JWL) = IPL2
+  310    CONTINUE
+         NL0 = NLN
+         NLT3 = NLNT3
+         NLF = JWL/2
+         IF (NLF .EQ. 0) GO TO  400
+C
+C - IMPROVES TRIANGULATION.
+C
+         NTT3P3 = NTT3+3
+         DO  390 IREP=1,NREP
+            DO  370 ILF=1,NLF
+               ILFT2 = ILF*2
+               IPL1 = IWL(ILFT2-1)
+               IPL2 = IWL(ILFT2)
+C
+C - - LOCATES IN THE IPT ARRAY TWO TRIANGLES ON BOTH SIDES OF
+C - - THE FLAGGED LINE SEGMENT.
+C
+               NTF = 0
+               DO  320 ITT3R=3,NTT3,3
+                  ITT3 = NTT3P3-ITT3R
+                  IPT1 = IPT(ITT3-2)
+                  IPT2 = IPT(ITT3-1)
+                  IPT3 = IPT(ITT3)
+                  IF (IPL1.NE.IPT1 .AND. IPL1.NE.IPT2 .AND.
+     1                IPL1.NE.IPT3) GO TO  320
+                  IF (IPL2.NE.IPT1 .AND. IPL2.NE.IPT2 .AND.
+     1                IPL2.NE.IPT3) GO TO  320
+                  NTF = NTF+1
+                  ITF(NTF) = ITT3/3
+                  IF (NTF .EQ. 2) GO TO  330
+  320          CONTINUE
+               IF (NTF .LT. 2) GO TO  370
+C
+C - - DETERMINES THE VERTEXES OF THE TRIANGLES THAT DO NOT LIE
+C - - ON THE LINE SEGMENT.
+C
+  330          IT1T3 = ITF(1)*3
+               IPTI1 = IPT(IT1T3-2)
+               IF (IPTI1.NE.IPL1 .AND. IPTI1.NE.IPL2) GO TO  340
+               IPTI1 = IPT(IT1T3-1)
+               IF (IPTI1.NE.IPL1 .AND. IPTI1.NE.IPL2) GO TO  340
+               IPTI1 = IPT(IT1T3)
+  340          IT2T3 = ITF(2)*3
+               IPTI2 = IPT(IT2T3-2)
+               IF (IPTI2.NE.IPL1 .AND. IPTI2.NE.IPL2) GO TO  350
+               IPTI2 = IPT(IT2T3-1)
+               IF (IPTI2.NE.IPL1 .AND. IPTI2.NE.IPL2) GO TO  350
+               IPTI2 = IPT(IT2T3)
+C
+C - - CHECKS IF THE EXCHANGE IS NECESSARY.
+C
+  350          IF (CONXCH(XD,YD,IPTI1,IPTI2,IPL1,IPL2) .EQ. 0)
+     1             GO TO  370
+C
+C - - MODIFIES THE IPT ARRAY WHEN NECESSARY.
+C
+               IPT(IT1T3-2) = IPTI1
+               IPT(IT1T3-1) = IPTI2
+               IPT(IT1T3) = IPL1
+               IPT(IT2T3-2) = IPTI2
+               IPT(IT2T3-1) = IPTI1
+               IPT(IT2T3) = IPL2
+C
+C - - SETS NEW FLAGS.
+C
+               JWL = JWL+8
+               IWL(JWL-7) = IPL1
+               IWL(JWL-6) = IPTI1
+               IWL(JWL-5) = IPTI1
+               IWL(JWL-4) = IPL2
+               IWL(JWL-3) = IPL2
+               IWL(JWL-2) = IPTI2
+               IWL(JWL-1) = IPTI2
+               IWL(JWL) = IPL1
+               DO  360 JLT3=3,NLT3,3
+                  IPLJ1 = IPL(JLT3-2)
+                  IPLJ2 = IPL(JLT3-1)
+                  IF ((IPLJ1.EQ.IPL1 .AND. IPLJ2.EQ.IPTI2) .OR.
+     1                (IPLJ2.EQ.IPL1 .AND. IPLJ1.EQ.IPTI2))
+     2                IPL(JLT3) = ITF(1)
+                  IF ((IPLJ1.EQ.IPL2 .AND. IPLJ2.EQ.IPTI1) .OR.
+     1                (IPLJ2.EQ.IPL2 .AND. IPLJ1.EQ.IPTI1))
+     2                IPL(JLT3) = ITF(2)
+  360          CONTINUE
+  370       CONTINUE
+            NLFC = NLF
+            NLF = JWL/2
+            IF (NLF .EQ. NLFC) GO TO  400
+C
+C - - RESETS THE IWL ARRAY FOR THE NEXT ROUND.
+C
+            JWL = 0
+            JWL1MN = (NLFC+1)*2
+            NLFT2 = NLF*2
+            DO  380 JWL1=JWL1MN,NLFT2,2
+               JWL = JWL+2
+               IWL(JWL-1) = IWL(JWL1-1)
+               IWL(JWL) = IWL(JWL1)
+  380       CONTINUE
+            NLF = JWL/2
+  390    CONTINUE
+  400 CONTINUE
+C
+C REARRANGE THE IPT ARRAY SO THAT THE VERTEXES OF EACH TRIANGLE
+C ARE LISTED COUNTER-CLOCKWISE.
+C
+      DO  410 ITT3=3,NTT3,3
+         IP1 = IPT(ITT3-2)
+         IP2 = IPT(ITT3-1)
+         IP3 = IPT(ITT3)
+         IF (SIDE(XD(IP1),YD(IP1),XD(IP2),YD(IP2),XD(IP3),YD(IP3)) .GE.
+     1       0.0) GO TO  410
+         IPT(ITT3-2) = IP2
+         IPT(ITT3-1) = IP1
+  410 CONTINUE
+      NT = NT0
+      NL = NL0
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/conlib/conxch.f b/sys/gio/ncarutil/conlib/conxch.f
new file mode 100644
index 00000000..6309f360
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conxch.f
@@ -0,0 +1,67 @@
+      INTEGER FUNCTION CONXCH (X,Y,I1,I2,I3,I4)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C THIS FUNCTION DETERMINES WHETHER OR NOT THE EXCHANGE OF TWO
+C TRIANGLES IS NECESSARY ON THE BASIS OF MAX-MIN-ANGLE CRITERION
+C BY C. L. LAWSON.
+C THE INPUT PARAMETERS ARE
+C     X,Y = ARRAYS CONTAINING THE COORDINATES OF THE DATA
+C           POINTS,
+C     I1,I2,I3,I4 = POINT NUMBERS OF FOUR POINTS P1, P2,
+C                   P3, AND P4 THAT FORM A QUADRILATERAL
+C                   WITH P3 AND P4 CONNECTED DIADONALLY.
+C THIS FUNCTION RETURNS A VALUE 1 (ONE) WHEN AN EXCHANGE IS
+C NEEDED, AND 0 (ZERO) OTHERWISE.
+C DECLARATION STATEMENTS
+C
+      DIMENSION       X(1)       ,Y(1)
+      DIMENSION       X0(4)      ,Y0(4)
+      EQUIVALENCE     (C2SQ,C1SQ),(A3SQ,B2SQ),(B3SQ,A1SQ),(A4SQ,B1SQ),
+     1                (B4SQ,A2SQ),(C4SQ,C3SQ)
+C
+        SAVE
+C
+C STATEMENT FUNCTIONS
+C
+C CALCULATION
+C
+      X0(1) = X(I1)
+      Y0(1) = Y(I1)
+      X0(2) = X(I2)
+      Y0(2) = Y(I2)
+      X0(3) = X(I3)
+      Y0(3) = Y(I3)
+      X0(4) = X(I4)
+      Y0(4) = Y(I4)
+      IDX = 0
+      U3 = (Y0(2)-Y0(3))*(X0(1)-X0(3))-(X0(2)-X0(3))*(Y0(1)-Y0(3))
+      U4 = (Y0(1)-Y0(4))*(X0(2)-X0(4))-(X0(1)-X0(4))*(Y0(2)-Y0(4))
+      IF (U3*U4 .LE. 0.0) GO TO  100
+      U1 = (Y0(3)-Y0(1))*(X0(4)-X0(1))-(X0(3)-X0(1))*(Y0(4)-Y0(1))
+      U2 = (Y0(4)-Y0(2))*(X0(3)-X0(2))-(X0(4)-X0(2))*(Y0(3)-Y0(2))
+      A1SQ = (X0(1)-X0(3))**2+(Y0(1)-Y0(3))**2
+      B1SQ = (X0(4)-X0(1))**2+(Y0(4)-Y0(1))**2
+      C1SQ = (X0(3)-X0(4))**2+(Y0(3)-Y0(4))**2
+      A2SQ = (X0(2)-X0(4))**2+(Y0(2)-Y0(4))**2
+      B2SQ = (X0(3)-X0(2))**2+(Y0(3)-Y0(2))**2
+      C3SQ = (X0(2)-X0(1))**2+(Y0(2)-Y0(1))**2
+      S1SQ = U1*U1/(C1SQ*AMAX1(A1SQ,B1SQ))
+      S2SQ = U2*U2/(C2SQ*AMAX1(A2SQ,B2SQ))
+      S3SQ = U3*U3/(C3SQ*AMAX1(A3SQ,B3SQ))
+      S4SQ = U4*U4/(C4SQ*AMAX1(A4SQ,B4SQ))
+      IF (AMIN1(S1SQ,S2SQ) .LT. AMIN1(S3SQ,S4SQ)) IDX = 1
+  100 CONXCH = IDX
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/conlib/mkpkg b/sys/gio/ncarutil/conlib/mkpkg
new file mode 100644
index 00000000..5ebdc2cb
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/mkpkg
@@ -0,0 +1,37 @@
+# Update the CONCOM and CONTERP contributions to LIBNCAR.
+
+$checkout libncar.a lib$
+$update   libncar.a
+$checkin  libncar.a lib$
+$exit
+
+libncar.a:
+	concal.f
+	concld.f
+	concls.f
+	concom.f
+	condet.f
+	condrw.f
+	condsd.f
+	conecd.f
+	congen.f
+	conint.f
+	conlcm.f
+	conlin.f
+	conloc.f
+	conlod.f
+	conop1.f
+	conop2.f
+	conop3.f
+	conop4.f
+	conot2.f
+	conout.f
+	conpdv.f
+	conreo.f
+	consld.f
+	conssd.f
+	constp.f
+	contlk.f
+	contng.f
+	conxch.f
+	;
diff --git a/sys/gio/ncarutil/conran.f b/sys/gio/ncarutil/conran.f
new file mode 100644
index 00000000..bc23a6cc
--- /dev/null
+++ b/sys/gio/ncarutil/conran.f
@@ -0,0 +1,1976 @@
+      SUBROUTINE CONRAN (XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C    SUBROUTINE CONRAN(XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C    STANDARD AND SMOOTH VERSIONS OF CONRAN
+C
+C          DIMENSION OF  XD(NDP),YD(NDP),ZD(NDP),WK(13*NDP)
+C             ARGUMENTS  IWK((27+NCP)*NDP),SCRARR(RESOLUTION**2)
+C                        WHERE NCP = 4 AND RESOLUTION = 40 BY
+C                        DEFAULT.
+C
+C       LATEST REVISION  JULY 1984
+C
+C              OVERVIEW  CONRAN  PERFORMS  CONTOURING  OF  IRREGULARLY
+C                        DISTRIBUTED  DATA.   IT IS THE STANDARD AND
+C                        SMOOTH MEMBERS OF THE CONRAN FAMILY. THIS
+C                        VERSION  WILL  PLOT CONTOURS; SMOOTH THEM USING
+C                        SPLINES  UNDER  TENSION (IF THE PACKAGE DASHSMTH
+C                        IS LOADED); PLOT A PERIMETER OR GRID; TITLE THE
+C                        PLOT; PRINT A MESSAGE GIVING THE CONTOUR INTERVALS
+C                        BELOW THE MAP; PLOT THE INPUT DATA ON THE MAP;
+C                        AND LABEL THE CONTOUR LINES.
+C
+C               PURPOSE  CONRAN  PLOTS  CONTOUR  LINES  USING  RANDOM,
+C                        SPARSE  OR  IRREGULAR DATA SETS.  THE DATA IS
+C                        TRIANGULATED AND THEN CONTOURED.   CONTOURING
+C                        IS  PERFORMED USING INTERPOLATION OF THE TRI-
+C                        ANGULATED DATA.  THERE ARE TWO METHODS OF
+C                        INTERPOLATION:  C1 SURFACES AND LINEAR.
+C
+C                 USAGE  CALL CONRAN(XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C                        AN OPTION SETTING ROUTINE  CAN  ALSO  BE  IN-
+C                        VOKED,  SEE  WRITEUP  BELOW.   FRAME  MUST BE
+C                        CALLED BY THE USER.
+C
+C                        IF DIFFERENT COLORS (OR INTENSITIES) ARE TO BE
+C                        USED FOR NORMAL INTENSITY, LOW INTENSITY OR
+C                        TEXT OUTPUT, THEN THE VALUES IN COMMON BLOCK
+C                        RANINT SHOULD BE CHANGED:
+C
+C                        IRANMJ  COLOR INDEX FOR NORMAL (MAJOR) INTENSITY
+C                                LINES.
+C                        IRANMN  COLOR INDEX FOR LOW INTENSITY LINES
+C                        IRANTX  COLOR INDEX FOR TEXT (LABELS)
+C
+C
+C             ARGUMENTS
+C
+C              ON INPUT  XD
+C                            ARRAY OF DIMENSION NDP CONTAINING THE  X-
+C                            COORDINATES OF THE DATA POINTS.
+C
+C                        YD
+C                            ARRAY OF DIMENSION NDP CONTAINING THE  Y-
+C                            COORDINATES OF THE DATA POINTS.
+C
+C                        ZD
+C                            ARRAY OF  DIMENSION  NDP  CONTAINING  THE
+C                            DATA VALUES AT THE POINTS.
+C
+C                        NDP
+C                            NUMBER OF  DATA  POINTS  (MUST  BE  4  OR
+C                            GREATER) TO BE CONTOURED.
+C
+C                        WK
+C                            REAL WORK ARRAY  OF  DIMENSION  AT  LEAST
+C                            13*NDP
+C
+C                        IWK
+C                            INTEGER WORK ARRAY.  WHEN USING C1 SURFACES
+C                            THE ARRAY MUST BE AT LEAST IWK((27+NCP)*NDP).
+C                            WHEN USING LINEAR INTERPOLATION THE ARRAY
+C                            MUST BE AT LEAST IWK((27+4)*NDP).
+C
+C                        SCRARR
+C                            REAL WORK ARRAY  OF  DIMENSION  AT  LEAST
+C                            (RESOLUTION**2)   WHERE   RESOLUTION   IS
+C                            DESCRIBED IN THE SSZ OPTION BELOW.  RESO-
+C                            LUTION IS 40 BY DEFAULT.
+C
+C             ON OUTPUT  ALL ARGUMENTS  REMAIN  UNCHANGED  EXCEPT  THE
+C                        SCRATCH ARRAYS IWK, WK, AND SCRARR WHICH HAVE
+C                        BEEN WRITTEN INTO.  IF MAKING  MULTIPLE  RUNS
+C                        ON  THE SAME TRIANGULATION IWK AND WK MUST BE
+C                        SAVED AND RETURNED TO THE NEXT INVOCATION  OF
+C                        CONRAN.
+C
+C          ENTRY POINTS  CONRAN, CONDET, CONINT, CONCAL, CONLOC, CONTNG,
+C                        CONDRW, CONCLS, CONSTP, CONBDN, CONTLK
+C                        CONPDV, CONOP1, CONOP2, CONOP3, CONOP4,
+C                        CONXCH, CONREO, CONCOM, CONCLD, CONPMM,
+C                        CONGEN, CONLOD, CONECD, CONOUT, CONOT2,
+C                        CONSLD, CONLCM, CONLIN, CONDSD, CONSSD
+C
+C         COMMON BLOCKS  CONRA1, CONRA2, CONRA3, CONRA4, CONRA5, CONRA6,
+C                        CONRA7, CONRA8, CONRA9, CONR10, CONR11, CONR12,
+C                        CONR13, CONR14, CONR15, CONR16, CONR17, RANINT
+C                        INTPR FROM THE DASH PACKAGE
+C
+C                   I/O  PLOTS THE CONTOUR MAP AND, VIA  THE ERPRT77
+C                        PACKAGE,  OUTPUTS  MESSAGES  TO  THE MESSAGE
+C                        OUTPUT  UNIT; AT  NCAR  THIS  UNIT  IS  THE
+C                        PRINTER.  THE OPTION VALUES ARE ALL LISTED ON
+C                        STANDARD ERPRT77 OUTPUT UNIT; AT NCAR THIS
+C                        UNIT IS THE PRINTER.
+C
+C             PRECISION  SINGLE
+C
+C      REQUIRED LIBRARY  STANDARD VERSION: DASHCHAR, WHICH AT NCAR IS
+C              ROUTINES  LOADED BY DEFAULT.
+C                        SMOOTH VERSION: DASHSMTH WHICH MUST BE
+C                        REQUESTED AT NCAR.
+C                        BOTH VERSIONS REQUIRE CONCOM, CONTERP, GRIDAL
+C                        THE ERPRT77 PACKAGE, AND THE SPPS.
+C
+C              LANGUAGE  FORTRAN77
+C
+C               HISTORY
+C
+C             ALGORITHM  THE SPARSE DATA IS TRIANGULATED AND A VIRTUAL
+C                        GRID  IS  LAID  OVER  THE  TRIANGULATED AREA.
+C                        EACH VIRTUAL GRID POINT RECEIVES AN  INTERPO-
+C                        LATED  VALUE.   THE  GRID IS SCANNED ONCE FOR
+C                        EACH CONTOUR LEVEL AND ALL CONTOURS  AT  THAT
+C                        LEVEL ARE PLOTTED.
+C                        THERE ARE TWO METHODS OF INTERPOLATION. THE
+C                        FIRST IS A SMOOTH DATA INTERPOLATION
+C                        SCHEME BASED  ON  LAWSON'S  C1
+C                        SURFACE  INTERPOLATION  ALGORITHM,  WHICH HAS
+C                        BEEN REFINED  BY  HIROSHA  AKIMA.   PARTS  OF
+C                        AKIMA'S  ALGORITHM  ARE USED IN THIS PACKAGE.
+C                        SEE THE "REFERENCE" SECTION BELOW.
+C                        THE SECOND IS A LINEAR INTERPOLATION SCHEME.
+C                        WHEN DATA IS SPARSE IT IS USUALLY BETTER TO
+C                        USE THE C1 INTERPOLATION.  IF YOU HAVE DENSE
+C                        DATA (OVER 100 POINTS) THEN THE LINEAR
+C                        INTERPOLATION WILL GIVE THE BETTER RESULTS.
+C
+C           PORTABILITY  ANSI FORTRAN
+C
+C
+C             OPERATION  CALL CONRAN (XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C
+C                        FRAME MUST BE CALLED BY THE USER.
+C
+C                        CONRAN HAS MANY OPTIONS, EACH OF WHICH MAY
+C                        BE CHANGED BY CALLING ONE OF THE FOUR
+C                        SUBROUTINES CONOP1, CONOP2, CONOP3, OR
+C                        CONOP4.  THE NUMBER OF ARGUMENTS TO EACH
+C                        CONOP ROUTINE IS THE SAME AS THE FINAL
+C                        SUFFIX CHARACTER IN THE ROUTINE'S NAME.
+C
+C                        THE CONOP ROUTINES ARE CALLED BEFORE CONRAN
+C                        IS CALLED, AND VALUES SET BY THESE CALLS
+C                        CONTINUE TO BE IN EFFECT UNTIL THEY ARE
+C                        CHANGED BY ANOTHER CALL TO A CONOP ROUTINE.
+C
+C                        ALL THE CONOP ROUTINES HAVE AS THEIR FIRST
+C                        ARGUMENT A CHARACTER STRING TO IDENTIFY THE
+C                        OPTION BEING CHANGED.  THIS IS THE ONLY
+C                        ARGUMENT TO CONOP1.  CONOP2 HAS AN INTEGER
+C                        SECOND ARGUMENT.  CONOP3 HAS A REAL ARRAY (OR
+C                        CONSTANT) AS ITS SECOND ARGUMENT AND AN
+C                        INTEGER (USUALLY THE DIMENSION OF THE
+C                        ARRAY) AS ITS THIRD ARGUMENT.  CONOP4 HAS A
+C                        CHARACTER STRING AS ITS SECOND ARGUMENT AND
+C                        INTEGERS FOR THE THIRD AND FOURTH ARGUMENTS.
+C
+C                        ONLY THE FIRST TWO CHARACTERS ON EACH SIDE OF
+C                        THE EQUAL SIGN ARE SCANNED.  THEREFORE ONLY 2
+C                        CHARACTERS  FOR  EACH  OPTION ARE REQUIRED ON
+C                        INPUT TO CONOP (I.E.  'SCA=PRI'  AND  'SC=PR'
+C                        ARE EQUIVALENT.)
+C
+C                        REMEMBER, THERE MUST BE AT LEAST 4 DATA POINTS.
+C                        THIS IS EQUAL TO  THE  DEFAULT  NUMBER OF
+C                        DATA POINTS TO BE USED FOR ESTIMATION OF PAR-
+C                        TIAL DERIVATIVES AT  EACH  DATA  POINT.
+C                        THE ESTIMATED PARTIAL DERIVATIVES  ARE
+C                        USED  FOR THE CONSTRUCTION OF THE INTERPOLAT-
+C                        ING POLYNOMIAL'S COEFFICIENTS.
+C
+C                        LISTED BELOW ARE OPTIONS WHICH CAN ENHANCE
+C                        YOUR PLOT.  AN EXAMPLE OF AN APPROPRIATE
+C                        CONOP CALL IS GIVEN FOR EACH OPTION.  A
+C                        COMPLETE LIST OF DEFAULT SETTINGS FOLLOWS
+C                        THE LAST OPTION.
+C
+C               OPTIONS
+C
+C                   CHL  THIS FLAG DETERMINES HOW  THE  HIGH  AND  LOW
+C                        CONTOUR VALUES ARE SET.  THESE CONTOUR VALUES
+C                        MAY BE SET BY THE PROGRAM OR BY THE USER.  IF
+C                        CHL=OFF,  THE PROGRAM EXAMINES THE USER'S IN-
+C                        PUT DATA AND DETERMINES BOTH THE HIGH AND LOW
+C                        VALUES.  IF CHL=ON, THE USER MUST SPECIFY THE
+C                        DESIRED HIGH (HI) AND LOW (FLO) VALUES.
+C                        THE DEFAULT IS CHL=OFF.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('CHL=OFF',0.,0)
+C
+C                        IF USER SET:  CALL CONOP3('CHL=ON',ARRAY,2)
+C                                WHERE ARRAY(1)=HI, ARRAY(2)=FLO
+C
+C                        NOTE: THE VALUES SUPPLIED FOR CONTOUR  INCRE-
+C                        MENT  AND CONTOUR HIGH AND LOW VALUES ASSUMES
+C                        THE UNSCALED DATA VALUES.  SEE THE SDC  FLAG,
+C                        BELOW.
+C
+C                        EXAMPLE:  CALL   CONOP3('CHL=ON',ARRAY,2)
+C                                  WHERE  ARRAY(1)=5020. (THE DESIRED
+C                                  HIGH CONTOUR VALUE) AND ARRAY(2)=
+C                                  2000 (THE DESIRED LOW CONTOUR VALUE).
+C                                  THESE ARE FLOATING POINT NUMBERS.
+C
+C                   CIL  THIS FLAG DETERMINES HOW THE  CONTOUR  INCRE-
+C                        MENT  (CINC) IS SET.  THE INCREMENT IS EITHER
+C                        CALCULATED BY THE PROGRAM (CIL=OFF) USING THE
+C                        RANGE  OF HIGH AND LOW VALUES FROM THE USER'S
+C                        INPUT DATA, OR SET BY THE USER (CIL=ON). THE
+C                        DEFAULT IS CIL=OFF.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('CIL=OFF',0.,0)
+C
+C                        IF USER SET:      CALL CONOP3('CIL=ON',CINC,1)
+C
+C                        NOTE: BY DEFAULT,  THE  PROGRAM  WILL EXAMINE
+C                        THE USER'S INPUT DATA AND DETERMINE THE CONTOUR
+C                        INTERVAL (CINC)  AT SOME APPROPRIATE RANGE BETWEEN
+C                        THE LEVEL OF HIGH AND LOW VALUES SUPPLIED, USUALLY
+C                        GENERATING BETWEEN 15 AND 20 CONTOUR LEVELS.
+C                        ELS.
+C
+C                        EXAMPLE:          CALL CONOP3('CIL=ON',15.,1)
+C                                          WHERE  15.  REPRESENTS  THE
+C                                          CONTOUR  INCREMENT  DESIRED
+C                                          BY THE USER.
+C
+C                   CON  THIS FLAG DETERMINES HOW THE  CONTOUR  LEVELS
+C                        ARE  SET.   IF  CON=ON, THE USER MUST SPECIFY
+C                        THE ARRAY OF CONTOUR VALUES AND THE NUMBER OF
+C                        CONTOUR LEVELS.  A  MAXIMUM OF 30 CONTOUR (NCL)
+C                        LEVELS ARE PERMITTED.  IF CON=OFF,  DEFAULT
+C                        VALUES  ARE  USED.  IN THIS CASE, THE PROGRAM
+C                        WILL CALCULATE THE VALUES FOR THE  ARRAY  AND
+C                        NCL USING INPUT DATA.  THE DEFAULT IS OFF.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('CON=OFF',0.,0)
+C
+C                        IF USER SET:   CALL CONOP3('CON=ON',ARRAY,NCL)
+C
+C                        NOTE: THE ARRAY (ARRAY) CONTAINS THE  CONTOUR
+C                        LEVELS  (FLOATING  POINT ONLY) AND NCL IS THE
+C                        NUMBER OF LEVELS.  THE MAXIMUM NUMBER OF CON-
+C                        TOUR LEVELS ALLOWED IS 30.  WHEN ASSIGNING
+C                        THE ARRAY OF CONTOUR VALUES, THE VALUES MUST
+C                        BE ORDERED FROM SMALLEST TO LARGEST.
+C
+C                        EXAMPLE:
+C                         DATA RLIST(1),...,RLIST(5)/1.,2.,3.,10.,12./
+C
+C                                  CALL CONOP3('CON=ON',RLIST,5) WHERE
+C                                  'RLIST' CONTAINS THE USER SPECIFIED
+C                                  CONTOUR LEVELS, AND 5  IS  THE
+C                                  NUMBER  OF  USER  SPECIFIED CONTOUR
+C                                  LEVELS (NCL).
+C
+C                        WARNING ON CONTOUR OPTIONS:
+C                        IT IS ILLEGAL TO USE THE CON OPTION WHEN
+C                        EITHER  CIL  OR  CHL  ARE ACTIVATED.  IF
+C                        THIS IS DONE, THE OPTION CALL THAT DETECTED
+C                        THE ERROR WILL NOT BE EXECUTED.
+C
+C                   DAS  THIS  FLAG  DETERMINES  WHICH  CONTOURS   ARE
+C                        REPRESENTED  BY  DASHED LINES.  THE USER SETS
+C                        THE DASHED LINE PATTERN.  THE USER MAY SPECI-
+C                        FY  THAT  DASHED  LINES  BE USED FOR CONTOURS
+C                        WHOSE  VALUE  IS  LESS  THAN,  EQUAL  TO,  OR
+C                        GREATER THAN THE DASH PATTERN BREAKPOINT (SEE
+C                        THE DBP OPTION BELOW), WHICH IS ZERO BY
+C                        DEFAULT.  IF DAS=OFF (THE DEFAULT VALUE), ALL
+C                        SOLID LINES ARE USED.
+C
+C                        ALL SOLID LINES: CALL CONOP4('DAS=OFF',' ',0,0)
+C
+C                        IF GREATER:      CALL CONOP4('DAS=GTR',PAT,0,0)
+C
+C                        IF EQUAL:        CALL CONOP4('DAS=EQU',PAT,0,0)
+C
+C                        IF LESS:         CALL CONOP4('DAS=LSS',PAT,0,0)
+C
+C                        IF ALL SAME:     CALL CONOP4('DAS=ALL',PAT,0,0)
+C
+C                        NOTE: PAT MUST BE A TEN CHARACTER
+C                        STRING WITH A DOLLAR SIGN ($) FOR SOLID AND A
+C                        SINGLE QUOTE (') FOR BLANK.  RECALL THAT IN
+C                        FORTRAN 77, IN A QUOTED STRING A SINGLE QUOTE
+C                        IS REPRESENTED BY TWO SINGLE QUOTES ('').
+C
+C                        EXAMPLE:
+C                          CALL CONOP4('DAS=GTR','$$$$$''$$$$',0,0)
+C
+C                   DBP  THIS FLAG DETERMINES  HOW  THE  DASH  PATTERN
+C                        BREAK POINT (BP) IS SET.  IF DBP=ON, BP  MUST
+C                        BE SET BY THE  USER  BY  SPECIFYING  BP.   IF
+C                        DBP=OFF  THE  PROGRAM  WILL SET BP TO THE
+C                        DEFAULT VALUE WHICH IS ZERO.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('DBP=OFF',0.,0)
+C
+C                        IF USER SET:      CALL CONOP3('DBP=ON',BP,1)
+C
+C                        NOTE: BP IS A FLOATING POINT NUMBER WHERE THE
+C                        BREAK  FOR  GTR AND LSS CONTOUR DASH PATTERNS
+C                        ARE DEFINED.  BP IS ASSUMED TO BE GIVEN RELA-
+C                        TIVE TO THE UNTRANSFORMED CONTOURS.
+C
+C                        EXAMPLE:          CALL CONOP3('DBP=ON',5.,1)
+C                                          WHERE 5. IS THE USER SPECI-
+C                                          FIED BREAK POINT.
+C
+C                   DEF  RESET FLAGS TO  DEFAULT  VALUES.   ACTIVATING
+C                        THIS  OPTION  SETS  ALL  FLAGS TO THE DEFAULT
+C                        VALUE.  DEF HAS NO 'ON' OF 'OFF' STATES.
+C
+C                        TO ACTIVATE:   CALL CONOP1('DEF')
+C
+C                   EXT  FLAG TO SET EXTRAPOLATION. NORMALLY ALL
+C                        CONRAN VERSIONS WILL  ONLY PLOT THE BOUNDARIES
+C                        OF THE CONVEX HULL DEFINED BY THE USER'S DATA.
+C                        TO HAVE THE CONTOURS FILL THE RECTANGULAR
+C                        AREA OF THE FRAME, SET THE EXT SWITCH ON.
+C                        THE DEFAULT IS OFF.
+C
+C                        TO TURN ON:    CALL CONOP1('EXT=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('EXT=OFF')
+C
+C                   FMT  FLAG FOR THE FORMAT OF THE PLOTTED INPUT DATA
+C                        VALUES.   IF  FMT=OFF, THE DEFAULT VALUES FOR
+C                        FT, L, AND IF ARE USED.  THE  DEFAULT  VALUES
+C                        ARE:
+C
+C                        FT = '(G10.3)'
+C                        L  = 7  CHARACTERS INCLUDING THE PARENTHESES
+C                        IF = 10 CHARACTERS PRINTED IN THE OUTPUT
+C                             FIELD BY THE FORMAT
+C
+C                        IF FMT=ON, THE USER MUST SPECIFY  VALUES  FOR
+C                        FT,  L,  AND  IF.   ALL USER SPECIFIED VALUES
+C                        MUST BE GIVEN IN THE CORRECT FORMAT.
+C
+C                        IF PROGRAM SET:  CALL CONOP4('FMT=OFF',' ',0,0)
+C
+C                        IF USER SET:  CALL CONOP4('FMT=ON',FT,L,IF)
+C
+C                        NOTE: FT IS A CHARACTER STRING CONTAINING THE
+C                        FORMAT.   THE  FORMAT  MUST  BE  ENCLOSED  IN
+C                        PARENTHESES.  ANY  FORMAT, UP TO 10 CHARACTERS
+C                        WHICH IS  ALLOWED  AT  YOUR INSTALLATION WILL BE
+C                        ACCEPTED.  L IS THE NUMBER OF  CHARACTERS  IN
+C                        FT.  IF IS THE LENGTH OF THE FIELD CREATED BY
+C                        THE FORMAT.
+C
+C                        EXAMPLE:  CALL CONOP4('FMT=ON','(G30.2)',7,30)
+C
+C                        WARNING: CONRAN WILL NOT  TEST  FOR  A  VALID
+C                        FORMAT.  THE FORMAT IS ONLY ALLOWED TO BE
+C                        10 CHARACTERS LONG.
+C
+C                   GRI  FLAG TO DISPLAY THE GRID. GRI IS OFF BY DEFAULT.
+C
+C                        TO TURN ON:    CALL CONOP1('GRI=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('GRI=OFF')
+C
+C                        NOTE: IF GRI IS ON, THE VIRTUAL GRID WILL
+C                        BE SUPERIMPOSED OVER THE CONTOUR PLOT.
+C                        THE X AND Y TICK INTERVALS WILL BE DISPLAYED
+C                        UNDER THE MAP ONLY IF PER=ON.  (SEE PER)
+C
+C                   INT  FLAG TO DETERMINE THE INTENSITIES OF THE CON-
+C                        TOUR  LINES  AND OTHER PARTS OF THE PLOT.  IF
+C                        INT=OFF,  ALL INTENSITIES ARE SET TO THE DEFAULT
+C                        VALUES.  IF INT=ALL, ALL INTENSITIES ARE SET
+C                        TO THE GIVEN VALUE, IVAL.  IF INT IS SET TO
+C                        ONE OF THE OTHER POSSIBLE OPTIONS (MAJ, MIN,
+C                        LAB OR DAT), THE INTENSITY LEVEL FOR THAT
+C                        OPTION IS SET TO THE GIVEN VALUE, IVAL.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('INT=OFF',0)
+C
+C                        ALL THE SAME:     CALL  CONOP2('INT=ALL',IVAL)
+C
+C                        MAJOR LINES:      CALL CONOP2('INT=MAJ',IVAL)
+C
+C                        MINOR LINES:      CALL CONOP2('INT=MIN',IVAL)
+C
+C                        TITLE AND MESSAGE:
+C                                          CALL  CONOP2('INT=LAB',IVAL)
+C
+C                        DATA VALUES:      CALL  CONOP2('INT=DAT',IVAL)
+C
+C                        NOTE: 'INT=DAT' RELATES TO THE PLOTTED DATA
+C                        VALUES AND THE PLOTTED MAXIMUMS AND MINIMUMS.
+C
+C                        NOTE: IVAL IS THE INTENSITY DESIRED.  FOR  AN
+C                        EXPLANATION  OF THE OPTION VALUE SETTINGS SEE
+C                        THE OPTN ROUTINE  IN  THE  NCAR  SYSTEM  PLOT
+C                        PACKAGE DOCUMENTATION.  BRIEFLY, IVAL  VALUES
+C                        RANGE FROM 0 TO 255 OR THE CHARACTER  STRINGS
+C                        'LO'  AND  'HI'.   THE DEFAULT IS 'HI' EXCEPT
+C                        FOR INT=MIN WHICH IS SET TO 'LO'.
+C
+C                        EXAMPLE:           CALL CONOP2('INT=ALL',110)
+C
+C                   ITP  SET THE INTERPOLATION SCHEME.
+C                        THERE ARE TWO SCHEMES--C1 SURFACES AND LINEAR.
+C                        THE C1 METHOD TAKES LONGER BUT WILL GIVE THE
+C                        BEST RESULTS WHEN THE DATA IS SPARSE (LESS
+C                        THAN 100 POINTS).  THE LINEAR METHOD WILL
+C                        PRODUCE A BETTER PLOT WHEN THERE IS A DENSE
+C                        DATA SET.  THE DEFAULT IS C1 SURFACE.
+C
+C                        FOR C1 SURFACE   CALL CONOP1('ITP=C1')
+C
+C                        FOR LINEAR       CALL CONOP1('ITP=LIN')
+C
+C                   LAB  THIS FLAG CAN BE SET TO EITHER LABEL THE CON-
+C                        TOURS (LAB=ON) OR NOT (LAB=OFF).  THE DEFAULT
+C                        VALUE IS LAB=ON.
+C
+C                        TO TURN ON:    CALL CONOP1('LAB=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('LAB=OFF')
+C
+C                   LOT  FLAG TO LIST OPTIONS ON THE PRINTER.  THE DE-
+C                        FAULT  VALUE  IS  SET  TO OFF, AND NO OPTIONS
+C                        WILL BE DISPLAYED.
+C
+C                        TO TURN ON:    CALL CONOP1('LOT=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('LOT=OFF')
+C
+C                        NOTE: IF  USERS  WANT  TO  PRINT  THE  OPTION
+C                        VALUES, THEY SHOULD TURN THIS OPTION ON.  THE
+C                        OPTION VALUES WILL BE SENT  TO  THE  STANDARD
+C                        OUTPUT  UNIT  AS  DEFINED BY THE SUPPORT
+C                        ROUTINE I1MACH.
+C
+C                   LSZ  THIS FLAG  DETERMINES  THE  LABEL  SIZE.   IF
+C                        LSZ=OFF,  THE  DEFAULT ISZLSZ VALUE WILL BE
+C                        USED.  IF LSZ=ON,  THE  USER  SHOULD  SPECIFY
+C                        ISZLSZ.   THE  DEFAULT VALUE IS 9 PLOTTER
+C                        ADDRESS UNITS.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('LSZ=OFF',0)
+C
+C                        IF USER SET:   CALL CONOP2('LSZ=ON',ISZLSZ)
+C
+C                        NOTE: ISZLSZ  IS  THE  REQUESTED  CHARACTER
+C                        SIZE IN PLOTTER ADDRESS UNITS.
+C
+C                        EXAMPLE:          CALL CONOP2('LSZ=ON',4)
+C                                          WHERE 4 IS THE USER DESIRED
+C                                          INTEGER PLOTTER ADDRESS
+C                                          UNITS.
+C
+C                   MES  FLAG TO PLOT A MESSAGE. THE DEFAULT IS ON.
+C
+C                        TO TURN ON:    CALL CONOP1('MES=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('MES=OFF')
+C
+C                        NOTE: IF MES=ON, A MESSAGE IS  PRINTED   BELOW
+C                        THE  PLOT GIVING CONTOUR INTERVALS AND EXECU-
+C                        TION TIME IN SECONDS.  IF PER OR GRI ARE  ON,
+C                        THE  MESSAGE  ALSO  CONTAINS THE X AND Y TICK
+C                        INTERVALS.
+C
+C                   NCP  FLAG TO INDICATE THE NUMBER OF DATA POINTS
+C                        USED FOR THE PARTIAL DERIVATIVE
+C                        ESTIMATION.   IF NCP=OFF, NUM IS SET TO
+C                        4, WHICH IS THE DEFAULT  VALUE.   IF  NCP=ON,
+C                        THE  USER  MUST  SPECIFY  NUM GREATER THAN OR
+C                        EQUAL TO 2.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('NCP=OFF',0)
+C
+C                        IF USER SET:      CALL CONOP2('NCP=ON',NUM)
+C
+C                        NOTE: NUM = NUMBER OF DATA  POINTS  USED  FOR
+C                        ESTIMATION.   CHANGING THIS VALUE EFFECTS THE
+C                        CONTOURS PRODUCED AND THE SIZE OF INPUT ARRAY
+C                        IWK.
+C
+C                        EXAMPLE:          CALL CONOP2('NCP=ON',3)
+C
+C                   PDV  FLAG TO PLOT THE INPUT DATA VALUES.  THE
+C                        DEFAULT VALUE IS PDV=OFF.
+C
+C                        TO TURN ON:    CALL CONOP1('PDV=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('PDV=OFF')
+C
+C                        NOTE: IF PDV=ON, THE INPUT  DATA  VALUES  ARE
+C                        PLOTTED  RELATIVE  TO  THEIR  LOCATION ON THE
+C                        CONTOUR MAP.  IF YOU ONLY WISH TO SEE THE
+C                        LOCATIONS  AND  NOT THE VALUES, SET PDV=ON AND
+C                        CHANGE FMT TO PRODUCE AN ASTERISK (*) SUCH AS
+C                        (I1).
+C
+C                   PER  FLAG TO SET THE PERIMETER.  THE DEFAULT VALUE
+C                        IS  PER=ON,  WHICH  CAUSES  A PERIMETER TO BE
+C                        DRAWN AROUND THE CONTOUR PLOT.
+C
+C                        TO TURN ON:    CALL CONOP1('PER=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('PER=OFF')
+C
+C                        NOTE: IF MES IS ON, THE X AND Y TICK INTERVALS
+C                        WILL  BE GIVEN.  THESE ARE THE INTERVALS IN USER
+C                        COORDINATES THAT EACH TICK MARK REPRESENTS.
+C
+C                   PMM  FLAG TO PLOT RELATIVE MINIMUMS AND MAXIMUMS.
+C                        THIS FLAG IS OFF BY DEFAULT.
+C
+C                        TO TURN OFF:      CALL CONOP1('PMM=OFF')
+C
+C                        TO TURN ON:       CALL CONOP1('PMM=ON')
+C
+C                   PSL  FLAG WHICH SETS THE PLOT SHIELD OPTION.
+C                        THE OUTLINE OF THE SHIELD WILL BE DRAWN ON
+C                        THE SAME FRAME AS THE CONTOUR PLOT.
+C                        BY DEFAULT THIS OPTION IS OFF.
+C                        (SEE SLD OPTION).
+C
+C                        DRAW THE SHIELD:  CALL CONOP1('PSL=ON')
+C
+C                        DON'T DRAW IT:    CALL CONOP1('PSL=OFF')
+C
+C                   REP  FLAG INDICATING THE USE OF THE SAME DATA IN
+C                        A NEW EXECUTION.  THE DEFAULT VALUE IS OFF.
+C
+C                        TO TURN ON:    CALL CONOP1('REP=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('REP=OFF')
+C
+C                        NOTE: IF REP=ON, THE SAME X-Y DATA AND TRIANGU-
+C                        LATION  ARE  TO  BE  USED BUT IT IS ASSUMED
+C                        THE USER HAS CHANGED CONTOUR VALUES OR RESOLUTION
+C                        FOR THIS RUN.  SCRATCH ARRAYS WK AND IWK MUST
+C                        REMAIN UNCHANGED.
+C
+C                   SCA  FLAG FOR SCALING OF THE PLOT ON A FRAME.
+C                        THIS FLAG IS ON BY DEFAULT.
+C
+C                        USER SCALING:     CALL CONOP1('SCA=OFF')
+C
+C                        PROGRAM SCALING:  CALL CONOP1('SCA=ON')
+C
+C                        PRIOR WINDOW:     CALL CONOP1('SCA=PRI')
+C
+C                        NOTE:  WITH  SCA=OFF,  PLOTTING  INSTRUCTIONS
+C                        WILL BE ISSUED USING THE USER'S INPUT COORDI-
+C                        NATES, UNLESS THEY ARE TRANSFORMED VIA FX AND
+C                        FY  TRANSFORMATIONS.   USERS WILL FIND AN
+C                        EXTENDED DISCUSSION IN THE "INTERFACING WITH
+C                        OTHER GRAPHICS ROUTINES" SECTION BELOW.  THE SCA
+C                        OPTION  ASSUMES  THAT ALL INPUT DATA FALLS INTO
+C                        THE CURRENT WINDOW SETTING.  WITH SCA=ON, THE
+C                        ENTRY POINT WILL ESTABLISH A VIEWPORT SO THAT
+C                        THE USER'S PLOT WILL FIT INTO THE  CENTER  90
+C                        PERCENT OF THE FRAME.  WHEN SCA=PRI, THE
+C                        PROGRAM  MAPS THE USER'S PLOT INSTRUCTIONS  INTO
+C                        THE  PORTION OF THE FRAME DEFINED BY THE
+C                        CURRENT NORMALIZATION TRANSFORMATION.  SCA=OFF
+C                        SHOULD BE USED TO INTERFACE WITH EZMAP.
+C
+C                   SDC  FLAG TO DETERMINE HOW TO SCALE  THE  DATA  ON
+C                        THE CONTOURS.  IF SDC=OFF, THE FLOATING POINT
+C                        VALUE IS GIVEN BY SCALE.  IF SDC=ON, THE USER
+C                        MAY SPECIFY SCALE.  THE DEFAULT VALUE FOR SCALE
+C                        IS 1.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('SDC=OFF',0.,0)
+C
+C                        IF USER SET:      CALL CONOP3('SDC=ON',SCALE,1)
+C
+C                        NOTE: THE DATA PLOTTED ON CONTOUR  LINES  AND
+C                        THE  DATA  PLOTTED  FOR RELATIVE MINIMUMS AND
+C                        MAXIMUMS WILL BE SCALED BY THE FLOATING POINT
+C                        VALUE  GIVEN  BY SCALE.  TYPICAL SCALE VALUES
+C                        ARE 10., 100., 1000., ETC.  THE ORIGINAL DATA
+C                        VALUES ARE MULTIPLIED BY SCALE.  SCALE MUST BE
+C                        A FLOATING POINT NUMBER AND IS DISPLAYED IN THE
+C                        MESSAGE  (SEE  MES).
+C
+C                        EXAMPLE:          CALL CONOP2('SDC=ON',100.,1)
+C
+C                   SLD  ACTIVATE OR DEACTIVATE THE SHIELDING OPTION.
+C                        WHEN THIS OPTION IS ACTIVATED,  ONLY THOSE
+C                        CONTOURS WITHIN THE SHIELD ARE DRAWN. THE SHIELD
+C                        IS A POLYGON SPECIFIED BY THE USER WHICH MUST
+C                        BE GIVEN IN THE SAME COORDINATE RANGE AS THE
+C                        THE DATA. IT MUST DEFINE ONLY ONE POLYGON.
+C
+C                        TO ACTIVATE THE SHIELD:
+C                               CALL CONOP3('SLD=ON',ARRAY,ICSD)
+C
+C                        TO DEACTIVATE THE SHIELD:
+C                               CALL CONOP3('SLD=OFF',0.,0)
+C
+C                        NOTE:  ARRAY IS A REAL ARRAY ICSD ELEMENTS LONG.
+C                        THE FIRST ICSD/2 ELEMENTS ARE X COORDINATES AND
+C                        THE SECOND ICSD/2 ELEMENTS ARE Y COORDINATES.
+C                        ICSD IS THE LENGTH OF ENTIRE ARRAY, THE
+C                        NUMBER OF (X + Y) SHIELD COORDS. THE POLYGON
+C                        MUST BE CLOSED, THAT IS THE FIRST AND LAST
+C                        POINTS DESCRIBING IT MUST BE THE SAME.
+C
+C                        EXAMPLE:       DIMENSION SHLD
+C                                       DATA SHLD/ 7.,10.,10.,7.,7.,
+C                                      1           7.,7.,10.,10.,7./
+C                                       CALL CONOP3 (6HSLD=ON,SHLD,10)
+C
+C
+C                   SML  FLAG TO DETERMINE THE  SIZE  OF  MINIMUM  AND
+C                        MAXIMUM CONTOUR LABELS.  IF SML=OFF, THE
+C                        ISZSML DEFAULT VALUE OF  15 IS  USED.
+C                        IF SML=ON, THE USER MUST SPECIFY ISZSML.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('SML=OFF',0)
+C
+C                        IF USER SET:  CALL CONOP2('SML=ON',ISZSML)
+C
+C                        NOTE: ISZSML IS AN INTEGER NUMBER WHICH  IS
+C                        THE SIZE OF LABELS IN PLOTTER ADDRESS UNITS
+C                        AS DEFINED IN THE SPPS ENTRY WTSTR.
+C
+C                        EXAMPLE:      CALL CONOP2('SML=ON',12)
+C
+C                   SPD  FLAG FOR THE SIZE OF THE PLOTTED  INPUT  DATA
+C                        VALUES.  IF SPD=OFF, THE VALUE OF ISZSPD IS
+C                        8, WHICH IS THE DEFAULT.  IF SPD=ON, THE USER
+C                        MUST SPECIFY ISZSPD.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('SPD=OFF',0)
+C
+C                        IF USER SET:   CALL CONOP2('SPD=ON',ISZSPD)
+C
+C                        NOTE: ISZSPD IS AN INTEGER NUMBER GIVING THE
+C                        SIZE TO PLOT THE DATA VALUES IN PLOTTER ADDRESS
+C                        UNITS AS DEFINED IN THE SPPS ENTRY WTSTR.    .
+C
+C                        EXAMPLE:          CALL CONOP2('SPD=ON',6)
+C
+C                   SSZ  FLAG TO DETERMINE THE RESOLUTION  (NUMBER  OF
+C                        STEPS  IN  EACH  DIRECTION).   IF SSZ=ON, THE
+C                        USER SETS ISTEP, OR, IF SSZ=OFF, THE  PROGRAM
+C                        WILL  AUTOMATICALLY  SET ISTEP AT THE DEFAULT
+C                        VALUE OF 40.
+C
+C                        IF PROGRAM SET:   CALL CONOP2('SSZ=OFF',0)
+C
+C                        IF USER SET:      CALL CONOP2('SSZ=ON',ISTEP)
+C
+C                        NOTE: ISTEP IS AN INTEGER SPECIFYING THE DENSITY
+C                        OF THE VIRTUAL GRID. IN MOST CASES, THE DEFAULT
+C                        VALUE OF 40 PRODUCES PLEASING CONTOURS.   FOR
+C                        COARSER   BUT  QUICKER  CONTOURS,  LOWER  THE
+C                        VALUE.  FOR SMOOTHER CONTOURS AT
+C                        THE EXPENSE OF TAKING LONGER  TIME,  RAISE
+C                        THE  VALUE.   NOTE:   FOR  STEP SIZES GREATER
+C                        THAN 200 IN CONRAN, THE ARRAYS  PV  IN  COMMON
+C                        CONRA1  AND ITLOC IN COMMON CONRA9,  MUST BE
+C                        EXPANDED TO ABOUT 10 MORE THAN ISTEP.
+C                        SEE CONRA1 AND CONRA9 COMMENTS BELOW FOR MORE
+C                        INFORMATION.
+C
+C                        EXAMPLE:          CALL    CONOP2('SSZ=ON',25)
+C                                          THIS  ISTEP VALUE WILL PRO-
+C                                          DUCE A COARSE CONTOUR.
+C
+C                   STL  FLAG TO DETERMINE  THE  SIZE  OF  THE  TITLE.
+C                        ISZSTL  MAY BE SET BY THE USER (STL=ON), OR
+C                        THE PROGRAM WILL SET IT TO THE  DEFAULT  SIZE
+C                        OF 16 PLOTTER ADDRESS UNITS (STL=OFF).
+C
+C                        IF PROGRAM SET:   CALL CONOP2('STL=OFF',0)
+C
+C                        IF USER SET:  CALL  CONOP2('STL=ON',ISZSTL)
+C
+C                        NOTE: WHEN 30 OR 40 CHARACTERS ARE  USED  FOR
+C                        THE TITLE, THE DEFAULT SIZE OF 16 PLOTTER
+C                        ADDRESS UNITS WORKS WELL.  FOR LONGER TITLES,
+C                        A SMALLER TITLE SIZE IS REQUIRED.
+C
+C                        EXAMPLE:          CALL CONOP2('STL=ON',13)
+C
+C                   TEN  FLAG TO DETERMINE THE TENSION FACTOR  APPLIED
+C                        WHEN  SMOOTHING  CONTOUR LINES.  THE USER MAY
+C                        SET TENS OR ALLOW  THE  PROGRAM  TO  SET  THE
+C                        VALUE.   IF  USER SET, TENS MUST HAVE A VALUE
+C                        GREATER THAN ZERO AND LESS THAN OR  EQUAL  TO
+C                        30.  THE DEFAULT VALUE IS 2.5.
+C
+C                        IF PROGRAM SET:   CALL CONOP3('TEN=OFF',0.,0)
+C
+C                        IF USER SET:      CALL CONOP3('TEN=ON',TENS,1)
+C
+C                        NOTE: TENS IS NOT AVAILABLE IN THE STANDARD
+C                        VERSION OF CONRAN.
+C                        SMOOTHING OF CONTOUR  LINES  IS  ACCOMPLISHED
+C                        WITH  SPLINES  UNDER  TENSION.  TO ADJUST THE
+C                        AMOUNT OF SMOOTHING APPLIED, ADJUST THE  TEN-
+C                        SION  FACTOR.   SETTING TENS VERY LARGE
+C                        (I.E. 30.), EFFECTIVELY SHUTS OFF SMOOTHING.
+C
+C                        EXAMPLE:          CALL CONOP3('TEN=ON',14.,1)
+C
+C                   TFR  FLAG TO ADVANCE THE FRAME BEFORE TRIANGULATION.
+C                        THE DEFAULT VALUE IS TFR=ON, WHICH MEANS THAT
+C                        THE CONTOURS AND THE TRIANGLES WILL BE PLOTTED
+C                        ON SEPARATE FRAMES.
+C
+C                        IF PROGRAM SET:   CALL CONOP1('TFR=ON')
+C
+C                        TO TURN OFF:      CALL CONOP1('TFR=OFF')
+C
+C                        NOTE: TRIANGLES ARE PLOTTED  AFTER  THE  CON-
+C                        TOURING  IS COMPLETED.  TO SEE THE TRIANGLES
+C                        OVER  THE  CONTOURS,  TURN THIS SWITCH OFF.
+C
+C                   TLE  FLAG TO PLACE A TITLE AT THE TOP OF THE PLOT.
+C                        IF  TLE=ON,  THE USER MUST SPECIFY CHARS AND
+C                        INUM.  CHARS  IS THE CHARACTER STRING CONTAINING
+C                        THE TITLE.  INUM IS THE NUMBER OF CHARACTERS
+C                        IN CHARS.  THE DEFAULT VALUE IS  OFF.
+C
+C                        TO TURN ON: CALL CONOP4('TLE=ON',CHARS,INUM,0)
+C
+C                        TO TURN OFF:   CALL CONOP4('TLE=OFF',' ',0,0)
+C
+C                        NOTE: IF LONGER THAN 64-CHARACTER TITLES ARE
+C                        DESIRED, THE CHARACTER VARIABLE ISTRNG FOUND
+C                        IN CONRA7 MUST BE INCREASED APPROPRIATELY.
+C
+C                        EXAMPLE: CALL CONOP4('TLE=ON','VECTOR REVIEW'
+C                                       ,13,0)
+C
+C                   TOP  FLAG TO PLOT ONLY THE TRIANGLES.
+C
+C                        TO TURN OFF:   CALL CONOP1('TOP=OFF')
+C
+C                        TO TURN ON:    CALL CONOP1('TOP=ON')
+C
+C                        NOTE: THE USER MAY WISH TO OVERLAY THE TRIAN-
+C                        GLES ON SOME OTHER PLOT.  'TOP=ON' WILL
+C                        ALLOW  THAT.   THIS  OPTION  WHEN   ACTIVATED
+C                        (TOP=ON),  WILL  SET TRI=ON, AND TFR=OFF.  IF
+C                        THE USER WANTS TFR=ON, IT SHOULD BE SET AFTER
+C                        TOP IS SET.  IF THE USER SETS TOP=OFF IT WILL
+C                        SET TRI=OFF AND TFR=ON. IF THE USER WANTS TRI
+C                        OR  TFR  DIFFERENT, SET THEM AFTER THE
+C                        TOP CALL.
+C
+C                   TRI  FLAG TO PLOT THE TRIANGULATION.  THE DEFAULT IS
+C                        OFF AND THEREFORE THE TRIANGLES ARE NOT DRAWN.
+C
+C                        TO TURN ON:    CALL CONOP1('TRI=ON')
+C
+C                        TO TURN OFF:   CALL CONOP1('TRI=OFF')
+C
+C                        NOTE: PLOTTING THE TRIANGLES WILL INDICATE TO
+C                        THE  USER WHERE GOOD AND BAD POINTS OF INTER-
+C                        POLATION ARE OCCURRING IN  THE  CONTOUR  MAP.
+C                        EQUILATERAL  TRIANGLES ARE OPTIMAL FOR INTER-
+C                        POLATION.  QUALITY DEGRADES AS TRIANGLES
+C                        APPROACH  A  LONG AND NARROW SHAPE.  THE CONVEX
+C                        HULL OF THE  TRIANGULATION  IS  ALSO  A  POOR
+C                        POINT OF INTERPOLATION.
+C
+C        OPTION DEFAULT  BELOW ARE  LISTED  THE  DEFAULT
+C                VALUES  VALUES  FOR  THE VARIOUS OPTIONS GIVEN ABOVE.
+C                        UNLESS THE USER  SPECIFIES  OTHERWISE,  THESE
+C                        VALUES WILL BE USED IN EXECUTION OF THE VARI-
+C                        OUS OPTIONS.
+C
+C                           CHL=OFF  LOT=OFF  SLD=OFF
+C                           CIL=OFF  LSZ=OFF  SML=OFF
+C                           CON=OFF  MES=ON   SPD=OFF
+C                           DAS=OFF  NCP=OFF  SPT=OFF
+C                           DBP=OFF  PDV=OFF  SSZ=OFF
+C                           EXT=OFF  PER=ON   STL=OFF
+C                           FMT=OFF  PMM=OFF  TEN=OFF
+C                           GRI=OFF  REP=OFF  TFR=ON
+C                           ITP=C1   SCA=ON   TOP=OFF
+C                           LAB=ON   SDC=OFF  TRI=OFF
+C
+C    DEFAULT VALUES FOR  THE OPTION DEFAULT  VALUES  GIVEN  ABOVE,  IF
+C        USER SPECIFIED  USED, WILL SET DEFAULT VALUES FOR THE FOLLOW-
+C            PARAMETERS  ING PARAMETERS:
+C
+C                        PARAMETER    DEFAULT
+C                        ---------    -------
+C
+C                        ARRAY        UP TO 30 CONTOUR LEVELS ALLOWED.
+C                                     VALUES  ARE COMPUTED BY THE
+C                                     PROGRAM, BASED ON INPUT.
+C
+C                        BP           0.
+C
+C                        CINC         COMPUTED BY THE PROGRAM BASED ON THE
+C                                     RANGE OF HI AND LO VALUES OF THE
+C                                     INPUT DATA.
+C
+C                        FLO          COMPUTED BY THE PROGRAM BASED ON THE
+C                                     LOWEST UNSCALED INPUT DATA.
+C
+C                        FT           (G10.3)  PARENTHESES MUST BE
+C                                     INCLUDED.
+C
+C                        HI           COMPUTED BY THE PROGRAM BASED ON THE
+C                                     HIGHEST UNSCALED INPUT DATA.
+C
+C                        CHARS        NO TITLE
+C
+C                        IF           10 CHARACTERS
+C
+C                        INUM         NO TITLE
+C
+C                        IPAT         '$$$$$$$$$$'  (THIS IS A 10 CHARACTER
+C                                     STRING.)
+C
+C                        ISZLSZ       9 PLOTTER ADDRESS UNITS
+C
+C                        ISZSML       15 PLOTTER ADDRESS UNITS
+C
+C                        ISZSPD       8 PLOTTER ADDRESS UNITS
+C
+C                        ISZSTL       16 PLOTTER ADDRESS UNITS
+C
+C                        ISTEP        40
+C
+C                        IVAL         'HI' FOR ALL EXCEPT  MINOR  CON-
+C                                     TOUR   LINES   WHICH  ARE  'LO'.
+C
+C                        L            7  CHARACTERS  (INCLUDING   BOTH
+C                                     PARENTHESES)
+C
+C                        NCL          COMPUTED BY THE PROGRAM BASED ON
+C                                     INPUT DATA.  UP TO 30 CONTOUR
+C                                     LEVELS ARE PERMITTED.
+C
+C                        NUM          4 DATA POINTS
+C
+C                        SCALE        1. (NO SCALING PERFORMED)
+C
+C                        TENS         2.5
+C
+C                        ICSD         0 (NO SHIELD)
+C
+C         OPTIONS WHICH  THE SHAPE OF THE CONTOURS MAY BE MODIFIED BY
+C            EFFECT THE  CHANGING NCP  AND SSZ.  NCP CONTROLS THE
+C              CONTOURS  NUMBER OF DATA POINTS TO BE USED IN THE
+C                        INTERPOLATION.  INCREASING NCP CAUSES MORE
+C                        OF THE  SURROUNDING  DATA  TO INFLUENCE THE
+C                        POINT OF INTERPOLATION.  SOME  DATASETS CAUSE
+C                        DIFFICULTY  WHEN  TRYING  TO PRODUCE MEANINGFUL
+C                        CONTOURS (TRIANGLES WHICH ARE LONG AND  NARROW).
+C                        BY MODIFYING NCP A USER CAN FINE-TUNE A
+C                        PLOT.   INCREASING  ISTEP, THE DENSITY OF THE
+C                        VIRTUAL GRID, WILL  SMOOTH OUT THE CONTOUR
+C                        LINES AND PICK UP  MORE  DETAIL  (NEW  CONTOURS
+C                        WILL APPEAR AS ISTEP INCREASES AND OLD ONES WILL
+C                        SOMETIMES BREAK INTO MORE  DISTINCT UNITS).
+C                        ISTEP IS CHANGED BY THE SSD OPTION.
+C
+C                  NOTE  IF NCP.GT.25, ARRAYS DSQ0 AND IPC0 IN CONDET
+C                        MUST  BE ADJUSTED ACCORDINGLY.  ALSO NCPSZ IN
+C                        CONBDN (25 BY DEFAULT), MUST BE INCREASED TO
+C                        NCP.   THE  DEFAULT  VALUE OF NCP, WHICH IS 4,
+C                        PRODUCES PLEASING  PICTURES  IN  MOST  CASES.
+C                        HOWEVER, FINE-TUNING OF THE INTERPOLATION CAN
+C                        BE OBTAINED BY INCREASING THE  SIZE  OF  NCP,
+C                        WITH  A CORRESPONDING LINEAR INCREASE IN WORK
+C                        SPACE.
+C
+C                        THE INTERPOLATION METHOD USED WILL ALSO CAUSE
+C                        DIFFERENT LOOKING CONTOURS.  THE C1 METHOD
+C                        IS RECOMMENDED WHEN THE DATA IS SPARSE.  IT
+C                        WILL SMOOTH THE DATA AND ADD TRENDS (FALSE
+C                        HILLS AND VALLEYS).  THE LINEAR METHOD IS
+C                        RECOMMENDED WHEN DATA IS DENSE (GT 50 TO 100)
+C                        IT WILL NOT SMOOTH THE DATA OR ADD TRENDS.
+C
+C      INTERFACING WITH  NORMALLY THE SCALING FACTOR WILL BE SET TO OFF.
+C        OTHER GRAPHICS  IN MOST CASES MAPPING CAN BE PERFORMED BEFORE
+C              ROUTINES  CALLING THE CONRAN ENTRY POINT, THUS SAVING THE
+C                        USER FROM  MODIFYING THE FILE.  IF REASONABLE
+C                        RESULTS CANNOT BE OBTAINED, THE STATEMENT
+C                        FUNCTIONS, FX AND FY, WILL HAVE TO BE REPLACED.
+C                        THE ROUTINES HAVING THESE STATEMENT FUNCTIONS
+C                        ARE:
+C
+C                           CONDRW, CONPDV, CONTLK, CONPMS, CONGEN
+C
+C            REFERENCES  AKIMA, HIROSHA
+C                           A METHOD OF BIVARIATE INTERPOLATION AND
+C                           SMOOTH SURFACE FITTING FOR IRREGULARLY
+C                           DISTRIBUTED DATA POINTS.
+C                           ACM TRANSACTIONS ON MATHEMATICAL SOFTWARE
+C                           VOL 4, NO. 2, JUNE 1978, PAGES 148-159
+C                        LAWSON, C.L.
+C                           SOFTWARE FOR C1 SURFACE INTERPOLATION
+C                           JPL PUBLICATION 77-30
+C                           AUGUST 15, 1977
+C
+C     CONRAN ERROR  ERROR  ROUTINE               MESSAGE
+C       MESSAGES
+C                    1      CONRAN         INPUT PARAMETER NDP LT NCP
+C                    2      CONRAN         NCP GT MAX SIZE OR LT 2
+C                    3      CONTNG         ALL COLINEAR DATA POINTS
+C                    4      CONTNG         IDENTICAL INPUT DATA POINTS
+C                                          FOUND
+C                    5      CONOP          UNDEFINED OPTION
+C                    6      CONCLS         CONSTANT INPUT FIELD
+C                    7      CONOP          INCORRECT CONOP CALL USED
+C                    8      CONOP          ILLEGAL USE OF CON OPTION
+C                                          WITH CIL OR CHL OPTIONS
+C                    9      CONOP          NUMBER OF CONTOUR LEVELS
+C                                          EXCEEDS 30
+C                    10     CONDRW         CONTOUR STORAGE EXHAUSTED
+C                                          THIS ERROR IS TRAPPED AND
+C                                          NULLIFIED BY CONRAN.  IT
+C                                          SERVES TO SIGNAL THE USER
+C                                          THAT A CONTOUR LEVEL MAY NOT
+C                                          BE COMPLETE.
+C                    11     CONSTP         ASPECT RATIO OF X AND Y
+C                                          GREATER THAN 5 TO 1.
+C                                          (THIS ERROR MAY CAUSE A POOR
+C                                          QUALITY PLOT.  USUALLY THIS
+C                                          CAN BE FIXED BY MULTIPLYING
+C                                          X OR Y BY A CONSTANT FACTOR.
+C                                          IF THIS SOLUTION IS
+C                                          UNACCEPTABLE THEN INCREASING
+C                                          SSZ TO A VERY LARGE VALUE
+C                                          MAY HELP.  NOTE:  THIS CAN BE
+C                                          EXPENSIVE.)
+C
+C                     THE ERRORS LISTED ABOVE ARE DEFINED AS RECOVERABLE
+C                     ERRORS SHOULD THE USER WISH TO USE THEM IN THAT
+C                     FASHION.  THE DOCUMENTATION ON THE ERPRT77 PACKAGE
+C                     EXPLAINS HOW TO RECOVER FROM AN ERROR.
+C
+C NOTE:  THE COMMON BLOCKS LISTED INCLUDE ALL THE COMMON USED BY
+C        THE ENTIRE CONRAN FAMILY.  NOT ALL MEMBERS WILL USE ALL
+C        THE COMMON VARIABLES.
+C
+C   CONRA1
+C       CL-ARRAY OF CONTOUR LEVELS
+C       NCL-NUMBER OF CONTOUR LEVELS
+C       OLDZ-Z VALUE OF LEFT NEIGHBOR TO CURRENT LOCATION
+C       PV-ARRAY OF PREVIOUS ROW VALUES
+C       HI-LARGEST CONTOUR PLOTTED
+C       FLO-LOWEST CONTOUR PLOTTED
+C       FINC-INCREMENT LEVEL BETWEEN EQUALLY SPACED CONTOURS
+C   CONRA2
+C       REPEAT-FLAG TO TRIANGULATE AND DRAW OR JUST DRAW
+C       EXTRAP-PLOT DATA OUTSIDE OF CONVEX DATA HULL
+C       PER-PUT PERIMETER AROUND PLOT
+C       MESS-FLAG TO INDICATE MESSAGE OUTPUT
+C       ISCALE-SCALING SWITCH
+C       LOOK-PLOT TRIANGLES FLAG
+C       PLDVLS-PLOT THE DATA VALUES FLAG
+C       GRD-PLOT GRID FLAG
+C       CON-USER SET OR PROGRAM SET CONTOURS FLAG
+C       CINC-USER OR PROGRAM SET INCREMENT FLAG
+C       CHILO-USER OR PROGRAM SET HI LOW CONTOURS
+C       LABON-FLAG TO CONTROL LABELING OF CONTOURS
+C       PMIMX-FLAG TO CONTROL THE PLOTTING OF MIN'S
+C             AND MAX'S
+C       SCALE-THE SCALE FACTOR FOR CONTOUR LINE VALUES
+C             AND MIN, MAX PLOTTED VALUES
+C       FRADV-ADVANCE FRAME BEFORE PLOTTING TRIANGULATION
+C       EXTRI-ONLY PLOT TRIANGULATION
+C       BPSIZ-BREAKPOINT SIZE FOR DASHPATTERNS
+C       LISTOP-LIST OPTIONS ON UNIT6 FLAG
+C   CONRA3
+C       IRED-ERPRT77 RECOVERABLE ERROR FLAG
+C   CONRA4
+C       NCP-NUMBER OF DATA POINTS USED AT EACH POINT FOR
+C           POLYNOMIAL CONSTRUCTION.
+C       NCPSZ-MAX SIZE ALLOWED FOR NCP
+C   CONRA5
+C       NIT-FLAG TO INDICATE STATUS OF SEARCH DATA BASE
+C       ITIPV-LAST TRIANGLE INTERPOLATION OCCURRED IN
+C  CONRA6
+C       XST-X COORDINATE START POINT FOR CONTOURING
+C       YST-Y COORDINATE START POINT FOR CONTOURING
+C       XED-X COORDINATE END POINT FOR CONTOURING
+C       YED-Y COORDINATE END POINT FOR CONTOURING
+C       STPSZ-STEP SIZE FOR X,Y CHANGE WHEN CONTOURING
+C       IGRAD-NUMBER OF GRADUATIONS FOR CONTOURING (STEP SIZE)
+C       IG-RESET VALUE FOR IGRAD
+C       XRG-X RANGE OF COORDINATES
+C       YRG-Y RANGE OF COORDINATES
+C       BORD-PERCENT OF FRAME USED FOR CONTOUR PLOT
+C       PXST-X PLOTTER START ADDRESS FOR CONTOURS
+C       PYST-Y PLOTTER START ADDRESS FOR CONTOURS
+C       PXED-X PLOTTER END ADDRESS FOR CONTOURS
+C       PYED-Y PLOTTER END ADDRESS FOR CONTOURS
+C       ITICK-NUMBER OF TICK MARKS FOR GRIDS AND PERIMETERS
+C CONRA7
+C       TITLE-SWITCH TO INDICATE IF TITLE OPTION ON OR OFF
+C       ISTRNG-CHARACTER STRING CONTAINING THE TITLE
+C       ICNT-CHARACTER COUNT OF ISTRNG
+C       ITLSIZ-SIZE OF TITLE IN PWRIT UNITS
+C CONRA8
+C       IHIGH-DEFAULT INTENSITY SETTING
+C       INMAJ-CONTOUR LEVEL INTENSITY FOR MAJOR LINES
+C       INMIN-CONTOUR LEVEL INTENSITY FOR MINOR LINES
+C       INLAB-TITLE AND MESSAGE INTENSITY
+C       INDAT-DATA VALUE INTENSITY
+C       FORM-THE FORMAT FOR PLOTTING THE DATA VALUES
+C       LEN-THE NUMBER OF CHARACTERS IN THE FORMAT
+C       IFMT-SIZE OF THE FORMAT FIELD
+C       LEND-DEFAULT FORMAT LENGTH
+C       IFMTD-DEFAULT FORMAT FIELD SIZE
+C       ISIZEP-SIZE OF THE PLOTTED DATA VALUES
+C  CONRA9
+C       X-ARRAY OF X COORDINATES OF CONTOURS DRAWN AT CURRENT CONTOUR
+C          LEVEL
+C       Y-ARRAY OF Y COORDINATES OF CONTOURS DRAWN AT CURRENT CONTOUR
+C          LEVEL
+C       NP-COUNT IN X AND Y
+C       MXXY-SIZE OF X AND Y
+C       TR-TOP RIGHT CORNER VALUE OF CURRENT CELL
+C       BR-BOTTOM RIGHT CORNER VALUE OF CURRENT CELL
+C       TL-TOP LEFT CORNER VALUE OF CURRENT CELL
+C       BL-BOTTOM LEFT CORNER VALUE OF CURRENT CELL
+C       CONV-CURRENT CONTOUR VALUE
+C       XN-X POSITION WHERE CONTOUR IS BEING DRAWN
+C       YN-Y POSITION WHERE CONTOUR IS BEING DRAWN
+C       ITLL-TRIANGLE WHERE TOP LEFT CORNER OF CURRENT CELL LIES
+C       IBLL-TRIANGLE OF BOTTOM LEFT CORNER
+C       ITRL-TRIANGLE OF TOP RIGHT CORNER
+C       IBRL-TRIANGLE OF BOTTOM RIGHT CORNER
+C       XC-X COORDINATE OF CURRENT CELL
+C       YC-Y COORDINATE OF CURRENT CELL
+C       ITLOC-IN CONJUNCTION WITH PV STORES THE TRIANGLE WHERE PV
+C             VALUE CAME FROM
+C CONR10
+C       NT-NUMBER OF TRIANGLES GENERATED
+C       NL-NUMBER OF LINE SEGMENTS
+C       NTNL-NT+NL
+C       JWIPT-POINTER INTO IWK WHERE WHERE TRIANGLE POINT NUMBERS
+C             ARE STORED
+C       JWIWL-IN IWK THE LOCATION OF A SCRATCH SPACE
+C       JWIWP-IN IWK THE LOCATION OF A SCRATCH SPACE
+C       JWIPL-IN IWK THE LOCATION OF END POINTS FOR BORDER LINE
+C             SEGMENTS
+C       IPR-IN WK THE LOCATION OF THE PARTIAL DERIVATIVES AT EACH
+C           DATA POINT
+C       ITPV-THE TRIANGLE WHERE THE PREVIOUS VALUE CAME FROM
+C CONR11
+C       NREP-NUMBER OF REPETITIONS OF DASH PATTERN BEFORE A LABEL
+C       NCRT-NUMBER OF CRT UNITS FOR A DASH MARK OR BLANK
+C       ISIZEL-SIZE OF CONTOUR LINE LABELS
+C       NDASH-ARRAY CONTAINING THE NEGATIVE VALUED CONTOUR DASH
+C             PATTERN
+C       MINGAP-NUMBER OF UNLABELED LINES BETWEEN EACH LABELED ONE
+C       IDASH-POSITIVE VALUED CONTOUR DASH PATTERN
+C       ISIZEM-SIZE OF PLOTTED MINIMUMS AND MAXIMUMS
+C       EDASH-EQUAL VALUED CONTOUR DASH PATTERN
+C       TENS-DEFAULT TENSION SETTING FOR SMOOTHING
+C CONR12
+C       IXMAX,IYMAX-MAXIMUM X AND Y COORDINATES RELATIVE TO THE
+C                 SCRATCH ARRAY, SCRARR
+C       XMAX,YMAX-MAXIMUM X AND Y COORDINATES RELATIVE TO USERS
+C                 COORDINATE SPACE
+C CONR13
+C       XVS-ARRAY OF THE X COORDINATES FOR SHIELDING
+C       YVS-ARRAY OF THE Y COORDINATES FOR SHIELDING
+C       IXVST-POINTER TO THE USERS X ARRAY FOR SHIELDING
+C       IYVST-POINTER TO THE USERS Y ARRAY FOR SHIELDING
+C       ICOUNT-COUNT OF THE SHIELD ELEMENTS
+C       SPVAL-SPECIAL VALUE USED TO HALT CONTOURING AT THE SHIELD
+C               BOUNDARY
+C       SHIELD-LOGICAL FLAG TO SIGNAL STATUS OF SHIELDING
+C       SLDPLT-LOGICAL FLAG TO INDICATE STATUS OF SHIELD PLOTTING
+C CONR14
+C       LINEAR-C1 LINEAR INTERPOLATING FLAG
+C CONR15
+C       ISTRNG-TITLE OF THE PLOT
+C CONR16
+C       FORM-FORMAT USED FOR DATA
+C CONR17
+C       NDASH-DASH PATTERN USED FOR CONTOUR LINES LESS THAN BP
+C       IDASH-DASH PATTERN USED FOR CONTOUR LINES GREATER THAN BP
+C       EDASH-DASH PATTERN USED FOR CONTOUR LINES EQUAL TO THE BP
+C RANINT
+C       IRANMJ-COLOR INDEX FOR NORMAL (MAJOR) INTENSITY LINES
+C       IRANMN-COLOR INDEX FOR LOW INTENSITY LINES
+C       IRANMJ-COLOR INDEX FOR TEXT (LABELS)
+C
+C +NOAO - Blockdata data conbdn rewritten as run time initialization
+C         Variable LNGTHS not used.
+C
+C     EXTERNAL        CONBDN
+C     DIMENSION       LNGTHS(4), HOLD(4)
+      DIMENSION       HOLD(4)
+C - NOAO
+        CHARACTER*110   IWORK
+        CHARACTER*13    ENCSCR,  ENSCRY
+        CHARACTER*1     ICHAR
+        CHARACTER*500   DPAT
+        REAL            WIND(4),   VIEW(4),  NWIND(4), NVIEW(4)
+      DIMENSION       XD(*)      ,YD(*)      ,ZD(*)      ,WK(*)      ,
+     1                IWK(*)     ,SCRARR(*)
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+        COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+        INTEGER OPLASF, OTXASF, LASF(13), OCOLI, OTEXCI
+        SAVE
+C
+C
+C+NOAO - Variable LNGTHS not used.
+C       DATA LNGTHS(1),LNGTHS(2),LNGTHS(3),LNGTHS(4)/13,4,21,6/
+C-NOAO
+C
+C ICONV CONVERT FORM 0-32767 TO 1-1024
+C
+        DATA ICONV/32/
+C
+C IABOVE AMOUNT TITLE IS PLACED ABOVE PLOT
+C IBELOW, IBEL2 AMOUNT MESSAGE IS BELOW PLOT
+C
+C       DATA IABOVE,IBELOW,IBEL2/30,-30,-45/
+C
+C + NOAO - Label placement is improved by changed these values.  Also,
+C          call the run time initialization subroutine, conbdn.
+C
+      iabove = 30
+      ibelow = -15
+      ibel2 = -30
+      call conbdn
+C - NOAO
+C
+C  THE FOLLOWING CALL IS FOR MONOTORING LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('NSSL','CONRAN','CONRAN','VERSION 01')
+C
+C  LIST THE OPTION VALUES IF REQUESTED
+C
+      IF (LISTOP) CALL CONOUT (2)
+C
+C  SET SWITCH TO MAP TRIANGLES, IN CONLOC, FOR QUICK SEARCHES
+C
+      NIT = 0
+C
+C  TEST TO SEE IF ENOUGH INPUT DATA
+C
+      IF (NDP.GE.NCP) GO TO    10
+      CALL SETER (' CONRAN - INPUT PARAMETER NDP LESS THAN NCP',1,
+     1             IREC)
+      RETURN
+C
+   10 IF (NCPSZ.GE.NCP .AND. NCP.GE.2) GO TO    20
+      CALL SETER (' CONRAN - NCP LT 2 OR GT NCPSZ',2,IREC)
+C
+   20 IWK(1) = NDP
+      IWK(2) = NCP
+      IWK(3) = 1
+C
+C  SET POLYLINE COLOR ASF TO INDIVIDUAL
+C
+        CALL GQASF(IERR,LASF)
+        OPLASF = LASF(3)
+        LASF(3) = 1
+        OTXASF = LASF(10)
+        LASF(10) = 1
+        CALL GSASF(LASF)
+C
+C  INQUIRE CURRENT POLYLINE AND TEXT COLOR
+C
+        CALL GQPLCI(IERR,OCOLI)
+        CALL GQTXCI(IERR,OTEXCI)
+C
+C  SET POLYLINE AND TEXT COLOR TO VALUE IN COMMON
+C
+        CALL GSPLCI(IRANMJ)
+      CALL GSTXCI(IRANTX)
+C
+C CONSTRUCTION OF WORK SPACE POINTERS
+C
+C TRIANGLE POINT NUMBERS
+C
+      JWIPT = 16
+C
+C SCRATCH SPACE
+C
+      JWIWL = 6*NDP + 1
+C
+C  END POINTS OF BORDER LINE SEGMENTS AND TRIANGLE NUMBER
+C
+      JWIPL = 24*NDP + 1
+C
+C  POINT NUMBERS WHERE THE NCP DATA POINTS AROUND EACH POINT
+C
+      JWIPC = 27*NDP + 1
+C
+C  SCRATCH SPACE
+C
+      JWIWP = 30*NDP + 1
+C
+C  PARTIAL DERIVATIVES AT EACH DATA POINT
+C
+      IPR = 8*NDP + 1
+C
+C  TEST IF REPEAT (JUST NEW CONTOURS OF INTERPOLATED DATA)
+C  OR NO REPEAT (TRIANGULATE AND CONTOUR)
+C
+      IF (REPEAT) GO TO    30
+C
+C TRIANGULATES THE X-Y PLANE.
+C
+      CALL CONTNG (NDP,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),IWK(JWIWL),
+     1             IWK(JWIWP),WK)
+      IF (NERRO(ITEMP).NE.0) RETURN
+C
+      IWK(5) = NT
+      IWK(6) = NL
+      NTNL = NT+NL
+C
+C  SKIP IF NOT LINEAR INTERPOLATION
+C
+      IF (.NOT.LINEAR) GO TO 25
+C
+C  FIND THE COEFICENTS FOR LINER INTERPOLATION OF EACH TRIANGLE
+C
+      CALL CONLIN(XD,YD,ZD,NT,IWK(JWIPT),WK(IPR))
+      GO TO 35
+C
+C
+C DETERMINES NCP POINTS CLOSEST TO EACH DATA POINT.
+C
+ 25   CALL CONDET (NDP,XD,YD,NCP,IWK(JWIPC))
+C
+C  ESTIMATE THE PARTIAL DERIVATIVES AT ALL DATA POINTS
+C
+      CALL CONINT (NDP,XD,YD,ZD,NCP,IWK(JWIPC),WK(IPR))
+C
+C  VERIFY DATA VALUES VALID
+C
+   30 NT = IWK(5)
+      NL = IWK(6)
+      NTNL = NT+NL
+C
+C  COMPUTE STEP SIZE FOR CONTOURING
+C
+ 35   CALL CONSTP (XD,YD,NDP)
+C
+C  SAVE ORIGINAL WINDOW, VIEWPORT OF TRANSFORMATION 1, AND ORIGINAL
+C  LOG SCALING FLAG.
+C
+        CALL GQCNTN(IER,IOLDNT)
+        CALL GQNT(IOLDNT,IER,WIND,VIEW)
+        RX1 = VIEW(1)
+        RX2 = VIEW(2)
+        RY1 = VIEW(3)
+        RY2 = VIEW(4)
+C  SAVE NORMALIZATION TRANSFORMATION 1
+        CALL GQNT(1,IER,WIND,VIEW)
+        CALL GETUSV('LS',IOLLS)
+C
+C  DETERMINE SCALING OPTION
+C
+      ISC = ISCALE+1
+      GO TO (   40,   60,   50),ISC
+C
+C  CONRAN SETS SCALING FACTOR
+C
+   40 CALL SET(PXST,PXED,PYST,PYED,XST,XED,YST,YED,1)
+      GO TO 60
+C
+C  CONRAN PLOTS WITHIN USERS BOUNDARIES
+C
+   50 CALL SET(RX1,RX2,RY1,RY2,XST,XED,YST,YED,1)
+C
+C  IF TRIANGULATION PLOT ONLY BRANCH
+C
+   60 IF (EXTRI) GO TO   390
+C
+C  GENERATE CONTOURS IF NONE SUPPLIED BY USER
+C
+      CALL CONCLS (ZD,NDP)
+      IF (NERRO(ITEMP).NE.0) RETURN
+C
+C  REORDER THE CONTOUR LINES FOR CORRECT PATTERN DISPLAY
+C
+      MAJLNS = 0
+      IF (LABON) CALL CONREO (MAJLNS)
+C
+C  MAKE SURE INTEGER COORDINATES IN 1-1024 RANGE
+C
+      CALL SETUSV('XF',10)
+        CALL SETUSV('YF',10)
+C
+C  SET THE DASH PATTERNS TO DEFAULT IF THEY HAVE NOT BEEN SET
+C
+C
+      IF (IDASH(1:1).NE.' ') GO TO        80
+C
+C  SET POSITIVE CONTOUR VALUE TO DEFAULT
+C
+        IDASH = '$$$$$$$$$$'
+   80 IF (NDASH(1:1).NE.' ') GO TO       100
+C
+C  SET NEGATIVE CONTOUR DASH PATTERN TO DEFAULT
+C
+        NDASH = '$$$$$$$$$$'
+  100 IF (EDASH(1:1).NE.' ') GO TO   120
+C
+C  SET EQUAL CONTOUR DASH PATTERN TO DEFAULT
+C
+        EDASH = '$$$$$$$$$$'
+C
+C  INITIALIZE THE CONTOURING DATA STRUCTURE
+C
+  120 IF (.NOT.EXTRAP) YST = YST+STPSZ
+C
+C  LOAD THE SCRATCH SPACE
+C
+      CALL CONLOD (XD,YD,ZD,NDP,WK,IWK,SCRARR)
+C
+C  PERFORM SHIELDING IF SO REQUESTED
+C
+      IF (SHIELD) CALL CONSLD(SCRARR)
+C
+C  *******************************************************
+C  *                                                     *
+C  * IF THE USER NEEDS TO DIVIDE THE PROGRAM UP          *
+C  * THIS IS THE BREAK POINT.  ALL SUBROUTINES CALLED    *
+C  * PRIOR TO THIS MESSAGE ARE NOT USED AGAIN AND        *
+C  * ALL ROUTINES AFTER THIS MESSAGE ARE NOT USED        *
+C  * ANY EARLIER.  NOTE THIS ONLY REFEARS TO ENTRY POINTS*
+C  * WHICH ARE PART OF THE CONRAN PACKAGE.               *
+C  * ALL DATA STRUCTURES AND VARIABLES MUST BE RETAINED. *
+C  *******************************************************
+C
+C
+C  PLOT RELATIVE MINIMUMS AND MAXIMUMS IF REQUESTED
+C
+      IF (PMIMX) CALL CONPMM (SCRARR)
+C
+C
+      LENDAS = NREP*10
+C
+C  SET THE ERROR MODE TO RECOVERY FOR THE CONTOURING STORAGE ERROR
+C
+      CALL ENTSR (IROLD,1)
+C
+C  DRAW THE CONTOURS
+C
+      DO   250 I=1,NCL
+C
+          CONV = CL(I)
+          IF (CONV.GE.BPSIZ) GO TO   150
+C
+C  SET UP NEGATIVE CONTOUR PATTERN
+C
+              DO   140 J=1,10
+                ICHAR = NDASH(J:J)
+                  DO   130 K=1,NREP
+                DPAT( J+( 10*(K-1) ): J+( 10*(K-1)) ) = ICHAR
+  130             CONTINUE
+  140         CONTINUE
+          GO TO   210
+C
+C  SET UP POSITIVE CONTOUR DASH PATTERN
+C
+  150     IF (CONV.EQ.BPSIZ) GO TO   180
+              DO   170 J=1,10
+                ICHAR = IDASH(J:J)
+                  DO   160 K=1,NREP
+                  DPAT( J+( 10*(K-1) ): J+( 10*(K-1)) ) = ICHAR
+  160             CONTINUE
+  170         CONTINUE
+          GO TO   210
+C
+C  SET UP EQUAL CONTOUR DASH PATTERN
+C
+  180         DO   200 J=1,10
+                ICHAR = EDASH(J:J)
+                  DO   190 K=1,NREP
+                DPAT( J+( 10*(K-1) ): J+( 10*(K-1)) ) = ICHAR
+  190             CONTINUE
+  200         CONTINUE
+C
+  210     IF (I.GT.MAJLNS) GO TO   230
+C
+C  SET UP MAJOR LINES
+C
+          CALL GSPLCI (IRANMJ)
+          CALL CONECD (CONV,IWORK,NCUSED)
+          NCHAR = LENDAS + NCUSED
+        DPAT(LENDAS+1:NCHAR) = IWORK(1:NCUSED)
+          GO TO   240
+C
+C  SET UP MINOR LINES
+C
+  230     NCHAR = 10
+      CALL GSPLCI (IRANMN)
+C
+C  PROCESS FOR ALL CONTOURS
+C
+  240     CALL DASHDC (DPAT(1:NCHAR),NCRT,ISIZEL)
+C
+C  DRAW ALL CONTOURS AT THIS LEVEL
+C
+          CALL CONDRW (SCRARR)
+C
+C  GET NEXT CONTOUR LEVEL
+C
+  250     CONTINUE
+C
+C  CONTOURING COMPLETED CHECK FOR OPTIONAL OUTPUTS ON PLOT
+C
+C  FIRST SET ERROR MODE BACK TO USERS VALUE
+C
+      CALL RETSR (IROLD)
+C
+C  GET PLOT BOUNDRIES FOR TITLING AND MESSAGE POSITIONING
+C
+      CALL GQCNTN(IER,ICN)
+        CALL GQNT(ICN,IER,NWIND,NVIEW)
+        XST = NWIND(1)
+        XED = NWIND(2)
+        YST = NWIND(3)
+        YED = NWIND(4)
+        CALL GETUSV('LS',LT)
+C
+C  RESET POLYLINE COLOR INDEX TO MAJOR (NORMAL)
+C
+        CALL GSPLCI (IRANMJ)
+C
+C  DRAW SHIELD ON PLOT IF REQUESTED
+C
+      IF(SLDPLT.AND.SHIELD) CALL CONDSD
+C
+C  DRAW PERIMETER ARROUND PLOT IF DESIRED
+C
+      IF (PER) CALL PERIM (ITICK,0,ITICK,0)
+C
+C  DRAW GRID IF REQUESTED
+C
+      IF (GRD) CALL GRID (ITICK,0,ITICK,0)
+C
+C  PLOT THE DATA VALUES IF REQUESTED
+C
+      IF (.NOT.PLDVLS) GO TO   260
+      CALL CONPDV (XD,YD,ZD,NDP)
+C
+C  OUTPUT TITLE IF REQUESTED
+C
+  260 IF (.NOT.TITLE) GO TO   270
+        CALL GSTXCI (IRANTX)
+      CALL FL2INT (XED,YED,MX,MY)
+      MY = (MY/ICONV)+IABOVE
+        ILAST = 64
+        DO 261 I = 64,1,-1
+            IF (ISTRNG(I:I) .NE. ' ')THEN
+                  ILAST = I + 1
+                  GOTO 262
+            ENDIF
+  261 CONTINUE
+  262 CONTINUE
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = ( NVIEW(1) + NVIEW(2)) / 2.
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,ISTRNG(1:ILAST),ITLSIZ,0,0)
+      CALL GSELNT(ICN)
+C
+C
+C  OUTPUT MESSAGE IF REQUESTED
+C
+  270 IF (.NOT.MESS) GO TO   390
+C
+        CALL GSTXCI(IRANTX)
+      CALL FL2INT (XST,YST,MX,MY)
+      MY = (MY/ICONV)
+C
+C  IF PERIMETER OR GRID PUT OUT TICK INTERVAL
+C
+        IMSZ = 0
+      IF (.NOT.PER .AND. .NOT.GRD) GO TO   300
+        IWORK(1:36) = 'X INTERVAL=              Y INTERVAL='
+C
+C +NOAO - FTN internal writes rewritten as calls to encode.
+C       WRITE(ENCSCR,'(G13.5)')XRG
+C       WRITE(ENSCRY,'(G13.5)')YRG
+        call encode (13, '(f13.5)', encscr, xrg)
+	call encode (13, '(f13.5)', enscry, yrg)
+C -NOAO
+        IWORK(12:24) = ENCSCR
+        IWORK(37:49) = ENSCRY
+        IMSZ = 50
+  300 IF (SCALE .EQ. 1.) GOTO 330
+            IWORK(IMSZ:IMSZ+10) = ' SCALED BY '
+C +NOAO
+C           WRITE(ENCSCR,'(G13.5)')SCALE
+            call encode (13, '(f13.5)', encscr, scale)
+C -NOAO
+            IWORK(IMSZ+11:IMSZ+23) = ENCSCR
+            IMSZ = 73
+  330 IF (IMSZ .NE. 0) THEN
+        ILAST = IMSZ
+        DO 291 I = IMSZ,1,-1
+            IF (IWORK(I:I) .NE. ' ')THEN
+                  ILAST = I + 1
+                  GOTO 292
+            ENDIF
+  291 CONTINUE
+  292 CONTINUE
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = ( NVIEW(1) + NVIEW(2)) / 2.
+      YC = CPUY(MY+IBEL2)
+      CALL WTSTR(XC,YC,IWORK(1:ILAST),8,0,0)
+      CALL GSELNT(ICN)
+        ENDIF
+C
+C  PRODUCE CONTOUR INFO
+C
+      IWORK(1:42) = 'CONTOUR FROM              TO              '
+      IWORK(43:77) = 'CONTOUR INTERVAL OF                '
+      HOLD(1) = FLO
+      HOLD(2) = HI
+      HOLD(3) = FINC
+C
+C +NOAO
+C       WRITE(ENCSCR,'(G13.5)')HOLD(1)
+        call encode (13, '(f13.5)', encscr, hold(1))
+        IWORK(13:25) = ENCSCR
+C       WRITE(ENCSCR,'(G13.5)')HOLD(2)
+        call encode (13, '(f13.5)', encscr, hold(2))
+        IWORK(29:41) = ENCSCR
+C       WRITE(ENCSCR,'(G13.5)')HOLD(3)
+        call encode (13, '(f13.5)', encscr, hold(3))
+        IWORK(62:74) = ENCSCR
+C -NOAO
+C
+C  IF IRREGULAR SPACED CONTOURS MODIFY CONTOUR INTERVAL STATEMENT
+C
+      IF (FINC.GE.0.) GO TO   380
+      NC = 62
+          IWORK(NC:NC+15) = ' IRREGULAR      '
+C
+        ILAST = 77
+  380 DO 381 I = 77,1,-1
+            IF (IWORK(I:I) .NE. ' ')THEN
+                  ILAST = I + 1
+                  GOTO 382
+            ENDIF
+  381 CONTINUE
+  382 CONTINUE
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = ( NVIEW(1) + NVIEW(2)) / 2.
+      YC = CPUY(MY+IBELOW)
+      CALL WTSTR(XC,YC,IWORK(1:ILAST),8,0,0)
+      CALL GSELNT(ICN)
+C
+C
+C
+C  PLOT TRIANGLES IF REQUESTED
+C
+  390 IF (LOOK) THEN
+          CALL GSPLCI(IRANMN)
+          CALL CONTLK (XD,YD,NDP,IWK(JWIPT))
+          CALL GSPLCI(IRANMJ)
+      ENDIF
+C  RESTORE NORMALIZATION TRANSFORMATION 1 AND LOG SCALING
+      IF (ISCALE .NE. 1) THEN
+        CALL SET(VIEW(1),VIEW(2),VIEW(3),VIEW(4),
+     -           WIND(1),WIND(2),WIND(3),WIND(4),IOLLS)
+      ENDIF
+C RESTORE ORIGINAL NORMALIZATION TRANSFORMATION NUMBER
+      CALL GSELNT (IOLDNT)
+C
+C  RESTORE ORIGINAL COLOR
+C
+      CALL GSPLCI(OCOLI)
+      CALL GSTXCI(OTEXCI)
+C
+C  RESTORE POLYLINE COLOR ASF TO WHAT IT WAS ON ENTRY TO GRIDAL
+C
+        LASF(10) = OTXASF
+        LASF(3) = OPLASF
+        CALL GSASF(LASF)
+      RETURN
+      END
+      SUBROUTINE CONPMM (SCRARR)
+C
+C THIS ROUTINE FINDS RELATIVE MINIMUMS AND MAXIMUMS.  A RELATIVE MINIMUM
+C (OR MAXIMUM) IS DEFINED TO BE THE LOWEST (OR HIGHEST) POINT WITHIN
+C A CERTAIN NEIGHBORHOOD OF THE POINT.  THE NEIGHBORHOOD USED HERE
+C IS + OR - IXRG IN THE X DIRECTION AND + OR - IYRG IN THE Y DIRECTION.
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C
+      DIMENSION       SCRARR(*)
+      CHARACTER*10    IA
+      SAVE
+C
+C  CONVERT FROM 0-32767 TO 1-1024
+C
+        DATA ICONV/32/
+C
+C  ACCESSING FUNCTION INTO SCRARR
+C
+      SCRTCH(IXX,IYY) = SCRARR(IYY+(IXX-1)*IYMAX)
+C
+C  GRAPHICS MAPPING FUNCTIONS
+C
+      FX(XXX,YYY) = XXX
+      FY(XXX,YYY) = YYY
+C
+C  MAPPING FROM INTEGER TO USER INPUT FLOATING POINT
+C
+      CONVX(IXX) = XST + FLOAT(IXX-1)*STPSZ
+      CONVY(IYY) = YST + FLOAT(IYY-1)*STPSZ
+C
+C  SET INTENSITY TO HIGH
+C
+        IF (INDAT .NE. 1) THEN
+          CALL GSTXCI (INDAT)
+      ELSE
+            CALL GSTXCI (IRANTX)
+        ENDIF
+C
+C  COMPUTE THE SEARCH RANGE FOR MIN AND MAX DETERMINATION
+C
+      IXRG = MIN0(15,MAX0(2,IFIX(FLOAT(IXMAX)/8.)))
+      IYRG = MIN0(15,MAX0(2,IFIX(FLOAT(IYMAX)/8.)))
+C
+C  LOOP THROUGH ALL ROWS OF THE DATA SEARCHING FOR AN IMMEDIATE MIN OR
+C  MAX.
+C
+      IX = 1
+C
+C  SCAN A ROW
+C
+C  IF EXTRAPOLATING DONT LIMIT ROW SCANS
+C
+   10 IF (.NOT.EXTRAP) GO TO    20
+      IYST = 1
+      IYED = IYMAX
+      IY = 1
+      GO TO    30
+C
+C  NOT EXTRAPOLATING STAY IN HULL BOUNDRIES
+C
+   20 IYST = ITLOC(IX*2-1)
+      IYED = ITLOC(IX*2)
+      IF (IYST.EQ.0) GO TO   240
+      IY = IYST
+   30 VAL = SCRTCH(IX,IY)
+C
+C  SEARCH FOR A MIN
+C
+C
+C  BRANCH IF NOT FIRST ON A ROW
+C
+      IF (IY.NE.IYST) GO TO    40
+      IF (VAL.GE.SCRTCH(IX,IY+1)) GO TO   130
+      IF (VAL.GE.SCRTCH(IX,IY+2)) GO TO   130
+      GO TO    60
+C
+C  BRANCH IF NOT LAST ON ROW
+C
+   40 IF (IY.NE.IYED) GO TO    50
+      IF (VAL.GE.SCRTCH(IX,IY-1)) GO TO   140
+      IF (VAL.GE.SCRTCH(IX,IY-2)) GO TO   140
+      GO TO    60
+C
+C  IN MIDDLE OF ROW
+C
+   50 IF (VAL.GE.SCRTCH(IX,IY+1)) GO TO   150
+      IF (VAL.GE.SCRTCH(IX,IY-1)) GO TO   150
+C
+C  POSSIBLE MIN FOUND SEARCH NEIGHBORHOOD
+C
+   60 IXST = MAX0(1,IX-IXRG)
+      IXSTOP = MIN0(IXMAX,IX+IXRG)
+C
+C IF NOT EXTRAPOLATING BRANCH
+C
+   70 IF (.NOT.EXTRAP) GO TO    80
+      IYSRS = 1
+      IYSRE = IYMAX
+      GO TO    90
+C
+C  NOT EXTRAPOLATING STAY IN CONVEX HULL
+C
+   80 IYSRS = ITLOC(IXST*2-1)
+      IYSRE = ITLOC(IXST*2)
+      IF (IYSRS.EQ.0) GO TO   120
+C
+   90 IYSRS = MAX0(IYSRS,IY-IYRG)
+      IYSRE = MIN0(IYSRE,IY+IYRG)
+C
+  100 CUR = SCRTCH(IXST,IYSRS)
+      IF (VAL.LT.CUR) GO TO   110
+      IF (VAL.GT.CUR) GO TO   230
+      IF (IX.EQ.IXST .AND. IY.EQ.IYSRS) GO TO   110
+      GO TO   230
+C
+C  SUCCESS SO FAR TRY NEXT SPACE
+C
+  110 IYSRS = IYSRS+1
+      IF (IYSRS.LE.IYSRE) GO TO   100
+  120 IXST = IXST+1
+      IF (IXST.LE.IXSTOP) GO TO    70
+C
+C  SUCCESS, WE HAVE FOUND A RELATIVE MIN
+C
+      X = CONVX(IX)
+      Y = CONVY(IY)
+      X1 = FX(X,Y)
+      CALL FL2INT (X1,FY(X,Y),MX,MY)
+      MX = MX/ICONV
+      MY = MY/ICONV
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = CPUX(MX)
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,'L',ISIZEM,0,0)
+      CALL GSELNT(ICN)
+C
+      CALL CONECD (VAL,IA,NC)
+      MY = MY - 2*ISIZEM
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,IA(1:NC),ISIZEM,0,0)
+      CALL GSELNT(ICN)
+C
+      GO TO   230
+C
+C  SEARCH FOR A LOCAL MAXIMUM
+C
+C  IF FIRST LOC ON A ROW
+C
+  130 IF (VAL.LE.SCRTCH(IX,IY+1)) GO TO   230
+      IF (VAL.LE.SCRTCH(IX,IY+2)) GO TO   230
+      GO TO   160
+C
+C  IF LAST ON ROW
+C
+  140 IF (VAL.LE.SCRTCH(IX,IY-1)) GO TO   230
+      IF (VAL.LE.SCRTCH(IX,IY-2)) GO TO   230
+      GO TO   160
+C
+C  IN MIDDLE OF ROW
+C
+  150 IF (VAL.LE.SCRTCH(IX,IY+1)) GO TO   230
+      IF (VAL.LE.SCRTCH(IX,IY-1)) GO TO   230
+C
+C  POSSIBLE MIN FOUND SEARCH NEIGHBORHOOD
+C
+  160 IXST = MAX0(1,IX-IXRG)
+      IXSTOP = MIN0(IXMAX,IX+IXRG)
+  170 IF (.NOT.EXTRAP) GO TO   180
+      IYSRS = 1
+      IYSRE = IYMAX
+      GO TO   190
+C
+C  NOT EXTRAPOLATING STAY IN CONVEX HULL
+C
+  180 IYSRS = ITLOC(IXST*2-1)
+      IYSRE = ITLOC(IXST*2)
+      IF (IYSRS.EQ.0) GO TO   220
+C
+  190 IYSRS = MAX0(IYSRS,IY-IYRG)
+      IYSRE = MIN0(IYSRE,IY+IYRG)
+C
+  200 CUR = SCRTCH(IXST,IYSRS)
+      IF (VAL.GT.CUR) GO TO   210
+      IF (VAL.LT.CUR) GO TO   230
+      IF (IX.EQ.IXST .AND. IY.EQ.IYSRS) GO TO   210
+      GO TO   230
+C
+C  SUCCESS SO FAR TRY NEXT SPACE
+C
+  210 IYSRS = IYSRS+1
+      IF (IYSRS.LE.IYSRE) GO TO   200
+  220 IXST = IXST+1
+      IF (IXST.LE.IXSTOP) GO TO   170
+C
+C  SUCCESS WE HAVE A MAXIMUM
+C
+      X = CONVX(IX)
+      Y = CONVY(IY)
+      X1 = FX(X,Y)
+      CALL FL2INT (X1,FY(X,Y),MX,MY)
+      MX = MX/ICONV
+      MY = MY/ICONV
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = CPUX(MX)
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,'H',ISIZEM,0,0)
+      CALL GSELNT(ICN)
+C
+      CALL CONECD (VAL,IA,NC)
+      MY = MY - 2*ISIZEM
+C
+C  POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      YC = CPUY(MY)
+      CALL WTSTR(XC,YC,IA(1:NC),ISIZEM,0,0)
+      CALL GSELNT(ICN)
+C
+C  END OF SEARCH AT THIS LOCATION TRY NEXT
+C
+  230 IY = IY+1
+      IF (IY.LE.IYED) GO TO    30
+  240 IX = IX+1
+      IF (IX.LE.IXMAX) GO TO    10
+C
+      CALL GSTXCI (IRANTX)
+C
+      RETURN
+C
+C******************************************************************
+C*                                                                *
+C*                   REVISION HISTORY                             *
+C*                                                                *
+C*  JUNE 1980   ADDED CONRAN TO ULIB                              *
+C*  AUGUST 1980 CHANGED ACCESS CARD DOCUMENTATION                 *
+C*  DECEMBER 1980 MODIFIED COMMENT CARD DOCUMENTATION             *
+C*  MARCH 1983  ADDED ASPECT RATIO ERROR                          *
+C*  JULY 1983  ADDED SHIELDING AND LINEAR INTERPOLATION           *
+C*             REMOVED 7600 ACCESS CARDS                          *
+C*  JULY 1984  CONVERTED TO STANDARD FORTRAN77 AND GKS        *
+C*                                                                *
+C******************************************************************
+C
+      END
diff --git a/sys/gio/ncarutil/conrec.f b/sys/gio/ncarutil/conrec.f
new file mode 100644
index 00000000..b3e246c1
--- /dev/null
+++ b/sys/gio/ncarutil/conrec.f
@@ -0,0 +1,1313 @@
+      SUBROUTINE CONREC (Z,L,M,N,FLO,HI,FINC,NSET,NHI,NDOT)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C
+C     DIMENSION OF           Z(L,N)
+C     ARGUMENTS
+C
+C     LATEST REVISION        JUNE 1984
+C
+C     PURPOSE                CONREC DRAWS A CONTOUR MAP FROM DATA STORED
+C                            IN A RECTANGULAR ARRAY, LABELING THE LINES.
+C
+C     USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                              CALL EZCNTR (Z,M,N)
+C
+C                              ASSUMPTIONS:
+C                                  --ALL OF THE ARRAY IS TO BE CONTOURED.
+C                                  --CONTOUR LEVELS ARE PICKED
+C                                    INTERNALLY.
+C                                  --CONTOURING ROUTINE PICKS SCALE
+C                                    FACTORS.
+C                                  --HIGHS AND LOWS ARE MARKED.
+C                                  --NEGATIVE LINES ARE DRAWN WITH A
+C                                    DASHED LINE PATTERN.
+C                                  --EZCNTR CALLS FRAME AFTER DRAWING THE
+C                                    CONTOUR MAP.
+C
+C                            IF THESE ASSUMPTIONS ARE NOT MET, USE
+C
+C                              CALL CONREC (Z,L,M,N,FLO,HI,FINC,NSET,
+C                                           NHI,NDOT)
+C
+C     ARGUMENTS
+C
+C     ON INPUT               Z
+C     FOR EZCNTR               M BY N ARRAY TO BE CONTOURED.
+C
+C                            M
+C                              FIRST DIMENSION OF Z.
+C
+C                            N
+C                              SECOND DIMENSION OF Z.
+C
+C     ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C     FOR EZCNTR
+C
+C     ON INPUT               Z
+C     FOR CONREC               THE (ORIGIN OF THE) ARRAY TO BE
+C                              CONTOURED.  Z IS DIMENSIONED L BY N.
+C
+C                            L
+C                              THE FIRST DIMENSION OF Z IN THE CALLING
+C                              PROGRAM.
+C
+C                            M
+C                              THE NUMBER OF DATA VALUES TO BE CONTOURED
+C                              IN THE X-DIRECTION (THE FIRST SUBSCRIPT
+C                              DIRECTION).  WHEN PLOTTING AN ENTIRE
+C                              ARRAY, L = M.
+C
+C                            N
+C                              THE NUMBER OF DATA VALUES TO BE CONTOURED
+C                              IN THE Y-DIRECTION (THE SECOND SUBSCRIPT
+C                              DIRECTION).
+C
+C                            FLO
+C                              THE VALUE OF THE LOWEST CONTOUR LEVEL.
+C                              IF FLO = HI = 0., A VALUE ROUNDED UP FROM
+C                              THE MINIMUM Z IS GENERATED BY CONREC.
+C
+C                            HI
+C                              THE VALUE OF THE HIGHEST CONTOUR LEVEL.
+C                              IF HI = FLO = 0., A VALUE ROUNDED DOWN
+C                              FROM THE MAXIMUM Z IS GENERATED BY
+C                              CONREC.
+C
+C                            FINC
+C                              > 0  INCREMENT BETWEEN CONTOUR LEVELS.
+C                              = 0  A VALUE, WHICH PRODUCES BETWEEN 10
+C                                   AND 30 CONTOUR LEVELS AT NICE VALUES,
+C                                   IS GENERATED BY CONREC.
+C                              < 0  THE NUMBER OF LEVELS GENERATED BY
+C                                   CONREC IS ABS(FINC).
+C
+C                            NSET
+C                              FLAG TO CONTROL SCALING.
+C                              = 0  CONREC AUTOMATICALLY SETS THE
+C                                   WINDOW AND VIEWPORT TO PROPERLY
+C                                   SCALE THE FRAME TO THE STANDARD
+C                                   CONFIGURATION.
+C                                   THE GRIDAL ENTRY PERIM IS
+C                                   CALLED AND TICK MARKS ARE PLACED
+C                                   CORRESPONDING TO THE DATA POINTS.
+C                              > 0  CONREC ASSUMES THAT THE USER
+C                                   HAS SET THE WINDOW AND VIEWPORT
+C                                   IN SUCH A WAY AS TO PROPERLY
+C                                   SCALE THE PLOTTING
+C                                   INSTRUCTIONS GENERATED BY CONREC.
+C                                   PERIM IS NOT CALLED.
+C                              < 0  CONREC GENERATES COORDINATES SO AS
+C                                   TO PLACE THE (UNTRANSFORMED) CONTOUR
+C                                   PLOT WITHIN THE LIMITS OF THE
+C                                   USER'S CURRENT WINDOW AND
+C                                   VIEWPORT.  PERIM IS NOT CALLED.
+C
+C                            NHI
+C                              FLAG TO CONTROL EXTRA INFORMATION ON THE
+C                              CONTOUR PLOT.
+C                              = 0  HIGHS AND LOWS ARE MARKED WITH AN H
+C                                   OR L AS APPROPRIATE, AND THE VALUE
+C                                   OF THE HIGH OR LOW IS PLOTTED UNDER
+C                                   THE SYMBOL.
+C                              > 0  THE DATA VALUES ARE PLOTTED AT
+C                                   EACH Z POINT, WITH THE CENTER OF
+C                                   THE STRING INDICATING THE DATA
+C                                   POINT LOCATION.
+C                              < 0  NEITHER OF THE ABOVE.
+C
+C                            NDOT
+C                              A 10-BIT CONSTANT DESIGNATING THE DESIRED
+C                              DASHED LINE PATTERN.
+C                              IF ABS(NDOT) = 0, 1, OR 1023, SOLID LINES
+C                              ARE DRAWN.
+C                              > 0 NDOT PATTERN IS USED FOR ALL LINES.
+C                              < 0 ABS(NDOT) PATTERN IS USED FOR NEGA-
+C                                TIVE-VALUED CONTOUR LINES, AND SOLID IS
+C                                USED FOR POSITIVE-VALUED CONTOURS.
+C                                CONREC CONVERTS NDOT
+C                                TO A 16-BIT PATTERN AND DASHDB IS USED.
+C                                SEE DASHDB COMMENTS IN THE DASHLINE
+C                                DOCUMENTATION FOR DETAILS.
+C
+C
+C
+C     ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C     FOR CONREC
+C
+C
+C     ENTRY POINTS           CONREC, CLGEN, REORD, STLINE, DRLINE,
+C                            MINMAX, PNTVAL, CALCNT, EZCNTR, CONBD
+C
+C     COMMON BLOCKS          INTPR, RECINT, CONRE1, CONRE2, CONRE3,
+C                            CONRE4,CONRE5
+C
+C     REQUIRED LIBRARY       STANDARD VERSION: DASHCHAR, WHICH AT
+C     ROUTINES               NCAR ISLOADED BY DEFAULT.
+C                            SMOOTH VERSION: DASHSMTH WHICH MUST BE
+C                            REQUESTED AT NCAR.
+C                            BOTH VERSIONS REQUIRE  GRIDAL, THE
+C                            ERPRT77 PACKAGE, AND THE SPPS.
+C
+C     I/O                    PLOTS CONTOUR MAP.
+C
+C     PRECISION              SINGLE
+C
+C     LANGUAGE               FORTRAN 77
+C
+C     HISTORY                REPLACES OLD CONTOURING PACKAGE CALLED
+C                            CALCNT AT NCAR.
+C
+C     ALGORITHM              EACH LINE IS FOLLOWED TO COMPLETION.  POINTS
+C                            ALONG A LINE ARE FOUND ON BOUNDARIES OF THE
+C                            (RECTANGULAR) CELLS. THESE POINTS ARE
+C                            CONNECTED BY LINE SEGMENTS USING THE
+C                            SOFTWARE DASHED LINE PACKAGE, DASHCHAR.
+C                            DASHCHAR IS ALSO USED TO LABEL THE
+C                            LINES.
+C
+C     NOTE                   TO DRAW NON-UNIFORM CONTOUR LEVELS, SEE
+C                            THE COMMENTS IN CLGEN.  TO MAKE SPECIAL
+C                            MODIFICATIONS FOR SPECIFIC NEEDS SEE THE
+C                            EXPLANATION OF THE INTERNAL PARAMETERS
+C                            BELOW.
+C
+C     TIMING                 VARIES WIDELY WITH SIZE AND SMOOTHNESS OF
+C                            Z.
+C
+C     INTERNAL PARAMETERS    NAME   DEFAULT         FUNCTION
+C                            ----   -------         --------
+C
+C                            ISIZEL   1      SIZE OF LINE LABELS,
+C                                            AS PER THE SIZE DEFINITIONS
+C                                            GIVEN IN THE SPPS
+C                                            DOCUMENTATION FOR WTSTR.
+C
+C                            ISIZEM   2      SIZE OF LABELS FOR MINIMUMS
+C                                            AND MAXIMUMS,
+C                                            AS PER THE SIZE DEFINITIONS
+C                                            GIVEN IN THE SPPS
+C                                            DOCUMENTATION FOR WTSTR.
+C
+C                            ISIZEP   0      SIZE OF LABELS FOR DATA
+C                                            POINT VALUES AS PER THE SIZE
+C                                            DEFINITIONS GIVEN IN THE SPPS
+C                                            DOCUMENTATION FOR WTSTR.
+C
+C                            NLA      16     APPROXIMATE NUMBER OF
+C                                            CONTOUR LEVELS WHEN
+C                                            INTERNALLY GENERATED.
+C
+C                            NLM      40     MAXIMUM NUMBER OF CONTOUR
+C                                            LEVELS.  IF THIS IS TO BE
+C                                            INCREASED, THE DIMENSIONS
+C                                            OF CL AND RWORK IN CONREC
+C                                            MUST BE INCREASED BY THE
+C                                            SAME AMOUNT.
+C
+C                            XLT      .05    LEFT HAND EDGE OF THE PLOT
+C                                            (0.0 IS THE LEFT EDGE OF
+C                                            THE FRAME AND 1.0 IS THE
+C                                            RIGHT EDGE OF THE FRAME.)
+C
+C                            YBT      .05    BOTTOM EDGE OF THE PLOT
+C                                            (0.0 IS THE BOTTOM OF THE
+C                                            FRAME AND 1.0 IS THE TOP
+C                                            OF THE FRAME.)
+C
+C                            SIDE     0.9    LENGTH OF LONGER EDGE OF
+C                                            PLOT (SEE ALSO EXT).
+C
+C                            NREP     6      NUMBER OF REPETITIONS OF
+C                                            THE DASH PATTERN BETWEEN
+C                                            LINE LABELS.
+C
+C                            NCRT     2      NUMBER OF CRT UNITS PER
+C                                            ELEMENT (BIT) IN THE DASH
+C                                            PATTERN.
+C +NOAO - Value of ncrt changed from 4 to 2 in conbd.
+C -NOAO
+C
+C                            ILAB     1      FLAG TO CONTROL THE DRAWING
+C                                            OF LINE LABELS.
+C                                            . ILAB NON-ZERO MEANS LABEL
+C                                              THE LINES.
+C                                            . ILAB = 0 MEANS DO NOT
+C                                              LABEL THE LINES.
+C
+C                            NULBLL   3      NUMBER OF UNLABELED LINES
+C                                            BETWEEN LABELED LINES.  FOR
+C                                            EXAMPLE, WHEN NULBLL = 3,
+C                                            EVERY FOURTH LEVEL IS
+C                                            LABELED.
+C
+C                            IOFFD    0      FLAG TO CONTROL
+C                                            NORMALIZATION OF LABEL
+C                                            NUMBERS.
+C                                            . IOFFD = 0 MEANS INCLUDE
+C                                              DECIMAL POINT WHEN
+C                                              POSSIBLE (DO NOT
+C                                              NORMALIZE UNLESS
+C                                              REQUIRED).
+C                                            . IOFFD NON-ZERO MEANS
+C                                              NORMALIZE ALL LABEL
+C                                              NUMBERS AND OUTPUT A
+C                                              SCALE FACTOR IN THE
+C                                              MESSAGE BELOW THE GRAPH.
+C
+C                            EXT      .0625  LENGTHS OF THE SIDES OF THE
+C                                            PLOT ARE PROPORTIONAL TO M
+C                                            AND N (WHEN CONREC SETS
+C                                            THE WINDOW AND VIEWPORT).
+C                                            IN EXTREME CASES, WHEN
+C                                            MIN(M,N)/MAX(M,N) IS LESS
+C                                            THAN EXT, CONREC
+C                                            PRODUCES A SQUARE PLOT.
+C
+C                            IOFFP      0    FLAG TO CONTROL SPECIAL
+C                                            VALUE FEATURE.
+C                                            . IOFFP = 0 MEANS SPECIAL
+C                                              VALUE FEATURE NOT IN USE.
+C                                            . IOFFP NON-ZERO MEANS
+C                                              SPECIAL VALUE FEATURE IN
+C                                              USE.  (SPVAL IS SET TO THE
+C                                              SPECIAL VALUE.)  CONTOUR
+C                                              LINES WILL THEN BE
+C                                              OMITTED FROM ANY CELL
+C                                              WITH ANY CORNER EQUAL TO
+C                                              THE SPECIAL VALUE.
+C
+C                            SPVAL    0.     CONTAINS THE SPECIAL VALUE
+C                                            WHEN IOFFP IS NON-ZERO.
+C
+C                            IOFFM    0      FLAG TO CONTROL THE MESSAGE
+C                                            BELOW THE PLOT.
+C                                            . IOFFM = 0  IF THE MESSAGE
+C                                              IS TO BE PLOTTED.
+C                                            . IOFFM NON-ZERO IF THE
+C                                              MESSAGE IS TO BE OMITTED.
+C
+C                            ISOLID   1023   DASH PATTERN FOR
+C                                            NON-NEGATIVE CONTOUR LINES.
+C
+C
+C +NOAO - Block data conbd rewritten as run time initialization.
+C     EXTERNAL        CONBD
+C -NOAO
+C
+      SAVE
+      CHARACTER*1     IGAP       ,ISOL       ,RCHAR
+      CHARACTER       ENCSCR*22  ,IWORK*126
+C +NOAO - Character variable added for improved label processing.
+      character*25    string(5)
+C -NOAO
+      DIMENSION       LNGTHS(5)  ,HOLD(5)    ,WNDW(4)    ,VWPRT(4)
+      DIMENSION       Z(L,N)     ,CL(40)     ,RWORK(40)  ,LASF(13)
+      COMMON /INTPR/ PAD1, FPART, PAD(8)
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+      COMMON /CONRE3/ IXBITS     ,IYBITS
+      COMMON /CONRE4/ ISIZEL     ,ISIZEM     ,ISIZEP     ,NREP       ,
+     1                NCRT       ,ILAB       ,NULBLL     ,IOFFD      ,
+     2                EXT        ,IOFFM      ,ISOLID     ,NLA        ,
+     3                NLM        ,XLT        ,YBT        ,SIDE
+      COMMON /CONRE5/ SCLY
+      COMMON /RECINT/ IRECMJ     ,IRECMN     ,IRECTX
+C +NOAO - Value of LNGTHS have been changed from original defaults.  Additional
+C         common block noaolb added for communication with calling routine.
+C
+      common /noaolb/ hold
+      DATA  LNGTHS(1),LNGTHS(2),LNGTHS(3),LNGTHS(4),LNGTHS(5)
+     1      /  13,       4,        21,       10,        19       /
+      DATA  ISOL, IGAP /'$', ''''/
+C
+C -NOAO
+C
+C ISOL AND IGAP (DOLLAR-SIGN AND APOSTROPHE) ARE USED TO CONSTRUCT PAT-
+C TERNS PASSED TO ROUTINE DASHDC IN THE SOFTWARE DASHED-LINE PACKAGE.
+C
+C
+C
+C +NOAO - Blockdata conbd called as run time initialization subroutine
+      call conbd
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','CONREC','CONREC','VERSION 01')
+C
+C NONSMOOTHING VERSION
+C
+C
+C
+C  CALL RESET FOR COMPATIBILITY WITH ALL DASH ROUTINES(EXCEPT DASHLINE)
+C
+      CALL RESET
+C
+C  GET NUMBER OF BITS IN INTEGER ARITHMETIC
+C
+      IARTH = I1MACH(8)
+      IXBITS = 0
+      DO 101 I=1,IARTH
+         IF (M .LE. (2**I-1)) GO TO 102
+         IXBITS = I+1
+  101 CONTINUE
+  102 IYBITS = 0
+      DO 103 I=1,IARTH
+         IF (N .LE. (2**I-1)) GO TO 104
+         IYBITS = I+1
+  103 CONTINUE
+  104 IF ((IXBITS*IYBITS).GT.0 .AND. (IXBITS+IYBITS).LE.24) GO TO 105
+C
+C REPORT ERROR NUMBER ONE
+C
+      IWORK =    'CONREC  - DIMENSION ERROR - M*N .GT. (2**IARTH)    M =
+     +            N = '
+C +NOAO
+C
+C     WRITE (IWORK(56:62),'(I6)') M
+      call encode (6, '(i6)', iwork(56:62), m)
+C     WRITE (IWORK(73:79),'(I6)') N
+      call encode (6, '(i6)', iwork(73:79), n)
+C -NOAO
+C
+      CALL SETER( IWORK, 1, 1 )
+      RETURN
+  105 CONTINUE
+C
+C INQUIRE CURRENT TEXT AND LINE COLOR INDEX
+C
+      CALL GQTXCI ( IERR, ITXCI )
+      CALL GQPLCI ( IERR, IPLCI )
+C
+C SET LINE AND TEXT ASF TO INDIVIDUAL
+C
+      CALL GQASF ( IERR, LASF )
+      LSV3  = LASF(3)
+      LSV10 = LASF(10)
+      LASF(3)  = 1
+      LASF(10) = 1
+      CALL GSASF ( LASF )
+C
+      GL = FLO
+      HA = HI
+      GP = FINC
+      MX = L
+      NX = M
+      NY = N
+      IDASH = NDOT
+      NEGPOS = ISIGN(1,IDASH)
+      IDASH = IABS(IDASH)
+      IF (IDASH.EQ.0 .OR. IDASH.EQ.1) IDASH = ISOLID
+C
+C SET CONTOUR LEVELS.
+C
+      CALL CLGEN (Z,MX,NX,NY,GL,HA,GP,NLA,NLM,CL,NCL,ICNST)
+C
+C FIND MAJOR AND MINOR LINES
+C
+      IF (ILAB .NE. 0) CALL REORD (CL,NCL,RWORK,NML,NULBLL+1)
+      IF (ILAB .EQ. 0) NML = 0
+C
+C SAVE CURRENT NORMALIZATION TRANS NUMBER NTORIG AND LOG SCALING FLAG
+C
+      CALL GQCNTN ( IERR, NTORIG )
+      CALL GETUSV ('LS',IOLLS)
+C
+C SET UP SCALING
+C
+      CALL GETUSV ( 'YF' , IYVAL )
+      SCLY = 1.0 / ISHIFT ( 1, 15 - IYVAL )
+C
+      IF (NSET) 106,107,111
+  106 CALL GQNT ( NTORIG,IERR,WNDW,VWPRT )
+      X1 = VWPRT(1)
+      X2 = VWPRT(2)
+      Y1 = VWPRT(3)
+      Y2 = VWPRT(4)
+C
+C SAVE NORMALIZATION TRANS 1
+C
+      CALL GQNT (1,IERR,WNDW,VWPRT)
+C
+C DEFINE NORMALIZATION TRANS AND LOG SCALING
+C
+      CALL SET(X1, X2, Y1, Y2, 1.0, FLOAT(NX), 1.0, FLOAT(NY), 1)
+      GO TO 111
+  107 CONTINUE
+      X1 = XLT
+      X2 = XLT+SIDE
+      Y1 = YBT
+      Y2 = YBT+SIDE
+      X3 = NX
+      Y3 = NY
+      IF (AMIN1(X3,Y3)/AMAX1(X3,Y3) .LT. EXT) GO TO 110
+      IF (NX-NY) 108,110,109
+  108 X2 = SIDE*X3/Y3+XLT
+      GO TO 110
+  109 Y2 = SIDE*Y3/X3+YBT
+C
+C SAVE NORMALIZATION TRANS 1
+C
+  110 CALL GQNT ( 1, IERR, WNDW, VWPRT )
+C
+C DEFINE NORMALIZATION TRANS 1 AND LOG SCALING
+C
+      CALL SET(X1,X2,Y1,Y2,1.0,X3,1.0,Y3,1)
+C
+C DRAW PERIMETER
+C
+      CALL PERIM (NX-1,1,NY-1,1)
+  111 IF (ICNST .NE. 0) GO TO 124
+C
+C SET UP LABEL SCALING
+C
+      IOFFDT = IOFFD
+      IF (GL.NE.0.0 .AND. (ABS(GL).LT.0.1 .OR. ABS(GL).GE.1.E5))
+     1    IOFFDT = 1
+      IF (HA.NE.0.0 .AND. (ABS(HA).LT.0.1 .OR. ABS(HA).GE.1.E5))
+     1    IOFFDT = 1
+      ASH = 10.**(3-IFIX(ALOG10(AMAX1(ABS(GL),ABS(HA),ABS(GP)))-5000.)-
+     1                                                             5000)
+      IF (IOFFDT .EQ. 0) ASH = 1.
+      HOLD(1) = GL
+      HOLD(2) = HA
+      HOLD(3) = GP
+      HOLD(4) = Z(3,3)
+      HOLD(5) = ASH
+      NCHAR = 0
+      IF (IOFFM .NE. 0) GO TO 115
+C +NOAO -  This label generation has been reworked to eliminate the large
+C          spaces in between fields of the label.
+C     IWORK = 'CONTOUR FROM              TO              CONTOUR INTERVAL
+C    1 OF              PT(3,3)=              LABELS SCALED BY'
+      string(1)(1:13) = 'CONTOUR FROM '
+      string(2)(1:4)  = ' TO '
+      string(3)(1:21) = '; CONTOUR INTERVAL = '
+      string(4)(1:11) = '; PT(3,3)= '
+      string(5)(1:19) = '; LABELS SCALED BY '
+C
+      DO 114 I=1,5
+C (NOAO) WRITE ( ENCSCR, '(G13.5)' ) HOLD(I)
+         call encd (hold(i), ash, encscr, nc, ioffd)
+         do 1113 k = 1, lngths(i)
+            nchar = nchar + 1
+ 1113    iwork(nchar:nchar) = string(i)(k:k)
+C
+C (NOAO) NCHAR = NCHAR+LNGTHS(I)
+C (NOAO) DO 113 J=1,13
+         do 113 j = 1, nc
+            NCHAR = NCHAR+1
+            IWORK(NCHAR:NCHAR) = ENCSCR(J:J)
+  113    CONTINUE
+  114 CONTINUE
+C
+C +NOAO IF (ASH .EQ. 1.) NCHAR = NCHAR-13-LNGTHS(5)
+         if (ash .eq. 1.) nchar = nchar - nc - lngths(5)
+C -NOAO
+C
+C SET TEXT INTENSITY TO LOW, AND WRITE TITLE USING NORMALIZATION
+C TRANS NUMBER 0
+C
+      CALL GSTXCI (IRECTX)
+      CALL GETUSV('LS',LSO)
+      CALL SETUSV('LS',1)
+      CALL GSELNT (0)
+C +NOAO - following text output centered on current viewport
+C     CALL WTSTR ( 0.5, 0.015625, IWORK(1:NCHAR), 0, 0, 0 )
+      CALL WTSTR ( ((x1+x2)/2.0), y1 - 0.03, IWORK(1:NCHAR), 0, 0, 0 )
+C -NOAO
+      CALL SETUSV('LS',LSO)
+      CALL GSELNT (1)
+C
+C
+C
+C                       * * * * * * * * * *
+C                            * * * * * * * * * *
+C
+C
+C PROCESS EACH LEVEL
+C
+  115 FPART = .5
+C
+      DO 123 I=1,NCL
+         CONTR = CL(I)
+         NDASH = IDASH
+         IF (NEGPOS.LT.0 .AND. CONTR.GE.0.) NDASH = ISOLID
+C
+C CHANGE 10 BIT PATTERN TO 10 CHARACTER PATTERN.
+C
+         DO 116 J=1,10
+            IBIT = IAND(ISHIFT(NDASH,(J-10)),1)
+            RCHAR = IGAP
+            IF (IBIT .NE. 0) RCHAR = ISOL
+            IWORK(J:J) = RCHAR
+  116    CONTINUE
+         IF (I .GT. NML) GO TO 121
+C
+C SET UP MAJOR LINE (LABELED)
+C
+C SET LINE INTENSITY TO HIGH
+C
+         CALL GSPLCI ( IRECMJ )
+C
+C NREP REPITITIONS OF PATTERN PER LABEL.
+C
+         NCHAR = 10
+         IF (NREP .LT. 2) GO TO 119
+         DO 118 J=1,10
+            NCHAR = J
+            RCHAR = IWORK(J:J)
+            DO 117 K=2,NREP
+               NCHAR = NCHAR+10
+               IWORK(NCHAR:NCHAR) = RCHAR
+  117       CONTINUE
+  118    CONTINUE
+  119    CONTINUE
+C
+C PUT IN LABEL.
+C
+         CALL ENCD (CONTR,ASH,ENCSCR,NCUSED,IOFFDT)
+         DO 120 J=1,NCUSED
+            NCHAR = NCHAR+1
+            IWORK(NCHAR:NCHAR) = ENCSCR(J:J)
+  120    CONTINUE
+         GO TO 122
+C
+C SET UP MINOR LINE (UNLABELED).
+C
+  121    CONTINUE
+C
+C SET LINE INTENSITY TO LOW
+C
+         CALL GSPLCI ( IRECMN )
+         NCHAR = 10
+  122    CALL DASHDC ( IWORK(1:NCHAR),NCRT, ISIZEL )
+C
+C
+C DRAW ALL LINES AT THIS LEVEL.
+C
+         CALL STLINE (Z,MX,NX,NY,CONTR)
+C
+C
+  123 CONTINUE
+C
+C FIND RELATIVE MINIMUMS AND MAXIMUMS IF WANTED, AND MARK VALUES IF
+C WANTED.
+C
+      IF (NHI .EQ. 0) CALL MINMAX (Z,MX,NX,NY,ISIZEM,ASH,IOFFDT)
+      IF (NHI .GT. 0) CALL MINMAX (Z,MX,NX,NY,ISIZEP,-ASH,IOFFDT)
+      FPART = 1.
+      GO TO 127
+  124 CONTINUE
+         IWORK = 'CONSTANT FIELD'
+C +NOAO 
+C     WRITE( ENCSCR, '(G22.14)' ) GL
+      i = gl
+      call encode (22, '(g22.14)', encscr, i)
+C -NOAO
+      DO 126 I=1,22
+         IWORK(I+14:I+14) = ENCSCR(I:I)
+  126 CONTINUE
+C
+C WRITE TITLE USING NORMALIZATION TRNS 0
+C
+      CALL GETUSV('LS',LSO)
+      CALL SETUSV('LS',1)
+      CALL GSELNT (0)
+C +NOAO
+C     CALL WTSTR ( 0.09765, 0.48825, IWORK(1:36), 3, 0, -1 )
+      CALL WTSTR ( x1+0.03, (y1+y2)/2.0, IWORK(1:36), 3, 0, -1 )
+C -NOAO
+C
+C RESTORE NORMALIZATION TRANS 1, LINE AND TEXT INTENSITY TO ORIGINAL
+C
+  127 IF (NSET.LE.0) THEN
+          CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -             WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      END IF
+      CALL GSPLCI ( IPLCI )
+      CALL GSTXCI ( ITXCI )
+C
+C SELECT ORIGINAL NORMALIZATION TRANS NUMBER NTORIG, AND RESTORE ASF
+C
+      CALL GSELNT ( NTORIG )
+      LASF(3)  = LSV3
+      LASF(10) = LSV10
+      CALL GSASF ( LASF )
+C
+      RETURN
+C
+C
+      END
+      SUBROUTINE CLGEN (Z,MX,NX,NNY,CCLO,CHI,CINC,NLA,NLM,CL,NCL,ICNST)
+      SAVE
+      DIMENSION       CL(NLM)    ,Z(MX,NNY)
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+C
+C CLGEN PUTS THE VALUES OF THE CONTOUR LEVELS IN CL.
+C VARIABLE NAMES MATCH THOSE IN CONREC, WITH THE FOLLOWING ADDITIONS.
+C         NCL     -NUMBER OF CONTOUR LEVELS PUT IN CL.
+C         ICNST   -FLAG TO TELL CONREC IF A CONSTANT FIELD WAS DETECTED.
+C                 .ICNST=0 MEANS NON-CONSTANT FIELD.
+C                 .ICNST NON-ZERO MEANS CONSTANT FIELD.
+C
+C TO PRODUCE NON-UNIFORM CONTOUR LEVEL SPACING, REPLACE THE CODE IN THIS
+C SUBROUTINE WITH CODE TO PRODUCE WHATEVER SPACING IS DESIRED.
+C
+      ICNST = 0
+      NY = NNY
+      CLO = CCLO
+      GLO = CLO
+      HA = CHI
+      FANC = CINC
+      CRAT = NLA
+      IF (HA-GLO) 101,102,111
+  101 GLO = HA
+      HA = CLO
+      GO TO 111
+  102 IF (GLO .NE. 0.) GO TO 120
+      GLO = Z(1,1)
+      HA = Z(1,1)
+      IF (IOFFP .EQ. 0) GO TO 107
+      DO 106 J=1,NY
+         DO 105 I=1,NX
+            IF (Z(I,J) .EQ. SPVAL) GO TO 105
+            GLO = Z(I,J)
+            HA = Z(I,J)
+            DO 104 JJ=J,NY
+               DO 103 II=1,NX
+                  IF (Z(II,JJ) .EQ. SPVAL) GO TO 103
+                  GLO = AMIN1(Z(II,JJ),GLO)
+                  HA = AMAX1(Z(II,JJ),HA)
+  103          CONTINUE
+  104       CONTINUE
+            GO TO 110
+  105    CONTINUE
+  106 CONTINUE
+      GO TO 110
+  107 DO 109 J=1,NY
+         DO 108 I=1,NX
+            GLO = AMIN1(Z(I,J),GLO)
+            HA = AMAX1(Z(I,J),HA)
+  108    CONTINUE
+  109 CONTINUE
+  110 IF (GLO .GE. HA) GO TO 119
+  111 IF (FANC) 112,113,114
+  112 CRAT = AMAX1(1.,-FANC)
+  113 FANC = (HA-GLO)/CRAT
+      P = 10.**(IFIX(ALOG10(FANC)+5000.)-5000)
+      FANC = AINT(FANC/P)*P
+  114 IF (CHI-CLO) 116,115,116
+  115 GLO = AINT(GLO/FANC)*FANC
+      HA = AINT(HA/FANC)*FANC*(1.+SIGN(1.E-6,HA))
+  116 DO 117 K=1,NLM
+         CC = GLO+FLOAT(K-1)*FANC
+         IF (CC .GT. HA) GO TO 118
+         KK = K
+         CL(K) = CC
+  117 CONTINUE
+  118 NCL = KK
+      CCLO = CL(1)
+      CHI = CL(NCL)
+      CINC = FANC
+      RETURN
+  119 ICNST = 1
+      NCL = 1
+      CCLO = GLO
+      RETURN
+  120 CL(1) = GLO
+      NCL = 1
+      RETURN
+      END
+      SUBROUTINE DRLINE (Z,L,MM,NN)
+      SAVE
+      DIMENSION       Z(L,NN)
+C
+C THIS ROUTINE TRACES A CONTOUR LINE WHEN GIVEN THE BEGINNING BY STLINE.
+C TRANSFORMATIONS CAN BE ADDED BY DELETING THE STATEMENT FUNCTIONS FOR
+C FX AND FY IN DRLINE AND MINMAX AND ADDING EXTERNAL FUNCTIONS.
+C X=1. AT Z(1,J), X=FLOAT(M) AT Z(M,J). X TAKES ON NON-INTEGER VALUES.
+C Y=1. AT Z(I,1), Y=FLOAT(N) AT Z(I,N). Y TAKES ON NON-INTEGER VALUES.
+C
+      COMMON /CONRE2/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(80000)  ,NR
+c + noao:  dimension of ir array in conre2 changed from 500 to 20000 6March87
+c + noao:  dimension of ir array in conre2 changed from 20000 to 80000 6-93
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+      COMMON /CONRE3/ IXBITS     ,IYBITS
+      LOGICAL         IPEN       ,IPENO
+      DATA IPEN,IPENO/.TRUE.,.TRUE./
+C
+      FX(X,Y) = X
+      FY(X,Y) = Y
+      IXYPAK(IXX,IYY) = ISHIFT(IXX,IYBITS)+IYY
+      C(P1,P2) = (P1-CV)/(P1-P2)
+C
+      M = MM
+      N = NN
+      IF (IOFFP .EQ. 0) GO TO 101
+      ASSIGN 110 TO JUMP1
+      ASSIGN 115 TO JUMP2
+      GO TO 102
+  101 ASSIGN 112 TO JUMP1
+      ASSIGN 117 TO JUMP2
+  102 IX0 = IX
+      IY0 = IY
+      IS0 = IS
+      IF (IOFFP .EQ. 0) GO TO 103
+      IX2 = IX+INX(IS)
+      IY2 = IY+INY(IS)
+      IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL
+      IPENO = IPEN
+  103 IF (IDX .EQ. 0) GO TO 104
+      Y = IY
+      ISUB = IX+IDX
+      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
+      GO TO 105
+  104 X = IX
+      ISUB = IY+IDY
+      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
+  105 CALL FRSTD (FX(X,Y),FY(X,Y))
+  106 IS = IS+1
+      IF (IS .GT. 8) IS = IS-8
+      IDX = INX(IS)
+      IDY = INY(IS)
+      IX2 = IX+IDX
+      IY2 = IY+IDY
+      IF (ISS .NE. 0) GO TO 107
+      IF (IX2.GT.M .OR. IY2.GT.N .OR. IX2.LT.1 .OR. IY2.LT.1) GO TO 120
+  107 IF (CV-Z(IX2,IY2)) 108,108,109
+  108 IS = IS+4
+      IX = IX2
+      IY = IY2
+      GO TO 106
+  109 IF (IS/2*2 .EQ. IS) GO TO 106
+      GO TO JUMP1,(110,112)
+  110 ISBIG = IS+(8-IS)/6*8
+      IX3 = IX+INX(ISBIG-1)
+      IY3 = IY+INY(ISBIG-1)
+      IX4 = IX+INX(ISBIG-2)
+      IY4 = IY+INY(ISBIG-2)
+      IPENO = IPEN
+      IF (ISS .NE. 0) GO TO 111
+      IF (IX3.GT.M .OR. IY3.GT.N .OR. IX3.LT.1 .OR. IY3.LT.1) GO TO 120
+      IF (IX4.GT.M .OR. IY4.GT.N .OR. IX4.LT.1 .OR. IY4.LT.1) GO TO 120
+  111 IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL .AND.
+     1       Z(IX3,IY3).NE.SPVAL .AND. Z(IX4,IY4).NE.SPVAL
+  112 IF (IDX .EQ. 0) GO TO 113
+      Y = IY
+      ISUB = IX+IDX
+      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
+      GO TO 114
+  113 X = IX
+      ISUB = IY+IDY
+      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
+  114 GO TO JUMP2,(115,117)
+  115 IF (.NOT.IPEN) GO TO 118
+      IF (IPENO) GO TO 116
+C
+C END OF LINE SEGMENT
+C
+      CALL LASTD
+      CALL FRSTD (FX(XOLD,YOLD),FY(XOLD,YOLD))
+C
+C CONTINUE LINE SEGMENT
+C
+  116 CONTINUE
+  117 CALL VECTD (FX(X,Y),FY(X,Y))
+  118 XOLD = X
+      YOLD = Y
+      IF (IS .NE. 1) GO TO 119
+      NP = NP+1
+      IF (NP .GT. NR) GO TO 120
+      IR(NP) = IXYPAK(IX,IY)
+  119 IF (ISS .EQ. 0) GO TO 106
+      IF (IX.NE.IX0 .OR. IY.NE.IY0 .OR. IS.NE.IS0) GO TO 106
+C
+C END OF LINE
+C
+  120 CALL LASTD
+      RETURN
+      END
+      SUBROUTINE MINMAX (Z,L,MM,NN,ISSIZM,AASH,JOFFDT)
+C
+C THIS ROUTINE FINDS RELATIVE MINIMUMS AND MAXIMUMS.  A RELATIVE MINIMUM
+C (OR MAXIMUM) IS DEFINED TO BE THE LOWEST (OR HIGHEST) POINT WITHIN
+C A CERTAIN NEIGHBORHOOD OF THE POINT.  THE NEIGHBORHOOD USED HERE
+C IS + OR - MN IN THE X DIRECTION AND + OR - NM IN THE Y DIRECTION.
+C
+C ORIGINATOR       DAVID KENNISON
+C
+      SAVE
+      CHARACTER*6     IA
+      DIMENSION       Z(L,NN)
+C
+C
+C
+      COMMON /CONRE1/ IOFFP      ,SPVAL
+      COMMON /CONRE5/ SCLY
+C
+      FX(X,Y) = X
+      FY(X,Y) = Y
+C
+      M = MM
+      N = NN
+C
+C SET UP SCALING FOR LABELS
+C
+      SIZEM = (ISSIZM + 1)*256*SCLY
+      ISIZEM = ISSIZM
+C
+      ASH = ABS(AASH)
+      IOFFDT = JOFFDT
+C
+      IF (AASH .LT. 0.0) GO TO 128
+C
+      MN = MIN0(15,MAX0(2,IFIX(FLOAT(M)/8.)))
+      NM = MIN0(15,MAX0(2,IFIX(FLOAT(N)/8.)))
+      NM1 = N-1
+      MM1 = M-1
+C
+C LINE LOOP FOLLOWS - THE COMPLETE TWO-DIMENSIONAL TEST FOR A MINIMUM OR
+C MAXIMUM OF THE FIELD IS ONLY PERFORMED FOR POINTS WHICH ARE MINIMA OR
+C MAXIMA ALONG SOME LINE - FINDING THESE CANDIDATES IS MADE EFFICIENT BY
+C USING A COUNT OF CONSECUTIVE INCREASES OR DECREASES OF THE FUNCTION
+C ALONG THE LINE
+C
+      DO 127 JP=2,NM1
+C
+         IM = MN-1
+         IP = -1
+         GO TO 126
+C
+C CONTROL RETURNS TO STATEMENT 10 AS LONG AS THE FUNCTION IS INCREASING
+C ALONG THE LINE - WE SEEK A POSSIBLE MAXIMUM
+C
+  101    IP = IP+1
+         AA = AN
+         IF (IP .EQ. MM1) GO TO 104
+         AN = Z(IP+1,JP)
+         IF (IOFFP.NE.0 .AND. AN.EQ.SPVAL) GO TO 125
+         IF (AA-AN) 102,103,104
+  102    IM = IM+1
+         GO TO 101
+  103    IM = 0
+         GO TO 101
+C
+C FUNCTION DECREASED - TEST FOR MAXIMUM ON LINE
+C
+  104    IF (IM .GE. MN) GO TO 106
+         IS = MAX0(1,IP-MN)
+         IT = IP-IM-1
+         IF (IS .GT. IT) GO TO 106
+         DO 105 II=IS,IT
+            IF (AA .LE. Z(II,JP)) GO TO 112
+  105    CONTINUE
+  106    IS = IP+2
+         IT = MIN0(M,IP+MN)
+         IF (IS .GT. IT) GO TO 109
+         DO 108 II=IS,IT
+            IF (IOFFP.EQ.0 .OR. Z(II,JP).NE.SPVAL) GO TO 107
+            IP = II-1
+            GO TO 125
+  107       IF (AA .LE. Z(II,JP)) GO TO 112
+  108    CONTINUE
+C
+C WE HAVE MAXIMUM ON LINE - DO TWO-DIMENSIONAL TEST FOR MAXIMUM OF FIELD
+C
+  109    JS = MAX0(1,JP-NM)
+         JT = MIN0(N,JP+NM)
+         IS = MAX0(1,IP-MN)
+         IT = MIN0(M,IP+MN)
+         DO 111 JK=JS,JT
+            IF (JK .EQ. JP) GO TO 111
+            DO 110 IK=IS,IT
+               IF (Z(IK,JK).GE.AA .OR.
+     1             (IOFFP.NE.0 .AND. Z(IK,JK).EQ.SPVAL)) GO TO 112
+  110       CONTINUE
+  111    CONTINUE
+C
+         X = FLOAT(IP)
+         Y = FLOAT(JP)
+         CALL WTSTR ( FX(X,Y),FY(X,Y),'H',ISIZEM,0,0 )
+         CALL FL2INT ( FX(X,Y),FY(X,Y),IFX,IFY )
+C
+C SCALE TO USER SET RESOLUTION
+C
+         IFY = IFY*SCLY
+         CALL ENCD (AA,ASH,IA,NC,IOFFDT)
+         MY = IFY - SIZEM
+         TMY = CPUY ( MY )
+         CALL WTSTR ( FX(X,Y),TMY,IA(1:NC),ISIZEM,0,0 )
+  112    IM = 1
+         IF (IP-MM1) 113,127,127
+C
+C CONTROL RETURNS TO STATEMENT 20 AS LONG AS THE FUNCTION IS DECREASING
+C ALONG THE LINE - WE SEEK A POSSIBLE MINIMUM
+C
+  113    IP = IP+1
+         AA = AN
+         IF (IP .EQ. MM1) GO TO 116
+         AN = Z(IP+1,JP)
+         IF (IOFFP.NE.0 .AND. AN.EQ.SPVAL) GO TO 125
+         IF (AA-AN) 116,115,114
+  114    IM = IM+1
+         GO TO 113
+  115    IM = 0
+         GO TO 113
+C
+C FUNCTION INCREASED - TEST FOR MINIMUM ON LINE
+C
+  116    IF (IM .GE. MN) GO TO 118
+         IS = MAX0(1,IP-MN)
+         IT = IP-IM-1
+         IF (IS .GT. IT) GO TO 118
+         DO 117 II=IS,IT
+            IF (AA .GE. Z(II,JP)) GO TO 124
+  117    CONTINUE
+  118    IS = IP+2
+         IT = MIN0(M,IP+MN)
+         IF (IS .GT. IT) GO TO 121
+         DO 120 II=IS,IT
+            IF (IOFFP.EQ.0 .OR. Z(II,JP).NE.SPVAL) GO TO 119
+            IP = II-1
+            GO TO 125
+  119       IF (AA .GE. Z(II,JP)) GO TO 124
+  120    CONTINUE
+C
+C WE HAVE MINIMUM ON LINE - DO TWO-DIMENSIONAL TEST FOR MINIMUM OF FIELD
+C
+  121    JS = MAX0(1,JP-NM)
+         JT = MIN0(N,JP+NM)
+         IS = MAX0(1,IP-MN)
+         IT = MIN0(M,IP+MN)
+         DO 123 JK=JS,JT
+            IF (JK .EQ. JP) GO TO 123
+            DO 122 IK=IS,IT
+               IF (Z(IK,JK).LE.AA .OR.
+     1             (IOFFP.NE.0 .AND. Z(IK,JK).EQ.SPVAL)) GO TO 124
+  122       CONTINUE
+  123    CONTINUE
+C
+         X = FLOAT(IP)
+         Y = FLOAT(JP)
+         CALL WTSTR ( FX(X,Y),FY(X,Y),'L',ISIZEM,0,0 )
+         CALL FL2INT( FX(X,Y),FY(X,Y),IFX,IFY )
+         IFY = SCLY*IFY
+         CALL ENCD (AA,ASH,IA,NC,IOFFDT)
+         MY = IFY - SIZEM
+         TMY = CPUY ( MY )
+         CALL WTSTR ( FX(X,Y),TMY,IA(1:NC),ISIZEM,0,0 )
+  124    IM = 1
+         IF (IP-MM1) 101,127,127
+C
+C SKIP SPECIAL VALUES ON LINE
+C
+  125    IM = 0
+  126    IP = IP+1
+         IF (IP .GE. MM1) GO TO 127
+         IF (IOFFP.NE.0 .AND. Z(IP+1,JP).EQ.SPVAL) GO TO 125
+         IM = IM+1
+         IF (IM .LE. MN) GO TO 126
+         IM = 1
+         AN = Z(IP+1,JP)
+         IF (Z(IP,JP)-AN) 101,103,113
+C
+  127 CONTINUE
+C
+      RETURN
+C
+C ****************************** ENTRY PNTVAL **************************
+C     ENTRY PNTVAL (Z,L,MM,NN,ISSIZM,AASH,JOFFDT)
+C
+  128 CONTINUE
+      II = (M-1+24)/24
+      JJ = (N-1+48)/48
+      NIQ = 1
+      NJQ = 1
+      DO 130 J=NJQ,N,JJ
+         Y = J
+         DO 129 I=NIQ,M,II
+            X = I
+            ZZ = Z(I,J)
+            IF (IOFFP.NE.0 .AND. ZZ.EQ.SPVAL) GO TO 129
+            CALL ENCD (ZZ,ASH,IA,NC,IOFFDT)
+            CALL WTSTR (FX(X,Y),FY(X,Y),IA(1:NC),ISIZEM,0,0 )
+  129    CONTINUE
+  130 CONTINUE
+      RETURN
+      END
+      SUBROUTINE REORD (CL,NCL,C1,MARK,NMG)
+      SAVE
+      DIMENSION       CL(NCL)    ,C1(NCL)
+C
+C THIS ROUTINE PUTS THE MAJOR (LABELED) LEVELS IN THE BEGINNING OF CL
+C AND THE MINOR (UNLABELED) LEVELS IN END OF CL.  THE NUMBER OF MAJOR
+C LEVELS IS RETURNED IN MARK.  C1 IS USED AS A WORK SPACE.  NMG IS THE
+C NUMBER OF MINOR GAPS (ONE MORE THAN THE NUMBER OF MINOR LEVELS BETWEEN
+C MAJOR LEVELS).
+C
+      NL = NCL
+      IF (NL.LE.4 .OR. NMG.LE.1) GO TO 113
+      NML = NMG-1
+      IF (NL .LE. 10) NML = 1
+C
+C CHECK FOR ZERO OR OTHER NICE NUMBER FOR A MAJOR LINE
+C
+      NMLP1 = NML+1
+      DO 101 I=1,NL
+         ISAVE = I
+         IF (CL(I) .EQ. 0.) GO TO 104
+  101 CONTINUE
+      L = NL/2
+      L = ALOG10(ABS(CL(L)))+1.
+      Q = 10.**L
+      DO 103 J=1,3
+         Q = Q/10.
+         DO 102 I=1,NL
+            ISAVE = I
+            IF (AMOD(ABS(CL(I)+1.E-9*CL(I))/Q,FLOAT(NMLP1)) .LE. .0001)
+     1          GO TO 104
+  102    CONTINUE
+  103 CONTINUE
+      ISAVE = NL/2
+C
+C PUT MAJOR LEVELS IN C1
+C
+  104 ISTART = MOD(ISAVE,NMLP1)
+      IF (ISTART .EQ. 0) ISTART = NMLP1
+      NMAJL = 0
+      DO 105 I=ISTART,NL,NMLP1
+         NMAJL = NMAJL+1
+         C1(NMAJL) = CL(I)
+  105 CONTINUE
+      MARK = NMAJL
+      L = NMAJL
+C
+C PUT MINOR LEVELS IN C1
+C
+      IF (ISTART .EQ. 1) GO TO 107
+      DO 106 I=2,ISTART
+         ISUB = L+I-1
+         C1(ISUB) = CL(I-1)
+  106 CONTINUE
+  107 L = NMAJL+ISTART-1
+      DO 109 I=2,NMAJL
+         DO 108 J=1,NML
+            L = L+1
+            ISUB = ISTART+(I-2)*NMLP1+J
+            C1(L) = CL(ISUB)
+  108    CONTINUE
+  109 CONTINUE
+      NLML = NL-L
+      IF (L .EQ. NL) GO TO 111
+      DO 110 I=1,NLML
+         L = L+1
+         C1(L) = CL(L)
+  110 CONTINUE
+C
+C PUT REORDERED ARRAY BACK IN ORIGINAL PLACE
+C
+  111 DO 112 I=1,NL
+         CL(I) = C1(I)
+  112 CONTINUE
+      RETURN
+  113 MARK = NL
+      RETURN
+      END
+      SUBROUTINE STLINE (Z,LL,MM,NN,CONV)
+      SAVE
+      DIMENSION       Z(LL,NN)
+C
+C THIS ROUTINE FINDS THE BEGINNINGS OF ALL CONTOUR LINES AT LEVEL CONV.
+C FIRST THE EDGES ARE SEARCHED FOR LINES INTERSECTING THE EDGE (OPEN
+C LINES) THEN THE INTERIOR IS SEARCHED FOR LINES WHICH DO NOT INTERSECT
+C THE EDGE (CLOSED LINES).  BEGINNINGS ARE STORED IN IR TO PREVENT RE-
+C TRACING OF LINES.  IF IR IS FILLED, THE SEARCH IS STOPPED FOR THIS
+C CONV.
+C
+      COMMON /CONRE2/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(80000)  ,NR
+c + noao:  dimension of ir array in conre2 changed from 500 to 20000 6March87
+c + noao:  dimension of ir array in conre2 changed from 20000 to 80000 6-93
+      COMMON /CONRE3/ IXBITS     ,IYBITS
+C
+C
+C
+C
+C
+C
+      IXYPAK(IXX,IYY) = ISHIFT(IXX,IYBITS)+IYY
+C
+      L = LL
+      M = MM
+      N = NN
+      CV = CONV
+      NP = 0
+      ISS = 0
+      DO 102 IP1=2,M
+         I = IP1-1
+         IF (Z(I,1).GE.CV .OR. Z(IP1,1).LT.CV) GO TO 101
+         IX = IP1
+         IY = 1
+         IDX = -1
+         IDY = 0
+         IS = 1
+         CALL DRLINE (Z,L,M,N)
+  101    IF (Z(IP1,N).GE.CV .OR. Z(I,N).LT.CV) GO TO 102
+         IX = I
+         IY = N
+         IDX = 1
+         IDY = 0
+         IS = 5
+         CALL DRLINE (Z,L,M,N)
+  102 CONTINUE
+      DO 104 JP1=2,N
+         J = JP1-1
+         IF (Z(M,J).GE.CV .OR. Z(M,JP1).LT.CV) GO TO 103
+         IX = M
+         IY = JP1
+         IDX = 0
+         IDY = -1
+         IS = 7
+         CALL DRLINE (Z,L,M,N)
+  103    IF (Z(1,JP1).GE.CV .OR. Z(1,J).LT.CV) GO TO 104
+         IX = 1
+         IY = J
+         IDX = 0
+         IDY = 1
+         IS = 3
+         CALL DRLINE (Z,L,M,N)
+  104 CONTINUE
+      ISS = 1
+      DO 108 JP1=3,N
+         J = JP1-1
+         DO 107 IP1=2,M
+            I = IP1-1
+            IF (Z(I,J).GE.CV .OR. Z(IP1,J).LT.CV) GO TO 107
+            IXY = IXYPAK(IP1,J)
+            IF (NP .EQ. 0) GO TO 106
+            DO 105 K=1,NP
+               IF (IR(K) .EQ. IXY) GO TO 107
+  105       CONTINUE
+  106       NP = NP+1
+            IF (NP .GT. NR) THEN
+C
+C THIS PRINTS AN ERROR MESSAGE IF THE LOCAL ARRAY IR IN SUBROUTINE
+C STLINE HAS AN OVERFLOW
+C THIS MESSAGE IS WRITTEN BOTH ON THE FRAME AND ON THE STANDARD ERROR
+C UNIT
+C
+C +NOAO - Message is written only to stderr, not to the plotting frame.
+C         Error is written with uliber, not FTN write statement.
+C
+      call uliber (1, 'STLINE (CONREC) - WORK ARRAY OVERFLOW', 80)
+      call uliber (1,'STLINE - ***WARNING -- PICTURE INCOMPLETE***',80)
+C     IUNIT = I1MACH(4)
+C     WRITE(IUNIT,1000)
+C1000 FORMAT(
+C    1' WARNING FROM ROUTINE STLINE IN CONREC--WORK ARRAY OVERFLOW')
+C     CALL GETSET(VXA,VXB,VYA,VYB,XA,XB,YA,YB,LTYPE)
+C     Y = (YB - YA) / 2.
+C     X = (XB - XA) / 2.
+C     CALL PWRIT(X,Y,
+C    1'**WARNING--PICTURE INCOMPLETE**',
+C    2 31,3,0,0)
+C     Y = Y * .7
+C     CALL PWRIT(X,Y,
+C    1'WORK ARRAY OVERFLOW IN STLINE',
+C    2 29,3,0,0)
+C -NOAO
+        RETURN
+        ENDIF
+            IR(NP) = IXY
+            IX = IP1
+            IY = J
+            IDX = -1
+            IDY = 0
+            IS = 1
+            CALL DRLINE (Z,L,M,N)
+  107    CONTINUE
+  108 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CALCNT (Z,M,N,A1,A2,A3,I1,I2,I3)
+C
+C THIS ENTRY POINT IS FOR USERS WHO ARE TOO LAZY TO SWITCH OLD DECKS
+C TO THE NEW CALLING SEQUENCE.
+C
+      DIMENSION       Z(M,N)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','CONREC','CALCNT','VERSION 01')
+C
+      CALL CONREC (Z,M,M,N,A1,A2,A3,I1,I2,-IABS(I3))
+      RETURN
+      END
+      SUBROUTINE EZCNTR (Z,M,N)
+C
+C CONTOURING VIA SHORTEST POSSIBLE ARGUMENT LIST
+C ASSUMPTIONS --
+C     ALL OF THE ARRAY IS TO BE CONTOURED,
+C     CONTOUR LEVELS ARE PICKED INTERNALLY,
+C     CONTOURING ROUTINE PICKS SCALE FACTORS,
+C     HIGHS AND LOWS ARE MARKED,
+C     NEGATIVE LINES ARE DRAWN WITH A DASHED LINE PATTERN,
+C     EZCNTR CALLS FRAME AFTER DRAWING THE CONTOUR MAP.
+C IF THESE ASSUMPTIONS ARE NOT MET, USE CONREC.
+C
+C ARGUMENTS
+C     Z   ARRAY TO BE CONTOURED
+C     M   FIRST DIMENSION OF Z
+C     N   SECOND DIMENSION OF Z
+C
+      SAVE
+      DIMENSION       Z(M,N)
+      DATA NSET,NHI,NDASH/0,0,682/
+C
+C                             682=1252B
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','CONREC','EZCNTR','VERSION 01')
+C
+      CALL CONREC (Z,M,M,N,0.,0.,0.,NSET,NHI,-NDASH)
+C +NOAO - EZCNTR no longer calls frame.
+C     CALL FRAME
+C -NOAO
+      RETURN
+      END
+C
+C REVISION HISTORY---
+C
+C JANUARY 1980     ADDED REVISION HISTORY AND CHANGED LIBRARY NAME
+C                  FROM CRAYLIB TO PORTLIB FOR MOVE TO PORTLIB
+C
+C MAY 1980         ARRAYS IWORK AND ENCSCR, PREVIOUSLY TOO SHORT FOR
+C                  SHORT-WORD-LENGTH MACHINES, LENGTHENED.  SOME
+C                  DOCUMENTATION CLARIFIED AND CORRECTED.
+C
+C JUNE 1984        CONVERTED TO FORTRAN 77 AND TO GKS
+C
+C JUNE 1985        ERROR HANDLING LINES ADDED; IF OVERFLOW HAPPENS TO
+C                  WORK ARRAY IN STLINE, A WARNING MESSAGE IS WRITTEN
+C                  BOTH ON PLOT FRAME AND ON STANDARD ERROR MESSAGE.
+C-------------------------------------------------------------------
+C
diff --git a/sys/gio/ncarutil/dashbd.f b/sys/gio/ncarutil/dashbd.f
new file mode 100644
index 00000000..cf499bc2
--- /dev/null
+++ b/sys/gio/ncarutil/dashbd.f
@@ -0,0 +1,143 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data changed to run time initialization. Logical param
+c "first" added, so initialization doesn't occur more than once.
+c     BLOCKDATA DASHBD
+        subroutine dashbd
+C
+C DASHBD IS USED TO INITIALIZE VARIABLES IN NAMED COMMON.
+C
+        logical first
+c
+      COMMON /DASHD1/  ISL,  L,  ISIZE,  IP(100),  NWDSM1,  IPFLAG(100)
+     1                 ,MNCSTR, IGP
+C
+      COMMON /FDFLAG/ IFLAG
+C
+      COMMON /DDFLAG/ IFCFLG
+C
+      COMMON /DCFLAG/ IFSTFL
+C
+      COMMON /DFFLAG/ IFSTF2
+C
+      COMMON /CFFLAG/ IVCTFG
+C
+      COMMON /DSAVE3/ IXSTOR,IYSTOR
+C
+      COMMON /DSAVE5/ XSAVE(70), YSAVE(70), XSVN, YSVN, XSV1, YSV1,
+     1                SLP1, SLPN, SSLP1, SSLPN, N, NSEG
+C
+      COMMON /SMFLAG/ IOFFS
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+C
+        SAVE
+        data first /.true./
+        if (.not. first) return
+        first = .false.
+            
+C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED (IN CFVLD)
+C WHENEVER DASHDB OR DASHDC HAS BEEN CALLED.
+C
+c     DATA IFSTFL /1/
+      IFSTFL  = 1
+C
+C IVCTFG INDICATES IF VECTD IS BEING CALLED OR LASTD (IN CFVLD)
+C
+c     DATA IVCTFG /1/
+      IVCTFG = 1
+C
+C ISL IS A FLAG FOR AN ALL SOLID PATTERN (+1) OR AN ALL GAP PATTERN (-1)
+C
+c     DATA ISL /1/
+      ISL = 1
+C
+C IGP IS AN INTERNAL PARAMETER. IT IS DESCRIBED IN THE DOCUMENTATION
+C TO THE DASHED LINE PACKAGE.
+C
+c     DATA IGP /9/
+      IGP = 9
+C
+C MNCSTR IS THE MAXIMUM NUMBER OF CHARACTERS ALLOWED IN A HOLLERITH
+C STRING PASSED TO DASHDC.
+C
+c     DATA MNCSTR /15/
+      MNCSTR = 15
+C
+C IOFFS IS AN INTERNAL PARAMETER.
+C IOFFS IS USED IN FDVDLD AND DRAWPV.
+C
+c     DATA IOFFS /0/
+      IOFFS = 0
+C
+C  INTERNAL PARAMETERS
+C
+c     DATA IPAU/3/
+      IPAU = 3
+c     DATA FPART/1./
+      FPART = 1.
+c     DATA TENSN/2.5/
+      TENSN = 2.5
+c     DATA NP/150/
+      NP = 150
+c     DATA SMALL/128./
+      SMALL = 128.
+c     DATA L1/70/
+      L1 = 70
+c     DATA ADDLR/2./
+      ADDLR = 2.
+c     DATA ADDTB/2./
+      ADDTB = 2.
+c     DATA MLLINE/384/
+      MLLINE = 384
+c     DATA ICLOSE/6/
+      ICLOSE = 6
+C
+C IFSTF2 IS A FLAG TO CONTROL THAT FRSTD IS CALLED BEFORE VECTD IS
+C CALLED (IN SUBROUTINE FDVDLD), WHENEVER DASHDB OR DASHDC
+C HAS BEEN CALLED.
+C
+c     DATA IFSTF2 /1/
+      IFSTF2  = 1
+C
+C IFLAG CONTROLS IF LASTD CAN BE CALLED DIRECTLY OR IF IT WAS JUST
+C CALLED FROM BY VECTD SO THAT THIS CALL CAN BE IGNORED.
+C
+c     DATA IFLAG /1/
+      IFLAG = 1
+C
+C IFCFLG IS THE FIRST CALL FLAG FOR SUBROUTINES DASHDB AND DASHDC.
+C  1 = FIRST CALL TO DASHDB OR DASHDC.
+C  2 = DASHDB OR DASHDC HAS BEEN CALLED BEFORE.
+C
+c     DATA IFCFLG /1/
+      IFCFLG = 1
+C
+C IXSTOR AND IYSTOR CONTAIN THE CURRENT PEN POSITION. THEY ARE
+C INITIALIZED TO AN IMPOSSIBLE VALUE.
+C
+c     DATA IXSTOR,IYSTOR /-9999,-9999/
+      IXSTOR = -9999 
+      IYSTOR = -9999
+C
+C SLP1 AND SLPN ARE INITIALIZED TO AVOID THAT THEY ARE PASSED AS ACTUAL
+C PARAMETERS FROM FDVDLD TO KURV1S WITHOUT BEING DEFINED.
+C
+c     DATA SLP1,SLPN /-9999.,-9999./
+      SLP1 = -9999. 
+      SLPN = -9999.
+c -noao
+C
+      END
diff --git a/sys/gio/ncarutil/dashsmth.f b/sys/gio/ncarutil/dashsmth.f
new file mode 100644
index 00000000..2fe25185
--- /dev/null
+++ b/sys/gio/ncarutil/dashsmth.f
@@ -0,0 +1,1224 @@
+      SUBROUTINE FDVDLD (IENTRY,IIX,IIY)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C SOFTWARE DASHED LINE PACKAGE WITH CHARACTER CAPABILITY AND SMOOTHING
+C
+C LATEST REVISION        JUNE 1984
+C
+C PURPOSE                DASHSMTH IS A SOFTWARE DASHED LINE PACKAGE WITH
+C                        SMOOTHING CAPABILITIES.  DASHSMTH IS DASHCHAR
+C                        WITH SMOOTHING FEATURES ADDED.
+C
+C USAGE                  FIRST, EITHER
+C                             CALL DASHDB (IPAT)
+C                        WHERE IPAT IS A 16-BIT DASH PATTERN AS
+C                        DESCRIBED IN THE SUBROUTINE DASHDB (SEE
+C                        DASHLINE DOCUMENTATION), OR
+C                             CALL DASHDC (IPAT,JCRT,JSIZE)
+C                        AS DESCRIBED BELOW.
+C
+C                        THEN, CALL ANY OF THE FOLLOWING:
+C                             CALL CURVED (X,Y,N)
+C                             CALL FRSTD (X,Y)
+C                             CALL VECTD (X,Y)
+C                             CALL LASTD
+C
+C                        LASTD IS CALLED ONLY AFTER THE LAST
+C                        POINT OF A LINE HAS BEEN PROCESSED IN VECTD.
+C
+C                        THE FOLLOWING MAY ALSO BE CALLED, BUT NO
+C                        SMOOTHING WILL RESULT:
+C                             CALL LINED (XA,YA,XB,YB)
+C
+C
+C ARGUMENTS              IPAT
+C ON INPUT                 A CHARACTER STRING OF ARBITRARY LENGTH
+C TO DASHDC                (60 CHARACTERS SEEMS TO BE A PRACTICAL
+C                          LIMIT) WHICH SPECIFIES THE DASH PATTERN
+C                          TO BE USED.  A DOLLAR SIGN IN IPAT
+C                          INDICATES SOLID; AN APOSTROPHE INDICATES
+C                          A GAP; BLANKS ARE IGNORED.  ANY CHARACTER
+C                          IN IPAT WHICH IS NOT A DOLLAR SIGN,
+C                          APOSTROPHE, OR BLANK IS CONSIDERED TO BE
+C                          PART OF A LINE LABEL.  EACH LINE LABEL
+C                          CAN BE AT MOST 15 CHARACTERS IN LENGTH.
+C                          SUFFICIENT WHITE SPACE IS RESERVED IN THE
+C                          DASHED LINE FOR WRITING LINE LABELS.
+C
+C                        JCRT
+C                          THE LENGTH IN PLOTTER ADDRESS UNITS PER
+C                          $ OR APOSTROPHE.
+C
+C                        JSIZE
+C                          IS THE SIZE OF THE PLOTTED CHARACTERS:
+C                          . IF BETWEEN 0 AND 3 , IT IS 1., 1.5, 2.
+C                            AND 3. TIMES AN 8 PLOTTER ADDRESS UNIT
+C                            WIDTH.
+C                          . IF GREATER THAN 3, IT IS THE CHARACTER
+C                            WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C
+C ARGUMENTS TO           CURVED(X,Y,N)
+C OTHER LINE-DRAWING       X AND Y ARE ARRAYS OF WORLD COORDINATE VALUES
+C ROUTINES                 OF LENGTH N OR GREATER.  LINE SEGMENTS OBEYING
+C                          THE SPECIFIED DASH PATTERN ARE DRAWN TO
+C                          CONNECT THE N POINTS.
+C
+C                        FRSTD(X,Y)
+C                          THE CURRENT PEN POSITION IS SET TO
+C                          THE WORLD COORDINATE VALUE (X,Y)
+C
+C                        VECTD(X,Y)
+C                          A LINE SEGMENT IS DRAWN BETWEEN THE
+C                          WORLD COORDINATE VALUE (X,Y) AND THE
+C                          MOST RECENT PEN POSITION.  (X,Y) THEN
+C                          BECOMES THE MOST RECENT PEN POSITION.
+C
+C                        LINED(XA,XB,YA,YB)
+C                          A LINE IS DRAWN BETWEEN WORLD COORDINATE
+C                          VALUES (XA,YA) AND (XB,YB).
+C
+C ON OUTPUT                ALL ARGUMENTS ARE UNCHANGED FOR ALL ROUTINES.
+C
+C NOTE                     WHEN USING FRSTD AND VECTD, LASTD MUST BE
+C                          CALLED (NO ARGUMENTS NEEDED).  LASTD SETS UP
+C                          THE CALLS TO THE SMOOTHING ROUTINES KURV1S AND
+C                          KURV2S.
+C
+C                          WHEN SWITCHING FROM THE REGULAR PLOTTING
+C                          ROUTINES TO A DASHED LINE PACKAGE THE FIRST
+C                          CALL SHOULD NOT BE TO VECTD.
+C
+C ENTRY POINTS             DASHDB, DASHDC, CURVED, FRSTD, VECTD, LINED,
+C                          RESET, LASTD, KURV1S, KURV2S, CFVLD, FDVDLD,
+C                          DRAWPV, DASHBD
+C
+C COMMON BLOCKS            INTPR, DASHD1, DASHD2, DDFLAG, DCFLAG, DSAVE1,
+C                          DSAVE2, DSAVE3, DSAVE5, CFFLAG, SMFLAG, DFFLAG,
+C                          FDFLAG
+C
+C REQUIRED LIBRARY         THE ERPRT77 PACKAGE AND THE SPPS.
+C ROUTINES
+C
+C I/O                      PLOTS SOLID OR DASHED LINES, POSSIBLY WITH
+C                          CHARACTERS AT INTERVALS IN THE LINE.
+C                          THE LINES MAY ALSO BE SMOOTHED.
+C
+C PRECISION                SINGLE
+C
+C LANGUAGE                 FORTRAN
+C
+C HISTORY                  WRITTEN IN OCTOBER 1973.
+C                          MADE PORTABLE IN SEPTEMBER 1977 FOR USE
+C                          WITH ALL MACHINES WHICH
+C                          SUPPORT PLOTTERS WITH UP TO 15 BIT RESOLUTION.
+C                          CONVERTED TO FORTRAN77 AND GKS IN JUNE, 1984.
+C
+C ALGORITHM                POINTS FOR EACH LINE
+C                          SEGMENT ARE PROCESSED AND PASSED TO THE
+C                          ROUTINES, KURV1S AND KURV2S, WHICH COMPUTE
+C                          SPLINES UNDER TENSION PASSING THROUGH THESE
+C                          POINTS.  NEW POINTS ARE GENERATED BETWEEN THE
+C                          GIVEN POINTS, RESULTING IN SMOOTH LINES.
+C
+C ACCURACY                 PLUS OR MINUS .5 PLOTTER ADDRESS UNITS PER CALL.
+C                          THERE IS NO CUMULATIVE ERROR.
+C
+C TIMING                   ABOUT THREE TIMES AS LONG AS DASHCHAR.
+C
+C
+C
+C
+C
+C
+C
+C
+C***********************************************************************
+C
+C FDVDLD RECEIVES IN ITS ARGUMENTS THE POINTS TO BE PROCESSED FOR A
+C LINE SEGMENT. IT PASSES THESE POINTS TO THE ROUTINES KURV1S AND KURV2S
+C WHICH COMPUTE SPLINES UNDER TENSION PASSING THROUGH THESE POINTS.
+C FDVDLD THEN CALLS CFVLD TO CONNECT THE POINTS GENERATED IN KURV2S.
+C
+      DIMENSION       XP(70),  YP(70),  TEMP(70)
+C
+C THE VARIABLES IN DSAVE5 HAVE TO BE SAVED FOR THE NEXT CALL TO FDVDLD.
+C
+      COMMON /DSAVE5/ XSAVE(70), YSAVE(70), XSVN, YSVN, XSV1, YSV1,
+     1                SLP1, SLPN, SSLP1, SSLPN, N, NSEG
+C
+C IOFFS IS AN INTERNAL PARAMETER. IT IS INITIALIZED IN DASHBD AND
+C REFERENCED IN FDVDLD AND DRAWPV.
+C
+      COMMON /SMFLAG/ IOFFS
+C
+C IFSTF2 IS A FLAG TO CONTROL THAT FRSTD IS CALLED BEFORE VECTD IS
+C CALLED.
+C
+      COMMON /DFFLAG/ IFSTF2
+C
+C IFLAG CONTROLS IF LASTD CAN BE CALLED DIRECTLY OR IF IT WAS JUST
+C CALLED FROM BY VECTD SO THAT THIS CALL CAN BE IGNORED.
+C
+      COMMON /FDFLAG/ IFLAG
+C
+C NOTE THAT THIS IFSTF2 FLAG CANNOT BE IDENTICAL TO THE IFSTFL FLAG
+C IN THE ROUTINE CFVLD, BECAUSE A CALL TO THE FRSTD ENTRY OF FDVDLD DOES
+C NOT ELIMINATE THE NECESSITY OF A CALL TO THE FRSTD ENTRY OF CFVLD,
+C AND REVERSE.
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+      SAVE
+C
+C
+C OTHER CONSTANTS.
+C
+      DATA PI /3.14159265358/
+      DATA IDUMMY /0/
+C
+C
+      GO TO (10,15,35),IENTRY
+C
+C *************************************
+C
+C ENTRY  FRSTD (XX,YY)
+C
+   10 DEG = 180./PI
+C
+      MX = IIX
+      MY = IIY
+      IFSTF2 = 0
+      SSLP1 = 0.0
+      SSLPN = 0.0
+      XSVN = 0.0
+      YSVN = 0.0
+      IF (IOFFS .GE. 1) CALL CFVLD (1,MX,MY)
+      IF (IOFFS .GE. 1) RETURN
+C
+C INITIALIZE THE POINT AND SEGMENT COUNTER
+C N COUNTS THE NUMBER OF POINTS/SEGMENT
+C
+      N = 0
+C
+C NSEG = 0       FIRST SEGMENT
+C NSEG = 1       MORE THAN ONE SEGMENT
+C
+      NSEG = 0
+C
+C SAVE THE X,Y COORDINATES OF THE FIRST POINT
+C XSV1           CONTAINS THE X COORDINATE OF THE FIRST POINT
+C                OF A LINE
+C YSV1           CONTAINS THE Y COORDINATE OF THE FIRST POINT
+C                OF A LINE
+C
+      XSV1 = MX
+      YSV1 = MY
+      GO TO 30
+C
+C *************************************
+C
+C     ENTRY VECTD (XX,YY)
+C
+   15 CONTINUE
+C
+C TEST FOR PREVIOUS FRSTD CALL
+C
+      IF (IFSTF2 .EQ. 0) GO TO 20
+C
+C INFORM USER - NO PREVIOUS CALL TO FRSTD. TREAT CALL AS FRSTD CALL.
+C
+      CALL SETER(' FDVDLD- VECTD CALL OCCURS BEFORE A CALL TO FRSTD.',
+     -            1,1)
+      GO TO 10
+   20 MX = IIX
+      MY = IIY
+C
+C VECTD          SAVES THE X,Y COORDINATES OF THE ACCEPTED
+C                POINTS ON A LINE SEGMENT
+C
+      IF (IOFFS .GE. 1) CALL CFVLD (2,MX,MY)
+      IF (IOFFS .GE. 1) RETURN
+C
+C IF THE NEW POINT IS TOO CLOSE TO THE PREVIOUS POINT, IGNORE IT
+C
+      IF (ABS(FLOAT(IFIX(XSVN)-MX))+ABS(FLOAT(IFIX(YSVN)-MY)) .LT.
+     1    SMALL) RETURN
+      IFLAG = 0
+   30 N = N+1
+C
+C SAVE THE X,Y COORDINATES OF EACH POINT OF THE SEGMENT
+C XSAVE          THE ARRAY OF X COORDINATES OF LINE SEGMENT
+C YSAVE          THE ARRAY OF Y COORDINATES OF LINE SEGMENT
+C
+      XSAVE(N) = MX
+      YSAVE(N) = MY
+      XSVN = XSAVE(N)
+      YSVN = YSAVE(N)
+      IF (N .GE. L1-1) GO TO 40
+      RETURN
+C
+C *************************************
+C
+C     ENTRY LASTD
+C
+   35 CONTINUE
+      IF (IFSTF2 .NE. 0) RETURN
+      IFSTF2 = 1
+C
+C LASTD          CHECKS FOR PERIODIC LINES AND SETS UP
+C                  THE CALLS TO KURV1S AND KURV2S
+C
+      IF (IOFFS .GE. 1) CALL CFVLD (3,IDUMMY,IDUMMY)
+      IF (IOFFS .GE. 1) RETURN
+C
+C IFLAG = 0      OK TO CALL LASTD DIRECTLY
+C IFLAG = 1      LASTD WAS JUST CALLED FROM BY VECTD
+C                IGNORE CALL TO LASTD
+C
+      IF (IFLAG .EQ. 1) RETURN
+C
+C COMPARE THE LAST POINT OF SEGMENT WITH FIRST POINT OF LINE
+C
+   40 IFLAG = 1
+C
+C IPRD = 0       PERIODIC LINE
+C IPRD = 1       NON-PERIODIC LINE
+C
+      IPRD = 1
+      IF (ABS(XSV1-XSVN)+ABS(YSV1-YSVN) .LT. SMALL) IPRD = 0
+C
+C TAKE CARE OF THE CASE OF ONLY TWO DISTINCT P0INTS ON A LINE
+C
+      IF (NSEG .GE. 1) GO TO 60
+      IF (N-2) 150,140,50
+   50 IF (N .GE. 4) GO TO 60
+C
+      IF (IPRD .NE. 0) GO TO 60
+      DX = XSAVE(2)-XSAVE(1)
+      DY = YSAVE(2)-YSAVE(1)
+      SLOPE = ATAN2(DY,DX)*DEG+90.
+      IF (SLOPE .GE. 360.) SLOPE = SLOPE-360.
+      IF (SLOPE .LE. 0.) SLOPE = SLOPE+360.
+      SLP1 = SLOPE
+      SLPN = SLOPE
+      ISLPSW = 0
+      SIGMA = TENSN
+      GO TO 100
+   60 SIGMA = TENSN
+      IF (IPRD .GE. 1) GO TO 80
+      IF (NSEG .GE. 1) GO TO 70
+C
+C SET UP FLAGS FOR A  1  SEGMENT, PERIODIC LINE
+C
+      ISLPSW = 4
+      XSAVE(N) = XSV1
+      YSAVE(N) = YSV1
+      GO TO 100
+C
+C SET UP FLAGS FOR AN N-SEGMENT, PERIODIC LINE
+C
+   70 SLP1 = SSLPN
+      SLPN = SSLP1
+      ISLPSW = 0
+      GO TO 100
+   80 IF (NSEG .GE. 1) GO TO 90
+C
+C SET UP FLAGS FOR THE 1ST SEGMENT OF A NON-PERIODIC LINE
+C
+      ISLPSW = 3
+      GO TO 100
+C
+C SET UP FLAGS FOR THE NTH SEGMENT OF A NON-PERIODIC LINE
+C
+   90 SLP1 = SSLPN
+      ISLPSW = 1
+C
+C CALL THE SMOOTHING ROUTINES
+C
+  100 CALL KURV1S (N,XSAVE,YSAVE,SLP1,SLPN,XP,YP,TEMP,S,SIGMA,ISLPSW)
+C
+C DETERMINE THE NUMBER OF POINTS TO INTERPOLATE FOR EACH SEGMENT
+C
+      IF (NSEG.GE.1 .AND. N.LT.L1-1) GO TO 110
+      NPRIME = FLOAT(NP)-(S*FLOAT(NP)*.5)/32767.
+      IF (S .GE. 32767.) NPRIME = .5*FLOAT(NP)
+      NPL = AMAX1(FLOAT(NPRIME)*S/32767.,2.5)
+  110 DT = 1./FLOAT(NPL)
+      IX = IFIX (XSAVE(1))
+      IY = IFIX (YSAVE(1))
+      IF (NSEG .LE. 0) GO TO 112
+      CALL DRAWPV (IX,IY,0)
+      GO TO 114
+  112 CONTINUE
+      CALL CFVLD (1,IX,IY)
+  114 CONTINUE
+      T = 0.0
+      NSLPSW = 1
+      IF (NSEG .GE. 1) NSLPSW = 0
+      NSEG = 1
+      CALL KURV2S (T,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C SAVE SLOPE AT THE FIRST POINT OF THE LINE
+C
+      IF (NSLPSW .GE. 1) SSLP1 = SLP
+      NSLPSW = 0
+      DO 120 I=1,NPL
+         T = T+DT
+         TT = -T
+         IF (I .EQ. NPL) NSLPSW = 1
+         CALL KURV2S (TT,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C SAVE THE LAST SLOPE OF THIS LINE SEGMENT
+C
+         IF (NSLPSW .GE. 1) SSLPN = SLP
+C
+C DRAW EACH PART OF THE LINE SEGMENT
+C
+         IX = IFIX(XS)
+         IY = IFIX (YS)
+         CALL CFVLD (2,IX,IY)
+  120 CONTINUE
+      IF (IPRD .NE. 0) GO TO 130
+C
+C CONNECT THE LAST POINT WITH THE FIRST POINT OF A PERIODIC LINE
+C
+      IX = IFIX (XSV1)
+      IY = IFIX (YSV1)
+      CALL CFVLD (2,IX,IY)
+C
+C BEGIN THE NEXT LINE SEGMENT WITH THE LAST POINT OF THIS SEGMENT
+C
+  130 XSAVE(1) = XS
+      YSAVE(1) = YS
+      N = 1
+      IF (IFSTF2 .EQ. 1) CALL CFVLD (3,IDUMMY,IDUMMY)
+      GO TO 150
+C
+C FOR THE CASE WHEN THERE ARE ONLY 2 DISTINCT POINTS ON A LINE.
+C
+  140 IX = IFIX (XSAVE(1))
+      IY = IFIX (YSAVE(1))
+      CALL CFVLD (1,IX,IY)
+      IX = IFIX (XSAVE(N))
+      IY = IFIX (YSAVE(N))
+      CALL CFVLD (2,IX,IY)
+      IF (IFSTF2 .EQ. 1) CALL CFVLD (3,IDUMMY,IDUMMY)
+C
+  150 CONTINUE
+      RETURN
+      END
+      SUBROUTINE RESET
+C
+C  THIS USER ENTRY POINT IS HERE ONLY FOR COMPATIBILITY WITH USE IN
+C  THE CONREC FAMILY WHICH CALL RESET WHEN USED WITH DASHSUPR.
+C
+      RETURN
+      END
+      SUBROUTINE DASHDC (IPAT,JCRT,JSIZE)
+C
+C
+C
+C
+C
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+C
+C USER ENTRY POINT.
+C DASHDC GIVES AN INTERNAL REPRESENTATION TO THE DASH PATTERN WHICH IS
+C SPECIFIED IN ITS ARGUMENTS. THIS INTERNAL REPRESENTATION IS PASSED
+C TO ROUTINE CFVLD IN THE COMMON-BLOCK DASHD1.
+C
+      CHARACTER*(*) IPAT
+      CHARACTER*1   IBLK, IGAP, ISOL, ICR
+      CHARACTER*16  IPC(100)
+C
+C DASHD1 AND DASHD2 ARE USED
+C FOR COMMUNICATION BETWEEN THE ROUTINES DASHDB, DASHDC AND CFVLD.
+C ISL, MNCSTR AND IGP ARE INITIALIZED IN DASHBD.
+C
+      COMMON /DASHD1/  ISL,  L,  ISIZE,  IP(100),  NWDSM1,  IPFLAG(100)
+     1                 ,MNCSTR, IGP
+      COMMON /DASHD2/  IPC
+C
+C IFCFLG IS THE FIRST CALL FLAG FOR DASHDB AND DASHDC.
+C IT IS INITIALIZED IN DASHBD.
+C
+      COMMON /DDFLAG/ IFCFLG
+C
+C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED (IN CFVLD)
+C WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
+C IT IS INITIALIZED IN DASHBD AND REFERENCED IN CFVLD.
+C
+      COMMON /DCFLAG/ IFSTFL
+C
+C IFSTF2 CONTROLS THAT THE FRSTD ENTRY IS CALLED IN FDVDLD BEFORE THE
+C VECTD ENTRY IS CALLED WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
+C IT IS INITIALIZED IN DASHBD AND REFERENCED IN FDVDLD.
+C
+      COMMON /DFFLAG/ IFSTF2
+C
+C LOCAL VARIABLES TO DASHDB AND DASHDC ARE SAVED IN DSAVE2
+C FOR THE NEXT CALL
+C
+      COMMON /DSAVE2/ MASK, NCHRWD, NBWD, MNCST1
+C SAVE ALL VARIABLES
+      SAVE
+C
+C NECESSARY ON SOME MACHINES TO GET BLOCK DATA LOADED
+C
+C NPD IS THE NUMBER OF WORDS IN IP
+C
+      DATA NPD/100/
+C
+C INITIALIZE CHARACTER FLAGS
+C
+      DATA IBLK,IGAP,ISOL/' ','''','$'/
+C
+C +NOAO - blockdata replaced with run time initialization.
+C     EXTERNAL DASHBD
+      call dashbd
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR LIBRARY STATISTICS GATHERING AT NCAR
+      CALL Q8QST4 ('GRAPHX', 'DASHSMTH', 'DASHDC', 'VERSION  1')
+C
+C     NC IS THE NUMBER OF CHARACTERS IN IPAT
+C
+      NC = LEN(IPAT)
+      IF (IFCFLG .EQ. 2) GOTO 10
+C
+C CHECK IF THE CONSTANTS IN THE BLOCKDATA DASHBD ARE LOADED CORRECTLY
+C
+      IF (MNCSTR .EQ. 15) GOTO 6
+      CALL SETER('DASHDC -- BLOCKDATA DASHBD APPARRENTLY NOT LOADED CORR
+     1ECTLY',1,2)
+    6 CONTINUE
+C
+C INITIALIZATION
+C
+      MNCST1 = MNCSTR + 1
+C
+C MASK IS AN ALL SOLID PATTERN TO BE PASSED TO OPTN (65535=177777B).
+C
+      MASK=IOR(ISHIFT(32767,1),1)
+C
+C
+      IFCFLG = 2
+C
+C NCHRTS - NUMBER OF CHARS IN THIS HOLLERITH STRING.
+C L      - NUMBER OF WORDS IN THE FINAL PATTERN, POINTER TO IP ARRAY.
+C ISL    - FLAG FOR ALL SOLID PATTERN (1) OR ALL GAP PATTERN (-1).
+C IFSTFL - FLAG TO CONTROL THAT FRSTD IS CALLED IN CFVLD BEFORE VECTD IS
+C          CALLED, WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
+C IFSTF2 - FLAG TO CONTROL THAT FRSTD IS CALLED IN FDVDLD BEFORE VECTD
+C          IS CALLED, WHENEVER DASHDB OR DASHDC HAVE BEEN CALLED.
+C
+   10 CONTINUE
+      NCHRTS = 0
+      L = 0
+      ISL = 0
+      IFSTFL = 1
+      IFSTF2 = 1
+C
+C RETRIEVE THE RESOLUTION AS SET BY THE USER.
+C
+      CALL GETUSV('XF',LXSAVE)
+      CALL GETUSV('YF',LYSAVE)
+C
+C IADJUS - TO ADJUST NUMBERS TO THE GIVEN RESOLUTION.
+C
+      IADJUS = ISHIFT(1,15-LXSAVE)
+      ICRT = JCRT*IADJUS
+      ISIZE = JSIZE
+      CHARW = FLOAT(ISIZE*IADJUS)
+      IF (ISIZE .GT. 3) GO TO 30
+      CHARW = 256. + FLOAT(ISIZE)*128.
+      IF (ISIZE .EQ. 3) CHARW = 768.
+C
+   30 CONTINUE
+      IF (ICRT .LT. 1) GO TO 230
+      MODE = 2
+C
+C START MAIN LOOP
+C
+C THIS LOOP GENERATES THE IP ARRAY (NEEDED BY CURVED,VECTD,ETC.) FROM
+C THE CHARACTER STRING IN IPAT.  EACH ITERATION OF THE LOOP PROCESSES
+C ONE CHAR OF IPAT.  A SOLID OR GAP IS CONSIDERED TO BE A TYPE 1 ENTRY,
+C AND A LABEL CHARACTER IS CONSIDERED TO BE A TYPE 2 ENTRY.
+C
+C IN THE CODE, L IS THE NUMBER OF CHANGES IN THE LINESTYLE (FROM GAP
+C TO SOLID, SOLID TO CHARACTER, ETC.)  THE IP AND IPFLAG ARRAYS DESCRIBE
+C THE LINE TO BE DRAWN, AND THESE ARRAYS ARE INDEXED FROM 1 TO L.  THE
+C RELATIONSHIP BETWEEN IP AND IPFLAG IS:
+C
+C      IPFLAG(N)    IP(N)
+C      ---------    -----
+C          1        LENGTH (IN PLOTTER ADDRESS UNITS) OF SOLID LINE TO
+C                   BE DRAWN.
+C          0        NUMBER OF CHARACTERS TO BE PLOTTED.
+C         -1        LENGTH (IN PLOTTER ADDRESS UNITS) OF GAP.
+C
+C THE 160 LOOP HANDLES 5 CASES:
+C
+C    1.)  CONTINUE TYPE 2 ENTRY (60-80)
+C    2.)  START TYPE 2 ENTRY (80-90)
+C    3.)  END TYPE 2 ENTRY AND START TYPE 1 ENTRY (90-160)
+C    4.)  START TYPE 1 ENTRY, OR SWITCH TYPE 1 ENTRY FROM SOLID TO
+C         GAP OR FROM GAP TO SOLID (140-160)
+C    5.)  CONTINUE TYPE 1 ENTRY (150-160)
+C
+      DO 160 J=1,NC
+C
+C GET NEXT CHAR INTO ICR, RIGHT JUSTIFIED ZERO FILLED.
+C
+            ICR = IPAT(J:J)
+C
+C MODE SPECIFIES WHAT THE LAST CHARACTER PROCESSED WAS:
+C
+C    LAST ICR WAS $ (SOLID),      MODE IS 8
+C    LAST ICR WAS ' (GAP),        MODE IS 2
+C    LAST ICR WAS HOLLERITH CHAR, MODE IS 5
+C
+C NMODE SPECIFIES WHAT THE CURRENT CHARACTER TO BE PROCESSED IS:
+C
+C      ICR     NMODE
+C      ---     -----
+C       $        1
+C       CHAR     0
+C       '       -1
+C
+            NMODE = 0
+            IF (ICR .EQ. IBLK) GO TO 160
+            IF (ICR .EQ. IGAP) NMODE = -1
+            IF (ICR .EQ. ISOL) NMODE = 1
+            IF (L.EQ.0 .AND. NMODE.EQ.-1) MODE = 8
+C
+C NGO DETERMINES WHERE TO BRANCH BASED ON CASE TO BE PROCESSED.
+C COMPUTE MODE FOR NEXT ITERATION.
+C
+            NGO = NMODE+MODE
+            MODE = NMODE*3+5
+            GO TO (150,80,140,90,60,90,140,80,150),NGO
+C
+C CHAR TO CHAR
+C
+C CASE 1) - CONTINUE TYPE 2 ENTRY.
+C
+   60      IF (NCHRTS .EQ. MNCSTR) GO TO 160
+           NCHRTS = NCHRTS + 1
+           IP(L) = NCHRTS
+           IPC(L)(NCHRTS:NCHRTS) = ICR
+           GO TO 160
+C
+C BLANK OR SOLID TO CHAR
+C
+C CASE 2) - START STRING ENTRY.  LGBSTR POINTS TO THE GAP WHICH
+C           WILL CONTAIN THE STRING.
+C
+   80      LGBSTR = MIN0(L+1,NPD)
+           L = MIN0(LGBSTR+1,NPD)
+           IPFLAG(L) = 0
+           NCHRTS    = 1
+           IP(L)     = 1
+           IPC(L)(NCHRTS:NCHRTS) = ICR
+           GO TO 160
+C
+C CHAR TO SOLID OR GAP
+C
+C CASE 3) - END STRING ENTRY.  ICR IS A $ OR '.
+C
+   90      CONTINUE
+           IP(LGBSTR) = CHARW*(FLOAT(NCHRTS) + .5)
+           IPFLAG(LGBSTR) = -1
+           IF (IGP .EQ. 0) IPFLAG(LGBSTR) = 1
+C
+C BLANK TO SOLID OR SOLID TO BLANK
+C
+C CASE 4) - START TYPE 1 ENTRY.
+C
+  140       L = MIN0(L+1,NPD)
+            IP(L) = 0
+C
+C ADD TO A BLANK OR SOLID LINE
+C
+C CASE 5) - CONTINUE TYPE 1 ENTRY.  ICR IS A $ OR '.
+C ADD ICRT UNITS TO THE PLOTTER ADDRESS UNITS IN IP(L).
+C NMODE INDICATES IF IT IS A GAP OR A SOLID.
+C
+  150       IP(L) = IP(L) + ICRT
+            IPFLAG(L) = NMODE
+  160    CONTINUE
+C
+C IF LAST ICR PROCESSED WAS A LABEL CHARACTER, MUST END STRING
+C ENTRY.
+C
+      IF (NGO.NE.2 .AND. NGO.NE.5 .AND. NGO.NE.8) GO TO 220
+      IP(LGBSTR) = CHARW*(FLOAT(NCHRTS)+.5)
+      IPFLAG(LGBSTR) = -1
+      IF (IGP .EQ. 0) IPFLAG(LGBSTR) = 1
+C
+C IF IP ARRAY HAS ONLY ONE TYPE 1 ENTRY, SET ISL FLAG.
+C
+  220 IF (L .GT. 1) RETURN
+      IBIG = ISHIFT(1,MAX0(LXSAVE,LYSAVE))
+      IF (IP(L) .GE. IBIG) GO TO 230
+      IF (IPFLAG(L)) 240,240,230
+  230 ISL = 1
+      RETURN
+  240 ISL = -1
+      RETURN
+      END
+      SUBROUTINE DASHDB (IPAT)
+C
+C ARGUMENTS              IPAT
+C ON INPUT                 IPAT IS A 16-BIT DASH PATTERN.  BY DEFAULT
+C                          EACH BIT IN THE PATTERN REPRESENTS 3 PLOTTER
+C                          ADDRESS UNITS (1=SOLID, 0=BLANK)
+C
+C
+C
+C USER ENTRY POINT.
+C DASHDB GIVES AN INTERNAL REPRESENTATION TO THE DASH PATTERN WHICH IS
+C SPECIFIED IN ITS ARGUMENT. THIS INTERNAL REPRESENTATION IS PASSED
+C TO ROUTINE CFVLD IN THE COMMON-BLOCK DASHD1.
+C
+      DIMENSION IPAT(1)
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+C
+C DASHD1 IS FOR COMMUNICATION BETWEEN THE ROUTINES DASHDB AND CFVLD.
+C ISL, MNCSTR AND IGP ARE INITIALIZED IN DASHBD.
+C
+      COMMON /DASHD1/  ISL,  L,  ISIZE,  IP(100),  NWDSM1,  IPFLAG(100)
+     1                 ,MNCSTR, IGP
+C
+C IFCFLG IS THE FIRST CALL FLAG FOR DASHDB. IT IS INITIALIZED IN DASHBD.
+C
+      COMMON /DDFLAG/ IFCFLG
+C
+C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED (IN CFVLD)
+C WHENEVER DASHDB HAS BEEN CALLED. IT IS INITIALIZED IN DASHBD AND
+C REFERENCED IN CFVLD.
+C
+      COMMON /DCFLAG/ IFSTFL
+C
+C IFSTF2 CONTROLS THAT THE FRSTD ENTRY IS CALLED IN FDVDLD BEFORE THE
+C VECTD ENTRY IS CALLED WHENEVER DASHDB OR DASHDC HAS BEEN CALLED. IT IS
+C INITIALIZED IN DASHBD AND REFERENCED IN FDVDLD.
+C
+      COMMON /DFFLAG/ IFSTF2
+C
+C LOCAL VARIABLES TO DASHDB ARE SAVED IN DSAVE2 FOR THE NEXT CALL TO
+C DASHDB.
+C
+      COMMON /DSAVE2/ MASK, NCHRWD, NBWD, MNCST1
+C
+C NECESSARY ON SOME MACHINES TO GET BLOCK DATA LOADED
+C
+      SAVE
+C
+C +NOAO - blockdata replaced with run time initialization.
+C     EXTERNAL DASHBD
+      call dashbd
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR LIBRARY STATISTICS GATHERING AT NCAR
+      CALL Q8QST4 ('GRAPHX', 'DASHSMTH', 'DASHDB', 'VERSION  1')
+      IF (IFCFLG .EQ. 2) GOTO 10
+C
+C CHECK IF THE CONSTANTS IN THE BLOCKDATA DASHBD ARE LOADED CORRECTLY
+C
+      IF (MNCSTR .EQ. 15) GOTO 6
+      CALL SETER('DASHDB -- BLOCKDATA DASHBD APPARRENTLY NOT LOADED CORR
+     1ECTLY',1,2)
+    6 CONTINUE
+C
+C INITIALIZATION
+C
+      MNCST1 = MNCSTR + 1
+C
+C MASK IS AN ALL SOLID PATTERN
+C
+      MASK=IOR(ISHIFT(32767,1),1)
+C
+      IFCFLG = 2
+C
+C L - NUMBER OF WORDS IN THE FINAL PATTERN, POINTER TO IP ARRAY.
+C ISL - FLAG FOR ALL SOLID PATTERN (1) OR ALL GAP PATTERN (-1).
+C IFSTFL - FLAG TO CONTROL THAT FRSTD IS CALLED IN CFVLD BEFORE VECTD IS
+C          CALLED, WHENEVER DASHDB OR DASHDC HAS BEEN CALLED.
+C IFSTF2 - FLAG TO CONTROL THAT FRSTD IS CALLED IN FDVDLD BEFORE VECTD
+C          IS CALLED, WHENEVER DASHDB OR DASHDC HAS BEEN CALLED.
+C
+   10 CONTINUE
+      NCHRTS = 0
+      L = 0
+      ISL = 0
+      IFSTFL = 1
+      IFSTF2 = 1
+C
+      ICRT = IPAU*ISHIFT(1,15-10)
+      IF (IPAT(1) .NE. 0) GO TO 260
+      ISL = -1
+      RETURN
+  260 IF (IPAT(1) .NE. MASK) GO TO 270
+      ISL = 1
+      RETURN
+  270 NMODE1 = IAND(ISHIFT(IPAT(1),-15),1)
+      DO 290 I = 1,16
+      IF (NMODE1 .NE. IAND(ISHIFT(IPAT(1),I-16),1)) GO TO 280
+      NMODE1 = 1 - NMODE1
+      L = L + 1
+      IP(L) = 0
+      IPFLAG(L) = 1 - 2*NMODE1
+  280 IP(L) = IP(L) + ICRT
+  290 CONTINUE
+      RETURN
+      END
+      SUBROUTINE DRAWPV (IX,IY,IND)
+C
+C DRAWPV INTERCEPTS THE CALL TO PLOTIT TO CHECK IF THE PEN HAS TO BE
+C MOVED OR IF IT IS ALREADY CLOSE ENOUGH TO THE WANTED POSITION.
+C IF IND=2 NEVER MOVE PEN, JUST UPDATE VARIABLES IXSTOR AND IYSTOR.
+C
+C IN IXSTOR AND IYSTOR THE CURRENT POSITION OF THE PEN IS SAVED.
+C
+      COMMON /DSAVE3/ IXSTOR,IYSTOR
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+      SAVE
+      IIND = IND + 1
+      GOTO (100,90,105), IIND
+C
+   90 CONTINUE
+C
+C DRAW LINE AND SAVE POSITION OF PEN.
+C
+      IXSTOR = IX
+      IYSTOR = IY
+      CALL PLOTIT (IXSTOR,IYSTOR,1)
+      GOTO 110
+C
+  100 CONTINUE
+C
+C CHECK IF PEN IS ALREADY CLOSE ENOUGH TO THE WANTED POSITION.
+C
+      DIFF = FLOAT(IABS(IXSTOR-IX)+IABS(IYSTOR-IY))
+      IF (DIFF .LE. FLOAT(ICLOSE)) GO TO 110
+C
+      IXSTOR = IX
+      IYSTOR = IY
+      CALL PLOTIT (IXSTOR,IYSTOR,0)
+      GOTO 110
+C
+  105 CONTINUE
+C
+C DO NOT MOVE PEN. JUST UPDATE VARIABLES IXSTOR AND IYSTOR.
+C
+      IXSTOR = IX
+      IYSTOR = IY
+C
+  110 CONTINUE
+C
+      RETURN
+      END
+C
+      SUBROUTINE CFVLD (IENTRY,IIX,IIY)
+C
+C CFVLD CONNECTS POINTS WHOSE COORDINATES ARE SUPPLIED IN THE ARGUMENTS,
+C ACCORDING TO THE DASH PATTERN WHICH IS PASSED FROM ROUTINE DASHDB
+C OR DASHDC IN THE COMMON-BLOCK DASHD1.
+C
+      CHARACTER*16  IPC(100)
+C
+      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
+     1    ICLOSE
+C
+C THE VARIABLES IN DASHD1 AND DASHD2 ARE USED FOR COMMUNICATION WITH
+C DASHDC AND DASHDB.
+C
+      COMMON /DASHD1/  ISL,  L,  ISIZE,  IP(100),  NWDSM1,  IPFLAG(100)
+     1                 ,MNCSTR, IGP
+      COMMON /DASHD2/  IPC
+C
+C THE VARIABLES IN DSAVE1 HAVE TO BE SAVED FOR THE NEXT CALL TO CFVLD.
+C
+      COMMON /DSAVE1/ X,Y,X2,Y2,X3,Y3,M,BTI,IB,IX,IY
+C
+C THE FLAGS IFSTFL AND IVCTFG ARE INITIALIZED IN THE BLOCK DATA DASHBD.
+C IFSTFL CONTROLS THAT FRSTD IS CALLED BEFORE VECTD IS CALLED.
+C IVCTFG IS A FLAG TO INDICATE IF CFVLD IS BEING CALLED FROM VECTD OR
+C LASTD.
+C
+      COMMON /DCFLAG/ IFSTFL
+      COMMON /CFFLAG/ IVCTFG
+      SAVE
+C
+C
+C CMN IS USED TO DETERMINE WHEN TO STOP DRAWING A LINE SEGMENT
+C
+      DATA CMN/1.5/
+C
+C IMPOS IS USED AS AN IMPOSSIBLE PEN POSITION.
+C
+      DATA IMPOS /-9999/
+C
+C
+C  ISL= -1  ALL BLANK  ) FLAG TO AVOID MOST CALCULATIONS
+C        0  DASHED     )   IF PATTERN IS ALL SOLID OR
+C        1  ALL SOLID  )   ALL BLANK
+C
+C     X,IX,Y,IY    CURRENT POSITION
+C     X1,Y1        START OF A USER LINE SEGMENT
+C     X2,Y2        END OF A USER LINE SEGMENT
+C     X3,Y3        START OF A GAP PATTERN SEGMENT
+C
+C  SYMBOLS,IF PRESENT ARE CENTERED IN AN IMMEDIATLY PRECEEDING
+C     GAP SEGMENT, OR DONE AT THE CURRENT POSITION OTHERWISE
+C
+C  SEGMENT TYPES ARE RECOGNIZED AS FOLLOWS
+C     SOLID - WORD IN IP-ARRAY CONTAINS POSITIVE INTEGER, CORRESPONDING
+C             ELEMENT IN IPFLAG IS 1.
+C     GAP - WORD IN IP-ARRAY CONTAINS POSITIVE INTEGER, CORRESPONDING
+C             ELEMENT IN IPFLAG IS -1.
+C     SYMBOL - WORD IN IP-ARRAY CONTAINS CHARACTER REPRESENTATIONS.
+C             CORRESPONDING ELEMENT IN IPFLAG IS 0.
+C             SYMBOL COUNT FOR CHAR STRING IN CHAR NUMBER MNCSTR+1.
+C     THE IP ARRAY AND THE IPFLAG ARRAY ARE COMPOSED OF L ELEMENTS.
+C
+C     BTI - BITS THIS INCREMENT
+C     BPBX,BPBY BITS PER BIT X(Y)
+C
+C
+C BRANCH DEPENDING ON FUNCTION TO BE PERFORMED.
+C
+      GO TO (330,305,350),IENTRY
+C
+C INITIALIZE VARIABLES (ENTRY FRSTD ONLY)
+C
+   30 CONTINUE
+      X = IX
+      Y = IY
+      X2 = X
+      X3 = X
+      Y2 = Y
+      Y3 = Y
+      M = 1
+      IB = IPFLAG(1)
+      IF (IPFLAG(1) .NE. 0) GO TO 40
+      IB = 0
+      BTI = 0
+   40 CONTINUE
+      BTI = FLOAT(IP(1))*FPART
+      GO TO 300
+C
+C MAIN LOOP START
+C
+   50 CONTINUE
+         X1 = X2
+         Y1 = Y2
+         MX = IIX
+         MY = IIY
+         X2 = MX
+         Y2 = MY
+         DX = X2-X1
+         DY = Y2-Y1
+         D = SQRT(DX*DX+DY*DY)
+         IF (D .LT. CMN) GO TO 190
+   60    BPBX = DX/D
+         BPBY = DY/D
+         CALL DRAWPV (IX,IY,0)
+   70    BTI = BTI-D
+         IF (BTI) 100,100,80
+C
+C LINE SEGMENT WILL FIT IN CURRENT PATTERN ELEMENT
+C
+   80    X = X2
+         Y = Y2
+         IX = X2
+         IY = Y2
+         IF (IB) 200,160,90
+   90    CALL DRAWPV (IX,IY,1)
+         GO TO 200
+C
+C LINE SEGMENT WONT FIT IN CURRENT PATTERN ELEMENT
+C DO IT TO END OF ELEMENT, SAVE HOW MUCH OF SEGMENT LEFT TO DO (D)
+C
+  100    BTI = BTI+D
+         D = D-BTI
+         X = X+BPBX*BTI
+         Y = Y+BPBY*BTI
+         IX = X+.5
+         IY = Y+.5
+         IF (IB) 110,160,120
+  110    CALL DRAWPV (IX,IY,0)
+         GO TO 130
+  120    CALL DRAWPV (IX,IY,1)
+C
+C GET THE NEXT PATTERN ELEMENT
+C
+  130    M = MOD(M,L)+1
+         IB = IPFLAG(M)
+         IF (IB) 140,160,150
+  140    X3 = X
+         Y3 = Y
+         BTI = FLOAT(IP(M))
+         GO TO 70
+  150    X3 = -1.
+         BTI = FLOAT(IP(M))
+         GO TO 70
+C
+C CHARACTER GENERATION
+C
+  160    S = 0.
+         IF (IGP .NE. 9) GO TO 162
+C
+         DX = X-X3
+         DY = Y-Y3
+         GO TO 164
+C
+  162    CONTINUE
+         DX = X - X1
+         DY = Y - Y1
+  164    CONTINUE
+C
+         IF (DY) 170,180,170
+  170    S = ATAN2(DY,DX)
+         IF (ABS(S-.00005) .GT. 1.5708) S = S-SIGN(3.14159,S)
+  180    IF (IGP .NE. 9) GO TO 182
+C
+         MX = X3 + DX*.5
+         MY = Y3 + DY*.5
+         LIGP = 0
+         GO TO 184
+C
+  182    CONTINUE
+         MX = X
+         MY = Y
+         LIGP = 1
+C
+  184    CONTINUE
+         IS = IFIX(S*180./3.14 + .5)
+         IF (IS .LT. 0) IS = 360+IS
+         CALL GETUSV('XF',LXSAVE)
+         CALL GETUSV('YF',LYSAVE)
+         MX = ISHIFT (MX,LXSAVE-15)
+         MY = ISHIFT(MY,LYSAVE-15)
+         CALL WTSTR(CPUX(MX),CPUY(MY),IPC(M)(1:IP(M)),ISIZE,IS,LIGP)
+         CALL DRAWPV (IMPOS,IMPOS,2)
+         CALL DRAWPV (IX,IY,0)
+         GO TO 130
+  190    X2 = X1
+         Y2 = Y1
+  200 CONTINUE
+C
+C EXIT IF CALL WAS TO VECTD.
+C
+      IF (IVCTFG .NE. 2) GO TO 210
+      IVCTFG = 1
+      GO TO 300
+C
+C EXIT IF NOT PLOTTING A GAP
+C
+  210 IF (IB .GE. 0) GO TO 300
+C
+C MUST BE IN A GAP AT END OF LASTD. EXIT IF NOT A LABEL GAP.
+C
+      MO = M
+      M = MOD(M,L) + 1
+      IF (IPFLAG(M) .NE. 0) GO TO 300
+C
+C CHECK PREVIOUS PLOTTED ELEMENT. WAS IT A GAP OR A LINE.
+C
+      MPREV = M - 2
+      IF (MPREV .LE. 0) MPREV = MPREV + L
+      IB = IPFLAG(MPREV)
+      IF (IB .GE. 0) GO TO 250
+C
+C PREVIOUS ELEMENT WAS A GAP - LOOK FOR NEXT LINE.
+C EXIT IF NO LINES IN PATTERN.
+C
+  230 CONTINUE
+  240 M = MOD(M,L)+1
+      IF (M .EQ. MO) GO TO 300
+      IB = IPFLAG(M)
+      IF (IB .EQ. 0) GOTO 245
+      BTI = FLOAT(IP(M))
+  245 CONTINUE
+C
+C IF IP(M) NOT A LINE, CONTINUE LOOKING.
+C
+      IF (IB) 240,230,280
+C
+C PREVIOUS ELEMENT WAS A LINE - LOOK FOR NEXT GAP.
+C IF NO NON-LABEL GAPS IN PATTERN, GO TO 290.
+C
+  250 CONTINUE
+  260 M = MOD(M,L)+1
+      IF (M .EQ. MO) GO TO 290
+      IB = IPFLAG(M)
+      IF (IB .EQ. 0) GOTO 265
+      BTI = FLOAT(IP(M))
+  265 CONTINUE
+C
+C IF IP(M) NOT A GAP, CONTINUE LOOKING.
+C
+      IF (IB) 270,250,260
+C
+C FOUND A GAP. IF ITS A LABEL GAP, GO LOOK FOR NEXT GAP.
+C
+  270 MT = M
+      M = MOD(M,L)+1
+      IF (IPFLAG(M) .EQ. 0) GO TO 250
+      M = MT
+C
+C M POINTS TO NEXT ELEMENT TO PLOT. SET UP AND GO PLOT.
+C
+  280 X1 = X3
+      Y1 = Y3
+      X = X3
+      Y = Y3
+      IX = X+0.5
+      IY = Y+0.5
+      DX = X2-X1
+      DY = Y2-Y1
+      D = SQRT(DX*DX+DY*DY)
+      IF (D .GE. CMN) GO TO 60
+      GO TO 300
+C
+C NO NON-LABEL GAPS IN THE PATTERN - FILL IN WITH SOLID LINE.
+C
+  290 IX = X3+0.5
+      IY = Y3+0.5
+      CALL DRAWPV (IX,IY,0)
+      IX = X2
+      IY = Y2
+      CALL DRAWPV (IX,IY,1)
+  300 RETURN
+C
+C *************************************
+C
+C ENTRY VECTD (XX,YY)
+C
+  305 CONTINUE
+C
+C TEST FOR PREVIOUS CALL TO FRSTD.
+C
+      IF (IFSTFL .EQ. 2) GO TO 310
+C
+C INFORM USER - NO PREVIOUS CALL TO FRSTD. TREAT CALL AS FRSTD CALL.
+C
+      CALL SETER ('CFVLD -- VECTD CALL OCCURS BEFORE A CALL TO FRSTD.',
+     -             1,1)
+      GO TO 330
+  310 K = 1
+      IVCTFG = 2
+      IF (ISL) 300,50,320
+  320 IX = IIX
+      IY = IIY
+      CALL DRAWPV (IX,IY,1)
+      GO TO 300
+C
+C *************************************
+C
+C     ENTRY FRSTD (FLDX,FLDY)
+C
+  330 IX = IIX
+      IY = IIY
+      IFSTFL = 2
+C AVOID UNEXPECTED PEN POSITION IF CALLS TO SYSTEM PLOT PACKAGE
+C ROUTINES WERE MADE.
+      CALL DRAWPV (IMPOS,IMPOS,2)
+      IF (ISL) 300,30,340
+  340 CALL DRAWPV (IX,IY,0)
+      GO TO 300
+C
+C *************************************
+C
+C     ENTRY LASTD
+C
+  350 CONTINUE
+C
+C TEST FOR PREVIOUS CALL TO FRSTD
+C
+      IF (IFSTFL .NE. 2) GO TO 300
+      IFSTFL = 1
+      K = 1
+      IF (ISL .NE. 0) GO TO 300
+      GO TO 210
+      END
+      SUBROUTINE FRSTD (X,Y)
+C USER ENTRY PPINT.
+      CALL FL2INT (X,Y,IIX,IIY)
+      CALL FDVDLD (1,IIX,IIY)
+      RETURN
+      END
+      SUBROUTINE VECTD (X,Y)
+C USER ENTRY POINT.
+      CALL FL2INT (X,Y,IIX,IIY)
+      CALL FDVDLD (2,IIX,IIY)
+      RETURN
+      END
+      SUBROUTINE LASTD
+C USER ENTRY POINT. SEE DOCUMENTATION FOR PURPOSE.
+      DATA IDUMMY /0/
+      CALL FDVDLD (3,IDUMMY,IDUMMY)
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE CURVED (X,Y,N)
+C USER ENTRY POINT.
+C
+      DIMENSION X(N),Y(N)
+C
+      CALL FRSTD (X(1),Y(1))
+      DO 10 I=2,N
+         CALL VECTD (X(I),Y(I))
+   10 CONTINUE
+C
+      CALL LASTD
+C
+      RETURN
+      END
+      SUBROUTINE LINED (XA,YA,XB,YB)
+C USER ENTRY POINT.
+C
+      DATA IDUMMY /0/
+      CALL FL2INT (XA,YA,IXA,IYA)
+      CALL FL2INT (XB,YB,IXB,IYB)
+C
+      CALL CFVLD (1,IXA,IYA)
+      CALL CFVLD (2,IXB,IYB)
+      CALL CFVLD (3,IDUMMY,IDUMMY)
+C
+      RETURN
+C
+C------REVISION HISTORY
+C
+C JUNE 1984          CONVERTED TO FORTRAN77 AND GKS
+C
+C DECEMBER 1979      ADDED REVISION HISTORY AND STATISTICS
+C                    CALL
+C
+C-----------------------------------------------------------------------
+C
+      END
diff --git a/sys/gio/ncarutil/ezmap.f b/sys/gio/ncarutil/ezmap.f
new file mode 100644
index 00000000..8d87a4d7
--- /dev/null
+++ b/sys/gio/ncarutil/ezmap.f
@@ -0,0 +1,4598 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C***********************************************************************
+C P A C K A G E   E Z M A P   -   I N T R O D U C T I O N
+C***********************************************************************
+C
+C THIS FILE CONTAINS IMPLEMENTATION INSTRUCTIONS, A WRITE-UP, AND THE
+C CODE FOR THE PACKAGE EZMAP.  BANNERS LIKE THE ONE ABOVE DELIMIT THE
+C MAJOR SECTIONS OF THE FILE.  THE CODE ITSELF IS SEPARATED INTO THREE
+C SECTIONS:  USER-LEVEL ROUTINES, INTERNAL ROUTINES, AND THE BLOCK DATA
+C ROUTINE WHICH DETERMINES THE DEFAULT VALUES OF INTERNAL PARAMETERS.
+C WITHIN EACH SECTION, ROUTINES APPEAR IN ALPHABETICAL ORDER.
+C
+C***********************************************************************
+C P A C K A G E   E Z M A P   -   I M P L E M E N T A T I O N
+C***********************************************************************
+C
+C THE EZMAP PACKAGE IS WRITTEN IN FORTRAN-77 AND SHOULD BE RELATIVELY
+C EASY TO IMPLEMENT.  THE OUTLINE DATA REQUIRED MAY BE GENERATED BY
+C RUNNING THE PROGRAM
+C
+C       PROGRAM CONVRT
+C       DIMENSION FLIM(4),PNTS(200)
+C     1 READ (1,3,END=2) NPTS,IGID,(FLIM(I),I=1,4)
+C       IF (NPTS.GT.1) READ (1,4,END=2) (PNTS(I),I=1,NPTS)
+C       WRITE (2) NPTS,IGID,(FLIM(I),I=1,4),(PNTS(I),I=1,NPTS)
+C       GO TO 1
+C     2 STOP
+C     3 FORMAT (2I8,4F8.3)
+C     4 FORMAT (10F8.3)
+C       END
+C
+C WITH THE FILE EZMAPDAT ASSIGNED TO UNIT 1.  THE OUTPUT FILE, ON UNIT
+C 2, CONTAINS THE BINARY OUTLINE DATA TO BE USED BY EZMAP.  THE EZMAP
+C ROUTINE MAPIO (WHICH SEE) MUST THEN BE MODIFIED TO ACCESS THIS FILE.
+C
+C THE ROUTINE MAPCHI CONTAINS THE STATEMENTS
+C
+C       CALL GETUSV ('IN',INTO)
+C       CALL SETUSV ('IN',IFIX(10000.*FLOAT(INTS(IPRT))/255.))
+C
+C (TO BE EXECUTED FOR A POSITIVE VALUE OF IPRT) AND THE STATEMENT
+C
+C       CALL SETUSV ('IN',INTO)
+C
+C (TO BE EXECUTED FOR A NEGATIVE VALUE OF IPRT).  THESE STATEMENTS
+C SET/RESET THE INTENSITY FOR VARIOUS PORTIONS OF THE MAP.  IF COLOR
+C IS AVAILABLE ON THE DEVICE(S) BEING DRIVEN, THESE STATEMENTS SHOULD
+C BE OMITTED AND THE IMPLEMENTOR SHOULD PROVIDE A DEFAULT VERSION OF
+C MAPUSR WHICH SETS/RESETS THE INTENSITY AND COLOR AS DESIRED.  THIS
+C DEFAULT VERSION OF MAPUSR SHOULD DECLARE THE LABELLED COMMON BLOCK
+C MAPNTS AND MAKE USE OF THE CURRENT VALUES IN THE ARRAY INTS TO SET
+C THE INTENSITY; IT SHOULD ALSO BE PUBLISHED TO AID USERS IN SETTING
+C UP THEIR OWN VERSIONS.
+C
+C
+C***********************************************************************
+C P A C K A G E   E Z M A P   -   U S E R ' S   G U I D E
+C***********************************************************************
+C
+C LATEST REVISION        AUGUST, 1985
+C
+C PURPOSE                TO PLOT MAPS OF THE EARTH ACCORDING TO ANY
+C                        ONE OF TEN DIFFERENT PROJECTIONS, SHOWING
+C                        CONTINENTAL, INTERNATIONAL, AND/OR U.S. STATE
+C                        OUTLINES, PARALLELS, AND MERIDIANS.  THE
+C                        ORIGIN AND ORIENTATION OF THE PROJECTION ARE
+C                        SELECTED BY THE USER.  POINTS ON THE EARTH
+C                        DEFINED BY LATITUDE AND LONGITUDE ARE MAPPED
+C                        TO POINTS IN THE PLANE OF PROJECTION - THE
+C                        U/V PLANE.  THE U AND V AXES ARE PARALLEL TO
+C                        THE X AND Y AXES OF THE PLOTTER, RESPECTIVELY.
+C                        A RECTANGULAR FRAME WHOSE SIDES ARE PARALLEL
+C                        TO THE U AND V AXES IS CHOSEN AND MATERIAL
+C                        WITHIN THAT FRAME (OR AN INSCRIBED ELLIPTICAL
+C                        FRAME) IS PLOTTED.
+C
+C USAGE                  THE ROUTINE MAPDRW DRAWS A COMPLETE MAP, AS
+C                        DIRECTED BY THE CURRENT VALUES OF PARAMETERS
+C                        IN THE EZMAP PACKAGE.  TO CHANGE THE VALUES
+C                        OF THOSE PARAMETERS, AND THUS THE APPEARANCE
+C                        OF THE MAP, ONE MAY FIRST CALL ONE OF THE
+C                        ROUTINES MAPROJ (TO CHANGE THE PROJECTION TO
+C                        BE USED), MAPSET (TO CHANGE WHAT PORTION OF
+C                        THE U/V PLANE IS TO BE VIEWED), MAPPOS (TO
+C                        CHANGE WHAT PORTION OF THE PLOTTER FRAME IS
+C                        TO BE USED), OR ONE OF THE PARAMETER-SETTING
+C                        ROUTINES MAPSTC, MAPSTI, MAPSTL, AND MAPSTR
+C                        (TO CHANGE VARIOUS OTHER PARAMETERS, OF TYPES
+C                        CHARACTER, INTEGER, LOGICAL, AND REAL).  THE
+C                        PARAMETER-RETRIEVAL ROUTINES MAPGTC, MAPGTI,
+C                        MAPGTL, AND MAPGTR ALLOW THE USER TO RETRIEVE
+C                        THE VALUES OF EZMAP PARAMETERS.
+C
+C                        THE ROUTINE MAPSAV ALLOWS ONE TO SAVE THE
+C                        CURRENT STATE OF EZMAP, THE ROUTINE MAPRST TO
+C                        RESTORE A SAVED STATE.
+C
+C                        USERS WITH SPECIAL NEEDS MAY WISH TO CALL THE
+C                        LOWER-LEVEL ROUTINES MAPINT (TO INITIALIZE
+C                        THE PACKAGE - IT MUST BE CALLED INITIALLY AND
+C                        AGAIN WHENEVER CERTAIN PARAMETERS ARE CHANGED),
+C                        MAPGRD (TO DRAW PARALLELS AND MERIDIANS),
+C                        MAPLBL (TO LABEL THE INTERNATIONAL DATE LINE,
+C                        THE EQUATOR, THE GREENWICH MERIDIAN, AND THE
+C                        POLES, AND TO DRAW THE PERIMETER), AND MAPLOT
+C                        (TO DRAW THE SELECTED GEOGRAPHIC OUTLINES).
+C                        THESE ROUTINES ARE NORMALLY CALLED BY MAPDRW.
+C
+C                        INTENSITIES OF VARIOUS MAP PORTIONS MAY BE SET
+C                        BY CALLS TO THE ROUTINE MAPSTI.  THE ROUTINE
+C                        MAPUSR IS CALLED BY EZMAP JUST BEFORE/AFTER
+C                        DRAWING VARIOUS PORTIONS OF THE MAP; THE
+C                        DEFAULT VERSION, WHICH DOES NOTHING, MAY BE
+C                        REPLACED BY A USER VERSION WHICH SETS/RESTORES
+C                        COLOR, SPOT SIZE, INTENSITY, DASH PATTERN, ETC.
+C
+C                        THE ROUTINE MAPEOS IS CALLED BY EZMAP ONCE FOR
+C                        EACH OUTLINE SEGMENT.  THE USER MAY SUPPLY A
+C                        VERSION WHICH EXAMINES THE SEGMENT TO SEE IF
+C                        IT OUGHT TO BE PLOTTED AND, IF NOT, TO DELETE
+C                        IT.  THIS MAY BE USED, FOR EXAMPLE, TO REDUCE
+C                        THE CLUTTER IN NORTHERN CANADA.
+C
+C                        TO OVERLAY OBJECTS OF ONE'S OWN ON THE MAP
+C                        DRAWN BY MAPDRW, ONE MAY USE ONE OR MORE OF
+C                        THE ROUTINES MAPTRN (TO COMPUTE THE U/V
+C                        COORDINATES OF A POINT, GIVEN ITS LATITUDE
+C                        AND LONGITUDE), MAPIT (TO DO "PEN-UP/DOWN"
+C                        MOVES), MAPFST (TO DO "PEN-UP" MOVES), AND
+C                        MAPVEC (TO DO "PEN-DOWN" MOVES).
+C
+C                        THE ROUTINE SUPMAP, FROM WHICH EZMAP GREW, IS
+C                        IMPLEMENTED WITHIN IT AND ALLOWS ONE TO DRAW
+C                        A COMPLETE MAP WITH A SINGLE, RATHER LENGTHY,
+C                        CALL.  THE ROUTINE SUPCON, WHICH IS THE OLD
+C                        ANALOGUE OF MAPTRN, IS ALSO IMPLEMENTED.
+C
+C                        THE OLD ROUTINE EZMAP, WHICH WAS IMPLEMENTED
+C                        IN SUCH A WAY AS TO CAUSE PORTABILITY PROBLEMS,
+C                        HAS BEEN REMOVED.  STATISTICS INDICATED THAT
+C                        IT WAS NOT BEING USED, ANYWAY.
+C
+C                        SEE THE WRITE-UPS OF INDIVIDUAL ROUTINES BELOW.
+C
+C I/O                    GRAPHICAL OUTPUT IS GENERATED.  OUTLINE DATA
+C                        IS READ FROM A "TAPE UNIT".
+C
+C ERROR CONDITIONS       WHEN AN ERROR OCCURS DURING A CALL TO AN EZMAP
+C                        ROUTINE, AN ERROR MESSAGE IS LOGGED, USING THE
+C                        NCAR VERSION OF THE PORT ERROR ROUTINE SETERR
+C                        (CALLED SETER); BY DEFAULT, THE PROGRAM IS THEN
+C                        ABORTED.  ERROR RECOVERY IS POSSIBLE, HOWEVER.
+C                        INSERT THE CALL
+C
+C                              CALL ENTSR (IOLD,1)
+C
+C                        AT THE BEGINNING OF YOUR PROGRAM.  THIS MAKES
+C                        ERROR RECOVERY POSSIBLE.  THEN, FOLLOWING EACH
+C                        CALL TO AN EZMAP ROUTINE WHICH COULD CAUSE AN
+C                        ERROR, INSERT CODE LIKE THE FOLLOWING:
+C
+C                              IF (NERRO(IERR).NE.0) THEN
+C                                CALL EPRIN
+C                                CALL ERROF
+C                              END IF
+C
+C                        THE VALUE OF THE FUNCTION NERRO IS NON-ZERO IF
+C                        SETER HAS BEEN CALLED.  THE CALL TO EPRIN DUMPS
+C                        OUT THE ERROR MESSAGE (WHICH HAS NOT YET BEEN
+C                        PRINTED) AND THE CALL TO ERROF TURNS OFF THE
+C                        ERROR CONDITION IN SETER.  THIS DOES NOT CLEAR
+C                        EZMAP'S ERROR FLAG, HOWEVER; IT REMAINS SET
+C                        UNTIL AFTER THE NEXT SUCCESSFUL CALL TO MAPINT,
+C                        PREVENTING OTHER EZMAP ROUTINES FROM TRYING TO
+C                        EXECUTE (AND POSSIBLY BOMBING AS A RESULT).
+C                        POSSIBLE ERROR FLAGS ARE AS FOLLOWS:
+C
+C                           1  MAPGTC - UNKNOWN PARAMETER NAME XX
+C                           2  MAPGTI - UNKNOWN PARAMETER NAME XX
+C                           3  MAPGTL - UNKNOWN PARAMETER NAME XX
+C                           4  MAPGTR - UNKNOWN PARAMETER NAME XX
+C                           5  MAPINT - ATTEMPT TO USE NON-EXISTENT
+C                                       PROJECTION
+C                           6  MAPINT - ANGULAR LIMITS TOO GREAT
+C                           7  MAPINT - MAP HAS ZERO AREA
+C                           8  MAPINT - MAP LIMITS INAPPROPIATE
+C                           9  MAPROJ - UNKNOWN PROJECTION NAME XX
+C                          10  MAPSET - UNKNOWN MAP AREA SPECIFIER XX
+C                          11  MAPSTC - UNKNOWN OUTLINE NAME XX
+C                          12  MAPSTC - UNKNOWN PARAMETER NAME XX
+C                          13  MAPSTI - UNKNOWN PARAMETER NAME XX
+C                          14  MAPSTL - UNKNOWN PARAMETER NAME XX
+C                          15  MAPSTR - UNKNOWN PARAMETER NAME XX
+C                          16  MAPTRN - ATTEMPT TO USE NON-EXISTENT
+C                                       PROJECTION
+C                          17  MAPIO -  OUTLINE DATASET IS UNREADABLE
+C                          18  MAPIO -  EOF ENCOUNTERED IN OUTLINE
+C                                       DATASET
+C                          19  MAPPOS - ARGUMENTS ARE INCORRECT
+C                          20  MAPRST - ERROR ON READ
+C                          21  MAPRST - EOF ON READ
+C                          22  MAPSAV - ERROR ON WRITE
+C
+C PRECISION              SINGLE.
+C
+C LANGUAGE               FORTRAN.
+C
+C HISTORY                IN ABOUT 1963, R. L. PARKER OF UCSD WROTE THE
+C                        ORIGINAL CODE CALLED SUPERMAP, USING OUTLINE
+C                        DATA GENERATED BY HERSHEY.  THIS WAS ADAPTED
+C                        FOR USE AT NCAR BY LEE, IN 1968.  REVISIONS
+C                        OCCURRED IN JANUARY OF 1969 AND MAY OF 1971.
+C                        THE CODE WAS PUT IN STANDARD NSSL FORMAT IN
+C                        OCTOBER OF 1973.  FURTHER REVISIONS OCCURRED
+C                        IN JULY, 1974, IN AUGUST, 1976, AND IN JULY,
+C                        1978.  IN LATE 1984 AND EARLY 1985, THE CODE
+C                        WAS HEAVILY REVISED TO ACHIEVE FORTRAN-77 AND
+C                        GKS COMPATIBILITY, TO REMOVE ERRORS, AND TO
+C                        EXPAND THE OUTLINE DATASETS.  CICELY RIDLEY,
+C                        JAY CHALMERS, AND DAVE KENNISON (THE CURRENT
+C                        CURATOR) HAVE ALL HAD A HAND IN THE CREATION
+C                        OF THIS PACKAGE.
+C
+C REFERENCES             HERSHEY, A.V., "THE PLOTTING OF MAPS ON A
+C                        CRT PRINTER."  NWL REPORT NO. 1844, 1963.
+C
+C                        LEE, TSO-HWA, "STUDENTS' SUMMARY REPORTS,
+C                        WORK-STUDY PROGRAM IN SCIENTIFIC COMPUTING".
+C                        NCAR, 1968.
+C
+C                        PARKER, R.L., "2UCSD SUPERMAP:  WORLD
+C                        PLOTTING PACKAGE".
+C
+C                        STEERS, J.A., "AN INTRODUCTION TO THE STUDY
+C                        OF MAP PROJECTIONS".  UNIVERSITY OF LONDON
+C                        PRESS, 1962.
+C
+C ACCURACY               THE DEFINITION OF THE MAP PRODUCED IS LIMITED
+C                        BY TWO FACTORS:  THE RESOLUTION OF THE OUTLINE
+C                        DATA AND THE RESOLUTION OF THE GRAPHICS
+C                        DEVICE.
+C
+C                        DATA POINTS IN THE CONTINENTAL OUTLINES ARE
+C                        ABOUT ONE DEGREE APART AND THE COORDINATES
+C                        ARE ACCURATE TO .01 DEGREE.  DATA POINTS IN
+C                        U.S. STATE OUTLINES ARE ABOUT .05 DEGREES
+C                        APART AND THE COORDINATES ARE ACCURATE TO
+C                        .001 DEGREE.  BOTH THE SPACING AND THE
+C                        ACCURACY OT THE INTERNATIONAL BOUNDARIES
+C                        FALLS SOMEWHERE BETWEEN THESE TWO EXTREMES.
+C
+C                        THE DICOMED HAS 15-BIT COORDINATE REGISTERS,
+C                        BUT AN EFFECTIVE RESOLUTION OF AT MOST 1 IN
+C                        4096 IN BOTH X AND Y.
+C
+C TIMING                 THE MARCH, 1985, UPDATE HAS MADE EZMAP RUN
+C                        SIGNIFICANTLY SLOWER.  THIS IS MOSTLY BECAUSE
+C                        THE DEFAULT RESOLUTION HAS BEEN INCREASED TO
+C                        A VALUE SUITABLE FOR THE DICOMED, RATHER THAN
+C                        THE DD80.  USERS WHO ARE CONCERNED ABOUT THIS
+C                        MAY INCREASE THE VALUES OF THE PARAMETERS 'MV'
+C                        AND/OR 'DD' (SEE THE DESCRIPTION OF MAPSTX)
+C                        TO DECREASE THE TIMING (AT THE EXPENSE OF PLOT
+C                        QUALITY, OF COURSE).
+C
+C PORTABILITY            THE CODE IS WRITTEN IN FORTRAN-77 AND SHOULD
+C                        BE VERY PORTABLE.  A BINARY DATASET CONTAINING
+C                        OUTLINE DATA MUST BE GENERATED AND THE ROUTINE
+C                        MAPIO MUST BE MODIFIED TO READ THAT DATASET.
+C                        SEE THE IMPLEMENTATION INSTRUCTIONS AT THE
+C                        BEGINNING OF THIS FILE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P D R W   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW THE COMPLETE MAP DESCRIBED BY THE
+C                        CURRENT VALUES OF THE EZMAP PARAMETERS.
+C
+C                        MAPDRW CALLS MAPINT (IF REQUIRED), MAPGRD,
+C                        MAPLBL, AND MAPLOT, IN THAT ORDER.  THE USER
+C                        MAY WISH TO CALL THESE ROUTINES DIRECTLY.
+C
+C USAGE                  CALL MAPDRW
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P E O S   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                MAPEOS IS CALLED BY EZMAP TO EXAMINE EACH
+C                        SEGMENT IN THE OUTLINE DATASETS.  THE DEFAULT
+C                        VERSION DOES NOTHING.  A USER-SUPPLIED VERSION
+C                        MAY CAUSE SELECTED SEGMENTS TO BE DELETED (TO
+C                        REDUCE THE CLUTTER IN NORTHERN CANADA, FOR
+C                        EXAMPLE).
+C
+C USAGE (BY EZMAP)       CALL MAPEOS (NOUT,NSEG,IGID,NPTS,PNTS)
+C
+C ARGUMENTS              NOUT IS THE NUMBER OF THE OUTLINE DATASET FROM
+C                        WHICH THE SEGMENT COMES, AS FOLLOWS:
+C
+C                          NOUT    DATASET TO WHICH SEGMENT BELONGS.
+C                          ----    ------------------------------------
+C                            1     'CO' - CONTINENTAL OUTLINES ONLY.
+C                            2     'US' - U.S STATE OUTLINES ONLY.
+C                            3     'PS' - CONTINENTAL, U.S STATE, AND
+C                                  INTERNATIONAL OUTLINES.
+C                            4     'PO' - CONTINENTAL AND INTERNATIONAL
+C                                  OUTLINES.
+C
+C                        NSEG IS THE NUMBER OF THE SEGMENT WITHIN THE
+C                        OUTLINE DATASET.
+C
+C                        IGID IDENTIFIES THE GROUP TO WHICH THE SEGMENT
+C                        BELONGS, AS FOLLOWS:
+C
+C                          IGID    GROUP TO WHICH SEGMENT BELONGS.
+C                          ----    ------------------------------------
+C                            1     CONTINENTAL OUTLINES.
+C                            2     U.S. STATE BOUNDARIES.
+C                            3     INTERNATIONAL BOUNDARIES.
+C
+C                        NPTS IS THE NUMBER OF POINTS DEFINING THE
+C                        OUTLINE SEGMENT.  NPTS MAY BE ZEROED TO
+C                        SUPPRESS PLOTTING OF THE SEGMENT.
+C
+C                        PNTS IS AN ARRAY OF COORDINATES.  PNTS(1)
+C                        AND PNTS(2) ARE THE LATITUDE AND LONGITUDE
+C                        OF THE FIRST POINT, PNTS(3) AND PNTS(4) THE
+C                        LATITUDE AND LONGITUDE OF THE SECOND POINT, ...
+C                        PNTS(2*NPTS-1) AND PNTS(2*NPTS) THE LATITUDE
+C                        AND LONGITUDE OF THE LAST POINT.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P F S T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW LINES ON THE MAP PRODUCED BY A CALL TO
+C                        MAPDRW - USED IN CONJUNCTION WITH MAPVEC.
+C
+C USAGE                  CALL MAPFST (RLAT,RLON)
+C
+C                        THIS CALL IS EXACTLY EQUIVALENT TO THE CALL
+C
+C                          CALL MAPIT (RLAT,RLON,0)
+C
+C ARGUMENTS              RLAT AND RLON ARE DEFINED AS FOR MAPIT.  SEE
+C                        THE DESCRIPTION OF MAPIT.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P G R D   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW A GRID MADE UP OF LINES OF LATITUDE AND
+C                        LONGITUDE.  IF EZMAP NEEDS INITIALIZATION OR IF
+C                        THE ERROR FLAG 'ER' IS NON-ZERO, MAPGRD DOES
+C                        NOTHING.
+C
+C USAGE                  CALL MAPGRD
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P G T X   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO GET THE VALUES OF EZMAP PARAMETERS.
+C
+C USAGE                  CALL MAPGTC (WHCH,CVAL)
+C                        CALL MAPGTI (WHCH,IVAL)
+C                        CALL MAPGTL (WHCH,LVAL)
+C                        CALL MAPGTR (WHCH,RVAL)
+C
+C ARGUMENTS              WHCH IS A CHARACTER STRING SPECIFYING THE
+C                        PARAMETER TO GET.
+C
+C                        CVAL, IVAL, LVAL, OR RVAL IS A VARIABLE TO
+C                        RECEIVE THE VALUE OF THE PARAMETER SPECIFIED
+C                        BY WHCH - OF TYPE CHARACTER, INTEGER, LOGICAL,
+C                        OR REAL, RESPECTIVELY.
+C
+C                        ALL OF THE PARAMETERS LISTED IN THE DISCUSSION
+C                        OF MAPSTX MAY BE RETRIEVED.  THE FOLLOWING MAY
+C                        ALSO BE RETRIEVED:
+C
+C                        WHCH       TYPE  MEANING
+C                        ----       ----  -------
+C
+C                        AREA          C  THE VALUE OF THE MAP LIMITS
+C                                         SPECIFIER JLTS FROM THE LAST
+C                                         CALL TO MAPSET.  THE DEFAULT
+C                                         VALUE IS 'MA'.
+C
+C                        ERROR         I  THE CURRENT VALUE OF THE ERROR
+C                                         FLAG.  DEFAULT IS ZERO.
+C
+C                        INITIALIZE  I,L  INITIALIZATION FLAG.  IF TRUE
+C                                         (NON-ZERO), EZMAP IS IN NEED
+C                                         OF INITIALIZATION (BY MEANS OF
+C                                         A CALL MAPINT).  THE DEFAULT
+C                                         VALUE IS TRUE (NON-ZERO).
+C
+C                        PROJECTION    C  THE VALUE OF THE PROJECTION
+C                                         SPECIFIER JPRJ FROM THE LAST
+C                                         CALL TO MAPROJ.  THE DEFAULT
+C                                         VALUE IS 'CE'.
+C
+C                        PN          I,R  THE VALUE OF PLON FROM THE
+C                                         LAST CALL TO MAPROJ.  THE
+C                                         DEFAULT VALUE IS ZERO.
+C
+C                        PT          I,R  THE VALUE OF PLAT FROM THE
+C                                         LAST CALL TO MAPROJ.  THE
+C                                         DEFAULT VALUE IS ZERO.
+C
+C                        PN          I,R  "N" IS AN INTEGER BETWEEN 1
+C                                         AND 8.  RETRIEVES VALUES FROM
+C                                         THE LAST CALL TO MAPSET.  P1
+C                                         THROUGH P4 GET YOU PLM1(1),
+C                                         PLM2(1), PLM3(1), AND PLM4(1),
+C                                         WHILE P5 THROUGH P8 GET YOU
+C                                         PLM1(2), PLM2(2), PLM3(2), AND
+C                                         PLM4(2).  THE DEFAULT VALUES
+C                                         ARE ALL ZERO.
+C
+C                        ROTATION    I,R  THE VALUE OF ROTA FROM THE
+C                                         LAST CALL TO MAPROJ.  THE
+C                                         DEFAULT VALUE IS ZERO.
+C
+C                        XLEFT         R  THE PARAMETERS XLOW, XROW,
+C                        XRIGHT        R  YBOW, AND YTOW FROM THE LAST
+C                        YBOTTOM       R  CALL TO MAPPOS.  DEFAULTS
+C                        YTOP          R  ARE .05, .95, .05, AND .95.
+C
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P I N T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO INITIALIZE THE PACKAGE AFTER THE VALUES OF
+C                        SOME PARAMETERS HAVE BEEN CHANGED.  THE FLAG
+C                        'IN', WHICH MAY BE RETRIEVED BY A CALL TO
+C                        MAPGTI OR MAPGTL, INDICATES WHETHER OR NOT
+C                        INITIALIZATION IS REQUIRED AT A GIVEN TIME.
+C                        (SOME PARAMETERS MAY BE RESET AT ANY TIME AND
+C                        DO NOT REQUIRE MAPINT TO BE CALLED AGAIN.)
+C
+C USAGE                  CALL MAPINT
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P I T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW LINES ON THE MAP PRODUCED BY A CALL
+C                        TO MAPDRW.  MAPIT ATTEMPTS TO OMIT NON-VISIBLE
+C                        PORTIONS AND TO HANDLE "CROSS-OVER" - A JUMP
+C                        FROM ONE END OF THE MAP TO THE OTHER CAUSED
+C                        BY THE PROJECTION'S HAVING SLIT THE GLOBE
+C                        ALONG SOME HALF OF A GREAT CIRCLE AND LAID IT
+C                        OPEN WITH THE TWO SIDES OF THE SLIT AT OPPOSITE
+C                        ENDS OF THE MAP.  CROSS-OVER CAN OCCUR ON
+C                        CYLINDRICAL AND CONICAL PROJECTIONS; MAPIT
+C                        HANDLES IT VERY WELL ON THE FORMER AND NOT SO
+C                        WELL ON THE LATTER.
+C
+C                        THE EZMAP PARAMETER 'DL' DETERMINES WHETHER
+C                        MAPIT DRAWS SOLID LINES OR DOTTED LINES.  THE
+C                        PARAMETERS 'DD' AND 'MV' ALSO AFFECT MAPIT'S
+C                        BEHAVIOR.  SEE THE DESCRIPTION OF THE ROUTINE
+C                        MAPSTX, BELOW.
+C
+C                        A SEQUENCE OF CALLS TO MAPIT SHOULD BE FOLLOWED
+C                        BY A CALL TO MAPIQ (WHICH SEE, ABOVE) TO FLUSH
+C                        ITS BUFFERS.
+C
+C                        POINTS IN TWO CONTIGUOUS PEN-DOWN CALLS TO
+C                        MAPIT SHOULD NOT BE FAR APART ON THE GLOBE.
+C
+C USAGE                  CALL MAPIT (RLAT,RLON,IFST)
+C
+C ARGUMENTS              RLAT AND RLON ARE THE LATITUDE AND LONGITUDE
+C                        OF A POINT TO WHICH THE "PEN" IS TO BE MOVED.
+C                        BOTH ARE GIVEN IN DEGREES.  RLAT MUST BE
+C                        BETWEEN -90. AND +90., INCLUSIVE; RLON MUST BE
+C                        BETWEEN -540. AND +540., INCLUSIVE.
+C
+C                        IFST IS 0 TO DO A "PEN-UP" MOVE, 1 TO DO A
+C                        "PEN-DOWN" MOVE IF THE DISTANCE FROM THE LAST
+C                        POINT TO THE NEW POINT IS GREATER THAN 'MV'
+C                        PLOTTER UNITS, 2 OR GREATER TO DO THE MOVE
+C                        REGARDLESS OF THE DISTANCE FROM THE LAST POINT
+C                        TO THE NEW ONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P I Q   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO FLUSH MAPIT'S BUFFERS.  THIS IS PARTICULARLY
+C                        IMPORTANT BEFORE A STOP OR A CALL FRAME AND
+C                        BEFORE CHANGING INTENSITY, DASH PATTERN, COLOR,
+C                        ETC.
+C
+C USAGE                  CALL MAPIQ
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P L B L   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO LABEL THE INTERNATIONAL DATE LINE (ID), THE
+C                        EQUATOR (EQ), THE GREENWICH MERIDIAN (GM), AND
+C                        THE POLES (NP AND SP), AND TO DRAW THE BORDER
+C                        AROUND THE MAP.  IF EZMAP NEEDS INITIALIZATION
+C                        OR IF THE ERROR FLAG 'ER' IS SET, MAPLBL DOES
+C                        NOTHING.
+C
+C USAGE                  CALL MAPLBL
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P L O T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW THE CONTINENTAL AND/OR INTERNATIONAL
+C                        AND/OR U.S. STATE OUTLINES SELECTED BY THE
+C                        PARAMETER 'OU'.  IF EZMAP CURRENTLY NEEDS
+C                        INITIALIZATION OR IF THE ERROR FLAG 'ER' IS
+C                        SET, MAPLOT DOES NOTHING.
+C
+C USAGE                  CALL MAPLOT
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P P O S   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO SPECIFY THE POSITION OF THE MAP ON THE
+C                        PLOTTER FRAME.
+C
+C USAGE                  CALL MAPPOS (XLOW,XROW,YBOW,YTOW)
+C
+C ARGUMENTS              THE ARGUMENTS ARE FRACTIONS BETWEEN 0 AND 1
+C                        DETERMINING THE POSITION OF A WINDOW IN THE
+C                        PLOTTER FRAME WITHIN WHICH THE MAP IS TO BE
+C                        DRAWN.  XLOW AND XROW POSITION THE LEFT AND
+C                        RIGHT EDGES AND ARE STATED AS FRACTIONS OF THE
+C                        DISTANCE FROM LEFT TO RIGHT IN THE PLOTTER
+C                        FRAME.  YBOW AND YTOW POSITION THE BOTTOM AND
+C                        TOP EDGES AND ARE STATED AS FRACTIONS OF THE
+C                        DISTANCE FROM BOTTOM TO TOP IN THE PLOTTER
+C                        FRAME.  THE MAP IS CENTERED IN THE SPECIFIED
+C                        WINDOW AND MADE AS LARGE AS POSSIBLE WHILE
+C                        MAINTAINING ITS PROPER SHAPE.
+C
+C                        THE DEFAULT VALUES OF THE INTERNAL PARAMETERS
+C                        CHANGED BY THIS ROUTINE ARE .05, .95, .05, AND
+C                        .95, RESPECTIVELY.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P R O J   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO SPECIFY THE PROJECTION TO BE USED.
+C
+C USAGE                  CALL MAPROJ (JPRJ,PLAT,PLON,ROTA)
+C
+C ARGUMENTS              JPRJ IS A CHARACTER VARIABLE DEFINING THE
+C                        DESIRED PROJECTION TYPE, AS FOLLOWS:
+C
+C                        THE CONIC PROJECTION:
+C
+C                            'LC' - LAMBERT CONFORMAL CONIC WITH TWO
+C                                   STANDARD PARALLELS.
+C
+C                        THE AZIMUTHAL PROJECTIONS:
+C
+C                            'ST' - STEREOGRAPHIC.
+C
+C                            'OR' - ORTHOGRAPHIC.  CAUSES THE PARAMETER
+C                                   'SA' (WHICH SEE, IN THE DESCRIPTION
+C                                   OF THE ROUTINE MAPSTX) TO BE ZEROED.
+C
+C                            'LE' - LAMBERT EQUAL AREA.
+C
+C                            'GN' - GNOMONIC.
+C
+C                            'AE' - AZIMUTHAL EQUIDISTANT.
+C
+C                            'SV' - SATELLITE-VIEW.  IF THE PARAMETER
+C                                   'SA' (WHICH SEE, IN THE DESCRIPTION
+C                                   OF THE ROUTINE MAPSTX) IS GREATER
+C                                   THAN 1 OR LESS THAN -1, IT IS LEFT
+C                                   ALONE; OTHERWISE, IT IS GIVEN THE
+C                                   VALUE 6.631.
+C
+C                        THE CYLINDRICAL PROJECTIONS:
+C
+C                            'CE' - CYLINDRICAL EQUIDISTANT.
+C
+C                            'ME' - MERCATOR.
+C
+C                            'MO' - MOLLWEIDE.  THE PROJECTION USED IS
+C                                   NOT ACTUALLY A TRUE MOLLWEIDE.
+C
+C                        PLAT, PLON, AND ROTA ARE REALS SPECIFYING THE
+C                        VALUES OF ANGULAR QUANTITIES, IN DEGREES.  HOW
+C                        THEY ARE USED DEPENDS ON THE VALUE OF JPRJ, AS
+C                        FOLLOWS:
+C
+C                        IF JPRJ IS NOT EQUAL TO 'LC':  PLAT AND PLON
+C                        DEFINE THE LATITUDE AND LONGITUDE OF THE POLE
+C                        OF THE PROJECTION - THE POINT ON THE GLOBE
+C                        WHICH IS TO BE PROJECTED TO THE ORIGIN OF THE
+C                        U/V PLANE.  PLAT MUST BE BETWEEN -90. AND +90.,
+C                        INCLUSIVE, POSITIVE IN THE NORTHERN HEMISPHERE,
+C                        NEGATIVE IN THE SOUTHERN.  PLON MUST BE BETWEEN
+C                        -180. AND +180., INCLUSIVE, POSITIVE TO THE
+C                        EAST, AND NEGATIVE TO THE WEST, OF GREENWICH.
+C                        ROTA IS THE ANGLE BETWEEN THE V AXIS AND NORTH
+C                        AT THE ORIGIN.  IT IS TAKEN TO BE POSITIVE IF
+C                        THE ANGULAR MOVEMENT FROM NORTH TO THE V AXIS
+C                        IS COUNTER-CLOCKWISE, NEGATIVE OTHERWISE.  IF
+C                        THE ORIGIN IS AT THE NORTH POLE, "NORTH" IS
+C                        CONSIDERED TO BE IN THE DIRECTION OF PLON+180.
+C                        IF THE ORIGIN IS AT THE SOUTH POLE, "NORTH" IS
+C                        CONSIDERED TO BE IN THE DIRECTION OF PLON.
+C                        FOR THE CYLINDRICAL PROJECTIONS, THE AXIS OF
+C                        THE PROJECTION IS PARALLEL TO THE V AXIS.
+C
+C                        IF JPRJ IS EQUAL TO 'LC' (LAMBERT CONFORMAL
+C                        CONIC WITH TWO STANDARD PARALLELS):  PLON
+C                        DEFINES THE CENTRAL MERIDIAN OF THE PROJECTION,
+C                        WHILE PLAT AND ROTA DEFINE THE TWO STANDARD
+C                        PARALLELS.  IF PLAT AND ROTA ARE EQUAL, A
+C                        CONIC PROJECTION WITH ONE STANDARD PARALLEL
+C                        IS USED.
+C
+C                        MORE DETAILED DESCRIPTIONS OF THE PROJECTIONS
+C                        MAY BE FOUND IN THE GRAPHICS MANUAL, TOGETHER
+C                        WITH HELPFUL DIAGRAMS, BUT A FEW WORDS MAY BE
+C                        HELPFUL HERE:
+C
+C                        THE CONICAL PROJECTION MAPS THE SURFACE OF THE
+C                        EARTH ONTO THE SURFACE OF A CONE INTERSECTING
+C                        THE EARTH ALONG THE TWO STANDARD PARALLELS.
+C                        THE CONE IS THEN SLIT ALONG A LINE OPPOSITE
+C                        THE CENTRAL MERIDIAN AND OPENED UP (WITH SOME
+C                        STRETCHING) ONTO A FLAT SURFACE.
+C
+C                        THE AZIMUTHAL PROJECTIONS MAP THE SURFACE OF
+C                        THE EARTH (OR OF ONE HEMISPHERE OF THE EARTH)
+C                        ONTO A PLANE WHOSE ORIGIN IS TANGENT TO IT AT
+C                        THE POINT (PLAT,PLON).  THE SEVERAL AZIMUTHAL
+C                        PROJECTIONS DIFFER ONLY IN THE FUNCTION USED
+C                        TO MAP THE GREAT-CIRCLE DISTANCE OF A POINT
+C                        FROM THE POLE (PLAT,PLON) TO A LINEAR DISTANCE
+C                        OF THE PROJECTED POINT FROM THE ORIGIN (0,0).
+C                        THE PROJECTED IMAGE MAY BE ROTATED USING THE
+C                        PARAMETER ROTA.
+C
+C                        THE CYLINDRICAL PROJECTIONS MAP THE SURFACE OF
+C                        THE EARTH ONTO A CYLINDER WHICH IS TANGENT TO
+C                        IT ALONG A GREAT CIRCLE PASSING THROUGH THE
+C                        POINT (PLAT,PLON) AT AN ANGLE DETERMINED BY
+C                        ROTA.  THE CYLINDER IS THEN SLIT ALONG ITS
+C                        LENGTH THROUGH THE POINT OPPOSITE (PLAT,PLON)
+C                        AND OPENED UP ONTO THE PLANE.  THE SEVERAL
+C                        CYLINDRICAL PROJECTIONS DIFFER PRINCIPALLY IN
+C                        THE FUNCTION USED TO MAP THE DISTANCE FROM THE
+C                        GREAT CIRCLE OF TANGENCY TO A DISTANCE ALONG
+C                        THE CYLINDER.  IF PLAT IS ZERO AND ROTA IS
+C                        EITHER 0. OR 180., THE CYLINDRICAL PROJECTIONS
+C                        ARE PARTICULARLY SIMPLE TO DO AND A FASTER PATH
+C                        THROUGH THE CODE IS USED.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P R S   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                RECALLS SET.  INTENDED TO BE USED WHEN DATA
+C                        IS TO BE PLOTTED OVER A MAP GENERATED IN A
+C                        DIFFERENT OVERLAY (E.G., USING A FLASH BUFFER),
+C                        AND WHEN THE SYSTEM PLOT PACKAGE DOES NOT
+C                        RESIDE IN AN OUTER OVERLAY.
+C
+C USAGE                  CALL MAPRS
+C
+C ARGUMENTS              NONE.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P R S T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                RESTORES A SAVED STATE OF EZMAP.  THIS IS DONE
+C                        BY READING SAVED PARAMETER VALUES FROM A USER
+C                        UNIT AND THEN CALLING MAPINT.  SEE MAPSAV.
+C
+C USAGE                  CALL MAPRST (IFNO)
+C
+C ARGUMENTS              IFNO IS THE NUMBER OF A UNIT FROM WHICH A
+C                        SINGLE UNFORMATTED RECORD IS TO BE READ.  IT
+C                        IS THE USER'S RESPONSIBILITY TO POSITION THIS
+C                        UNIT.  MAPRST DOES NOT REWIND IT, EITHER BEFORE
+C                        OR AFTER READING THE RECORD.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P S A V   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                SAVES THE CURRENT STATE OF EZMAP BY WRITING
+C                        PARAMETER VALUES ONTO A USER UNIT.  SEE MAPRST.
+C
+C USAGE                  CALL MAPSAV (IFNO)
+C
+C ARGUMENTS              IFNO IS THE NUMBER OF A UNIT TO WHICH A SINGLE
+C                        UNFORMATTED RECORD IS TO BE WRITTEN.  IT IS THE
+C                        USER'S RESPONSIBILITY TO POSITION THIS UNIT.
+C                        MAPSAV DOES NOT REWIND IT, EITHER BEFORE OR
+C                        AFTER WRITING THE RECORD.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P S E T   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO SPECIFY THE RECTANGULAR PORTION OF THE U/V
+C                        PLANE TO BE DRAWN.
+C
+C USAGE                  CALL MAPSET (JLTS,PLM1,PLM2,PLM3,PLM4)
+C
+C ARGUMENTS              JLTS CAN HAVE THE FOLLOWING CHARACTER VALUES.
+C                        IT SPECIFIES ONE OF FIVE WAYS IN WHICH THE
+C                        LIMITS OF THE MAP ARE DEFINED BY THE PARAMETERS
+C                        PLM1, PLM2, PLM3, AND PLM4.
+C
+C                        JLTS='MA' (MAXIMUM).  THE MAXIMUM USEFUL AREA
+C                        PRODUCED BY THE PROJECTION IS PLOTTED.  PLM1,
+C                        PLM2, PLM3, AND PLM4 ARE NOT USED.
+C
+C                        JLTS='CO' (CORNERS).  THE POINTS (PLM1,PLM2)
+C                        AND (PLM3,PLM4) ARE TO BE AT OPPOSITE CORNERS
+C                        OF THE MAP.  PLM1 AND PLM3 ARE LATITUDES, IN
+C                        DEGREES.  PLM2 AND PLM4 ARE LONGITUDES, IN
+C                        DEGREES.  IF A CYLINDRICAL PROJECTION IS BEING
+C                        USED, THE FIRST POINT SHOULD BE ON THE LEFT
+C                        EDGE OF THE MAP AND THE SECOND POINT ON THE
+C                        RIGHT EDGE; OTHERWISE, THE ORDER MAKES NO
+C                        DIFFERENCE.
+C
+C                        JLTS='PO' (POINTS).  PLM1, PLM2, PLM3, AND PLM4
+C                        ARE TWO-ELEMENT ARRAYS GIVING THE LATITUDES
+C                        AND LONGITUDES, IN DEGREES, OF FOUR POINTS
+C                        WHICH ARE TO BE ON THE EDGES OF THE RECTANGULAR
+C                        MAP.  IF A CYLINDRICAL PROJECTION IS BEING
+C                        USED, THE FIRST POINT SHOULD BE ON THE LEFT
+C                        EDGE AND THE SECOND POINT ON THE RIGHT EDGE;
+C                        OTHERWISE, THE ORDER MAKES NO DIFFERENCE.
+C                        NOTE THAT THE CALLING PROGRAM SHOULD INCLUDE
+C                        THE FOLLOWING STATEMENT:
+C
+C                          DIMENSION PLM1(2),PLM2(2),PLM3(2),PLM4(2)
+C
+C                        (IN FACT, STRICT ADHERENCE TO THE FORTRAN-77
+C                        STANDARD REQUIRES THIS, NO MATTER WHAT THE
+C                        VALUE OF JLTS.)
+C
+C                        JLTS='AN' (ANGLES).  PLM1, PLM2, PLM3, AND PLM4
+C                        ARE POSITIVE ANGLES, IN DEGREES, REPRESENTING
+C                        ANGULAR DISTANCES FROM A POINT ON THE MAP TO
+C                        THE LEFT, RIGHT, BOTTOM, AND TOP EDGES OF THE
+C                        MAP.  FOR MOST PROJECTIONS, THESE ANGLES ARE
+C                        MEASURED WITH THE CENTER OF THE EARTH AT THE
+C                        VERTEX AND REPRESENT ANGULAR DISTANCES FROM THE
+C                        POINT WHICH PROJECTS TO THE ORIGIN OF THE U/V
+C                        PLANE; ON A SATELLITE-VIEW PROJECTION, THEY ARE
+C                        MEASURED WITH THE SATELLITE AT THE VERTEX AND
+C                        REPRESENT ANGULAR DEVIATIONS FROM THE LINE OF
+C                        SIGHT.  ANGULAR LIMITS ARE PARTICULARLY USEFUL
+C                        FOR POLAR PROJECTIONS AND THE SATELLITE-VIEW
+C                        PROJECTION; THEY ARE NOT APPROPRIATE FOR THE
+C                        LAMBERT CONFORMAL CONIC AND AN ERROR WILL
+C                        RESULT IF ONE ATTEMPTS TO USE JLTS='AN' WITH
+C                        JPRJ='LC'.
+C
+C                        JLTS='LI' (LIMITS).  PLM1, PLM2, PLM3, AND PLM4
+C                        SPECIFY THE MINIMUM VALUE OF U, THE MAXIMUM
+C                        VALUE OF U, THE MINIMUM VALUE OF V, AND THE
+C                        MAXIMUM VALUE OF V, RESPECTIVELY.  KNOWLEDGE
+C                        OF THE PROJECTION EQUATIONS IS NECESSARY IN
+C                        ORDER TO USE THIS OPTION CORRECTLY.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P S T X   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO SET THE VALUES OF EZMAP PARAMETERS.
+C
+C USAGE                  CALL MAPSTC (WHCH,CVAL)
+C                        CALL MAPSTI (WHCH,IVAL)
+C                        CALL MAPSTL (WHCH,LVAL)
+C                        CALL MAPSTR (WHCH,RVAL)
+C
+C ARGUMENTS              WHCH IS A CHARACTER STRING SPECIFYING THE
+C                        PARAMETER TO BE SET.
+C
+C                        CVAL, IVAL, LVAL, OR RVAL IS THE VALUE TO BE
+C                        GIVEN TO THE PARAMETER SPECIFIED BY WHCH - OF
+C                        TYPE CHARACTER, INTEGER, LOGICAL, OR REAL,
+C                        RESPECTIVELY.
+C
+C                        SOME PARAMETERS MAY BE SET IN MORE THAN ONE
+C                        WAY.  FOR EXAMPLE, THE PARAMETER 'GR' (GRID),
+C                        WHICH SPECIFIES THE GRID SPACING, MAY BE GIVEN
+C                        THE VALUE 10.0 IN EITHER OF TWO WAYS:
+C
+C                          CALL MAPSTI ('GR',10)
+C                          CALL MAPSTR ('GR',10.)
+C
+C                        THE FLAG WHICH CONTROLS DOTTING OF OUTLINES
+C                        MAY BE TURNED ON USING EITHER OF THESE CALLS:
+C
+C                          CALL MAPSTI ('DO',1)
+C                          CALL MAPSTL ('DO',.TRUE.)
+C
+C                        THE IMPORTANT POINT TO REMEMBER IS THAT THE
+C                        LAST CHARACTER OF THE ROUTINE NAME IMPLIES
+C                        THE TYPE OF THE ARGUMENT.
+C
+C                        ONLY THE FIRST TWO CHARACTERS OF WHCH ARE
+C                        EXAMINED.  FOR THE SAKE OF CODE READABILITY,
+C                        A LONGER CHARACTER STRING MAY BE USED.
+C
+C                        BELOW IS A LIST OF ALL THE PARAMETERS WHICH
+C                        MAY BE SET USING THESE ROUTINES.
+C
+C                        WHCH       TYPE  MEANING
+C                        ----       ----  -------
+C
+C                        DASHPATTERN   I  DASHED-LINE PATTERN FOR THE
+C                                         GRIDS.  A 16-BIT QUANTITY.
+C                                         DEFAULT IS 21845 (OCTAL 52525
+C                                         OR BINARY 0101010101010101).
+C
+C                        DD          I,R  DISTANCE BETWEEN DOTS ALONG A
+C                                         DOTTED LINE DRAWN BY MAPIT.
+C                                         THE DEFAULT VALUE IS 12 (OUT
+C                                         OF 4096; SEE 'RE', BELOW).
+C
+C                        DL          I,L  IF TRUE (NON-ZERO), USER CALLS
+C                                         TO MAPIT DRAW DOTTED LINES.
+C                                         DEFAULT IS FALSE (ZERO); LINES
+C                                         DRAWN BY MAPIT ARE SOLID OR
+C                                         DASHED, DEPENDING ON THE
+C                                         CURRENT STATE OF THE DASHCHAR
+C                                         PACKAGE.
+C
+C                        DOT         I,L  IF TRUE (NON-ZERO), OUTLINES
+C                                         ARE DOTTED.  DEFAULT IS FALSE
+C                                         (ZERO); OUTLINES ARE SOLID.
+C
+C                        ELLIPTICAL  I,L  IF TRUE (NON-ZERO), ONLY THAT
+C                                         PART OF THE MAP WHICH FALLS
+C                                         INSIDE AN ELLIPSE INSCRIBED
+C                                         WITHIN THE NORMAL RECTANGULAR
+C                                         PERIMETER IS DRAWN.  THIS IS
+C                                         PARTICULARLY APPROPRIATE FOR
+C                                         USE WITH AZIMUTHAL PROJECTIONS
+C                                         AND ANGULAR LIMITS SPECIFYING
+C                                         A SQUARE, IN WHICH CASE THE
+C                                         ELLIPSE BECOMES A CIRCLE, BUT
+C                                         IT WILL WORK FOR ANY MAP.  THE
+C                                         DEFAULT VALUE IS ZERO.
+C
+C                        GD            R  THE DISTANCE BETWEEN POINTS
+C                                         USED TO DRAW THE GRID, IN
+C                                         DEGREES.  THE DEFAULT VALUE
+C                                         IS 1.; USER VALUES MUST FALL
+C                                         BETWEEN .001 AND 10.
+C
+C                        GRID        I,R  THE DESIRED GRID SPACING.  A
+C                                         ZERO SUPPRESSES THE GRID.  THE
+C                                         DEFAULT IS 10 DEGREES.
+C
+C                        IN            I  "N" IS AN INTEGER BETWEEN 1
+C                                         AND 7.  EACH "IN" SPECIFIES
+C                                         THE INTENSITY OF SOME PORTION
+C                                         OF THE MAP.  VALUES ARE IN THE
+C                                         RANGE 0-255.  DEFAULTS ARE:
+C
+C                                           N   USE           DEFAULT
+C                                           -   -----------   -------
+C                                           1   PERIMETER        240
+C                                           2   GRID             150
+C                                           3   LABELS           210
+C                                           4   LIMBS            240
+C                                           5   CONTINENTS       240
+C                                           6   U.S. STATES      180
+C                                           7   COUNTRIES        210
+C
+C                        LABEL       I,L  IF TRUE (NON-ZERO), LABEL THE
+C                                         MERIDIANS AND POLES.  DEFAULT
+C                                         IS TRUE (NON-ZERO).
+C
+C                        LS            I  CONTROLS LABEL SIZE.  A
+C                                         CHARACTER WIDTH, TO BE USED
+C                                         IN CALLING PWRIT.  THE DEFAULT
+C                                         VALUE IS 1, WHICH GIVES A
+C                                         CHARACTER WIDTH OF 12 PLOTTER
+C                                         UNITS.
+C
+C                        MV          I,R  MINIMUM VECTOR LENGTH FOR
+C                                         OUTLINES.  A POINT CLOSER TO
+C                                         THE PREVIOUS POINT THAN THIS
+C                                         IS OMITTED.  DEFAULT VALUE IS
+C                                         4 (OUT OF 4096; SEE 'RE',
+C                                         BELOW).
+C
+C                        OUTLINE       C  SAYS WHICH SET OF OUTLINE DATA
+C                                         TO USE.  POSSIBLE VALUES ARE
+C                                         'NO', FOR NO OUTLINES, 'CO',
+C                                         FOR THE CONTINENTAL OUTLINES
+C                                         (THE DEFAULT), 'US', FOR U.S.
+C                                         STATE OUTLINES, 'PS', FOR
+C                                         CONTINENTAL OUTLINES PLUS
+C                                         INTERNATIONAL OUTLINES PLUS
+C                                         U.S. STATE OUTLINES, AND 'PO',
+C                                         FOR CONTINENTAL OUTLINES PLUS
+C                                         INTERNATIONAL OUTLINES.
+C                                         DEFAULT IS 'CO'.
+C
+C                        PERIM       I,L  IF TRUE (NON-ZERO), DRAW THE
+C                                         PERIMETER.  DEFAULT IS TRUE
+C                                         (NON-ZERO).
+C
+C                        RESOLUTION  I,R  THE WIDTH OF THE TARGET
+C                                         PLOTTER, IN PLOTTER UNITS.
+C                                         DEFAULT VALUE IS 4096.
+C
+C                        SATELLITE   I,R  IF LESS THAN -1 OR GREATER
+C                                         THAN 1, CHANGES ORTHOGRAPHIC
+C                                         PROJECTION TO SATELLITE-VIEW.
+C                                         ABSOLUTE VALUE IS THE DISTANCE
+C                                         OF SATELLITE FROM THE CENTER
+C                                         OF THE EARTH, IN MULTIPLES OF
+C                                         THE EARTH'S RADIUS.  THE SIGN
+C                                         INDICATES WHETHER A NORMAL
+C                                         PROJECTION (POSITIVE) OR AN
+C                                         EXTENDED PROJECTION (NEGATIVE)
+C                                         IS TO BE USED.  THE EXTENDED
+C                                         PROJECTION IS USEFUL WHEN ONE
+C                                         IS OVERLAYING CONREC OUTPUT ON
+C                                         A MAP.  THE DEFAULT VALUE OF
+C                                         'SA' IS ZERO.  SEE ALSO 'S1'
+C                                         AND 'S2', BELOW.
+C
+C                        S1 AND S2   I,R  USED ONLY WHEN 'SA' IS OUTSIDE
+C                                         [-1,1].  BOTH ARE ANGLES, IN
+C                                         DEGREES.  'S1' MEASURES THE
+C                                         ANGLE BETWEEN THE CENTER OF
+C                                         THE EARTH AND THE AIM POINT
+C                                         OF THE SATELLITE'S CAMERA, AS
+C                                         SEEN FROM THE SATELLITE.  IF
+C                                         'S1' IS ZERO, THE PROJECTION
+C                                         SHOWS THE EARTH AS SEEN BY A
+C                                         SATELLITE LOOKING STRAIGHT
+C                                         DOWN; CALL THIS THE "BASIC
+C                                         VIEW".  IF 'S1' IS NON-ZERO,
+C                                         'S2' MEASURES THE ANGLE FROM
+C                                         THE POSITIVE U AXIS OF THE
+C                                         BASIC VIEW TO THE LINE OP,
+C                                         WHERE O IS THE ORIGIN OF THE
+C                                         BASIC VIEW AND P IS THE
+C                                         PROJECTION OF THE DESIRED LINE
+C                                         OF SIGHT ON THE BASIC VIEW,
+C                                         POSITIVE IF MEASURED COUNTER-
+C                                         CLOCKWISE.
+C
+C                        SR            R  A SEARCH RADIUS, IN DEGREES.
+C                                         USED BY MAPINT IN FINDING THE
+C                                         LATITUDE/LONGITUDE RANGE OF
+C                                         THE MAP.  THE DEFAULT VALUE
+C                                         IS 1.; USER VALUES MUST FALL
+C                                         BETWEEN .001 AND 10.  THIS
+C                                         PARAMETER SHOULD PROBABLY NOT
+C                                         BE CHANGED EXCEPT BY ADVICE
+C                                         OF A KNOWLEDGEABLE CONSULTANT.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P T R N   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO FIND THE PROJECTION IN THE U/V PLANE OF A
+C                        POINT WHOSE LATITUDE AND LONGITUDE ARE KNOWN.
+C                        MAY BE CALLED AT ANY TIME AFTER EZMAP HAS BEEN
+C                        INITIALIZED (BY CALLING MAPINT OR OTHERWISE).
+C
+C USAGE                  CALL MAPTRN (RLAT,RLON,UVAL,VVAL)
+C
+C ARGUMENTS              RLAT AND RLON ARE THE LATITUDE AND LONGITUDE,
+C                        RESPECTIVELY, OF A POINT ON THE GLOBE.  RLAT
+C                        MUST BE BETWEEN -90. AND +90., INCLUSIVE; RLON
+C                        MUST BE BETWEEN -540. AND +540., INCLUSIVE.
+C
+C                        (UVAL,VVAL) IS THE PROJECTION IN THE U/V PLANE
+C                        OF (RLAT,RLON).  THE UNITS OF UVAL AND VVAL
+C                        DEPEND ON THE PROJECTION.
+C
+C                        IF THE POINT IS NOT PROJECTABLE, UVAL IS
+C                        RETURNED EQUAL TO 1.E12.  NOTE THAT, IF
+C                        THE POINT IS PROJECTABLE, BUT OUTSIDE THE
+C                        BOUNDARY OF THE MAP, AS DEFINED BY THE LAST
+C                        CALL TO MAPSET, ITS U AND V COORDINATES ARE
+C                        STILL RETURNED BY MAPTRN.  THE USER MUST DO
+C                        THE TEST REQUIRED TO DETERMINE IF THE POINT
+C                        IS WITHIN LIMITS, IF THAT IS NECESSARY.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P U S R   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                THE ROUTINE MAPUSR IS CALLED BY EZMAP JUST
+C                        BEFORE AND JUST AFTER PORTIONS OF THE MAP
+C                        ARE DRAWN.  THE DEFAULT VERSION DOES NOTHING.
+C                        (ACTUALLY, THAT'S NOT QUITE TRUE; FOR THE SAKE
+C                        OF EFFICIENCY, THE NON-GKS VERSIONS RESETS THE
+C                        DASH PATTERN FOR GRID LINES TO "SOLID" AND
+C                        THEN DOES AN OPTN CALL TO MAKE THE TRANSLATOR
+C                        GENERATE THE DESIRED PATTERN.)  A USER-SUPPLIED
+C                        VERSION MAY SET/RESET THE DOTTING PARAMETER
+C                        'DL', THE DASHCHAR DASH PATTERN, THE INTENSITY,
+C                        THE COLOR, ETC., SO AS TO ACHIEVE A DESIRED
+C                        EFFECT.
+C
+C USAGE (BY EZMAP)       CALL MAPUSR (IPRT)
+C
+C ARGUMENTS              IPRT, IF POSITIVE, SAYS THAT A PARTICULAR PART
+C                        OF THE MAP IS ABOUT TO BE DRAWN, AS FOLLOWS:
+C
+C                          IPRT  PART
+C                          ----  -----------------------
+C                            1   PERIMETER.
+C                            2   GRID.
+C                            3   LABELS.
+C                            4   LIMB LINES.
+C                            5   CONTINENTAL OUTLINES.
+C                            6   U.S. STATE OUTLINES.
+C                            7   INTERNATIONAL OUTLINES.
+C
+C                        IF IPRT IS NEGATIVE, IT SAYS THAT DRAWING OF
+C                        THE LAST PART IS COMPLETE.  THE ABSOLUTE VALUE
+C                        OF IPRT WILL BE ONE OF THE ABOVE VALUES.
+C                        CHANGED QUANTITIES SHOULD BE RESTORED.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   M A P V E C   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO DRAW LINES ON THE MAP PRODUCED BY A CALL TO
+C                        MAPDRW - USED IN CONJUNCTION WITH MAPFST.
+C
+C USAGE                  CALL MAPVEC (RLAT,RLON)
+C
+C                        THIS CALL IS EXACTLY EQUIVALENT TO THE CALL
+C
+C                          CALL MAPIT (RLAT,RLON,1)
+C
+C ARGUMENTS              RLAT AND RLON ARE DEFINED AS FOR MAPIT.  SEE
+C                        THE DESCRIPTION OF MAPIT.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   S U P C O N   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                TO FIND THE PROJECTION IN THE U/V PLANE OF A
+C                        POINT WHOSE LATITUDE AND LONGITUDE ARE KNOWN.
+C                        THIS ROUTINE IS PROVIDED FOR COMPATIBILITY
+C                        WITH EARLIER VERSIONS OF THE PACKAGE.  IF
+C                        EFFICIENCY IS A CONSIDERATION, THE USER SHOULD
+C                        BY-PASS THIS ROUTINE AND CALL MAPTRN DIRECTLY.
+C
+C USAGE                  CALL SUPCON (RLAT,RLON,UVAL,VVAL)
+C
+C                        THIS CALL IS EXACTLY EQUIVALENT TO THE CALL
+C
+C                          CALL MAPTRN (RLAT,RLON,UVAL,VVAL)
+C
+C ARGUMENTS              RLAT, RLON, UVAL, AND VVAL ARE DEFINED AS FOR
+C                        THE ROUTINE MAPTRN.  SEE THE DESCRIPTION OF
+C                        MAPTRN.
+C
+C-----------------------------------------------------------------------
+C S U B R O U T I N E   S U P M A P   -   D E S C R I P T I O N
+C-----------------------------------------------------------------------
+C
+C PURPOSE                AN IMPLEMENTATION OF THE ROUTINE FROM WHICH
+C                        EZMAP GREW.  A SINGLE CALL TO SUPMAP CREATES
+C                        A MAP OF A DESIRED PORTION OF THE GLOBE,
+C                        ACCORDING TO A DESIRED PROJECTION, WITH DESIRED
+C                        OUTLINES DRAWN IN, AND WITH LINES OF LATITUDE
+C                        AND LONGITUDE AT DESIRED INTERVALS.  AN
+C                        APPROPRIATE CALL TO THE ROUTINE SET IS
+C                        PERFORMED, AND THE ROUTINE SUPCON (WHICH SEE)
+C                        IS INITIALIZED SO THAT THE USER MAY MAP POINTS
+C                        OF KNOWN LATITUDE AND LONGITUDE TO POINTS IN
+C                        THE U/V PLANE AND USE THE U/V COORDINATES TO
+C                        DRAW OBJECTS ON THE MAP PRODUCED BY SUPMAP.
+C
+C USAGE                  CALL SUPMAP (JPRJ,PLAT,PLON,ROTA,PLM1,PLM2,
+C                                     PLM3,PLM4,JLTS,JGRD,IOUT,IDOT,
+C                                     IERR)
+C
+C ARGUMENTS              IABS(JPRJ) DEFINES THE PROJECTION TYPE, AS
+C                        FOLLOWS (VALUES LESS THAN 1 OR GREATER THAN
+C                        10 ARE TREATED AS 1 OR 10, RESPECTIVELY):
+C
+C                           1  STEREOGRAPHIC.
+C                           2  ORTHOGRAPHIC.
+C                           3  LAMBERT CONFORMAL CONIC.
+C                           4  LAMBERT EQUAL AREA.
+C                           5  GNOMONIC.
+C                           6  AZIMUTHAL EQUIDISTANT.
+C                           7  SATELLITE VIEW.
+C                           8  CYLINDRICAL EQUIDISTANT.
+C                           9  MERCATOR.
+C                          10  MOLLWEIDE.
+C
+C                        USING THE VALUE 2 CAUSES THE PARAMETER 'SA' TO
+C                        BE ZEROED.  USING THE VALUE 7 CAUSES 'SA' TO
+C                        BE EXAMINED.  IF IT HAS A NON-ZERO VALUE, THE
+C                        VALUE IS LEFT ALONE.  IF IT HAS A ZERO VALUE,
+C                        ITS VALUE IS RESET TO 6.631, WHICH IS ABOUT
+C                        RIGHT FOR A SATELLITE IN A GEOSYNCHRONOUS
+C                        EQUATORIAL ORBIT (FOR WHATEVER THAT'S WORTH).
+C
+C                        THE SIGN OF JPRJ, WHEN IOUT IS -1, 0, OR 1,
+C                        INDICATES WHETHER THE CONTINENTAL OUTLINES ARE
+C                        TO BE PLOTTED OR NOT.  SEE IOUT, BELOW.
+C
+C                        PLAT, PLON, AND ROTA DEFINE THE ORIGIN OF THE
+C                        PROJECTION AND ITS ROTATION ANGLE AND ARE USED
+C                        IN THE SAME WAY AS THEY WOULD BE IN A CALL TO
+C                        THE ROUTINE MAPROJ (WHICH SEE).
+C
+C                        JLTS, PLM1, PLM2, PLM3, AND PLM4 SPECIFY THE
+C                        RECTANGULAR LIMITS OF THE MAP.  THESE ARGUMENTS
+C                        ARE USED IN THE SAME WAY AS THEY WOULD BE IN
+C                        A CALL TO MAPSET (WHICH SEE), EXCEPT THAT JLTS
+C                        IS AN INTEGER INSTEAD OF A CHARACTER STRING.
+C                        IABS(JLTS) MAY TAKE ON THE VALUES 1 THROUGH 5,
+C                        AS FOLLOWS:
+C
+C                          1  LIKE JLTS='MA' IN A CALL TO MAPSET.
+C                          2  LIKE JLTS='CO' IN A CALL TO MAPSET.
+C                          3  LIKE JLTS='LI' IN A CALL TO MAPSET.
+C                          4  LIKE JLTS='AN' IN A CALL TO MAPSET.
+C                          5  LIKE JLTS='PO' IN A CALL TO MAPSET.
+C
+C                        AT ONE TIME, THE SIGN OF JLTS SPECIFIED WHETHER
+C                        OR NOT A LINE OF TEXT WAS TO BE WRITTEN AT THE
+C                        BOTTOM OF THE PLOT PRODUCED.  THIS LINE MAY NO
+C                        LONGER BE WRITTEN AND THE SIGN OF JLTS IS
+C                        THEREFORE IGNORED.
+C
+C                        MOD(IABS(JGRD),1000) IS THE VALUE, IN DEGREES,
+C                        OF THE INTERVAL AT WHICH LINES OF LATITUDE AND
+C                        LONGITUDE ARE TO BE PLOTTED.  IF THE GIVEN
+C                        INTERVAL IS ZERO, GRID LINES AND LABELS ARE
+C                        NOT PLOTTED.  IF JGRD IS LESS THAN ZERO, THE
+C                        PERIMETER IS NOT PLOTTED.  SET JGRD TO -1000 TO
+C                        SUPPRESS BOTH GRID LINES AND PERIMETER AND TO
+C                        +1000 TO SUPPRESS THE GRID LINES, BUT LEAVE THE
+C                        PERIMETER.  THE VALUE -0 MAY HAVE A MEANING ON
+C                        ONES' COMPLEMENT MACHINES, BUT SHOULD BE
+C                        AVOIDED; USE -1000 INSTEAD.
+C
+C                        IF IOUT HAS THE VALUE 0, U.S. STATE OUTLINES
+C                        ARE OMITTED.  IF IT HAS THE ABSOLUTE VALUE 1,
+C                        THEY ARE PLOTTED.  IN BOTH OF THESE CASES, THE
+C                        SIGN OF JPRJ INDICATES WHETHER CONTINENTAL
+C                        OUTLINES ARE TO BE PLOTTED (JPRJ POSITIVE)
+C                        OR NOT (JPRJ NEGATIVE).  ORIGINALLY, SUPMAP
+C                        RECOGNIZED ONLY THESE VALUES OF IOUT; NOW, IF
+C                        IOUT IS LESS THAN -1 OR GREATER THAN 1, THE
+C                        SIGN OF JPRJ IS IGNORED, AND IOUT SELECTS AN
+C                        OUTLINE GROUP, AS FOLLOWS:
+C
+C                          -2 OR LESS     'NO' (NO OUTLINES).
+C                           2             'CO' (CONTINENTAL OUTLINES).
+C                           3             'US' (U.S. STATE OUTLINES).
+C                           4             'PS' (CONTINENTAL OUTLINES
+C                                               PLUS INTERNATIONAL
+C                                               OUTLINES PLUS U.S.
+C                                               STATE OUTLINES).
+C                           5 OR GREATER  'PO' (CONTINENTAL OUTLINES
+C                                               PLUS INTERNATIONAL
+C                                               OUTLINES, BUT NO U.S.
+C                                               STATE OUTLINES).
+C
+C                        AT ONE TIME, THE SIGN OF IOUT SPECIFIED WHETHER
+C                        OR NOT A LINE OF TEXT WAS TO BE WRITTEN ON THE
+C                        PRINT OUTPUT.  THIS MAY NO LONGER BE DONE.
+C
+C                        IDOT=0 TO GET CONTINUOUS OUTLINES, 1 TO GET
+C                        DOTTED OUTLINES.
+C
+C                        IERR IS AN OUTPUT PARAMETER.  A NON-ZERO VALUE
+C                        INDICATES THAT AN ERROR HAS OCCURRED.
+C
+C***********************************************************************
+C T H E   C O D E   -   U S E R - L E V E L   R O U T I N E S
+C***********************************************************************
+C
+      SUBROUTINE MAPDRW
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPDRW','VERSION  1')
+C
+C INITIALIZE THE PACKAGE, DRAW AND LABEL THE GRID, AND DRAW OUTLINES.
+C
+      IF (INTF) CALL MAPINT
+      CALL MAPGRD
+      CALL MAPLBL
+      CALL MAPLOT
+C
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPEOS (NOUT,NSEG,IGID,NPTS,PNTS)
+      DIMENSION PNTS(*)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPFST (XLAT,XLON)
+      CALL MAPIT (XLAT,XLON,0)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGRD
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C DEFINE LOCAL LOGICAL FLAGS.
+C
+      LOGICAL IMF,IPF
+C
+C DEFINE REQUIRED CONSTANTS.
+C
+      DATA DTOR / .017453292519943 /
+C
+C THE ARITHMETIC STATEMENT FUNCTIONS FLOOR AND CLING GIVE, RESPECTIVELY,
+C THE "FLOOR" OF X - THE LARGEST INTEGER LESS THAN OR EQUAL TO X - AND
+C THE "CEILING" OF X - THE SMALLEST INTEGER GREATER THAN OR EQUAL TO X.
+C
+      FLOOR(X)=AINT(X+1.E4)-1.E4
+      CLING(X)=-FLOOR(-X)
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGRD','VERSION  1')
+C
+C IF EZMAP NEEDS INITIALIZATION OR IF AN ERROR HAS OCCURRED SINCE THE
+C LAST INITIALIZATION, DO NOTHING.
+C
+      IF (INTF) RETURN
+      IF (IIER.NE.0) RETURN
+C
+C IF THE GRID IS SUPPRESSED, DO NOTHING.
+C
+      IF (GRID.LE.0.) RETURN
+C
+C RESET THE INTENSITY, DOTTING, AND DASH PATTERN FOR THE GRID.
+C
+      CALL MAPCHI (2,0,IDSH)
+C
+C SET THE FLAGS IMF AND IPF, WHICH ARE TRUE IF AND ONLY IF MERIDIANS AND
+C PARALLELS, RESPECTIVELY, ARE STRAIGHT LINES AND IT IS "SAFE" TO DRAW
+C THEM USING LONG LINE SEGMENTS.  WHAT WE HAVE TO BE SURE OF IS THAT AT
+C LEAST ONE OF THE TWO ENDPOINTS OF EACH MERIDIAN, OR ITS MIDPOINT, WILL
+C BE VISIBLE.  (IF TWO POINTS ARE INVISIBLE, MAPIT DRAWS NOTHING, EVEN
+C THOUGH THE LINE JOINING THEM MAY BE VISIBLE ALONG PART OF ITS LENGTH.)
+C
+      IF (IPRJ.GE.1.AND.IPRJ.LE.6) THEN
+        IF (ELPF) THEN
+          IMF=(UCEN/URNG)**2+(VCEN/VRNG)**2.LT.1.
+        ELSE
+          IMF=UMIN*UMAX.LT.0..AND.VMIN*VMAX.LT.0.
+        END IF
+        IF (IPRJ.NE.1) IMF=IMF.AND.ABS(PHIA).GE.89.9999
+      ELSE IF (IPRJ.EQ.10) THEN
+        IMF=.TRUE.
+      ELSE IF (IPRJ.EQ.11.AND.(.75*(VMAX-VMIN)).LE.VEPS) THEN
+        IMF=.TRUE.
+      ELSE
+        IMF=.FALSE.
+      END IF
+C
+      IPF=IPRJ.EQ.10.OR.IPRJ.EQ.11.OR.(IPRJ.EQ.12.AND.ILTS.EQ.1)
+C
+C TRANSFER THE LATITUDE/LONGITUDE LIMITS COMPUTED BY MAPINT TO LOCAL,
+C MODIFIABLE VARIABLES.
+C
+      SLAT=SLAM
+      BLAT=BLAM
+      SLON=SLOM
+      BLON=BLOM
+C
+C FOR CERTAIN AZIMUTHAL PROJECTIONS CENTERED AT A POLE, THE LATITUDE
+C LIMIT FURTHEST FROM THE POLE NEEDS ADJUSTMENT TO MAKE IT PROJECTABLE
+C AND VISIBLE.  OTHERWISE, WE HAVE TROUBLE WITH PORTIONS OF MERIDIANS
+C DISAPPEARING.
+C
+      IF (IPRJ.EQ.3.OR.IPRJ.EQ.4.OR.IPRJ.EQ.6) THEN
+        IF (PHIA.GT.+89.9999) THEN
+          SLAT=SLAT+SRCH
+          IF (IPRJ.EQ.3) SLAT=SLAT+SRCH
+        END IF
+        IF (PHIA.LT.-89.9999) THEN
+          BLAT=BLAT-SRCH
+          IF (IPRJ.EQ.3) BLAT=BLAT-SRCH
+        END IF
+      END IF
+C
+C RLON IS THE SMALLEST LONGITUDE FOR WHICH A MERIDIAN IS TO BE DRAWN,
+C XLON THE BIGGEST.  AVOID DRAWING A GIVEN MERIDIAN TWICE.
+C
+      RLON=GRID*FLOOR(SLON/GRID)
+      XLON=GRID*CLING(BLON/GRID)
+      IF (XLON-RLON.GT.359.9999) THEN
+        IF (IPRJ.EQ.1) THEN
+          RLON=GRID*CLING((PHIO-179.9999)/GRID)
+          XLON=GRID*FLOOR((PHIO+179.9999)/GRID)
+        ELSE IF (IPRJ.GE.2.AND.IPRJ.LE.9) THEN
+          XLON=XLON-GRID
+          IF (XLON-RLON.GT.359.9999) XLON=XLON-GRID
+        END IF
+      END IF
+C
+C OLAT IS THE LATITUDE AT WHICH MERIDIANS WHICH ARE NOT MULTIPLES OF 90
+C ARE TO STOP.  (EXCEPT ON CERTAIN FAST-PATH CYLINDRICAL PROJECTIONS,
+C ONLY THE MERIDIANS AT LONGITUDES WHICH ARE MULTIPLES OF 90 RUN ALL
+C THE WAY TO THE POLES.  THIS AVOIDS A LOT OF CLUTTER.)
+C
+      IF (IPRJ.EQ.10.OR.IPRJ.EQ.11) THEN
+        OLAT=90.
+      ELSE
+        OLAT=GRID*FLOOR(89.9999/GRID)
+      END IF
+C
+C DRAW THE MERIDIANS.
+C
+      RLON=RLON-GRID
+  101 RLON=RLON+GRID
+      XLAT=OLAT
+      IF (AMOD(RLON,90.).EQ.0.) XLAT=90.
+      RLAT=AMAX1(SLAT,-XLAT)
+      XLAT=AMIN1(BLAT,XLAT)
+      IF (IMF) THEN
+        DLAT=.5*(XLAT-RLAT)
+      ELSE
+        DLAT=(XLAT-RLAT)/CLING((XLAT-RLAT)/GRDR)
+      END IF
+      CALL MAPIT (RLAT,RLON,0)
+  102 RLAT=RLAT+DLAT
+      CALL MAPIT (RLAT,RLON,1)
+      IF (RLAT.LT.XLAT-.9999) GO TO 102
+      IF (RLON.LT.XLON-.9999) GO TO 101
+C
+C ROUND THE LATITUDE LIMITS TO APPROPRIATE MULTIPLES OF GRID.
+C
+      SLAT=GRID*FLOOR(SLAT/GRID)
+      IF (SLAT.LE.-90.) SLAT=SLAT+GRID
+      BLAT=GRID*CLING(BLAT/GRID)
+      IF (BLAT.GE.90.) BLAT=BLAT-GRID
+C
+C IF A FAST-PATH CYLINDRICAL EQUIDISTANT PROJECTION IS IN USE AND EITHER
+C OR BOTH OF THE POLES IS WITHIN THE (RECTANGULAR) PERIMETER, ARRANGE
+C FOR THE PARALLELS AT -90 AND/OR +90 TO BE DRAWN.
+C
+      IF (IPRJ.EQ.10) THEN
+        CALL MAPTRN (-90.,PHIO,U,V)
+        IF (U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN.AND.V.LE.VMAX)
+     +                                                    SLAT=SLAT-GRID
+        CALL MAPTRN (90.,PHIO,U,V)
+        IF (U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN.AND.V.LE.VMAX)
+     +                                                    BLAT=BLAT+GRID
+      END IF
+C
+C DRAW THE PARALLELS.
+C
+      XLAT=SLAT-GRID
+  103 XLAT=XLAT+GRID
+      RLAT=AMAX1(-90.,AMIN1(90.,XLAT))
+      RLON=FLOOR(SLON)
+      XLON=AMIN1(CLING(BLON),RLON+360.)
+      IF (IPF) THEN
+        DLON=.5*(XLON-RLON)
+      ELSE
+        DLON=(XLON-RLON)/CLING((XLON-RLON)/GRDR)
+      END IF
+      CALL MAPIT (RLAT,RLON,0)
+  104 RLON=RLON+DLON
+      CALL MAPIT (RLAT,RLON,1)
+      IF (RLON.LT.XLON-.9999) GO TO 104
+      IF (XLAT.LT.BLAT-.9999) GO TO 103
+C
+C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN.
+C
+      CALL MAPCHI (-2,0,0)
+C
+C DRAW THE LIMB LINES.
+C
+      CALL MAPLMB
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGTC (WHCH,CVAL)
+C
+      CHARACTER*(*) WHCH,CVAL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTC','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'AR') THEN
+        CVAL=LDCT(ILTS)
+      ELSE IF (WHCH(1:2).EQ.'OU') THEN
+        CVAL=DDCT(NOUT+1)
+      ELSE IF (WHCH(1:2).EQ.'PR') THEN
+        CVAL=PDCT(JPRJ)
+        IF (JPRJ.EQ.3.AND.ABS(SALT).GT.1.) CVAL=PDCT(10)
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=1
+      CALL MAPCEM (' MAPGTC - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      CVAL=' '
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGTI (WHCH,IVAL)
+C
+      CHARACTER*(*) WHCH
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPNTS/ INTS(7)
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTI','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DA') THEN
+        IVAL=IDSH
+      ELSE IF (WHCH(1:2).EQ.'DD') THEN
+        IVAL=DDTS
+      ELSE IF (WHCH(1:2).EQ.'DL') THEN
+        IVAL=IDTL
+      ELSE IF (WHCH(1:2).EQ.'DO') THEN
+        IVAL=IDOT
+      ELSE IF (WHCH(1:2).EQ.'EL') THEN
+        IVAL=0
+        IF (ELPF) IVAL=1
+      ELSE IF (WHCH(1:2).EQ.'ER') THEN
+        IVAL=IIER
+      ELSE IF (WHCH(1:2).EQ.'GR') THEN
+        IVAL=GRID
+      ELSE IF (WHCH(1:2).EQ.'IN') THEN
+        IVAL=0
+        IF (INTF) IVAL=1
+      ELSE IF (WHCH(1:2).EQ.'I1') THEN
+        IVAL=INTS(1)
+      ELSE IF (WHCH(1:2).EQ.'I2') THEN
+        IVAL=INTS(2)
+      ELSE IF (WHCH(1:2).EQ.'I3') THEN
+        IVAL=INTS(3)
+      ELSE IF (WHCH(1:2).EQ.'I4') THEN
+        IVAL=INTS(4)
+      ELSE IF (WHCH(1:2).EQ.'I5') THEN
+        IVAL=INTS(5)
+      ELSE IF (WHCH(1:2).EQ.'I6') THEN
+        IVAL=INTS(6)
+      ELSE IF (WHCH(1:2).EQ.'I7') THEN
+        IVAL=INTS(7)
+      ELSE IF (WHCH(1:2).EQ.'LA') THEN
+        IVAL=0
+        IF (LBLF) IVAL=1
+      ELSE IF (WHCH(1:2).EQ.'LS') THEN
+        IVAL=ILCW
+      ELSE IF (WHCH(1:2).EQ.'MV') THEN
+        IVAL=DPLT
+      ELSE IF (WHCH(1:2).EQ.'PE') THEN
+        IVAL=0
+        IF (PRMF) IVAL=1
+      ELSE IF (WHCH(1:2).EQ.'PN') THEN
+        IVAL=PHIO
+      ELSE IF (WHCH(1:2).EQ.'PT') THEN
+        IVAL=PHIA
+      ELSE IF (WHCH(1:2).EQ.'P1') THEN
+        IVAL=PLA1
+      ELSE IF (WHCH(1:2).EQ.'P2') THEN
+        IVAL=PLA2
+      ELSE IF (WHCH(1:2).EQ.'P3') THEN
+        IVAL=PLA3
+      ELSE IF (WHCH(1:2).EQ.'P4') THEN
+        IVAL=PLA4
+      ELSE IF (WHCH(1:2).EQ.'P5') THEN
+        IVAL=PLB1
+      ELSE IF (WHCH(1:2).EQ.'P6') THEN
+        IVAL=PLB2
+      ELSE IF (WHCH(1:2).EQ.'P7') THEN
+        IVAL=PLB3
+      ELSE IF (WHCH(1:2).EQ.'P8') THEN
+        IVAL=PLB4
+      ELSE IF (WHCH(1:2).EQ.'RE') THEN
+        IVAL=PLTR
+      ELSE IF (WHCH(1:2).EQ.'RO') THEN
+        IVAL=ROTA
+      ELSE IF (WHCH(1:2).EQ.'SA') THEN
+        IVAL=SALT
+      ELSE IF (WHCH(1:2).EQ.'S1') THEN
+        IVAL=ALFA
+      ELSE IF (WHCH(1:2).EQ.'S2') THEN
+        IVAL=BETA
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=2
+      CALL MAPCEM (' MAPGTI - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      IVAL=0
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGTL (WHCH,LVAL)
+C
+      CHARACTER*(*) WHCH
+      LOGICAL LVAL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTL','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DL') THEN
+        LVAL=IDTL.NE.0
+      ELSE IF (WHCH(1:2).EQ.'DO') THEN
+        LVAL=IDOT.NE.0
+      ELSE IF (WHCH(1:2).EQ.'EL') THEN
+        LVAL=ELPF
+      ELSE IF (WHCH(1:2).EQ.'IN') THEN
+        LVAL=INTF
+      ELSE IF (WHCH(1:2).EQ.'LA') THEN
+        LVAL=LBLF
+      ELSE IF (WHCH(1:2).EQ.'PE') THEN
+        LVAL=PRMF
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=3
+      CALL MAPCEM (' MAPGTL - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      LVAL=.FALSE.
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPGTR (WHCH,RVAL)
+C
+      CHARACTER*(*) WHCH
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPGTR','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DD') THEN
+        RVAL=DDTS
+      ELSE IF (WHCH(1:2).EQ.'GD') THEN
+        RVAL=GRDR
+      ELSE IF (WHCH(1:2).EQ.'GR') THEN
+        RVAL=GRID
+      ELSE IF (WHCH(1:2).EQ.'MV') THEN
+        RVAL=DPLT
+      ELSE IF (WHCH(1:2).EQ.'PN') THEN
+        RVAL=PHIO
+      ELSE IF (WHCH(1:2).EQ.'PT') THEN
+        RVAL=PHIA
+      ELSE IF (WHCH(1:2).EQ.'P1') THEN
+        RVAL=PLA1
+      ELSE IF (WHCH(1:2).EQ.'P2') THEN
+        RVAL=PLA2
+      ELSE IF (WHCH(1:2).EQ.'P3') THEN
+        RVAL=PLA3
+      ELSE IF (WHCH(1:2).EQ.'P4') THEN
+        RVAL=PLA4
+      ELSE IF (WHCH(1:2).EQ.'P5') THEN
+        RVAL=PLB1
+      ELSE IF (WHCH(1:2).EQ.'P6') THEN
+        RVAL=PLB2
+      ELSE IF (WHCH(1:2).EQ.'P7') THEN
+        RVAL=PLB3
+      ELSE IF (WHCH(1:2).EQ.'P8') THEN
+        RVAL=PLB4
+      ELSE IF (WHCH(1:2).EQ.'RE') THEN
+        RVAL=PLTR
+      ELSE IF (WHCH(1:2).EQ.'RO') THEN
+        RVAL=ROTA
+      ELSE IF (WHCH(1:2).EQ.'SA') THEN
+        RVAL=SALT
+      ELSE IF (WHCH(1:2).EQ.'S1') THEN
+        RVAL=ALFA
+      ELSE IF (WHCH(1:2).EQ.'S2') THEN
+        RVAL=BETA
+      ELSE IF (WHCH(1:2).EQ.'SR') THEN
+        RVAL=SRCH
+      ELSE IF (WHCH(1:2).EQ.'XL') THEN
+        RVAL=XLOW
+      ELSE IF (WHCH(1:2).EQ.'XR') THEN
+        RVAL=XROW
+      ELSE IF (WHCH(1:2).EQ.'YB') THEN
+        RVAL=YBOW
+      ELSE IF (WHCH(1:2).EQ.'YT') THEN
+        RVAL=YTOW
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=4
+      CALL MAPCEM (' MAPGTR - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RVAL=0.
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPINT
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C SET UP ALTERNATE NAMES FOR SOME OF THE VARIABLES IN COMMON.
+C
+      EQUIVALENCE     (PHIA,FLT1),(ROTA,FLT2)
+C
+      EQUIVALENCE     (PLA1,AUMN),(PLA2,AUMX),
+     +                (PLA3,AVMN),(PLA4,AVMX)
+C
+C ENSURE THAT THE BLOCK DATA ROUTINE WILL LOAD, SO THAT VARIABLES WILL
+C HAVE THE PROPER DEFAULT VALUES.
+C
+      EXTERNAL MAPBD
+C
+C DEFINE THE NECESSARY CONSTANTS.
+C
+      DATA RESL / 10. /
+      DATA DTOR / .017453292519943 /
+      DATA OV90 / .011111111111111 /
+      DATA PI   / 3.14159265358979 /
+      DATA RTOD / 57.2957795130823 /
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPINT','VERSION  1')
+C
+C CHECK FOR AN ERROR IN THE PROJECTION SPECIFIER.
+C
+      IF (JPRJ.LE.0.OR.JPRJ.GE.10) GO TO 901
+C
+C IPRJ EQUALS JPRJ UNTIL WE FIND OUT IF FAST-PATH PROJECTIONS ARE TO BE
+C USED.  PHOC IS JUST A COPY OF PHIO.
+C
+      IPRJ=JPRJ
+      PHOC=PHIO
+C
+      IF (IPRJ.EQ.1) THEN
+C
+C COMPUTE CONSTANTS FOR THE LAMBERT CONFORMAL CONIC.
+C
+        SINO=SIGN(1.,.5*(FLT1+FLT2))
+        CHI1=(90.-SINO*FLT1)*DTOR
+        IF (FLT1.EQ.FLT2) THEN
+          COSO=COS(CHI1)
+        ELSE
+          CHI2=(90.-SINO*FLT2)*DTOR
+          COSO=ALOG(SIN(CHI1)/SIN(CHI2))/ALOG(TAN(.5*CHI1)/TAN(.5*CHI2))
+        END IF
+C
+      ELSE
+C
+C COMPUTE CONSTANTS REQUIRED FOR ALL THE OTHER PROJECTIONS.
+C
+        TMP1=ROTA*DTOR
+        TMP2=PHIA*DTOR
+        SINR=SIN(TMP1)
+        COSR=COS(TMP1)
+        SINO=SIN(TMP2)
+        COSO=COS(TMP2)
+C
+C COMPUTE CONSTANTS REQUIRED ONLY BY THE CYLINDRICAL PROJECTIONS.
+C
+        IF (IPRJ.GE.7) THEN
+C
+C SEE IF FAST-PATH TRANSFORMATIONS CAN BE USED.  (PLAT = 0 AND ROTA = 0
+C OR 180.)
+C
+          IF (ABS(PHIA).GE..0001.OR.(ABS(ROTA).GE..0001.AND.
+     +                               ABS(ROTA).LE.179.9999)) THEN
+C
+C NO.  COMPUTE CONSTANTS FOR THE ORDINARY CYLINDRICAL PROJECTIONS.
+C
+            SINT=COSO*COSR
+            COST=SQRT(1.-(SINT)**2)
+            TMP1=SINR/COST
+            TMP2=SINO/COST
+            PHIO=PHIO-ATAN2(TMP1,-COSR*TMP2)*RTOD
+            PHOC=PHIO
+            SINR=TMP1*COSO
+            COSR=-TMP2
+            SINO=SINT
+            COSO=COST
+C
+          ELSE
+C
+C YES.  THE FAST PATHS ARE IMPLEMENTED AS THREE ADDITIONAL PROJECTIONS.
+C
+            IPRJ=IPRJ+3
+C
+            IF (ABS(ROTA).LT..0001) THEN
+              SINO=1.
+            ELSE
+              SINO=-1.
+              PHIO=PHIO+180.
+              PHOC=PHIO
+            END IF
+C
+            COSO=0.
+            SINR=0.
+            COSR=1.
+C
+          END IF
+C
+        END IF
+C
+      END IF
+C
+C NOW, SET UMIN, UMAX, VMIN, AND VMAX TO CORRESPOND TO THE MAXIMUM
+C USEFUL AREA PRODUCED BY THE PROJECTION.
+C
+      GO TO (101,102,101,102,102,103,104,103,105,104,103,105) , IPRJ
+C
+C LAMBERT CONFORMAL CONIC AND ORTHOGRAPHIC.
+C
+  101 IF (IPRJ.NE.3.OR.ABS(SALT).LE.1..OR.ALFA.EQ.0.) THEN
+        UMIN=-1.
+        UMAX=1.
+        VMIN=-1.
+        VMAX=1.
+      ELSE
+        TMP1=SALT*SALT*CALF*CALF-1.
+        TMP2=CALF*SQRT(SALT*SALT*(1.-SALF*SALF*SBET*SBET)-1.)
+        UMIN=SRSS*(-SALF*CBET-TMP2)/TMP1
+        UMAX=SRSS*(-SALF*CBET+TMP2)/TMP1
+        TMP2=CALF*SQRT(SALT*SALT*(1.-SALF*SALF*CBET*CBET)-1.)
+        VMIN=SRSS*(-SALF*SBET-TMP2)/TMP1
+        VMAX=SRSS*(-SALF*SBET+TMP2)/TMP1
+      END IF
+C
+      GO TO 106
+C
+C STEREOGRAPHIC, LAMBERT EQUAL AREA, AND GNOMONIC.
+C
+  102 UMIN=-2.
+      UMAX=2.
+      VMIN=-2.
+      VMAX=2.
+      GO TO 106
+C
+C AZIMUTHAL EQUIDISTANT AND MERCATOR.
+C
+  103 UMIN=-PI
+      UMAX=PI
+      VMIN=-PI
+      VMAX=PI
+      GO TO 106
+C
+C CYLINDRICAL EQUIDISTANT.
+C
+  104 UMIN=-180.
+      UMAX=180.
+      VMIN=-90.
+      VMAX=90.
+      GO TO 106
+C
+C MOLLWEIDE.
+C
+  105 UMIN=-2.
+      UMAX=2.
+      VMIN=-1.
+      VMAX=1.
+C
+C COMPUTE THE QUANTITIES USED BY MAPIT IN CHECKING FOR CROSS-OVER.
+C
+  106 UEPS=.75*(UMAX-UMIN)
+      VEPS=.75*(VMAX-VMIN)
+C
+C AS ALWAYS, THE CONICAL PROJECTION IS THE ODDBALL.  CROSS-OVER IS NOT
+C DETECTED IN U AND V, BUT IN LONGITUDE, SO THE VALUE HAS TO BE SET
+C DIFFERENTLY.
+C
+      IF (IPRJ.EQ.1) UEPS=180.
+C
+C NOW, JUMP TO THE APPROPRIATE LIMIT-SETTING CODE.
+C
+      GO TO (600,200,300,400,500) , ILTS
+C
+C ILTS=2    POINTS (PL1,PL2) AND (PL3,PL4) ARE ON OPPOSITE CORNERS
+C ------    OF THE PLOT.
+C
+  200 E=0.
+  201 CALL MAPTRN (PLA1,PLA2+E,TMP1,TMP3)
+      CALL MAPTRN (PLA3,PLA4-E,TMP2,TMP4)
+      IF (IPRJ.GE.7.AND.TMP1.GE.TMP2.AND.E.EQ.0.) THEN
+        E=.0001
+        GO TO 201
+      END IF
+      UMIN=AMIN1(TMP1,TMP2)
+      UMAX=AMAX1(TMP1,TMP2)
+      VMIN=AMIN1(TMP3,TMP4)
+      VMAX=AMAX1(TMP3,TMP4)
+      IF (UMAX.GE.1.E12) GO TO 904
+      GO TO 600
+C
+C ILTS=3    FOUR EDGE POINTS ARE GIVEN.
+C ------
+C
+  300 E=0.
+  301 CALL MAPTRN (PLA1,PLB1+E,TMP1,TMP5)
+      CALL MAPTRN (PLA2,PLB2-E,TMP2,TMP6)
+      IF (IPRJ.GE.7.AND.TMP1.GE.TMP2.AND.E.EQ.0.) THEN
+        E=.0001
+        GO TO 301
+      END IF
+      CALL MAPTRN (PLA3,PLB3,TMP3,TMP7)
+      CALL MAPTRN (PLA4,PLB4,TMP4,TMP8)
+      UMIN=AMIN1(TMP1,TMP2,TMP3,TMP4)
+      UMAX=AMAX1(TMP1,TMP2,TMP3,TMP4)
+      VMIN=AMIN1(TMP5,TMP6,TMP7,TMP8)
+      VMAX=AMAX1(TMP5,TMP6,TMP7,TMP8)
+      IF (UMAX.GE.1.E12) GO TO 904
+      GO TO 600
+C
+C ILTS=4    ANGULAR DISTANCES ARE GIVEN.
+C ------
+C
+  400 CUMI=COS(AUMN*DTOR)
+      SUMI=SIN(AUMN*DTOR)
+      CUMA=COS(AUMX*DTOR)
+      SUMA=SIN(AUMX*DTOR)
+      CVMI=COS(AVMN*DTOR)
+      SVMI=SIN(AVMN*DTOR)
+      CVMA=COS(AVMX*DTOR)
+      SVMA=SIN(AVMX*DTOR)
+C
+      GO TO (904,401,402,403,404,405,406,407,408,406,407,408) , IPRJ
+C
+C STEREOGRAPHIC.
+C
+  401 IF (SUMI.LT..0001) THEN
+        IF (CUMI.GT.0.) UMIN=0.
+      ELSE
+        UMIN=-(1.-CUMI)/SUMI
+      END IF
+      IF (SUMA.LT..0001) THEN
+        IF (CUMA.GT.0.) UMAX=0.
+      ELSE
+        UMAX=(1.-CUMA)/SUMA
+      END IF
+      IF (SVMI.LT..0001) THEN
+        IF (CVMI.GT.0.) VMIN=0.
+      ELSE
+        VMIN=-(1.-CVMI)/SVMI
+      END IF
+      IF (SVMA.LT..0001) THEN
+        IF (CVMA.GT.0.) VMAX=0.
+      ELSE
+        VMAX=(1.-CVMA)/SVMA
+      END IF
+      GO TO 600
+C
+C ORTHOGRAPHIC.
+C
+  402 IF (ABS(SALT).LE.1.) THEN
+        IF (AMAX1(AUMN,AUMX,AVMN,AVMX).GT.90.) GO TO 902
+        UMIN=-SUMI
+        UMAX=SUMA
+        VMIN=-SVMI
+        VMAX=SVMA
+      ELSE
+        IF (AMAX1(AUMN,AUMX,AVMN,AVMX).GE.90.) GO TO 902
+        UTMP=SRSS*SALF/CALF
+        VTMP=0.
+        UCEN=UTMP*CBET-VTMP*SBET
+        VCEN=VTMP*CBET+UTMP*SBET
+        UMIN=UCEN-SRSS*CALF*SUMI/CUMI
+        UMAX=UCEN+SRSS*CALF*SUMA/CUMA
+        VMIN=VCEN-SRSS*CALF*SVMI/CVMI
+        VMAX=VCEN+SRSS*CALF*SVMA/CVMA
+      END IF
+      GO TO 600
+C
+C LAMBERT EQUAL AREA.
+C
+  403 IF (SUMI.LT..0001) THEN
+        IF (CUMI.GT.0.) UMIN=0.
+      ELSE
+        UMIN=-2./SQRT(1.+((1.+CUMI)/SUMI)**2)
+      END IF
+      IF (SUMA.LT..0001) THEN
+        IF (CUMA.GT.0.) UMAX=0.
+      ELSE
+        UMAX=2./SQRT(1.+((1.+CUMA)/SUMA)**2)
+      END IF
+      IF (SVMI.LT..0001) THEN
+        IF (CVMI.GT.0.) VMIN=0.
+      ELSE
+        VMIN=-2./SQRT(1.+((1.+CVMI)/SVMI)**2)
+      END IF
+      IF (SVMA.LT..0001) THEN
+        IF (CVMA.GT.0.) VMAX=0.
+      ELSE
+        VMAX=2./SQRT(1.+((1.+CVMA)/SVMA)**2)
+      END IF
+      GO TO 600
+C
+C GNOMONIC.
+C
+  404 IF (AMAX1(AUMN,AUMX,AVMN,AVMX).GE.89.9999) GO TO 902
+      UMIN=-SUMI/CUMI
+      UMAX=SUMA/CUMA
+      VMIN=-SVMI/CVMI
+      VMAX=SVMA/CVMA
+      GO TO 600
+C
+C AZIMUTHAL EQUIDISTANT.
+C
+  405 UMIN=-AUMN*DTOR
+      UMAX=AUMX*DTOR
+      VMIN=-AVMN*DTOR
+      VMAX=AVMX*DTOR
+      GO TO 600
+C
+C CYLINDRICAL EQUIDISTANT.
+C
+  406 UMIN=-AUMN
+      UMAX=AUMX
+      VMIN=-AVMN
+      VMAX=AVMX
+      GO TO 600
+C
+C MERCATOR.
+C
+  407 IF (AMAX1(AVMN,AVMX).GE.89.9999) GO TO 902
+      UMIN=-AUMN*DTOR
+      UMAX=AUMX*DTOR
+      VMIN=-ALOG((1.+SVMI)/CVMI)
+      VMAX=ALOG((1.+SVMA)/CVMA)
+      GO TO 600
+C
+C MOLLWEIDE.
+C
+  408 UMIN=-AUMN*OV90
+      UMAX=AUMX*OV90
+      VMIN=-SVMI
+      VMAX=SVMA
+      GO TO 600
+C
+C ILTS=5    VALUES IN THE U/V PLANE ARE GIVEN.
+C ------
+C
+  500 UMIN=PLA1
+      UMAX=PLA2
+      VMIN=PLA3
+      VMAX=PLA4
+C
+C COMPUTE THE WIDTH AND HEIGHT OF THE PLOT.
+C
+  600 DU=UMAX-UMIN
+      DV=VMAX-VMIN
+C
+C ERROR IF MAP HAS ZERO AREA.
+C
+      IF (DU.LE.0..OR.DV.LE.0.) GO TO 903
+C
+C POSITION THE MAP ON THE PLOTTER FRAME.
+C
+      IF (DU/DV.LT.(XROW-XLOW)/(YTOW-YBOW)) THEN
+        ULOW=.5*(XLOW+XROW)-.5*(DU/DV)*(YTOW-YBOW)
+        UROW=.5*(XLOW+XROW)+.5*(DU/DV)*(YTOW-YBOW)
+        VBOW=YBOW
+        VTOW=YTOW
+      ELSE
+        ULOW=XLOW
+        UROW=XROW
+        VBOW=.5*(YBOW+YTOW)-.5*(DV/DU)*(XROW-XLOW)
+        VTOW=.5*(YBOW+YTOW)+.5*(DV/DU)*(XROW-XLOW)
+      END IF
+C
+C ERROR IF MAP HAS ESSENTIALLY ZERO AREA.
+C
+      IF (AMIN1(UROW-ULOW,VTOW-VBOW)*PLTR.LT.RESL) GO TO 903
+C
+C DO THE REQUIRED SET CALL.
+C
+      CALL SET (ULOW,UROW,VBOW,VTOW,UMIN,UMAX,VMIN,VMAX,1)
+C
+C COMPUTE THE QUANTITIES USED BY MAPIT TO SEE IF POINTS ARE FAR ENOUGH
+C APART TO DRAW THE LINE BETWEEN THEM AND THE QUANTITIES USED BY MAPVP
+C TO DETERMINE THE NUMBER OF DOTS TO INTERPOLATE BETWEEN TWO POINTS.
+C
+      DSCA=(UROW-ULOW)*PLTR/DU
+      DPSQ=DPLT*DPLT
+      DSSQ=DSCA*DSCA
+      DBTD=DDTS/DSCA
+C
+C SET PARAMETERS REQUIRED IF AN ELLIPTICAL PERIMETER IS BEING USED.  THE
+C ELLIPSE IS MADE TO BE JUST A LITTLE BIGGER THAN AN INSCRIBED ELLIPSE
+C SO AS TO AVOID ROUND-OFF PROBLEMS WHEN DRAWING THE LIMB OF CERTAIN
+C PROJECTIONS.
+C
+      UCEN=.5*(UMIN+UMAX)
+      VCEN=.5*(VMIN+VMAX)
+      URNG=.50005*(UMAX-UMIN)
+      VRNG=.50005*(VMAX-VMIN)
+C
+C NOW, COMPUTE THE LATITUDE/LONGITUDE LIMITS WHICH WILL BE REQUIRED BY
+C MAPGRD AND MAPLOT, IF ANY.
+C
+      IF (GRID.GT.0..OR.NOUT.NE.0) THEN
+C
+C AT FIRST, ASSUME THE WHOLE GLOBE WILL BE PROJECTED.
+C
+        SLAM=-90.
+        BLAM=+90.
+        SLOM=PHIO-180.
+        BLOM=PHIO+180.
+C
+C JUMP IF IT'S OBVIOUS THAT REALLY IS THE CASE.
+C
+        IF (ILTS.EQ.1.AND.(JPRJ.EQ.4.OR.JPRJ.EQ.6.OR.JPRJ.EQ.7.OR.
+     +                                             JPRJ.EQ.9)) GO TO 700
+C
+C OTHERWISE, THE WHOLE GLOBE IS NOT BEING PROJECTED.  THE FIRST THING
+C TO DO IS TO FIND A POINT (CLAT,CLON) WHOSE PROJECTION IS KNOWN TO BE
+C ON THE MAP.  FIRST, TRY THE POLE OF THE PROJECTION.
+C
+        CLAT=PHIA
+        CLON=PHIO
+        CALL MAPTRN (CLAT,CLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 611
+C
+C IF THAT DIDN'T WORK, TRY A POINT BASED ON THE LIMITS SPECIFIER.
+C
+        IF (ILTS.EQ.2) THEN
+          CLAT=.5*(PLA1+PLA3)
+          CLON=.5*(PLA2+PLA4)
+        ELSE IF (ILTS.EQ.3) THEN
+          TMP1=AMIN1(PLA1,PLA2,PLA3,PLA4)
+          TMP2=AMAX1(PLA1,PLA2,PLA3,PLA4)
+          TMP3=AMIN1(PLB1,PLB2,PLB3,PLB4)
+          TMP4=AMAX1(PLB1,PLB2,PLB3,PLB4)
+          CLAT=.5*(TMP1+TMP2)
+          CLON=.5*(TMP3+TMP4)
+        ELSE
+          GO TO 700
+        END IF
+        CALL MAPTRN (CLAT,CLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 611
+        GO TO 700
+C
+C ONCE WE HAVE THE LATITUDES AND LONGITUDES OF A POINT ON THE MAP, WE
+C FIND THE MINIMUM AND MAXIMUM LATITUDE AND THE MINIMUM AND MAXIMUM
+C LONGITUDE BY RUNNING A SEARCH POINT ABOUT ON A FINE LAT/LON GRID.
+C
+C FIND THE MINIMUM LATITUDE.
+C
+  611   RLAT=CLAT
+        RLON=CLON
+        DLON=SRCH
+  612   RLAT=RLAT-SRCH
+        IF (RLAT.LE.-90.) GO TO 621
+  613   CALL MAPTRN (RLAT,RLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN
+          DLON=SRCH
+          GO TO 612
+        END IF
+        RLON=RLON+DLON
+        DLON=SIGN(ABS(DLON)+SRCH,-DLON)
+        IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 613
+        RLON=RLON+DLON
+        DLON=SIGN(ABS(DLON)+SRCH,-DLON)
+        IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 613
+        SLAM=RLAT
+C
+C FIND THE MAXIMUM LATITUDE.
+C
+  621   RLAT=CLAT
+        RLON=CLON
+        DLON=SRCH
+  622   RLAT=RLAT+SRCH
+        IF (RLAT.GT.90.) GO TO 631
+  623   CALL MAPTRN (RLAT,RLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN
+          DLON=SRCH
+          GO TO 622
+        END IF
+        RLON=RLON+DLON
+        DLON=SIGN(ABS(DLON)+SRCH,-DLON)
+        IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 623
+        RLON=RLON+DLON
+        DLON=SIGN(ABS(DLON)+SRCH,-DLON)
+        IF (RLON.GT.CLON-180..AND.RLON.LT.CLON+180.) GO TO 623
+        BLAM=RLAT
+C
+C FIND THE MINIMUM LONGITUDE.
+C
+  631   RLAT=CLAT
+        RLON=CLON
+        DLAT=SRCH
+  632   RLON=RLON-SRCH
+        IF (RLON.LE.CLON-360.) GO TO 651
+  633   CALL MAPTRN (RLAT,RLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN
+          DLAT=SRCH
+          GO TO 632
+        END IF
+        RLAT=RLAT+DLAT
+        DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT)
+        IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 633
+        RLAT=RLAT+DLAT
+        DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT)
+        IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 633
+        SLOM=RLON-SIGN(180.,RLON+180.)+SIGN(180.,180.-RLON)
+C
+C FIND THE MAXIMUM LONGITUDE.
+C
+  641   RLAT=CLAT
+        RLON=CLON
+        DLAT=SRCH
+  642   RLON=RLON+SRCH
+        IF (RLON.GE.CLON+360.) GO TO 651
+  643   CALL MAPTRN (RLAT,RLON,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                               .AND.V.LE.VMAX).OR.
+     +      (ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.)) THEN
+          DLAT=SRCH
+          GO TO 642
+        END IF
+        RLAT=RLAT+DLAT
+        DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT)
+        IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 643
+        RLAT=RLAT+DLAT
+        DLAT=SIGN(ABS(DLAT)+SRCH,-DLAT)
+        IF (RLAT.GT.-90..AND.RLAT.LT.90.) GO TO 643
+        BLOM=RLON-SIGN(180.,RLON+180.)+SIGN(180.,180.-RLON)
+        IF (BLOM.LE.SLOM) BLOM=BLOM+360.
+        GO TO 700
+C
+  651   SLOM=PHIO-180.
+        BLOM=PHIO+180.
+C
+      END IF
+C
+C ZERO THE ERROR FLAG AND TURN OFF THE INITIALIZATION-REQUIRED FLAG.
+C
+  700 IIER=0
+      INTF=.FALSE.
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR RETURNS.
+C
+  901 IIER=5
+      CALL SETER (' MAPINT - ATTEMPT TO USE NON-EXISTENT PROJECTION',
+     1              IIER,1)
+      RETURN
+C
+  902 IIER=6
+      CALL SETER (' MAPINT - ANGULAR LIMITS TOO GREAT',IIER,1)
+      RETURN
+C
+  903 IIER=7
+      CALL SETER (' MAPINT - MAP HAS ZERO AREA',IIER,1)
+      RETURN
+C
+  904 IIER=8
+      CALL SETER (' MAPINT - MAP LIMITS INAPPROPIATE',IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPIT (RLAT,RLON,IFST)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM8/ P,Q,R
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+C
+      DIMENSION CPRJ(3)
+C
+      SAVE IVSO,POLD,QOLD,UOLD,VOLD
+C
+      DATA CPRJ / 360.,6.28318530717959,4. /
+C
+      DATA IVSO,POLD,QOLD,UOLD,VOLD / 0,0.,0.,0.,0. /
+C
+C PROJECT THE POINT (RLAT,RLON) TO (U,V).
+C
+      CALL MAPTRN (RLAT,RLON,U,V)
+C
+C FOR THE SAKE OF EFFICIENCY, EXECUTE ONE OF TWO PARALLEL ALGORITHMS,
+C DEPENDING ON WHETHER AN ELLIPTICAL OR A RECTANGULAR PERIMETER IS IN
+C USE.  (THAT WAY, WE TEST ELPF ONLY ONCE.)
+C
+      IF (ELPF) THEN
+C
+C ELLIPTICAL - ASSUME THE NEW POINT IS VISIBLE UNTIL WE FIND OTHERWISE.
+C
+        IVIS=1
+C
+C SEE IF THE NEW POINT IS INVISIBLE.
+C
+        IF (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.) THEN
+C
+C THE NEW POINT IS INVISIBLE.  RESET THE VISIBILITY FLAG.
+C
+          IVIS=0
+C
+C IF THE NEW POINT IS A "FIRST POINT" OR IF THE LAST POINT WAS NOT
+C VISIBLE OR IF THE NEW POINT IS INVISIBLE BECAUSE ITS PROJECTION IS
+C UNDEFINED, DRAW NOTHING.  THE POSSIBLE EXISTENCE OF A VISIBLE SEGMENT
+C ALONG THE LINE JOINING TWO INVISIBLE POINTS IS INTENTIONALLY IGNORED,
+C FOR REASONS OF EFFICIENCY.  FOR THIS REASON, OBJECTS SHOULD NOT BE
+C DRAWN USING LONG LINE SEGMENTS.
+C
+          IF (IFST.EQ.0.OR.IVSO.EQ.0.OR.U.GE.1.E12) GO TO 108
+C
+C OTHERWISE, THE NEW POINT IS NOT A "FIRST POINT", THE LAST POINT WAS
+C VISIBLE, AND THE PROJECTION OF THE NEW POINT IS DEFINED, SO WE NEED
+C TO CONTINUE THE LINE.  FIRST, IF THERE'S A CROSS-OVER PROBLEM, MOVE
+C THE NEW POINT TO ITS ALTERNATE POSITION.  THIS MAY MAKE IT VISIBLE.
+C
+          IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) THEN
+C
+            IF (JPRJ.GE.7) THEN
+              P=P-SIGN(CPRJ(JPRJ-6),P)
+              U=P
+              IF (JPRJ.EQ.9) U=U*SQRT(1.-V*V)
+            ELSE
+              GO TO 108
+            END IF
+C
+            IF (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.) THEN
+              IVIS=1
+              GO TO 107
+            END IF
+C
+          END IF
+C
+C IF IT'S STILL INVISIBLE, INTERPOLATE TO THE EDGE OF THE FRAME, EXTEND
+C THE LINE TO THAT POINT, AND QUIT.
+C
+          CALL MAPTRE (UOLD,VOLD,U,V,UINT,VINT)
+          CALL MAPVP (UOLD,VOLD,UINT,VINT)
+          GO TO 108
+C
+        END IF
+C
+C THE NEW POINT IS VISIBLE.  IF IT'S THE FIRST POINT OF A LINE, GO START
+C A NEW LINE.
+C
+        IF (IFST.EQ.0.OR.UOLD.GE.1.E12) GO TO 106
+C
+C THE NEW POINT IS VISIBLE, BUT IT'S NOT THE FIRST POINT OF A LINE.
+C CHECK FOR CROSS-OVER PROBLEMS.
+C
+        IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) GO TO 101
+C
+C THE NEW POINT IS VISIBLE, IT'S NOT THE FIRST POINT OF A LINE, AND
+C THERE ARE NO CROSS-OVER PROBLEMS.  IF THE OLD POINT WAS INVISIBLE,
+C JUMP TO DRAW THE VISIBLE PORTION OF THE LINE FROM THE OLD POINT TO
+C THE NEW ONE.
+C
+        IF (IVSO.EQ.0) GO TO 102
+C
+C THE NEW POINT IS VISIBLE, IT'S NOT THE FIRST POINT OF A LINE, THERE
+C ARE NO CROSS-OVER PROBLEMS, AND THE LAST POINT WAS VISIBLE.  JUMP TO
+C JUST CONTINUE THE LINE.
+C
+        GO TO 107
+C
+C WE HAVE THE MOST DIFFICULT CASE.  THE NEW POINT IS VISIBLE, IT'S NOT
+C THE FIRST POINT OF A LINE, AND THERE IS A CROSS-OVER PROBLEM.  NONE,
+C ONE, OR TWO SEGMENTS MAY NEED TO BE DRAWN.
+C
+  101   IF (JPRJ.LT.7) GO TO 106
+C
+C IF THE OLD POINT WAS VISIBLE, GENERATE THE ALTERNATE PROJECTION OF THE
+C NEW POINT AND DRAW THE VISIBLE PORTION OF THE LINE SEGMENT JOINING THE
+C OLD POINT TO THE ALTERNATE PROJECTION POINT.
+C
+        IF (IVSO.NE.0) THEN
+C
+          UTMP=P-SIGN(CPRJ(JPRJ-6),P)
+          VTMP=Q
+          IF (JPRJ.EQ.9) UTMP=UTMP*SQRT(1.-VTMP*VTMP)
+C
+          IF (((UTMP-UCEN)/URNG)**2+((VTMP-VCEN)/VRNG)**2.GT.1.) THEN
+            CALL MAPTRE (UOLD,VOLD,UTMP,VTMP,UTMP,VTMP)
+          END IF
+C
+          CALL MAPVP (UOLD,VOLD,UTMP,VTMP)
+C
+        END IF
+C
+C NOW GENERATE AN ALTERNATE PROJECTION OF THE OLD POINT CLOSE TO THE NEW
+C ONE AND DRAW THE VISIBLE PORTION OF THE LINE SEGMENT JOINING IT TO THE
+C NEW POINT.
+C
+        UOLD=POLD-SIGN(CPRJ(JPRJ-6),POLD)
+        IF (JPRJ.EQ.9) UOLD=UOLD*SQRT(1.-VOLD*VOLD)
+C
+        IF (((UOLD-UCEN)/URNG)**2+((VOLD-VCEN)/VRNG)**2.LE.1.) GO TO 105
+C
+C MOVE (UOLD,VOLD) BY INTERPOLATING TO THE EDGE OF THE FRAME.
+C
+  102   CALL MAPTRE (U,V,UOLD,VOLD,UOLD,VOLD)
+C
+      ELSE
+C
+C RECTANGULAR - REPEAT THE ABOVE CODE, CHANGING THE TESTS FOR A POINT'S
+C BEING INSIDE/OUTSIDE THE PERIMETER.  COMMENTING WILL BE ABBREVIATED.
+C
+        IVIS=1
+C
+        IF (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX) THEN
+C
+          IVIS=0
+C
+          IF (IFST.EQ.0.OR.IVSO.EQ.0.OR.U.GE.1.E12) GO TO 108
+C
+          IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) THEN
+C
+            IF (JPRJ.GE.7) THEN
+              P=P-SIGN(CPRJ(JPRJ-6),P)
+              U=P
+              IF (JPRJ.EQ.9) U=U*SQRT(1.-V*V)
+            ELSE
+              GO TO 108
+            END IF
+C
+            IF (U.GE.UMIN.AND.U.LE.UMAX.AND.
+     +          V.GE.VMIN.AND.V.LE.VMAX) THEN
+              IVIS=1
+              GO TO 107
+            END IF
+          END IF
+C
+          CALL MAPTRP (UOLD,VOLD,U,V,UINT,VINT)
+          CALL MAPVP (UOLD,VOLD,UINT,VINT)
+          GO TO 108
+C
+        END IF
+C
+        IF (IFST.EQ.0.OR.UOLD.GE.1.E12) GO TO 106
+C
+        IF (ABS(P-POLD).GT.UEPS.OR.ABS(Q-QOLD).GT.VEPS) GO TO 103
+C
+        IF (IVSO.EQ.0) GO TO 104
+C
+        GO TO 107
+C
+  103   IF (JPRJ.LT.7) GO TO 106
+C
+        IF (IVSO.NE.0) THEN
+C
+          UTMP=P-SIGN(CPRJ(JPRJ-6),P)
+          VTMP=Q
+          IF (JPRJ.EQ.9) UTMP=UTMP*SQRT(1.-VTMP*VTMP)
+C
+          IF (UTMP.LT.UMIN.OR.UTMP.GT.UMAX.OR.
+     +        VTMP.LT.VMIN.OR.VTMP.GT.VMAX) THEN
+            CALL MAPTRP (UOLD,VOLD,UTMP,VTMP,UTMP,VTMP)
+          END IF
+C
+          CALL MAPVP (UOLD,VOLD,UTMP,VTMP)
+        END IF
+C
+        UOLD=POLD-SIGN(CPRJ(JPRJ-6),POLD)
+        IF (JPRJ.EQ.9) UOLD=UOLD*SQRT(1.-VOLD*VOLD)
+C
+        IF (UOLD.GE.UMIN.AND.UOLD.LE.UMAX.AND.
+     +      VOLD.GE.VMIN.AND.VOLD.LE.VMAX) GO TO 105
+C
+  104   CALL MAPTRP (U,V,UOLD,VOLD,UOLD,VOLD)
+C
+      END IF
+C
+C DRAW THE VISIBLE PORTION OF THE LINE JOINING THE OLD POINT TO THE NEW.
+C
+  105 IF (IDTL.EQ.0) THEN
+        CALL FRSTD (UOLD,VOLD)
+        DATL=0.
+      END IF
+C
+      CALL MAPVP (UOLD,VOLD,U,V)
+C
+      GO TO 108
+C
+C START A NEW LINE.
+C
+  106 IF (IDTL.EQ.0) THEN
+        CALL FRSTD (U,V)
+        DATL=0.
+      END IF
+C
+      GO TO 108
+C
+C CONTINUE THE LINE.
+C
+  107 IF (IFST.LT.2.AND.((U-UOLD)**2+(V-VOLD)**2)*DSSQ.LE.DPSQ) RETURN
+      CALL MAPVP (UOLD,VOLD,U,V)
+C
+C SAVE INFORMATION ABOUT THE CURRENT POINT FOR THE NEXT CALL AND QUIT.
+C
+  108 IVSO=IVIS
+      POLD=P
+      QOLD=Q
+      UOLD=U
+      VOLD=V
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPIQ
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCMP/ NPTB,XPTB(50),YPTB(50)
+C
+C FLUSH THE POINTS BUFFER.
+C
+      IF (NPTB.GT.0) THEN
+        CALL POINTS (XPTB,YPTB,NPTB,0,0)
+        NPTB=0
+      END IF
+C
+C FLUSH PLOTIT'S BUFFER, TOO.
+C
+      CALL PLOTIT (0,0,0)
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPLBL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+C
+C DEFINE REQUIRED CONSTANTS.  SIN1 AND COS1 ARE RESPECTIVELY THE SINE
+C AND COSINE OF ONE DEGREE.
+C
+      DATA SIN1 / .017452406437283 /
+      DATA COS1 / .999847695156390 /
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPLBL','VERSION  1')
+C
+C IF EZMAP NEEDS INITIALIZATION OR IF AN ERROR HAS OCCURRED SINCE THE
+C LAST INITIALIZATION, DO NOTHING.
+C
+      IF (INTF) RETURN
+      IF (IIER.NE.0) RETURN
+C
+C IF REQUESTED, LETTER KEY MERIDIANS AND POLES.
+C
+      IF (LBLF) THEN
+C
+C RESET THE INTENSITY, DOTTING, AND DASH PATTERN FOR LABELLING.
+C
+        CALL MAPCHI (3,1,0)
+C
+C FIRST, THE NORTH POLE.
+C
+        CALL MAPTRN (90.,0.,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                    CALL WTSTR (U,V,'NP',ILCW,0,0)
+C
+C THEN, THE SOUTH POLE.
+C
+        CALL MAPTRN (-90.,0.,U,V)
+        IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                    CALL WTSTR (U,V,'SP',ILCW,0,0)
+C
+C THE EQUATOR.
+C
+        RLON=PHIO-10.
+        DO 101 I=1,36
+          RLON=RLON+10.
+          CALL MAPTRN (0.,RLON,U,V)
+          IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 102
+  101   CONTINUE
+        GO TO 103
+  102   CALL WTSTR (U,V,'EQ',ILCW,0,0)
+C
+C THE GREENWICH MERIDIAN.
+C
+  103   RLAT=85.
+        DO 104 I=1,16
+          RLAT=RLAT-10.
+          CALL MAPTRN (RLAT,0.,U,V)
+          IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 105
+  104   CONTINUE
+        GO TO 106
+  105   CALL WTSTR (U,V,'GM',ILCW,0,0)
+C
+C INTERNATIONAL DATE LINE.
+C
+  106   RLAT=85.
+        DO 107 I=1,16
+          RLAT=RLAT-10.
+          CALL MAPTRN (RLAT,180.,U,V)
+          IF ((.NOT.ELPF.AND.U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN
+     +                                                   .AND.V.LE.VMAX)
+     +     .OR.(ELPF.AND.((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.LE.1.))
+     +                                                         GO TO 108
+  107   CONTINUE
+        GO TO 109
+  108   CALL WTSTR (U,V,'ID',ILCW,0,0)
+C
+C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN.
+C
+  109   CALL MAPCHI (-3,0,0)
+C
+      END IF
+C
+C DRAW PERIMETER, IF REQUESTED.
+C
+      IF (PRMF) THEN
+C
+C RESET THE LINE INTENSITY, DOTTING, AND DASH PATTERN FOR THE PERIMETER.
+C
+        CALL MAPCHI (1,0,IOR(ISHIFT(32767,1),1))
+C
+C THE PERIMETER IS EITHER AN ELLIPSE OR A RECTANGLE, DEPENDING ON ELPF.
+C
+        IF (ELPF) THEN
+          U=.9999*URNG
+          V=0.
+          DATL=0.
+          CALL FRSTD (UCEN+U,VCEN)
+          DO 110 I=1,360
+            UOLD=U
+            VOLD=V
+            U=COS1*UOLD-SIN1*VOLD
+            V=SIN1*UOLD+COS1*VOLD
+            CALL MAPVP (UCEN+UOLD,VCEN+VOLD*VRNG/URNG,
+     +                  UCEN+U   ,VCEN+V   *VRNG/URNG)
+  110     CONTINUE
+        ELSE
+          DATL=0.
+          UMINX=UMIN+.9999*(UMAX-UMIN)
+          UMAXX=UMAX-.9999*(UMAX-UMIN)
+          VMINX=VMIN+.9999*(VMAX-VMIN)
+          VMAXX=VMAX-.9999*(VMAX-VMIN)
+          CALL FRSTD (UMINX,VMINX)
+          CALL MAPVP (UMINX,VMINX,UMAXX,VMINX)
+          CALL MAPVP (UMAXX,VMINX,UMAXX,VMAXX)
+          CALL MAPVP (UMAXX,VMAXX,UMINX,VMAXX)
+          CALL MAPVP (UMINX,VMAXX,UMINX,VMINX)
+        END IF
+C
+C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN.
+C
+        CALL MAPCHI (-1,0,0)
+C
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPLOT
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C DEFINE REQUIRED CONSTANTS.
+C
+      DATA PI / 3.14159265358979 /
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPLOT','VERSION  1')
+C
+C IF EZMAP NEEDS INITIALIZATION OR IF AN ERROR HAS OCCURRED SINCE THE
+C LAST INITIALIZATION, DO NOTHING.
+C
+      IF (INTF) RETURN
+      IF (IIER.NE.0) RETURN
+C
+C IF THE SELECTED OUTLINE TYPE IS "NONE", DO NOTHING.
+C
+      IF (NOUT.LE.0) RETURN
+C
+C SET THE FLAG IWGF TO SAY WHETHER OR NOT THE WHOLE GLOBE IS SHOWN BY
+C THE CURRENT PROJECTION.  IF SO (IWGF=1), THERE'S NO NEED TO WASTE THE
+C TIME REQUIRED TO CHECK EACH OUTLINE POINT GROUP FOR INTERSECTION WITH
+C THE WINDOW.
+C
+      IWGF=0
+      IF (BLAM-SLAM.GT.179.9999.AND.BLOM-SLOM.GT.359.9999) IWGF=1
+C
+C IGIS KEEPS TRACK OF CHANGES IN THE GROUP IDENTIFIER, SO THAT THE
+C INTENSITY CAN BE CHANGED WHEN NECESSARY.
+C
+      IGIS=0
+C
+C POSITION TO THE USER-SELECTED PORTION OF THE OUTLINE DATASET.
+C
+      CALL MAPIO (1)
+      NSEG=0
+C
+C READ THE NEXT RECORD (GROUP OF POINTS).
+C
+  101 CALL MAPIO (2)
+      NSEG=NSEG+1
+C
+C CHECK FOR THE END OF THE DESIRED DATA.
+C
+      IF (NPTS.EQ.0) GO TO 103
+C
+C IF LESS THAN THE WHOLE GLOBE IS SHOWN BY THE PROJECTION, DO A QUICK
+C CHECK FOR INTERSECTION OF THE BOX SURROUNDING THE POINT GROUP WITH
+C THE AREA SHOWN.
+C
+      IF (IWGF.EQ.0) THEN
+        IF (SLAG.GT.BLAM.OR.BLAG.LT.SLAM) GO TO 101
+        IF ((SLOG     .GT.BLOM.OR.BLOG     .LT.SLOM).AND.
+     +      (SLOG-360..GT.BLOM.OR.BLOG-360..LT.SLOM).AND.
+     +      (SLOG+360..GT.BLOM.OR.BLOG+360..LT.SLOM)) GO TO 101
+      END IF
+C
+C SEE IF THE USER WANTS TO OMIT THIS POINT GROUP.
+C
+      CALL MAPEOS (NOUT,NSEG,IGID,NPTS,PNTS)
+      IF (NPTS.LE.1) GO TO 101
+C
+C IF WE'VE SWITCHED TO A NEW GROUP, SET THE INTENSITY, DOTTING, AND
+C DASH PATTERN FOR THE GROUP.
+C
+      IF (IGID.NE.IGIS) THEN
+        IF (IGIS.NE.0) CALL MAPCHI (-4-IGIS,0,0)
+        CALL MAPCHI (4+IGID,IDOT,IOR(ISHIFT(32767,1),1))
+        IGIS=IGID
+      END IF
+C
+C PLOT THE GROUP.
+C
+      CALL MAPIT (PNTS(1),PNTS(2),0)
+C
+      DO 102 K=2,NPTS-1
+        CALL MAPIT (PNTS(2*K-1),PNTS(2*K),1)
+  102 CONTINUE
+C
+      CALL MAPIT (PNTS(2*NPTS-1),PNTS(2*NPTS),2)
+C
+C GO GET ANOTHER GROUP.
+C
+      GO TO 101
+C
+C RESET THE INTENSITY, DOTTING, AND DASH PATTERN, IF NECESSARY.
+C
+  103 IF (IGIS.NE.0) CALL MAPCHI (-4-IGIS,0,0)
+C
+C IF THE LIMB LINES HAVE NOT ALREADY BEEN DRAWN, DO IT NOW.
+C
+      IF (GRID.LE.0.) CALL MAPLMB
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPPOS (ARG1,ARG2,ARG3,ARG4)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPPOS','VERSION  1')
+C
+C CHECK THE ARGUMENTS FOR ERRORS.
+C
+      IF (ARG1.LT.0..OR.ARG1.GE.ARG2.OR.ARG2.GT.1.) GO TO 901
+      IF (ARG3.LT.0..OR.ARG3.GE.ARG4.OR.ARG4.GT.1.) GO TO 901
+C
+C TRANSFER IN THE VALUES.
+C
+      XLOW=ARG1
+      XROW=ARG2
+      YBOW=ARG3
+      YTOW=ARG4
+C
+C SET THE FLAG TO INDICATE THAT INITIALIZATION IS NOW REQUIRED.
+C
+      INTF=.TRUE.
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXIT.
+C
+  901 IIER=19
+      CALL SETER (' MAPPOS - ARGUMENTS ARE INCORRECT',IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPROJ (ARG1,ARG2,ARG3,ARG4)
+C
+      CHARACTER*(*) ARG1
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPROJ','VERSION  1')
+C
+C TRANSFER THE PARAMETERS DEFINING THE PROJECTION.
+C
+      I=IDICTL(ARG1,PDCT,10)
+      IF (I.EQ.0) GO TO 901
+C
+      JPRJ=I
+C
+      IF (JPRJ.EQ.3) THEN
+        CALL MAPSTR ('SA',0.)
+      ELSE IF (JPRJ.EQ.10) THEN
+        JPRJ=3
+        IF (ABS(SALT).LE.1.) CALL MAPSTR ('SA',6.631)
+      END IF
+C
+      PHIA=ARG2
+      PHIO=ARG3
+      ROTA=ARG4
+C
+C SET THE FLAG TO INDICATE THAT INITIALIZATION IS NOW REQUIRED.
+C
+      INTF=.TRUE.
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXIT.
+C
+  901 IIER=9
+      CALL MAPCEM (' MAPROJ - UNKNOWN PROJECTION NAME ',ARG1,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPRS
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPRS','VERSION  1')
+C
+C RESTORE THE SET CALL.
+C
+      CALL SET (ULOW,UROW,VBOW,VTOW,UMIN,UMAX,VMIN,VMAX,1)
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPRST (IFNO)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPNTS/ INTS(7)
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPRST','VERSION  1')
+C
+C READ A RECORD OF SAVED PARAMETERS.
+C
+      READ (IFNO,ERR=901,END=902) NOUT,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,
+     +                            PLA2,PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,
+     +                            PLTR,GRID,IDSH,IDOT,LBLF,PRMF,ELPF,
+     +                            XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,
+     +                            ILCW,DPLT,DDTS,SALT,SSMO,SRSS,ALFA,
+     +                            BETA,SALF,CALF,SBET,CBET,
+     +                            (INTS(I),I=1,7)
+C
+C RE-INITIALIZE EZMAP.
+C
+      CALL MAPINT
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=20
+      CALL SETER ('MAPRST - ERROR ON READ',IIER,1)
+      RETURN
+C
+  902 IIER=21
+      CALL SETER ('MAPRST - EOF ON READ',IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSAV (IFNO)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPNTS/ INTS(7)
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSAV','VERSION  1')
+C
+C WRITE A RECORD CONTAINING ALL THE USER-SETTABLE PARAMETERS.
+C
+      WRITE (IFNO,ERR=901) NOUT,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,
+     +                     PLA2,PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,
+     +                     PLTR,GRID,IDSH,IDOT,LBLF,PRMF,ELPF,
+     +                     XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,
+     +                     ILCW,DPLT,DDTS,SALT,SSMO,SRSS,ALFA,
+     +                     BETA,SALF,CALF,SBET,CBET,
+     +                     (INTS(I),I=1,7)
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=22
+      CALL SETER ('MAPSAV - ERROR ON WRITE',IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSET (ARG1,ARG2,ARG3,ARG4,ARG5)
+C
+      CHARACTER*(*) ARG1
+      DIMENSION ARG2(2),ARG3(2),ARG4(2),ARG5(2)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSET','VERSION  1')
+C
+C TRANSFER THE PARAMETERS DEFINING THE MAP LIMITS.
+C
+      I=IDICTL(ARG1,LDCT,5)
+      IF (I.EQ.0) GO TO 901
+      ILTS=I
+C
+      PLA1=ARG2(1)
+      PLA2=ARG3(1)
+      PLA3=ARG4(1)
+      PLA4=ARG5(1)
+C
+      IF (I.EQ.3) THEN
+        PLB1=ARG2(2)
+        PLB2=ARG3(2)
+        PLB3=ARG4(2)
+        PLB4=ARG5(2)
+      END IF
+C
+C SET THE FLAG TO INDICATE THAT INITIALIZATION IS NOW REQUIRED.
+C
+      INTF=.TRUE.
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXIT.
+C
+  901 IIER=10
+      CALL MAPCEM (' MAPSET - UNKNOWN MAP AREA SPECIFIER ',ARG1,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSTC (WHCH,CVAL)
+C
+      CHARACTER*(*) WHCH,CVAL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTC','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'OU') THEN
+        I=IDICTL(CVAL,DDCT,5)
+        IF (I.EQ.0) GO TO 901
+        NOUT=I-1
+      ELSE
+        GO TO 902
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=11
+      CALL MAPCEM (' MAPSTC - UNKNOWN OUTLINE NAME ',CVAL,IIER,1)
+      RETURN
+C
+  902 IIER=12
+      CALL MAPCEM (' MAPSTC - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSTI (WHCH,IVAL)
+C
+      CHARACTER*(*) WHCH
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPNTS/ INTS(7)
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTI','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DA') THEN
+        IDSH=IVAL
+      ELSE IF (WHCH(1:2).EQ.'DD') THEN
+        DDTS=IVAL
+        DBTD=DDTS/DSCA
+      ELSE IF (WHCH(1:2).EQ.'DL') THEN
+        IDTL=IVAL
+      ELSE IF (WHCH(1:2).EQ.'DO') THEN
+        IDOT=IVAL
+      ELSE IF (WHCH(1:2).EQ.'EL') THEN
+        ELPF=IVAL.NE.0
+      ELSE IF (WHCH(1:2).EQ.'GR') THEN
+        GRID=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I1') THEN
+        INTS(1)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I2') THEN
+        INTS(2)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I3') THEN
+        INTS(3)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I4') THEN
+        INTS(4)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I5') THEN
+        INTS(5)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I6') THEN
+        INTS(6)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'I7') THEN
+        INTS(7)=IVAL
+      ELSE IF (WHCH(1:2).EQ.'LA') THEN
+        LBLF=IVAL.NE.0
+      ELSE IF (WHCH(1:2).EQ.'LS') THEN
+        ILCW=IVAL
+      ELSE IF (WHCH(1:2).EQ.'MV') THEN
+        DPLT=IVAL
+        DPSQ=DPLT*DPLT
+      ELSE IF (WHCH(1:2).EQ.'PE') THEN
+        PRMF=IVAL.NE.0
+      ELSE IF (WHCH(1:2).EQ.'RE') THEN
+        PLTR=IVAL
+        DSCA=(UROW-ULOW)*PLTR/(UMAX-UMIN)
+        DSSQ=DSCA*DSCA
+        DBTD=DDTS/DSCA
+      ELSE IF (WHCH(1:2).EQ.'SA') THEN
+        SALT=IVAL
+        IF (ABS(SALT).GT.1.) THEN
+          SSMO=SALT*SALT-1.
+          SRSS=SQRT(SSMO)
+        END IF
+      ELSE IF (WHCH(1:2).EQ.'S1') THEN
+        ALFA=IVAL
+        SALF=SIN(.017453292519943*ALFA)
+        CALF=COS(.017453292519943*ALFA)
+      ELSE IF (WHCH(1:2).EQ.'S2') THEN
+        BETA=IVAL
+        SBET=SIN(.017453292519943*BETA)
+        CBET=COS(.017453292519943*BETA)
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=13
+      CALL MAPCEM (' MAPSTI - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSTL (WHCH,LVAL)
+C
+      CHARACTER*(*) WHCH
+      LOGICAL LVAL
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMB/ IIER
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTL','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DL') THEN
+        IDTL=0
+        IF (LVAL) IDTL=1
+      ELSE IF (WHCH(1:2).EQ.'DO') THEN
+        IDOT=0
+        IF (LVAL) IDOT=1
+      ELSE IF (WHCH(1:2).EQ.'EL') THEN
+        ELPF=LVAL
+      ELSE IF (WHCH(1:2).EQ.'LA') THEN
+        LBLF=LVAL
+      ELSE IF (WHCH(1:2).EQ.'PE') THEN
+        PRMF=LVAL
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=14
+      CALL MAPCEM (' MAPSTL - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPSTR (WHCH,RVAL)
+C
+      CHARACTER*(*) WHCH
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','MAPSTR','VERSION  1')
+C
+      IF (WHCH(1:2).EQ.'DD') THEN
+        DDTS=RVAL
+        DBTD=DDTS/DSCA
+      ELSE IF (WHCH(1:2).EQ.'GD') THEN
+        GRDR=AMAX1(.001,AMIN1(10.,RVAL))
+      ELSE IF (WHCH(1:2).EQ.'GR') THEN
+        GRID=RVAL
+      ELSE IF (WHCH(1:2).EQ.'MV') THEN
+        DPLT=RVAL
+        DPSQ=DPLT*DPLT
+      ELSE IF (WHCH(1:2).EQ.'RE') THEN
+        PLTR=RVAL
+        DSCA=(UROW-ULOW)*PLTR/(UMAX-UMIN)
+        DSSQ=DSCA*DSCA
+        DBTD=DDTS/DSCA
+      ELSE IF (WHCH(1:2).EQ.'SA') THEN
+        SALT=RVAL
+        IF (ABS(SALT).GT.1.) THEN
+          SSMO=SALT*SALT-1.
+          SRSS=SQRT(SSMO)
+        END IF
+      ELSE IF (WHCH(1:2).EQ.'S1') THEN
+        ALFA=RVAL
+        SALF=SIN(.017453292519943*ALFA)
+        CALF=COS(.017453292519943*ALFA)
+      ELSE IF (WHCH(1:2).EQ.'S2') THEN
+        BETA=RVAL
+        SBET=SIN(.017453292519943*BETA)
+        CBET=COS(.017453292519943*BETA)
+      ELSE IF (WHCH(1:2).EQ.'SR') THEN
+        SRCH=AMAX1(.001,AMIN1(10.,RVAL))
+      ELSE
+        GO TO 901
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=15
+      CALL MAPCEM (' MAPSTR - UNKNOWN PARAMETER NAME ',WHCH,IIER,1)
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPTRN (RLAT,RLON,U,V)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM8/ P,Q,R
+      COMMON /MAPCMB/ IIER
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C DEFINE REQUIRED CONSTANTS.  DTOR IS PI OVER 180, DTRH IS HALF OF DTOR
+C OR PI OVER 360, AND TOPI IS 2 OVER PI.
+C
+      DATA DTOR / .017453292519943 /
+      DATA DTRH / .008726646259971 /
+      DATA RTOD / 57.2957795130823 /
+      DATA TOPI / .636619772367581 /
+C
+C SET UP U AND V FOR THE FAST PATHS.  U IS A LONGITUDE, IN DEGREES,
+C BETWEEN -180. AND +180., INCLUSIVE, AND V IS A LATITUDE, IN DEGREES.
+C
+      TMP1=RLON-PHOC
+      U=TMP1-SIGN(180.,TMP1+180.)+SIGN(180.,180.-TMP1)
+      V=RLAT
+C
+C TAKE FAST PATHS FOR SIMPLE CYLINDRICAL PROJECTIONS.
+C
+      IF (IPRJ-10) 101,116,112
+C
+C NO FAST PATH.  SORT OUT THE LAMBERT CONFORMAL CONIC FROM THE REST.
+C
+  101 IF (IPRJ-1) 901,102,103
+C
+C LAMBERT CONFORMAL CONIC.
+C
+  102 P=U
+      CHI=90.-SINO*RLAT
+      IF (CHI.GE.179.9999) GO TO 118
+      R=TAN(DTRH*CHI)**COSO
+      U=U*COSO*DTOR
+      V=-R*SINO*COS(U)
+      U=R*SIN(U)
+      GO TO 117
+C
+C NOT LAMBERT CONFORMAL CONIC.  CALCULATE CONSTANTS COMMON TO MOST OF
+C THE OTHER PROJECTIONS.
+C
+  103 TMP1=U*DTOR
+      TMP2=V*DTOR
+      SINPH=SIN(TMP1)
+      SINLA=SIN(TMP2)
+      COSPH=COS(TMP1)
+      COSLA=COS(TMP2)
+      TCOS=COSLA*COSPH
+      COSA=AMAX1(-1.,AMIN1(+1.,SINLA*SINO+TCOS*COSO))
+      SINA=SQRT(1.-COSA*COSA)
+      IF (SINA.LT..0001) THEN
+        SINA=0.
+        IF (IPRJ.GE.7.OR.COSA.LT.0.) GO TO 118
+        U=0.
+        V=0.
+        GO TO 116
+      END IF
+      SINB=COSLA*SINPH/SINA
+      COSB=(SINLA*COSO-TCOS*SINO)/SINA
+C
+C JUMP TO CODE APPROPRIATE FOR THE CHOSEN PROJECTION.
+C
+      GO TO (104,105,106,107,108,109,110,111) , IPRJ-1
+C
+C STEREOGRAPHIC.
+C
+  104 IF (ABS(SINA).LT..0001) THEN
+        R=SINA/2.
+      ELSE
+        R=(1.-COSA)/SINA
+      END IF
+      GO TO 115
+C
+C ORTHOGRAPHIC OR SATELLITE-VIEW, DEPENDING ON THE VALUE OF SALT.
+C
+  105 IF (ABS(SALT).LE.1.) THEN
+        IF (COSA.GT.0.) THEN
+          R=SINA
+        ELSE
+          IF (SALT.GE.0.) GO TO 118
+          R=2.-SINA
+        END IF
+        GO TO 115
+      ELSE
+        IF (COSA.GT.1./ABS(SALT)) THEN
+          R=SRSS*SINA/(ABS(SALT)-COSA)
+        ELSE
+          IF (SALT.GE.0.) GO TO 118
+          R=2.-SRSS*SINA/(ABS(SALT)-COSA)
+        END IF
+        IF (ALFA.EQ.0.) GO TO 115
+        UTM1=R*(SINB*COSR+COSB*SINR)
+        VTM1=R*(COSB*COSR-SINB*SINR)
+        UTM2=UTM1*CBET+VTM1*SBET
+        VTM2=VTM1*CBET-UTM1*SBET
+        UTM3=SRSS*UTM2/(UTM2*SALF+SRSS*CALF)
+        VTM3=SRSS*VTM2*CALF/(UTM2*SALF+SRSS*CALF)
+        U=UTM3*CBET-VTM3*SBET
+        V=VTM3*CBET+UTM3*SBET
+        GO TO 116
+      END IF
+C
+C LAMBERT EQUAL AREA.
+C
+  106 IF (ABS(COSA+1.).LT.1.E-6) GO TO 118
+      R=(1.+COSA)/SINA
+      R=2./SQRT(1.+R*R)
+      GO TO 115
+C
+C GNOMONIC.
+C
+  107 IF (COSA.LE..0001) GO TO 118
+      R=SINA/COSA
+      GO TO 115
+C
+C AZIMUTHAL EQUIDISTANT.
+C
+  108 IF (ABS(COSA+1.).LT.1.E-6) GO TO 118
+      R=ACOS(COSA)
+      GO TO 115
+C
+C CYLINDRICAL EQUIDISTANT, ARBITRARY POLE AND ORIENTATION.
+C
+  109 U=ATAN2(SINB*COSR+COSB*SINR,SINB*SINR-COSB*COSR)*RTOD
+      V=90.-ACOS(COSA)*RTOD
+      GO TO 116
+C
+C MERCATOR, ARBITRARY POLE AND ORIENTATION.
+C
+  110 U=ATAN2(SINB*COSR+COSB*SINR,SINB*SINR-COSB*COSR)
+      V=ALOG((1.+COSA)/SINA)
+      GO TO 116
+C
+C MOLLWEIDE, ARBITRARY POLE AND ORIENTATION.
+C
+  111 U=ATAN2(SINB*COSR+COSB*SINR,SINB*SINR-COSB*COSR)*TOPI
+      P=U
+      V=COSA
+      U=U*SINA
+      GO TO 117
+C
+C FAST-PATH CYLINDRICAL PROJECTIONS (WITH PLAT=ROTA=0).
+C
+  112 IF (IPRJ-12) 113,114,901
+C
+C FAST-PATH MERCATOR.
+C
+  113 IF (ABS(RLAT).GT.89.9999) GO TO 118
+      U=U*DTOR
+      V=ALOG(TAN((RLAT+90.)*DTRH))
+      GO TO 116
+C
+C FAST-PATH MOLLWEIDE.
+C
+  114 U=U/90.
+      V=SIN(RLAT*DTOR)
+      P=U
+      U=U*SQRT(1.-V*V)
+      GO TO 117
+C
+C COMMON TERMINAL CODE FOR CERTAIN PROJECTIONS.
+C
+  115 U=R*(SINB*COSR+COSB*SINR)
+      V=R*(COSB*COSR-SINB*SINR)
+C
+  116 P=U
+C
+  117 Q=V
+C
+C NORMAL EXIT.
+C
+      RETURN
+C
+C PROJECTION OF POINT IS INVISIBLE OR UNDEFINED.
+C
+  118 U=1.E12
+      P=U
+      RETURN
+C
+C ERROR EXIT.
+C
+  901 IF (IIER.NE.0) GO TO 118
+      IIER=16
+      CALL SETER (' MAPTRN - ATTEMPT TO USE NON-EXISTENT PROJECTION',
+     +              IIER,1)
+      GO TO 118
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPUSR (IPRT)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPVEC (XLAT,XLON)
+      CALL MAPIT (XLAT,XLON,1)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE SUPCON (RLAT,RLON,UVAL,VVAL)
+      CALL MAPTRN (RLAT,RLON,UVAL,VVAL)
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE SUPMAP (JPRJ,PLAT,PLON,ROTA,PLM1,PLM2,PLM3,PLM4,JLTS,
+     +                   JGRD,IOUT,IDOT,IERR)
+C
+      DIMENSION PLM1(2),PLM2(2),PLM3(2),PLM4(2)
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+      CHARACTER*2     DDCT,LDCT,PDCT
+      COMMON /MAPCMB/ IIER
+C
+      DIMENSION LPRJ(10),LLTS(5)
+C
+      DATA LPRJ / 2,3,1,4,5,6,10,7,8,9 /
+      DATA LLTS / 1,2,5,4,3 /
+C
+C THE FOLLOWING CALL GATHERS STATISTICS ON LIBRARY USAGE AT NCAR.
+C
+      CALL Q8QST4 ('GRAPHX','EZMAP','SUPMAP','VERSION  1')
+C
+C SET EZMAP'S GRID-SPACING PARAMETER.
+C
+      CALL MAPSTI ('GR',MOD(IABS(JGRD),1000))
+C
+C SET EZMAP'S OUTLINE-SELECTION PARAMETER.
+C
+      IF (IABS(IOUT).EQ.0.OR.IABS(IOUT).EQ.1) THEN
+        I=1+2*IABS(IOUT)+(1+ISIGN(1,JPRJ))/2
+      ELSE
+        I=MAX0(1,MIN0(5,IOUT))
+      END IF
+C
+      CALL MAPSTC ('OU',DDCT(I))
+C
+C SET EZMAP'S PERIMETER-DRAWING FLAG.
+C
+      CALL MAPSTL ('PE',JGRD.GE.0)
+C
+C SET EZMAP'S GRID-LINE-LABELLING FLAG.
+C
+      CALL MAPSTL ('LA',MOD(IABS(JGRD),1000).NE.0)
+C
+C SET EZMAP'S DOTTED-OUTLINE FLAG.
+C
+      CALL MAPSTI ('DO',MAX0(0,MIN0(1,IDOT)))
+C
+C SET EZMAP'S PROJECTION-SELECTION PARAMETERS.
+C
+      I=MAX0(1,MIN0(10,IABS(JPRJ)))
+      CALL MAPROJ (PDCT(LPRJ(I)),PLAT,PLON,ROTA)
+C
+C SET EZMAP'S RECTANGULAR-LIMITS-SELECTION PARAMETERS.
+C
+      I=LLTS(MAX0(1,MIN0(5,IABS(JLTS))))
+      CALL MAPSET (LDCT(I),PLM1,PLM2,PLM3,PLM4)
+C
+C DRAW THE MAP.
+C
+      CALL MAPDRW
+C
+C RETURN THE ERROR FLAG TO THE USER.
+C
+      IERR=IIER
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C***********************************************************************
+C T H E   C O D E   -   I N T E R N A L   R O U T I N E S
+C***********************************************************************
+C
+      SUBROUTINE MAPCEM (IEM1,IEM2,IIER,IFLG)
+C
+      CHARACTER*(*) IEM1,IEM2
+C
+C MAPCEM IS CALLED TO DO A CALL TO SETER WHEN THE ERROR MESSAGE TO BE
+C PRINTED IS IN TWO PARTS WHICH NEED TO BE CONCATENATED.  FORTRAN-77
+C RULES MAKE IT NECESSARY TO CONCATENATE THE TWO PARTS OF THE MESSAGE
+C INTO A LOCAL CHARACTER VARIABLE.
+C
+      CHARACTER*100 IEMC
+C
+      IEMC=IEM1//IEM2
+      CALL SETER (IEMC,IIER,IFLG)
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPCHI (IPRT,IDTG,IDPT)
+C
+C MAPCHI IS CALLED BY VARIOUS EZMAP ROUTINES TO RESET THE INTENSITY,
+C DOTTING, AND DASH PATTERN BEFORE AND AFTER DRAWING PARTS OF A MAP.
+C
+C THE ARGUMENT IPRT, IF POSITIVE, SAYS WHICH PART OF THE MAP IS ABOUT
+C TO BE DRAWN, AS FOLLOWS:
+C
+C     IPRT    PART OF MAP.
+C     ----    ------------
+C       1     PERIMETER.
+C       2     GRID.
+C       3     LABELLING.
+C       4     LIMB LINES.
+C       5     OUTLINE POINT GROUP, CONTINENTAL.
+C       6     OUTLINE POINT GROUP, U.S.
+C       7     OUTLINE POINT GROUP, COUNTRY.
+C
+C A CALL WITH IPRT EQUAL TO THE NEGATIVE OF ONE OF THESE VALUES ASKS
+C THAT THE INTENSITY SAVED BY THE LAST CALL, WITH IPRT POSITIVE, BE
+C RESTORED.
+C
+C WHEN IPRT IS POSITIVE, IDTG IS ZERO IF SOLID LINES ARE TO BE USED, 1
+C IF DOTTED LINES ARE TO BE USED.  IF IPRT IS NEGATIVE, IDTG IS IGNORED.
+C
+C WHEN IPRT IS POSITIVE AND IDTG IS ZERO, IDPT IS THE DASH PATTERN TO BE
+C USED.  IF IPRT IS NEGATIVE OR IDTG IS NON-ZERO, IDPT IS IGNORED.
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPNTS/ INTS(7)
+C
+C DECLARE ONE OF THE DASH-PACKAGE COMMON BLOCKS, TOO.
+C
+      COMMON /SMFLAG/ ISMO
+C
+C THE VARIABLES INTO, IDTS, AND ISMS NEED TO BE SAVED BETWEEN CALLS.
+C
+      SAVE INTO,IDTS,ISMS
+C
+C FLUSH ALL BUFFERS BEFORE CHANGING ANYTHING.
+C
+      CALL MAPIQ
+C
+C SET/RESET INTENSITY, DOTTING, AND DASH PATTERN.  THE USER HAS THE
+C LAST WORD.
+C
+      IF (IPRT.GT.0) THEN
+        ISMS=ISMO
+        ISMO=1
+        IDTS=IDTL
+        IDTL=IDTG
+        IF (IDTL.EQ.0) CALL DASHDB (IDPT)
+C
+C THE FOLLOWING LINES HAVE BEEN COMMENTED OUT BECAUSE THE INTENSITY
+C SETTING CAUSES SOME STRANGE BEHAVIOUR ON CERTAIN TERMINALS AND
+C WORKSTATIONS.
+C
+C        CALL GETUSV ('IN',INTO)
+C        CALL SETUSV ('IN',IFIX(10000.*FLOAT(INTS(IPRT))/255.))
+        CALL MAPUSR (IPRT)
+      ELSE
+        CALL MAPUSR (IPRT)
+C
+C THE FOLLOWING LINE HAVE BEEN COMMENTED OUT BECAUSE THE INTENSITY
+C SETTING CAUSES SOME STRANGE BEHAVIOUR ON CERTAIN TERMINALS AND
+C WORKSTATIONS.
+C
+C        CALL SETUSV ('IN',INTO)
+        IF (IDTL.EQ.0) CALL DASHDB (IOR(ISHIFT(32767,1),1))
+        IDTL=IDTS
+        ISMO=ISMS
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      INTEGER FUNCTION IDICTL (ISTR,IDCT,NDCT)
+C
+      CHARACTER*(*) ISTR
+      CHARACTER*2 IDCT(NDCT)
+C
+C THE VALUE OF THIS FUNCTION IS THE INDEX IN THE NDCT-ELEMENT DICTIONARY
+C IDCT OF THE STRING ISTR.  ONLY THE FIRST TWO CHARACTERS OF ISTR AND
+C IDCT(I) ARE COMPARED.  IF ISTR IS NOT FOUND IN THE DICTIONARY, THE
+C FUNCTION VALUE IS ZERO.
+C
+      DO 101 I=1,NDCT
+        IF (ISTR(1:2).EQ.IDCT(I)) THEN
+          IDICTL=I
+          RETURN
+        END IF
+  101 CONTINUE
+C
+C NOT FOUND.  RETURN A ZERO.
+C
+      IDICTL=0
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPIO (IACT)
+C
+C THIS ROUTINE PERFORMS ALL POSITIONING AND INPUT OF THE OUTLINE DATASET
+C FOR MAPLOT.  THE ARGUMENT IACT SPECIFIES WHAT IS TO BE DONE:  1 ASKS
+C THAT THE DATASET BE POSITIONED AT THE BEGINNING OF THE DESIRED "FILE",
+C 2 THAT THE NEXT RECORD BE READ.
+C
+C FIVE LINES OF THE CODE BELOW HAVE BEEN INSERTED TO MAKE THIS ROUTINE
+C RUN EFFICIENTLY ON NCAR'S CRAYS; THESE LINES SHOULD BE REMOVED BY
+C ANYONE IMPLEMENTING EZMAP ON ANOTHER SYSTEM (EXCEPT PERHAPS ANOTHER
+C CRAY).
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+      COMMON /MAPCMB/ IERR
+C
+      IF (IACT.EQ.1) THEN
+C
+C POSITION TO THE DESIRED "FILE" WITHIN THE DATASET.
+C
+C THE FOLLOWING FIVE LINES ARE FOR NCAR'S CRAYS.
+C
+C       ITPN=6LEZMPDT
+C       IF (IFDNT(ITPN).EQ.0) THEN
+C         CALL SDACCESS (IERR,ITPN)
+C         IF (IERR.NE.0) GO TO 901
+C       END IF
+C
+        REWIND ITPN
+C
+        IF (NOUT.NE.1) THEN
+          ITMP=NOUT
+  101     READ (ITPN,END=902) NPTS,IGID,BLAG,SLAG,BLOG,SLOG,
+     +                                                (PNTS(I),I=1,NPTS)
+          IF (NPTS.GT.1) GO TO 101
+          ITMP=ITMP-1
+          IF (ITMP.GT.1) GO TO 101
+        END IF
+C
+      ELSE
+C
+C READ THE NEXT RECORD.
+C
+        READ (ITPN) NPTS,IGID,BLAG,SLAG,BLOG,SLOG,(PNTS(I),I=1,NPTS)
+        NPTS=NPTS/2
+C
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+C ERROR EXITS.
+C
+  901 IIER=17
+      CALL SETER (' MAPIO - OUTLINE DATASET IS UNREADABLE',IIER,1)
+      NOUT=0
+      RETURN
+C
+  902 IIER=18
+      CALL SETER (' MAPIO - EOF ENCOUNTERED IN OUTLINE DATASET',IIER,1)
+      NOUT=0
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPLMB
+C
+C THE ROUTINE MAPLMB IS CALLED BY MAPGRD AND/OR MAPLOT TO DRAW THE LIMB
+C LINES.
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C DEFINE REQUIRED CONSTANTS.  SIN1 AND COS1 ARE RESPECTIVELY THE SINE
+C AND COSINE OF ONE DEGREE.
+C
+      DATA SIN1 / .017452406437283 /
+      DATA COS1 / .999847695156390 /
+      DATA PI   / 3.14159265358979 /
+C
+C THE ARITHMETIC STATEMENT FUNCTIONS FLOOR AND CLING GIVE, RESPECTIVELY,
+C THE "FLOOR" OF X - THE LARGEST INTEGER LESS THAN OR EQUAL TO X - AND
+C THE "CEILING" OF X - THE SMALLEST INTEGER GREATER THAN OR EQUAL TO X.
+C
+      FLOOR(X)=AINT(X+1.E4)-1.E4
+      CLING(X)=-FLOOR(-X)
+C
+C RESET THE INTENSITY, DOTTING, AND DASH PATTERN FOR LIMB LINES.
+C
+      CALL MAPCHI (4,0,IOR(ISHIFT(32767,1),1))
+C
+C DRAW LIMB LINES, THE NATURE OF WHICH DEPENDS ON THE PROJECTION.
+C
+      GO TO (101,110,104,105,110,106,110,110,107,110,110,107) , IPRJ
+C
+C LAMBERT CONFORMAL CONIC WITH TWO STANDARD PARALLELS.
+C
+  101 DLAT=GRDR
+      RLON=PHIO+179.9999
+      K=CLING(180./DLAT)
+      DO 103 I=1,2
+        RLAT=-90.
+        CALL MAPIT (RLAT,RLON,0)
+        DO 102 J=1,K-1
+          RLAT=RLAT+DLAT
+          CALL MAPIT (RLAT,RLON,1)
+  102   CONTINUE
+        RLAT=RLAT+DLAT
+        CALL MAPIT (RLAT,RLON,2)
+        RLON=PHIO-179.9999
+  103 CONTINUE
+      GO TO 110
+C
+C ORTHOGRAPHIC (OR SATELLITE-VIEW).
+C
+  104 IF (ABS(SALT).LE.1..OR.ALFA.EQ.0.) THEN
+        URAD=1.
+        RVTU=1.
+      ELSE
+        DNOM=SALT*SALT*CALF*CALF-1.
+        URAD=SSMO*CALF/DNOM
+        RVTU=SQRT(DNOM)/SRSS
+      END IF
+      GO TO 108
+C
+C LAMBERT EQUAL AREA.
+C
+  105 URAD=2.
+      RVTU=1.
+      GO TO 108
+C
+C AZIMUTHAL EQUIDISTANT.
+C
+  106 URAD=PI
+      RVTU=1.
+      GO TO 108
+C
+C MOLLWEIDE.
+C
+  107 URAD=2.
+      RVTU=0.5
+C
+  108 UCIR=URAD
+      VCIR=0.
+      IVIS=-1
+      DO 109 I=1,361
+        IF (IPRJ.NE.3.OR.ABS(SALT).LE.1..OR.ALFA.EQ.0.) THEN
+          U=UCIR
+          V=RVTU*VCIR
+        ELSE
+          UTMP=UCIR-SRSS*SALF/DNOM
+          VTMP=RVTU*VCIR
+          U=UTMP*CBET-VTMP*SBET
+          V=VTMP*CBET+UTMP*SBET
+        END IF
+        IF (.NOT.ELPF.AND.
+     +      (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX)) THEN
+          IF (IVIS.EQ.1) THEN
+            CALL MAPTRP (UOLD,VOLD,U,V,UEDG,VEDG)
+            CALL MAPVP  (UOLD,VOLD,UEDG,VEDG)
+          END IF
+          IVIS=0
+        ELSE IF (ELPF.AND.
+     +           (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.)) THEN
+          IF (IVIS.EQ.1) THEN
+            CALL MAPTRE (UOLD,VOLD,U,V,UEDG,VEDG)
+            CALL MAPVP  (UOLD,VOLD,UEDG,VEDG)
+          END IF
+          IVIS=0
+        ELSE
+          IF (IVIS.LT.0) THEN
+            DATL=0.
+            CALL FRSTD (U,V)
+            IVIS=1
+          ELSE
+            IF (IVIS.EQ.0) THEN
+              IF (.NOT.ELPF) CALL MAPTRP (U,V,UOLD,VOLD,UOLD,VOLD)
+              IF (     ELPF) CALL MAPTRE (U,V,UOLD,VOLD,UOLD,VOLD)
+              DATL=0.
+              CALL FRSTD (UOLD,VOLD)
+              IVIS=1
+            END IF
+            CALL MAPVP (UOLD,VOLD,U,V)
+          END IF
+        END IF
+        UOLD=U
+        VOLD=V
+        UTMP=UCIR
+        VTMP=VCIR
+        UCIR=UTMP*COS1-VTMP*SIN1
+        VCIR=UTMP*SIN1+VTMP*COS1
+  109 CONTINUE
+C
+C RESTORE THE ORIGINAL INTENSITY, DOTTING, AND DASH PATTERN.
+C
+  110 CALL MAPCHI (-4,0,0)
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPTRE (UINS,VINS,UOUT,VOUT,UINT,VINT)
+C
+C THIS ROUTINE FINDS THE POINT OF INTERSECTION (UINT,VINT) OF THE LINE
+C FROM (UINS,VINS) TO (UOUT,VOUT) WITH THE EDGE OF AN ELLIPTICAL FRAME.
+C THE FIRST POINT IS INSIDE THE FRAME AND THE SECOND OUTSIDE THE FRAME.
+C
+C BECAUSE MAPTRE CAN BE CALLED WITH THE SAME ACTUAL ARGUMENTS FOR UINT
+C AND VINT AS FOR UOUT AND VOUT, RESPECTIVELY, UINT AND VINT MUST NOT
+C BE RESET UNTIL ALL USE OF UOUT AND VOUT IS COMPLETE.
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+C
+C WHAT'S INVOLVED IS JUST A LOT OF ALGEBRA.
+C
+      IF (ABS(UOUT-UINS).GT.ABS(VOUT-VINS)) THEN
+        P=(VOUT-VINS)/(UOUT-UINS)
+        Q=(UOUT*VINS-UINS*VOUT)/(UOUT-UINS)
+        A=VRNG*VRNG+P*P*URNG*URNG
+        B=2.*(P*Q*URNG*URNG-UCEN*VRNG*VRNG-P*URNG*URNG*VCEN)
+        C=UCEN*UCEN*VRNG*VRNG+Q*Q*URNG*URNG-2.*Q*URNG*URNG*VCEN+
+     +                           URNG*URNG*VCEN*VCEN-URNG*URNG*VRNG*VRNG
+        UTM1=SQRT(AMAX1(B*B-4.*A*C,0.))
+        UTM2=.5*(-B-UTM1)/A
+        IF ((UTM2-UOUT)*(UTM2-UINS).GT.0.) UTM2=.5*(-B+UTM1)/A
+        UINT=UTM2
+        VINT=P*UINT+Q
+      ELSE
+        P=(UOUT-UINS)/(VOUT-VINS)
+        Q=(UINS*VOUT-UOUT*VINS)/(VOUT-VINS)
+        A=URNG*URNG+P*P*VRNG*VRNG
+        B=2.*(P*Q*VRNG*VRNG-URNG*URNG*VCEN-P*UCEN*VRNG*VRNG)
+        C=URNG*URNG*VCEN*VCEN+Q*Q*VRNG*VRNG-2.*Q*UCEN*VRNG*VRNG+
+     +                           UCEN*UCEN*VRNG*VRNG-URNG*URNG*VRNG*VRNG
+        VTM1=SQRT(AMAX1(B*B-4.*A*C,0.))
+        VTM2=.5*(-B-VTM1)/A
+        IF ((VTM2-VOUT)*(VTM2-VINS).GT.0.) VTM2=.5*(-B+VTM1)/A
+        VINT=VTM2
+        UINT=P*VINT+Q
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPTRP (UINS,VINS,UOUT,VOUT,UINT,VINT)
+C
+C THIS ROUTINE FINDS THE POINT OF INTERSECTION (UINT,VINT) OF THE LINE
+C FROM (UINS,VINS) TO (UOUT,VOUT) WITH THE EDGE OF A RECTANGULAR FRAME.
+C THE FIRST POINT IS INSIDE THE FRAME AND THE SECOND OUTSIDE THE FRAME.
+C
+C BECAUSE MAPTRP CAN BE CALLED WITH THE SAME ACTUAL ARGUMENTS FOR UINT
+C AND VINT AS FOR UOUT AND VOUT, RESPECTIVELY, UINT AND VINT MUST NOT
+C BE RESET UNTIL ALL USE OF UOUT AND VOUT IS COMPLETE.
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+C
+C GIVEN ONE COORDINATE OF A POINT ON THE LINE JOINING (UINS,VINS) AND
+C (UOUT,VOUT), THE OTHER CAN BE OBTAINED BY USING ONE OF THE FOLLOWING
+C ARITHMETIC STATEMENT FUNCTIONS:
+C
+      UFUN(V)=UINS+(V-VINS)*DU/DV
+      VFUN(U)=VINS+(U-UINS)*DV/DU
+C
+C                                      I     I
+C                                   5  I  4  I  6
+C                                      I     I
+C                                 -----------------
+C FIRST, DETERMINE IN WHICH            I     I
+C OF THE AREAS SHOWN THE            2  I  1  I  3
+C POINT (UOUT,VOUT) LIES.              I     I
+C                                 -----------------
+C                                      I     I
+C                                   8  I  7  I  9
+C                                      I     I
+C
+      IREA=1
+      IF (UOUT-UMIN) 101,104,102
+  101 IREA=IREA+1
+      GO TO 104
+  102 IF (UOUT-UMAX) 104,104,103
+  103 IREA=IREA+2
+  104 IF (VOUT-VMIN) 105,108,106
+  105 IREA=IREA+6
+      GO TO 108
+  106 IF (VOUT-VMAX) 108,108,107
+  107 IREA=IREA+3
+C
+C NEXT, COMPUTE THE QUANTITIES REQUIRED BY UFUN AND VFUN AND JUMP TO THE
+C APPROPRIATE PIECE OF CODE FOR THE GIVEN AREA.
+C
+  108 DU=UOUT-UINS
+      DV=VOUT-VINS
+C
+      GO TO (119,113,114,115,109,110,116,111,112) , IREA
+C
+  109 IF (UFUN(VMAX)-UMIN) 113,115,115
+  110 IF (UFUN(VMAX)-UMAX) 115,115,114
+  111 IF (UFUN(VMIN)-UMIN) 113,116,116
+  112 IF (UFUN(VMIN)-UMAX) 116,116,114
+C
+  113 UINT=UMIN
+      GO TO 117
+  114 UINT=UMAX
+      GO TO 117
+  115 VINT=VMAX
+      GO TO 118
+  116 VINT=VMIN
+      GO TO 118
+C
+  117 VINT=VFUN(UINT)
+      RETURN
+C
+  118 UINT=UFUN(VINT)
+      RETURN
+C
+  119 UINT=UOUT
+      VINT=VOUT
+      RETURN
+C
+      END
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE MAPVP (UOLD,VOLD,U,V)
+C
+C PLOT THE LINE SEGMENT FROM (UOLD,VOLD) TO (U,V), USING EITHER A SOLID
+C LINE OR A DOTTED LINE (DEPENDING ON THE VALUE OF THE COMMON VARIABLE
+C IDTL).
+C
+C DECLARE REQUIRED COMMON BLOCKS.  SEE MAPBD FOR DESCRIPTIONS OF THESE
+C COMMON BLOCKS AND THE VARIABLES IN THEM.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+      COMMON /MAPCMP/ NPTB,XPTB(50),YPTB(50)
+C
+C SELECT VECTOR OR DOT MODE.
+C
+      IF (IDTL.EQ.0) THEN
+C
+C USE A SINGLE VECTOR.
+C
+        CALL VECTD (U,V)
+C
+      ELSE
+C
+C USE DOTS.  DELU AND DELV ARE THE U AND V COMPONENTS OF THE VECTOR
+C JOINING (UOLD,VOLD) TO (U,V) AND VLEN IS THE LENGTH OF THE VECTOR.
+C
+        DELU=U-UOLD
+        DELV=V-VOLD
+C
+        VLEN=SQRT(DELU*DELU+DELV*DELV)
+C
+C NOW DISTRIBUTE DOTS ALONG THE VECTOR.  THE FIRST ONE IS SPACED JUST
+C FAR ENOUGH ALONG IT (DATL UNITS) TO BE DBTD UNITS AWAY FROM THE LAST
+C DOT ON THE PREVIOUS VECTOR AND THE REST ARE DBTD UNITS APART.
+C
+  101   IF (DATL.LT.VLEN) THEN
+          IF (NPTB.GE.50) THEN
+            CALL POINTS (XPTB,YPTB,NPTB,0,0)
+            NPTB=0
+          END IF
+          NPTB=NPTB+1
+          XPTB(NPTB)=UOLD+(DATL/VLEN)*DELU
+          YPTB(NPTB)=VOLD+(DATL/VLEN)*DELV
+          DATL=DATL+DBTD
+          GO TO 101
+        END IF
+C
+C SET DATL FOR THE NEXT CALL.
+C
+        DATL=DATL-VLEN
+C
+      END IF
+C
+C DONE.
+C
+      RETURN
+C
+      END
+C
+C***********************************************************************
+C T H E   B L O C K   D A T A   " R O U T I N E "   -   D E F A U L T S
+C***********************************************************************
+C
+      BLOCK DATA MAPBD
+C
+C THE COMMON BLOCK MAPCM1 CONTAINS TRANSFORMATION CONSTANTS.
+C
+      COMMON /MAPCM1/ IPRJ,SINO,COSO,SINR,COSR,PHOC
+C
+C THE COMMON BLOCK MAPCM2 CONTAINS AREA-SPECIFICATION VARIABLES.
+C
+      COMMON /MAPCM2/ UMIN,UMAX,VMIN,VMAX,UEPS,VEPS,UCEN,VCEN,URNG,VRNG,
+     +                BLAM,SLAM,BLOM,SLOM
+C
+C THE COMMON BLOCK MAPCM3 CONTAINS PARAMETERS HAVING TO DO WITH READING
+C THE DATA FOR OUTLINES.
+C
+      COMMON /MAPCM3/ ITPN,NOUT,NPTS,IGID,BLAG,SLAG,BLOG,SLOG,PNTS(200)
+C
+C THE COMMON BLOCK MAPCM4 CONTAINS MOST OF THE INPUT PARAMETERS.
+C
+      COMMON /MAPCM4/ INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,
+     +                PLB1,PLB2,PLB3,PLB4,PLTR,GRID,IDSH,IDOT,LBLF,PRMF,
+     +                ELPF,XLOW,XROW,YBOW,YTOW,IDTL,GRDR,SRCH,ILCW
+C
+      LOGICAL         INTF,LBLF,PRMF,ELPF
+C
+C THE COMMON BLOCK MAPCM5 CONTAINS VARIOUS LISTS ("DICTIONARIES") OF
+C TWO-CHARACTER CODES REQUIRED BY EZMAP FOR PARAMETER-SETTING.
+C
+      COMMON /MAPCM5/ DDCT(5),LDCT(5),PDCT(10)
+C
+      CHARACTER*2     DDCT,LDCT,PDCT
+C
+C THE COMMON BLOCK MAPCM7 CONTAINS PARAMETERS DESCRIBING THE PORTION OF
+C THE PLOTTER FRAME BEING USED.
+C
+      COMMON /MAPCM7/ ULOW,UROW,VBOW,VTOW
+C
+C THE COMMON BLOCK MAPCM8 CONTAINS PARAMETERS SET BY MAPTRN AND USED BY
+C MAPIT IN HANDLING "CROSS-OVER" PROBLEMS.
+C
+      COMMON /MAPCM8/ P,Q,R
+C
+C THE COMMON BLOCK MAPCMA CONTAINS VALUES WHICH ARE USED TO POSITION
+C DOTS ALONG DOTTED OUTLINES AND TO AVOID DRAWING VECTORS WHICH ARE
+C TOO SHORT.
+C
+      COMMON /MAPCMA/ DPLT,DDTS,DSCA,DPSQ,DSSQ,DBTD,DATL
+C
+C THE COMMON BLOCK MAPCMB CONTAINS THE EZMAP ERROR FLAG.
+C
+      COMMON /MAPCMB/ IIER
+C
+C THE COMMON BLOCK MAPCMP CONTAINS THE BUFFERS IN WHICH THE X AND Y
+C COORDINATES OF POINTS ARE COLLECTED FOR AN EVENTUAL CALL TO POINTS.
+C
+      COMMON /MAPCMP/ NPTB,XPTB(50),YPTB(50)
+C
+C THE COMMON BLOCK MAPNTS CONTAINS QUANTITIES SPECIFYING THE INTENSITIES
+C TO BE USED FOR VARIOUS PORTIONS OF THE PLOT.
+C
+      COMMON /MAPNTS/ INTS(7)
+C
+C THE COMMON BLOCK MAPSAT CONTAINS PARAMETERS FOR THE SATELLITE-VIEW
+C PROJECTION.
+C
+      COMMON /MAPSAT/ SALT,SSMO,SRSS,ALFA,BETA,SALF,CALF,SBET,CBET
+C
+C
+C BELOW ARE DESCRIPTIONS OF THE VARIABLES IN EACH OF THE COMMON BLOCKS,
+C TOGETHER WITH DATA STATEMENTS GIVING DEFAULT VALUES TO THOSE VARIABLES
+C WHICH NEED DEFAULT VARIABLES.
+C
+C
+C VARIABLES IN MAPCM1:
+C
+C IPRJ IS AN INTEGER BETWEEN 1 AND 12, SPECIFYING WHAT PROJECTION IS
+C CURRENTLY IN USE.  THE VALUES 10, 11, AND 12 SPECIFY FAST-PATH
+C VERSIONS OF THE VALUES 7, 8, AND 9, RESPECTIVELY.  SINO, COSO, SINR,
+C COSR, AND PHOC ARE PROJECTION VARIABLES COMPUTED BY MAPINT FOR USE BY
+C MAPTRN.  PHOC, AS IT HAPPENS, IS JUST A COPY OF PHIO, FROM THE COMMON
+C BLOCK MAPCM4.
+C
+C
+C VARIABLES IN MAPCM2:
+C
+C UMIN, UMAX, VMIN, AND VMAX SPECIFY THE LIMITS OF THE RECTANGLE TO BE
+C DRAWN, IN PROJECTION SPACE.  UEPS AND VEPS ARE SET BY MAPINT FOR USE
+C IN MAPIT IN TESTING FOR CROSS-OVER PROBLEMS.  UCEN, VCEN, URNG, AND
+C VRNG ARE COMPUTED BY MAPINT FOR USE WHEN THE MAP PERIMETER IS MADE
+C ELLIPTICAL (BY SETTING THE FLAG ELPF).  BLAM, SLAM, BLOM, AND SLOM
+C ARE RESPECTIVELY THE BIGGEST LATITUDE, THE  SMALLEST LATITUDE, THE
+C BIGGEST LONGITUDE, AND THE SMALLEST LONGITUDE ON THE MAP.  THEY ARE
+C USED IN MAPGRD AND IN MAPLOT TO MAKE THE DRAWING OF GRIDS AND OUTLINES
+C MORE EFFICIENT.  UMIN AND UMAX ARE GIVEN DEFAULT VALUES TO PREVENT
+C IN MAPSTI AND MAPSTR FROM BLOWING UP WHEN PLTR IS SET PRIOR TO THE
+C FIRST CALL TO MAPINT.
+C
+      DATA UMIN,UMAX / 0.,1. /
+C
+C
+C VARIABLES IN MAPCM3:
+C
+C ITPN IS THE UNIT NUMBER OF THE "TAPE" FROM WHICH OUTLINE DATA IS TO
+C BE READ.  NOUT IS THE NUMBER OF THE OUTLINE TO BE USED; THE VALUES 0
+C THROUGH 5 IMPLY 'NO', 'CO', 'US', 'PS', AND 'PO', RESPECTIVELY; THUS,
+C IF NOUT IS ZERO, NO OUTLINES ARE TO BE USED, AND, IF IT IS NON-ZERO,
+C IT IS THE NUMBER OF THE "FILE" TO BE READ FROM UNIT ITPN.  NPTS, JUST
+C AFTER A READ, IS THE NUMBER OF ELEMENTS READ INTO PNTS; IT IS THEN
+C DIVIDED BY 2 TO BECOME THE NUMBER OF POINTS DEFINED BY THE GROUP JUST
+C READ.  IGID IS AN IDENTIFIER FOR THE GROUP, SO THAT, FOR EXAMPLE, ONE
+C CAN DISTINGUISH A GROUP BELONGING TO A INTERNATIONAL BOUNDARY FROM
+C ONE BELONGING TO A U.S. STATE BOUNDARY.  BLAG, SLAG, BLOG, AND SLOG
+C SPECIFY THE BIGGEST AND SMALLEST LATITUDE AND THE BIGGEST AND SMALLEST
+C LONGITUDE OF THE POINTS IN THE GROUP, SO THAT, IN SOME CASES AT LEAST,
+C ONE CAN DECIDE QUICKLY NOT TO BOTHER WITH THE GROUP.  PNTS CONTAINS
+C NPTS COORDINATE PAIRS, EACH CONSISTING OF A LATITUDE AND A LONGITUDE,
+C IN DEGREES.
+C
+      DATA ITPN,NOUT / 1,1 /
+C
+C
+C VARIABLES IN MAPCM4:
+C
+C INTF IS A FLAG WHOSE VALUE AT ANY GIVEN TIME INDICATES WHETHER THE
+C PACKAGE EZMAP IS IN NEED OF INITIALIZATION (.TRUE.) OR NOT (.FALSE).
+C JPRJ IS AN INTEGER BETWEEN 1 AND 9 INDICATING THE TYPE OF PROJECTION
+C CURRENTLY IN USE.  PHIA, PHIO, AND ROTA ARE THE POLE LATITUDE AND
+C LONGITUDE AND THE ROTATION ANGLE SPECIFIED BY THE LAST USER CALL TO
+C MAPROJ.  ILTS IS AN INTEGER BETWEEN 1 AND 5, SPECIFYING HOW THE LIMITS
+C OF THE MAP ARE TO BE CHOSEN.  PLA1-4 AND PLB1-4 ARE THE VALUES GIVEN
+C BY THE USER FOR PLM1(1), PLM2(1), ..., PLM1(2), PLM2(2), ..., IN THE
+C LAST CALL TO MAPSET.  PLTR IS THE PLOTTER RESOLUTION - EFFECTIVELY,
+C THE NUMBER OF ADDRESSABLE POINTS IN THE X DIRECTION.  GRID IS THE
+C DESIRED SPACING BETWEEN GRID LINES, IN DEGREES OF LATITUDE/LONGITUDE.
+C IDSH IS THE DESIRED DASH PATTERN (16-BIT BINARY) FOR GRID LINES.  IDOT
+C IS A FLAG SELECTING SOLID OUTLINES (0) OR DOTTED OUTLINES (1).  LBLF
+C IS A LOGICAL FLAG INDICATING WHETHER THE INTERNATIONAL DATE LINE, THE
+C EQUATOR, THE GREENWICH MERIDIAN, AND THE POLES ARE TO BE LABELLED OR
+C NOT.  PRMF IS A LOGICAL FLAG INDICATING WHETHER OR NOT A PERIMETER
+C IS TO BE DRAWN.  ELPF IS A LOGICAL FLAG INDICATING WHETHER THE MAP
+C PERIMETER IS TO BE RECTANGULAR (.FALSE.) OR ELLIPTICAL (.TRUE.).
+C XLOW, XROW, YBOW, AND YTOW ARE FRACTIONS BETWEEN 0. AND 1. SPECIFYING
+C THE POSITION OF AREA OF THE PLOTTER FRAME IN WHICH THE MAP IS TO BE
+C PUT; THE MAP IS CENTERED IN THIS AREA AND MADE AS LARGE AS POSSIBLE.
+C IDTL IS A FLAG SPECIFYING THAT MAPIT SHOULD DRAW SOLID OUTLINES (0)
+C OR DOTTEN OUTLINES (1).  GRDR AND SRCH ARE MEASURED IN DEGREES AND
+C LIE IN THE RANGE FROM .001 TO 10.  GRDR SPECIFIES THE RESOLUTION WITH
+C WHICH THE GRID IS TO BE DRAWN AND SRCH THE ACCURACY WITH WHICH THE
+C LATITUDE/LONGITUDE LIMITS OF THE MAP ARE TO BE FOUND.  ILCW IS THE
+C CHARACTER WIDTH FOR CHARACTERS IN THE LABEL, AS REQUIRED FOR USE IN A
+C CALL TO PWRIT.
+C
+      DATA INTF,JPRJ,PHIA,PHIO,ROTA,ILTS,PLA1,PLA2,PLA3,PLA4,PLB1,PLB2 /
+     1   .TRUE.,   7,  0.,  0.,  0.,   1,  0.,  0.,  0.,  0.,  0.,  0. /
+C
+      DATA PLB3,PLB4, PLTR,GRID, IDSH,IDOT, LBLF , PRMF ,  ELPF ,IDTL /
+     1       0.,  0.,4096., 10.,21845,   0,.TRUE.,.TRUE.,.FALSE.,   0 /
+C
+      DATA XLOW,XROW,YBOW,YTOW / .05,.95,.05,.95 /
+C
+      DATA GRDR,SRCH / 1.,1. /
+C
+      DATA ILCW / 1 /
+C
+C
+C VARIABLES IN MAPCM5:
+C
+C DDCT IS THE DICTIONARY OF AVAILABLE DATASETS, LDCT THE DICTIONARY OF
+C MAP LIMIT DEFINITION TYPES, AND PDCT THE DICTIONARY OF MAP PROJECTION
+C NAMES.
+C
+      DATA DDCT / 'NO','CO','US','PS','PO' /
+C
+      DATA LDCT / 'MA','CO','PO','AN','LI' /
+C
+      DATA PDCT / 'LC','ST','OR','LE','GN','AE','CE','ME','MO','SV' /
+C
+C
+C VARIABLES IN MAPCM7:
+C
+C ULOW, UROW, VBOW, AND VTOW DEFINE THE FRACTION OF THE PLOTTER FRAME
+C TO BE OCCUPIED BY THE MAP - THEY MAY BE THOUGHT OF AS THE FIRST FOUR
+C ARGUMENTS OF THE SET CALL OR, IN THE GKS SCHEME, AS THE VIEWPORT.
+C THEY ARE COMPUTED BY MAPINT.  ULOW AND UROW ARE GIVEN DEFAULT VALUES
+C TO PREVENT CODE IN MAPSTI AND MAPSTR FROM BLOWING UP WHEN PLTR IS
+C SET PRIOR TO THE FIRST CALL TO MAPINT.
+C
+      DATA ULOW,UROW / 0.,1. /
+C
+C
+C VARIABLES IN MAPCM8:
+C
+C P, Q, AND R ARE SET BY MAPTRN EACH TIME IT MAPS (RLAT,RLON) TO (U,V).
+C Q IS ALWAYS EQUAL TO V, BUT P IS NOT ALWAYS EQUAL TO U.  INSTEAD, IT
+C IS A VALUE OF U FROM AN INTERMEDIATE STEP IN THE PROJECTION PROCESS.
+C FOR THE LAMBERT CONFORMAL CONIC, P IS THE DISTANCE, IN LONGITUDE, FROM
+C THE CENTRAL MERIDIAN.  FOR THE CYLINDRICAL PROJECTIONS, P IS A VALUE
+C OF U PRIOR TO MULTIPLICATION BY A FUNCTION OF V SHRINKING THE MAP
+C TOWARD A VERTICAL BISECTOR.  THEY ARE ALL USED BY MAPIT, WHILE DRAWING
+C LINES FROM POINT TO POINT, TO DETECT "CROSS-OVER" (A JUMP FROM ONE
+C SIDE OF THE MAP TO THE OTHER, CAUSED BY THE PROJECTION'S HAVING SLIT
+C THE GLOBE ALONG SOME HALF OF A GREAT CIRCLE AND LAID IT OPEN WITH THE
+C TWO SIDES OF THE SLIT AT OPPOSITE ENDS OF THE MAP).
+C
+C
+C VARIABLES IN MAPCMA:
+C
+C DPLT IS THE MIMIMUM VECTOR LENGTH; MAPIT REQUIRES TWO POINTS TO BE AT
+C LEAST DPLT PLOTTER UNITS APART BEFORE IT WILL JOIN THEM WITH A VECTOR.
+C DDTS IS THE DESIRED DISTANCE IN PLOTTER UNITS BETWEEN DOTS IN A DOTTED
+C OUTLINE.  THESE VALUES ARE RELATIVE TO THE "PLOTTER RESOLUTION" PLTR;
+C DPLT/PLTR IS A FRACTION OF THE PLOTTER FRAME.  DSCA IS THE RATIO OF
+C THE LENGTH OF A VECTOR, MEASURED IN PLOTTER UNITS, TO THE LENGTH OF
+C THE SAME VECTOR, MEASURED IN THE U/V PLANE.  THUS, GIVEN A VECTOR OF
+C LENGTH D IN THE U/V PLANE, D*DSCA IS ITS LENGTH IN PLOTTER UNITS.
+C DPSQ AND DSSQ ARE THE SQUARES OF DPLT AND DSCA, RESPECTIVELY.  DBTD
+C IS THE DISTANCE, IN THE U/V PLANE, BETWEEN TWO DOTS DDTS PLOTTER
+C UNITS APART.  DPLT AND DDTS HAVE THE VALUES GIVEN BELOW AND ARE NOT
+C RESET BY THE CODE; DSCA, DPSQ, DSSQ, AND DBTD ARE COMPUTED BY MAPINT.
+C DSCA IS GIVEN A DEFAULT VALUE ONLY TO KEEP THE ROUTINES MAPSTI AND
+C MAPSTR FROM BLOWING UP WHEN DDTS IS SET PRIOR TO ANY CALL TO MAPINT.
+C DATL IS USED BY MAPIT AND MAPVP TO KEEP TRACK OF WHERE THE NEXT POINT
+C ALONG A CURVE SHOULD GO.
+C
+      DATA DPLT,DDTS,DSCA / 4.,12.,1. /
+C
+C
+C VARIABLES IN MAPCMB:
+C
+C IIER IS AN ERROR FLAG, SET WHENEVER AN ERROR OCCURS DURING A CALL TO
+C ONE OF THE EZMAP ROUTINES.  ITS VALUE MAY BE RETRIEVED BY A CALL TO
+C MAPGTI.
+C
+      DATA IIER / 0 /
+C
+C
+C VARIABLES IN MAPCMP:
+C
+C NPTB IS THE NUMBER OF POINTS WHOSE COORDINATES HAVE BEEN COLLECTED IN
+C THE ARRAYS XPTB AND YPTB FOR EVENTUAL OUTPUT BY A CALL TO POINTS.
+C
+      DATA NPTB / 0 /
+C
+C VARIABLES IN MAPNTS:
+C
+C THE ARRAY INTS SPECIFIES INTENSITIES TO BE USED FOR THE PERIMETER, FOR
+C THE GRID, FOR LABELLING, FOR LIMBS, FOR THE CONTINENTAL OUTLINES, FOR
+C THE U.S. STATE OUTLINES, AND FOR INTERNATIONAL POLITICAL OUTLINES.
+C SEE THE ROUTINE MAPCHI.  EACH ELEMENT IS AN INTEGER IN THE RANGE 0 TO
+C 255, INCLUSIVE.
+C
+      DATA INTS / 240,150,210,240,240,180,210 /
+C
+C
+C VARIABLES IN MAPSAT:
+C
+C THE ABSOLUTE VALUE OF SALT, IF GREATER THAN 1, SERVES AS A FLAG THAT
+C A SATELLITE-VIEW PROJECTION IS TO BE USED IN PLACE OF AN ORTHOGRAPHIC
+C PROJECTION; ITS VALUE IS THE DISTANCE OF THE SATELLITE FROM THE CENTER
+C OF THE EARTH, IN UNITS OF EARTH RADII.  IN THIS CASE, SSMO IS THE
+C SQUARE OF SALT MINUS 1 AND SRSS IS THE SQUARE ROOT OF SSMO.  IF ALFA
+C IS ZERO, THE PROJECTION SHOWS THE VIEW SEEN BY A SATELLITE LOOKING
+C STRAIGHT AT THE CENTER OF THE EARTH; CALL THIS THE BASIC SATELLITE
+C VIEW.  IF ALFA IS NON-ZERO, IT AND BETA ARE ANGLES, IN DEGREES,
+C DETERMINING WHERE THE LINE OF SIGHT OF THE PROJECTION IS.  IF E IS
+C AT THE CENTER OF THE EARTH, S IS AT THE SATELLITE, AND P IS A POINT
+C ALONG THE LINE OF SIGHT, THEN ALFA MEASURES THE ANGLE ESP.  IF O IS
+C THE POINT AT THE ORIGIN OF THE BASIC SATELLITE VIEW AND P IS THE
+C PROJECTION OF THE LINE OF SIGHT, THEN BETA MEASURES THE ANGULAR
+C DISTANCE FROM THE POSITIVE U AXIS TO THE LINE OP, POSITIVE IF
+C MEASURED COUNTER-CLOCKWISE.  SALF, CALF, SBET, AND CBET ARE SINES
+C AND COSINES OF ALFA AND BETA.  THE SIGN OF SALT INDICATES WHETHER A
+C NORMAL PROJECTION (POSITIVE) OR AN EXTENDED PROJECTION (NEGATIVE)
+C IS TO BE USED.  THE LATTER MAKES IT EASIER TO OVERLAY CONREC OUTPUT
+C ON ONE OF THESE PROJECTIONS, BY PROJECTING POINTS OUT OF SIGHT AROUND
+C THE LIMB TO POINT JUST OUTSIDE THE LIMB ON THE PROJECTED VIEW.
+C
+      DATA SALT,ALFA,BETA,SALF,CALF,SBET,CBET / 0.,0.,0.,0.,1.,0.,1. /
+C
+C REVISION HISTORY:
+C
+C FEBRUARY, 1982   ADDED MODIFICATIONS SO THAT POINTS GENERATED BY THE
+C                  DRAWING OF DOTTED CONTINENTAL OUTLINES ARE BUFFERED
+C                  AND THEN PUT OUT WITH A CALL TO POINTS, INSTEAD OF
+C                  BEING PUT OUT ONE AT A TIME WITH A CALL TO POINT AS
+C                  BEFORE.  THE LATTER RESULTED IN HUGE OVERHEAD IN THE
+C                  PLOT FILE.  ROUTINES MAPLOT AND MAPVP WERE MODIFIED,
+C                  AND A NEW COMMON BLOCK MAPCMP WAS ADDED.
+C
+C AUGUST, 1984     CONVERTED TO FORTRAN-77 AND GKS.  DELETED THE EZMAP
+C                  ENTRY POINT.
+C
+C MARCH, 1985      COMPLETELY OVERHAULED THE CODE TO SIMPLIFY IT AND TO
+C                  REMOVE KNOWN ERRORS.  UPDATED THE OUTLINE DATASET
+C                  TO REMOVE ERRORS AND TO INCLUDE INTERNATIONAL
+C                  BOUNDARIES.  IMPLEMENTED MANY CONTROLS AIMED AT
+C                  OBVIATING THE NEED FOR SOURCE MODIFICATION BY USERS.
+C
+C MAY, 1985        ADDED CODE TO PREVENT PROBLEMS WHEN A SMOOTHING
+C                  VERSION OF THE DASH PACKAGE IS LOADED.  ADDED CODE
+C                  IN MAPIT TO GET AROUND A CFT COMPILER PROBLEM.
+C                  ADDED CODE TO DO EXTENDED ORTHOGRAPHIC AND SATELLITE-
+C                  VIEW PROJECTIONS.
+C
+C JULY, 1985       FIXED A MISSING DECLARATION IN THE SUBROUTINE MAPSET
+C                  AND LIMITED "CALL PLOTIT (0,0,0)" TO THE GKS VERSION.
+C
+C AUGUST, 1985     FIXED A PROBLEM IN MAPGRD WHICH CAUSED MERIDIANS ON
+C                  MERCATOR MAPS WITH VERTICAL LIMITS TOO CLOSE TO THE
+C                  POLES TO BE DRAWN IMPROPERLY.  (THE TEST FOR CROSS-
+C                  OVER, IN MAPIT, WAS BEING PASSED BECAUSE THE POINTS
+C                  USED TO DRAW THE MERIDIANS WERE TOO FAR APART.)  ALSO
+C                  FIXED AN ERROR IN THE GKS CODE IN MAPCHI AND BEEFED
+C                  UP THE IMPLEMENTORS' INSTRUCTIONS TO SAY WHAT TO DO
+C                  WITH THAT ROUTINE WHEN COLOR IS AVAILABLE.
+C
+C NOVEMBER, 1985   ADDED CODE TO PREVENT GKS CLIPPING FROM DESTROYING
+C                  PART OF THE PERIMETER.
+C
+      END
diff --git a/sys/gio/ncarutil/gridal.f b/sys/gio/ncarutil/gridal.f
new file mode 100644
index 00000000..8ad31020
--- /dev/null
+++ b/sys/gio/ncarutil/gridal.f
@@ -0,0 +1,1583 @@
+      SUBROUTINE GRIDAL(MAJRX,MINRX,MAJRY,MINRY,IXLAB,IYLAB,IGPH,X,Y)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C LATEST REVISION        JULY, 1985
+C
+C PURPOSE                THIS IS A PACKAGE OF ROUTINES FOR DRAWING
+C                        GRAPH PAPER, AXES, AND OTHER BACKGROUNDS.
+C
+C USAGE                  EACH USER ENTRY POINT IN THIS PACKAGE (GRID,
+C                        GRIDL, PERIM, PERIML, HALFAX, LABMOD,
+C                        TICK4, AND GRIDAL) WILL BE DESCRIBED
+C                        SEPARATELY BELOW.  FIRST, HOWEVER, WE
+C                        WILL DISCUSS HOW MAJOR AND MINOR DIVISIONS
+C                        IN THE GRAPH PAPER ARE HANDLED BY ALL
+C                        ENTRIES WHICH USE THEM.
+C
+C                        GRIDAL, GRID, GRIDL, PERIM, PERIML, AND
+C                        HALFAX HAVE ARGUMENTS  MAJRX,MINRX,MAJRY,
+C                        MINRY WHICH CONTROL THE NUMBER OF MAJOR AND
+C                        MINOR DIVISIONS IN THE GRAPH PAPER OR
+C                        PERIMETERS.  THE NUMBER OF DIVISIONS REFERS
+C                        TO THE HOLES BETWEEN LINES RATHER THAN THE
+C                        LINES THEMSELVES.  THIS MEANS THAT THERE
+C                        IS ALWAYS ONE MORE MAJOR DIVISION LINE THAN
+C                        THE NUMBER OF MAJOR DIVISIONS.  SIMILARLY,
+C                        THERE IS ONE LESS MINOR DIVISION LINE THAN
+C                        MINOR DIVISIONS (PER MAJOR DIVISION.)
+C
+C                        MAJRX,MAJRY,MINRX,MINRY HAVE DIFFERENT
+C                        MEANINGS DEPENDING UPON WHETHER LOG
+C                        SCALING IS IN EFFECT (SET VIA SETUSV OR
+C                        SET IN THE SPPS PACKAGE.)
+C
+C                        FOR LINEAR SCALING,
+C                        MAJRX AND MAJRY SPECIFY THE NUMBER OF MAJOR
+C                        DIVISIONS ALONG THE X-AXIS OR Y-AXIS
+C                        RESPECTIVELY, AND MINRX AND MINRY SPECIFY
+C                        THE NUMBER OF MINOR DIVISIONS PER MAJOR
+C                        DIVISION.
+C
+C                        FOR LOG SCALING ALONG THE X-AXIS
+C                        EACH MAJOR DIVISION OCCURS AT A FACTOR OF
+C                        10**MAJRX TIMES THE PREVIOUS DIVISION.
+C                        FOR EXAMPLE, IF THE MINIMUM X-AXIS VALUE IS
+C                        3., AND THE MAXIMUM X-AXIS VALUE IS 3000.,
+C                        AND MAJRX IS 1, THEN MAJOR DIVISIONS WILL
+C                        OCCUR AT 3., 30., 300., AND 3000.  SIMILARLY
+C                        FOR MAJRY.   IF LOG SCALING IS IN EFFECT ON
+C                        THE X-AXIS AND MINRX.LE.10, THEN THERE ARE
+C                        NINE MINOR DIVISIONS BETWEEN EACH MAJOR
+C                        DIVISION.  FOR EXAMPLE, BETWEEN 3. AND 30.
+C                        THERE WOULD BE A MINOR DIVISION AT 6., 9.,
+C                        12.,...,27.  IF LOG SCALING IS IN EFFECT ON
+C                        THE X-AXIS AND MINRX.GT.10, THEN THERE WILL
+C                        BE NO MINOR SUBDIVISIONS.  MINRY IS TREATED
+C                        IN THE SAME MANNER AS MINRX.
+C
+C                        IF DIFFERENT COLORS (OR INTENSITIES) ARE TO
+C                        BE USED FOR NORMAL INTENSITY, LOW INTENSITY,
+C                        OR TEXT COLOR, THEN THE VALUES IN COMMON
+C                        BLOCK  GRIINT  SHOULD BE CHANGED AS FOLLOWS:
+C
+C                          IGRIMJ      COLOR INDEX FOR NORMAL (MAJOR)
+C                                      INTENSITY LINES.
+C                          IGRIMN      COLOR INDEX FOR LOW INTENSITY
+C                                      LINES.
+C                          IGRITX      COLOR INDEX FOR TEXT (LABELS.)
+C
+C WE NOW DESCRIBE EACH ENTRY IN THIS PACKAGE.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE GRID
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW GRAPH PAPER.
+C
+C USAGE         CALL GRID (MAJRX,MINRX,MAJRY,MINRY)
+C
+C DESCRIPTION   THIS SUBROUTINE DRAWS GRAPH LINES IN THE PORTION
+C               OF THE PLOTTER SPECIFIED BY THE CURRENT VIEWPORT
+C               SETTING WITH THE NUMBER OF MAJOR AND MINOR
+C               DIVISIONS AS SPECIFIED BY THE ARGUMENTS.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE GRIDAL
+C-----------------------------------------------------------------------
+C
+C PURPOSE       A GENERAL ENTRY POINT FOR ALL BACKGROUND ROUTINES
+C               WITH THE OPTION OF LINE LABELLING ON EACH AXIS.
+C
+C USAGE         CALL GRIDAL (MAJRX,MINRX,MAJRY,MINRY,IXLAB,IYLAB,
+C                            IGPH,X,Y)
+C
+C ARGUMENTS     MAJRX,MINRX,MAJRY,MINRY
+C                 MAJOR AND MINOR AXIS DIVISIONS AS DESCRIBED IN THE
+C                 USAGE SECTION OF THE PACKAGE DOCUMENTATION ABOVE.
+C
+C               IXLAB,IYLAB (INTEGERS)
+C                 FLAGS FOR AXIS LABELS:
+C
+C                   IXLAB = -1  NO X-AXIS DRAWN
+C                               NO X-AXIS LABELS
+C
+C                         =  0  X-AXIS DRAWN
+C                               NO X-AXIS LABELS
+C
+C                         =  1  X-AXIS DRAWN
+C                               X-AXIS LABELS
+C
+C                   IYLAB = -1  NO Y-AXIS DRAWN
+C                               NO Y-AXIS LABELS
+C
+C                         =  0  Y-AXIS DRAWN
+C                               NO Y-AXIS LABELS
+C
+C                         =  1  Y-AXIS DRAWN
+C                               Y-AXIS LABELS
+C
+C
+C               IGPH
+C                 FLAG FOR BACKGROUND TYPE:
+C
+C                    IGPH         X-AXIS BACKGROUND  Y-AXIS BACKGROUND
+C                    ----         -----------------  -----------------
+C                     0           GRID               GRID
+C                     1           GRID               PERIM
+C                     2           GRID               HALFAX
+C                     4           PERIM              GRID
+C                     5           PERIM              PERIM
+C                     6           PERIM              HALFAX
+C                     8           HALFAX             GRID
+C                     9           HALFAX             PERIM
+C                    10           HALFAX             HALFAX
+C
+C               X,Y
+C                 WORLD COORDINATES OF THE INTERSECTION OF THE AXES
+C                 IF  IGPH=10 .
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE GRIDL
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW GRAPH PAPER.
+C
+C USAGE         CALL GRIDL (MAJRX,MINRX,MAJRY,MINRY)
+C
+C DESCRIPTION   THIS SUBROUTINE BEHAVES EXACTLY AS GRID, BUT EACH
+C               MAJOR DIVISION IS LABELED WITH ITS NUMERICAL VALUE.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE HALFAX
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW ORTHOGONAL AXES.
+C
+C USAGE         CALL HALFAX (MAJRX,MINRX,MAJRY,MINRY,X,Y,IXLAB,IYLAB)
+C
+C DESCRIPTION   THIS SUBROUTINE DRAWS ORTHOGONAL AXES INTERSECTING
+C               AT COORDINATE (X,Y) WITH OPTIONAL LABELING OPTIONS AS
+C               SPECIFIED BY IXLAB AND IYLAB.
+C
+C ARGUMENTS     MAJRX,MINRX,MAJRY,MINRY
+C                 MAJOR AND MINOR DIVISION SPECIFICATIONS AS PER THE
+C                 DESCRIPTION IN THE PACKAGE USAGE SECTION ABOVE.
+C
+C               X,Y
+C                 WORLD COORDINATES SPECIFYING THE INTERSECTION POINT
+C                 OF THE X AND Y AXES.
+C
+C               IXLAB,IYLAB (INTEGERS)
+C                 FLAGS FOR AXIS LABELS:
+C
+C                   IXLAB = -1  NO X-AXIS DRAWN
+C                               NO X-AXIS LABELS
+C
+C                         =  0  X-AXIS DRAWN
+C                               NO X-AXIS LABELS
+C
+C                         =  1  X-AXIS DRAWN
+C                               X-AXIS LABELS
+C
+C                   IYLAB = -1  NO Y-AXIS DRAWN
+C                               NO Y-AXIS LABELS
+C
+C                         =  0  Y-AXIS DRAWN
+C                               NO Y-AXIS LABELS
+C
+C                         =  1  Y-AXIS DRAWN
+C                               Y-AXIS LABELS
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE LABMOD
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO ALLOW MORE COMPLETE CONTROL OVER THE APPEARANCE
+C               OF THE LABELS ON THE BACKGROUND PLOTS.
+C
+C USAGE         CALL LABMOD (FMTX,FMTY,NUMX,NUMY,ISIZX,ISIZY,
+C                            IXDEC,IYDEC,IXOR)
+C
+C DESCRIPTION   THIS SUBROUTINE PRESETS PARAMETERS FOR THE OTHER
+C               BACKGROUND ROUTINES IN THIS PACKAGE.  LABMOD ITSELF
+C               DOES NO PLOTTING AND IT MUST BE CALLED BEFORE THE
+C               THE BACKGROUND ROUTINES FOR WHICH IT IS PRESETTING
+C               PARAMETERS.
+C
+C ARGUMENTS     FMTX,FMTY  (TYPE CHARACTER)
+C                 FORMAT SPECIFICATIONS FOR THE X-AXIS AND Y-AXIS
+C                 NUMERICAL LABELS IN GRIDL, PERIML, GRIDAL, OR
+C                 HALFAX.  THE SPECIFICATION MUST START WITH A LEFT
+C                 PARENTHESIS AND END WITH A RIGHT PARENTHESIS AND
+C                 SHOULD NOT USE MORE THAN 8 CHARACTERS.  ONLY
+C                 FLOATING-POINT CONVERSIONS (F, E, AND G) SUCH AS
+C                 FMTX='(F8.2)' AND  FMTY='(E10.0)' FOR EXAMPLE.
+C
+C               NUMX,NUMY (INTEGER)
+C                 THE NUMBER OF CHARACTERS SPECIFIED BY  FMTX  AND
+C                 FMTY.  FOR THE ABOVE EXAMPLES, THESE WOULD BE
+C                 NUMX=8  AND  NUMY=10  (NOT 6 AND 7).
+C
+C               ISIZX,ISIZY
+C                 CHARACTER SIZE CODES FOR THE LABELS.  THESE SIZE
+C                 CODES ARE THE SAME AS THOSE FOR THE SPPS ENTRY
+C                 PWRIT.
+C
+C               IXDEC
+C                 THE DECREMENT IN PLOTTER ADDRESS UNITS FROM THE
+C                 LEFTMOST PLOTTER COORDINATE (AS SPECIFIED BY THE
+C                 CURRENT VIEWPORT) TO THE NEAREST X-ADDRESS OF THE
+C                 LABEL SPECIFIED BY  FMTY, NUMY, AND ISIZY.  FOR
+C                 EXAMPLE, IF THE MINIMUM X-COORDINATE OF THE CURRENT
+C                 VIEWPORT IS .1,  MINX  IS 102 (.1*1024).  IF  IXDEC
+C                 IS 60, THE LABEL WILL START AT 42 (102-60).  THE
+C                 FOLLOWING CONVENTIONS ARE USED:
+C
+C                 O  IF  IXDEC=0, IT IS AUTOMATICALLY RESET TO PROPERLY
+C                    POSITION THE  Y-AXIS  LABELS TO THE LEFT OF THE
+C                    LEFT Y-AXIS,  IXDEC=20 .
+C
+C                 O  IF  IXDEC=1,  Y-AXIS LABELS WILL GO TO THE RIGHT
+C                    OF THE GRAPH, IXDEC=-20 .
+C
+C                 WHEN EITHER  HALFAX  OR  GRIDAL  IS CALLED TO DRAW AN
+C                 AXIS,  IXDEC  IS THE DISTANCE FROM THE AXIS RATHER
+C                 THAN FROM THE MINIMUM VIEWPORT COORDINATE.
+C
+C               IYDEC
+C                 THE DECREMENT IN PLOTTER ADDRESS UNITS FROM THE
+C                 MINIMUM Y-AXIS COORDINATE AS SPECIFIED BY THE
+C                 CURRENT VIEWPORT TO THE NEAREST Y-ADDRESS OF THE
+C                 LABEL SPECIFIED BY  FMTX, NUMX, AND ISIZX.  FOR
+C                 EXAMPLE, IF THE MINIMUM Y-COORDINATE OF THE
+C                 CURRENT VIEWPORT IS .2,  MINY IS 205 (.2*1024).
+C                 IF  IYDEC=30, THE LABEL WILL END AT  205-30=175.
+C                 THE FOLLOWING CONVENTIONS ARE USED:
+C
+C                 O  IF  IYDEC=0, IT IS AUTOMATICALLY RESET TO
+C                    PROPERLY POSITION X-AXIS LABELS ALONG THE
+C                    BOTTOM,  IYDEC=20 .
+C
+C                 O  IF  IYDEC=1, X-AXIS LABELS WILL GO ALONG THE
+C                    TOP OF THE GRAPH,  IYDEC=-20 .
+C
+C               IXOR (INTEGER)
+C                 ORIENTATION OF THE X-AXIS LABELS.
+C
+C                   IXOR = 0    +X (HORIZONTAL)
+C                        = 1    +Y (VERTICAL)
+C
+C                 IN NORMAL ORIENTATION, THE ACTUAL NUMBER OF
+C                 NON-BLANK DIGITS IS CENTERED UNDER THE LINE
+C                 OR TICK TO WHICH IT APPLIES.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE PERIM
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW A PERIMETER WITH TICK MARKS.
+C
+C USAGE         CALL PERIM (MAJRX,MINRX,MAJRY,MINRY)
+C
+C DESCRIPTION   THIS SUBROUTINE BEHAVES JUST AS GRID EXCEPT THAT
+C               INTERIOR LINES ARE REPLACED WITH TICK MARKS ALONG
+C               THE EDGES.  TICK MARKS AT MAJOR DIVISIONS ARE
+C               SLIGHTLY LARGER THAN TICK MARKS AT MINOR DIVISIONS.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE PERIML
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO DRAW A PERIMETER WITH TICK MARKS AND LABELS.
+C
+C USAGE         CALL PERIML (MAJRX,MINRX,MAJRY,MINRY)
+C
+C DESCRIPTION   THIS SUBROUTINE BEHAVES JUST AS PERIM, BUT EACH
+C               MAJOR DIVISION IS LABELED WITH ITS NUMERICAL VALUE.
+C
+C-----------------------------------------------------------------------
+C SUBROUTINE TICK4
+C-----------------------------------------------------------------------
+C
+C PURPOSE       TO ALLOW PROGRAM CONTROL OF TICK MARK LENGTH.
+C
+C USAGE         CALL TICK4 (LMAJX,LMINX,LMAJY,LMINY)
+C
+C DESCRIPTION   THIS SUBROUTINE ALLOWS PROGRAM CONTROL OF TICK
+C               MARK LENGTH IN  PERIM, PERIML, GRIDAL, AND HALFAX.
+C
+C ARGUMENTS     LMAJX,LMAJY
+C                 LENGTH IN PLOTTER ADDRESS UNITS OF MAJOR DIVISION
+C                 TICK MARKS ON THE X-AXIS AND Y-AXIS RESPECTIVELY.
+C                 THESE VALUES ARE INITIALLY SET TO 12 .
+C
+C               MINRX,MINRY
+C                 LENGTH IN PLOTTER ADDRESS UNITS OF MINOR DIVISION
+C                 TICK MARKS ON THE X-AXIS AND Y-AXIS RESPECTIVELY.
+C                 THESE VALUES ARE INITIALLY SET TO 8 .
+C
+C-----------------------------------------------------------------------
+C
+C WE NOW RESUME THE PACKAGE DOCUMENTATION.
+C
+C ENTRY POINTS  GRID,GRIDAL,GRIDL,HALFAX,LABMOD,PERIM,PERIML,TICK4,
+C               TICKS,CHSTR,EXPAND,GRIDT
+C
+C COMMON BLOCKS LAB,CLAB,TICK,GRIINT
+C
+C REQUIRED      THE ERPRT77 PACKAGE AND THE SPPS.
+C ROUTINES
+C
+C I/O           PLOTS BACKGROUNDS
+C
+C PRECISION     SINGLE
+C
+C LANGUAGE      FORTRAN 77
+C
+C HISTORY       WRITTEN IN JUNE, 1984.  BASED ON THE NCAR SYSTEM
+C               PLOT PACKAGE ENTRIES HAVING THE SAME NAMES.
+C
+        COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+        COMMON /CLAB/ XFMT, YFMT
+        COMMON /TICK/ MAJX, MINX, MAJY, MINY
+        COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+C
+C INTERNAL VARIABLES:
+C
+C               CHUPX,CHUPY     CHARACTER UP VECTOR VALUES ON ENTRY
+C
+C               CURMAJ          IF LOGMIN=.TRUE., THEN THIS IS THE
+C                               CURRENT MAJOR TICK/GRID POSITION
+C
+C               ICNT            NORMALIZATION TRANSFORMATION NUMBER IN
+C                               EFFECT ON ENTRY TO GRIDAL
+C
+C               LASF(13)        ASPECT SOURCE FLAG TABLE AS USED BY GKS.
+C
+C               LGRID           .TRUE. IF GRIDS ARE TO BE DRAWN ON THE
+C                               CURRENT AXIS (OPPOSED TO TICKS)
+C
+C               LOGMIN          .TRUE.  IF LOG SCALING IS IN EFFECT AND
+C                               MINOR TICK MARKS OR GRIDS ARE DESIRED
+C
+C               LOGVAL          LINEAR OR LOG SCALING
+C                               1 = X LINEAR, Y LINEAR
+C                               2 = X LINEAR, Y LOG
+C                               3 = X LOG, Y LINEAR
+C                               4 = X LOG, Y LOG
+C
+C               MINCNT          NUMBER OF MINOR DIVISIONS PER MAJOR
+C
+C               NERR            COUNTS ERROR NUMBER
+C
+C               NEXTMAJ         IF LOGMIN=.TRUE., THEN THIS IS THE NEXT
+C                               MAJOR TICK/GRID POSITION
+C
+C               NWIND(4)        WINDOW LIMITS IN WORLD COORDINATES
+C                               AFTER EXPANSION
+C
+C               OCOLI           COLOR INDEX ON ENTRY TO GRIDAL
+C
+C               OLDALH,OLDALV   TEXT ALIGNMENT VALUES ON ENTRY
+C                               (HORIZONTAL AND VERTICAL)
+C
+C               OLDCH           CHARACTER HEIGHT ON ENTRY TO GRIDAL
+C
+C               OPLASF          STORES VALUE OF POLYLINE COLOR ASF ON
+C                               ENTRY TO GRIDAL
+C
+C               OTXASF          STORES VALUE OF TEXT COLOR ASF ON
+C                               ENTRY TO GRIDAL
+C
+C               OTXCOL          TEXT COLOR INDEX ON ENTRY TO GRIDAL
+C
+C               OWIND(4)        WINDOW LIMITS IN WORLD COORDINATES
+C                               ON ENTRY TO GRIDAL
+C
+C               PY(2)           2 Y-COORDINATES FOR LINE TO BE DRAWN
+C                               VIA GKS ROUTINE GPL
+C
+C               PX(2)           2 X-COORDINATES FOR LINE TO BE DRAWN
+C                               VIA GKS ROUTINE GPL
+C
+C               START           IF DRAWING TICKS/GRIDS ON X-AXIS:
+C                                       Y-COORD OF ORIGIN OF EACH LINE;
+C                               IF DRAWING TICKS/GRIDS ON Y-AXIS:
+C                                       X-COORD OF ORIGIN OF EACH LINE
+C
+C               TICBIG          END OF MAJOR TICK LINE IN WORLD
+C                               COORDINATES
+C
+C               TICEND          END OF MINOR TICK LINE IN WORLD
+C                               COORDINATES
+C
+C               TICMAJ          LENGTH OF MAJOR TICKS IN WORLD
+C                               COORDINATES
+C
+C               TICMIN          LENGTH OF MINOR TICKS IN WORLD
+C                               COORDINATES
+C
+C               VIEW(4)         VIEWPORT LIMITS IN NDC PRIOR TO
+C                               EXPANSION FOR LABELLING
+C
+C               WIND(4)         SAME AS IN OWIND(4)
+C
+C               XCUR            A TICK/GRID IS DRAWN AT THIS POSITION
+C                               IF LOG SCALING IS IN EFFECT.
+C
+C               XDEC            LENGTH IN WORLD COORDINATES FROM
+C                               X-AXIS TO LABEL
+C
+C               XI              ALOG10(X), IF LOG SCALING
+C
+C               XINT            INTERVAL BETWEEN MINOR X-AXIS
+C                               TICKS/GRIDS IN WORLD COORDINATES
+C
+C               XINTM           INTERVAL BETWEEN MAJOR X-AXIS
+C                               TICKS/GRIDS IN WORLD COORDINATES
+C
+C               XMIRRO          LOGICAL FLAGS FOR MIRROR-IMAGE
+C
+C               XNUM            TOTAL NUMBER OF X-AXIS TICKS/GRIDS
+C                               WITH LINEAR SCALING
+C
+C               XPOS            IF LINEAR SCALING, KEEPS TRACK OF X-AXIS
+C                               POSITION FOR CURRENT TICK/GRID
+C
+C               XRANGE          TOTAL RANGE IN X DIRECTION IN WORLD
+C                               COORDINATES PRIOR TO EXPANSION FOR
+C                               LABELLING.
+C
+C               XRNEW           RANGE IN X DIRECTION IN WORLD
+C                               COORDINATES, AFTER EXPANSION
+C
+C               YCUR            A TICK/GRID IS DRAWN AT THIS POSITION
+C                               IF LOG SCALING IS IN EFFECT.
+C
+C               YDEC            LENGTH IN WORLD COORDINATES FROM
+C                               Y-AXIS TO LABEL
+C
+C               YI              ALOG10(Y), IF LOG SCALING
+C
+C               YINTM           INTERVAL BETWEEN MAJOR Y-AXIS
+C                               TICKS/GRIDS IN WORLD COORDINATES
+C
+C               YMIRRO          PLOTTING.
+C
+C               YNUM            TOTAL NUMBER OF Y-AXIS TICKS/GRIDS
+C                               WITH LINEAR SCALING
+C
+C               YPOS            IF LINEAR SCALING, KEEPS TRACK OF Y-AXIS
+C                               POSITION FOR CURRENT TICK/GRID
+C
+C               YRANGE          TOTAL RANGE IN Y DIRECTION IN WORLD
+C                               COORDINATES PRIOR TO EXPANSION FOR
+C                               LABELLING.
+C
+C               YRNEW           RANGE IN Y DIRECTION IN WORLD
+C                               COORDINATES, AFTER EXPANSION
+C
+C               XLAB,YLAB       IF LABELLING X-AXIS, Y-COORDINATE FOR
+C                               FOR TEXT POSITION;
+C                               IF LABELLING Y-AXIS, X-COORDINATE FOR
+C                               TEXT POSITION.
+C
+C
+C
+      CHARACTER*8 XFMT,YFMT
+      REAL WIND(4), VIEW(4), PX(2), PY(2), NWIND(4), OWIND(4)
+      REAL MAJX, MINX, MAJY, MINY
+      INTEGER TCOUNT, XTNUM, YTNUM, FIRST, LAST
+      INTEGER OPLASF, OTXASF, LASF(13), OCOLI, OTEXCI, OLDALH ,OLDALV
+      LOGICAL LGRID,LOGMIN
+      LOGICAL XMIRRO,YMIRRO
+      REAL MAJDIV, NEXTMA
+      CHARACTER*15 LABEL
+C
+      DATA TICMIN,TICMAJ,XCUR,YCUR,EXCUR,EYCUR/0.,0.,0.,0.,0.,0./
+C
+C +NOAO - Blockdata rewritten as run time initialization.
+C       EXTERNAL GRIDT
+	call gridt
+C -NOAO
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR.
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','GRIDAL','VERSION 01')
+      XRNEW = 0.
+      YRNEW = 0.
+C
+C  INITIALIZE ERROR COUNT.
+C
+      NERR = 0
+C
+C  CHECK FOR BAD VALUES OF IGPH.
+C
+      IF (IGPH.LT.0.OR.IGPH.EQ.3.OR.IGPH.EQ.7.OR.IGPH.GT.10) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--INVALID IGPH VALUE',NERR,2)
+      ENDIF
+C
+C  GET STANDARD ERROR MESSAGE UNIT
+C
+      IERUNT = I1MACH(4)
+      XMIRRO = .FALSE.
+      YMIRRO = .FALSE.
+C
+C  SET POLYLINE COLOR ASF TO INDIVIDAUL.
+C
+      CALL GQASF(IERR,LASF)
+      OPLASF = LASF(3)
+      LASF(3) = 1
+      OTXASF = LASF(10)
+      LASF(10) = 1
+      CALL GSASF(LASF)
+C
+C  INQUIRE CURRENT POLYLINE COLOR INDEX.
+C
+      CALL GQPLCI(IERR,OCOLI)
+C
+C  SET POLYLINE COLOR TO THE VALUE SPECIFIED IN COMMON.
+C
+      CALL GSPLCI(IGRIMJ)
+C
+C  INQUIRE CURRENT NORMALIZATION TRANSFORMATION NUMBER.
+C
+      CALL GQCNTN(IERR,ICNT)
+C
+C  INQUIRE CURRENT WINDOW AND VIEWPORT LIMITS.
+C
+      CALL GQNT(ICNT,IERR,WIND,VIEW)
+C
+C  STORE WINDOW VALUES
+C
+      DO 10 I = 1,4
+      OWIND(I) = WIND(I)
+   10 CONTINUE
+C
+C  LOG OR LINEAR SCALING?
+C
+C           1 = X LINEAR, Y LINEAR
+C           2 = X LINEAR, Y LOG
+C           3 = X LOG, Y LINEAR
+C           4 = X LOG, Y LOG
+C
+      CALL GETUSV('LS',LOGVAL)
+C
+C  ADJUST WINDOW TO ACCOUNT FOR LOG SCALING.
+C
+      IF (LOGVAL .EQ. 2) THEN
+        WIND(3) = 10.**WIND(3)
+        WIND(4) = 10.**WIND(4)
+      ELSE IF (LOGVAL .EQ. 3) THEN
+        WIND(1) = 10.**WIND(1)
+        WIND(2) = 10.**WIND(2)
+      ELSE IF (LOGVAL .EQ. 4) THEN
+        WIND(1) = 10.**WIND(1)
+        WIND(2) = 10.**WIND(2)
+        WIND(3) = 10.**WIND(3)
+        WIND(4) = 10.**WIND(4)
+      ENDIF
+C
+C  DETERMINE IF MIRROR-IMAGE MAPPING IS REQUIRED.
+C
+      IF (WIND(1) .GT. WIND(2)) THEN
+        XMIRRO = .TRUE.
+      ENDIF
+      IF (WIND(3) .GT. WIND(4)) THEN
+        YMIRRO = .TRUE.
+      ENDIF
+C
+C  IF IGPH=10, CHECK FOR X(Y) VALUES IN RANGE (IF NOT, CHANGE TO
+C  DEFAULT.
+C
+      IF (IGPH .EQ. 10) THEN
+        XI = X
+        YI = Y
+        IF (((XI .LT. WIND(1) .OR. XI .GT. WIND(2)) .AND. .NOT.
+     1  XMIRRO) .OR. (XMIRRO.AND.(XI.GT.WIND(1).OR.XI.LT.WIND(2))))
+     2  THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--X VALUE OUT OF WINDOW RANGE',NERR,1)
+C +NOAO - FTN writes and format statements deleted.  Call to SETER okay.
+C
+C         WRITE(IERUNT,1001)NERR
+C1001     FORMAT(' ERROR',I3,' IN GRIDAL--X VALUE OUT OF WINDOW RANGE')
+          CALL ERROF
+          XI = WIND(1)
+        ENDIF
+        IF (((YI .LT. WIND(3) .OR. YI .GT. WIND(4)) .AND. .NOT.
+     1  YMIRRO).OR.(YMIRRO.AND.(YI.GT.WIND(3).OR.YI.LT.WIND(4))))
+     2  THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--Y VALUE OUT OF WINDOW RANGE',NERR,1)
+C         WRITE(IERUNT,1002)NERR
+C1002     FORMAT(' ERROR',I3,' IN GRIDAL--Y VALUE OUT OF WINDOW RANGE')
+C -NOAO
+          CALL ERROF
+          YI = WIND(3)
+        ENDIF
+      ENDIF
+      MX = MAJRX
+      MY = MAJRY
+      IF (LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 3) THEN
+        IF (MX .LT. 1) MX = 1
+        IF (WIND(1) .LE. 0.) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--NON-POSITIVE WINDOW BOUNDARY WITH LOG SCA
+     1LING',NERR,2)
+        ELSE
+          WIND(1) = ALOG10(WIND(1))
+        ENDIF
+        IF (WIND(2) .LE. 0.) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--NON-POSITIVE WINDOW BOUNDARY WITH LOG SCA
+     1LING',NERR,2)
+        ELSE
+          WIND(2) = ALOG10(WIND(2))
+        ENDIF
+        IF (IGPH .EQ. 10) THEN
+          XI = ALOG10(XI)
+        ENDIF
+      ENDIF
+C
+      IF(LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 2) THEN
+        IF (MY .LT. 1) MY = 1
+        IF (WIND(3) .LE. 0.) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--NON-POSITIVE WINDOW BOUNDARY WITH LOG SCA
+     1LING',NERR,2)
+        ELSE
+          WIND(3) = ALOG10(WIND(3))
+        ENDIF
+        IF (WIND(4) .LE. 0.) THEN
+          NERR = NERR + 1
+          CALL SETER(' GRIDAL--NON-POSITIVE WINDOW BOUNDARY WITH LOG SCA
+     1LING',NERR,2)
+        ELSE
+          WIND(4) = ALOG10(WIND(4))
+        ENDIF
+        IF (IGPH .EQ. 10) THEN
+          YI = ALOG10(YI)
+        ENDIF
+      ENDIF
+C
+C  DEFINE NORMALIZATION TRANSFORMATION NUMBER 1.
+C
+      CALL GSWN(1,WIND(1),WIND(2),WIND(3),WIND(4))
+      CALL GSVP(1,VIEW(1),VIEW(2),VIEW(3),VIEW(4))
+      CALL GSELNT(1)
+C
+C  CALCULATE X AND Y WORLD COORDINATE RANGES.
+C
+      XRANGE = WIND(2) - WIND(1)
+      YRANGE = WIND(4) - WIND(3)
+C
+C  IF LABELS ARE REQUESTED, INQUIRE AND SAVE TEXT ATTRIBUTES.
+C
+      IF (IXLAB .EQ. 1 .OR. IYLAB .EQ. 1) THEN
+        CALL GQCHH(IERR,OLDCHH)
+        CALL GQCHUP(IERR,CHUPX,CHUPY)
+        CALL GQTXAL(IERR,OLDALH,OLDALV)
+        CALL GQTXCI (IERR,OTEXCI)
+        CALL GSTXCI (IGRITX)
+C
+C  EXPAND WINDOW AND VIEWPORT FOR LABELS AND CALCULATE NEW
+C  X AND Y WORLD COORDINATE RANGES.
+C
+        CALL EXPAND(NWIND)
+        XRNEW = NWIND(2) - NWIND(1)
+        YRNEW = NWIND(4) - NWIND(3)
+C
+C  SET CHARACTER HEIGHT (1% OF Y RANGE.)
+C
+        CHARH = SIZX * YRNEW
+        IF (YMIRRO) THEN
+          CHARH = -CHARH
+        ENDIF
+        CALL GSCHH(CHARH)
+      ENDIF
+C
+      IF (IGPH .EQ. 0) GOTO 50
+C
+C  CALCULATE TIC LENGTH.
+C
+C  IF NO LABELS AND TICK4 (OR TICKS) WERE NOT CALLED.
+C
+      IF (MAJX .EQ. 0.) THEN
+        MAJX = .013
+        MINX = .007
+        TICMIN = MINX * YRANGE
+        TICMAJ = MAJX * YRANGE
+      ELSE
+C
+C  EXPAND WINDOW IF NOT ALREADY EXPANDED.
+C  (IF LABMOD WAS NOT CALLED BUT TICK4(S) WAS.)
+C
+        IF (IXLAB.NE.1 .AND. IYLAB.NE.1) THEN
+          CALL EXPAND (NWIND)
+          XRNEW = NWIND(2) - NWIND(1)
+          YRNEW = NWIND(4) - NWIND(3)
+        ENDIF
+        TICMIN = MINX * YRNEW
+        TICMAJ = MAJX * YRNEW
+      ENDIF
+C
+C  **** X-AXIS TICS/GRIDS AND LABELS ****
+C
+C  CALCULATE TIC/GRID INTERVALS ON X AXIS.
+C
+  50  IF (IXLAB .EQ. -1) GOTO 175
+      MINCNT = MINRX
+      IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 2) THEN
+        LOGMIN = .FALSE.
+        XINTM = XRANGE/MX
+        XINT = XINTM
+        IF (MINCNT .GT. 1) THEN
+          XINT = XINT/MINCNT
+        ENDIF
+C
+C  CALCULATE TOTAL NUMBER OF TICS/GRIDS ON AXIS.
+C
+        XTNUM = MX * MINCNT
+        IF (MINCNT .EQ. 0) XTNUM = MX
+      ELSE
+        XTNUM = 50
+        XCUR = 10.**OWIND(1)
+        MAJDIV = 10 ** MX
+        IF (MINCNT .LE. 10 .AND. MX .LE. 1) THEN
+          LOGMIN = .TRUE.
+          CURMAJ = XCUR
+          NEXTMA = XCUR * MAJDIV
+          XINT = (NEXTMA - CURMAJ) / 9.
+          MINCNT = 9
+        ELSE
+          LOGMIN = .FALSE.
+          MINCNT = 1
+        ENDIF
+      ENDIF
+C
+      LGRID = .FALSE.
+      LOOP = 1
+C
+C  DETERMINE ORIGIN OF TICK/GRID LINES (Y COORDINATE.)
+C
+      IF (IGPH .NE. 10) THEN
+        START = WIND(3)
+      ELSE
+        START = YI
+      ENDIF
+C
+      XPOS = WIND(1)
+      PY(1) = START
+      TICEND = START + TICMIN
+      TICBIG = START + TICMAJ
+C
+      PX(1) = XPOS
+      PX(2) = PX(1)
+C
+C  DRAW LEFT-MOST TICK ON X-AXIS (IF IGPH = 10 AND
+C  INTERSECTION OF AXES IS NOT AT BOTTOM LEFT OF WINDOW.)
+C
+      IF (IGPH .EQ. 10) THEN
+        IF (XI .NE. WIND(1)) THEN
+          PY(2) = TICBIG
+          CALL GPL(2,PX,PY)
+        ENDIF
+C
+C  DRAW X-AXIS FOR IGPH = 10
+C
+        PX(2) = WIND(2)
+        PY(2) = PY(1)
+        CALL GPL(2,PX,PY)
+        PX(2) = PX(1)
+      ELSE
+C
+C  DRAW Y-AXIS FOR ANY OTHER IGPH (FIRST TICK.)
+C
+        PY(2) = WIND(4)
+        CALL GPL(2,PX,PY)
+      ENDIF
+C
+C  TICKS OR GRIDS ?
+C
+      IF (IGPH .EQ. 0 .OR. IGPH .EQ. 1 .OR. IGPH .EQ.2) THEN
+        PY(2) = WIND(4)
+        LGRID = .TRUE.
+      ELSE
+        PY(2) = TICEND
+      ENDIF
+C
+      IF (IXLAB .EQ. 1) THEN
+C
+C  IF VERTICAL X-AXIS LABEL ORIENTATION, THEN SET CHAR UP VECTOR
+C  TO BE VERTICAL AND TEXT ALIGNMENT TO (RIGHT,HALF),
+C  OTHERWISE TO (CENTER,TOP)
+C
+        IF (YMIRRO) THEN
+          IF (IXORI .EQ. 1) THEN
+            CALL GSCHUP(1.,0.)
+            CALL GSTXAL(3,3)
+          ELSE
+            CALL GSCHUP(0.,-1.)
+            CALL GSTXAL(2,1)
+          ENDIF
+        ELSE
+          IF (IXORI .EQ. 1) THEN
+            CALL GSCHUP(-1.,0.)
+            CALL GSTXAL(3,3)
+          ELSE
+            CALL GSTXAL(2,1)
+          ENDIF
+        ENDIF
+        IF (XDEC.NE.0. .AND. XDEC.NE.1.) THEN
+          DEC = XDEC * YRNEW
+        ELSE
+          DEC = .02 * YRNEW
+        ENDIF
+        IF (XDEC .NE. 1.) THEN
+          XLAB = START - DEC
+        ELSE
+          IF (IGPH .NE. 10) THEN
+            XLAB = WIND(4)+DEC
+          ELSE
+            XLAB = YI+DEC
+          ENDIF
+C
+C  IF LABELS ARE ON TOP OF THE X-AXIS, SET THE TEXT
+C  ALIGNMENT TO (LEFT,HALF) IF THE X-AXIS LABELS ARE
+C  VERTICAL, OTHERWISE TO (CENTER,BASE).
+C
+          IF (IXORI .EQ. 1) THEN
+            CALL GSTXAL(1,3)
+          ELSE
+            CALL GSTXAL(2,4)
+          ENDIF
+        ENDIF
+        IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 2) THEN
+C +NOAO
+C         WRITE(LABEL,XFMT)XPOS
+          call encode (10, xfmt, label, xpos)
+C -NOAO
+        ELSE
+C +NOAO
+C         WRITE(LABEL,XFMT)XCUR
+          call encode (10, yfmt, label, xcur)
+C -NOAO
+        ENDIF
+        CALL CHSTR(LABEL,FIRST,LAST)
+        CALL GTX (XPOS,XLAB,LABEL(FIRST:LAST))
+      ENDIF
+C
+ 80   TCOUNT = 1
+C
+      DO 100 I = 1,XTNUM
+      IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 2) THEN
+        XPOS = XPOS + XINT
+      ELSE
+        IF (.NOT. LOGMIN) THEN
+          XCUR = XCUR * MAJDIV
+        ELSE
+          IF (TCOUNT .NE. MINCNT) THEN
+            XCUR = XCUR + XINT
+          ELSE
+            XCUR = XCUR + XINT
+            CURMAJ = NEXTMA
+            NEXTMA = CURMAJ * MAJDIV
+            XINT = (NEXTMA - CURMAJ) / 9.
+          ENDIF
+        ENDIF
+        IF (XCUR .GT. 10.**OWIND(2)-.1*XINT) THEN
+          XPOS = WIND(2)
+        ELSE
+          XPOS = ALOG10(XCUR)
+        ENDIF
+      ENDIF
+C
+      PX(1) = XPOS
+      PX(2) = XPOS
+C
+C  IF IGPH = 0,1,2,4,5,8 OR 9 AND XPOS=RIGHT AXIS, THEN
+C  DRAW AXIS, ELSE IF IGPH = 6 OR 10 DRAW TIC AND LABEL.
+C
+      IF (LOGVAL .EQ. 3 .OR. LOGVAL .EQ. 4) EXCUR = 10.**OWIND(2)
+C
+      IF ((((LOGVAL .EQ. 1.OR.LOGVAL.EQ.2) .AND. (I .EQ. XTNUM))
+     1 .OR.((LOGVAL .EQ.4 .OR.LOGVAL .EQ.3).AND.XCUR.GE.EXCUR-.1*XINT))
+     2 .AND.(IGPH.NE.6.AND.IGPH.NE.10)) THEN
+        IF (LOOP .EQ. 1) THEN
+          PY(2) = WIND(4)
+          CALL GPL(2,PX,PY)
+          IF (IXLAB .EQ. 1) THEN
+            IF (LOGVAL.EQ.1 .OR. LOGVAL.EQ.2) THEN
+C (NOAO)      WRITE(LABEL,XFMT) XPOS
+              call encode (10, xfmt, label, xpos)
+            ELSE
+              IF (XCUR .GT. EXCUR+.1*XINT) THEN
+                GOTO 101
+              ELSE
+C (NOAO)        WRITE(LABEL,XFMT) XCUR
+                call encode (10, xfmt, label, xcur)
+              ENDIF
+            ENDIF
+            CALL CHSTR(LABEL,FIRST,LAST)
+            CALL GTX (XPOS,XLAB,LABEL(FIRST:LAST))
+          ENDIF
+        ENDIF
+        GOTO 101
+      ENDIF
+      IF ((LOGVAL.EQ.4 .OR. LOGVAL.EQ.3) .AND. XCUR.GT.EXCUR+.1*XINT)
+     1    GOTO 101
+C
+C  MINOR TIC/GRID ?
+C
+      IF (TCOUNT .NE. MINCNT .AND. MINCNT .NE. 0) THEN
+        IF (LGRID) THEN
+          CALL GSPLCI(IGRIMN)
+        ENDIF
+        CALL GPL(2,PX,PY)
+        IF (LGRID) THEN
+          CALL GSPLCI(IGRIMJ)
+        ENDIF
+        TCOUNT = TCOUNT + 1
+C
+C  MAJOR TIC/GRID
+C
+      ELSE
+        IF (.NOT. LGRID) THEN
+          PY(2) = TICBIG
+        ENDIF
+        CALL GPL(2,PX,PY)
+C
+C  LABEL.
+C
+        IF (IXLAB .EQ. 1 .AND. LOOP .EQ. 1) THEN
+          IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 2) THEN
+C (NOAO)    WRITE(LABEL,XFMT)XPOS
+            call encode (10, xfmt, label, xpos)
+          ELSE
+C (NOAO)    WRITE(LABEL,XFMT)XCUR
+            call encode (10, xfmt, label, xcur)
+          ENDIF
+          CALL CHSTR(LABEL,FIRST,LAST)
+          CALL GTX (XPOS,XLAB,LABEL(FIRST:LAST))
+        ENDIF
+        TCOUNT = 1
+        IF (.NOT. LGRID) THEN
+          PY(2) = TICEND
+        ENDIF
+      ENDIF
+      IF ((LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 3) .AND.
+     1     XCUR .GE. EXCUR-.1*XINT) GOTO 101
+ 100  CONTINUE
+ 101  CONTINUE
+C
+C  TOP X-AXIS TICKS ?
+C
+      IF (LOOP.EQ.1 .AND. (IGPH.EQ.4 .OR. IGPH.EQ.5 .OR. IGPH.EQ.6))
+     1  THEN
+        START = WIND(4)
+        TICEND = START - TICMIN
+        TICBIG = START - TICMAJ
+        PY(1) = START
+        PY(2) = TICEND
+        XPOS = WIND(1)
+        LOOP = 2
+        IF (LOGVAL .EQ. 4 .OR. LOGVAL .EQ.3) THEN
+          XCUR = 10.**OWIND(1)
+          IF (LOGMIN) THEN
+            CURMAJ = XCUR
+            NEXTMA = XCUR * MAJDIV
+            XINT = (NEXTMA - CURMAJ) / 9.
+          ENDIF
+        ENDIF
+        GOTO 80
+      ENDIF
+C
+C  **** Y-AXIS TICS/GRIDS AND LABELS ****
+C
+  175 IF (IYLAB .EQ. -1) GOTO 999
+C
+C  CALCULATE Y-AXIS TICS
+C
+      MINCNT = MINRY
+      IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 3) THEN
+        LOGMIN = .FALSE.
+        YINTM = YRANGE/MY
+        YINT = YINTM
+        IF (MINCNT .GT. 1) THEN
+          YINT = YINT/MINCNT
+        ENDIF
+        YTNUM = MY * MINCNT
+        IF (MINCNT .EQ. 0) YTNUM = MY
+      ELSE
+        YTNUM = 50
+        YCUR = 10.**OWIND(3)
+        MAJDIV = 10 ** MY
+        IF (MINCNT .LE. 10 .AND. MY .LE. 1) THEN
+          LOGMIN = .TRUE.
+          CURMAJ = YCUR
+          NEXTMA = YCUR * MAJDIV
+          YINT = (NEXTMA - CURMAJ) / 9.
+          MINCNT = 9
+        ELSE
+          LOGMIN = .FALSE.
+          MINCNT = 1
+        ENDIF
+      ENDIF
+C
+      LGRID = .FALSE.
+      LOOP = 1
+C
+C  DETERMINE ORIGIN OF TICK/GRID LINES (X COORDINATE.)
+C
+      IF (IGPH .NE. 10) THEN
+        START = WIND(1)
+      ELSE
+        START = XI
+      ENDIF
+C
+      YPOS = WIND(3)
+      PX(1) = START
+C
+C  DETERMINE Y-AXIS TICK LENGTHS.
+C
+      IF (MAJY .EQ. 0.) THEN
+        MAJY = .013
+        MINY = .007
+      ENDIF
+      IF (XRNEW .EQ. 0.) THEN
+        TICMIN = MINY * XRANGE
+        TICMAJ = MAJY * XRANGE
+      ELSE
+        TICMIN = MINY * XRNEW
+        TICMAJ = MAJY * XRNEW
+      ENDIF
+      TICEND = START + TICMIN
+      TICBIG = START + TICMAJ
+C
+      PY(1) = YPOS
+      PY(2) = PY(1)
+C
+C  DRAW BOTTOM-MOST TICK ON Y-AXIS IF (IGPH = 10
+C  AND INTERSECTION OF AXES IS NOT AT BOTTOM LEFT
+C  OF WINDOW.)
+C
+      IF (IGPH .EQ. 10) THEN
+        IF (YI .NE. WIND(3)) THEN
+          PX(2) = TICBIG
+          CALL GPL(2,PX,PY)
+        ENDIF
+C
+C  DRAW Y-AXIS FOR IGPH = 10
+C
+        PY(2) = WIND(4)
+        PX(2) = PX(1)
+        CALL GPL(2,PX,PY)
+        PY(2) = PY(1)
+      ELSE
+C
+C  DRAW X-AXIS FOR ANY OTHER IGPH (FIRST TICK.)
+C
+        PX(2) = WIND(2)
+        CALL GPL(2,PX,PY)
+      ENDIF
+C
+C  GRIDS OR TICS ?
+C
+      IF ((IGPH .EQ. 0 .OR. IGPH .EQ. 4).OR. IGPH .EQ. 8) THEN
+        PX(2) = WIND(2)
+        LGRID = .TRUE.
+      ELSE
+        PX(2) = TICEND
+      ENDIF
+C
+C  SET TEXT ATTRIBUTES IF Y-AXIS IS TO BE LABELLED.
+C
+      IF (IYLAB .EQ. 1) THEN
+        IF (IXORI .EQ. 1) THEN
+          IF (YMIRRO) THEN
+            CALL GSCHUP(0.,-1.)
+          ELSE
+            CALL GSCHUP(0.,1.)
+          ENDIF
+        ENDIF
+C
+C  SET TEXT ALIGNMENT TO (RIGHT,HALF)
+C
+        CALL GSTXAL(3,3)
+C
+C  RECALCULATE CHARACTER HEIGHT IF Y-AXIS LABELS ARE OF DIFFERENT
+C  SIZE FORM X-AXIS LABELS.
+C
+        CHARH = SIZY * YRNEW
+        IF (YMIRRO) THEN
+          CHARH = -CHARH
+        ENDIF
+        CALL GSCHH(CHARH)
+        IF (YDEC .NE. 0. .AND. YDEC .NE. 1.) THEN
+          DEC = YDEC * XRNEW
+        ELSE
+          DEC = .02 * XRNEW
+        ENDIF
+        IF (YDEC .NE. 1.) THEN
+          YLAB = START - DEC
+        ELSE
+          IF (IGPH .NE. 10) THEN
+            YLAB = WIND(2)+DEC
+          ELSE
+            YLAB = XI+DEC
+          ENDIF
+C
+C  SET TEXT ALIGNMENT TO (LEFT,HALF) IF LABELLING ON RIGHT OF Y-AXIS.
+C
+          CALL GSTXAL(1,3)
+        ENDIF
+        IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ.3) THEN
+C (NOAO)  WRITE(LABEL,YFMT)YPOS
+          call encode (10, yfmt, label, ypos)
+        ELSE
+C (NOAO)  WRITE(LABEL,YFMT)YCUR
+          call encode (10, yfmt, label, ycur)
+        ENDIF
+        CALL CHSTR(LABEL,FIRST,LAST)
+        CALL GTX (YLAB,YPOS,LABEL(FIRST:LAST))
+      ENDIF
+C
+ 180  TCOUNT = 1
+C
+      DO 200 I = 1,YTNUM
+      IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ. 3) THEN
+        YPOS = YPOS + YINT
+      ELSE
+        IF (.NOT. LOGMIN) THEN
+          YCUR = YCUR * MAJDIV
+        ELSE
+          IF (TCOUNT .NE. MINCNT) THEN
+            YCUR = YCUR + YINT
+          ELSE
+            YCUR = YCUR + YINT
+            CURMAJ = NEXTMA
+            NEXTMA = CURMAJ * MAJDIV
+            YINT = (NEXTMA - CURMAJ) / 9.
+          ENDIF
+        ENDIF
+        IF (YCUR .GT. 10.**OWIND(4)-.1*YINT) THEN
+          YPOS = WIND(4)
+        ELSE
+          YPOS = ALOG10(YCUR)
+        ENDIF
+      ENDIF
+C
+      PY(1) = YPOS
+      PY(2) = YPOS
+C
+C IF IGPH = 0,1,2,4,5,6 OR 8 AND YPOS = TOP AXIS, THEN
+C DRAW AXIS, ELSE IF IGPH = 9 OR 10 DRAW TIC.
+C
+      IF (LOGVAL .EQ. 3 .OR. LOGVAL .EQ. 4) EYCUR = 10.**OWIND(4)
+C
+      IF ((((LOGVAL .EQ. 1.OR.LOGVAL.EQ.3) .AND. (I .EQ. YTNUM))
+     1 .OR.((LOGVAL .EQ.4 .OR.LOGVAL .EQ.2).AND.YCUR.GE.EYCUR-.1*YINT))
+     2 .AND.(IGPH.NE.9.AND.IGPH.NE.10)) THEN
+        IF (LOOP .EQ. 1) THEN
+          PX(2) = WIND(2)
+          CALL GPL(2,PX,PY)
+          IF (IYLAB .EQ. 1) THEN
+            IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ.3) THEN
+C (NOAO)      WRITE(LABEL,YFMT)YPOS
+              call encode (10, yfmt, label, ypos)
+            ELSE
+              IF (YCUR .GT. EYCUR+.1*YINT) THEN
+                GOTO 201
+              ELSE
+C (NOAO)        WRITE(LABEL,YFMT)YCUR
+                call encode (10, yfmt, label, ycur)
+              ENDIF
+            ENDIF
+            CALL CHSTR(LABEL,FIRST,LAST)
+            CALL GTX (YLAB,YPOS,LABEL(FIRST:LAST))
+          ENDIF
+        ENDIF
+        GOTO 201
+      ENDIF
+      IF ((LOGVAL.EQ.4 .OR. LOGVAL.EQ.2) .AND. YCUR.GT.EYCUR+.1*YINT)
+     1  GOTO 201
+C
+C  MINOR TIC/GRID ?
+C
+      IF (TCOUNT .NE. MINCNT .AND. MINCNT .NE. 0) THEN
+        IF (LGRID) THEN
+          CALL GSPLCI(IGRIMN)
+        ENDIF
+        CALL GPL(2,PX,PY)
+        IF (LGRID) THEN
+          CALL GSPLCI(IGRIMJ)
+        ENDIF
+        TCOUNT = TCOUNT + 1
+C
+C  MAJOR TIC/GRID.
+C
+      ELSE
+        IF (.NOT. LGRID) THEN
+          PX(2) = TICBIG
+        ENDIF
+        CALL GPL(2,PX,PY)
+C
+C  LABEL.
+C
+        IF (IYLAB .EQ. 1 .AND. LOOP .EQ.1) THEN
+          IF (LOGVAL .EQ. 1 .OR. LOGVAL .EQ.3) THEN
+C (NOAO)   WRITE(LABEL,YFMT)YPOS
+           call encode (10, yfmt, label, ypos)
+          ELSE
+C (NOAO)    WRITE(LABEL,YFMT)YCUR
+            call encode (10, yfmt, label, ycur)
+          ENDIF
+          CALL CHSTR(LABEL,FIRST,LAST)
+          CALL GTX(YLAB,YPOS,LABEL(FIRST:LAST))
+        ENDIF
+        TCOUNT = 1
+        IF (.NOT. LGRID) THEN
+          PX(2) = TICEND
+        ENDIF
+      ENDIF
+      IF ((LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 2) .AND.
+     -     YCUR .GE. EYCUR-.1*YINT)
+     1   GOTO 201
+  200 CONTINUE
+  201 CONTINUE
+C
+C  RIGHT Y-AXIS TICKS ?
+C
+      IF (LOOP .EQ. 1 .AND.(IGPH.EQ.1 .OR. IGPH .EQ. 5 .OR.
+     1  IGPH .EQ. 9)) THEN
+        START = WIND(2)
+        TICEND = START - TICMIN
+        TICBIG = START - TICMAJ
+        PX(1) = START
+        PX(2) = TICEND
+        YPOS = WIND(3)
+        LOOP = 2
+        IF (LOGVAL .EQ. 4 .OR. LOGVAL .EQ. 2) THEN
+          YCUR = 10.**OWIND(3)
+          IF (LOGMIN) THEN
+            CURMAJ = YCUR
+            NEXTMA = YCUR * MAJDIV
+            YINT = (NEXTMA - CURMAJ) / 9.
+          ENDIF
+        ENDIF
+        GOTO 180
+      ENDIF
+C
+C  RESET NORMALIZATION TRANSFORMATION TO WHAT IT WAS UPON ENTRY.
+C
+      IF (ICNT .NE. 0) THEN
+        CALL GSWN(ICNT,OWIND(1),OWIND(2),OWIND(3),OWIND(4))
+        CALL GSVP(ICNT,VIEW(1),VIEW(2),VIEW(3),VIEW(4))
+      ENDIF
+      CALL GSELNT(ICNT)
+C
+C  IF LABELS, RESTORE TEXT ATTRIBUTES.
+C
+      IF (IXLAB .EQ. 1 .OR. IYLAB .EQ. 1) THEN
+        CALL GSCHH(OLDCHH)
+        CALL GSCHUP(CHUPX,CHUPY)
+        CALL GSTXAL(OLDALH,OLDALV)
+        CALL GSTXCI(OTEXCI)
+      ENDIF
+C
+C  RESTORE ORIGINAL COLOR.
+C
+      CALL GSPLCI(OCOLI)
+C
+C  RESTORE POLYLINE COLOR ASF TO WHAT IS WAS ON ENTRY.
+C
+      LASF(10) = OTXASF
+      LASF(3) = OPLASF
+      CALL GSASF(LASF)
+C
+ 999  RETURN
+      END
+      SUBROUTINE GRID(MAJRX,MINRX,MAJRY,MINRY)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','GRID','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,0,0,0,0.,0.)
+      RETURN
+      END
+      SUBROUTINE GRIDL(MAJRX,MINRX,MAJRY,MINRY)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','GRIDL','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,1,1,0,0.,0.)
+      RETURN
+      END
+      SUBROUTINE PERIM(MAJRX,MINRX,MAJRY,MINRY)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','PERIM','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,0,0,5,0.,0.)
+      RETURN
+      END
+      SUBROUTINE PERIML(MAJRX,MINRX,MAJRY,MINRY)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','PERIML','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,1,1,5,0.,0.)
+      RETURN
+      END
+      SUBROUTINE HALFAX(MAJRX,MINRX,MAJRY,MINRY,X,Y,IXLAB,IYLAB)
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+      CHARACTER*8 XFMT,YFMT
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','HALFAX','VERSION 01')
+C
+      CALL GRIDAL(MAJRX,MINRX,MAJRY,MINRY,IXLAB,IYLAB,10,X,Y)
+      RETURN
+      END
+      SUBROUTINE LABMOD(FMTX,FMTY,NUMX,NUMY,ISIZX,ISIZY,IXDEC,IYDEC,
+     1                  IXOR)
+C
+C  RESETS PARAMETERS FOR TEXT GRAPHICS FROM DEFAULT VALUES.
+C
+      COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+      COMMON /CLAB/ XFMT, YFMT
+      CHARACTER*8 XFMT,YFMT,FMTX,FMTY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','LABMOD','VERSION 01')
+C
+C
+C +NOAO - Blockdata rewritten as run time initialization.
+C       EXTERNAL GRIDT
+	call gridt
+C -NOAO
+      XFMT = '        '
+      YFMT = '        '
+      XFMT = FMTX
+      YFMT = FMTY
+C
+      CALL GETUSV('XF',IVAL)
+      XRANGE = 2. ** IVAL
+      CALL GETUSV('YF', IVAL)
+      YRANGE = 2. ** IVAL
+C
+C  SIZX AND SIZY ARE COMPUTED TO BE PERCENTAGES OF TOTAL SCREEN
+C  WIDTH.
+C
+      IF (ISIZX .GT. 3) THEN
+        SIZX = FLOAT(ISIZX)/XRANGE
+      ELSEIF (ISIZX .EQ. 3) THEN
+        SIZX = 24./1024.
+      ELSEIF (ISIZX .EQ. 2) THEN
+        SIZX = 16./1024.
+      ELSEIF (ISIZX .EQ. 1) THEN
+        SIZX = 12./1024.
+      ELSE
+        SIZX = 8./1024.
+      ENDIF
+C
+      IF (ISIZY .GT. 3) THEN
+        SIZY = FLOAT(ISIZY)/XRANGE
+      ELSEIF (ISIZY .EQ. 3) THEN
+        SIZY = 24./1024.
+      ELSEIF (ISIZY .EQ. 2) THEN
+        SIZY = 16./1024.
+      ELSEIF (ISIZY .EQ. 1) THEN
+        SIZY = 12./1024.
+      ELSE
+        SIZY = 8./1024.
+      ENDIF
+C
+C  CALCULATE XDEC AND YDEC AS PERCENTAGES OF TOTAL SCREEN WIDTH
+C  IN PLOTTER ADDRESS UNITS.
+C
+      IF (IXDEC .EQ. 0 .OR. IXDEC .EQ. 1) THEN
+        YDEC = FLOAT(IXDEC)
+      ELSE
+        YDEC = FLOAT(IXDEC)/XRANGE
+      ENDIF
+      IF (IYDEC .EQ. 0 .OR. IYDEC .EQ. 1) THEN
+        XDEC = FLOAT(IYDEC)
+      ELSE
+        XDEC = FLOAT(IYDEC)/YRANGE
+      ENDIF
+C
+      IXORI = IXOR
+C
+      RETURN
+      END
+      SUBROUTINE TICK4(LMAJX,LMINX,LMAJY,LMINY)
+C
+C  CHANGES TICK LENGTH FOR EACH AXIS.
+C
+      COMMON /TICK/ MAJX, MINX, MAJY, MINY
+      REAL MAJX, MINX, MAJY, MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','TICK4','VERSION 01')
+C
+      CALL GETUSV('XF', IVAL)
+      XRANGE = 2. ** IVAL
+      CALL GETUSV('YF', IVAL)
+      YRANGE = 2. ** IVAL
+C
+      MAJX = FLOAT(LMAJX)/YRANGE
+      MINX = FLOAT(LMINX)/YRANGE
+      MAJY = FLOAT(LMAJY)/XRANGE
+      MINY = FLOAT(LMINY)/XRANGE
+C
+      RETURN
+      END
+      SUBROUTINE TICKS(LMAJ,LMIN)
+C
+      COMMON /TICK/ MAJX,MINX,MAJY,MINY
+      REAL MAJX,MINX,MAJY,MINY
+C
+C  THE FOLLOWING IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4('GRAPHX','GRIDAL','TICKS','VERSION 01')
+C
+      CALL TICK4(LMAJ,LMIN,LMAJ,LMIN)
+C
+      RETURN
+      END
+      SUBROUTINE CHSTR(LABEL,FIRST,LAST)
+C
+C  THIS CALCULATES THE POSITION OF THE FIRST NON-BLANK CHARACTER
+C  AND THE POSITION OF THE LAST NON-BLANK CHARACTER IN LABEL.
+C
+      INTEGER   FIRST, LAST
+      CHARACTER*15 LABEL
+C
+      DO 100 I = 1,15
+      IF (LABEL(I:I) .NE. ' ') GOTO 200
+ 100  CONTINUE
+ 200  FIRST = I
+      LAST = 15
+      IF (FIRST .NE. 15) THEN
+        DO 300 J = FIRST+1,15
+        IF (LABEL(J:J) .EQ. ' ') THEN
+          LAST = J-1
+          GOTO 999
+        ENDIF
+ 300    CONTINUE
+ 999    CONTINUE
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE EXPAND(MAXW)
+C
+C  THE WINDOW IS EXPANDED AND THE NEW WORLD COORDINATES ARE
+C  CALCULATED TO CORRESPOND TO THE MAXIMUM VIEWPORT.
+C  THE ORIGINAL ASPECT RATIO OF WORLD COORDINATES TO VIEWPORT
+C  COORDINATES REMAINS THE SAME.  UNDER THE NEWLY-DEFINED
+C  NORMALIZATION TRANSFORMATION, THE WINDOW OF THE ORIGINAL
+C  NORMALIZATION TRANSFORMATION IS MAPPED TO THE VIEWPORT
+C  OF THE ORIGINAL NORMALIZATION TRANSFORMATION IN EXACTLY
+C  THE SAME WAY AS IN THE INITIAL NORMALIZATION TRANSFORMATION.
+C
+      REAL MAXW(4), VIEW(4), WIND(4)
+      REAL LEFT
+C
+C  INQUIRE CURRENT WINDOW AND VIEWPORT SETTINGS.
+C
+      CALL GQCNTN(IERR,ICNT)
+      CALL GQNT(ICNT,IERR,WIND,VIEW)
+C
+C  CALCULATE RATIO OF Y WORLD/VIEWPORT COORDINATES.
+C
+      YRATIO = (WIND(4) - WIND(3))/(VIEW(4) - VIEW(3))
+C
+C  CALCULATE RATIO OF X WORLD/VIEWPORT COORDINATES.
+C
+      XRATIO = (WIND(2) - WIND(1))/(VIEW(2) - VIEW(1))
+C
+C  GET EXPANDED LOWER LIMIT Y COORDINATE.
+C
+      VBOTTM = VIEW(3) - 0.
+      BOTTOM = YRATIO * VBOTTM
+      MAXW(3) = WIND(3) - BOTTOM
+C
+C  GET EXPANDED UPPER LIMIT Y COORDINATE.
+C
+      VTOP = 1. - VIEW(4)
+      TOP = YRATIO * VTOP
+      MAXW(4) = WIND(4) + TOP
+C
+C  GET EXPANDED LEFT LIMIT X COORDINATE.
+C
+      VLEFT = VIEW(1) - 0.
+      LEFT = XRATIO * VLEFT
+      MAXW(1) = WIND(1) - LEFT
+C
+C  GET EXPANDED RIGHT LIMIT X COORDINATE.
+C
+      VRIGHT = 1. - VIEW(2)
+      RIGHT = XRATIO * VRIGHT
+      MAXW(2) = WIND(2) + RIGHT
+C
+C  SET NEW (EXPANDED) NORMALIZATION TRANSFORMATION.
+C
+      CALL GSWN(1,MAXW(1),MAXW(2),MAXW(3),MAXW(4))
+      CALL GSVP(1, 0., 1., 0., 1. )
+      CALL GSELNT(1)
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/gridt.f b/sys/gio/ncarutil/gridt.f
new file mode 100644
index 00000000..eb10ddf1
--- /dev/null
+++ b/sys/gio/ncarutil/gridt.f
@@ -0,0 +1,65 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c + noao: block data gridt changed to run time initialization
+c       BLOCK DATA GRIDT
+        subroutine gridt
+C
+C
+        COMMON /LAB/ SIZX,SIZY,XDEC,YDEC,IXORI
+        COMMON /CLAB/ XFMT, YFMT
+        COMMON /TICK/ MAJX, MINX, MAJY, MINY
+        COMMON /GRIINT/ IGRIMJ, IGRIMN, IGRITX
+        CHARACTER*8 XFMT,YFMT
+        REAL MAJX,MINX,MAJY,MINY
+C
+c +noao: following flag added to prevent initializing more than once
+        logical first
+        SAVE
+        data first /.true./
+        if (.not. first) then
+            return
+        endif
+        first = .false.
+C
+c       DATA XFMT,YFMT /'(E10.3) ','(E10.3) '/
+        XFMT = '(E10.3) '
+        YFMT = '(E10.3) '
+c
+c       DATA SIZX,SIZY / 0.01, 0.01 /
+        SIZX = 0.01
+        SIZY = 0.01
+c
+c       DATA XDEC,YDEC / 0., 0. /
+        XDEC = 0.
+        YDEC = 0.
+c
+c       DATA IXORI / 0 /
+        IXORI = 0 
+c
+c       DATA MAJX,MINX,MAJY,MINY / 0., 0., 0., 0./
+        MAJX = 0.
+        MINX = 0.
+        MAJY = 0.
+        MINY = 0.
+c
+c       DATA IGRIMJ,IGRIMN,IGRITX / 1, 1, 1/
+c+noao: These values changed so major axes and labels are bold
+        IGRIMJ = 2
+        IGRIMN = 1
+        IGRITX = 2
+C - noao
+        END
+C REVISION HISTORY---------------
+C----------------------------------------------------------
+
diff --git a/sys/gio/ncarutil/hafton.f b/sys/gio/ncarutil/hafton.f
new file mode 100644
index 00000000..7d597470
--- /dev/null
+++ b/sys/gio/ncarutil/hafton.f
@@ -0,0 +1,830 @@
+      SUBROUTINE HAFTON (Z,L,M,N,FLO,HI,NLEV,NOPT,NPRM,ISPV,SPVAL)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C     SUBROUTINE HAFTON (Z,L,M,N,FLO,HI,NLEV,NOPT,NPRM,ISPV,SPVAL)
+C
+C
+C     DIMENSION OF           Z(L,M)
+C     ARGUMENTS
+C
+C     LATEST REVISION        JULY,1984
+C
+C     PURPOSE                HAFTON DRAWS A HALF-TONE PICTURE FROM DATA
+C                            STORED IN A RECTANGULAR ARRAY WITH THE
+C                            INTENSITY IN THE PICTURE PROPORTIONAL TO
+C                            THE DATA VALUE.
+C
+C     USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                                 CALL EZHFTN (Z,M,N)
+C
+C                              ASSUMPTIONS:
+C                                  .ALL OF THE ARRAY IS TO BE DRAWN.
+C                                  .LOWEST VALUE IN Z WILL BE AT LOWEST
+C                                   INTENSITY ON READER/PRINTER OUTPUT.
+C                                  .HIGHEST VALUE IN Z WILL BE AT
+C                                   HIGHEST INTENSITY.
+C                                  .VALUES IN BETWEEN WILL APPEAR
+C                                   LINEARLY SPACED.
+C                                  .MAXIMUM POSSIBLE NUMBER OF
+C                                   INTENSITIES ARE USED.
+C                                  .THE PICTURE WILL HAVE A PERIMETER
+C                                   DRAWN.
+C                                  .FRAME WILL BE CALLED AFTER THE
+C                                   PICTURE IS DRAWN.
+C                                  .Z IS FILLED WITH NUMBERS THAT SHOULD
+C                                   BE USED (NO MISSING VALUES).
+C
+C                            IF THESE ASSUMPTIONS ARE NOT MET, USE
+C
+C                                 CALL HAFTON (Z,L,M,N,FLO,HI,NLEV,
+C                                              NOPT,NPRM,ISPV,SPVAL)
+C
+C     ARGUMENTS
+C
+C     ON INPUT               Z
+C     FOR EZHFTN               M BY N ARRAY TO BE USED TO GENERATE A
+C                              HALF-TONE PLOT.
+C
+C                            M
+C                              FIRST DIMENSION OF Z.
+C
+C                            N
+C                              SECOND DIMENSION OF Z.
+C
+C     ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C     FOR EZHFTN
+C
+C     ON INPUT               Z
+C     FOR HAFTON               THE ORIGIN OF THE ARRAY TO BE PLOTTED.
+C
+C                            L
+C                              THE FIRST DIMENSION OF Z IN THE CALLING
+C                              PROGRAM.
+C
+C                            M
+C                              THE NUMBER OF DATA VALUES TO BE PLOTTED
+C                              IN THE X-DIRECTION (THE FIRST SUBSCRIPT
+C                              DIRECTION).  WHEN PLOTTING ALL OF AN
+C                              ARRAY, L = M.
+C
+C                            N
+C                              THE NUMBER OF DATA VALUES TO BE PLOTTED
+C                              IN THE Y-DIRECTION (THE SECOND SUBSCRIPT
+C                              DIRECTION).
+C
+C                            FLO
+C                              THE VALUE OF Z THAT CORRESPONDS TO THE
+C                              LOWEST INTENSITY.  (WHEN NOPT.LT.0, FLO
+C                              CORRESPONDS TO THE HIGHEST INTENSITY.)
+C                              IF FLO=HI=0.0, MIN(Z) WILL BE USED FOR FLO.
+C
+C                            HI
+C                              THE VALUE OF Z THAT CORRESPONDS TO THE
+C                              HIGHEST INTENSITY.  (WHEN NOPT.LT.0, HI
+C                              CORRESPONDS TO THE LOWEST INTENSITY.)  IF
+C                              HI=FLO=0.0, MAX(Z) WILL BE USED FOR HI.
+C
+C                            NLEV
+C                              THE NUMBER OF INTENSITY LEVELS DESIRED.
+C                              16 MAXIMUM.  IF NLEV = 0 OR 1, 16 LEVELS
+C                              ARE USED.
+C
+C                            NOPT
+C                              FLAG TO CONTROL THE MAPPING OF Z ONTO THE
+C                              INTENSITIES.  THE SIGN OF NOPT CONTROLS
+C                              THE DIRECTNESS OR INVERSENESS OF THE
+C                              MAPPING.
+C
+C                              . NOPT POSITIVE YIELDS DIRECT MAPPING.
+C                                THE LARGEST VALUE OF Z PRODUCES THE
+C                                MOST DENSE DOTS.  ON MECHANICAL PLOTTERS,
+C                                LARGE VALUES OF Z WILL PRODUCE A DARK
+C                                AREA ON THE PAPER.  WITH THE FILM
+C                                DEVELOPMENT METHODS USED AT NCAR,
+C                                LARGE VALUES OF Z WILL PRODUCE MANY
+C                                (WHITE) DOTS ON THE FILM, ALSO
+C                                RESULTING IN A DARK AREA ON
+C                                READER-PRINTER PAPER.
+C                              . NOPT NEGATIVE YIELDS INVERSE MAPPING.
+C                                THE SMALLEST VALUES OF Z PRODUCE THE
+C                                MOST DENSE DOTS RESULTING IN DARK
+C                                AREAS ON THE PAPER.
+C
+C                              THE ABSOLUTE VALUE OF NOPT DETERMINES THE
+C                              MAPPING OF Z ONTO THE INTENSITIES.  FOR
+C                              IABS(NOPT)
+C                              = 0  THE MAPPING IS LINEAR.  FOR
+C                                   EACH INTENSITY THERE IS AN EQUAL
+C                                   RANGE IN Z VALUE.
+C                              = 1  THE MAPPING IS LINEAR.  FOR
+C                                   EACH INTENSITY THERE IS AN EQUAL
+C                                   RANGE IN Z VALUE.
+C                              = 2  THE MAPPING IS EXPONENTIAL.  FOR
+C                                   LARGER VALUES OF Z, THERE IS A
+C                                   LARGER DIFFERENCE IN INTENSITY FOR
+C                                   RELATIVELY CLOSE VALUES OF Z.  DETAILS
+C                                   IN THE LARGER VALUES OF Z ARE DISPLAYED
+C                                   AT THE EXPENSE OF THE SMALLER VALUES
+C                                   OF Z.
+C                              = 3  THE MAPPING IS LOGRITHMIC, SO
+C                                   DETAILS OF SMALLER VALUES OF Z ARE SHOWN
+C                                   AT THE EXPENSE OF LARGER VALUES OF Z.
+C                              = 4  SINUSOIDAL MAPPING, SO MID-RANGE VALUES
+C                                   OF Z SHOW DETAILS AT THE EXPENSE OF
+C                                   EXTREME VALUES OF Z.
+C                              = 5  ARCSINE MAPPING, SO EXTREME VALUES OF
+C                                   Z ARE SHOWN AT THE EXPENSE OF MID-RANGE
+C                                   VALUES OF Z.
+C
+C                            NPRM
+C                              FLAG TO CONTROL THE DRAWING OF A
+C                              PERIMETER AROUND THE HALF-TONE PICTURE.
+C
+C                              . NPRM=0:  THE PERIMETER IS DRAWN WITH
+C                                TICKS POINTING AT DATA LOCATIONS.
+C                                (SIDE LENGTHS ARE PROPORTIONAL TO NUMBER
+C                                OF DATA VALUES.)
+C                              . NPRM POSITIVE:  NO PERIMETER IS DRAWN.  THE
+C                                PICTURE FILLS THE FRAME.
+C                              . NPRM NEGATIVE:  THE PICTURE IS WITHIN THE
+C                                CONFINES OF THE USER'S CURRENT VIEWPORT
+C                                SETTING.
+C
+C                            ISPV
+C                              FLAG TO TELL IF THE SPECIAL VALUE FEATURE
+C                              IS BEING USED.  THE SPECIAL VALUE FEATURE
+C                              IS USED TO MARK AREAS WHERE THE DATA IS
+C                              NOT KNOWN OR HOLES ARE WANTED IN THE
+C                              PICTURE.
+C
+C                              . ISPV = 0:  SPECIAL VALUE FEATURE NOT IN
+C                                USE.  SPVAL IS IGNORED.
+C                              . ISPV NON-ZERO:  SPECIAL VALUE FEATURE
+C                                IN USE.  SPVAL DEFINES THE SPECIAL
+C                                VALUE.  WHERE Z CONTAINS THE SPECIAL
+C                                VALUE, NO HALF-TONE IS DRAWN.  IF ISPV
+C                                = 0  SPECIAL VALUE FEATURE NOT IN USE.
+C                                     SPVAL IS IGNORED.
+C                                = 1  NOTHING IS DRAWN IN SPECIAL VALUE
+C                                     AREA.
+C                                = 2  CONTIGUOUS SPECIAL VALUE AREAS ARE
+C                                     SURROUNDED BY A POLYGONAL LINE.
+C                                = 3  SPECIAL VALUE AREAS ARE FILLED
+C                                     WITH X(S).
+C                                = 4  SPECIAL VALUE AREAS ARE FILLED IN
+C                                     WITH THE HIGHEST INTENSITY.
+C
+C                            SPVAL
+C                              THE VALUE USED IN Z TO DENOTE MISSING
+C                              VALUES.  THIS ARGUMENT IS IGNORED IF
+C                              ISPV = 0.
+C
+C     ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C     FOR HAFTON
+C
+C     NOTE                   THIS ROUTINE PRODUCES A HUGE NUMBER OF
+C                            PLOTTER INSTRUCTIONS PER PICTURE, AVERAGING
+C                            OVER 100,000 LINE-DRAWS PER FRAME WHEN M = N.
+C
+C
+C     ENTRY POINTS           EZHFTN, HAFTON, ZLSET, GRAY, BOUND, HFINIT
+C
+C     COMMON BLOCKS          HAFT01, HAFT02, HAFT03, HAFT04
+C
+C     REQUIRED LIBRARY       GRIDAL, THE ERPRT77 PACKAGE AND THE SPPS.
+C     ROUTINES
+C
+C     I/O                    PLOTS HALF-TONE PICTURE.
+C
+C     PRECISION              SINGLE
+C
+C     LANGUAGE               FORTRAN
+C
+C     HISTORY                REWRITE OF PHOMAP ORIGINALLY WRITTEN BY
+C                            M. PERRY OF HIGH ALTITUDE OBSERVATORY,
+C                            NCAR.
+C
+C     ALGORITHM              BI-LINEAR INTERPOLATION ON PLOTTER
+C                            (RESOLUTION-LIMITED) GRID OF NORMALIZED
+C                            REPRESENTATION OF DATA.
+C
+C     PORTABILITY            ANSI FORTRAN 77.
+C
+C
+C
+C INTERNAL PARAMTERSS
+C VALUES SET IN BLOCK DATA
+C         NAME  DEFAULT                   FUNCTION
+C         ----  -------                   ________
+C
+C         XLT     0.1    LEFT-HAND EDGE OF THE PLOT WHEN NSET=0.  (0.0=
+C                        LEFT EDGE OF FRAME, 1.0=RIGHT EDGE OF FRAME.)
+C         YBT     0.1    BOTTOM EDGE OF THE PLOT WHEN NSET=0.  (0.0=
+C                        BOTTOM OF FRAME, 1.0=TOP OF FRAME.)
+C         SIDE    0.8    LENGTH OF LONGER EDGE OF PLOT (SEE ALSO EXT).
+C         EXT     .25    LENGTHS OF THE SIDES OF THE PLOT ARE PROPOR-
+C                        TIONAL TO M AND N (WHEN NSET=0) EXCEPT IN
+C                        EXTREME CASES, NAMELY, WHEN MIN(M,N)/MAX(M,N)
+C                        IS LESS THAN EXT.  THEN A SQUARE PLOT IS PRO-
+C                        DUCED.  WHEN A RECTANGULAR PLOT IS PRODUCED,
+C                        THE PLOT IS CENTERED ON THE FRAME (AS LONG AS
+C                        SIDE+2*XLT = SIDE+2*YBT=1., AS WITH THE
+C                        DEFAULTS.)
+C         ALPHA   1.6    A PARAMETER TO CONTROL THE EXTREMENESS OF THE
+C                        MAPPING FUNCTION SPECIFIED BY NOPT.  (FOR
+C                        IABS(NOPT)=0 OR 1, THE MAPPING FUNCTION IS
+C                        LINEAR AND INDEPENDENT OF ALPHA.)  FOR THE NON-
+C                        LINEAR MAPPING FUNCTIONS, WHEN ALPHA IS CHANGED
+C                        TO A NUMBER CLOSER TO 1., THE MAPPING FUNCTION
+C                        BECOMES MORE LINEAR; WHEN ALPHA IS CHANGED TO
+C                        A LARGER NUMBER, THE MAPPING FUNCTION BECOMES
+C                        MORE EXTREME.
+C         MXLEV   16     MAXIMUM NUMBER OF LEVELS.  LIMITED BY PLOTTER.
+C         NCRTG   8      NUMBER OF CRT UNITS PER GRAY-SCALE CELL.
+C                        LIMITED BY PLOTTER.
+C         NCRTF   1024   NUMBER OF PLOTTER ADDRESS UNITS PER FRAME.
+C         IL    (BELOW)  AN ARRAY DEFINING WHICH OF THE AVAILABLE IN-
+C                        TENSITIES ARE USED WHEN LESS THAN THE MAXIMUM
+C                        NUMBER OF INTENSITIES ARE REQUESTED.
+C
+C
+C   NLEV         INTENSITIES USED
+C   ____         ________________
+C    2           5,11,
+C    3           4, 8,12,
+C    4           3, 6,10,13,
+C    5           2, 5, 8,11,14,
+C    6           1, 4, 7, 9,12,15,
+C    7           1, 4, 6, 8,10,12,15,
+C    8           1, 3, 5, 7, 9,11,13,15,
+C    9           1, 3, 4, 6, 8,10,12,13,15
+C   10           1, 3, 4, 6, 7, 9,10,12,13,15,
+C   11           1, 2, 3, 5, 6, 8,10,11,13,14,15,
+C   12           1, 2, 3, 5, 6, 7, 9,10,11,13,14,15,
+C   13           1, 2, 3, 4, 6, 7, 8, 9,10,12,13,14,15
+C   14           1, 2, 3, 4, 5, 6, 7, 9,10,11,12,13,14,15,
+C   15           1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,
+C   16           0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15
+C
+C
+
+      SAVE
+      DIMENSION       Z(L,N)      ,PX(2)       ,PY(2)
+      DIMENSION       ZLEV(16)    ,VWPRT(4)    ,WNDW(4)
+      DIMENSION                    VWPR2(4)    ,WND2(4)
+      CHARACTER*11    IDUMMY
+C
+C
+      COMMON /HAFTO1/ I          ,J          ,INTEN
+      COMMON /HAFTO2/ GLO        ,HA         ,NOPTN      ,ALPHA      ,
+     1                NSPV       ,SP         ,ICNST
+      COMMON /HAFTO3/ XLT        ,YBT        ,SIDE       ,EXT        ,
+     1                IOFFM      ,ALPH       ,MXLEV      ,NCRTG      ,
+     2                NCRTF      ,IL(135)
+      COMMON /HAFTO4/ NPTMAX     ,NPOINT     ,XPNT(50)  ,YPNT(50)
+C +NOAO - Blockdata rewritten as run time initialization subroutine
+C
+C     EXTERNAL HFINIT
+      call hfinit
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','HAFTON','HAFTON','VERSION  1')
+C
+      NPOINT = 0
+      ALPHA = ALPH
+      GLO = FLO
+      HA = HI
+      NLEVL = MIN0(IABS(NLEV),MXLEV)
+      IF (NLEVL .LE. 1) NLEVL = MXLEV
+      NOPTN = NOPT
+      IF (NOPTN .EQ. 0) NOPTN = 1
+      NPRIM = NPRM
+      NSPV = MAX0(MIN0(ISPV,4),0)
+      IF (NSPV .NE. 0) SP = SPVAL
+      MX = L
+      NX = M
+      NY = N
+      CRTF = NCRTF
+      MSPV = 0
+C
+C SET INTENSITY BOUNDARY LEVELS
+C
+      CALL ZLSET (Z,MX,NX,NY,ZLEV,NLEVL)
+C
+C SET UP PERIMETER
+C
+      X3 = NX
+      Y3 = NY
+      CALL GQCNTN (IERR,NTORIG)
+      CALL GETUSV('LS',IOLLS)
+      IF (NPRIM.LT.0) THEN
+         CALL GQNT (NTORIG,IERR,WNDW,VWPRT)
+         X1 = VWPRT(1)
+         X2 = VWPRT(2)
+         Y1 = VWPRT(3)
+         Y2 = VWPRT(4)
+      ELSE IF (NPRIM.EQ.0) THEN
+         X1 = XLT
+         X2 = XLT+SIDE
+         Y1 = YBT
+         Y2 = YBT+SIDE
+         IF (AMIN1(X3,Y3)/AMAX1(X3,Y3) .GE. EXT) THEN
+            IF (NX-NY.LT.0) THEN
+               X2 =SIDE*X3/Y3+XLT
+               X2 = (AINT(X2*CRTF/FLOAT(NCRTG))*FLOAT(NCRTG))/CRTF
+            ELSE IF (NX-NY.GT.0) THEN
+               Y2 = SIDE*Y3/X3+YBT
+               Y2 = (AINT(Y2*CRTF/FLOAT(NCRTG))*FLOAT(NCRTG))/CRTF
+            END IF
+         END IF
+      ELSE IF (NPRIM.GT.0) THEN
+         X1 = 0.0
+         X2 = 1.0
+         Y1 = 0.0
+         Y2 = 1.0
+      END IF
+      MX1 = X1*CRTF
+      MX2 = X2*CRTF
+      MY1 = Y1*CRTF
+      MY2 = Y2*CRTF
+      IF (NPRIM.GT.0) THEN
+         MX1 = 1
+         MY1 = 1
+         MX2 = NCRTF
+         MY2 = NCRTF
+      END IF
+C
+C SAVE NORMALIZATION TRANS 1
+C
+      CALL GQNT (1,IERR,WNDW,VWPRT)
+C
+C DEFINE NORMALIZATION TRANS 1 AND LOG SCALING FOR USE WITH PERIM
+C DRAW PERIMETER IF NPRIM EQUALS 0
+C
+      CALL SET(X1,X2,Y1,Y2,1.0,X3,1.0,Y3,1)
+      IF (NPRIM .EQ. 0) CALL PERIM (NX-1,1,NY-1,1)
+      IF (ICNST .NE. 0) THEN
+        CALL GSELNT (0)
+        CALL WTSTR(XLT*1.1,0.5,'CONSTANT FIELD',2,0,0)
+        GO TO 132
+      END IF
+C
+C FIND OFFSET FOR REFERENCE TO IL, WHICH IS TRIANGULAR
+C
+      IOFFST = NLEVL*((NLEVL-1)/2)+MOD(NLEVL-1,2)*(NLEVL/2)-1
+C
+C OUTPUT INTENSITY SCALE
+C
+      IF (NPRIM .GT. 0) GO TO 112
+      LEV = 0
+      KX = (1.1*XLT+SIDE)*CRTF
+      KY = YBT*CRTF
+      NNX = KX/NCRTG
+  109 LEV = LEV+1
+C +NOAO
+C The following statement moved from after statement label 111 (CONTINUE) to
+C here.  Otherwise an extra (unlabelled) grayscale box was being drawn.
+C This was (eventually) causing a [floating operand error] on a Sun-3.
+      IF (LEV .GT. NLEVL) GO TO 112
+C -NOAO
+      ISUB = IOFFST+LEV
+      INTEN = IL(ISUB)
+      IF (NOPTN .LT. 0) INTEN = MXLEV-INTEN
+      NNY = KY/NCRTG
+      DO 111 JJ=1,3
+         DO 110 II=1,10
+            I = NNX+II
+            J = NNY+JJ
+            CALL GRAY
+  110    CONTINUE
+  111 CONTINUE
+C +NOAO - FTN internal write rewritten as call to encode.
+C       WRITE(IDUMMY,'(G11.4)') ZLEV(LEV)
+	call encode (11, '(g11.4)', idummy, zlev(lev))
+C -NOAO
+      TKX = KX
+      TKY = KY+38
+      CALL GQNT(1,IERR,WND2,VWPR2)
+      CALL SET(0.,1.,0.,1.,0.,1023.,0.,1023.,1)
+      CALL WTSTR (TKX,TKY,IDUMMY,0,0,-1)
+      CALL SET(VWPR2(1),VWPR2(2),VWPR2(3),VWPR2(4),
+     -         WND2(1),WND2(2),WND2(3),WND2(4),1)
+C
+C ADJUST 38 TO PLOTTER.
+C
+      KY = KY+52
+C
+C ADJUST 52 TO PLOTTER.
+C
+      GO TO 109
+C
+C STEP THROUGH PLOTTER GRID OF INTENSITY CELLS.
+C
+  112 IMIN = (MX1-1)/NCRTG+1
+      IMAX = (MX2-1)/NCRTG
+      JMIN = (MY1-1)/NCRTG+1
+      JMAX = (MY2-1)/NCRTG
+      XL = IMAX-IMIN+1
+      YL = JMAX-JMIN+1
+      XN = NX
+      YN = NY
+      LSRT = NLEVL/2
+      DO 130 J=JMIN,JMAX
+C
+C FIND Y FOR THIS J AND Z FOR THIS Y.
+C
+       YJ = (FLOAT(J-JMIN)+.5)/YL*(YN-1.)+1.
+         LOWY = YJ
+         YPART = YJ-FLOAT(LOWY)
+         IF (LOWY .NE. NY) GO TO 113
+         LOWY = LOWY-1
+         YPART = 1.
+  113    IPEN = 0
+         ZLFT = Z(1,LOWY)+YPART*(Z(1,LOWY+1)-Z(1,LOWY))
+         ZRHT = Z(2,LOWY)+YPART*(Z(2,LOWY+1)-Z(2,LOWY))
+         IF (NSPV .EQ. 0) GO TO 114
+         IF (Z(1,LOWY).EQ.SP .OR. Z(2,LOWY).EQ.SP .OR.
+     1       Z(1,LOWY+1).EQ.SP .OR. Z(2,LOWY+1).EQ.SP) IPEN = 1
+  114    IF (IPEN .EQ. 1) GO TO 117
+C
+C FIND INT FOR THIS Z.
+C
+         IF (ZLFT .GT. ZLEV(LSRT+1)) GO TO 116
+  115    IF (ZLFT .GE. ZLEV(LSRT)) GO TO 117
+C
+C LOOK LOWER
+C
+         IF (LSRT .LE. 1) GO TO 117
+         LSRT = LSRT-1
+         GO TO 115
+C
+C LOOK HIGHER
+C
+  116    IF (LSRT .GE. NLEVL) GO TO 117
+         LSRT = LSRT+1
+         IF (ZLFT .GT. ZLEV(LSRT+1)) GO TO 116
+C
+C OK
+C
+  117    IRHT = 2
+         LAST = LSRT
+         DO 129 I=IMIN,IMAX
+C
+C FIND X FOR THIS I AND Z FOR THIS X AND Y.
+C
+            IADD = 1
+            XI = (FLOAT(I-IMIN)+.5)/XL*(XN-1.)+1.
+            LOWX = XI
+            XPART = XI-FLOAT(LOWX)
+            IF (LOWX .NE. NX) GO TO 118
+            LOWX = LOWX-1
+            XPART = 1.
+C
+C TEST FOR INTERPOLATION POSITIONING
+C
+  118       IF (LOWX .LT. IRHT) GO TO 119
+C
+C MOVE INTERPOLATION ONE CELL TO THE RIGHT
+C
+            ZLFT = ZRHT
+            IRHT = IRHT+1
+            ZRHT = Z(IRHT,LOWY)+YPART*(Z(IRHT,LOWY+1)-Z(IRHT,LOWY))
+            IF (NSPV .EQ. 0) GO TO 118
+            IPEN = 0
+            IF (Z(IRHT-1,LOWY).EQ.SP .OR. Z(IRHT,LOWY).EQ.SP .OR.
+     1          Z(IRHT-1,LOWY+1).EQ.SP .OR. Z(IRHT,LOWY+1).EQ.SP)
+     2          IPEN = 1
+            GO TO 118
+  119       IF (IPEN .NE. 1) GO TO 123
+C
+C SPECIAL VALUE AREA
+C
+            GO TO (129,120,121,122),NSPV
+  120       MSPV = 1
+            GO TO 129
+  121       PX(1) = I*NCRTG
+            PY(1) = J*NCRTG
+            PX(2) = PX(1)+NCRTG-1
+            PY(2) = PY(1)+NCRTG-1
+            CALL GPL (2,PX,PY)
+            PYTMP = PY(1)
+            PY(1) = PY(2)
+            PY(2) = PYTMP
+            CALL GPL (2,PX,PY)
+C
+            GO TO 129
+  122       INTEN = MXLEV
+            GO TO 128
+  123       ZZ = ZLFT+XPART*(ZRHT-ZLFT)
+C
+C TEST FOR SAME INT AS LAST TIME.
+C
+            IF (ZZ .GT. ZLEV(LAST+1)) GO TO 126
+  124       IF (ZZ .GE. ZLEV(LAST)) GO TO 127
+C
+C LOOK LOWER
+C
+            IF (LAST .LE. 1) GO TO 125
+            LAST = LAST-1
+            GO TO 124
+  125       IF (ZZ .LT. ZLEV(LAST)) IADD = 0
+            GO TO 127
+C
+C LOOK HIGHER
+C
+  126       IF (LAST .GE. NLEVL) GO TO 127
+            LAST = LAST+1
+            IF (ZZ .GE. ZLEV(LAST+1)) GO TO 126
+C
+C OK
+C
+  127       ISUB = LAST+IOFFST+IADD
+            INTEN = IL(ISUB)
+            IF (NOPTN .LT. 0) INTEN = MXLEV-INTEN
+  128       CALL GRAY
+  129    CONTINUE
+  130 CONTINUE
+C
+C PUT OUT ANY REMAINING BUFFERED POINTS.
+C
+      IF (NPOINT.GT.0) THEN
+         CALL GQNT(1,IERR,WND2,VWPR2)
+         CALL SET(0.,1.,0.,1.,0.,1023.,0.,1023.,1)
+         CALL POINTS(XPNT,YPNT,NPOINT,0,0)
+         CALL SET(VWPR2(1),VWPR2(2),VWPR2(3),VWPR2(4),
+     -            WND2(1),WND2(2),WND2(3),WND2(4),1)
+      ENDIF
+C
+C CALL BOUND IF ISPV=2 AND SPECIAL VALUES WERE FOUND.
+C
+      IF (MSPV .EQ. 1) THEN
+        CALL SET(X1,X2,Y1,Y2,1.0,X3,1.0,Y3,1)
+        CALL BOUND (Z,MX,NX,NY,SP)
+      END IF
+  132 CONTINUE
+C
+C RESTORE NORMALIZATION TRANS 1 AND ORIGINAL NORMALIZATION NUMBER
+C
+      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -         WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      CALL SETUSV('LS',IOLLS)
+      CALL GSELNT (NTORIG)
+      RETURN
+C
+      END
+      SUBROUTINE ZLSET (Z,MX,NX,NY,ZL,NLEVL)
+      SAVE
+C
+      DIMENSION       Z(MX,NY)   ,ZL(NLEVL)
+C
+      COMMON /HAFTO2/ GLO        ,HA         ,NOPTN      ,ALPHA      ,
+     1                NSPV       ,SP         ,ICNST
+C
+      BIG = R1MACH(2)
+C
+C ZLSET PUTS THE INTENSITY LEVEL BREAK POINTS IN ZL.
+C ALL ARGUMENTS ARE AS IN HAFTON.
+C
+      LX = NX
+      LY = NY
+      NLEV = NLEVL
+      NOPT = IABS(NOPTN)
+      RALPH = 1./ALPHA
+      ICNST = 0
+      IF (GLO.NE.0. .OR. HA.NE.0.) GO TO 106
+C
+C FIND RANGE IF NOT KNOWN.
+C
+      GLO = BIG
+      HA = -GLO
+      IF (NSPV .NE. 0) GO TO 103
+      DO 102 J=1,LY
+         DO 101 I=1,LX
+            ZZ = Z(I,J)
+            GLO = AMIN1(ZZ,GLO)
+            HA = AMAX1(ZZ,HA)
+  101    CONTINUE
+  102 CONTINUE
+      GO TO 106
+  103 DO 105 J=1,LY
+         DO 104 I=1,LX
+            ZZ = Z(I,J)
+            IF (ZZ .EQ. SP) GO TO 104
+            GLO = AMIN1(ZZ,GLO)
+            HA = AMAX1(ZZ,HA)
+  104    CONTINUE
+  105 CONTINUE
+C
+C FILL ZL
+C
+  106 DELZ = HA-GLO
+      IF (DELZ .EQ. 0.) GO TO 115
+      DZ = DELZ/FLOAT(NLEV)
+      NLEVM1 = NLEV-1
+      DO 114 K=1,NLEVM1
+         ZNORM = FLOAT(K)/FLOAT(NLEV)
+         GO TO (107,108,109,110,111),NOPT
+C
+C NOPT=1
+C
+  107    ZL(K) = GLO+FLOAT(K)*DZ
+         GO TO 114
+C
+C NOPT=2
+C
+  108    ONORM = (1.-(1.-ZNORM)**ALPHA)**RALPH
+         GO TO 113
+C
+C NOPT=3
+C
+  109    ONORM = 1.-(1.-ZNORM**ALPHA)**RALPH
+         GO TO 113
+C
+C NOPT=4
+C
+  110    ONORM = .5*(1.-(ABS(ZNORM+ZNORM-1.))**ALPHA)**RALPH
+         GO TO 112
+C
+C NOPT=5
+C
+  111    ZNORM2 = ZNORM+ZNORM
+         IF (ZNORM .GT. .5) ZNORM2 = 2.-ZNORM2
+         ONORM = .5*(1.-(1.-ABS(ZNORM2)**ALPHA)**RALPH)
+  112    IF (ZNORM .GT. .5) ONORM = 1.-ONORM
+  113    ZL(K) = GLO+DELZ*ONORM
+  114 CONTINUE
+      ZL(NLEV) = BIG
+      RETURN
+  115 ICNST = 1
+      RETURN
+      END
+      SUBROUTINE GRAY
+C
+C SUBROUTINE GRAY COLORS HALF-TONE CELL (I,J) WITH INTENSITY INTEN.
+C THE ROUTINE ASSUMES 8X8 CELL SIZE ON A VIRTUAL SCREEN 1024X1024.
+C
+      DIMENSION       IFOT(16)   ,JFOT(16)
+      DIMENSION       WNDW(4)    ,VWPRT(4)
+CCC      DIMENSION       MX(16)  ,MY(16)
+      COMMON /HAFTO1/ I          ,J          ,INTEN
+      COMMON /HAFTO4/ NPTMAX     ,NPOINT     ,XPNT(50)  ,YPNT(50)
+      SAVE
+C
+      DATA
+     1 IFOT(1),IFOT(2),IFOT(3),IFOT(4),IFOT(5),IFOT(6),IFOT(7),IFOT(8)/
+     2   1,      5,      1,      5,      3,      7,      3,      7   /
+      DATA
+     1 IFOT(9),IFOT(10),IFOT(11),IFOT(12),IFOT(13),IFOT(14),IFOT(15)/
+     2   3,      7,       3,       7,       1,       5,       1/,
+     3 IFOT(16)/
+     4   5    /
+C
+      DATA
+     1 JFOT(1),JFOT(2),JFOT(3),JFOT(4),JFOT(5),JFOT(6),JFOT(7),JFOT(8)/
+     2   1,      5,      5,      1,      3,     7,      7,      3   /
+      DATA
+     1 JFOT(9),JFOT(10),JFOT(11),JFOT(12),JFOT(13),JFOT(14),JFOT(15)/
+     2   1,      5,       5,       1,       3,       7,       7/,
+     3 JFOT(16)/
+     4   3    /
+C
+      IF (INTEN) 103,103,101
+  101 I1 = I*8
+      J1 = J*8
+      IF ((NPOINT+INTEN) .LE.NPTMAX)  GO TO 1015
+      CALL GQNT(1,IERR,WNDW,VWPRT)
+      CALL SET(0.,1.,0.,1.,0.,1023.,0.,1023.,1)
+      CALL POINTS(XPNT,YPNT,NPOINT,0,0)
+      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -         WNDW(1),WNDW(2),WNDW(3),WNDW(4),1)
+      NPOINT = 0
+ 1015 DO 102 I2=1,INTEN
+      NPOINT = NPOINT + 1
+      XPNT(NPOINT) = I1+IFOT(I2)
+      YPNT(NPOINT) = J1+JFOT(I2)
+  102 CONTINUE
+  103 RETURN
+      END
+      SUBROUTINE BOUND (Z,MX,NNX,NNY,SSP)
+      DIMENSION       Z(MX,NNY)   ,PX(2)   ,PY(2)
+C
+C BOUND DRAWS A POLYGONAL BOUNDRY AROUND ANY SPECIAL-VALUE AREAS IN Z.
+C
+      SAVE
+      NX = NNX
+      NY = NNY
+C
+C VERTICAL LINES
+C
+      SP = SSP
+      DO 103 IP1=3,NX
+         I = IP1-1
+         PX(1) = I
+         PX(2) = I
+         IM1 = I-1
+         DO 102 JP1=2,NY
+            PY(2) = JP1
+            J = JP1-1
+            PY(1) = J
+            KLEFT = 0
+            IF (Z(IM1,J).EQ.SP .OR. Z(IM1,JP1).EQ.SP) KLEFT = 1
+            KCENT = 0
+            IF (Z(I,J).EQ.SP .OR. Z(I,JP1).EQ.SP) KCENT = 1
+            KRIGT = 0
+            IF (Z(IP1,J).EQ.SP .OR. Z(IP1,JP1).EQ.SP) KRIGT = 1
+            JUMP = KLEFT*4+KCENT*2+KRIGT+1
+            GO TO (102,101,102,102,101,102,102,102,102),JUMP
+  101       CALL GPL (2,PX,PY)
+  102    CONTINUE
+  103 CONTINUE
+C
+C HORIZONTAL
+C
+      DO 106 JP1=3,NY
+         J = JP1-1
+         PY(1) = J
+         PY(2) = J
+         JM1 = J-1
+         DO 105 IP1=2,NX
+            PX(2) = IP1
+            I = IP1-1
+            PX(1) = I
+            KLOWR = 0
+            IF (Z(I,JM1).EQ.SP .OR. Z(IP1,JM1).EQ.SP) KLOWR = 1
+            KCENT = 0
+            IF (Z(I,J).EQ.SP .OR. Z(IP1,J).EQ.SP) KCENT = 1
+            KUPER = 0
+            IF (Z(I,JP1).EQ.SP .OR. Z(IP1,JP1).EQ.SP) KUPER = 1
+            JUMP = KLOWR*4+KCENT*2+KUPER+1
+            GO TO (105,104,105,105,104,105,105,105,105),JUMP
+  104       CALL GPL (2,PX,PY)
+  105    CONTINUE
+  106 CONTINUE
+      RETURN
+      END
+      SUBROUTINE EZHFTN (Z,M,N)
+C
+      DIMENSION       Z(M,N)
+      SAVE
+C
+C HALF-TONE PICTURE VIA SHORTEST ARGUMENT LIST.
+C ASSUMPTIONS--
+C     ALL OF THE ARRAY IS TO BE DRAWN,
+C     LOWEST VALUE IN Z WILL BE AT LOWEST INTENSITY ON READER/PRINTER
+C     OUTPUT, HIGHEST VALUE IN Z WILL BE AT HIGHEST INTENSITY, VALUES IN
+C     BETWEEN WILL APPEAR LINEARLY SPACED, MAXIMUM POSSIBLE NUMBER OF
+C     INTENSITIES ARE USED, THE PICTURE WILL HAVE A PERIMETER DRAWN,
+C     FRAME WILL BE CALLED AFTER THE PICTURE IS DRAWN, Z IS FILLED WITH
+C     NUMBERS THAT SHOULD BE USED (NO UNKNOWN VALUES).
+C IF THESE CONDITIONS ARE NOT MET, USE HAFTON.
+C EZHFTN ARGUMENTS--
+C     Z   2 DIMENSIONAL ARRAY TO BE USED TO GENERATE A HALF-TONE PLOT.
+C     M   FIRST DIMENSION OF Z.
+C     N   SECOND DIMENSION OF Z.
+C
+      DATA FLO,HI,NLEV,NOPT,NPRM,ISPV,SPV/0.0,0.0,0,0,0,0,0.0/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','HAFTON','EZHFTN','VERSION  1')
+C
+      CALL HAFTON (Z,M,M,N,FLO,HI,NLEV,NOPT,NPRM,ISPV,SPV)
+C
+C +NOAO - EZHFTN no longer calls frame.
+C     CALL FRAME
+C -NOAO
+      RETURN
+      END
+C
+C-----------------------------------------------------------------------
+C
+C REVISION HISTORY---
+C
+C JULY     1984    CONVERTED TO FORTAN 77 AND GKS
+C
+C MARCH    1983    INSTITUTED BUFFERING OF POINTS WITHIN ROUTINE GRAY,
+C                  WHICH DRAMATICALLY REDUCES SIZE OF OUTPUT PLOT CODE,
+C                  METACODE.  THIS IN TURN GENERALLY IMPROVES THROUGHPUT
+C                  OF METACODE INTERPRETERS.
+C
+C FEBRUARY 1979    MODIFIED CODE TO CONFORM TO FORTRAN 66 STANDARD
+C
+C JANUARY  1978    DELETED REFERENCES TO THE  *COSY  CARDS AND
+C                  ADDED REVISION HISTORY
+C
+C-----------------------------------------------------------------------
+C
diff --git a/sys/gio/ncarutil/hfinit.f b/sys/gio/ncarutil/hfinit.f
new file mode 100644
index 00000000..e64207eb
--- /dev/null
+++ b/sys/gio/ncarutil/hfinit.f
@@ -0,0 +1,229 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data hfinit changed to run time initialization
+c     BLOCKDATA HFINIT
+        subroutine hfinit
+C
+      COMMON /HAFTO3/ XLT        ,YBT        ,SIDE       ,EXT,
+     1                IOFFM      ,ALPH       ,MXLEV   ,NCRTG ,
+     2                NCRTF      ,IL(135)
+      COMMON /HAFTO4/ NPTMAX     ,NPOINT  ,XPNT(50)  ,YPNT(50)
+C
+C  INITIALIZATION OF INTERNAL PARAMETERS
+C
+c     DATA   XLT,  YBT,SIDE,EXT,IOFFM,ALPH,MXLEV,NCRTG,NCRTF/
+c    1     0.102,0.102,.805,.25,    0, 1.6,   16,    8, 1024/
+c
+c +noao:  following flag added to prevent initializing more than once
+        logical first
+        SAVE
+        data first /.true./
+        if (.not. first) then
+            return
+        endif
+        first = .false.
+
+c +noao: call to utilbd added to make sure those parameters set by getusv
+c        have been set before they are retrieved.
+         call utilbd
+c -noao
+        XLT   = 0.102
+        YBT   = 0.102
+        SIDE  = .805
+        EXT   = .25
+        IOFFM = 0
+        ALPH  = 1.6
+        MXLEV = 16
+        NCRTG = 8
+        NCRTF = 1024
+c
+c     DATA IL(1),IL(2),IL(3),IL(4),IL(5),IL(6),IL(7),IL(8),IL(9),IL(10),
+c    1IL(11),IL(12),IL(13),IL(14),IL(15),IL(16),IL(17),IL(18),IL(19),
+c    2IL(20),IL(21),IL(22),IL(23),IL(24),IL(25),IL(26),IL(27),IL(28),
+c    3IL(29),IL(30),IL(31),IL(32),IL(33),IL(34),IL(35),IL(36),IL(37),
+c    4IL(38),IL(39),IL(40),IL(41),IL(42),IL(43),IL(44)/
+c    5    5,11,
+c    6    4, 8,12,
+c    7    3, 6,10,13,
+c    8    2, 5, 8,11,14,
+c    9    1, 4, 7, 9,12,15,
+c    +    1, 4, 6, 8,10,12,15,
+c    1    1, 3, 5, 7, 9,11,13,15,
+c    2     1, 3, 4, 6, 8, 10, 12, 13, 15/
+c
+       IL(1)  =  5
+       IL(2)  = 11
+       IL(3)  =  4
+       IL(4)  =  8
+       IL(5)  = 12
+       IL(6)  =  3
+       IL(7)  =  6
+       IL(8)  = 10
+       IL(9)  = 13
+       IL(10) =  2
+       IL(11) =  5 
+       IL(12) =  8
+       IL(13) = 11
+       IL(14) = 14
+       IL(15) =  1
+       IL(16) =  4
+       IL(17) =  7
+       IL(18) =  9
+       IL(19) = 12
+       IL(20) = 15
+       IL(21) =  1
+       IL(22) =  4
+       IL(23) =  6
+       IL(24) =  8
+       IL(25) = 10
+       IL(26) = 12
+       IL(27) = 15
+       IL(28) =  1
+       IL(29) =  3
+       IL(30) =  5
+       IL(31) =  7
+       IL(32) =  9
+       IL(33) = 11
+       IL(34) = 13
+       IL(35) = 15
+       IL(36) =  1
+       IL(37) =  3
+       IL(38) =  4
+       IL(39) =  6
+       IL(40) =  8
+       IL(41) = 10
+       IL(42) = 12
+       IL(43) = 13
+       IL(44) = 15
+c
+c     DATA IL(45),IL(46),
+c    1IL(47),IL(48),IL(49),IL(50),IL(51),IL(52),IL(53),IL(54),IL(55),
+c    2IL(56),IL(57),IL(58),IL(59),IL(60),IL(61),IL(62),IL(63),IL(64),
+c    3IL(65),IL(66),IL(67),IL(68),IL(69),IL(70),IL(71),IL(72),IL(73),
+c    4IL(74),IL(75),IL(76),IL(77),IL(78),IL(79),IL(80),IL(81),IL(82),
+c    5IL(83),IL(84),IL(85),IL(86),IL(87),IL(88),IL(89),IL(90)/
+c    6    1, 3, 4, 6, 7, 9,10,12,13,15,
+c    7    1, 2, 3, 5, 6, 8,10,11,13,14,15,
+c    8    1, 2, 3, 5, 6, 7, 9,10,11,13,14,15,
+c    9    1, 2, 3, 4, 6, 7, 8, 9, 10, 12, 13, 14, 15/
+c
+       IL(45) =  1
+       IL(46) =  3
+       IL(47) =  4
+       IL(48) =  6 
+       IL(49) =  7 
+       IL(50) =  9
+       IL(51) = 10
+       IL(52) = 12
+       IL(53) = 13
+       IL(54) = 15 
+       IL(55) =  1 
+       IL(56) =  2 
+       IL(57) =  3 
+       IL(58) =  5 
+       IL(59) =  6 
+       IL(60) =  8
+       IL(61) = 10
+       IL(62) = 11
+       IL(63) = 13
+       IL(64) = 14
+       IL(65) = 15 
+       IL(66) =  1 
+       IL(67) =  2 
+       IL(68) =  3
+       IL(69) =  5 
+       IL(70) =  6 
+       IL(71) =  7 
+       IL(72) =  9
+       IL(73) = 10
+       IL(74) = 11
+       IL(75) = 13
+       IL(76) = 14
+       IL(77) = 15 
+       IL(78) =  1 
+       IL(79) =  2 
+       IL(80) =  3 
+       IL(81) =  4 
+       IL(82) =  6 
+       IL(83) =  7 
+       IL(84) =  8 
+       IL(85) =  9 
+       IL(86) = 10 
+       IL(87) = 12 
+       IL(88) = 13 
+       IL(89) = 14 
+       IL(90) = 15
+c
+c     DATA IL(91),
+c    1IL(92),IL(93),IL(94),IL(95),IL(96),IL(97),IL(98),IL(99),IL(100),
+c    2IL(101),IL(102),IL(103),IL(104),IL(105),IL(106),IL(107),IL(108),
+c    3IL(109),IL(110),IL(111),IL(112),IL(113),IL(114),IL(115),IL(116),
+c    4IL(117),IL(118),IL(119),IL(120),IL(121),IL(122),IL(123),IL(124),
+c    5IL(125),IL(126),IL(127),IL(128),IL(129),IL(130),IL(131),IL(132),
+c    6IL(133),IL(134),IL(135)/
+c    7    1, 2, 3, 4, 5, 6, 7, 9,10,11,12,13,14,15,
+c    8    1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,
+c    9    0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15/
+c
+       IL(91) =  1 
+       IL(92) = 2 
+       IL(93) = 3 
+       IL(94) = 4 
+       IL(95) = 5 
+       IL(96) = 6 
+       IL(97) = 7 
+       IL(98) = 9
+       IL(99) = 10
+       IL(100) = 11
+       IL(101) = 12
+       IL(102) = 13
+       IL(103) = 14
+       IL(104) = 15 
+       IL(105) = 1 
+       IL(106) = 2 
+       IL(107) = 3 
+       IL(108) = 4 
+       IL(109) = 5 
+       IL(110) = 6 
+       IL(111) = 7 
+       IL(112) = 8 
+       IL(113) = 9
+       IL(114) = 10
+       IL(115) = 11
+       IL(116) = 12
+       IL(117) = 13
+       IL(118) = 14
+       IL(119) = 15 
+       IL(120) = 0 
+       IL(121) = 1
+       IL(122) = 2 
+       IL(123) = 3 
+       IL(124) = 4 
+       IL(125) = 5 
+       IL(126) = 6 
+       IL(127) = 7 
+       IL(128) = 8 
+       IL(129) = 9
+       IL(130) = 10
+       IL(131) = 11
+       IL(132) = 12
+       IL(133) = 13
+       IL(134) = 14
+       IL(135) = 15
+c
+C SIZE OF THE COORDINATE BUFFERING ARRAYS FOR POINTS BUFFERING.
+c     DATA  NPTMAX/50/
+      NPTMAX = 50
+c -noao
+      END
diff --git a/sys/gio/ncarutil/isosrb.f b/sys/gio/ncarutil/isosrb.f
new file mode 100644
index 00000000..5c1481a0
--- /dev/null
+++ b/sys/gio/ncarutil/isosrb.f
@@ -0,0 +1,98 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: blockdata isosrb changed to run time initialization subroutine
+      subroutine isosrb
+c     BLOCKDATA ISOSRB
+C
+C     BLOCK DATA
+C
+      COMMON /ISOSR2/ LX         ,NX               ,NY   ,ISCR(8,128),
+     1                ISCA(8,128)
+      COMMON /ISOSR4/ RX         ,RY
+      COMMON /ISOSR5/ NBPW       ,MASK(16)      ,GENDON
+      LOGICAL               GENDON
+      COMMON /ISOSR6/ IX         ,IY               ,IDX  ,IDY,
+     1                IS         ,ISS        ,NP         ,CV,
+     2                INX(8)     ,INY(8)     ,IR(500)    ,NR
+      COMMON /ISOSR7/ IENTRY     ,IONES
+      COMMON /ISOSR8/ NMASK(16)  ,IXOLD      ,IYOLD      ,IBTOLD,
+     1                HBFLAG     ,IOSLSN     ,LRLX       ,IFSX,
+     2                IFSY       ,FIRST      ,IYDIR      ,IHX,
+     3                IHB        ,IHS        ,IHV        ,IVOLD,
+     4                IVAL       ,IHRX       ,YCHANG     ,ITPD,
+     5                IHF
+      COMMON /ISOSR9/ BIG        ,IXBIT
+      COMMON /TEMPR/  RZERO
+      LOGICAL               YCHANG       ,HBFLAG        ,FIRST   ,IHF
+C
+      logical first1
+      SAVE
+      data first1 /.true./
+      if (.not. first1) then
+        return
+      endif
+      first1 = .false.
+c
+c     DATA LX,NX,NY/8,128,128/
+      LX = 8
+      NX = 128
+      NY = 128   
+c
+c     DATA INX(1),INX(2),INX(3),INX(4),INX(5),INX(6),INX(7),INX(8)/
+c    1        -1 ,   -1 ,    0 ,    1 ,    1 ,          1 ,      0 ,   -1 /
+      INX(1) = -1
+      INX(2) = -1
+      INX(3) =  0
+      INX(4) =  1
+      INX(5) =  1
+      INX(6) =  1
+      INX(7) =  0
+      INX(8) = -1
+c
+c     DATA INY(1),INY(2),INY(3),INY(4),INY(5),INY(6),INY(7),INY(8)/
+c    1         0 ,    1 ,    1 ,    1 ,    0 ,   -1 ,   -1 ,   -1 /
+      INY(1) =  0
+      INY(2) =  1
+      INY(3) =  1
+      INY(4) =  1
+      INY(5) =  0
+      INY(6) = -1
+      INY(7) = -1
+      INY(8) = -1
+c
+c     DATA NR/500/
+      NR = 500
+c
+c     DATA NBPW/16/
+      NBPW = 16
+c
+c     DATA IHF/.FALSE./
+      IHF = .FALSE.
+C
+c     DATA GENDON /.FALSE./
+      GENDON = .FALSE.
+c
+c     DATA RZERO/0./
+      RZERO = 0.
+C
+C
+C RX = (NX-1)/SCREEN WIDTH FROM TRN32I
+C RY = (NY-1)/SCREEN HEIGHT FROM TRN32I
+C
+c     DATA RX,RY/.00389,.00389/
+      RX = .00389
+      RY = .00389  
+C
+c -noao
+      END
diff --git a/sys/gio/ncarutil/isosrf.f b/sys/gio/ncarutil/isosrf.f
new file mode 100644
index 00000000..7be532ee
--- /dev/null
+++ b/sys/gio/ncarutil/isosrf.f
@@ -0,0 +1,1696 @@
+      SUBROUTINE ISOSRF (T,LU,MU,LV,MV,MW,EYE,MUVWP2,SLAB,TISO,IFLAG)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C DIMENSION OF           T(LU,LV,MW),EYE(3),SLAB(MUVWP2,MUVWP2)
+C ARGUMENTS
+C
+C LATEST REVISION        DECEMBER 1984
+C
+C PURPOSE                ISOSRF DRAWS AN APPROXIMATION OF AN ISO-VALUED
+C                        SURFACE FROM A THREE-DIMENSIONAL ARRAY WITH
+C                        HIDDEN LINES REMOVED.
+C
+C USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                            CALL EZISOS (T,MU,MV,MW,EYE,SLAB,TISO)
+C
+C                               ASSUMPTIONS:
+C                                 -- ALL OF THE T ARRAY IS TO BE USED.
+C                                 -- IFLAG IS CHOSEN INTERNALLY.
+C                                 -- FRAME IS CALLED BY EZISOS.
+C
+C                        IF THE ASSUMPTIONS ARE NOT MET, USE
+C
+C                            CALL ISOSRF (T,LU,MU,LV,MV,MW,EYE,MUVWP2,
+C                                         SLAB,TISO,IFLAG)
+C
+C ARGUMENTS
+C
+C ON INPUT               T
+C                          THREE DIMENSIONAL ARRAY OF DATA THAT DEFINES
+C                          THE ISO-VALUED SURFACE.
+C
+C                        LU
+C                          FIRST DIMENSION OF T IN THE CALLING PROGRAM.
+C
+C                        MU
+C                          THE NUMBER OF DATA VALUES OF T TO BE
+C                          PROCESSED IN THE U DIRECTION (THE FIRST
+C                          SUBSCRIPT DIRECTION).  WHEN PROCESSING THE
+C                          ENTIRE ARRAY, LU = MU (AND LV = MV).
+C
+C                        LV
+C                          SECOND DIMENSION OF T IN THE CALLING PROGRAM.
+C
+C                        MV
+C                          THE NUMBER OF DATA VALUES OF T TO BE
+C                          PROCESSED IN THE V DIRECTION (THE SECOND
+C                          SUBSCRIPT DIRECTION).
+C
+C                        MV
+C                          THE NUMBER OF DATA VALUES OF T TO BE
+C                          PROCESSED IN THE W DIRECTION (THE THIRD
+C                          SUBSCRIPT DIRECTION).
+C
+C                        EYE
+C                          THE POSITION OF THE EYE IN THREE-SPACE.  T IS
+C                          CONSIDERED TO BE IN A BOX WITH OPPOSITE
+C                          CORNERS (1,1,1) AND (MU,MV,MW).  THE EYE IS
+C                          AT (EYE(1),EYE(2),EYE(3)), WHICH MUST BE
+C                          OUTSIDE THE BOX THAT CONTAINS T.  WHILE GAINING
+C                          EXPERIENCE WITH THE ROUTINE, A GOOD CHOICE
+C                          FOR EYE MIGHT BE (5.0*MU,3.5*MV,2.0*MW).
+C
+C                        MUVWP2
+C                          THE MAXIMUM OF (MU,MV,MW)+2; THAT IS,
+C                          MUVWP2 = MAX(MU,MV,MW)+2).
+C
+C                        SLAB
+C                          A WORK SPACE USED FOR INTERNAL STORAGE.  SLAB
+C                          MUST BE AT LEAST MUVWP2*MUVWP2 WORDS LONG.
+C
+C                        TISO
+C                          THE ISO-VALUE USED TO DEFINE THE SURFACE.  THE
+C                          SURFACE DRAWN WILL SEPARATE VOLUMES OF T THAT
+C                          HAVE VALUES GREATER THAN OR EQUAL TO TISO FROM
+C                          VOLUMES OF T THAT HAVE VALUES LESS THAN TISO.
+C
+C                        IFLAG
+C                          THIS FLAG SERVES TWO PURPOSES.
+C                          .  FIRST, THE ABSOLUTE VALUE OF IFLAG
+C                             DETERMINES WHICH TYPES OF LINES ARE DRAWN
+C                             TO APPROXIMATE THE SURFACE.  THREE TYPES
+C                             OF LINES ARE CONSIDERED:  LINES OF
+C                             CONSTANT U, LINES OF CONSTANT V AND LINES
+C                             OF CONSTANT W.  THE FOLLOWING TABLE LISTS
+C                             THE TYPES OF LINES DRAWN.
+C
+C                                                LINES OF CONSTANT
+C                                                -----------------
+C                             IABS(IFLAG)           U    V    W
+C                             -----------          ---  ---  ---
+C                                  1               NO   NO   YES
+C                                  2               NO   YES  NO
+C                                  3               NO   YES  YES
+C                                  4               YES  NO   NO
+C                                  5               YES  NO   YES
+C                                  6               YES  YES  NO
+C                             0, 7 OR MORE         YES  YES  YES
+C
+C                          .  SECOND, THE SIGN OF IFLAG DETERMINES WHAT
+C                             IS INSIDE AND WHAT IS OUTSIDE, HENCE,
+C                             WHICH LINES ARE VISIBLE AND WHAT IS DONE
+C                             AT THE BOUNDARY OF T.  FOR IFLAG:
+C
+C                             POSITIVE   T VALUES GREATER THAN TISO ARE
+C                                        ASSUMED TO BE INSIDE THE SOLID
+C                                        FORMED BY THE DRAWN SURFACE.
+C                             NEGATIVE   T VALUES LESS THAN TISO ARE
+C                                        ASSUMED TO BE INSIDE THE SOLID
+C                                        FORMED BY THE DRAWN SURFACE.
+C                             IF THE ALGORITHM DRAWS A CUBE, REVERSE THE
+C                             SIGN OF IFLAG.
+C
+C ON OUTPUT              T,LU,MU,LV,MV,MW,EYE,MUVWP2,TISO AND IFLAG ARE
+C                        UNCHANGED.  SLAB HAS BEEN WRITTEN IN.
+C
+C NOTE                   .   THIS ROUTINE IS FOR LOWER RESOLUTION ARRAYS
+C                            THAN ISOSRFHR.  40 BY 40 BY 40 IS A
+C                            PRACTICAL MAXIMUM.
+C                        .   TRANSFORMATIONS CAN BE ACHIEVED BY
+C                            ADJUSTING SCALING STATEMENT FUNCTIONS IN
+C                            ISOSRF, SET3D AND TR32.
+C                        .   THE HIDDEN-LINE ALGORITHM IS NOT EXACT, SO
+C                            VISIBILITY ERRORS CAN OCCUR.
+C                        .   THREE-DIMENSIONAL PERSPECTIVE CHARACTER
+C                            LABELING OF ISOSRF IS POSSIBLE BY USING
+C                            THE UTILITY PWRZI.  FOR A DESCRIPTION OF
+C                            THE USAGE, SEE THE PWRZI DOCUMENTATION.
+C
+C ENTRY POINTS           ISOSRF, EZISOS, SET3D, TRN32I, ZEROSC,
+C                        STCNTR, DRCNTR, TR32, FRSTS, KURV1S, KURV2S,
+C                        FRSTC, FILLIN, DRAWI, ISOSRB, MMASK
+C
+C COMMON BLOCKS          ISOSR1, ISOSR2, ISOSR3, ISOSR4, ISOSR5,
+C                        ISOSR6, ISOSR7, ISOSR8, ISOSR9, TEMPR,
+C                        PWRZ1I
+C
+C REQUIRED LIBRARY       THE ERPRT77 PACKAGE AND THE SPPS.
+C ROUTINES
+C
+C I/O                    PLOTS SURFACE
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN 77
+C
+C HISTORY                DEVELOPED FOR USERS OF ISOSRFHR WITH SMALLER
+C                        ARRAYS.
+C
+C ALGORITHM              CUTS THROUGH THE THREE-DIMENSIONAL ARRAY ARE
+C                        CONTOURED WITH A SMOOTHING CONTOURER WHICH ALSO
+C                        MARKS A MODEL OF THE PLOTTING PLANE.  INTERIORS
+C                        OF BOUNDARIES ARE FILLED IN AND THE RESULT IS
+C                        .OR.ED INTO ANOTHER MODEL OF THE PLOTTING PLANE
+C                        WHICH IS USED TO TEST SUBSEQUENT CONTOUR LINES
+C                        FOR VISIBILITY.
+C
+C TIMING                 VARIES WIDELY WITH SIZE OF T AND THE VOLUME OF
+C                        THE SPACE ENCLOSED BY THE SURFACE DRAWN.
+C
+C  **NOTE**                  SPACE REQUIREMENTS CAN BE REDUCED BY
+C                            CHANGING THE SIZE OF THE ARRAYS ISCR, ISCA
+C                            (FOUND IN COMMON ISOSR2), MASK(FOUND IN
+C                            COMMON ISOSR5) AND THE VARIABLE NBPW
+C                            (COMMON ISOSR5).
+C                            ISCR AND ISCA NEED 128X128 BITS.  SO ON A
+C                            64 BIT MACHINE ISCR, ISCA CAN BE
+C                            DIMENSIONED TO (2,128). NBPW SET IN
+C                            SUBROUTINE MMASK SHOULD CONTAIN THE
+C                            NUMBER OF BITS PER WORD YOU WISH TO
+C                            UTILIZE.
+C                            THE DIMENSION OF MASK AND NMASK SHOULD
+C                            EQUAL THE VALUE OF NBPW.
+C                            LS SHOULD BE SET TO THE FIRST DIMENSION
+C                            OF ISCA AND ISCR.
+C
+C               EXAMPLES:
+C                            ON A 60 BIT MACHINE:
+C                                 DIMENSION ISCA(4,128), ISCR(4,128)
+C                                 DIMENSION MASK(32)
+C                                 NBPW = 32
+C                            ON A 64 BIT MACHINE:
+C                                 DIMENSION ISCA(2,128), ISCR(2,128)
+C                                 DIMENSION MASK(64)
+C                                 NBPW = 64
+C
+C INTERNAL PARAMETERS    NAME  DEFAULT           FUNCTION
+C                        ----  -------           --------
+C                        IREF     1     FLAG TO CONTROL DRAWING OF AXES.
+C                                       .IREF=NONZERO   DRAW AXES.
+C                                       .IREF=ZERO      DO NOT DRAW AXES.
+C
+C
+      SAVE
+      DIMENSION       T(LU,LV,MW),EYE(3)     ,SLAB(MUVWP2,MUVWP2)
+C
+      COMMON /ISOSR1/ ISLBT      ,U          ,V          ,W
+      COMMON /ISOSR2/ LX         ,NX         ,NY         ,ISCR(8,128),
+     1                ISCA(8,128)
+      COMMON /ISOSR3/ ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0
+      COMMON /ISOSR4/ RX         ,RY
+      COMMON /ISOSR5/ NBPW       ,MASK(16)   ,GENDON
+      COMMON /ISOSR6/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(500)    ,NR
+      COMMON /ISOSR7/ IENTRY     ,IONES
+      COMMON /ISOSR9/ BIG        ,IXBIT
+C
+      LOGICAL         GENDON
+      DATA IREF/1/
+C
+      AVE(A,B) = (A+B)*.5
+C
+C A.S.F. FOR SCALING
+C
+      SU(UTEMP) = UTEMP
+      SV(VTEMP) = VTEMP
+      SW(WTEMP) = WTEMP
+C
+C +NOAO - Blockdata ISOSRB rewritten as run time initialization
+C     EXTERNAL ISOSRB
+      call isosrb
+C -NOAO
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('NSSL','ISOSRF','ISOSRF','VERSION 12')
+      NERR = 0
+C
+C 3-SPACE  U,V,W,IU,IV,IW,ETC
+C 2-SPACE  X,Y,IX,IY,ETC
+C
+C  INITIALIZE MASKS
+C
+      IF (.NOT.GENDON) CALL MMASK
+C
+C  SET SHIFT VALUE FOR X,Y PACKING
+C
+C  IF YOUR MACHINE HAS MORE THAN 16 BITS PER WORD THIS CHECK MAY BE
+C  MODIFIED
+C
+      IF (LU .LE. 256) GO TO  10
+      NERR = NERR + 1
+      CALL SETER('DIMENSION OF CUBE EXCEEDS 256',NERR,2)
+      RETURN
+   10 DO  20 J=1,30
+         IF (LU .LE. 2**(J-1)) GO TO  30
+   20 CONTINUE
+   30 IXBIT = J
+      NU = MU
+      NUP2 = NU+2
+      NV = MV
+      NVP2 = NV+2
+      NW = MW
+      NWP2 = NW+2
+      FNU = NU
+      FNV = NV
+      FNW = NW
+      SU1 = SU(1.)
+      SV1 = SV(1.)
+      SW1 = SW(1.)
+      SUNU = SU(FNU)
+      SVNV = SV(FNV)
+      SWNW = SW(FNW)
+      AVEU = AVE(SU1,SUNU)
+      AVEV = AVE(SV1,SVNV)
+      AVEW = AVE(SW1,SWNW)
+      EYEU = EYE(1)
+      EYEV = EYE(2)
+      EYEW = EYE(3)
+      NUVWP2 = MUVWP2
+      TVAL = TISO
+      NFLAG = IABS(IFLAG)
+      IF (NFLAG.EQ.0 .OR. NFLAG.GE.8) NFLAG = 7
+C
+C SET UP SCALING
+C
+      FACT = -ISIGN(1,IFLAG)
+      CALL SET3D (EYE,1.,FNU,1.,FNV,1.,FNW)
+C
+C BOUND LOWER AND LEFT EDGE OF SLAB
+C
+      EDGE = SIGN(BIG,FACT)
+      DO  40 IUVW=1,NUVWP2
+         SLAB(IUVW,1) = EDGE
+         SLAB(1,IUVW) = EDGE
+   40 CONTINUE
+C
+C SLICES PERPENDICULAR TO U. THAT IS, V W SLICES. T OF CONSTANT U.
+C
+      IF (NFLAG .LT. 4) GO TO 100
+      CALL ZEROSC
+      ISLBT = -1
+C
+C BOUND UPPER AND RIGHT EDGE OF SLAB.
+C
+      DO  50 IV=2,NVP2
+         SLAB(IV,NWP2) = EDGE
+   50 CONTINUE
+      DO  60 IW=2,NWP2
+         SLAB(NVP2,IW) = EDGE
+   60 CONTINUE
+C
+C GO THRU 3-D ARRAY IN U DIRECTION.  IUEW=IU EITHER WAY.
+C PICK IU BASED ON EYEU.
+C
+      DO  90 IUEW=1,NU
+         IU = IUEW
+         IF (EYEU .GT. AVEU) IU = NU+1-IUEW
+         U = IU
+C
+C LOAD THIS SLICE OF T INTO SLAB.
+C
+         DO  80 IV=1,NV
+            DO  70 IW=1,NW
+               SLAB(IV+1,IW+1) = T(IU,IV,IW)
+   70       CONTINUE
+   80    CONTINUE
+C
+C CONTOUR THIS SLAB.
+C
+         CALL STCNTR (SLAB,NUVWP2,NVP2,NWP2,TVAL)
+C
+C CONSTRUCT VISIBILITY ARRAY.
+C
+         CALL FILLIN
+   90 CONTINUE
+C
+C SLICES PERPENDICULAR TO V. U W SLICES. T OF CONSTANT V.
+C
+  100 IF (MOD(NFLAG/2,2) .EQ. 0) GO TO 160
+      CALL ZEROSC
+      ISLBT = 0
+C
+C BOUND UPPER AND RIGHT EDGE OF SLAB.
+C
+      DO 110 IU=2,NUP2
+         SLAB(IU,NWP2) = EDGE
+  110 CONTINUE
+      DO 120 IW=2,NWP2
+         SLAB(NUP2,IW) = EDGE
+  120 CONTINUE
+C
+C GO THRU T IN V DIRECTION.  IVEW=IV EITHER WAY.
+C
+      DO 150 IVEW=1,NV
+         IV = IVEW
+         IF (EYEV .GT. AVEV) IV = NV+1-IVEW
+         V = IV
+C
+C LOAD THIS SLICE OF T INTO SLAB.
+C
+         DO 140 IU=1,NU
+            DO 130 IW=1,NW
+               SLAB(IU+1,IW+1) = T(IU,IV,IW)
+  130       CONTINUE
+  140    CONTINUE
+C
+C CONTOUR THIS SLAB.
+C
+         CALL STCNTR (SLAB,NUVWP2,NUP2,NWP2,TVAL)
+C
+C CONSTRUCT VISIBILITY ARRAY.
+C
+         CALL FILLIN
+  150 CONTINUE
+C
+C SLICES PERPENDICULAR TO W. U V SLICES. T OF CONSTANT W.
+C
+  160 IF (MOD(NFLAG,2) .EQ. 0) GO TO 220
+      CALL ZEROSC
+C
+      ISLBT = 1
+C
+C BOUND UPPER AND RIGHT EDGE OF SLAB.
+C
+      DO 170 IU=2,NUP2
+         SLAB(IU,NVP2) = EDGE
+  170 CONTINUE
+      DO 180 IV=2,NVP2
+         SLAB(NUP2,IV) = EDGE
+  180 CONTINUE
+C
+C GO THRU T IN W DIRECTION.
+C
+      DO 210 IWEW=1,NW
+         IW = IWEW
+         IF (EYEW .GT. AVEW) IW = NW+1-IWEW
+         W = IW
+C
+C LOAD THIS SLICE OF T INTO SLAB.
+C
+         DO 200 IU=1,NU
+            DO 190 IV=1,NV
+               SLAB(IU+1,IV+1) = T(IU,IV,IW)
+  190       CONTINUE
+  200    CONTINUE
+C
+C CONTOUR THIS SLAB.
+C
+         CALL STCNTR (SLAB,NUVWP2,NUP2,NVP2,TVAL)
+C
+C CONSTRUCT VISIBILITY ARRAY.
+C
+         CALL FILLIN
+  210 CONTINUE
+C
+C DRAW REFERENCE PLANE EDGES AND W AXIS.
+C
+  220 IF (IREF .EQ. 0) RETURN
+      CALL TRN32I (SU1,SV1,SW1,XT,YT,DUM,2)
+      IF (EYEV .LT. SV1) GO TO 240
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 230 IU=2,NU
+         CALL TRN32I (SU(FLOAT(IU)),SV1,SW1,XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  230 CONTINUE
+      GO TO 250
+  240 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SUNU,SV1,SW1,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+  250 IF (EYEU .GT. SUNU) GO TO 270
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 260 IV=2,NV
+         CALL TRN32I (SUNU,SV(FLOAT(IV)),SW1,XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  260 CONTINUE
+      GO TO 280
+  270 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SUNU,SVNV,SW1,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+  280 IF (EYEV .GT. SVNV) GO TO 300
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 290 IUOW=2,NU
+         CALL TRN32I (SU(FLOAT(NU-IUOW+1)),SVNV,SW1,XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  290 CONTINUE
+      GO TO 310
+  300 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SU1,SVNV,SW1,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+  310 IF (EYEU .LT. SU1) GO TO 330
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 320 IVOW=2,NV
+         CALL TRN32I (SU1,SV(FLOAT(NV-IVOW+1)),SW1,XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  320 CONTINUE
+      GO TO 340
+  330 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SU1,SV1,SW1,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+  340 IF (EYEU.LE.SU1 .OR. EYEV.LE.SV1) GO TO 360
+      CALL FRSTC (IFIX(XT),IFIX(YT),1)
+      DO 350 IW=2,NW
+         CALL TRN32I (SU1,SV1,SW(FLOAT(IW)),XT,YT,DUM,2)
+         CALL FRSTC (IFIX(XT),IFIX(YT),2)
+  350 CONTINUE
+C +NOAO - Plotit buffer needs to be flushed before returning.
+      call plotit (0, 0, 2)
+C -NOAO
+      RETURN
+  360 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      CALL TRN32I (SU1,SV1,SWNW,XT,YT,DUM,2)
+      CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+C +NOAO - Plotit buffer needs to be flushed before returning.
+      call plotit (0, 0, 2)
+C -NOAO
+      RETURN
+      END
+      SUBROUTINE EZISOS (T,MU,MV,MW,EYE,SLAB,TISO)
+C
+      SAVE
+      DIMENSION       T(MU,MV,MW),EYE(3)
+C
+        DATA ANG,PI/.35,3.141592/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('NSSL','ISOSRF','EZISOS','VERSION 12')
+C
+C ARGUMENTS DESCRIBED IN ISOSRF
+C
+C PICK TYPES OF LINES TO DRAW
+C
+      NU = MU
+      NV = MV
+      NW = MW
+      TVAL = TISO
+      MAX = MAX0(NU,NV,NW)+2
+      ATU = NU/2
+      ATV = NV/2
+      ATW = NW/2
+      EYEU = EYE(1)
+      EYEV = EYE(2)
+      EYEW = EYE(3)
+      RU = EYEU-ATU
+      RV = EYEV-ATV
+      RW = EYEW-ATW
+      RU2 = RU*RU
+      RV2 = RV*RV
+      RW2 = RW*RW
+      DU = SQRT(RV2+RW2)
+      DV = SQRT(RU2+RW2)
+      DW = SQRT(RU2+RV2)
+      DR = 1./SQRT(RU2+RV2+RW2)
+C
+C  COMPUTE THE ARCCOSINE
+C
+      TU = DU*DR
+      ANGU = ATAN(ABS(SQRT(1.-TU*TU)/TU))
+      IF (TU .LE. 0.) ANGU = PI-ANGU
+      TV = DV*DR
+      ANGV = ATAN(ABS(SQRT(1.-TV*TV)/TV))
+      IF (TV .LE. 0.) ANGV = PI-ANGV
+      TW = DW*DR
+      ANGW = ATAN(ABS(SQRT(1.-TW*TW)/TW))
+      IF (TW .LE. 0.) ANGW = PI-ANGW
+C
+C BREAK POINT IS ABOUT 20 DEGREES OR ABOUT .35 RADIANS
+C
+      IFLAG = 0
+      IF (ANGU .GT. ANG) IFLAG = IFLAG+4
+      IF (ANGV .GT. ANG) IFLAG = IFLAG+2
+      IF (ANGW .GT. ANG) IFLAG = IFLAG+1
+C
+C FIND SIGN OF IFLAG
+C
+      ICNT = 0
+      IF (ABS(RU) .LE. ATU) GO TO  30
+      IU = 1
+      IF (EYEU .GT. ATU) IU = NU
+      DO  20 IW=1,NW
+         DO  10 IV=1,NV
+            IF (T(IU,IV,IW) .GT. TVAL) ICNT = ICNT-2
+            ICNT = ICNT+1
+   10    CONTINUE
+   20 CONTINUE
+   30 IF (ABS(RV) .LE. ATV) GO TO  60
+      IV = 1
+      IF (EYEV .GT. ATV) IV = NV
+      DO  50 IW=1,NW
+         DO  40 IU=1,NU
+            IF (T(IU,IV,IW) .GT. TVAL) ICNT = ICNT-2
+            ICNT = ICNT+1
+   40    CONTINUE
+   50 CONTINUE
+   60 IF (ABS(RW) .LE. ATW) GO TO  90
+      IW = 1
+      IF (EYEW .GT. ATW) IW = NW
+      DO  80 IV=1,NV
+         DO  70 IU=1,NU
+            IF (T(IU,IV,IW) .GT. TVAL) ICNT = ICNT-2
+            ICNT = ICNT+1
+   70    CONTINUE
+   80 CONTINUE
+   90 IFLAG = ISIGN(IFLAG,ICNT)
+      CALL ISOSRF (T,NU,NU,NV,NV,NW,EYE,MAX,SLAB,TVAL,IFLAG)
+C +NOAO - Call to frame is suppressed.
+C     CALL FRAME
+C -NOAO
+      RETURN
+      END
+      SUBROUTINE SET3D (EYE,ULO,UHI,VLO,VHI,WLO,WHI)
+      SAVE
+      COMMON /TEMPR/  RZERO
+C
+      DIMENSION       EYE(3)
+C
+      COMMON /ISOSR3/ ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0
+      COMMON /PWRZ1I/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+C
+C
+      AVE(A,B) = (A+B)*.5
+C
+C A.S.F. FOR SCALING
+C
+      SU(UTEMP) = UTEMP
+      SV(VTEMP) = VTEMP
+      SW(WTEMP) = WTEMP
+C
+C CONSTANTS FOR PWRZ
+C
+      UUMIN = ULO
+      UUMAX = UHI
+      VVMIN = VLO
+      VVMAX = VHI
+      WWMIN = WLO
+      WWMAX = WHI
+      EYEU = EYE(1)
+      EYEV = EYE(2)
+      EYEW = EYE(3)
+C
+C FIND CORNERS IN 2-SPACE FOR 3-SPACE BOX CONTAINING OBJECT
+C
+      ISCALE = 0
+      ATU = AVE(SU(UUMIN),SU(UUMAX))
+      ATV = AVE(SV(VVMIN),SV(VVMAX))
+      ATW = AVE(SW(WWMIN),SW(WWMAX))
+      BIGD = 0.
+      IF (RZERO .LE. 0.) GO TO  10
+C
+C RELETIVE SIZE FEATURE IN USE.
+C GENERATE EYE POSITION THAT MAKES BOX HAVE MAXIMUM PROJECTED SIZE.
+C
+      ALPHA = -(VVMIN-ATV)/(UUMIN-ATU)
+      VVEYE = -RZERO/SQRT(1.+ALPHA*ALPHA)
+      UUEYE = VVEYE*ALPHA
+      VVEYE = VVEYE+ATV
+      UUEYE = UUEYE+ATU
+      WWEYE = ATW
+      CALL TRN32I (ATU,ATV,ATW,UUEYE,VVEYE,WWEYE,1)
+      CALL TRN32I (UUMIN,VVMIN,ATW,XMIN,DUMM,DUMM,2)
+      CALL TRN32I (UUMAX,VVMIN,WWMIN,DUMM,YMIN,DUMM,2)
+      CALL TRN32I (UUMAX,VVMAX,ATW,XMAX,DUMM,DUMM,2)
+      CALL TRN32I (UUMAX,VVMIN,WWMAX,DUMM,YMAX,DUMM,2)
+      BIGD = SQRT((UUMAX-UUMIN)**2+(VVMAX-VVMIN)**2+(WWMAX-WWMIN)**2)*.5
+      R0 = RZERO
+      GO TO  20
+   10 CALL TRN32I (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
+      CALL TRN32I (SU(UUMIN),SV(VVMIN),SW(WWMIN),X1,Y1,DUM,2)
+      CALL TRN32I (SU(UUMIN),SV(VVMIN),SW(WWMAX),X2,Y2,DUM,2)
+      CALL TRN32I (SU(UUMIN),SV(VVMAX),SW(WWMIN),X3,Y3,DUM,2)
+      CALL TRN32I (SU(UUMIN),SV(VVMAX),SW(WWMAX),X4,Y4,DUM,2)
+      CALL TRN32I (SU(UUMAX),SV(VVMIN),SW(WWMIN),X5,Y5,DUM,2)
+      CALL TRN32I (SU(UUMAX),SV(VVMIN),SW(WWMAX),X6,Y6,DUM,2)
+      CALL TRN32I (SU(UUMAX),SV(VVMAX),SW(WWMIN),X7,Y7,DUM,2)
+      CALL TRN32I (SU(UUMAX),SV(VVMAX),SW(WWMAX),X8,Y8,DUM,2)
+      XMIN = AMIN1(X1,X2,X3,X4,X5,X6,X7,X8)
+      XMAX = AMAX1(X1,X2,X3,X4,X5,X6,X7,X8)
+      YMIN = AMIN1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
+      YMAX = AMAX1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
+C
+C ADD RIGHT AMOUNT TO KEEP PICTURE SQUARE
+C
+   20 WIDTH = XMAX-XMIN
+      HIGHT = YMAX-YMIN
+      DIF = .5*(WIDTH-HIGHT)
+      IF (DIF)  30, 50, 40
+   30 XMIN = XMIN+DIF
+      XMAX = XMAX-DIF
+      GO TO  50
+   40 YMIN = YMIN-DIF
+      YMAX = YMAX+DIF
+   50 ISCALE = 1
+      CALL TRN32I (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
+      RETURN
+      END
+      SUBROUTINE TRN32I (U,V,W,XT,YT,ZT,IENT)
+C
+C THIS ROUTINE IMPLEMENTS THE 3-SPACE TO 2-SPACE TRANSFOR-
+C MATION BY KUBER, SZABO AND GIULIERI, THE PERSPECTIVE
+C REPRESENTATION OF FUNCTIONS OF TWO VARIABLES. J. ACM 15,
+C 2, 193-204,1968.
+C ARGUMENTS FOR SET
+C U,V,W    ARE THE 3-SPACE COORDINATES OF THE INTERSECTION
+C          OF THE LINE OF SIGHT AND THE IMAGE PLANE.  THIS
+C          POINT CAN BE THOUGHT OF AS THE POINT LOOKED AT.
+C XT,YT,ZT ARE THE 3-SPACE COORDINATES OF THE EYE POSITION.
+C
+C TRN32 ARGUMENTS
+C U,V,W    ARE THE 3-SPACE COORDINATES OF A POINT TO BE
+C          TRANSFORMED.
+C XT,YT    THE RESULTS OF THE 3-SPACE TO 2-SPACE TRANSFOR-
+C          MATION.  WHEN ISCALE=0, XT AND YT ANR IN THE SAME
+C          UNITS AS U,V, AND W.  WHEN ISCALE'0, XT AND YT
+C          ARE IN PLOTTER COORDINATES.
+C ZT       NOT USED.
+C
+      SAVE
+      COMMON /PWRZ1I/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+      COMMON /ISOSR3/ ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0
+C
+C RANGE OF PLOTTER COORDINATES
+C
+C
+C  WARNING
+C  IF PLOTTER MAXIMUM VALUE RANGES (IN X OR Y DIRECTION) FALL BELOW
+C  101, THEN CHANGES MUST BE MADE IN SUBROUTINE FRSTC. THE REQUIRED
+C  CHANGES ARE MARKED BY WARNING COMMENTS IN FRSTC.
+      DATA NLX,NBY,NRX,NTY/10,10,32760,32760/
+        DATA PI/3.1411592/
+C
+C STORE THE PARAMETERS OF THE SET CALL FOR USE
+C WITH THE TRANSLATE CALL
+C
+C DECIDE IF SET OR TRANSLATE CALL
+C
+      IF (IENT .NE. 1) GO TO  50
+      AU = U
+      AV = V
+      AW = W
+      EU = XT
+      EV = YT
+      EW = ZT
+C
+C
+C
+C
+C
+      DU = AU-EU
+      DV = AV-EV
+      DW = AW-EW
+      D = SQRT(DU*DU+DV*DV+DW*DW)
+      COSAL = DU/D
+      COSBE = DV/D
+      COSGA = DW/D
+C
+C  COMPUTE THE ARCCOSINE
+C
+      AL = ATAN(ABS(SQRT(1.-COSAL*COSAL)/COSAL))
+      IF (COSAL .LE. 0.) AL = PI-AL
+      BE = ATAN(ABS(SQRT(1.-COSBE*COSBE)/COSBE))
+      IF (COSBE .LE. 0.) BE = PI-BE
+      GA = ATAN(ABS(SQRT(1.-COSGA*COSGA)/COSGA))
+      IF (COSGA .LE. 0.) GA = PI-GA
+      SINGA = SIN(GA)
+C
+C THE 3-SPACE POINT LOOKED AT IS TRANSFORMED INTO (0,0) OF
+C THE 2-SPACE.  THE 3-SPACE W AXIS IS TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.  IF THE LINE OF SIGHT IS CLOSE TO PARALLEL
+C TO THE 3-SPACE W AXIS, THE 3-SPACE V AXIS IS CHOSEN (IN-
+C STEAD OF THE 3-SPACE W AXIS) TO BE TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.
+C
+      ASSIGN  90 TO JDONE
+      IF (ISCALE)  10, 30, 10
+   10 X0 = XMIN
+      Y0 = YMIN
+      X1 = NLX
+      Y1 = NBY
+      X2 = NRX-NLX
+      Y2 = NTY-NBY
+      X3 = X2/(XMAX-XMIN)
+      Y3 = Y2/(YMAX-YMIN)
+      X4 = NRX
+      Y4 = NTY
+      FACT = 1.
+      IF (BIGD .LE. 0.) GO TO  20
+      X0 = -BIGD
+      Y0 = -BIGD
+      X3 = X2/(2.*BIGD)
+      Y3 = Y2/(2.*BIGD)
+      FACT = R0/D
+   20 DELCRT = X2
+      ASSIGN  80 TO JDONE
+   30 IF (SINGA .LT. 0.0001) GO TO  40
+      R = 1./SINGA
+      ASSIGN  70 TO JUMP
+      RETURN
+   40 SINBE = SIN(BE)
+      R = 1./SINBE
+      ASSIGN  60 TO JUMP
+      RETURN
+C
+C********************  ENTRY TRN32  ************************
+C     ENTRY TRN32 (U,V,W,XT,YT,ZT)
+C
+   50 UU = U
+      VV = V
+      WW = W
+      Q = D/((UU-EU)*COSAL+(VV-EV)*COSBE+(WW-EW)*COSGA)
+      GO TO JUMP,( 60, 70)
+   60 UU = ((EW+Q*(WW-EW)-AW)*COSAL-(EU+Q*(UU-EU)-AU)*COSGA)*R
+      VV = (EV+Q*(VV-EV)-AV)*R
+      GO TO JDONE,( 80, 90)
+   70 UU = ((EU+Q*(UU-EU)-AU)*COSBE-(EV+Q*(VV-EV)-AV)*COSAL)*R
+      VV = (EW+Q*(WW-EW)-AW)*R
+      GO TO JDONE,( 80, 90)
+   80 XT = AMIN1(X4,AMAX1(X1,X1+X3*(FACT*UU-X0)))
+      YT = AMIN1(Y4,AMAX1(Y1,Y1+Y3*(FACT*VV-Y0)))
+      RETURN
+   90 XT = UU
+      YT = VV
+      RETURN
+      END
+      SUBROUTINE ZEROSC
+      SAVE
+C
+      COMMON /ISOSR2/ LX         ,NX         ,NY         ,ISCR(8,128),
+     1                ISCA(8,128)
+C
+C ZERO BOTH SCRENE MODELS.
+C
+      DO  20 I=1,LX
+         DO  10 J=1,NY
+            ISCR(I,J) = 0
+            ISCA(I,J) = 0
+   10    CONTINUE
+   20 CONTINUE
+      RETURN
+      END
+      SUBROUTINE STCNTR (Z,L,M,N,CONV)
+C
+      SAVE
+      DIMENSION       Z(L,N)
+C
+C THIS ROUTINE FINDS THE BEGINNINGS OF ALL CONTOUR LINES AT LEVEL CONV.
+C FIRST THE EDGES ARE SEARCHED FOR LINES INTERSECTING THE EDGE (OPEN
+C LINES) THEN THE INTERIOR IS SEARCHED FOR LINES WHICH DO NOT INTERSECT
+C THE EDGE (CLOSED LINES).  BEGINNINGS ARE STORED IN IR TO PREVENT RE-
+C TRACING OF LINES.  IF IR IS FILLED, THE SEARCH IS STOPPED FOR THIS
+C CONV.
+C
+      COMMON /ISOSR6/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(500)    ,NR
+      COMMON /ISOSR7/ IENTRY     ,IONES
+      COMMON /ISOSR9/ BIG        ,IXBIT
+C
+C  PACK X AND Y
+C
+      IPXY(I1,J1) = ISHIFT(I1,IXBIT)+J1
+C
+      IENTRY = 0
+      NP = 0
+      CV = CONV
+C
+C THE FOLLOWING CODE SHOULD BE RE-ENABLED IF THIS ROUTINE IS USED FOR
+C GENERAL CONTOURING
+C
+C     ISS=0
+C     DO 2 IP1=2,M
+C     I=IP1-1
+C     IF(Z(I,1).GE.CV.OR.Z(IP1,1).LT.CV) GO TO 1
+C     IX=IP1
+C     IY=1
+C     IDX=-1
+C     IDY=0
+C     IS=1
+C     CALL DRLINE(Z,L,M,N)
+C   1 IF(Z(IP1,N).GE.CV.OR.Z(I,N).LT.CV) GO TO 2
+C     IX=I
+C     IY=N
+C     IDX=1
+C     IDY=0
+C     IS=5
+C     CALL DRLINE(Z,L,M,N)
+C   2 CONTINUE
+C     DO 4 JP1=2,N
+C     J=JP1-1
+C     IF(Z(M,J).GE.CV.OR.Z(M,JP1).LT.CV) GO TO 3
+C     IX=M
+C     IY=JP1
+C     IDX=0
+C     IDY=-1
+C     IS=7
+C     CALL DRLINE(Z,L,M,N)
+C   3 IF(Z(1,JP1).GE.CV.OR.Z(1,J).LT.CV) GO TO 4
+C     IX=1
+C     IY=J
+C     IDX=0
+C     IDY=1
+C     IS=3
+C     CALL DRLINE(Z,L,M,N)
+C   4 CONTINUE
+C
+      ISS = 1
+      DO  40 JP1=3,N
+         J = JP1-1
+         DO  30 IP1=2,M
+            I = IP1-1
+            IF (Z(I,J).GE.CV .OR. Z(IP1,J).LT.CV) GO TO  30
+            IXY = IPXY(IP1,J)
+            IF (NP .EQ. 0) GO TO  20
+            DO  10 K=1,NP
+               IF (IR(K) .EQ. IXY) GO TO  30
+   10       CONTINUE
+   20       NP = NP+1
+            IF (NP .GT. NR) RETURN
+            IR(NP) = IXY
+            IX = IP1
+            IY = J
+            IDX = -1
+            IDY = 0
+            IS = 1
+            CALL DRCNTR (Z,L,M,N)
+   30    CONTINUE
+   40 CONTINUE
+      RETURN
+      END
+      SUBROUTINE DRCNTR (Z,L,MM,NN)
+      SAVE
+C
+      DIMENSION       Z(L,NN)
+C
+C THIS ROUTINE TRACES A CONTOUR LINE WHEN GIVEN THE BEGINNING BY STLINE.
+C TRANSFORMATIONS CAN BE ADDED BY DELETING THE STATEMENT FUNCTIONS FOR
+C FX AND FY IN DRLINE AND MINMAX AND ADDING EXTERNAL FUNCTIONS.
+C X=1. AT Z(1,J), X=FLOAT(M) AT Z(M,J). X TAKES ON NON-INTEGER VALUES.
+C Y=1. AT Z(I,1), Y=FLOAT(N) AT Z(I,N). Y TAKES ON NON-INTEGER VALUES.
+C
+      COMMON /ISOSR6/ IX         ,IY         ,IDX        ,IDY        ,
+     1                IS         ,ISS        ,NP         ,CV         ,
+     2                INX(8)     ,INY(8)     ,IR(500)    ,NR
+      COMMON /ISOSR9/ BIG        ,IXBIT
+C
+      LOGICAL         IPEN       ,IPENO
+C
+      DATA IOFFP,SPVAL/0,0./
+      DATA IPEN,IPENO/.TRUE.,.TRUE./
+C
+C  PACK X AND Y
+C
+      IPXY(I1,J1) = ISHIFT(I1,IXBIT)+J1
+      FX(X1,Y1) = X1
+      FY(X1,Y1) = Y1
+      C(P11,P21) = (P11-CV)/(P11-P21)
+C
+      M = MM
+      N = NN
+      IF (IOFFP .EQ. 0) GO TO  10
+      ASSIGN 100 TO JUMP1
+      ASSIGN 150 TO JUMP2
+      GO TO  20
+   10 ASSIGN 120 TO JUMP1
+      ASSIGN 160 TO JUMP2
+   20 IX0 = IX
+      IY0 = IY
+      IS0 = IS
+      IF (IOFFP .EQ. 0) GO TO  30
+      IX2 = IX+INX(IS)
+      IY2 = IY+INY(IS)
+      IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL
+      IPENO = IPEN
+   30 IF (IDX .EQ. 0) GO TO  40
+      Y = IY
+      ISUB = IX+IDX
+      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
+      GO TO  50
+   40 X = IX
+      ISUB = IY+IDY
+      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
+   50 IF (IPEN) CALL FRSTS (FX(X,Y),FY(X,Y),1)
+   60 IS = IS+1
+      IF (IS .GT. 8) IS = IS-8
+      IDX = INX(IS)
+      IDY = INY(IS)
+      IX2 = IX+IDX
+      IY2 = IY+IDY
+      IF (ISS .NE. 0) GO TO  70
+      IF (IX2.GT.M .OR. IY2.GT.N .OR. IX2.LT.1 .OR. IY2.LT.1) GO TO 190
+   70 IF (CV-Z(IX2,IY2))  80, 80, 90
+   80 IS = IS+4
+      IX = IX2
+      IY = IY2
+      GO TO  60
+   90 IF (IS/2*2 .EQ. IS) GO TO  60
+      GO TO JUMP1,(100,120)
+  100 ISBIG = IS+(8-IS)/6*8
+      IX3 = IX+INX(ISBIG-1)
+      IY3 = IY+INY(ISBIG-1)
+      IX4 = IX+INX(ISBIG-2)
+      IY4 = IY+INY(ISBIG-2)
+      IPENO = IPEN
+      IF (ISS .NE. 0) GO TO 110
+      IF (IX3.GT.M .OR. IY3.GT.N .OR. IX3.LT.1 .OR. IY3.LT.1) GO TO 190
+      IF (IX4.GT.M .OR. IY4.GT.N .OR. IX4.LT.1 .OR. IY4.LT.1) GO TO 190
+  110 IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL .AND.
+     1       Z(IX3,IY3).NE.SPVAL .AND. Z(IX4,IY4).NE.SPVAL
+  120 IF (IDX .EQ. 0) GO TO 130
+      Y = IY
+      ISUB = IX+IDX
+      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
+      GO TO 140
+  130 X = IX
+      ISUB = IY+IDY
+      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
+  140 GO TO JUMP2,(150,160)
+  150 IF (.NOT.IPEN) GO TO 170
+      IF (IPENO) GO TO 160
+C
+C END OF LINE SEGMENT
+C
+      CALL FRSTS (D1,D2,3)
+      CALL FRSTS (FX(XOLD,YOLD),FY(XOLD,YOLD),1)
+C
+C CONTINUE LINE SEGMENT
+C
+  160 CALL FRSTS (FX(X,Y),FY(X,Y),2)
+  170 XOLD = X
+      YOLD = Y
+      IF (IS .NE. 1) GO TO 180
+      NP = NP+1
+      IF (NP .GT. NR) GO TO 190
+      IR(NP) = IPXY(IX,IY)
+  180 IF (ISS .EQ. 0) GO TO  60
+      IF (IX.NE.IX0 .OR. IY.NE.IY0 .OR. IS.NE.IS0) GO TO  60
+C
+C END OF LINE
+C
+  190 CALL FRSTS (D1,D2,3)
+      RETURN
+      END
+      SUBROUTINE TR32 (X,Y,MX,MY)
+      SAVE
+C
+      COMMON /ISOSR1/ ISLBT      ,U          ,V          ,W
+C
+C A.S.F. FOR SCALING
+C
+      SU(UTEMP) = UTEMP
+      SV(VTEMP) = VTEMP
+      SW(WTEMP) = WTEMP
+C
+      XX = X
+      YY = Y
+      IF (ISLBT)  10, 20, 30
+   10 CALL TRN32I (SU(U),SV(XX-1.),SW(YY-1.),XT,YT,DUM,2)
+      GO TO  40
+   20 CALL TRN32I (SU(XX-1.),SV(V),SW(YY-1.),XT,YT,DUM,2)
+      GO TO  40
+   30 CALL TRN32I (SU(XX-1.),SV(YY-1.),SW(W),XT,YT,DUM,2)
+   40 MX = XT
+      MY = YT
+      RETURN
+      END
+      SUBROUTINE FRSTS (XX,YY,IENT)
+C
+C THIS IS A SPECIAL VERSION OF THE SMOOTHING DASHED LINE PACKAGE.  LINES
+C ARE SMOOTHED IN THE SAME WAY, BUT NO SOFTFARE DASHED LINES ARE USED.
+C CONDITIONAL PLOTTING ROUTINES ARE CALL WHICH DETERMINE THE VISIBILITY
+C OF A LINE SEGMENT BEFORE PLOTTING.
+C
+      SAVE
+      DIMENSION       XSAVE(70)  ,YSAVE(70)  ,XP(70)     ,YP(70)     ,
+     1                TEMP(70)
+C
+      COMMON /ISOSR7/ IENTRY     ,IONES
+C
+      DATA NP/150/
+      DATA L1/70/
+      DATA TENSN/2.5/
+      DATA PI/3.14159265358/
+      DATA SMALL/128./
+C
+      AVE(A,B) = .5*(A+B)
+C
+C  DECIDE IF FRSTS,VECTS,LASTS CALL
+C
+      GO TO ( 10, 20, 40),IENT
+   10 DEG = 180./PI
+      X = XX
+      Y = YY
+      LASTFL = 0
+      SSLP1 = 0.0
+      SSLPN = 0.0
+      XSVN = 0.0
+      YSVN = 0.0
+C
+C INITIALIZE THE POINT AND SEGMENT COUNTER
+C N COUNTS THE NUMBER OF POINTS/SEGMENT
+C
+      N = 0
+C
+C NSEG = 0       FIRST SEGMENT
+C NSEG = 1       MORE THAN ONE SEGMENT
+C
+      NSEG = 0
+      CALL TR32 (X,Y,MX,MY)
+C
+C SAVE THE X,Y COORDINATES OF THE FIRST POINT
+C XSV1           CONTAINS THE X COORDINATE OF THE FIRST POINT
+C                OF A LINE
+C YSV1           CONTAINS THE Y COORDINATE OF THE FIRST POINT
+C                OF A LINE
+C
+      XSV1 = MX
+      YSV1 = MY
+      GO TO  30
+C
+C ************************* ENTRY VECTS *************************
+C     ENTRY VECTS (XX,YY)
+C
+   20 X = XX
+      Y = YY
+C
+C VECTS          SAVES THE X,Y COORDINATES OF THE ACCEPTED
+C                POINTS ON A LINE SEGMENT
+C
+      CALL TR32 (X,Y,MX,MY)
+C
+CIF THE NEW POINT IS TOO CLOSE TO THE PREVIOUS POINT, IGNORE IT
+C
+      IF (ABS(FLOAT(IFIX(XSVN)-MX))+ABS(FLOAT(IFIX(YSVN)-MY)) .LT.
+     1    SMALL) RETURN
+      IFLAG = 0
+   30 N = N+1
+C
+C SAVE THE X,Y COORDINATES OF EACH POINT OF THE SEGMENT
+C XSAVE          THE ARRAY OF X COORDINATES OF LINE SEGMENT
+C YSAVE          THE ARRAY OF Y COORDINATES OF LINE SEGMENT
+C
+      XSAVE(N) = MX
+      YSAVE(N) = MY
+      XSVN = XSAVE(N)
+      YSVN = YSAVE(N)
+      IF (N .GE. L1-1) GO TO  50
+      RETURN
+C
+C ************************* ENTRY LASTS *************************
+C     ENTRY LASTS
+C
+   40 LASTFL = 1
+C
+C LASTS          CHECKS FOR PERIODIC LINES AND SETS UP
+C                  THE CALLS TO KURV1S AND KURV2S
+C
+C IFLAG = 0      OK TO CALL LASTS DIRECTLY
+C IFLAG = 1      LASTS WAS JUST CALLED FROM BY VECTS
+C                IGNORE CALL TO LASTS
+C
+      IF (IFLAG .EQ. 1) RETURN
+C
+C COMPARE THE LAST POINT OF SEGMENT WITH FIRST POINT OF LINE
+C
+   50 IFLAG = 1
+C
+C IPRD = 0       PERIODIC LINE
+C IPRD = 1       NON-PERIODIC LINE
+C
+      IPRD = 1
+      IF (ABS(XSV1-XSVN)+ABS(YSV1-YSVN) .LT. SMALL) IPRD = 0
+C
+C TAKE CARE OF THE CASE OF ONLY TWO DISTINCT P0INTS ON A LINE
+C
+      IF (NSEG .GE. 1) GO TO  70
+      IF (N-2) 160,150, 60
+   60 IF (N .GE. 4) GO TO  70
+      DX = XSAVE(2)-XSAVE(1)
+      DY = YSAVE(2)-YSAVE(1)
+      SLOPE = ATAN2(DY,DX)*DEG+90.
+      IF (SLOPE .GE. 360.) SLOPE = SLOPE-360.
+      IF (SLOPE .LE. 0.) SLOPE = SLOPE+360.
+      SLP1 = SLOPE
+      SLPN = SLOPE
+      ISLPSW = 0
+      SIGMA = TENSN
+      GO TO 110
+   70 SIGMA = TENSN
+      IF (IPRD .GE. 1) GO TO  90
+      IF (NSEG .GE. 1) GO TO  80
+C
+C SET UP FLAGS FOR A  1  SEGMENT, PERIODIC LINE
+C
+      ISLPSW = 4
+      XSAVE(N) = XSV1
+      YSAVE(N) = YSV1
+      GO TO 110
+C
+C SET UP FLAGS FOR AN N-SEGMENT, PERIODIC LINE
+C
+   80 SLP1 = SSLPN
+      SLPN = SSLP1
+      ISLPSW = 0
+      GO TO 110
+   90 IF (NSEG .GE. 1) GO TO 100
+C
+C SET UP FLAGS FOR THE 1ST SEGMENT OF A NON-PERIODIC LINE
+C
+      ISLPSW = 3
+      GO TO 110
+C
+C SET UP FLAGS FOR THE NTH SEGMENT OF A NON-PERIODIC LINE
+C
+  100 SLP1 = SSLPN
+      ISLPSW = 1
+C
+C CALL THE SMOOTHING ROUTINES
+C
+  110 CALL KURV1S (N,XSAVE,YSAVE,SLP1,SLPN,XP,YP,TEMP,S,SIGMA,ISLPSW)
+      IF (IPRD.EQ.0 .AND. NSEG.EQ.0 .AND. S.LT.70.) GO TO 170
+      IENTRY = 1
+C
+C DETERMINE THE NUMBER OF POINTS TO INTERPOLATE FOR EACH SEGMENT
+C
+      IF (NSEG.GE.1 .AND. N.LT.L1-1) GO TO 120
+      NPRIME = FLOAT(NP)-(S*FLOAT(NP))/(2.*32768.)
+      IF (S .GE. 32768.) NPRIME = .5*FLOAT(NP)
+      NPL = FLOAT(NPRIME)*S/32768.
+      IF (NPL .LT. 2) NPL = 2
+  120 DT = 1./FLOAT(NPL)
+      IF (NSEG .LE. 0) CALL FRSTC (IFIX(XSAVE(1)),IFIX(YSAVE(1)),1)
+      T = 0.0
+      NSLPSW = 1
+      IF (NSEG .GE. 1) NSLPSW = 0
+      NSEG = 1
+      CALL KURV2S (T,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C SAVE SLOPE AT THE FIRST POINT OF THE LINE
+C
+      IF (NSLPSW .GE. 1) SSLP1 = SLP
+      NSLPSW = 0
+      XSOLD = XSAVE(1)
+      YSOLD = YSAVE(1)
+      DO 130 I=1,NPL
+         T = T+DT
+         TT = -T
+         IF (I .EQ. NPL) NSLPSW = 1
+         CALL KURV2S (TT,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C SAVE THE LAST SLOPE OF THIS LINE SEGMENT
+C
+         IF (NSLPSW .GE. 1) SSLPN = SLP
+C
+C DRAW EACH PART OF THE LINE SEGMENT
+C
+         CALL FRSTC (IFIX(AVE(XSOLD,XS)),IFIX(AVE(YSOLD,YS)),2)
+         CALL FRSTC (IFIX(XS),IFIX(YS),2)
+         XSOLD = XS
+         YSOLD = YS
+  130 CONTINUE
+      IF (IPRD .NE. 0) GO TO 140
+C
+C CONNECT THE LAST POINT WITH THE FIRST POINT OF A PERIODIC LINE
+C
+      CALL FRSTC (IFIX(AVE(XSOLD,XS)),IFIX(AVE(YSOLD,YS)),2)
+      CALL FRSTC (IFIX(XSV1),IFIX(YSV1),2)
+C
+C BEGIN THE NEXT LINE SEGMENT WITH THE LAST POINT OF THIS SEGMENT
+C
+  140 XSAVE(1) = XS
+      YSAVE(1) = YS
+      N = 1
+  150 CONTINUE
+  160 RETURN
+  170 N = 0
+      RETURN
+      END
+      SUBROUTINE FRSTC (MX,MY,IENT)
+      SAVE
+C
+      COMMON /ISOSR2/ LX         ,NX         ,NY         ,ISCR(8,128),
+     1                ISCA(8,128)
+      COMMON /ISOSR4/ RX         ,RY
+      COMMON /ISOSR5/ NBPW       ,MASK(16)   ,GENDON
+      LOGICAL         GENDON
+      COMMON /ISOSR8/ NMASK(16)  ,IXOLD      ,IYOLD      ,IBTOLD     ,
+     1                HBFLAG     ,IOSLSN     ,LRLX       ,IFSX       ,
+     2                IFSY       ,FIRST      ,IYDIR      ,IHX        ,
+     3                IHB        ,IHS        ,IHV        ,IVOLD      ,
+     4                IVAL       ,IHRX       ,YCHANG     ,ITPD       ,
+     5                IHF
+      LOGICAL         YCHANG     ,HBFLAG     ,FIRST      ,IHF
+C
+C
+C  DRAW LINE TO THE POINT MX,MY
+C
+C  ENTER THE POINT INTO THE CURRENT SCREEN, ISCR, IF THE POINT CONFORMS
+C  TO THE SHADING ALGORITHM.
+C  THE POINT IS NOT ENTERED WHEN;
+C  1. IT IS THE SAME POINT USED IN THE LAST CALL, RESOLUTION PROBLEM
+C  2. IT IS PART OF A HORIZONTAL LINE BUT NOT AN END POINT
+C  3.  THE ENTIRE CONTOUR RESTS ON A HORIZONTAL PLANE
+C
+C  WHEN DRAWING A HORIZONTAL LINE THREE CONDITIONS EXIST;
+C  1. WHEN THE LINE IS A HORIZONTAL STEP ENTER ONLY THE OUTSIDE POINT.
+C     A HORIZONTAL STEP IS DEFINED BY THE ENTERING AND EXITING Y
+C     DIRECTION THAT IS THE SAME.
+C  2. ENTER BOTH END POINTS OF A HORIZONTAL TURNING POINT. A HORIZONTAL
+C     TURNING POINT IS A LINE WITH GREATER THAN 1 HORIZONTAL BITS
+C     AND THE ENTERING AND EXITING Y DIRECTION IS DIFFIRENT.
+C  3.  WHEN THE ENTIRE CONTOUR IS A HORIZONTAL LINE NO POINTS ARE
+C      ENTERED. THIS CONDITION IS DETECTED BY THE STATUS OF YCHANG.
+C      IF IT IS TRUE THEN THE CONTOUR IS NOT A SINGLE HORIZONTAL LINE.
+C
+C  THE PREVIOUS POINT IS ERASED IF IT IS A VERTICAL TURNING POINT.
+C  A VERTICAL TURNING POINT IS A HORIZONTAL LINE WITH ONLY 1 POINT
+C  AND THE ENTERING AND EXITING Y DIRECTION DIFFERS.THIS DATA IS
+C  IN THE VARIABLES IOSLSN-OLD SLOPE AND ISLSGN-NEW SLOPE.
+C  THE CHANGE IN SLOPE MUST BE -1 TO 1 OR 1 TO -1.
+C
+C  OTHERWISE THE POINT IS ENTERED INTO ISCR.
+C
+C  THE TWO ENTRY POINTS ARE REQUIRED BY THE HARDWARE DRAWING ROUTINES.
+C  FIRSTC IS USED FOR THE FIRST POINT ON THE CONTOUR. THE REMAINING
+C  POINTS ON THE SAME CONTOUR ARE ENTERED VIA VECTC.
+C
+      DATA IONE/1/
+      AVE(A,B) = (A+B)*.5
+C
+C  COMPUTE VISIBILITY OF THIS POINT
+C
+C  WARNING
+C  IF X OR Y PLOTTER MAXIMUM VALUE RANGES FALL BELOW 101 THEN THE
+C  FOLLOWING TWO STATEMENTS WHICH SET IX AND IY MUST BE CHANGED.
+C  REPLACE THE CONSTANT 1.0 BY 0.5 IN THE STATEMENTS WHERE THE
+C  MAXIMUM PLOTTER VALUE IS LESS THAN 101 FOR THAT DIRECTION.  THE
+C  PLOTTER CORDINATE RANGES ARE SET IN SET32.
+C
+      IX = FLOAT(MX-1)*RX+1.0
+      NRLX = IX
+      IY = FLOAT(MY-1)*RY+1.0
+      IBIT = NBPW-MOD(IX,NBPW)
+      IX = IX/NBPW+1
+      IVNOW = IAND(ISHIFT(ISCA(IX,IY),1-IBIT),IONE)
+C
+C  DECIDE IF FRSTC OR VECTC CALL
+C
+      IF (IENT .NE. 1) GO TO  10
+C
+      XOLD = MX
+      YOLD = MY
+C
+C
+C  SET INITIAL VALUES
+C
+      IHF = .FALSE.
+      IYDIR = 0
+      ITPD = 0
+      IVAL = 0
+      IOSLSN = 0
+      IFSX = NRLX
+      IFSY = IY
+      LASTV = IVNOW
+      HBFLAG = .FALSE.
+      YCHANG = .FALSE.
+      CALL PLOTIT (IFIX(XOLD),IFIX(YOLD),0)
+      GO TO 180
+C
+C****************************  ENTRY VECTC  ****************************
+C     ENTRY VECTC (MX,MY)
+C
+   10 XNOW = MX
+      YNOW = MY
+      JUMP = IVNOW*2+LASTV+1
+      GO TO ( 20, 30, 40, 50),JUMP
+C
+C BOTH VISIBLE
+C
+   20 CALL PLOTIT (IFIX(XNOW),IFIX(YNOW),1)
+      GO TO  50
+C
+C JUST TURNED VISIBLE
+C
+   30 CALL PLOTIT (IFIX(AVE(XNOW,XOLD)),IFIX(AVE(YNOW,YOLD)),0)
+      GO TO  50
+C
+C JUST TURNED INVISIBLE
+C
+   40 CALL PLOTIT (IFIX(AVE(XNOW,XOLD)),IFIX(AVE(YNOW,YOLD)),1)
+C
+C BOTH INVISIBLE
+C
+   50 XOLD = XNOW
+      YOLD = YNOW
+      LASTV = IVNOW
+C
+C  TEST FOR RESOLUTION PROBLEM
+C
+      IF (NRLX.EQ.LRLX .AND. IY.EQ.IYOLD) RETURN
+C
+C  TEST FOR HORIZONTAL BITS
+C
+      IF (IYOLD .NE. IY) GO TO  70
+C
+C  HORIZONTAL BITS DETECTED. SET FLAG AND EXIT.
+C  THIS AND THE NEXT HORIZONTAL BIT TEST IS NECESSARY FOR ISCR TO
+C  CONFORM TO THE SHADING ALGORITHM IN SUBROUTINE FILLIN
+C
+C
+C  IF HORIZONTAL LINE PREVIOUSLY DETECTED EXIT
+C
+      IF (.NOT.HBFLAG) GO TO  60
+C
+C  IF END OF CONTOUR ON A HORIZONTAL LINE BRANCH FOR SPECIAL PROCESSING.
+C
+      IF (NRLX.EQ.IFSX .AND. IY.EQ.IFSY) GO TO 210
+      GO TO 200
+C
+C  SAVE SLOPE PRIOR TO HORIZONTAL LINE
+C
+   60 IHX = IXOLD
+      IHB = IBTOLD
+      IHS = IOSLSN
+      IOSLSN = 0
+      HBFLAG = .TRUE.
+      IHRX = LRLX
+      IHV = IVOLD
+      IF (LRLX.EQ.IFSX .AND. IYOLD.EQ.IFSY) IHF = .TRUE.
+C
+C  THIS IS THE SECOND TRAP FOR END OF CONTOUR ON A HORIZONTAL LINE.
+C
+      IF (NRLX.EQ.IFSX .AND. IY.EQ.IFSY) GO TO 210
+      GO TO 200
+C
+C  COMPUTE THE SLOPE TO THIS POINT
+C
+   70 IF (IY-IYOLD)  80, 90,100
+   80 ISLSGN = 1
+      GO TO 110
+   90 ISLSGN = 0
+      GO TO 120
+  100 ISLSGN = -1
+  110 IF (IYDIR .EQ. 0) IYDIR = ISLSGN
+  120 CONTINUE
+C
+C  IF PROCESS REACHES THIS CODE THE CONTOUR IS NOT CONTAINED ON A SINGLE
+C  HORIZONTAL  PLANE, SO RECORD THIS FACT BY SETTING Y CHANGE FLAG.
+C
+      YCHANG = .TRUE.
+C
+C  TEST FOR END OF HORIZONTAL LINE
+C
+      IF (.NOT.HBFLAG) GO TO 160
+      HBFLAG = .FALSE.
+C
+C  HORIZONTAL LINE JUST ENDED
+C
+C  TEST FOR REDRAW
+C
+      ITEMP = IAND(ISCR(IXOLD,IYOLD),MASK(IBTOLD))
+      IF ((IHV .EQ. 0) .AND. (ITEMP .EQ. 0)) GO TO 130
+C
+C  REDRAWING ERASE THIS POINT
+C
+      ISCR(IXOLD,IYOLD) = IAND(ISCR(IXOLD,IYOLD),NMASK(IBTOLD))
+      ISCR(IHX,IYOLD) = IAND(ISCR(IHX,IYOLD),NMASK(IHB))
+      GO TO 170
+C
+C  TEST FOR STEP PROBLEM
+C
+  130 IF (IHS .NE. ISLSGN) GO TO 140
+C
+C  STEP PROBLEM
+C
+      GO TO 170
+C
+C  TURNING PROBLEM HORIZONTAL LINE IS A TURNING POINT
+C
+  140 CONTINUE
+C
+C  ENTER THE TURNING POINT ONLY IF IT IS NOT THE SECOND SUCCEEDING
+C  EVENT IN A ROW
+C
+      ICTPD = 1
+      IF (IHRX .GT. NRLX) ICTPD = -1
+      IF (ICTPD .NE. ITPD) GO TO 150
+      ITPD = 0
+C
+C  ERASE THE FIRST POINT
+C
+      ISCR(IHX,IYOLD) = IAND(ISCR(IHX,IYOLD),NMASK(IHB))
+      GO TO 170
+C
+C  ENTER THE TURNING POINT
+C
+  150 CONTINUE
+      ITPD = ICTPD
+C
+C  ENTER THE SECOND POINT
+C
+      ISCR(IXOLD,IYOLD) = IOR(ISCR(IXOLD,IYOLD),MASK(IBTOLD))
+      GO TO 170
+C
+C  CHECK IF PREVIOUS ENTRY WAS A VERTICAL TURNING POINT.
+C  IF SO ERASE IT.
+C
+  160 IF (ISLSGN.EQ.IOSLSN .OR. (IOSLSN.EQ.0 .OR. ISLSGN.EQ.0))
+     1    GO TO 170
+      ITPD = 0
+      ISCR(IXOLD,IYOLD) = IAND(ISCR(IXOLD,IYOLD),NMASK(IBTOLD))
+C
+  170 IOSLSN = ISLSGN
+C
+C  CHECK IF THIS GRID POINT PREVIOUSLY ACTIVATED
+C
+      IVAL = IAND(ISCR(IX,IY),MASK(IBIT))
+C
+C  IF GRID POINTS ACTIVATED BRANCH
+C
+      IF (IVAL .NE. 0) GO TO 190
+C
+C  GRID POINT NOT ACTIVATED   SET AND EXIT
+C
+  180 CONTINUE
+      ISCR(IX,IY) = IOR(ISCR(IX,IY),MASK(IBIT))
+      GO TO 200
+C
+C  THIS POINT IS BEING REDRAWN SO ERASE IT.
+C  (THIS IS TO CONFORM WITH THE SHADING ALGORITHM, FILLIN.
+C  HOWEVER IF BACK TO STARTING POINT DO NOT ERASE
+C
+  190 IF (NRLX.EQ.IFSX .AND. IY.EQ.IFSY) RETURN
+      ISCR(IX,IY) = IAND(ISCR(IX,IY),NMASK(IBIT))
+C
+C
+  200 IXOLD = IX
+      LRLX = NRLX
+      IYOLD = IY
+      IBTOLD = IBIT
+      IVOLD = IVAL
+      RETURN
+C
+C  PERFORM THIS OPERATION WHEN A CONTOUR STARTS OR ENDS ON A HORIZONTAL
+C  LINE.
+C
+  210 CONTINUE
+C
+C  ERASE THE FIRST POINT OF A CONTOUR WHEN IT IS PART OF A HORIZONTAL
+C  LINE SEGMENT AND IS NOT THE ENDPOINT OF THE SEGMENT
+C
+      IF (.NOT.IHF) GO TO 220
+      ISCR(IX,IY) = IAND(ISCR(IX,IY),NMASK(IBIT))
+  220 CONTINUE
+C
+C  ERASE THE FIRST POINT OF A HORIZONTAL LINE SEGMENT WHEN IT ENDS
+C  THE CONTOUR AND IS NOT THE HIGHEST LINE SEG ON THS SIDE.
+C
+      IF (.NOT.YCHANG) GO TO 230
+      IF (IYDIR .NE. IHS) GO TO 200
+  230 ISCR(IHX,IY) = IAND(ISCR(IHX,IY),NMASK(IHB))
+      GO TO 200
+      END
+      SUBROUTINE FILLIN
+C
+      SAVE
+      COMMON /ISOSR2/ LX         ,NX         ,NY         ,ISCR(8,128),
+     1                ISCA(8,128)
+      COMMON /ISOSR5/ NBPW       ,MASK(16)   ,GENDON
+      LOGICAL         GENDON
+      COMMON /ISOSR7/ IENTRY     ,IONES
+C
+      IF (IENTRY .EQ. 0) RETURN
+C
+C  THIS IS A SHADING ALGORITHM IT IS USED TO DETERMINE CONTOUR LINES
+C  THAT ARE HIDDEN BY THE PRESENT LINE. THE ALGORITHM PROCESSES
+C  HORIZONTAL ROWS. IT ASSUMES THAT THE BIT PATTERN PASSED TO IT
+C  HAS ONLY BITS SET TO MARK THE START AND END OF SHADING. THE
+C  ALGORITHM ALSO ASSUMES THAT WHEN AN ON BIT IS ENCOUNTERED THAT A
+C  CORRESPONDING OFF BIT IS INCLUDED IN THE SAME ROW.
+C
+C
+C  PULL OUT ROWS OF THE CONTOUR PATTERN
+C
+      IBVAL = 0
+      DO  80 IYNOW=1,NY
+         DO  40 IXNOW=1,LX
+C
+C  IF NO ACTIVATED BITS BRANCH
+C
+            ICRWD = ISCR(IXNOW,IYNOW)
+            IF (ICRWD .EQ. 0) GO TO  30
+C
+C  ACTIVATED BITS IN WORD SET SHADING FLAG
+C
+C  CHECK BIT BY BIT FOR ON/OFF FLAGS
+C
+            DO  20 IB=1,NBPW
+               IBIT = (NBPW+1)-IB
+C
+C
+C  PULL OUT THE CURRENT GRID POINT VALUE
+C
+               IVAL = IAND(ICRWD,MASK(IBIT))
+C
+C  IF IVAL SET, THIS IS AN ON/OFF FLAG
+C
+               IF (IVAL .EQ. 0) GO TO  10
+C
+C  FLAG BIT, ALWAYS SET
+C
+               IBVAL = MOD(IBVAL+1,2)
+               GO TO  20
+C
+C  SHADE THE SCREEN ACCORDING TO THE STATUS OF IBVAL
+C
+   10          IF (IBVAL .NE. 0) ICRWD = IOR(ICRWD,MASK(IBIT))
+C
+   20       CONTINUE
+C
+C  ZERO OUT THE SCREEN
+C
+            ISCR(IXNOW,IYNOW) = 0
+            ISCA(IXNOW,IYNOW) = IOR(ICRWD,ISCA(IXNOW,IYNOW))
+            GO TO  40
+C
+   30       IF (IBVAL .NE. 0) ISCA(IXNOW,IYNOW) = IONES
+   40    CONTINUE
+C
+C  FIX FOR NONCORRECTABLE RUNAWAYS
+C
+         IF (IBVAL .EQ. 0) GO TO  80
+         IBVAL = 0
+         DO  70 K=1,LX
+            ITEST = 0
+            IF (IYNOW .EQ. 1) GO TO  50
+            ITEST = ISCA(K,IYNOW-1)
+            IF (IYNOW .EQ. NY) GO TO  60
+   50       ITEST = IOR(ITEST,ISCA(K,IYNOW+1))
+   60       ISCA(K,IYNOW) = ITEST
+   70    CONTINUE
+C
+   80 CONTINUE
+      RETURN
+      END
+      SUBROUTINE DRAWI (IXA,IYA,IXB,IYB)
+C
+C INCLUDED FOR USE BY PWRZ
+C
+      SAVE
+      CALL FRSTC (IXA,IYA,1)
+      CALL FRSTC (IXB,IYB,2)
+      RETURN
+      END
+      SUBROUTINE MMASK
+C
+C  MAKE THE MACHINE DEPENDENT MASKS USED IN THE CONTOUR DRAWING
+C  AND SHADING ALGORITHMS
+C
+      SAVE
+      COMMON /ISOSR5/ NBPW       ,MASK(16)   ,GENDON
+      LOGICAL         GENDON
+      COMMON /ISOSR7/ IENTRY     ,IONES
+      COMMON /ISOSR8/ NMASK(16)  ,IXOLD      ,IYOLD      ,IBTOLD     ,
+     1                HBFLAG     ,IOSLSN     ,LRLX       ,IFSX       ,
+     2                IFSY       ,FIRST      ,IYDIR      ,IHX        ,
+     3                IHB        ,IHS        ,IHV        ,IVOLD      ,
+     4                IVAL       ,IHRX       ,YCHANG     ,ITPD       ,
+     5                IHF
+      COMMON /ISOSR9/ BIG        ,IXBIT
+      LOGICAL         YCHANG     ,HBFLAG     ,FIRST      ,IHF
+      GENDON = .TRUE.
+      NBPW = 16
+C
+C  GET BIGGEST REAL NUMBER
+C
+      BIG = R1MACH(2)
+C
+C  MASKS TO SELECT A SPECIFIC BIT
+C
+      DO  10 K=1,NBPW
+         MASK(K) = ISHIFT(1,K-1)
+   10 CONTINUE
+C
+C  GENERATE  THE BIT PATTERN 177777 OCTAL
+C
+      ITEMP1 = 0
+      ITEMP = MASK(NBPW)
+      IST = NBPW-1
+      DO  20 K=1,IST
+         ITEMP1 = IOR(ITEMP,ISHIFT(ITEMP1,-1))
+   20 CONTINUE
+      MFIX = IOR(ITEMP1,1)
+C
+C  MASKS TO CLEAR A SPECIFIC BIT
+C
+      DO  30 K=1,NBPW
+         NMASK(K) = IAND(ITEMP1,MFIX)
+         ITEMP1 = IOR(ISHIFT(ITEMP1,1),1)
+   30 CONTINUE
+      IONES = MFIX
+      RETURN
+C
+C REVISION HISTORY---
+C
+C JANUARY 1978     DELETED REFERENCES TO THE  *COSY  CARDS AND
+C                  ADDED REVISION HISTORY
+C JANUARY 1979     NEW SHADING ALGORITHM
+C MARCH 1979       MADE CODE MACHINE INDEPENDENT AND CONFORM
+C                  TO 66 FORTRAN STANDARD
+C JUNE 1979        THIS VERSION PLACED ON ULIB.
+C SEPTEMBER 1979   FIXED PROBLEM IN EZISOS DEALING WITH
+C                  DETERMINATION OF VISIBILITY OF W PLANE.
+C DECEMBER 1979    FIXED PROBLEM WITH PEN DOWN ON CONTOUR
+C                  INITIALIZATION IN SUBROUTINE FRSTC
+C MARCH            CHANGED ROUTINE NAMES  TRN32I  AND  DRAW  TO
+C                  TRN32I  AND  DRAWI  TO BE CONSISTENT WITH THE
+C                  USAGE OF THE NEW ROUTINE  PWRZI.
+C JUNE  1980       FIXED PROBLEM WITH ZERO INDEX COMPUTATION IN
+C                  SUBROUTINE FRSTC.  ADDED INPUT PARAMETER
+C                  DIMENSION STATEMENT MISSING IN EZISOS.
+C                  FIXED ERROR IN COMPUTATION OF ARCCOSINE
+C                  IN EZISOS AND TRN32I.
+C DECEMBER 1984    CONVERTED TO GKS LEVEL 0A AND STANDARD FORTRAN 77
+C-----------------------------------------------------------------------
+C
+      END
diff --git a/sys/gio/ncarutil/kurv.f b/sys/gio/ncarutil/kurv.f
new file mode 100644
index 00000000..1d160b89
--- /dev/null
+++ b/sys/gio/ncarutil/kurv.f
@@ -0,0 +1,451 @@
+      SUBROUTINE KURV1S (N,X,Y,SLOP1,SLOPN,XP,YP,TEMP,S,SIGMA,ISLPSW)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C DIMENSION OF           X(N),Y(N),XP(N),YP(N),TEMP(N)
+C ARGUMENTS
+C
+C LATEST REVISION        FEBRUARY 5, 1974
+C
+C PURPOSE                KURV1S DETERMINES THE PARAMETERS NECESSARY TO
+C                        COMPUTE A SPLINE UNDER TENSION PASSING THROUGH
+C                        A SEQUENCE OF PAIRS
+C                        (X(1),Y(1)),...,(X(N),Y(N)) IN THE PLANE.
+C                        THE SLOPES AT THE TWO ENDS OF THE CURVE MAY BE
+C                        SPECIFIED OR OMITTED.  FOR ACTUAL COMPUTATION
+C                        OF POINTS ON THE CURVE IT IS NECESSARY TO CALL
+C                        THE SUBROUTINE KURV2S.
+C
+C USAGE                  CALL KURV1S(N,X,Y,SLP1,SLPN,XP,YP,TEMP,S,SIGMA)
+C
+C ARGUMENTS
+C
+C ON INPUT               N
+C                          IS THE NUMBER OF POINTS TO BE INTERPOLATED
+C                          (N .GE. 2).
+C
+C                        X
+C                          IS AN ARRAY CONTAINING THE N X-COORDINATES
+C                          OF THE POINTS.
+C
+C                        Y
+C                          IS AN ARRAY CONTAINING THE N Y-COORDINATES
+C                          OF THE POINTS.
+C
+C                        SLOP1 AND SLOPN
+C                          CONTAIN THE DESIRED VALUES FOR THE SLOPE OF
+C                          THE CURVE AT (X(1),Y(1)) AND (X(N),Y(N)),
+C                          RESPECTIVELY.  THESE QUANTITIES ARE IN
+C                          DEGREES AND MEASURED COUNTER-CLOCKWISE
+C                          FROM THE POSITIVE X-AXIS.  IF ISLPSW IS NON-
+C                          ZERO, ONE OR BOTH OF SLP1 AND SLPN MAY BE
+C                          DETERMINED INTERNALLY BY KURV1S.
+C
+C                        XP AND YP
+C                          ARE ARRAYS OF LENGTH AT LEAST N.
+C
+C                        TEMP
+C                          IS AN ARRAY OF LENGTH AT LEAST N WHICH IS
+C                          USED FOR SCRATCH STORAGE.
+C
+C                        SIGMA
+C                          CONTAINS THE TENSION FACTOR.  THIS IS
+C                          NON-ZERO AND INDICATES THE CURVINESS DESIRED.
+C                          IF ABS(SIGMA) IS VERY LARGE (E.G., 50.) THE
+C                          RESULTING CURVE IS VERY NEARLY A POLYGONAL
+C                          LINE.  A STANDARD VALUE FOR SIGMA IS ABOUT 2.
+C
+C                        ISLPSW
+C                          IS AN INTEGER INDICATING WHICH END SLOPES
+C                          HAVE BEEN USER PROVIDED AND WHICH MUST BE
+C                          COMPUTED BY KURV1S.  FOR ISLPSW
+C                            = 0  INDICATES BOTH SLOPES ARE PROVIDED,
+C                            = 1  ONLY SLOP1 IS PROVIDED,
+C                            = 2  ONLY SLOPN IS PROVIDED,
+C                            = 3  NEITHER SLOP1 NOR SLOPN IS PROVIDED.
+C                            = 4  NEITHER SLOP1 NOR SLOPN IS PROVIDED,
+C                                 BUT SLOP1=SLOPN.  IN THIS CASE X(1)=
+C                                 X(N), Y(1)=Y(N) AND N.GE.3.
+C ON OUTPUT              XP AND YP
+C                          CONTAIN INFORMATION ABOUT THE CURVATURE OF
+C                          THE CURVE AT THE GIVEN NODES.
+C
+C                        S
+C                          CONTAINS THE POLYGONAL ARCLENGTH OF THE
+C                          CURVE.
+C
+C                        N, X, Y, SLP1, SLPN, SIGMA AND ISLPSW ARE
+C                        UNCHANGED.
+C
+C ENTRY POINTS           KURV1S
+C
+C SPECIAL CONDITIONS     NONE
+C
+C COMMON BLOCKS          NONE
+C
+C I/O                    NONE
+C
+C PRECISION              SINGLE
+C
+C REQUIRED ULIB          NONE
+C ROUTINES
+C
+C SPECIALIST             RUSSELL K. REW, NCAR, BOULDER, COLORADO  80302
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                ORIGINALLY WRITTEN BY A. K. CLINE, MARCH 1972.
+C
+C
+C
+C
+      INTEGER         N
+      REAL            X(N)       ,Y(N)       ,XP(N)      ,YP(N)      ,
+     1                TEMP(N)    ,S          ,SIGMA
+      SAVE
+C
+      DATA PI /3.1415926535897932/
+C
+      NN = N
+      JSLPSW = ISLPSW
+      SLP1 = SLOP1
+      SLPN = SLOPN
+      DEGRAD = PI/180.
+      NM1 = NN-1
+      NP1 = NN+1
+      DELX1 = X(2)-X(1)
+      DELY1 = Y(2)-Y(1)
+      DELS1 = SQRT(DELX1*DELX1+DELY1*DELY1)
+      DX1 = DELX1/DELS1
+      DY1 = DELY1/DELS1
+C
+C DETERMINE SLOPES IF NECESSARY
+C
+      IF (JSLPSW .NE. 0) GO TO 70
+   10 SLPP1 = SLP1*DEGRAD
+      SLPPN = SLPN*DEGRAD
+C
+C SET UP RIGHT HAND SIDES OF TRIDIAGONAL LINEAR SYSTEM FOR XP
+C AND YP
+C
+      XP(1) = DX1-COS(SLPP1)
+      YP(1) = DY1-SIN(SLPP1)
+
+      TEMP(1) = DELS1
+      SS = DELS1
+      IF (NN .EQ. 2) GO TO 30
+      DO 20 I=2,NM1
+         DELX2 = X(I+1)-X(I)
+         DELY2 = Y(I+1)-Y(I)
+         DELS2 = SQRT(DELX2*DELX2+DELY2*DELY2)
+         DX2 = DELX2/DELS2
+         DY2 = DELY2/DELS2
+         XP(I) = DX2-DX1
+         YP(I) = DY2-DY1
+         TEMP(I) = DELS2
+         DELX1 = DELX2
+         DELY1 = DELY2
+         DELS1 = DELS2
+         DX1 = DX2
+         DY1 = DY2
+C
+C ACCUMULATE POLYGONAL ARCLENGTH
+C
+         SS = SS+DELS1
+   20 CONTINUE
+   30 XP(NN) = COS(SLPPN)-DX1
+      YP(NN) = SIN(SLPPN)-DY1
+C
+C DENORMALIZE TENSION FACTOR
+C
+      SIGMAP = ABS(SIGMA)*FLOAT(NN-1)/SS
+C
+C PERFORM FORWARD ELIMINATION ON TRIDIAGONAL SYSTEM
+C
+      S = SS
+      DELS = SIGMAP*TEMP(1)
+      EXPS = EXP(DELS)
+      SINHS = .5*(EXPS-1./EXPS)
+      SINHIN = 1./(TEMP(1)*SINHS)
+      DIAG1 = SINHIN*(DELS*.5*(EXPS+1./EXPS)-SINHS)
+      DIAGIN = 1./DIAG1
+      XP(1) = DIAGIN*XP(1)
+      YP(1) = DIAGIN*YP(1)
+      SPDIAG = SINHIN*(SINHS-DELS)
+      TEMP(1) = DIAGIN*SPDIAG
+      IF (NN .EQ. 2) GO TO 50
+      DO 40 I=2,NM1
+         DELS = SIGMAP*TEMP(I)
+         EXPS = EXP(DELS)
+         SINHS = .5*(EXPS-1./EXPS)
+         SINHIN = 1./(TEMP(I)*SINHS)
+         DIAG2 = SINHIN*(DELS*(.5*(EXPS+1./EXPS))-SINHS)
+         DIAGIN = 1./(DIAG1+DIAG2-SPDIAG*TEMP(I-1))
+         XP(I) = DIAGIN*(XP(I)-SPDIAG*XP(I-1))
+         YP(I) = DIAGIN*(YP(I)-SPDIAG*YP(I-1))
+         SPDIAG = SINHIN*(SINHS-DELS)
+         TEMP(I) = DIAGIN*SPDIAG
+         DIAG1 = DIAG2
+   40 CONTINUE
+   50 DIAGIN = 1./(DIAG1-SPDIAG*TEMP(NM1))
+      XP(NN) = DIAGIN*(XP(NN)-SPDIAG*XP(NM1))
+      YP(NN) = DIAGIN*(YP(NN)-SPDIAG*YP(NM1))
+C
+C PERFORM BACK SUBSTITUTION
+C
+      DO 60 I=2,NN
+         IBAK = NP1-I
+         XP(IBAK) = XP(IBAK)-TEMP(IBAK)*XP(IBAK+1)
+         YP(IBAK) = YP(IBAK)-TEMP(IBAK)*YP(IBAK+1)
+   60 CONTINUE
+      RETURN
+   70 IF (NN .EQ. 2) GO TO 100
+C
+C IF NO SLOPES ARE GIVEN, USE SECOND ORDER INTERPOLATION ON
+C INPUT DATA FOR SLOPES AT ENDPOINTS
+C
+      IF (JSLPSW .EQ. 4) GO TO 90
+      IF (JSLPSW .EQ. 2) GO TO 80
+      DELNM1 = SQRT((X(NN-2)-X(NM1))**2+(Y(NN-2)-Y(NM1))**2)
+      DELN = SQRT((X(NM1)-X(NN))**2+(Y(NM1)-Y(NN))**2)
+      DELNN = DELNM1+DELN
+      C1 = (DELNN+DELN)/DELNN/DELN
+      C2 = -DELNN/DELN/DELNM1
+      C3 = DELN/DELNN/DELNM1
+      SX = C3*X(NN-2)+C2*X(NM1)+C1*X(NN)
+      SY = C3*Y(NN-2)+C2*Y(NM1)+C1*Y(NN)
+C
+      SLPN = ATAN2(SY,SX)/DEGRAD
+   80 IF (JSLPSW .EQ. 1) GO TO 10
+      DELS2 = SQRT((X(3)-X(2))**2+(Y(3)-Y(2))**2)
+      DELS12 = DELS1+DELS2
+      C1 = -(DELS12+DELS1)/DELS12/DELS1
+      C2 = DELS12/DELS1/DELS2
+      C3 = -DELS1/DELS12/DELS2
+      SX = C1*X(1)+C2*X(2)+C3*X(3)
+      SY = C1*Y(1)+C2*Y(2)+C3*Y(3)
+C
+      SLP1 = ATAN2(SY,SX)/DEGRAD
+      GO TO 10
+   90 DELN = SQRT((X(NM1)-X(NN))**2+(Y(NM1)-Y(NN))**2)
+      DELNN = DELS1+DELN
+      C1 = -DELS1/DELN/DELNN
+      C2 = (DELS1-DELN)/DELS1/DELN
+      C3 = DELN/DELNN/DELS1
+      SX = C1*X(NM1)+C2*X(1)+C3*X(2)
+      SY = C1*Y(NM1)+C2*Y(1)+C3*Y(2)
+      IF (SX.EQ.0. .AND. SY.EQ.0.) SX = 1.
+      SLP1 = ATAN2(SY,SX)/DEGRAD
+      SLPN = SLP1
+      GO TO 10
+C
+C IF ONLY TWO POINTS AND NO SLOPES ARE GIVEN, USE STRAIGHT
+C LINE SEGMENT FOR CURVE
+C
+  100 IF (JSLPSW .NE. 3) GO TO 110
+      XP(1) = 0.
+      XP(2) = 0.
+      YP(1) = 0.
+      YP(2) = 0.
+C
+      SLP1 = ATAN2(Y(2)-Y(1),X(2)-X(1))/DEGRAD
+      SLPN = SLP1
+      RETURN
+C
+  110 IF (JSLPSW .EQ. 2)
+     1    SLP1 = ATAN2(Y(2)-Y(1)-SLPN*(X(2)-X(1)),
+     2                                X(2)-X(1)-SLPN*(Y(2)-Y(1)))/DEGRAD
+C
+      IF (JSLPSW .EQ. 1)
+     1    SLPN = ATAN2(Y(2)-Y(1)-SLP1*(X(2)-X(1)),
+     2                                X(2)-X(1)-SLP1*(Y(2)-Y(1)))/DEGRAD
+      GO TO 10
+      END
+      SUBROUTINE KURV2S (T,XS,YS,N,X,Y,XP,YP,S,SIGMA,NSLPSW,SLP)
+C
+C
+C
+C DIMENSION OF           X(N),Y(N),XP(N),YP(N)
+C ARGUMENTS
+C
+C LATEST REVISION        OCTOBER 22, 1973
+C
+C PURPOSE                KURV2S PERFORMS THE MAPPING OF POINTS IN THE
+C                        INTERVAL (0.,1.) ONTO A CURVE IN THE PLANE.
+C                        THE SUBROUTINE KURV1S SHOULD BE CALLED EARLIER
+C                        TO DETERMINE CERTAIN NECESSARY PARAMETERS.
+C                        THE RESULTING CURVE HAS A PARAMETRIC
+C                        REPRESENTATION BOTH OF WHOSE COMPONENTS ARE
+C                        SPLINES UNDER TENSION AND FUNCTIONS OF THE
+C                        POLYGONAL ARCLENGTH PARAMETER.
+C
+C ACCESS CARDS           *FORTRAN,S=ULIB,N=KURV
+C                        *COSY
+C
+C USAGE                  CALL KURV2S (T,XS,YS,N,X,Y,XP,YP,S,SIGMA)
+C
+C ARGUMENTS
+C
+C ON INPUT               T
+C                          CONTAINS A REAL VALUE OF ABSOLUTE VALUE LESS
+C                          THAN OR EQUAL TO 1. TO BE MAPPED TO A POINT
+C                          ON THE CURVE.  THE SIGN OF T IS IGNORED AND
+C                          THE INTERVAL (0.,1.) IS MAPPED ONTO THE
+C                          ENTIRE CURVE.  IF T IS NEGATIVE, THIS
+C                          INDICATES THAT THE SUBROUTINE HAS BEEN CALLED
+C                          PREVIOUSLY (WITH ALL OTHER INPUT VARIABLES
+C                          UNALTERED) AND THAT THIS VALUE OF T EXCEEDS
+C                          THE PREVIOUS VALUE IN ABSOLUTE VALUE.  WITH
+C                          SUCH INFORMATION THE SUBROUTINE IS ABLE TO
+C                          MAP THE POINT MUCH MORE RAPIDLY.  THUS IF THE
+C                          USER SEEKS TO MAP A SEQUENCE OF POINTS ONTO
+C                          THE SAME CURVE, EFFICIENCY IS GAINED BY
+C                          ORDERING THE VALUES INCREASING IN MAGNITUDE
+C                          AND SETTING THE SIGNS OF ALL BUT THE FIRST
+C                          NEGATIVE.
+C
+C                        N
+C                          CONTAINS THE NUMBER OF POINTS WHICH WERE
+C                          INTERPOLATED TO DETERMINE THE CURVE.
+C
+C                        X AND Y
+C                          ARRAYS CONTAINING THE X- AND Y-COORDINATES
+C                          OF THE INTERPOLATED POINTS.
+C
+C                        XP AND YP
+C                          ARE THE ARRAYS OUTPUT FROM KURV1 CONTAINING
+C                          CURVATURE INFORMATION.
+C
+C                        S
+C                          CONTAINS THE POLYGONAL ARCLENGTH OF THE
+C                          CURVE.
+C
+C                        SIGMA
+C                          CONTAINS THE TENSION FACTOR (ITS SIGN IS
+C                          IGNORED).
+C
+C                        NSLPSW
+C                          IS AN INTEGER SWITCH WHICH TURNS ON OR OFF
+C                          THE CALCULATION OF SLP
+C                          NSLPSW
+C                                 = 0 INDICATES THAT SLP WILL NOT BE
+C                                     CALCULATED
+C                                 = 1 SLP WILL BE CALCULATED
+C
+C                        THE PARAMETERS N, X, Y, XP, YP, S AND SIGMA
+C                        SHOULD BE INPUT UNALTERED FROM THE OUTPUT OF
+C                        KURV1S.
+C
+C ON OUTPUT              XS AND YS
+C                          CONTAIN THE X- AND Y-COORDINATES OF THE IMAGE
+C                          POINT ON THE CURVE.
+C
+C                        SLP
+C                          CONTAINS THE SLOPE OF THE CURVE IN DEGREES AT
+C                          THIS POINT.
+C
+C                        T, N, X, Y, XP, YP, S AND SIGMA ARE UNALTERED.
+C
+C ENTRY POINTS           KURV2S
+C
+C SPECIAL CONDITIONS     NONE
+C
+C COMMON BLOCKS          NONE
+C
+C I/O                    NONE
+C
+C PRECISION              SINGLE
+C
+C REQUIRED ULIB          NONE
+C ROUTINES
+C
+C SPECIALIST             RUSSELL K. REW, NCAR, BOULDER, COLORADO  80302
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                ORIGINALLY WRITTEN BY A. K. CLINE, MARCH 1972.
+C
+C
+C
+C
+      INTEGER         N
+      REAL            T          ,XS         ,YS         ,X(N)       ,
+     1                Y(N)       ,XP(N)      ,YP(N)      ,S          ,
+     2                SIGMA      ,SLP
+      SAVE
+C
+      DATA PI /3.1415926535897932/
+C
+C
+C DENORMALIZE SIGMA
+C
+      SIGMAP = ABS(SIGMA)*FLOAT(N-1)/S
+C
+C STRETCH UNIT INTERVAL INTO ARCLENGTH DISTANCE
+C
+      TN = ABS(T*S)
+C
+C FOR NEGATIVE T START SEARCH WHERE PREVIOUSLY TERMINATED,
+C OTHERWISE START FROM BEGINNING
+C
+      IF (T .LT. 0.) GO TO 10
+      DEGRAD = PI/180.
+      I1 = 2
+      XS = X(1)
+      YS = Y(1)
+      SUM = 0.
+      IF (T .LT. 0.) RETURN
+C
+C DETERMINE INTO WHICH SEGMENT TN IS MAPPED
+C
+   10 DO 30 I=I1,N
+         DELX = X(I)-X(I-1)
+         DELY = Y(I)-Y(I-1)
+         DELS = SQRT(DELX*DELX+DELY*DELY)
+         IF (SUM+DELS-TN) 20,40,40
+   20    SUM = SUM+DELS
+   30 CONTINUE
+C
+C IF ABS(T) IS GREATER THAN 1., RETURN TERMINAL POINT ON
+C CURVE
+C
+      XS = X(N)
+      YS = Y(N)
+      RETURN
+C
+C SET UP AND PERFORM INTERPOLATION
+C
+   40 DEL1 = TN-SUM
+      DEL2 = DELS-DEL1
+      EXPS1 = EXP(SIGMAP*DEL1)
+      SINHD1 = .5*(EXPS1-1./EXPS1)
+      EXPS2 = EXP(SIGMAP*DEL2)
+      SINHD2 = .5*(EXPS2-1./EXPS2)
+      EXPS = EXPS1*EXPS2
+      SINHS = .5*(EXPS-1./EXPS)
+      XS = (XP(I)*SINHD1+XP(I-1)*SINHD2)/SINHS+
+     1     ((X(I)-XP(I))*DEL1+(X(I-1)-XP(I-1))*DEL2)/DELS
+      YS = (YP(I)*SINHD1+YP(I-1)*SINHD2)/SINHS+
+     1     ((Y(I)-YP(I))*DEL1+(Y(I-1)-YP(I-1))*DEL2)/DELS
+      I1 = I
+      IF (NSLPSW .EQ. 0) RETURN
+      COSHD1 = .5*(EXPS1+1./EXPS1)*SIGMAP
+      COSHD2 = .5*(EXPS2+1./EXPS2)*SIGMAP
+      XT = (XP(I)*COSHD1-XP(I-1)*COSHD2)/SINHS+
+     1     ((X(I)-XP(I))-(X(I-1)-XP(I-1)))/DELS
+      YT = (YP(I)*COSHD1-YP(I-1)*COSHD2)/SINHS+
+     1     ((Y(I)-YP(I))-(Y(I-1)-YP(I-1)))/DELS
+      SLP = ATAN2(YT,XT)/DEGRAD
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/mkpkg b/sys/gio/ncarutil/mkpkg
new file mode 100644
index 00000000..20b06e09
--- /dev/null
+++ b/sys/gio/ncarutil/mkpkg
@@ -0,0 +1,51 @@
+# Make the NCAR utilities library libncar.a.
+
+$checkout libncar.a lib$
+$update   libncar.a
+$checkin  libncar.a lib$
+$exit
+
+libncar.a:
+	@sysint
+	@autograph
+	@conlib
+
+	conran.f    # blockdata for the conrec utility
+	conbdn.f    # blockdata for the conran utility
+	#conraq.f   - Conran, conraq and conras form the "conran" family.
+	#conras.f   - Conran is the only one of the 3 included in "libncar.a";
+	#	    - the others contain duplicate entry points and blockdatas
+	#           - and are not included.
+	#
+	conrec.f
+	conbd.f
+	#conrcqck.f - Conrcqck, conrcspr and conrec form the "conrec" family.
+	#conrcspr.f - Conrec is the only one of the 3 included in "libncar.a";
+	#           - the others contain duplicate entry points and blockdatas
+	#           - and are not included.
+	#dashchar.f
+	#dashline.f - Like the "conrec" family above, the "dash" family contains
+	dashsmth.f  #- duplicate entry points and blockdatas.  Only dashsmth is
+		    #- included in "libncar.a".  The others are redundant.
+	dashbd.f    #  blockdata for the dashsmth utility
+	#dashsupr.f
+	#ezmapg.f
+	gridal.f
+	gridt.f     #- blockdata for the gridal utility
+	hafton.f
+	hfinit.f    #- blockdata for the hafton utility
+	isosrf.f 
+	isosrb.f    #- blockdata for the isosrf utility
+ 	kurv.f	    #- support routines for dashsmth and isosrf
+	pwrity.f
+	pwrzi.f
+	pwrzs.f
+	pwrzt.f
+	srface.f
+	srfabd.f    #- blockdata for the srface utility
+	#strmln.f
+	threed.f
+	threbd.f    #- blockdata for the threed utility
+	velvct.f
+	veldat.f    #- blockdata for the velvct utility
+	;
diff --git a/sys/gio/ncarutil/pwrity.f b/sys/gio/ncarutil/pwrity.f
new file mode 100644
index 00000000..5685c9b7
--- /dev/null
+++ b/sys/gio/ncarutil/pwrity.f
@@ -0,0 +1,604 @@
+      SUBROUTINE PWRITY (X,Y,ID,N,ISIZE,ITHETA,ICNT)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C LATEST REVISION        JULY 1984
+C
+C PURPOSE                PWRITY IS A CHARACTER PLOTTING ROUTINE.  IT HAS
+C                        SOME FEATURES NOT FOUND IN WTSTR, BUT IS NOT AS
+C                        FANCY AS PWRITX.
+C
+C
+C USAGE                  CALL PWRITY(X,Y,ID,N,ISIZE,ITHETA,ICNT)
+C
+C ARGUMENTS
+C
+C ON INPUT               X,Y
+C                          POSITIONING COORDINATES FOR THE CHARACTERS TO
+C                          BE DRAWN.  X AND Y ARE USER WORLD COORDINATES
+C                          AND ARE SCALED ACCORDING TO THE CURRENT
+C                          NORMALIZATION TRANSFORMATION.  ALSO, SEE ICNT.
+C
+C                        ID
+C                          CHARACTER STRING TO BE DRAWN.
+C
+C                        N
+C                          THE NUMBER OF CHARACTERS IN ID.
+C
+C                         ISIZE
+C                            SIZE OF THE CHARACTER:
+C                            . IF BETWEEN 0 AND 3, ISIZE IS CHOSEN AS
+C                              1., 1.5, 2., OR 3. TIMES AN 8 PLOTTER
+C                              ADDRESS CHARACTER WIDTH.
+C                            . IF GREATER THAN 3, ISIZE IS THE CHARACTER
+C                              WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C                        ITHETA
+C                          ANGLE, IN DEGREES, AT WHICH THE CHARACTERS ARE
+C                          PLOTTED (COUNTER CLOCKWISE FROM THE POSITIVE
+C                          X AXIS.)
+C
+C                        ICNT
+C                          CENTERING OPTION:
+C                            = -1  (X,Y) IS THE CENTER OF THE LEFT EDGE
+C                                  OF THE FIRST CHARACTER.
+C                            =  0  (X,Y) IS THE CENTER OF THE ENTIRE
+C                                  STRING.
+C                            =  1  (X,Y) IS THE CENTER OD THE RIGHT EDGE
+C                                  OF THE LAST CHARACTER.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C ENTRY POINTS           PWRY, PWRYSO, PWRYGT, PWRITY, PWRYBD
+C
+C COMMON BLOCKS          PWRCOM
+C
+C REQUIRED LIBRARY       THE SPPS.
+C
+
+C
+C I/O                    PLOTS CHARACTERS.
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                IMPLEMENTED FOR USE IN DASHCHAR.
+C                        MADE PORTABLE IN JANUARY 1977
+C                        FOR USE ON COMPUTER SYSTEMS WHICH
+C                        SUPPORT PLOTTERS WITH UP TO 15 BITS RESOLUTION.
+C                        CONVERTED TO FORTRAN77 AND GKS IN JULY, 1984.
+C
+C ALGORITHM              DIGITIZATIONS OF THE CHARACTERS ARE STORED
+C                        NTERNALLY AND ADJUSTED ACCORDING TO X, Y,
+C                        ISIZE AND ICNT, THEN PLOTTED.
+C
+C TIMING                 SLOWER THAN WTSTR, FASTER THAN PWRITX.
+C
+C PORTABILITY            FORTRAN
+C
+C
+      SAVE
+      CHARACTER*(*)   ID
+      CHARACTER*1     JCHAR(46)  ,KCHAR
+      DIMENSION       INDEX(46)  ,KX(494)    ,KY(494)
+      COMMON /PWRCOM/ USABLE
+      LOGICAL         USABLE
+      LOGICAL         LENTRY
+C
+C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS
+C DIGITIZATION.  THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS
+C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON.
+C
+      DATA JCHAR( 1),INDEX( 1)/'A',  1/
+      DATA JCHAR( 2),INDEX( 2)/'B', 13/
+      DATA JCHAR( 3),INDEX( 3)/'C', 28/
+      DATA JCHAR( 4),INDEX( 4)/'D', 40/
+      DATA JCHAR( 5),INDEX( 5)/'E', 49/
+      DATA JCHAR( 6),INDEX( 6)/'F', 60/
+      DATA JCHAR( 7),INDEX( 7)/'G', 68/
+      DATA JCHAR( 8),INDEX( 8)/'H', 82/
+      DATA JCHAR( 9),INDEX( 9)/'I', 92/
+      DATA JCHAR(10),INDEX(10)/'J',104/
+      DATA JCHAR(11),INDEX(11)/'K',113/
+      DATA JCHAR(12),INDEX(12)/'L',123/
+      DATA JCHAR(13),INDEX(13)/'M',130/
+      DATA JCHAR(14),INDEX(14)/'N',137/
+      DATA JCHAR(15),INDEX(15)/'O',143/
+      DATA JCHAR(16),INDEX(16)/'P',157/
+      DATA JCHAR(17),INDEX(17)/'Q',166/
+      DATA JCHAR(18),INDEX(18)/'R',182/
+      DATA JCHAR(19),INDEX(19)/'S',194/
+      DATA JCHAR(20),INDEX(20)/'T',210/
+      DATA JCHAR(21),INDEX(21)/'U',219/
+      DATA JCHAR(22),INDEX(22)/'V',229/
+      DATA JCHAR(23),INDEX(23)/'W',236/
+      DATA JCHAR(24),INDEX(24)/'X',245/
+      DATA JCHAR(25),INDEX(25)/'Y',252/
+      DATA JCHAR(26),INDEX(26)/'Z',262/
+      DATA JCHAR(27),INDEX(27)/'0',273/
+      DATA JCHAR(28),INDEX(28)/'1',286/
+      DATA JCHAR(29),INDEX(29)/'2',296/
+      DATA JCHAR(30),INDEX(30)/'3',308/
+      DATA JCHAR(31),INDEX(31)/'4',326/
+      DATA JCHAR(32),INDEX(32)/'5',339/
+      DATA JCHAR(33),INDEX(33)/'6',352/
+      DATA JCHAR(34),INDEX(34)/'7',368/
+      DATA JCHAR(35),INDEX(35)/'8',378/
+      DATA JCHAR(36),INDEX(36)/'9',398/
+      DATA JCHAR(37),INDEX(37)/'+',414/
+      DATA JCHAR(38),INDEX(38)/'-',423/
+      DATA JCHAR(39),INDEX(39)/'*',429/
+      DATA JCHAR(40),INDEX(40)/'/',444/
+      DATA JCHAR(41),INDEX(41)/'(',448/
+      DATA JCHAR(42),INDEX(42)/')',456/
+      DATA JCHAR(43),INDEX(43)/'=',464/
+      DATA JCHAR(44),INDEX(44)/' ',473/
+      DATA JCHAR(45),INDEX(45)/',',476/
+      DATA JCHAR(46),INDEX(46)/'.',486/
+C
+C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE
+C CHARACTERS.  THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND
+C 7 UNITS TALL.  THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF
+C EACH CHARACTER.  IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING
+C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND
+C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC-
+C TER HAS BEEN REACHED.
+C
+      DATA WIDE,HIGH,WHITE/6.,7.,2./
+C
+      DATA KX(  1),KX(  2),KX(  3),KX(  4),KX(  5),KX(  6)/0,4,7,0,0,1/
+      DATA KY(  1),KY(  2),KY(  3),KY(  4),KY(  5),KY(  6)/3,3,0,3,6,7/
+      DATA KX(  7),KX(  8),KX(  9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/
+      DATA KY(  7),KY(  8),KY(  9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/
+      DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/
+      DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/
+      DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/
+      DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/
+      DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/
+      DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/
+      DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/
+      DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/
+      DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/
+      DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/
+      DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/
+      DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/
+      DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/
+      DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/
+      DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/
+      DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/
+      DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/
+      DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/
+      DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/
+      DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/
+      DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/
+      DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/
+      DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/
+      DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/
+      DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/
+      DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/
+      DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/
+      DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/
+      DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/
+      DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/
+      DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/
+      DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/
+      DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/
+      DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/
+      DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/
+      DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/
+      DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/
+      DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/
+      DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/
+      DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/
+      DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/
+      DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/
+      DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/
+      DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/
+      DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/
+      DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/
+      DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/
+      DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/
+      DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/
+      DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/
+      DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/
+      DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/
+      DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/
+      DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/
+      DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/
+      DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/
+      DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/
+      DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/
+      DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/
+      DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/
+      DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/
+      DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/
+      DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/
+      DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/
+      DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/
+      DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/
+      DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/
+      DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/
+      DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/
+      DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/
+      DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/
+      DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/
+      DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/
+      DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/
+      DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/
+      DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/
+      DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/
+      DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/
+      DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/
+      DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/
+      DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/
+      DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/
+      DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/
+      DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/
+      DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/
+      DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/
+      DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/
+      DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/
+      DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/
+      DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/
+      DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/
+      DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/
+      DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/
+      DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/
+      DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/
+      DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/
+      DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/
+      DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/
+      DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/
+      DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/
+      DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/
+      DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/
+      DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/
+      DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/
+      DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/
+      DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/
+      DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/
+      DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/
+      DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/
+      DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/
+      DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/
+      DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/
+      DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/
+      DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/
+      DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/
+      DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/
+      DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/
+      DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/
+      DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/
+      DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/
+      DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/
+      DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/
+      DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/
+      DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/
+      DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/
+      DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/
+      DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/
+      DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/
+      DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/
+      DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/
+      DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/
+      DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/
+      DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/
+      DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/
+      DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/
+      DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/
+      DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/
+      DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/
+      DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/
+      DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/
+      DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/
+      DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/
+      DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/
+      DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/
+      DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/
+      DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/
+      DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/
+      DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/
+      DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/
+      DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/
+      DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/
+      DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/
+      DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/
+      DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/
+      DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/
+      DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/
+      DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/
+      DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/
+      DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/
+      DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/
+      DATA KX(493),KX(494)                                /6,7        /
+      DATA KY(493),KY(494)                                /0,7        /
+C
+C NSIZE IS THE LENGTH OF JCHAR AND INDEX.
+C LEN IS THE LENGTH OF KX AND KY.
+C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRY.
+C LRES IS THE NUMBER OF BITS OF ACCURACY USED FOR INTEGER INPUT TO
+C THE SYSTEM PLOT PACKAGE.
+C
+      DATA NSIZE/46/
+c Variable LEN not used.
+c     DATA LEN/494/
+      DATA LENTRY/.FALSE./
+      DATA LRES/15/
+      DATA DEGRAD/0.017453293/
+      IF (USABLE) GO TO 101
+C
+C  THIS IS A PWRITY CALL
+C
+      CALL Q8QST4 ('GRAPHX','PWRITY','PWRITY','VERSION  1')
+  101 USABLE = .FALSE.
+C
+C SEE IF THIS IS THE FIRST CALL TO PWRITY.
+C
+      IF (LENTRY) GO TO 103
+C
+C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE.
+C
+      LENTRY = .TRUE.
+C
+C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN
+C CHARACTERS.
+C
+      IBLKPT = INDEX(44)
+C
+C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX.
+C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.)
+C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT
+C CALLS TO PWRY.
+C
+      CALL PWRYSO (JCHAR,INDEX,NSIZE)
+C
+C ALL ONE-TIME INITIALIZATION NOW FINISHED.
+C
+C TRANSFORM THE INPUT COORDINATES TO INTEGER SPACE.
+C
+  103 CALL FL2INT (X,Y,IX,IY)
+C
+      NN = N
+      IF (NN .LE. 0) GO TO 113
+      FNNM1 = NN-1
+      JCNT = ICNT
+C
+C GET USER SET RESOLUTION.
+C
+      CALL GETUSV ('XF',LXSAVE)
+      CALL GETUSV ('YF',LYSAVE)
+C
+C PUT RELATIVE SIZE IN Q.
+C
+      Q = ISIZE
+      IF (Q .LE. 3.) GO TO 104
+      Q = Q/FLOAT(ISHIFT(6,LXSAVE-10))
+      GO TO 105
+  104 Q = (1.+.5*(FLOAT(IFIX(Q)+IFIX(Q)/3)))*4./3.
+  105 Q = Q*FLOAT(ISHIFT(1,LRES-10))
+C
+C CALCULATE COMBINED TRANSFORMATION.
+C
+      THETA = FLOAT(ITHETA)*DEGRAD
+      CT = Q*COS(THETA)
+      ST = Q*SIN(THETA)
+C
+C FIND PLOTTER ADDRESS COORDINATES FOR BEGINNING.
+C
+      XC = IX
+      YC = IY
+C
+C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED.
+C
+      XC = XC-WHITE*CT+HIGH*.5*ST
+      YC = YC-WHITE*ST-HIGH*.5*CT
+C
+C CORRECT FOR CENTERING IF TURNED ON.
+C
+      JCENT = MAX0(-1,MIN0(1,JCNT))+2
+      GO TO (107,106,108),JCENT
+  106 XC = XC-CT*FNNM1*WIDE*.5
+      YC = YC-ST*FNNM1*WIDE*.5
+      GO TO 109
+  107 XC = XC+CT*WHITE
+      YC = YC+ST*WHITE
+      GO TO 109
+  108 XC = XC-CT*WHITE
+      YC = YC-ST*WHITE
+      XC = XC-CT*FNNM1*WIDE
+      YC = YC-ST*FNNM1*WIDE
+C
+C SET PLOTTER TO STARTING POINT.
+C
+  109 CALL PLOTIT (IFIX(XC),IFIX(YC),0)
+C
+C PLOT ALL THE CHARACTERS IN THE INPUT STRING.
+C
+      DO 112 K=1,NN
+         YB = YC
+         XB = XC
+         IP = 1
+C
+C EXTRACT CHARACTER NUMBER K FROM THE STRING.
+C
+         KCHAR = ID(K:K)
+C
+C FIND THE TABLE ENTRY.
+C
+         CALL PWRYGT (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+         IF (IPOINT .EQ. -1) IPOINT = IBLKPT
+C
+C DRAW INDIVIDUAL CHARACTER.
+C
+         L = 0
+  110    ISUB = IPOINT+L
+         NX = KX(ISUB)
+         FNX = NX
+         NY = KY(ISUB)
+         FNY = NY
+         L = L+1
+C
+C TEST FOR OP-CODE OR DX AND DY.
+C
+         IF (NX .NE. 7) GO TO 111
+C
+C OP-CODE
+C
+         IP = 0
+         IF (NY-7) 110,112,110
+C
+C DX AND DY
+C
+  111    XC = XB+FNX*CT-FNY*ST
+         YC = YB+FNX*ST+FNY*CT
+C
+C CALL PLOTTING ROUTINE. MODE DETERMINED BY OP-CODE.
+C
+         CALL PLOTIT (IFIX(XC+.5),IFIX(YC+.5),IP)
+         IP = 1
+         GO TO 110
+  112 CONTINUE
+C
+  113 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE PWRYSO (JCHAR,INDEX,NSIZE)
+C
+C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH.  THE RELATIONSHIP
+C BETWEEN JCHAR AND INDEX IS MAINTAINED.  A BUBBLE SORT IS USED.
+C JCHAR IS SORTED IN ASCENDING ORDER.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)   ,JTEMP     ,KTEMP
+      DIMENSION       INDEX(NSIZE)
+      LOGICAL         LDONE
+C
+      ISTART = 1
+      ISTOP = NSIZE
+      ISTEP = 1
+C
+C AT MOST NSIZE PASSES ARE NEEDED.
+C
+      DO 104 NPASS=1,NSIZE
+         LDONE = .TRUE.
+         I = ISTART
+  101    ISUB = I+ISTEP
+         IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102
+C
+C THEY NEED TO BE SWITCHED.
+C
+  102    LDONE = .FALSE.
+         JTEMP = JCHAR(I)
+         KTEMP = JCHAR(ISUB)
+         JCHAR(I) = KTEMP
+         JCHAR(ISUB) = JTEMP
+         ITEMP = INDEX(I)
+         INDEX(I) = INDEX(ISUB)
+         INDEX(ISUB) = ITEMP
+C
+C THEY DO NOT NEED TO BE SWITCHED.
+C
+  103    I = I+ISTEP
+         IF (I .NE. ISTOP) GO TO 101
+C
+C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT.
+C
+         IF (LDONE) RETURN
+C
+C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION.
+C
+         ISTEP  = -ISTEP
+         ITEMP  = ISTART
+         ISTART = ISTOP+ISTEP
+         ISTOP  = ITEMP
+  104 CONTINUE
+      RETURN
+      END
+      SUBROUTINE PWRYGT (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+C
+C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES-
+C PONDING INDEX IN IPOINT.  BINARY HALVING IS USED.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)   ,KCHAR
+      DIMENSION       INDEX(NSIZE)
+C
+C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS
+C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED.
+C
+      KOUNT = 0
+      IBOT = 1
+      ITOP = NSIZE
+      I = ITOP
+      GO TO 102
+  101 I = (IBOT+ITOP)/2
+      KOUNT = KOUNT+1
+      IF (KOUNT .GT. 10) GO TO 106
+  102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104
+  103 IBOT = I
+      GO TO 101
+  104 ITOP = I
+      GO TO 101
+  105 IPOINT = INDEX(I)
+      RETURN
+C
+C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE.
+C
+  106 IPOINT = -1
+      RETURN
+      END
+      SUBROUTINE PWRY (X,Y,ID,N,SIZE,THETA,ICNT)
+C
+C PWRY IS AN OLD ENTRY POINT AND HAS BEEN REMOVED - USE PWRITY
+C ENTRY POINT
+C
+C +NOAO - FTN writes and format statements commented out.
+C     WRITE (I1MACH(4),1001)
+C     WRITE (I1MACH(4),1002)
+C     STOP
+C
+C1001 FORMAT ('1'//////////)
+C1002 FORMAT (' ****************************************'/
+C    1        ' *                                      *'/
+C    2        ' *                                      *'/
+C    3        ' *   THE ENTRY POINT PWRY IS NO LONGER  *'/
+C    4        ' *   SUPPORTED.  PLEASE USE THE MORE    *'/
+C    5        ' *   RECENT VERSION  PWRITY.            *'/
+C    6        ' *                                      *'/
+C    7        ' *                                      *'/
+C    8        ' ****************************************')
+C -NOAO
+      END
+C +NOAO - Blockdata rewritten as subroutine
+C     BLOCKDATA PWRYBD
+      subroutine pwrybd
+      COMMON /PWRCOM/ USABLE
+      LOGICAL         USABLE
+C     DATA USABLE/.FALSE./
+      usable = .false.
+C -NOAO
+C REVISION HISTORY------
+C FEBURARY 1979    CREATED NEW ALGORITHM PWRITY TO REPLACE PWRY
+C                  ADDED REVISION HISTORY
+C JUNE 1979        CHANGE ARGUMENT THETA IN PWRITY FROM FLOATING TO
+C                  INTEGER, USING ITHETA AS THE NEW NAME.  ITS
+C                  MEANING IS NOW DEGREES INSTEAD OF RADIANS.
+C JULY 1984        CONVERTED TO FORTRAN 77 AND GKS
+C-----------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/pwrzi.f b/sys/gio/ncarutil/pwrzi.f
new file mode 100644
index 00000000..d49b9ff5
--- /dev/null
+++ b/sys/gio/ncarutil/pwrzi.f
@@ -0,0 +1,732 @@
+      SUBROUTINE PWRZI (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C LATEST REVISION        JULY, 1984
+C
+C PURPOSE                PWRZI IS A CHARACTER PLOTTING ROUTINE FOR
+C                        PLOTTING CHARACTERS IN THREE-SPACE WHEN USING
+C                        ISOSRF.  FOR A LARGE CLASS OF
+C                        POSSIBLE POSITIONS, THE HIDDEN CHARACTER
+C                        PROBLEM IS SOLVED.
+C
+C                        PWRZI WILL NOT WORK WITH ISOSRFHR.
+C
+C
+C USAGE                  CALL PWRZI (X,Y,Z,ID,N,ISIZE,LINE,ITOP,ICNT)
+C                          USE CALL PWRZI AFTER CALLING
+C                          ISOSRF AND BEFORE CALLING FRAME.
+C
+C ARGUMENTS
+C
+C ON INPUT               X,Y,Z
+C                          POSITIONING COORDINATES FOR THE CHARACTERS
+C                          TO BE DRAWN.  THESE ARE FLOATING POINT
+C                          NUMBERS IN THE SAME THREE-SPACE AS USED IN
+C                          ISOSRF.
+C
+C                        ID
+C                          CHARACTER STRING TO BE DRAWN.  ID IS OF TYPE
+C                          CHARACTER .
+C
+C                        N
+C                          THE NUMBER OF CHARACTERS IN ID.
+C
+C                        ISIZE
+C                          SIZE OF THE CHARACTER:
+C                          .  IF BETWEEN 0 AND 3, ISIZE IS 1., 1.5,
+C                             2., OR 3. TIMES A STANDARD WIDTH EQUAL
+C                             TO 1/128TH OF THE SCREEN WIDTH.
+C                          .  IF GREATER THAN 3, ISIZE IS THE CHARACTER
+C                             WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C                        LINE
+C                          THE DIRECTION IN WHICH THE CHARACTERS ARE TO
+C                          BE WRITTEN.
+C                            1 = +X     -1 = -X
+C                            2 = +Y     -2 = -Y
+C                            3 = +Z     -3 = -Z
+C
+C                        ITOP
+C                          THE DIRECTION FROM THE CENTER OF THE FIRST
+C                          CHARACTER TO THE TOP OF THE FIRST
+C                          CHARACTER (THE POTENTIAL VALUES FOR
+C                          ITOP ARE THE SAME AS THOSE FOR LINE AS
+C                          GIVEN ABOVE.)  NOTE THAT LINE CANNOT
+C                          EQUAL ITOP EVEN IN ABSOLUTE VALUE.
+C
+C                        ICNT
+C                          CENTERING OPTION.
+C                          -1 (X,Y,Z)  IS THE CENTER OF THE LEFT EDGE OF
+C                                      THE FIRST CHARACTER.
+C                          0  (X,Y,Z)  IS THE CENTER OF THE ENTIRE
+C                                      STRING.
+C                          1  (X,Y,Z)  IS THE CENTER OF THE RIGHT EDGE
+C                                      OF THE LAST CHARACTER.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C NOTE                   THE HIDDEN CHARACTER PROBLEM IS SOLVED
+C                        CORRECTLY FOR CHARACTERS NEAR (BUT NOT INSIDE)
+C                        THE THREE-SPACE OBJECT.
+C
+C ENTRY POINTS           PWRZI, INITZI, PWRZOI, PWRZGI
+C
+C COMMON BLOCKS          PWRZ1I,PWRZ2I
+C
+C I/O                    PLOTS CHARACTER(S)
+C
+C PRECISION              SINGLE
+C
+C REQUIRED LIBRARY       ISOSRF, THE ERPRT77 PACKAGE, AND THE SPPS
+C ROUTINES
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                IMPLEMENTED FOR USE WITH ISOSRF.
+C
+C
+C
+C
+C***********************************************************************
+C
+      SAVE
+      CHARACTER*(*)   ID
+      CHARACTER*1     JCHAR(46)  ,KCHAR
+      DIMENSION       INDEX(46)  ,KX(494)    ,KY(494)
+      LOGICAL         LENTRY
+C
+C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS
+C DIGITIZATION.  THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS
+C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON.
+C
+      DATA JCHAR( 1),INDEX( 1)/'A',  1/
+      DATA JCHAR( 2),INDEX( 2)/'B', 13/
+      DATA JCHAR( 3),INDEX( 3)/'C', 28/
+      DATA JCHAR( 4),INDEX( 4)/'D', 40/
+      DATA JCHAR( 5),INDEX( 5)/'E', 49/
+      DATA JCHAR( 6),INDEX( 6)/'F', 60/
+      DATA JCHAR( 7),INDEX( 7)/'G', 68/
+      DATA JCHAR( 8),INDEX( 8)/'H', 82/
+      DATA JCHAR( 9),INDEX( 9)/'I', 92/
+      DATA JCHAR(10),INDEX(10)/'J',104/
+      DATA JCHAR(11),INDEX(11)/'K',113/
+      DATA JCHAR(12),INDEX(12)/'L',123/
+      DATA JCHAR(13),INDEX(13)/'M',130/
+      DATA JCHAR(14),INDEX(14)/'N',137/
+      DATA JCHAR(15),INDEX(15)/'O',143/
+      DATA JCHAR(16),INDEX(16)/'P',157/
+      DATA JCHAR(17),INDEX(17)/'Q',166/
+      DATA JCHAR(18),INDEX(18)/'R',182/
+      DATA JCHAR(19),INDEX(19)/'S',194/
+      DATA JCHAR(20),INDEX(20)/'T',210/
+      DATA JCHAR(21),INDEX(21)/'U',219/
+      DATA JCHAR(22),INDEX(22)/'V',229/
+      DATA JCHAR(23),INDEX(23)/'W',236/
+      DATA JCHAR(24),INDEX(24)/'X',245/
+      DATA JCHAR(25),INDEX(25)/'Y',252/
+      DATA JCHAR(26),INDEX(26)/'Z',262/
+      DATA JCHAR(27),INDEX(27)/'0',273/
+      DATA JCHAR(28),INDEX(28)/'1',286/
+      DATA JCHAR(29),INDEX(29)/'2',296/
+      DATA JCHAR(30),INDEX(30)/'3',308/
+      DATA JCHAR(31),INDEX(31)/'4',326/
+      DATA JCHAR(32),INDEX(32)/'5',339/
+      DATA JCHAR(33),INDEX(33)/'6',352/
+      DATA JCHAR(34),INDEX(34)/'7',368/
+      DATA JCHAR(35),INDEX(35)/'8',378/
+      DATA JCHAR(36),INDEX(36)/'9',398/
+      DATA JCHAR(37),INDEX(37)/'+',414/
+      DATA JCHAR(38),INDEX(38)/'-',423/
+      DATA JCHAR(39),INDEX(39)/'*',429/
+      DATA JCHAR(40),INDEX(40)/'/',444/
+      DATA JCHAR(41),INDEX(41)/'(',448/
+      DATA JCHAR(42),INDEX(42)/')',456/
+      DATA JCHAR(43),INDEX(43)/'=',464/
+      DATA JCHAR(44),INDEX(44)/' ',473/
+      DATA JCHAR(45),INDEX(45)/',',476/
+      DATA JCHAR(46),INDEX(46)/'.',486/
+C
+C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE
+C CHARACTERS.  THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND
+C 7 UNITS TALL.  THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF
+C EACH CHARACTER.  IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING
+C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND
+C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC-
+C TER HAS BEEN REACHED.
+C
+c None of the following variables are used.
+c     DATA WIDE,HIGH,WHITE/6.,7.,2./
+C
+      DATA KX(  1),KX(  2),KX(  3),KX(  4),KX(  5),KX(  6)/0,4,7,0,0,1/
+      DATA KY(  1),KY(  2),KY(  3),KY(  4),KY(  5),KY(  6)/3,3,0,3,6,7/
+      DATA KX(  7),KX(  8),KX(  9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/
+      DATA KY(  7),KY(  8),KY(  9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/
+      DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/
+      DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/
+      DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/
+      DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/
+      DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/
+      DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/
+      DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/
+      DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/
+      DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/
+      DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/
+      DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/
+      DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/
+      DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/
+      DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/
+      DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/
+      DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/
+      DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/
+      DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/
+      DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/
+      DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/
+      DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/
+      DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/
+      DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/
+      DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/
+      DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/
+      DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/
+      DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/
+      DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/
+      DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/
+      DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/
+      DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/
+      DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/
+      DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/
+      DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/
+      DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/
+      DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/
+      DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/
+      DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/
+      DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/
+      DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/
+      DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/
+      DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/
+      DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/
+      DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/
+      DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/
+      DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/
+      DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/
+      DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/
+      DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/
+      DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/
+      DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/
+      DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/
+      DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/
+      DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/
+      DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/
+      DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/
+      DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/
+      DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/
+      DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/
+      DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/
+      DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/
+      DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/
+      DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/
+      DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/
+      DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/
+      DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/
+      DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/
+      DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/
+      DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/
+      DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/
+      DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/
+      DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/
+      DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/
+      DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/
+      DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/
+      DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/
+      DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/
+      DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/
+      DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/
+      DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/
+      DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/
+      DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/
+      DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/
+      DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/
+      DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/
+      DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/
+      DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/
+      DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/
+      DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/
+      DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/
+      DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/
+      DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/
+      DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/
+      DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/
+      DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/
+      DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/
+      DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/
+      DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/
+      DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/
+      DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/
+      DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/
+      DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/
+      DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/
+      DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/
+      DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/
+      DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/
+      DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/
+      DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/
+      DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/
+      DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/
+      DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/
+      DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/
+      DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/
+      DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/
+      DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/
+      DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/
+      DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/
+      DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/
+      DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/
+      DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/
+      DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/
+      DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/
+      DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/
+      DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/
+      DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/
+      DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/
+      DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/
+      DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/
+      DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/
+      DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/
+      DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/
+      DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/
+      DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/
+      DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/
+      DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/
+      DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/
+      DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/
+      DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/
+      DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/
+      DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/
+      DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/
+      DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/
+      DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/
+      DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/
+      DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/
+      DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/
+      DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/
+      DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/
+      DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/
+      DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/
+      DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/
+      DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/
+      DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/
+      DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/
+      DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/
+      DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/
+      DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/
+      DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/
+      DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/
+      DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/
+      DATA KX(493),KX(494)                                /6,7        /
+      DATA KY(493),KY(494)                                /0,7        /
+C
+C NSIZE IS THE LENGTH OF JCHAR AND INDEX.
+C LNGTH IS THE LENGTH OF KX AND KY.
+C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRZI.
+C
+      DATA NSIZE/46/
+c Variable LNGTH is not used.
+c     DATA LNGTH/494/
+      DATA LENTRY/.FALSE./
+      DATA ITHETA/0/
+      DATA IDUM1,IDUM2,IDUM3/1,1,1/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','PWRZI','PWRZI','VERSION  1')
+C
+C SEE IF THIS IS THE FIRST CALL TO PWRZI
+C
+      IF (LENTRY) GO TO 103
+C
+C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE.
+C
+      LENTRY = .TRUE.
+C
+C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN
+C CHARACTERS.
+C
+      IBLKPT = INDEX(44)
+C
+C CHANGE EACH CHARACTER IN THE TABLE TO RIGHT JUSTIFIED, ZERO FILLED.
+C
+C
+C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX.
+C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.)
+C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT
+C CALLS TO PWRZI.
+C
+      CALL PWRZOI (JCHAR,INDEX,NSIZE)
+C
+C ALL ONE-TIME INITIALIZATION NOW FINISHED.
+C
+  103 CONTINUE
+C
+      NN = N
+      IF (NN .LE. 0) RETURN
+      FNNM1 = NN-1
+      JCNT = ICNT
+C
+C PUT RELATIVE SIZE IN Q, ADJUST FOR CURRENT PLOTTER RESOLUTION
+C
+      CALL GETUSV ('XF',LX)
+      SCALE = 32.
+      IF (ISIZE .EQ. 0) Q = 1.3334*SCALE
+      IF (ISIZE .EQ. 1) Q = 2.*SCALE
+      IF (ISIZE .EQ. 2) Q = 2.6667*SCALE
+      IF (ISIZE .EQ. 3) Q = 4.*SCALE
+      IF (ISIZE .GT. 3) Q = FLOAT(ISIZE)*(2**(15-LX))/6.
+C
+C PUT ANGLE IN RADIANS IN T.
+C
+      T = FLOAT(ITHETA)*1.5708
+  104 CONTINUE
+C
+C CALCULATE COMBINED TRANSFORMATION
+C
+      CT = Q*COS(T)
+      ST = Q*SIN(T)
+C
+C FIND CRT COORDINATES OF CENTER.
+C
+      LINEI = LIN3
+      CALL INTZI (X,Y,Z,LINEI,ITOP)
+      IF (LINEI .EQ. 0) RETURN
+      IX = 0
+      IY = 0
+      XC = IX
+      YC = IY
+C
+C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED.
+C
+      XC = XC-2.*CT+3.5*ST
+      YC = YC-2.*ST-3.5*CT
+C
+C CORRECT FOR CENTERING IF TURNED ON.
+C
+      JCNT = MAX0(-1,MIN0(1,JCNT))+2
+      GO TO (108,107,109),JCNT
+  107 XC = XC-CT*FNNM1*3.
+      YC = YC-ST*FNNM1*3.
+      GO TO 110
+  108 XC = XC+CT*2.
+      YC = YC+ST*2.
+      GO TO 110
+  109 XC = XC-CT*2.
+      YC = YC-ST*2.
+      XC = XC-CT*FNNM1*6.
+      YC = YC-ST*FNNM1*6.
+  110 CALL INITZI (IFIX(XC),IFIX(YC),1,IDUM1,IDUM2,2)
+      CALL INITZI (IFIX(XC+CT*6.*FNNM1),IFIX(YC+ST*6.*FNNM1),2,IDUM1,
+     +             IDUM2,2)
+      CALL INITZI (IFIX(XC),IFIX(YC),IDUM1,IDUM2,IDUM3,3)
+      DO 114 K=1,NN
+         XB = XC
+         YB = YC
+         IP = 1
+C
+C EXTRACT CHARACTER NUMBER K FROM THE STRING.
+C
+         KCHAR = ID(K:K)
+C
+C FIND THE TABLE ENTRY.
+C
+       CALL PWRZGI (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+       IF (IPOINT .EQ. -1) IPOINT = IBLKPT
+C
+C ALWAYS LESS THAN 20 INSTRUCTIONS.
+C
+       DO 113 L=1,20
+          ISUB = IPOINT+L-1
+          NX = KX(ISUB)
+          FNX = NX
+          NY = KY(ISUB)
+          FNY = NY
+C
+C TEST FOR OP-CODE OR DX AND DY.
+C
+          IF (NX .NE. 7) GO TO 111
+C
+C OP-CODE
+C
+          IP = 0
+          IF (NY-7) 113,114,113
+C
+C DX AND DY
+C
+  111     XC = XB+FNX*CT-FNY*ST
+          YC = YB+FNX*ST+FNY*CT
+C
+C CALL DESIRED PLOTTING ROUTINE.  DETERMINED BY OP-CODES.
+C
+          IF (IP .NE. 0) GO TO 112
+      CALL INITZI (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,3)
+          IP = 1
+          GO TO 113
+  112 CALL INITZI (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,4)
+  113  CONTINUE
+  114 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE INTZI (XX,YY,ZZ,LIN3,ITOP)
+C
+C FORCE STORAGE OF X, Y, AND Z INTO COMMON BLOCK
+C
+      COMMON /PWRZ2I/ X, Y, Z
+      DATA IDUMX,IDUMY,IDUMZ /0, 0, 0/
+      X = XX
+      Y = YY
+      Z = ZZ
+      CALL INITZI (IDUMX,IDUMY,IDUMZ,LIN3,ITOP,1)
+      RETURN
+      END
+      SUBROUTINE INITZI (IX,IY,IZ,LIN3,ITOP,IENT)
+C
+      SAVE
+      COMMON /PWRZ1I/ XXMIN      ,XXMAX      ,YYMIN      ,YYMAX      ,
+     +                ZZMIN      ,ZZMAX      ,DELCRT     ,EYEX       ,
+     +                EYEY       ,EYEZ
+C
+      COMMON /PWRZ2I/ X          ,Y          ,Z
+      FX(R) = R+FACTX*FLOAT(IX)
+      FY(R) = R+FACTY*FLOAT(IY)
+C
+C
+C  DETERMINE INITZI,VISSET,FRSTZ OR VECTZ CALL
+C
+      GO TO (1000,2000,3000,4000),IENT
+ 1000 LIN = MAX0(1,MIN0(3,IABS(LIN3)))
+      ITO = MAX0(1,MIN0(3,IABS(ITOP)))
+C
+C SET UP SCALING CONSTANTS
+C
+      DELMAX = AMAX1(XXMAX-XXMIN,YYMAX-YYMIN,ZZMAX-ZZMIN)
+      FACTOR = DELMAX/DELCRT
+      FACTX = SIGN(FACTOR,FLOAT(LIN3))
+      FACTY = SIGN(FACTOR,FLOAT(ITOP))
+C
+C SET UP FOR PROPER PLANE
+C
+      JUMP1 = LIN+(ITO-1)*3
+      GO TO (108,101,102,103,108,104,105,106,108),JUMP1
+  101 ASSIGN 111 TO JUMP
+      GO TO 107
+  102 ASSIGN 112 TO JUMP
+      GO TO 107
+  103 ASSIGN 113 TO JUMP
+      GO TO 107
+  104 ASSIGN 114 TO JUMP
+      GO TO 107
+  105 ASSIGN 115 TO JUMP
+      GO TO 107
+  106 ASSIGN 116 TO JUMP
+  107 RETURN
+  108 CALL SETER ('INITZI - LINE OR ITOP IMPROPER IN PWRZI CALL' ,1,1)
+      LIN3 = 0
+      RETURN
+C
+C **************************** ENTRY VISSET ****************************
+C     ENTRY VISSET (IX,IY,IZ)
+C
+C
+C VISSET IS CALLED ONCE FOR EACH END OF THE CHARACTER STRING
+C
+ 2000 IVIS = -1
+      ITEMP = 0
+      GO TO 110
+C
+C SEE IF THIS END COULD BE BEHIND THE OBJECT
+C
+  109 IF (EYEX.GT.XXMAX .AND. XX.GT.XXMAX) ITEMP = ITEMP+1
+      IF (EYEY.GT.YYMAX .AND. YY.GT.YYMAX) ITEMP = ITEMP+1
+      IF (EYEZ.GT.ZZMAX .AND. ZZ.GT.ZZMAX) ITEMP = ITEMP+1
+      IF (EYEX.LT.XXMIN .AND. XX.LT.XXMIN) ITEMP = ITEMP+1
+      IF (EYEY.LT.YYMIN .AND. YY.LT.YYMIN) ITEMP = ITEMP+1
+      IF (EYEZ.LT.ZZMIN .AND. ZZ.LT.ZZMIN) ITEMP = ITEMP+1
+      IF (IZ .EQ. 1) IVISS = ITEMP
+C
+C IF EITHER END CHARACTER COULD BE HIDDEN, TEST ALL LINE SEGMENTS.
+C
+      IF (IZ .EQ. 2) IVIS = MIN0(IVISS,ITEMP)
+      RETURN
+C
+C **************************** ENTRY FRSTZ *****************************
+C     ENTRY FRSTZ (IX,IY)
+C
+ 3000 IFRST = 1
+      GO TO 110
+C
+C **************************** ENTRY VECTZ *****************************
+C     ENTRY VECTZ (IX,IY)
+C
+ 4000 IFRST = 0
+C
+C PICK CORRECT 3-SPACE PLANE TO DRAW IN
+C
+  110 GO TO JUMP,(111,112,113,114,115,116)
+  111 XX = FY(X)
+      YY = FX(Y)
+      ZZ = Z
+      GO TO 117
+  112 XX = FY(X)
+      YY = Y
+      ZZ = FX(Z)
+      GO TO 117
+  113 XX = FX(X)
+      YY = FY(Y)
+      ZZ = Z
+      GO TO 117
+  114 XX = X
+      YY = FY(Y)
+      ZZ = FX(Z)
+      GO TO 117
+  115 XX = FX(X)
+      YY = Y
+      ZZ = FY(Z)
+      GO TO 117
+  116 XX = X
+      YY = FX(Y)
+      ZZ = FY(Z)
+C
+C TRANSLATE TO 2-SPACE
+C
+  117 CALL TRN32I (XX,YY,ZZ,XT,YT,DUMMY,2)
+      IF (IVIS) 109,121,118
+  118 IF (IFRST) 119,120,119
+C
+C IF IN FRONT, DRAW IN ANY CASE.
+C
+  119 CALL PLOTIT (IFIX(XT),IFIX(YT),0)
+      RETURN
+  120 CALL PLOTIT (IFIX(XT),IFIX(YT),1)
+      RETURN
+  121 IF (IFRST) 122,123,122
+  122 IX1 = XT
+      IY1 = YT
+      RETURN
+  123 IX2 = XT
+      IY2 = YT
+C
+C IF COULD BE HIDDEN, USE HIDDEN LINE PLOTTING ENTRY IN ISOSRF
+C
+      CALL DRAWI (IX1,IY1,IX2,IY2)
+      IX1 = IX2
+      IY1 = IY2
+      RETURN
+      END
+      SUBROUTINE PWRZOI (JCHAR,INDEX,NSIZE)
+C
+C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH.  THE RELATIONSHIP
+C BETWEEN JCHAR AND INDEX IS MAINTAINED.  A BUBBLE SORT IS USED.
+C JCHAR IS SORTED IN ASCENDING ORDER.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,JTEMP     ,KTEMP
+      DIMENSION       INDEX(NSIZE)
+      LOGICAL         LDONE
+C
+      ISTART = 1
+      ISTOP = NSIZE
+      ISTEP = 1
+C
+C AT MOST NSIZE PASSES ARE NEEDED.
+C
+      DO 104 NPASS=1,NSIZE
+       LDONE = .TRUE.
+       I = ISTART
+  101  ISUB = I+ISTEP
+       IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102
+C
+C THEY NEED TO BE SWITCHED.
+C
+  102  LDONE = .FALSE.
+       JTEMP = JCHAR(I)
+       KTEMP = JCHAR(ISUB)
+       JCHAR(I) = KTEMP
+       JCHAR(ISUB) = JTEMP
+       ITEMP = INDEX(I)
+       INDEX(I) = INDEX(ISUB)
+       INDEX(ISUB) = ITEMP
+C
+C THEY DO NOT NEED TO BE SWITCHED.
+C
+  103  I = I+ISTEP
+       IF (I .NE. ISTOP) GO TO 101
+C
+C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT.
+C
+       IF (LDONE) RETURN
+C
+C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION.
+C
+       ISTEP = -ISTEP
+       ITEMP = ISTART
+       ISTART = ISTOP+ISTEP
+       ISTOP = ITEMP
+  104 CONTINUE
+      RETURN
+      END
+      SUBROUTINE PWRZGI (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+C
+C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES-
+C PONDING INDEX IN IPOINT.  BINARY HALVING IS USED.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,KCHAR
+      DIMENSION       INDEX(NSIZE)
+C
+C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS
+C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED.
+C
+      KOUNT = 0
+      IBOT = 1
+      ITOP = NSIZE
+      I = ITOP
+      GO TO 102
+  101 I = (IBOT+ITOP)/2
+      KOUNT = KOUNT+1
+      IF (KOUNT .GT. 10) GO TO 106
+  102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104
+  103 IBOT = I
+      GO TO 101
+  104 ITOP = I
+      GO TO 101
+  105 IPOINT = INDEX(I)
+      RETURN
+C
+C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE.
+C
+  106 IPOINT = -1
+      RETURN
+C
+C
+C
+C REVISION HISTORY----------
+C
+C MARCH    1980    FIRST ADDED TO ULIB AS A SEPARATE FILE TO BE
+C                  USED IN CONJUNCTION WITH THE ULIB ROUTINE
+C                  ISOSRF
+C
+C JULY     1984    CONVERTED TO GKS AND FORTRAN 77
+C------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/pwrzs.f b/sys/gio/ncarutil/pwrzs.f
new file mode 100644
index 00000000..cfda613e
--- /dev/null
+++ b/sys/gio/ncarutil/pwrzs.f
@@ -0,0 +1,772 @@
+      SUBROUTINE PWRZS (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C LATEST REVISION        JULY, 1984
+C
+C PURPOSE                PWRZS IS A CHARACTER PLOTTING ROUTINE FOR
+C                        PLOTTING CHARACTERS IN THREE-SPACE WHEN USING
+C                        SRFACE.  FOR A LARGE CLASS OF
+C                        POSSIBLE POSITIONS, THE HIDDEN CHARACTER
+C                        PROBLEM IS SOLVED.
+C
+C
+C
+C USAGE                  CALL PWRZS (X,Y,Z,ID,N,ISIZE,LINE,ITOP,ICNT)
+C                          USE CALL PWRZS AFTER CALLING
+C                          SRFACE AND BEFORE CALLING FRAME
+C                            NOTE:  SRFACE WILL HAVE TO BE CHANGED
+C                                   TO SUPPRESS THE FRAME CALL.  SEE IFR
+C                                   IN SRFACE INTERNAL PARAMETERS.
+C
+C ARGUMENTS
+C
+C ON INPUT               X,Y,Z
+C                          POSITIONING COORDINATES FOR THE CHARACTERS
+C                          TO BE DRAWN.  THESE ARE FLOATING POINT
+C                          NUMBERS IN THE SAME THREE-SPACE AS USED IN
+C                          SRFACE.
+C
+C                        ID
+C                          CHARACTER STRING TO BE DRAWN
+C
+C                        N
+C                          THE NUMBER OF CHARACTERS IN ID
+C
+C                        ISIZE
+C                          SIZE OF THE CHARACTER
+C                          .  IF BETWEEN 0 AND 3 THE FACTOR IS 1., 1.5,
+C                             2., OR 3. TIMES A STANDARD WIDTH EQUAL
+C                             TO 1/128TH OF THE SCREEN WIDTH.
+C                          .  IF GREATER THAN 3 IT IS THE CHARACTER
+C                             WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C                        LINE
+C                          THE DIRECTION IN WHICH THE CHARACTERS ARE TO
+C                          BE WRITTEN.
+C                            1 = +X     -1 = -X
+C                            2 = +Y     -2 = -Y
+C                            3 = +Z     -3 = -Z
+C
+C                        ITOP
+C                          THE DIRECTION FROM THE CENTER OF THE FIRST
+C                          CHARACTER TO THE TOP OF THE FIRST
+C                          CHARACTER.  NOTE THAT LINE CANNOT
+C                          EQUAL ITOP EVEN IN ABSOLUTE VALUE.
+C
+C                        ICNT
+C                          CENTERING OPTION.
+C                          -1 (X,Y,Z)  IS THE CENTER OF THE LEFT EDGE OF
+C                                      THE FIRST CHARACTER.
+C                          0  (X,Y,Z)  IS THE CENTER OF THE ENTIRE
+C                                      STRING.
+C                          1  (X,Y,Z)  IS THE CENTER OF THE RIGHT EDGE
+C                                      OF THE LAST CHARACTER.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C NOTE                   THE HIDDEN CHARACTER PROBLEM IS SOLVED
+C                        CORRECTLY FOR CHARACTERS NEAR (BUT NOT INSIDE)
+C                        THE THREE-SPACE OBJECT.
+C
+C ENTRY POINTS           PWRZS, INITZS, PWRZOS, PWRZGS
+C
+C COMMON BLOCKS          PWRZ1S,PWRZ2S
+C
+C I/O                    PLOTS CHARACTER(S)
+C
+C PRECISION              SINGLE
+C
+C REQUIRED LIBRARY       SRFACE
+C ROUTINES
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                IMPLEMENTED FOR USE WITH SRFACE.
+C
+C
+C
+C
+C***********************************************************************
+C
+      SAVE
+      CHARACTER*(*)   ID
+      CHARACTER*1     JCHAR(46)  ,KCHAR
+      DIMENSION       INDEX(46)  ,KX(494)    ,KY(494)
+      DIMENSION       VWPRT(4)   ,WNDW(4)
+      LOGICAL         LENTRY
+c +NOAO:  common block added for user control of viewport
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c -NOAO
+C
+C
+C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS
+C DIGITIZATION.  THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS
+C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON.
+C
+      DATA JCHAR( 1),INDEX( 1)/'A',  1/
+      DATA JCHAR( 2),INDEX( 2)/'B', 13/
+      DATA JCHAR( 3),INDEX( 3)/'C', 28/
+      DATA JCHAR( 4),INDEX( 4)/'D', 40/
+      DATA JCHAR( 5),INDEX( 5)/'E', 49/
+      DATA JCHAR( 6),INDEX( 6)/'F', 60/
+      DATA JCHAR( 7),INDEX( 7)/'G', 68/
+      DATA JCHAR( 8),INDEX( 8)/'H', 82/
+      DATA JCHAR( 9),INDEX( 9)/'I', 92/
+      DATA JCHAR(10),INDEX(10)/'J',104/
+      DATA JCHAR(11),INDEX(11)/'K',113/
+      DATA JCHAR(12),INDEX(12)/'L',123/
+      DATA JCHAR(13),INDEX(13)/'M',130/
+      DATA JCHAR(14),INDEX(14)/'N',137/
+      DATA JCHAR(15),INDEX(15)/'O',143/
+      DATA JCHAR(16),INDEX(16)/'P',157/
+      DATA JCHAR(17),INDEX(17)/'Q',166/
+      DATA JCHAR(18),INDEX(18)/'R',182/
+      DATA JCHAR(19),INDEX(19)/'S',194/
+      DATA JCHAR(20),INDEX(20)/'T',210/
+      DATA JCHAR(21),INDEX(21)/'U',219/
+      DATA JCHAR(22),INDEX(22)/'V',229/
+      DATA JCHAR(23),INDEX(23)/'W',236/
+      DATA JCHAR(24),INDEX(24)/'X',245/
+      DATA JCHAR(25),INDEX(25)/'Y',252/
+      DATA JCHAR(26),INDEX(26)/'Z',262/
+      DATA JCHAR(27),INDEX(27)/'0',273/
+      DATA JCHAR(28),INDEX(28)/'1',286/
+      DATA JCHAR(29),INDEX(29)/'2',296/
+      DATA JCHAR(30),INDEX(30)/'3',308/
+      DATA JCHAR(31),INDEX(31)/'4',326/
+      DATA JCHAR(32),INDEX(32)/'5',339/
+      DATA JCHAR(33),INDEX(33)/'6',352/
+      DATA JCHAR(34),INDEX(34)/'7',368/
+      DATA JCHAR(35),INDEX(35)/'8',378/
+      DATA JCHAR(36),INDEX(36)/'9',398/
+      DATA JCHAR(37),INDEX(37)/'+',414/
+      DATA JCHAR(38),INDEX(38)/'-',423/
+      DATA JCHAR(39),INDEX(39)/'*',429/
+      DATA JCHAR(40),INDEX(40)/'/',444/
+      DATA JCHAR(41),INDEX(41)/'(',448/
+      DATA JCHAR(42),INDEX(42)/')',456/
+      DATA JCHAR(43),INDEX(43)/'=',464/
+      DATA JCHAR(44),INDEX(44)/' ',473/
+      DATA JCHAR(45),INDEX(45)/',',476/
+      DATA JCHAR(46),INDEX(46)/'.',486/
+C
+C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE
+C CHARACTERS.  THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND
+C 7 UNITS TALL.  THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF
+C EACH CHARACTER.  IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING
+C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND
+C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC-
+C TER HAS BEEN REACHED.
+C
+c None of the following are used anywere.
+c     DATA WIDE,HIGH,WHITE/6.,7.,2./
+C
+      DATA KX(  1),KX(  2),KX(  3),KX(  4),KX(  5),KX(  6)/0,4,7,0,0,1/
+      DATA KY(  1),KY(  2),KY(  3),KY(  4),KY(  5),KY(  6)/3,3,0,3,6,7/
+      DATA KX(  7),KX(  8),KX(  9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/
+      DATA KY(  7),KY(  8),KY(  9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/
+      DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/
+      DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/
+      DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/
+      DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/
+      DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/
+      DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/
+      DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/
+      DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/
+      DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/
+      DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/
+      DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/
+      DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/
+      DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/
+      DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/
+      DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/
+      DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/
+      DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/
+      DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/
+      DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/
+      DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/
+      DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/
+      DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/
+      DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/
+      DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/
+      DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/
+      DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/
+      DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/
+      DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/
+      DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/
+      DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/
+      DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/
+      DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/
+      DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/
+      DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/
+      DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/
+      DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/
+      DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/
+      DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/
+      DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/
+      DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/
+      DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/
+      DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/
+      DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/
+      DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/
+      DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/
+      DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/
+      DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/
+      DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/
+      DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/
+      DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/
+      DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/
+      DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/
+      DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/
+      DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/
+      DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/
+      DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/
+      DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/
+      DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/
+      DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/
+      DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/
+      DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/
+      DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/
+      DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/
+      DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/
+      DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/
+      DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/
+      DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/
+      DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/
+      DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/
+      DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/
+      DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/
+      DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/
+      DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/
+      DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/
+      DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/
+      DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/
+      DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/
+      DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/
+      DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/
+      DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/
+      DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/
+      DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/
+      DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/
+      DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/
+      DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/
+      DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/
+      DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/
+      DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/
+      DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/
+      DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/
+      DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/
+      DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/
+      DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/
+      DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/
+      DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/
+      DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/
+      DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/
+      DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/
+      DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/
+      DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/
+      DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/
+      DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/
+      DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/
+      DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/
+      DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/
+      DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/
+      DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/
+      DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/
+      DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/
+      DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/
+      DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/
+      DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/
+      DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/
+      DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/
+      DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/
+      DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/
+      DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/
+      DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/
+      DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/
+      DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/
+      DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/
+      DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/
+      DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/
+      DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/
+      DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/
+      DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/
+      DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/
+      DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/
+      DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/
+      DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/
+      DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/
+      DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/
+      DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/
+      DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/
+      DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/
+      DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/
+      DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/
+      DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/
+      DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/
+      DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/
+      DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/
+      DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/
+      DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/
+      DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/
+      DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/
+      DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/
+      DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/
+      DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/
+      DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/
+      DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/
+      DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/
+      DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/
+      DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/
+      DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/
+      DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/
+      DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/
+      DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/
+      DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/
+      DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/
+      DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/
+      DATA KX(493),KX(494)                                /6,7        /
+      DATA KY(493),KY(494)                                /0,7        /
+C
+C NSIZE IS THE LENGTH OF JCHAR AND INDEX.
+C LNGTH IS THE LENGTH OF KX AND KY.
+C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRZS.
+C
+      DATA NSIZE/46/
+c Variable LNGTH never used.
+c     DATA LNGTH/494/
+      DATA LENTRY/.FALSE./
+      DATA ITHETA/0/
+      DATA IDUM1,IDUM2,IDUM3/1,1,1/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','PWRZS','PWRZS','VERSION  1')
+C
+C INQUIRE CURRENT NORMALIZATION TRANS NUMBER
+C
+      CALL GQCNTN (IERR,NTORIG)
+C
+C SAVE NORMALIZATION TRANS 1 AND LOG SCALING FLAG
+C
+      CALL GQNT (1,IERR,WNDW,VWPRT)
+      CALL GETUSV('LS',IOLLS)
+C
+C DEFINE NORMALIZATION TRANS 1 FOR USE WITH DRAWS
+C
+c +NOAO: device viewport now user controlled through common noaovp
+      call set (vpx1, vpx2, vpy1, vpy2, 1., 1024., 1., 1024., 1)
+c     CALL SET(0.0,1.0,0.0,1.0,1.0,1024.0,1.0,1024.0,1)
+c-NOAO
+C
+C SEE IF THIS IS THE FIRST CALL TO PWRZS
+C
+      IF (LENTRY) GO TO 103
+C
+C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE.
+C
+      LENTRY = .TRUE.
+C
+C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN
+C CHARACTERS.
+C
+      IBLKPT = INDEX(44)
+C
+C CHANGE EACH CHARACTER IN THE TABLE TO RIGHT JUSTIFIED, ZERO FILLED.
+C
+C
+C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX.
+C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.)
+C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT
+C CALLS TO PWRZS.
+C
+      CALL PWRZOS (JCHAR,INDEX,NSIZE)
+C
+C ALL ONE-TIME INITIALIZATION NOW FINISHED.
+C
+  103 CONTINUE
+C
+      NN = N
+      IF (NN .LE. 0) RETURN
+      FNNM1 = NN-1
+      JCNT = ICNT
+C
+C PUT RELATIVE SIZE IN Q, ADJUST FOR CURRENT PLOTTER RESOLUTION
+C
+      CALL GETUSV ('XF',LX)
+      SCALE = 2.**(LX-10)
+      IF (ISIZE .EQ. 0) Q = 1.3334*SCALE
+      IF (ISIZE .EQ. 1) Q = 2.*SCALE
+      IF (ISIZE .EQ. 2) Q = 2.6667*SCALE
+      IF (ISIZE .EQ. 3) Q = 4.*SCALE
+      IF (ISIZE .GT. 3) Q = FLOAT(ISIZE)/(6.)
+C
+C PUT ANGLE IN RADIANS IN T.
+C
+      T = FLOAT(ITHETA)*1.5708
+  104 CONTINUE
+C
+C CALCULATE COMBINED TRANSFORMATION
+C
+      CT = Q*COS(T)
+      ST = Q*SIN(T)
+C
+C FIND CRT COORDINATES OF CENTER.
+C
+      LINEI = LIN3
+      CALL INTZS (X,Y,Z,LINEI,ITOP)
+      IF (LINEI .EQ. 0) RETURN
+      IX = 0
+      IY = 0
+      XC = IX
+      YC = IY
+C
+C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED.
+C
+      XC = XC-2.*CT+3.5*ST
+      YC = YC-2.*ST-3.5*CT
+C
+C CORRECT FOR CENTERING IF TURNED ON.
+C
+      JCNT = MAX0(-1,MIN0(1,JCNT))+2
+      GO TO (108,107,109),JCNT
+  107 XC = XC-CT*FNNM1*3.
+      YC = YC-ST*FNNM1*3.
+      GO TO 110
+  108 XC = XC+CT*2.
+      YC = YC+ST*2.
+      GO TO 110
+  109 XC = XC-CT*2.
+      YC = YC-ST*2.
+      XC = XC-CT*FNNM1*6.
+      YC = YC-ST*FNNM1*6.
+  110 CALL INITZS (IFIX(XC),IFIX(YC),1,IDUM1,IDUM2,2)
+      CALL INITZS (IFIX(XC+CT*6.*FNNM1),IFIX(YC+ST*6.*FNNM1),2,IDUM1,
+     +             IDUM2,2)
+      CALL INITZS (IFIX(XC),IFIX(YC),IDUM1,IDUM2,IDUM3,3)
+      DO 114 K=1,NN
+         XB = XC
+         YB = YC
+         IP = 1
+C
+C EXTRACT CHARACTER NUMBER K FROM THE STRING.
+C
+         KCHAR = ID(K:K)
+C
+C FIND THE TABLE ENTRY.
+C
+       CALL PWRZGS (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+       IF (IPOINT .EQ. -1) IPOINT = IBLKPT
+C
+C ALWAYS LESS THAN 20 INSTRUCTIONS.
+C
+       DO 113 L=1,20
+          ISUB = IPOINT+L-1
+          NX = KX(ISUB)
+          FNX = NX
+          NY = KY(ISUB)
+          FNY = NY
+C
+C TEST FOR OP-CODE OR DX AND DY.
+C
+          IF (NX .NE. 7) GO TO 111
+C
+C OP-CODE
+C
+          IP = 0
+          IF (NY-7) 113,114,113
+C
+C DX AND DY
+C
+  111     XC = XB+FNX*CT-FNY*ST
+          YC = YB+FNX*ST+FNY*CT
+C
+C CALL DESIRED PLOTTING ROUTINE.  DETERMINED BY OP-CODES.
+C
+          IF (IP .NE. 0) GO TO 112
+      CALL INITZS (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,3)
+          IP = 1
+          GO TO 113
+  112 CALL INITZS (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,4)
+  113  CONTINUE
+  114 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+C
+C RESTORE NORMALIZATION TRANS 1 AND LOG SCALING
+C
+      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     +         WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      CALL GSELNT (NTORIG)
+      RETURN
+      END
+      SUBROUTINE INTZS (XX,YY,ZZ,LIN3,ITOP)
+C
+C FORCE STORAGE OF X, Y, AND Z INTO COMMON BLOCK
+C
+      COMMON /PWRZ2S/ X, Y, Z
+      DATA IDUMX,IDUMY,IDUMZ /0, 0, 0/
+      X = XX
+      Y = YY
+      Z = ZZ
+      CALL INITZS (IDUMX,IDUMY,IDUMZ,LIN3,ITOP,1)
+      RETURN
+      END
+      SUBROUTINE INITZS (IX,IY,IZ,LIN3,ITOP,IENT)
+C
+      SAVE
+      COMMON /PWRZ1S/ XXMIN ,XXMAX ,YYMIN ,YYMAX ,
+     +                ZZMIN ,ZZMAX ,DELCRT,EYEX  ,
+     +                EYEY       ,EYEZ
+C
+      COMMON /PWRZ2S/ X          ,Y          ,Z
+c +NOAO:  common block added to allow user control of device viewport.
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c -NOAO
+      FX(R) = R+FACTX*FLOAT(IX)
+      FY(R) = R+FACTY*FLOAT(IY)
+C
+C
+C  DETERMINE INITZS,VISSET,FRSTZ OR VECTZ CALL
+C
+      GO TO (1000,2000,3000,4000),IENT
+ 1000 LIN = MAX0(1,MIN0(3,IABS(LIN3)))
+      ITO = MAX0(1,MIN0(3,IABS(ITOP)))
+C
+C SET UP SCALING CONSTANTS
+C
+      DELMAX = AMAX1(XXMAX-XXMIN,YYMAX-YYMIN,ZZMAX-ZZMIN)
+      FACTOR = DELMAX/DELCRT
+      FACTX = SIGN(FACTOR,FLOAT(LIN3))
+      FACTY = SIGN(FACTOR,FLOAT(ITOP))
+C
+C SET UP FOR PROPER PLANE
+C
+      JUMP1 = LIN+(ITO-1)*3
+      GO TO (108,101,102,103,108,104,105,106,108),JUMP1
+  101 ASSIGN 111 TO JUMP
+      GO TO 107
+  102 ASSIGN 112 TO JUMP
+      GO TO 107
+  103 ASSIGN 113 TO JUMP
+      GO TO 107
+  104 ASSIGN 114 TO JUMP
+      GO TO 107
+  105 ASSIGN 115 TO JUMP
+      GO TO 107
+  106 ASSIGN 116 TO JUMP
+  107 RETURN
+  108 CALL SETER ('INITZS - LINE OR ITOP IMPROPER IN PWRZS CALL' ,1,1)
+      LIN3 = 0
+      RETURN
+C
+C **************************** ENTRY VISSET ****************************
+C     ENTRY VISSET (IX,IY,IZ)
+C
+C
+C VISSET IS CALLED ONCE FOR EACH END OF THE CHARACTER STRING
+C
+ 2000 IVIS = -1
+      ITEMP = 0
+      GO TO 110
+C
+C SEE IF THIS END COULD BE BEHIND THE OBJECT
+C
+  109 IF (EYEX.GT.XXMAX .AND. XX.GT.XXMAX) ITEMP = ITEMP+1
+      IF (EYEY.GT.YYMAX .AND. YY.GT.YYMAX) ITEMP = ITEMP+1
+      IF (EYEZ.GT.ZZMAX .AND. ZZ.GT.ZZMAX) ITEMP = ITEMP+1
+      IF (EYEX.LT.XXMIN .AND. XX.LT.XXMIN) ITEMP = ITEMP+1
+      IF (EYEY.LT.YYMIN .AND. YY.LT.YYMIN) ITEMP = ITEMP+1
+      IF (EYEZ.LT.ZZMIN .AND. ZZ.LT.ZZMIN) ITEMP = ITEMP+1
+      IF (IZ .EQ. 1) IVISS = ITEMP
+C
+C IF EITHER END CHARACTER COULD BE HIDDEN, TEST ALL LINE SEGMENTS.
+C
+      IF (IZ .EQ. 2) IVIS = MIN0(IVISS,ITEMP)
+      RETURN
+C
+C **************************** ENTRY FRSTZ *****************************
+C     ENTRY FRSTZ (IX,IY)
+C
+ 3000 IFRST = 1
+      GO TO 110
+C
+C **************************** ENTRY VECTZ *****************************
+C     ENTRY VECTZ (IX,IY)
+C
+ 4000 IFRST = 0
+C
+C PICK CORRECT 3-SPACE PLANE TO DRAW IN
+C
+  110 GO TO JUMP,(111,112,113,114,115,116)
+  111 XX = FY(X)
+      YY = FX(Y)
+      ZZ = Z
+      GO TO 117
+  112 XX = FY(X)
+      YY = Y
+      ZZ = FX(Z)
+      GO TO 117
+  113 XX = FX(X)
+      YY = FY(Y)
+      ZZ = Z
+      GO TO 117
+  114 XX = X
+      YY = FY(Y)
+      ZZ = FX(Z)
+      GO TO 117
+  115 XX = FX(X)
+      YY = Y
+      ZZ = FY(Z)
+      GO TO 117
+  116 XX = X
+      YY = FX(Y)
+      ZZ = FY(Z)
+C
+C TRANSLATE TO 2-SPACE
+C
+  117 CALL TRN32S (XX,YY,ZZ,XT,YT,DUMMY,1)
+      IF (IVIS) 109,121,118
+  118 IF (IFRST) 119,120,119
+C
+C IF IN FRONT, DRAW IN ANY CASE.
+C
+c +NOAO: Remove the assumption that window coordinates 1-1024 map to the
+c full plotter metacode range 1-32768
+c
+  119 zzxmc = (32768./1023.) * (vpx2 - vpx1) * (xt-1.) + (vpx1 * 32768.)
+      zzymc = (32768./1023.) * (vpy2 - vpy1) * (yt-1.) + (vpy1 * 32768.)
+      call plotit (ifix(zzxmc), ifix(zzymc), 0)
+c 119 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),0)
+      RETURN
+c
+  120 zzxmc = (32768./1023.) * (vpx2 - vpx1) * (xt-1.) + (vpx1 * 32768.)
+      zzymc = (32768./1023.) * (vpy2 - vpy1) * (yt-1.) + (vpy1 * 32768.)
+      call plotit (ifix(zzxmc), ifix(zzymc), 1)
+c 120 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),1)
+c -NOAO
+      RETURN
+  121 IF (IFRST) 122,123,122
+  122 IX1 = XT
+      IY1 = YT
+      RETURN
+  123 IX2 = XT
+      IY2 = YT
+C
+C IF COULD BE HIDDEN, USE HIDDEN LINE PLOTTING ENTRY IN SRFACE
+C
+      CALL DRAWS (IX1,IY1,IX2,IY2,1,0)
+      IX1 = IX2
+      IY1 = IY2
+      RETURN
+      END
+      SUBROUTINE PWRZOS (JCHAR,INDEX,NSIZE)
+C
+C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH.  THE RELATIONSHIP
+C BETWEEN JCHAR AND INDEX IS MAINTAINED.  A BUBBLE SORT IS USED.
+C JCHAR IS SORTED IN ASCENDING ORDER.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,JTEMP     ,KTEMP
+      DIMENSION       INDEX(NSIZE)
+      LOGICAL         LDONE
+C
+      ISTART = 1
+      ISTOP = NSIZE
+      ISTEP = 1
+C
+C AT MOST NSIZE PASSES ARE NEEDED.
+C
+      DO 104 NPASS=1,NSIZE
+       LDONE = .TRUE.
+       I = ISTART
+  101  ISUB = I+ISTEP
+       IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102
+C
+C THEY NEED TO BE SWITCHED.
+C
+  102  LDONE = .FALSE.
+       JTEMP = JCHAR(I)
+       KTEMP = JCHAR(ISUB)
+       JCHAR(I) = KTEMP
+       JCHAR(ISUB) = JTEMP
+       ITEMP = INDEX(I)
+       INDEX(I) = INDEX(ISUB)
+       INDEX(ISUB) = ITEMP
+C
+C THEY DO NOT NEED TO BE SWITCHED.
+C
+  103  I = I+ISTEP
+       IF (I .NE. ISTOP) GO TO 101
+C
+C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT.
+C
+       IF (LDONE) RETURN
+C
+C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION.
+C
+       ISTEP = -ISTEP
+       ITEMP = ISTART
+       ISTART = ISTOP+ISTEP
+       ISTOP = ITEMP
+  104 CONTINUE
+      RETURN
+      END
+      SUBROUTINE PWRZGS (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+C
+C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES-
+C PONDING INDEX IN IPOINT.  BINARY HALVING IS USED.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,KCHAR
+      DIMENSION       INDEX(NSIZE)
+C
+C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS
+C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED.
+C
+      KOUNT = 0
+      IBOT = 1
+      ITOP = NSIZE
+      I = ITOP
+      GO TO 102
+  101 I = (IBOT+ITOP)/2
+      KOUNT = KOUNT+1
+      IF (KOUNT .GT. 10) GO TO 106
+  102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104
+  103 IBOT = I
+      GO TO 101
+  104 ITOP = I
+      GO TO 101
+  105 IPOINT = INDEX(I)
+      RETURN
+C
+C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE.
+C
+  106 IPOINT = -1
+      RETURN
+C
+C
+C
+C REVISION HISTORY----------
+C
+C MARCH    1980    FIRST ADDED TO ULIB AS A SEPARATE FILE TO BE
+C                  USED IN CONJUNCTION WITH THE ULIB ROUTINE
+C                  SRFACE
+C
+C JULY     1984    CONVERTED TO GKS AND FORTRAN 77
+C------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/pwrzt.f b/sys/gio/ncarutil/pwrzt.f
new file mode 100644
index 00000000..eea2b0d0
--- /dev/null
+++ b/sys/gio/ncarutil/pwrzt.f
@@ -0,0 +1,731 @@
+      SUBROUTINE PWRZT (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C LATEST REVISION        JULY, 1984
+C
+C PURPOSE                PWRZT IS A CHARACTER PLOTTING ROUTINE FOR
+C                        PLOTTING CHARACTERS IN THREE-SPACE WHEN USING
+C                        THREED.  FOR A LARGE CLASS OF
+C                        POSSIBLE POSITIONS, THE HIDDEN CHARACTER
+C                        PROBLEM IS SOLVED.
+C
+C
+C
+C USAGE                  CALL PWRZT (X,Y,Z,ID,N,ISIZE,LINE,ITOP,ICNT)
+C                          USE CALL PWRZT AFTER CALLING
+C                          THREED AND BEFORE CALLING FRAME.
+C
+C ARGUMENTS
+C
+C ON INPUT               X,Y,Z
+C                          POSITIONING COORDINATES FOR THE CHARACTERS
+C                          TO BE DRAWN.  THESE ARE FLOATING POINT
+C                          NUMBERS IN THE SAME THREE-SPACE AS USED IN
+C                          THREED.
+C
+C                        ID
+C                          CHARACTER STRING TO BE DRAWN.  ID IS OF TYPE
+C                          CHARACTER .
+C
+C                        N
+C                          THE NUMBER OF CHARACTERS IN ID.
+C
+C                        ISIZE
+C                          SIZE OF THE CHARACTER:
+C                          .  IF BETWEEN 0 AND 3, ISIZE IS 1., 1.5,
+C                             2., OR 3. TIMES A STANDARD WIDTH EQUAL
+C                             TO 1/128TH OF THE SCREEN WIDTH.
+C                          .  IF GREATER THAN 3, ISIZE IS THE CHARACTER
+C                             WIDTH IN PLOTTER ADDRESS UNITS.
+C
+C                        LINE
+C                          THE DIRECTION IN WHICH THE CHARACTERS ARE TO
+C                          BE WRITTEN.
+C                            1 = +X     -1 = -X
+C                            2 = +Y     -2 = -Y
+C                            3 = +Z     -3 = -Z
+C
+C                        ITOP
+C                          THE DIRECTION FROM THE CENTER OF THE FIRST
+C                          CHARACTER TO THE TOP OF THE FIRST
+C                          CHARACTER (THE POTENTIAL VALUES FOR
+C                          ITOP ARE THE SAME AS THOSE FOR LINE AS
+C                          GIVEN ABOVE.)  NOTE THAT LINE CANNOT
+C                          EQUAL ITOP EVEN IN ABSOLUTE VALUE.
+C
+C                        ICNT
+C                          CENTERING OPTION.
+C                          -1 (X,Y,Z)  IS THE CENTER OF THE LEFT EDGE OF
+C                                      THE FIRST CHARACTER.
+C                          0  (X,Y,Z)  IS THE CENTER OF THE ENTIRE
+C                                      STRING.
+C                          1  (X,Y,Z)  IS THE CENTER OF THE RIGHT EDGE
+C                                      OF THE LAST CHARACTER.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C NOTE                   THE HIDDEN CHARACTER PROBLEM IS SOLVED
+C                        CORRECTLY FOR CHARACTERS NEAR (BUT NOT INSIDE)
+C                        THE THREE-SPACE OBJECT.
+C
+C ENTRY POINTS           PWRZT, INITZT, PWRZOT, PWRZGT
+C
+C COMMON BLOCKS          PWRZ1T,PWRZ2T
+C
+C I/O                    PLOTS CHARACTER(S)
+C
+C PRECISION              SINGLE
+C
+C REQUIRED LIBRARY       THREED, THE ERPRT77 PACKAGE, AND THE SPPS
+C ROUTINES
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                IMPLEMENTED FOR USE WITH THREED.
+C
+C
+C
+C
+C***********************************************************************
+C
+      SAVE
+      CHARACTER*(*)   ID
+      CHARACTER*1     JCHAR(46)  ,KCHAR
+      DIMENSION       INDEX(46)  ,KX(494)    ,KY(494)
+      LOGICAL         LENTRY
+C
+C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS
+C DIGITIZATION.  THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS
+C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON.
+C
+      DATA JCHAR( 1),INDEX( 1)/'A',  1/
+      DATA JCHAR( 2),INDEX( 2)/'B', 13/
+      DATA JCHAR( 3),INDEX( 3)/'C', 28/
+      DATA JCHAR( 4),INDEX( 4)/'D', 40/
+      DATA JCHAR( 5),INDEX( 5)/'E', 49/
+      DATA JCHAR( 6),INDEX( 6)/'F', 60/
+      DATA JCHAR( 7),INDEX( 7)/'G', 68/
+      DATA JCHAR( 8),INDEX( 8)/'H', 82/
+      DATA JCHAR( 9),INDEX( 9)/'I', 92/
+      DATA JCHAR(10),INDEX(10)/'J',104/
+      DATA JCHAR(11),INDEX(11)/'K',113/
+      DATA JCHAR(12),INDEX(12)/'L',123/
+      DATA JCHAR(13),INDEX(13)/'M',130/
+      DATA JCHAR(14),INDEX(14)/'N',137/
+      DATA JCHAR(15),INDEX(15)/'O',143/
+      DATA JCHAR(16),INDEX(16)/'P',157/
+      DATA JCHAR(17),INDEX(17)/'Q',166/
+      DATA JCHAR(18),INDEX(18)/'R',182/
+      DATA JCHAR(19),INDEX(19)/'S',194/
+      DATA JCHAR(20),INDEX(20)/'T',210/
+      DATA JCHAR(21),INDEX(21)/'U',219/
+      DATA JCHAR(22),INDEX(22)/'V',229/
+      DATA JCHAR(23),INDEX(23)/'W',236/
+      DATA JCHAR(24),INDEX(24)/'X',245/
+      DATA JCHAR(25),INDEX(25)/'Y',252/
+      DATA JCHAR(26),INDEX(26)/'Z',262/
+      DATA JCHAR(27),INDEX(27)/'0',273/
+      DATA JCHAR(28),INDEX(28)/'1',286/
+      DATA JCHAR(29),INDEX(29)/'2',296/
+      DATA JCHAR(30),INDEX(30)/'3',308/
+      DATA JCHAR(31),INDEX(31)/'4',326/
+      DATA JCHAR(32),INDEX(32)/'5',339/
+      DATA JCHAR(33),INDEX(33)/'6',352/
+      DATA JCHAR(34),INDEX(34)/'7',368/
+      DATA JCHAR(35),INDEX(35)/'8',378/
+      DATA JCHAR(36),INDEX(36)/'9',398/
+      DATA JCHAR(37),INDEX(37)/'+',414/
+      DATA JCHAR(38),INDEX(38)/'-',423/
+      DATA JCHAR(39),INDEX(39)/'*',429/
+      DATA JCHAR(40),INDEX(40)/'/',444/
+      DATA JCHAR(41),INDEX(41)/'(',448/
+      DATA JCHAR(42),INDEX(42)/')',456/
+      DATA JCHAR(43),INDEX(43)/'=',464/
+      DATA JCHAR(44),INDEX(44)/' ',473/
+      DATA JCHAR(45),INDEX(45)/',',476/
+      DATA JCHAR(46),INDEX(46)/'.',486/
+C
+C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE
+C CHARACTERS.  THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND
+C 7 UNITS TALL.  THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF
+C EACH CHARACTER.  IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING
+C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND
+C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC-
+C TER HAS BEEN REACHED.
+C
+c None of the following are used anywhere.
+c     DATA WIDE,HIGH,WHITE/6.,7.,2./
+C
+      DATA KX(  1),KX(  2),KX(  3),KX(  4),KX(  5),KX(  6)/0,4,7,0,0,1/
+      DATA KY(  1),KY(  2),KY(  3),KY(  4),KY(  5),KY(  6)/3,3,0,3,6,7/
+      DATA KX(  7),KX(  8),KX(  9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/
+      DATA KY(  7),KY(  8),KY(  9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/
+      DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/
+      DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/
+      DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/
+      DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/
+      DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/
+      DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/
+      DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/
+      DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/
+      DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/
+      DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/
+      DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/
+      DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/
+      DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/
+      DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/
+      DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/
+      DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/
+      DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/
+      DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/
+      DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/
+      DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/
+      DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/
+      DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/
+      DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/
+      DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/
+      DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/
+      DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/
+      DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/
+      DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/
+      DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/
+      DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/
+      DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/
+      DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/
+      DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/
+      DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/
+      DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/
+      DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/
+      DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/
+      DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/
+      DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/
+      DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/
+      DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/
+      DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/
+      DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/
+      DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/
+      DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/
+      DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/
+      DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/
+      DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/
+      DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/
+      DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/
+      DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/
+      DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/
+      DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/
+      DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/
+      DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/
+      DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/
+      DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/
+      DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/
+      DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/
+      DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/
+      DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/
+      DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/
+      DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/
+      DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/
+      DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/
+      DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/
+      DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/
+      DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/
+      DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/
+      DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/
+      DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/
+      DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/
+      DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/
+      DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/
+      DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/
+      DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/
+      DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/
+      DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/
+      DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/
+      DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/
+      DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/
+      DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/
+      DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/
+      DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/
+      DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/
+      DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/
+      DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/
+      DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/
+      DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/
+      DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/
+      DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/
+      DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/
+      DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/
+      DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/
+      DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/
+      DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/
+      DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/
+      DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/
+      DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/
+      DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/
+      DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/
+      DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/
+      DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/
+      DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/
+      DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/
+      DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/
+      DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/
+      DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/
+      DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/
+      DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/
+      DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/
+      DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/
+      DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/
+      DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/
+      DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/
+      DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/
+      DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/
+      DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/
+      DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/
+      DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/
+      DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/
+      DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/
+      DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/
+      DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/
+      DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/
+      DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/
+      DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/
+      DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/
+      DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/
+      DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/
+      DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/
+      DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/
+      DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/
+      DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/
+      DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/
+      DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/
+      DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/
+      DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/
+      DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/
+      DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/
+      DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/
+      DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/
+      DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/
+      DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/
+      DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/
+      DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/
+      DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/
+      DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/
+      DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/
+      DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/
+      DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/
+      DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/
+      DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/
+      DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/
+      DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/
+      DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/
+      DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/
+      DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/
+      DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/
+      DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/
+      DATA KX(493),KX(494)                                /6,7        /
+      DATA KY(493),KY(494)                                /0,7        /
+C
+C NSIZE IS THE LENGTH OF JCHAR AND INDEX.
+C LNGTH IS THE LENGTH OF KX AND KY.
+C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRZT.
+C
+      DATA NSIZE/46/
+c Variable LNGTH not used.
+c     DATA LNGTH/494/
+      DATA LENTRY/.FALSE./
+      DATA ITHETA/0/
+      DATA IDUM1,IDUM2,IDUM3/1,1,1/
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','PWRZT','PWRZT','VERSION  1')
+C
+C SEE IF THIS IS THE FIRST CALL TO PWRZT
+C
+      IF (LENTRY) GO TO 103
+C
+C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE.
+C
+      LENTRY = .TRUE.
+C
+C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN
+C CHARACTERS.
+C
+      IBLKPT = INDEX(44)
+C
+C CHANGE EACH CHARACTER IN THE TABLE TO RIGHT JUSTIFIED, ZERO FILLED.
+C
+C
+C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX.
+C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.)
+C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT
+C CALLS TO PWRZT.
+C
+      CALL PWRZOT (JCHAR,INDEX,NSIZE)
+C
+C ALL ONE-TIME INITIALIZATION NOW FINISHED.
+C
+  103 CONTINUE
+C
+      NN = N
+      IF (NN .LE. 0) RETURN
+      FNNM1 = NN-1
+      JCNT = ICNT
+C
+C PUT RELATIVE SIZE IN Q, ADJUST FOR CURRENT PLOTTER RESOLUTION
+C
+      CALL GETUSV ('XF',LX)
+      SCALE = 2.**(LX-10)
+      IF (ISIZE .EQ. 0) Q = 1.3334*SCALE
+      IF (ISIZE .EQ. 1) Q = 2.*SCALE
+      IF (ISIZE .EQ. 2) Q = 2.6667*SCALE
+      IF (ISIZE .EQ. 3) Q = 4.*SCALE
+      IF (ISIZE .GT. 3) Q = FLOAT(ISIZE)/(6.)
+C
+C PUT ANGLE IN RADIANS IN T.
+C
+      T = FLOAT(ITHETA)*1.5708
+  104 CONTINUE
+C
+C CALCULATE COMBINED TRANSFORMATION
+C
+      CT = Q*COS(T)
+      ST = Q*SIN(T)
+C
+C FIND CRT COORDINATES OF CENTER.
+C
+      LINEI = LIN3
+      CALL INTZT (X,Y,Z,LINEI,ITOP)
+      IF (LINEI .EQ. 0) RETURN
+      IX = 0
+      IY = 0
+      XC = IX
+      YC = IY
+C
+C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED.
+C
+      XC = XC-2.*CT+3.5*ST
+      YC = YC-2.*ST-3.5*CT
+C
+C CORRECT FOR CENTERING IF TURNED ON.
+C
+      JCNT = MAX0(-1,MIN0(1,JCNT))+2
+      GO TO (108,107,109),JCNT
+  107 XC = XC-CT*FNNM1*3.
+      YC = YC-ST*FNNM1*3.
+      GO TO 110
+  108 XC = XC+CT*2.
+      YC = YC+ST*2.
+      GO TO 110
+  109 XC = XC-CT*2.
+      YC = YC-ST*2.
+      XC = XC-CT*FNNM1*6.
+      YC = YC-ST*FNNM1*6.
+  110 CALL INITZT (IFIX(XC),IFIX(YC),1,IDUM1,IDUM2,2)
+      CALL INITZT (IFIX(XC+CT*6.*FNNM1),IFIX(YC+ST*6.*FNNM1),2,IDUM1,
+     +             IDUM2,2)
+      CALL INITZT (IFIX(XC),IFIX(YC),IDUM1,IDUM2,IDUM3,3)
+      DO 114 K=1,NN
+         XB = XC
+         YB = YC
+         IP = 1
+C
+C EXTRACT CHARACTER NUMBER K FROM THE STRING.
+C
+         KCHAR = ID(K:K)
+C
+C FIND THE TABLE ENTRY.
+C
+       CALL PWRZGT (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+       IF (IPOINT .EQ. -1) IPOINT = IBLKPT
+C
+C ALWAYS LESS THAN 20 INSTRUCTIONS.
+C
+       DO 113 L=1,20
+          ISUB = IPOINT+L-1
+          NX = KX(ISUB)
+          FNX = NX
+          NY = KY(ISUB)
+          FNY = NY
+C
+C TEST FOR OP-CODE OR DX AND DY.
+C
+          IF (NX .NE. 7) GO TO 111
+C
+C OP-CODE
+C
+          IP = 0
+          IF (NY-7) 113,114,113
+C
+C DX AND DY
+C
+  111     XC = XB+FNX*CT-FNY*ST
+          YC = YB+FNX*ST+FNY*CT
+C
+C CALL DESIRED PLOTTING ROUTINE.  DETERMINED BY OP-CODES.
+C
+          IF (IP .NE. 0) GO TO 112
+      CALL INITZT (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,3)
+          IP = 1
+          GO TO 113
+  112 CALL INITZT (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,4)
+  113  CONTINUE
+  114 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE INTZT (XX,YY,ZZ,LIN3,ITOP)
+C
+C FORCE STORAGE OF X, Y, AND Z INTO COMMON BLOCK
+C
+      COMMON /PWRZ2T/ X, Y, Z
+      DATA IDUMX,IDUMY,IDUMZ /0, 0, 0/
+      X = XX
+      Y = YY
+      Z = ZZ
+      CALL INITZT (IDUMX,IDUMY,IDUMZ,LIN3,ITOP,1)
+      RETURN
+      END
+      SUBROUTINE INITZT (IX,IY,IZ,LIN3,ITOP,IENT)
+C
+      SAVE
+      COMMON /PWRZ1T/ XXMIN      ,XXMAX      ,YYMIN      ,YYMAX      ,
+     +                ZZMIN      ,ZZMAX      ,DELCRT     ,EYEX       ,
+     +                EYEY       ,EYEZ
+C
+      COMMON /PWRZ2T/ X          ,Y          ,Z
+      FX(R) = R+FACTX*FLOAT(IX)
+      FY(R) = R+FACTY*FLOAT(IY)
+C
+C
+C  DETERMINE INITZT,VISSET,FRSTZ OR VECTZ CALL
+C
+      GO TO (1000,2000,3000,4000),IENT
+ 1000 LIN = MAX0(1,MIN0(3,IABS(LIN3)))
+      ITO = MAX0(1,MIN0(3,IABS(ITOP)))
+C
+C SET UP SCALING CONSTANTS
+C
+      DELMAX = AMAX1(XXMAX-XXMIN,YYMAX-YYMIN,ZZMAX-ZZMIN)
+      FACTOR = DELMAX/DELCRT
+      FACTX = SIGN(FACTOR,FLOAT(LIN3))
+      FACTY = SIGN(FACTOR,FLOAT(ITOP))
+C
+C SET UP FOR PROPER PLANE
+C
+      JUMP1 = LIN+(ITO-1)*3
+      GO TO (108,101,102,103,108,104,105,106,108),JUMP1
+  101 ASSIGN 111 TO JUMP
+      GO TO 107
+  102 ASSIGN 112 TO JUMP
+      GO TO 107
+  103 ASSIGN 113 TO JUMP
+      GO TO 107
+  104 ASSIGN 114 TO JUMP
+      GO TO 107
+  105 ASSIGN 115 TO JUMP
+      GO TO 107
+  106 ASSIGN 116 TO JUMP
+  107 RETURN
+  108 CALL SETER ('INITZT - LINE OR ITOP IMPROPER IN PWRZT CALL' ,1,1)
+      LIN3 = 0
+      RETURN
+C
+C **************************** ENTRY VISSET ****************************
+C     ENTRY VISSET (IX,IY,IZ)
+C
+C
+C VISSET IS CALLED ONCE FOR EACH END OF THE CHARACTER STRING
+C
+ 2000 IVIS = -1
+      ITEMP = 0
+      GO TO 110
+C
+C SEE IF THIS END COULD BE BEHIND THE OBJECT
+C
+  109 IF (EYEX.GT.XXMAX .AND. XX.GT.XXMAX) ITEMP = ITEMP+1
+      IF (EYEY.GT.YYMAX .AND. YY.GT.YYMAX) ITEMP = ITEMP+1
+      IF (EYEZ.GT.ZZMAX .AND. ZZ.GT.ZZMAX) ITEMP = ITEMP+1
+      IF (EYEX.LT.XXMIN .AND. XX.LT.XXMIN) ITEMP = ITEMP+1
+      IF (EYEY.LT.YYMIN .AND. YY.LT.YYMIN) ITEMP = ITEMP+1
+      IF (EYEZ.LT.ZZMIN .AND. ZZ.LT.ZZMIN) ITEMP = ITEMP+1
+      IF (IZ .EQ. 1) IVISS = ITEMP
+C
+C IF EITHER END CHARACTER COULD BE HIDDEN, TEST ALL LINE SEGMENTS.
+C
+      IF (IZ .EQ. 2) IVIS = MIN0(IVISS,ITEMP)
+      RETURN
+C
+C **************************** ENTRY FRSTZ *****************************
+C     ENTRY FRSTZ (IX,IY)
+C
+ 3000 IFRST = 1
+      GO TO 110
+C
+C **************************** ENTRY VECTZ *****************************
+C     ENTRY VECTZ (IX,IY)
+C
+ 4000 IFRST = 0
+C
+C PICK CORRECT 3-SPACE PLANE TO DRAW IN
+C
+  110 GO TO JUMP,(111,112,113,114,115,116)
+  111 XX = FY(X)
+      YY = FX(Y)
+      ZZ = Z
+      GO TO 117
+  112 XX = FY(X)
+      YY = Y
+      ZZ = FX(Z)
+      GO TO 117
+  113 XX = FX(X)
+      YY = FY(Y)
+      ZZ = Z
+      GO TO 117
+  114 XX = X
+      YY = FY(Y)
+      ZZ = FX(Z)
+      GO TO 117
+  115 XX = FX(X)
+      YY = Y
+      ZZ = FY(Z)
+      GO TO 117
+  116 XX = X
+      YY = FX(Y)
+      ZZ = FY(Z)
+C
+C TRANSLATE TO 2-SPACE
+C
+  117 CALL TRN32T (XX,YY,ZZ,XT,YT,DUMMY,2)
+      IF (IVIS) 109,121,118
+  118 IF (IFRST) 119,120,119
+C
+C IF IN FRONT, DRAW IN ANY CASE.
+C
+  119 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),0)
+      RETURN
+  120 CALL PLOTIT (32*IFIX(XT),32*IFIX(YT),1)
+      RETURN
+  121 IF (IFRST) 122,123,122
+  122 IX1 = XT
+      IY1 = YT
+      RETURN
+  123 IX2 = XT
+      IY2 = YT
+C
+C IF COULD BE HIDDEN, USE HIDDEN LINE PLOTTING ENTRY IN THREED
+C
+      CALL DRAWT (IX1,IY1,IX2,IY2)
+      IX1 = IX2
+      IY1 = IY2
+      RETURN
+      END
+      SUBROUTINE PWRZOT (JCHAR,INDEX,NSIZE)
+C
+C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH.  THE RELATIONSHIP
+C BETWEEN JCHAR AND INDEX IS MAINTAINED.  A BUBBLE SORT IS USED.
+C JCHAR IS SORTED IN ASCENDING ORDER.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,JTEMP     ,KTEMP
+      DIMENSION       INDEX(NSIZE)
+      LOGICAL         LDONE
+C
+      ISTART = 1
+      ISTOP = NSIZE
+      ISTEP = 1
+C
+C AT MOST NSIZE PASSES ARE NEEDED.
+C
+      DO 104 NPASS=1,NSIZE
+       LDONE = .TRUE.
+       I = ISTART
+  101  ISUB = I+ISTEP
+       IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102
+C
+C THEY NEED TO BE SWITCHED.
+C
+  102  LDONE = .FALSE.
+       JTEMP = JCHAR(I)
+       KTEMP = JCHAR(ISUB)
+       JCHAR(I) = KTEMP
+       JCHAR(ISUB) = JTEMP
+       ITEMP = INDEX(I)
+       INDEX(I) = INDEX(ISUB)
+       INDEX(ISUB) = ITEMP
+C
+C THEY DO NOT NEED TO BE SWITCHED.
+C
+  103  I = I+ISTEP
+       IF (I .NE. ISTOP) GO TO 101
+C
+C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT.
+C
+       IF (LDONE) RETURN
+C
+C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION.
+C
+       ISTEP = -ISTEP
+       ITEMP = ISTART
+       ISTART = ISTOP+ISTEP
+       ISTOP = ITEMP
+  104 CONTINUE
+      RETURN
+      END
+      SUBROUTINE PWRZGT (KCHAR,JCHAR,INDEX,NSIZE,IPOINT)
+C
+C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES-
+C PONDING INDEX IN IPOINT.  BINARY HALVING IS USED.
+C
+      SAVE
+      CHARACTER*1     JCHAR(NSIZE)     ,KCHAR
+      DIMENSION       INDEX(NSIZE)
+C
+C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS
+C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED.
+C
+      KOUNT = 0
+      IBOT = 1
+      ITOP = NSIZE
+      I = ITOP
+      GO TO 102
+  101 I = (IBOT+ITOP)/2
+      KOUNT = KOUNT+1
+      IF (KOUNT .GT. 10) GO TO 106
+  102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104
+  103 IBOT = I
+      GO TO 101
+  104 ITOP = I
+      GO TO 101
+  105 IPOINT = INDEX(I)
+      RETURN
+C
+C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE.
+C
+  106 IPOINT = -1
+      RETURN
+C
+C
+C
+C REVISION HISTORY----------
+C
+C MARCH    1980    FIRST ADDED TO ULIB AS A SEPARATE FILE TO BE
+C                  USED IN CONJUNCTION WITH THE ULIB ROUTINE
+C                  THREED
+C
+C JULY     1984    CONVERTED TO GKS AND FORTRAN 77
+C------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/srfabd.f b/sys/gio/ncarutil/srfabd.f
new file mode 100644
index 00000000..25712c27
--- /dev/null
+++ b/sys/gio/ncarutil/srfabd.f
@@ -0,0 +1,89 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: here is the changed block data
+c     BLOCKDATA SRFABD
+      subroutine srfabd
+c
+      integer first, temp
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      COMMON /SRFIP1/ IFR        ,ISTP       ,IROTS      ,IDRX,
+     1                IDRY       ,IDRZ       ,IUPPER     ,ISKIRT,
+     2                NCLA       ,THETA      ,HSKIRT     ,CHI,
+     3                CLO        ,CINC       ,ISPVAL
+      COMMON /SRFINT/ ISRFMJ     ,ISRFMN     ,ISRFTX
+c +noao: common block added 4NOV85 to allow user control of viewport.
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c-noao
+C
+c +noao: following flag added to prevent initialization more than once
+        common /frstfg/ first
+	SAVE
+        data temp /1/
+	first = temp
+        if (first .ne. 1) then
+            return
+        endif
+        temp = 0
+c
+C +noao: by default, the full device viewport is used
+      vpx1 = 0.0
+      vpx2 = 1.0
+      vpy1 = 0.0
+      vpy2 = 1.0
+c -noao
+C  INITIALIZATION OF INTERNAL PARAMETERS
+C
+c     DATA ISPVAL/-999/
+      ISPVAL = -999
+
+c     DATA IFR,ISTP,IROTS,IDRX,IDRY,IDRZ,IUPPER,ISKIRT,NCLA/
+c    1       1,   0,    0,       1,       1,   0,         0,     0,       6/
+c +noao: initial value of ifr changed to 0 to suppress frame advance.  This
+c       function should be performed by the calling procedure.
+c -noao
+      IFR    = 0
+      ISTP   = 0
+      IROTS  = 0  
+      IDRX   = 1
+      IDRY   = 1
+      IDRZ   = 0
+      IUPPER = 0
+      ISKIRT = 0
+      NCLA   = 6
+     
+c     DATA THETA,HSKIRT,CHI,CLO,CINC/
+c    1       .02,    0., 0., 0.,  0./
+      THETA  =.02
+      HSKIRT = 0.
+      CHI    = 0.
+      CLO    = 0.
+      CINC   = 0.
+     
+c     DATA NRSWT/0/
+      NRSWT = 0
+
+c     DATA IOFFP,SPVAL/0,0.0/
+      IOFFP = 0
+      SPVAL = 0.0
+
+C LINE COLOR INDEX
+c     DATA ISRFMJ/1/
+      ISRFMJ = 1
+C
+c -noao
+      END
diff --git a/sys/gio/ncarutil/srface.f b/sys/gio/ncarutil/srface.f
new file mode 100644
index 00000000..8a5981db
--- /dev/null
+++ b/sys/gio/ncarutil/srface.f
@@ -0,0 +1,1347 @@
+      SUBROUTINE SRFACE (X,Y,Z,M,MX,NX,NY,S,STEREO)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C DIMENSION OF           X(NX),Y(NY),Z(MX,NY),M(2,NX,NY),S(6)
+C ARGUMENTS
+C
+C LATEST REVISION        MARCH 1984
+C
+C PURPOSE                SRFACE DRAWS A PERSPECTIVE PICTURE OF A
+C                        FUNCTION OF TWO VARIABLES WITH HIDDEN LINES
+C                        REMOVED.  THE FUNCTION IS APPROXIMATED BY A
+C                        TWO-DIMENSIONAL ARRAY OF HEIGHTS.
+C
+C USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C                                 CALL EZSRFC (Z,M,N,ANGH,ANGV,WORK)
+C
+C                          ASSUMPTIONS:
+C                                  .THE ENTIRE ARRAY IS TO BE DRAWN,
+C                                  .THE DATA IS EQUALLY SPACED (IN THE
+C                               X-Y PLANE),
+C                                  .NO STEREO PAIRS,
+C                                  .SCALING     IS CHOSEN INTERNALLY.
+C
+C                        IF THESE ASSUMPTIONS ARE NOT MET USE
+C                                 CALL SRFACE (X,Y,Z,M,MX,NX,NY,S,
+C                                                STEREO)
+C
+C ARGUMENTS
+C
+C ON INPUT               Z
+C FOR EZSRFC                     THE M BY N ARRAY TO BE DRAWN.
+C
+C                        M
+C                          THE FIRST DIMENSION OF Z.
+C
+C                        N
+C                          THE SECOND DIMENSION OF Z.
+C
+C                        ANGH
+C                          ANGLE IN DEGREES IN THE X-Y PLANE TO THE
+C                          LINE OF SIGHT (COUNTER-CLOCK WISE FROM
+C                          THE PLUS-X AXIS).
+C
+C                        ANGV
+C                          ANGLE IN DEGREES FROM THE X-Y PLANE TO
+C                          THE LINE OF SIGHT (POSITIVE ANGLES ARE
+C                          ABOVE THE MIDDLE Z, NEGATIVE BELOW).
+C
+C                        WORK
+C                          A SCRATCH STORAGE DIMENSIONED AT LEAST
+C                          2*M*N+M+N.
+C
+C ON OUTPUT              Z, M, N, ANGH, ANGV ARE UNCHANGED.  WORK
+C FOR EZSRFC             HAS BEEN WRITTEN IN.
+C
+C
+C ARGUMENTS
+C
+C ON INPUT               X
+C FOR SRFACE                     A LINEAR ARRAY NX LONG CONTAINING THE X
+C                          COORDINATES OF THE POINTS IN THE SURFACE
+C                          APPROXIMATION.  SEE NOTE, BELOW.
+C
+C                        Y
+C                          THE LINEAR ARRAY NY LONG CONTAINING THE
+C                          Y COORDINATES OF THE POINTS IN THE
+C                          SURFACE APPROXIMATION.  SEE NOTE, BELOW.
+C
+C                        Z
+C                          AN ARRAY MX BY NY CONTAINING THE SURFACE
+C                          TO BE DRAWN IN NX BY NY CELLS.
+C                          Z(I,J) = F(X(I),Y(J)).  SEE NOTE, BELOW.
+C
+C                        M
+C                          SCRATCH ARRAY AT LEAST 2*NX*NY WORDS
+C                          LONG.
+C
+C                        MX
+C                          FIRST DIMENSION OF Z.
+C
+C                        NX
+C                          NUMBER OF POINTS IN THE X DIRECTION
+C                          IN Z.  WHEN PLOTTING AN ENTIRE ARRAY,
+C                          MX=NX.  SEE APPENDIX 1 OF THE GRAPHICS
+C                          CHAPTER FOR AN EXPLANATION OF USING THIS
+C                          ARGUMENT LIST TO PROCESS ANY PART OF AN
+C                          ARRAY.
+C
+C                        NY
+C                          NUMBER OF POINTS IN THE Y DIRECTION IN Z.
+C
+C                        S
+C                          S DEFINES THE LINE OF SIGHT.  THE VIEWER'S
+C                          EYE IS AT (S(1), S(2), S(3)) AND THE
+C                          POINT LOOKED AT IS AT (S(4), S(5), S(6)).
+C                          THE EYE SHOULD BE OUTSIDE THE BLOCK WITH
+C                          OPPOSITE CORNERS (X(1), Y(1), ZMIN) AND
+C                          (X(NX), Y(NY), ZMAX) AND THE POINT LOOKED
+C                          AT SHOULD BE INSIDE IT.      FOR     A NICE
+C                          PERSPECTIVE EFFECT, THE DISTANCE BETWEEN
+C                          THE EYE AND THE POINT LOOKED AT SHOULD BE
+C                          5 TO 10 TIMES THE SIZE OF THE BLOCK.  SEE
+C                          NOTE, BELOW.
+C
+C                        STEREO
+C                          FLAG TO INDICATE IF STEREO PAIRS ARE TO
+C                          BE DRAWN.  0.0 MEANS NO STEREO PAIR (ONE
+C                          PICTURE).  NON-ZERO MEANS PUT OUT TWO
+C                          PICTURES.  THE VALUE OF STEREO IS THE
+C                          RELATIVE ANGLE BETWEEN THE EYES.  A VALUE
+C                          OF 1.0 PRODUCES STANDARD SEPARATION.
+C                          NEGATIVE STEREO REVERSES THE LEFT AND
+C                          RIGHT FIGURES.
+C
+C ON OUTPUT              X, Y, Z, MX, NX, NY, S, STEREO ARE
+C FOR SRFACE             UNCHANGED.  M HAS BEEN WRITTEN IN.
+C
+C NOTES                  . THE RANGE OF Z COMPARED WITH THE RANGE
+C                          OF X AND Y DETERMINES THE SHAPE OF THE
+C                          PICTURE.  THEY ARE ASSUMED TO BE IN THE
+C                          SAME UNITS AND NOT WILDLY DIFFERENT IN
+C                          MAGNITUDE.  S IS ASSUMED TO BE IN THE
+C                          SAME UNITS AS X, Y, AND Z.
+C                        . PICTURE SIZE CAN BE MADE RELATIVE TO
+C                          DISTANCE.  SEE COMMENTS IN SETR.
+C                        . TRN32S CAN BE USED TO TRANSLATE FROM 3
+C                          SPACE TO 2 SPACE.  SEE COMMENTS THERE.
+C                        . DATA WITH EXTREME DISCONTINUITIES MAY
+C                          CAUSE VISIBILITY ERRORS.  IF THIS PROBLEM
+C                          OCCURS, USE A DISTANT EYE POSITION
+C                          AWAY FROM THE +Z AXIS.
+C                        . THE DEFAULT LINE COLOR IS SET TO
+C                          COLOR INDEX 1.  IF THE USER WISHES TO
+C                          CHANGE THE LINE COLOR, HE CAN DO SO BY
+C                          DEFINING COLOR INDEX 1 BEFORE CALLING
+C                          SRFACE, OR BY PUTTING THE COMMON BLOCK
+C                          SRFINT IN HIS CALLING PROGRAM AND
+C                          DEFINING AND USING COLOR INDEX ISRFMJ
+C                          (DEFAULTED TO 1 IN BLOCKDATA.)
+C
+C ENTRY POINTS           SRFACE, SRFGK, EZSRFC, SETR, DRAWS, TRN32S,
+C                        CLSET, CTCELL, SRFABD
+C
+C COMMON BLOCKS          PWRZ1S, SRFBLK, SRFINT, SRFIP1
+C
+C I/O                    PLOTS
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                CONVERTED TO FORTRAN 77 AND GKS IN MARCH 1984.
+C
+C                        PREPARED FOR SIGGRAPH, AUGUST 1976.
+C
+C                        STANDARDIZED IN JANUARY 1973.
+C
+C                        WRITTEN IN DECEMBER 1971.      REPLACED K.S.+G.
+C                        ALGORITHM CALLED SOLIDS AT NCAR.
+C
+C
+C ALGORITHM              HIGHEST SO FAR IS VISIBLE FROM ABOVE.  (SEE
+C                        REFERENCE.)
+C
+C REFERENCE              WRIGHT, T.J., A TWO SPACE SOLUTION TO THE
+C                        HIDDEN LINE PROBLEM FOR PLOTTING A FUNCTION
+C                        OF TWO VARIABLES.      IEEE TRANS.     COMP.,
+C                        PP 28-33, JANUARY 1973.
+C
+C ACCURACY               IF THE ENDS OF A LINE SEGMENT ARE VISIBLE,
+C                        THE MIDDLE IS ASSUMED VISIBLE.
+C
+C TIMING                 PROPORTIONAL TO NX*NY.
+C
+C
+C INTERNAL PARAMETERS    NAME   DEFAULT  FUNCTION
+C                        ----   -------  --------
+C                        IFR        1    -1  CALL FRAME FIRST.
+C                                         0  DO NOT CALL FRAME.
+C                                        +1  CALL FRAME WHEN DONE.
+c +NOAO:  The value of ifr has been changed from its default of +1 to 0.
+c -NOAO
+C
+C                        ISTP       0    STEREO TYPE IF STEREO
+C                                        NON-ZERO.
+C                                        -1  ALTERNATING FRAMES,
+C                                                  SLIGHTLY OFFSET (FOR
+C                                                  MOVIES.  IROTS = 0).
+C                                               0  BLANK FRAME BETWEEN
+C                                                  FOR STEREO   SLIDE.
+C                                                  IROTS = 1).
+C                                        +1  BOTH ON SAME FRAME.
+C                                                  (LEFT PICTURE TO LEFT
+C                                                  SIDE.  IROTS = 0).
+C
+C                        IROTS      0     0  +Z IN VERTICAL PLOTTING
+C                                                  DIRECTION (CINE MODE).
+C                                        +1  +Z IN HORIZONTAL
+C                                                  PLOTTING DIRECTION
+C                                                  (COMIC MODE).
+C
+C                        IDRX       1    +1  DRAW LINES OF CONSTANT
+C                                                  X.
+C                                               0  DO   NOT.
+C
+C                        IDRY       1    +1  DRAW LINES OF CONSTANT
+C                                                  Y.
+C                                               0  DO   NOT.
+C
+C                        IDRZ       0    +1  DRAW LINES OF CONSTANT
+C                                                  Z (CONTOUR   LINES).
+C                                               0  DO   NOT.
+C
+C                        IUPPER         0        +1  DRAW UPPER SIDE OF
+C                                                  SURFACE.
+C                                        0  DRAW BOTH SIDES.
+C                                        -1  DRAW LOWER SIDE.
+C
+C                        ISKIRT         0        +1  DRAW A SKIRT AROUND THE
+C                                                  SURFACE.
+C                                                  BOTTOM = HSKIRT.
+C                                               0  DO   NOT.
+C
+C                        NCLA       6    APPROXIMATE NUMBER OF
+C                                        LEVELS OF CONSTANT Z THAT
+C                                        ARE DRAWN IF LEVELS ARE NOT
+C                                        SPECIFIED.  40 LEVELS
+C                                        MAXIMUM.
+C
+C                        THETA    .02    ANGLE IN RADIANS BETWEEN
+C                                        EYES FOR STEREO PAIRS.
+C
+C                        HSKIRT    0.    HEIGHT OF SKIRT
+C                                                  (IF ISKIRT   = 1).
+C
+C                        CHI       0.    HIGHEST LEVEL OF CONSTANT
+C                                        Z.
+C
+C                        CLO       0.    LOWEST LEVEL OF CONSTANT Z.
+C
+C                        CINC      0.    INCREMENT BETWEEN LEVELS.
+C
+C                          [IF CHI, CLO, OR CINC IS ZERO, A NICE
+C                               VALUE IS GENERATED AUTOMATICALLY.]
+C
+C                        IOFFP     0     FLAG TO CONTROL USE OF SPECIAL
+C                                        VALUE FEATURE.  DO NOT HAVE
+C                                        BOTH IOFFP=1 AND ISKIRT=1.
+C                                               0 FEATURE NOT   IN USE
+C                                        +1  FEATURE IN USE.  NO LINES
+C                                                  DRAWN TO DATA POINTS IN Z
+C                                                  THAT ARE EQUAL TO SPVAL.
+C
+C                        SPVAL     0.    SPECIAL VALUE USED TO MARK UN-
+C                                        KNOWN DATA WHEN IOFFP=1.
+C
+C
+C
+      DIMENSION       X(NX)      ,Y(NY)    ,Z(MX,NY), M(2,NX,NY),
+     1                S(6)
+      DIMENSION       WIN1(4)    ,VP1(4)           ,LASF(13)
+      COMMON /SRFINT/ ISRFMJ     ,ISRFMN          ,ISRFTX
+c +NOAO: common block added 4NOV85 to allow user control of viewport
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c -NOAO
+c +NOAO: Blockdata srfabd rewritten as run time initialization
+c     EXTERNAL        SRFABD
+      call srfabd
+c -NOAO
+      CALL Q8QST4 ('GRAPHX','SRFACE','SRFACE','VERSION 01')
+C
+C     THIS DRIVER SAVES THE CURRENT NORMALIZATION TRANSFORMATION
+C     INFORMATION, DEFINES THE NORMALIZATION TRANSFORMATION
+C     APPROPRIATE FOR SRFGK, CALLS SRFGK, AND RESTORES THE ORIGINAL
+C     NORMALIZATION TRANSFORMATION.
+C
+C     GET CURRENT NORMALIZATION TRANSFORMATION NUMBER
+C
+      CALL GQCNTN (IER,NTORIG)
+C
+C     STORE WINDOW AND VIEWPORT OF NORMALIZATION TRANSFORMATION 1
+C
+      CALL GQNT (NTORIG,IER,WIN1,VP1)
+      CALL GETUSV('LS',IOLLS)
+C
+C     SET WINDOW AND VIEWPORT FOR SRFGK
+C
+c     CALL SET(0.,1.,0.,1.,1.,1024.,1.,1024.,1)
+c +NOAO: viewport limits now stored in common block noaovp
+      CALL SET(vpx1, vpx2, vpy1, vpy2, 1.0, 1024., 1.0, 1024., 1)
+c -NOAO
+C
+C     SET LINE COLOR TO INDIVIDUAL (SAVE CURRENT SETTING)
+C
+      CALL GQASF (IER,LASF)
+      LASFSV  = LASF(3)
+      LASF(3) = 1
+      CALL GSASF(LASF)
+C
+C     SET LINE COLOR INDEX TO COMMON VARIABLE ISRFMJ (SAVE
+C     CURRENT SETTING)
+C
+      CALL GQPLCI (IER,LCISV)
+      CALL GSPLCI (ISRFMJ)
+C
+C     DRAW PLOT
+C
+      CALL SRFGK (X,Y,Z,M,MX,NX,NY,S,STEREO)
+C
+C     RESTORE INITIAL LINE COLOR SETTINGS
+C
+      LASF(3) = LASFSV
+      CALL GSASF(LASF)
+      CALL GSPLCI (LCISV)
+C
+C     RESTORE ORIGINAL NORMALIZATION TRANSFORMATION
+C
+      CALL SET(VP1(1),VP1(2),VP1(3),VP1(4),WIN1(1),WIN1(2),
+     -         WIN1(3),WIN1(4),IOLLS)
+      CALL GSELNT (NTORIG)
+C
+      RETURN
+      END
+      SUBROUTINE SRFGK (X,Y,Z,M,MX,NX,NY,S,STEREO)
+C
+      DIMENSION       X(NX)      ,Y(NY)   ,Z(MX,NY)  ,M(2,NX,NY) ,
+     1                S(6)
+      DIMENSION       MXS(2)     ,MXF(2) ,MXJ(2) ,MYS(2),
+     1                MYF(2)     ,MYJ(2)
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      COMMON /PWRZ1S/ XXMIN      ,XXMAX      ,YYMIN      ,YYMAX,
+     1                ZZMIN      ,ZZMAX      ,DELCRT     ,EYEX,
+     2                EYEY       ,EYEZ
+      COMMON /SRFIP1/ IFR        ,ISTP       ,IROTS      ,IDRX ,
+     1                IDRY       ,IDRZ       ,IUPPER     ,ISKIRT,
+     2                NCLA       ,THETA      ,HSKIRT     ,CHI,
+     3                CLO        ,CINC       ,ISPVAL
+c +NOAO:
+      common /noaovp/ vpx1, vpx2, vpy1, vpy2
+c -NOAO
+C
+      DATA JF, IF, LY, LX, ICNST /1, 1, 2, 2, 0/
+      CALL Q8QST4 ('GRAPHX','SRFACE','SRFGK','VERSION 01')
+      BIGEST = R1MACH(2)
+      MMXX = MX
+      NNXX = NX
+      NNYY = NY
+      STER = STEREO
+      NXP1 = NNXX+1
+      NYP1 = NNYY+1
+      NLA = NCLA
+      NSPVAL = ISPVAL
+      NDRZ = IDRZ
+      IF (IDRZ .NE. 0)
+     1    CALL CLSET (Z,MMXX,NNXX,NNYY,CHI,CLO,CINC,NLA,40,CL,NCL,
+     2                ICNST,IOFFP,SPVAL,BIGEST)
+      IF (IDRZ .NE. 0) NDRZ = 1-ICNST
+      STHETA = SIN(STER*THETA)
+      CTHETA = COS(STER*THETA)
+      RX = S(1)-S(4)
+      RY = S(2)-S(5)
+      RZ = S(3)-S(6)
+      D1 = SQRT(RX*RX+RY*RY+RZ*RZ)
+      D2 = SQRT(RX*RX+RY*RY)
+      DX = 0.
+      DY = 0.
+      IF (STEREO .EQ. 0.) GO TO  20
+      D1 = D1*STEREO*THETA
+      IF (D2 .GT. 0.) GO TO  10
+      DX = D1
+      GO TO  20
+   10 AGL = ATAN2(RX,-RY)
+      DX = D1*COS(AGL)
+      DY = D1*SIN(AGL)
+   20 IROT = IROTS
+      NPIC = 1
+      IF (STER .NE. 0.) NPIC = 2
+      FACT = 1.
+      IF (NRSWT .NE. 0) FACT = RZERO/D1
+      IF (ISTP.EQ.0 .AND. STER.NE.0.) IROT = 1
+      DO 570 IPIC=1,NPIC
+         NUPPER = IUPPER
+         IF (IFR .LT. 0) CALL FRAME
+C
+C SET UP MAPING FROM FLOATING POINT 3-SPACE TO CRT SPACE.
+C
+         SIGN1 = IPIC*2-3
+         EYEX = S(1)+SIGN1*DX
+         POIX = S(4)+SIGN1*DX
+         EYEY = S(2)+SIGN1*DY
+         POIY = S(5)+SIGN1*DY
+         EYEZ = S(3)
+         POIZ = S(6)
+         LL = 0
+         XEYE = EYEX
+         YEYE = EYEY
+         ZEYE = EYEZ
+         CALL TRN32S (POIX,POIY,POIZ,XEYE,YEYE,ZEYE,0)
+         LL = IPIC+2*ISTP+3
+         IF (STER .EQ. 0.) LL = 1
+         IF (NRSWT .NE. 0) GO TO 100
+         XXMIN = X(1)
+         XXMAX = X(NNXX)
+         YYMIN = Y(1)
+         YYMAX = Y(NNYY)
+         UMIN = BIGEST
+         VMIN = BIGEST
+         ZZMIN = BIGEST
+         UMAX = -UMIN
+         VMAX = -VMIN
+         ZZMAX = -ZZMIN
+         DO  40 J=1,NNYY
+            DO  30 I=1,NNXX
+                ZZ = Z(I,J)
+                IF (IOFFP.EQ.1 .AND. ZZ.EQ.SPVAL) GO TO 30
+                ZZMAX = AMAX1(ZZMAX,ZZ)
+                ZZMIN = AMIN1(ZZMIN,ZZ)
+                CALL TRN32S (X(I),Y(J),Z(I,J),UT,VT,DUMMY,1)
+                UMAX = AMAX1(UMAX,UT)
+                UMIN = AMIN1(UMIN,UT)
+                VMAX = AMAX1(VMAX,VT)
+                VMIN = AMIN1(VMIN,VT)
+   30             CONTINUE
+   40    CONTINUE
+         IF (ISKIRT .NE. 1) GO TO  70
+         NXSTP = NNXX-1
+         NYSTP = NNYY-1
+         DO  60 J=1,NNYY,NYSTP
+            DO  50 I=1,NNXX,NXSTP
+                CALL TRN32S (X(I),Y(J),HSKIRT,UT,VT,DUMMY,1)
+                UMAX = AMAX1(UMAX,UT)
+                UMIN = AMIN1(UMIN,UT)
+                VMAX = AMAX1(VMAX,VT)
+                VMIN = AMIN1(VMIN,VT)
+   50             CONTINUE
+   60    CONTINUE
+   70    CONTINUE
+         WIDTH = UMAX-UMIN
+         HIGHT = VMAX-VMIN
+         DIF = .5*(WIDTH-HIGHT)
+         IF (DIF)  80,100, 90
+   80    UMIN = UMIN+DIF
+         UMAX = UMAX-DIF
+         GO TO 100
+   90    VMIN = VMIN-DIF
+         VMAX = VMAX+DIF
+  100    XEYE = EYEX
+         YEYE = EYEY
+         ZEYE = EYEZ
+         CALL TRN32S (POIX,POIY,POIZ,XEYE,YEYE,ZEYE,0)
+         DO 120 J=1,NNYY
+            DO 110 I=1,NNXX
+                CALL TRN32S (X(I),Y(J),Z(I,J),UT,VT,DUMMY,1)
+                M(1,I,J)        = UT
+                M(2,I,J)        = VT
+  110             CONTINUE
+  120    CONTINUE
+C
+C INITIALIZE UPPER AND LOWER VISIBILITY ARRAYS
+C
+         DO 130 K=1,1024
+            LIMU(K) = 0
+            LIML(K) = 1024
+  130    CONTINUE
+C
+C FIND ORDER TO DRAW LINES
+C
+         NXPASS = 1
+         IF (S(1) .GE. X(NNXX)) GO TO 160
+         IF (S(1) .LE. X(1)) GO TO 170
+         DO 140 I=2,NNXX
+            LX = I
+            IF (S(1) .LE. X(I)) GO TO 150
+  140    CONTINUE
+  150    MXS(1) = LX-1
+         MXJ(1) = -1
+         MXF(1) = 1
+         MXS(2) = LX
+         MXJ(2) = 1
+         MXF(2) = NNXX
+         NXPASS = 2
+         GO TO 180
+  160    MXS(1) = NNXX
+         MXJ(1) = -1
+         MXF(1) = 1
+         GO TO 180
+  170    MXS(1) = 1
+         MXJ(1) = 1
+         MXF(1) = NNXX
+  180    NYPASS = 1
+         IF (S(2) .GE. Y(NNYY)) GO TO 210
+         IF (S(2) .LE. Y(1)) GO TO 220
+         DO 190 J=2,NNYY
+            LY = J
+            IF (S(2) .LE. Y(J)) GO TO 200
+  190    CONTINUE
+  200    MYS(1) = LY-1
+         MYJ(1) = -1
+         MYF(1) = 1
+         MYS(2) = LY
+         MYJ(2) = 1
+         MYF(2) = NNYY
+         NYPASS = 2
+         GO TO 230
+  210    MYS(1) = NNYY
+         MYJ(1) = -1
+         MYF(1) = 1
+         GO TO 230
+  220    MYS(1) = 1
+         MYJ(1) = 1
+         MYF(1) = NNYY
+C
+C PUT ON SKIRT ON FRONT SIDE IF WANTED
+C
+  230    IF (NXPASS.EQ.2 .AND. NYPASS.EQ.2) GO TO 490
+         IF (ISKIRT .EQ. 0) GO TO 290
+         IN = MXS(1)
+         IF = MXF(1)
+         JN = MYS(1)
+         JF = MYF(1)
+         IF (NYPASS .NE. 1) GO TO 260
+         CALL TRN32S (X(1),Y(JN),HSKIRT,UX1,VX1,DUMMY,1)
+         CALL TRN32S (X(NNXX),Y(JN),HSKIRT,UX2,VX2,DUMMY,1)
+         QU = (UX2-UX1)/(X(NNXX)-X(1))
+         QV = (VX2-VX1)/(X(NNXX)-X(1))
+         YNOW = Y(JN)
+         DO 240 I=1,NNXX
+            CALL TRN32S (X(I),YNOW,HSKIRT,RU,RV,DUMMY,1)
+            CALL DRAWS (IFIX(RU),IFIX(RV),M(1,I,JN),M(2,I,JN),1,0)
+  240    CONTINUE
+         CALL DRAWS (IFIX(UX1),IFIX(VX1),IFIX(UX2),IFIX(VX2),1,1)
+         IF (IDRY .NE. 0) GO TO 260
+         DO 250 I=2,NNXX
+            CALL DRAWS (M(1,I-1,JN),M(2,I-1,JN),M(1,I,JN),M(2,I,JN),1,1)
+  250    CONTINUE
+  260    IF (NXPASS .NE. 1) GO TO 290
+         CALL TRN32S (X(IN),Y(1),HSKIRT,UY1,VY1,DUMMY,1)
+         CALL TRN32S (X(IN),Y(NNYY),HSKIRT,UY2,VY2,DUMMY,1)
+         QU = (UY2-UY1)/(Y(NNYY)-Y(1))
+         QV = (VY2-VY1)/(Y(NNYY)-Y(1))
+         XNOW = X(IN)
+         DO 270 J=1,NNYY
+            CALL TRN32S (XNOW,Y(J),HSKIRT,RU,RV,DUMMY,1)
+            CALL DRAWS (IFIX(RU),IFIX(RV),M(1,IN,J),M(2,IN,J),1,0)
+  270    CONTINUE
+         CALL DRAWS (IFIX(UY1),IFIX(VY1),IFIX(UY2),IFIX(VY2),1,1)
+         IF (IDRX .NE. 0) GO TO 290
+         DO 280 J=2,NNYY
+            CALL DRAWS (M(1,IN,J-1),M(2,IN,J-1),M(1,IN,J),M(2,IN,J),1,1)
+  280    CONTINUE
+C
+C PICK PROPER ALGORITHM
+C
+  290    LI = MXJ(1)
+         MI = MXS(1)-LI
+         NI = IABS(MI-MXF(1))
+         LJ = MYJ(1)
+         MJ = MYS(1)-LJ
+         NJ = IABS(MJ-MYF(1))
+C
+C WHEN LINE OF SIGHT IS NEARER TO PARALLEL TO THE X AXIS,
+C HAVE J LOOP OUTER-MOST, OTHERWISE HAVE I LOOP OUTER-MOST.
+C
+         IF (ABS(RX) .LE. ABS(RY)) GO TO 360
+         IF (ISKIRT.NE.0 .OR. NYPASS.NE.1) GO TO 310
+         I = MXS(1)
+         DO 300 J=2,NNYY
+            CALL DRAWS (M(1,I,J-1),M(2,I,J-1),M(1,I,J),M(2,I,J),0,1)
+  300    CONTINUE
+  310    DO 350 II=1,NNXX
+            I = MI+II*LI
+            IPLI = I+LI
+            IF (NYPASS .EQ. 1) GO TO 320
+            K = MYS(1)
+            L = MYS(2)
+            IF (IDRX .NE. 0)
+     1          CALL DRAWS (M(1,I,K),M(2,I,K),M(1,I,L),M(2,I,L),1,1)
+            IF (NDRZ.NE.0 .AND. II.NE.NI)
+     1          CALL CTCELL (Z,MMXX,NNXX,NNYY,M,MIN0(I,I+LI),K)
+  320             DO 340 JPASS=1,NYPASS
+                LJ = MYJ(JPASS)
+                MJ = MYS(JPASS)-LJ
+                NJ = IABS(MJ-MYF(JPASS))
+                DO 330 JJ=1,NJ
+                  J = MJ+JJ*LJ
+                  JPLJ = J+LJ
+                  IF (IDRX.NE.0 .AND. JJ.NE.NJ)
+     1                CALL DRAWS (M(1,I,J),M(2,I,J),M(1,I,JPLJ),
+     2                            M(2,I,JPLJ),1,1)
+                  IF (I.NE.MXF(1) .AND. IDRY.NE.0)
+     1                CALL DRAWS (M(1,IPLI,J),M(2,IPLI,J),M(1,I,J),
+     2                            M(2,I,J),1,1)
+                  IF (NDRZ.NE.0 .AND. JJ.NE.NJ .AND. II.NE.NNXX)
+     1                CALL CTCELL (Z,MMXX,NNXX,NNYY,M,MIN0(I,I+LI),
+     2                             MIN0(J,J+LJ))
+  330                CONTINUE
+  340             CONTINUE
+  350    CONTINUE
+         GO TO 430
+  360    IF (ISKIRT.NE.0 .OR. NXPASS.NE.1) GO TO 380
+         J = MYS(1)
+         DO 370 I=2,NNXX
+            CALL DRAWS (M(1,I-1,J),M(2,I-1,J),M(1,I,J),M(2,I,J),0,1)
+  370    CONTINUE
+  380    DO 420 JJ=1,NNYY
+            J = MJ+JJ*LJ
+            JPLJ = J+LJ
+            IF (NXPASS .EQ. 1) GO TO 390
+            K = MXS(1)
+            L = MXS(2)
+            IF (IDRY .NE. 0)
+     1          CALL DRAWS (M(1,K,J),M(2,K,J),M(1,L,J),M(2,L,J),1,1)
+            IF (NDRZ.NE.0 .AND. JJ.NE.NJ)
+     1          CALL CTCELL (Z,MMXX,NNXX,NNYY,M,K,MIN0(J,J+LJ))
+  390             DO 410 IPASS=1,NXPASS
+                LI = MXJ(IPASS)
+                MI = MXS(IPASS)-LI
+                NI = IABS(MI-MXF(IPASS))
+                DO 400 II=1,NI
+                  I = MI+II*LI
+                  IPLI = I+LI
+                  IF (IDRY.NE.0 .AND. II.NE.NI)
+     1                CALL DRAWS (M(1,I,J),M(2,I,J),M(1,IPLI,J),
+     2                            M(2,IPLI,J),1,1)
+                  IF (J.NE.MYF(1) .AND. IDRX.NE.0)
+     1                CALL DRAWS (M(1,I,JPLJ),M(2,I,JPLJ),M(1,I,J),
+     2                            M(2,I,J),1,1)
+                  IF (NDRZ.NE.0 .AND. II.NE.NI .AND. JJ.NE.NNYY)
+     1                CALL CTCELL (Z,MMXX,NNXX,NNYY,M,MIN0(I,I+LI),
+     2                             MIN0(J,J+LJ))
+  400                CONTINUE
+  410             CONTINUE
+  420    CONTINUE
+  430    IF (ISKIRT .EQ. 0) GO TO 520
+C
+C FIX UP IF SKIRT IS USED WITH LINES ONE WAY.
+C
+         IF (IDRX .NE. 0) GO TO 460
+         DO 450 IPASS=1,NXPASS
+            IF (NXPASS .EQ. 2) IF = 1+(IPASS-1)*(NNXX-1)
+            DO 440 J=2,NNYY
+                CALL DRAWS (M(1,IF,J-1),M(2,IF,J-1),M(1,IF,J),M(2,IF,J),
+     1                     1,0)
+  440             CONTINUE
+  450    CONTINUE
+  460    IF (IDRY .NE. 0) GO TO 520
+         DO 480 JPASS=1,NYPASS
+            IF (NYPASS .EQ. 2) JF = 1+(JPASS-1)*(NNYY-1)
+            DO 470 I=2,NNXX
+                CALL DRAWS (M(1,I-1,JF),M(2,I-1,JF),M(1,I,JF),M(2,I,JF),
+     1                     1,0)
+  470             CONTINUE
+  480    CONTINUE
+         GO TO 520
+C
+C ALL VISIBLE IF VIEWED FROM DIRECTLY ABOVE OR BELOW.
+C
+  490    IF (NUPPER.GT.0 .AND. S(3).LT.S(6)) GO TO 520
+         IF (NUPPER.LT.0 .AND. S(3).GT.S(6)) GO TO 520
+         NUPPER = 1
+         IF (S(3) .LT. S(6)) NUPPER = -1
+         DO 510 I=1,NNXX
+            DO 500 J=1,NNYY
+                IF (IDRX.NE.0 .AND. J.NE.NNYY)
+     1             CALL DRAWS (M(1,I,J),M(2,I,J),M(1,I,J+1),M(2,I,J+1),
+     2                          1,0)
+                IF (IDRY.NE.0 .AND. I.NE.NNXX)
+     1             CALL DRAWS (M(1,I,J),M(2,I,J),M(1,I+1,J),M(2,I+1,J),
+     2                          1,0)
+                IF (IDRZ.NE.0 .AND. I.NE.NNXX .AND. J.NE.NNYY)
+     1             CALL CTCELL (Z,MMXX,NNXX,NNYY,M,I,J)
+  500             CONTINUE
+  510    CONTINUE
+  520    IF (STER .EQ. 0.) GO TO 560
+         IF (ISTP) 540,530,550
+  530    CALL FRAME
+  540    CALL FRAME
+         GO TO 570
+  550    IF (IPIC .NE. 2) GO TO 570
+  560    IF (IFR .GT. 0) CALL FRAME
+  570 CONTINUE
+      RETURN
+      END
+      SUBROUTINE EZSRFC (Z,M,N,ANGH,ANGV,WORK)
+      DIMENSION       Z(M,N)     ,WORK(1)
+C
+C                         WORK(2*M*N+M+N)
+C
+C PERSPECTIVE PICTURE OF A SURFACE STORED IN A TWO DIMENSIONAL ARRAY
+C VIA A VERY SHORT ARGUMENT LIST.
+C
+C ASSUMPTIONS--
+C     THE ENTIRE ARRAY IS TO BE DRAWN,
+C     THE DATA IS EQUALLY SPACED (IN THE X-Y PLANE),
+C     NO STEREO PAIRS.
+C IF THESE ASSUMPTIONS ARE NOT MET USE SRFACE.
+C
+C ARGUMENTS--
+C     Z    THE 2 DIMENSIONAL ARRAY TO BE DRAWN.
+C     M    THE FIRST DIMENSION OF Z.
+C     N    THE SECOND DIMENSION OF Z.
+C     ANGH ANGLE IN DEGREES IN THE X-Y PLANE TO THE LINE OF SIGHT
+C          (COUNTER-CLOCK WISE FROM THE PLUS-X AXIS).
+C     ANGV ANGLE IN DEGREES FROM THE X-Y PLANE TO THE LINE OF SIGHT
+C          (POSITIVE ANGLES ARE ABOVE THE MIDDLE Z, NEGATIVE BELOW).
+C     WORK A SCRATCH STORAGE DIMENSIONED AT LEAST 2*M*N+M+N.
+C
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                NOFFP      ,NSPVAL     ,SPV        ,BIGEST
+      DIMENSION       S(6)
+      DATA S(4),S(5),S(6)/0.0,0.0,0.0/
+C
+C  FACT1 IS THE PERSPECTIVE RATIO AND IS DEFINED TO BE THE RATIO
+C         MAXIMUM(LENGTH,WIDTH)/HEIGHT
+C
+C  FACT2 IS THE RATIO   (LENGTH OF LINE OF SIGHT)/MAXIMUM(LENGTH,WIDTH)
+C
+      DATA FACT1,FACT2/2.0,5.0/
+      BIGEST = R1MACH(2)
+C
+C FIND RANGE OF Z
+C
+      MX = M
+      NY = N
+      ANG1 = ANGH*3.14159265358979/180.
+      ANG2 = ANGV*3.14159265358979/180.
+      FLO = BIGEST
+      HI = -FLO
+      DO  20 J=1,NY
+         DO  10 I=1,MX
+            IF (NOFFP.EQ.1 .AND. Z(I,J).EQ.SPV) GO TO   10
+            HI = AMAX1(Z(I,J),HI)
+            FLO = AMIN1(Z(I,J),FLO)
+   10    CONTINUE
+   20 CONTINUE
+C
+C SET UP LINEAR X AND Y ARRAYS FOR SRFACE
+C
+      DELTA = (HI-FLO)/(AMAX0(MX,NY)-1.)*FACT1
+      XMIN = -(FLOAT(MX/2)*DELTA+FLOAT(MOD(MX+1,2))*DELTA)
+      YMIN = -(FLOAT(NY/2)*DELTA+FLOAT(MOD(NY+1,2))*DELTA)
+      DO  30 I=1,MX
+         WORK(I) = XMIN+FLOAT(I-1)*DELTA
+   30 CONTINUE
+      DO  40 J=1,NY
+         K = MX+J
+         WORK(K) = YMIN+FLOAT(J-1)*DELTA
+   40 CONTINUE
+C
+C SET UP EYE POSITION
+C
+      FACTE = (HI-FLO)*FACT1*FACT2
+      CANG2 = COS(ANG2)
+      S(1) = FACTE*CANG2*COS(ANG1)
+      S(2) = FACTE*CANG2*SIN(ANG1)
+      S(3) = FACTE*SIN(ANG2)+(FLO+HI)*.5
+C
+C READY
+C
+      CALL SRFACE (WORK(1),WORK(MX+1),Z,WORK(K+1),MX,MX,NY,S,0.)
+      RETURN
+      END
+      SUBROUTINE SETR (XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,R0)
+C
+C THIS ROUTINE ESTABLISHES CERTAIN CONSTANTS SO THAT SRFACE
+C PRODUCES A PICTURE WHOSE SIZE CHANGES WITH RESPECT TO THE
+C VIEWERS DISTANCE FROM THE OBJECT.  IT CAN ALSO BE USED
+C WHEN MAKING A MOVIE OF AN OBJECT EVOLVING IN TIME TO KEEP
+C IT POSITIONED PROPERLY ON THE SCREEN, SAVING COMPUTER TIME
+C IN THE BARGIN.  CALL IT WITH R0 NEGATIVE TO TURN OFF THIS
+C FEATURE.
+C PARAMETERS
+C XMIN,XMAX - RANGE OF X ARRAY THAT WILL BE PASSED TO SRFACE.
+C YMIN,YMAX - SAME IDEA, BUT FOR Y.
+C ZMIN,ZMAX - SAME IDEA, BUT FOR Z.  IF A MOVIE IS BEING
+C               MADE OF AN EVOLVING Z ARRAY, ZMIN       AND ZMAX
+C               SHOULD CONTAIN RANGE OF THE UNION       OF ALL THE Z
+C               ARRAYS.  THEY NEED NOT BE       EXACT.
+C R0             - DISTANCE BETWEEN OBSERVER    AND POINT LOOKED AT
+C               WHEN THE PICTURE IS TO FILL THE SCREEN WHEN
+C               VIEWED FROM THE DIRECTION       WHICH MAKES THE PIC-
+C               TURE BIGGEST.  IF       R0 IS NOT POSITIVE, THEN THE
+C               RELATIVE SIZE FEATURE IS TURNED OFF, AND SUB-
+C               SEQUENT PICTURES WILL FILL THE SCREEN.
+C
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      COMMON /PWRZ1S/ XXMIN      ,XXMAX      ,YYMIN      ,YYMAX,
+     1                ZZMIN      ,ZZMAX      ,DELCRT     ,EYEX,
+     2                EYEY       ,EYEZ
+C
+C
+      CALL Q8QST4 ('GRAPHX','SRFACE','SETR','VERSION 01')
+      IF (R0)  10, 10, 20
+   10 NRSWT = 0
+      RETURN
+   20 NRSWT = 1
+      XXMIN = XMIN
+      XXMAX = XMAX
+      YYMIN = YMIN
+      YYMAX = YMAX
+      ZZMIN = ZMIN
+      ZZMAX = ZMAX
+      RZERO = R0
+      LL = 0
+      XAT = (XXMAX+XXMIN)*.5
+      YAT = (YYMAX+YYMIN)*.5
+      ZAT = (ZZMAX+ZZMIN)*.5
+      ALPHA = -(YYMIN-YAT)/(XXMIN-XAT)
+      YEYE = -RZERO/SQRT(1.+ALPHA*ALPHA)
+      XEYE = YEYE*ALPHA
+      YEYE = YEYE+YAT
+      XEYE = XEYE+XAT
+      ZEYE = ZAT
+      CALL TRN32S (XAT,YAT,ZAT,XEYE,YEYE,ZEYE,0)
+      XMN = XXMIN
+      XMX = XXMAX
+      YMN = YYMIN
+      YMX = YYMAX
+      ZMN = ZZMIN
+      ZMX = ZZMAX
+      CALL TRN32S (XMN,YMN,ZAT,UMN,DUMMY,DUMMIE,1)
+      CALL TRN32S (XMX,YMN,ZMN,DUMMY,VMN,DUMMIE,1)
+      CALL TRN32S (XMX,YMX,ZAT,UMX,DUMMY,DUMMIE,1)
+      CALL TRN32S (XMX,YMN,ZMX,DUMMY,VMX,DUMMIE,1)
+      UMIN = UMN
+      UMAX = UMX
+      VMIN = VMN
+      VMAX = VMX
+      BIGD = SQRT((XXMAX-XXMIN)**2+(YYMAX-YYMIN)**2+(ZZMAX-ZZMIN)**2)*.5
+      RETURN
+      END
+      SUBROUTINE DRAWS (MX1,MY1,MX2,MY2,IDRAW,IMARK)
+C
+C THIS ROUTINE DRAWS THE VISIBLE PART OF THE LINE CONNECTING
+C (MX1,MY1) AND (MX2,MY2).  IF IDRAW .NE. 0, THE LINE IS DRAWN.
+C IF IMARK .NE. 0, THE VISIBILITY ARRAY IS MARKED.
+C
+      LOGICAL               VIS1         ,VIS2
+      DIMENSION       PXS(2)     ,PYS(2)
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      DATA STEEP/5./
+      DATA MX, MY /0, 0/
+C
+c +NOAO: Blockdata srfabd rewritten as run time initialization
+c     EXTERNAL        SRFABD
+      call srfabd
+c -NOAO
+C MAKE LINE LEFT TO RIGHT.
+C
+      MMX1 = MX1
+      MMY1 = MY1
+      MMX2 = MX2
+      MMY2 = MY2
+      IF (MMX1.EQ.NSPVAL .OR. MMX2.EQ.NSPVAL) RETURN
+      IF (MMX1 .GT. MMX2) GO TO  10
+      NX1 = MMX1
+      NY1 = MMY1
+      NX2 = MMX2
+      NY2 = MMY2
+      GO TO  20
+   10 NX1 = MMX2
+      NY1 = MMY2
+      NX2 = MMX1
+      NY2 = MMY1
+   20 IF (NUPPER .LT. 0) GO TO 180
+C
+C CHECK UPPER VISIBILITY.
+C
+      VIS1 = NY1 .GE. (LIMU(NX1)-1)
+      VIS2 = NY2 .GE. (LIMU(NX2)-1)
+C
+C VIS1 AND VIS2 TRUE MEANS VISIBLE.
+C
+      IF (VIS1 .AND. VIS2) GO TO 120
+C
+C VIS1 AND VIS2 FALSE MEANS INVISIBLE.
+C
+      IF (.NOT.(VIS1 .OR. VIS2)) GO TO 180
+C
+C FIND CHANGE POINT.
+C
+      IF (NX1 .EQ. NX2) GO TO 110
+      DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1)
+      NX1P1 = NX1+1
+      FNY1 = NY1
+      IF (VIS1) GO TO  60
+      DO  30 K=NX1P1,NX2
+         MX = K
+         MY = FNY1+FLOAT(K-NX1)*DY
+         IF (MY .GT. LIMU(K)) GO TO  40
+   30 CONTINUE
+   40 IF (ABS(DY) .GE. STEEP) GO TO  90
+   50 NX1 = MX
+      NY1 = MY
+      GO TO 120
+   60 DO  70 K=NX1P1,NX2
+         MX = K
+         MY = FNY1+FLOAT(K-NX1)*DY
+         IF (MY .LT. LIMU(K)) GO TO  80
+   70 CONTINUE
+   80 IF (ABS(DY) .GE. STEEP) GO TO 100
+      NX2 = MX-1
+      NY2 = MY
+      GO TO 120
+   90 IF (LIMU(MX) .EQ. 0) GO TO  50
+      NX1 = MX
+      NY1 = LIMU(NX1)
+      GO TO 120
+  100 NX2 = MX-1
+      NY2 = LIMU(NX2)
+      GO TO 120
+  110 IF (VIS1) NY2 = MIN0(LIMU(NX1),LIMU(NX2))
+      IF (VIS2) NY1 = MIN0(LIMU(NX1),LIMU(NX2))
+  120 IF (IDRAW .EQ. 0) GO TO 150
+C
+C DRAW VISIBLE PART OF LINE.
+C
+      IF (IROT) 130,140,130
+  130 CONTINUE
+      PXS(1) = FLOAT(NY1)
+      PXS(2) = FLOAT(NY2)
+      PYS(1) = FLOAT(1024-NX1)
+      PYS(2) = FLOAT(1024-NX2)
+      CALL GPL (2,PXS,PYS)
+      GO TO 150
+  140 CONTINUE
+      PXS(1) = FLOAT(NX1)
+      PXS(2) = FLOAT(NX2)
+      PYS(1) = FLOAT(NY1)
+      PYS(2) = FLOAT(NY2)
+      CALL GPL (2,PXS,PYS)
+  150 IF (IMARK .EQ. 0) GO TO 180
+      IF (NX1 .EQ. NX2) GO TO 170
+      DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1)
+      FNY1 = NY1
+      DO 160 K=NX1,NX2
+         LTEMP = FNY1+FLOAT(K-NX1)*DY
+	 IF (LTEMP .GT. LIMU(K)) LIMU(K) = LTEMP
+  160 CONTINUE
+      GO TO 180
+  170 LTEMP = MAX0(NY1,NY2)
+      IF (LTEMP .GT. LIMU(NX1)) LIMU(NX1) = LTEMP
+  180 IF (NUPPER) 190,190,370
+C
+C SAME IDEA AS ABOVE, BUT FOR LOWER SIDE.
+C
+  190 IF (MMX1 .GT. MMX2) GO TO 200
+      NX1 = MMX1
+      NY1 = MMY1
+      NX2 = MMX2
+      NY2 = MMY2
+      GO TO 210
+  200 NX1 = MMX2
+      NY1 = MMY2
+      NX2 = MMX1
+      NY2 = MMY1
+  210 VIS1 = NY1 .LE. (LIML(NX1)+1)
+      VIS2 = NY2 .LE. (LIML(NX2)+1)
+      IF (VIS1 .AND. VIS2) GO TO 310
+      IF (.NOT.(VIS1 .OR. VIS2)) GO TO 370
+      IF (NX1 .EQ. NX2) GO TO 300
+      DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1)
+      NX1P1 = NX1+1
+      FNY1 = NY1
+      IF (VIS1) GO TO 250
+      DO 220 K=NX1P1,NX2
+         MX = K
+         MY = FNY1+FLOAT(K-NX1)*DY
+         IF (MY .LT. LIML(K)) GO TO 230
+  220 CONTINUE
+  230 IF (ABS(DY) .GE. STEEP) GO TO 280
+  240 NX1 = MX
+      NY1 = MY
+      GO TO 310
+  250 DO 260 K=NX1P1,NX2
+         MX = K
+         MY = FNY1+FLOAT(K-NX1)*DY
+         IF (MY .GT. LIML(K)) GO TO 270
+  260 CONTINUE
+  270 IF (ABS(DY) .GE. STEEP) GO TO 290
+      NX2 = MX-1
+      NY2 = MY
+      GO TO 310
+  280 IF (LIML(MX) .EQ. 1024) GO TO 240
+      NX1 = MX
+      NY1 = LIML(NX1)
+      GO TO 310
+  290 NX2 = MX-1
+      NY2 = LIML(NX2)
+      GO TO 310
+  300 IF (VIS1) NY2 = MAX0(LIML(NX1),LIML(NX2))
+      IF (VIS2) NY1 = MAX0(LIML(NX1),LIML(NX2))
+  310 IF (IDRAW .EQ. 0) GO TO 340
+      IF (IROT) 320,330,320
+  320 CONTINUE
+      PXS(1) = FLOAT(NY1)
+      PXS(2) = FLOAT(NY2)
+      PYS(1) = FLOAT(1024-NX1)
+      PYS(2) = FLOAT(1024-NX2)
+      CALL GPL (2,PXS,PYS)
+      GO TO 340
+  330 CONTINUE
+      PXS(1) = FLOAT(NX1)
+      PXS(2) = FLOAT(NX2)
+      PYS(1) = FLOAT(NY1)
+      PYS(2) = FLOAT(NY2)
+      CALL GPL (2,PXS,PYS)
+  340 IF (IMARK .EQ. 0) GO TO 370
+      IF (NX1 .EQ. NX2) GO TO 360
+      DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1)
+      FNY1 = NY1
+      DO 350 K=NX1,NX2
+         LTEMP = FNY1+FLOAT(K-NX1)*DY
+	 IF (LTEMP .LT. LIML(K)) LIML(K) = LTEMP
+  350 CONTINUE
+      RETURN
+  360 LTEMP = MIN0(NY1,NY2)
+      IF (LTEMP .LT. LIML(NX1)) LIML(NX1) = LTEMP
+  370 RETURN
+      END
+      SUBROUTINE TRN32S (X,Y,Z,XT,YT,ZT,IFLAG)
+C
+C THIS ROUTINE IMPLEMENTS THE 3-SPACE TO 2-SPACE TRANSFOR-
+C MATION BY KUBER, SZABO AND GIULIERI, THE PERSPECTIVE
+C REPRESENTATION OF FUNCTIONS OF TWO VARIABLES. J. ACM 15,
+C 2, 193-204,1968.
+C IFLAG=0 ARGUMENTS
+C X,Y,Z    ARE THE 3-SPACE COORDINATES OF THE INTERSECTION
+C          OF THE LINE OF SIGHT AND THE IMAGE PLANE.    THIS
+C          POINT CAN BE THOUGHT OF AS THE POINT LOOKED AT.
+C XT,YT,ZT ARE THE 3-SPACE COORDINATES OF THE EYE POSITION.
+C
+C IFLAG=1 ARGUMENTS
+C X,Y,Z    ARE THE 3-SPACE COORDINATES OF A POINT TO BE
+C          TRANSFORMED.
+C XT,YT    THE RESULTS OF THE 3-SPACE TO 2-SPACE TRANSFOR-
+C          MATION.
+C          USE IFIX(XT) AND IFIX(YT) IN GPL CALLS.
+C ZT            NOT USED.
+C IF LL (IN COMMON) =0 XT AND YT ARE IN THE SAME SCALE AS X, Y, AND Z.
+C
+      COMMON /PWRZ1S/ XXMIN      ,XXMAX      ,YYMIN  ,YYMAX,
+     1                ZZMIN      ,ZZMAX      ,DELCRT ,EYEX,
+     2                EYEY       ,EYEZ
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      DIMENSION       NLU(7)     ,NRU(7)     ,NBV(7)     ,NTV(7)
+C
+C SAVE INSERTED BY BEN DOMENICO 9/8/85 BECAUSE OF ASSUMPTION THAT
+C   JUMP, JUMP2, AND JUMP3 ARE PRESERVED BETWEEN CALLS.
+C   THERE MAY BE OTHER SUCH ASSUMPTIONS AS WELL.
+C
+      SAVE
+C
+C PICTURE CORNER COORDINATES FOR LL=1
+C
+      DATA NLU(1),NRU(1),NBV(1),NTV(1)/  10,1014,  10,1014/
+C
+C PICTURE CORNER COORDINATES FOR LL=2
+C
+      DATA NLU(2),NRU(2),NBV(2),NTV(2)/  10, 924,  50, 964/
+C
+C PICTURE CORNER COORDINATES FOR LL=3
+C
+      DATA NLU(3),NRU(3),NBV(3),NTV(3)/ 100,1014,  50, 964/
+C
+C PICTURE CORNER COORDINATES FOR LL=4
+C
+      DATA NLU(4),NRU(4),NBV(4),NTV(4)/  10,1014,  10,1014/
+C
+C PICTURE CORNER COORDINATES FOR LL=5
+C
+      DATA NLU(5),NRU(5),NBV(5),NTV(5)/  10,1014,  10,1014/
+C
+C PICTURE CORNER COORDINATES FOR LL=6
+C
+      DATA NLU(6),NRU(6),NBV(6),NTV(6)/  10, 512, 256, 758/
+C
+C PICTURE CORNER COORDINATES FOR LL=7
+C
+      DATA NLU(7),NRU(7),NBV(7),NTV(7)/ 512,1014, 256, 758/
+C
+C STORE THE PARAMETERS OF THE SET32 CALL FOR USE WHEN
+C TRN32 IS CALLED.
+C
+      IF (IFLAG)  40, 10, 40
+   10 CONTINUE
+      ASSIGN  60 TO JUMP3
+      IF (IOFFP .EQ. 1) ASSIGN  50 TO JUMP3
+      AX = X
+      AY = Y
+      AZ = Z
+      EX = XT
+      EY = YT
+      EZ = ZT
+C
+C AS MUCH COMPUTATION AS POSSIBLE IS DONE DURING EXECUTION
+C THIS ROUTINE WHEN IFLAG=0 BECAUSE CALLS IN THAT MODE ARE INFREQUENT.
+C
+      DX = AX-EX
+      DY = AY-EY
+      DZ = AZ-EZ
+      D = SQRT(DX*DX+DY*DY+DZ*DZ)
+      COSAL = DX/D
+      COSBE = DY/D
+      COSGA = DZ/D
+      SINGA = SQRT(1.-COSGA*COSGA)
+      ASSIGN 120 TO JUMP2
+      IF (LL .EQ. 0) GO TO  20
+      ASSIGN 100 TO JUMP2
+      DELCRT = NRU(LL)-NLU(LL)
+      U0 = UMIN
+      V0 = VMIN
+      U1 = NLU(LL)
+      V1 = NBV(LL)
+      U2 = NRU(LL)-NLU(LL)
+      V2 = NTV(LL)-NBV(LL)
+      U3 = U2/(UMAX-UMIN)
+      V3 = V2/(VMAX-VMIN)
+      U4 = NRU(LL)
+      V4 = NTV(LL)
+      IF (NRSWT .EQ. 0) GO TO  20
+      U0 = -BIGD
+      V0 = -BIGD
+      U3 = U2/(2.*BIGD)
+      V3 = V2/(2.*BIGD)
+C
+C THE 3-SPACE POINT LOOKED AT IS TRANSFORMED INTO (0,0) OF
+C THE 2-SPACE.  THE 3-SPACE Z AXIS IS TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.  IF THE LINE OF SIGHT IS CLOSE TO PARALLEL
+C TO THE 3-SPACE Z AXIS, THE 3-SPACE Y AXIS IS CHOSEN (IN-
+C STEAD OF THE 3-SPACE Z AXIS) TO BE TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.
+C
+   20 IF (SINGA .LT. 0.0001) GO TO  30
+      R = 1./SINGA
+      ASSIGN  70 TO JUMP
+      RETURN
+   30 SINBE = SQRT(1.-COSBE*COSBE)
+      R = 1./SINBE
+      ASSIGN  80 TO JUMP
+      RETURN
+   40 CONTINUE
+      XX = X
+      YY = Y
+      ZZ = Z
+      GO TO JUMP3,( 50, 60)
+   50 IF (ZZ .EQ. SPVAL) GO TO 110
+   60 Q = D/((XX-EX)*COSAL+(YY-EY)*COSBE+(ZZ-EZ)*COSGA)
+      GO TO JUMP,( 70, 80)
+   70 XX = ((EX+Q*(XX-EX)-AX)*COSBE-(EY+Q*(YY-EY)-AY)*COSAL)*R
+      YY = (EZ+Q*(ZZ-EZ)-AZ)*R
+      GO TO  90
+   80 XX = ((EZ+Q*(ZZ-EZ)-AZ)*COSAL-(EX+Q*(XX-EX)-AX)*COSGA)*R
+      YY = (EY+Q*(YY-EY)-AY)*R
+   90 GO TO JUMP2,(100,120)
+c + NOAO: Clipping is done at the gio level and is unnecessary here.  The
+c following statements were preventing labels from being positioned properly
+c at the edges of the surface plot, even when the viewport had been reset.
+  100 xx = u1 + u3 * (fact * xx - u0)
+      yy = v1 + v3 * (fact * yy - v0)
+c 100 XX = AMIN1(U4,AMAX1(U1,U1+U3*(FACT*XX-U0)))
+c     YY = AMIN1(V4,AMAX1(V1,V1+V3*(FACT*YY-V0)))
+c -NOAO
+      GO TO 120
+  110 XX = NSPVAL
+      YY = NSPVAL
+C
+  120 XT = XX
+      YT = YY
+      RETURN
+      END
+      SUBROUTINE CLSET (Z,MX,NX,NY,CHI,CLO,CINC,NLA,NLM,CL,NCL,ICNST,
+     1                  IOFFP,SPVAL,BIGEST)
+      DIMENSION       Z(MX,NY)   ,CL(NLM)
+      DATA KK /0/
+C
+C CLSET PUTS THE VALUS OF THE CONTOUR LEVELS IN CL
+C
+      ICNST = 0
+      GLO = CLO
+      HA = CHI
+      FANC = CINC
+      CRAT = NLA
+      IF (HA-GLO)  10, 20, 50
+   10 GLO = HA
+      HA = CLO
+      GO TO  50
+   20 GLO = BIGEST
+      HA = -GLO
+      DO  40 J=1,NY
+         DO  30 I=1,NX
+            IF (IOFFP.EQ.1 .AND. Z(I,J).EQ.SPVAL) GO TO  30
+            GLO = AMIN1(Z(I,J),GLO)
+            HA = AMAX1(Z(I,J),HA)
+   30    CONTINUE
+   40 CONTINUE
+   50 IF (FANC)  60, 70, 90
+   60 CRAT = -FANC
+   70 FANC = (HA-GLO)/CRAT
+      IF (FANC) 140,140, 80
+   80 P = 10.**(IFIX(ALOG10(FANC)+500.)-500)
+      FANC = AINT(FANC/P)*P
+   90 IF (CHI-CLO) 110,100,110
+  100 GLO = AINT(GLO/FANC)*FANC
+      HA = AINT(HA/FANC)*FANC
+  110 DO 120 K=1,NLM
+         CC = GLO+FLOAT(K-1)*FANC
+         IF (CC .GT. HA) GO TO 130
+         KK = K
+         CL(K) = CC
+  120 CONTINUE
+  130 NCL = KK
+      RETURN
+  140 ICNST = 1
+      RETURN
+      END
+      SUBROUTINE CTCELL (Z,MX,NX,NY,M,I0,J0)
+C
+C CTCELL COMPUTES LINES OF CONSTANT Z (CONTOUR LINES) IN ONE
+C CELL OF THE ARRAY Z FOR THE SRFACE PACKAGE.
+C Z,MX,NX,NY ARE THE SAME AS IN SRFACE.
+C M              BY     THE TIME CTCELL IS FIRST CALLED, M CONTAINS
+C            THE TWO-SPACE PLOTTER LOCATION OF EACH Z POINT.
+C            U(Z(I,J))=M(1,I,J).  V(Z(I,J))=M(2,I,J)
+C I0,J0      THE CELL Z(I0,J0) TO Z(I0+1,J0+1) IS THE ONE TO
+C            BE CONTOURED.
+C
+      DIMENSION       Z(MX,NY)   ,M(2,NX,NY)
+      COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41)     ,NCL,
+     1                LL         ,FACT       ,IROT       ,NDRZ,
+     2                NUPPER     ,NRSWT      ,BIGD       ,UMIN,
+     3                UMAX       ,VMIN       ,VMAX       ,RZERO,
+     4                IOFFP      ,NSPVAL     ,SPVAL      ,BIGEST
+      DATA IDUB/0/
+      R(HO,HU) = (HO-CV)/(HO-HU)
+      I1 = I0
+      I1P1 = I1+1
+      J1 = J0
+      J1P1 = J1+1
+      H1 = Z(I1,J1)
+      H2 = Z(I1,J1P1)
+      H3 = Z(I1P1,J1P1)
+      H4 = Z(I1P1,J1)
+      IF (IOFFP .NE. 1) GO TO  10
+      IF (H1.EQ.SPVAL .OR. H2.EQ.SPVAL .OR. H3.EQ.SPVAL .OR.
+     1    H4.EQ.SPVAL) RETURN
+   10 IF (AMIN1(H1,H2,H3,H4) .GT. CL(NCL)) RETURN
+      DO 110 K=1,NCL
+C
+C FOR EACH CONTOUR LEVEL, DESIDE WHICH OF THE 16 BASIC SIT-
+C UATIONS EXISTS, THEN INTERPOLATE IN TWO-SPACE TO FIND THE
+C END POINTS OF THE CONTOUR LINE SEGMENT WITHIN THIS CELL.
+C
+         CV = CL(K)
+         K1 = (IFIX(SIGN(1.,H1-CV))+1)/2
+         K2 = (IFIX(SIGN(1.,H2-CV))+1)/2
+         K3 = (IFIX(SIGN(1.,H3-CV))+1)/2
+         K4 = (IFIX(SIGN(1.,H4-CV))+1)/2
+         JUMP = 1+K1+K2*2+K3*4+K4*8
+         GO TO (120, 30, 50, 60, 70, 20, 80, 90, 90, 80,
+     1           40, 70, 60, 50, 30,110),JUMP
+   20    IDUB = 1
+   30    RA = R(H1,H2)
+         MUA = FLOAT(M(1,I1,J1))+RA*FLOAT(M(1,I1,J1P1)-M(1,I1,J1))
+         MVA = FLOAT(M(2,I1,J1))+RA*FLOAT(M(2,I1,J1P1)-M(2,I1,J1))
+         RB = R(H1,H4)
+         MUB = FLOAT(M(1,I1,J1))+RB*FLOAT(M(1,I1P1,J1)-M(1,I1,J1))
+         MVB = FLOAT(M(2,I1,J1))+RB*FLOAT(M(2,I1P1,J1)-M(2,I1,J1))
+         GO TO 100
+   40    IDUB = -1
+   50    RA = R(H2,H1)
+         MUA = FLOAT(M(1,I1,J1P1))+RA*FLOAT(M(1,I1,J1)-M(1,I1,J1P1))
+         MVA = FLOAT(M(2,I1,J1P1))+RA*FLOAT(M(2,I1,J1)-M(2,I1,J1P1))
+         RB = R(H2,H3)
+         MUB = FLOAT(M(1,I1,J1P1))+RB*FLOAT(M(1,I1P1,J1P1)-M(1,I1,J1P1))
+         MVB = FLOAT(M(2,I1,J1P1))+RB*FLOAT(M(2,I1P1,J1P1)-M(2,I1,J1P1))
+         GO TO 100
+   60    RA = R(H2,H3)
+         MUA = FLOAT(M(1,I1,J1P1))+RA*FLOAT(M(1,I1P1,J1P1)-M(1,I1,J1P1))
+         MVA = FLOAT(M(2,I1,J1P1))+RA*FLOAT(M(2,I1P1,J1P1)-M(2,I1,J1P1))
+         RB = R(H1,H4)
+         MUB = FLOAT(M(1,I1,J1))+RB*FLOAT(M(1,I1P1,J1)-M(1,I1,J1))
+         MVB = FLOAT(M(2,I1,J1))+RB*FLOAT(M(2,I1P1,J1)-M(2,I1,J1))
+         GO TO 100
+   70    RA = R(H3,H2)
+         MUA = FLOAT(M(1,I1P1,J1P1))+
+     1         RA*FLOAT(M(1,I1,J1P1)-M(1,I1P1,J1P1))
+         MVA = FLOAT(M(2,I1P1,J1P1))+
+     1         RA*FLOAT(M(2,I1,J1P1)-M(2,I1P1,J1P1))
+         RB = R(H3,H4)
+         MUB = FLOAT(M(1,I1P1,J1P1))+
+     1         RB*FLOAT(M(1,I1P1,J1)-M(1,I1P1,J1P1))
+         MVB = FLOAT(M(2,I1P1,J1P1))+
+     1         RB*FLOAT(M(2,I1P1,J1)-M(2,I1P1,J1P1))
+         IDUB = 0
+         GO TO 100
+   80    RA = R(H2,H1)
+         MUA = FLOAT(M(1,I1,J1P1))+RA*FLOAT(M(1,I1,J1)-M(1,I1,J1P1))
+         MVA = FLOAT(M(2,I1,J1P1))+RA*FLOAT(M(2,I1,J1)-M(2,I1,J1P1))
+         RB = R(H3,H4)
+         MUB = FLOAT(M(1,I1P1,J1P1))+
+     1         RB*FLOAT(M(1,I1P1,J1)-M(1,I1P1,J1P1))
+         MVB = FLOAT(M(2,I1P1,J1P1))+
+     1         RB*FLOAT(M(2,I1P1,J1)-M(2,I1P1,J1P1))
+         GO TO 100
+   90    RA = R(H4,H1)
+         MUA = FLOAT(M(1,I1P1,J1))+RA*FLOAT(M(1,I1,J1)-M(1,I1P1,J1))
+         MVA = FLOAT(M(2,I1P1,J1))+RA*FLOAT(M(2,I1,J1)-M(2,I1P1,J1))
+         RB = R(H4,H3)
+         MUB = FLOAT(M(1,I1P1,J1))+RB*FLOAT(M(1,I1P1,J1P1)-M(1,I1P1,J1))
+         MVB = FLOAT(M(2,I1P1,J1))+RB*FLOAT(M(2,I1P1,J1P1)-M(2,I1P1,J1))
+         IDUB = 0
+  100    CALL DRAWS (MUA,MVA,MUB,MVB,1,0)
+         IF (IDUB)  90,110, 70
+  110 CONTINUE
+  120 RETURN
+      END
diff --git a/sys/gio/ncarutil/strmln.f b/sys/gio/ncarutil/strmln.f
new file mode 100644
index 00000000..411caed8
--- /dev/null
+++ b/sys/gio/ncarutil/strmln.f
@@ -0,0 +1,957 @@
+      SUBROUTINE STRMLN (U,V,WORK,IMAX,IPTSX,JPTSY,NSET,IER)
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SUBROUTINE STRMLN (U,V,WORK,IMAX,IPTSX,JPTSY,NSET,IER)
+C
+C DIMENSION OF           U(IMAX,JPTSY) , V(IMAX,JPTSY) ,
+C ARGUMENTS              WORK(2*IMAX*JPTSY)
+C
+C LATEST REVISION        JUNE 1984
+C
+C PURPOSE                STRMLN DRAWS A STREAMLINE REPRESENTATION OF
+C                        THE FLOW FIELD. THE REPRESENTATION IS
+C                        INDEPENDENT OF THE FLOW SPEED.
+C
+C USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                            CALL EZSTRM  (U,V,WORK,IMAX,JMAX)
+C
+C                          ASSUMPTIONS:
+C                            --THE WHOLE ARRAY IS TO BE PROCESSED.
+C                            --THE ARRAYS ARE DIMENSIONED
+C                              U(IMAX,JMAX) , V(IMAX,JMAX) AND
+C                              WORK(2*IMAX*JMAX).
+C                            --WINDOW AND VIEWPORT ARE TO BE CHOSEN
+C                              BY STRMLN.
+C                            --PERIM IS TO BE CALLED.
+C
+C                        IF THESE ASSUMPTIONS ARE NOT MET, USE
+C
+C                            CALL STRMLN (U,V,WORK,IMAX,IPTSX,JPTSY,
+C                                         NSET,IER)
+C
+C                        THE USER MUST CALL FRAME IN THE CALLING
+C                        ROUTINE.
+C
+C                        THE USER MAY CHANGE VARIOUS INTERNAL
+C                        PARAMETERS VIA COMMON BLOCKS. SEE BELOW.
+C
+C ARGUMENTS
+C
+C ON INPUT               U, V
+C                          TWO DIMENSIONAL ARRAYS CONTAINING THE
+C                          VELOCITY FIELDS TO BE PLOTTED.
+C                          (NOTE:  IF THE U AND V COMPONENTS
+C                          ARE, FOR EXAMPLE, DEFINED IN CARTESIAN
+C                          COORDINATES AND THE USER WISHES TO PLOT THEM
+C                          ON A DIFFERENT PROJECTION (I.E., STEREO-
+C                          GRAPHIC), THEN THE APPROPRIATE
+C                          TRANSFORMATION MUST BE MADE TO THE U AND V
+C                          COMPONENTS VIA THE FUNCTIONS FU AND FV
+C                          (LOCATED IN DRWSTR).
+C
+C                        WORK
+C                          USER PROVIDED WORK ARRAY.  THE DIMENSION
+C                          OF THIS ARRAY MUST BE .GE. 2*IMAX*JPTSY.
+C                          CAUTION:  THIS ROUTINE DOES NOT CHECK THE
+C                          SIZE OF THE WORK ARRAY.
+C
+C                        IMAX
+C                          THE FIRST DIMENSION OF U AND V IN THE
+C                          CALLING PROGRAM. (X-DIRECTION)
+C
+C                        IPTSX
+C                          THE NUMBER OF POINTS TO BE PLOTTED IN THE
+C                          FIRST SUBSCRIPT DIRECTION.  (X-DIRECTION)
+C
+C                        JPTSY
+C                          THE NUMBER OF POINTS TO BE PLOTTED IN THE
+C                          SECOND SUBSCRIPT DIRECTION. (Y-DIRECTION)
+C
+C                        NSET
+C                          FLAG TO CONTROL SCALING
+C                          > 0  STRMLN ASSUMES THAT THE WINDOW
+C                               AND VIEWPORT HAVE BEEN SET BY THE
+C                               USER IN SUCH A WAY AS TO PROPERLY
+C                               SCALE THE PLOTTING INSTRUCTIONS
+C                               GENERATED BY STRMLN. PERIM IS NOT
+C                               CALLED.
+C                          = 0  STRMLN WILL ESTABLISH THE WINDOW AND
+C                               VIEWPORT TO PROPERLY SCALE THE
+C                               PLOTTING INSTRUCTIONS TO THE STANDARD
+C                               CONFIGURATION. PERIM IS CALLED TO DRAW
+C                               THE BORDER.
+C                          < 0  STRMLN ESTABLISHES THE WINDOW
+C                               AND VIEWPORT SO AS TO PLACE THE
+C                               STREAMLINES WITHIN THE LIMITS
+C                               OF THE USER'S WINDOW.  PERIM IS
+C                               NOT CALLED.
+C
+C ON OUTPUT              ONLY THE IER ARGUMENT MAY BE CHANGED. ALL
+C                        OTHER ARGUMENTS ARE UNCHANGED.
+C
+C
+C                        IER
+C                          =  0 WHEN NO ERRORS ARE DETECTED
+C                          = -1 WHEN THE ROUTINE IS CALLED WITH ICYC
+C                               .NE. 0  AND THE DATA ARE NOT CYCLIC
+C                               (ICYC IS AN INTERNAL PARAMETER
+C                               DESCRIBED BELOW); IN THIS CASE THE
+C                               ROUTINE WILL DRAW THE
+C                               STREAMLINES WITH THE NON-CYCLIC
+C                               INTERPOLATION FORMULAS.
+C
+C ENTRY POINTS           STRMLN, DRWSTR, EZSTRM, GNEWPT, CHKCYC
+C
+C COMMON BLOCKS          STR01, STR02, STR03, STR04
+C
+C REQUIRED LIBRARY       GRIDAL, GBYTES, AND THE SPPS
+C ROUTINES
+C
+C HISTORY                WRITTEN AND STANDARDIZED IN NOVEMBER 1973.
+C I/O                    DRAWS STREAMLINES
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN
+C
+C HISTORY                WRITTEN IN 1979.
+C                        CONVERTED TO FORTRAN 77 AND GKS IN JUNE 1984.
+C
+C PORTABILITY            FORTRAN 77
+C
+C ALGORITHM              WIND COMPONENTS ARE NORMALIZED TO THE VALUE
+C                        OF DISPL. THE LEAST SIGNIFICANT TWO
+C                        BITS OF THE WORK ARRAY ARE
+C                        UTILIZED AS FLAGS FOR EACH GRID BOX. FLAG 1
+C                        INDICATES WHETHER ANY STREAMLINE HAS
+C                        PREVIOUSLY PASSED THROUGH THIS BOX.  FLAG 2
+C                        INDICATES WHETHER A DIRECTIONAL ARROW HAS
+C                        ALREADY APPEARED IN A BOX. JUDICIOUS USE
+C                        OF THESE FLAGS PREVENTS OVERCROWDING OF
+C                        STREAMLINES AND DIRECTIONAL ARROWS.
+C                        EXPERIENCE INDICATES THAT A FINAL PLEASING
+C                        PICTURE IS PRODUCED WHEN STREAMLINES ARE
+C                        INITIATED IN THE CENTER OF A GRID BOX. THE
+C                        STREAMLINES ARE DRAWN IN ONE DIRECTION THEN
+C                        IN THE OPPOSITE DIRECTION.
+C
+C REFERENCE              THE TECHNIQUES UTILIZED HERE ARE DESCRIBED
+C                        IN AN ARTICLE BY THOMAS WHITTAKER (U. OF
+C                        WISCONSIN) WHICH APPEARED IN THE NOTES AND
+C                        CORRESPONDENCE SECTION OF MONTHLY WEATHER
+C                        REVIEW, JUNE 1977.
+C
+C TIMING                 HIGHLY VARIABLE
+C                          IT DEPENDS ON THE COMPLEXITY OF THE
+C                          FLOW FIELD AND THE PARAMETERS:  DISPL,
+C                          DISPC , CSTOP , INITA , INITB , ITERC ,
+C                          AND IGFLG. (SEE BELOW FOR A DISCUSSION
+C                          OF THESE PARAMETERS.) IF ALL VALUES
+C                          ARE DEFAULT, THEN A SIMPLE LINEAR
+C                          FLOW FIELD FOR A 40 X 40 GRID WILL
+C                          TAKE ABOUT 0.4 SECONDS ON THE CRAY1-A;
+C                          A FAIRLY COMPLEX FLOW FIELD WILL TAKE ABOUT
+C                          1.5 SECONDS ON THE CRAY1-A.
+C
+C
+C INTERNAL PARAMETERS
+C
+C                        NAME     DEFAULT            FUNCTION
+C                        ----     -------            --------
+C
+C                        EXT       0.25      LENGTHS OF THE SIDES OF THE
+C                                            PLOT ARE PROPORTIONAL TO
+C                                            IPTSX AND JPTSY EXCEPT IN
+C                                            THE CASE WHEN MIN(IPTSX,JPT
+C                                            / MAX(IPTSX,JPTSY) .LT. EXT;
+C                                            IN THAT CASE A SQUARE
+C                                            GRAPH IS PLOTTED.
+C
+C                        SIDE      0.90      LENGTH OF LONGER EDGE OF
+C                                            PLOT. (SEE ALSO EXT.)
+C
+C                        XLT       0.05      LEFT HAND EDGE OF THE PLOT.
+C                                            (0.0 = LEFT EDGE OF FRAME)
+C                                            (1.0 = RIGHT EDGE OF FRAME)
+C
+C                        YBT       0.05      BOTTOM EDGE OF THE PLOT.
+C                                            (0.0 = BOTTOM ; 1.0 = TOP)
+C
+C                                            (YBT+SIDE AND XLT+SIDE MUST
+C                                            BE .LE. 1. )
+C
+C                        INITA     2         USED TO PRECONDITION GRID
+C                                            BOXES TO BE ELIGIBLE TO
+C                                            START A STREAMLINE.
+C                                            FOR EXAMPLE, A VALUE OF 4
+C                                            MEANS THAT EVERY FOURTH
+C                                            GRID BOX IS ELIGIBLE ; A
+C                                            VALUE OF 2 MEANS THAT EVERY
+C                                            OTHER GRID BOX IS ELIGIBLE.
+C                                            (SEE INITB)
+C
+C                        INITB     2         USED TO PRECONDITION GRID
+C                                            BOXES TO BE ELIGIBLE FOR
+C                                            DIRECTION ARROWS.
+C                                            IF THE USER CHANGES THE
+C                                            DEFAULT VALUES OF INITA
+C                                            AND/OR INITB, IT SHOULD
+C                                            BE DONE SUCH THAT
+C                                            MOD(INITA,INITB) = 0 .
+C                                            FOR A DENSE GRID TRY
+C                                            INITA=4 AND INITB=2 TO
+C                                            REDUCE THE CPU TIME.
+C
+C                        AROWL     0.33      LENGTH OF DIRECTION ARROW.
+C                                            FOR EXAMPLE, 0.33 MEANS
+C                                            EACH DIRECTIONAL ARROW WILL
+C                                            TAKE UP A THIRD OF A GRID
+C                                            BOX.
+C
+C                        ITERP     35        EVERY 'ITERP' ITERATIONS
+C                                            THE STREAMLINE PROGRESS
+C                                            IS CHECKED.
+C
+C                        ITERC     -99       THE DEFAULT VALUE OF THIS
+C                                            PARAMETER IS SUCH THAT
+C                                            IT HAS NO EFFECT ON THE
+C                                            CODE. WHEN SET TO SOME
+C                                            POSITIVE VALUE, THE PROGRAM
+C                                            WILL CHECK FOR STREAMLINE
+C                                            CROSSOVER EVERY 'ITERC'
+C                                            ITERATIONS. (THE ROUTINE
+C                                            CURRENTLY DOES THIS EVERY
+C                                            TIME IT ENTERS A NEW GRID
+C                                            BOX.) CAUTION:  WHEN
+C                                            THIS PARAMETER IS ACTIVATED
+C                                            CPU TIME WILL INCREASE.
+C
+C                        IGFLG     0         A VALUE OF ZERO MEANS THAT
+C                                            THE SIXTEEN POINT BESSEL
+C                                            INTERPOLATION FORMULA WILL
+C                                            BE UTILIZED WHERE POSSIBLE;
+C                                            WHEN NEAR THE GRID EDGES,
+C                                            QUADRATIC AND BI-LINEAR
+C                                            INTERPOLATION  WILL BE
+C                                            USED. THIS MIXING OF
+C                                            INTERPOLATION SCHEMES CAN
+C                                            SOMETIMES CAUSE SLIGHT
+C                                            RAGGEDNESS NEAR THE EDGES
+C                                            OF THE PLOT.  IF IGFLG.NE.0,
+C                                            THEN ONLY THE BILINEAR
+C                                            INTERPOLATION FORMULA
+C                                            IS USED; THIS WILL GENERALLY
+C                                            RESULT IN SLIGHTLY FASTER
+C                                            PLOT TIMES BUT A LESS
+C                                            PLEASING PLOT.
+C
+C                        IMSG      0         IF ZERO, THEN NO MISSING
+C                                            U AND V COMPONENTS ARE
+C                                            PRESENT.
+C                                            IF .NE. 0, STRMLN WILL
+C                                            UTILIZE THE
+C                                            BI-LINEAR INTERPOLATION
+C                                            SCHEME AND TERMINATE IF
+C                                            ANY DATA POINTS ARE MISSING.
+C
+C                        UVMSG     1.E+36    VALUE ASSIGNED TO A MISSING
+C                                            POINT.
+C
+C                        ICYC      0         ZERO MEANS THE DATA ARE
+C                                            NON-CYCLIC IN THE X
+C                                            DIRECTION.
+C                                            IF .NE 0, THE
+C                                            CYCLIC INTERPOLATION
+C                                            FORMULAS WILL BE USED.
+C                                            (NOTE:  EVEN IF THE DATA
+C                                            ARE CYCLIC IN X LEAVING
+C                                            ICYC = 0 WILL DO NO HARM.)
+C
+C                        DISPL     0.33      THE WIND SPEED IS
+C                                            NORMALIZED TO THIS VALUE.
+C                                            (SEE THE DISCUSSION BELOW.)
+C
+C                        DISPC     0.67      THE CRITICAL DISPLACEMENT.
+C                                            IF AFTER 'ITERP' ITERATIONS
+C                                            THE STREAMLINE HAS NOT
+C                                            MOVED THIS DISTANCE, THE
+C                                            STREAMLINE WILL BE
+C                                            TERMINATED.
+C
+C                        CSTOP     0.50      THIS PARAMETER CONTROLS
+C                                            THE SPACING BETWEEN
+C                                            STREAMLINES.  THE CHECKING
+C                                            IS DONE WHEN A NEW GRID
+C                                            BOX IS ENTERED.
+C
+C DISCUSSION OF          ASSUME A VALUE OF 0.33 FOR DISPL.  THIS
+C DISPL,DISPC            MEANS THAT IT WILL TAKE THREE STEPS TO MOVE
+C AND CSTOP              ACROSS ONE GRID BOX IF THE FLOW WAS ALL IN THE
+C                        X DIRECTION. IF THE FLOW IS ZONAL, THEN A
+C                        LARGER VALUE OF DISPL IS IN ORDER.
+C                        IF THE FLOW IS HIGHLY TURBULENT, THEN
+C                        A SMALLER VALUE IS IN ORDER. NOTE: THE SMALLER
+C                        DISPL, THE MORE THE CPU TIME.  A VALUE
+C                        OF 2 TO 4 TIMES DISPL IS A REASONABLE VALUE
+C                        FOR DISPC.  DISPC SHOULD ALWAYS BE GREATER
+C                        THAN DISPL. A VALUE OF 0.33 FOR CSTOP WOULD
+C                        MEAN THAT A MAXIMUM OF THREE STREAM-
+C                        LINES WILL BE DRAWN PER GRID BOX. THIS MAX
+C                        WILL NORMALLY ONLY OCCUR IN AREAS OF SINGULAR
+C                        POINTS.
+C
+C                                            ***************************
+C                                            ANY OR ALL OF THE ABOVE
+C                                            PARAMETERS MAY BE CHANGED
+C                                            BY UTILIZING COMMON BLOCKS
+C                                            STR02 AND/OR STR03
+C                                            ***************************
+C
+C                        UXSML     1.E-50    THE SMALLEST REAL NUMBER
+C                                            ON THE HOST COMPUTER.  THIS
+C                                            IS SET AUTOMATICALLY BY
+C                                            R1MACH.
+C
+C                        NCHK      750       THIS PARAMETER IS LOCATED
+C                                            IN DRWSTR. IT SPECIFIES THE
+C                                            LENGTH OF THE CIRCULAR
+C                                            LISTS  USED FOR CHECKING
+C                                            FOR STRMLN CROSSOVERS.
+C                                            FOR MOST PLOTS THIS NUMBER
+C                                            MAY BE REDUCED TO 500
+C                                            OR LESS AND THE PLOTS WILL
+C                                            NOT BE ALTERED.
+C
+C                        ISKIP               NUMBER OF BITS TO BE
+C                                            SKIPPED TO GET TO THE
+C                                            LEAST TWO SIGNIFICANT BITS
+C                                            IN A FLOATING POINT NUMBER.
+C                                            THE DEFAULT VALUE IS SET TO
+C                                            I1MACH(5) - 2 . THIS VALUE
+C                                            MAY HAVE TO BE CHANGED
+C                                            DEPENDING ON THE TARGET
+C                                            COMPUTER, SEE SUBROUTINE
+C                                            DRWSTR.
+C
+C
+C
+      DIMENSION       U(IMAX,JPTSY)         ,V(IMAX,JPTSY)           ,
+     1                WORK(1)
+      DIMENSION       WNDW(4)               ,VWPRT(4)
+C
+      COMMON /STR01/  IS         ,IEND      ,JS        ,JEND
+     1             ,  IEND1      ,JEND1     ,I         ,J
+     2             ,  X          ,Y         ,DELX      ,DELY
+     3             ,  ICYC1      ,IMSG1     ,IGFL1
+      COMMON /STR02/  EXT , SIDE , XLT , YBT
+      COMMON /STR03/  INITA , INITB , AROWL , ITERP , ITERC , IGFLG
+     1             ,  IMSG , UVMSG , ICYC , DISPL , DISPC , CSTOP
+C
+      SAVE
+C
+      EXT       = 0.25
+      SIDE      = 0.90
+      XLT       = 0.05
+      YBT       = 0.05
+C
+      INITA     = 2
+      INITB     = 2
+      AROWL     = 0.33
+      ITERP     = 35
+      ITERC     = -99
+      IGFLG     = 0
+      ICYC      = 0
+      IMSG      = 0
+C +NOAO
+C     UVMSG     = 1.E+36
+      uvmsg     = 1.E+16
+C -NOAO
+      DISPL     = 0.33
+      DISPC     = 0.67
+      CSTOP     = 0.50
+C
+C THE FOLLOWING CALL IS FOR MONITORING LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ( 'GRAPHX', 'STRMLN', 'STRMLN', 'VERSION 01')
+C
+      IER = 0
+C
+C LOAD THE COMMUNICATION COMMON BLOCK WITH PARAMETERS
+C
+      IS = 1
+      IEND = IPTSX
+      JS = 1
+      JEND = JPTSY
+      IEND1 = IEND-1
+      JEND1 = JEND-1
+      IEND2 = IEND-2
+      JEND2 = JEND-2
+      XNX = FLOAT(IEND-IS+1)
+      XNY = FLOAT(JEND-JS+1)
+      ICYC1 = ICYC
+      IGFL1 = IGFLG
+      IMSG1 = 0
+C
+C IF ICYC .NE. 0 THEN CHECK TO MAKE SURE THE CYCLIC CONDITION EXISTS.
+C
+      IF (ICYC1.NE.0) CALL CHKCYC  (U,V,IMAX,JPTSY,IER)
+C
+C SAVE ORIGINAL  NORMALIZATION TRANSFORMATION NUMBER
+C
+      CALL GQCNTN ( IERR,NTORIG )
+C
+C SET UP SCALING
+C
+      IF (NSET) 10 , 20 , 60
+   10 CALL GETUSV ( 'LS' , ITYPE )
+      CALL GQNT ( NTORIG,IERR,WNDW,VWPRT )
+      CALL GETUSV('LS',IOLLS)
+      X1 = VWPRT(1)
+      X2 = VWPRT(2)
+      Y1 = VWPRT(3)
+      Y2 = VWPRT(4)
+      X3 = IS
+      X4 = IEND
+      Y3 = JS
+      Y4 = JEND
+      GO TO  55
+C
+   20 ITYPE = 1
+      X1 = XLT
+      X2 = (XLT+SIDE)
+      Y1 = YBT
+      Y2 = (YBT+SIDE)
+      X3 = IS
+      X4 = IEND
+      Y3 = JS
+      Y4 = JEND
+      IF (AMIN1(XNX,XNY)/AMAX1(XNX,XNY).LT.EXT) GO TO  50
+      IF (XNX-XNY)  30, 50, 40
+   30 X2 = (SIDE*(XNX/XNY) + XLT)
+      GO TO  50
+   40 Y2 = (SIDE*(XNY/XNX) + YBT)
+   50 CONTINUE
+C
+C CENTER THE PLOT
+C
+      DX = 0.25*( 1. - (X2-X1) )
+      DY = 0.25*( 1. - (Y2-Y1) )
+      X1 = (XLT+DX)
+      X2 = (X2+DX )
+      Y1 = (YBT+DY)
+      Y2 = (Y2+DY )
+C
+   55 CONTINUE
+C
+C SAVE NORMALIZATION TRANSFORMATION 1
+C
+      CALL GQNT ( 1,IERR,WNDW,VWPRT )
+C
+C DEFINE AND SELECT NORMALIZATION TRANS, SET LOG SCALING
+C
+      CALL SET(X1,X2,Y1,Y2,X3,X4,Y3,Y4,ITYPE)
+C
+      IF (NSET.EQ.0) CALL PERIM (1,0,1,0)
+C
+   60 CONTINUE
+C
+C DRAW THE STREAMLINES
+C .   BREAK THE WORK ARRAY INTO TWO PARTS.  SEE DRWSTR FOR FURTHER
+C .   COMMENTS ON THIS.
+C
+      CALL DRWSTR (U,V,WORK(1),WORK(IMAX*JPTSY+1),IMAX,JPTSY)
+C
+C RESET NORMALIATION TRANSFORMATION 1 TO ORIGINAL VALUES
+C
+      IF (NSET .LE. 0) THEN
+        CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -           WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      ENDIF
+      CALL GSELNT (NTORIG)
+C
+      RETURN
+      END
+      SUBROUTINE DRWSTR  (U,V,UX,VY,IMAX,JPTSY)
+C
+      PARAMETER (NCHK=750)
+C
+C THIS ROUTINE DRAWS THE STREAMLINES.
+C .   THE XCHK AND YCHK ARRAYS SERVE AS A CIRCULAR LIST. THEY
+C .   ARE USED TO PREVENT LINES FROM CROSSING ONE ANOTHER.
+C
+C THE WORK ARRAY HAS BEEN BROKEN UP INTO TWO ARRAYS FOR CLARITY.  THE
+C .   TOP HALF OF WORK (CALLED UX) WILL HAVE THE NORMALIZED (AND
+C .   POSSIBLY TRANSFORMED) U COMPONENTS AND WILL BE USED FOR BOOK
+C .   KEEPING.  THE LOWER HALF OF THE WORK ARRAY (CALLED VY) WILL
+C .   CONTAIN THE NORMALIZED (AND POSSIBLY TRANSFORMED) V COMPONENTS.
+C
+      DIMENSION       U(IMAX,JPTSY)         ,V(IMAX,JPTSY)
+     1             ,  UX(IMAX,JPTSY)        ,VY(IMAX,JPTSY)
+      COMMON /STR01/  IS         ,IEND      ,JS        ,JEND
+     1             ,  IEND1      ,JEND1     ,I         ,J
+     2             ,  X          ,Y         ,DELX      ,DELY
+     3             ,  ICYC1      ,IMSG1     ,IGFL1
+      COMMON /STR03/  INITA , INITB , AROWL , ITERP , ITERC , IGFLG
+     1             ,  IMSG , UVMSG , ICYC , DISPL , DISPC , CSTOP
+      COMMON /STR04/  XCHK(NCHK) ,YCHK(NCHK) , NUMCHK , UXSML
+C
+C
+        SAVE
+C
+C STATEMENT FUNCTIONS FOR SPATIAL AND VELOCITY TRANSFORMATIONS.
+C .   (IF THE USER WISHES OTHER TRANSFORMATIONS  REPLACE THESE STATEMENT
+C .   FUNCTIONS WITH THE APPROPRIATE NEW ONES, OR , IF THE TRANSFORMA-
+C .   TIONS ARE COMPLICATED DELETE THESE STATEMENT FUNCTIONS
+C .   AND ADD EXTERNAL ROUTINES WITH THE SAME NAMES TO DO THE TRANS-
+C .   FORMING.)
+C
+      FX(X,Y) = X
+      FY(X,Y) = Y
+      FU(X,Y) = X
+      FV(X,Y) = Y
+C
+C INITIALIZE
+C
+      ISKIP    = I1MACH(5) - 2
+      ISKIP1   = ISKIP + 1
+      UXSML    = R1MACH(1)
+C
+C
+      NUMCHK   = NCHK
+      LCHK = 1
+      ICHK = 1
+      XCHK(1) = 0.
+      YCHK(1) = 0.
+      KFLAG = 0
+      IZERO = 0
+      IONE = 1
+      ITWO = 2
+C
+C
+C COMPUTE THE X AND Y NORMALIZED (AND POSSIBLY TRANSFORMED)
+C .   DISPLACEMENT COMPONENTS (UX AND VY).
+C
+      DO  40 J=JS,JEND
+      DO  30 I=IS,IEND
+      IF (U(I,J).EQ.0. .AND. V(I,J).EQ.0.) GO TO  10
+      UX(I,J) = FU(U(I,J),V(I,J))
+      VY(I,J) = FV(U(I,J),V(I,J))
+      CON = DISPL/SQRT(UX(I,J)*UX(I,J) + VY(I,J)*VY(I,J))
+      UX(I,J) = CON*UX(I,J)
+      VY(I,J) = CON*VY(I,J)
+C
+      IF(UX(I,J) .EQ. 0.) UX(I,J) = CON*FU(UXSML,V(I,J))
+C
+      GO TO  20
+   10 CONTINUE
+C
+C BOOKKEEPING IS DONE IN THE LEAST SIGNIFICANT BITS OF THE UX ARRAY.
+C .   WHEN UX(I,J) IS EXACTLY ZERO THIS CAN PRESENT SOME PROBLEMS.
+C .   TO GET AROUND THIS PROBLEM SET IT TO SOME VERY SMALL NUMBER.
+C
+      UX(I,J) = FU(UXSML,0.)
+      VY(I,J) = 0.
+C
+C MASK OUT THE LEAST SIGNIFICANT TWO BITS AS FLAGS FOR EACH GRID BOX
+C .   A GRID BOX IS ANY REGION SURROUNDED BY FOUR GRID POINTS.
+C .   FLAG 1 INDICATES WHETHER ANY STREAMLINE HAS PREVIOUSLY PASSED
+C .          THROUGH THIS BOX.
+C .   FLAG 2 INDICATES WHETHER ANY DIRECTIONAL ARROW HAS ALREADY
+C .          APPEARED IN THIS BOX.
+C .   JUDICIOUS USE OF THESE FLAGS PREVENTS OVERCROWDING OF
+C .   STREAMLINES AND DIRECTIONAL ARROWS.
+C
+   20 CALL SBYTES( UX(I,J) , IZERO , ISKIP , 2 , 0 , 1 )
+C
+      IF (MOD(I,INITA).NE.0 .OR. MOD(J,INITA).NE.0)
+     1    CALL SBYTES( UX(I,J) , IONE , ISKIP1, 1 , 0 , 1 )
+      IF (MOD(I,INITB).NE.0 .OR. MOD(J,INITB).NE.0)
+     1    CALL SBYTES( UX(I,J) , IONE , ISKIP , 1 , 0 , 1 )
+C
+   30 CONTINUE
+   40 CONTINUE
+C
+   50 CONTINUE
+C
+C START A STREAMLINE. EXPERIENCE HAS SHOWN THAT A PLEASING PICTURE
+C .   WILL BE PRODUCED IF NEW STREAMLINES ARE STARTED ONLY IN GRID
+C .   BOXES THAT PREVIOUSLY HAVE NOT HAD OTHER STREAMLINES PASS THROUGH
+C .   THEM. AS LONG AS A REASONABLY DENSE PATTERN OF AVAILABLE BOXES
+C .   IS INITIALLY PRESCRIBED, THE ORDER OF SCANNING THE GRID PTS. FOR
+C .   AVAILABLE BOXES IS IMMATERIAL
+C
+C FIND AN AVAILABLE BOX FOR STARTING A STREAMLINE
+C
+      IF (KFLAG.NE.0) GO TO  90
+      DO  70 J=JS,JEND1
+      DO  60 I=IS,IEND1
+      CALL GBYTES( UX(I,J) , IUX , ISKIP , 2 , 0 , 1 )
+      IF ( IAND( IUX , IONE ) .EQ. IZERO ) GO TO 80
+   60 CONTINUE
+   70 CONTINUE
+C
+C MUST BE NO AVAILABLE BOXES FOR STARTING A STREAMLINE
+C
+      GO TO 190
+   80 CONTINUE
+C
+C INITILIZE PARAMETERS FOR STARTING A STREAMLINE
+C .   TURN THE BOX OFF FOR STARTING A STREAMLINE
+C .   CHECK TO SEE IF THIS BOX HAS MISSING DATA (IMSG.NE.0). IF SO ,
+C .      FIND A NEW STARTING BOX
+C
+      CALL SBYTES( UX(I,J) , IONE , ISKIP1 , 1 , 0 , 1 )
+      IF ( IMSG.EQ.0) GO TO 85
+      IF (U(I,J).EQ.UVMSG .OR. U(I,J+1).EQ.UVMSG .OR.
+     1    U(I+1,J).EQ.UVMSG .OR. U(I+1,J+1).EQ.UVMSG) GO TO 50
+C
+   85 ISAV = I
+      JSAV = J
+      KFLAG = 1
+      PLMN1 = +1.
+      GO TO 100
+   90 CONTINUE
+C
+C COME TO HERE TO DRAW IN THE OPPOSITE DIRECTION
+C
+      KFLAG = 0
+      PLMN1 = -1.
+      I = ISAV
+      J = JSAV
+  100 CONTINUE
+C
+C INITIATE THE DRAWING SEQUENCE
+C .   START ALL STREAMLINES IN THE CENTER OF A BOX
+C
+      NBOX = 0
+      ITER = 0
+      IF (KFLAG.NE.0) ICHKB = ICHK+1
+      IF (ICHKB.GT.NUMCHK) ICHKB = 1
+      X = FLOAT(I)+0.5
+      Y = FLOAT(J)+0.5
+      XBASE = X
+      YBASE = Y
+      CALL FL2INT (FX(X,Y),FY(X,Y),IFX,IFY)
+      CALL PLOTIT (IFX,IFY,0)
+      CALL GBYTES( UX(I,J) , IUX , ISKIP , 2 , 0 , 1 )
+      IF ( (KFLAG.EQ.0) .OR. (IAND( IUX , ITWO ) .NE. 0 ) ) GO TO 110
+C
+C GRID BOX MUST BE ELIGIBLE FOR A DIRECTIONAL ARROW
+C
+      CALL GNEWPT (UX,VY,IMAX,JPTSY)
+      MFLAG = 1
+      GO TO 160
+C
+  110 CONTINUE
+C
+C PLOT LOOP
+C .   CHECK TO SEE IF THE STREAMLINE HAS ENTERED A NEW GRID BOX
+C
+      IF (I.NE.IFIX(X) .OR. J.NE.IFIX(Y)) GO TO 120
+C
+C MUST BE IN SAME BOX CALCULATE THE DISPLACEMENT COMPONENTS
+C
+      CALL GNEWPT (UX,VY,IMAX,JPTSY)
+C
+C UPDATE THE POSITION AND DRAW THE VECTOR
+C
+      X = X+PLMN1*DELX
+      Y = Y+PLMN1*DELY
+      CALL FL2INT (FX(X,Y),FY(X,Y),IFX,IFY)
+      CALL PLOTIT (IFX,IFY,1)
+      ITER = ITER+1
+C
+C CHECK STREAMLINE PROGRESS EVERY 'ITERP' OR SO ITERATIONS
+C
+      IF (MOD(ITER,ITERP).NE.0) GO TO 115
+      IF (ABS(X-XBASE).LT.DISPC  .AND. ABS(Y-YBASE).LT.DISPC ) GO TO  50
+      XBASE = X
+      YBASE = Y
+      GO TO 110
+  115 CONTINUE
+C
+C SHOULD THE CIRCULAR LISTS BE CHECKED FOR STREAMLINE CROSSOVER
+C
+      IF ( (ITERC.LT.0) .OR. (MOD(ITER,ITERC).NE.0) ) GO TO 110
+C
+C MUST WANT THE CIRCULAR LIST CHECKED
+C
+      GO TO 130
+  120 CONTINUE
+C
+C MUST HAVE ENTERED A NEW GRID BOX  CHECK FOR THE FOLLOWING :
+C .   (1) ARE THE NEW POINTS ON THE GRID
+C .   (2) CHECK FOR MISSING DATA IF MSG  DATA FLAG (IMSG) HAS BEEN SET.
+C .   (3) IS THIS BOX ELIGIBLE FOR A DIRECTIONAL ARROW
+C .   (4) LOCATION OF THIS ENTRY VERSUS OTHER STREAMLINE ENTRIES
+C
+      NBOX = NBOX+1
+C
+C CHECK (1)
+C
+      IF (IFIX(X).LT.IS .OR. IFIX(X).GT.IEND1) GO TO  50
+      IF (IFIX(Y).LT.JS .OR. IFIX(Y).GT.JEND1) GO TO  50
+C
+C CHECK (2)
+C
+      IF ( IMSG.EQ.0) GO TO 125
+      II = IFIX(X)
+      JJ = IFIX(Y)
+      IF (U(II,JJ).EQ.UVMSG .OR. U(II,JJ+1).EQ.UVMSG .OR.
+     1    U(II+1,JJ).EQ.UVMSG .OR. U(II+1,JJ+1).EQ.UVMSG) GO TO 50
+  125 CONTINUE
+C
+C CHECK (3)
+C
+      CALL GBYTES( UX(I,J) , IUX , ISKIP , 2 , 0 , 1 )
+      IF ( IAND( IUX , ITWO )  .NE. 0) GO TO 130
+      MFLAG = 2
+      GO TO 160
+  130 CONTINUE
+C
+C CHECK (4)
+C
+      DO 140 LOC=1,LCHK
+      IF (ABS( X-XCHK(LOC) ).GT.CSTOP .OR.
+     1    ABS( Y-YCHK(LOC) ).GT.CSTOP) GO TO 140
+      LFLAG = 1
+      IF (ICHKB.LE.ICHK .AND. LOC.GE.ICHKB .AND. LOC.LE.ICHK) LFLAG = 2
+      IF (ICHKB.GE.ICHK .AND. (LOC.GE.ICHKB .OR. LOC.LE.ICHK)) LFLAG = 2
+      IF (LFLAG.EQ.1) GO TO  50
+  140 CONTINUE
+      LCHK = MIN0(LCHK+1,NUMCHK)
+      ICHK = ICHK+1
+      IF (ICHK.GT.NUMCHK) ICHK = 1
+      XCHK(ICHK) = X
+      YCHK(ICHK) = Y
+      I = IFIX(X)
+      J = IFIX(Y)
+      CALL SBYTES( UX(I,J) , IONE , ISKIP1 , 1 , 0 , 1 )
+      IF (NBOX.LT.5) GO TO 150
+      ICHKB = ICHKB+1
+      IF (ICHKB.GT.NUMCHK) ICHKB = 1
+  150 CONTINUE
+      GO TO 110
+C
+  160 CONTINUE
+C
+C THIS SECTION DRAWS A DIRECTIONAL ARROW BASED ON THE MOST RECENT DIS-
+C .   PLACEMENT COMPONENTS ,DELX AND DELY, RETURNED BY GNEWPT. IN EARLIE
+C .   VERSIONS THIS WAS A SEPARATE SUBROUTINE (CALLED DRWDAR). IN THAT
+C .   CASE ,HOWEVER, FX AND FY WERE DEFINED EXTERNAL SINCE THESE
+C .   FUNCTIONS WERE USED BY BOTH DRWSTR AND DRWDAR. IN ORDER TO
+C .   MAKE ALL DEFAULT TRANSFORMATIONS STATEMENT FUNCTIONS I HAVE
+C .   PUT DRWDAR  HERE AND I WILL USE MFLAG TO RETURN  TO THE CORRECT
+C .   LOCATION IN THE CODE.
+C
+      IF ( (DELX.EQ.0.) .AND. (DELY.EQ.0.) ) GO TO 50
+C
+      CALL SBYTES( UX(I,J) ,IONE , ISKIP , 1 ,0 , 1 )
+      D = ATAN2(-DELX,DELY)
+      D30 = D+0.5
+  170 YY = -AROWL*COS(D30)+Y
+      XX = +AROWL*SIN(D30)+X
+      CALL FL2INT (FX(XX,YY),FY(XX,YY),IFXX,IFYY)
+      CALL PLOTIT (IFXX,IFYY,1)
+      CALL FL2INT (FX(X,Y),FY(X,Y),IFX,IFY)
+      CALL PLOTIT (IFX,IFY,0)
+      IF (D30.LT.D) GO TO 180
+      D30 = D-0.5
+      GO TO 170
+  180 IF (MFLAG.EQ.1) GO TO 110
+      IF (MFLAG.EQ.2) GO TO 130
+C
+  190 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE GNEWPT (UX,VY,IMAX,JPTSY)
+C
+C INTERPOLATION ROUTINE TO CALCULATE THE DISPLACEMANT COMPONENTS
+C .   THE PHILOSPHY HERE IS TO UTILIZE AS MANY POINTS AS POSSIBLE
+C .   (WITHIN REASON) IN ORDER TO OBTAIN A PLEASING AND ACCURATE PLOT.
+C .   INTERPOLATION SCHEMES DESIRED BY OTHER USERS MAY EASILY BE
+C .   SUBSTITUTED IF DESIRED.
+C
+      DIMENSION       UX(IMAX,JPTSY)        ,VY(IMAX,JPTSY)
+      COMMON /STR01/  IS         ,IEND      ,JS        ,JEND
+     1             ,  IEND1      ,JEND1     ,I         ,J
+     2             ,  X          ,Y         ,DELX      ,DELY
+     3             ,  ICYC1      ,IMSG1     ,IGFL1
+      COMMON /STR03/  INITA , INITB , AROWL , ITERP , ITERC , IGFLG
+     1             ,  IMSG , UVMSG , ICYC , DISPL , DISPC , CSTOP
+C
+      SAVE
+C
+C FDLI - DOUBLE LINEAR INTERPOLATION FORMULA
+C FBESL - BESSEL 16 PT INTERPOLATION FORMULA ( MOST USED FORMULA )
+C FQUAD - QUADRATIC INTERPOLATION FORMULA
+C
+      FDLI(Z,Z1,Z2,Z3,DX,DY) = (1.-DX)*((1.-DY)*Z +DY*Z1)
+     1                         +     DX *((1.-DY)*Z2+DY*Z3)
+      FBESL(Z,ZP1,ZP2,ZM1,DZ)=Z+DZ*(ZP1-Z+0.25*(DZ-1.)*((ZP2-ZP1-Z+ZM1)
+     1                        +0.666667*(DZ-0.5)*(ZP2-3.*ZP1+3.*Z-ZM1)))
+      FQUAD(Z,ZP1,ZM1,DZ)=Z+0.5*DZ*(ZP1-ZM1+DZ*(ZP1-2.*Z+ZM1))
+C
+      DX = X-AINT(X)
+      DY = Y-AINT(Y)
+C
+      IF( IMSG.NE.0.OR.IGFLG.NE.0) GO TO 20
+C
+      IM1 = I-1
+      IP2 = I+2
+C
+C DETERMINE WHICH INTERPOLATION FORMULA TO USE DEPENDING ON I,J LOCATION
+C .   THE FIRST CHECK IS FOR I,J IN THE GRID INTERIOR.
+C
+      IF (J.GT.JS .AND. J.LT.JEND1 .AND. I.GT.IS .AND. I.LT.IEND1)
+     1    GO TO 30
+      IF (J.EQ.JEND1 .AND. I.GT.IS .AND. I.LT.IEND1) GO TO  40
+      IF (J.EQ.JS) GO TO 20
+C
+      IF (ICYC1.EQ.1) GO TO 10
+C
+C MUST NOT BE CYCLIC
+C
+      IF (I.EQ.IS) GO TO 20
+      IF (I.EQ.IEND1) GO TO  50
+      GO TO 20
+   10 CONTINUE
+C
+C MUST BE CYCLIC IN THE X DIRECTION
+C
+      IF (I.EQ.IS .AND. J.LT.JEND1) GO TO 12
+      IF (I.EQ.IEND1 .AND. J.LT.JEND1) GO TO 14
+      IF (J.EQ.JEND1 .AND. I.EQ.IS) GO TO 16
+      IF (J.EQ.JEND1 .AND. I.EQ.IEND1) GO TO 18
+      GO TO 20
+   12 IM1 = IEND1
+      GO TO 30
+   14 IP2 = IS+1
+      GO TO 30
+   16 IM1 = IEND1
+      GO TO 40
+   18 IP2 = IS+1
+      GO TO 40
+C
+   20 CONTINUE
+C
+C DOUBLE LINEAR INTERPOLATION FORMULA. THIS SCHEME WORKS AT ALL POINTS
+C .   BUT THE RESULTING STREAMLINES ARE NOT AS PLEASING AS THOSE DRAWN
+C .   BY FBESL OR FQUAD. CURRENTLY THIS IS USED AT THIS IS UTILIZED
+C .   ONLY AT CERTAIN BOUNDARY POINTS OR IF IGFLG IS NOT EQUAL TO ZERO.
+C
+      DELX = FDLI (UX(I,J),UX(I,J+1),UX(I+1,J),UX(I+1,J+1),DX,DY)
+      DELY = FDLI (VY(I,J),VY(I,J+1),VY(I+1,J),VY(I+1,J+1),DX,DY)
+      RETURN
+   30 CONTINUE
+C
+C USE A 16 POINT BESSEL INTERPOLATION SCHEME
+C
+      UJM1 = FBESL (UX(I,J-1),UX(I+1,J-1),UX(IP2,J-1),UX(IM1,J-1),DX)
+      UJ   = FBESL (UX(I,J),UX(I+1,J),UX(IP2,J),UX(IM1,J),DX)
+      UJP1 = FBESL (UX(I,J+1),UX(I+1,J+1),UX(IP2,J+1),UX(IM1,J+1),DX)
+      UJP2 = FBESL (UX(I,J+2),UX(I+1,J+2),UX(IP2,J+2),UX(IM1,J+2),DX)
+      DELX = FBESL (UJ,UJP1,UJP2,UJM1,DY)
+      VJM1 = FBESL (VY(I,J-1),VY(I+1,J-1),VY(IP2,J-1),VY(IM1,J-1),DX)
+      VJ   = FBESL (VY(I,J),VY(I+1,J),VY(IP2,J),VY(IM1,J),DX)
+      VJP1 = FBESL (VY(I,J+1),VY(I+1,J+1),VY(IP2,J+1),VY(IM1,J+1),DX)
+      VJP2 = FBESL (VY(I,J+2),VY(I+1,J+2),VY(IP2,J+2),VY(IM1,J+2),DX)
+      DELY = FBESL (VJ,VJP1,VJP2,VJM1,DY)
+      RETURN
+   40 CONTINUE
+C
+C 12 POINT INTERPOLATION SCHEME APPLICABLE TO ONE ROW FROM TOP BOUNDARY
+C
+      UJM1 = FBESL (UX(I,J-1),UX(I+1,J-1),UX(IP2,J-1),UX(IM1,J-1),DX)
+      UJ   = FBESL (UX(I,J),UX(I+1,J),UX(IP2,J),UX(IM1,J),DX)
+      UJP1 = FBESL (UX(I,J+1),UX(I+1,J+1),UX(IP2,J+1),UX(IM1,J+1),DX)
+      DELX = FQUAD (UJ,UJP1,UJM1,DY)
+      VJM1 = FBESL (VY(I,J-1),VY(I+1,J-1),VY(IP2,J-1),VY(IM1,J-1),DX)
+      VJ   = FBESL (VY(I,J),VY(I+1,J),VY(IP2,J),VY(IM1,J),DX)
+      VJP1 = FBESL (VY(I,J+1),VY(I+1,J+1),VY(IP2,J+1),VY(IM1,J+1),DX)
+      DELY = FQUAD (VJ,VJP1,VJM1,DY)
+      RETURN
+   50 CONTINUE
+C
+C 9 POINT INTERPOLATION SCHEME FOR USE IN THE NON-CYCLIC CASE
+C .   AT I=IEND1 ; JS.LT.J AND J.LE.JEND1
+C
+      UJP1 = FQUAD (UX(I,J+1),UX(I+1,J+1),UX(IM1,J+1),DX)
+      UJ   = FQUAD (UX(I,J),UX(I+1,J),UX(IM1,J),DX)
+      UJM1 = FQUAD (UX(I,J-1),UX(I+1,J-1),UX(IM1,J-1),DX)
+      DELX = FQUAD (UJ,UJP1,UJM1,DY)
+      VJP1 = FQUAD (VY(I,J+1),VY(I+1,J+1),VY(IM1,J+1),DX)
+      VJ   = FQUAD (VY(I,J),VY(I+1,J),VY(IM1,J),DX)
+      VJM1 = FQUAD (VY(I,J-1),VY(I+1,J-1),VY(IM1,J-1),DX)
+      DELY = FQUAD (VJ,VJP1,VJM1,DY)
+      RETURN
+      END
+      SUBROUTINE EZSTRM(U,V,WORK,IMAX,JMAX)
+C
+      DIMENSION       U(IMAX,JMAX)       ,V(IMAX,JMAX)     ,WORK(1)
+C
+        SAVE
+C
+C THE FOLLOWING CALL IS FOR MONITORING LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ( 'GRAPHX', 'STRMLN', 'EZSTRM', 'VERSION 01')
+C
+      CALL STRMLN(U,V,WORK,IMAX,IMAX,JMAX,0,IER)
+      RETURN
+      END
+      SUBROUTINE CHKCYC  (U,V,IMAX,JPTSY,IER)
+C
+C CHECK FOR CYCLIC CONDITION
+C
+      DIMENSION       U(IMAX,JPTSY)          ,V(IMAX,JPTSY)
+      COMMON /STR01/  IS         ,IEND      ,JS        ,JEND
+     1             ,  IEND1      ,JEND1     ,I         ,J
+     2             ,  X          ,Y         ,DELX      ,DELY
+     3             ,  ICYC1      ,IMSG1     ,IGFL1
+C
+        SAVE
+      DO  10 J=JS,JEND
+      IF (U(IS,J).NE.U(IEND,J)) GO TO  20
+      IF (V(IS,J).NE.V(IEND,J)) GO TO  20
+   10 CONTINUE
+C
+C MUST BE CYCLIC
+C
+      RETURN
+   20 CONTINUE
+C
+C MUST NOT BE CYCLIC
+C . CHANGE THE PARAMETER AND SET IER = -1
+C
+      ICYC1 = 0
+      IER = -1
+      RETURN
+C
+C------------------------------------------------------------------
+C REVISION HISTORY
+C
+C OCTOBER 1979      FIRST ADDED TO ULIB
+C
+C OCTOBER 1980      ADDED BUGS SECTION
+C
+C JUNE    1984      REMOVED STATEMENT FUNCTIONS ANDF AND ORF,
+C                   CONVERTED TO FORTRAN77 AND GKS.
+C-------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/sysint/README b/sys/gio/ncarutil/sysint/README
new file mode 100644
index 00000000..38d7b6f8
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/README
@@ -0,0 +1,2 @@
+SYSINT - This directory contains the System Interface Routines needed
+for implementing the GKS based NCAR plotting utilities.
diff --git a/sys/gio/ncarutil/sysint/fencode.x b/sys/gio/ncarutil/sysint/fencode.x
new file mode 100644
index 00000000..1e2e37d5
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/fencode.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<error.h>
+include	<ctype.h>
+
+define	SZ_FORMAT	11
+
+# FENCD -- Format a real variable and return as a spp character string.
+# A packed format string is passed as an input argument to define how the
+# number is to be encoded.  The format of the format string is:
+#	format string = "(cW.D)"
+# where c is one of [EFGI], and where W and D are the field width and
+# number of decimal places or precision, respectively.
+
+procedure fencd (nchars, f_format, spp_outstr, rval)
+
+int	nchars			# desired number of output chars
+char	f_format[SZ_FORMAT] 	# SPP string containing format
+char	spp_outstr[nchars+1]    # SPP string containing encoded number
+real	rval			# value to be encoded
+
+char	fmtchar, outstr[MAX_DIGITS], spp_format[SZ_FORMAT+1]
+int	ip, op, stridxs()
+real	x
+
+begin
+	# Encode format string for SPRINTF, format "%w.d".  Start copying
+	# Fortran format at char 3, which should follow the EFGI char.
+
+	spp_format[1] = '%'
+	op = 2
+
+	if (f_format[1] != '(')
+	    call fatal (1, "Missing lparen in Ncar ENCODE format")
+	for (ip=3;  f_format[ip] != ')' && f_format[ip] != EOS;  ip=ip+1) {
+	    spp_format[op] = f_format[ip]
+	    op = op + 1
+	}
+
+	# Now add the SPP format character.  EFG are the same for sprintf as
+	# as for Fortran.  The integer format is 'd' for decimal in SPP.
+
+	fmtchar = f_format[2]
+	if (IS_UPPER(fmtchar))
+	    fmtchar = TO_LOWER (fmtchar)
+	    
+	switch (fmtchar) {
+	case 'e', 'f', 'g':
+	    spp_format[op] = fmtchar
+	case 'i':
+	    spp_format[op] = 'd'
+	default:
+	    call fatal (1, "Unknown Ncar ENCODE format code")
+	}
+	op = op + 1
+	spp_format[op] = EOS
+	x = rval
+	if (rval > 0)
+	    x = -x
+
+	# Now encode the user supplied variable and return it as a spp
+	# string.
+
+	iferr {
+	    call sprintf (outstr, MAX_DIGITS, spp_format)
+		call pargr (x)
+	} then
+	    call erract (EA_FATAL)
+
+	# Let's try adding a "+" prefix to positive numbers to set if that
+	# makes nicer plots.  Sep86 - This was not a good idea - changed to
+	# a blank.
+
+	op = stridxs ("-", outstr)
+	if (rval > 0 && op > 0) 
+	    outstr[op] = ' '
+
+	call strcpy (outstr, spp_outstr, SZ_LINE)
+end
diff --git a/sys/gio/ncarutil/sysint/fulib.x b/sys/gio/ncarutil/sysint/fulib.x
new file mode 100644
index 00000000..1951f26c
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/fulib.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# FULIB -- Print an error message processed by fortran routine uliber.
+
+procedure fulib (errcode, upkmsg, msglen)
+
+int	errcode
+char	upkmsg[ARB]		# unpacked string
+int	msglen			# number of chars in string
+
+pointer	sp, sppmsg
+
+begin
+	call smark (sp)
+	call salloc (sppmsg,  SZ_LINE, TY_CHAR)
+
+	# Construct error message string
+	call sprintf (Memc[sppmsg], SZ_LINE, "ERROR %d IN %s\n")
+	    call pargi (errcode)
+	    call pargstr (upkmsg)
+
+	# Call error with the constructed message
+	iferr (call error (errcode, Memc[sppmsg]))
+	    call erract (EA_WARN)
+	
+	call sfree (sp)
+end
diff --git a/sys/gio/ncarutil/sysint/gbytes.x b/sys/gio/ncarutil/sysint/gbytes.x
new file mode 100644
index 00000000..b129ffbc
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/gbytes.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GBYTES -- Locally implemented bit unpacker for the NCAR extended metacode
+# translator.   3 may 84 cliff stoll
+# Required for the ncar/gks vdi metacode generator.
+#
+# Essentially this routine accepts an array which is a packed series of bits. 
+# [array BUFIN], and unpacks them into an array [array BUFOUT].  Received
+# integer INDEX is the beginning bit in BUFIN  where information is to be 
+# placed.  INDEX is zero indexed.  Received integer argument SIZE is the 
+# number of bits in each "information packet".  Received argument SKIP is the 
+# number of bits to skip between bit packets.  For more info, see page 4 of 
+# the NCAR "Implementaton details for the new metafile translator, version 1.0"
+
+procedure gbytes (bufin, bufout, index, size, skip, count)
+
+int	bufout[ARB], bufin[ARB], index, size, skip, count
+int	pack
+int	offset
+int	bitupk()	# Iraf function to unpack bits
+
+begin
+	for (pack = 1; pack <= count ; pack = pack+1) {
+	    # Offset is a bit offset into the input buffer bufin.
+	    # (offset is 1- indexed; INDEX is zero indexed)
+
+	    offset = (size + skip) * (pack - 1) + index + 1
+	    bufout(pack) = bitupk(bufin, offset, size)
+	}
+end
diff --git a/sys/gio/ncarutil/sysint/ishift.x b/sys/gio/ncarutil/sysint/ishift.x
new file mode 100644
index 00000000..580996c0
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/ishift.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ISHIFT -- integer shift.  To be used for calls to ISHIFT in NCAR routines.
+
+int procedure ishift (in_word, n)
+
+int	in_word, n
+int	new_word, bit, index, i
+int	bitupk()
+
+begin
+	if (n > NBITS_INT)
+	    call error (0, "n > NBITS_INT in ishift")
+	if (n < 0)
+	    # Right end-off shift
+	    new_word = bitupk (in_word, abs(n) + 1, NBITS_INT - abs(n))
+	else {
+	    # Left circular shift (rotate)
+	    do i = 1, NBITS_INT {
+		index = n + i
+		if (index > NBITS_INT)
+		    index = mod ((n + i), NBITS_INT)
+		bit = bitupk (in_word, i, 1)
+		call bitpak (bit, new_word, index, 1)
+	    }
+	}
+
+	return (new_word)
+end
+
+
+# IAND -- AND two integers.
+
+int procedure iand (a, b)
+
+int	a, b
+int	and()
+
+begin
+	return (and (a, b))
+end
+
+
+# IOR -- OR two integers.  
+
+int procedure ior (a, b)
+
+int	a, b
+int	or()
+
+begin
+	return (or (a, b))
+end
diff --git a/sys/gio/ncarutil/sysint/mkpkg b/sys/gio/ncarutil/sysint/mkpkg
new file mode 100644
index 00000000..f3ba6fb5
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/mkpkg
@@ -0,0 +1,16 @@
+# Make the system interface for libncar.a.
+
+$checkout libncar.a lib$
+$update   libncar.a
+$checkin  libncar.a lib$
+$exit
+
+libncar.a:
+	support.f
+	fencode.x	<mach.h> <error.h> <ctype.h>
+	fulib.x		<error.h>
+	ishift.x	<mach.h>
+	gbytes.x
+	sbytes.x	<mach.h>
+	spps.f
+	;
diff --git a/sys/gio/ncarutil/sysint/sbytes.x b/sys/gio/ncarutil/sysint/sbytes.x
new file mode 100644
index 00000000..4d4094c3
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/sbytes.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# SBYTES -- Locally implemented bit packer for the NCAR extended metacode
+# translator.   3 may 84 cliff stoll
+# Required for the ncar/gks vdi metacode generator.
+#
+# Essentially this routine accepts an array of "information packets"
+# [array BUFIN], and packs them into a packed array [array BUFOUT]
+# received integer argument INDEX points to the beginning bit in BUFOUT
+# where information is to be placed.  INDEX is zero indexed.
+# received integer argument SIZE is the number of bits in each "information
+# packet.  received argument SKIP is the number of bits to skip between
+# bit packets.  For more info, see page 6 of the NCAR "Implementaton
+# details for the new metafile translator, version 1.0"  
+# bufin is stuffed into bufout
+
+procedure sbytes (bufout, bufin, index, size, skip, count)
+
+int	bufout[ARB], bufin[ARB], index, size, skip, count
+int	metacode_word_length
+int	pack
+int	offset
+
+data	metacode_word_length / 16 /
+
+begin
+	if (metacode_word_length != NBITS_SHORT) 
+	    call error ( 0, " bad metacode word length in SBYTES")
+
+	for (pack = 1; pack <= count; pack = pack + 1) {
+	    # Offset is a bit offset into the output buffer bufout.
+	    # (offset is 1- indexed; INDEX is zero indexed)
+	    # see page 58 of IRAF system interface book
+
+	    offset =  (size + skip) * (pack - 1) + index + 1
+	    call bitpak (bufin[pack], bufout, offset, size)
+	}
+end
diff --git a/sys/gio/ncarutil/sysint/spps.f b/sys/gio/ncarutil/sysint/spps.f
new file mode 100644
index 00000000..4a394d9e
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/spps.f
@@ -0,0 +1,1797 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+      FUNCTION CFUX (RX)
+C
+C Given an x coordinate RX in the fractional system, CFUX(RX) is an x
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      CFUX=WD(I)+(RX-VP(1))/(VP(2)-VP(1))*(WD(3-I)-WD(I))
+      IF (LL.GE.3) CFUX=10.**CFUX
+      RETURN
+      END
+      FUNCTION CFUY (RY)
+C
+C Given a y coordinate RY in the fractional system, CFUY(RY) is a y
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      CFUY=WD(I)+(RY-VP(3))/(VP(4)-VP(3))*(WD(7-I)-WD(I))
+      IF (LL.EQ.2.OR.LL.GE.4) CFUY=10.**CFUY
+      RETURN
+      END
+      FUNCTION CMFX (IX)
+C
+C Given an x coordinate IX in the metacode system, CMFX(IX) is an x
+C coordinate in the fractional system.
+C
+      CMFX=FLOAT(IX)/32767.
+      RETURN
+      END
+      FUNCTION CMFY (IY)
+C
+C Given a y coordinate IY in the metacode system, CMFY(IY) is a y
+C coordinate in the fractional system.
+C
+      CMFY=FLOAT(IY)/32767.
+      RETURN
+      END
+      FUNCTION CMUX (IX)
+C
+C Given an x coordinate IX in the metacode system, CMUX(IX) is an x
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      CMUX=WD(I)+(FLOAT(IX)/32767.-VP(1))/(VP(2)-VP(1))*(WD(3-I)-WD(I))
+      IF (LL.GE.3) CMUX=10.**CMUX
+      RETURN
+      END
+      FUNCTION CMUY (IY)
+C
+C Given a y coordinate IY in the metacode system, CMUY(IY) is a y
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      CMUY=WD(I)+(FLOAT(IY)/32767.-VP(3))/(VP(4)-VP(3))*(WD(7-I)-WD(I))
+      IF (LL.EQ.2.OR.LL.GE.4) CMUY=10.**CMUY
+      RETURN
+      END
+      FUNCTION CPFX (IX)
+C
+C Given an x coordinate IX in the plotter system, CPFX(IX) is an x
+C coordinate in the fractional system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      CPFX=FLOAT(IX-1)/(2.**MX-1.)
+      RETURN
+      END
+      FUNCTION CPFY (IY)
+C
+C Given a y coordinate IY in the plotter system, CPFY(IY) is a y
+C coordinate in the fractional system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      CPFY=FLOAT(IY-1)/(2.**MY-1.)
+      RETURN
+      END
+      FUNCTION CPUX (IX)
+C
+C Given an x coordinate IX in the plotter system, CPUX(IX) is an x
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      CPUX=WD(I)+(FLOAT(IX-1)/(2.**MX-1.)-VP(1))/(VP(2)-VP(1))*
+     +           (WD(3-I)-WD(I))
+      IF (LL.GE.3) CPUX=10.**CPUX
+      RETURN
+      END
+      FUNCTION CPUY (IY)
+C
+C Given a y coordinate IY in the plotter system, CPUY(IY) is a y
+C coordinate in the user system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      CPUY=WD(I)+(FLOAT(IY-1)/(2.**MY-1.)-VP(3))/(VP(4)-VP(3))*
+     +     (WD(7-I)-WD(I))
+      IF (LL.EQ.2.OR.LL.GE.4) CPUY=10.**CPUY
+      RETURN
+      END
+      FUNCTION CUFX (RX)
+C
+C Given an x coordinate RX in the user system, CUFX(RX) is an x
+C coordinate in the fractional system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      IF (LL.LE.2) THEN
+        CUFX=(RX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1)
+      ELSE
+        CUFX=(ALOG10(RX)-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1)
+      ENDIF
+      RETURN
+      END
+      FUNCTION CUFY (RY)
+C
+C Given a y coordinate RY in the user system, CUFY(RY) is a y
+C coordinate in the fractional system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      IF (LL.LE.1.OR.LL.EQ.3) THEN
+        CUFY=(RY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3)
+      ELSE
+        CUFY=(ALOG10(RY)-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3)
+      ENDIF
+      RETURN
+      END
+      FUNCTION KFMX (RX)
+C
+C Given an x coordinate RX in the fractional system, KFMX(RX) is an x
+C coordinate in the metacode system.
+C
+      KFMX=IFIX(RX*32767.)
+      RETURN
+      END
+      FUNCTION KFMY (RY)
+C
+C Given a y coordinate RY in the fractional system, KFMY(RY) is a y
+C coordinate in the metacode system.
+C
+      KFMY=IFIX(RY*32767.)
+      RETURN
+      END
+      FUNCTION KFPX (RX)
+C
+C Given an x coordinate RX in the fractional system, KFPX(RX) is an x
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KFPX=1+IFIX(RX*(2.**MX-1.))
+      RETURN
+      END
+      FUNCTION KFPY (RY)
+C
+C Given a y coordinate RY in the fractional system, KFPY(RY) is a y
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KFPY=1+IFIX(RY*(2.**MX-1.))
+      RETURN
+      END
+      FUNCTION KMPX (IX)
+C
+C Given an x coordinate IX in the metacode system, KMPX(IX) is an x
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KMPX=1+IFIX((2.**MX-1.)*FLOAT(IX)/32767.)
+      RETURN
+      END
+      FUNCTION KMPY (IY)
+C
+C Given a y coordinate IY in the metacode system, KMPY(IY) is a y
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KMPY=1+IFIX((2.**MY-1.)*FLOAT(IY)/32767.)
+      RETURN
+      END
+      FUNCTION KPMX (IX)
+C
+C Given an x coordinate IX in the plotter system, KPMX(IX) is an x
+C coordinate in the metacode system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KPMX=IFIX(32767.*FLOAT(IX-1)/(2.**MX-1.))
+      RETURN
+      END
+      FUNCTION KPMY (IY)
+C
+C Given a y coordinate IY in the plotter system, KPMY(IY) is a y
+C coordinate in the metacode system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      KPMY=IFIX(32767.*FLOAT(IY-1)/(2.**MY-1.))
+      RETURN
+      END
+      FUNCTION KUMX (RX)
+C
+C Given an x coordinate RX in the user system, KUMX(RX) is an x
+C coordinate in the metacode system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      IF (LL.LE.2) THEN
+        KUMX=IFIX(((RX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1))*
+     +              32767.)
+      ELSE
+        KUMX=IFIX(((ALOG10(RX)-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+
+     +              VP(1))*32767.)
+      ENDIF
+      RETURN
+      END
+      FUNCTION KUMY (RY)
+C
+C Given a y coordinate RY in the user system, KUMY(RY) is a y
+C coordinate in the metacode system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      IF (LL.LE.1.OR.LL.EQ.3) THEN
+        KUMY=IFIX(((RY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3))*
+     +              32767.)
+      ELSE
+        KUMY=IFIX(((ALOG10(RY)-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+
+     +              VP(3))*32767.)
+      ENDIF
+      RETURN
+      END
+      FUNCTION KUPX (RX)
+C
+C Given an x coordinate RX in the user system, KUPX(RX) is an x
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=1
+      IF (MI.GE.3) I=2
+      IF (LL.LE.2) THEN
+        KUPX=1+IFIX(((RX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1))*
+     +              (2.**MX-1.))
+      ELSE
+        KUPX=1+IFIX(((ALOG10(RX)-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+
+     +              VP(1))*(2.**MX-1.))
+      ENDIF
+      RETURN
+      END
+      FUNCTION KUPY (RY)
+C
+C Given a y coordinate RY in the user system, KUPY(RY) is a y
+C coordinate in the plotter system.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+      DIMENSION WD(4),VP(4)
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      IF (LL.LE.1.OR.LL.EQ.3) THEN
+        KUPY=1+IFIX(((RY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3))*
+     +              (2.**MY-1.))
+      ELSE
+        KUPY=1+IFIX(((ALOG10(RY)-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+
+     +              VP(3))*(2.**MY-1.))
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE CLSGKS
+C
+C IU(6), in IUTLCM, is the current metacode unit number.
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C Deactivate the metacode workstation, close the workstation, and
+C close GKS.
+C
+      CALL GDAWK (IU(6))
+      CALL GCLWK (IU(6))
+      CALL GCLKS
+C
+      RETURN
+C
+      END
+      SUBROUTINE CURVE (PX,PY,NP)
+C
+      DIMENSION PX(NP),PY(NP)
+C
+C CURVE draws the curve defined by the points (PX(I),PY(I)), for I = 1
+C to NP.  All coordinates are stated in the user coordinate system.
+C
+C Define arrays to hold converted point coordinates when it becomes
+C necessary to draw the curve piecewise.
+C
+      DIMENSION QX(10),QY(10)
+C
+C If NP is less than or equal to zero, there's nothing to do.
+C
+      IF (NP.LE.0) RETURN
+C
+C If NP is exactly equal to 1, just draw a point.
+C
+      IF (NP.EQ.1) THEN
+        CALL POINT (PX(1),PY(1))
+C
+C Otherwise, draw the curve.
+C
+      ELSE
+C
+C Flush the pen-move buffer.
+C
+        CALL PLOTIF (0.,0.,2)
+C
+C Save the current SET parameters.
+C
+        CALL GETSET (F1,F2,F3,F4,F5,F6,F7,F8,LL)
+C
+C If the mapping defined by the last SET call was non-reversed and
+C linear in both x and y, a single polyline will suffice.
+C
+        IF (F5.LT.F6.AND.F7.LT.F8.AND.LL.EQ.1) THEN
+          CALL GPL (NP,PX,PY)
+C
+C Otherwise, piece the line together out of smaller chunks, converting
+C the coordinates for each chunk as directed by the last SET call.
+C
+        ELSE
+          DO 102 IP=1,NP,9
+            NQ=MIN0(10,NP-IP+1)
+            IF (NQ.GE.2) THEN
+              DO 101 IQ=1,NQ
+                QX(IQ)=CUFX(PX(IP+IQ-1))
+                QY(IQ)=CUFY(PY(IP+IQ-1))
+  101         CONTINUE
+              CALL SET (F1,F2,F3,F4,F1,F2,F3,F4,1)
+              CALL GPL (NQ,QX,QY)
+              CALL SET (F1,F2,F3,F4,F5,F6,F7,F8,LL)
+            END IF
+  102     CONTINUE
+        END IF
+C
+C Update the pen position.
+C
+        CALL FRSTPT (PX(NP),PY(NP))
+C
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE FL2INT (PX,PY,IX,IY)
+C
+C Given the user coordinates PX and PY of a point, FL2INT returns the
+C metacode coordinates IX and IY of that point.
+C
+C Declare the common block containing the user state variables LL, MI,
+C MX, and MY.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Declare arrays in which to retrieve the variables defining the current
+C window and viewport.
+C
+      DIMENSION WD(4),VP(4)
+C
+C Get the variables defining the current window and viewport.
+C
+      CALL GQCNTN (IE,NT)
+      CALL GQNT (NT,IE,WD,VP)
+C
+C Compute IX.
+C
+      I=1
+      IF (MI.GE.3) I=2
+      IF (LL.LE.2) THEN
+        IX=IFIX(((PX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1))*32767.)
+      ELSE
+        IX=IFIX(((ALOG10(PX)-WD(I))/(WD(3-I)-WD(I))*
+     +                              (VP(2)-VP(1))+VP(1))*32767.)
+      ENDIF
+C
+C Compute IY.
+C
+      I=3
+      IF (MI.EQ.2.OR.MI.GE.4) I=4
+      IF (LL.LE.1.OR.LL.EQ.3) THEN
+        IY=IFIX(((PY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3))*32767.)
+      ELSE
+        IY=IFIX(((ALOG10(PY)-WD(I))/(WD(7-I)-WD(I))*
+     +                              (VP(4)-VP(3))+VP(3))*32767.)
+      ENDIF
+C
+C Done.
+C
+      RETURN
+C
+      END
+C
+C +NOAO - name conflict
+C
+C     SUBROUTINE FLUSH
+      subroutine mcflsh
+C
+C - NOAO
+C
+C FLUSH currently does nothing except flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE FRAME
+C
+C FRAME is intended to advance to a new frame.  The GKS version clears
+C all open workstations.
+C
+C First, flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C +NOAO - Initialize utilbd 'first' flag for next plot
+      call initut
+C 
+C - NOAO
+C Get the number of open workstations.  If there are none, we're done.
+C
+      CALL GQOPWK (0,IE,NO,ID)
+      IF (NO.EQ.0) RETURN
+C
+C Otherwise, clear the open workstations.
+C
+      DO 101 I=1,NO
+        CALL GQOPWK (I,IE,NO,ID)
+        CALL GCLRWK (ID,1)
+  101 CONTINUE
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE FRSTPT (PX,PY)
+C
+C Given the user coordinates PX and PY of a point, FRSTPT generates a
+C pen-up move to that point.
+C
+      CALL PLOTIF (CUFX(PX),CUFY(PY),0)
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE GETSET (VL,VR,VB,VT,WL,WR,WB,WT,LF)
+C
+C GETSET returns to its caller the current values of the parameters
+C defining the mapping from the user system to the fractional system
+C (in GKS terminology, the mapping from world coordinates to normalized
+C device coordinates).
+C
+C VL, VR, VB, and VT define the viewport (in the fractional system), WL,
+C WR, WB, and WT the window (in the user system), and LF the nature of
+C the mapping, according to the following table:
+C
+C    1  -  x linear, y linear
+C    2  -  x linear, y logarithmic
+C    3  -  x logarithmic, y linear
+C    4  -  x logarithmic, y logarithmic
+C
+C Declare the common block containing the linear-log and mirror-imaging
+C flags.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Define variables to receive the GKS viewport and window.
+C
+      DIMENSION VP(4),WD(4)
+C
+C Retrieve the number of the current GKS normalization transformation.
+C
+      CALL GQCNTN (IE,NT)
+C
+C Retrieve the definition of that normalization transformation.
+C
+      CALL GQNT (NT,IE,WD,VP)
+C
+C Pass the viewport definition to the caller.
+C
+      VL=VP(1)
+      VR=VP(2)
+      VB=VP(3)
+      VT=VP(4)
+C
+C Pass the linear/log flag and a (possibly modified) window definition
+C to the caller.
+C
+      LF=LL
+C
+      IF (LL.EQ.1.OR.LL.EQ.2) THEN
+        WL=WD(1)
+        WR=WD(2)
+      ELSE
+        WL=10.**WD(1)
+        WR=10.**WD(2)
+      END IF
+C
+      IF (MI.GE.3) THEN
+        WW=WL
+        WL=WR
+        WR=WW
+      END IF
+C
+      IF (LL.EQ.1.OR.LL.EQ.3) THEN
+        WB=WD(3)
+        WT=WD(4)
+      ELSE
+        WB=10.**WD(3)
+        WT=10.**WD(4)
+      END IF
+C
+      IF (MI.EQ.2.OR.MI.GE.4) THEN
+        WW=WB
+        WB=WT
+        WT=WW
+      END IF
+C
+      RETURN
+C
+      END
+      SUBROUTINE GETSI (IX,IY)
+C
+C Return to the user the parameters which determine the assumed size of
+C the target plotter and therefore determine how user coordinates are
+C to be mapped into plotter coordinates.
+C
+C Declare the common block containing the scaling information.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Set the user variables.
+
+      IX=MX
+      IY=MY
+C
+      RETURN
+C
+      END
+      SUBROUTINE GETUSV (VN,IV)
+      CHARACTER*(*) VN
+C
+C This subroutine retrieves the current values of the utility state
+C variables.  VN is the character name of the variable and IV is
+C its value.
+C
+C The labelled common block IUTLCM contains all of the utility state
+C variables.
+C
+      COMMON /IUTLCM/IU(100)
+C
+C Check for the linear-log scaling variable.
+C
+      IF (VN(1:2).EQ.'LS') THEN
+        IV=IU(1)
+C
+C Check for the variable specifying the mirror-imaging of the axes.
+C
+      ELSE IF (VN(1:2).EQ.'MI') THEN
+        IV=IU(2)
+C
+C Check for the variable specifying the resolution of the plotter in x.
+C
+      ELSE IF (VN(1:2).EQ.'XF') THEN
+        IV=IU(3)
+C
+C Check for the variable specifying the resolution of the plotter in x.
+C
+      ELSE IF (VN(1:2).EQ.'YF') THEN
+        IV=IU(4)
+C
+C Check for the variable specifying the size of the pen-move buffer.
+C
+      ELSE IF (VN(1:2).EQ.'PB') THEN
+        IV=IU(5)
+C
+C Check for the variable specifying the metacode unit.
+C
+      ELSE IF (VN(1:2).EQ.'MU') THEN
+        IV=IU(6)
+C
+C Check for one of the variables specifying color and intensity.
+C
+      ELSE IF (VN(1:2).EQ.'IR') THEN
+        IV=IU(7)
+C
+      ELSE IF (VN(1:2).EQ.'IG') THEN
+        IV=IU(8)
+C
+      ELSE IF (VN(1:2).EQ.'IB') THEN
+        IV=IU(9)
+C
+      ELSE IF (VN(1:2).EQ.'IN') THEN
+        IV=IU(10)
+C
+C Check for the variable specifying the current color index.
+C
+      ELSE IF (VN(1:2).EQ.'II') THEN
+        IV=IU(11)
+C
+C Check for the variable specifying the maximum color index.
+C
+      ELSE IF (VN(1:2).EQ.'IM') THEN
+        IV=IU(12)
+C
+C Check for the variable specifying the line width scale factor.
+C
+      ELSE IF (VN(1:2).EQ.'LW') THEN
+        IV=IU(13)
+C
+C Check for the variable specifying the marker size scale factor.
+C
+      ELSE IF (VN(1:2).EQ.'MS') THEN
+        IV=IU(14)
+C
+C Otherwise, the variable name is unknown.
+C
+      ELSE
+        CALL SETER ('GETUSV - UNKNOWN VARIABLE NAME IN CALL',1,2)
+C
+      ENDIF
+C
+      RETURN
+C
+      END
+      SUBROUTINE LINE (X1,Y1,X2,Y2)
+C
+C Draw a line connecting the point (X1,Y1) to the point (X2,Y2), in the
+C user coordinate system.
+C
+      CALL PLOTIF (CUFX(X1),CUFY(Y1),0)
+      CALL PLOTIF (CUFX(X2),CUFY(Y2),1)
+      RETURN
+      END
+      SUBROUTINE MXMY (IX,IY)
+C
+C Return to the user the coordinates of the current pen position, in the
+C plotter coordinate system.
+C
+C In the common block PLTCM are recorded the coordinates of the last
+C pen position, in the metacode coordinate system.
+C
+      COMMON /PLTCM/ JX,JY
+C
+C Declare the common block containing the user state variables LL, MI,
+C MX, and MY.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Return to the user the plotter-system equivalents of the values in
+C the metacode system.
+C
+      IX=1+IFIX((2.**MX-1.)*FLOAT(JX)/32767.)
+      IY=1+IFIX((2.**MY-1.)*FLOAT(JY)/32767.)
+C
+C Done.
+C
+      RETURN
+C
+      END
+C
+C + NOAO - Following subroutine 
+C     SUBROUTINE OPNGKS
+C
+C IU(6), in IUTLCM, is the current metacode unit number.
+C
+C     COMMON /IUTLCM/ IU(100)
+C
+C Force all required BLOCKDATA's to load.
+C
+C     EXTERNAL GKSBD,G01BKD,UERRBD,UTILBD
+C
+C GKS buffer size (a dummy for NCAR GKS.)
+C
+C     DATA ISZ /0/
+C
+C Open GKS, define a workstation, and activate the workstation.
+C
+C     CALL GOPKS (6,ISZ)
+C     CALL GOPWK (IU(6),2,1)
+C     CALL GACWK (IU(6))
+C
+C     RETURN
+C
+C + NOAO
+C
+C     END
+      SUBROUTINE PLOTIF (FX,FY,IP)
+C
+C Move the pen to the point (FX,FY), in the fractional cooordinate
+C system.  If IP is zero, do a pen-up move.  If IP is one, do a pen-down
+C move.  If IP is two, flush the buffer.
+C
+C The variable IU(5), in the labelled common block IUTLCM, specifies
+C the size of the pen-move buffer (between 2 and 50).
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C The common block VCTSEQ contains variables implementing the buffering
+C of pen moves.
+C
+      COMMON /VCTSEQ/ NQ,QX(50),QY(50),NF,IF(25)
+C
+C In the common block PLTCM are recorded the coordinates of the last
+C pen position, in the metacode coordinate system, for MXMY.
+C
+      COMMON /PLTCM/ JX,JY
+C
+C Force loading of the block data routine which initializes the contents
+C of the common blocks.
+C
+C     EXTERNAL UTILBD
+C
+C VP and WD hold viewport and window parameters obtained, when needed,
+C from GKS.
+C
+      DIMENSION VP(4),WD(4)
+C
+C + NOAO - block data utilbd has been rewritten as a run time initialization
+C
+      call utilbd
+C
+C - NOAO
+C Check for out-of-range values of the pen parameter.
+C
+      IF (IP.LT.0.OR.IP.GT.2) THEN
+        CALL SETER ('PLOTIF - ILLEGAL VALUE FOR IPEN',1,2)
+      END IF
+C
+C If a buffer flush is requested, jump.
+C
+      IF (IP.EQ.2) GO TO 101
+C
+C Limit the given coordinates to the legal fractional range.
+C
+      GX=AMAX1(0.,AMIN1(1.,FX))
+      GY=AMAX1(0.,AMIN1(1.,FY))
+C
+C Set JX and JY for a possible call to MXMY.
+C
+      JX=KFMX(GX)
+      JY=KFMY(GY)
+C
+C If the current move is a pen-down move, or if the last one was, bump
+C the pointer into the coordinate arrays and, if the current move is
+C a pen-up move, make a new entry in the array IF, which records the
+C positions of the pen-up moves.  Note that we never get two pen-up
+C moves in a row, which means that IF need be dimensioned only half as
+C large as QX and QY.
+C
+      IF (IP.NE.0.OR.IF(NF).NE.NQ) THEN
+        NQ=NQ+1
+        IF (IP.EQ.0) THEN
+          NF=NF+1
+          IF(NF)=NQ
+        END IF
+      END IF
+C
+C Save the coordinates of the point, in the fractional coordinate
+C system.
+C
+      QX(NQ)=GX
+      QY(NQ)=GY
+C
+C If the point-coordinate buffer is full, dump the buffers; otherwise,
+C return.
+C
+      IF (NQ.LT.IU(5)) RETURN
+C
+C Dump the buffers.  If NQ is one, there's nothing to dump.  All that's
+C there is a single pen-up move.
+C
+  101 IF (NQ.LE.1) RETURN
+C
+C Get NT, the number of the current transformation, and, if it is not
+C zero, modify the current transformation so that we can use fractional
+C coordinates (normalized device coordinates, in GKS terms).
+C
+      CALL GQCNTN (IE,NT)
+      IF (NT.NE.0) THEN
+        CALL GQNT (NT,IE,WD,VP)
+        CALL GSWN (NT,VP(1),VP(2),VP(3),VP(4))
+      END IF
+C
+C Dump out a series of polylines, each one defined by a pen-up move and
+C a series of pen-down moves.
+C
+      DO 102 I=1,NF-1
+        CALL GPL (IF(I+1)-IF(I),QX(IF(I)),QY(IF(I)))
+  102 CONTINUE
+      IF (IF(NF).NE.NQ) CALL GPL (NQ-IF(NF)+1,QX(IF(I)),QY(IF(I)))
+C
+C Put the current transformation back the way it was.
+C
+      IF (NT.NE.0) THEN
+        CALL GSWN (NT,WD(1),WD(2),WD(3),WD(4))
+      END IF
+C
+C Move the last pen position to the beginning of the buffer and pretend
+C there was a pen-up move to that position.
+C
+      QX(1)=QX(NQ)
+      QY(1)=QY(NQ)
+      NQ=1
+      IF(1)=1
+      NF=1
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE PLOTIT (IX,IY,IP)
+C
+C Move the pen to the point (IX,IY), in the metacode coordinate system.
+C If IP is zero, do a pen-up move.  If IP is one, do a pen-down move.
+C If IP is two, flush the buffer.  (For the sake of efficiency, the
+C moves are buffered; "CALL PLOTIT (0,0,0)" will also flush the buffer.)
+C
+C The variable IU(5), in the labelled common block IUTLCM, specifies
+C the size of the pen-move buffer (between 2 and 50).
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C The common block VCTSEQ contains variables implementing the buffering
+C of pen moves.
+C
+      COMMON /VCTSEQ/ NQ,QX(50),QY(50),NF,IF(25)
+C
+C In the common block PLTCM are recorded the coordinates of the last
+C pen position, in the metacode coordinate system, for MXMY.
+C
+      COMMON /PLTCM/ JX,JY
+C
+C Force loading of the block data routine which initializes the contents
+C of the common blocks.
+C
+C     EXTERNAL UTILBD
+C
+C VP and WD hold viewport and window parameters obtained, when needed,
+C from GKS.
+C
+      DIMENSION VP(4),WD(4)
+C
+C + NOAO - Blockdata utilbd has been rewritten as a run time initialization
+C
+      call utilbd
+C
+C - NOAO
+C Check for out-of-range values of the pen parameter.
+C
+      IF (IP.LT.0.OR.IP.GT.2) THEN
+        CALL SETER ('PLOTIT - ILLEGAL VALUE FOR IPEN',1,2)
+      END IF
+C
+C If a buffer flush is requested, jump.
+C
+      IF (IP.EQ.2) GO TO 101
+C
+C Limit the given coordinates to the legal metacode range.
+C
+      JX=MAX0(0,MIN0(32767,IX))
+      JY=MAX0(0,MIN0(32767,IY))
+C
+C If the current move is a pen-down move, or if the last one was, bump
+C the pointer into the coordinate arrays and, if the current move is
+C a pen-up move, make a new entry in the array IF, which records the
+C positions of the pen-up moves.  Note that we never get two pen-up
+C moves in a row, which means that IF need be dimensioned only half as
+C large as QX and QY.
+C
+      IF (IP.NE.0.OR.IF(NF).NE.NQ) THEN
+        NQ=NQ+1
+        IF (IP.EQ.0) THEN
+          NF=NF+1
+          IF(NF)=NQ
+        END IF
+      END IF
+C
+C Save the coordinates of the point, in the fractional coordinate
+C system.
+C
+      QX(NQ)=FLOAT(JX)/32767.
+      QY(NQ)=FLOAT(JY)/32767.
+C
+C If all three arguments were zero, or if the point-coordinate buffer
+C is full, dump the buffers; otherwise, return.
+C
+      IF (IX.EQ.0.AND.IY.EQ.0.AND.IP.EQ.0) GO TO 101
+      IF (NQ.LT.IU(5)) RETURN
+C
+C Dump the buffers.  If NQ is one, there's nothing to dump.  All that's
+C there is a single pen-up move.
+C
+  101 IF (NQ.LE.1) RETURN
+C
+C Get NT, the number of the current transformation, and, if it is not
+C zero, modify the current transformation so that we can use fractional
+C coordinates (normalized device coordinates, in GKS terms).
+C
+      CALL GQCNTN (IE,NT)
+      IF (NT.NE.0) THEN
+        CALL GQNT (NT,IE,WD,VP)
+        CALL GSWN (NT,VP(1),VP(2),VP(3),VP(4))
+      END IF
+C
+C Dump out a series of polylines, each one defined by a pen-up move and
+C a series of pen-down moves.
+C
+      DO 102 I=1,NF-1
+        CALL GPL (IF(I+1)-IF(I),QX(IF(I)),QY(IF(I)))
+  102 CONTINUE
+      IF (IF(NF).NE.NQ) CALL GPL (NQ-IF(NF)+1,QX(IF(I)),QY(IF(I)))
+C
+C Put the current transformation back the way it was.
+C
+      IF (NT.NE.0) THEN
+        CALL GSWN (NT,WD(1),WD(2),WD(3),WD(4))
+      END IF
+C
+C Move the last pen position to the beginning of the buffer and pretend
+C there was a pen-up move to that position.
+C
+      QX(1)=QX(NQ)
+      QY(1)=QY(NQ)
+      NQ=1
+      IF(1)=1
+      NF=1
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE POINT (PX,PY)
+C
+C Draws a point at (PX,PY), defined in the user coordinate system.
+C
+      CALL PLOTIF (CUFX(PX),CUFY(PY),0)
+      CALL PLOTIF (CUFX(PX),CUFY(PY),1)
+      RETURN
+      END
+      SUBROUTINE POINTS (PX,PY,NP,IC,IL)
+      DIMENSION PX(NP),PY(NP)
+C
+C Marks the points at positions in the user coordinate system defined
+C by ((PX(I),PY(I)),I=1,NP).  If IC is zero, each point is marked with
+C a simple point.  If IC is positive, each point is marked with the
+C single character defined by the FORTRAN-77 function CHAR(IC).  If IC
+C is negative, each point is marked with a GKS polymarker of type -IC.
+C If IL is non-zero, a curve is also drawn, connecting the points.
+C
+C Define arrays to hold converted point coordinates when it becomes
+C necessary to mark the points a few at a time.
+C
+      DIMENSION QX(10),QY(10)
+C
+C Define an array to hold the aspect source flags which may need to be
+C retrieved from GKS.
+C
+      DIMENSION LA(13)
+      CHARACTER*1 CHRTMP
+C
+C If the number of points is zero or negative, there's nothing to do.
+C
+      IF (NP.LE.0) RETURN
+C
+C Otherwise, flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C Retrieve the parameters from the last SET call.
+C
+      CALL GETSET (F1,F2,F3,F4,F5,F6,F7,F8,LL)
+C
+C If a linear-linear, non-mirror-imaged, mapping is being done and the
+C GKS polymarkers can be used, all the points can be marked with a
+C single polymarker call and joined, if requested, by a single polyline
+C call.
+C
+      IF (F5.LT.F6.AND.F7.LT.F8.AND.LL.EQ.1.AND.IC.LE.0) THEN
+        CALL GQASF (IE,LA)
+        IF (LA(4).EQ.0) THEN
+          CALL GQPMI (IE,IN)
+          CALL GSPMI (MAX0(-IC,1))
+          CALL GPM (NP,PX,PY)
+          CALL GSPMI (IN)
+        ELSE
+          CALL GQMK (IE,IN)
+          CALL GSMK (MAX0(-IC,1))
+          CALL GPM (NP,PX,PY)
+          CALL GSMK (IN)
+        END IF
+        IF (IL.NE.0.AND.NP.GE.2) CALL GPL (NP,PX,PY)
+C
+C Otherwise, things get complicated.  We have to do batches of nine
+C points at a time.  (Actually, we convert ten coordinates at a time,
+C so that the curve joining the points, if any, won't have gaps in it.)
+C
+      ELSE
+C
+C Initially, we have to reset either the polymarker index or the text
+C alignment, depending on how we're marking the points.
+C
+        IF (IC.LE.0) THEN
+          CALL GQASF (IE,LA)
+          IF (LA(4).EQ.0) THEN
+            CALL GQPMI (IE,IN)
+            CALL GSPMI (MAX0(-IC,1))
+          ELSE
+            CALL GQMK (IE,IN)
+            CALL GSMK (MAX0(-IC,1))
+          END IF
+        ELSE
+          CALL GQTXAL (IE,IH,IV)
+          CALL GSTXAL (2,3)
+        END IF
+C
+C Loop through the points by nines.
+C
+        DO 104 IP=1,NP,9
+C
+C Fill the little point coordinate arrays with up to ten values,
+C converting them from the user system to the fractional system.
+C
+          NQ=MIN0(10,NP-IP+1)
+          MQ=MIN0(9,NQ)
+          DO 102 IQ=1,NQ
+            QX(IQ)=CUFX(PX(IP+IQ-1))
+            QY(IQ)=CUFY(PY(IP+IQ-1))
+  102     CONTINUE
+C
+C Change the SET call to allow the use of fractional coordinates.
+C
+          CALL SET (F1,F2,F3,F4,F1,F2,F3,F4,1)
+C
+C Crank out either a polymarker or a set of characters.
+C
+          IF (IC.LE.0) THEN
+            CALL GPM (MQ,QX,QY)
+          ELSE
+            DO 103 IQ=1,MQ
+              CHRTMP = CHAR(IC)
+              CALL GTX (QX(IQ),QY(IQ),CHRTMP)
+  103       CONTINUE
+          END IF
+          IF (IL.NE.0.AND.NQ.GE.2) CALL GPL (NQ,QX,QY)
+C
+C Put the SET parameters back the way they were.
+C
+          CALL SET (F1,F2,F3,F4,F5,F6,F7,F8,LL)
+C
+  104   CONTINUE
+C
+C Finally, we put either the polymarker index or the text alignment
+C back the way it was.
+C
+        IF (IC.LE.0) THEN
+          IF (LA(4).EQ.0) THEN
+            CALL GSPMI (IN)
+          ELSE
+            CALL GSMK (IN)
+          END IF
+        ELSE
+          CALL GSTXAL (IH,IV)
+        END IF
+C
+      END IF
+C
+C Update the pen position.
+C
+      CALL FRSTPT (PX(NP),PY(NP))
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE PWRIT (PX,PY,CH,NC,IS,IO,IC)
+      CHARACTER*(*) CH
+C
+C PWRIT is called to draw a character string in a specified position.
+C It is just like WTSTR, but has one extra argument.  NC is the number
+C of characters to be written from the string CH.
+C
+      CALL WTSTR (PX,PY,CH(1:NC),IS,IO,IC)
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE SET (VL,VR,VB,VT,WL,WR,WB,WT,LF)
+C
+C SET allows the user to change the current values of the parameters
+C defining the mapping from the user system to the fractional system
+C (in GKS terminology, the mapping from world coordinates to normalized
+C device coordinates).
+C
+C VL, VR, VB, and VT define the viewport (in the fractional system), WL,
+C WR, WB, and WT the window (in the user system), and LF the nature of
+C the mapping, according to the following table:
+C
+C    1  -  x linear, y linear
+C    2  -  x linear, y logarithmic
+C    3  -  x logarithmic, y linear
+C    4  -  x logarithmic, y logarithmic
+C
+C Declare the common block containing the linear-log and mirror-imaging
+C flags.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C Set the GKS viewport for transformation 1.
+C
+      CALL GSVP (1,VL,VR,VB,VT)
+C
+C Set the utility state variable controlling linear-log mapping.
+C
+      LL=MAX0(1,MIN0(4,LF))
+C
+C Set the GKS window for transformation 1.
+C
+      IF (WL.LT.WR) THEN
+        MI=1
+        QL=WL
+        QR=WR
+      ELSE
+        MI=3
+        QL=WR
+        QR=WL
+      END IF
+C
+      IF (WB.LT.WT) THEN
+        QB=WB
+        QT=WT
+      ELSE
+        MI=MI+1
+        QB=WT
+        QT=WB
+      END IF
+C
+      IF (LL.EQ.1) THEN
+        CALL GSWN (1,QL,QR,QB,QT)
+      ELSE IF (LL.EQ.2) THEN
+        CALL GSWN (1,QL,QR,ALOG10(QB),ALOG10(QT))
+      ELSE IF (LL.EQ.3) THEN
+        CALL GSWN (1,ALOG10(QL),ALOG10(QR),QB,QT)
+      ELSE
+        CALL GSWN (1,ALOG10(QL),ALOG10(QR),ALOG10(QB),ALOG10(QT))
+      END IF
+C
+C Select transformation 1 as the current one.
+C
+      CALL GSELNT (1)
+C
+      RETURN
+C
+      END
+      SUBROUTINE SETI (IX,IY)
+C
+C Allows the user to set the parameters which determine the assumed size
+C of the target plotter and therefore determine how user coordinates are
+C to be mapped into plotter coordinates.
+C
+C Declare the common block containing the scaling information.
+C
+      COMMON /IUTLCM/ LL,MI,MX,MY,IU(96)
+C
+C Transfer the user's values into the common block.
+C
+      MX=MAX0(1,MIN0(15,IX))
+      MY=MAX0(1,MIN0(15,IY))
+C
+      RETURN
+C
+      END
+      SUBROUTINE SETUSV (VN,IV)
+      CHARACTER*(*) VN
+C
+C This subroutine sets the values of various utility state variables.
+C VN is the name of the variable and IV is its value.
+C
+C The labelled common block IUTLCM contains all of the utility state
+C variables.
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C Define an array in which to get the GKS aspect source flags.
+C
+      DIMENSION LF(13)
+C
+C Check for the linear-log scaling variable, which can take on these
+C values:
+C
+C     1 = X linear, Y linear
+C     2 = X linear, Y log
+C     3 = X log   , Y linear
+C     4 = X log   , Y log
+C
+      IF (VN(1:2).EQ.'LS') THEN
+        IF (IV.LT.1.OR.IV.GT.4) THEN
+          CALL SETER ('SETUSV - LOG SCALE VALUE OUT OF RANGE',2,2)
+        END IF
+        IU(1)=IV
+C
+C Check for the mirror-imaging variable, which can take on these
+C values:
+C
+C     1 = X normal  , Y normal
+C     2 = X normal  , Y reversed
+C     3 = X reversed, Y normal
+C     4 = X reversed, Y reversed
+C
+      ELSE IF (VN(1:2).EQ.'MI') THEN
+        IF (IV.LT.1.OR.IV.GT.4) THEN
+          CALL SETER ('SETUSV - MIRROR-IMAGING VALUE OUT OF RANGE',3,2)
+        END IF
+        IU(2)=IV
+C
+C Check for the scale factor setting the resolution of the plotter in
+C the x direction.
+C
+      ELSE IF (VN(1:2).EQ.'XF') THEN
+        IF (IV.LT.1.OR.IV.GT.15) THEN
+          CALL SETER ('SETUSV - X RESOLUTION OUT OF RANGE',4,2)
+        END IF
+        IU(3)=IV
+C
+C Check for the scale factor setting the resolution of the plotter in
+C the y direction.
+C
+      ELSE IF (VN(1:2).EQ.'YF') THEN
+        IF (IV.LT.1.OR.IV.GT.15) THEN
+          CALL SETER ('SETUSV - Y RESOLUTION OUT OF RANGE',5,2)
+        END IF
+        IU(4)=IV
+C
+C Check for the variable specifying the size of the pen-move buffer.
+C
+      ELSE IF (VN(1:2).EQ.'PB') THEN
+        IF (IV.LT.2.OR.IV.GT.50) THEN
+          CALL SETER ('SETUSV - PEN-MOVE BUFFER SIZE OUT OF RANGE',6,2)
+        END IF
+        CALL PLOTIF (0.,0.,2)
+        IU(5)=IV
+C
+C Check for a metacode unit number.
+C
+      ELSE IF (VN(1:2).EQ.'MU') THEN
+        IF (IV.LE.0) THEN
+          CALL SETER ('SETUSV - METACODE UNIT NUMBER ILLEGAL',7,2)
+        END IF
+C
+C For the moment (1/11/85), we have to deactivate and close the old
+C workstation and open and activate a new one.  This does allow the
+C user to break up his metacode output.  It does not necessarily allow
+C for the resumption of output to a previously-written metacode file.
+C
+        CALL GDAWK (IU(6))
+        CALL GCLWK (IU(6))
+        IU(6)=IV
+        CALL GOPWK (IU(6),2,1)
+        CALL GACWK (IU(6))
+C
+C If, in the future, it becomes possible to have more than one metacode
+C workstation open at once, the following code can be used instead.
+C
+C       CALL GDAWK (IU(6))
+C       IU(6)=IV
+C       CALL GQOPWK (0,IE,NO,ID)
+C       IF (NO.NE.0) THEN
+C         DO 101 I=1,NO
+C           CALL GQOPWK (I,IE,NO,ID)
+C           IF (ID.EQ.IU(6)) GO TO 102
+C 101     CONTINUE
+C       END IF
+C       CALL GOPWK (IU(6),2,1)
+C 102   CALL GAWK (IU(6))
+C
+C Check for one of the variables setting color and intensity.
+C
+      ELSE IF (VN(1:2).EQ.'IR') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL VALUE OF RED INTENSITY',8,2)
+        END IF
+        IU(7)=IV
+C
+      ELSE IF (VN(1:2).EQ.'IG') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL VALUE OF GREEN INTENSITY',9,2)
+        END IF
+        IU(8)=IV
+C
+      ELSE IF (VN(1:2).EQ.'IB') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL VALUE OF BLUE INTENSITY',10,2)
+        END IF
+        IU(9)=IV
+C
+      ELSE IF (VN(1:2).EQ.'IN') THEN
+        IF (IV.LT.0.OR.IV.GT.10000) THEN
+          CALL SETER ('SETUSV - ILLEGAL VALUE OF INTENSITY',11,2)
+        END IF
+        IU(10)=IV
+C
+C Assign the intensity-controlling variables to local variables with
+C simple, meaningful names.
+C
+        IR=IU(7)
+        IG=IU(8)
+        IB=IU(9)
+        IN=IU(10)
+        II=IU(11)
+        IM=IU(12)
+C
+C Compute the floating-point red, green, and blue intensities.
+C
+        FR=FLOAT(IR)/FLOAT(MAX0(IR,IG,IB,1))*FLOAT(IN)/10000.
+        FG=FLOAT(IG)/FLOAT(MAX0(IR,IG,IB,1))*FLOAT(IN)/10000.
+        FB=FLOAT(IB)/FLOAT(MAX0(IR,IG,IB,1))*FLOAT(IN)/10000.
+C
+C Dump the pen-move buffer before changing anything.
+C
+        CALL PLOTIF (0.,0.,2)
+C
+C Set the aspect source flags for all the color indices to "individual".
+C
+        CALL GQASF (IE,LF)
+        LF( 3)=1
+        LF( 6)=1
+        LF(10)=1
+        LF(13)=1
+        CALL GSASF (LF)
+C
+C Pick a new color index and use it for polylines, polymarkers, text,
+C and areas.
+C
+        II=MOD(II,IM)+1
+        IU(11)=II
+        CALL GSPLCI (II)
+        CALL GSPMCI (II)
+        CALL GSTXCI (II)
+        CALL GSFACI (II)
+C
+C Now, redefine the color for that color index on each open workstation.
+C
+        CALL GQOPWK (0,IE,NO,ID)
+C
+        DO 103 I=1,NO
+          CALL GQOPWK (I,IE,NO,ID)
+          CALL GSCR (ID,II,FR,FG,FB)
+  103   CONTINUE
+C
+C Check for variable resetting the color index.
+C
+      ELSE IF (VN(1:2).EQ.'II') THEN
+        IF (IV.LT.1.OR.IV.GT.IU(12)) THEN
+          CALL SETER ('SETUSV - ILLEGAL COLOR INDEX',12,2)
+        END IF
+        IU(11)=IV
+C
+        CALL PLOTIF (0.,0.,2)
+C
+        CALL GQASF (IE,LF)
+        LF( 3)=1
+        LF( 6)=1
+        LF(10)=1
+        LF(13)=1
+        CALL GSASF (LF)
+C
+        CALL GSPLCI (IV)
+        CALL GSPMCI (IV)
+        CALL GSTXCI (IV)
+        CALL GSFACI (IV)
+C
+C Check for the variable limiting the values of color index used.
+C
+      ELSE IF (VN(1:2).EQ.'IM') THEN
+        IF (IV.LT.1) THEN
+          CALL SETER ('SETUSV - ILLEGAL MAXIMUM COLOR INDEX',13,2)
+        END IF
+        IU(12)=IV
+C
+C Check for the variable setting the current line width scale factor.
+C
+      ELSE IF (VN(1:2).EQ.'LW') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL LINE WIDTH SCALE FACTOR',14,2)
+        END IF
+        IU(13)=IV
+C
+C Dump the pen-move buffer before changing anything.
+C
+        CALL PLOTIF (0.,0.,2)
+C
+C Set the aspect source flag for linewidth scale factor to "individual".
+C
+        CALL GQASF (IE,LF)
+        LF(2)=1
+        CALL GSASF (LF)
+C
+C Redefine the line width scale factor.
+C
+        CALL GSLWSC (FLOAT(IV)/1000.)
+C
+C Check for the variable setting the current marker size scale factor.
+C
+      ELSE IF (VN(1:2).EQ.'MS') THEN
+        IF (IV.LT.0) THEN
+          CALL SETER ('SETUSV - ILLEGAL MARKER SIZE SCALE FACTOR',15,2)
+        END IF
+        IU(14)=IV
+C
+C Set aspect source flag for marker size scale factor to "individual".
+C
+        CALL GQASF (IE,LF)
+        LF(5)=1
+        CALL GSASF (LF)
+C
+C Redefine the marker size scale factor.
+C
+        CALL GSMKSC (FLOAT(IV)/1000.)
+C
+C Otherwise, the variable name is unknown.
+C
+      ELSE
+        CALL SETER ('SETUSV - UNKNOWN VARIABLE NAME IN CALL',1,2)
+C
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE VECTOR (PX,PY)
+C
+C Draw a vector (line segment) from the current pen position to the new
+C pen position (PX,PY), in the user coordinate system, and then make
+C (PX,PY) the current pen position.
+C
+      CALL PLOTIF (CUFX(PX),CUFY(PY),1)
+      RETURN
+      END
+      SUBROUTINE WTSTR (PX,PY,CH,IS,IO,IC)
+C
+C WTSTR is called to draw a character string in a specified position.
+C
+C PX and PY specify, in user coordinates, the position of a point
+C relative to which a character string is to be positioned.
+C
+C CH is the character string to be written.
+C
+C IS is the desired size of the characters to be used, stated as a
+C character width in the plotter coordinate system.  The values 0, 1,
+C 2, and 3 mean 8, 12, 16, and 24, respectively.
+C
+C IO is the desired orientation angle, in degrees counterclockwise from
+C a horizontal vector pointing to the right.
+C
+C IC specifies the desired type of centering.  A negative value puts
+C (PX,PY) in the center of the left end of the character string, a zero
+C puts (PX,PY) in the center of the whole string, and a positive value
+C puts (PX,PY) in the center of the right end of the character string.
+C
+      CHARACTER*(*) CH
+C
+C Define arrays in which to save the current viewport and window.
+C
+      DIMENSION VP(4),WD(4)
+C
+C Flush the pen-move buffer.
+C
+      CALL PLOTIF (0.,0.,2)
+C
+C Compute the coordinates of (PX,PY) in the fractional coordinate
+C system (normalized device coordinates).
+C
+      XN=CUFX(PX)
+      YN=CUFY(PY)
+C
+C Save the current window and, if necessary, redefine it so that we can
+C use normalized device coordinates.
+C
+      CALL GQCNTN (IE,NT)
+      IF (NT.NE.0) THEN
+        CALL GQNT (NT,IE,WD,VP)
+        CALL GSWN (NT,VP(1),VP(2),VP(3),VP(4))
+      END IF
+C
+C Save current character height, text path, character up vector, and
+C text alignment.
+C
+      CALL GQCHH (IE,OS)
+      CALL GQTXP (IE,IP)
+      CALL GQCHUP (IE,UX,UY)
+      CALL GQTXAL (IE,IX,IY)
+C
+C Define the character height.  (The final scale factor is derived from
+C the default font.)
+C
+      CALL GETUSV ('YF',MY)
+      YS=FLOAT(2**MY)
+      IF (IS.GE.0.AND.IS.LE.3) THEN
+        CS=FLOAT(8+4*IS+4*(IS/3))/YS
+      ELSE
+        CS=AMIN1(FLOAT(IS),YS)/YS
+      ENDIF
+C
+      CS=CS*25.5/27.
+C
+C + NOAO - make character size readable with IRAF font
+      cs = cs * 2.0
+C
+C - NOAO
+
+      CALL GSCHH(CS)
+C
+C Define the text path.
+C
+      CALL GSTXP (0)
+C
+C Define the character up vector.
+C
+      JO=MOD(IO,360)
+      IF (JO.EQ.0) THEN
+        CALL GSCHUP (0.,1.)
+      ELSE IF (JO.EQ.90) THEN
+        CALL GSCHUP (-1.,0.)
+      ELSE IF (JO.EQ.180) THEN
+        CALL GSCHUP (0.,-1.)
+      ELSE IF (JO.EQ.270) THEN
+        CALL GSCHUP (1.,0.)
+      ELSE IF (JO.GT.0.AND.JO.LT.180) THEN
+        CALL GSCHUP (-1.,1./TAN(FLOAT(JO)*3.1415926/180.))
+      ELSE
+        CALL GSCHUP (1.,-1./TAN(FLOAT(JO)*3.1415926/180.))
+      ENDIF
+C
+C Define the text alignment.
+C
+      CALL GSTXAL (IC+2,3)
+C
+C Plot the characters.
+C
+      CALL GTX (XN,YN,CH)
+C
+C Restore the original text attributes.
+C
+      CALL GSCHH (OS)
+      CALL GSTXP (IP)
+      CALL GSCHUP (UX,UY)
+      CALL GSTXAL (IX,IY)
+C
+C Restore the window definition.
+C
+      IF (NT.NE.0) THEN
+        CALL GSWN (NT,WD(1),WD(2),WD(3),WD(4))
+      END IF
+C
+C Update the pen position.
+C
+      CALL FRSTPT (PX,PY)
+C
+C Done.
+C
+      RETURN
+C
+      END
+c + NOAO - blockdata utilbd changed to run time initialization
+      subroutine utilbd
+c     BLOCKDATA UTILBD
+C
+      logical first
+C The common block IUTLCM contains integer utility variables which are
+C user-settable by the routine SETUSV and user-retrievable by the
+C routine GETUSV.
+C
+      COMMON /IUTLCM/ IU(100)
+C
+C The common block VCTSEQ contains variables realizing the buffering
+C scheme used by PLOTIT/F for pen moves.  The dimension of QX and QY must
+C be an even number greater than or equal to the value of IU(5).  The
+C dimension of IF must be half that of QX and QY.
+C
+      COMMON /VCTSEQ/ NQ,QX(50),QY(50),NF,IF(25)
+C
+C In the common block PLTCM are recorded the coordinates of the last
+C point to which a pen move was requested by a call to PLOTIT/F.
+C
+      COMMON /PLTCM/ JX,JY
+C
+C IU(1) contains the log scaling parameter, which may take on the
+C following possible values:
+C
+C     1 = linear-linear
+C     2 = log-linear
+C     3 = linear-log
+C     4 = log-log
+C
+c     DATA IU(1) / 1 /
+      IU(1) = 1 
+C
+C IU(2) specifies the mirror-imaging of the x and y axes, as follows:
+C
+C     1 = x normal, y normal
+C     2 = x normal, y reversed
+C     3 = x reversed, y normal
+C     4 = x reversed, y reversed
+C
+c +NOAO - logical parameter first inserted to avoid clobbering initialization
+      data first /.true./
+      if (.not. first) return
+        first = .false.
+c -NOAO
+c     DATA IU(2) / 1 /
+      IU(2) = 1 
+C
+C IU(3) specifies the assumed resolution of the plotter in the x
+C direction.  Plotter x coordinates are assumed to lie between 1 and
+C 2**IU(3), inclusive.
+C
+c     DATA IU(3) / 10 /
+      IU(3) = 10 
+C
+C IU(4) specifies the assumed resolution of the plotter in the y
+C direction.  Plotter y coordinates are assumed to lie between 1 and
+C 2**IU(4), inclusive.
+C
+c     DATA IU(4) / 10 /
+      IU(4) = 10 
+C
+C IU(5) specifies the size of the buffers used by PLOTIT/F.  Its value
+C must be greater than or equal to 2 and not greater than the dimension
+C of the variables QX and QY.  Using the value 2 effectively turns off
+C the buffering.
+C
+c     DATA IU(5) / 50 /
+      IU(5) = 50
+C
+C IU(6) specifies the current metacode unit, which is machine-dependent.
+C At NCAR, the value "1" currently (1/11/85) causes metacode to be
+C written on the file "GMETA".  Eventually, it will cause output to be
+C written on unit number 1.  At that point, the value, on the Cray at
+C least, should be changed to "4H$PLT", so that output will come out on
+C the old familiar dataset.
+C
+c     DATA IU(6) / 1 /
+      IU(6) = 1 
+C
+C IU(7), IU(8), IU(9), and IU(10) specify color and intensity, in the
+C following way (letting IR=IU(7), IG=IU(8), IB=IU(9), and IN=IU(10)):
+C
+C     The red intensity is IR/(IR+IG+IB)*IN/10000.
+C     The green intensity is IG/(IR+IG+IB)*IN/10000.
+C     The blue intensity is IB/(IR+IG+IB)*IN/10000.
+C
+C The GKS calls to set these intensities are executed in response to a
+C "CALL SETUSV ('IN',IN)", using the existing values of IR, IG, and IB.
+C Thus, to completely determine the color and the intensity, the user
+C must execute four calls, as follows:
+C
+C     CALL SETUSV ('IR',IR)
+C     CALL SETUSV ('IG',IG)
+C     CALL SETUSV ('IB',IB)
+C     CALL SETUSV ('IN',IN)
+C
+C The default values create a white line at .8 x maximum intensity.
+C
+c     DATA IU(7) / 1 /
+c     DATA IU(8) / 1 /
+c     DATA IU(9) / 1 /
+      IU(7) = 1
+      IU(8) = 1 
+      IU(9) = 1
+C
+c     DATA IU(10) / 8000 /
+      IU(10) = 8000 
+C
+C IU(11) and IU(12) specify, respectively, the last color index used
+C and the maximum number of color indices it is permissible to use.
+C
+c     DATA IU(11) / 0 /
+c     DATA IU(12) / 1 /
+      IU(11) = 0 
+      IU(12) = 1 
+C
+C IU(13)/1000 specifies the current line width scale factor.
+C
+c     DATA IU(13) / 1000 /
+      IU(13) = 1000
+C
+C IU(14)/1000 specifies the current marker size scale factor.
+C
+c     DATA IU(14) / 1000 /
+      IU(14) = 1000 
+C
+C IU(15) through IU(100) are currently undefined.
+C
+C Initialization for the routine PLOTIT/F:  For values of I between 1 and
+C NQ, (QX(I),QY(I)) is a point to which a pen move has been requested
+C by a past call to PLOTIT/F.  The coordinates are stated in the fractional
+C coordinate system.  For values of I between 1 and NF, IF(I) is the
+C index, in QX and QY, of the coordinates of a point to which a pen-up
+C move was requested.  NQ and NF are never allowed to be less than one.
+C
+c     DATA NQ,QX(1),QY(1),NF,IF(1) / 1 , 0. , 0. , 1 , 1 /
+      NQ    = 1
+      QX(1) = 0. 
+      QY(1) = 0. 
+      NF    = 1 
+      IF(1) = 1 
+C
+C JX and JY are the coordinates, in the metacode system, of the last
+C point to which a pen move was requested by a call to PLOTIT/F.
+C
+c     DATA JX,JY / 0 , 0 /
+      JX = 0 
+      JY = 0 
+C
+c -NOAO
+      return
+c
+      entry initut
+      first = .true.
+      END
diff --git a/sys/gio/ncarutil/sysint/support.f b/sys/gio/ncarutil/sysint/support.f
new file mode 100644
index 00000000..84d11ba5
--- /dev/null
+++ b/sys/gio/ncarutil/sysint/support.f
@@ -0,0 +1,581 @@
+      SUBROUTINE ENCD (VALU,ASH,IOUT,NC,IOFFD)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C
+C
+C ON INPUT     VALU      FLOATING POINT NUMBER FROM WHICH THE LABEL IS
+C                        TO BE CREATED.
+C              ASH       SEE IOFFD.
+C              IOFFD     IF IOFFD .EQ. 0, A LABEL WHICH REFLECTS THE
+C                             MAGNITUDE OF VALU IS TO BE CREATED.
+C                             .1 .LE. ABS(VALU) .LE. 99999.49999...
+C                             OR VALUE .EQ. 0.0.  THE LABEL CREATED
+C                             SHOULD HAVE 3 TO 5 CHARACTERS DEPENDING
+C                             ON THE MAGNITUDE OF VALU.  SEE IOUT.
+C                        IF IOFFD .NE. 0, A LABEL WHICH DOES NOT REFLECT
+C                             THE MAGNITUDE OF VALU IS TO BE CREATED.
+C                             ASH IS USED AS THE NORMALIZATION FACTOR.
+C                             1. .LE. ASH*ABS(VALU) .LT. 1000. OR
+C                             VALU .EQ. 0.0.  THE LABEL CREATED SHOULD
+C                             HAVE 1 TO 3 CHARACTERS, DEPENDING ON THE
+C                             MAGNITUDE OF ASH*VALU.  SEE IOUT.
+C ON OUTPUT    IOUT      CONTAINS THE LABEL CREATED.  IT SHOULD HAVE NO
+C                        LEADING BLANKS.  SEE NC.
+C              NC        THE NUMBERS IN THE LABEL IN IOUT.  SHOULD BE
+C                        1 TO 5.
+C
+      SAVE
+      CHARACTER*11 IFMT
+      CHARACTER*(*) IOUT
+C
+C IFMT MUST HOLD 11 CHARACTERS
+C
+      VAL = VALU
+      IF (IOFFD .NE. 0) GO TO 103
+      IF (VAL) 101,104,101
+  101 LOG = IFIX((ALOG10(ABS(VAL))+.00001)+5000.)-5000
+      V = VAL
+      NS = MAX0(4,MIN0(6,LOG+2))
+      ND = MIN0(3,MAX0(0,2-LOG))
+c     IF (VAL.LT.0)  NS = NS + 1
+c + NOAO - replacing ftn i/o for iraf implementation
+c 102 WRITE (IFMT,'(A2,I2,A1,I1,A1)') '(F',NS,'.',ND,')'
+  102 continue
+      ifmt(1:6) = '(f . )'
+      ifmt(3:3) = char (ns + ichar ('0'))
+      ifmt(5:5) = char (nd + ichar ('0'))
+c     WRITE (IOUT,IFMT) V
+      call encode (ns, ifmt, iout, v)
+      NC = NS
+c + NOAO
+c The following statement was making 5 digit labels (+4800) come out
+c truncated (+480) and it has been commented out.
+c     IF (LOG.GE.3)  NC = NC - 1
+c - NOAO
+      RETURN
+  103 NS = 4
+      IF (VAL.LT.0.)  NS=5
+      IF (VAL.EQ.0.)  NS=2
+      ND = 0
+      V = VAL*ASH
+      LOG = 100
+      GO TO 102
+  104 iout(1:3) = '0.0'
+      nc = 3
+c 104 NS = 3
+c     ND = 1
+c     LOG = -100
+c     V = 0.
+c     GO TO 102
+C
+C1001 FORMAT('(F',I2,'.',I1,',1H',A1,')')
+C
+      END
+C
+      SUBROUTINE ENCODE (NCHARS, FTNFMT, FTNOUT, RVAL)
+
+      INTEGER SZFMT, SZBUF
+      PARAMETER (SZFMT=11)
+      PARAMETER (SZBUF=15)
+
+      CHARACTER*(*) FTNFMT
+      CHARACTER*(*) FTNOUT
+      INTEGER*2 SPPFMT(SZFMT), SPPOUT(SZBUF)
+
+C UNPACK THE FORTRAN CHARACTER STRING, CALL FENCD TO ACTUALLY ENCODE THE
+C OUTPUT STRING, THEN PACK THE OUTPUT STRING INTO A FORTRAN STRING FOR RETURN
+C
+      CALL F77UPK (FTNFMT, SPPFMT, SZFMT)
+      CALL FENCD (NCHARS, SPPFMT, SPPOUT, RVAL)
+      CALL F77PAK (SPPOUT, FTNOUT, NCHARS)
+
+      END
+C
+C PACKAGE ERPRT77        DESCRIPTION OF INDIVIDUAL USER ENTRIES
+C                        FOLLOWS THIS PACKAGE DESCRIPTION.
+C
+C LATEST REVISION        FEBRUARY 1985
+C
+C PURPOSE                TO PROVIDE A PORTABLE, FORTRAN 77 ERROR
+C                        HANDLING PACKAGE.
+C
+C USAGE                  THESE ROUTINES ARE INTENDED TO BE USED IN
+C                        THE SAME MANNER AS THEIR SIMILARLY NAMED
+C                        COUNTERPARTS ON THE PORT LIBRARY.  EXCEPT
+C                        FOR ROUTINE SETER, THE CALLING SEQUENCES
+C                        OF THESE ROUTINES ARE THE SAME AS FOR
+C                        THEIR PORT COUNTERPARTS.
+C                        ERPRT77 ENTRY          PORT ENTRY
+C                        -------------          ----------
+C                        ENTSR                  ENTSRC
+C                        RETSR                  RETSRC
+C                        NERRO                  NERROR
+C                        ERROF                  ERROFF
+C                        SETER                  SETERR
+C                        EPRIN                  EPRINT
+C                        FDUM                   FDUMP
+C
+C I/O                    SOME OF THE ROUTINES PRINT ERROR MESSAGES.
+C
+C PRECISION              NOT APPLICABLE
+C
+C REQUIRED LIBRARY       MACHCR, WHICH IS LOADED BY DEFAULT ON
+C FILES                  NCAR'S CRAY MACHINES.
+C
+C LANGUAGE               FORTRAN 77
+C
+C HISTORY                DEVELOPED OCTOBER, 1984 AT NCAR IN BOULDER,
+C                        COLORADO BY FRED CLARE OF THE SCIENTIFIC
+C                        COMPUTING DIVISION BY ADAPTING THE NON-
+C                        PROPRIETARY, ERROR HANDLING ROUTINES
+C                        FROM THE PORT LIBRARY OF BELL LABS.
+C
+C PORTABILITY            FULLY PORTABLE
+C
+C REFERENCES             SEE THE MANUAL
+C                          PORT MATHEMATICAL SUBROUTINE LIBRARY
+C                        ESPECIALLY "ERROR HANDLING" IN SECTION 2
+C                        OF THE INTRODUCTION, AND THE VARIOUS
+C                        SUBROUTINE DESCRIPTIONS.
+C ******************************************************************
+C
+C SUBBROUTINE ENTSR(IROLD,IRNEW)
+C
+C PURPOSE               SAVES THE CURRENT RECOVERY MODE STATUS AND
+C                       SETS A NEW ONE.  IT ALSO CHECKS THE ERROR
+C                       STATE, AND IF THERE IS AN ACTIVE ERROR
+C                       STATE A MESSAGE IS PRINTED.
+C
+C USAGE                 CALL ENTSR(IROLD,IRNEW)
+C
+C ARGUMENTS
+C
+C ON INPUT               IRNEW
+C                          VALUE SPECIFIED BY USER FOR ERROR
+C                          RECOVERY
+C                          = 0 LEAVES RECOVERY UNCHANGED
+C                          = 1 GIVES  RECOVERY
+C                          = 2 TURNS  RECOVERY OFF
+C
+C ON OUTPUT              IROLD
+C                          RECEIVES THE CURRENT VALUE OF THE ERROR
+C                          RECOVERY MODE
+C
+C SPECIAL CONDITIONS     IF THERE IS AN ACTIVE ERROR STATE, THE
+C                        MESSAGE IS PRINTED AND EXECUTION STOPS.
+C
+C                        ERROR STATES -
+C                        1 - ILLEGAL VALUE OF IRNEW.
+C                        2 - CALLED WHILE IN AN ERROR STATE.
+C ******************************************************************
+C
+C SUBROUTINE RETSR(IROLD)
+C
+C PURPOSE                SETS THE RECOVERY MODE TO THE STATUS GIVEN
+C                        BY THE INPUT ARGUMENT.  A TEST IS THEN MADE
+C                        TO SEE IF A CURRENT ERROR STATE EXISTS WHICH
+C                        IS UNRECOVERABLE; IF SO, RETSR PRINTS AN
+C                        ERROR MESSAGE AND TERMINATES THE RUN.
+C
+C                        BY CONVENTION, RETSR IS USED UPON EXIT
+C                        FROM A SUBROUTINE TO RESTORE THE PREVIOUS
+C                        RECOVERY MODE STATUS STORED BY ROUTINE
+C                        ENTSR IN IROLD.
+C
+C USAGE                  CALL RETSR(IROLD)
+C
+C ARGUMENTS
+C
+C ON INPUT               IROLD
+C                          = 1 SETS FOR RECOVERY
+C                          = 2 SETS FOR NONRECOVERY
+C
+C ON OUTPUT              NONE
+C
+C SPECIAL CONDITIONS     IF THE CURRENT ERROR BECOMES UNRECOVERABLE,
+C                        THE MESSAGE IS PRINTED AND EXECUTION STOPS.
+C
+C                        ERROR STATES -
+C                          1 - ILLEGAL VALUE OF IROLD.
+C ******************************************************************
+C
+C INTEGER FUNCTION NERRO(NERR)
+C
+C PURPOSE                PROVIDES THE CURRENT ERROR NUMBER (IF ANY)
+C                        OR ZERO IF THE PROGRAM IS NOT IN THE
+C                        ERROR STATE.
+C
+C USAGE                  N = NERRO(NERR)
+C
+C ARGUMENTS
+C
+C ON INPUT               NONE
+C
+C ON OUTPUT              NERR
+C                          CURRENT VALUE OF THE ERROR NUMBER
+C ******************************************************************
+C SUBROUTINE ERROF
+C
+C PURPOSE                TURNS OFF THE ERROR STATE BY SETTING THE
+C                        ERROR NUMBER TO ZERO
+C
+C USAGE                  CALL ERROF
+C
+C ARGUMENTS
+C
+C ON INPUT               NONE
+C
+C ON OUTPUT              NONE
+C ******************************************************************
+C
+C SUBROUTINE SETER(MESSG,NERR,IOPT)
+C
+C PURPOSE                SETS THE ERROR INDICATOR AND, DEPENDING
+C                        ON THE OPTIONS STATED BELOW, PRINTS A
+C                        MESSAGE AND PROVIDES A DUMP.
+C
+C
+C USAGE                  CALL SETER(MESSG,NERR,IOPT)
+C
+C ARGUMENTS
+C
+C ON INPUT               MESSG
+C                          HOLLERITH STRING CONTAINING THE MESSAGE
+C                          ASSOCIATED WITH THE ERROR
+C
+C                        NERR
+C                          THE NUMBER TO ASSIGN TO THE ERROR
+C
+C                        IOPT
+C                          = 1 FOR A RECOVERABLE ERROR
+C                          = 2 FOR A FATAL ERROR
+C
+C                         IF IOPT = 1 AND THE USER IS IN ERROR
+C                         RECOVERY MODE, SETERR SIMPLY REMEMBERS
+C                         THE ERROR MESSAGE, SETS THE ERROR NUMBER
+C                         TO NERR, AND RETURNS.
+C
+C                         IF IOPT = 1 AND THE USER IS NOT IN ERROR
+C                         RECOVERY MODE, SETERR PRINTS THE ERROR
+C                         MESSAGE AND TERMINATES THE RUN.
+C
+C                         IF IOPT = 2 SETERR ALWAYS PRINTS THE ERROR
+C                         MESSAGE, CALLS FDUM, AND TERMINATES THE RUN.
+C
+C ON OUTPUT              NONE
+C
+C SPECIAL CONDITIONS     CANNOT ASSIGN NERR = 0, AND CANNOT SET IOPT
+C                        TO ANY VALUE OTHER THAN 1 OR 2.
+C ******************************************************************
+C
+C  SUBROUTINE EPRIN
+C
+C PURPOSE                PRINTS THE CURRENT ERROR MESSAGE IF THE
+C                        PROGRAM IS IN THE ERROR STATE; OTHERWISE
+C                        NOTHING IS PRINTED.
+C
+C USAGE                  CALL EPRIN
+C
+C ARGUMENTS
+C
+C ON INPUT               NONE
+C
+C ON OUTPUT              NONE
+C ******************************************************************
+C
+C SUBROUTINE FDUM
+C
+C PURPOSE                TO PROVIDE A DUMMY ROUTINE WHICH SERVES
+C                        AS A PLACEHOLDER FOR A SYMBOLIC DUMP
+C                        ROUTINE, SHOULD IMPLEMENTORS DECIDE TO
+C                        PROVIDE SUCH A ROUTINE.
+C
+C USAGE                  CALL EPRIN
+C
+C ARGUMENTS
+C
+C ON INPUT               NONE
+C
+C ON OUTPUT              NONE
+C ******************************************************************
+      SUBROUTINE ENTSR(IROLD,IRNEW)
+C
+      LOGICAL TEMP
+      IF (IRNEW.LT.0 .OR. IRNEW.GT.2)
+     1   CALL SETER(' ENTSR - ILLEGAL VALUE OF IRNEW',1,2)
+C
+      TEMP = IRNEW.NE.0
+      IROLD = I8SAV(2,IRNEW,TEMP)
+C
+C  IF HAVE AN ERROR STATE, STOP EXECUTION.
+C
+      IF (I8SAV(1,0,.FALSE.) .NE. 0) CALL SETER
+     1   (' ENTSR - CALLED WHILE IN AN ERROR STATE',2,2)
+C
+      RETURN
+C
+      END
+      SUBROUTINE RETSR(IROLD)
+C
+      IF (IROLD.LT.1 .OR. IROLD.GT.2)
+     1  CALL SETER(' RETSR - ILLEGAL VALUE OF IROLD',1,2)
+C
+      ITEMP=I8SAV(2,IROLD,.TRUE.)
+C
+C  IF THE CURRENT ERROR IS NOW UNRECOVERABLE, PRINT AND STOP.
+C
+      IF (IROLD.EQ.1 .OR. I8SAV(1,0,.FALSE.).EQ.0) RETURN
+C
+        CALL EPRIN
+        CALL FDUM
+c       STOP
+C
+      END
+      INTEGER FUNCTION NERRO(NERR)
+C
+      NERRO=I8SAV(1,0,.FALSE.)
+      NERR=NERRO
+      RETURN
+C
+      END
+      SUBROUTINE ERROF
+C
+      I=I8SAV(1,0,.TRUE.)
+      RETURN
+C
+      END
+      SUBROUTINE SETER(MESSG,NERR,IOPT)
+C
+      CHARACTER*(*) MESSG
+      COMMON /UERRF/IERF
+C
+C  THE UNIT FOR ERROR MESSAGES IS I1MACH(4)
+C
+c + NOAO -  blockdata uerrbd changed to runtime initialization subroutine
+C     FORCE LOAD OF BLOCKDATA
+C
+c     EXTERNAL UERRBD
+      call uerrbd
+c - NOAO
+      IF (IERF .EQ. 0) THEN
+      IERF = I1MACH(4)
+      ENDIF
+C
+      NMESSG = LEN(MESSG)
+      IF (NMESSG.GE.1) GO TO 10
+C
+C  A MESSAGE OF NON-POSITIVE LENGTH IS FATAL.
+C
+c + NOAO -  FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9000)
+c9000   FORMAT(' ERROR 1 IN SETER - MESSAGE LENGTH NOT POSITIVE.')
+        call uliber (1,' SETER - MESSAGE LENGTH NOT POSITIVE.', 80) 
+c - NOAO
+        GO TO 60
+C
+   10 CONTINUE
+      IF (NERR.NE.0) GO TO 20
+C
+C  CANNOT TURN THE ERROR STATE OFF USING SETER.
+C
+c + NOAO -  FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9001)
+c9001   FORMAT(' ERROR 2 IN SETER - CANNOT HAVE NERR=0'/
+c    1         ' THE CURRENT ERROR MESSAGE FOLLOWS'/)
+        call uliber (2, ' SETER - CANNOT HAVE NERR=0', 80)
+        call uliber (2, ' SETER - THE CURRENT ERROR MSG FOLLOWS', 80) 
+c - NOAO
+        CALL E9RIN(MESSG,NERR,.TRUE.)
+        ITEMP=I8SAV(1,1,.TRUE.)
+        GO TO 50
+C
+C  SET LERROR AND TEST FOR A PREVIOUS UNRECOVERED ERROR.
+C
+ 20   CONTINUE
+      IF (I8SAV(1,NERR,.TRUE.).EQ.0) GO TO 30
+C
+c + NOAO - FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9002)
+c9002   FORMAT(' ERROR    3 IN SETER -',
+c    1         ' AN UNRECOVERED ERROR FOLLOWED BY ANOTHER ERROR.'//
+c    2         ' THE PREVIOUS AND CURRENT ERROR MESSAGES FOLLOW.'///)
+        call uliber (3,' SETER - A SECOND UNRECOV ERROR SEEN.', 80)
+        call uliber (3,' SETER - THE ERROR MESSAGES FOLLOW.', 80)
+c - NOAO
+        CALL EPRIN
+        CALL E9RIN(MESSG,NERR,.TRUE.)
+        GO TO 50
+C
+C  SAVE THIS MESSAGE IN CASE IT IS NOT RECOVERED FROM PROPERLY.
+C
+ 30   CALL E9RIN(MESSG,NERR,.TRUE.)
+C
+      IF (IOPT.EQ.1 .OR. IOPT.EQ.2) GO TO 40
+C
+C  MUST HAVE IOPT = 1 OR 2.
+C
+c + NOAO -  FTN writes rewritten as calls to uliber for IRAF
+c     WRITE(IERF,9003)
+c9003   FORMAT(' ERROR    4 IN SETER - BAD VALUE FOR IOPT'//
+c    1         ' THE CURRENT ERROR MESSAGE FOLLOWS'///)
+        call uliber (4, ' SETER - BAD VALUE FOR IOPT', 80)
+        call uliber (4, ' SETER - THE CURRENT ERR MSG FOLLOWS', 80)
+c - NOAO 
+        GO TO 50
+C
+C  TEST FOR RECOVERY.
+C
+ 40   CONTINUE
+      IF (IOPT.EQ.2) GO TO 50
+C
+      IF (I8SAV(2,0,.FALSE.).EQ.1) RETURN
+C
+      CALL EPRIN
+      CALL FDUM
+c     STOP
+C
+ 50   CALL EPRIN
+ 60   CALL FDUM
+c     STOP
+C
+      END
+      SUBROUTINE EPRIN
+C
+      CHARACTER*1 MESSG
+C
+      CALL E9RIN(MESSG,1,.FALSE.)
+      RETURN
+C
+      END
+      SUBROUTINE E9RIN(MESSG,NERR,SAVE)
+C
+C  THIS ROUTINE STORES THE CURRENT ERROR MESSAGE OR PRINTS THE OLD ONE,
+C  IF ANY, DEPENDING ON WHETHER OR NOT SAVE = .TRUE. .
+C
+      CHARACTER*(*) MESSG
+      CHARACTER*113 MESSGP
+      INTEGER NERRP
+      LOGICAL SAVE
+      COMMON /UERRF/IERF
+      SAVE MESSGP,NERRP
+C
+C  MESSGP STORES THE FIRST 113 CHARACTERS OF THE PREVIOUS MESSAGE
+C
+C
+C  START WITH NO PREVIOUS MESSAGE.
+C
+      DATA MESSGP/'1'/
+      DATA NERRP/0/
+C
+      IF (.NOT.SAVE) GO TO 20
+C
+C  SAVE THE MESSAGE.
+C
+        NERRP=NERR
+        MESSGP = MESSG
+C
+        GO TO 30
+C
+ 20   IF (I8SAV(1,0,.FALSE.).EQ.0) GO TO 30
+C
+C  PRINT THE MESSAGE.
+C
+c + NOAO -  FTN write rewritten as call to uliber
+c     WRITE(IERF,9000) NERRP,MESSGP
+c9000 FORMAT(' ERROR ',I4,' IN ',A113)
+      call uliber (nerrp, messgp, 113)
+C
+ 30   RETURN
+C
+      END
+      INTEGER FUNCTION I8SAV(ISW,IVALUE,SET)
+C
+C  IF (ISW = 1) I8SAV RETURNS THE CURRENT ERROR NUMBER AND
+C               SETS IT TO IVALUE IF SET = .TRUE. .
+C
+C  IF (ISW = 2) I8SAV RETURNS THE CURRENT RECOVERY SWITCH AND
+C               SETS IT TO IVALUE IF SET = .TRUE. .
+C
+      LOGICAL SET
+      INTEGER LERROR, LRECOV
+      SAVE LERROR,LRECOV
+C
+C  START EXECUTION ERROR FREE AND WITH RECOVERY TURNED OFF.
+C
+      DATA LERROR/0/ , LRECOV/2/
+      IF (ISW .EQ. 1) THEN
+        I8SAV = LERROR
+        IF (SET) LERROR = IVALUE
+      ELSE IF (ISW .EQ. 2) THEN
+        I8SAV = LRECOV
+        IF (SET) LRECOV = IVALUE
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE FDUM
+C
+C     DUMMY ROUTINE TO BE LOCALLY IMPLEMENTED
+C
+      RETURN
+      END
+C
+      SUBROUTINE Q8QST4(NAME,LBRARY,ENTRY,VRSION)
+C
+C DIMENSION OF           NAME(1),LBRARY(1),ENTRY(1),VRSION(1)
+C ARGUMENTS
+C
+C LATEST REVISION        MARCH 1984
+C
+C PURPOSE                MONITORS LIBRARY USE BY WRITING A RECORD WITH
+C                        INFORMATION ABOUT THE CIRCUMSTANCES OF A
+C                        LIBRARY ROUTINE CALL TO THE SYSTEM ACCOUNTING
+C                        TAPE FOR LATER PROCESSING.
+C
+C NOTE---                THIS VERSION OF Q8QST4 SIMPLY RETURNS TO THE
+C                        CALLING ROUTINE.  LOCAL IMPLEMENTORS MAY WISH
+C                        TO IMPLEMENT A VERSION OF THIS ROUTINE THAT
+C                        MONITORS USE OF NCAR ROUTINES WITH LOCAL
+C                        MECHANISMS.  OTHERWISE IT WILL SAVE A SMALL
+C                        AMOUNT OF SPACE AND TIME IF CALLS TO Q8QST4 ARE
+C                        DELETED FROM ALL NSSL ROUTINES.
+C
+      CHARACTER*(*) NAME,LBRARY,ENTRY,VRSION
+C
+      RETURN
+      END
+c + NOAO -  Blockdata uerrbd rewritten as a runtime initialization subroutine
+c     BLOCKDATA UERRBD
+      subroutine uerrbd
+c
+      COMMON /UERRF/IERF
+C     DEFAULT ERROR UNIT
+c     DATA IERF/0/
+      IERF= 0
+      END
+c -NOAO
+        subroutine uliber (errcode, pkerrmsg, msglen)
+
+        character*80 pkerrmsg
+        integer errcode, msglen
+        integer*2 sppmsg(81)
+        integer SZLINE
+        parameter (SZLINE=80)
+
+c unpack the fortran character string, call fulib to output the string.
+c
+        call f77upk (pkerrmsg, sppmsg, SZLINE)
+        call fulib  (errcode, sppmsg, msglen)
+
+        end
diff --git a/sys/gio/ncarutil/tests/README b/sys/gio/ncarutil/tests/README
new file mode 100644
index 00000000..d74bb65f
--- /dev/null
+++ b/sys/gio/ncarutil/tests/README
@@ -0,0 +1,2 @@
+This directory contains test routines for the NCAR utilities.  The files
+ending with "t.f" are the NCAR supplied fortran test routines. 
diff --git a/sys/gio/ncarutil/tests/auto10t.f b/sys/gio/ncarutil/tests/auto10t.f
new file mode 100644
index 00000000..26109f4f
--- /dev/null
+++ b/sys/gio/ncarutil/tests/auto10t.f
@@ -0,0 +1,262 @@
+      SUBROUTINE XMPL10
+C
+C Define the data arrays.
+C
+      REAL XDRA(1201),YDRA(1201)
+C
+C Fill the data arrays.  The independent variable represents time during
+C the year (a hypothetical year with equal-length months) and is set up
+C so that the minor ticks can be lengthened to delimit the months; the
+C major ticks, though shortened to invisibility, will determine where
+C the labels go.
+C
+      DO 101 I=1,1201
+        XDRA(I)=FLOAT(I-51)
+        YDRA(I)=COSH(FLOAT(I-601)/202.)
+  101 CONTINUE
+C
+C Change the labels on the bottom and left axes.
+C
+      CALL ANOTAT ('MONTHS OF THE YEAR$','ROMAN NUMERALS$',0,0,0,0)
+C
+C Fix the minimum and maximum values on both axes and prevent AUTOGRAPH
+C from using rounded values at the ends of the axes.
+C
+      CALL AGSETF ('X/MIN.',-50.)
+      CALL AGSETF ('X/MAX.',1150.)
+      CALL AGSETI ('X/NICE.',0)
+C
+      CALL AGSETF ('Y/MIN.',1.)
+      CALL AGSETF ('Y/MAX.',10.)
+      CALL AGSETI ('Y/NICE.',0)
+C
+C Specify the spacing between major tick marks on all axes.  Note that
+C the AUTOGRAPH dummy routine AGCHNL is supplanted (below) by one which
+C supplies dates for the bottom axis and Roman numerals for the left
+C axis in place of the numeric labels one would otherwise get.
+C
+      CALL AGSETI ('  LEFT/MAJOR/TYPE.',1)
+      CALL AGSETI (' RIGHT/MAJOR/TYPE.',1)
+      CALL AGSETI ('BOTTOM/MAJOR/TYPE.',1)
+      CALL AGSETI ('   TOP/MAJOR/TYPE.',1)
+C
+      CALL AGSETF ('  LEFT/MAJOR/BASE.',  1.)
+      CALL AGSETF (' RIGHT/MAJOR/BASE.',  1.)
+      CALL AGSETF ('BOTTOM/MAJOR/BASE.',100.)
+      CALL AGSETF ('   TOP/MAJOR/BASE.',100.)
+C
+C Suppress minor ticks on the left and right axes.
+C
+      CALL AGSETI ('  LEFT/MINOR/SPACING.',0)
+      CALL AGSETI (' RIGHT/MINOR/SPACING.',0)
+C
+C On the bottom and top axes, put one minor tick between each pair of
+C major ticks, shorten the major ticks to invisibility, and lengthen
+C the minor ticks.  The net effect is to make the minor ticks delimit
+C the beginning and end of each month, while the major ticks, though
+C invisible, cause the names of the months to be where we want them.
+C
+      CALL AGSETI ('BOTTOM/MINOR/SPACING.',1)
+      CALL AGSETI ('   TOP/MINOR/SPACING.',1)
+C
+      CALL AGSETF ('BOTTOM/MAJOR/INWARD. ',0.)
+      CALL AGSETF ('BOTTOM/MINOR/INWARD. ',.015)
+      CALL AGSETF ('   TOP/MAJOR/INWARD. ',0.)
+      CALL AGSETF ('   TOP/MINOR/INWARD. ',.015)
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZXY.
+C
+      CALL EZXY (XDRA,YDRA,1201,'EXAMPLE 10 (MODIFIED NUMERIC LABELS)$')
+C
+c     STOP
+C
+      END
+      SUBROUTINE AGCHNL (IAXS,VILS,CHRM,MCIM,NCIM,IPXM,CHRE,MCIE,NCIE)
+C
+      CHARACTER*(*) CHRM,CHRE
+C
+C The routine AGCHNL is called by AGAXIS just after it has set up the
+C character strings comprising a numeric label along an axis.  The
+C default version does nothing.  A user may supply his own version to
+C change the numeric labels.  For each numeric label, this routine is
+C called twice by AGAXIS - once to determine how much space will be
+C required when the label is actually drawn and once just before it
+C is actually drawn.  The arguments are as follows:
+C
+C - IAXS is the number of the axis being drawn.  Its value is 1, 2, 3,
+C   or 4, implying the left, right, bottom, or top axes, respectively.
+C   The value of IAXS must not be altered.
+C
+C - VILS is the value to be represented by the numeric label, in the
+C   label system for the axis.  The value of VILS must not be altered.
+C
+C - CHRM, on entry, is a character string containing the mantissa of the
+C   numeric label, as it will appear if AGCHNL makes no changes.  If the
+C   numeric label includes a "times" symbol, it will be represented by
+C   a blank in CHRM.  (See IPXM, below.)  CHRM may be modified.
+C
+C - MCIM is the length of CHRM - the maximum number of characters that
+C   it will hold.  The value of MCIM must not be altered.
+C
+C - NCIM, on entry, is the number of meaningful characters in CHRM.  If
+C   CHRM is changed, NCIM should be changed accordingly.
+C
+C - IPXM, on entry, is zero if there is no "times" symbol in CHRM; if it
+C   is non-zero, it is the index of the appropriate character position
+C   in CHRM.  If AGCHNL changes the position of the "times" symbol in
+C   CHRM, removes it, or adds it, the value of IPXM must be changed.
+C
+C - CHRE, on entry, is a character string containing the exponent of the
+C   numeric label, as it will appear if AGCHNL makes no changes.  CHRE
+C   may be modified.
+C
+C - MCIE is the length of CHRE - the maximum number of characters that
+C   it will hold.  The value of MCIE must not be altered.
+C
+C - NCIE, on entry, is the number of meaningful characters in CHRE.  If
+C   CHRE is changed, NCIE should be changed accordingly.
+C
+C Define the names of the months for use on the bottom axis.
+C
+      CHARACTER*3 MONS(12)
+      DATA MONS / 'JAN','FEB','MAR','APR','MAY','JUN',
+     +            'JUL','AUG','SEP','OCT','NOV','DEC'/
+C
+C Modify the numeric labels on the left axis.
+C
+      IF (IAXS.EQ.1) THEN
+        CALL AGCORN (IFIX(VILS),CHRM,NCIM)
+        IPXM=0
+        NCIE=0
+C
+C Modify the numeric labels on the bottom axis.
+C
+      ELSE IF (IAXS.EQ.3) THEN
+        IMON=IFIX(VILS+.5)/100+1
+        CHRM(1:3)=MONS(IMON)
+        NCIM=3
+        IPXM=0
+        NCIE=0
+      END IF
+C
+C Done.
+C
+      RETURN
+C
+      END
+      SUBROUTINE AGCORN (NTGR,BCRN,NCRN)
+C
+      CHARACTER*(*) BCRN
+C
+C This routine receives an integer in NTGR and returns its Roman-numeral
+C equivalent - NCRN characters - in the character variable BCRN.  It
+C only works for integers within a limited range and it does some rather
+C unorthodox things (like using zero and minus).
+C
+C ICH1, ICH5, and IC10 are character variables used for the single-unit,
+C five-unit, and ten-unit symbols at a given level.
+C
+      CHARACTER*1 ICH1,ICH5,IC10
+C
+C Treat numbers outside the range (-4000,+4000) as infinites.
+C
+      IF (IABS(NTGR).GE.4000) THEN
+        IF (NTGR.GT.0) THEN
+          NCRN=5
+          BCRN(1:5)='(INF)'
+        ELSE
+          NCRN=6
+          BCRN(1:6)='(-INF)'
+        END IF
+        RETURN
+      END IF
+C
+C Use the symbol '0' for the zero.  The Romans never had it so good.
+C
+      IF (NTGR.EQ.0) THEN
+        NCRN=1
+        BCRN(1:1)='0'
+        RETURN
+      END IF
+C
+C Zero the character counter.
+C
+      NCRN=0
+C
+C Handle negative integers by prefixing a minus sign.
+C
+      IF (NTGR.LT.0) THEN
+        NCRN=NCRN+1
+        BCRN(NCRN:NCRN)='-'
+      END IF
+C
+C Initialize some constants.  We'll check for thousands first.
+C
+      IMOD=10000
+      IDIV=1000
+      ICH1='M'
+C
+C Find out how many thousands (hundreds, tens, units) there are and jump
+C to the proper code block for each case.
+C
+  101 INTG=MOD(IABS(NTGR),IMOD)/IDIV
+C
+      GO TO (107,104,104,104,102,103,103,103,103,106) , INTG+1
+C
+C Four - add ICH1 followed by ICH5.
+C
+  102 NCRN=NCRN+1
+      BCRN(NCRN:NCRN)=ICH1
+C
+C Five through eight - add ICH5, followed by INTG-5 ICH1's.
+C
+  103 NCRN=NCRN+1
+      BCRN(NCRN:NCRN)=ICH5
+C
+      INTG=INTG-5
+      IF (INTG.LE.0) GO TO 107
+C
+C One through three - add that many ICH1's.
+C
+  104 DO 105 I=1,INTG
+        NCRN=NCRN+1
+        BCRN(NCRN:NCRN)=ICH1
+  105 CONTINUE
+C
+      GO TO 107
+C
+C Nine - add ICH1, followed by IC10.
+C
+  106 NCRN=NCRN+1
+      BCRN(NCRN:NCRN)=ICH1
+      NCRN=NCRN+1
+      BCRN(NCRN:NCRN)=IC10
+C
+C If we're done, exit.
+C
+  107 IF (IDIV.EQ.1) RETURN
+C
+C Otherwise, tool up for the next digit and loop back.
+C
+      IMOD=IMOD/10
+      IDIV=IDIV/10
+      IC10=ICH1
+C
+      IF (IDIV.EQ.100) THEN
+        ICH5='D'
+        ICH1='C'
+      ELSE IF (IDIV.EQ.10) THEN
+        ICH5='L'
+        ICH1='X'
+      ELSE
+        ICH5='V'
+        ICH1='I'
+      END IF
+C
+      GO TO 101
+C
+      END
diff --git a/sys/gio/ncarutil/tests/autograph.x b/sys/gio/ncarutil/tests/autograph.x
new file mode 100644
index 00000000..3c2ccb14
--- /dev/null
+++ b/sys/gio/ncarutil/tests/autograph.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+include	<ctype.h>
+
+# Test NCAR routine AUTOGRAPH - EZXY, EZMXY etc.
+
+procedure t_autograph()
+
+char	device[SZ_FNAME], command[SZ_LINE]
+int	ierror, wkid, junk, cmd
+int	ctoi()
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tautog (ierror)
+	if (ierror == 0)
+	    call eprintf ("Test successful\n")
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/autographt.f b/sys/gio/ncarutil/tests/autographt.f
new file mode 100644
index 00000000..25b14518
--- /dev/null
+++ b/sys/gio/ncarutil/tests/autographt.f
@@ -0,0 +1,186 @@
+      SUBROUTINE TAUTOG	(IERROR)
+C
+C LATEST REVISION	 FEBRUARY 1985
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 AUTOGRAPH AND TO TEST AUTOGRAPH ON A
+C			 SIMPLE	PROBLEM
+C
+C USAGE			 CALL TAUTOG (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN ERROR PARAMETER
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   AUTOGRAPH TEST SUCCESSFUL  .	. .  SEE PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS WRITTEN ON UNIT 6.
+C
+C			 IN ADDITION, FOUR (4) LABELLED	FRAMES
+C			 CONTAINING THE	TWO-DIMENSIONAL	PLOTS ARE
+C			 PRODUCED ON THE MACHINE GRAPHICS DEVICE.
+C			 TO DETERMINE IF THE TEST WAS SUCCESSFUL,
+C			 IT IS NECESSARY TO EXAMINE THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 AUTOGRAPH
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C HISTORY		 ORIGINALLY WRITTEN IN APRIL, 1979 AND
+C			 CONVERTED TO FORTRAN 77 AND GKS IN FEBRUARY
+C			 1985.
+C
+C ALGORITHM		 TAUTOG	COMPUTES DATA FOR AUTOGRAPH SUBROUTINES
+C
+C			   EZY,	EZXY, EZMY, AND	EZMXY,
+C
+C			 AND CALLS EACH	OF THESE ROUTINES TO PRODUCE
+C			 ONE PLOT EACH.
+C
+C			 ON THREE OF THE PLOTS,	TAUTOG USES THE
+C			 AUTOGRAPH CONTROL PARAMETER ROUTINES
+C			 AGSETF, AGSETI, AND AGSETP TO SPECIFY
+C			 Y-AXIS	LABELS OR INTRODUCE LOG	SCALING.
+C
+C PORTABILITY		 FORTRAN 77
+C
+      REAL	      X(21)	 ,Y1D(21)    ,Y2D(21,5)
+C
+C X CONTAINS THE ABSCISSA VALUES FOR THE PLOTS PRODUCED	BY EZXY	AND
+C EZMXY,  Y1D CONTAINS THE ORDINATE VALUES FOR THE PLOTS PRODUCED BY
+C EZXY AND EZY,	 AND Y2D CONTAINS THE ORDINATE VALUES FOR THE PLOTS
+C PRODUCED BY EZMY AND EZMXY.
+C
+C
+C
+C
+C FILL Y1D ARRAY FOR ENTRY EZY
+C
+      DO  10 I=1,21
+	 Y1D(I)	= EXP(-.1*FLOAT(I))*COS(FLOAT(I)*.5)
+   10 CONTINUE
+C
+C     ENTRY EZY	PLOTS THE CONTENTS OF Y1D AS A FUNCTION	OF THE INTEGERS
+C     THE TITLE	FOR THIS PLOT IS
+C
+C	DEMONSTRATING EZY ENTRY	OF AUTOGRAPH
+C
+      CALL EZY (Y1D(1),21,'DEMONSTRATING EZY ENTRY OF AUTOGRAPH$')
+C
+	
+C
+C
+C
+C FILL X AND Y1D ARRAYS	FOR ENTRY EZXY
+C
+      DO  20 I=1,21
+	 X(I) =	FLOAT(I-1)*.314
+	 Y1D(I)	= X(I)+COS(X(I))*2.0
+   20 CONTINUE
+C
+C     SET AUTOGRAPH CONTROL PARAMETERS FOR Y-AXIS LABEL
+C	  X+COS(X)*2
+C
+      CALL AGSETC('LABEL/NAME.','L')
+      CALL AGSETI('LINE/NUMBER.',100)
+      CALL AGSETC('LINE/TEXT.','X+COS(X)*2$')
+C
+C     ENTRY EZXY PLOTS CONTENTS	OF X-ARRAY VS. Y1D-ARRAY
+C     THE TITLE	FOR THIS PLOT IS
+C
+C	DEMONSTRATING EZXY ENTRY OF AUTOGRAPH
+C
+      CALL EZXY	(X,Y1D,21,'DEMONSTRATING EZXY ENTRY IN AUTOGRAPH$')
+C
+C
+C
+C
+C FILL Y2D ARRAY FOR ENTRY EZMY
+C
+      DO  40 I=1,21
+	 T = .5*FLOAT(I-1)
+	 DO  30	J=1,5
+	    Y2D(I,J) = EXP(-.5*T)*COS(T)/FLOAT(J)
+   30	 CONTINUE
+   40 CONTINUE
+C
+C     SET AUTOGRAPH CONTROL PARAMETERS FOR Y-AXIS LABEL
+C	  EXP(-X/2)*COS(X)*SCALE
+C
+      CALL AGSETC('LABEL/NAME.','L')
+      CALL AGSETI('LINE/NUMBER.',100)
+      CALL AGSETC('LINE/TEXT.','EXP(-X/2)*COS(X)*SCALE$')
+C
+C     SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE
+C     ALPHABETIC SET OF	DASHED LINE PATTERNS IS	TO BE USED.
+C
+      CALL AGSETI('DASH/SELECTOR.',-1)
+C
+C     SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE
+C     GRAPH DRAWN IS TO	BE LOGARITHMIC IN THE X-AXIS.
+C
+      CALL AGSETI('X/LOGARITHMIC.',1)
+C
+C     ENTRY EZMY PLOTS MULTIPLE	ARRAYS AS A FUNCTION OF	THE INTEGERS
+C     THE TITLE	FOR THIS PLOT IS
+C
+C	DEMONSTRATING EZMY ENTRY OF AUTOGRAPH
+C
+      CALL EZMY	(Y2D,21,5,10,'DEMONSTRATING EZMY ENTRY OF AUTOGRAPH$')
+C
+C
+C
+C
+C FILL Y2D ARRAY FOR EZMXY
+C
+      DO  60 I=1,21
+	 DO  50	J=1,5
+	    Y2D(I,J) = X(I)**J+COS(X(I))
+   50	 CONTINUE
+   60 CONTINUE
+C
+C     SET AUTOGRAPH CONTROL PARAMETERS FOR Y-AXIS LABEL
+C	  X**J+COS(X)
+C
+      CALL AGSETC('LABEL/NAME.','L')
+      CALL AGSETI('LINE/NUMBER.',100)
+      CALL AGSETC('LINE/TEXT.','X**J+COS(X)$')
+C
+C     SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE
+C     ALPHABETIC SET OF	DASHED LINE PATTERNS IS	TO BE USED.
+C
+      CALL AGSETI('DASH/SELECTOR.',-1)
+C
+C     SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE GRAPH
+C     IS TO BE LINEAR IN THE X-AXIS AND	LOGARITHMIC IN THE Y-AXIS.
+C
+      CALL AGSETI('X/LOGARITHMIC.',0)
+      CALL AGSETI('Y/LOGARITHMIC.',1)
+C
+C     ENTRY EZMXY PLOTS	MULTIPLE ARRAYS	AS A FUNCTION OF A SINGLE
+C		  X ARRAY (OR MANY X ARRAYS)
+C     THE TITLE	FOR THIS PLOT IS
+C
+C	DEMONSTRATING EZMXY ENTRY OF AUTOGRAPH
+C
+      CALL EZMXY (X,Y2D,21,5,21,
+     +		  'DEMONSTRATING EZMXY ENTRY OF AUTOGRAPH$')
+C
+      IERROR = 0
+c     WRITE (6,1001)
+C
+      RETURN
+C
+c1001 FORMAT ('	 AUTOGRAPH TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/conran.x b/sys/gio/ncarutil/tests/conran.x
new file mode 100644
index 00000000..11a4ab0d
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conran.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_CONRAN -- test NCAR contour routine CONRAN.
+
+procedure t_conran ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconan (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else {
+	    call printf ("Test was not successful. ierror = %d\n")
+		call pargi (error_code)
+	}
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/conrant.f b/sys/gio/ncarutil/tests/conrant.f
new file mode 100644
index 00000000..a144de35
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrant.f
@@ -0,0 +1,97 @@
+      SUBROUTINE TCONAN	(IERROR)
+C
+C LATEST REVISION	 JULY 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRAN, THE STANDARD ENTRY POINT OF THE
+C			 CONRAN	PACKAGE.
+C
+C			 THIS SAME SUBROUTINE CAN BE USED TO PRODUCE
+C			 DEMO PLOTS OF THE SMOOTH VERSION OF CONRAN
+C			 BY LOADING DASHSMTH INSTEAD OF	DASHCHAR.
+C
+C USAGE			 CALL TCONAN (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   .EQ.	0, IF THE TEST WAS SUCCESSFUL,
+C			   .NE.	0, OTHERWISE
+C			   IF NOT ZERO THE NUMBER PRODUCED WILL
+C			   CORRESPOND TO THE ERROR NUMBERS IN
+C			   THE CONRAN LISTING.
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRAN TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT AND TRIANGULATION	OF THE DATA ARE	PRODUCED
+C			 ON THE	DEFAULT	GRAPHICS DEVICE	UNLESS THE USER
+C			 SPECIFIES OTHERWISE VIA JCL.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 CONRAN
+C FILES			 CONTERP
+C			 CONCOM
+C
+C LANGUAGE		 FORTRAN77
+C
+C ALGORITHM		 A SPARSE DATA SET IS DEFINED VIA DATA
+C			 STATEMENTS.  OPTIONS ARE SET TO PRODUCE A
+C			 TITLE AND DISPLAY THE TRIANGULATION GENERATED
+C			 BY THE	INTERPOLATING ROUTINES.	 BY DEFAULT
+C			 A MESSAGE AT THE BOTTEM OF THE	PLOT AND A
+C			 PERIMETER ARE ALSO PRODUCED.  THIS ROUTINE
+C			 TAKES ADVANTAGE OF THE	PORT ERROR HANDLING
+C			 ROUTINES TO DETERMINE IF CONRAN TERMINATED
+C			 NORMALLY.
+C
+C PORTABILITY		 ANSI FORTRAN77	STANDARD
+C
+C     COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
+C  SET UP THE SCRATCH SPACES REQUIRED BY CONRAN
+C
+      DIMENSION	WK(221),IWK(744),SCR(1600)
+C
+C  SET UP THE ARRAYS TO	DEFINE THE DATA	SET
+C
+      DIMENSION	XD(17),YD(17),ZD(17)
+C
+C DEFINE THE DATA SET
+C
+      DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8),
+     1	   XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15),
+     2	   XD(16),XD(17)
+     3	   /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20.,
+     4		5.,15.,10.,7.,13.,16./
+C
+      DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8),
+     1	   YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15),
+     2	   YD(16),YD(17)
+     3	  /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10.,
+     4		15.,15.,15.,20.,20.,8./
+C
+      DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8),
+     1	   ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15),
+     2	   ZD(16),ZD(17)
+     3	  /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1.,
+     4		1.,1.,1.,1.,1.,25./
+C
+C  SET UP PARAMETER FOR	NUMBER OF INPUT	POINTS
+C
+      DATA NDP/17/
+      call conbdn
+C
+C  SET UP TITLE	 FOR PLOT
+C
+      CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAN',29, 0)
+C
+      CALL CONRAN(XD,YD,ZD,NDP,WK,IWK,SCR)
+C
+      RETURN
+      END
diff --git a/sys/gio/ncarutil/tests/conraq.x b/sys/gio/ncarutil/tests/conraq.x
new file mode 100644
index 00000000..d0480e97
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conraq.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_CONRAQ -- test NCAR contour routine CONRAQ.
+
+procedure t_conraq ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconaq (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/conraqt.f b/sys/gio/ncarutil/tests/conraqt.f
new file mode 100644
index 00000000..dbf211aa
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conraqt.f
@@ -0,0 +1,139 @@
+      SUBROUTINE TCONAQ	(IERROR)
+C
+C LATEST REVISION	 JULY 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRAQ, THE QUICK ENTRY  POINT	OF THE
+C			 CONRAN	PACKAGE.
+C
+C USAGE			 CALL TCONAQ (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   .EQ.	0, IF THE TEST WAS SUCCESSFUL,
+C			   .NE.	0, OTHERWISE.
+C			   IF NOT ZERO THE NUMBER PRODUCED WILL
+C			   CORRESPOND TO THE ERROR NUMBERS IN
+C			   THE CONRAQ LISTING.
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRAQ TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT AND TRIANGULATION	OF THE DATA ARE	PRODUCED
+C			 ON THE	DEFAULT	GRAPHICS DEVICE	UNLESS THE USER
+C			 SPECIFIES OTHERWISE VIA JCL.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 CONRAQ
+C FILES			 CONTERP
+C
+C LANGUAGE		 FORTRAN77
+C
+C ALGORITHM		 A SPARSE DATA SET IS DEFINED VIA DATA
+C			 STATEMENTS.  OPTIONS ARE SET TO PRODUCE A
+C			 TITLE AND DISPLAY THE TRIANGULATION GENERATED
+C			 BY THE	INTERPOLATING ROUTINES.	 BY DEFAULT
+C			 A MESSAGE AT THE BOTTEM OF THE	PLOT AND A
+C			 PERIMETER ARE ALSO PRODUCED.  THIS ROUTINE
+C			 TAKES ADVANTAGE OF THE	PORT ERROR HANDLING
+C			 ROUTINES TO DETERMINE IF CONRAQ TERMINATED
+C			 NORMALLY.
+C
+      COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
+C
+C  SET UP THE SCRATCH SPACES REQUIRED BY CONRAQ
+C
+      DIMENSION	WK(221),IWK(744)
+C
+C  SET UP THE ARRAYS TO	DEFINE THE DATA	SET
+C
+      DIMENSION	XD(17),YD(17),ZD(17)
+C
+C DEFINE THE DATA SET
+C
+      DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8),
+     1	   XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15),
+     2	   XD(16),XD(17)
+     3	   /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20.,
+     4		5.,15.,10.,7.,13.,16./
+C
+      DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8),
+     1	   YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15),
+     2	   YD(16),YD(17)
+     3	  /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10.,
+     4		15.,15.,15.,20.,20.,8./
+C
+      DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8),
+     1	   ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15),
+     2	   ZD(16),ZD(17)
+     3	  /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1.,
+     4		1.,1.,1.,1.,1.,25./
+C
+C  SET UP PARAMETER FOR	NUMBER OF INPUT	POINTS
+C
+      DATA NDP/17/
+C
+C  SET PORT ERROR HANDLING ROUTINE TO RECOVERY MODE
+C
+      CALL ENTSR(IROLD,1)
+C
+C  SET UP TITLE	 FOR PLOT
+C
+      CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAQ',29)
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C  SET OPTION TO DISPLAY THE TRIANGULATION
+C
+      CALL CONOP1('TRI=ON')
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C  CALL	CONRAQ TO CONTOUR DATA
+C
+      CALL CONRAQ(XD,YD,ZD,NDP,WK,IWK)
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C
+C  CALL	FRAME, CONRAQ WILL NOT DO THIS
+C
+cCALL NEWFM
+C
+C  PRINT MESSAGE EVERYTHING OK
+C
+c     WRITE(6,10)
+c10   FORMAT(1X,'CONRAQ	TEST SUCCESSFUL, SEE PLOT TO VERIFY',
+c    1'	PERFORMANCE')
+C
+C
+      RETURN
+C
+C  IF ERROR CALL THE PORT ERROR	PRINT ROUTINE.
+C  THIS	CALL IS	NOT NECESSARY UNLESS YOU ARE IN	RECOVER	MODE.
+C  IF YOU ARE NOT IN RECOVER MODE THE ERROR MESSAGE WILL  BE PRINTED
+C  AUTOMATICALLY.
+C
+ 100  CALL EPRIN
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/tests/conras.x b/sys/gio/ncarutil/tests/conras.x
new file mode 100644
index 00000000..d2b48dc2
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conras.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_CONRAS -- test NCAR contour routine CONRAS.
+
+procedure t_conras ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconas (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/conrast.f b/sys/gio/ncarutil/tests/conrast.f
new file mode 100644
index 00000000..c4f3ab12
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrast.f
@@ -0,0 +1,147 @@
+      SUBROUTINE TCONAS	(IERROR)
+C
+C LATEST REVISION	 AUGUST	1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRAS, THE SUPER ENTRY  POINT	OF THE
+C			 CONRAN	PACKAGE.
+C
+C USAGE			 CALL TCONAS (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   .EQ.	0, IF THE TEST WAS SUCCESSFUL,
+C			   .NE.	0, OTHERWISE
+C			   IF NOT ZERO THE NUMBER PRODUCED WILL
+C			   CORRESPOND TO THE ERROR NUMBERS IN
+C			   THE CONRAS LISTING.
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRAS TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT AND TRIANGULATION	OF THE DATA ARE	PRODUCED
+C			 ON THE	DEFAULT	GRAPHICS DEVICE	UNLESS THE USER
+C			 SPECIFIES OTHERWISE VIA JCL.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 CONRAS
+C FILES			 CONTERP
+C			 CONCOM
+C			 DASHSUPR
+C
+C SPECIALIST		 FOR INFORMATION ABOUT THIS ROUTINE OR THE
+C			 ULIB CONRAS PACKAGE, CONTACT THE SPECIALIST
+C			 NAMED IN THE ULIB CONRAS PACKAGE.
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 A SPARSE DATA SET IS DEFINED VIA DATA
+C			 STATEMENTS.  OPTIONS ARE SET TO PRODUCE A
+C			 TITLE AND DISPLAY THE TRIANGULATION GENERATED
+C			 BY THE	INTERPOLATING ROUTINES.	 BY DEFAULT
+C			 A MESSAGE AT THE BOTTEM OF THE	PLOT AND A
+C			 PERIMETER ARE ALSO PRODUCED.  THIS ROUTINE
+C			 TAKES ADVANTAGE OF THE	PORT ERROR HANDLING
+C			 ROUTINES TO DETERMINE IF CONRAS TERMINATED
+C			 NORMALLY.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+C  SET UP THE SCRATCH SPACES REQUIRED BY CONRAS
+C
+      DIMENSION	WK(221),IWK(744),SCR(1600)
+C
+C  SET UP THE ARRAYS TO	DEFINE THE DATA	SET
+C
+      DIMENSION	XD(17),YD(17),ZD(17)
+	COMMON /RASINT/	IRASMJ,	IRASMN,	IRASTX
+C
+C DEFINE THE DATA SET
+C
+      DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8),
+     1	   XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15),
+     2	   XD(16),XD(17)
+     3	   /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20.,
+     4		5.,15.,10.,7.,13.,16./
+C
+      DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8),
+     1	   YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15),
+     2	   YD(16),YD(17)
+     3	  /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10.,
+     4		15.,15.,15.,20.,20.,8./
+C
+      DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8),
+     1	   ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15),
+     2	   ZD(16),ZD(17)
+     3	  /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1.,
+     4		1.,1.,1.,1.,1.,25./
+C
+C  SET UP PARAMETER FOR	NUMBER OF INPUT	POINTS
+C
+      DATA NDP/17/
+C
+C  SET PORT ERROR HANDLING ROUTINE TO RECOVERY MODE
+C
+      CALL ENTSR(IROLD,1)
+C
+C  SET UP TITLE	 FOR PLOT
+C
+      CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAS',29,0)
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C  SET OPTION TO DISPLAY THE TRIANGULATION
+C
+      CALL CONOP1('TRI=ON')
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C  CALL	CONRAS TO CONTOUR DATA
+C
+      CALL CONRAS(XD,YD,ZD,NDP,WK,IWK,SCR)
+C
+C  TEST	FOR ERROR
+C
+      IF (NERRO(IERROR).NE.0) GO TO 100
+C
+C  NO ERROR
+C
+C
+C  CALL	FRAME, CONRAS WILL NOT DO THIS
+C
+c	CALL NEWFM
+C
+C  PRINT MESSAGE EVERYTHING OK
+C
+c     WRITE(6,10)
+c10   FORMAT(1X,'CONRAS	TEST SUCCESSFUL, SEE PLOT TO VERIFY ',
+c    1'PERFORMANCE')
+C
+C
+      RETURN
+C
+C  IF ERROR CALL THE PORT ERROR	PRINT ROUTINE.
+C  THIS	CALL IS	NOT NECESSARY UNLESS YOU ARE IN	RECOVER	MODE.
+C  IF YOU ARE NOT IN RECOVER MODE THE ERROR MESSAGE WILL  BE PRINTED
+C  AUTOMATICALLY.
+C
+ 100  CALL EPRIN
+      RETURN
+C
+      END
diff --git a/sys/gio/ncarutil/tests/conrcqckt.f b/sys/gio/ncarutil/tests/conrcqckt.f
new file mode 100644
index 00000000..d9d2f827
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrcqckt.f
@@ -0,0 +1,114 @@
+      SUBROUTINE TCNQCK	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRECQCK AND TO TEST CONRECQCK ON A SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TCNQCK (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRECQCK TEST SUCCESSFUL  .	. . SEE	PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 TCNQCK	CALLS SUBROUTINES EZCNTR, CONREC, AND
+C			 PWRIT TO DRAW TWO LABELLED CONTOUR PLOTS OF THE
+C			 ARRAY Z.
+C
+C PORTABILITY		 ANSI FORTRAN77
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA TX/.4267/, TY/.9765/
+C
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT (0)
+C
+C ENTRY	EZCNTR REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECQCK
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR EZCNTR	ENTRY OF CONRECQCK',
+     2		 2,0,0)
+      CALL EZCNTR (Z,21,25)
+C
+C
+C ENTRY	CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF	DESIRED
+C
+C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE	HIGHEST	CONTOUR
+C LEVEL	(4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS	(0.3) ARE
+C SPECIFIED.
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECQCK
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR CONREC	ENTRY OF CONRECQCK',
+     2		 2,0,0)
+      CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0)
+c     CALL NEWFM
+C
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	 CONRECQCK TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+C---------------------------------------------------------------------
+C REVISION HISTORY
+C
+C JUNE 1984			CONVERTED TO FORTRAN 77	AND GKS
+C
+C---------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/tests/conrcsmtht.f b/sys/gio/ncarutil/tests/conrcsmtht.f
new file mode 100644
index 00000000..735d109a
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrcsmtht.f
@@ -0,0 +1,122 @@
+      SUBROUTINE TCNSMT	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRECSMTH AND	TO TEST	CONRECSMTH ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TCNSMT (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRECSMTH TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 TCNSMT	CALLS SUBROUTINES EZCNTR, CONREC, AND
+C			 WTSTR TO DRAW TWO LABELLED CONTOUR PLOTS OF THE
+C			 ARRAY Z.
+C
+C PORTABILITY		 ANSI FORTRAN77	STANDARD
+C
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+c      DATA TX/0.42676/,	TY/0.97656/
+      TX = 0.42676
+      TY = 0.97656
+C
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMAIZATION TRANS NUMBER TO WRITE TITLES
+C
+      CALL GSELNT (0)
+C
+C ENTRY	EZCNTR REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECSMTH
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR EZCNTR	ENTRY OF CONRECSMTH',
+     2		 2,0,0)
+      CALL EZCNTR (Z,21,25)
+C
+C
+C ENTRY	CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF	DESIRED
+C
+C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE	HIGHEST	CONTOUR
+C LEVEL	(4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS	(0.3) ARE
+C SPECIFIED.
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECSMTH
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR CONREC	ENTRY OF CONRECSMTH',
+     2		 2,0,0)
+      CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0)
+c     CALL NEWFM
+C
+c      WRITE (6,1001)
+      RETURN
+C
+c 1001 FORMAT ('	CONRECSMTH TEST	SUCCESSFUL',24X,
+c     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+C
+C---------------------------------------------------------------------
+C
+C REVISION HISTORY
+C
+C     JUNE 1984			 CONVERTED TO FORTRAN 77 AND GKS
+C
+C---------------------------------------------------------------------
+      END
diff --git a/sys/gio/ncarutil/tests/conrcsprt.f b/sys/gio/ncarutil/tests/conrcsprt.f
new file mode 100644
index 00000000..484d1ccc
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrcsprt.f
@@ -0,0 +1,110 @@
+      SUBROUTINE TCNSUP	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONRECSUPR AND	TO TEST	CONRECSUPR ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TCNSUP (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONRECSUPR TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 TCNSUP	CALLS SUBROUTINES EZCNTR, CONREC, AND
+C			 WTSTR TO DRAW TWO LABELLED CONTOUR PLOTS OF THE
+C			 ARRAY Z.
+C
+C PORTABILITY		 ANSI FORTRAN77
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA TX/0.4219/, TY/0.9765/
+C
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANS NUMBER 0
+C
+      CALL GSELNT (0)
+C
+C ENTRY	EZCNTR REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECSUPR
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR EZCNTR	ENTRY OF CONRECSUPR',
+     2		 2,0,0)
+      CALL EZCNTR (Z,21,25)
+C
+C
+C ENTRY	CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF	DESIRED
+C
+C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE	HIGHEST	CONTOUR
+C LEVEL	(4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS	(0.3) ARE
+C SPECIFIED.  ALSO THE LABELLING OF THE	HIGHS AND LOWS IS SUPRESSED.
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECSUPR
+C
+      CALL WTSTR (TX,TY,
+     1		 'DEMONSTRATION	PLOT FOR CONREC	ENTRY OF CONRECSUPR',
+     2		 2,0,0)
+      CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,-1,0)
+      CALL NEWFM
+C
+      WRITE (6,1001)
+      RETURN
+C
+ 1001 FORMAT ('	CONRECSUPR TEST	SUCCESSFUL',24X,
+     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/conrec.x b/sys/gio/ncarutil/tests/conrec.x
new file mode 100644
index 00000000..2d9adfe5
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrec.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_CONREC -- test NCAR contour routine CONREC.
+
+procedure t_conrec ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconre (2, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/conrect.f b/sys/gio/ncarutil/tests/conrect.f
new file mode 100644
index 00000000..401aad9b
--- /dev/null
+++ b/sys/gio/ncarutil/tests/conrect.f
@@ -0,0 +1,118 @@
+      SUBROUTINE TCONRE	(nplot, IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 CONREC	AND TO TEST CONREC ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TCONRE (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   CONREC TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	CONTOUR
+C			 PLOT ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 TCONRE	CALL SUBROUTINES EZCNTR, CONREC, AND
+C			 PWRIT TO DRAW TWO LABELLED CONTOUR PLOTS OF THE
+C			 ARRAY Z.
+C
+C PORTABILITY		 FORTRAN77
+C
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+C     DATA TX/.3955/, TY/.9765/
+	data tx/.4267/, ty/.97/
+C
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANSFORMATION NUMBER 0
+C
+      CALL GSELNT ( 0 )
+C
+C ENTRY	EZCNTR REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONREC
+C
+c +noao: flag added to plot either EZCNTR or CONREC
+      if (nplot .eq. 1) then
+      CALL WTSTR ( TX, TY,
+     1		 'DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONREC',2,0,0 )
+      CALL EZCNTR (Z,21,25)
+      endif
+c -noao
+C
+C
+C ENTRY	CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF	DESIRED
+C
+C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE	HIGHEST	CONTOUR
+C LEVEL	(4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS	(0.3) ARE
+C SPECIFIED.
+C
+C THE TITLE FOR	THIS PLOT IS
+C
+C  DEMONSTRATION PLOT FOR CONREC ENTRY OF CONREC
+C
+c +noao:  flag added to plot either EZCNTR of CONREC
+      if (nplot .eq. 2) then
+      CALL WTSTR ( TX ,TY,
+     1		 'DEMONSTRATION PLOT FOR CONREC ENTRY OF CONREC',2,0,0 )
+      CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0)
+      endif
+c -noao
+c     CALL NEWFM
+C
+C     WRITE (6,1001)
+      RETURN
+C
+C1001 FORMAT ('	    CONREC TEST	SUCCESSFUL',24X,
+C    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/dashchar.x b/sys/gio/ncarutil/tests/dashchar.x
new file mode 100644
index 00000000..77430f37
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashchar.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+# Test NCAR routine DASHCHAR
+
+procedure t_dashchar()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	 gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tdashc (error_code)
+
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/dashchart.f b/sys/gio/ncarutil/tests/dashchart.f
new file mode 100644
index 00000000..fa583b84
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashchart.f
@@ -0,0 +1,145 @@
+      SUBROUTINE TDASHC	(IERROR)
+C
+C LATEST REVISION	 MAY 1984
+C
+C PURPOSE		 TO PROVIDE A DEMONSTRATION OF DASHCHAR
+C			 AND TO	TEST DASHCHAR ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TDASHC (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   DASHCHAR TEST SUCCESSFUL  . . .  SEE	PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 DASHED	LINE PLOT IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 DASHCHAR
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TDASHC	UTILIZES THE SOFTWARE DASHCHAR
+C			 SUBROUTINES DASHDB, DASHDC, FRSTD, VECTD,
+C			 LINED AND CURVED TO DRAW FIVE CURVES ON ONE
+C			 PICTURE USING FIVE DIFFERENT DASHCHAR
+C			 PATTERNS.  EACH CURVE IS CENTERED ABOUT
+C			 SOLID AXIS LINES AND LABELLED WITH THE
+C			 CHARACTER REPRESENTATION OF THE DASHCHAR
+C			 PATTERN USED.
+C
+C PORTABILITY		 FORTRAN 77
+C
+C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS
+C ORDINATE VALUES OF THE CURVE TO BE PLOTTED.
+C
+      DIMENSION	      X(31)	 ,Y(31)
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C SET SOLID DASH PATTERN,  1111111111111111 (BINARY).
+C BOOLEAN OPERATIONS (EMPLOYING	LOCALLY-IMPLEMENTED SUPPORT
+C ROUTINES) ARE	USED FOR PORTABILITY TO	HOSTS WITH 16 BIT
+C INTEGERS.
+C
+      ISOLID = IOR (ISHIFT (32767,1), 1)
+C
+      DO 130 K=1,5
+	 CALL DASHDB (ISOLID)
+	 ORG =1.07-0.195*K
+C
+C	DRAW CENTRAL AXIS FOR EACH CURVE
+C
+	 CALL FRSTD (.50,ORG-0.03)
+	 CALL VECTD (.50,ORG+0.03)
+	 CALL LINED (.109,ORG,.891,ORG)
+C
+C CALL SUBROUTINE DASHDC WITH A	DIFFERENT DASHED LINE AND CHARACTER
+C COMBINATION FOR EACH OF FIVE CURVES
+C
+	 GO TO ( 10, 20, 30, 40, 50),K
+   10	 CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12)
+	 GO TO	60
+   20	 CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12)
+	 GO TO	60
+   30	 CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12)
+	 GO TO	60
+   40	 CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12)
+	 GO TO	60
+   50	 CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12)
+   60	 CONTINUE
+C
+C	COMPUTE	VALUES FOR AND DRAW THE	KTH CURVE
+C
+	 DO  70	I=1,31
+	    THETA = FLOAT(I-1)*3.1415926535897932/15.
+	    X(I) = 0.5+.4*COS(THETA)
+	    Y(I) = ORG+.075*SIN(FLOAT(K)*THETA)
+   70	 CONTINUE
+	 CALL CURVED (X,Y,31)
+C
+C	LABEL EACH CURVE WITH THE APPROPRIATE CHARACTER	REPRESENTATION
+C	OF THE DASHCHAR	PATTERN.  IN THE PATTERN LABELS, A AND D
+C	SHOULD BE INTERPRETED AS APOSTROPHE AND	DOLLAR SIGN.
+C
+C	SET TEXT ALIGNMENT TO CENTER THE STRING	AT THE LEFT OF THE
+C	STRING AND IN THE VERTICAL CENTER
+C
+	CALL GSTXAL(1,3)
+C
+C	SET CHARACTER HEIGHT
+C
+	 CALL GSCHH(.012)
+C
+	 ORY = ORG+.089
+	 GO TO ( 80, 90,100,110,120),K
+   80	 CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1')
+	 GO TO 130
+   90	 CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2')
+	 GO TO 130
+  100	 CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3')
+	 GO TO 130
+  110	 CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4')
+	 GO TO 130
+  120	 CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5')
+C
+  130 CONTINUE
+C
+      CALL GSTXAL(2,3)
+      CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR	DASHCHAR')
+      CALL GTX (.5,.015,'IN IPAT STRINGS, A AND	D SHOULD BE INTERPRETED
+     1AS APOSTROPHE AND	DOLLAR SIGN')
+C
+C ADVANCE FRAME
+C
+c + noao: no need for clearing terminal
+c     CALL NEWFM
+c - noao
+C
+      IERROR = 0
+C      WRITE (6,1001)
+C
+      RETURN
+C
+C
+C1001 FORMAT ('	  DASHCHAR TEST	SUCCESSFUL',24X,
+C    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/dashlinet.f b/sys/gio/ncarutil/tests/dashlinet.f
new file mode 100644
index 00000000..c857428c
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashlinet.f
@@ -0,0 +1,138 @@
+      SUBROUTINE TDASHL	(IERROR)
+C
+C LATEST REVISION	 APRIL 1984
+C
+C PURPOSE		 TO PROVIDE A DEMONSTRATION OF DASHLINE
+C			 AND TO	TEST DASHLINE ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TDASHL (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   DASHLINE TEST SUCCESSFUL  . . .  SEE	PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 DASHED	LINE PLOT IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 DASHLINE
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TDASHL	UTILIZES THE SOFTWARE DASHLINE
+C			 SUBROUTINES DASHDB, FRSTD, VECTD, LINED AND
+C			 CURVED	TO DRAW	FIVE CURVES ON ONE PICTURE
+C			 USING FIVE DIFFERENT DASHLINE PATTERNS.  EACH
+C			 CURVE IS CENTERED ABOUT SOLID AXIS LINES AND
+C			 LABELLED WITH THE BINARY REPRESENTATION OF THE
+C			 DASHLINE PATTERN USED.
+C
+C PORTABILITY		 FORTRAN 77
+C
+C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS
+C COORDINATE VALUES OF THE CURVE TO BE PLOTTED.
+C
+      DIMENSION	      X(31)	 ,Y(31)	     ,IPAT(5)
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C SET SOLID DASH PATTERN,  1111111111111111 (BINARY).
+C BOOLEAN OPERATIONS (EMPLOYING	LOCALLY	IMPLEMENTED
+C SUPPORT ROUTINES) ARE	USED.
+C
+      ISOLID = IOR (ISHIFT (32767,1), 1)
+C
+C ARRAY	IPAT CONTAINS 5	DIFFERENT 16-BIT DASH PATTERNS.	 THE PATTERNS
+C CONSTRUCTED WITH BOOLEAN OPERATIONS AS ABOVE.
+C THE BINARY REPRESENTATIONS OF	THE PATTERNS ARE
+C	 0001110001111111
+C	 1111000011110000
+C	 1111110011111100
+C	 1111111100000000
+C	 1111111111111100
+C
+      IPAT(1) =	IOR (ISHIFT ( 3647,1), 1)
+      IPAT(2) =	ISHIFT (30840,1)
+      IPAT(3) =	ISHIFT (32382,1)
+      IPAT(4) =	ISHIFT (32640,1)
+      IPAT(5) =	ISHIFT (32766,1)
+C
+      DO  70 K=1,5
+	 CALL DASHDB (ISOLID)
+	 ORG =1.07-0.195*K
+C
+C	DRAW CENTRAL AXIS FOR EACH CURVE
+C
+	 CALL FRSTD (.50,ORG-0.03)
+	 CALL VECTD (.50,ORG+0.03)
+	 CALL LINED (.109,ORG,.891,ORG)
+	 CALL DASHDB (IPAT(K))
+C
+C	COMPUTE	VALUES FOR AND DRAW THE	KTH CURVE
+C
+	 DO  10	I=1,31
+	    THETA = FLOAT(I-1)*3.1415926535897932/15.
+	    X(I) = 0.5+.4*COS(THETA)
+	    Y(I) = ORG+.075*SIN(FLOAT(K)*THETA)
+   10	 CONTINUE
+	 CALL CURVED (X,Y,31)
+C
+C	LABEL EACH CURVE WITH THE APPROPRIATE BINARY REPRESENTATION OF
+C	THE DASHLINE PATTERN
+C
+C	SET TEXT ALIGNMENT TO CENTER THE STRING	AT THE LEFT OF THE
+C	STRING AND IN THE VERTICAL CENTER
+C
+      CALL GSTXAL(1,3)
+C
+C	SET CHARACTER HEIGHT
+C
+      CALL GSCHH(.012)
+C
+	 ORY = ORG+.09
+	 GO TO ( 20, 30, 40, 50, 60),K
+   20	 CALL GTX (.1,ORY,'IPAT=0001110001111111')
+	 GO TO	70
+   30	 CALL GTX (.1,ORY,'IPAT=1111000011110000')
+	 GO TO	70
+   40	 CALL GTX (.1,ORY,'IPAT=1111110011111100')
+	 GO TO	70
+   50	 CALL GTX (.1,ORY,'IPAT=1111111100000000')
+	 GO TO	70
+   60	 CALL GTX (.1,ORY,'IPAT=1111111111111100')
+C
+   70 CONTINUE
+C
+      CALL GSTXAL(2,3)
+      CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR	DASHLINE')
+C
+C ADVANCE FRAME
+C
+      CALL NEWFM
+C
+      IERROR = 0
+      WRITE (6,1001)
+C
+      RETURN
+C
+ 1001 FORMAT ('	  DASHLINE TEST	SUCCESSFUL',24X,
+     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/dashsmth.x b/sys/gio/ncarutil/tests/dashsmth.x
new file mode 100644
index 00000000..4bca9807
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashsmth.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+# Test NCAR routine DASHSMTH
+
+procedure t_dashsmth()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	 gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tdashs (error_code)
+
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/dashsmtht.f b/sys/gio/ncarutil/tests/dashsmtht.f
new file mode 100644
index 00000000..147d5139
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashsmtht.f
@@ -0,0 +1,144 @@
+      SUBROUTINE TDASHS	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A DEMONSTRATION OF DASHSMTH
+C			 AND TO	TEST DASHSMTH ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TDASHS (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   DASHSMTH TEST SUCCESSFUL  . . .  SEE	PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 DASHED	LINE PLOT IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 DASHSMTH
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TDASHS	UTILIZES THE SOFTWARE DASHSMTH
+C			 SUBROUTINES DASHDB, DASHDC, FRSTD,
+C			 VECTD,	LASTD, LINED AND CURVED	TO
+C			 DRAW FIVE CURVES ON ONE PICTURE USING
+C			 FIVE DIFFERENT	DASHSMTH PATTERNS.  EACH
+C			 CURVE IS CENTERED ABOUT SOLID AXIS LINES AND
+C			 LABELLED WITH THE CHARACTER REPRESENTATION OF
+C			 THE DASHSMTH PATTERN USED.
+C
+C PORTABILITY		 FORTRAN 77
+C
+C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS
+C ORDINATE VALUES OF THE CURVE TO BE PLOTTED.
+C
+      DIMENSION	      X(31)	 ,Y(31)
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C SET SOLID DASH PATTERN,  1111111111111111 (BINARY).
+C BOOLEAN OPERATIONS (EMPLOYING	LOCALLY	IMPLEMENTED SUPPORT
+C ROUTINES) ARE	USED FOR PORTABILITY TO	HOSTS WITH 16 BIT
+C INTEGERS.
+C
+      ISOLID = IOR (ISHIFT (32767,1), 1)
+C
+      DO 130 K=1,5
+	 CALL DASHDB (ISOLID)
+	 ORG =1.07-0.195*K
+C
+C	DRAW CENTRAL AXIS FOR EACH CURVE
+C
+	 CALL FRSTD (.50,ORG-0.03)
+	 CALL VECTD (.50,ORG+0.03)
+	 CALL LASTD
+	 CALL LINED (.109,ORG,.891,ORG)
+C
+C CALL SUBROUTINE DASHDC WITH A	DIFFERENT DASHED LINE AND CHARACTER
+C COMBINATION FOR EACH OF FIVE CURVES
+C
+	 GO TO ( 10, 20, 30, 40, 50),K
+   10	 CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12)
+	 GO TO	60
+   20	 CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12)
+	 GO TO	60
+   30	 CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12)
+	 GO TO	60
+   40	 CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12)
+	 GO TO	60
+   50	 CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12)
+   60	 CONTINUE
+C
+C	COMPUTE	VALUES FOR AND DRAW THE	KTH CURVE
+C
+	 DO  70	I=1,31
+	    THETA = FLOAT(I-1)*3.1415926535897932/15.
+	    X(I) = 0.5+.4*COS(THETA)
+	    Y(I) = ORG+.075*SIN(FLOAT(K)*THETA)
+   70	 CONTINUE
+	 CALL CURVED (X,Y,31)
+C
+C	LABEL EACH CURVE WITH THE APPROPRIATE CHARACTER	REPRESENTATION
+C	OF THE DASHSMTH	PATTERN.  IN THE PATTERN LABELS, A AND D
+C	SHOULD BE INTERPRETED AS APOSTROPHE AND	DOLLAR SIGN.
+C
+C
+C	SET TEXT ALIGNMENT TO CENTER THE STRING	AT THE LEFT OF THE
+C	STRING AND IN THE VERTICAL CENTER
+C
+	CALL GSTXAL(1,3)
+C
+C	SET CHARACTER HEIGHT
+C
+	 CALL GSCHH(.012)
+C
+	 ORY = ORG+.089
+	 GO TO ( 80, 90,100,110,120),K
+   80	 CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1')
+	 GO TO 130
+   90	 CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2')
+	 GO TO 130
+  100	 CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3')
+	 GO TO 130
+  110	 CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4')
+	 GO TO 130
+  120	 CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5')
+C
+  130 CONTINUE
+C
+      CALL GSTXAL(2,3)
+      CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR DASHSMTH')
+      CALL GTX (.5,.015,'IN IPAT STRINGS, A AND D SHOULD BE INTERPRETED
+     1AS APOSTROPHE AND DOLLAR SIGN')
+C
+C ADVANCE FRAME
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c      WRITE (6,1001)
+C
+      RETURN
+C
+c 1001 FORMAT ('	  DASHSMTH TEST	SUCCESSFUL',24X,
+c     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/dashsuprt.f b/sys/gio/ncarutil/tests/dashsuprt.f
new file mode 100644
index 00000000..f35c9c8b
--- /dev/null
+++ b/sys/gio/ncarutil/tests/dashsuprt.f
@@ -0,0 +1,151 @@
+      SUBROUTINE TDASHP	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A DEMONSTRATION OF DASHSUPR
+C			 AND TO	TEST DASHSUPR ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TDASHP (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   DASHSUPR TEST SUCCESSFUL  . . .  SEE	PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 DASHED	LINE PLOT IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 DASHSUPR
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TDASHP	UTILIZES THE SOFTWARE DASHSUPR
+C			 SUBROUTINES DASHDB, DASHDC, FRSTD,
+C			 VECTD,	LASTD, LINED AND CURVED	TO
+C			 DRAW FIVE CURVES ON ONE PICTURE USING
+C			 FIVE DIFFERENT	DASHSMTH PATTERNS.  EACH
+C			 CURVE IS CENTERED ABOUT SOLID AXIS LINES AND
+C			 LABELLED WITH THE CHARACTER REPRESENTATION OF
+C			 THE DASHSUPR PATTERN USED.
+C
+C PORTABILITY		 FORTRAN 77
+C
+C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS
+C ORDINATE VALUES OF THE CURVE TO BE PLOTTED.
+C
+      DIMENSION	      X(31)	 ,Y(31)
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C RESET	 INITIALIZES THE MODEL PICTURE ARRAY AND SHOULD	BE CALLED WITH
+C EACH NEW FRAME AND BEFORE THE	OTHER SUBROUTINES OF THE DASHSUPR
+C PACKAGE.
+C
+      CALL RESET
+C
+C
+C SET SOLID DASH PATTERN,  1111111111111111 (BINARY).
+C BOOLEAN OPERATIONS (EMPLOYING	LOCALLY	IMPLEMENTED PLOT PACKAGE
+C SUPPORT ROUTINES) ARE	USED FOR PORTABILITY TO	HOSTS WITH 16 BIT
+C INTEGERS.
+C
+      ISOLID = IOR (ISHIFT (32767,1), 1)
+C
+      DO 130 K=1,5
+	 CALL DASHDB (ISOLID)
+	 ORG =1.07-0.195*K
+C
+C	DRAW CENTRAL AXIS FOR EACH CURVE
+C
+	 CALL FRSTD (.50,ORG-0.03)
+	 CALL VECTD (.50,ORG+0.03)
+	 CALL LASTD
+	 CALL LINED (.109,ORG,.891,ORG)
+C
+C CALL SUBROUTINE DASHDC WITH A	DIFFERENT DASHED LINE AND CHARACTER
+C COMBINATION FOR EACH OF FIVE CURVES
+C
+	 GO TO ( 10, 20, 30, 40, 50),K
+   10	 CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12)
+	 GO TO	60
+   20	 CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12)
+	 GO TO	60
+   30	 CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12)
+	 GO TO	60
+   40	 CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12)
+	 GO TO	60
+   50	 CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12)
+   60	 CONTINUE
+C
+C	COMPUTE	VALUES FOR AND DRAW THE	KTH CURVE
+C
+	 DO  70	I=1,31
+	    THETA = FLOAT(I-1)*3.1415926535897932/15.
+	    X(I) = 0.5+.4*COS(THETA)
+	    Y(I) = ORG+.075*SIN(FLOAT(K)*THETA)
+   70	 CONTINUE
+	 CALL CURVED (X,Y,31)
+C
+C	LABEL EACH CURVE WITH THE APPROPRIATE CHARACTER	REPRESENTATION
+C	OF THE DASHSMTH	PATTERN.  IN THE PATTERN LABELS, A AND D
+C	SHOULD BE INTERPRETED AS APOSTROPHE AND	DOLLAR SIGN.
+C
+C
+C	SET TEXT ALIGNMENT TO CENTER THE STRING	AT THE LEFT OF THE
+C	STRING AND IN THE VERTICAL CENTER
+C
+	CALL GSTXAL(1,3)
+C
+C	SET CHARACTER HEIGHT
+C
+	 CALL GSCHH(.012)
+C
+	 ORY = ORG+.089
+	 GO TO ( 80, 90,100,110,120),K
+   80	 CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1')
+	 GO TO 130
+   90	 CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2')
+	 GO TO 130
+  100	 CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3')
+	 GO TO 130
+  110	 CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4')
+	 GO TO 130
+  120	 CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5')
+C
+  130 CONTINUE
+C
+      CALL GSTXAL(2,3)
+      CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR	DASHSUPR')
+      CALL GTX (.5,.013,'IN IPAT STRINGS, A AND	D SHOULD BE INTERPRETED
+     1AS APOSTROPHE AND	DOLLAR SIGN')
+C
+C ADVANCE FRAME
+C
+      CALL NEWFM
+C
+      IERROR = 0
+      WRITE (6,1001)
+C
+      RETURN
+C
+ 1001 FORMAT ('	  DASHSUPR TEST	SUCCESSFUL',24X,
+     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/ezconrec.x b/sys/gio/ncarutil/tests/ezconrec.x
new file mode 100644
index 00000000..afb0775c
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezconrec.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# T_EZCONREC -- test NCAR contour routine EZCNTR.
+
+procedure t_ezconrec ()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tconre (1, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+
+end
diff --git a/sys/gio/ncarutil/tests/ezhafton.x b/sys/gio/ncarutil/tests/ezhafton.x
new file mode 100644
index 00000000..e1cbbc2c
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezhafton.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+procedure t_ezhafton
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call zhafto (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezhaftont.f b/sys/gio/ncarutil/tests/ezhaftont.f
new file mode 100644
index 00000000..b3fcee3b
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezhaftont.f
@@ -0,0 +1,123 @@
+      SUBROUTINE ZHAFTO	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 EZHAFTON AND TO TEST HAFTON ON A SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL ZHAFTO (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   HAFTON TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE
+C			 HALF-TONE PLOT	ARE PRODUCED ON	THE MACHINE
+C			 GRAPHICS DEVICE.  IN ORDER TO DETERMINE IF THE
+C			 TEST WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 HAFTON
+C FILES
+C
+C LANGUAGE		 ANSI FORTRAN 77
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 THAFTO	CALLS SUBROUTINES EZHFTN AND HAFTON TO
+C			 DRAW TWO HALF-TONE PLOTS OF THE ARRAY Z.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE LEFT	EDGE OF	THE TITLE STRING.
+C
+      DATA TX/0.0762/, TY/0.9769/
+C
+C SPECIFY SOME ARGUMENT	VALUES FOR ROUTINE HAFTON.
+C FLO CONTAINS THE LOW VALUE DESIGNATION FOR HAFTON, FHI
+C CONTAINS THE HIGH VALUE DESIGNATION FOR HAFTON, NLEV
+C SPECIFIES THE	NUMBER OF UNIQUE LEVELS	BETWEEN	FLO AND	FHI,  THE
+C ABSOLUTE VALUE OF NOPT DETERMINES THE	MAPPING	OF Z ONTO THE
+C INTENSITIES, AND THE SIGN OF NOPT CONTROLS THE DIRECTNESS OR
+C INVERSNESS OF	THE MAPPING.
+C
+      DATA FLO/-4.0/, FHI/4.0/,	NLEV/8/, NOPT/-3/
+C
+C
+      SAVE
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANS 0 FOR PLOTTING TITLE
+C
+      CALL GSELNT (0)
+C
+C
+C
+C ENTRY	EZHFTN REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON
+C
+      CALL WTSTR (TX,TY,
+     1		'DEMONSTRATION PLOT FOR	ENTRY EZHFTN OF	HAFTON',2,0,-1)
+      CALL EZHFTN (Z,21,25)
+C
+C ENTRY	HAFTON ALLOWS USER SPECIFICATIONS OF PLOT PARAMETERS, IF DESIRED
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON
+C
+c     CALL GSELNT (0)
+c     CALL WTSTR (TX,TY,
+c    1		'DEMONSTRATION PLOT FOR	ENTRY HAFTON OF	HAFTON',2,0,-1)
+c     CALL HAFTON (Z,21,21,25,FLO,FHI,NLEV,NOPT,0,0,0.)
+c     CALL NEWFM
+C
+c     WRITE (6,1001)
+      RETURN
+C
+C
+c1001 FORMAT ('	    HAFTON TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/ezisosrf.x b/sys/gio/ncarutil/tests/ezisosrf.x
new file mode 100644
index 00000000..21257526
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezisosrf.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine EZISOSRF
+
+procedure t_ezisos()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tisosr (1, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezmapg.x b/sys/gio/ncarutil/tests/ezmapg.x
new file mode 100644
index 00000000..d2f7dce1
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezmapg.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine SUPMAP of the EZMAPG utility.
+
+procedure t_ezmapg()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tsupma (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezmapgt.f b/sys/gio/ncarutil/tests/ezmapgt.f
new file mode 100644
index 00000000..fab53ce0
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezmapgt.f
@@ -0,0 +1,318 @@
+      SUBROUTINE TSUPMA	(IERROR)
+C
+C LATEST REVISION	 AUGUST	1984
+C
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF THE
+C			 SUPMAP	AND MAPDRW ENTRYS OF EZMAPG.
+C
+C USAGE			 CALL TSUPMA (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			 = 0 IF	THE TEST WAS SUCCESSFUL
+C			 = 1 OTHERWISE
+C
+C I/O			 IF EACH CALL TO ROUTINE SUPMAP	RESULTS	IN
+C			 A NORMAL SUPMAP EXIT, THE MESSAGE
+C			   SUPMAP TEST SUCCESSFUL  . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED ON UNIT 6.
+C
+C			 TEN CONTINENTAL OUTLINE PLOTS,	EACH
+C			 RESULTING FROM	A DIFFERENT SPECIFIED
+C			 PROJECTION, ARE PRODUCED ON THE MACHINE
+C			 GRAPHICS DEVICE.
+C			 TO DETERMINE IF THE TEST WAS SUCCESSFUL,
+C			 IT IS NECESSARY TO EXAMINE THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 EZMAPG
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 SUBROUTINE TSUPMA CALLS ROUTINE SUPMAP	ONCE
+C			 FOR EACH OF THE NINE PROJECTION TYPES
+C			 IN SUPMAP.  SPECIFICALLY, THESE ARE
+C			   STEREOGRAPHIC
+C			   ORTHOGRAPHIC
+C			   LAMBERT CONFORMAL CONIC WITH	TWO
+C			     STANDARD PARALLELS
+C			   LAMBERT EQUAL AREA
+C			   GNOMONIC
+C			   AZIMUTHAL EQUIDISTANT
+C			   CYLINDRICAL EQUIDISTANT
+C			   MERCATOR
+C			   MOLLWEIDE TYPE
+C			 THE ROUTINE THEN DEMONSTRATES THE SATELLITE VIEW
+C			 PROJECTION.
+C
+C HISTORY		 WRITTEN OCTOBER, 1976
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C COMMON BLOCK FOR SATELLITE VIEW PROJECTION
+C
+      COMMON /SATMAP/ SL
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT PLOTTER GRID
+C WHERE	THE  COORDINATES RANGE FROM 0.0	TO 1.0,	THE VALUES TX
+C AND TY DEFINE	THE CENTER OF THE TITLE	STRING.
+C
+      DATA TX/0.5/, TY/0.9765/
+C
+C INITIALIZE ERROR FLAG
+C
+      IERROR = 0
+C
+C CHECK	PERFORMANCE CRITERION
+C SPECIFY PARAMETERS BEFORE EACH SUPMAP	CALL
+C
+      IPROJ = 1
+      POLAT = 80.
+      POLONG = -160.
+      ROT = 0.
+      PL1 = 0.
+      PL2 = 0.
+      PL3 = 0.
+      PL4 = 0.
+      JLTS = 1
+      JGRID = 10
+      IUSOUT = -1
+      IDOT = 0
+C
+C SELECT NORMALIZATION TRANS 0 TO WRITE	TITLE
+C
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	STEREOGRAPHIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c     CALL NEWFM
+      IF (IER .EQ. 0) GO TO 10
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   10 CONTINUE
+C
+C
+      IPROJ = 2
+      POLAT = 60.
+      POLONG = -120.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	ORTHOGRAPHIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  20
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   20 CONTINUE
+C
+C
+      IPROJ = -3
+      POLAT = 45.
+      POLONG = -100.
+      ROT = 45.
+      PL1 = 50.
+      PL2 = -130.
+      PL3 = 20.
+      PL4 = -75.
+      JLTS = 2
+      JGRID = 10
+      IUSOUT = 1
+      IDOT = 0
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	      'SUPMAP DEMONSTRATION: LAMBERT CONFORMAL CONIC PROJECTION'
+     2	      ,2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance is handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  30
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   30 CONTINUE
+C
+C
+      IPROJ = 4
+      POLAT = 20.
+      POLONG = -40.
+      ROT = 0.
+      PL1 = 0.
+      PL2 = 0.
+      PL3 = 0.
+      PL4 = 0.
+      JLTS = 1
+      JGRID = 10
+      IUSOUT = -1
+      IDOT = 0
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		'SUPMAP	DEMONSTRATION: LAMBERT EQUAL AREA PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance is handled by calling routine
+c     CALL NEWFM
+c -nooa
+      IF (IER .EQ. 0) GO TO  40
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+C     WRITE (6,1001) IPROJ
+      IERROR = 1
+   40 CONTINUE
+C
+C
+      IPROJ = 5
+      POLAT = 0.
+      POLONG = 0.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	GNOMONIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  50
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   50 CONTINUE
+C
+C
+      IPROJ = 6
+      POLAT = -20.
+      POLONG = 40.
+      JGRID = 5
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	     'SUPMAP DEMONSTRATION: AZIMUTHAL EQUIDISTANT PROJECTION',
+     2	      2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  60
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   60 CONTINUE
+C
+C
+      IPROJ = 8
+      POLAT = -40.
+      POLONG = 80.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	   'SUPMAP DEMONSTRATION: CYLINDRICAL EQUIDISTANT PROJECTION'
+     2	   ,2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  70
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   70 CONTINUE
+C
+C
+      IPROJ = 9
+      POLAT = -60.
+      POLONG = 120.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	MERCATOR PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO  80
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   80 CONTINUE
+C
+C
+      IPROJ = 10
+      POLAT = -80.
+      POLONG = 160.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	MOLLWEIDE TYPE PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+      IF (IER .EQ. 0) GO TO 90
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+c     WRITE (6,1001) IPROJ
+      IERROR = 1
+   90 CONTINUE
+C
+C DEMONSTRATION	OF SATELLITE VIEW PROJECTION
+C
+      SL = 6.5
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'EZMAPG DEMONSTRATION:	SATELLITE VIEW PROJECTION',
+     2		 2,0,0)
+      CALL MAPROJ('OR',0.0,-135.0,0.0)
+      CALL MAPSET('MA',0.0,0.0,0.0,0.0)
+      CALL MAPDRW
+c +noao: frame advance handled by calling routine
+c     CALL NEWFM
+c -noao
+C
+C
+c     IF (IERROR .EQ. 0) WRITE (6,1002)
+c     IF (IERROR .EQ. 1) WRITE (6,1003)
+      RETURN
+C
+C
+c1001 FORMAT ('	SUPMAP RETURNED	ERROR FLAG','	IPROJ=',I4/)
+c1002 FORMAT('	   SUPMAP TEST SUCCESSFUL',24X,
+c    1	     'SEE PLOT TO VERIFY PERFORMANCE')
+c1003 FORMAT ('	    SUPMAP TEST	UNSUCCESSFUL')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/ezmapt.f b/sys/gio/ncarutil/tests/ezmapt.f
new file mode 100644
index 00000000..330fe6e2
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezmapt.f
@@ -0,0 +1,300 @@
+      SUBROUTINE TSUPMA	(IERROR)
+C
+C LATEST REVISION	 AUGUST	1984
+C
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF THE
+C			 SUPMAP	AND MAPDRW ENTRYS OF EZMAPG.
+C
+C USAGE			 CALL TSUPMA (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			 = 0 IF	THE TEST WAS SUCCESSFUL
+C			 = 1 OTHERWISE
+C
+C I/O			 IF EACH CALL TO ROUTINE SUPMAP	RESULTS	IN
+C			 A NORMAL SUPMAP EXIT, THE MESSAGE
+C			   SUPMAP TEST SUCCESSFUL  . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED ON UNIT 6.
+C
+C			 TEN CONTINENTAL OUTLINE PLOTS,	EACH
+C			 RESULTING FROM	A DIFFERENT SPECIFIED
+C			 PROJECTION, ARE PRODUCED ON THE MACHINE
+C			 GRAPHICS DEVICE.
+C			 TO DETERMINE IF THE TEST WAS SUCCESSFUL,
+C			 IT IS NECESSARY TO EXAMINE THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 EZMAPG
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 SUBROUTINE TSUPMA CALLS ROUTINE SUPMAP	ONCE
+C			 FOR EACH OF THE NINE PROJECTION TYPES
+C			 IN SUPMAP.  SPECIFICALLY, THESE ARE
+C			   STEREOGRAPHIC
+C			   ORTHOGRAPHIC
+C			   LAMBERT CONFORMAL CONIC WITH	TWO
+C			     STANDARD PARALLELS
+C			   LAMBERT EQUAL AREA
+C			   GNOMONIC
+C			   AZIMUTHAL EQUIDISTANT
+C			   CYLINDRICAL EQUIDISTANT
+C			   MERCATOR
+C			   MOLLWEIDE TYPE
+C			 THE ROUTINE THEN DEMONSTRATES THE SATELLITE VIEW
+C			 PROJECTION.
+C
+C HISTORY		 WRITTEN OCTOBER, 1976
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C COMMON BLOCK FOR SATELLITE VIEW PROJECTION
+C
+      COMMON /SATMAP/ SL
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT PLOTTER GRID
+C WHERE	THE  COORDINATES RANGE FROM 0.0	TO 1.0,	THE VALUES TX
+C AND TY DEFINE	THE CENTER OF THE TITLE	STRING.
+C
+      DATA TX/0.5/, TY/0.9765/
+C
+C INITIALIZE ERROR FLAG
+C
+      IERROR = 0
+C
+C CHECK	PERFORMANCE CRITERION
+C SPECIFY PARAMETERS BEFORE EACH SUPMAP	CALL
+C
+      IPROJ = 1
+      POLAT = 80.
+      POLONG = -160.
+      ROT = 0.
+      PL1 = 0.
+      PL2 = 0.
+      PL3 = 0.
+      PL4 = 0.
+      JLTS = 1
+      JGRID = 10
+      IUSOUT = -1
+      IDOT = 0
+C
+C SELECT NORMALIZATION TRANS 0 TO WRITE	TITLE
+C
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	STEREOGRAPHIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO 10
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   10 CONTINUE
+C
+C
+      IPROJ = 2
+      POLAT = 60.
+      POLONG = -120.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	ORTHOGRAPHIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  20
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   20 CONTINUE
+C
+C
+      IPROJ = -3
+      POLAT = 45.
+      POLONG = -100.
+      ROT = 45.
+      PL1 = 50.
+      PL2 = -130.
+      PL3 = 20.
+      PL4 = -75.
+      JLTS = 2
+      JGRID = 10
+      IUSOUT = 1
+      IDOT = 0
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	      'SUPMAP DEMONSTRATION: LAMBERT CONFORMAL CONIC PROJECTION'
+     2	      ,2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  30
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   30 CONTINUE
+C
+C
+      IPROJ = 4
+      POLAT = 20.
+      POLONG = -40.
+      ROT = 0.
+      PL1 = 0.
+      PL2 = 0.
+      PL3 = 0.
+      PL4 = 0.
+      JLTS = 1
+      JGRID = 10
+      IUSOUT = 0
+      IDOT = 0
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		'SUPMAP	DEMONSTRATION: LAMBERT EQUAL AREA PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  40
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   40 CONTINUE
+C
+C
+      IPROJ = 5
+      POLAT = 0.
+      POLONG = 0.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	GNOMONIC PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  50
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   50 CONTINUE
+C
+C
+      IPROJ = 6
+      POLAT = -20.
+      POLONG = 40.
+      JGRID = 5
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	     'SUPMAP DEMONSTRATION: AZIMUTHAL EQUIDISTANT PROJECTION',
+     2	      2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  60
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   60 CONTINUE
+C
+C
+      IPROJ = 8
+      POLAT = -40.
+      POLONG = 80.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1	   'SUPMAP DEMONSTRATION: CYLINDRICAL EQUIDISTANT PROJECTION'
+     2	   ,2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  70
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   70 CONTINUE
+C
+C
+      IPROJ = 9
+      POLAT = -60.
+      POLONG = 120.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	MERCATOR PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO  80
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   80 CONTINUE
+C
+C
+      IPROJ = 10
+      POLAT = -80.
+      POLONG = 160.
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'SUPMAP DEMONSTRATION:	MOLLWEIDE TYPE PROJECTION',
+     2		 2,0,0)
+      CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID,
+     1		   IUSOUT,IDOT,IER)
+      CALL FRAME
+      IF (IER .EQ. 0) GO TO 90
+C
+C SUPMAP TEST UNSUCCESSFUL
+C
+      WRITE (6,1001) IPROJ
+      IERROR = 1
+   90 CONTINUE
+C
+C DEMONSTRATION	OF SATELLITE VIEW PROJECTION
+C
+      SL = 6.5
+      CALL GSELNT (0)
+      CALL WTSTR(TX,TY,
+     1		 'EZMAPG DEMONSTRATION:	SATELLITE VIEW PROJECTION',
+     2		 2,0,0)
+      CALL MAPROJ('OR',0.0,-135.0,0.0)
+      CALL MAPSET('MA',0.0,0.0,0.0,0.0)
+      CALL MAPDRW
+      CALL FRAME
+C
+C
+      IF (IERROR .EQ. 0) WRITE (6,1002)
+      IF (IERROR .EQ. 1) WRITE (6,1003)
+      RETURN
+C
+C
+ 1001 FORMAT ('	SUPMAP RETURNED	ERROR FLAG','	IPROJ=',I4/)
+ 1002 FORMAT('	   SUPMAP TEST SUCCESSFUL',24X,
+     1	     'SEE PLOT TO VERIFY PERFORMANCE')
+ 1003 FORMAT ('	    SUPMAP TEST	UNSUCCESSFUL')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/ezsurface.x b/sys/gio/ncarutil/tests/ezsurface.x
new file mode 100644
index 00000000..75abf061
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezsurface.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine EZSRF.
+
+procedure t_ezsurface()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tsrfac (1, error_code)
+	if (error_code == 0)
+	    call printf ("Test of EZSRF successful\n")
+
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezvelvect.x b/sys/gio/ncarutil/tests/ezvelvect.x
new file mode 100644
index 00000000..aeb5a5ab
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezvelvect.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routines EZVELVEC
+
+procedure t_ezvelvect()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tvelvc (1, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/ezytst.x b/sys/gio/ncarutil/tests/ezytst.x
new file mode 100644
index 00000000..b3ac1cb1
--- /dev/null
+++ b/sys/gio/ncarutil/tests/ezytst.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+include	<ctype.h>
+
+# Test NCAR routine AUTOGRAPH - EZXY, EZMXY etc.
+
+task ezytst = t_ezytst
+
+procedure t_ezytst()
+
+char	device[SZ_FNAME], title[SZ_LINE]
+int	wkid, i
+real	y_vector[512]
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	# Construct vector to be plotted
+	do i = 1, 512
+	    y_vector[i] = i
+
+	call strcpy ("TIMING TEST: 512 POINT VECTOR$", title, SZ_LINE)
+	call ezy (y_vector(1), 512, 'Timing Test: 512 Point Vector$')
+
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/hafton.x b/sys/gio/ncarutil/tests/hafton.x
new file mode 100644
index 00000000..63795b22
--- /dev/null
+++ b/sys/gio/ncarutil/tests/hafton.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+procedure t_hafton
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call thafto (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/haftont.f b/sys/gio/ncarutil/tests/haftont.f
new file mode 100644
index 00000000..b4cfe017
--- /dev/null
+++ b/sys/gio/ncarutil/tests/haftont.f
@@ -0,0 +1,123 @@
+      SUBROUTINE THAFTO	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 HAFTON	AND TO TEST HAFTON ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL THAFTO (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   HAFTON TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE
+C			 HALF-TONE PLOT	ARE PRODUCED ON	THE MACHINE
+C			 GRAPHICS DEVICE.  IN ORDER TO DETERMINE IF THE
+C			 TEST WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 HAFTON
+C FILES
+C
+C LANGUAGE		 ANSI FORTRAN 77
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 THAFTO	CALLS SUBROUTINES EZHFTN AND HAFTON TO
+C			 DRAW TWO HALF-TONE PLOTS OF THE ARRAY Z.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE LEFT	EDGE OF	THE TITLE STRING.
+C
+      DATA TX/0.0762/, TY/0.9769/
+C
+C SPECIFY SOME ARGUMENT	VALUES FOR ROUTINE HAFTON.
+C FLO CONTAINS THE LOW VALUE DESIGNATION FOR HAFTON, FHI
+C CONTAINS THE HIGH VALUE DESIGNATION FOR HAFTON, NLEV
+C SPECIFIES THE	NUMBER OF UNIQUE LEVELS	BETWEEN	FLO AND	FHI,  THE
+C ABSOLUTE VALUE OF NOPT DETERMINES THE	MAPPING	OF Z ONTO THE
+C INTENSITIES, AND THE SIGN OF NOPT CONTROLS THE DIRECTNESS OR
+C INVERSNESS OF	THE MAPPING.
+C
+      DATA FLO/-4.0/, FHI/4.0/,	NLEV/8/, NOPT/-3/
+C
+C
+      SAVE
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANS 0 FOR PLOTTING TITLE
+C
+c     CALL GSELNT (0)
+C
+C
+C
+C ENTRY	EZHFTN REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON
+C
+c     CALL WTSTR (TX,TY,
+c    1		'DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON',2,0,-1)
+c     CALL EZHFTN (Z,21,25)
+C
+C ENTRY	HAFTON ALLOWS USER SPECIFICATIONS OF PLOT PARAMETERS, IF DESIRED
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON
+C
+      CALL GSELNT (0)
+      CALL WTSTR (TX,TY,
+     1		'DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON',2,0,-1)
+      CALL HAFTON (Z,21,21,25,FLO,FHI,NLEV,NOPT,0,0,0.)
+c     CALL NEWFM
+C
+c     WRITE (6,1001)
+      RETURN
+C
+C
+c1001 FORMAT ('	    HAFTON TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/isosrf.x b/sys/gio/ncarutil/tests/isosrf.x
new file mode 100644
index 00000000..1216db50
--- /dev/null
+++ b/sys/gio/ncarutil/tests/isosrf.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine ISOSRFHR
+
+procedure t_isosrf()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tisosr (2, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/isosrfhrt.f b/sys/gio/ncarutil/tests/isosrfhrt.f
new file mode 100644
index 00000000..1d8fb249
--- /dev/null
+++ b/sys/gio/ncarutil/tests/isosrfhrt.f
@@ -0,0 +1,165 @@
+      SUBROUTINE TISOHR	(IERROR)
+C
+C LATEST REVISION	 JULY 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 THE  ISOSRFHR	PACKAGE
+C
+C USAGE			 CALL TISOHR (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ISOSRFHR	ROUTINES
+C			   =1 OTHERWISE
+C
+C I/O			 THIS ROUTINE REQUIRES UNIT IUNIT FOR SCRATCH
+C			 PURPOSES.  USERS SHOULD PUT THE UNITS LABELLED
+C			 COMMON	(SEE BELOW) IN THE CALLING PROGRAM,
+C			 AND ALSO SET THE VALUE	OF THE COMMON VARIABLE
+C			 IUNIT IN THE CALLING PROGRAM.
+C
+C			 IF THERE IS A NORMAL EXIT FROM	THE
+C			 ISOSRFHR  ROUTINES THE	MESSAGE
+C			   ISOSRFHR TEST SUCCESSFUL . .	. SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C			 ALSO, A SAMPLE	PLOT IS
+C			 PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  ONE MUST EXAMINE THIS	PLOT
+C			 TO DETERMINE IF THE ROUTINES HAVE
+C			 EXECUTED CORRECTLY.
+C
+C COMMON BLOCKS		 UNITS
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 ISOSRFHR
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 THIS SUBROUTINE USES THE ROUTINES IN
+C			 THE PACKAGE  ISOSRFHR	TO DRAW	A PERSPECTIVE
+C			 DRAWING OF TWO	INTERLOCKING DOUGHNUTS
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+      DIMENSION	      EYE(3)	 ,S(4)	     ,IS2(4,200) ,
+     1		      ST1(81,51,2)	     ,IOBJS(81,51)
+      COMMON /UNITS/  IUNIT
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 1 TO 1024,	THE VALUES IX AND IY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA IX/448/, IY/990/
+C
+C
+C     DEFINE THE EYE POSITION
+C
+      DATA	      EYE(1), EYE(2), EYE(3) / 200., 250., 250.	/
+C
+C     DEFINE THE OVERALL DIMENSION OF THE BOX CONTAINING THE OBJECTS
+C
+      DATA	      NU, NV, NW /  51,	81, 51 /
+C
+C     SPECIFY THE DIMENSIONS OF	THE MODEL OF THE IMAGE PLANE
+C
+      DATA	      LX, NX, NY / 4, 180, 180 /
+C
+C     SPECIFY  CRT  COORDINATES	OF THE AREA WHERE THE PICTURE
+C     IS TO BE DRAWN
+C
+      DATA	      S(1),S(2),S(3),S(4)/ 10.,1010.,10.,1010./
+      DATA	      MV / 81 /
+C
+C     SPECIFY THE LARGE	AND SMALL RADII	FOR THE	INDIVIDUAL DOUGHNUTS
+C
+      DATA	      RBIG1,RBIG2,RSML1,RSML2/ 20., 20., 6., 6.	/
+C
+      SAVE
+C
+C     CALL THE INITIALIZATION ROUTINE
+C
+      CALL INIT3D (EYE,NU,NV,NW,ST1,LX,NY,IS2,IUNIT,S)
+C
+C     INITIALIZE THE ERRROR FLAG
+C
+      IERROR = 1
+C
+C     CREATE AND PLOT DATA FOR TWO INTERLOCKING	DOUGHNUTS
+C
+      JCENT1 = FLOAT(NV)*.5-RBIG1*.5
+      JCENT2 = FLOAT(NV)*.5+RBIG2*.5
+      DO  70 IBKWDS=1,NU
+	 I = NU+1-IBKWDS
+C
+C     CREATE THE I-TH CROSS SECTION IN THE U DIRECTION OF THE
+C     THREE-DIMENSIONAL	ARRAY AND STORE	IN  IOBJS  AS ZEROS AND	ONES
+C
+	 FIMID = I-NU/2
+	 DO  20	J=1,NV
+	    FJMID1 = J-JCENT1
+	    FJMID2 = J-JCENT2
+	    DO	10 K=1,NW
+	       FKMID = K-NW/2
+	       F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1))
+	       F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1))
+	       FIP1 = (1.-F1)*FIMID
+	       FIP2 = (1.-F2)*FIMID
+	       FJP1 = (1.-F1)*FJMID1
+	       FJP2 = (1.-F2)*FJMID2
+	       FKP1 = (1.-F1)*FKMID
+	       FKP2 = (1.-F2)*FKMID
+	       TEMP = AMIN1(FIMID**2+FJP1**2+FKP1**2-RSML1**2,
+     1				      FKMID**2+FIP2**2+FJP2**2-RSML2**2)
+	       IF (TEMP	.LE. 0.) IOBJS(J,K) = 1
+	       IF (TEMP	.GT. 0.) IOBJS(J,K) = 0
+   10	    CONTINUE
+   20	 CONTINUE
+C
+C     SET PROPER WORDS TO  1  FOR DRAWING AXES
+C
+	 IF (I .NE. 1) GO TO  50
+	 DO  30	K=1,NW
+	    IOBJS(1,K) = 1
+   30	 CONTINUE
+	 DO  40	J=1,NV
+	    IOBJS(J,1) = 1
+   40	 CONTINUE
+	 GO TO	60
+   50	 CONTINUE
+	 IOBJS(1,1) = 1
+   60	 CONTINUE
+C
+C     CALL THE DRAW AND	REMEMBER ROUTINE FOR THIS SLAB
+C
+	 CALL DANDR (NV,NW,ST1,LX,NX,NY,IS2,IUNIT,S,IOBJS,MV)
+   70 CONTINUE
+C
+C    TITLE THE PLOT
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = PAU2FX(IX)
+      YC = PAU2FY(IY)
+      CALL WTSTR(XC,YC,'DEMONSTRATION PLOT FOR ISOSRFHR',2,0,0)
+      CALL GSELNT(ICN)
+C
+C     ADVANCE THE PLOTTING DEVICE
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	  ISOSRFHR TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/isosrft.f b/sys/gio/ncarutil/tests/isosrft.f
new file mode 100644
index 00000000..1e99e02e
--- /dev/null
+++ b/sys/gio/ncarutil/tests/isosrft.f
@@ -0,0 +1,137 @@
+      SUBROUTINE TISOSR	(nplot, IERROR)
+C
+C LATEST REVISION	 DECEMBER 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 ISOSRF	AND TO TEST ISOSRF ON A	SINGLE PROBLEM
+C
+C USAGE			 CALL TISOSR (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   ISOSRF TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS WRITTEN ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	SAMPLE
+C			 PLOTS ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 ISOSRF	FROM ULIB LIBRARY
+C FILES
+C
+C LANGUAGE		 STANDARD FORTRAN77
+C
+C HISTORY		 WRITTEN  BY MEMBERS OF	THE
+C			 SCIENTIFIC COMPUTING DIVISION OF NCAR,
+C			 BOULDER COLORADO
+C
+C ALGORITHM		 A FUNCTION OF THREE VARIABLES IS DEFINED, AND
+C			 VALUES	OF THE FUNCTION	ON A THREE DIMENSIONAL
+C			 RECTANGULAR GRID ARE STORED IN	AN ARRAY.  THIS
+C			 SUBROUTINE CALLS EZISOS AND ISOSRF TO DRAW ISO-
+C			 VALUED	SURFACE	PLOTS OF THE FUNCTION.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+      SAVE
+      DIMENSION	      T(21,31,19),SLAB(33,33),EYE(3)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 1 TO 1024,	THE VALUES IX AND IY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      REAL IX,IY
+      DATA IX/.44/, IY/.95/
+C
+      DATA NU,NV,NW/21,31,19/
+      DATA RBIG1,RBIG2,RSML1,RSML2/6.,6.,2.,2./
+      DATA TISO/0./
+      DATA MUVWP2/33/
+      DATA IFLAG/-7/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C FILL THREE DIMENSIONAL ARRAY TO BE PLOTTED
+C
+      JCENT1 = FLOAT(NV)*.5-RBIG1*.5
+      JCENT2 = FLOAT(NV)*.5+RBIG2*.5
+      DO  30 I=1,NU
+	 FIMID = I-NU/2
+	 DO  20	J=1,NV
+	    FJMID1 = J-JCENT1
+	    FJMID2 = J-JCENT2
+	    DO	10 K=1,NW
+	       FKMID = K-NW/2
+	       F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1))
+	       F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1))
+	       FIP1 = (1.-F1)*FIMID
+	       FIP2 = (1.-F2)*FIMID
+	       FJP1 = (1.-F1)*FJMID1
+	       FJP2 = (1.-F2)*FJMID2
+	       FKP1 = (1.-F1)*FKMID
+	       FKP2 = (1.-F2)*FKMID
+	       T(I,J,K)	= AMIN1(FIMID*FIMID+FJP1*FJP1+FKP1*FKP1-
+     1			  RSML1*RSML1,
+     2			    FKMID*FKMID+FIP2*FIP2+FJP2*FJP2-RSML2*RSML2)
+   10	    CONTINUE
+   20	 CONTINUE
+   30 CONTINUE
+C
+C DEFINE EYE POSITION
+C
+      EYE(1) = 100.
+      EYE(2) = 150.
+      EYE(3) = 125.
+C
+C LABEL	THE PLOT TO BE DRAWN BY	EZISOS
+C
+      if (nplot .eq. 1) then
+      CALL GSELNT(0)
+      CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY EZISOS OF ISOSRF',
+     1 2,0,0)
+C
+C TEST EZISOS
+C
+      CALL EZISOS (T,NU,NV,NW,EYE,SLAB,TISO)
+      endif
+C
+C LABEL	THE PLOT TO BE DRAWN BY	ISOSRF
+C
+      if (nplot .eq. 2) then
+      CALL GSELNT(0)
+      CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY ISOSRF OF ISOSRF',
+     1 2,0,0)
+C
+C TEST ISOSRF WITH SUBARRAY OF T
+C
+      MU=NU/2
+      MV=NV/2
+      MW=NW/2
+      MUVWP2=MAX0(MU,MV,MW)+2
+      CALL ISOSRF(T(MU,MV,MW),NU,MU,NV,MV,MW,EYE,MUVWP2,SLAB,TISO,IFLAG)
+      endif
+c     CALL FRAME
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	    ISOSRF TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/mkpkg b/sys/gio/ncarutil/tests/mkpkg
new file mode 100644
index 00000000..79beff4f
--- /dev/null
+++ b/sys/gio/ncarutil/tests/mkpkg
@@ -0,0 +1,65 @@
+# Make the x_ncartest.e executable for testing the NCAR utilities.
+	#conraq.x	<error.h> <gset.h>
+	#conraqt.f
+	#conras.x	<error.h> <gset.h>
+	#conrast.f
+	#conrcqckt.f
+	#conrcsmtht.f
+	#conrcsprt.f
+	#dashchar.x	
+	#dashchart.f
+	#dashlinet.f
+	#dashsuprt.f
+	#ezmapg.x	<error.h> <gset.h>
+	#ezmapgt.f
+	#ezmapt.f
+	#isosrfhrt.f
+
+$update libpkg.a
+$omake	x_ncartest.x
+$link	x_ncartest.o libpkg.a -lncar -lgks -o /tmp2/newncar/x_ncartest.e
+$exit
+
+libpkg.a:
+	auto10t.f
+	autograph.x	<ctype.h> <error.h> <gset.h>
+	autographt.f
+	conran.x	<error.h> <gset.h>
+	conrant.f
+	conrec.x	<error.h> <gset.h>
+	conrect.f
+	dashsmth.x	
+	dashsmtht.f
+	ezconrec.x	<error.h> <gset.h>
+	ezhafton.x	<error.h> <gset.h>
+	ezhaftont.f
+	ezisosrf.x	<error.h> <gset.h>
+	ezsurface.x	<error.h> <gset.h>
+	ezvelvect.x	<error.h> <gset.h>
+	ezytst.x	<ctype.h> <error.h> <gset.h>
+	hafton.x	<error.h> <gset.h>
+	haftont.f
+	isosrf.x	<error.h> <gset.h>
+	isosrft.f
+	oldauto.x	<ctype.h> <error.h> <gset.h>
+	oldautot.f
+	preal.x	
+	pwrity.x	
+	pwrityt.f
+	pwrzit.f
+	pwrzs.x	
+	pwrzst.f
+	pwrztt.f
+	srfacet.f
+	srftest.x	
+	srftestd.x	
+	strmln.x	<error.h> <gset.h>
+	strmlnt.f
+	surface.x	<error.h> <gset.h>
+	threed.x	<error.h> <gset.h>
+	threed2.x	<error.h> <gset.h>
+	threed2t.f
+	threedt.f
+	velvctt.f
+	velvect.x	<error.h> <gset.h>
+	;
diff --git a/sys/gio/ncarutil/tests/oldauto.x b/sys/gio/ncarutil/tests/oldauto.x
new file mode 100644
index 00000000..90287803
--- /dev/null
+++ b/sys/gio/ncarutil/tests/oldauto.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+include	<ctype.h>
+
+# Test NCAR routine AUTOGRAPH - EZXY, EZMXY etc.
+
+procedure t_oldauto()
+
+char	device[SZ_FNAME], command[SZ_LINE]
+int	error_code, wkid
+int	ctoi()
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+		call exmpl1
+		call exmpl2
+		call exmpl3
+		call exmpl4
+		call exmpl5
+		call exmpl6
+		call exmpl7
+		call exmpl8
+		# call exmpl9
+		call xmpl11
+
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/oldautot.f b/sys/gio/ncarutil/tests/oldautot.f
new file mode 100644
index 00000000..168d5f37
--- /dev/null
+++ b/sys/gio/ncarutil/tests/oldautot.f
@@ -0,0 +1,833 @@
+      SUBROUTINE EXMPL1
+C
+C Define the data array.
+C
+      REAL YDRA(1001)
+C
+C Fill the data array.
+C
+      DO 101 I=1,1001
+        X=FLOAT(I)/20.
+        YDRA(I)=10.*(X-1.)*(X-11.)*(X-21.)*(X-31.)*(X-41.)*(X-51.)
+     +                                                 +2.E7*(FRAN()-.5)
+  101 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZY.
+C
+      CALL EZY (YDRA,1001,'EXAMPLE 1 (EZY)$')
+C
+c     STOP
+C
+      END
+      FUNCTION FRAN()
+C
+C Random-number generator.
+C
+      DATA X / 2.7182818 /
+      SAVE X
+      X=AMOD(9821.*X+.211327,1.)
+      FRAN=X
+      RETURN
+      END
+      SUBROUTINE BNDARY
+C
+C Routine to draw the plotter-frame edge.
+C
+      CALL PLOTIT (    0,    0,0)
+      CALL PLOTIT (32767,    0,1)
+      CALL PLOTIT (32767,32767,1)
+      CALL PLOTIT (    0,32767,1)
+      CALL PLOTIT (    0,    0,1)
+      RETURN
+      END
+c
+      SUBROUTINE EXMPL2
+C
+C Define the data arrays.
+C
+      REAL XDRA(4001),YDRA(4001)
+C
+C Fill the data arrays.
+C
+      DO 101 I=1,4001
+        THETA=.0015707963267949*FLOAT(I-1)
+        RHO=SIN(2.*THETA)+.05*SIN(64.*THETA)
+        XDRA(I)=RHO*COS(THETA)
+        YDRA(I)=RHO*SIN(THETA)
+  101 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZXY.
+C
+      CALL EZXY (XDRA,YDRA,4001,'EXAMPLE 2 (EZXY)$')
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPL3
+C
+C Define the data array.
+C
+      REAL YDRA(100,2)
+C
+C Fill the data array.
+C
+      DO 101 I=1,100
+        YDRA(I,1)=COS(3.14159265358979*FLOAT(I)/25.)*FLOAT(I)**2
+        YDRA(I,2)=COS(3.14159265358979*FLOAT(I)/25.)*10.**(.04*FLOAT(I))
+  101 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZMY.
+C
+      CALL EZMY (YDRA,100,2,100,'EXAMPLE 3 (EZMY)$')
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPL4
+C
+C Define the data arrays.
+C
+      REAL XDRA(201),YDRA(201,10)
+C
+C Fill the data arrays.
+C
+      DO 102 I=1,201
+        XDRA(I)=-1.+.02*FLOAT(I-1)
+        IF (I.GT.101) XDRA(I)=2.-XDRA(I)
+        DO 101 J=1,10
+          YDRA(I,J)=FLOAT(J)*SQRT(1.000000000001-XDRA(I)**2)/10.
+          IF (I.GT.101) YDRA(I,J)=-YDRA(I,J)
+  101   CONTINUE
+  102 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZMXY.
+C
+      CALL EZMXY (XDRA,YDRA,201,10,201,'EXAMPLE 4 (EZMXY)$')
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPL5
+C
+C Define the data arrays.
+C
+      REAL XDRA(401,6),YDRA(401,6)
+C
+C Compute required constants.
+C
+      PI=3.14159265358979
+      PID200=PI/200.
+      PITTWO=2.*PI
+      PIT2D3=2.*PI/3.
+      PIT4D3=4.*PI/3.
+      RADOSC=SQRT(3.)/3.
+      RADOLC=SQRT(3.)/2.
+      BSSCLL=ATAN(SQRT(12.)/6.)
+      BSSCUL=ATAN(SQRT(143.)/7.)
+      BSLCLL=ATAN(SQRT(143.)/17.)
+      BSLCUL=ATAN(SQRT(2.0))
+C
+C Fill the data arrays.
+C
+      DO 101 I=1,401
+        THETA=PID200*FLOAT(I-1)
+        XDRA(I,1)=   -.5+RADOSC*COS(THETA)
+        YDRA(I,1)=       RADOSC*SIN(THETA)
+        IF (ABS(THETA       ).GE.BSSCLL.AND.
+     +      ABS(THETA       ).LE.BSSCUL) XDRA(I,1)=1.E36
+        IF (ABS(THETA-PITTWO).GE.BSSCLL.AND.
+     +      ABS(THETA-PITTWO).LE.BSSCUL) XDRA(I,1)=1.E36
+        XDRA(I,2)=    .5+RADOSC*COS(THETA)
+        YDRA(I,2)=       RADOSC*SIN(THETA)
+        IF (ABS(THETA-PIT2D3).GE.BSSCLL.AND.
+     +      ABS(THETA-PIT2D3).LE.BSSCUL) XDRA(I,2)=1.E36
+        XDRA(I,3)=       RADOSC*COS(THETA)
+        YDRA(I,3)=RADOLC+RADOSC*SIN(THETA)
+        IF (ABS(THETA-PIT4D3).GE.BSSCLL.AND.
+     +      ABS(THETA-PIT4D3).LE.BSSCUL) XDRA(I,3)=1.E36
+        XDRA(I,4)=   -.5+RADOLC*COS(THETA)
+        YDRA(I,4)=       RADOLC*SIN(THETA)
+        IF (ABS(THETA       ).GE.BSLCLL.AND.
+     +      ABS(THETA       ).LE.BSLCUL) XDRA(I,4)=1.E36
+        IF (ABS(THETA-PITTWO).GE.BSLCLL.AND.
+     +      ABS(THETA-PITTWO).LE.BSLCUL) XDRA(I,4)=1.E36
+        XDRA(I,5)=    .5+RADOLC*COS(THETA)
+        YDRA(I,5)=       RADOLC*SIN(THETA)
+        IF (ABS(THETA-PIT2D3).GE.BSLCLL.AND.
+     +      ABS(THETA-PIT2D3).LE.BSLCUL) XDRA(I,5)=1.E36
+        XDRA(I,6)=       RADOLC*COS(THETA)
+        YDRA(I,6)=RADOLC+RADOLC*SIN(THETA)
+        IF (ABS(THETA-PIT4D3).GE.BSLCLL.AND.
+     +      ABS(THETA-PIT4D3).LE.BSLCUL) XDRA(I,6)=1.E36
+  101 CONTINUE
+C
+C Specify subscripting of XDRA and YDRA.
+C
+      CALL AGSETI ('ROW.',2)
+C
+C Make sure grid shape is such that one unit in x = one unit in y.
+C
+      CALL AGSETF ('GRID/SHAPE.',2.)
+C
+C Turn off background, then turn labels back on.
+C
+      CALL AGSETF ('BACKGROUND.',4.)
+      CALL AGSETI ('LABEL/CONTROL.',2)
+C
+C Turn off left label.
+C
+      CALL AGSETC ('LABEL/NAME.','L')
+      CALL AGSETI ('LABEL/SUPPRESSION FLAG.',1)
+C
+C Change text of bottom label.
+C
+      CALL AGSETC ('LABEL/NAME.','B')
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','PURITY, BODY, AND FLAVOR$')
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZMXY.
+C
+      CALL EZMXY (XDRA,YDRA,401,6,401,'EXAMPLE 5 (EZMXY)$')
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPL6
+C
+C Define the data arrays.
+C
+      REAL XDRA(501),YDRA(501)
+C
+      CHARACTER*35 GLAB
+      CHARACTER*23 BACK(4)
+      CHARACTER*12 LNLG(4)
+      character*1  tmp
+C Define the graph-window parameter array.
+C
+      REAL GWND (4,4)
+C
+      DATA (GWND(I,1),I=1,4) / 0.0 , 0.5 , 0.5 , 1.0 /
+      DATA (GWND(I,2),I=1,4) / 0.5 , 1.0 , 0.5 , 1.0 /
+      DATA (GWND(I,3),I=1,4) / 0.0 , 0.5 , 0.0 , 0.5 /
+      DATA (GWND(I,4),I=1,4) / 0.5 , 1.0 , 0.0 , 0.5 /
+C
+C Define variables used in setting up informational labels on the graph.
+C
+C
+      DATA BACK(1) / '(PERIMETER BACKGROUND)$' /
+      DATA BACK(2) / '(GRID BACKGROUND)$     ' /
+      DATA BACK(3) / '(HALF-AXIS BACKGROUND)$' /
+      DATA BACK(4) / '(NO BACKGROUND)$       ' /
+C
+      DATA LNLG(1) / 'LINEAR$' /
+      DATA LNLG(2) / 'LOGARITHMIC$' /
+C
+C Fill the data arrays.
+C
+      DO 101 I=1,501
+        THETA=.031415926535898*FLOAT(I-1)
+        XDRA(I)=500.+.9*FLOAT(I-1)*COS(THETA)
+        YDRA(I)=500.+.9*FLOAT(I-1)*SIN(THETA)
+  101 CONTINUE
+C
+C
+C Do four graphs on the same frame, using different backgrounds.
+C
+      DO 102 IGRF = 1,4
+C
+C Suppress the frame advance.
+C
+      CALL AGSETI ('FRAME.',2)
+C
+C Position the graph window.
+C
+        CALL AGSETP ('GRAPH WINDOW.',GWND(1,IGRF),4)
+C
+C Declare the background type.
+C
+        CALL AGSETI ('BACKGROUND TYPE.',IGRF)
+C
+C Setting the background type may have turned the informational labels
+C off.  In that case, turn them back on.
+C
+        IF (IGRF.EQ.4) CALL AGSETI ('LABEL/CONTROL.',2)
+C
+C Set up parameters determining the linear/log nature of the axes.
+C
+        ILLX=(IGRF-1)/2
+        ILLY=MOD(IGRF-1,2)
+C
+C Declare the linear/log nature of the graph.
+C
+        CALL AGSETI ('X/LOGARITHMIC.',ILLX)
+        CALL AGSETI ('Y/LOGARITHMIC.',ILLY)
+C
+C Change the x- and y-axis labels to reflect the linear/log nature of
+C the graph.
+C
+        CALL AGSETC ('LABEL/NAME.','B')
+        CALL AGSETI ('LINE/NUMBER.',-100)
+        CALL AGSETC ('LINE/TEXT.',LNLG(ILLX+1))
+C
+        CALL AGSETC ('LABEL/NAME.','L')
+        CALL AGSETI ('LINE/NUMBER.',100)
+        CALL AGSETC ('LINE/TEXT.',LNLG(ILLY+1))
+C
+C Set up the label for the top of the graph.
+C
+c     WRITE (GLAB,1001) IGRF,BACK(IGRF)
+      glab(1:35) = 'EXAMPLE 6-                         '
+      glab(11:11) = char (igrf + ichar ('0'))
+      glab(13:35) = back (igrf)
+C
+C Draw the graph, using EZXY.
+C
+        CALL EZXY (XDRA,YDRA,501,GLAB)
+C
+  102 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Advance the frame.
+C
+      CALL FRAME
+C
+c     STOP
+C
+C Format for encode.
+C
+c1001 FORMAT ('EXAMPLE 6-',I1,' ',A23)
+      END
+c
+      SUBROUTINE EXMPL7
+C
+C Define the data arrays and the dash-pattern array.
+C
+      REAL XDRA(101),YDRA(101,9)
+      CHARACTER*28 DSHP(9)
+C
+C Declare the type of the dash-pattern-name generator.
+C
+      CHARACTER*16 AGDSHN
+C
+C Fill the data arrays and the dash pattern array.
+C
+      DO 101 I=1,101
+        XDRA(I)=-90.+1.8*FLOAT(I-1)
+  101 CONTINUE
+C
+      DO 103 J=1,9
+c       WRITE (DSHP(J),1001) J
+        dshp(j) = '$$$$$$$$$$$$$$$$$$$$$ J =   '
+	dshp(j)(27:27) = char (j + ichar ('0'))
+        FJ=J
+        DO 102 I=1,101
+          YDRA(I,J)=3.*FJ-(FJ/2700.)*XDRA(I)**2
+  102   CONTINUE
+  103 CONTINUE
+C
+C Turn on windowing.  (Some curves run outside the curve window.)
+C
+      CALL AGSETI ('WINDOWING.',1)
+C
+C Move the edges of the curve window (grid).
+C
+      CALL AGSETF ('GRID/LEFT.'  ,.10)
+      CALL AGSETF ('GRID/RIGHT.' ,.90)
+      CALL AGSETF ('GRID/BOTTOM.',.10)
+      CALL AGSETF ('GRID/TOP.'   ,.85)
+C
+C Set the x and y minimum and maximum.
+C
+      CALL AGSETF ('X/MINIMUM.',-90.)
+      CALL AGSETF ('X/MAXIMUM.',+90.)
+      CALL AGSETF ('Y/MINIMUM.',  0.)
+      CALL AGSETF ('Y/MAXIMUM.', 18.)
+C
+C Set left axis parameters.
+C
+      CALL AGSETI ('LEFT/MAJOR/TYPE.',1)
+      CALL AGSETF ('LEFT/MAJOR/BASE.',3.)
+      CALL AGSETI ('LEFT/MINOR/SPACING.',2)
+C
+C Set right axis parameters.
+C
+      CALL AGSETI ('RIGHT/FUNCTION.',1)
+      CALL AGSETF ('RIGHT/NUMERIC/TYPE.',1.E36)
+C
+C Set bottom axis parameters.
+C
+      CALL AGSETI ('BOTTOM/MAJOR/TYPE.',1)
+      CALL AGSETF ('BOTTOM/MAJOR/BASE.',15.)
+      CALL AGSETI ('BOTTOM/MINOR/SPACING.',2)
+C
+C Set top axis parameters.
+C
+      CALL AGSETI ('TOP/FUNCTION.',1)
+      CALL AGSETF ('TOP/NUMERIC/TYPE.',1.E36)
+C
+C Set up the dash patterns to be used.
+C
+      CALL AGSETI ('DASH/SELECTOR.',9)
+      CALL AGSETI ('DASH/LENGTH.',28)
+      DO 104 I=1,9
+        CALL AGSETC (AGDSHN(I),DSHP(I))
+  104 CONTINUE
+C
+C Set up the left label.
+C
+      CALL AGSETC ('LABEL/NAME.','L')
+      CALL AGSETI ('LINE/NUMBER.',100)
+      CALL AGSETC ('LINE/TEXT.','HEIGHT (KILOMETERS)$')
+C
+C Set up the right label.
+C
+      CALL AGSETC ('LABEL/NAME.','R')
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','PRESSURE (TONS/SQUARE FURLONG)$')
+C
+C Set up the bottom labels.
+C
+      CALL AGSETC ('LABEL/NAME.','B')
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','LATITUDE (DEGREES)$')
+C
+      CALL AGSETC ('LABEL/NAME.','SP')
+      CALL AGSETF ('LABEL/BASEPOINT/X.',.000001)
+      CALL AGSETF ('LABEL/BASEPOINT/Y.',0.)
+      CALL AGSETF ('LABEL/OFFSET/Y.',-.015)
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','SP$')
+C
+      CALL AGSETC ('LABEL/NAME.','NP')
+      CALL AGSETF ('LABEL/BASEPOINT/X.',.999999)
+      CALL AGSETF ('LABEL/BASEPOINT/Y.',0.)
+      CALL AGSETF ('LABEL/OFFSET/Y.',-.015)
+      CALL AGSETI ('LINE/NUMBER.',-100)
+      CALL AGSETC ('LINE/TEXT.','NP$')
+C
+C Set up the top label.
+C
+      CALL AGSETC ('LABEL/NAME.','T')
+      CALL AGSETI ('LINE/NUMBER.',80)
+      CALL AGSETC ('LINE/TEXT.','DISTANCE FROM EQUATOR (MILES)$')
+      CALL AGSETI ('LINE/NUMBER.',90)
+      CALL AGSETC ('LINE/TEXT.',' $')
+      CALL AGSETI ('LINE/NUMBER.',100)
+      CALL AGSETC ('LINE/TEXT.','LINES OF CONSTANT INCRUDESCENCE$')
+      CALL AGSETI ('LINE/NUMBER.',110)
+      CALL AGSETC ('LINE/TEXT.','EXAMPLE 7 (EZMXY)$')
+C
+C Set up centered (box 6) label.
+C
+      CALL AGSETC ('LABEL/NAME.','EQUATOR')
+      CALL AGSETI ('LABEL/ANGLE.',90)
+      CALL AGSETI ('LINE/NUMBER.',0)
+      CALL AGSETC ('LINE/TEXT.','EQUATOR$')
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the graph, using EZMXY.
+C
+      CALL EZMXY (XDRA,YDRA,101,9,101,0)
+C
+c     STOP
+C
+C Format for encode above.
+C
+c1001 FORMAT ('$$$$$$$$$$$$$$$$$$$$$''J''=''',I1,'''')
+C
+      END
+c
+      SUBROUTINE EXMPL8
+C
+C Define the data arrays.
+C
+      REAL XDRA(101),YDRA(4,101)
+C
+C Fill the data arrays.
+C
+      DO 101 I=1,101
+        XDRA(I)=-3.14159265358979+.062831853071796*FLOAT(I-1)
+  101 CONTINUE
+C
+      DO 103 I=1,4
+        FLTI=I
+        BASE=2.*FLTI-1.
+        DO 102 J=1,101
+          YDRA(I,J)=BASE+.75*SIN(-3.14159265358979+.062831853071796*
+     +                                                  FLTI*FLOAT(J-1))
+  102   CONTINUE
+  103 CONTINUE
+C
+C Change the line-end character to a period.
+C
+      CALL AGSETC ('LINE/END.','.')
+C
+C Specify labels for x and y axes.
+C
+      CALL ANOTAT ('SINE FUNCTIONS OF T.','T.',0,0,0,0)
+C
+C Use a half-axis background.
+C
+      CALL AGSETI ('BACKGROUND.',3)
+C
+C Move x axis to the zero point on the y axis.
+C
+      CALL AGSETF ('BOTTOM/INTERSECTION/USER.',0.)
+C
+C Specify base value for spacing of major ticks on x axis.
+C
+      CALL AGSETF ('BOTTOM/MAJOR/BASE.',1.)
+C
+C Run major ticks on x axis to edge of curve window.
+C
+      CALL AGSETF ('BOTTOM/MAJOR/INWARD.',1.)
+      CALL AGSETF ('BOTTOM/MAJOR/OUTWARD.',1.)
+C
+C Position x axis minor ticks.
+C
+      CALL AGSETI ('BOTTOM/MINOR/SPACING.',9)
+C
+C Run the y axis backward.
+C
+      CALL AGSETI ('Y/ORDER.',1)
+C
+C Run plots full-scale in y.
+C
+      CALL AGSETI ('Y/NICE.',0)
+C
+C Have AUTOGRAPH scale x and y data the same.
+C
+      CALL AGSETF ('GRID/SHAPE.',.01)
+C
+C Use the alphabetic set of dashed-line patterns.
+C
+      CALL AGSETI ('DASH/SELECTOR.',-1)
+C
+C Tell AUTOGRAPH how the data arrays are dimensioned.
+C
+      CALL AGSETI ('ROW.',-1)
+C
+C Reverse the roles of the x and y arrays.
+C
+      CALL AGSETI ('INVERT.',1)
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Draw the curves.
+C
+      CALL EZMXY (XDRA,YDRA,4,4,101,'EXAMPLE 8.')
+C
+c     STOP
+C
+      END
+c
+C      SUBROUTINE EXMPL9
+CC
+CC Define the data arrays.
+CC
+C      DIMENSION XDAT(400),YDAT(400)
+CC
+CC Fill the data arrays.
+CC
+C      DO 101 I=1,400
+C        XDAT(I)=(FLOAT(I)-1.)/399.
+C  101 CONTINUE
+CC
+C      CALL GENDAT (YDAT(  1),200,200,1,3,3,+.01,+10.)
+C      CALL GENDAT (YDAT(201),200,200,1,3,3,-10.,-.01)
+CC
+CC The y data ranges over both positive and negative values.  It is
+CC desired that both ranges be represented on the same graph and that
+CC each be shown logarithmically, ignoring values in the range -.01 to
+CC +.01, in which we're not interested.  First we map each y datum into
+CC its absolute value (.01 if the absolute value is too small).  Then we
+CC take the base-10 logarithm, add 2.0001 (so as to be sure of getting a
+CC positive number), and re-attach the original sign.  We can plot the
+CC resulting y data on a linear y axis.
+CC
+C      DO 102 I=1,400
+C        YDAT(I)=SIGN(ALOG10(AMAX1(ABS(YDAT(I)),.01))+2.0001,YDAT(I))
+C  102 CONTINUE
+CC
+CC In order that the labels on the y axis should show the original values
+CC of the y data, we change the user-system-to-label-system mapping on
+CC both y axes and force major ticks to be spaced logarithmically in the
+CC label system (which will be defined by the subroutine AGUTOL in such
+CC a way as to re-create numbers in the original range).
+CC
+C      CALL AGSETI ('LEFT/FUNCTION.',1)
+C      CALL AGSETI ('LEFT/MAJOR/TYPE.',2)
+CC
+C      CALL AGSETI ('RIGHT/FUNCTION.',1)
+C      CALL AGSETI ('RIGHT/MAJOR/TYPE.',2)
+CC
+CC Change the label on the left axis to reflect what's going on.
+CC
+C      CALL AGSETC ('LABEL/NAME.','L')
+C      CALL AGSETI ('LINE/NUMBER.',100)
+C      CALL AGSETC ('LINE/TEXT.','LOG SCALING, POSITIVE AND NEGATIVE$')
+CC
+CC Draw a boundary around the edge of the plotter frame.
+CC
+Cc     CALL BNDARY
+CC
+CC Draw the curve.
+CC
+C      CALL EZXY (XDAT,YDAT,400,'EXAMPLE 9$')
+CC
+Cc     STOP
+CC
+C      END
+Cc
+C      SUBROUTINE GENDAT (DATA,IDIM,M,N,MLOW,MHGH,DLOW,DHGH)
+CC
+CC This is a routine to generate test data for two-dimensional graphics
+CC routines.  Given an array "DATA", dimensioned "IDIM x 1", it fills
+CC the sub-array ((DATA(I,J),I=1,M),J=1,N) with a two-dimensional field
+CC of data having approximately "MLOW" lows and "MHGH" highs, a minimum
+CC value of exactly "DLOW" and a maximum value of exactly "DHGH".
+CC
+CC "MLOW" and "MHGH" are each forced to be greater than or equal to 1
+CC and less than or equal to 25.
+CC
+CC The function used is a sum of exponentials.
+CC
+C      DIMENSION DATA(IDIM,1),CCNT(3,50)
+CC
+C      FOVM=9./FLOAT(M)
+C      FOVN=9./FLOAT(N)
+CC
+C      NLOW=MAX0(1,MIN0(25,MLOW))
+C      NHGH=MAX0(1,MIN0(25,MHGH))
+C      NCNT=NLOW+NHGH
+CC
+C      DO 101 K=1,NCNT
+C        CCNT(1,K)=1.+(FLOAT(M)-1.)*FRAN()
+C        CCNT(2,K)=1.+(FLOAT(N)-1.)*FRAN()
+C        IF (K.LE.NLOW) THEN
+C          CCNT(3,K)=-1.
+C        ELSE
+C          CCNT(3,K)=+1.
+C        END IF
+C  101 CONTINUE
+CC
+C      DMIN=+1.E36
+C      DMAX=-1.E36
+C      DO 104 J=1,N
+C        DO 103 I=1,M
+C          DATA(I,J)=.5*(DLOW+DHGH)
+C          DO 102 K=1,NCNT
+C            DATA(I,J)=DATA(I,J) + .5 * (DHGH-DLOW) * CCNT(3,K) *
+C     +                EXP( - ( ( FOVM*(FLOAT(I)-CCNT(1,K)) )**2 +
+C     +                         ( FOVN*(FLOAT(J)-CCNT(2,K)) )**2   ) )
+C  102     CONTINUE
+C          DMIN=AMIN1(DMIN,DATA(I,J))
+C          DMAX=AMAX1(DMAX,DATA(I,J))
+C  103   CONTINUE
+C  104 CONTINUE
+CC
+C      DO 106 J=1,N
+C        DO 105 I=1,M
+C          DATA(I,J)=(DATA(I,J)-DMIN)/(DMAX-DMIN)*(DHGH-DLOW)+DLOW
+C  105   CONTINUE
+C  106 CONTINUE
+CC
+C      RETURN
+CC
+C      END
+Cc
+C      SUBROUTINE XMPL10
+C      RETURN
+C      END
+Cc
+      SUBROUTINE XMPL11
+C
+C Create a sort of histogram.
+C
+      REAL XDRA(249),YDRA(249),WORK(204),IWRK(204)
+C
+C Fill the data arrays.  First, we define the histogram outline.  This
+C will be used in the call to FILL which fills in the area under the
+C histogram.
+C
+      XDRA(1)=0.
+      YDRA(1)=0.
+C
+      DO 101 I=2,100,2
+        XDRA(I  )=XDRA(I-1)
+        YDRA(I  )=EXP(-16.*(FLOAT(I/2)/50.-.51)**2)+.1*FRAN()
+        XDRA(I+1)=XDRA(I-1)+.02
+        YDRA(I+1)=YDRA(I)
+  101 CONTINUE
+C
+      XDRA(102)=1.
+      YDRA(102)=0.
+C
+C Then, we define lines separating the vertical boxes from each other.
+C
+      NDRA=102
+C
+      DO 102 I=3,99,2
+        XDRA(NDRA+1)=1.E36
+        YDRA(NDRA+1)=1.E36
+        XDRA(NDRA+2)=XDRA(I)
+        YDRA(NDRA+2)=0.
+        XDRA(NDRA+3)=XDRA(I)
+        YDRA(NDRA+3)=AMIN1(YDRA(I),YDRA(I+1))
+        NDRA=NDRA+3
+  102 CONTINUE
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Suppress the frame advance.
+C
+      CALL AGSETI ('FRAME.',2)
+C
+C Draw the graph, using EZXY.
+C
+      CALL EZXY (XDRA,YDRA,249,'EXAMPLE 11 (HISTOGRAM)$')
+C
+C Use the XLIB routine FILL to fill the area defined by the data.  Note
+C that FILL is not a part of the AUTOGRAPH package.
+C
+c     CALL FILLOP ('AN',45)
+c    CALL FILLOP ('SP',128)
+c    CALL FILL (XDRA,YDRA,102,WORK,204,IWRK,204)
+C
+C Advance the frame.
+C
+c     CALL FRAME
+C
+c     STOP
+C
+      END
+c
+      SUBROUTINE EXMPLF
+C
+C Define the data array.
+C
+      DIMENSION XYCD(226)
+C
+C Fill the data array.
+C
+c     READ 1001 , XYCD
+C
+      DO 101 I=1,226
+        IF (XYCD(I).EQ.1.E36) GO TO 101
+        XYCD(I)=2.**((XYCD(I)-15.)/2.5)
+  101 CONTINUE
+C
+C Specify log/log plot.
+C
+      CALL DISPLA (0,0,4)
+C
+C Bump the line-maximum parameter past 42.
+C
+      CALL AGSETI ('LINE/MAXIMUM.',50)
+C
+C Specify x- and y-axis labels, grid background.
+C
+      CALL ANOTAT ('LOGARITHMIC, BASE 2, EXPONENTIAL LABELING$',
+     +             'LOGARITHMIC, BASE 2, NO-EXPONENT LABELING$',2,0,0,0)
+C
+C Specify the graph label.
+C
+      CALL AGSETC ('LABEL/NAME.','T')
+      CALL AGSETI ('LINE/NUMBER.',100)
+      CALL AGSETC ('LINE/TEXT.','FINAL EXAMPLE$')
+C
+C Specify x-axis ticks and labels.
+C
+      CALL AGSETI ('BOTTOM/MAJOR/TYPE.',3)
+      CALL AGSETF ('BOTTOM/MAJOR/BASE.',2.)
+      CALL AGSETI ('BOTTOM/NUMERIC/TYPE.',2)
+      CALL AGSETI ('BOTTOM/MINOR/SPACING.',4)
+c     CALL AGSETI ('BOTTOM/MINOR/PATTERN.',125252B)
+C
+C Specify y-axis ticks and labels.
+C
+      CALL AGSETI ('LEFT/MAJOR/TYPE.',3)
+      CALL AGSETF ('LEFT/MAJOR/BASE.',2.)
+      CALL AGSETI ('LEFT/NUMERIC/TYPE.',3)
+      CALL AGSETI ('LEFT/MINOR/SPACING.',4)
+c     CALL AGSETI ('LEFT/MINOR/PATTERN.',125252B)
+C
+C Compute secondary control parameters.
+C
+      CALL AGSTUP (XYCD(1),1,0,113,2,XYCD(2),1,0,113,2)
+C
+C Draw the background.
+C
+      CALL AGBACK
+C
+C Draw the curve twice to make it darker.
+C
+      CALL AGCURV (XYCD(1),2,XYCD(2),2,113,1)
+      CALL AGCURV (XYCD(1),2,XYCD(2),2,113,1)
+C
+C Draw a boundary around the edge of the plotter frame.
+C
+c     CALL BNDARY
+C
+C Advance the frame.
+C
+c     CALL FRAME
+C
+c     STOP
+C
+C Format.
+C
+c1001 FORMAT (14E5.0)
+C
+      END
+C  1.8  2.1  2.7         1.6  4.2  1.5  5.7  1.9  6.3  2.9  6.5  4.7  6.0  6.7
+C  5.6  8.6  5.4        10.7  5.6 13.1  4.8 11.2  3.7  9.7 1E36 1E36  7.0  8.2
+C  7.7 10.6  8.2        12.6  8.2 14.3  8.0 15.3  7.7 15.6  7.5 15.1  7.4 14.0
+C  7.6 12.3  7.7        10.7  7.9  8.9  8.2  7.3  8.5  4.6  8.5  7.3  8.6  9.3
+C  8.8 10.2  9.1        10.5  9.4 10.1  9.6  9.1  9.9  7.8 10.3  6.9 11.1  7.0
+C 11.7  7.8 12.0         8.6 12.3 10.0 12.5 11.5 12.4 12.7 12.2 13.0 11.9 12.6
+C 11.7 11.7 11.6        10.5 11.7  9.3 12.0  8.6 12.5  8.6 13.0  9.0 13.8 10.1
+C 14.3 11.1 1E36        1E36 18.5 23.4 18.2 23.5 17.8 23.2 17.2 22.6 16.8 21.8
+C 16.0 20.2 15.8        19.5 16.0 19.3 16.6 19.6 17.8 20.6 17.3 19.1 16.9 17.3
+C 16.6 16.0 16.6        14.5 16.8 13.7 17.1 13.1 17.8 13.2 18.4 14.0 19.2 15.5
+C 19.8 16.8 20.3        18.0 20.9 20.1 21.1 18.9 21.1 17.4 21.1 18.9 21.2 19.7
+C  1.5 20.5 21.8        20.8 22.0 20.4 22.1 19.6 22.3 18.7 22.6 18.4 23.1 18.9
+C 23.6 20.0 24.1        21.7 24.7 22.9 25.3 23.9 24.7 22.9 24.4 21.6 24.4 20.6
+C 24.7 20.2 25.2        20.7 25.6 21.5 26.0 22.9 26.4 24.5 26.7 25.9 26.8 27.9
+C 26.6 30.0 26.4        30.3 26.2 30.0 25.7 28.0 25.5 26.1 25.3 24.9 25.3 23.9
+C 25.4 22.9 25.9        22.5 26.6 22.4 27.4 23.1 28.2 24.0 29.0 25.0 30.1 26.4
+C 1E36 1E36
diff --git a/sys/gio/ncarutil/tests/preal.x b/sys/gio/ncarutil/tests/preal.x
new file mode 100644
index 00000000..79d33218
--- /dev/null
+++ b/sys/gio/ncarutil/tests/preal.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+procedure preal (tval, rval)
+
+char	tval[ARB]
+real	rval
+
+begin
+	call eprintf ("%s %.4f\n")
+	    call pargstr (tval)
+	    call pargr (rval)
+end
diff --git a/sys/gio/ncarutil/tests/pwrity.x b/sys/gio/ncarutil/tests/pwrity.x
new file mode 100644
index 00000000..3b5c1437
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrity.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+# Test NCAR routines PWRITY
+
+procedure t_pwrity()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+int	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tpwry (error_code)
+
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/pwrityt.f b/sys/gio/ncarutil/tests/pwrityt.f
new file mode 100644
index 00000000..5b033933
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrityt.f
@@ -0,0 +1,90 @@
+      SUBROUTINE TPWRY (IERROR)
+C
+C LATEST REVISION	 JULY 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 ENTRY PWRITY OF PWRITY	AND
+C			 TO TEST PWRITY	ON A SIMPLE PROBLEM
+C
+C USAGE			 CALL TPWRY (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   PWRITY TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS WRITTEN TO UNIT 6.
+C			 IN ADDITION, ONE FRAME	CONTAINING
+C			 CHARACTER STRING PLOTS	IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  IN ORDER TO
+C			 DETERMINE WHETHER THE TEST WAS	SUCCESSFUL,
+C			 IT IS NECESSARY TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 PWRITY
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TPWRY CALLS PWRITY TO PLOT VARIOUS CHARACTER
+C			 STRINGS USING DIFFERENT PARAMETERS.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C INITIALIZE THE ERROR PARAMETER.
+C
+      IERROR = 0
+C
+C DEFINE NORMALIZATION TRANS 1 AND LOG SCALING
+C
+      CALL GSVP	(1, 0.0, 1.0, 0.0, 1.0)
+      CALL GSWN	(1, 1.0, 1024.0, 1.0, 1024.0)
+      CALL GSELNT (1)
+      CALL SETUSV ('LS',1)
+C
+C LABEL	FRAME
+C
+      CALL PWRITY(512.0,950.0,
+     1		  'DEMONSTRATION PLOT FOR PWRITY',
+     2		  29,2,0,0)
+C
+C TEST PWRITY FOR DIFFERENT SIZE CHARACTERS.
+C
+      CALL PWRITY (10.0,900.0,'SIZE TEST',9,0,0,-1)
+      CALL PWRITY (10.0,850.0,'SIZE TEST',9,1,0,-1)
+      CALL PWRITY (10.0,775.0,'SIZE TEST',9,2,0,-1)
+      CALL PWRITY (10.0,675.0,'SIZE TEST',9,3,0,-1)
+      CALL PWRITY (10.0,525.0,'SIZE TEST',9,4,0,-1)
+      CALL PWRITY (10.0,375.0,'SIZE TEST',9,5,0,-1)
+C
+C TEST PWRITY FOR DIFFERENT CHARACTER ORIENTATIONS.
+C
+      CALL PWRITY (600.0,600.0,'THETA TEST',10,2,0*90,-1)
+      CALL PWRITY (600.0,600.0,'THETA TEST',10,2,1*90,-1)
+      CALL PWRITY (600.0,600.0,'THETA TEST',10,2,2*90,-1)
+      CALL PWRITY (600.0,600.0,'THETA TEST',10,2,3*90,-1)
+C
+C TEST CENTERING OPTIONS FOR PWRITY.
+C
+      CALL PWRITY (512.0,160.0,'CENTR TEST',10,2,0,0)
+      CALL PWRITY (512.0,85.0,'CENTR TEST',10,2,0,-1)
+      CALL PWRITY (512.0,235.0,'CENTR TEST',10,2,0,1)
+c
+c     CALL NEWFM
+C
+c      WRITE (6,1001)
+      RETURN
+C
+c 1001 FORMAT ('	PWRITY TEST SUCCESSFUL',24X,
+c     1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/pwrzit.f b/sys/gio/ncarutil/tests/pwrzit.f
new file mode 100644
index 00000000..7c96e926
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrzit.f
@@ -0,0 +1,132 @@
+      SUBROUTINE TPWRZI	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 PWRZI IN CONJUNCTION WITH ISOSRF
+C
+C USAGE			 CALL TPWRZI (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   PWRZI TEST SUCCESSFUL  . . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, ONE FRAME	CONTAINING THE SAMPLE
+C			 PLOT IS PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 PWRZI,	ISOSRF
+C FILES
+C
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 A FUNCTION OF THREE VARIABLES IS DEFINED, AND
+C			 VALUES	OF THE FUNCTION	ON A THREE DIMENSIONAL
+C			 RECTANGULAR GRID ARE STORED IN	AN ARRAY.  THIS
+C			 SUBROUTINE THEN CALLS ISOSRF TO DRAW AN
+C			 ISO-VALUED SURFACE PLOT OF THE	FUNCTION,
+C			 THEN PWRZI IS CALLED THREE TIMES TO
+C			 LABEL THE FRONT, SIDE,	AND BACK OF THE
+C			 PICTURE.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+      DIMENSION	      T(21,31,19),SLAB(33,33),EYE(3)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA TX/0.4375/, TY/0.9667/
+C
+      DATA NU,NV,NW/21,31,19/
+      DATA RBIG1,RBIG2,RSML1,RSML2/6.,6.,2.,2./
+      DATA TISO/0./
+      DATA MUVWP2/33/
+      DATA IFLAG/-7/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C FILL THREE DIMENSIONAL ARRAY TO BE PLOTTED
+C
+      JCENT1 = FLOAT(NV)*.5-RBIG1*.5
+      JCENT2 = FLOAT(NV)*.5+RBIG2*.5
+      DO  30 I=1,NU
+	 FIMID = I-NU/2
+	 DO  20	J=1,NV
+	    FJMID1 = J-JCENT1
+	    FJMID2 = J-JCENT2
+	    DO	10 K=1,NW
+	       FKMID = K-NW/2
+	       F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1))
+	       F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1))
+	       FIP1 = (1.-F1)*FIMID
+	       FIP2 = (1.-F2)*FIMID
+	       FJP1 = (1.-F1)*FJMID1
+	       FJP2 = (1.-F2)*FJMID2
+	       FKP1 = (1.-F1)*FKMID
+	       FKP2 = (1.-F2)*FKMID
+	       T(I,J,K)	= AMIN1(FIMID*FIMID+FJP1*FJP1+FKP1*FKP1-
+     1			  RSML1*RSML1,
+     2			    FKMID*FKMID+FIP2*FIP2+FJP2*FJP2-RSML2*RSML2)
+   10	    CONTINUE
+   20	 CONTINUE
+   30 CONTINUE
+C
+C DEFINE EYE POSITION
+C
+      EYE(1) = 100.
+      EYE(2) = 150.
+      EYE(3) = 125.
+C
+C SELECT NORMALIZATION TRANS NUMBER 0
+C
+      CALL GSELNT (0)
+C
+C
+C LABEL	THE PLOT
+C
+      CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR	PWRZI',2,0,0)
+C
+C TEST ISOSRF WITH SUBARRAY OF T
+C
+      MU = NU/2
+      MV = NV/2
+      MW = NW/2
+      MUVWP2 = MAX0(MU,MV,MW)+2
+      CALL ISOSRF (T(MU,MV,MW),NU,MU,NV,MV,MW,EYE,MUVWP2,SLAB,TISO,
+     1		   IFLAG)
+      ISIZE = 35
+      CALL PWRZI (5.,16.,.5,'FRONT',5,ISIZE,-1,3,0)
+      CALL PWRZI (11.,7.5,.5,'SIDE',4,ISIZE,2,-1,0)
+      CALL PWRZI (5.,1.,5.,' BACK BACK BACK BACK BACK',25,ISIZE,-1,3,0)
+      CALL SETUSV ('XF',10)
+      CALL SETUSV ('YF',10)
+      CALL NEWFM
+      IERROR = 0
+C
+c     WRITE (6,1001)
+      RETURN
+C
+C
+c1001 FORMAT ('	     PWRZI TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/pwrzs.x b/sys/gio/ncarutil/tests/pwrzs.x
new file mode 100644
index 00000000..f2eeec96
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrzs.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+# Test NCAR routines PWRZS
+
+procedure t_przs()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+int	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tpwrzs (error_code)
+
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	else
+	    call printf ("Test was not successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/pwrzst.f b/sys/gio/ncarutil/tests/pwrzst.f
new file mode 100644
index 00000000..4067ed86
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrzst.f
@@ -0,0 +1,127 @@
+      SUBROUTINE TPWRZS	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 PWRZS IN CONJUNCTION WITH SRFACE.
+C
+C USAGE			 CALL TPWRZS (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST WAS SUCCESSFUL, THE MESSAGE
+C
+C			   PWRZS TEST SUCCESSFUL  . . .	 SEE PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, ONE FRAME	CONTAINING THE SAMPLE
+C			 PLOT IS PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 PWRZS,	SRFACE
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 A FUNCTION OF TWO VARIABLES IS	DEFINED, AND
+C			 VALUES	OF THE FUNCTION	ON A TWO DIMENSIONAL
+C			 RECTANGULAR GRID ARE STORED IN	AN ARRAY.  THIS
+C			 SUBROUTINE CALLS  SRFACE  TO DRAW A SURFACE
+C			 REPRESENTATION	OF THE ARRAY VALUES, AND THEN
+C			 PWRZS IS CALLED THREE TIMES TO	LABEL THE
+C			 FRONT,	SIDE, AND BACK OF THE PICTURE.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+      DIMENSION	      Z(20,30)	 ,X(20)	     ,Y(30)	 ,MM(20,30,2),
+     1		      S(6)
+C
+C LOAD THE SRFACE COMMON BLOCK,	NEEDED TO SURPRESS NEWFM CALL
+C
+      COMMON /SRFIP1/ IFR	 ,ISTP	     ,IROTS	 ,IDRX	     ,
+     1		      IDRY	 ,IDRZ	     ,IUPPER	 ,ISKIRT     ,
+     2		      NCLA	 ,THETA	     ,HSKIRT	 ,CHI	     ,
+     3		      CLO	 ,CINC	     ,ISPVAL
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES  TX	AND
+C TY  DEFINE THE CENTER	OF THE TITLE STRING.
+C
+      DATA TX/0.4375/, TY/0.9667/
+C
+C SPECIFY GRID LOOP INDICES, AND LINE OF SIGHT
+C
+      DATA M/20/, N/30/
+      DATA S/4.,5.,3.,0.,0.,0./
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C DEFINE FUNCTION VALUES AND STORE IN Z
+C
+      DO  10 I=1,M
+	 X(I) =	-1.+FLOAT(I-1)/FLOAT(M-1)*2.
+   10 CONTINUE
+      DO  20 J=1,N
+	 Y(J) =	-1.+FLOAT(J-1)/FLOAT(N-1)*2.
+   20 CONTINUE
+      DO  40 J=1,N
+	 DO  30	I=1,M
+	    Z(I,J) = EXP(-2.*SQRT(X(I)**2+Y(J)**2))
+   30	 CONTINUE
+   40 CONTINUE
+C
+C SET SRFACE PARAMETERS	TO SURPRESS FRAME CALL AND DRAW	CONTOURS
+      call srfabd
+C
+      IFR = 0
+      IDRZ = 1
+C
+C SELECT NORMALIZATION TRANS NUMBER 0
+C
+      CALL GSELNT (0)
+C
+C LABEL	THE PLOT
+C
+      CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR PWRZS',2,0,0)
+C
+C DRAW SURFACE PLOT
+C
+      CALL SRFACE (X,Y,Z,MM,M,M,N,S,0.)
+C
+C PUT PWRZS LABELS ON PICTURE
+C
+      ISIZE = 35
+      CALL PWRZS (0.,1.1,0.,'FRONT',5,ISIZE,-1,3,0)
+      CALL PWRZS (1.1,0.,0.,'SIDE',4,ISIZE,2,-1,0)
+      CALL PWRZS (0.,-1.1,.2,' BACK BACK BACK BACK BACK',25,ISIZE,-1,
+     1		  3,0)
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+C
+C RESTORE SRFACE PARAMETERS TO DEFAULT
+C
+      IFR = 1
+      IDRZ = 0
+C
+      RETURN
+C
+C
+c1001 FORMAT ('	     PWRZS TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/pwrztt.f b/sys/gio/ncarutil/tests/pwrztt.f
new file mode 100644
index 00000000..dcf43638
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrztt.f
@@ -0,0 +1,116 @@
+      SUBROUTINE TPWRZT	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 PWRZT IN CONJUNCTION WITH THREED.
+C
+C USAGE			 CALL TPWRZT (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   PWRZT TEST SUCCESSFUL  . . .	 SEE PLOT
+C			   TO VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, ONE FRAME	CONTAINING THE
+C			 CHARACTER PLOT	IS PRODUCED ON THE
+C			 MACHINE GRAPHICS DEVICE.  TO DETERMINE
+C			 IF THE	TEST IS	SUCCESSFUL, IT IS NECESSARY
+C			 TO EXAMINE THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 PWRZT,	THREED
+C FILES
+C
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 TPWRZT	CALLS SUBROUTINES SET3 AND LINE3 FROM
+C			 THE ULIB THREED PACKAGE TO ESTABLISH THE
+C			 THREE SPACE-TO-TWO SPACE TRANSFORMATION
+C			 AND TO	DRAW AXIS LINES.  TPWRZT NEXT CALLS
+C			 SUBROUTINE PWRZT FROM THE ULIB	THREED
+C			 PACKAGE TO LABEL THE AXES FOR A THREE SPACE
+C			 PLOT.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C EYE CONTAINS THE (U,V,Z) COORDINATE OF THE EYE POSITION
+C
+      REAL	      EYE(3)
+      DATA EYE(1), EYE(2), EYE(3) /3.5,	3.0, 5.0/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C SELECT NORMALIZATION TRANS NUMBER 0
+C
+      CALL GSELNT (0)
+C
+C SUBROUTINE SET3 ESTABLISHES THE MAPPING OF THREE SPACE COORDINATES
+C ONTO THE GRAPHICS DEVICE COORDINATE SYSTEM.
+C
+      CALL SET3	(.1,.9,.1,.9,0.,1.,0.,1.,0.,1.,EYE)
+C
+C THE FOLLOWING	THREE CALLS TO LINE3 DRAW THE THREE SPACE AXES
+C
+      CALL LINE3 (0.,0.,0.,0.,0.,1.)
+      CALL LINE3 (0.,0.,0.,0.,1.,0.)
+      CALL LINE3 (0.,0.,0.,1.,0.,0.)
+C
+C SUBROUTINE PWRZ IS USED TO LABEL EACH	OF THE AXES AND	THE PLOT
+C ON INPUT TO PWRZ,
+C THE FIRST THREE PARAMETERS AND ICNT DETERMINE	THE POSITION OF	THE
+C CHARACTER STRING.
+C ISIZE	DETERMINES THE CHARACTER SIZE.
+C LINE AND ITOP	DETERMINE THE DIRECTION	AND PLANE OF THE CHARACTERS.
+C
+C
+      ICNT = 0
+      ISIZE = 30
+      LINE = 2
+      ITOP = 3
+      CALL PWRZT (0.,.5,.1,'V-AXIS',6,ISIZE,LINE,ITOP,ICNT)
+C
+      LINE = -1
+      ITOP = 3
+      CALL PWRZT (.5,0.,.1,'U-AXIS',6,ISIZE,LINE,ITOP,ICNT)
+C
+      LINE = 3
+      ITOP = -2
+      CALL PWRZT (0.,.1,.5,'Z-AXIS',6,ISIZE,LINE,ITOP,ICNT)
+C
+      LINE = 2
+      ITOP = -1
+      ISIZE = 30
+      ICNT = -1
+      CALL PWRZT (.5,.2,0.,'DEMONSTRATION OF PWRZT WITH	THREED',
+     1		  34,ISIZE,LINE,ITOP,ICNT)
+C
+C A CALL TO NEWFM INDICATES THAT THE PICTURE IS	COMPLETE
+C
+      CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+C
+      RETURN
+C
+C
+C
+c1001 FORMAT ('	     PWRZT TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/srf.com b/sys/gio/ncarutil/tests/srf.com
new file mode 100644
index 00000000..d1b4288c
--- /dev/null
+++ b/sys/gio/ncarutil/tests/srf.com
@@ -0,0 +1,4 @@
+int	ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, ncla, hskirt, ispval
+real	theta, chi, clo, cinc
+common  /srfip1/ ifr, istp, irots, idrx, idry, idrz, iupper, iskirt,
+	  ncla, theta, hskirt, chi, clo, cinc, ispval
diff --git a/sys/gio/ncarutil/tests/srfacet.f b/sys/gio/ncarutil/tests/srfacet.f
new file mode 100644
index 00000000..4e5bad00
--- /dev/null
+++ b/sys/gio/ncarutil/tests/srfacet.f
@@ -0,0 +1,150 @@
+      SUBROUTINE TSRFAC	(nplot, IERROR)
+C
+C LATEST REVISION	 MARCH 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 SRFACE	AND TO TEST SRFACE ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL TSRFAC (IERROR)
+C
+C ARGUMENTS
+c +noao: additional input parameter
+c			 nplot
+c		 	   = 1, EZSRF is demonstrated
+c			   = 2, SRFACE is demonstrated
+c
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST IS SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   SRFACE TEST SUCCESSFUL  . . .  SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C
+C			 IN ADDITION, TWO FRAMES CONTAINING THE
+C			 SURFACE PLOT ARE PRODUCED ON THE MACHINE
+C			 GRAPHICS DEVICE.  IN ORDER TO DETERMINE
+C			 IF THE	TEST WAS SUCCESSFUL, IT	IS
+C			 NECESSARY TO EXAMINE THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 SRFACE
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C HISTORY		 FIRST WRITTEN IN APRIL	1979, CONVERTED	TO
+C			 FORTRAN 77 AND	GKS IN MARCH 1984.
+C
+C ALGORITHM		 THE FUNCTION
+C
+C			   Z(X,Y) = .25*(X + Y + 1./((X-.1)**2+Y**2+.09)
+C					  - 1./((X+.1)**2+Y**2+.09))
+C
+C			 IS EVALUATED FOR
+C			   X = -1. TO 1. IN INCREMENTS OF .1 AND
+C			   Y = -1.2 TO 1.2 IN INCREMENTS OF .1.
+C			 TSRFAC	CALLS SUBROUTINES EZSRFC AND SRFACE
+C			 ONCE.	EACH CALL PRODUCES A SURFACE PLOT
+C			 OF THE	ARRAY Z.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C XX CONTAINS THE X-DIRECTION COORDINATE VALUES	FOR Z(X,Y),  YY	CONTAINS
+C THE Y-DIRECTION COORDINATE VALUES FOR	Z(X,Y),	 Z CONTAINS THE	FUNCTION
+C VALUES,  S CONTAINS VALUES FOR THE LINE OF SIGHT FOR ENTRY SRFACE,
+C WORK IS A WORK ARRAY,	 ANGH CONTAINS THE ANGLE IN DEGREES IN THE X-Y
+C PLANE	TO THE LINE OF SIGHT,  ANGV CONTAINS THE ANGLE IN DEGREES FROM
+C THE X-Y PLANE	TO THE LINE OF SIGHT.
+C
+      REAL	      XX(21)	 ,YY(25)     ,Z(21,25)	 ,S(6)	     ,
+     1		      WORK(1096)
+C
+      DATA  S(1), S(2),	S(3), S(4), S(5), S(6)/
+     1	    -8.0, -6.0,	 3.0,  0.0,  0.0,  0.0/
+C
+      DATA  ANGH/45./, ANGV/15./
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE COORDINATES RANGE	FROM 0.	TO 1., THE VALUES CX AND CY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA CX/.405/, CY/.97/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL XX AND YY COORDINATE ARRAYS AND Z FUNCTION VALUE	ARRAY
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 XX(I) = X
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    YY(J) = Y
+	    Z(I,J) = (X+Y+1./((X-.1)**2+Y**2+.09)-
+     1					    1./((X+.1)**2+Y**2+.09))*.25
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT(0)
+C
+C EZSRFC DEMO
+C
+C LABEL	THE PLOT FOR ENTRY EZSRFC
+C
+C SET TEXT ALIGNMENT TO	CENTER THE STRING AT THE STRING	CENTER
+C AND IN THE VERTICAL CENTER
+C
+      CALL GSTXAL(2,3)
+C
+C SET CHARACTER	HEIGHT
+C
+      CALL GSCHH(.016)
+C
+C PLOT CHARACTERS
+C
+      if (nplot .eq. 1) then
+      CALL GTX(CX,CY,'DEMONSTRATION PLOT FOR EZSRFC ENTRY OF SRFACE')
+      CALL EZSRFC (Z,21,25,ANGH,ANGV,WORK)
+      endif
+C
+C
+C SRFACE DEMO
+C
+C LABEL	THE PLOT FOR ENTRY SRFACE
+C
+C SET TEXT ALIGNMENT TO	CENTER THE STRING AT THE STRING	CENTER
+C AND IN THE VERTICAL CENTER
+C
+      CALL GSTXAL(2,3)
+C
+C SET CHARACTER	HEIGHT
+C
+      CALL GSCHH(.016)
+C
+C PLOT CHARACTERS
+C
+      if (nplot .eq. 2) then
+      CALL GTX(CX,CY,'DEMONSTRATION PLOT FOR SRFACE ENTRY OF SRFACE')
+      CALL SRFACE (XX,YY,Z,WORK,21,21,25,S,0.)
+      endif
+C
+c     WRITE (6,1001)
+C
+      RETURN
+C
+C1001 FORMAT ('	    SRFACE TEST	SUCCESSFUL',24X,
+C    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/srftest.x b/sys/gio/ncarutil/tests/srftest.x
new file mode 100644
index 00000000..cf1496b7
--- /dev/null
+++ b/sys/gio/ncarutil/tests/srftest.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+procedure srf_test()
+
+char	temp[SZ_LINE]
+real    z[20,30], x[20], y[30], s[6]
+int	mm[20,30,2]
+real	tx, ty
+int	i, j, m, n, isize
+real	xt, yt, dum
+
+int	ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, ncla, hskirt, ispval
+real	theta, chi, clo, cinc
+common  /srfip1/ ifr, istp, irots, idrx, idry, idrz, iupper, iskirt,
+	  ncla, theta, hskirt, chi, clo, cinc, ispval
+
+begin
+      # Some initialization that was originally in data statements:
+      tx = 0.4375
+      ty = 0.9667
+      m = 20
+      n = 30
+      s[1] = 4.0
+      s[2] = 5.0
+      s[3] = 3.0
+      s[4] = 0.0
+      s[5] = 0.0
+      s[6] = 0.0
+
+      # Define function values and store in z
+      DO  I=1,M
+	 X(I) =	-1.+FLOAT(I-1)/FLOAT(M-1)*2.
+   
+      DO  J=1,N
+	 Y(J) =	-1.+FLOAT(J-1)/FLOAT(N-1)*2.
+   
+      DO  J=1,N {
+	 DO  I=1,M
+	    Z(I,J) = EXP(-2.*SQRT(X(I)**2+Y(J)**2))
+      }
+
+      # Initialize block data before changing parameters.
+      call srfabd
+
+      IFR = 0
+      IDRZ = 1
+
+      CALL GSELNT (0)
+      call f77pak ("DEMONSTRATION PLOT FOR PWRZS", temp, SZ_LINE)
+      CALL WTSTR (TX,TY,temp,2,0,0)
+
+      CALL SRFACE (X,Y,Z,MM,M,M,N,S,0.)
+#
+# PUT PWRZS LABELS ON PICTURE
+#
+      ISIZE = 35
+      call f77pak ("FRONT", temp, SZ_LINE)
+      CALL PWRZS (0.,1.1,0.,temp,5,ISIZE,-1,3,0)
+      call f77pak ("SIDE", temp, SZ_LINE)
+      CALL PWRZS (1.1,0.,0.,temp,4,ISIZE,2,-1,0)
+      call f77pak (" BACK BACK BACK BACK BACK", temp, SZ_LINE)
+      CALL PWRZS (0.,-1.1,.2,temp,25,ISIZE,-1,3,0)
+#
+# RESTORE SRFACE PARAMETERS TO DEFAULT
+#
+      IFR = 1
+      IDRZ = 0
+end
diff --git a/sys/gio/ncarutil/tests/srftestd.x b/sys/gio/ncarutil/tests/srftestd.x
new file mode 100644
index 00000000..8c22ff92
--- /dev/null
+++ b/sys/gio/ncarutil/tests/srftestd.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task srftest = t_srftest
+
+define	DUMMY	6
+
+# Rewrite of pwrzs.t.f in spp to check things out.  
+
+procedure t_srftest()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+int	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call srf_test()
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/strmln.x b/sys/gio/ncarutil/tests/strmln.x
new file mode 100644
index 00000000..2835d211
--- /dev/null
+++ b/sys/gio/ncarutil/tests/strmln.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine STRMLN
+
+procedure t_strmln()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tstrml (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/strmlnt.f b/sys/gio/ncarutil/tests/strmlnt.f
new file mode 100644
index 00000000..f2b40c69
--- /dev/null
+++ b/sys/gio/ncarutil/tests/strmlnt.f
@@ -0,0 +1,101 @@
+      SUBROUTINE TSTRML	(IERROR)
+C
+C LATEST REVISION	 JUNE 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 ROUTINE STRMLN.
+C
+C USAGE			 CALL TSTRML (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ROUTINE STRMLN.
+C			   =1 OTHERWISE
+C
+C I/O			 IF THERE IS A NORMAL EXIT FROM	THE ROUTINE
+C			 STRMLN	THE MESSAGE
+C			   STRMLN TEST SUCCESSFUL . . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C PRECISION		 SINGLE
+C
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 ROUTINE TSTRML	CALLS ROUTINE STRMLN TO
+C			 PRODUCE A PLOT	REPRESENTING THE  FLOW AND
+C			 MAGNITUDE OF A	VECTOR FIELD.
+C
+C PORTABILITY		 FORTRAN77
+C
+C
+C
+      REAL	      U(21,25)	 ,V(21,25)   ,WRK(1050)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA TX/.5/,TY/.9765/
+C
+C     SET DIMENSIONS
+C
+      DATA NH,NV/21,25/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C SPECIFY HORIZONTAL AND VERTICAL VECTOR COMPONENTS U AND V ON
+C THE RECTANGULAR GRID
+C
+      TPIMX = 2.*3.14/FLOAT(NH)
+      TPJMX = 2.*3.14/FLOAT(NV)
+      DO  20 J=1,NV
+	 DO  10	I=1,NH
+	 U(I,J)	= SIN(TPIMX*(FLOAT(I)-1.))
+	 V(I,J)	= SIN(TPJMX*(FLOAT(J)-1.))
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT (0)
+C
+C CALL WTSTR FOR STRMLN	PLOT TITLE
+C
+      CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR ROUTINE STRMLN',2,
+     1		  0,0)
+C
+C DEFINE NORMALIZATION TRANSFORMATION 1, AND SET UP LOG	SCALING
+C
+      CALL GSVP	( 1, 0.1, 0.9, 0.1, 0.9	)
+      CALL GSWN	( 1, 1.0, 21., 1.0, 25.	)
+      CALL SETUSV ( 'LS' , 1 )
+C
+C SELECT NORMALIZATION TRANSFORMATION 1
+C
+      CALL GSELNT (1)
+C
+C     DRAW PERIMETER
+C
+c     CALL PERIM(1,0,1,0)
+C
+C CALL STRMLN FOR VECTOR FIELD STREAMLINES PLOT
+C
+      CALL STRMLN (U,V,WRK,NH,NH,NV,0,IER)
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	    STRMLN TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/surface.x b/sys/gio/ncarutil/tests/surface.x
new file mode 100644
index 00000000..07b25e9a
--- /dev/null
+++ b/sys/gio/ncarutil/tests/surface.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routines SRFACE.
+
+procedure t_surface()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tsrfac (2, error_code)
+	if (error_code == 0)
+	    call printf ("Test of SRFACE successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/threed.x b/sys/gio/ncarutil/tests/threed.x
new file mode 100644
index 00000000..a22d51da
--- /dev/null
+++ b/sys/gio/ncarutil/tests/threed.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine THREED
+
+procedure t_threed()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tthree (error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/threed2.x b/sys/gio/ncarutil/tests/threed2.x
new file mode 100644
index 00000000..224fd2c3
--- /dev/null
+++ b/sys/gio/ncarutil/tests/threed2.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routine THREED with extra test program tst3d2
+
+procedure t_threed2()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tst3d2 ()
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/threed2t.f b/sys/gio/ncarutil/tests/threed2t.f
new file mode 100644
index 00000000..baaa8f78
--- /dev/null
+++ b/sys/gio/ncarutil/tests/threed2t.f
@@ -0,0 +1,26 @@
+	subroutine tst3d2 ()
+	real eye(3)
+	dimension u(50), v(50), w(50)
+	data eye /5., -10., 4./
+	isiz = 36
+	xs = 90. / 1024.
+	xe = 1010. / 1024.
+	ys = 90. / 1024.
+	ye = 1010. / 1024.
+	call tick43 (24, 16, 24, 16, 24, 16)
+c	call set3 (90, 1010, 90, 1010, 0., 2., -1., 1., 0., 1., eye)
+	call set3 (xs, xe, ys, ye, 0., 2., -1., 1., 0., 1., eye)
+	do 1 i = 1, 50
+	    u(i) = float(i) * .04
+	    v(i) = sin (u(i) * 6.) * float (80 - i) / 80.
+	    w(i) = .5 + sin (u(i) *3.141592) * .5
+  1	continue
+	call perim3 (2,5,1,5,1,0.)
+	call perim3 (2,5,1,5,2,-1.)
+	call perim3 (2,5,2,5,3,0.)
+	call pwrzt (2.1, -1., 0., 3hU->, 3, isiz, 1,3,-1)
+	call pwrzt (0., 1.1, 0., 3hV->, 3, isiz, 2,3,0)
+	call pwrzt (0., -1., 1.1, 2hW , 2, isiz, 3, -1, 0)
+	call fence3 (u, v, w, 50, 3, 0.)
+	end
+
diff --git a/sys/gio/ncarutil/tests/threedt.f b/sys/gio/ncarutil/tests/threedt.f
new file mode 100644
index 00000000..0cb6532d
--- /dev/null
+++ b/sys/gio/ncarutil/tests/threedt.f
@@ -0,0 +1,129 @@
+      SUBROUTINE TTHREE	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 THE ROUTINE THREED.
+C
+C USAGE			 CALL TTHREE (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ROUTINE THREED.
+C			   =1 OTHERWISE
+C
+C I/O			 IF THERE IS A NORMAL EXIT FROM	THE ROUTINE
+C			 THREED	THE MESSAGE
+C			   THREED TEST SUCCESSFUL . . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C PRECISION		 SINGLE
+C
+C LANGUAGE		 FORTRAN
+C
+C HISTORY		 ORIGINALLY WRITTEN NOVEMBER 1976
+C			 CONVERTED TO GKS AND FORTRAN 77 JULY 1984
+C
+C ALGORITHM		 ROUTINE TTHREE	CALLS SET3 TO ESTABLISH	A
+C			 MAPPING BETWEEN THE PLOTTER ADDRESSES AND
+C			 THE USER'S VOLUME, AND	TO INDICATE THE
+C			 COORDINATES OF	THE EYE	POSITION FROM
+C			 WHICH THE LINES TO BE DRAWN ARE VIEWED.
+C			 NEXT, THE VOLUME PERIMETERS AND ASSOCIATED
+C			 TICK MARKS ARE	DRAWN BY CALLS TO PERIM3.
+C			 THEN THE LINES	ARE DRAWN.  THESE ARE
+C			 CERTAIN LATITUDES AND LONGITUDES OF A
+C			 SPHERE.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C
+C
+      REAL EYE(3),X(31),Y(31),Z(31)
+C
+C SPECIFY ARGUMENT VALUES TO BE	USED BY	ROUTINE	SET3.  ON AN
+C ABSTRACT PLOTTER WITH	AN ADDRESS RANGE OF 0. TO 1. IN	EACH
+C COORDINATE DIRECTION,	THE VALUES  RXA, RXB, RYA, AND RYB
+C DEFINE THE PORTION OF	THE ADDRESS SPACE TO BE	USED IN	MAKING
+C THE PLOT.  UC, UD, VC, VD, WC, WD  DEFINE A VOLUME IN	USER
+C COORDINATES WHICH IS TO BE MAPPED ONTO THE PORTION OF	THE
+C VIEWING SURFACE AS SPECIFIED BY  RXA,	RXB, RYA, AND RYB.
+C
+      DATA RXA/0.097656/, RXB/0.90236/,	RYA/0.097656/, RYB/0.90236/
+      DATA UC/-1./, UD/1./, VC/-1./, VD/1./, WC/-1./, WD/1./
+      DATA EYE(1),EYE(2),EYE(3)/10.,6.,3./
+      DATA TX/0.4374/, TY/0.9570/
+C
+C DEFINE PI
+      DATA PI/3.1415926535898/
+C
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT (0)
+C
+C CALL SET3 TO ESTABLISH A MAPPING BETWEEN THE PLOTTER ADDRESSES
+C AND THE USER'S VOLUME, AND TO	INDICATE THE COORDINATES OF THE
+C EYE POSITION FROM WHICH THE LINES TO BE DRAWN	ARE VIEWED.
+C
+      CALL SET3(RXA,RXB,RYA,RYB,UC,UD,VC,VD,WC,WD,EYE)
+C
+C CALL PERIM3 TO DRAW PERIMETER	LINES AND TICK MARKS
+C
+      CALL PERIM3(2,5,1,10,1,-1.)
+      CALL PERIM3(4,2,1,1,2,-1.)
+      CALL PERIM3(2,10,4,5,3,-1.)
+C
+C DEFINE AND DRAW LATITUDINAL LINES ON THE SPHERE OF RADIUS ONE
+C HAVING CENTER	(0.,0.,0.)
+C
+      DO 10 J=1,18
+      THETA = FLOAT(J)*PI/9.
+      CT = COS(THETA)
+      ST = SIN(THETA)
+      DO 20 K=1,31
+      PHI = FLOAT(K-16)*PI/30.
+      Z(K) = SIN(PHI)
+      CP = COS(PHI)
+      X(K) = CT*CP
+      Y(K) = ST*CP
+   20 CONTINUE
+      CALL CURVE3(X,Y,Z,31)
+   10 CONTINUE
+C
+C DEFINE AND DRAW LONGITUDINAL LINES ON	THE SPHERE OF RADIUS ONE
+C HAVING CENTER	(0.,0.,0.)
+C
+      DO 30 K=1,5
+      PHI = FLOAT(K-3)*PI/6.
+      SP = SIN(PHI)
+      CP = COS(PHI)
+      DO 40 J=1,31
+      TUETA = FLOAT(J-1)*PI/15.
+      X(J) = COS(TUETA)*CP
+      Y(J) = SIN(TUETA)*CP
+      Z(J) = SP
+   40 CONTINUE
+      CALL CURVE3(X,Y,Z,31)
+   30 CONTINUE
+C
+C CALL WTSTR FOR THREED	PLOT TITLE
+C
+      CALL WTSTR(TX,TY,'DEMONSTRATION PLOT FOR ROUTINE THREED',2,0,0)
+      call pwrzt (1.,0.,-1.,'DEMONSTRATION PLOT FOR ROUTINE THREED', 37,
+     * 2, 2, 3, 0)
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE(6,1001)
+      RETURN
+C
+c1001 FORMAT('	   THREED TEST SUCCESSFUL', 24X,
+c    1	     'SEE PLOT TO VERIFY PERFORMANCE')
+      END
diff --git a/sys/gio/ncarutil/tests/velvctt.f b/sys/gio/ncarutil/tests/velvctt.f
new file mode 100644
index 00000000..36e22d28
--- /dev/null
+++ b/sys/gio/ncarutil/tests/velvctt.f
@@ -0,0 +1,126 @@
+      SUBROUTINE TVELVC	(nplot, IERROR)
+C
+C LATEST REVISION   JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 SUBROUTINES VELVCT AND	EZVEC.
+C
+C USAGE			 CALL TVELVC (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ROUTINES VELVCT AND EZVEC
+C			   =1 OTHERWISE
+C
+C I/O			 IF THERE IS A NORMAL EXIT FROM	THE ROUTINES
+C			 VELVCT	AND EZVEC THE MESSAGE
+C			   VELVCT TEST SUCCESSFUL . . .	SEE PLOTS TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C PRECISION		 SINGLE
+C
+C LANGUAGE		 FORTRAN
+C
+C HISTORY		 ORIGINALLY WRITTEN NOVEMBER 1976
+C
+C ALGORITHM		 ROUTINE TVELVC	CALLS ROUTINES EZVEC AND
+C			 VELVCT	ONCE.  EACH CALL PRODUCES A PLOT
+C			 REPRESENTING A	VECTOR FIELD.  THE VECTOR
+C			 FIELD IS OBTAINED FROM	THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09),
+C			 BY USING THE DIRECTION	OF THE Z GRADIENT
+C			 VECTORS AND THE LOGARITHM OF THE ABSOLUTE
+C			 VALUE OF THE COMPONENTS.
+C
+C
+C
+C
+      DIMENSION	      U(21,25)	 ,V(21,25)
+C
+C SPECIFY COORDS FOR PLOT TITLES
+C
+	DATA IX/94/,IY/1000/
+C
+C SPECIFY SOME OF THE ARGUMENTS	IN VELVCT CALLING SEQUENCE
+C
+      DATA FLO/0./,HI/0./,NSET/0/,LENGTH/0/,ISPV/0/,SPV/0./
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C SPECIFY VELOCITY FIELD FUNCTIONS U AND V
+C
+      M	= 21
+      N	= 25
+      DO  20 I=1,M
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,N
+	    Y =	.1*FLOAT(J-13)
+	    DZDX = 1.-2.*(X-.10)/((X-.10)**2+Y**2+.09)**2+
+     1		   2.*(X+.10)/((X+.10)**2+Y**2+.09)**2
+	    DZDY = 1.-2.*Y/((X-.10)**2+Y**2+.09)**2+
+     1		   2.*Y/((X+.10)**2+Y**2+.09)**2
+	    UVMAG = ALOG(SQRT(DZDX*DZDX+DZDY*DZDY))
+	    UVDIR = ATAN2(DZDY,DZDX)
+	    U(I,J) = UVMAG*COS(UVDIR)
+	    V(I,J) = UVMAG*SIN(UVDIR)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C CALL WTSTR FOR EZVEC PLOT TITLE
+C
+c +noao: flag used to plot either velvct or ezvec
+	if (nplot .eq. 1) then
+	CALL GQCNTN(IERR,ICN)
+	CALL GSELNT(0)
+c       X = PAU2FX(IX)
+	x = cpux (ix)
+c       Y = PAU2FY(IY)
+        y = cpuy (iy)
+      CALL WTSTR (X,Y,'DEMONSTRATION PLOT FOR ENTRY EZVEC OF VELVCT',
+     1		 2,0,-1)
+	CALL GSELNT(ICN)
+C
+C CALL EZVEC FOR VELOCITY FIELD	PLOT
+C
+      CALL EZVEC (U,V,M,N)
+      endif
+c -noao
+C
+C CALL VELVCT FOR VELOCITY FIELD PLOT
+C
+c +noao: flag used to plot either velvct or ezvec
+      if (nplot .eq. 2) then
+      CALL VELVCT (U,M,V,M,M,N,FLO,HI,NSET,LENGTH,ISPV,SPV)
+C
+C CALL WTSTR FOR VELVCT	PLOT TITLE
+C
+	CALL GQCNTN(IERR,ICN)
+	CALL GSELNT(0)
+c       X = PAU2FX(IX)
+        x = cpux (ix)
+c       Y = PAU2FY(IY)
+        y = cpuy (iy)
+      CALL WTSTR (X,Y,
+     1		 'DEMONSTRATION PLOT FOR ENTRY VELVCT OF VELVCT',2,
+     2		 0,-1)
+	CALL GSELNT(ICN)
+	endif
+c -noao
+c
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	    VELVCT TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOTS TO VERIFY PERFORMANCE')
+C
+      END
diff --git a/sys/gio/ncarutil/tests/velvect.x b/sys/gio/ncarutil/tests/velvect.x
new file mode 100644
index 00000000..d09f1c08
--- /dev/null
+++ b/sys/gio/ncarutil/tests/velvect.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	DUMMY	6
+
+include	<error.h>
+include	<gset.h>
+
+# Test NCAR routines VELVEC
+
+procedure t_velvect()
+
+char	device[SZ_FNAME]
+int	error_code, wkid
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+
+	call gopks (STDERR)
+	wkid = 1
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	call tvelvc (2, error_code)
+	if (error_code == 0)
+	    call printf ("Test successful\n")
+	
+	call gdawk (wkid)
+	call gclwk (wkid)
+	call gclks ()
+end
diff --git a/sys/gio/ncarutil/tests/x_ncartest.x b/sys/gio/ncarutil/tests/x_ncartest.x
new file mode 100644
index 00000000..cc8b727f
--- /dev/null
+++ b/sys/gio/ncarutil/tests/x_ncartest.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# These tasks temporarily deleted: conraq = t_conraq, conras = t_conras,
+	  #ezmapg = t_ezmapg,
+
+task	  conran = t_conran,
+       autograph = t_autograph,
+	 oldauto = t_oldauto,
+	dashsmth = t_dashsmth,
+	   pwrzs = t_przs,
+	  srface = t_surface,
+	ezsrface = t_ezsurface,
+	  conrec = t_conrec,
+	ezconrec = t_ezconrec,
+	  hafton = t_hafton,
+	  isosrf = t_isosrf,
+	ezisosrf = t_ezisos,
+	ezhafton = t_ezhafton,
+	  pwrity = t_pwrity,
+	  threed = t_threed,
+	 threed2 = t_threed2,
+	  velvec = t_velvect,
+	ezvelvec = t_ezvelvect,
+	  strmln = t_strmln
diff --git a/sys/gio/ncarutil/threbd.f b/sys/gio/ncarutil/threbd.f
new file mode 100644
index 00000000..5dbce5e0
--- /dev/null
+++ b/sys/gio/ncarutil/threbd.f
@@ -0,0 +1,56 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data threbd changed to run time initialization
+        subroutine threbd
+c     BLOCKDATA THREBD
+      COMMON /TEMPR/  RZERO
+      COMMON /SET31/  ISCALE     ,XMIN       ,XMAX   ,YMIN,
+     1                YMAX       ,BIGD       ,R0     ,NLX,
+     2                NBY        ,NRX        ,NTY
+      COMMON /TCK31/  TMAGU      ,TMINU      ,TMAGV  ,TMINV,
+     1                TMAGW      ,TMINW
+      COMMON /THRINT/ ITHRMJ     ,ITHRMN     ,ITHRTX
+c +noao: following flag added to prevent over-initialization
+      logical first
+      SAVE
+      data first /.true./
+      if (.not. first) then
+        return
+      endif
+      first = .false.
+
+c     DATA RZERO/0./
+      RZERO = 0.
+c
+c     DATA NLX,NBY,NRX,NTY/10,10,1010,1010/
+      NLX = 10
+      NBY = 10
+      NRX = 1010
+      NTY = 1010   
+c
+c     DATA TMAGU,TMINU,TMAGV,TMINV,TMAGW,TMINW/12.,8.,12.,8.,12.,8./
+      TMAGU = 12.
+      TMINU =  8.
+      TMAGV = 12.
+      TMINV =  8.
+      TMAGW = 12.
+      TMINW =  8.
+c
+c     DATA ITHRMJ,ITHRMN,ITHRTX/ 1,1,1/
+      ITHRMJ = 2
+      ITHRMN = 1
+      ITHRTX = 1
+c
+c -noao
+      END
diff --git a/sys/gio/ncarutil/threed.f b/sys/gio/ncarutil/threed.f
new file mode 100644
index 00000000..3b5061f4
--- /dev/null
+++ b/sys/gio/ncarutil/threed.f
@@ -0,0 +1,826 @@
+      SUBROUTINE SET3 (XA,XB,YA,YB,ULO,UHI,VLO,VHI,WLO,WHI,EYE)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C THREE-DIMENSIONAL LINE DRAWING PACKAGE
+C
+C
+C LATEST REVISION        JULY, 1984
+C
+C PURPOSE                THREED IS A PACKAGE OF SUBROUTINES THAT
+C                        PROVIDES LINE DRAWING CAPABILITIES IN
+C                        THREE-SPACE.
+C
+C USAGE                  EACH ENTRY POINT IN THIS PACKAGE IS
+C                        DESCRIBED BELOW.
+C
+C                        SET3 (XA,XB,YA,YB,UC,UD,VC,VD,WC,WD,EYE)
+C
+C                          XA, XB, YA, YB  DEFINE THE PORTION OF THE
+C                          PLOTTING SURFACE INTO WHICH THE USER'S
+C                          PLOT WILL BE PLACED.  THESE VALUES SHOULD
+C                          BE IN THE RANGE 0. TO 1.  FOR EXAMPLE, IF
+C                          ONE WANTS THE PLOT TO OCCUPY THE MAXIMUM
+C                          PLOTTING SURFACE, SET XA=0., YA=0., XB=1.,
+C                          YB=1.; IF ONE WANTS THE PLOT TO APPEAR IN
+C                          THE LOWER LEFT CORNER OF THE PLOTTING
+C                          SURFACE, SET XA=0., YA=0., XB=.5, YB=.5 .
+C
+C                          UC, UD, VC, VD, WC, AND WD DEFINE A
+C                          VOLUME IN USER-COORDINATE SPACE WHICH
+C                          WILL BE TRANSFORMED ONTO THE PLOTTING
+C                          SURFACE DEFINED BY XA, XB, YA, YB.
+C
+C                          EYE IS AN ARRAY, 3 WORDS LONG, CONTAINING THE
+C                          U, V, AND W COORDINATES OF THE EYE POSITION.
+C                          ALL LINES IN THE PLOT ARE DRAWN AS VIEWED
+C                          FROM THE EYE.  EYE IS SPECIFIED IN USER
+C                          COORDINATES AND SHOULD BE OUTSIDE THE BOX
+C                          DEFINED BY UC, UD, VC, VC, WC, AND WD.
+C
+C                        CURVE3 (U,V,W,N)
+C
+C                          DRAWS A CURVE THROUGH N POINTS.  THE
+C                          POINTS ARE DEFINED BY THE LINEAR ARRAYS
+C                          U, V, AND W WHICH ARE DIMENSIONED N OR
+C                          GREATER.
+C
+C                        LINE3 (UA,VA,WA,UB,VB,WB)
+C
+C                          DRAWS A LINE CONNECTING THE COORDINATES
+C                          (UA,VA,WA)  AND  (UB,VB,WB).
+C
+C                        FRST3 (U,V,W)
+C
+C                          POSITIONS THE PEN TO (U,V,W).
+C
+C                        VECT3 (U,V,W)
+C
+C                          DRAWS A LINE BETWEEN THE CURRENT PEN
+C                          POSITION AND THE POINT (U,V,W).  THE
+C                          CURRENT PEN POSITION BECOMES (U,V,W).
+C                          NOTE THAT A CURVE CAN BE DRAWN BY USING
+C                          A FRST3 CALL FOLLOWED BY A SEQUENCE OF
+C                          VECT3 CALLS.
+C
+C                        POINT3 (U,V,W)
+C
+C                          PLOTS A POINT AT (U,V,W) .
+C
+C                        PERIM3 (MAGR1,MINR1,MAGR2,MINR2,IWHICH,VAR)
+C
+C                          DRAWS A PERIMETER WITH TICK MARKS.
+C
+C                          IWHICH DESIGNATES THE NORMAL VECTOR TO THE
+C                          PERIMETER DRAWN (1=U, 2=V, 3=W).
+C
+C                          VAR IS THE VALUE ON THE AXIS SPECIFIED BY
+C                          INWHICH WHERE THE PERIMETER IS TO BE DRAWN.
+C
+C                          MAGR1  AND  MAGR2  SPECIFY THE
+C                          NUMBER OF MAJOR TICK MARKS TO BE DRAWN IN
+C                          THE TWO COORDINATE DIRECTIONS.
+C
+C                          MINR1  AND  MINR2  SPECIFY THE NUMBER
+C                          OF MINOR TICKS BETWEEN EACH MAJOR TICK.
+C
+C                          MAGR1, MAGR2, MINR1 AND MINR2
+C                          ARE SPECIFIED BY THE NUMBER
+C                          OF DIVISIONS(HOLES), NOT THE NUMBER OF
+C                          TICKS.  SO IF MAGR1=1, THERE WOULD BE NO
+C                          MAJOR DIVISIONS.
+C
+C                        TICK43 (MAGU,MINU,MAGV,MINV,MAGW,MINW)
+C
+C                          TICK43 ALLOWS PROGRAM CONTROL OF TICK
+C                          MARK LENGTH IN SUBROUTINE PERIM3.
+C                          MAGU, MAGV, MAGW SPECIFY THE LENGTH,
+C                          IN PLOTTER ADDRESS UNITS OF MAJOR
+C                          DIVISION TICK MARKS ON THE U, V, AND W
+C                          AXES.  MINU, MINV, MINW SPECIFY THE LENGTH,
+C                          IN PLOTTER ADDRESS UNITS OF MINOR
+C                          DIVISION TICK MARKS ON THE U, V, AND
+C                          W AXES.
+C
+C                        FENCE3 (U,V,W,N,IOREN,BOT)
+C
+C                          THIS ENTRY IS USED TO DRAW A LINE IN THREE-
+C                          SPACE AS WELL AS A "FENCE" BETWEEN THE
+C                          LINE AND A PLANE NORMAL TO ONE OF THE
+C                          COORDINATE AXES.
+C
+C                          THE ARGUMENTS U, V, W AND N
+C                          ARE THE SAME AS FOR CURVE, DESCRIBED ABOVE.
+C
+C                          IOREN SPECIFIES THE DIRECTION IN WHICH THE
+C                          FENCE LINES ARE TO BE DRAWN (1 INDICATES
+C                          PARALLEL TO THE U-AXIS, 2 INDICATES PARALLEL
+C                          TO THE V-AXIS, AND 3 INDICATES PARALLEL TO
+C                          TO THE W-AXIS.)
+C
+C                          BOT SPECIFIES WHERE THE BOTTOM OF THE FENCE
+C                          IS TO BE DRAWN.
+C                          IF THE FENCE LINES ARE TO BE DRAWN PARALLEL
+C                          TO THE W-AXIS, AND  BOT=2., THEN THE BOTTOM
+C                          OF THE FENCE WOULD BE THE PLANE  W=2.
+C
+C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
+C
+C NOTES                  .  FOR DRAWING CHARACTERS IN CONJUNCTION
+C                           WITH THREED, USE THE COMPANION ROUTINE
+C                           PWRZT.
+C
+C ENTRY POINTS          FENCE3, TRN32T, FRST3, VECT3, LIN3,
+C                       POINT3, CURVE3, PSYM3, PERIM3, LINE3W,
+C                       DRAWT, TICK43, TICK3, THREBD
+C
+C COMMON BLOCKS         TEMPR, SET31, PWRZ1T, TCK31, PRM31, THRINT
+C
+C REQUIRED LIBRARY      PWRZ AND THE SPPS
+C ROUTINES
+C
+C HISTORY               WRITTEN AND STANDARDIZED IN NOVEMBER 1973.
+C I/O                   PLOTS LINES.
+C
+C PRECISION             SINGLE
+C
+C LANGUAGE              FORTRAN
+C
+C ACCURACY              + OR -.5 PLOTTER ADDRESS UNITS PER CALL.
+C                       THERE IS NO CUMULATIVE ERROR.
+C
+C PORTABILITY           ANSI FORTRAN 77
+C
+C
+C
+C
+C
+      SAVE
+C
+      COMMON /TEMPR/  RZERO
+C
+      DIMENSION       EYE(3)
+C
+      COMMON /SET31/  ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0         ,NLX        ,
+     2                NBY        ,NRX        ,NTY
+      COMMON /PWRZ1T/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+C
+C
+      AVE(A,B) = (A+B)*.5
+C
+C ARITHMETIC STATEMENT FUNCTION FOR SCALING
+C
+      SU(UTEMP) = UTEMP
+      SV(VTEMP) = VTEMP
+      SW(WTEMP) = WTEMP
+C
+C +NOAO - Blockdata threbd rewritten as run time initialization.
+C
+C     EXTERNAL        THREBD
+      call threbd
+C -NOAO
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','SET3','VERSION  1')
+C
+C SET UP FRAME SIZE
+C
+      NLX = XA*1023.+1.
+      NRX = XB*1023.+1.
+      NBY = YA*1023.+1.
+      NTY = YB*1023.+1.
+C
+C CONSTANTS FOR PWRZT
+C
+      UUMIN = ULO
+      UUMAX = UHI
+      VVMIN = VLO
+      VVMAX = VHI
+      WWMIN = WLO
+      WWMAX = WHI
+      EYEU = EYE(1)
+      EYEV = EYE(2)
+      EYEW = EYE(3)
+C
+C FIND CORNERS IN 2-SPACE FOR 3-SPACE BOX CONTAINING OBJECT
+C
+      ISCALE = 0
+      ATU = AVE(SU(UUMIN),SU(UUMAX))
+      ATV = AVE(SV(VVMIN),SV(VVMAX))
+      ATW = AVE(SW(WWMIN),SW(WWMAX))
+      BIGD = 0.
+      IF (RZERO .LE. 0.) GO TO  10
+C
+C RELATIVE SIZE FEATURE IN USE.  THIS SECTION OF CODE IS NEVER
+C EXECUTED UNLESS RZERO IS SET POSITIVE IN THE CALLING PROGRAM
+C VIA COMMON BLOCK TEMPR.  RZERO  IS THE DISTANCE BETWEEN THE
+C OBSERVER AND THE POINT LOOKED AT (CENTER OF THE BOX BY DEFAULT)
+C WHEN THE INPUT BOX IS TO FILL THE SCREEN WHEN VIEWED FROM THE
+C DIRECTION WHICH MAKES THE BOX BIGGEST.  RZERO  IS THUS TO
+C BE USED TO DETERMINE THE SHAPE OF THE OBJECT.   THIS SECTION
+C OF CODE IS TO BE USED WHEN IT IS DESIRED TO KEEP THE VIEWED
+C OBJECT IN RELATIVE PERSPECTIVE ACROSS FRAMES--E.G. IN MAKING
+C MOVIES.
+C
+      ALPHA = -(VVMIN-ATV)/(UUMIN-ATU)
+      VVEYE = -RZERO/SQRT(1.+ALPHA*ALPHA)
+      UUEYE = VVEYE*ALPHA
+      VVEYE = VVEYE+ATV
+      UUEYE = UUEYE+ATU
+      WWEYE = ATW
+      CALL TRN32T (ATU,ATV,ATW,UUEYE,VVEYE,WWEYE,1)
+      CALL TRN32T (UUMIN,VVMIN,ATW,XMIN,DUMM,DUMM,2)
+      CALL TRN32T (UUMAX,VVMIN,WWMIN,DUMM,YMIN,DUMM,2)
+      CALL TRN32T (UUMAX,VVMAX,ATW,XMAX,DUMM,DUMM,2)
+      CALL TRN32T (UUMAX,VVMIN,WWMAX,DUMM,YMAX,DUMM,2)
+      BIGD = SQRT((UUMAX-UUMIN)**2+(VVMAX-VVMIN)**2+(WWMAX-WWMIN)**2)*.5
+      R0 = RZERO
+      GO TO  20
+   10 CALL TRN32T (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
+      CALL TRN32T (SU(UUMIN),SV(VVMIN),SW(WWMIN),X1,Y1,DUM,2)
+      CALL TRN32T (SU(UUMIN),SV(VVMIN),SW(WWMAX),X2,Y2,DUM,2)
+      CALL TRN32T (SU(UUMIN),SV(VVMAX),SW(WWMIN),X3,Y3,DUM,2)
+      CALL TRN32T (SU(UUMIN),SV(VVMAX),SW(WWMAX),X4,Y4,DUM,2)
+      CALL TRN32T (SU(UUMAX),SV(VVMIN),SW(WWMIN),X5,Y5,DUM,2)
+      CALL TRN32T (SU(UUMAX),SV(VVMIN),SW(WWMAX),X6,Y6,DUM,2)
+      CALL TRN32T (SU(UUMAX),SV(VVMAX),SW(WWMIN),X7,Y7,DUM,2)
+      CALL TRN32T (SU(UUMAX),SV(VVMAX),SW(WWMAX),X8,Y8,DUM,2)
+      XMIN = AMIN1(X1,X2,X3,X4,X5,X6,X7,X8)
+      XMAX = AMAX1(X1,X2,X3,X4,X5,X6,X7,X8)
+      YMIN = AMIN1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
+      YMAX = AMAX1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
+C
+C ADD RIGHT AMOUNT TO KEEP PICTURE SQUARE
+C
+   20 WIDTH = XMAX-XMIN
+      HIGHT = YMAX-YMIN
+      DIF = .5*(WIDTH-HIGHT)
+      IF (DIF)  30, 50, 40
+   30 XMIN = XMIN+DIF
+      XMAX = XMAX-DIF
+      GO TO  50
+   40 YMIN = YMIN-DIF
+      YMAX = YMAX+DIF
+   50 ISCALE = 1
+      CALL TRN32T (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
+      RETURN
+      END
+      SUBROUTINE TRN32T (U,V,W,XT,YT,ZT,IENT)
+C
+C THIS ROUTINE IMPLEMENTS THE 3-SPACE TO 2-SPACE TRANSFOR-
+C MATION BY KUBER, SZABO AND GIULIERI, THE PERSPECTIVE
+C REPRESENTATION OF FUNCTIONS OF TWO VARIABLES. J. ACM 15,
+C 2, 193-204,1968.
+C TRN32T ARGUMENTS
+C U,V,W    ARE THE 3-SPACE COORDINATES OF THE INTERSECTION
+C          OF THE LINE OF SIGHT AND THE IMAGE PLANE.  THIS
+C          POINT CAN BE THOUGHT OF AS THE POINT LOOKED AT.
+C XT,YT,ZT ARE THE 3-SPACE COORDINATES OF THE EYE POSITION.
+C
+C TRN32 ARGUMENTS
+C U,V,W    ARE THE 3-SPACE COORDINATES OF A POINT TO BE
+C          TRANSFORMED.
+C XT,YT    THE RESULTS OF THE 3-SPACE TO 2-SPACE TRANSFOR-
+C          MATION.  WHEN ISCALE=0, XT AND YT ANR IN THE SAME
+C          UNITS AS U,V, AND W.  WHEN ISCALE'0, XT AND YT
+C          ARE IN PLOTTER COORDINATES.
+C ZT       NOT USED.
+C
+C
+      SAVE
+C
+      COMMON /PWRZ1T/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+      COMMON /SET31/  ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
+     1                YMAX       ,BIGD       ,R0         ,NLX        ,
+     2                NBY        ,NRX        ,NTY
+C
+C DECIDE IF SET OR TRANSLATE CALL
+C
+      IF (IENT .NE. 1) GO TO  50
+C
+C STORE THE PARAMETERS OF THE SET CALL
+C FOR USE WITH THE TRANSLATION CALL
+C
+      AU = U
+      AV = V
+      AW = W
+      EU = XT
+      EV = YT
+      EW = ZT
+C
+C
+C
+C
+C
+      DU = AU-EU
+      DV = AV-EV
+      DW = AW-EW
+      D = SQRT(DU*DU+DV*DV+DW*DW)
+      COSAL = DU/D
+      COSBE = DV/D
+      COSGA = DW/D
+      AL = ACOS(COSAL)
+      BE = ACOS(COSBE)
+      GA = ACOS(COSGA)
+      SINGA = SIN(GA)
+C
+C THE 3-SPACE POINT LOOKED AT IS TRANSFORMED INTO (0,0) OF
+C THE 2-SPACE.  THE 3-SPACE W AXIS IS TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.  IF THE LINE OF SIGHT IS CLOSE TO PARALLEL
+C TO THE 3-SPACE W AXIS, THE 3-SPACE V AXIS IS CHOSEN (IN-
+C STEAD OF THE 3-SPACE W AXIS) TO BE TRANSFORMED INTO THE
+C 2-SPACE Y AXIS.
+C
+      ASSIGN  90 TO JDONE
+      IF (ISCALE)  10, 30, 10
+   10 X0 = XMIN
+      Y0 = YMIN
+      X1 = NLX
+      Y1 = NBY
+      X2 = NRX-NLX
+      Y2 = NTY-NBY
+      X3 = X2/(XMAX-XMIN)
+      Y3 = Y2/(YMAX-YMIN)
+      X4 = NRX
+      Y4 = NTY
+      FACT = 1.
+      IF (BIGD .LE. 0.) GO TO  20
+      X0 = -BIGD
+      Y0 = -BIGD
+      X3 = X2/(2.*BIGD)
+      Y3 = Y2/(2.*BIGD)
+      FACT = R0/D
+   20 DELCRT = X2
+      ASSIGN  80 TO JDONE
+   30 IF (SINGA .LT. 0.0001) GO TO  40
+      R = 1./SINGA
+      ASSIGN  70 TO JUMP
+      RETURN
+   40 SINBE = SIN(BE)
+      R = 1./SINBE
+      ASSIGN  60 TO JUMP
+      RETURN
+C
+C********************  ENTRY TRN32  ************************
+C     ENTRY TRN32 (U,V,W,XT,YT,ZT)
+C
+   50 UU = U
+      VV = V
+      WW = W
+      Q = D/((UU-EU)*COSAL+(VV-EV)*COSBE+(WW-EW)*COSGA)
+      GO TO JUMP,( 60, 70)
+   60 UU = ((EW+Q*(WW-EW)-AW)*COSAL-(EU+Q*(UU-EU)-AU)*COSGA)*R
+      VV = (EV+Q*(VV-EV)-AV)*R
+      GO TO JDONE,( 80, 90)
+   70 UU = ((EU+Q*(UU-EU)-AU)*COSBE-(EV+Q*(VV-EV)-AV)*COSAL)*R
+      VV = (EW+Q*(WW-EW)-AW)*R
+      GO TO JDONE,( 80, 90)
+   80 XT = X1+X3*(FACT*UU-X0)
+      YT = Y1+Y3*(FACT*VV-Y0)
+      RETURN
+   90 XT = UU
+      YT = VV
+      RETURN
+      END
+      SUBROUTINE FRST3 (U,V,W)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','FRST3','VERSION  1')
+      XDUM = 5.
+      CALL TRN32T (U,V,W,X,Y,XDUM,2)
+      CALL PLOTIT  (32*IFIX(X),32*IFIX(Y),0)
+      RETURN
+      END
+      SUBROUTINE VECT3 (U,V,W)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','VECT3','VERSION  1')
+      CALL TRN32T (U,V,W,X,Y,ZDUM,2)
+      IIX = 32*IFIX(X)
+      IIY = 32*IFIX(Y)
+      CALL PLOTIT  (IIX,IIY,1)
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT  (IIX,IIY,0)
+      RETURN
+      END
+      SUBROUTINE LINE3 (UA,VA,WA,UB,VB,WB)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','LINE3','VERSION  1')
+      CALL TRN32T (UA,VA,WA,XA,YA,XDUM,2)
+      CALL TRN32T (UB,VB,WB,XB,YB,XDUM,2)
+      IIX = 32*IFIX(XB)
+      IIY = 32*IFIX(YB)
+      CALL PLOTIT (32*IFIX(XA),32*IFIX(YA),0)
+      CALL PLOTIT (IIX,IIY,1)
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT (IIX,IIY,0)
+      RETURN
+      END
+      SUBROUTINE POINT3 (U,V,W)
+      SAVE
+      DIMENSION VWPRT(4),WNDW(4)
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','POINT3','VERSION  1')
+C
+C INQUIRE CURRENT NORMALIZATION TRANS NUMBER
+C
+      CALL GQCNTN (IERR,NTORIG)
+C
+C SAVE NORMALIZATION TRANS 1 AND CURRENT LOG SCALING
+C
+      CALL GQNT (1,IERR,WNDW,VWPRT)
+      CALL GETUSV ('LS',IOLLS)
+C
+C DEFINE NOMALIZATION TRANS TO BE USED WITH POLYMARKER
+C
+      CALL SET(0.0, 1.0, 0.0, 1.0, 1.0, 1024.0, 1.0, 1024.0, 1)
+C
+C SET MARKER TYPE TO 1
+C
+      CALL GSMK (1)
+      CALL TRN32T (U,V,W,X,Y,ZDUM,2)
+      PX = X
+      PY = Y
+      CALL GPM (1,PX,PY)
+C
+C RESTORE ORIGINAL TRANS 1 AND SELECT TRANS NUMBER NTORIG
+C RESTORE LOG SCALING
+C
+      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
+     -         WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
+      CALL GSELNT (NTORIG)
+      RETURN
+      END
+      SUBROUTINE CURVE3 (U,V,W,N)
+      SAVE
+      DIMENSION       U(N)       ,V(N)       ,W(N)
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','CURVE3','VERSION  1')
+      CALL TRN32T (U(1),V(1),W(1),X,Y,ZDUM,2)
+      CALL PLOTIT (32*IFIX(X),32*IFIX(Y),0)
+      NN = N
+      IF (NN .LT. 2) RETURN
+      DO  10 I=2,NN
+         UU = U(I)
+         VV = V(I)
+         WW = W(I)
+         CALL TRN32T (UU,VV,WW,X,Y,ZDUM,2)
+         CALL PLOTIT (32*IFIX(X),32*IFIX(Y),1)
+   10 CONTINUE
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(0,0,0)
+      RETURN
+      END
+      SUBROUTINE PSYM3 (U,V,W,ICHAR,SIZE,IDIR,ITOP,IUP)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','PSYM3','VERSION  1')
+      IF (IUP .EQ. 2) CALL VECT3 (U,V,W)
+      CALL PWRZ (U,V,W,ICHAR,1,SIZE,IDIR,ITOP,0)
+      RETURN
+      END
+      SUBROUTINE PERIM3 (MAGR1,MINI1,MAGR2,MINI2,IWHICH,VAR)
+      SAVE
+      COMMON /PWRZ1T/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
+     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
+     2                EYEV       ,EYEW
+      COMMON /PRM31/  Q          ,L
+      COMMON /TCK31/  TMAGU      ,TMINU      ,TMAGV      ,TMINV      ,
+     1                TMAGW      ,TMINW
+C
+C THRINT COMMON BLOCK IS USED FOR SETTING COLOR INTENSITY
+C
+      COMMON /THRINT/ ITHRMJ     ,ITHRMN     ,ITHRTX
+      DIMENSION       LASF(13)
+C
+      TICK(T) = AMAX1(UUMAX-UUMIN,VVMAX-VVMIN,WWMAX-WWMIN)*T/1024.
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','PERIM3','VERSION  1')
+C
+C INQUIRE LINE COLOR INDEX AND SET ASF TO INDIVIDUAL
+C
+      CALL GQPLCI (IERR, IPLCI)
+      CALL GQASF (IERR, LASF)
+      LSV3  = LASF(3)
+      LASF(3) = 1
+      CALL GSASF (LASF)
+C
+      MGR1 = MAGR1
+      MN1 = MINI1-1
+      MGR2 = MAGR2
+      MN2 = MINI2-1
+      MN1P1 = MAX0(MN1+1,1)
+      MN2P1 = MAX0(MN2+1,1)
+      L = MIN0(3,MAX0(1,IWHICH))
+      Q = VAR
+C
+C PICK BOUNDS
+C
+      GO TO ( 10, 30, 40),L
+   10 XMIN = VVMIN
+      XMAX = VVMAX
+      DELXL = TICK(TMAGU)
+      DELXS = TICK(TMINU)
+   20 YMIN = WWMIN
+      YMAX = WWMAX
+      DELYL = TICK(TMAGW)
+      DELYS = TICK(TMINW)
+      GO TO  50
+   30 XMIN = UUMIN
+      XMAX = UUMAX
+      DELXL = TICK(TMAGU)
+      DELXS = TICK(TMINU)
+      GO TO  20
+   40 XMIN = UUMIN
+      XMAX = UUMAX
+      DELXL = TICK(TMAGU)
+      DELXS = TICK(TMINU)
+      YMIN = VVMIN
+      YMAX = VVMAX
+      DELYL = TICK(TMAGV)
+      DELYS = TICK(TMINV)
+C
+C PERIM
+C
+   50 CALL LINE3W (XMIN,YMIN,XMAX,YMIN)
+      CALL LINE3W (XMAX,YMIN,XMAX,YMAX)
+      CALL LINE3W (XMAX,YMAX,XMIN,YMAX)
+      CALL LINE3W (XMIN,YMAX,XMIN,YMIN)
+      IF (MGR1 .LT. 1) GO TO  90
+      DX = (XMAX-XMIN)/AMAX0(MGR1*(MN1P1),1)
+      DO  80 I=1,MGR1
+C
+C MINORS FIRST
+C
+         IF (MN1 .LE. 0) GO TO  70
+C
+C SET LINE INTENSITY TO LOW
+C
+         CALL GSPLCI (ITHRMN)
+         DO  60 J=1,MN1
+            X = XMIN+FLOAT(MN1P1*(I-1)+J)*DX
+            CALL LINE3W (X,YMIN,X,YMIN+DELYS)
+            CALL LINE3W (X,YMAX,X,YMAX-DELYS)
+   60    CONTINUE
+   70    IF (I .GE. MGR1) GO TO  90
+C
+C SET LINE INTENSITY TO HIGH
+C
+         CALL GSPLCI (ITHRMJ)
+         X = XMIN+FLOAT(MN1P1*I)*DX
+C
+C MAJORS
+C
+         CALL LINE3W (X,YMIN,X,YMIN+DELYL)
+         CALL LINE3W (X,YMAX,X,YMAX-DELYL)
+   80 CONTINUE
+   90 IF (MGR2 .LT. 1) GO TO 130
+      DY = (YMAX-YMIN)/AMAX0(MGR2*(MN2P1),1)
+      DO 120 J=1,MGR2
+         IF (MN2 .LE. 0) GO TO 110
+         DO 100 I=1,MN2
+            Y = YMIN+FLOAT(MN2P1*(J-1)+I)*DY
+            CALL LINE3W (XMIN,Y,XMIN+DELXS,Y)
+C
+C SET LINE INTENSITY TO LOW
+C
+            CALL GSPLCI (ITHRMN)
+            CALL LINE3W (XMAX,Y,XMAX-DELXS,Y)
+  100    CONTINUE
+  110    IF (J .GE. MGR2) GO TO 130
+C
+C SET LINE INTENSITY TO HIGH
+C
+         CALL GSPLCI (ITHRMJ)
+         Y = YMIN+FLOAT(MN2P1*J)*DY
+         CALL LINE3W (XMIN,Y,XMIN+DELXL,Y)
+         CALL LINE3W (XMAX,Y,XMAX-DELXL,Y)
+  120 CONTINUE
+C
+C RESTORE ASF AND LINE INTENSITY TO ORIGINAL
+C
+  130 LASF(3) = LSV3
+      CALL GSASF (LASF)
+      CALL GSPLCI (IPLCI)
+      RETURN
+      END
+      SUBROUTINE LINE3W (XA,YA,XB,YB)
+      SAVE
+      COMMON /PRM31/  Q          ,L
+      GO TO ( 10, 30, 40),L
+   10 UA = Q
+      UB = Q
+      VA = XA
+      VB = XB
+   20 WA = YA
+      WB = YB
+      GO TO  50
+   30 UA = XA
+      UB = XB
+      VA = Q
+      VB = Q
+      GO TO  20
+   40 UA = XA
+      UB = XB
+      VA = YA
+      VB = YB
+      WA = Q
+      WB = Q
+   50 CALL LINE3 (UA,VA,WA,UB,VB,WB)
+      RETURN
+      END
+      SUBROUTINE DRAWT (IXA,IYA,IXB,IYB)
+      SAVE
+      CALL PLOTIT(32*IXA,32*IYA,0)
+      IIX = 32*IXB
+      IIY = 32*IYB
+      CALL PLOTIT(IIX,IIY,1)
+C
+C     FLUSH PLOTIT BUFFER
+C
+      CALL PLOTIT(IIX,IIY,0)
+      RETURN
+      END
+      SUBROUTINE TICK43 (MAGU,MINU,MAGV,MINV,MAGW,MINW)
+      SAVE
+      COMMON /TCK31/  TMAGU      ,TMINU      ,TMAGV      ,TMINV      ,
+     1                TMAGW      ,TMINW
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','TICK43','VERSION  1')
+      TMAGU = MAGU
+      TMINU = MINU
+      TMAGV = MAGV
+      TMINV = MINV
+      TMAGW = MAGW
+      TMINW = MINW
+      RETURN
+      END
+      SUBROUTINE TICK3 (MAG,MIN)
+      SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','TICK3','VERSION  1')
+      CALL TICK43 (MAG,MIN,MAG,MIN,MAG,MIN)
+      RETURN
+      END
+      SUBROUTINE FENCE3 (U,V,W,N,IOR,BOT)
+      SAVE
+      REAL            U(N)       ,V(N)       ,W(N)
+      DIMENSION       LASF(13)
+C
+C COMMON BLOCK THRINT IS USED FOR SETTING COLOR INTENSITY
+C
+      COMMON /THRINT/ ITHRMJ     ,ITHRMN     ,ITHRTX
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
+C
+      CALL Q8QST4 ('GRAPHX','THREED','FENCE3','VERSION  1')
+C
+C INQUIRE LINE COLOR INDEX AND SET ASF TO INDIVIDUAL
+C
+      CALL GQPLCI (IERR, IPLCI)
+      CALL GQASF (IERR, LASF)
+      LSV3  = LASF(3)
+      LASF(3) = 1
+      CALL GSASF (LASF)
+C
+      M = N
+      BASE = BOT
+      L = MAX0(1,MIN0(3,IOR))
+C
+C SET LINE INTENSITY TO LOW
+C
+      CALL GSPLCI (ITHRMN)
+      GO TO ( 10, 40, 70),L
+   10 CALL FRST3 (BASE,V(1),W(1))
+      DO  20 I=2,M
+         VV = V(I)
+         WW = W(I)
+         CALL VECT3 (BASE,VV,WW)
+   20 CONTINUE
+      DO  30 I=1,M
+         UU = U(I)
+         VV = V(I)
+         WW = W(I)
+         CALL LINE3 (UU,VV,WW,BASE,VV,WW)
+   30 CONTINUE
+      GO TO 100
+   40 CALL FRST3 (U(1),BASE,W(1))
+      DO  50 I=2,M
+         UU = U(I)
+         WW = W(I)
+         CALL VECT3 (UU,BASE,WW)
+   50 CONTINUE
+      DO  60 I=1,M
+         UU = U(I)
+         VV = V(I)
+         WW = W(I)
+         CALL LINE3 (UU,VV,WW,UU,BASE,WW)
+   60 CONTINUE
+      GO TO 100
+   70 CALL FRST3 (U(1),V(1),BASE)
+      DO  80 I=2,M
+         UU = U(I)
+         VV = V(I)
+         CALL VECT3 (UU,VV,BASE)
+   80 CONTINUE
+      DO  90 I=1,M
+         UU = U(I)
+         VV = V(I)
+         WW = W(I)
+         CALL LINE3 (UU,VV,WW,UU,VV,BASE)
+   90 CONTINUE
+C
+C SET LINE INTENSITY TO HIGH
+C
+  100 CALL GSPLCI (ITHRMJ)
+      CALL CURVE3 (U,V,W,M)
+C
+C RESTORE ASF AND LINE INTENSITY TO ORIGINAL
+C
+      LASF(3) = LSV3
+      CALL GSASF (LASF)
+      CALL GSPLCI (IPLCI)
+C
+      RETURN
+C
+C REVISION HISTORY---
+C
+C JANUARY 1978     DELETED REFERENCES TO THE  *COSY  CARDS AND
+C                  ADDED REVISION HISTORY
+C FEBURARY 1979    MODIFIED CODE TO CONFORM TO FORTRAN 66 STANDARD
+C JUNE 1979        UPDATED FILE TO INCLUDE BLOCK DATA PWRZBD AND
+C                  CORRECT A COMMENTED OUT STATEMENT IN CURVE3.
+C MARCH 1980       REMOVED THE PWRZ AND PWRITZ ENTRIES.  THESE
+C                  CAPABILITIES WERE REPLACED WITH THE NEW ULIB FILE
+C                  PWRZT.
+C JULY 1984        CONVERTED TO FORTRAN 77 AND GKS
+C-----------------------------------------------------------------------
+C
+      END
+      SUBROUTINE PWRZ (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT)
+C     WRITE (6,1001)
+C     WRITE (6,1002)
+C     STOP
+C
+C1001 FORMAT (1H1//////////)
+C1002 FORMAT (' *****************************************'/
+C    1        ' *                                       *'/
+C    2        ' *                                       *'/
+C    3        ' *   THE ENTRY POINT PWRZ IS NO LONGER   *'/
+C    4        ' *   SUPPORTED.  THE CAPABILITIES OF     *'/
+C    5        ' *   THIS OLD ENTRY ARE NOW AVAILABLE    *'/
+C    6        ' *   IN THE NEW PORTABLE VERSIONS        *'/
+C    7        ' *                                       *'/
+C    8        ' *        PWRZS  FOR USE WITH SRFACE     *'/
+C    9        ' *        PWRZI  FOR USE WITH ISOSRF     *'/
+C    +        ' *        PWRZT  FOR USE WITH THREED     *'/
+C    1        ' *                                       *'/
+C    2        ' *   FOR USAGE OF THESE ROUTINES, SEE    *'/
+C    3        ' *   THE DOCUMENTATION FOR THE DESIRED   *'/
+C    4        ' *   ROUTINE.                            *'/
+C    5        ' *                                       *'/
+C    6        ' *                                       *'/
+C    7        ' *****************************************')
+C
+      END
diff --git a/sys/gio/ncarutil/veldat.f b/sys/gio/ncarutil/veldat.f
new file mode 100644
index 00000000..9baef78d
--- /dev/null
+++ b/sys/gio/ncarutil/veldat.f
@@ -0,0 +1,67 @@
+C
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+c +noao: block data veldat changed to run time initialization
+c     BLOCK DATA VELDAT
+        subroutine veldat
+C
+C THIS 'ROUTINE' DEFINES THE DEFAULT VALUES OF THE VELVCT PARAMETERS.
+C
+      COMMON /VEC1/   ASH        ,EXT        ,ICTRFG     ,ILAB,
+     +                IOFFD      ,IOFFM      ,ISX        ,ISY,
+     +                RMN        ,RMX        ,SIDE       ,SIZE,
+     +                XLT        ,YBT        ,ZMN        ,ZMX
+C
+      COMMON /VEC2/   BIG        ,INCX       ,INCY
+C
+c     DATA     EXT /    0.25 /
+c     DATA  ICTRFG /    1         /
+c     DATA    ILAB /    0         /
+c     DATA   IOFFD /    0         /
+c     DATA   IOFFM /    0         /
+c     DATA     RMN /  160.00 /
+c     DATA     RMX / 6400.00 /
+c     DATA    SIDE /    0.90 /
+c     DATA    SIZE /  256.00 /
+c     DATA     XLT /    0.05 /
+c     DATA     YBT /    0.05 /
+c     DATA     ZMX /    0.00 /
+c     DATA    INCX /    1          /
+c     DATA    INCY /    1          /
+c
+c +noao: following flag added to prevent over-initialization
+      logical first
+        SAVE
+      data first /.true./
+      if (.not. first) then
+          return
+      endif
+      first = .false.
+
+      EXT =     0.25 
+      ICTRFG =  1    
+      ILAB =    0         
+      IOFFD =   0    
+      IOFFM =   0    
+      RMN =  160.00 
+      RMX = 6400.00 
+      SIDE =    0.90 
+      SIZE =  256.00 
+      XLT =     0.05 
+      YBT =     0.05 
+      ZMX =     0.00 
+      INCX =    1          
+      INCY =    1          
+C
+c - noao
+      END
diff --git a/sys/gio/ncarutil/velvct.f b/sys/gio/ncarutil/velvct.f
new file mode 100644
index 00000000..fd8f46c7
--- /dev/null
+++ b/sys/gio/ncarutil/velvct.f
@@ -0,0 +1,821 @@
+      SUBROUTINE VELVCT (U,LU,V,LV,M,N,FLO,HI,NSET,LENGTH,ISPV,SPV)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C
+C SUBROUTINE VELVCT (U,LU,V,LV,M,N,FLO,HI,NSET,LENGTH,ISPV,SPV)
+C
+C
+C DIMENSION OF           U(LU,N),V(LV,N),SPV(2)
+C ARGUMENTS
+C
+C LATEST REVISION        JULY 1984
+C
+C PURPOSE                VELVCT DRAWS A REPRESENTATION OF A TWO-
+C                        DIMENSIONAL VELOCITY FIELD BY DRAWING ARROWS
+C                        FROM EACH DATA LOCATION.  THE LENGTH OF THE
+C                        ARROW IS PROPORTIONAL TO THE STRENGTH OF THE
+C                        FIELD AT THAT LOCATION AND THE DIRECTION OF
+C                        THE ARROW INDICATES THE DIRECTION OF THE FLOW
+C                        AT THAT LOCATION.
+C
+C USAGE                  IF THE FOLLOWING ASSUMPTIONS ARE MET, USE
+C
+C                               CALL EZVEC (U,V,M,N)
+C
+C                          ASSUMPTIONS -
+C
+C                            --THE WHOLE ARRAY IS PROCESSED.
+C                            --THE SCALE FACTOR IS CHOSEN INTERNALLY.
+C                            --THE PERIMETER IS DRAWN.
+C                            --FRAME IS CALLED AFTER PLOTTING.
+C                            --THERE ARE NO SPECIAL VALUES.
+C
+C                        IF THESE ASSUMPTIONS ARE NOT MET, USE
+C
+C                               CALL VELVCT (U,LU,V,LV,M,N,FLO,HI,
+C                                                 NSET,LENGTH,ISPV,SPV)
+C
+C ARGUMENTS
+C
+C ON INPUT               U,V
+C
+C                          THE (ORIGINS OF THE) TWO-DIMENSIONAL ARRAYS
+C                          CONTAINING THE VELOCITY FIELD TO BE PLOTTED.
+C                          THE VECTOR AT THE POINT (I,J) HAS MAGNITUDE
+C                          SQRT(U(I,J)**2+V(I,J)**2) AND DIRECTION
+C                          ATAN2(V(I,J),U(I,J)).  OTHER REPRESENTATIONS,
+C                          SUCH AS (R,THETA), CAN BE PLOTTED BY
+C                          CHANGING STATEMENT FUNCTIONS IN THIS ROUTINE.
+C
+C                        LU
+C
+C                          THE FIRST DIMENSION OF U IN THE CALLING
+C                          PROGRAM.
+C
+C                        LV
+C
+C                          THE FIRST DIMENSION OF V IN THE CALLING
+C                          PROGRAM.
+C
+C                        M
+C
+C                          THE NUMBER OF DATA VALUES TO BE PLOTTED IN
+C                          THE X-DIRECTION (THE FIRST SUBSCRIPT
+C                          DIRECTION).  WHEN PLOTTING THE ENTIRE ARRAY,
+C                          LU = LV = M.
+C
+C                        N
+C
+C                          THE NUMBER OF DATA VALUES TO BE PLOTTED IN
+C                          THE Y-DIRECTION (THE SECOND SUBSCRIPT
+C                          DIRECTION).
+C
+C                        FLO
+C
+C                          THE MINIMUM VECTOR MAGNITUDE TO BE SHOWN.
+C
+C                        HI
+C
+C                          THE MAXIMUM VECTOR MAGNITUDE TO BE SHOWN. (A
+C                          VALUE LESS THAN OR EQUAL TO ZERO CAUSES THE
+C                          MAXIMUM VALUE OF SQRT(U**2+V**2) TO BE USED.)
+C
+C                        NSET
+C
+C                          FLAG TO CONTROL SCALING -
+C
+C                          IF NSET IS ZERO, VELVCT ESTABLISHES THE
+C                          WINDOW AND VIEWPORT TO PROPERLY
+C                          SCALE PLOTTING INSTRUCTIONS TO THE STANDARD
+C                          CONFIGURATION.  PERIM IS CALLED TO DRAW A
+C                          BORDER.
+C
+C                          IF NSET IS GREATER THAN ZERO, VELVCT ASSUMES
+C                          THAT THE USER HAS ESTABLISHED THE WINDOW
+C                          AND VIEWPORT IN SUCH A WAY AS TO PROPERLY
+C                          SCALE THE PLOTTING INSTRUCTIONS GENERATED
+C                          BY VELVCT.  PERIM IS NOT CALLED.
+C
+C                          IF NSET IS LESS THAN ZERO, VELVCT
+C                          PLACES THE CONTOUR PLOT
+C                          WITHIN THE LIMITS OF THE USER'S CURRENT
+C                          WINDOW AND VIEWPORT.  PERIM IS NOT CALLED.
+C
+C                        LENGTH
+C
+C                          THE LENGTH, IN PLOTTER ADDRESS UNITS (PAUS),
+C                          OF A VECTOR HAVING MAGNITUDE HI
+C                          (OR, IF HI=0, THE LENGTH IN PAUS
+C                          OF THE LONGEST VECTOR).  IF LENGTH=0, A
+C                          VALUE IS CHOSEN SUCH THAT THE LONGEST VECTOR
+C                          COULD JUST REACH TO THE TAIL OF THE NEXT
+C                          VECTOR.  IF THE HORIZONTAL AND VERTICAL
+C                          RESOLUTIONS OF THE PLOTTER ARE DIFFERENT,
+C                          LENGTH SHOULD BE NON-ZERO AND SPECIFIED AS A
+C                          HORIZONTAL DISTANCE.
+C
+C                        ISPV
+C
+C                          FLAG TO CONTROL THE SPECIAL VALUE FEATURE.
+C
+C                             0 MEANS THAT THE FEATURE IS NOT IN USE.
+C
+C                             1 MEANS THAT IF THE VALUE OF
+C                               U(I,J)=SPV(1) THE VECTOR WILL NOT BE
+C                               PLOTTED.
+C
+C                             2 MEANS THAT IF THE VALUE OF
+C                               V(I,J)=SPV(2) THE VECTOR WILL NOT BE
+C                               PLOTTED.
+C
+C                             3 MEANS THAT IF EITHER U(I,J)=SPV(1) OR
+C                               V(I,J)=SPV(2) THEN THE VECTOR WILL NOT
+C                               BE PLOTTED.
+C
+C                             4 MEANS THAT IF U(I,J)=SPV(1)
+C                               AND V(I,J)=SPV(2), THE VECTOR
+C                               WILL NOT BE PLOTTED.
+C
+C                        SPV
+C
+C                        AN ARRAY OF LENGTH 2 WHICH GIVES THE VALUE
+C                        IN THE U ARRAY AND THE VALUE IN THE V ARRAY
+C                        WHICH DENOTE MISSING VALUES.
+C                        THIS ARGUMENT IS IGNORED IF ISPV=0.
+C
+C
+C ON OUTPUT              ALL ARGUMENTS REMAIN UNCHANGED.
+C
+C NOTE                   THE ENDPOINTS OF EACH ARROW DRAWN ARE (FX(X,Y),
+C                        FY(X,Y)) AND (MXF(X,Y,U,V,SFX,SFY,MX,MY),
+C                        MYF(X,Y,U,V,SFX,SFY,MX,MY)) WHERE X=I, Y=J,
+C                        U=U(I,J), V=V(I,J), AND SFX AND SFY ARE SCALE
+C                        FACTORS.  HERE I IS THE X-INDEX AND J IS THE
+C                        Y-INDEX.  (MX,MY) IS THE LOCATION OF THE TAIL.
+C                        THUS THE ACTUAL LENGTH OF THE ARROW IS
+C                        SQRT(DX**2+DY**2) AND THE DIRECTION IS
+C                        ATAN2(DX,DY), WHERE DX=MX-MXF(...) AND
+C                        DY=MY-MYF(...).
+C
+C ENTRY POINTS           VELVCT,EZVECT,DRWVEC,VELVEC,VELDAT
+C
+C COMMON BLOCKS          VEC1,VEC2
+C
+C I/O                    PLOTS THE VECTOR FIELD.
+C
+C PRECISION              SINGLE
+C
+C LANGUAGE               FORTRAN
+C
+C REQUIRED LIBRARY       GRIDAL AND THE SPPS
+C ROUTINES
+C
+C HISTORY                WRITTEN AND STANDARDIZED IN NOVEMBER 1973.
+C                        REVISED IN MAY, 1975, TO INCLUDE MXF AND MYF.
+C                        REVISED IN MARCH, 1981, TO FIX CERTAIN ERRORS;
+C                        TO USE FL2INT AND PLOTIT INSTEAD OF MXMY,
+C                        FRSTPT, AND VECTOR; AND TO MAKE THE ARROWHEADS
+C                        NARROWER.  CONVERTED TO FORTRAN77 AND GKS
+C                        IN JULY 1984.
+C
+C ALGORITHM              EACH VECTOR IS EXAMINED, POSSIBLY TRANSFORMED,
+C                        THEN PLOTTED.
+C
+C PORTABILITY            FORTRAN77
+C
+C ---------------------------------------------------------------------
+C
+C SPECIAL NOTE -
+C
+C USING THIS ROUTINE TO PUT VECTORS ON AN ARBITRARY BACKGROUND DRAWN BY
+C SUPMAP IS A BIT TRICKY.  THE ARITHMETIC STATEMENT FUNCTIONS FX AND FY
+C ARE EASY TO REPLACE.  THE PROBLEM ARISES IN REPLACING MXF AND MYF.
+C THE FOLLOWING EXAMPLE MAY BE HELPFUL. (SUPMAP IS AN ENTRY POINT IN
+C THE EZMAP PACKAGE.)
+C
+C SUPPOSE THAT WE HAVE TWO ARRAYS, CLON(36,9) AND CLAT(36,9), WHICH
+C CONTAIN THE E-W AND N-S COMPONENTS OF A WIND FLOW FIELD ON THE SURFACE
+C OF THE EARTH.  CLON(I,J) IS THE MAGNITUDE OF THE EASTERLY FLOW.
+C CLAT(I,J) IS THE MAGNITUDE OF THE NORTHERLY FLOW AT A LONGITUDE (I-1)
+C *10 DEGREES EAST OF GREENWICH AND A LATITUDE (J-1)*10 DEGREES NORTH OF
+C THE EQUATOR.  SUPMAP IS TO BE USED TO DRAW A POLAR PROJECTION OF THE
+C EARTH AND VELVCT IS TO BE USED TO SUPERIMPOSE VECTORS REPRESENTING THE
+C FLOW FIELD ON IT.  THE FOLLOWING STEPS WOULD BE NECESSARY:
+C
+C     1.  CALL SUPMAP (1,90.,0.,-90.,90.,90.,90.,90.,-4,10,0,1,IER)
+C         TO DRAW THE MAP.
+C
+C     2.  CALL VELVCT (CLON,36,CLAT,36,36,9,0.,0.,1,50,0,0.) TO PUT
+C         VECTORS ON IT.  NOTICE THAT NSET HAS THE VALUE 1 TO TELL
+C         VELVCT THAT SUPMAP HAS DONE THE REQUIRED SET CALL.
+C
+C     3.  IN ORDER TO ENSURE THAT STEP 2 WILL WORK PROPERLY, DELETE
+C         THE ARITHMETIC STATEMENT FUNCTIONS FX, FY, MXF, AND MYF
+C         FROM VELVCT AND INCLUDE THE FOLLOWING FUNCTIONS.
+C
+C     FUNCTION FX(XX,YY)
+C     CALL MAPTRN (10.*(YY-1.),10.*(XX-1.),X,Y)
+C     FX=X
+C     RETURN
+C     END
+C
+C     FUNCTION FY(XX,YY)
+C     CALL MAPTRN (10.*(YY-1.),10.*(XX-1.),X,Y)
+C     FY=Y
+C     RETURN
+C     END
+C
+C     FUNCTION MXF(XX,YY,UU,VV,SFX,SFY,MX,MY)
+C     CFCT=COS(.17453292519943*(YY-1.))
+C     CALL MAPTRN(10.*(YY-1.)         ,10.*(XX-1.)              ,X1,Y1)
+C     CALL MAPTRN(10.*(YY-1.)+1.E-6*VV,10.*(XX-1.)+1.E-6*UU/CFCT,X2,Y2)
+C     U=((X2-X1)/SQRT((X2-X1)**2+(Y2-Y1)**2))*SQRT(UU**2+VV**2)
+C     MXF=MX+IFIX(SFX*U)
+C     RETURN
+C     END
+C
+C     FUNCTION MYF(XX,YY,UU,VV,SFX,SFY,MX,MY)
+C     CFCT=COS(.17453292519943*(YY-1.))
+C     CALL MAPTRN(10.*(YY-1.)         ,10.*(XX-1.)              ,X1,Y1)
+C     CALL MAPTRN(10.*(YY-1.)+1.E-6*VV,10.*(XX-1.)+1.E-6*UU/CFCT,X2,Y2)
+C     V=((Y2-Y1)/SQRT((X2-X1)**2+(Y2-Y1)**2))*SQRT(UU**2+VV**2)
+C     MYF=MY+IFIX(SFY*V)
+C     RETURN
+C     END
+C
+C THE BASIC NOTION BEHIND THE CODING OF THE MXF AND MYF FUNCTIONS IS AS
+C FOLLOWS.  SINCE UU AND VV ARE THE LONGITUDINAL AND LATITUDINAL COMPONENTS,
+C RESPECTIVELY, OF A VELOCITY VECTOR HAVING UNITS OF DISTANCE OVER TIME,
+C 1.E-6*UU/COS(LATITUDE) AND 1.E-6*VV REPRESENT THE CHANGE IN LONGITUDE
+C AND LATITUDE, RESPECTIVELY, OF A PARTICLE MOVING WITH THE FLOW FIELD
+C FOR A VERY SHORT PERIOD OF TIME.  THE ROUTINE MAPTRN IS USED TO FIND
+C THE POSITION OF THE PARTICLE'S PROJECTION AT THE BEGINNING AND END OF
+C THAT TINY TIME SLICE AND, THEREFORE, THE DIRECTION IN WHICH TO DRAW
+C THE ARROW REPRESENTING THE VELOCITY VECTOR SO THAT IT WILL BE TANGENT
+C TO A PROJECTED FLOW LINE OF THE FIELD AT THAT POINT.  THE VALUES U
+C AND V ARE COMPUTED SO AS TO GIVE THE ARROW THE LENGTH IMPLIED BY UU
+C AND VV.  (THE CODE ENSURES THAT SQRT(U**2+V**2) IS EQUAL TO
+C SQRT(UU**2+VV**2).)  THE LENGTH OF THE ARROW REPRESENTS THE MAGNITUDE
+C OF THE VELOCITY VECTOR, UNAFFECTED BY PERSPECTIVE.  THE SCALING SET
+C UP BY VELVCT WILL THEREFORE BE APPROPRIATE FOR THE ARROWS DRAWN.
+C
+C THIS METHOD IS RATHER HEURISTIC AND HAS THREE INHERENT PROBLEMS.
+C FIRST, THE CONSTANT 1.E-6 MAY NEED TO BE MADE LARGER OR SMALLER,
+C DEPENDING ON THE MAGNITUDE OF YOUR U/V DATA.  SECOND, THE NORTH AND
+C SOUTH POLES MUST BE AVOIDED.  AT EITHER POLE, CFCT GOES TO ZERO,
+C GIVING A DIVISION BY ZERO; IN A SMALL REGION NEAR THE POLE, THE
+C METHOD MAY TRY TO USE MAPTRN WITH A LATITUDE OUTSIDE THE RANGE
+C (-90,+90).  THIRD, THE PROJECTION MUST BE SET UP SO AS TO AVOID
+C HAVING VECTOR BASEPOINTS AT THE EXACT EDGE OF THE MAP.  VECTORS
+C THERE WILL BE OF THE CORRECT LENGTH, BUT THEY MAY BE DRAWN IN THE
+C WRONG DIRECTION (WHEN THE PROJECTED PARTICLE TRACK DETERMINING THE
+C DIRECTION CROSSES THE EDGE AND REAPPEARS ELSEWHERE ON THE MAP).
+C WITH A LITTLE CARE, THE DESIRED RESULTS MAY BE OBTAINED.
+C ---------------------------------------------------------------------
+C
+C DECLARATIONS -
+C
+      COMMON /VEC1/   ASH        ,EXT        ,ICTRFG     ,ILAB       ,
+     +                IOFFD      ,IOFFM      ,ISX        ,ISY        ,
+     +                RMN        ,RMX        ,SIDE       ,SIZE       ,
+     +                XLT        ,YBT        ,ZMN        ,ZMX
+C
+      COMMON /VEC2/   BIG        ,INCX       ,INCY
+C
+C ARGUMENT DIMENSIONS.
+C
+      DIMENSION       U(LU,N)    ,V(LV,N)    ,SPV(2)
+        CHARACTER*10    LABEL
+        REAL WIND(4), VIEW(4), IAR(4)
+C
+C ---------------------------------------------------------------------
+C
+C INTERNAL PARAMETERS OF VELVCT ARE AS FOLLOWS.  THE DEFAULT VALUES OF
+C THESE PARAMETERS ARE DECLARED IN THE BLOCK DATA ROUTINE VELDAT.
+C
+C                        NAME   DEFAULT  FUNCTION
+C                        ----   -------  --------
+C
+C                        BIG   R1MACH(2) CONSTANT USED TO INITIALIZE
+C                                        POSSIBLE SEARCH FOR HI.
+C
+C                        EXT     0.25    THE LENGTHS OF THE SIDES OF THE
+C                                        PLOT ARE PROPORTIONAL TO M AND
+C                                        N WHEN NSET IS LESS THAN OR
+C                                        EQUAL TO ZERO, EXCEPT WHEN
+C                                        MIN(M,N)/MAX(M,N) IS LESS THAN
+C                                        EXT, IN WHICH CASE A SQUARE
+C                                        GRAPH IS PLOTTED.
+C
+C                        ICTRFG    1     FLAG TO CONTROL THE POSITION OF
+C                                        THE ARROW RELATIVE TO  A BASE
+C                                        POINT AT (MX,MY).
+C
+C                                        ZERO - CENTER AT (MX,MY)
+C
+C                                        POSITIVE - TAIL AT (MX,MY)
+C
+C                                        NEGATIVE -  HEAD AT (MX,MY)
+C
+C                        ILAB      0     FLAG TO CONTROL THE DRAWING OF
+C                                        LINE LABELS.
+C
+C                                        ZERO - DO NOT DRAW THE LABELS
+C
+C                                        NON-ZERO - DRAW THE LABELS
+C
+C                        INCX      1     X-COORDINATE STEP SIZE FOR LESS
+C                                        DENSE ARRAYS.
+C
+C                        INCY      1     Y-COORDINATE STEP SIZE.
+C
+C                        IOFFD     0     FLAG TO CONTROL NORMALIZATION
+C                                        OF LABEL NUMBERS.
+C
+C                                        ZERO - INCLUDE A DECIMAL POINT
+C                                        WHEN POSSIBLE
+C
+C                                        NON-ZERO - NORMALIZE ALL LABEL
+C                                        NUMBERS BY ASH
+C
+C                        IOFFM     0     FLAG TO CONTROL PLOTTING OF
+C                                        THE MESSAGE BELOW THE PLOT.
+C
+C                                        ZERO - PLOT THE MESSAGE
+C
+C                                        NON-ZERO - DO NOT PLOT IT
+C
+C                        RMN     160.    ARROW SIZE BELOW WHICH THE
+C                                        HEAD NO LONGER SHRINKS, ON A
+C                                        2**15 X 2**15 GRID.
+C
+C                        RMX    6400.    ARROW SIZE ABOVE WHICH THE
+C                                        HEAD NO LONGER GROWS LARGER,
+C                                        ON A 2**15 X 2**15 GRID.
+C
+C                        SIDE    0.90    LENGTH OF LONGER EDGE OF PLOT.
+C                                        (SEE ALSO EXT.)
+C
+C                        SIZE    256.    WIDTH OF THE CHARACTERS IN
+C                                        VECTOR LABELS, ON A 2**15 X
+C                                        2**15 GRID.
+C
+C                        XLT     0.05    LEFT HAND EDGE OF THE PLOT.
+C                                        (0 IS THE LEFT EDGE OF THE
+C                                        FRAME, 1 THE RIGHT EDGE.)
+C
+C                        YBT     0.05    BOTTOM EDGE OF THE PLOT (0 IS
+C                                        THE BOTTOM OF THE FRAME, 1 THE
+C                                        TOP OF THE FRAME.)
+C
+C ---------------------------------------------------------------------
+C
+C INTERNAL FUNCTIONS WHICH MAY BE MODIFIED FOR DATA TRANSFORMATION -
+C
+C                        SCALE    COMPUTES A SCALE FACTOR USED IN THE
+C                                 DETERMINATION OF THE LENGTH OF THE
+C                                 VECTOR TO BE DRAWN.
+C
+C                        DIST     COMPUTES THE LENGTH OF A VECTOR.
+C
+C                        FX       RETURNS THE X INDEX AS THE
+C                                 X-COORDINATE OF THE VECTOR BASE.
+C
+C                        MXF      RETURNS THE X-COORDINATE OF THE VECTOR
+C                                 HEAD.
+C
+C                        FY       RETURNS THE Y INDEX AS THE
+C                                 Y-COORDINATE OF THE VECTOR BASE.
+C
+C                        MYF      RETURNS THE Y-COORDINATE OF THE VECTOR
+C                                 HEAD.
+C
+C                        VLAB     THE VALUE FOR THE VECTOR LABEL WHEN
+C                                 ILAB IS NON-ZERO.
+C
+      SAVE
+      DIST(XX,YY) = SQRT(XX*XX+YY*YY)
+      FX(XX,YY) = XX
+      FY(XX,YY) = YY
+      MXF(XX,YY,UU,VV,SFXX,SFYY,MXX,MYY) = MXX+IFIX(SFXX*UU)
+      MYF(XX,YY,UU,VV,SFXX,SFYY,MXX,MYY) = MYY+IFIX(SFYY*VV)
+      SCALEX(MM,NN,INCXX,INCYY,HAA,XX1,XX2,YY1,YY2,XX3,XX4,YY3,YY4,
+     1       LENN) = LENN/HAA
+      SCALEY(MM,NN,INCXX,INCYY,HAA,XX1,XX2,YY1,YY2,XX3,XX4,YY3,YY4,
+     1       LENN) = SCALEX(MM,NN,INCXX,INCYY,HAA,XX1,XX2,YY1,YY2,XX3,
+     2                                                 XX4,YY3,YY4,LENN)
+      VLAB(UU,VV,II,JJ) = DIST(UU,VV)
+C
+C FORCE THE BLOCK DATA ROUTINE, WHICH SETS DEFAULT VARIABLES, TO LOAD.
+C +NOAO - blockdata replaced with run time initialization.
+C
+C     EXTERNAL        VELDAT
+      call veldat
+C -NOAO
+C
+C ---------------------------------------------------------------------
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR.
+C
+      CALL Q8QST4 ('NSSL','VELVCT','VELVCT','VERSION  6')
+C
+C INITIALIZE AND TRANSFER SOME ARGUMENTS TO LOCAL VARIABLES.
+C
+      BIG = -R1MACH(2)
+      MX = LU
+      MY = LV
+      NX = M
+      NY = N
+      GL = FLO
+      HA = HI
+      ISP = ISPV
+      NC = 0
+C
+C COMPUTE CONSTANTS BASED ON THE ADDRESSABILITY OF THE PLOTTER.
+C
+      CALL GETUSV('XF',ISX)
+      CALL GETUSV('YF',ISY)
+      ISX = 2**(15-ISX)
+      ISY = 2**(15-ISY)
+      LEN = LENGTH*ISX
+C
+C SET UP THE SCALING OF THE PLOT.
+C
+        CALL GQCNTN(IERR,IOLDNT)
+        CALL GQNT(IOLDNT,IERR,WIND,VIEW)
+        X1 = VIEW(1)
+        X2 = VIEW(2)
+        Y1 = VIEW(3)
+        Y2 = VIEW(4)
+        X3 = WIND(1)
+        X4 = WIND(2)
+        Y3 = WIND(3)
+        Y4 = WIND(4)
+        CALL GETUSV('LS',IOLLS)
+C
+C     SAVE NORMALIZATION TRANSFORMATION 1
+C
+      CALL GQNT(1,IERR,WIND,VIEW)
+C
+      IF (NSET) 101,102,106
+C
+  101 X3 = 1.
+      X4 = FLOAT(NX)
+      Y3 = 1.
+      Y4 = FLOAT(NY)
+      GO TO 105
+C
+  102 X1 = XLT
+      X2 = XLT+SIDE
+      Y1 = YBT
+      Y2 = YBT+SIDE
+      X3 = 1.
+      Y3 = 1.
+      X4 = FLOAT(NX)
+      Y4 = FLOAT(NY)
+      IF (AMIN1(X4,Y4)/AMAX1(X4,Y4) .LT. EXT) GO TO 105
+C
+      IF (NX-NY) 103,105,104
+  103 X2 = XLT+SIDE*X4/Y4
+      GO TO 105
+  104 Y2 = YBT+SIDE*Y4/X4
+C
+  105 CALL SET(X1,X2,Y1,Y2,X3,X4,Y3,Y4,1)
+      IF (NSET .EQ. 0) CALL PERIM (1,0,1,0)
+C
+C CALCULATE A LENGTH IF NONE PROVIDED.
+C
+  106 IF (LEN .NE. 0) GO TO 107
+      CALL FL2INT(FX(1.,1.),FY(1.,1.),MX,MY)
+      CALL FL2INT(FX(FLOAT(1+INCX),FLOAT(1+INCY)),
+     +            FY(FLOAT(1+INCX),FLOAT(1+INCY)),LX,LY)
+      LEN = SQRT((FLOAT(MX-LX)**2+FLOAT(MY-LY)**2)/2.)
+C
+C SET UP SPECIAL VALUES.
+C
+  107 IF (ISP .EQ. 0) GO TO 108
+      SPV1 = SPV(1)
+      SPV2 = SPV(2)
+      IF (ISP .EQ. 4) SPV2 = SPV(1)
+C
+C FIND THE MAXIMUM VECTOR LENGTH.
+C
+  108 IF (HA .GT. 0.) GO TO 118
+C
+      HA = BIG
+      IF (ISP .EQ. 0) GO TO 115
+C
+      DO 114 J=1,NY,INCY
+         DO 113 I=1,NX,INCX
+            IF (ISP-2) 109,111,110
+  109       IF (U(I,J) .EQ. SPV1) GO TO 113
+            GO TO 112
+  110       IF (U(I,J) .EQ. SPV1) GO TO 113
+  111       IF (V(I,J) .EQ. SPV2) GO TO 113
+  112       HA = AMAX1(HA,DIST(U(I,J),V(I,J)))
+  113    CONTINUE
+  114 CONTINUE
+      GO TO 126
+C
+  115 DO 117 J=1,NY,INCY
+         DO 116 I=1,NX,INCX
+            HA = AMAX1(HA,DIST(U(I,J),V(I,J)))
+  116    CONTINUE
+  117 CONTINUE
+C
+C BRANCH IF NULL VECTOR SIZE.
+C
+  126 IF (HA .LE. 0.) GO TO 125
+C
+C COMPUTE SCALE FACTORS.
+C
+  118 SFX = SCALEX(M,N,INCX,INCY,HA,X1,X2,Y1,Y2,X3,X4,Y3,Y4,LEN)
+      SFY = SCALEY(M,N,INCX,INCY,HA,X1,X2,Y1,Y2,X3,X4,Y3,Y4,LEN)
+      IOFFDT = IOFFD
+      IF (GL.NE.0.0 .AND. (ABS(GL).LT.0.1 .OR. ABS(GL).GE.1.E5))
+     1    IOFFDT = 1
+      IF (HA.NE.0.0 .AND. (ABS(HA).LT.0.1 .OR. ABS(HA).GE.1.E5))
+     1    IOFFDT = 1
+      ASH = 1.0
+      IF (IOFFDT .NE. 0)
+     1    ASH = 10.**(3-IFIX(ALOG10(AMAX1(ABS(GL),ABS(HA)))-500.)-500)
+      IZFLG = 0
+C
+C COMPUTE ZMN AND ZMX, WHICH ARE USED IN DRWVEC.
+C
+      ZMN = LEN*(GL/HA)
+      ZMX = FLOAT(LEN)+.01
+C
+C DRAW THE VECTORS.
+C
+      DO 123 J=1,NY,INCY
+         DO 122 I=1,NX,INCX
+            UI = U(I,J)
+            VI = V(I,J)
+            IF (ISP-1) 121,119,120
+  119       IF (UI-SPV1) 121,122,121
+  120       IF (VI .EQ. SPV2) GO TO 122
+            IF (ISP .GE. 3) GO TO 119
+  121       X = I
+            Y = J
+            CALL FL2INT(FX(X,Y),FY(X,Y),MX,MY)
+            LX = MAX0(1,MXF(X,Y,UI,VI,SFX,SFY,MX,MY))
+            LY = MAX0(1,MYF(X,Y,UI,VI,SFX,SFY,MX,MY))
+            IZFLG = 1
+            IF (ILAB .NE. 0) CALL ENCD(VLAB(UI,VI,I,J),ASH,LABEL,NC,
+     +                                                           IOFFDT)
+            CALL DRWVEC (MX,MY,LX,LY,LABEL,NC)
+  122    CONTINUE
+  123 CONTINUE
+C
+      IF (IZFLG .EQ. 0) GO TO 125
+C
+      IF (IOFFM .NE. 0) GO TO 200
+C +NOAO - FTN internal write replaced with call to encode
+C     WRITE(LABEL,'(E10.3)')HA
+      call encode (10, '(e10.3)', label, ha)
+C -NOAO
+C
+C     TURN OFF CLIPPING SO ARROW CAN BE DRAWN
+C
+      CALL GQCLIP(IER,ICLP,IAR)
+      CALL GSCLIP(0)
+      CALL DRWVEC (28768,608,28768+LEN,608,LABEL,10)
+C
+C     RESTORE CLIPPING
+C
+      CALL GSCLIP(ICLP)
+        IX = 1+(28768+LEN/2)/ISX
+        IY = 1+(608-(5*ISX*MAX0(256/ISX,8))/4)/ISY
+        CALL GQCNTN(IER,ICN)
+        CALL GSELNT(0)
+        XC = CPUX(IX)
+        YC = CPUY(IY)
+      CALL WTSTR (XC,YC,
+     +                         'MAXIMUM VECTOR',MAX0(256/ISX,8),0,0)
+      CALL GSELNT(ICN)
+C
+C DONE.
+C
+      GOTO 200
+C
+C ZERO-FIELD ACTION.
+C
+  125 IX = 1+16384/ISX
+        IY = 1+16384/ISY
+        CALL GQCNTN(IER,ICN)
+        CALL GSELNT(0)
+        XC = CPUX(IX)
+        YC = CPUY(IY)
+      CALL WTSTR (XC,YC,
+     +                             'ZERO FIELD',MAX0(960/ISX,8),0,0)
+        CALL GSELNT(ICN)
+C
+C RESTORE TRANS 1 AND LOG SCALING AND ORIGINAL TRANS NUMBER
+C
+  200 CONTINUE
+      IF (NSET .LE. 0) THEN
+        CALL SET(VIEW(1),VIEW(2),VIEW(3),VIEW(4),
+     -           WIND(1),WIND(2),WIND(3),WIND(4),IOLLS)
+      ENDIF
+      CALL GSELNT(IOLDNT)
+      RETURN
+      END
+      SUBROUTINE EZVEC (U,V,M,N)
+C
+C THIS SUBROUTINE IS FOR THE USER WHO WANTS A QUICK-AND-DIRTY VECTOR
+C PLOT WITH DEFAULT VALUES FOR MOST OF THE ARGUMENTS.
+C
+        SAVE
+C
+      DIMENSION       U(M,N)     ,V(M,N)     ,SPVAL(2)
+C
+      DATA FLO,HI,NSET,LENGTH,ISPV,SPVAL(1),SPVAL(2) /
+     +      0.,0.,   0,     0,   0,      0.,      0. /
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR.
+C
+      CALL Q8QST4 ('CRAYLIB','VELVCT','EZVEC','VERSION  6')
+C
+      CALL VELVCT (U,M,V,M,M,N,FLO,HI,NSET,LENGTH,ISPV,SPVAL)
+C +NOAO - call to frame is suppressed.
+C     CALL FRAME
+C -NOAO
+      RETURN
+      END
+      SUBROUTINE DRWVEC (M1,M2,M3,M4,LABEL,NC)
+C
+C THIS ROUTINE IS CALLED TO DRAW A SINGLE ARROW.  IT HAS ARGUMENTS AS
+C FOLLOWS -
+C
+C     (M1,M2)  -  COORDINATE OF ARROW BASE, ON A 2**15 X 2**15 GRID.
+C     (M3,M4)  -  COORDINATE OF ARROW HEAD, ON A 2**15 X 2**15 GRID.
+C     LABEL    -  CHARACTER LABEL TO BE PUT ABOVE ARROW.
+C     NC       -  NUMBER OF CHARACTERS IN LABEL.
+C
+        SAVE
+C
+C
+      COMMON /VEC1/   ASH        ,EXT        ,ICTRFG     ,ILAB       ,
+     +                IOFFD      ,IOFFM      ,ISX        ,ISY        ,
+     +                RMN        ,RMX        ,SIDE       ,SIZE       ,
+     +                XLT        ,YBT        ,ZMN        ,ZMX
+        CHARACTER*10 LABEL
+C
+C SOME LOCAL PARAMETERS ARE THE FOLLOWING -
+C
+C     CL     -  ARROW HEAD LENGTH SCALE FACTOR - EACH SIDE OF THE ARROW
+C               HEAD IS THIS LONG RELATIVE TO THE LENGTH OF THE ARROW
+C     ST,CT  -  SIN AND COS OF THE ARROW HEAD ANGLE
+C     PI     -  THE CONSTANT PI
+C     TWOPI  -  TWO TIMES PI
+C     OHOPI  -  ONE HALF OF PI
+C     FHOPI  -  FIVE HALVES OF PI
+C
+      DATA    CL / .25 /
+      DATA    ST / .382683432365090 /
+      DATA    CT / .923879532511287 /
+      DATA    PI / 3.14159265358979 /
+      DATA TWOPI / 6.28318530717959 /
+      DATA OHOPI / 1.57079632679489 /
+      DATA FHOPI / 7.85398163397448 /
+C
+      DIST(X,Y) = SQRT(X*X+Y*Y)
+C
+C TRANSFER ARGUMENTS TO LOCAL VARIABLES AND COMPUTE THE VECTOR LENGTH.
+C
+      N1 = M1
+      N2 = M2
+      N3 = M3
+      N4 = M4
+      DX = N3-N1
+      DY = N4-N2
+      R = DIST(DX,DY)
+C
+C SORT OUT POSSIBLE CASES, DEPENDING ON VECTOR LENGTH.
+C
+      IF (R .LE. ZMN) RETURN
+C
+      IF (R .LE. ZMX) GO TO 101
+C
+C PLOT A POINT FOR VECTORS WHICH ARE TOO LONG.
+C
+      CALL PLOTIT (N1,N2,0)
+      CALL PLOTIT (N1,N2,1)
+      CALL PLOTIT (N1,N2,0)
+      RETURN
+C
+C ADJUST THE COORDINATES OF THE VECTOR ENDPOINTS AS IMPLIED BY THE
+C CENTERING OPTION.
+C
+  101 IF (ICTRFG) 102,103,104
+C
+  102 N3 = N1
+      N4 = N2
+      N1 = FLOAT(N1)-DX
+      N2 = FLOAT(N2)-DY
+      GO TO 104
+C
+  103 N1 = FLOAT(N1)-.5*DX
+      N2 = FLOAT(N2)-.5*DY
+      N3 = FLOAT(N3)-.5*DX
+      N4 = FLOAT(N4)-.5*DY
+C
+C DETERMINE THE COORDINATES OF THE POINTS USED TO DRAW THE ARROWHEAD.
+C
+  104 C1 = CL
+C
+C SHORT ARROWS HAVE HEADS OF A FIXED MINIMUM SIZE.
+C
+      IF (R .LT. RMN) C1 = RMN*CL/R
+C
+C LONG ARROWS HAVE HEADS OF A FIXED MAXIMUM SIZE.
+C
+      IF (R .GT. RMX) C1 = RMX*CL/R
+C
+C COMPUTE THE COORDINATES OF THE HEAD.
+C
+      N5 = FLOAT(N3)-C1*(CT*DX-ST*DY)
+      N6 = FLOAT(N4)-C1*(CT*DY+ST*DX)
+      N7 = FLOAT(N3)-C1*(CT*DX+ST*DY)
+      N8 = FLOAT(N4)-C1*(CT*DY-ST*DX)
+C
+C PLOT THE ARROW.
+C
+      CALL PLOTIT (N1,N2,0)
+      CALL PLOTIT (N3,N4,1)
+      CALL PLOTIT (N5,N6,0)
+      CALL PLOTIT (N3,N4,1)
+      CALL PLOTIT (N7,N8,1)
+      CALL PLOTIT (0,0,0)
+C
+C IF REQUESTED, PUT THE VECTOR MAGNITUDE ABOVE THE ARROW.
+C
+      IF (NC .EQ. 0) RETURN
+      PHI = ATAN2(DY,DX)
+      IF (AMOD(PHI+FHOPI,TWOPI) .GT. PI) PHI = PHI+PI
+      IX = 1+IFIX(.5*FLOAT(N1+N3)+1.25*
+     +            FLOAT(ISX*MAX0(IFIX(SIZE)/ISX,8))*COS(PHI+OHOPI))/ISX
+      IY = 1+IFIX(.5*FLOAT(N2+N4)+1.25*
+     +            FLOAT(ISX*MAX0(IFIX(SIZE)/ISX,8))*SIN(PHI+OHOPI))/ISY
+        CALL GQCNTN(IER,ICN)
+        CALL GSELNT(0)
+        XC = CPUX(IX)
+        YC = CPUY(IY)
+      CALL WTSTR(XC,YC,
+     +           LABEL,MAX0(IFIX(SIZE)/ISX,8),
+     +                                     IFIX(57.2957795130823*PHI),0)
+        CALL GSELNT(ICN)
+      RETURN
+      END
+      SUBROUTINE VELVEC (U,LU,V,LV,M,N,FLO,HI,NSET,ISPV,SPV)
+C
+C THIS ROUTINE SUPPORTS USERS OF THE OLD VERSION OF THIS PACKAGE.
+C
+      DIMENSION       U(LU,N)    ,V(LV,N)    ,SPV(2)
+C
+        SAVE
+C
+C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR.
+C
+      CALL Q8QST4 ('CRAYLIB','VELVCT','VELVEC','VERSION  4')
+      CALL VELVCT (U,LU,V,LV,M,N,FLO,HI,NSET,0,ISPV,SPV)
+      RETURN
+      END
+C
+C REVISION HISTORY ----------------------------------------------------
+C
+C FEBRUARY, 1979   ADDED REVISION HISTORY
+C                  MODIFIED CODE TO CONFORM TO FORTRAN 66 STANDARD
+C
+C JULY, 1979       FIXED HI VECTOR TRAP AND MESSAGE INDICATING
+C                  MAXIMUM VECTOR PLOTTED.
+C
+C DECEMBER, 1979   CHANGED THE STATISTICS CALL FROM CRAYLIB TO NSSL
+C
+C MARCH, 1981      FIXED SOME FRINGE-CASE ERRORS, CHANGED THE CODE TO
+C                  USE FL2INTT AND PLOTIT INSTEAD OF MXMY, FRSTPT, AND
+C                  VECTOR, AND MADE THE ARROWHEADS NARROWER (45 DEGREES
+C                  APART, RATHER THAN 60 DEGREES APART)
+C
+C FEBRUARY, 1984   PROVIDED A DIMENSION STATEMENT FOR A VARIABLE INTO
+C                  WHICH A TEN-CHARACTER STRING WAS BEING ENCODED.  ON
+C                  THE CRAY, WHEN THE ENCODE WAS DONE, A WORD FOLLOWING
+C                  THE VARIABLE WAS CLOBBERED, BUT THIS APPARENTLY MADE
+C                  NO DIFFERENCE.  ON AT LEAST ONE OTHER MACHINE, THE
+C                  CODE BLEW UP.  (ERROR REPORTED BY GREG WOODS)
+C
+C JULY, 1984       CONVERTED TO FORTRAN77 AND GKS.
+C
+C ---------------------------------------------------------------------
diff --git a/sys/gio/nspp/README b/sys/gio/nspp/README
new file mode 100644
index 00000000..38bd1580
--- /dev/null
+++ b/sys/gio/nspp/README
@@ -0,0 +1,9 @@
+NSPP -- The NCAR System Plot Package.
+
+	portlib		portable NSPP modules
+	sysint		the system interface
+
+Usage:
+	The user must supply a subroutine called WRITEB to use the library.
+	See gio$nsppkern for an example.  The subroutine Z8ZPII should be
+	called before using NSPP to initialize the internal variables.
diff --git a/sys/gio/nspp/mkpkg b/sys/gio/nspp/mkpkg
new file mode 100644
index 00000000..3ce0021c
--- /dev/null
+++ b/sys/gio/nspp/mkpkg
@@ -0,0 +1,11 @@
+# Make the LIBNSPP.A library for the Ncar system plot package.
+
+$checkout libnspp.a lib$
+$update   libnspp.a
+$checkin  libnspp.a lib$
+$exit
+
+libnspp.a:
+	@portlib
+	@sysint
+	;
diff --git a/sys/gio/nspp/portlib/README b/sys/gio/nspp/portlib/README
new file mode 100644
index 00000000..261de972
--- /dev/null
+++ b/sys/gio/nspp/portlib/README
@@ -0,0 +1,28 @@
+This directory contains the sources for the NCAR system plot package.
+The original source is in the file "plot.4.8.sav".  If any modifications
+have to be made, they will be recorded here.
+
+REVISIONS
+
+04Mar84 SET --> SPPSET
+	The name of the SET module, used to set the device window and
+	user coordinate system, was changed to SPPSET.  The module "set.x"
+	in the high level code intercepts calls by the utilities to set,
+	so that the transformations may be stored away in a file for recovery
+	by another process.
+
+05Mar84 Elimination of Fortran i/o
+	All formatted writes to mprint were commented out.
+
+05Mar48 Resolve library conflict
+	getchr --> ncgchr		[collision with fio.getchar]
+	putchr --> ncpchr		[for consistency with above]
+
+12Mar84 Moved most of the initialization from the block data z8zpbd into
+	the initialization subroutine z8zpii, called by nspp_init at
+	GOPEN time.
+
+12Dec85 SPPSET -> SET
+	Changed this guy back, as the high level interface to the system
+	plot package is no longer used.  The NCAR system plot package stuff
+	is only used by the GIO/NCAR kernel now.
diff --git a/sys/gio/nspp/portlib/axes.f b/sys/gio/nspp/portlib/axes.f
new file mode 100644
index 00000000..badf7004
--- /dev/null
+++ b/sys/gio/nspp/portlib/axes.f
@@ -0,0 +1,6 @@
+      subroutine axes (x,y)
+      call getset (idummy,idummy,idummy,idummy,xc,xd,yc,yd,idummy)
+      call line (x,yc,x,yd)
+      call line (xc,y,xd,y)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/curve.f b/sys/gio/nspp/portlib/curve.f
new file mode 100644
index 00000000..265b9811
--- /dev/null
+++ b/sys/gio/nspp/portlib/curve.f
@@ -0,0 +1,41 @@
+      subroutine curve (x,y,n)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      dimension       x(n)   ,y(n)
+c
+      kn = n
+      if (kn-1) 104,103,101
+  101 xx = x(1)
+      yy = y(1)
+      call trans
+      minst = 0
+      call put42
+      do 102 i=2,kn
+         xx = x(i)
+         yy = y(i)
+         call trans
+         minst = 1
+         call put42
+  102 continue
+      go to 104
+  103 call point (x(1),y(1))
+  104 continue
+      return
+      end
diff --git a/sys/gio/nspp/portlib/dashln.f b/sys/gio/nspp/portlib/dashln.f
new file mode 100644
index 00000000..35ac6851
--- /dev/null
+++ b/sys/gio/nspp/portlib/dashln.f
@@ -0,0 +1,5 @@
+      subroutine dashln (ipat)
+      jpat = ior(ishift(ipat,6),ishift(ipat,-4))
+      call optn (4hdpat,jpat)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/fl2int.f b/sys/gio/nspp/portlib/fl2int.f
new file mode 100644
index 00000000..59939aca
--- /dev/null
+++ b/sys/gio/nspp/portlib/fl2int.f
@@ -0,0 +1,31 @@
+      subroutine fl2int (x,y,imx,imy)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      nx = mx
+      ny = my
+      xx = x
+      yy = y
+      call trans
+      imx = mx
+      imy = my
+      mx = nx
+      my = ny
+      return
+      end
diff --git a/sys/gio/nspp/portlib/flash1.f b/sys/gio/nspp/portlib/flash1.f
new file mode 100644
index 00000000..39fb31c6
--- /dev/null
+++ b/sys/gio/nspp/portlib/flash1.f
@@ -0,0 +1,42 @@
+      subroutine flash1 (ibuf,ibufl)
+      dimension       ibuf(ibufl)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      if (modef .eq. 1) go to 101
+      mxold = -9999
+      myold = -9999
+      call mcflsh
+      mbufa = loci(ibuf)
+      mbufl = ibufl
+      modef = 1
+      mnxsto = mjxmin
+      mnysto = mjymin
+      mxxsto = mjxmax
+      mxysto = mjymax
+      mjxmin = 32767
+      mjymin = 32767
+      mjxmax = 0
+      mjymax = 0
+      mbuflu = 0
+      return
+c
+  101 call uliber (0,
+     1             48h0flash1 called consecutively without flash2 call,
+     2             48)
+      call perror
+      return
+      end
diff --git a/sys/gio/nspp/portlib/flash2.f b/sys/gio/nspp/portlib/flash2.f
new file mode 100644
index 00000000..0f909414
--- /dev/null
+++ b/sys/gio/nspp/portlib/flash2.f
@@ -0,0 +1,71 @@
+      subroutine flash2 (ipoint,ibuflu)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       idummy(1)
+      if (modef .ne. 1) go to 101
+      kpoint = ipoint
+      if (kpoint.lt.0 .or. kpoint.gt.10) go to 102
+      call flushb
+      nextra = 5
+      ibuflu = mbuflu+nextra
+      if (mf2er .gt. 0) go to 103
+      if (ibuflu .gt. mbufl) go to 103
+      mfwa(kpoint+1) = mbufa
+      mlwa(kpoint+1) = mbufa+mbuflu-1
+      isub = mbufa+mbuflu-loci(idummy)
+      idummy(isub+1) = mbuflu
+      idummy(isub+2) = mjxmin
+      idummy(isub+3) = mjymin
+      idummy(isub+4) = mjxmax
+      idummy(isub+5) = mjymax
+      modef = 2
+      mbufa = loci(msybuf)
+      mbufl = msblen
+      mbuflu = 0
+      mbprs(1) = mpair1
+      mbprs(2) = mpair2
+      mipair = 2
+      mflcnt = 0
+      mxold = -9999
+      myold = -9999
+      mjxmin = mnxsto
+      mjymin = mnysto
+      mjxmax = mxxsto
+      mjymax = mxysto
+      return
+c
+  101 call uliber (0,29h0flash2 called without flash1,29)
+      call perror
+      return
+  102 continue
+c     write (mprint,1001) kpoint
+c
+      call uliber (0,38h0first argument to flash2 out of range,38)
+      call perror
+      return
+  103 continue
+      nlen = mf2er*mbufl+ibuflu
+c     write (mprint,1002) nlen
+c
+      call uliber (0,23h0flash buffer too short,23)
+      call perror
+      return
+c
+c1001 format (27h0flash2 called with ipoint=,i5)
+c1002 format (27h0flash buffer must be about,i8,11h words long)
+c
+      end
diff --git a/sys/gio/nspp/portlib/flash3.f b/sys/gio/nspp/portlib/flash3.f
new file mode 100644
index 00000000..ce7f36d5
--- /dev/null
+++ b/sys/gio/nspp/portlib/flash3.f
@@ -0,0 +1,70 @@
+      subroutine flash3 (ipoint)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       idummy(1)
+      if (modef .lt. 2) go to 102
+      kpoint = ipoint
+      if (kpoint.lt.0 .or. kpoint.gt.10) go to 103
+      if (mfwa(kpoint+1) .eq. -9999) go to 102
+      call mcflsh
+      isave1 = mbufa
+      isave2 = mbuflu
+      mbufa = mfwa(kpoint+1)
+      nlentg = mlwa(kpoint+1)-mbufa+1
+      isub = mbufa+nlentg-loci(idummy)
+      nusrwc = idummy(isub+1)
+      if (nusrwc .ne. nlentg) go to 104
+      modef = -3
+  101 mbuflu = min0(nlentg,msblen)
+      if (mbuflu .gt. 0) call preout
+      nlentg = nlentg-msblen
+      mbufa = mbufa+msblen
+      if (nlentg .gt. 0) go to 101
+      mbufa = isave1
+      mbuflu = isave2
+      mxold = -9999
+      myold = -9999
+      modef = 3
+      mjxmin = min0(mjxmin,idummy(isub+2))
+      mjymin = min0(mjymin,idummy(isub+3))
+      mjxmax = max0(mjxmax,idummy(isub+4))
+      mjymax = max0(mjymax,idummy(isub+5))
+      return
+  102 continue
+c     write (mprint,1001) kpoint
+c
+      call uliber (0,
+     1             48h0flash3 called without call to flash1 and flash2,
+     2             48)
+      call perror
+      return
+  103 continue
+c     write (mprint,1001) kpoint
+c
+      call uliber (0,37h0argument out of range in flash3 call,37)
+      call perror
+      return
+  104 continue
+c     write (mprint,1001) kpoint
+c
+      call uliber (0,37h0user flash buffer has been corrupted,37)
+      call perror
+      return
+c
+c1001 format (27h0flash3 called with ipoint=,i5)
+c
+      end
diff --git a/sys/gio/nspp/portlib/flash4.f b/sys/gio/nspp/portlib/flash4.f
new file mode 100644
index 00000000..9fc13238
--- /dev/null
+++ b/sys/gio/nspp/portlib/flash4.f
@@ -0,0 +1,46 @@
+      subroutine flash4 (ifw,lwd,ipoint)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       ifw(1) ,lwd(1)
+      jfwa = loci(ifw)
+      jlwda = loci(lwd)
+      kpoint = ipoint
+      if (jfwa .gt. jlwda) go to 101
+      if (kpoint.lt.0 .or. kpoint.gt.10) go to 102
+      nextra = 5
+      mfwa(kpoint+1) = jfwa
+      mlwa(kpoint+1) = jlwda-nextra
+      nwds = jlwda-jfwa
+      modef = 4
+      return
+  101 continue
+c     write (mprint,1001) jfwa,jlwda
+c
+      call uliber (0,38h0loci(ifw).gt.loci(lwd) in flash4 call,38)
+      call perror
+      return
+  102 continue
+c     write (mprint,1002) kpoint
+c
+      call uliber (0,43h0third argument out of range in flash4 call,43)
+      call perror
+      return
+c
+c1001 format (10h0loci(ifw)=,i10,10x,9hloci(lwd)=,i10)
+c1002 format (27h0flash4 called with ipoint=,i5)
+c
+      end
diff --git a/sys/gio/nspp/portlib/flush.f b/sys/gio/nspp/portlib/flush.f
new file mode 100644
index 00000000..07ee8418
--- /dev/null
+++ b/sys/gio/nspp/portlib/flush.f
@@ -0,0 +1,22 @@
+      subroutine mcflsh
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      if (modef .eq. 1) go to 101
+      call flushb
+      if (mbuflu .gt. 0) call preout
+  101 return
+      end
diff --git a/sys/gio/nspp/portlib/flushb.f b/sys/gio/nspp/portlib/flushb.f
new file mode 100644
index 00000000..7f88c29b
--- /dev/null
+++ b/sys/gio/nspp/portlib/flushb.f
@@ -0,0 +1,41 @@
+      subroutine flushb
+c     dimension       idummy(1)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      external        z8zpbd
+      if (mipair .eq. 16) go to 102
+      if (mipair .eq. 0) return
+      if (mipair.eq.2 .and. mflcnt.eq.0) return
+      mipp1 = mipair+1
+      do 101 i=mipp1,16
+         mbprs(i) = 40992
+  101 continue
+  102 if (mbufa .eq. -9999) mbufa = loci(msybuf)
+      mflcnt = mflcnt+1
+      call packum (mbprs,16,mbufa+mbuflu)
+      mbuflu = mbuflu+8
+      mipair = 0
+      if (modef .eq. 1) go to 103
+      if (mbuflu+8 .le. mbufl) return
+      if (mbuflu .gt. 0) call preout
+      return
+  103 if (mod(mbuflu,msblen) .eq. 0) go to 104
+      if (mbuflu+8 .le. mbufl) return
+  104 continue
+      if (mbuflu .gt. 0) call preout
+      return
+      end
diff --git a/sys/gio/nspp/portlib/frame.f b/sys/gio/nspp/portlib/frame.f
new file mode 100644
index 00000000..c8396fcd
--- /dev/null
+++ b/sys/gio/nspp/portlib/frame.f
@@ -0,0 +1,70 @@
+      subroutine frame
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      if (modef .eq. 1) go to 101
+      mbpair = ior(ishift(226,8),0)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if ((mipair+5) .gt. 16) call flushb
+      mbpair = ior(ishift(231,8),8)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = mjxmin
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = mjymin
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = mjxmax
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = mjymax
+      mfrend = 1
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      call flushb
+      if (mbuflu .gt. 0) call preout
+      mjxmin = 32767
+      mjymin = 32767
+      mjxmax = 0
+      mjymax = 0
+      mxold = -9999
+      myold = -9999
+      mop(1) = 0
+      mop(2) = 204
+      mop(5) = 0
+      mop(3) = 0
+      mop(4) = 128
+      mop(7) = 8
+      mop(6) = ior(1,ishift(32767,1))
+      mop(8) = 0
+      mop(9) = 0
+      mop(10) = 0
+      mfrend = 0
+      return
+c
+  101 call uliber (0,45h0frame call illegal between flash1 and flash2,
+     1             45)
+      call perror
+      return
+      end
diff --git a/sys/gio/nspp/portlib/frstpt.f b/sys/gio/nspp/portlib/frstpt.f
new file mode 100644
index 00000000..7fea3675
--- /dev/null
+++ b/sys/gio/nspp/portlib/frstpt.f
@@ -0,0 +1,30 @@
+      subroutine frstpt (x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      mxold = mx
+      myold = my
+      xx = x
+      yy = y
+      call trans
+      if (iabs(mx-mxold)+iabs(my-myold) .eq. 0) return
+      minst = 0
+      call put42
+      return
+      end
diff --git a/sys/gio/nspp/portlib/getopt.f b/sys/gio/nspp/portlib/getopt.f
new file mode 100644
index 00000000..10474014
--- /dev/null
+++ b/sys/gio/nspp/portlib/getopt.f
@@ -0,0 +1,37 @@
+      subroutine getopt (iopnam,iopval)
+      dimension       iopnam(1)      ,iopval(1)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c find index for input name
+c
+      do 101 i=1,9
+         iop = i
+         if (jlm2(iopnam) .eq. jlm2(mname(i))) go to 102
+  101 continue
+c
+      call uliber (0,36hounknown name in optn or getopt call,36)
+      call perror
+      return
+  102 if (iop .eq. 9) go to 103
+      return
+  103 do 104 i=1,3
+         call ncgchr (mop(iop),3,i,jchar)
+         call ncpchr (iopval,3,i,jchar)
+  104 continue
+      return
+      end
diff --git a/sys/gio/nspp/portlib/getset.f b/sys/gio/nspp/portlib/getset.f
new file mode 100644
index 00000000..7bc6b8ce
--- /dev/null
+++ b/sys/gio/nspp/portlib/getset.f
@@ -0,0 +1,28 @@
+      subroutine getset (nxa,nxb,nya,nyb,xc,xd,yc,yd,itype)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      nxa = ishift(mxa,-mshftx)+1
+      nxb = ishift(mxb,-mshftx)+1
+      xc = xxc
+      xd = xxd
+      nya = ishift(mya,-mshfty)+1
+      nyb = ishift(myb,-mshfty)+1
+      yc = yyc
+      yd = yyd
+      itype = mtype
+      return
+      end
diff --git a/sys/gio/nspp/portlib/getsi.f b/sys/gio/nspp/portlib/getsi.f
new file mode 100644
index 00000000..400da7b1
--- /dev/null
+++ b/sys/gio/nspp/portlib/getsi.f
@@ -0,0 +1,21 @@
+      subroutine getsi (npowx,npowy)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      npowx = 15-mshftx
+      npowy = 15-mshfty
+      return
+      end
diff --git a/sys/gio/nspp/portlib/grid.f b/sys/gio/nspp/portlib/grid.f
new file mode 100644
index 00000000..358045fc
--- /dev/null
+++ b/sys/gio/nspp/portlib/grid.f
@@ -0,0 +1,4 @@
+      subroutine grid (magrx,minrx,magry,minry)
+      call gridal (magrx,minrx,magry,minry,0,0,0,1,1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/gridal.f b/sys/gio/nspp/portlib/gridal.f
new file mode 100644
index 00000000..814cb42e
--- /dev/null
+++ b/sys/gio/nspp/portlib/gridal.f
@@ -0,0 +1,218 @@
+      subroutine gridal (imajx,iminx,imajy,iminy,ixlab,iylab,iflg,x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c non-compact version of gridal
+c
+c     ray bovet ishft changed to ishfta patch
+      dimension       nmaj(2),nmin(2),nlab(2),nflg(2),num(2) ,zza(2) ,
+     1                zzb(2) ,zzc(2) ,zzd(2) ,ichars(5)      ,
+     2                ifmt(3,2)      ,iz(2)  ,iza(2) ,izb(2) ,imz(2) ,
+     3                izdec(2)       ,isiz(2),imajl(2)       ,
+     4                iminl(2)       ,itype(2)       ,zz(2)  ,
+     5                ishfta(2)       ,izaa(2),izbb(2),kz(4)
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+c
+c     ray bovet ishft changed to ishfta patch
+      equivalence     (xxa,zza(1))   ,(xxb,zzb(1))   ,(xxc,zzc(1))   ,
+     1                (xxd,zzd(1))   ,(mfmtx(1),ifmt(1,1)),
+     2                (mx,iz(1))     ,(mxa,iza(1))   ,(mxb,izb(1))   ,
+     3                (majx,nmaj(1)) ,(minx,nmin(1)) ,(mumx,num(1))  ,
+     4                (mxdec,izdec(1))       ,(msizx,isiz(1)),
+     5                (mmgrx,imajl(1))       ,(mmnrx,iminl(1))       ,
+     6                (mtypex,itype(1))      ,(xx,kz(1))     ,
+     7                (xx,zz(1))     ,(mshftx,ishfta(1))
+c
+c set up variables for loop
+c
+      nmaj(1) = imajx
+      nmaj(2) = imajy
+      nmin(1) = iminx
+      nmin(2) = iminy
+      nlab(1) = ixlab
+      nlab(2) = iylab
+      nflg(1) = ishift(iflg,-2)-1
+      nflg(2) = iand(iflg,3)-1
+      izaa(1) = iza(1)
+      izaa(2) = iza(2)
+      izbb(1) = izb(1)
+      izbb(2) = izb(2)
+      if (nflg(1).le.0 .and. nflg(2).le.0) go to 101
+      xx = x
+      yy = y
+      call trans
+      if (nflg(2) .gt. 0) izaa(1) = mx
+      if (nflg(1) .gt. 0) izaa(2) = my
+      if (nflg(2) .gt. 0) izbb(1) = mx
+      if (nflg(1) .gt. 0) izbb(2) = my
+  101 continue
+      call optn (4hdpat,65535)
+      do 121 i=1,2
+c
+c i=1 for x axis with ticks in y direction
+c i=2 for y axis with ticks in x direction
+c
+         if (nlab(i)) 121,102,102
+  102    continue
+c
+c ior.ne.0 posibility for x only
+c
+         ixor = (2-i)*90*mxor
+         imaj = max0(nmaj(i),1)
+         imin = max0(nmin(i),1)
+         begin = iza(i)
+         biginc = float(izb(i)-iza(i))/float(imaj)
+         smlinc = biginc/float(imin)
+         start = zzc(i)
+         dif = (zzd(i)-zzc(i))/float(imaj)
+         iop = 3-i
+c
+c iop is the opposit axis to i
+c
+         idec = izdec(iop)
+         if (idec .eq. 0) idec = izaa(iop)-izbb(iop)-655
+         if (ixor .eq. i-1) go to 103
+c
+c labels and axis are orthogonal
+c
+         icent = isign(1,idec-1)
+         go to 104
+c
+c labels and axis are parallel
+c
+  103    icent = 0
+  104    continue
+         if (itype(i) .eq. 0) go to 105
+         fact = 10.**imaj
+         if (zzc(i) .gt. zzd(i)) fact = 1./fact
+         val = zzc(i)/fact
+         delval = val
+         if (imin.le.10 .and. imaj.eq.1) imin = 9
+         if (imin .ne. 9) imin = 1
+         imaj = abs(alog10(zzd(i)/zzc(i)))+1.0001
+  105    imajp1 = imaj+1
+         iminm1 = imin-1
+         do 119 j=1,imajp1
+            part = j-1
+c
+c draw major line or tick
+c
+            call optn (4hintn,4hhigh)
+            if (itype(i) .ne. 0) go to 106
+            iz(i) = begin+part*biginc
+            go to 107
+  106       val = val*fact
+            zz(i) = val
+            kz(iop) = 1
+            call trans
+            delval = delval*fact
+            if (iz(i)-10 .gt. izb(i)) go to 120
+  107       continue
+            iz(iop) = izaa(iop)
+            minst = 0
+            call put42
+            if (nflg(i)) 108,109,109
+  108       iz(iop) = izb(iop)
+            minst = 1
+            call put42
+            go to 111
+  109       iz(iop) = izaa(iop)+imajl(iop)
+            minst = 1
+            call put42
+            if (nflg(i)) 110,110,111
+  110       iz(iop) = izb(iop)
+            minst = 0
+            call put42
+            iz(iop) = izb(iop)-imajl(iop)
+            minst = 1
+            call put42
+  111       continue
+c
+c form label if needed
+c
+            if (nlab(i) .le. 0) go to 112
+            if (itype(i) .eq. 0) val = start+part*dif
+            call encode (num(i),ifmt(1,i),ichars,val)
+c     ray bovet ishft changed to ishfta patch
+            imz(i) = ishift(iz(i),-ishfta(i))
+            imz(iop) = max0(1,ishift(izaa(iop)-idec,-ishfta(iop)))
+            njust = num(i)
+            if (icent .eq. 0) call justfy (ichars,num(i),njust)
+            call pwrit (imz(1),imz(2),ichars,njust,isiz(i),ixor,icent)
+c
+c put in minor ticks
+c
+  112       if (iminm1.le.0 .or. j.eq.imajp1) go to 119
+            call optn (4hintn,3hlow)
+            do 118 k=1,iminm1
+               if (itype(i) .ne. 0) go to 113
+               iz(i) = begin+part*biginc+float(k)*smlinc
+               go to 114
+  113          zz(i) = val+float(k)*delval
+               if (zzc(i) .gt. zzd(i)) zzi = val-float(k)*delval*.1
+               kz(iop) = 1
+               call trans
+               if (iz(i) .gt. izb(i)) go to 120
+               if (iz(i) .lt. iza(i)) go to 118
+  114          continue
+               iz(iop) = izaa(iop)
+               minst = 0
+               call put42
+               if (nflg(i)) 115,116,116
+  115          iz(iop) = izb(iop)
+               minst = 1
+               call put42
+               go to 118
+  116          iz(iop) = izaa(iop)+iminl(iop)
+               minst = 1
+               call put42
+               if (nflg(i)) 117,117,118
+  117          iz(iop) = izb(iop)
+               minst = 0
+               call put42
+               iz(iop) = izb(iop)-iminl(iop)
+               minst = 1
+               call put42
+  118       continue
+  119    continue
+         call optn (4hintn,4hhigh)
+  120    if (nflg(iop) .lt. 0) go to 121
+c
+c draw axis line
+c
+         iz(i) = iza(i)
+         iz(iop) = izaa(iop)
+         minst = 0
+         call put42
+         iz(i) = izb(i)
+         iz(iop) = izaa(iop)
+         minst = 1
+         call put42
+         if (nflg(i) .gt. 0) go to 121
+         iz(i) = iza(i)
+         iz(iop) = izb(iop)
+         minst = 0
+         call put42
+         iz(i) = izb(i)
+         iz(iop) = izb(iop)
+         minst = 1
+         call put42
+  121 continue
+      return
+      end
diff --git a/sys/gio/nspp/portlib/gridl.f b/sys/gio/nspp/portlib/gridl.f
new file mode 100644
index 00000000..7de4687f
--- /dev/null
+++ b/sys/gio/nspp/portlib/gridl.f
@@ -0,0 +1,4 @@
+      subroutine gridl (magrx,minrx,magry,minry)
+      call gridal (magrx,minrx,magry,minry,1,1,0,1,1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/halfax.f b/sys/gio/nspp/portlib/halfax.f
new file mode 100644
index 00000000..c996a4dd
--- /dev/null
+++ b/sys/gio/nspp/portlib/halfax.f
@@ -0,0 +1,4 @@
+      subroutine halfax (magrx,minrx,magry,minry,x,y,ixlab,iylab)
+      call gridal (magrx,minrx,magry,minry,ixlab,iylab,10,x,y)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/jlm2.f b/sys/gio/nspp/portlib/jlm2.f
new file mode 100644
index 00000000..455c1310
--- /dev/null
+++ b/sys/gio/nspp/portlib/jlm2.f
@@ -0,0 +1,7 @@
+      function jlm2 (ichar)
+      dimension       ichar(1)
+      call ncgchr (ichar,2,1,ichar1)
+      call ncgchr (ichar,2,2,ichar2)
+      jlm2 = ior(ishift(ichar1,8),ichar2)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/justfy.f b/sys/gio/nspp/portlib/justfy.f
new file mode 100644
index 00000000..f543e539
--- /dev/null
+++ b/sys/gio/nspp/portlib/justfy.f
@@ -0,0 +1,14 @@
+      subroutine justfy (ichar,len,newlen)
+      dimension       ichar(1)
+      in = 0
+      call ncgchr (1h ,1,1,iblank)
+      do 102 i=1,len
+         call ncgchr (ichar,len,i,jchar)
+         if (in .ne. 0) go to 101
+         if (jchar .eq. iblank) go to 102
+  101    in = in+1
+         call ncpchr (ichar,len,in,jchar)
+  102 continue
+      newlen = in
+      return
+      end
diff --git a/sys/gio/nspp/portlib/labmod.f b/sys/gio/nspp/portlib/labmod.f
new file mode 100644
index 00000000..94110f19
--- /dev/null
+++ b/sys/gio/nspp/portlib/labmod.f
@@ -0,0 +1,53 @@
+      subroutine labmod (ifmtx,ifmty,numx,numy,isizx,isizy,ixdec,iydec,
+     1                   ixor)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet ishft changed to ishfta patch
+      dimension       ifmtx(3)       ,ifmty(3)       ,idec(2),ishfta(2)
+      equivalence     (mxdec,idec(1)),(mshftx,ishfta(1))
+      do 101 i=1,10
+         call ncgchr (ifmtx,10,i,ichar)
+         call ncpchr (mfmtx,10,i,ichar)
+         call ncgchr (ifmty,10,i,ichar)
+         call ncpchr (mfmty,10,i,ichar)
+  101 continue
+      mumx = numx
+      mumy = numy
+      if (max0(mumx,mumy) .gt. 20) go to 103
+      msizx = isizx
+      msizy = isizy
+      mxdec = ixdec
+      mydec = iydec
+      do 102 i=1,2
+c     ray bovet ishft changed to ishfta patch
+         jdec = isign(ishift(iabs(idec(i)),ishfta(i)),idec(i))
+         if (idec(i) .eq. 0) jdec = 655
+         if (idec(i) .eq. 1) jdec = 0
+         idec(i) = jdec
+  102 continue
+      mxor = ixor
+      return
+  103 continue
+c     write (mprint,1001) mumx,mumy
+c
+      call uliber (0,36h0numx or numy .gt. 20 in labmod call,36)
+      call perror
+      return
+c
+c1001 format (6h0numx=,i5,6h numy=,i5)
+c
+      end
diff --git a/sys/gio/nspp/portlib/line.f b/sys/gio/nspp/portlib/line.f
new file mode 100644
index 00000000..a88330db
--- /dev/null
+++ b/sys/gio/nspp/portlib/line.f
@@ -0,0 +1,32 @@
+      subroutine line (xa,ya,xb,yb)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer xa,xb,ya,yb,xx,yy
+c
+      xx = xa
+      yy = ya
+      call trans
+      minst = 0
+      call put42
+      xx = xb
+      yy = yb
+      call trans
+      minst = 1
+      call put42
+      return
+      end
diff --git a/sys/gio/nspp/portlib/mkpkg b/sys/gio/nspp/portlib/mkpkg
new file mode 100644
index 00000000..a77011d0
--- /dev/null
+++ b/sys/gio/nspp/portlib/mkpkg
@@ -0,0 +1,56 @@
+# Make the NCAR system plot package.
+
+$checkout libnspp.a lib$
+$update   libnspp.a
+$checkin  libnspp.a lib$
+$exit
+
+libnspp.a:
+	axes.f
+	curve.f
+	dashln.f
+	fl2int.f
+	flash1.f
+	flash2.f
+	flash3.f
+	flash4.f
+	flush.f
+	flushb.f
+	frame.f
+	frstpt.f
+	getopt.f
+	getset.f
+	getsi.f
+	grid.f
+	gridal.f
+	gridl.f
+	halfax.f
+	jlm2.f
+	justfy.f
+	labmod.f
+	line.f
+	mxmy.f
+	option.f
+	optn.f
+	perim.f
+	periml.f
+	plotit.f
+	point.f
+	points.f
+	porgn.f
+	preout.f
+	pscale.f
+	psym.f
+	put42.f
+	putins.f
+	pwrit.f
+	pwrt.f
+	set.f
+	seti.f
+	tick4.f
+	ticks.f
+	trans.f
+	vector.f
+	z8zpbd.f
+	z8zpii.f
+	;
diff --git a/sys/gio/nspp/portlib/mxmy.f b/sys/gio/nspp/portlib/mxmy.f
new file mode 100644
index 00000000..d0045227
--- /dev/null
+++ b/sys/gio/nspp/portlib/mxmy.f
@@ -0,0 +1,21 @@
+      subroutine mxmy (imx,imy)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      imx = ishift(mx,-mshftx)+1
+      imy = ishift(my,-mshfty)+1
+      return
+      end
diff --git a/sys/gio/nspp/portlib/option.f b/sys/gio/nspp/portlib/option.f
new file mode 100644
index 00000000..059a7e40
--- /dev/null
+++ b/sys/gio/nspp/portlib/option.f
@@ -0,0 +1,8 @@
+      subroutine option (icas,int,ital,ior)
+      call optn (4hcase,icas)
+      if (int .eq. 0) call optn (4hintn,3hlow)
+      if (int .eq. 1) call optn (4hintn,4hhigh)
+      call optn (4hfont,ital)
+      call optn (4horen,ior)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/optn.f b/sys/gio/nspp/portlib/optn.f
new file mode 100644
index 00000000..965356f1
--- /dev/null
+++ b/sys/gio/nspp/portlib/optn.f
@@ -0,0 +1,99 @@
+      subroutine optn (iopnam,iopval)
+      dimension       iopnam(1)      ,iopval(1)
+      dimension       ichar(3)
+      logical         skip
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+      data ihigh,ilow/2hhi,2hlo/
+c
+c find index for input name
+c
+      do 101 i=1,9
+         iop = i
+         if (jlm2(iopnam) .eq. jlm2(mname(i))) go to 102
+  101 continue
+c
+      call uliber (0,36hounknown name in optn or getopt call,36)
+      call perror
+      return
+  102 continue
+      if (iop.ne.2 .and. iop.ne.9) iopv = iopval(1)
+c
+c     if character input for intensity, change to numeric
+c
+      if (iop .ne. 2) go to 105
+      jchar = jlm2(iopval)
+      if (jchar .ne. jlm2(ihigh)) go to 103
+      iopv = 204
+      go to 105
+  103 if (jchar .ne. jlm2(ilow)) go to 104
+      iopv = 127
+      go to 105
+  104 iopv = iopval(1)
+  105 continue
+c
+c     reset option if necessary
+c
+      if (iop .ne. 9) go to 107
+      skip = modef .eq. 0
+      do 106 i=1,3
+         call ncgchr (iopval,3,i,ichar(i))
+         call ncgchr (mop(iop),3,i,jchar)
+         skip = skip .and. (jchar .eq. ichar(i))
+         call ncpchr (mop(iop),3,i,ichar(i))
+  106 continue
+      if (skip) go to 109
+      nchar = 4
+      mbpair = 1*nchar+58112
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = ior(ishift(iop,8),ichar(1))
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = ior(ishift(ichar(2),8),ichar(3))
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      go to 109
+  107 continue
+      if (mop(iop).eq.iopv .and. modef.eq.0) go to 109
+      mop(iop) = iopv
+      nchar = 2
+      if (iop.eq.6 .or. iop.eq.3 .or. iop.eq.4 .or. iop.eq.7) nchar = 4
+      mbpair = 1*nchar+58112
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if (nchar .eq. 4) go to 108
+      mbpair = ior(ishift(iand(iop,255),8),iand(iopv,255))
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      go to 109
+  108 mbpair = ishift(iop,8)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = iand(iopv,65535)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+  109 return
+      end
diff --git a/sys/gio/nspp/portlib/perim.f b/sys/gio/nspp/portlib/perim.f
new file mode 100644
index 00000000..44c29212
--- /dev/null
+++ b/sys/gio/nspp/portlib/perim.f
@@ -0,0 +1,4 @@
+      subroutine perim (magrx,minrx,magry,minry)
+      call gridal (magrx,minrx,magry,minry,0,0,5,1,1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/periml.f b/sys/gio/nspp/portlib/periml.f
new file mode 100644
index 00000000..a30b839d
--- /dev/null
+++ b/sys/gio/nspp/portlib/periml.f
@@ -0,0 +1,4 @@
+      subroutine periml (magrx,minrx,magry,minry)
+      call gridal (magrx,minrx,magry,minry,1,1,5,1,1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/plotit.f b/sys/gio/nspp/portlib/plotit.f
new file mode 100644
index 00000000..df048298
--- /dev/null
+++ b/sys/gio/nspp/portlib/plotit.f
@@ -0,0 +1,23 @@
+      subroutine plotit (nx,ny,npen)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      mx = max0(0,min0(nx,32767))
+      my = max0(0,min0(ny,32767))
+      minst = max0(0,min0(1,npen))
+      call put42
+      return
+      end
diff --git a/sys/gio/nspp/portlib/point.f b/sys/gio/nspp/portlib/point.f
new file mode 100644
index 00000000..efca3bd0
--- /dev/null
+++ b/sys/gio/nspp/portlib/point.f
@@ -0,0 +1,43 @@
+      subroutine point (x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      mbpair = 59394
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 256
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = x
+      yy = y
+      call trans
+      minst = 0
+      call put42
+      mbpair = 59394
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 0
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      return
+      end
diff --git a/sys/gio/nspp/portlib/points.f b/sys/gio/nspp/portlib/points.f
new file mode 100644
index 00000000..07b11c5b
--- /dev/null
+++ b/sys/gio/nspp/portlib/points.f
@@ -0,0 +1,57 @@
+      subroutine points (x,y,n,ichar,ipen)
+      dimension       x(n)   ,y(n)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      if (n .le. 0) return
+      mbpair = 59394
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if (ichar) 102,101,102
+  101 mbpair = 256
+      go to 103
+  102 call ncgchr (ichar,1,1,jchar)
+      mbpair = 512+jchar
+  103 mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = x(1)
+      yy = y(1)
+      call trans
+      minst = 0
+      call put42
+      if (n .eq. 1) go to 105
+      do 104 i=2,n
+         xx = x(i)
+         yy = y(i)
+         call trans
+         minst = ipen
+         call put42
+  104 continue
+  105 mbpair = 59394
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 0
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      return
+      end
diff --git a/sys/gio/nspp/portlib/porgn.f b/sys/gio/nspp/portlib/porgn.f
new file mode 100644
index 00000000..ed2acf93
--- /dev/null
+++ b/sys/gio/nspp/portlib/porgn.f
@@ -0,0 +1,27 @@
+      subroutine porgn (x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      xx = x
+      yy = y
+      call trans
+      xadd = mx-1
+      yadd = my-1
+      return
+      end
diff --git a/sys/gio/nspp/portlib/preout.f b/sys/gio/nspp/portlib/preout.f
new file mode 100644
index 00000000..ec2ead3b
--- /dev/null
+++ b/sys/gio/nspp/portlib/preout.f
@@ -0,0 +1,116 @@
+      subroutine preout
+      dimension       idummy(1)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c+kpno
+c Initialization moved to z8zpii.f.
+c
+      common /nsplt1/  iclrfb ,isetfb ,ibpw   ,ifwd
+c     data iclrfb/0/, isetfb/0/, ibpw/32/, ifwd/1/
+c-kpno
+c
+      kbufa = mbufa
+c
+c entry while in flash1 mode will cause restart of filling user buffer
+c if its size is exceded.  otherwise it is assumed fixed-length output
+c record size is exceded, so place for 4 bytes is reserved in user
+c buffer, to allow proper record formatting during flash3 call.
+c
+      if (modef .ne. 1) go to 101
+      if (mbuflu+4 .le. mbufl) go to 113
+      mbuflu = 0
+      mf2er = mf2er+1
+      go to 113
+c
+c if necessary, build masks for setting and clearing new-frame flag
+c
+  101 if (iclrfb .ne. 0) go to 103
+      iposn = ibpw*ifwd-21
+      isetfb = ishift(1,iposn)
+      do 102 i=1,ibpw
+         ibit = 1
+         if (i .eq. (ibpw-iposn)) ibit = 0
+         iclrfb = ior(ishift(iclrfb,1),ibit)
+  102 continue
+c
+c in flash3 mode, copy any shorter-than-record-length user buffer into
+c system buffer, to avoid possible addressing error during fixed-length
+c write.
+c
+  103 if (modef .ne. -3) go to 105
+      if (mbuflu .eq. msblen) go to 105
+      isub = kbufa-loci(idummy)+1
+      do 104 i=1,mbuflu
+         msybuf(i) = idummy(isub)
+         isub = isub+1
+  104 continue
+      kbufa = loci(msybuf)
+c
+c compute metacode byte count and put in first 16 bits of buffer.
+c       *** note that we are directly manipulating the
+c           first 32 bits of the output buffer here ***
+c
+  105 mcrout = mcrout+1
+      nbytes = -3+(ibpw*mbuflu-1)/8
+      isub = kbufa-loci(idummy)+1
+      idummy(isub) = ior(idummy(isub),ishift(nbytes,ibpw-16))
+c
+c put in first-record-of-frame flag if appropriate.  otherwise insure
+c frame flag is zeroed.  put buffer out via writeb.
+c
+      isub = kbufa-loci(idummy)+ifwd
+      if (mfrlst .ne. 1) go to 106
+      idummy(isub) = ior(idummy(isub),isetfb)
+      mfrlst = 0
+      go to 107
+  106 idummy(isub) = iand(idummy(isub),iclrfb)
+  107 if (mbuflu .eq. msblen) go to 109
+      isub = kbufa+mbuflu-loci(idummy)
+      do 108 i=mbuflu,msblen
+         isub = isub+1
+         idummy(isub) = 0
+  108 continue
+  109 call writeb (kbufa,mbuflu,munit)
+c
+c if this is last buffer of frame, call writeb with zero-byte-count
+c record, so that it may arrange that such a record follows the last
+c frame of the metafile (note that mbufa points to msybuf when get here)
+c
+      if (mfrend .ne. 1) go to 112
+      mfrlst = 1
+      isub = kbufa-loci(idummy)
+      do 110 i=1,mbuflu
+         isub = isub+1
+         idummy(isub) = 0
+  110 continue
+      do 111 i=1,16
+         mbprs(i) = 0
+  111 continue
+      mbprs(2) = ior(mpair2,2048)
+      call packum (mbprs,16,kbufa)
+      call writeb (kbufa,0,munit)
+c
+c finish up by reserving 4 bytes at start of next output buffer.
+c
+  112 mbuflu = 0
+  113 mbprs(1) = mpair1
+      mbprs(2) = mpair2
+      mipair = 2
+      mflcnt = 0
+      return
+      end
diff --git a/sys/gio/nspp/portlib/pscale.f b/sys/gio/nspp/portlib/pscale.f
new file mode 100644
index 00000000..3145d586
--- /dev/null
+++ b/sys/gio/nspp/portlib/pscale.f
@@ -0,0 +1,21 @@
+      subroutine pscale (scalex,scaley)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      xfactr = scalex*2.**mshftx
+      yfactr = scaley*2.**mshfty
+      return
+      end
diff --git a/sys/gio/nspp/portlib/psym.f b/sys/gio/nspp/portlib/psym.f
new file mode 100644
index 00000000..c16cf020
--- /dev/null
+++ b/sys/gio/nspp/portlib/psym.f
@@ -0,0 +1,27 @@
+      subroutine psym (x,y,ichr,isiz,icas,ip)
+      dimension       ichr(1)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       iwide(4)
+      data iwide(1),iwide(2),iwide(3),iwide(4)/256,384,512,768/
+      if (ip-1) 102,102,101
+  101 call vector (x,y)
+  102 call optn (4hcase,icas)
+      call getopt (5horien,iorn)
+      call pwrit (x,y,ichr,1,isiz,iorn,0)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/put42.f b/sys/gio/nspp/portlib/put42.f
new file mode 100644
index 00000000..5f8aac81
--- /dev/null
+++ b/sys/gio/nspp/portlib/put42.f
@@ -0,0 +1,60 @@
+      subroutine put42
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      mjxmax = max0(mx,mjxmax)
+      mjymax = max0(my,mjymax)
+      mjxmin = min0(mx,mjxmin)
+      mjymin = min0(my,mjymin)
+c
+c test if increment instruction will work
+c
+      if (iabs(mx-mxold).gt.mxmax .or. iabs(my-myold).gt.mymax)
+     1    go to 101
+c
+c construct increment instructions
+c
+      incx = (mx-mxold)/mxfac+160
+      incy = (my-myold)/myfac+32+minst*128
+c
+c put instruction in buffer
+c
+      mbpair = ior(ishift(incx,8),incy)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mxold = mx
+      myold = my
+      return
+  101 continue
+c
+c mx is first half of the instruction as it stands
+c
+      mbpair = mx
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+c
+c my needs only pen bit
+c
+      mbpair = my+ishift(minst,15)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mxold = mx
+      myold = my
+      return
+      end
diff --git a/sys/gio/nspp/portlib/putins.f b/sys/gio/nspp/portlib/putins.f
new file mode 100644
index 00000000..466ebd56
--- /dev/null
+++ b/sys/gio/nspp/portlib/putins.f
@@ -0,0 +1,59 @@
+      subroutine putins (nopcd,ins,nchar)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      dimension       ins(nchar)
+      kopcd = nopcd
+      kchar = nchar
+c
+c put in the two header bytes
+c
+      if (kopcd.lt.0 .or. kopcd.gt.63) go to 102
+      mbpair = ior(ishift(kopcd+192,8),kchar)
+      mipair = mipair+1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if (kchar .eq. 0) return
+      if (kchar.lt.0 .or. kchar.ge.255) go to 103
+c
+c put character string into instruction string
+c
+      do 101 i=1,kchar,2
+         call ncgchr (ins,kchar,i,jcharl)
+         call ncgchr (ins,kchar,i+1,jcharr)
+         mbpair = ior(ishift(jcharl,8),jcharr)
+         mipair = mipair+1
+         mbprs(mipair) = mbpair
+         if (mipair .ge. 16) call flushb
+  101 continue
+      return
+  102 continue
+c     write (mprint,1001) kopcd
+c
+      call uliber (0,40h0in putins call, nopcd .lt. 0 or .ge. 63,40)
+      call perror
+      return
+  103 continue
+c     write (mprint,1002) kchar
+c
+      call uliber (0,41h0in putins call, nchar .le. 0 or .ge. 255,41)
+      call perror
+      return
+c
+c1001 format (7h0nopcd=,i10)
+c1002 format (7h0nchar=,i10)
+c
+      end
diff --git a/sys/gio/nspp/portlib/pwrit.f b/sys/gio/nspp/portlib/pwrit.f
new file mode 100644
index 00000000..56ed0fb2
--- /dev/null
+++ b/sys/gio/nspp/portlib/pwrit.f
@@ -0,0 +1,95 @@
+      subroutine pwrit (x,y,ichar,nchar,isize,ioren,icent)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      dimension       ichar(nchar)
+      dimension       iwide(4)
+      data wide,high,white /6.,7.,2./
+      data iwide(1),iwide(2),iwide(3),iwide(4)/256,384,512,768/
+c
+c copy parameters into local variables
+c
+      kchar = nchar
+      ksize = isize
+      koren = ioren
+c
+c transform character size into metacode units.
+c
+      if (ksize .gt. 3) ksize = ishift(ksize,mshftx)
+      if (ksize .le. 3) ksize = iwide(ksize+1)
+      call optn (4hcsiz,ksize)
+c
+c transform orientation.
+c
+      if (koren .lt. 0) koren = koren+360
+      if (koren .ge. 0) call optn (4horen,koren)
+c
+c pass on centering.
+c
+      call optn (4hcent,max0(0,min0(2,icent+1)))
+c
+c make coordinates global.
+c
+      xx = x
+      yy = y
+      call trans
+c
+c use real variables for convenience.
+c
+      fmx = mx
+      fmy = my
+c
+c work with radians instead of degrees.
+c 2*pi/360. approximately = .0174533
+c
+      angle = float(koren)*.0174533
+c
+c find starting point for string when considering centering option.
+c
+      cosa = cos(angle)
+      sina = sin(angle)
+      wide2 = ksize/2
+      widen = float(ksize*kchar)-float(ksize)*white/wide
+      if (icent) 103,101,102
+  101 fmx = fmx-cosa*widen*.5
+      fmy = fmy-sina*widen*.5
+      go to 103
+  102 fmx = fmx-cosa*widen
+      fmy = fmy-sina*widen
+  103 continue
+      hgt2 = (3*ksize)/4
+      nxul = fmx-cosa*wide2-sina*hgt2
+      nyul = fmy+cosa*hgt2-sina*wide2
+      nxll = fmx-cosa*wide2+sina*hgt2
+      nyll = fmy-cosa*hgt2-sina*wide2
+      nxur = fmx+cosa*widen+cosa*wide2-sina*hgt2
+      nyur = fmy+sina*widen+cosa*hgt2+sina*wide2
+      nxlr = fmx+cosa*widen+cosa*wide2+sina*hgt2
+      nylr = fmy+sina*widen-cosa*hgt2+sina*wide2
+      mjxmax = min0(32767,max0(mjxmax,nxul,nxll,nxur,nxlr))
+      mjxmin = max0(0,min0(mjxmin,nxul,nxll,nxur,nxlr))
+      mjymax = min0(32767,max0(mjymax,nyul,nyll,nyur,nylr))
+      mjymin = max0(0,min0(mjymin,nyul,nyll,nyur,nylr))
+      minst = 0
+      call put42
+      call putins (33,ichar,kchar)
+      mxold = -9999
+      myold = -9999
+      return
+      end
diff --git a/sys/gio/nspp/portlib/pwrt.f b/sys/gio/nspp/portlib/pwrt.f
new file mode 100644
index 00000000..ebb85ca5
--- /dev/null
+++ b/sys/gio/nspp/portlib/pwrt.f
@@ -0,0 +1,12 @@
+      subroutine pwrt (x,y,chars,nchar,jsiz,jor)
+      dimension       chars(1)
+      dimension       jfix(4)
+      data jfix(1),jfix(2),jfix(3),jfix(4)/128,192,256,384/
+      isiz = max0(0,min0(3,jsiz))
+      call fl2int (x,y,nx,ny)
+      call getsi (ixsave,iysave)
+      nx = max0(0,ishift(nx-(1-jor)*jfix(isiz+1),ixsave-15))
+      ny = max0(0,ishift(ny-jor*jfix(isiz+1),iysave-15))
+      call pwrit (nx,ny,chars,nchar,isiz,jor*90,-1)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/set.f b/sys/gio/nspp/portlib/set.f
new file mode 100644
index 00000000..a9417d90
--- /dev/null
+++ b/sys/gio/nspp/portlib/set.f
@@ -0,0 +1,140 @@
+      subroutine set (xa,xb,ya,yb,xc,xd,yc,yd,itype)
+c
+c *************** KPNO -- name changed from set to sppset **********
+c
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer xa,xb,ya,yb,xxa,xxb,yya,yyb,zz
+      logical         intt
+      dimension       zz(4)  ,mz(4)  ,zc(2)  ,zd(2)  ,zfactr(2)      ,
+     1                zadd(2),mtypez(2)
+      dimension       mshftz(2)
+      dimension       mes(2)
+      equivalence     (xxc,zc(1))    ,(xxd,zd(1))    ,(xxa,zz(1))    ,
+     1                (mxa,mz(1))    ,(xfactr,zfactr(1))     ,
+     2                (xadd,zadd(1)) ,(mtypex,mtypez(1))     ,
+     3                (mshftx,mshftz(1))     ,(temp,itemp)
+      data mes(1),mes(2)/1hx,1hy/
+      xxa = xa
+      xxb = xb
+      xxc = xc
+      xxd = xd
+      yya = ya
+      yyb = yb
+      yyc = yc
+      yyd = yd
+      mtype = itype
+      mtypex = (mtype-1)/2
+      mtypey = mod(mtype-1,2)
+c
+c find mxa, mxb, etc by mapping xxa, xxb, etc into integer space if they
+c are not integers
+c
+      do 103 i=1,4
+         k = i
+         if (k .gt. 2) k = k-2
+c     ray bovet patch to avoid small integers being set to 0
+c        temp = zz(i)
+         itemp = zz(i)
+c        if (temp .lt. 0.0) go to 106
+c
+         if (.not.(intt(temp))) go to 101
+         if (itemp.lt.0) go to 106
+         itemp = ishift(itemp-1,mshftz(k))
+         go to 102
+c     ray bovet patch to avoid small integers being set to 0
+c 101    itemp = temp*32767.
+  101    if(temp.lt.0.0) go to 106
+         itemp = temp*32767.
+c
+  102    if (itemp.lt.0 .or. itemp.gt.32767) go to 107
+         mz(i) = itemp
+  103 continue
+c
+c set up parameters for translating real input from frstpt, etc. to
+c integer plotting space
+c
+      do 105 i=1,2
+         prange = mz(i+2)-mz(i)
+         urange = zd(i)-zc(i)
+c
+c test for no range
+c
+         if (urange.eq.0. .or. prange.eq.0.) go to 108
+c
+c test for log scaling
+c
+         if (mtypez(i) .eq. 0) go to 104
+c
+c test for error
+c
+         if (zc(i) .le. 0.) go to 109
+         if (zd(i) .le. 0.) go to 110
+         urange = alog10(zd(i)/zc(i))
+         zfactr(i) = prange/urange
+         zadd(i) = float(mz(i))-zfactr(i)*alog10(zc(i))
+         go to 105
+  104    zfactr(i) = prange/urange
+         zadd(i) = float(mz(i))-zfactr(i)*zc(i)
+  105 continue
+      return
+c
+c error processing
+c
+  106 continue
+      if (i.gt.1 .and. i.lt.4) i = 5-i
+c     write (mprint,1001) i
+c
+      call uliber (0,53h0negative values not allowed in first 4 set argu
+     1ments        ,53)
+      call perror
+      return
+  107 continue
+      if (i.gt.1 .and. i.lt.4) i = 5-i
+c     write (mprint,1002) i
+c
+      call uliber (0,83h0first 4 set arguments must be real between 0 an
+     1d 1 or integers between 1 and 32767,83)
+      call perror
+      return
+  108 continue
+      i1 = i*2+3
+      i2 = i*2+4
+c     write (mprint,1003) i1,i2
+c
+      call uliber (0,31h0no range in x or y in set call,31)
+      call perror
+      return
+  109 continue
+c 109 write (mprint,1004) mes(i)
+      go to 111
+  110 continue
+c 110 write (mprint,1005) mes(i)
+c
+  111 call uliber (0,46h0non-positive argument to set with log scaling,
+     1             46)
+      call perror
+      return
+c
+c1001 format (9h0argument,i2,9h negative)
+c1002 format (9h0argument,i2,13h out of range)
+c1003 format (10h0arguments,i2,4h and,i2,14h are identical)
+c1004 format (1h0,a1,8hc .le. 0)
+c1005 format (1h0,a1,8hd .le. 0)
+c
+      end
diff --git a/sys/gio/nspp/portlib/seti.f b/sys/gio/nspp/portlib/seti.f
new file mode 100644
index 00000000..9bc9a635
--- /dev/null
+++ b/sys/gio/nspp/portlib/seti.f
@@ -0,0 +1,37 @@
+      subroutine seti (npowx,npowy)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c     patch by r bovet to ensure that values are <= 12 on vax
+c     this is necessary to ensure that intt can work.
+c
+      ipowx = npowx
+      ipowy = npowy
+      if(ipowx.le.12) go to 10
+        call uliber(0,'x power input to seti cannot exceed 12
+     & on vax',80)
+         ipowx = 12
+10	continue
+      if(ipowy.le.12) go to 20
+        call uliber(0,'y power input to seti cannot exceed 12
+     & on vax',80)
+         ipowy = 12
+20	continue
+      mshftx = 15-ipowx
+      mshfty = 15-ipowy
+      return
+      end
diff --git a/sys/gio/nspp/portlib/tick4.f b/sys/gio/nspp/portlib/tick4.f
new file mode 100644
index 00000000..2f1d0ace
--- /dev/null
+++ b/sys/gio/nspp/portlib/tick4.f
@@ -0,0 +1,30 @@
+      subroutine tick4 (mgrx,mnrx,mgry,mnry)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c mmgrx(y) is the length in the x(y) direction of major tick marks
+c and is therefor used on the y(x) axis (to be consistent with mx(y)dec
+c of labmod).
+c mgrx(y) is the length of x(y) axis major tick marks.
+c similarly for mmnrx(y) and mnrx(y).
+c
+      mmgrx = isign(ishift(iabs(mgry),mshftx),mgry)
+      mmgry = isign(ishift(iabs(mgrx),mshfty),mgrx)
+      mmnrx = isign(ishift(iabs(mnry),mshftx),mnry)
+      mmnry = isign(ishift(iabs(mnrx),mshfty),mnrx)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/ticks.f b/sys/gio/nspp/portlib/ticks.f
new file mode 100644
index 00000000..96484c5d
--- /dev/null
+++ b/sys/gio/nspp/portlib/ticks.f
@@ -0,0 +1,4 @@
+      subroutine ticks (major,minor)
+      call tick4 (major,minor,major,minor)
+      return
+      end
diff --git a/sys/gio/nspp/portlib/trans.f b/sys/gio/nspp/portlib/trans.f
new file mode 100644
index 00000000..5fe0affc
--- /dev/null
+++ b/sys/gio/nspp/portlib/trans.f
@@ -0,0 +1,52 @@
+      subroutine trans
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer xx,yy
+c
+      logical         intt
+      equivalence     (zz,mz),(temp,itemp)
+c     ray bovet patch to avoid small integers being set to 0
+c     zz = xx
+      mz = xx
+      if (intt(zz)) go to 102
+      if (mtypex .eq. 0) go to 101
+      if (zz .le. 0.0)
+     1    call uliber (0,35h0negative argument with log scaling,35)
+      zz = amax1(zz,small)
+      zz = xfactr*alog10(zz)+xadd
+      go to 103
+  101 zz = xfactr*zz+xadd
+      go to 103
+  102 zz = float(ishift(mz-1,mshftx))
+  103 mx = max1(0.,amin1(32767.,zz))
+c     ray bovet patch to avoid small integers being set to 0
+c     zz = yy
+      mz = yy
+      if (intt(zz)) go to 105
+      if (mtypey .eq. 0) go to 104
+      if (zz .le. 0.0)
+     1    call uliber (0,35h0negative argument with log scaling,35)
+      zz = amax1(zz,small)
+      zz = yfactr*alog10(zz)+yadd
+      go to 106
+  104 zz = yfactr*zz+yadd
+      go to 106
+  105 zz = float(ishift(mz-1,mshfty))
+  106 my = max1(0.,amin1(32767.,zz))
+      return
+      end
diff --git a/sys/gio/nspp/portlib/vector.f b/sys/gio/nspp/portlib/vector.f
new file mode 100644
index 00000000..03b3bac8
--- /dev/null
+++ b/sys/gio/nspp/portlib/vector.f
@@ -0,0 +1,27 @@
+      subroutine vector (x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+      xx = x
+      yy = y
+      call trans
+      minst = 1
+      call put42
+      return
+      end
diff --git a/sys/gio/nspp/portlib/z8zpbd.f b/sys/gio/nspp/portlib/z8zpbd.f
new file mode 100644
index 00000000..4392d84a
--- /dev/null
+++ b/sys/gio/nspp/portlib/z8zpbd.f
@@ -0,0 +1,6 @@
+      subroutine z8zpbd
+c
+c kpno: only obvious constants are initialized in this block data.
+c all other initialization occurs in z8zpii.
+c
+      end
diff --git a/sys/gio/nspp/portlib/z8zpii.f b/sys/gio/nspp/portlib/z8zpii.f
new file mode 100644
index 00000000..580d9968
--- /dev/null
+++ b/sys/gio/nspp/portlib/z8zpii.f
@@ -0,0 +1,362 @@
+      subroutine z8zpii
+c+kpno
+c
+c All data statements changed to runtime assignment statements; routine
+c changed from block data to subroutine.
+c
+c-kpno
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+      common /nsplt1/  iclrfb ,isetfb ,ibpw   ,ifwd
+c
+c      variables                 use
+c      ---------                 ---
+c
+c mmajx,mmajy,mminx,   gridal arguments stored here so they will be in a
+c mminy,mxlab,mylab,   known order for insertion in the instruction
+c mflg                 stream only when ultracompact metacode is
+c                      being produced.
+c
+c mtype                scaling type of the most recent set call
+c
+c mx,my                plotter address of the pen location
+c
+c mxa,mya,mxb,myb      plotter address corresponding to the first four
+c                      arguments of the most recent set call.
+c
+c mtypex,mtypey        a decoding of mtype-- 0 = linear, 1 = log
+c
+c xxa,yya,xxb,yyb,     exact copies of the first eight parameters
+c xxc,yyc,xxd,yyd      of the most recent set call
+c
+c xfactr,yfactr,xadd,  numbers computed from the most recent set call
+c yadd                 arguments so that real valued coordinates can
+c                      be translated to integers by
+c                       mx = xfactr*xx + xadd
+c                      or
+c                       mx = xfactr*alog10(xx) + xadd
+c                      and similarly for y.
+c
+c xx,yy                most recent coordinate input to the plot package
+c
+c mfmtx,mfmty,mumx,    most recent labmod inputs except that mxdec = 0
+c mumy,msizx,msizy,    and mydec = 0 are decoded and mxdec = 1 and
+c mxdec,mydec,mxor     mydec = 1 become 0.
+c
+c mop(i),mname(i)      option names are given in mname and their
+c                      current values in mop
+c
+c mxold,myold,mxmax,   all used for increment instructions only.  mxold
+c mymax,mxfac,myfac    and myold are the plotter coordinates of the
+c                      previous point, mxmax and mymax are the greatest
+c                      distance an increment can move, and mxfac and
+c                      myfac are the number of plotter units per
+c                      increment unit (generally 1, but can be more if
+c                      compaction is important and high resolution is
+c                      not).
+c
+c modef                = 0 flash routines have not been used
+c                      = 1 most recent flash call was to flash1
+c                          (we are between flash1 and flash2 calls
+c                          and the instructions should be put in the
+c                          users buffer)
+c                      = 2 flash1 call has been closed with a
+c                          flash2 call
+c                      =-3 flash3 has been entered, but not exited,
+c                          i.e., flash3 is dumping a user buffer.
+c                      = 3 most recent flash activity is a completed
+c                          flash3 call.
+c                      = 4 most recent flash call was to flash4
+c
+c mf2er                = 0 no flash buffer overflow
+c                      = n counts the number of times the buffer
+c                          was reused so the required size can be
+c                          estimated
+c
+c mshftx,mshfty        the power of two of the ratio between the
+c                      resolution of the metacode address and the
+c                      resolution the user is working in.  in the
+c                      default case, the user assumes the plotter
+c                      is 1024 by 1024 (1024 = 2 **10).  metacode
+c                      addresses have 15 bits, so their capacity is
+c                      32,768.  thus, the default for mshftx and mshfty
+c                      is 5, and user integer coordinates are left
+c                      shifted 5 to make plotter addresses.
+c
+c mmgrx,mmgry,mmnrx,   tick mark lengths (positive values point in)
+c mmnry
+c
+c mcrout               number of metacode records that have been put
+c                      out via preout.
+c
+c mflcnt               used to count the number of flushb calls since
+c                      last mbprs initialization.  it is used to avoid
+c                      empty records which could otherwise be put out.
+c
+c mfrend               frame sets to 1 to indicate last output call of a
+c                      frame,  and resets to zero before returning.
+c
+c mfrlst               preout manipulates, based on mfrend, so that it
+c                      knows when a record is the first of a new frame.
+c
+c mjxmin,mjymin,       used to keep track of the range of the plotting
+c mjxmax,mjymax        address on the frame being created
+c
+c mnxsto,mnysto        used to hold mjxmin,... after flash1 call, and
+c mxxsto,mxysto        restore them after flash2.  mjxmin,... are ac-
+c                      cumulated anew during flash saving, and stored
+c                      in user flash buffer after flash2 call.
+c
+c mpair1,mpair2        two 16-bit pairs used to initialize each output
+c                      record, so that preout may format first 32 bits.
+c                      they are actually put into mbprs at proper times
+c
+c mprint               unit number for printing error messages too
+c                      extensive to be handled by uliber
+c
+c msybuf               buffer to hold up to a few hundred metacode
+c                      instructions
+c
+c msblen               word length of msybuf.
+c
+c mncpw                the number of characters per word on the host
+c                      computer
+c
+c minst                holds instruction op-code for the instruction
+c                      being formed
+c
+c mbufa                contains the address of the buffer for the
+c                      metacode instructions, either loci(msybuf) or
+c                      loci(user buffer) from a flash1 call
+c
+c mbuflu               the number of words of the buffer pointed to by
+c                      mbufa that have been filled with metacode or
+c                      dd80 instructions
+c
+c mfwa,mlwa            contains the first word address and the last
+c                      word address for the flash buffers
+c
+c mipair,mbprs         mbprs is used to store byte pairs of metacode
+c                      until they can be packed in an integral number
+c                      of words and placed in the buffer pointed to by
+c                      mbufa.  mipair tells how much of mbprs has been
+c                      used.
+c
+c mbufl                the length of the buffer pointed to by mbufa.
+c
+c munit                unit number for writing metacode
+c
+c small                smallest positive number on the host computer.
+c                      this is used when nonpositive numbers are plotted
+c                      with log scaling.
+c
+c
+      dimension mfssx(2), mfssy(2), mnsss(9)
+c
+      data mfssx(1)/4h(e10/
+      data mfssx(2)/4h.3) /
+      data mfssy(1)/4h(e10/
+      data mfssy(2)/4h.3) /
+c
+      data mnsss(1)/4hcase/
+      data mnsss(2)/4hintn/
+      data mnsss(3)/4horen/
+      data mnsss(4)/4hcsiz/
+      data mnsss(5)/4hfont/
+      data mnsss(6)/4hdpat/
+      data mnsss(7)/4hssiz/
+      data mnsss(8)/4hcent/
+      data mnsss(9)/4hcolr/
+c
+      do 10 i = 1, 2
+	  mfmtx(i) = mfssx(i)
+10    continue
+      do 11 i = 1, 2
+	  mfmty(i) = mfssy(i)
+11    continue
+      do 12 i = 1, 9
+	  mname(i) = mnsss(i)
+12    continue
+c
+c     data iclrfb/0/, isetfb/0/, ibpw/32/, ifwd/1/
+      iclrfb   = 0
+      isetfb   = 0
+      ibpw     = 32
+      ifwd     = 1
+c
+c     data mtype,mtypex,mtypey/1,0,0/
+      mtype    = 1
+      mtypex   = 0
+      mtypey   = 0
+c
+c     data mx,my/0,0/
+      mx       = 0
+      my       = 0
+c
+c     data xxa,yya,xxb,yyb/0.,0.,1.,1./
+      xxa      = 0.0
+      yya      = 0.0
+      xxb      = 1.0
+      yyb      = 1.0
+c
+c     data xxc,yyc,xxd,yyd/0.,0.,1.,1./
+      xxc      = 0.0
+      yyc      = 0.0
+      xxd      = 1.0
+      yyd      = 1.0
+c
+c     data mxa,mya,mxb,myb/1,1,32767,32767/
+      mxa      = 1
+      mya      = 32767
+      mxb      = 1
+      mxb      = 32767
+c
+c     data xfactr,yfactr/32767.,32767./
+      xfactr   = 32767.
+      yfactr   = 32767.
+c
+c     data xadd,yadd/1.,1./
+      xadd     = 1.0
+      yadd     = 1.0
+c
+c     data mumx,mumy/10,10/
+      mumx     = 10
+      mumy     = 10
+c
+c     data msizx,msizy/0,0/
+      msizx    = 0
+      msizy    = 0
+c
+c     data mxdec,mydec/655,655/
+      mxdec    = 655
+      mydec    = 655
+c
+c     data mxor/0/
+      mxor     = 0
+c
+c     data mop(1)/0/
+c     data mop(2)/204/
+c     data mop(3)/0/
+c     data mop(4)/128/
+c     data mop(5)/0/
+c     data mop(6)/65535/
+c     data mop(7)/8/
+c     data mop(8)/0/
+c     data mop(9)/0/
+      mop(1)   = 0
+      mop(2)   = 204
+      mop(3)   = 0
+      mop(4)   = 128
+      mop(5)   = 0
+      mop(6)   = 65535
+      mop(7)   = 8
+      mop(8)   = 0
+      mop(9)   = 0
+c
+c     data mxold,myold/-9999,-9999/
+      mxold    = -9999
+      myold    = -9999
+c
+c     data mxmax,mymax/31,31/
+      mxmax    = 31
+      mymax    = 31
+c
+c     data mxfac,myfac/1,1/
+      mxfac    = 1
+      myfac    = 1
+c
+c     data mmgrx,mmgry/385,385/
+      mmgrx    = 385
+      mmgry    = 385
+c
+c     data mmnrx,mmnry/255,255/
+      mmnrx    = 255
+      mmnry    = 255
+c
+c     data modef/0/
+      modef    = 0
+c
+c     data mncpw/4/
+      mncpw    = 4
+c
+c     data mbuflu/0/
+      mbuflu   = 0
+c
+c     data msblen/360/
+      msblen   = 360
+c
+c     data mbufl/360/
+      mbufl    = 360
+c
+c     data mf2er/0/
+      mf2er    = 0
+c
+c     data mshftx,mshfty/5,5/
+      mshftx   = 5
+      mshfty   = 5
+c
+c     data mbufa/-9999/
+      mbufa    = -9999
+c
+c     data mflcnt/0/
+      mflcnt   = 0
+c
+c     data mfrend/0/
+      mfrend   = 0
+c
+c     data mfrlst/1/
+      mfrlst   = 1
+c
+c     data mpair1/0/
+      mpair1   = 0
+c
+c     data mpair2/8192/
+      mpair2   = 8192
+c
+c     data mcrout/0/
+      mcrout   = 0
+c
+c     data mbprs(1)/0/
+      mbprs(1) = 0
+c
+c     data mbprs(2)/8192/
+      mbprs(2) = 8192
+c
+c     data mipair/2/
+      mipair   = 2
+c
+c     data mjxmax,mjymax,mjxmin,mjymin/0,0,32767,32767/
+      mjxmax   = 0
+      mjymax   = 0
+      mjxmin   = 32767
+      mjxmin   = 32767
+c
+c set to unit number for printer
+c
+c     data mprint/6/
+      mprint   = 6
+c
+c set to unit number for plotter
+c
+c     data munit/8/
+      munit     = 8
+c set to smallest positive number on the computer
+c
+c     data small/1.e-25/
+      small     = 1.e-25
+      end
diff --git a/sys/gio/nspp/sysint/README b/sys/gio/nspp/sysint/README
new file mode 100644
index 00000000..64537d9d
--- /dev/null
+++ b/sys/gio/nspp/sysint/README
@@ -0,0 +1 @@
+SYSINT -- System interface for the Ncar System Plot Package (NSPP)
diff --git a/sys/gio/nspp/sysint/encd.f b/sys/gio/nspp/sysint/encd.f
new file mode 100644
index 00000000..1dba902b
--- /dev/null
+++ b/sys/gio/nspp/sysint/encd.f
@@ -0,0 +1,78 @@
+      SUBROUTINE ENCD (VALU,ASH,IOUT,NC,IOFFD)
+C
+C
+C
+C
+C ON INPUT     VALU	 FLOATING POINT	NUMBER FROM WHICH THE LABEL IS
+C			 TO BE CREATED.
+C	       ASH	 SEE IOFFD.
+C	       IOFFD	 IF IOFFD .EQ. 0, A LABEL WHICH	REFLECTS THE
+C			      MAGNITUDE	OF VALU	IS TO BE CREATED.
+C			      .1 .LE. ABS(VALU)	.LE. 99999.49999...
+C			      OR VALUE .EQ. 0.0.  THE LABEL CREATED
+C			      SHOULD HAVE 3 TO 5 CHARACTERS DEPENDING
+C			      ON THE MAGNITUDE OF VALU.	 SEE IOUT.
+C			 IF IOFFD .NE. 0, A LABEL WHICH	DOES NOT REFLECT
+C			      THE MAGNITUDE OF VALU IS TO BE CREATED.
+C			      ASH IS USED AS THE NORMALIZATION FACTOR.
+C			      1. .LE. ASH*ABS(VALU) .LT. 1000. OR
+C			      VALU .EQ.	0.0.  THE LABEL	CREATED	SHOULD
+C			      HAVE 1 TO	3 CHARACTERS, DEPENDING	ON THE
+C			      MAGNITUDE	OF ASH*VALU.  SEE IOUT.
+C ON OUTPUT    IOUT	 CONTAINS THE LABEL CREATED.  IT SHOULD	HAVE NO
+C			 LEADING BLANKS.  SEE NC.
+C	       NC	 THE NUMBERS IN	THE LABEL IN IOUT.  SHOULD BE
+C			 1 TO 5.
+C
+      SAVE
+      CHARACTER*11 IFMT, IOUT
+C
+C IFMT MUST HOLD 11 CHARACTERS
+C
+      VAL = VALU
+      IF (IOFFD	.NE. 0)	GO TO 103
+      IF (VAL) 101,104,101
+  101 LOG = IFIX((ALOG10(ABS(VAL))+.00001)+5000.)-5000
+      V	= VAL
+      NS = MAX0(4,MIN0(6,LOG+2))
+      ND = MIN0(3,MAX0(0,2-LOG))
+c     IF (VAL.LT.0)  NS	= NS + 1
+c +noao: replacing ftn i/o for iraf implementation
+c 102 WRITE (IFMT,'(A2,I2,A1,I1,A1)') '(F',NS,'.',ND,')'
+  102 continue
+c     if (len (char (ns + ichar ('0'))) .eq. 2) then
+c	 ifmt(1:7) = '(f  . )'
+c	 ifmt(3:4) = char (ns + ichar ('0'))
+c	 ifmt(6:6) = char (nd + ichar ('0'))
+c     else 
+c	 ifmt(1:6) = '(f . )'
+c	 ifmt(3:3) = char (ns + ichar ('0'))
+c	 ifmt(5:5) = char (nd + ichar ('0'))
+c     endif
+c     WRITE (IOUT,IFMT)	V
+      call encode (ns, ifmt, iout, v)
+      NC = NS
+c +noao
+c The following statement was making 5 digit labels (+4800) come out
+c truncated (+480) and it has been commented out.
+c     IF (LOG.GE.3)  NC	= NC - 1
+c -noao
+      RETURN
+  103 NS = 4
+      IF (VAL.LT.0.)  NS=5
+      IF (VAL.EQ.0.)  NS=2
+      ND = 0
+      V	= VAL*ASH
+      LOG = 100
+      GO TO 102
+  104 iout(1:3) = '0.0'
+      nc = 3
+c 104 NS = 3
+c     ND = 1
+c     LOG = -100
+c     V	= 0.
+c     GO TO 102
+C
+C1001 FORMAT('(F',I2,'.',I1,',1H',A1,')')
+C
+      END
diff --git a/sys/gio/nspp/sysint/encode.f b/sys/gio/nspp/sysint/encode.f
new file mode 100644
index 00000000..e6417bee
--- /dev/null
+++ b/sys/gio/nspp/sysint/encode.f
@@ -0,0 +1,15 @@
+        subroutine encode (nchars, ftnfmt, ftnout, rval)
+
+	character*11 ftnfmt, ftnout
+	integer*2 sppfmt(12), sppout(12)
+	integer SZFMT
+	parameter (SZFMT=11)
+
+c unpack the fortran character string, call fencd to actually encode the
+c output string, then pack the output string into a fortran string for return
+c
+	call f77upk (ftnfmt, sppfmt, SZFMT)
+	call fencd (nchars, sppfmt, sppout, rval)
+	call f77pak (sppout, ftnout, SZFMT)
+
+	end
diff --git a/sys/gio/nspp/sysint/erprt77.f b/sys/gio/nspp/sysint/erprt77.f
new file mode 100644
index 00000000..a4f60e1d
--- /dev/null
+++ b/sys/gio/nspp/sysint/erprt77.f
@@ -0,0 +1,441 @@
+C PACKAGE ERPRT77	 DESCRIPTION OF	INDIVIDUAL USER	ENTRIES
+C			 FOLLOWS THIS PACKAGE DESCRIPTION.
+C
+C LATEST REVISION	 FEBRUARY 1985
+C
+C PURPOSE		 TO PROVIDE A PORTABLE,	FORTRAN	77 ERROR
+C			 HANDLING PACKAGE.
+C
+C USAGE			 THESE ROUTINES	ARE INTENDED TO	BE USED	IN
+C			 THE SAME MANNER AS THEIR SIMILARLY NAMED
+C			 COUNTERPARTS ON THE PORT LIBRARY.  EXCEPT
+C			 FOR ROUTINE SETER, THE	CALLING	SEQUENCES
+C			 OF THESE ROUTINES ARE THE SAME	AS FOR
+C			 THEIR PORT COUNTERPARTS.
+C			 ERPRT77 ENTRY		PORT ENTRY
+C			 -------------		----------
+C			 ENTSR			ENTSRC
+C			 RETSR			RETSRC
+C			 NERRO			NERROR
+C			 ERROF			ERROFF
+C			 SETER			SETERR
+C			 EPRIN			EPRINT
+C			 FDUM			FDUMP
+C
+C I/O			 SOME OF THE ROUTINES PRINT ERROR MESSAGES.
+C
+C PRECISION		 NOT APPLICABLE
+C
+C REQUIRED LIBRARY	 MACHCR, WHICH IS LOADED BY DEFAULT ON
+C FILES			 NCAR'S	CRAY MACHINES.
+C
+C LANGUAGE		 FORTRAN 77
+C
+C HISTORY		 DEVELOPED OCTOBER, 1984 AT NCAR IN BOULDER,
+C			 COLORADO BY FRED CLARE	OF THE SCIENTIFIC
+C			 COMPUTING DIVISION BY ADAPTING	THE NON-
+C			 PROPRIETARY, ERROR HANDLING ROUTINES
+C			 FROM THE PORT LIBRARY OF BELL LABS.
+C
+C PORTABILITY		 FULLY PORTABLE
+C
+C REFERENCES		 SEE THE MANUAL
+C			   PORT	MATHEMATICAL SUBROUTINE	LIBRARY
+C			 ESPECIALLY "ERROR HANDLING" IN	SECTION	2
+C			 OF THE	INTRODUCTION, AND THE VARIOUS
+C			 SUBROUTINE DESCRIPTIONS.
+C ******************************************************************
+C
+C SUBBROUTINE ENTSR(IROLD,IRNEW)
+C
+C PURPOSE		SAVES THE CURRENT RECOVERY MODE	STATUS AND
+C			SETS A NEW ONE.	 IT ALSO CHECKS	THE ERROR
+C			STATE, AND IF THERE IS AN ACTIVE ERROR
+C			STATE A	MESSAGE	IS PRINTED.
+C
+C USAGE			CALL ENTSR(IROLD,IRNEW)
+C
+C ARGUMENTS
+C
+C ON INPUT		 IRNEW
+C			   VALUE SPECIFIED BY USER FOR ERROR
+C			   RECOVERY
+C			   = 0 LEAVES RECOVERY UNCHANGED
+C			   = 1 GIVES  RECOVERY
+C			   = 2 TURNS  RECOVERY OFF
+C
+C ON OUTPUT		 IROLD
+C			   RECEIVES THE	CURRENT	VALUE OF THE ERROR
+C			   RECOVERY MODE
+C
+C SPECIAL CONDITIONS	 IF THERE IS AN	ACTIVE ERROR STATE, THE
+C			 MESSAGE IS PRINTED AND	EXECUTION STOPS.
+C
+C			 ERROR STATES -
+C			 1 - ILLEGAL VALUE OF IRNEW.
+C			 2 - CALLED WHILE IN AN	ERROR STATE.
+C ******************************************************************
+C
+C SUBROUTINE RETSR(IROLD)
+C
+C PURPOSE		 SETS THE RECOVERY MODE	TO THE STATUS GIVEN
+C			 BY THE	INPUT ARGUMENT.	 A TEST	IS THEN	MADE
+C			 TO SEE	IF A CURRENT ERROR STATE EXISTS	WHICH
+C			 IS UNRECOVERABLE; IF SO, RETSR	PRINTS AN
+C			 ERROR MESSAGE AND TERMINATES THE RUN.
+C
+C			 BY CONVENTION,	RETSR IS USED UPON EXIT
+C			 FROM A	SUBROUTINE TO RESTORE THE PREVIOUS
+C			 RECOVERY MODE STATUS STORED BY	ROUTINE
+C			 ENTSR IN IROLD.
+C
+C USAGE			 CALL RETSR(IROLD)
+C
+C ARGUMENTS
+C
+C ON INPUT		 IROLD
+C			   = 1 SETS FOR	RECOVERY
+C			   = 2 SETS FOR	NONRECOVERY
+C
+C ON OUTPUT		 NONE
+C
+C SPECIAL CONDITIONS	 IF THE	CURRENT	ERROR BECOMES UNRECOVERABLE,
+C			 THE MESSAGE IS	PRINTED	AND EXECUTION STOPS.
+C
+C			 ERROR STATES -
+C			   1 - ILLEGAL VALUE OF	IROLD.
+C ******************************************************************
+C
+C INTEGER FUNCTION NERRO(NERR)
+C
+C PURPOSE		 PROVIDES THE CURRENT ERROR NUMBER (IF ANY)
+C			 OR ZERO IF THE	PROGRAM	IS NOT IN THE
+C			 ERROR STATE.
+C
+C USAGE			 N = NERRO(NERR)
+C
+C ARGUMENTS
+C
+C ON INPUT		 NONE
+C
+C ON OUTPUT		 NERR
+C			   CURRENT VALUE OF THE	ERROR NUMBER
+C ******************************************************************
+C SUBROUTINE ERROF
+C
+C PURPOSE		 TURNS OFF THE ERROR STATE BY SETTING THE
+C			 ERROR NUMBER TO ZERO
+C
+C USAGE			 CALL ERROF
+C
+C ARGUMENTS
+C
+C ON INPUT		 NONE
+C
+C ON OUTPUT		 NONE
+C ******************************************************************
+C
+C SUBROUTINE SETER(MESSG,NERR,IOPT)
+C
+C PURPOSE		 SETS THE ERROR	INDICATOR AND, DEPENDING
+C			 ON THE	OPTIONS	STATED BELOW, PRINTS A
+C			 MESSAGE AND PROVIDES A	DUMP.
+C
+C
+C USAGE			 CALL SETER(MESSG,NERR,IOPT)
+C
+C ARGUMENTS
+C
+C ON INPUT		 MESSG
+C			   HOLLERITH STRING CONTAINING THE MESSAGE
+C			   ASSOCIATED WITH THE ERROR
+C
+C			 NERR
+C			   THE NUMBER TO ASSIGN	TO THE ERROR
+C
+C			 IOPT
+C			   = 1 FOR A RECOVERABLE ERROR
+C			   = 2 FOR A FATAL ERROR
+C
+C			  IF IOPT = 1 AND THE USER IS IN ERROR
+C			  RECOVERY MODE, SETERR	SIMPLY REMEMBERS
+C			  THE ERROR MESSAGE, SETS THE ERROR NUMBER
+C			  TO NERR, AND RETURNS.
+C
+C			  IF IOPT = 1 AND THE USER IS NOT IN ERROR
+C			  RECOVERY MODE, SETERR	PRINTS THE ERROR
+C			  MESSAGE AND TERMINATES THE RUN.
+C
+C			  IF IOPT = 2 SETERR ALWAYS PRINTS THE ERROR
+C			  MESSAGE, CALLS FDUM, AND TERMINATES THE RUN.
+C
+C ON OUTPUT		 NONE
+C
+C SPECIAL CONDITIONS	 CANNOT	ASSIGN NERR = 0, AND CANNOT SET	IOPT
+C			 TO ANY	VALUE OTHER THAN 1 OR 2.
+C ******************************************************************
+C
+C  SUBROUTINE EPRIN
+C
+C PURPOSE		 PRINTS	THE CURRENT ERROR MESSAGE IF THE
+C			 PROGRAM IS IN THE ERROR STATE;	OTHERWISE
+C			 NOTHING IS PRINTED.
+C
+C USAGE			 CALL EPRIN
+C
+C ARGUMENTS
+C
+C ON INPUT		 NONE
+C
+C ON OUTPUT		 NONE
+C ******************************************************************
+C
+C SUBROUTINE FDUM
+C
+C PURPOSE		 TO PROVIDE A DUMMY ROUTINE WHICH SERVES
+C			 AS A PLACEHOLDER FOR A	SYMBOLIC DUMP
+C			 ROUTINE, SHOULD IMPLEMENTORS DECIDE TO
+C			 PROVIDE SUCH A	ROUTINE.
+C
+C USAGE			 CALL EPRIN
+C
+C ARGUMENTS
+C
+C ON INPUT		 NONE
+C
+C ON OUTPUT		 NONE
+C ******************************************************************
+      SUBROUTINE ENTSR(IROLD,IRNEW)
+C
+      LOGICAL TEMP
+      IF (IRNEW.LT.0 .OR. IRNEW.GT.2)
+     1	 CALL SETER(' ENTSR - ILLEGAL VALUE OF IRNEW',1,2)
+C
+      TEMP = IRNEW.NE.0
+      IROLD = I8SAV(2,IRNEW,TEMP)
+C
+C  IF HAVE AN ERROR STATE, STOP	EXECUTION.
+C
+      IF (I8SAV(1,0,.FALSE.) .NE. 0) CALL SETER
+     1	 (' ENTSR - CALLED WHILE IN AN ERROR STATE',2,2)
+C
+      RETURN
+C
+      END
+      SUBROUTINE RETSR(IROLD)
+C
+      IF (IROLD.LT.1 .OR. IROLD.GT.2)
+     1	CALL SETER(' RETSR - ILLEGAL VALUE OF IROLD',1,2)
+C
+      ITEMP=I8SAV(2,IROLD,.TRUE.)
+C
+C  IF THE CURRENT ERROR	IS NOW UNRECOVERABLE, PRINT AND	STOP.
+C
+      IF (IROLD.EQ.1 .OR. I8SAV(1,0,.FALSE.).EQ.0) RETURN
+C
+	CALL EPRIN
+	CALL FDUM
+c       STOP
+C
+      END
+      INTEGER FUNCTION NERRO(NERR)
+C
+      NERRO=I8SAV(1,0,.FALSE.)
+      NERR=NERRO
+      RETURN
+C
+      END
+      SUBROUTINE ERROF
+C
+      I=I8SAV(1,0,.TRUE.)
+      RETURN
+C
+      END
+      SUBROUTINE SETER(MESSG,NERR,IOPT)
+C
+      CHARACTER*(*) MESSG
+      COMMON /UERRF/IERF
+C
+C  THE UNIT FOR	ERROR MESSAGES IS I1MACH(4)
+C
+c +noao:  blockdata uerrbd changed to runtime initialization subroutine
+C     FORCE LOAD OF BLOCKDATA
+C
+c     EXTERNAL UERRBD
+      call uerrbd
+c -noao
+      IF (IERF .EQ. 0) THEN
+      IERF = I1MACH(4)
+      ENDIF
+C
+      NMESSG = LEN(MESSG)
+      IF (NMESSG.GE.1) GO TO 10
+C
+C  A MESSAGE OF	NON-POSITIVE LENGTH IS FATAL.
+C
+c +noao:  FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9000)
+c9000	FORMAT(' ERROR 1 IN SETER - MESSAGE LENGTH NOT POSITIVE.')
+        call uliber (1,' SETER - MESSAGE LENGTH NOT POSITIVE.', 80) 
+c -noao
+	GO TO 60
+C
+   10 CONTINUE
+      IF (NERR.NE.0) GO	TO 20
+C
+C  CANNOT TURN THE ERROR STATE OFF USING SETER.
+C
+c +noao:  FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9001)
+c9001	FORMAT(' ERROR 2 IN SETER - CANNOT HAVE NERR=0'/
+c    1	       ' THE CURRENT ERROR MESSAGE FOLLOWS'/)
+        call uliber (2, ' SETER - CANNOT HAVE NERR=0', 80)
+        call uliber (2, ' SETER - THE CURRENT ERROR MSG FOLLOWS', 80) 
+c -noao
+	CALL E9RIN(MESSG,NERR,.TRUE.)
+	ITEMP=I8SAV(1,1,.TRUE.)
+	GO TO 50
+C
+C  SET LERROR AND TEST FOR A PREVIOUS UNRECOVERED ERROR.
+C
+ 20   CONTINUE
+      IF (I8SAV(1,NERR,.TRUE.).EQ.0) GO	TO 30
+C
+c +noao: FTN writes rewritten as calls to uliber for IRAF
+c       WRITE(IERF,9002)
+c9002	FORMAT(' ERROR	  3 IN SETER -',
+c    1	       ' AN UNRECOVERED	ERROR FOLLOWED BY ANOTHER ERROR.'//
+c    2	       ' THE PREVIOUS AND CURRENT ERROR	MESSAGES FOLLOW.'///)
+        call uliber (3,' SETER - A SECOND UNRECOV ERROR SEEN.', 80)
+        call uliber (3,' SETER - THE ERROR MESSAGES FOLLOW.', 80)
+c -noao
+	CALL EPRIN
+	CALL E9RIN(MESSG,NERR,.TRUE.)
+	GO TO 50
+C
+C  SAVE	THIS MESSAGE IN	CASE IT	IS NOT RECOVERED FROM PROPERLY.
+C
+ 30   CALL E9RIN(MESSG,NERR,.TRUE.)
+C
+      IF (IOPT.EQ.1 .OR. IOPT.EQ.2) GO TO 40
+C
+C  MUST	HAVE IOPT = 1 OR 2.
+C
+c +noao:  FTN writes rewritten as calls to uliber for IRAF
+c     WRITE(IERF,9003)
+c9003	FORMAT(' ERROR	  4 IN SETER - BAD VALUE FOR IOPT'//
+c    1	       ' THE CURRENT ERROR MESSAGE FOLLOWS'///)
+        call uliber (4, ' SETER - BAD VALUE FOR IOPT', 80)
+	call uliber (4, ' SETER - THE CURRENT ERR MSG FOLLOWS', 80)
+c -noao 
+	GO TO 50
+C
+C  TEST	FOR RECOVERY.
+C
+ 40   CONTINUE
+      IF (IOPT.EQ.2) GO	TO 50
+C
+      IF (I8SAV(2,0,.FALSE.).EQ.1) RETURN
+C
+      CALL EPRIN
+      CALL FDUM
+c     STOP
+C
+ 50   CALL EPRIN
+ 60   CALL FDUM
+c     STOP
+C
+      END
+      SUBROUTINE EPRIN
+C
+      CHARACTER*1 MESSG
+C
+      CALL E9RIN(MESSG,1,.FALSE.)
+      RETURN
+C
+      END
+      SUBROUTINE E9RIN(MESSG,NERR,SAVE)
+C
+C  THIS	ROUTINE	STORES THE CURRENT ERROR MESSAGE OR PRINTS THE OLD ONE,
+C  IF ANY, DEPENDING ON	WHETHER	OR NOT SAVE = .TRUE. .
+C
+      CHARACTER*(*) MESSG
+      CHARACTER*113 MESSGP
+      LOGICAL SAVE
+      COMMON /UERRF/IERF
+C
+C  MESSGP STORES THE FIRST 113 CHARACTERS OF THE PREVIOUS MESSAGE
+C
+C
+C  START WITH NO PREVIOUS MESSAGE.
+C
+c+noao
+c Moved save to before data statements.
+      SAVE MESSGP,NERRP
+c-noao
+      DATA MESSGP/'1'/
+      DATA NERRP/0/
+C
+      IF (.NOT.SAVE) GO	TO 20
+C
+C  SAVE	THE MESSAGE.
+C
+	NERRP=NERR
+	MESSGP = MESSG
+C
+	GO TO 30
+C
+ 20   IF (I8SAV(1,0,.FALSE.).EQ.0) GO TO 30
+C
+C  PRINT THE MESSAGE.
+C
+c +noao:  FTN write rewritten as call to uliber
+c     WRITE(IERF,9000) NERRP,MESSGP
+c9000 FORMAT(' ERROR ',I4,' IN ',A113)
+      call uliber (nerrp, messgp, 113)
+C
+ 30   RETURN
+C
+      END
+      INTEGER FUNCTION I8SAV(ISW,IVALUE,SET)
+C
+C  IF (ISW = 1)	I8SAV RETURNS THE CURRENT ERROR	NUMBER AND
+C		SETS IT	TO IVALUE IF SET = .TRUE. .
+C
+C  IF (ISW = 2)	I8SAV RETURNS THE CURRENT RECOVERY SWITCH AND
+C		SETS IT	TO IVALUE IF SET = .TRUE. .
+C
+      LOGICAL SET
+C
+C  START EXECUTION ERROR FREE AND WITH RECOVERY	TURNED OFF.
+C
+c+noao
+c Moved save to before data statement.
+      SAVE LERROR,LRECOV
+      DATA LERROR/0/ , LRECOV/2/
+c-noao
+      IF (ISW .EQ. 1) THEN
+	I8SAV =	LERROR
+	IF (SET) LERROR	= IVALUE
+      ELSE IF (ISW .EQ.	2) THEN
+	I8SAV =	LRECOV
+	IF (SET) LRECOV	= IVALUE
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE FDUM
+C
+C     DUMMY ROUTINE TO BE LOCALLY IMPLEMENTED
+C
+      RETURN
+      END
+c +noao:  Blockdata uerrbd rewritten as a runtime initialization subroutine
+c     BLOCKDATA	UERRBD
+      subroutine uerrbd
+c
+      COMMON /UERRF/IERF
+C     DEFAULT ERROR UNIT
+c     DATA IERF/0/
+      IERF= 0
+      END
+c -noao
diff --git a/sys/gio/nspp/sysint/fencode.x b/sys/gio/nspp/sysint/fencode.x
new file mode 100644
index 00000000..fe3e37ed
--- /dev/null
+++ b/sys/gio/nspp/sysint/fencode.x
@@ -0,0 +1,79 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<error.h>
+include	<ctype.h>
+
+define	SZ_FORMAT	11
+
+# FENCD -- Format a real variable and return as a spp character string.
+# A packed format string is passed as an input argument to define how the
+# number is to be encoded.  The format of the format string is:
+#	format string = "(cW.D)"
+# where c is one of [EFGI], and where W and D are the field width and
+# number of decimal places or precision, respectively.
+
+procedure fencd (nchars, f_format, spp_outstr, rval)
+
+int	nchars			# desired number of output chars
+char	f_format[SZ_FORMAT+1] 	# SPP string containing format
+char	spp_outstr[SZ_FORMAT+1] # SPP string containing encoded number
+real	rval			# value to be encoded
+
+char	fmtchar, outstr[MAX_DIGITS], spp_format[SZ_FORMAT+1]
+int	ip, op, stridx()
+real	x
+
+begin
+	# Encode format string for SPRINTF, format "%w.d".  Start copying
+	# Fortran format at char 3, which should follow the EFGI char.
+
+	spp_format[1] = '%'
+	op = 2
+
+	if (f_format[1] != '(')
+	    call fatal (1, "Missing lparen in Ncar ENCODE format")
+	for (ip=3;  f_format[ip] != ')' && f_format[ip] != EOS;  ip=ip+1) {
+	    spp_format[op] = f_format[ip]
+	    op = op + 1
+	}
+
+	# Now add the SPP format character.  EFG are the same for sprintf as
+	# as for Fortran.  The integer format is 'd' for decimal in SPP.
+
+	fmtchar = f_format[2]
+	if (IS_UPPER(fmtchar))
+	    fmtchar = TO_LOWER (fmtchar)
+	    
+	switch (fmtchar) {
+	case 'e', 'f', 'g':
+	    spp_format[op] = fmtchar
+	case 'i':
+	    spp_format[op] = 'd'
+	default:
+	    call fatal (1, "Unknown Ncar ENCODE format code")
+	}
+	op = op + 1
+	spp_format[op] = EOS
+	x = rval
+	if (rval > 0)
+	    x = -x
+
+	# Now encode the user supplied variable and return it as a spp
+	# string.
+
+	iferr {
+	    call sprintf (outstr, MAX_DIGITS, spp_format)
+		call pargr (x)
+	} then
+	    call erract (EA_FATAL)
+
+	# Let's try adding a "+" prefix to positive numbers to set if that
+	# makes nicer plots.
+
+	op = stridx ('-', outstr)
+	if (rval > 0 && op > 0) 
+	    outstr[op] = '+'
+
+	call strcpy (outstr, spp_outstr, SZ_LINE)
+end
diff --git a/sys/gio/nspp/sysint/fulib.x b/sys/gio/nspp/sysint/fulib.x
new file mode 100644
index 00000000..1951f26c
--- /dev/null
+++ b/sys/gio/nspp/sysint/fulib.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# FULIB -- Print an error message processed by fortran routine uliber.
+
+procedure fulib (errcode, upkmsg, msglen)
+
+int	errcode
+char	upkmsg[ARB]		# unpacked string
+int	msglen			# number of chars in string
+
+pointer	sp, sppmsg
+
+begin
+	call smark (sp)
+	call salloc (sppmsg,  SZ_LINE, TY_CHAR)
+
+	# Construct error message string
+	call sprintf (Memc[sppmsg], SZ_LINE, "ERROR %d IN %s\n")
+	    call pargi (errcode)
+	    call pargstr (upkmsg)
+
+	# Call error with the constructed message
+	iferr (call error (errcode, Memc[sppmsg]))
+	    call erract (EA_WARN)
+	
+	call sfree (sp)
+end
diff --git a/sys/gio/nspp/sysint/intt.x b/sys/gio/nspp/sysint/intt.x
new file mode 100644
index 00000000..315248fd
--- /dev/null
+++ b/sys/gio/nspp/sysint/intt.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<nspp.h>
+
+# INTT -- Test whether the argument is an integer (return true) or a real
+# (return false).  This works, hopefully, because legal NCAR metacode integers
+# are always less than 2 ** 15, while real numbers will always appear to be
+# large positive or negative integers.
+
+bool procedure intt (value)
+
+int	value
+
+begin
+	return (value > 0 && value < INTT_TESTVAL)
+end
diff --git a/sys/gio/nspp/sysint/ishift.x b/sys/gio/nspp/sysint/ishift.x
new file mode 100644
index 00000000..580996c0
--- /dev/null
+++ b/sys/gio/nspp/sysint/ishift.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# ISHIFT -- integer shift.  To be used for calls to ISHIFT in NCAR routines.
+
+int procedure ishift (in_word, n)
+
+int	in_word, n
+int	new_word, bit, index, i
+int	bitupk()
+
+begin
+	if (n > NBITS_INT)
+	    call error (0, "n > NBITS_INT in ishift")
+	if (n < 0)
+	    # Right end-off shift
+	    new_word = bitupk (in_word, abs(n) + 1, NBITS_INT - abs(n))
+	else {
+	    # Left circular shift (rotate)
+	    do i = 1, NBITS_INT {
+		index = n + i
+		if (index > NBITS_INT)
+		    index = mod ((n + i), NBITS_INT)
+		bit = bitupk (in_word, i, 1)
+		call bitpak (bit, new_word, index, 1)
+	    }
+	}
+
+	return (new_word)
+end
+
+
+# IAND -- AND two integers.
+
+int procedure iand (a, b)
+
+int	a, b
+int	and()
+
+begin
+	return (and (a, b))
+end
+
+
+# IOR -- OR two integers.  
+
+int procedure ior (a, b)
+
+int	a, b
+int	or()
+
+begin
+	return (or (a, b))
+end
diff --git a/sys/gio/nspp/sysint/loc.x b/sys/gio/nspp/sysint/loc.x
new file mode 100644
index 00000000..59e509b5
--- /dev/null
+++ b/sys/gio/nspp/sysint/loc.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# LOCI -- Return the zero-indexed offset of the argument in the user address
+# space, in integer units.  In other words, if A is an integer array,
+# { loci(a[2]) - loci(a[1]) } is exactly one.
+#
+# NOTE -- The original NSPP (portlib) code called this function LOC, however,
+# the Sun-4 Fortran compiler has an intrinsic function of the same name which
+# behaves slightly differently, hence the name was changed to LOCI.
+
+int procedure loci (x)
+
+int	x
+int	xaddr
+
+begin
+	# ZLOCVA returns the address of the variable in units of XCHAR.
+
+	call zlocva (x, xaddr)
+	return (xaddr / SZ_INT)
+end
diff --git a/sys/gio/nspp/sysint/mcswap.x b/sys/gio/nspp/sysint/mcswap.x
new file mode 100644
index 00000000..eb9cee7d
--- /dev/null
+++ b/sys/gio/nspp/sysint/mcswap.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MCSWAP -- Swap the instructions in a metacode array.
+
+procedure mcswap (a, npix)
+
+int	a[npix]
+int	npix
+int	i, temp
+
+begin
+	do i = 1, npix, 2 {
+	    temp = a[i]
+	    a[i] = a[i+1]
+	    a[i+1] = temp
+	}
+end
diff --git a/sys/gio/nspp/sysint/mkpkg b/sys/gio/nspp/sysint/mkpkg
new file mode 100644
index 00000000..b00eb46e
--- /dev/null
+++ b/sys/gio/nspp/sysint/mkpkg
@@ -0,0 +1,24 @@
+# Make the system interface modules for libnspp.a.
+
+$checkout libnspp.a lib$
+$update   libnspp.a
+$checkin  libnspp.a lib$
+$exit
+
+libnspp.a:
+	encd.f
+	encode.f
+	erprt77.f
+	fencode.x	<ctype.h> <error.h> <mach.h>
+	fulib.x		<error.h>
+	intt.x		<nspp.h>
+	ishift.x	<mach.h>
+	loc.x		<mach.h>
+	mcswap.x	
+	ncgchr.x	
+	ncpchr.x	
+	packum.x	<mach.h> <nspp.h> nspp.com
+	perror.x	
+	q8qst4.f
+	uliber.f
+	;
diff --git a/sys/gio/nspp/sysint/ncgchr.x b/sys/gio/nspp/sysint/ncgchr.x
new file mode 100644
index 00000000..5cf40b22
--- /dev/null
+++ b/sys/gio/nspp/sysint/ncgchr.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# NCGCHR -- Get a single character (byte) from a packed array.  Return
+# a blank if the index is out of bounds.
+
+procedure ncgchr (ichars, len_ichars, index, char_value)
+
+int	ichars[ARB]		# packed character array
+int	len_ichars		# length of the array
+int	index			# index of char to be extracted
+int	char_value		# return value
+
+char	ch
+
+begin
+	if (index < 1 || index > len_ichars)
+	    char_value = ' '
+	else {
+	    call chrupk (ichars, index, ch, 1, 1)
+	    char_value = ch
+	}
+end
diff --git a/sys/gio/nspp/sysint/ncpchr.x b/sys/gio/nspp/sysint/ncpchr.x
new file mode 100644
index 00000000..4312068d
--- /dev/null
+++ b/sys/gio/nspp/sysint/ncpchr.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# NCPCHR -- Put a single character (byte) into a packed array.  Do nothing if
+# the index is out of bounds.
+
+procedure ncpchr (ichars, len_ichars, index, char_value)
+
+int	ichars[ARB]		# packed character array
+int	len_ichars		# length of the array
+int	index			# index of char to be set
+int	char_value		# value to be stored
+
+char	ch[1]
+
+begin
+	if (index >= 1 && index <= len_ichars) {
+	    ch[1] = char_value
+	    call chrpak (ch, 1, ichars, index, 1)
+	}
+end
diff --git a/sys/gio/nspp/sysint/nspp.com b/sys/gio/nspp/sysint/nspp.com
new file mode 100644
index 00000000..e3cac846
--- /dev/null
+++ b/sys/gio/nspp/sysint/nspp.com
@@ -0,0 +1,40 @@
+# NSPP.COM -- The nspp system plot package common block.
+
+int	mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab
+int	mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb
+int	mx     ,my     ,mtypex ,mtypey 
+real	xxa    ,yya    , xxb    ,yyb    ,xxc    ,yyc
+real	xxd    ,yyd    , xfactr ,yfactr ,xadd   ,yadd
+real	xx     ,yy
+
+# XX declared integer some places in nspp code !!!
+# on a VAX this works, but what if float not same size as int ???
+
+int	mfmtx[3]       ,mfmty[3]       ,mumx   ,mumy
+int	msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop[19]
+int	mname[19]      ,mxold  ,myold  ,mxmax  ,mymax
+int	mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty
+int	mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst
+int	mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin
+int	mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto
+int	mxysto ,mprint ,msybuf[360]    ,mncpw  ,minst
+int	mbufa  ,mbuflu ,mfwa[12]       ,mlwa[12]
+int	mipair ,mbprs[16]      ,mbufl  ,munit  ,mbswap
+
+real	small
+
+common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab,
+	mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb,
+	mx     ,my     ,mtypex ,mtypey ,xxa    ,yya,
+	xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd,
+	xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy,
+	mfmtx  ,mfmty  ,mumx   ,mumy,
+	msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop,
+	mname  ,mxold  ,myold  ,mxmax  ,mymax,
+	mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty,
+	mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst,
+	mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin,
+	mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto,
+	mxysto ,mprint ,msybuf ,mncpw  ,minst,
+	mbufa  ,mbuflu ,mfwa   ,mlwa,
+	mipair ,mbprs  ,mbufl  ,munit  ,mbswap ,small
diff --git a/sys/gio/nspp/sysint/packum.x b/sys/gio/nspp/sysint/packum.x
new file mode 100644
index 00000000..7991658c
--- /dev/null
+++ b/sys/gio/nspp/sysint/packum.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<nspp.h>
+
+# PACKUM -- Pack an integer array containing 16 bit quantities into a buffer.
+# Each 16 bit input datum occupies one integer; the input integers may be
+# any size.  This implementation will work on most byte oriented machines,
+# but will generate a fatal error on machines with 24, 60, etc. bit words.
+
+procedure packum (a, npix, bp)
+
+int	a[ARB]			# input array, one 16-bit datum per word
+int	npix			# number of mc words
+int	bp			# LOC pointer to output buffer
+
+int	offset, dummy[1]
+int	loci()
+include	"nspp.com"
+
+begin
+	offset = bp - loci (dummy) + 1
+
+	# It is necessary to swap the order of the metacode words on some
+	# machines.  Npix is always an even number.  The swapping must be
+	# done here because the NSPP and MCTR code assumes that the bytes
+	# are ordered in a certain manner (most significant first).  Thus,
+	# when the buffer is flushed FLUSHB will set the magic bits, and
+	# if we wait and swap upon output rather than here, it will set the
+	# bits in the wrong word.
+
+	if (mbswap == YES)		# flag set from graphcap in nsppkern
+	    call mcswap (a, npix)
+
+	switch (NBITS_MCWORD) {
+	case NBITS_SHORT:
+	    call achtis (a, dummy[offset], npix)
+	case NBITS_INT:
+	    call amovi (a, dummy[offset], npix)
+	default:
+	    call fatal (1, "gio.ncar.packum: cannot pack metacode")
+	}
+end
diff --git a/sys/gio/nspp/sysint/perror.x b/sys/gio/nspp/sysint/perror.x
new file mode 100644
index 00000000..6c1cb85b
--- /dev/null
+++ b/sys/gio/nspp/sysint/perror.x
@@ -0,0 +1,9 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PERROR -- Fatal error in NSPP.
+
+procedure perror()
+
+begin
+	call fatal (0, "Fatal error in Ncar system plot package")
+end
diff --git a/sys/gio/nspp/sysint/q8qst4.f b/sys/gio/nspp/sysint/q8qst4.f
new file mode 100644
index 00000000..0b8ca796
--- /dev/null
+++ b/sys/gio/nspp/sysint/q8qst4.f
@@ -0,0 +1,24 @@
+      SUBROUTINE Q8QST4(NAME,LBRARY,ENTRY,VRSION)
+C
+C DIMENSION OF		 NAME(1),LBRARY(1),ENTRY(1),VRSION(1)
+C ARGUMENTS
+C
+C LATEST REVISION	 MARCH 1984
+C
+C PURPOSE		 MONITORS LIBRARY USE BY WRITING A RECORD WITH
+C			 INFORMATION ABOUT THE CIRCUMSTANCES OF	A
+C			 LIBRARY ROUTINE CALL TO THE SYSTEM ACCOUNTING
+C			 TAPE FOR LATER	PROCESSING.
+C
+C NOTE---		 THIS VERSION OF Q8QST4	SIMPLY RETURNS TO THE
+C			 CALLING ROUTINE.  LOCAL IMPLEMENTORS MAY WISH
+C			 TO IMPLEMENT A	VERSION	OF THIS	ROUTINE	THAT
+C			 MONITORS USE OF NCAR ROUTINES WITH LOCAL
+C			 MECHANISMS.  OTHERWISE	IT WILL	SAVE A SMALL
+C			 AMOUNT	OF SPACE AND TIME IF CALLS TO Q8QST4 ARE
+C			 DELETED FROM ALL NSSL ROUTINES.
+C
+      CHARACTER*(*) NAME,LBRARY,ENTRY,VRSION
+C
+      RETURN
+      END
diff --git a/sys/gio/nspp/sysint/uliber.f b/sys/gio/nspp/sysint/uliber.f
new file mode 100644
index 00000000..7dba302e
--- /dev/null
+++ b/sys/gio/nspp/sysint/uliber.f
@@ -0,0 +1,14 @@
+        subroutine uliber (errcode, pkerrmsg, msglen)
+
+	character*80 pkerrmsg
+	integer errcode, msglen
+	integer*2 sppmsg(81)
+	integer SZLINE
+	parameter (SZLINE=80)
+
+c unpack the fortran character string, call fulib to output the string.
+c
+	call f77upk (pkerrmsg, sppmsg, SZLINE)
+	call fulib  (errcode, sppmsg, msglen)
+
+	end
diff --git a/sys/gio/nsppkern/README b/sys/gio/nsppkern/README
new file mode 100644
index 00000000..0990eac0
--- /dev/null
+++ b/sys/gio/nsppkern/README
@@ -0,0 +1,399 @@
+This directory contains the source for the NSPP/GIO kernel, the interface
+between GIO and the old Ncar system plot package and associated metacode
+translators.
+
+Special graphcap entries used by this kernel:
+
+	MF		maximum frame count per metafile
+	FS		frame advance req'd at start of metafile
+	FE		frame advance req'd at end of metafile
+
+Rev 1.0 installed in March 1985.
+----------------------------------------------------------------------------
+
+Differences between Rev 1.0 and Rev 1.1 of the NSPP/GIO kernel.
+Collated at installation of Rev 1.1 on 24 April 1985.
+----------------------------------------------------------------------------
+
+gktclose.x
++ diff gktclose.x ../nsppkern.old/gktclose.x 
+12,13d11
+< 	call frame
+< 	call gkt_flush
++ echo gktclosews.x 
+gktinit.x
++ diff gktinit.x ../nsppkern.old/gktinit.x 
+49a50,59
+> 	# get the window offsets
+> 
+> 	g_xoff = ttygeti (tty, "XO")
+> 	if (g_xoff < 0)
+> 	    g_xoff = 0
+> 	g_yoff = ttygeti (tty, "YO")
+> 	if (g_yoff < 0)
+> 	    g_yoff = 0
+> 
+> 
+112d121
+< 	GKT_PIXREP(g_kt)     = btoi (ttygetb (tty, "pr"))
+gktopenws.x
++ diff gktopenws.x ../nsppkern.old/gktopenws.x 
+98,104c98,99
+< 	if (mode == NEW_FILE) {
+< 	    # Frame call only if NEW_FILE and not first time open with
+< 	    # this device.  This prevents frame before first data.
+< 	    if (!need_open)
+< 	        call frame
+< 	    call gkt_reset
+< 	}
+---
+> 	if (mode == NEW_FILE)
+> 	    call frame()
++ echo gktpcell.x 
+gktpcell.x
++ diff gktpcell.x ../nsppkern.old/gktpcell.x 
+8a9
+> 
+12c13
+< procedure gkt_putcellarray (m, nc, nr, ax1,ay1, ax2,ay2)
+---
+> procedure gkt_putcellarray (m, nc, nr, x1,y1, x2,y2)
+17,18c18,19
+< int	ax1, ay1		# lower left corner of output window
+< int	ax2, ay2		# upper right corner of output window
+---
+> int	x1, y1			# lower left corner of output window
+> int	x2, y2			# upper right corner of output window
+20d20
+< int	x1,y1,x2,y2		# device coordinates
+22c22
+< int	nx, ny, y
+---
+> int	nx, ny
+28c28
+< bool	ca, use_orig, new_row, pr
+---
+> bool	ca, use_orig, new_row
+31,32d30
+< real	delta_y
+< int	xrep, yrep
+43c41
+< 	# Determine if can do real cell array.  If not, use character
+---
+> 	# determine if can do real cell array.  If not, use character
+49d46
+< 	pr = false
+53d49
+< 	    pr = (GKT_PIXREP(g_kt) != 0)
+65,66c61
+< 	# Input arguments (ax, ay) refer to corners of put cell array;
+< 	# we need corners of the corresponding device array.
+---
+> 	# find out how many real pixels we have to fill
+68,73c63,66
+< 	x1 = ax1
+< 	x2 = ax2
+< 	y1 = ay1
+< 	y2 = ay2
+< 	call adjust(x1,x2,xres)
+< 	call adjust(y1,y2,yres)
+---
+> 	px1 = real(x1)/GKI_MAXNDC
+> 	py1 = real(y1)/GKI_MAXNDC
+> 	px2 = real(x2)/GKI_MAXNDC
+> 	py2 = real(y2)/GKI_MAXNDC
+75,79c68,69
+< 	# Find out how many real pixels we have to fill
+< 	px1 = real(x1)/(GKI_MAXNDC+1)
+< 	py1 = real(y1)/(GKI_MAXNDC+1)
+< 	px2 = real(x2)/(GKI_MAXNDC+1)
+< 	py2 = real(y2)/(GKI_MAXNDC+1)
+---
+> 	nx = int( (px2 - px1) * (xres-1.0) + 1.5 )
+> 	ny = int( (py2 - py1) * (yres-1.0) + 1.5 )
+81,90c71
+< 	nx = int( px2 * xres ) - int( px1 * xres ) + 1
+< 	ny = int( py2 * yres ) - int( py1 * yres ) + 1
+< 
+< 	if ( ny > 1)
+< 	     delta_y = (real(y2) - real(y1))/ny
+< 	else {
+< 	     delta_y = 0.
+< 	}
+< 
+< 	# If too many data points in input, set skip.  If skip is close
+---
+> 	# if too many data points in input, set skip.  If skip is close
+92,93c73,74
+< 	# Set block replication factors - will be > 1.0 if too few input points.
+< 	# Cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have
+---
+> 	# set block replication factors - will be > 1.0 if too few input points.
+> 	# cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have
+110c91,101
+< 	# Allocate storage for a row of pixels.  This is quite inefficient
+---
+> 
+> 	# try for the simplest case: 1:1 match with input data
+> 
+> 	if ( ca && (nx == nc) && (ny == nr) ) {
+> 	    call pixels( real(x1)/GKI_MAXNDC, real(y1)/GKI_MAXNDC,
+> 		nx, ny, m)
+> 	    call sfree(sp)
+> 	    return
+> 	}
+> 
+> 	# allocate storage for a row of pixels.  This is quite inefficient
+113d103
+< 	# need nx+1 in case nx odd ... pixels() wants to pad output.
+115,116c105
+< 	call salloc ( cell, nx+1, TY_SHORT)
+< 	Mems[cell + nx] = 0
+---
+> 	call salloc ( cell, nx, TY_SHORT)
+118c107
+< 	# Initialize counters
+---
+> 	# initialize counters
+125c114
+< 	# See if we can use original data ... no massaging
+---
+> 	# see if we can use original data ... no massaging
+128c117
+< 	# Note that if blockx > 1.0, skip_x must be 1.0, and vv
+---
+> 	# note that if blockx > 1.0, skip_x must be 1.0, and vv
+138,152c127
+< 	# If device can pixel replicate, use that feature where we can
+< 	if( pr) {
+< 	    if( (skip_x == 1.0) && ( int(blockx) == blockx) ) {
+< 		 xrep = int(blockx)
+< 		 use_orig = true
+< 		 nx = nc
+< 	    } else
+< 		 xrep = 1
+< 	    if( (skip_y == 1.0) && ( int(blocky) == blocky) ) {
+< 		 yrep = int(blocky)
+< 		 ny = 1
+< 	    } else
+< 		 yrep = 1
+< 	}
+< 	call pixel0(1,0,xrep,0,1,yrep)
+---
+> 	# do it
+154c129
+< 	# Do it
+---
+> 	for (i = 1;  i <= ny;  i = i + 1) {
+156c131
+< 	for ( i = 1; i <= ny ; i = i + 1) {
+---
+> 	    # Build the row data.
+158,159d132
+< 	    # Build the row data
+< 
+161c134
+< 		if ( skip_x == 1.0) {
+---
+> 		if ( skip_x == 1.0)
+163c136
+< 		} else {
+---
+> 		else {
+181d153
+< 		y = y1 + ((i - 1)*delta_y + 0.5)
+183,184c155,159
+< 		        call pixels( px1, real(y)/GKI_MAXNDC,
+< 			    nx, 1, m[element])
+---
+> 		    if ( i == 1 )
+> 		        call pixelr( real(x1)/GKI_MAXNDC, real(y1)/GKI_MAXNDC,
+> 			    nx, ny, m[element])
+> 		    else
+> 		        call pixeli( 0., 0., nx, 1, m[element])
+186c161,165
+< 		        call pixels( px1, real(y)/GKI_MAXNDC, nx, 1, Mems[cell])
+---
+> 		    if ( i == 1 )
+> 		        call pixelr( real(x1)/GKI_MAXNDC, real(y1)/GKI_MAXNDC,
+> 			    nx, ny, Mems[cell])
+> 		    else
+> 		        call pixeli( 0., 0., nx, 1, Mems[cell])
+188,189c167
+< 	    }   
+< 	    else
+---
+> 	    } else
+192c170
+< 	    # Advance a row
+---
+> 	    # Advance a row.
+206c184
+< 	# All done, restore text parameters and release storage
+---
+> 	# all done, restore text parameters and release storage
+209c187
+< 	    call restoretx (txsave,tx)
+---
+> 	    call restoretx(txsave,tx)
+212a191
+> 
+218d196
+< pointer savep, txp
+219a198
+> pointer savep, txp
+254a234
+> 
+258d237
+< pointer savep, txp
+259a239
+> pointer savep, txp
+263c243
+< 	# Restore values
+---
+> 	# restore values
+283a264
+> 
+287c268,269
+< procedure fakepc (indata, outdata, nx,  scale)
+---
+> procedure fakepc( indata, outdata, nx,  scale)
+> 
+298c280
+< data cdata /' ', '.', ':', '|', 'i', 'l', 'J', 'm', '#', 'S', 'B', EOS/
+---
+> data	cdata /' ', '.', ':', '|', 'i', 'l', 'J', 'm', '#', 'S', 'B', EOS/
+330,374d311
+< end
+< 
+< # ADJUST -- round/truncate putcell array corners to device coordinates
+< # move up lower bound if it is above center point of device cell,
+< # move down upper bound if below.  Don't allow bounds to go beyond
+< # resolution or below zero.  Do not allow bounds to cross.  Part of the
+< # assumptions behind all this is that putcells will be continguous and
+< # rows/columns must not be plotted twice.
+< 
+< procedure adjust ( lower, upper, res)
+< 
+< int	lower, upper
+< real	res
+< 
+< real	factor
+< real	low, up
+< 
+< begin
+< 	factor = res/(GKI_MAXNDC+1)
+< 	low = real(lower) * factor
+< 	up  = real(upper) * factor
+< 
+< 	# if boundaries result in same row, return
+< 	if ( int(low) == int(up) )
+< 	    return
+< 
+< 	# if low is in upper half of device pixel, round up
+< 	if ( (low - int(low)) >= 0.5 ) {
+< 	    low = int(low) + 1
+< 	    # don't go to or beyond upper bound
+< 	    if ( low < up ) {
+< 	        # ... 0.2 just for "rounding protection";
+< 		lower = (low + 0.2)/factor
+< 	        # if now reference same cell, return
+< 		if ( int(low) == int(up) )
+< 		    return
+< 	    }
+< 	}
+< 
+< 	# if "up" in bottom half of pixel, drop down one.  Note that
+< 	# due to two "==" tests above, upper will not drop below lower.
+< 	# 0.2 means drop partway down into pixel below; calling code will
+< 	# truncate.
+< 	if ( (up - int(up)) < 0.5 )
+< 	    upper = real(int(up) - 0.2)/factor
++ echo gktpl.x 
+gktpl.x
++ diff gktpl.x ../nsppkern.old/gktpl.x 
+51,52c51,52
+< 	x = p[1]
+< 	y = p[2]
+---
+> 	x = p[1] + g_xoff
+> 	y = p[2] + g_yoff
+58,59c58,59
+< 	    x = p[i]
+< 	    y = p[i+1]
+---
+> 	    x = p[i] + g_xoff
+> 	    y = p[i+1] + g_yoff
+gktpm.x
++ diff gktpm.x ../nsppkern.old/gktpm.x 
+48,49c48,49
+< 	x = p[1]
+< 	y = p[2]
+---
+> 	x = p[1] + g_xoff
+> 	y = p[2] + g_yoff
+63,64c63,64
+< 	    x = p[i]
+< 	    y = p[i+1]
+---
+> 	    x = p[i] + g_xoff
+> 	    y = p[i+1] + g_yoff
++ echo gktpmset.x 
+gkttx.x
++ diff gkttx.x ../nsppkern.old/gkttx.x 
+109,110c109,110
+< 		call pwrity (real(x)/GKI_MAXNDC,
+< 			real(y)/GKI_MAXNDC, Memc[pstring], seglen,
+---
+> 		call pwrity (real(x+g_xoff)/GKI_MAXNDC,
+> 			real(y+g_yoff)/GKI_MAXNDC, Memc[pstring], seglen,
+_____________________________________________________________________________
+
+25Apr85	gktpl.x
+	Call to optn to set line width changed to set option "inten" instead
+	of "spot size", which was not changing the line width.
+
+26Apr85 gktpm.x
+	Same change as one to gktpl.x
+
+	Character size as used in gkttx.x is a floating point number, but
+	NCAR pwry.f uses an integer value -- the conversion was causing
+	centering errors as gkttx.x would calculate a "path length" for
+	the text based on one size, and pwry.f would use a different size
+	to generate the text.  Changed pwry.f to use a floating point
+	size as an input variable, changed gkttx.x to send same.
+
+	gktpcell.x
+	Moved pixel0 call inside the "if (pr) {" statment, where it should
+	have been.
+
+	graphcap
+	Added  "pr" capablility flag to dicomed entry.  Changed character
+	height to reflect the 9 to 8 ratio that pwry uses.
+
+
+---------------------------------------------------------------------------
+Rev 1.2 10 May 1985 Dct.
+
+Fairly extensive modifications made to minimize the number of frame calls
+and metafiles generated.  Redundant CLEAR calls or clear calls immediately
+after open workstation are ignored.  Multiple frames are permitted in a
+metafile (formerly the metafile was disposed after each frame).  Graphcap
+parameters were added to control automatic frame advances at the beginning
+and end of metafiles.
+
+---------------------------------------------------------------------------
+Rev 1.3 1 June 1985 Dct.
+
+[1] Fixed a bug in polymarker; was drawing polylines.
+
+[2] Replaced the old character generation code by all new code, using the stroke
+table from the NCAR/GKS code.  Replaced "pwry.f" by the much simpler
+"gktdrawch.x".  Largely copied the stdgraph "stgtx.x", including the clipping
+logic therein.
+
+17-Aug-85 Dct.
+	Added support for the new DD graphcap parameter, used to pass device
+	dependent information to the device driver.  This information was
+	formerly encoded in a table at compile time, with the table defined
+	in <libc/kernel.h>.
diff --git a/sys/gio/nsppkern/font.com b/sys/gio/nsppkern/font.com
new file mode 100644
index 00000000..ec1b0ec9
--- /dev/null
+++ b/sys/gio/nsppkern/font.com
@@ -0,0 +1,207 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each character
+# is encoded as a series of strokes.  Each stroke is expressed by a single
+# integer containing the following bitfields:
+#
+#	2                   1
+#	0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 
+#	          | | | |         | |         |
+#		  | | | +---------+ +---------+
+#		  | | |      |           |
+#		  | | |      X           Y
+#		  | | |
+#	          | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#------------------------------------------------------------------------------
+
+# Define the database.
+
+short	chridx[96]		# character index in chrtab
+short	chrtab[800]		# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP).
+
+data    (chridx(i), i=01,05) /   1,   3,  12,  21,  30/
+data    (chridx(i), i=06,10) /  45,  66,  79,  85,  92/
+data    (chridx(i), i=11,15) /  99, 106, 111, 118, 121/
+data    (chridx(i), i=16,20) / 128, 131, 141, 145, 154/
+data    (chridx(i), i=21,25) / 168, 177, 187, 199, 203/
+data    (chridx(i), i=26,30) / 221, 233, 246, 259, 263/
+data    (chridx(i), i=31,35) / 268, 272, 287, 307, 314/
+data    (chridx(i), i=36,40) / 327, 336, 344, 352, 359/
+data    (chridx(i), i=41,45) / 371, 378, 385, 391, 398/
+data    (chridx(i), i=46,50) / 402, 408, 413, 425, 433/
+data    (chridx(i), i=51,55) / 445, 455, 468, 473, 480/
+data    (chridx(i), i=56,60) / 484, 490, 495, 501, 506/
+data    (chridx(i), i=61,65) / 511, 514, 519, 523, 526/
+data    (chridx(i), i=66,70) / 529, 543, 554, 563, 574/
+data    (chridx(i), i=71,75) / 585, 593, 607, 615, 625/
+data    (chridx(i), i=76,80) / 638, 645, 650, 663, 671/
+data    (chridx(i), i=81,85) / 681, 692, 703, 710, 723/
+data    (chridx(i), i=86,90) / 731, 739, 743, 749, 754/
+data    (chridx(i), i=91,95) / 759, 764, 776, 781, 793/
+data    (chridx(i), i=96,96) / 801/
+
+# Stroke data.
+
+data	(chrtab(i), i=001,005) /    36,  1764,   675, 29328,   585/
+data	(chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/
+data	(chrtab(i), i=011,015) /  1764,   355, 29023,   351, 29027/
+data	(chrtab(i), i=016,020) /   931, 29599,   927, 29603,  1764/
+data	(chrtab(i), i=021,025) /   603, 29066,   842, 29723,  1302/
+data	(chrtab(i), i=026,030) / 28886,   143, 29839,  1764,   611/
+data	(chrtab(i), i=031,035) / 29256,    78, 20810, 21322, 21581/
+data	(chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/
+data	(chrtab(i), i=041,045) / 20833, 21345, 29789,  1764,   419/
+data	(chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/
+data	(chrtab(i), i=051,055) / 21022, 21025, 20899,  1187, 28744/
+data	(chrtab(i), i=056,060) /   717, 21194, 21320, 21512, 21642/
+data	(chrtab(i), i=061,065) / 21645, 21519, 21327, 21197,  1764/
+data	(chrtab(i), i=066,070) /  1160, 20700, 20704, 20835, 21027/
+data	(chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/
+data	(chrtab(i), i=076,080) / 21192, 29841,  1764,   611, 21023/
+data	(chrtab(i), i=081,085) / 21087, 21155, 21091,  1764,   739/
+data	(chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/
+data	(chrtab(i), i=091,095) /  1764,   547, 21151, 21210, 21201/
+data	(chrtab(i), i=096,100) / 21132, 29192,  1764,    93, 29774/
+data	(chrtab(i), i=101,105) /   608, 29259,    78, 29789,  1764/
+data	(chrtab(i), i=106,110) /   604, 29260,    84, 29780,  1764/
+data	(chrtab(i), i=111,115) /   516, 21062, 21065, 21001, 21000/
+data	(chrtab(i), i=116,120) / 21064,  1764,    84, 29780,  1764/
+data	(chrtab(i), i=121,125) /   585, 21063, 21191, 21193, 21065/
+data	(chrtab(i), i=126,130) / 21191,  1764,    72, 29859,  1764/
+data	(chrtab(i), i=131,135) /   419, 20573, 20558, 20872, 21320/
+data	(chrtab(i), i=136,140) / 21646, 21661, 21347, 20899,  1764/
+data	(chrtab(i), i=141,145) /   221, 21155, 29320,  1764,    95/
+data	(chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/
+data	(chrtab(i), i=151,155) / 20552, 29832,  1764,    95, 20899/
+data	(chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/
+data	(chrtab(i), i=161,165) /   854,  5266, 21644, 21320, 20872/
+data	(chrtab(i), i=166,170) / 28749,  1764,   904, 21411, 21283/
+data	(chrtab(i), i=171,175) / 20561, 20559, 21391,   911, 13455/
+data	(chrtab(i), i=176,180) /  1764,   136, 21320, 21645, 21652/
+data	(chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/
+data	(chrtab(i), i=186,190) /  1764,    83, 20888, 21336, 21651/
+data	(chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/
+data	(chrtab(i), i=196,200) / 20635, 29347,  1764,    99, 21667/
+data	(chrtab(i), i=201,205) / 29064,  1764,   355, 20575, 20570/
+data	(chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/
+data	(chrtab(i), i=211,215) / 21644, 21650, 21398, 20822,   918/
+data	(chrtab(i), i=216,220) /  5274, 21663, 21411, 20835,  1764/
+data	(chrtab(i), i=221,225) /   648, 21584, 21656, 21662, 21347/
+data	(chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/
+data	(chrtab(i), i=231,235) / 21656,  1764,   602, 21210, 21207/
+data	(chrtab(i), i=236,240) / 21079, 21082, 21207,   592, 21069/
+data	(chrtab(i), i=241,245) / 21197, 21200, 21072, 21197,  1764/
+data	(chrtab(i), i=246,250) /   602, 21146, 21143, 21079, 21082/
+data	(chrtab(i), i=251,255) / 21143,   585, 21132, 21136, 21072/
+data	(chrtab(i), i=256,260) / 21071, 21135,  1764,   988, 20628/
+data	(chrtab(i), i=261,265) / 29644,  1764,  1112, 28824,   144/
+data	(chrtab(i), i=266,270) / 29776,  1764,   156, 21460, 28812/
+data	(chrtab(i), i=271,275) /  1764,   221, 20704, 20899, 21218/
+data	(chrtab(i), i=276,280) / 21471, 21466, 21011, 21007,   521/
+data	(chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/
+data	(chrtab(i), i=286,290) /  1764,   908, 20812, 20560, 20571/
+data	(chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/
+data	(chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/
+data	(chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/
+data	(chrtab(i), i=306,310) /  1764,    72, 20963, 21219, 29768/
+data	(chrtab(i), i=311,315) /   210,  5074,  1764,    99, 21411/
+data	(chrtab(i), i=316,320) / 21663, 21658, 21398, 20566,   918/
+data	(chrtab(i), i=321,325) /  5266, 21644, 21384, 20552, 20579/
+data	(chrtab(i), i=326,330) /  1764,  1165, 21320, 20872, 20557/
+data	(chrtab(i), i=331,335) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=336,340) /    99, 21347, 21662, 21645, 21320/
+data	(chrtab(i), i=341,345) / 20552, 20579,  1764,    99, 20552/
+data	(chrtab(i), i=346,350) / 29832,    86, 13078,    99, 29859/
+data	(chrtab(i), i=351,355) /  1764,    99, 20552,    86, 13078/
+data	(chrtab(i), i=356,360) /    99, 29859,  1764,   722, 21650/
+data	(chrtab(i), i=361,365) / 29832,  1165,  4936, 20872, 20557/
+data	(chrtab(i), i=366,370) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=371,375) /    99, 28744,    85,  5269,  1160/
+data	(chrtab(i), i=376,380) / 29859,  1764,   291, 29603,   611/
+data	(chrtab(i), i=381,385) /  4680,   328, 29576,  1764,    77/
+data	(chrtab(i), i=386,390) / 20872, 21256, 21581, 29795,  1764/
+data	(chrtab(i), i=391,395) /    99, 28744,  1160, 20887,    82/
+data	(chrtab(i), i=396,400) / 13475,  1764,    99, 20552, 29832/
+data	(chrtab(i), i=401,405) /  1764,    72, 20579, 21077, 21603/
+data	(chrtab(i), i=406,410) / 29768,  1764,    72, 20579, 21640/
+data	(chrtab(i), i=411,415) / 29859,  1764,    94, 20899, 21347/
+data	(chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/
+data	(chrtab(i), i=421,425) / 20574,   862, 29859,  1764,    72/
+data	(chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/
+data	(chrtab(i), i=431,435) / 20564,  1764,    94, 20557, 20872/
+data	(chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/
+data	(chrtab(i), i=441,445) / 20574,   536, 29828,  1764,    72/
+data	(chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/
+data	(chrtab(i), i=451,455) / 20566,   918, 13448,  1764,    76/
+data	(chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/
+data	(chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/
+data	(chrtab(i), i=466,470) / 29855,  1764,   648, 21155,    99/
+data	(chrtab(i), i=471,475) / 29923,  1764,    99, 20557, 20872/
+data	(chrtab(i), i=476,480) / 21320, 21645, 29859,  1764,    99/
+data	(chrtab(i), i=481,485) / 21064, 29795,  1764,    99, 20808/
+data	(chrtab(i), i=486,490) / 21141, 21448, 29923,  1764,    99/
+data	(chrtab(i), i=491,495) / 29832,    72, 29859,  1764,    99/
+data	(chrtab(i), i=496,500) / 21079, 29256,   599, 13411,  1764/
+data	(chrtab(i), i=501,505) /    99, 21667, 20552, 29832,  1764/
+data	(chrtab(i), i=506,510) /   805, 20965, 20935, 29447,  1764/
+data	(chrtab(i), i=511,515) /    99, 29832,  1764,   421, 21221/
+data	(chrtab(i), i=516,520) / 21191, 29063,  1764,   288, 21091/
+data	(chrtab(i), i=521,525) / 29600,  1764,     3, 29891,  1764/
+data	(chrtab(i), i=526,530) /   547, 29341,  1764,   279, 21207/
+data	(chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/
+data	(chrtab(i), i=536,540) / 20558, 20753, 21201, 21391,   907/
+data	(chrtab(i), i=541,545) / 13447,  1764,    99, 28744,    76/
+data	(chrtab(i), i=546,550) /  4424, 21256, 21516, 21523, 21271/
+data	(chrtab(i), i=551,555) / 20823, 20563,  1764,   981, 21271/
+data	(chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/
+data	(chrtab(i), i=561,565) / 29642,  1764,  1043,  4887, 20823/
+data	(chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=571,575) /  1032, 29731,  1764,    80,  5136/
+data	(chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/
+data	(chrtab(i), i=581,585) / 20808, 21256, 29707,  1764,   215/
+data	(chrtab(i), i=586,590) / 29591,   456, 20958, 21153, 21409/
+data	(chrtab(i), i=591,595) / 29727,  1764,    67, 20800, 21248/
+data	(chrtab(i), i=596,600) / 21508, 29719,  1043, 21271, 20823/
+data	(chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=606,610) /  1764,    99, 28744,    83,  4439/
+data	(chrtab(i), i=611,615) / 21271, 21523, 29704,  1764,   541/
+data	(chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=621,625) /   533, 21077, 29256,  1764,   541/
+data	(chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=631,635) /   533, 21077, 21058, 20928, 20736/
+data	(chrtab(i), i=636,640) / 28802,  1764,    99, 28744,    84/
+data	(chrtab(i), i=641,645) / 29530,   342, 13320,  1764,   483/
+data	(chrtab(i), i=646,650) / 21089, 21066, 29384,  1764,    87/
+data	(chrtab(i), i=651,655) / 28744,   584, 21076,    84,  4375/
+data	(chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/
+data	(chrtab(i), i=661,665) / 29768,  1764,    87, 28744,    83/
+data	(chrtab(i), i=666,670) / 20823, 21271, 21523, 29704,  1764/
+data	(chrtab(i), i=671,675) /    83, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=676,680) / 21523, 21271, 20823, 20563,  1764/
+data	(chrtab(i), i=681,685) /    87, 28736,    83, 20823, 21271/
+data	(chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/
+data	(chrtab(i), i=691,695) /  1764,  1047, 29696,  1036, 21256/
+data	(chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/
+data	(chrtab(i), i=701,705) / 21523,  1764,    87, 28744,    83/
+data	(chrtab(i), i=706,710) / 20823, 21271, 29716,  1764,    74/
+data	(chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/
+data	(chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/
+data	(chrtab(i), i=721,725) / 21461,  1764,   279, 29591,   970/
+data	(chrtab(i), i=726,730) / 21320, 21128, 21002, 21025,  1764/
+data	(chrtab(i), i=731,735) /    87, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=736,740) /  1032, 29719,  1764,   151, 21064/
+data	(chrtab(i), i=741,745) / 29719,  1764,    87, 20808, 21077/
+data	(chrtab(i), i=746,750) / 21320, 29783,  1764,   151, 29704/
+data	(chrtab(i), i=751,755) /   136, 29719,  1764,    87, 21064/
+data	(chrtab(i), i=756,760) /   320, 29783,  1764,   151, 21527/
+data	(chrtab(i), i=761,765) / 20616, 29704,  1764,   805, 21157/
+data	(chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/
+data	(chrtab(i), i=771,775) / 21011, 21001, 21127, 21255,  1764/
+data	(chrtab(i), i=776,780) /   611, 29273,   594, 29256,  1764/
+data	(chrtab(i), i=781,785) /   485, 21093, 21218, 21209, 21271/
+data	(chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/
+data	(chrtab(i), i=791,795) / 29127,  1764,    83, 20758, 20950/
+data	(chrtab(i), i=796,800) / 21265, 21457, 29844,  1764,     0/
diff --git a/sys/gio/nsppkern/font.h b/sys/gio/nsppkern/font.h
new file mode 100644
index 00000000..c33dc6ee
--- /dev/null
+++ b/sys/gio/nsppkern/font.h
@@ -0,0 +1,29 @@
+# NCAR font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/nsppkern/gkt.com b/sys/gio/nsppkern/gkt.com
new file mode 100644
index 00000000..828b39bb
--- /dev/null
+++ b/sys/gio/nsppkern/gkt.com
@@ -0,0 +1,17 @@
+# GKTRANS common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The stdgraph data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.
+
+pointer	g_kt				# kernel transform graphics descriptor
+pointer	g_tty				# graphcap descriptor
+int	g_nframes			# number of frames written
+int	g_maxframes			# max frames per device metafile
+int	g_ndraw				# no draw instr. in current frame
+int	g_in, g_out			# input, output files
+int	g_xres, g_yres			# desired device resolution
+char	g_device[SZ_GDEVICE]		# force output to named device
+
+common	/gktcom/ g_kt, g_tty, g_nframes, g_maxframes, g_ndraw,
+	g_in, g_out, g_xres, g_yres, g_device
diff --git a/sys/gio/nsppkern/gkt.h b/sys/gio/nsppkern/gkt.h
new file mode 100644
index 00000000..09ab7b80
--- /dev/null
+++ b/sys/gio/nsppkern/gkt.h
@@ -0,0 +1,75 @@
+# GKTRANS definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		1024			# initial string buffer size
+define	SZ_MFRECORD	(1440/SZB_CHAR)		# metafile record size
+define	SZ_GDEVICE	31			# maxsize forced device name
+define	DEF_MAXFRAMES	16			# maximum frames/metafile
+
+# The GKTRANS state/device descriptor.
+
+define	LEN_GKT		81
+
+define	GKT_SBUF	Memi[$1]		# string buffer
+define	GKT_SZSBUF	Memi[$1+1]		# size of string buffer
+define	GKT_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	GKT_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	GKT_POLYLINE	Memi[$1+4]		# device supports polyline
+define	GKT_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	GKT_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	GKT_CELLARRAY	Memi[$1+7]		# device supports cell array
+define	GKT_ZRES	Memi[$1+8]		# device resolution in Z
+define	GKT_FILLSTYLE	Memi[$1+9]		# number of fill styles
+define	GKT_ROAM	Memi[$1+10]		# device supports roam
+define	GKT_ZOOM	Memi[$1+11]		# device supports zoom
+define	GKT_SELERASE	Memi[$1+12]		# device has selective erase
+define	GKT_PIXREP	Memi[$1+13]		# device supports pixel replic.
+define	GKT_STARTFRAME	Memi[$1+14]		# frame advance at metafile BOF
+define	GKT_ENDFRAME	Memi[$1+15]		# frame advance at metafile EOF
+	# extra space
+define	GKT_CURSOR	Memi[$1+20]		# last cursor accessed
+define	GKT_COLOR	Memi[$1+21]		# last color set
+define	GKT_TXSIZE	Memi[$1+22]		# last text size set
+define	GKT_TXFONT	Memi[$1+23]		# last text font set
+define	GKT_TYPE	Memi[$1+24]		# last line type set
+define	GKT_WIDTH	Memi[$1+25]		# last line width set
+define	GKT_DEVNAME	Memi[$1+26]		# name of open device
+	# extra space
+define	GKT_CHARHEIGHT	Memi[$1+30+$2-1]	# character height
+define	GKT_CHARWIDTH 	Memi[$1+40+$2-1]	# character width
+define	GKT_CHARSIZE	Memr[P2R($1+50+$2-1)]	# text sizes permitted
+define	GKT_PLAP	($1+60)			# polyline attributes
+define	GKT_PMAP	($1+64)			# polymarker attributes
+define	GKT_FAAP	($1+68)			# fill area attributes
+define	GKT_TXAP	($1+71)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
diff --git a/sys/gio/nsppkern/gktcancel.x b/sys/gio/nsppkern/gktcancel.x
new file mode 100644
index 00000000..17679f89
--- /dev/null
+++ b/sys/gio/nsppkern/gktcancel.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	"gkt.h"
+
+# GKT_CANCEL -- Cancel any buffered output.
+
+procedure gkt_cancel (dummy)
+
+int	dummy			# not used at present
+include	"gkt.com"
+
+begin
+	if (g_kt == NULL)
+	    return
+
+	# First we cancel any output in the FIO stream, then
+	# flush the nspp buffers.  This might, of course,
+	# put something in the FIO stream, so we cancel again.
+	# note the Fortran escape for "flush"...spp has a reserved
+	# word of the same name.
+
+	call fseti (g_out, F_CANCEL, OK)
+%	call mcflsh
+	call fseti (g_out, F_CANCEL, OK)
+	call gkt_reset()
+end
diff --git a/sys/gio/nsppkern/gktclear.x b/sys/gio/nsppkern/gktclear.x
new file mode 100644
index 00000000..4132d371
--- /dev/null
+++ b/sys/gio/nsppkern/gktclear.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"gkt.h"
+
+# GKT_CLEAR -- Advance a frame on the plotter.  All attribute packets are
+# initialized to their default values.  Redundant calls or calls immediately
+# after a workstation open (before anything has been drawn) are ignored.
+
+procedure gkt_clear (dummy)
+
+int	dummy			# not used at present
+
+int	gkt_mfopen()
+errchk	gkt_mfopen
+include	"gkt.com"
+
+begin
+	# This is a no-op if nothing has been drawn.
+	if (g_kt == NULL || g_ndraw == 0)
+	    return
+
+	# Start a new frame.  This is done either by calling NSPP to do a frame
+	# advance or by starting a new metafile.  Close the output file and 
+	# start a new metafile if the maximum frame count has been reached.
+	# This disposes of the metafile to the system, causing the actual
+	# plots to be drawn.  Open a new metafile ready to receive next frame.
+
+	g_nframes = g_nframes + 1
+	if (g_nframes >= g_maxframes) {
+
+	    # Does this device require a frame advance at end of metafile?
+	    if (GKT_ENDFRAME(g_kt) == YES)
+		call frame()
+
+	    # The call to the NSPP flush procedure must be escaped to avoid
+	    # interpretation as the FIO flush procedure.
+
+%	    call mcflsh
+
+	    g_nframes = 0
+	    call close (g_out)
+
+	    g_out = gkt_mfopen (g_tty, NEW_FILE)
+
+	    # Does this device require a frame advance at beginning of metafile?
+	    if (GKT_STARTFRAME(g_kt) == YES)
+		call frame()
+
+	} else {
+	    # Merely output NSPP frame instruction to start a new frame in
+	    # the same metafile.
+
+	    call frame()
+	}
+
+	# Init kernel data structures.
+	call gkt_reset()
+	g_ndraw = 0
+end
diff --git a/sys/gio/nsppkern/gktclose.x b/sys/gio/nsppkern/gktclose.x
new file mode 100644
index 00000000..9ab73c34
--- /dev/null
+++ b/sys/gio/nsppkern/gktclose.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# GKT_CLOSE -- Close the nspp translation kernel.  Close the spool file so
+# the output is finally plotted.  Free up storage.
+
+procedure gkt_close()
+
+include	"gkt.com"
+
+begin
+	# If there is anything in the metafile, flush it and add a frame
+	# advance if required for the device.
+
+	if (g_ndraw > 0 || g_nframes > 0) {
+	    # Does this device require a frame advance at end of metafile?
+	    if (GKT_ENDFRAME(g_kt) == YES)
+		call frame()
+
+	    # The call to the NSPP flush procedure must be escaped to avoid
+	    # interpretation as the FIO flush procedure.
+
+%	    call mcflsh
+	}
+
+	# Close output metafile, disposing of it to the host system.
+	call close (g_out)
+
+	# Free kernel data structures.
+	call mfree (GKT_SBUF(g_kt), TY_CHAR)
+	call mfree (g_kt, TY_STRUCT)
+
+	g_kt = NULL
+end
diff --git a/sys/gio/nsppkern/gktclws.x b/sys/gio/nsppkern/gktclws.x
new file mode 100644
index 00000000..27889c7c
--- /dev/null
+++ b/sys/gio/nsppkern/gktclws.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# GKT_CLOSEWS -- Close the named workstation.  Flush the output.
+# The spool file is closed only on the next plot or at gktclose time.
+# If the spool file is closed here, APPEND mode would not work.
+
+procedure gkt_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+include "gkt.com"
+
+begin
+	call gkt_flush (0)
+end
diff --git a/sys/gio/nsppkern/gktcolor.x b/sys/gio/nsppkern/gktcolor.x
new file mode 100644
index 00000000..7d24368a
--- /dev/null
+++ b/sys/gio/nsppkern/gktcolor.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# nspp particulars
+# colors
+define	BLACK		1
+define	WHITE		2
+define	RED		3
+define	GREEN		4
+define	BLUE		5
+
+# GKT_COLOR  set the color option in the nspp world
+
+procedure gkt_color(index)
+
+int	index		# index for color switch statement
+include	"gkt.com"
+
+begin
+	switch (index) {
+	    case WHITE:
+		call optn (*"co", *"white")
+	    case RED:
+		call optn (*"co", *"red")
+	    case GREEN:
+		call optn (*"co", *"green")
+	    case BLUE:
+		call optn (*"co", *"blue")
+	    default:
+		call optn (*"co", *"black")
+	}
+end
diff --git a/sys/gio/nsppkern/gktdrawch.x b/sys/gio/nsppkern/gktdrawch.x
new file mode 100644
index 00000000..dd7dbeb1
--- /dev/null
+++ b/sys/gio/nsppkern/gktdrawch.x
@@ -0,0 +1,68 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gki.h>
+include	<gset.h>
+include	"gkt.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+
+
+# GKT_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+procedure gkt_drawchar (ch, x, y, xsize, ysize, orien, font)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# width, height of char in GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+
+real	px, py, sx, sy, coso, sino, theta
+int	stroke, tab1, tab2, i, pen
+int	bitupk()
+include	"font.com"
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	# Set the font.
+	call gkt_font (font)
+
+	tab1 = chridx[i]
+	tab2 = chridx[i+1] - 1
+
+	theta = -DEGTORAD(orien)
+	coso = cos(theta)
+	sino = sin(theta)
+
+	do i = tab1, tab2 {
+	    stroke = chrtab[i]
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    # Scale size of character.
+	    px = px / FONT_WIDTH  * xsize
+	    py = py / FONT_HEIGHT * ysize
+
+	    # The italic font is implemented applying a tilt.
+	    if (font == GT_ITALIC)
+		px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+	    # Rotate and shift.
+	    sx = x + px * coso + py * sino
+	    sy = y - px * sino + py * coso
+
+	    # Draw the line segment or move pen.
+	    if (pen == 0)
+		call frstpt (sx / GKI_MAXNDC, sy / GKI_MAXNDC)
+	    else
+		call vector (sx / GKI_MAXNDC, sy / GKI_MAXNDC)
+	}
+end
diff --git a/sys/gio/nsppkern/gktescape.x b/sys/gio/nsppkern/gktescape.x
new file mode 100644
index 00000000..ad8ff494
--- /dev/null
+++ b/sys/gio/nsppkern/gktescape.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GKt_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# The nspp kernel does not have any escape functions at present.
+
+procedure gkt_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+
+begin
+end
diff --git a/sys/gio/nsppkern/gktfa.x b/sys/gio/nsppkern/gktfa.x
new file mode 100644
index 00000000..4df21260
--- /dev/null
+++ b/sys/gio/nsppkern/gktfa.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# GKT_FILLAREA -- Fill a closed area.
+
+procedure gkt_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+include	"gkt.com"
+
+begin
+	# Not implemented yet.
+	call gkt_polyline (p, npts)
+end
diff --git a/sys/gio/nsppkern/gktfaset.x b/sys/gio/nsppkern/gktfaset.x
new file mode 100644
index 00000000..f5851cb9
--- /dev/null
+++ b/sys/gio/nsppkern/gktfaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_FASET -- Set the fillarea attributes.
+
+procedure gkt_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"gkt.com"
+
+begin
+	fa = GKT_FAAP(g_kt)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/nsppkern/gktflush.x b/sys/gio/nsppkern/gktflush.x
new file mode 100644
index 00000000..decb5300
--- /dev/null
+++ b/sys/gio/nsppkern/gktflush.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gkt.h"
+
+# GKT_FLUSH -- Flush output.
+
+procedure gkt_flush (dummy)
+
+int	dummy			# not used at present
+include	"gkt.com"
+
+begin
+	# Since the NSPP devices are not interactive, calls to FLUSH
+	# are ignored.
+end
diff --git a/sys/gio/nsppkern/gktfont.x b/sys/gio/nsppkern/gktfont.x
new file mode 100644
index 00000000..cbcb9f90
--- /dev/null
+++ b/sys/gio/nsppkern/gktfont.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gset.h>
+include	"gkt.h"
+
+# GKT_FONT -- Set the character font.  The roman font is normal.  Bold is
+# implemented by increasing the vector line width; care must be taken to
+# set GKT_WIDTH so that the other vector drawing procedures remember to
+# change the width back.  The italic font is implemented in the character
+# generator by a geometric transformation.
+
+procedure gkt_font (font)
+
+int	font			# code for font to be set
+int	pk1, pk2, width
+include	"gkt.com"
+
+begin
+	pk1 = GKI_PACKREAL(1.0)
+	pk2 = GKI_PACKREAL(2.0)
+
+	width = GKT_WIDTH(g_kt)
+
+	if (font == GT_BOLD) {
+	    if (width != pk2) {
+		call optn (*"inten", *"high")
+		width = pk2
+	    }
+	} else {
+	    if (GKI_UNPACKREAL(width) > 1.5) {
+		call optn (*"inten", *"low")
+		width = pk1
+	    }
+	}
+
+	GKT_WIDTH(g_kt) = width
+end
diff --git a/sys/gio/nsppkern/gktgcell.x b/sys/gio/nsppkern/gktgcell.x
new file mode 100644
index 00000000..197bf018
--- /dev/null
+++ b/sys/gio/nsppkern/gktgcell.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GKT_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure gkt_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+begin
+	# Not implemented yet.
+end
diff --git a/sys/gio/nsppkern/gktinit.x b/sys/gio/nsppkern/gktinit.x
new file mode 100644
index 00000000..78ae0840
--- /dev/null
+++ b/sys/gio/nsppkern/gktinit.x
@@ -0,0 +1,194 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_INIT -- Initialize the gkt data structures from the graphcap entry
+# for the device.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine GKT_RESET initializes the attribute
+# packets when the frame is flushed.
+
+procedure gkt_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+int	maxch, i
+real	char_height, char_width, char_size
+
+bool	ttygetb()
+real	ttygetr()
+int	ttygeti(), btoi(), gstrcpy()
+include	"gkt.com"
+include	"nspp.com"
+int	pow2()
+
+begin
+	# Allocate the gkt descriptor and the string buffer.
+	if (g_kt == NULL) {
+	    call calloc (g_kt, LEN_GKT, TY_STRUCT)
+	    call malloc (GKT_SBUF(g_kt), SZ_SBUF, TY_CHAR)
+	}
+
+	# Get the maximum frame count and the flags controlling frame advance
+	# at start and end of metafile (NSPP parameters).
+
+	g_maxframes = ttygeti (tty, "MF")
+	if (g_maxframes == 0)
+	    g_maxframes = DEF_MAXFRAMES
+	GKT_STARTFRAME(g_kt) = btoi (ttygetb (tty, "FS"))
+	GKT_ENDFRAME(g_kt)   = btoi (ttygetb (tty, "FE"))
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	GKT_SZSBUF(g_kt) = SZ_SBUF
+	GKT_NEXTCH(g_kt) = GKT_SBUF(g_kt) + 1
+	Memc[GKT_SBUF(g_kt)] = EOS
+
+	# Get the device resolution from the graphcap entry.
+
+	g_xres = ttygeti (tty, "xr")
+	if (g_xres <= 0)
+	    g_xres = 1024
+	g_yres = ttygeti (tty, "yr")
+	if (g_yres <= 0)
+	    g_yres = 1024
+
+	# Set up coordinate transformations.
+
+	call seti (pow2(g_xres), pow2(g_yres))
+	call set (0., 1., 0., 1., 0., 1., 0., 1., 1)
+	call z8zpii()
+
+	# Set byteswap flag for output metacode.
+	mbswap = btoi (ttygetb (tty, "BS"))
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the device has a set of discreet character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+	# ... not relevant for nspp, but leave here anyway for now
+
+	GKT_NCHARSIZES(g_kt) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = GKT_NEXTCH(g_kt)
+
+	if (GKT_NCHARSIZES(g_kt) <= 0) {
+	    GKT_NCHARSIZES(g_kt) = 1
+	    GKT_CHARSIZE(g_kt,1) = 1.0
+	    GKT_CHARHEIGHT(g_kt,1) = char_height
+	    GKT_CHARWIDTH(g_kt,1)  = char_width
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= GKT_NCHARSIZES(g_kt);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		GKT_CHARSIZE(g_kt,i)   = char_size
+		GKT_CHARHEIGHT(g_kt,i) = char_height * char_size
+		GKT_CHARWIDTH(g_kt,i)  = char_width  * char_size
+	    }
+	}
+
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the gkt
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	GKT_POLYLINE(g_kt)   = btoi (ttygetb (tty, "pl"))
+	GKT_POLYMARKER(g_kt) = btoi (ttygetb (tty, "pm"))
+	GKT_FILLAREA(g_kt)   = btoi (ttygetb (tty, "fa"))
+	GKT_FILLSTYLE(g_kt)  =       ttygeti (tty, "fs")
+	GKT_ROAM(g_kt)	     = btoi (ttygetb (tty, "ro"))
+	GKT_ZOOM(g_kt)	     = btoi (ttygetb (tty, "zo"))
+	GKT_ZRES(g_kt)	     =       ttygeti (tty, "zr")
+	GKT_CELLARRAY(g_kt)  = btoi (ttygetb (tty, "ca"))
+	GKT_SELERASE(g_kt)   = btoi (ttygetb (tty, "se"))
+	GKT_PIXREP(g_kt)     = btoi (ttygetb (tty, "pr"))
+
+	# Initialize the input parameters.
+
+	GKT_CURSOR(g_kt)     = 1
+
+	# Save the device string in the descriptor.
+	nextch = GKT_NEXTCH(g_kt)
+	GKT_DEVNAME(g_kt) = nextch
+	maxch = GKT_SBUF(g_kt) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+	GKT_NEXTCH(g_kt) = nextch
+end
+
+
+# GKT_GSTRING -- Get a string value parameter from the graphcap table,
+# placing the string at the end of the string buffer.  If the device does
+# not have the named capability return a pointer to the null string,
+# otherwise return a pointer to the string.  Since pointers are used,
+# rather than indices, the string buffer is fixed in size.  The additional
+# degree of indirection required with an index was not considered worthwhile
+# in this application since the graphcap entries are never very large.
+
+pointer procedure gkt_gstring (cap)
+
+char	cap[ARB]		# device capability to be fetched
+pointer	strp, nextch
+int	maxch, nchars
+int	ttygets()
+include	"gkt.com"
+
+begin
+	nextch = GKT_NEXTCH(g_kt)
+	maxch = GKT_SBUF(g_kt) + SZ_SBUF - nextch + 1
+
+	nchars = ttygets (g_tty, cap, Memc[nextch], maxch)
+	if (nchars > 0) {
+	    strp = nextch
+	    nextch = nextch + nchars + 1
+	} else
+	    strp = GKT_SBUF(g_kt)
+
+	GKT_NEXTCH(g_kt) = nextch
+	return (strp)
+end
+
+
+# POW2 -- Return the integer base two exponent of the first power of two
+# greater than the argument.  The technique is to use successive one bit
+# shift rights to determine the index of the leftmost one-bit.
+
+int procedure pow2 (num)
+
+int	num
+int	bitshift, n, pow
+
+begin
+	bitshift = 0
+	for (n=max(1,num);  n > 0;  n=n/2)
+	    bitshift = bitshift + 1
+	pow = bitshift - 1
+
+	if (num > 2 ** pow)
+	    return (pow + 1)
+	else
+	    return (pow)
+end
diff --git a/sys/gio/nsppkern/gktline.x b/sys/gio/nsppkern/gktline.x
new file mode 100644
index 00000000..08318c91
--- /dev/null
+++ b/sys/gio/nsppkern/gktline.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gset.h>
+include	"gkt.h"
+
+# GKT_LINETYPE -- Set the line type option in the nspp world.
+
+procedure gkt_linetype (index)
+
+int	index		# index for line type switch statement
+
+int	linetype
+include	"gkt.com"
+
+begin
+	switch (index) {
+	    case GL_CLEAR:
+		linetype = 0
+	    case GL_DASHED:
+		linetype = 0FF00X
+	    case GL_DOTTED:
+		linetype = 08888X
+	    case GL_DOTDASH:
+		linetype = 0F040X
+	    default:
+		linetype = 0FFFFX	# GL_SOLID and default
+	}
+
+	call optn (*"dp", linetype)
+end
diff --git a/sys/gio/nsppkern/gktmfopen.x b/sys/gio/nsppkern/gktmfopen.x
new file mode 100644
index 00000000..97ab92f9
--- /dev/null
+++ b/sys/gio/nsppkern/gktmfopen.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<mach.h>
+include	<fset.h>
+include	"gkt.h"
+
+define	SZ_DDSTR	256
+
+
+# GKT_MFOPEN -- Open the NSPP metacode output file.  The device is connected
+# to FIO as a binary file.  Metacode output to the device will be spooled
+# and then disposed of to the device when the file descriptor we return is
+# later closed.
+
+int procedure gkt_mfopen (tty, mode)
+
+pointer	tty			# pointer to graphcap entry for device
+int	mode			# access mode
+
+int	fd
+pointer	sp, ddstr
+int	fopnbf(), ttygets()
+extern	zopnpl(), zardpl(), zawrpl(), zawtpl(), zsttpl(), zclspl()
+errchk	fopnbf
+
+begin
+	call smark (sp)
+	call salloc (ddstr, SZ_DDSTR, TY_CHAR)
+
+	# The DD string is used to pass device dependent information to the
+	# NSPP graphics device driver.
+
+	if (ttygets (tty, "DD", Memc[ddstr], SZ_DDSTR) <= 0)
+	    call error (1, "nsppkern: missing DD parameter in graphcap")
+
+	fd = fopnbf (Memc[ddstr], mode,
+	    zopnpl, zardpl, zawrpl, zawtpl, zsttpl, zclspl)
+
+	# Set the FIO buffer size to the size of a metafile record.
+	call fseti (fd, F_BUFSIZE, SZ_MFRECORD)
+
+	call sfree (sp)
+	return (fd)
+end
diff --git a/sys/gio/nsppkern/gktopen.x b/sys/gio/nsppkern/gktopen.x
new file mode 100644
index 00000000..41e3b19a
--- /dev/null
+++ b/sys/gio/nsppkern/gktopen.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_OPEN -- Install the nspp kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  If a driver does not implement a particular
+# instruction the table entry for that procedure may be set to zero, causing
+# the interpreter to ignore the instruction.
+
+procedure gkt_open (devname, dd)
+
+char	devname[ARB]		# nonnull for forced output to a device
+int	dd[ARB]			# device table to be initialized
+
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+extern	gkt_openws(), gkt_closews(), gkt_clear(), gkt_cancel()
+extern	gkt_flush(), gkt_polyline(), gkt_polymarker(), gkt_text()
+extern	gkt_fillarea(), gkt_putcellarray(), gkt_plset()
+extern	gkt_pmset(), gkt_txset(), gkt_faset()
+extern	gkt_escape()
+include	"gkt.com"
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	# Flag first pass.  Save forced device name in common for OPENWS.
+	# Zero the frame and instruction counters.
+
+	g_kt = NULL
+	g_nframes = 0
+	g_ndraw = 0
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+
+	dd[GKI_OPENWS]		= locpr (gkt_openws)
+	dd[GKI_CLOSEWS]		= locpr (gkt_closews)
+	dd[GKI_DEACTIVATEWS]	= 0
+	dd[GKI_REACTIVATEWS]	= 0
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (gkt_clear)
+	dd[GKI_CANCEL]		= locpr (gkt_cancel)
+	dd[GKI_FLUSH]		= locpr (gkt_flush)
+	dd[GKI_POLYLINE]	= locpr (gkt_polyline)
+	dd[GKI_POLYMARKER]	= locpr (gkt_polymarker)
+	dd[GKI_TEXT]		= locpr (gkt_text)
+	dd[GKI_FILLAREA]	= locpr (gkt_fillarea)
+	dd[GKI_PUTCELLARRAY]	= locpr (gkt_putcellarray)
+	dd[GKI_SETCURSOR]	= 0
+	dd[GKI_PLSET]		= locpr (gkt_plset)
+	dd[GKI_PMSET]		= locpr (gkt_pmset)
+	dd[GKI_TXSET]		= locpr (gkt_txset)
+	dd[GKI_FASET]		= locpr (gkt_faset)
+	dd[GKI_GETCURSOR]	= 0
+	dd[GKI_GETCELLARRAY]	= 0
+	dd[GKI_ESCAPE]		= locpr (gkt_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call gkt_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/nsppkern/gktopenws.x b/sys/gio/nsppkern/gktopenws.x
new file mode 100644
index 00000000..2ef91e3d
--- /dev/null
+++ b/sys/gio/nsppkern/gktopenws.x
@@ -0,0 +1,104 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include	<gki.h>
+include	<error.h>
+include	"gkt.h"
+
+# GKT_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, following by initialization of the device itself.
+
+procedure gkt_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+pointer	sp, buf
+pointer	ttygdes()
+bool	streq()
+int	gkt_mfopen()
+bool	need_open, same_dev
+
+include	"gkt.com"
+include	"nspp.com"
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_FNAME, n), TY_CHAR)
+
+	# If a device was named when the kernel was opened then output will
+	# always go to that device (g_device) regardless of the device named
+	# in the OPENWS instruction.  If no device was named (null string)
+	# then unpack the device name, passed as a short integer array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Find out if first time, and if not, if same device as before
+	# note that if (g_kt == NULL), then same_dev is false.
+
+	same_dev = false
+	need_open = true
+
+	if (g_kt != NULL) {
+	    same_dev = (streq (Memc[GKT_DEVNAME(g_kt)], Memc[buf]))
+	    if (!same_dev) {
+		# Does this device require a frame advance at end of metafile?
+		if (GKT_ENDFRAME(g_kt) == YES)
+		    call frame()
+		call close (g_out)
+	    } else
+		need_open = false
+	}
+
+	# Initialize the kernel data structures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+	# graphcap entry for device must exist.
+
+	if (need_open) {
+	    if (!same_dev) {
+		if (g_kt != NULL)
+		    call ttycdes (g_tty)
+		iferr (g_tty = ttygdes (Memc[buf]))
+		    call erract (EA_ERROR)
+
+		# Initialize data structures if we had to open a new device.
+		call gkt_init (g_tty, Memc[buf])
+		call gkt_reset()
+	    }
+
+	    # Open the output file.  The device is connected to FIO as a 
+	    # binary file.  Metacode output to the device will be spooled
+	    # and then disposed of to the device at CLOSEWS time.
+
+	    iferr (g_out = gkt_mfopen (g_tty, mode)) {
+	        call ttycdes (g_tty)
+	        call erract (EA_ERROR)
+	    } else {
+		# Does this device require a frame advance at start of metafile?
+		if (GKT_STARTFRAME(g_kt) == YES)
+		    call frame()
+		g_nframes = 0
+		g_ndraw = 0
+	    }
+
+	    # Initialize output file descriptor in nspp common.
+	    munit = g_out
+	}
+
+	# Clear the screen if device is being opened in new_file mode.
+	# This is a nop if we really opened a new device, but it will clear
+	# the screen if this is just a reopen of the same device in new file
+	# mode.
+
+	if (mode == NEW_FILE)
+	    call gkt_clear (0)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/nsppkern/gktpcell.x b/sys/gio/nsppkern/gktpcell.x
new file mode 100644
index 00000000..e7e0ca4a
--- /dev/null
+++ b/sys/gio/nsppkern/gktpcell.x
@@ -0,0 +1,383 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include "gkt.h"
+
+# Number of grey scale symbols
+define NSYMBOL	11
+define TSIZE	(1.0/2.0)
+
+# GKT_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure gkt_putcellarray (m, nc, nr, ax1,ay1, ax2,ay2)
+
+short	m[ARB]			# cell array
+int	nc, nr			# number of pixels in X and Y
+				# (number of columns[x], rows[y]
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+int	x1,y1,x2,y2		# device coordinates
+real	px1, py1, px2, py2
+int	nx, ny, y
+real	skip_x, skip_y, sx, sy
+real	blockx, blocky, bcy
+int	i, j, startrow, element
+real	xres, yres
+pointer	sp, cell, tx, txsave
+bool	ca, use_orig, new_row, pr
+real	z_scale
+real	charheight, charwidth
+real	delta_y
+int	xrep, yrep
+
+include "gkt.com"
+
+begin
+	call smark(sp)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+
+	g_ndraw = g_ndraw + 1
+
+	skip_x = 1.0
+	skip_y = 1.0
+	blockx = 1.0
+	blocky = 1.0
+
+	# Determine if can do real cell array.  If not, use character
+	# sized boxes as pixels.  In that case, we need to save all
+	# the character attributes since we will want to force default
+	# character size, orientation, etc.
+
+	ca = (GKT_CELLARRAY(g_kt) != 0)
+	pr = false
+	if ( ca ) {
+	    xres = real(g_xres)
+	    yres = real(g_yres)
+	    pr = (GKT_PIXREP(g_kt) != 0)
+	} else {
+	    charwidth  = real(GKT_CHARWIDTH(g_kt,1))*TSIZE
+	    charheight = real(GKT_CHARHEIGHT(g_kt,1))*TSIZE
+	    xres = real(GKI_MAXNDC)/ charwidth
+	    yres = real(GKI_MAXNDC)/ charheight
+	    z_scale = 1.0 / sqrt ( real(max(NSYMBOL, GKT_ZRES(g_kt))) )
+	    tx = GKT_TXAP(g_kt)
+	    call salloc(txsave, LEN_TX, TY_INT)
+	    call savetx(txsave,tx)
+	}
+
+	# Input arguments (ax, ay) refer to corners of put cell array;
+	# we need corners of the corresponding device array.
+
+	x1 = ax1
+	x2 = ax2
+	y1 = ay1
+	y2 = ay2
+	call adjust(x1,x2,xres)
+	call adjust(y1,y2,yres)
+
+	# Find out how many real pixels we have to fill
+	px1 = real(x1)/(GKI_MAXNDC+1)
+	py1 = real(y1)/(GKI_MAXNDC+1)
+	px2 = real(x2)/(GKI_MAXNDC+1)
+	py2 = real(y2)/(GKI_MAXNDC+1)
+
+	nx = int( px2 * xres ) - int( px1 * xres ) + 1
+	ny = int( py2 * yres ) - int( py1 * yres ) + 1
+
+	if ( ny > 1)
+	     delta_y = (real(y2) - real(y1))/ny
+	else {
+	     delta_y = 0.
+	}
+
+	# If too many data points in input, set skip.  If skip is close
+	# enough to one, set it to one.
+	# Set block replication factors - will be > 1.0 if too few input points.
+	# Cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have
+	# enough points and so *some* have to be replicated.
+
+	if ( nc > nx ) {
+	    skip_x = real(nc)/nx
+	    if ( (skip_x - 1.0)*(nx-1) < 1.0 )
+		skip_x = 1.0
+	} else
+	    blockx = real(nx)/nc
+
+	if ( nr > ny ) {
+	    skip_y = real(nr)/ny
+	    if ( (skip_y - 1.0)*(ny-1) < 1.0 )
+		skip_y = 1.0
+	} else
+	    blocky = real(ny)/nr
+
+	# Allocate storage for a row of pixels.  This is quite inefficient
+	# if the x dimension of the cell array is small, but the metacode
+	# won't be too much bigger (?).
+	# need nx+1 in case nx odd ... pixels() wants to pad output.
+
+	call salloc ( cell, nx+1, TY_SHORT)
+	Mems[cell + nx] = 0
+
+	# Initialize counters
+
+	sy = skip_y
+	bcy = blocky
+	startrow = 1
+	element = startrow
+
+	# See if we can use original data ... no massaging
+	# also set the initial value of the new_row flag, which tells
+	# if we have to rebuild the row data
+	# Note that if blockx > 1.0, skip_x must be 1.0, and vv
+
+	if ( (skip_x == 1.0) && (blockx == 1.0) ) {
+	    use_orig = true
+	    new_row  = false
+	} else {
+	    use_orig = false
+	    new_row  = true
+	}
+
+	# If device can pixel replicate, use that feature where we can
+	if( pr) {
+	    if( (skip_x == 1.0) && ( int(blockx) == blockx) ) {
+		 xrep = int(blockx)
+		 use_orig = true
+		 nx = nc
+	    } else
+		 xrep = 1
+	    if( (skip_y == 1.0) && ( int(blocky) == blocky) ) {
+		 yrep = int(blocky)
+		 ny = 1
+	    } else
+		 yrep = 1
+	    call pixel0(1,0,xrep,0,1,yrep)
+	}
+
+	# Do it
+
+	for ( i = 1; i <= ny ; i = i + 1) {
+
+	    # Build the row data
+
+	    if ( !use_orig && new_row ) {
+		if ( skip_x == 1.0) {
+		    call blockit(m[element], Mems[cell], nx, blockx)
+		} else {
+	            sx = skip_x
+	            for ( j = 1; j <= nx; j = j + 1) {
+		        Mems[cell+j-1] = m[element]
+		        element = startrow + int(sx+0.5)
+		        sx = sx + skip_x
+	            }
+		}
+		if ( !ca )
+		    if ( use_orig)
+			call fakepc(m[element], Mems[cell], nx, z_scale)
+		    else
+			call fakepc(Mems[cell], Mems[cell], nx, z_scale)
+	    }
+
+	    # Send the row data.
+
+	    if ( ca ) {
+		y = y1 + ((i - 1)*delta_y + 0.5)
+	        if ( use_orig ) {
+		        call pixels( px1, real(y)/GKI_MAXNDC,
+			    nx, 1, m[element])
+	        } else {
+		        call pixels( px1, real(y)/GKI_MAXNDC, nx, 1, Mems[cell])
+	        }
+	    }   
+	    else
+		call gkt_text( x1, y1+(i-1)*int(charheight), Mems[cell], nx)
+
+	    # Advance a row
+
+	    element = startrow
+	    if ( bcy <= real(i) ) {
+		startrow = 1 + nc * int(sy+0.5)
+		element = startrow
+		sy = sy + skip_y
+	        bcy = bcy + blocky
+		new_row = true
+	    } else {
+		new_row = false
+	    }
+	}
+
+	# All done, restore text parameters and release storage
+
+	if ( !ca )
+	    call restoretx (txsave,tx)
+	call sfree(sp)
+end
+
+# SAVETX --- save the current text parameters as pointed to by "txp"
+# in the area pointed to by "savep", and then set the necessary
+# defaults.
+
+procedure savetx (savep, txp)
+pointer savep, txp
+
+include "gkt.com"
+
+begin
+	# save old values
+
+	TX_UP(savep)	   = TX_UP(txp)
+	TX_SIZE(savep)	   = TX_SIZE(txp)
+	TX_PATH(savep)	   = TX_PATH(txp)
+	TX_HJUSTIFY(savep) = TX_HJUSTIFY(txp)
+	TX_VJUSTIFY(savep) = TX_VJUSTIFY(txp)
+	TX_FONT(savep)	   = TX_FONT(txp)
+	TX_COLOR(savep)	   = TX_COLOR(txp)
+	TX_SPACING(savep)  = TX_SPACING(txp)
+
+	# set new (default) ones
+
+	TX_UP(txp)	= 90
+	TX_SIZE(txp)	= GKI_PACKREAL(TSIZE)
+	TX_PATH(txp)	= GT_RIGHT
+	TX_HJUSTIFY(txp)= GT_LEFT
+	TX_VJUSTIFY(txp)= GT_BOTTOM
+	TX_FONT(txp)	= GT_ROMAN
+	TX_COLOR(txp)	= 1
+	TX_SPACING(txp)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	GKT_TYPE(g_kt)		= -1
+	GKT_WIDTH(g_kt)		= -1
+	GKT_COLOR(g_kt)		= -1
+	GKT_TXSIZE(g_kt)	= -1
+	GKT_TXFONT(g_kt)	= -1
+end
+
+# RESTORETX --- restore the text parameters from the save area
+
+procedure restoretx (savep, txp)
+pointer savep, txp
+
+include "gkt.com"
+
+begin
+	# Restore values
+
+	TX_UP(txp)	 = TX_UP(savep)
+	TX_SIZE(txp)	 = TX_SIZE(savep)
+	TX_PATH(txp)	 = TX_PATH(savep)
+	TX_HJUSTIFY(txp) = TX_HJUSTIFY(savep)
+	TX_VJUSTIFY(txp) = TX_VJUSTIFY(savep)
+	TX_FONT(txp)	 = TX_FONT(savep)
+	TX_COLOR(txp)	 = TX_COLOR(savep)
+	TX_SPACING(txp)  = TX_SPACING(savep)
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	GKT_TYPE(g_kt)		= -1
+	GKT_WIDTH(g_kt)		= -1
+	GKT_COLOR(g_kt)		= -1
+	GKT_TXSIZE(g_kt)	= -1
+	GKT_TXFONT(g_kt)	= -1
+end
+
+# FAKEPC --- fake putcell output by using appropriately chosen text
+# characters to make grey scale.
+
+procedure fakepc (indata, outdata, nx,  scale)
+int	nx			# number of points in row
+short	indata[ARB]		# input row data
+short	outdata[ARB]		# output row data
+real	scale			# intensity scaling factor
+
+include "gkt.com"
+
+int	i
+real	temp
+char	cdata[NSYMBOL]		# characters to represent intensity
+data cdata /' ', '.', ':', '|', 'i', 'l', 'J', 'm', '#', 'S', 'B', EOS/
+
+begin
+	#
+	for ( i = 1 ; i <= nx ; i = i + 1 ) {
+	    temp = sqrt( max(0., real(indata[i])) )
+	    outdata[i] = cdata[ min( NSYMBOL, int(NSYMBOL*scale*temp)+1 ) ]
+	}
+end
+
+# BLOCKIT -- block replication of data
+
+procedure blockit( from, to, count, factor)
+
+short	from[ARB]			# input data
+short	to[ARB]				# output data
+int	count				# number of output pixels
+real	factor				# blocking factor
+
+int	i, j
+real	bc
+
+begin
+	bc = factor
+	j = 1
+	for ( i = 1; i <= count ; i = i + 1 ) {
+	    to[i] = from[j]
+	    if ( bc <= real(i) ) {
+		j = j + 1
+		bc = bc + factor
+	    }
+	}
+end
+
+# ADJUST -- round/truncate putcell array corners to device coordinates
+# move up lower bound if it is above center point of device cell,
+# move down upper bound if below.  Don't allow bounds to go beyond
+# resolution or below zero.  Do not allow bounds to cross.  Part of the
+# assumptions behind all this is that putcells will be continguous and
+# rows/columns must not be plotted twice.
+
+procedure adjust ( lower, upper, res)
+
+int	lower, upper
+real	res
+
+real	factor
+real	low, up
+
+begin
+	factor = res/(GKI_MAXNDC+1)
+	low = real(lower) * factor
+	up  = real(upper) * factor
+
+	# if boundaries result in same row, return
+	if ( int(low) == int(up) )
+	    return
+
+	# if low is in upper half of device pixel, round up
+	if ( (low - int(low)) >= 0.5 ) {
+	    low = int(low) + 1
+	    # don't go to or beyond upper bound
+	    if ( low < up ) {
+	        # ... 0.2 just for "rounding protection";
+		lower = (low + 0.2)/factor
+	        # if now reference same cell, return
+		if ( int(low) == int(up) )
+		    return
+	    }
+	}
+
+	# if "up" in bottom half of pixel, drop down one.  Note that
+	# due to two "==" tests above, upper will not drop below lower.
+	# 0.2 means drop partway down into pixel below; calling code will
+	# truncate.
+	if ( (up - int(up)) < 0.5 )
+	    upper = real(int(up) - 0.2)/factor
+end
diff --git a/sys/gio/nsppkern/gktpl.x b/sys/gio/nsppkern/gktpl.x
new file mode 100644
index 00000000..7e7243cf
--- /dev/null
+++ b/sys/gio/nsppkern/gktpl.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	"gkt.h"
+
+# GKT_POLYLINE -- Draw a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted but rather defines the start of the polyline.  The remaining
+# points define line segments to be drawn.
+
+procedure gkt_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl
+int	i, len_p
+int	x,y
+include	"gkt.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polyline attributes if necessary.
+	pl = GKT_PLAP(g_kt)
+
+	if (GKT_TYPE(g_kt) != PL_LTYPE(pl)) {
+	    call gkt_linetype (PL_LTYPE(pl))
+	    GKT_TYPE(g_kt) = PL_LTYPE(pl)
+	}
+	if (GKT_WIDTH(g_kt) != PL_WIDTH(pl)) {
+	    if (GKI_UNPACKREAL(PL_WIDTH(pl)) < 1.5)
+		call optn (*"inten", *"low")
+	    else
+		call optn (*"inten", *"high")
+	    GKT_WIDTH(g_kt) = PL_WIDTH(pl)
+	}
+	if (GKT_COLOR(g_kt) != PL_COLOR(pl)) {
+	    call gkt_color (PL_COLOR(pl))
+	    GKT_COLOR(g_kt) = PL_COLOR(pl)
+	}
+
+	# Transform the first point from GKI coords to nspp coords and
+	# move to the transformed point.
+
+	x = p[1]
+	y = p[2]
+	call frstpt(real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC)
+
+	# Draw the polyline.
+
+	for (i=3;  i <= len_p;  i=i+2) {
+	    x = p[i]
+	    y = p[i+1]
+	    call vector (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC)
+	}
+end
diff --git a/sys/gio/nsppkern/gktplset.x b/sys/gio/nsppkern/gktplset.x
new file mode 100644
index 00000000..9342fccc
--- /dev/null
+++ b/sys/gio/nsppkern/gktplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure gkt_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"gkt.com"
+
+begin
+	pl = GKT_PLAP(g_kt)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = gki[GKI_PLSET_LW]
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/nsppkern/gktpm.x b/sys/gio/nsppkern/gktpm.x
new file mode 100644
index 00000000..fe6a9a0a
--- /dev/null
+++ b/sys/gio/nsppkern/gktpm.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	"gkt.h"
+
+# Nspp particulars.
+define	BASELW		8	# base width of line
+
+
+# GKT_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs.
+
+procedure gkt_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+int	i, len_p
+int	x, y, oldx, oldy
+include	"gkt.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polymarker attributes if necessary.
+
+	pm = GKT_PMAP(g_kt)
+
+	if (GKT_TYPE(g_kt) != PM_LTYPE(pm)) {
+	    call gkt_linetype (PM_LTYPE(pm))
+	    GKT_TYPE(g_kt) = PM_LTYPE(pm)
+	}
+	if (GKT_WIDTH(g_kt) != PM_WIDTH(pm)) {
+	    if (GKI_UNPACKREAL(PM_WIDTH(pm)) < 1.5)
+		call optn (*"inten", *"low")
+	    else
+		call optn (*"inten", *"high")
+	    GKT_WIDTH(g_kt) = PM_WIDTH(pm)
+	}
+	if (GKT_COLOR(g_kt) != PM_COLOR(pm)) {
+	    call gkt_color (PM_COLOR(pm))
+	    GKT_COLOR(g_kt) = PM_COLOR(pm)
+	}
+
+	# Get to start of marker.
+	call frstpt (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC)
+	oldx = 0; oldy = 0
+
+	# Draw the polymarker.
+	for (i=1;  i <= len_p;  i=i+2) {
+	    x = p[i]; y = p[i+1]
+	    if (x != oldx && y != oldy)
+		call point (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC)
+	    oldx = x; oldy = y
+	}
+end
diff --git a/sys/gio/nsppkern/gktpmset.x b/sys/gio/nsppkern/gktpmset.x
new file mode 100644
index 00000000..8a3ebe24
--- /dev/null
+++ b/sys/gio/nsppkern/gktpmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_PMSET -- Set the polymarker attributes.
+
+procedure gkt_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"gkt.com"
+
+begin
+	pm = GKT_PMAP(g_kt)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = gki[GKI_PMSET_MW]
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/nsppkern/gktreset.x b/sys/gio/nsppkern/gktreset.x
new file mode 100644
index 00000000..6e34cec4
--- /dev/null
+++ b/sys/gio/nsppkern/gktreset.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	<gset.h>
+include	"gkt.h"
+
+# GKT_RESET -- Reset the state of the transform common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure gkt_reset()
+
+pointer	pl, pm, fa, tx
+include	"gkt.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = GKT_PLAP(g_kt)
+	pm = GKT_PMAP(g_kt)
+	fa = GKT_FAAP(g_kt)
+	tx = GKT_TXAP(g_kt)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	= 1
+	PL_WIDTH(pl)	= GKI_PACKREAL(1.)
+	PL_COLOR(pl)	= 1
+	PM_LTYPE(pm)	= 1
+	PM_WIDTH(pm)	= GKI_PACKREAL(1.)
+	PM_COLOR(pm)	= 1
+	FA_STYLE(fa)	= 1
+	FA_COLOR(fa)	= 1
+	TX_UP(tx)	= 90
+	TX_SIZE(tx)	= GKI_PACKREAL(1.)
+	TX_PATH(tx)	= GT_RIGHT
+	TX_HJUSTIFY(tx)	= GT_LEFT
+	TX_VJUSTIFY(tx)	= GT_BOTTOM
+	TX_FONT(tx)	= GT_ROMAN
+	TX_COLOR(tx)	= 1
+	TX_SPACING(tx)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	GKT_TYPE(g_kt)		= -1
+	GKT_WIDTH(g_kt)		= -1
+	GKT_COLOR(g_kt)		= -1
+	GKT_TXSIZE(g_kt)	= -1
+	GKT_TXFONT(g_kt)	= -1
+
+	# Reset the nspp common.
+
+	call z8zpii()
+
+	# If cellarray allowed, reset pixel size to standard one.
+
+	if (GKT_CELLARRAY(g_kt) != 0)
+	    call pixel0 (1,0,1,0,1,1)
+end
diff --git a/sys/gio/nsppkern/gkttx.x b/sys/gio/nsppkern/gkttx.x
new file mode 100644
index 00000000..7aaf3c31
--- /dev/null
+++ b/sys/gio/nsppkern/gkttx.x
@@ -0,0 +1,428 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"gkt.h"
+
+define	BASECS_X	12	# Base (size 1.0) char width in GKI coords.
+define	BASECS_Y	12	# Base (size 1.0) char height in GKI coords.
+
+
+# GKT_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.
+
+procedure gkt_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+real	x, y, dx, dy, tsz
+int	x1, x2, y1, y2, orien
+int	x0, y0, gki_dx, gki_dy, ch, cw
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen 
+pointer	sp, seg, ip, op, tx, first
+int	stx_segment()
+include	"gkt.com"
+
+real	g_dx, g_dy		# scale GKI to window coords
+int	g_x1, g_y1		# origin of device window
+int	g_x2, g_y2		# upper right corner of device window
+data	g_dx /1.0/, g_dy /1.0/
+data	g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Set pointer to the text attribute structure.
+	tx = GKT_TXAP(g_kt)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  The text size was
+	# set by gkt_txset, and is just a scaling factor.
+
+	GKT_TXSIZE(g_kt) = TX_SIZE(tx)
+	if (TX_COLOR(tx) != GKT_COLOR(g_kt)) {
+	    call gkt_color (TX_COLOR(tx))
+	    GKT_COLOR(g_kt) = TX_COLOR(tx)
+	}
+
+	# Set the linetype to a solid line, and invalidate last setting.
+	call gkt_linetype (GL_SOLID)
+	GKT_TYPE(g_kt) = -1
+
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx))
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call stx_parameters (xc,yc, totlen, x0,y0, gki_dx,gki_dy, polytext,
+	    orien)
+
+	# For nspp, have 32767 sizes, so just scale the the base sizes.
+	tsz = GKI_UNPACKREAL(TX_SIZE(tx))	# scale factor
+	ch = GKT_CHARHEIGHT(g_kt,1) * tsz
+	cw = GKT_CHARWIDTH(g_kt,1) * tsz
+
+	# Draw the segments, setting the font at the beginning of each segment.
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+
+	x  = x0 * g_dx + g_x1
+	y  = y0 * g_dy + g_y1
+	dx = gki_dx * g_dx
+	dy = gki_dy * g_dy
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    call gkt_drawchar (Memc[ip], nint(x), nint(y), cw, ch,
+			orien, font)
+		    ip = ip + 1
+		    seglen = seglen - 1
+		    x = x + dx
+		    y = y + dy
+		}
+
+		x = newx
+		y = newy
+		ip = op
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure stx_segment (text, n, out, start_font)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+
+int	ip, op
+int	totlen, font
+
+begin
+	out[1] = start_font
+	totlen = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+int	up, path
+real	dir, sz, ch, cw, cosv, sinv, space
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q
+include	"gkt.com"
+
+begin
+	tx = GKT_TXAP(g_kt)
+
+	# Get character sizes in GKI(NSPP) coords.
+	sz = GKI_UNPACKREAL (TX_SIZE(tx))
+	ch = GKT_CHARHEIGHT(g_kt,1) * sz
+	cw = GKT_CHARWIDTH(g_kt,1) * sz
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated).
+	space = (1.0 + TX_SPACING(tx))
+	if (path == GT_UP || path == GT_DOWN)
+	    p = ch * space
+	else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation.
+	dx =  p * cosv + q * sinv
+	dy = -p * sinv + q * cosv
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	xvlen = dx * (totlen - 1)
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character in size X and Y.
+	xsize = abs ( cw * cosv + ch * sinv)
+	ysize = abs (-cw * sinv + ch * cosv)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	x0 = x0 + ( p * cosv + q * sinv)
+	y0 = y0 + (-p * sinv + q * cosv)
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
diff --git a/sys/gio/nsppkern/gkttxset.x b/sys/gio/nsppkern/gkttxset.x
new file mode 100644
index 00000000..28ed1d32
--- /dev/null
+++ b/sys/gio/nsppkern/gkttxset.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"gkt.h"
+
+# GKT_TXSET -- Set the text drawing attributes.
+
+procedure gkt_txset (gki)
+
+short	gki[ARB]		# attribute structure
+
+pointer	tx
+include	"gkt.com"
+
+begin
+	tx = GKT_TXAP(g_kt)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+	TX_SIZE(tx)     = gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/nsppkern/mkpkg b/sys/gio/nsppkern/mkpkg
new file mode 100644
index 00000000..e9f92d6e
--- /dev/null
+++ b/sys/gio/nsppkern/mkpkg
@@ -0,0 +1,56 @@
+# Make the NSPPKERN GIO graphics kernel.  Requires LIBNSPP.  Requires
+# a host system metacode translation task for each device.
+
+$checkout libgkt.a lib$
+$update   libgkt.a
+$checkin  libgkt.a lib$
+$call     relink
+$exit
+
+update:					# update lib$x_nsppkern.e
+	$call	relink
+	$call	install
+	;
+
+relink:					# make x_nsppkern.e in local directory
+	$omake  writeb.x <mach.h> <error.h> gkt.h gkt.com
+	$omake  x_nsppkern.x
+	$link	x_nsppkern.o writeb.o -lgkt -lnspp
+	;
+
+install:				# install in system library
+	$move	x_nsppkern.e bin$
+	;
+
+libgkt.a:
+	gktcancel.x	gkt.com gkt.h <fset.h>
+	gktclear.x	gkt.com gkt.h <mach.h>
+	gktclose.x	gkt.com gkt.h
+	gktclws.x	gkt.h gkt.com
+	gktcolor.x	gkt.com gkt.h
+	gktdrawch.x	font.com font.h gkt.h <gki.h> <gset.h> <math.h>
+	gktescape.x	
+	gktfa.x		gkt.com gkt.h
+	gktfaset.x	gkt.com gkt.h <gki.h>
+	gktflush.x	gkt.com gkt.h
+	gktfont.x	gkt.com gkt.h <gki.h> <gset.h>
+	gktgcell.x	
+	gktinit.x	gkt.com gkt.h nspp.com <ctype.h> <gki.h> <mach.h>
+	gktline.x	gkt.com gkt.h <gset.h>
+	gktmfopen.x	gkt.h <fset.h> <knet.h> <mach.h>
+	gktopen.x	gkt.com gkt.h <gki.h>
+	gktopenws.x	gkt.com gkt.h nspp.com <error.h> <gki.h> <mach.h>
+	gktpcell.x	gkt.com gkt.h <gki.h> <gset.h>
+	gktpl.x		gkt.com gkt.h <gki.h>
+	gktplset.x	gkt.com gkt.h <gki.h>
+	gktpm.x		gkt.com gkt.h <gki.h>
+	gktpmset.x	gkt.com gkt.h <gki.h>
+	gktreset.x	gkt.com gkt.h <gset.h> <gki.h>
+	gkttx.x		gkt.com gkt.h <gki.h> <gset.h> <math.h>
+	gkttxset.x	gkt.com gkt.h <gki.h> <gset.h>
+	pixel0.f
+	pixels.f
+	t_nsppkern.x	<error.h> <gki.h>
+	tran16.f
+	writeb.x	gkt.h <error.h> <mach.h> gkt.com
+	;
diff --git a/sys/gio/nsppkern/nspp.com b/sys/gio/nsppkern/nspp.com
new file mode 100644
index 00000000..e3cac846
--- /dev/null
+++ b/sys/gio/nsppkern/nspp.com
@@ -0,0 +1,40 @@
+# NSPP.COM -- The nspp system plot package common block.
+
+int	mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab
+int	mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb
+int	mx     ,my     ,mtypex ,mtypey 
+real	xxa    ,yya    , xxb    ,yyb    ,xxc    ,yyc
+real	xxd    ,yyd    , xfactr ,yfactr ,xadd   ,yadd
+real	xx     ,yy
+
+# XX declared integer some places in nspp code !!!
+# on a VAX this works, but what if float not same size as int ???
+
+int	mfmtx[3]       ,mfmty[3]       ,mumx   ,mumy
+int	msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop[19]
+int	mname[19]      ,mxold  ,myold  ,mxmax  ,mymax
+int	mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty
+int	mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst
+int	mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin
+int	mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto
+int	mxysto ,mprint ,msybuf[360]    ,mncpw  ,minst
+int	mbufa  ,mbuflu ,mfwa[12]       ,mlwa[12]
+int	mipair ,mbprs[16]      ,mbufl  ,munit  ,mbswap
+
+real	small
+
+common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab,
+	mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb,
+	mx     ,my     ,mtypex ,mtypey ,xxa    ,yya,
+	xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd,
+	xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy,
+	mfmtx  ,mfmty  ,mumx   ,mumy,
+	msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop,
+	mname  ,mxold  ,myold  ,mxmax  ,mymax,
+	mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty,
+	mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst,
+	mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin,
+	mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto,
+	mxysto ,mprint ,msybuf ,mncpw  ,minst,
+	mbufa  ,mbuflu ,mfwa   ,mlwa,
+	mipair ,mbprs  ,mbufl  ,munit  ,mbswap ,small
diff --git a/sys/gio/nsppkern/pixel0.f b/sys/gio/nsppkern/pixel0.f
new file mode 100644
index 00000000..df42b150
--- /dev/null
+++ b/sys/gio/nsppkern/pixel0.f
@@ -0,0 +1,58 @@
+      subroutine pixel0(dx1,dy1,n1,dx2,dy2,n2)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      data ipixop / 10/
+      mbpair = ior(ishift(ior(192, ipixop), 8), 12)
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = dx1
+      yy = dy1
+      call dtran16
+      mx1 = mx
+      mbpair = mx
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      my1=my
+      mbpair=my
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=n1
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = dx2
+      yy = dy2
+      call dtran16
+      mbpair=mx
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=my
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=n2
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      if(n1*n2*(mx1*my-mx*my1) .ne. 0) return
+      call uliber(0,35h vectors not independent in pixel0.,35)
+      call perror
+      end
diff --git a/sys/gio/nsppkern/pixels.f b/sys/gio/nsppkern/pixels.f
new file mode 100644
index 00000000..a7b5e039
--- /dev/null
+++ b/sys/gio/nsppkern/pixels.f
@@ -0,0 +1,74 @@
+      subroutine pixels(x0,y0,ni,nj,inten)
+      integer*2 inten(1)
+c	assume inten is a linear array rather than 2-d.  This is a change
+c	from the original code.
+c	assume nj == 1
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+      data ipixop / 10/
+      mbpair = ior(ishift(ior(192, ipixop + 1), 8), 8)
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      xx = x0
+      yy = y0
+      call tran16
+      mbpair = mx
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=my
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=ni
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair=nj
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      nni = max0(1,(ni+iand(ni,1)))
+      nnj = max0(1,nj)
+      kmax=nni*nnj
+      k=0
+      do 200 j=1,nnj
+      do 100 i=1,nni
+      if(mod(k,254).ne.0) goto 90
+      mbpair = ior(ishift(ior(192, ipixop+2),8), min0(254,kmax-k))
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 0
+   90 ik = iand ( i, 1)
+c
+c 14Nov85 mod so that arguments to ishift are of same type
+      itmp = inten(i)
+      mbpair = ior (ishift(iand(itmp,255),8*ik),mbpair)
+c     mbpair = ior (ishift(iand(inten(i),255),8*ik),mbpair)
+c
+      if ( ik .ne. 0 ) go to 95
+      mipair = mipair + 1
+      mbprs(mipair) = mbpair
+      if (mipair .ge. 16) call flushb
+      mbpair = 0
+   95 k = k + 1
+  100 continue
+  200 continue
+      return
+      end
diff --git a/sys/gio/nsppkern/t_nsppkern.x b/sys/gio/nsppkern/t_nsppkern.x
new file mode 100644
index 00000000..69a5ec27
--- /dev/null
+++ b/sys/gio/nsppkern/t_nsppkern.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+
+# NSPPKERN -- Graphics kernel for the NCAR System Plot Package graphics
+# interface.
+
+procedure t_nsppkern()
+
+int	fd, list
+pointer	gki, sp, fname, devname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits
+bool	clgetb()
+int	clpopni(), clgfil(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+	if (clgetb ("generic")) {
+	    debug = NO
+	    verbose = NO
+	    gkiunits = NO
+	} else {
+	    debug   = btoi (clgetb ("debug"))
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	}
+
+	# Open the graphics kernel.
+	call gkt_open (Memc[devname], dev)
+	call gkp_install (deb, STDERR, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF) {
+		if (debug == YES)
+		    call gki_execute (Mems[gki], deb)
+		call gki_execute (Mems[gki], dev)
+	    }
+
+	    call close (fd)
+	}
+
+	call gkp_close()
+	call gkt_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/nsppkern/tran16.f b/sys/gio/nsppkern/tran16.f
new file mode 100644
index 00000000..e0503d57
--- /dev/null
+++ b/sys/gio/nsppkern/tran16.f
@@ -0,0 +1,64 @@
+      subroutine tran16
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c     ray bovet patch to avoid small integers being set to 0
+      integer xx,yy
+c
+      logical         intt
+      equivalence     (zz,mz),(temp,itemp)
+c     ray bovet patch to avoid small integers being set to 0
+c     zz = xx
+      mz = xx
+      if (intt(zz)) go to 102
+      if (mtypex .eq. 0) go to 101
+      if (zz .le. 0.0)
+     1    call uliber (0,35h0negative argument with log scaling,35)
+      zz = amax1(zz,small)
+      mz = 2.0*(xfactr*alog10(zz)+xadd)
+      go to 103
+  101 mz = 2.0*(xfactr*zz+xadd)
+      go to 103
+  102 mz = ishift(mz,mshftx+1)
+  103 mx = max0(0,min0(65535,mz-1))
+c     ray bovet patch to avoid small integers being set to 0
+c     zz = yy
+      mz = yy
+      if (intt(zz)) go to 105
+      if (mtypey .eq. 0) go to 104
+      if (zz .le. 0.0)
+     1    call uliber (0,35h0negative argument with log scaling,35)
+      zz = amax1(zz,small)
+      mz = 2.0*(yfactr*alog10(zz)+yadd)
+      go to 106
+  104 mz = 2.0*(yfactr*zz+yadd)
+      go to 106
+  105 mz =ishift(mz,mshfty+1)
+  106 my = max0(0,min0(65535,mz-1))
+      return
+C
+      entry DTRAN16
+C
+      zz = xx
+      if(intt(zz) .or. (zz .eq. 0.0)) goto 203
+      mz = 2.0 * xfactr * zz
+  203 mx = max0(-127,min0(127,mz))
+      zz = yy
+      if(intt(zz) .or. (zz .eq. 0.0)) goto 206
+      mz = 2.0 * yfactr * zz
+  206 my = max0(-127,min0(127,mz))
+      return
+      end
diff --git a/sys/gio/nsppkern/writeb.x b/sys/gio/nsppkern/writeb.x
new file mode 100644
index 00000000..dfcd82bb
--- /dev/null
+++ b/sys/gio/nsppkern/writeb.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<error.h>
+include	"gkt.h"
+
+.help writeb
+.nf ___________________________________________________________________________
+WRITEB -- Write an NCAR metacode record.  Always write a full record
+regardless of the buffer length; any data beyond buflen is undefined.
+If the buffer length is passed as zero, the metafile standard wants us to
+write a full (zeroed) record and backspace over it, to signify end of
+metafile if the physical metafile is subsequently closed.  Instead of
+writing the EOF record here, we leave that to the FIO close routine
+for the graphics device.
+.endhelp ______________________________________________________________________
+
+procedure writeb (metacode_buffer, buflen, mbunit)
+
+int	metacode_buffer		# LOC pointer to metacode buffer
+int	buflen			# number of words of metacode data
+int	mbunit			# FIO file descriptor !! from nspp common !!
+
+int	dummy[1], offset
+int	loci()
+include "gkt.com"
+
+begin
+	if (buflen <= 0)
+	    return
+
+	# Standard NCAR pointer technique for accessing integer arrays.  This
+	# assumes alignment of integer variables.  Convert to use IRAF
+	# pointers if this causes problems.
+
+	offset = metacode_buffer - loci (dummy) + 1
+
+        iferr (call write (mbunit, dummy[offset], SZ_MFRECORD))
+	    call erract (EA_FATAL)
+end
diff --git a/sys/gio/nsppkern/x_nsppkern.x b/sys/gio/nsppkern/x_nsppkern.x
new file mode 100644
index 00000000..4b54cba2
--- /dev/null
+++ b/sys/gio/nsppkern/x_nsppkern.x
@@ -0,0 +1,3 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	nsppkern = t_nsppkern
diff --git a/sys/gio/nsppkern/zzdebug.x b/sys/gio/nsppkern/zzdebug.x
new file mode 100644
index 00000000..b2ae6144
--- /dev/null
+++ b/sys/gio/nsppkern/zzdebug.x
@@ -0,0 +1,472 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<mach.h>
+include	<fset.h>
+include	<gset.h>
+include	"font.h"
+
+define	XS	0.216
+define	XE	0.719
+define	YS	0.214
+define	YE	0.929
+
+task	grid	= t_grid,
+	grey	= t_grey,
+	text	= t_text, 
+	seefont = t_seefont,
+	txup	= t_txup,
+	font	= t_font,
+	efont	= t_efont
+
+
+# GRID -- Test program for graphics plotting.  A labelled grid is output.
+
+procedure t_grid ()
+
+pointer	gp
+bool	redir
+char	command[SZ_LINE], image[SZ_FNAME], word[SZ_LINE]
+char	output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME]
+int	cmd, input_fd, stat, fd
+
+pointer	gopen()
+bool	streq()
+int	fstati(), open(), getline(), sscan()
+
+begin
+	# If the input has been redirected, input is read from the named
+	# command file.  If not, each image name in the input template is
+	# plotted.
+	
+	if (fstati (STDIN, F_REDIR) == YES) {
+call eprintf ("Input has been redirected\n")
+	    redir = true
+	    cmd = open (STDIN, READ_ONLY, TEXT_FILE)
+	} 
+
+	# Loop over commands until EOF
+	repeat {
+	    if (redir) {
+		if (getline (STDIN, command, SZ_LINE) == EOF)
+		    break
+		stat = sscan (command)
+		    call gargwrd (word, SZ_LINE)
+		if (!streq (word, "plot")) {
+		    # Pixel window has been stored as WCS 2
+		    call gseti (gp, G_WCS, 2)
+		    call gscan (command)
+		    next
+		} else 
+		    call gargwrd (image)
+	    } 
+
+	    call clgstr ("output", output, SZ_FNAME)
+	    if (!streq (output, "")) {
+	        call strcpy (output, output_file, SZ_FNAME)
+	        fd = open (output_file, NEW_FILE, BINARY_FILE)
+	    } else
+		fd = open ("dev$crt", NEW_FILE, BINARY_FILE)
+
+	    call clgstr ("device", device, SZ_FNAME)
+	    gp = gopen (device, NEW_FILE, fd)
+		
+	    call gseti (gp, G_XDRAWGRID, 1)
+	    call gseti (gp, G_YDRAWGRID, 1)
+	    call gseti (gp, G_NMAJOR, 21)
+	    call glabax (gp, "TEST", "NDC_X", "NDC_Y")
+	    call gline (gp, XS, YS, XE, YS)
+	    call gline (gp, XE, YS, XE, YE)
+	    call gline (gp, XE, YE, XS, YE)
+	    call gline (gp, XS, YE, XS, YS)
+	    call gmark (gp, 0.5, 0.5, GM_CROSS, 3.0, 3.0)
+	    call gtext (gp, XS, YS-0.1, "DICOMED crtpict film area")
+	    call gclose  (gp)
+	    call close   (fd)
+	}
+
+	call clpcls (input_fd)
+end
+
+
+# GREY -- test code to generate grey scale on plotters
+
+procedure t_grey()
+
+pointer	gp
+real	size
+int	i, fd, count
+short	celldata[1024]
+char	output[SZ_FNAME], device[SZ_FNAME]
+
+pointer	gopen()
+real	clgetr()
+int	open(), clgeti()
+string	fmt "hj=c;vj=c"
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("output", output, SZ_FNAME)
+
+	fd = open (output, NEW_FILE, BINARY_FILE)
+	gp = gopen (device, NEW_FILE, fd)
+
+	size = clgetr ("size")
+		
+	call gsetr (gp, G_TXSIZE, size)
+	call gtext (gp, .5, .9, "! !\"#$%&'()*+,-./", fmt)
+	call gtext (gp, .5, .8, "1234567890", fmt)
+	call gtext (gp, .5, .7, "ABCDEFGHIJKLMNOPQR", fmt)
+	call gtext (gp, .5, .6, "STUVWXYZ[\\]^_`", fmt)
+	call gtext (gp, .5, .5, "abcdefghijklmnopqr", fmt)
+	call gtext (gp, .5, .4, "stuvwxyz{}|~", fmt)
+
+	call gtext (gp, .5, .1, "Grey Scale Test", fmt)
+
+	count = clgeti ( "count")
+	if (count > 1024)
+	    count = 1024
+	for (i=1;  i <= count;  i=i+1)
+	    celldata[i] = i - 1
+
+	call gpcell (gp, celldata, count, 1, 0.05, 0.2, .95, 0.3)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# TEXT -- Test character drawing.
+
+procedure t_text()
+
+char	device[SZ_FNAME]
+char	output[SZ_FNAME]
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("output", output, SZ_FNAME)
+
+	fd = open (output, NEW_FILE, BINARY_FILE)
+	gp = gopen (device, NEW_FILE, fd)
+
+	call gsetr (gp, G_TXSIZE, 1.0)
+
+	call gtext (gp, .1, .1,
+	    "abcdefghijklmnopqrstuvwxyz", "hj=l,vj=b")
+	call gtext (gp, .1, .2,
+	    "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "hj=l,vj=b")
+	call gtext (gp, .1, .3,
+	    "0123456789", "hj=l,vj=b")
+	call gtext (gp, .1, .4,
+	    " ,./<>?;:'\"\\|[]{}!@#$%^&*()-_=+`~", "hj=l,vj=b")
+
+	call gsetr (gp, G_TXSIZE, 2.0)
+
+	call gtext (gp, .1, .5,
+	    "abcdefghijklmnopqrstuvwxyz", "hj=l,vj=b")
+	call gtext (gp, .1, .6,
+	    "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "hj=l,vj=b")
+	call gtext (gp, .1, .7,
+	    "0123456789", "hj=l,vj=b")
+	call gtext (gp, .1, .8,
+	    " ,./<>?;:'\"\\|[]{}!@#$%^&*()-_=+`~", "hj=l,vj=b")
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# SEEFONT definitions.
+define	L	.40
+define	R	.60
+define	U	.75
+define	D	.25
+define	W	(R-L)
+define	H	(U-D)
+
+
+# SEEFONT -- Draw a character from the font table.
+
+procedure t_seefont()
+
+char	ch
+pointer	gp
+real	x, y
+int	wcs, key
+char	strval[SZ_FNAME]
+
+pointer	gopen()
+int	clgcur()
+
+begin
+	gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+
+	call gline (gp, L, D, R, D)
+	call gline (gp, R, D, R, U)
+	call gline (gp, R, U, L, U)
+	call gline (gp, L, U, L, D)
+
+	ch = 'A'
+	call gdrwch (gp, L, D, ch, W, H)
+
+	while (clgcur ("gcur", x, y, wcs, key, strval, SZ_FNAME) != EOF) {
+	    call gclear (gp)
+
+	    call gline (gp, L, D, R, D)
+	    call gline (gp, R, D, R, U)
+	    call gline (gp, R, U, L, U)
+	    call gline (gp, L, U, L, D)
+
+	    ch = key
+	    call gdrwch (gp, L, D, ch, W, H)
+	}
+
+	call gclose (gp)
+end
+
+
+# GDRWCH -- Draw a character of the given size and orientation at the given
+# position.
+
+procedure gdrwch (gp, x, y, ch, xsize, ysize)
+
+pointer	gp			# graphics descriptor
+real	x, y			# lower left NDC coords of character
+char	ch			# character to be drawn
+real	xsize, ysize		# size of character in NDC units
+
+real	px, py
+int	stroke, tab1, tab2, i, pen
+int	bitupk()
+include	"font.com"
+common	/font/ chridx, chrtab
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	tab1 = chridx[i]
+	tab2 = chridx[i+1] - 1
+
+	do i = tab1, tab2 {
+	    stroke = chrtab[i]
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    px = x + ((px + FONT_LEFT)   / FONT_WIDTH)  * xsize
+	    py = y + ((py + FONT_BOTTOM) / FONT_HEIGHT) * ysize
+
+	    if (pen == 0)
+		call gamove (gp, px, py)
+	    else
+		call gadraw (gp, px, py)
+	}
+end
+
+
+# TXUP -- Draw text strings with various character up vectors and paths.
+
+procedure t_txup()
+
+char	device[SZ_FNAME]
+char	output[SZ_FNAME]
+char	text[SZ_LINE]
+int	fd, open(), clgeti()
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("output", output, SZ_FNAME)
+
+	fd = open (output, NEW_FILE, BINARY_FILE)
+	gp = gopen (device, NEW_FILE, fd)
+
+	call clgstr ("text", text, SZ_LINE)
+
+	call gseti (gp, G_TXHJUSTIFY, clgeti("hjustify"))
+	call gseti (gp, G_TXVJUSTIFY, clgeti("vjustify"))
+
+	call gmark (gp, .1, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .1, .2, text, "up=0,path=right")
+	# --
+	call gmark (gp, .2, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .2, .2, text, "up=45,path=right")
+	# --
+	call gmark (gp, .3, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .3, .2, text, "up=90,path=right")
+	# --
+	call gmark (gp, .4, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .4, .2, text, "up=135,path=right")
+	# --
+	call gmark (gp, .5, .2, GM_CROSS, 3., 3.)
+	call gtext (gp, .5, .2, text, "up=180,path=right")
+
+	call gmark (gp, .1, .4, GM_CROSS, 3., 3.)
+	call gtext (gp, .1, .4, text, "up=90,path=left")
+	# --
+	call gmark (gp, .2, .4, GM_CROSS, 3., 3.)
+	call gtext (gp, .2, .4, text, "up=90,path=right")
+	# --
+	call gmark (gp, .3, .4, GM_CROSS, 3., 3.)
+	call gtext (gp, .3, .4, text, "up=90,path=up")
+	# --
+	call gmark (gp, .4, .4, GM_CROSS, 3., 3.)
+	call gtext (gp, .4, .4, text, "up=90,path=down")
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# FONT -- Test the font change escapes.
+
+procedure t_font()
+
+char	device[SZ_FNAME]
+char	output[SZ_FNAME]
+char	text[SZ_LINE], format[SZ_FNAME]
+int	fd, i, open()
+pointer	gp, gopen()
+
+begin
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("output", output, SZ_FNAME)
+
+	fd = open (output, NEW_FILE, BINARY_FILE)
+	gp = gopen (device, NEW_FILE, fd)
+
+	do i = 2, 8, 2 {
+	    call clgstr ("text", text, SZ_LINE)
+	    call clgstr ("format", format, SZ_FNAME)
+	    call gtext (gp, .2, i / 10.0, text, format)
+	}
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# EFONT -- Font editor.
+
+procedure t_efont()
+
+char	cmd[SZ_LINE]
+real	scale
+int	pen, x, y, nw, w1, w2, ch, fcn
+int	ip, i, tab1, tab2, stroke, junk
+
+int	bitupk(), ctoi(), ctor(), getline()
+short	chridx[96], chrtab[800]
+common	/font/ chridx, chrtab
+define	decode_ 91
+
+begin
+	repeat {
+	    # Get command.
+	    call clgstr ("cmd", cmd, SZ_FNAME)
+	    if (cmd[1] == 'q')
+		break
+
+	    # Decode function and integer arguments (range of words).
+	    # Format "fcn [scale] ch w1 w2".
+
+	    fcn = cmd[1]
+	    ip = 2
+
+	    scale = 0
+	    if (fcn == 'x' || fcn == 'y') 
+		if (ctor (cmd, ip, scale) <= 0)
+		    scale = 1.0
+
+	    while (IS_WHITE(cmd[ip]))
+		ip = ip + 1
+
+	    ch = cmd[ip]
+	    ip = ip + 1
+
+	    if (ctoi (cmd, ip, w1) < 0)
+		w1 = 1
+	    if (ctoi (cmd, ip, w2) < 0)
+		w2 = w1
+
+	    if (ch < CHARACTER_START || ch > CHARACTER_END)
+		next
+	    else
+		i = ch  - CHARACTER_START + 1
+
+	    tab1 = chridx[i]
+	    tab2 = chridx[i+1] - 1
+
+	    nw = tab2 - tab1 + 1
+	    w1 = max(1, min(nw, w1))
+	    w2 = max(1, min(nw, w2))
+
+call eprintf ("fcn=%c [%g], ch=%c, tab1=%d, tab2=%d, nw=%d, w1=%d, w2=%d\n")
+call pargi(fcn); call pargr (scale);
+call pargi(ch); call pargi(tab1); call pargi(tab2)
+call pargi(nw); call pargi(w1); call pargi(w2)
+
+	    # Functions:
+	    #
+	    #	w	write codes
+	    #	r	read and encode
+	    #   x	scale in X
+	    #   y       scale in Y
+
+	    do i = w1-1+tab1, w2-1+tab1 {
+		stroke = chrtab[i]
+		x   = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+		y   = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+		pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+		switch (fcn) {
+		case 'w':
+decode_		    call eprintf ("%2d %6d (%6o) %d %3d %3d\n")
+			call pargi (i - tab1 + 1)
+			call pargi (stroke)
+			call pargi (stroke)
+			call pargi (pen)
+			call pargi (x)
+			call pargi (y)
+		    next
+
+		case 'r':
+		    junk = getline (STDIN, cmd)
+		    ip = 1
+		    junk = ctoi (cmd, ip, pen)
+		    junk = ctoi (cmd, ip, x)
+		    junk = ctoi (cmd, ip, y)
+		    call bitpak (x,   stroke, COORD_X_START,   COORD_X_LEN)
+		    call bitpak (y,   stroke, COORD_Y_START,   COORD_Y_LEN)
+		    call bitpak (pen, stroke, COORD_PEN_START, COORD_PEN_LEN)
+		    chrtab[i] = stroke
+		    goto decode_
+
+		case 'x':
+		    x = x * scale
+		    call bitpak (x,   stroke, COORD_X_START,   COORD_X_LEN)
+		    call bitpak (y,   stroke, COORD_Y_START,   COORD_Y_LEN)
+		    call bitpak (pen, stroke, COORD_PEN_START, COORD_PEN_LEN)
+		    chrtab[i] = stroke
+		    goto decode_
+
+		case 'y':
+		    y = (y - FONT_BASE) * scale + FONT_BASE
+		    call bitpak (x,   stroke, COORD_X_START,   COORD_X_LEN)
+		    call bitpak (y,   stroke, COORD_Y_START,   COORD_Y_LEN)
+		    call bitpak (pen, stroke, COORD_PEN_START, COORD_PEN_LEN)
+		    chrtab[i] = stroke
+		    goto decode_
+
+		default:
+		    call eprintf ("unknown function code\n")
+		}
+	    }
+	}
+end
diff --git a/sys/gio/sgikern/README b/sys/gio/sgikern/README
new file mode 100644
index 00000000..e944a4be
--- /dev/null
+++ b/sys/gio/sgikern/README
@@ -0,0 +1,12 @@
+SGIKERN -
+
+This directory contains the source for the simple GIO kernel, used to write
+a metacode file using only the simplest possible drawing instructions.  This
+makes it relatively easy to implement functional (but probably suboptimal)
+translators for new devices.
+
+Special graphcap entries used by this kernel:
+
+	MF		maximum frame count per metafile
+	FS		frame advance req'd at start of metafile
+	FE		frame advance req'd at end of metafile
diff --git a/sys/gio/sgikern/font.com b/sys/gio/sgikern/font.com
new file mode 100644
index 00000000..c26af8d6
--- /dev/null
+++ b/sys/gio/sgikern/font.com
@@ -0,0 +1,746 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each
+# character is encoded as a series of strokes.  Each stroke is ex-
+# pressed by a single integer containing the following bitfields:
+#
+#       2                   1
+#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
+#                 | | | |         | |         |
+#                 | | | +---------+ +---------+
+#                 | | |      |           |
+#                 | | |      X           Y
+#                 | | |
+#                 | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#----------------------------------------------------------------------------
+
+# Define the database.
+
+short   chridx[97]	# character index in chrtab
+short   chrwid[97]	# character width table
+short   chrtab[3363]	# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP)
+
+data    (chridx(i), i=001,005) /    1,    3,   32,   49,   58/
+data    (chridx(i), i=006,010) /  110,  140,  207,  228,  253/
+data    (chridx(i), i=011,015) /  278,  309,  322,  343,  350/
+data    (chridx(i), i=016,020) /  365,  372,  418,  438,  494/
+data    (chridx(i), i=021,025) /  563,  583,  632,  696,  733/
+data    (chridx(i), i=026,030) /  803,  867,  896,  931,  935/
+data    (chridx(i), i=031,035) /  948,  952,  999, 1052, 1077/
+data    (chridx(i), i=036,040) / 1139, 1174, 1223, 1281, 1330/
+data    (chridx(i), i=041,045) / 1381, 1436, 1463, 1500, 1547/
+data    (chridx(i), i=046,050) / 1583, 1626, 1653, 1703, 1748/
+data    (chridx(i), i=051,055) / 1818, 1881, 1923, 1962, 1997/
+data    (chridx(i), i=056,060) / 2021, 2060, 2097, 2131, 2160/
+data    (chridx(i), i=061,065) / 2169, 2172, 2181, 2190, 2193/
+data    (chridx(i), i=066,070) / 2214, 2263, 2303, 2335, 2378/
+data    (chridx(i), i=071,075) / 2415, 2447, 2527, 2575, 2606/
+data    (chridx(i), i=076,080) / 2640, 2682, 2704, 2778, 2826/
+data    (chridx(i), i=081,085) / 2868, 2916, 2961, 2994, 3033/
+data    (chridx(i), i=086,090) / 3052, 3086, 3108, 3140, 3173/
+data    (chridx(i), i=091,095) / 3204, 3233, 3271, 3274, 3312/
+data    (chridx(i), i=096,096) / 3335/
+
+
+# Width data.
+
+data    (chrwid(i), i=001,005) /   21,   16,   23,   26,   25/
+data    (chrwid(i), i=006,010) /   29,   31,   16,   19,   19/
+data    (chrwid(i), i=011,015) /   21,   30,   16,   30,   16/
+data    (chrwid(i), i=016,020) /   28,   25,   25,   25,   25/
+data    (chrwid(i), i=021,025) /   25,   25,   25,   25,   25/
+data    (chrwid(i), i=026,030) /   25,   16,   16,   29,   30/
+data    (chrwid(i), i=031,035) /   29,   24,   32,   25,   27/
+data    (chrwid(i), i=036,040) /   26,   27,   26,   25,   28/
+data    (chrwid(i), i=041,045) /   29,   17,   21,   27,   23/
+data    (chrwid(i), i=046,050) /   31,   29,   27,   27,   27/
+data    (chrwid(i), i=051,055) /   27,   25,   25,   29,   25/
+data    (chrwid(i), i=056,060) /   29,   25,   27,   25,   19/
+data    (chrwid(i), i=061,065) /   19,   19,   21,   21,   16/
+data    (chrwid(i), i=066,070) /   25,   26,   24,   26,   24/
+data    (chrwid(i), i=071,075) /   19,   24,   28,   17,   18/
+data    (chrwid(i), i=076,080) /   27,   17,   32,   28,   25/
+data    (chrwid(i), i=081,085) /   26,   25,   22,   22,   20/
+data    (chrwid(i), i=086,090) /   28,   23,   29,   25,   24/
+data    (chrwid(i), i=091,095) /   23,   19,   13,   19,   29/
+data    (chrwid(i), i=096,096) /   19/
+
+
+# Stroke data.
+
+data    (chrtab(i), i=0001,0005) /    35,     0,   220,  4251,  4249/
+data    (chrtab(i), i=0006,0010) /  4305,   220,  4302,  4366,   220/
+data    (chrtab(i), i=0011,0015) /  4380,  4366,   284,  4443,  4441/
+data    (chrtab(i), i=0016,0020) /  4369,   202,  4233,  4232,  4295/
+data    (chrtab(i), i=0021,0025) /  4359,  4424,  4425,  4362,  4298/
+data    (chrtab(i), i=0026,0030) /   201,  4296,  4360,  4361,  4297/
+data    (chrtab(i), i=0031,0035) /     0,   220,  4251,  4245,   219/
+data    (chrtab(i), i=0036,0040) /  4245,   220,  4379,  4245,   796/
+data    (chrtab(i), i=0041,0045) /  4827,  4821,   795,  4821,   796/
+data    (chrtab(i), i=0046,0050) /  4955,  4821,     0,   604,  4224/
+data    (chrtab(i), i=0051,0055) /   988,  4608,   145,  5137,    75/
+data    (chrtab(i), i=0056,0060) /  5067,     0,   416,  4483,   672/
+data    (chrtab(i), i=0061,0065) /  4739,   919,  5016,  4952,  4950/
+data    (chrtab(i), i=0066,0070) /  5078,  5080,  5018,  4955,  4764/
+data    (chrtab(i), i=0071,0075) /  4508,  4315,  4185,  4182,  4244/
+data    (chrtab(i), i=0076,0080) /  4434,  4816,  4943,  5005,  5002/
+data    (chrtab(i), i=0081,0085) /  4936,   150,  4308,  4435,  4817/
+data    (chrtab(i), i=0086,0090) /  4944,  5006,   219,  4249,  4247/
+data    (chrtab(i), i=0091,0095) /  4309,  4436,  4818,  5008,  5070/
+data    (chrtab(i), i=0096,0100) /  5067,  5001,  4936,  4743,  4487/
+data    (chrtab(i), i=0101,0105) /  4296,  4233,  4171,  4173,  4301/
+data    (chrtab(i), i=0106,0110) /  4299,  4235,  4236,     0,  1244/
+data    (chrtab(i), i=0111,0115) /  4167,   412,  4634,  4632,  4566/
+data    (chrtab(i), i=0116,0120) /  4437,  4309,  4183,  4185,  4251/
+data    (chrtab(i), i=0121,0125) /  4380,  4508,  4635,  4826,  5018/
+data    (chrtab(i), i=0126,0130) /  5211,  5340,   974,  4941,  4875/
+data    (chrtab(i), i=0131,0135) /  4873,  4999,  5127,  5256,  5322/
+data    (chrtab(i), i=0136,0140) /  5324,  5198,  5070,     0,  1299/
+data    (chrtab(i), i=0141,0145) /  5396,  5332,  5330,  5458,  5460/
+data    (chrtab(i), i=0146,0150) /  5397,  5333,  5268,  5202,  5069/
+data    (chrtab(i), i=0151,0155) /  4938,  4808,  4679,  4423,  4296/
+data    (chrtab(i), i=0156,0160) /  4234,  4237,  4303,  4691,  4821/
+data    (chrtab(i), i=0161,0165) /  4887,  4889,  4827,  4700,  4571/
+data    (chrtab(i), i=0166,0170) /  4505,  4502,  4563,  4688,  4939/
+data    (chrtab(i), i=0171,0175) /  5128,  5255,  5383,  5449,  5450/
+data    (chrtab(i), i=0176,0180) /   264,  4298,  4301,  4367,  4432/
+data    (chrtab(i), i=0181,0185) /   725,  4889,   791,  4827,   475/
+data    (chrtab(i), i=0186,0190) /  4503,   468,  4689,  4940,  5129/
+data    (chrtab(i), i=0191,0195) /  5256,   455,  4424,  4362,  4365/
+data    (chrtab(i), i=0196,0200) /  4431,  4691,   409,  4565,  4753/
+data    (chrtab(i), i=0201,0205) /  5004,  5193,  5320,  5384,  5449/
+data    (chrtab(i), i=0206,0210) /     0,   346,  4377,  4313,  4250/
+data    (chrtab(i), i=0211,0215) /  4251,  4316,  4380,  4443,  4440/
+data    (chrtab(i), i=0216,0220) /  4374,  4245,   219,  4314,  4378/
+data    (chrtab(i), i=0221,0225) /  4379,  4315,   281,  4440,   346/
+data    (chrtab(i), i=0226,0230) /  4374,     0,   544,  4510,  4379/
+data    (chrtab(i), i=0231,0235) /  4247,  4178,  4174,  4233,  4357/
+data    (chrtab(i), i=0236,0240) /  4482,  4608,   282,  4311,  4243/
+data    (chrtab(i), i=0241,0245) /  4237,  4297,  4358,   414,  4444/
+data    (chrtab(i), i=0246,0250) /  4377,  4307,  4301,  4359,  4420/
+data    (chrtab(i), i=0251,0255) /  4482,     0,   160,  4382,  4507/
+data    (chrtab(i), i=0256,0260) /  4631,  4690,  4686,  4617,  4485/
+data    (chrtab(i), i=0261,0265) /  4354,  4224,   410,  4567,  4627/
+data    (chrtab(i), i=0266,0270) /  4621,  4553,  4486,   286,  4444/
+data    (chrtab(i), i=0271,0275) /  4505,  4563,  4557,  4487,  4420/
+data    (chrtab(i), i=0276,0280) /  4354,     0,   412,  4443,  4561/
+data    (chrtab(i), i=0281,0285) /  4496,   412,  4496,   412,  4571/
+data    (chrtab(i), i=0286,0290) /  4433,  4496,    89,  4249,  4755/
+data    (chrtab(i), i=0291,0295) /  4819,    89,  4819,    89,  4184/
+data    (chrtab(i), i=0296,0300) /  4820,  4819,   729,  4761,  4243/
+data    (chrtab(i), i=0301,0305) /  4179,   729,  4179,   729,  4824/
+data    (chrtab(i), i=0306,0310) /  4180,  4179,     0,   665,  4744/
+data    (chrtab(i), i=0311,0315) /  4808,   665,  4825,  4808,   145/
+data    (chrtab(i), i=0316,0320) /  5329,  5328,   145,  4240,  5328/
+data    (chrtab(i), i=0321,0325) /     0,   328,  4359,  4295,  4232/
+data    (chrtab(i), i=0326,0330) /  4233,  4298,  4362,  4425,  4422/
+data    (chrtab(i), i=0331,0335) /  4356,  4227,   201,  4296,  4360/
+data    (chrtab(i), i=0336,0340) /  4361,  4297,   263,  4422,   328/
+data    (chrtab(i), i=0341,0345) /  4356,     0,   145,  5329,  5328/
+data    (chrtab(i), i=0346,0350) /   145,  4240,  5328,     0,   202/
+data    (chrtab(i), i=0351,0355) /  4233,  4232,  4295,  4359,  4424/
+data    (chrtab(i), i=0356,0360) /  4425,  4362,  4298,   201,  4296/
+data    (chrtab(i), i=0361,0365) /  4360,  4361,  4297,     0,  1184/
+data    (chrtab(i), i=0366,0370) /  4096,  4160,  1184,  5344,  4160/
+data    (chrtab(i), i=0371,0375) /     0,   476,  4379,  4248,  4179/
+data    (chrtab(i), i=0376,0380) /  4176,  4235,  4360,  4551,  4679/
+data    (chrtab(i), i=0381,0385) /  4872,  5003,  5072,  5075,  5016/
+data    (chrtab(i), i=0386,0390) /  4891,  4700,  4572,   282,  4312/
+data    (chrtab(i), i=0391,0395) /  4244,  4239,  4299,  4361,   777/
+data    (chrtab(i), i=0396,0400) /  4939,  5007,  5012,  4952,  4890/
+data    (chrtab(i), i=0401,0405) /   476,  4443,  4377,  4308,  4303/
+data    (chrtab(i), i=0406,0410) /  4362,  4424,  4551,   583,  4808/
+data    (chrtab(i), i=0411,0415) /  4874,  4943,  4948,  4889,  4827/
+data    (chrtab(i), i=0416,0420) /  4700,     0,   474,  4551,   538/
+data    (chrtab(i), i=0421,0425) /  4616,   604,  4679,   604,  4505/
+data    (chrtab(i), i=0426,0430) /  4376,   199,  4935,   456,  4423/
+data    (chrtab(i), i=0431,0435) /   457,  4487,   585,  4743,   584/
+data    (chrtab(i), i=0436,0440) /  4807,     0,   152,  4247,  4311/
+data    (chrtab(i), i=0441,0445) /  4312,  4248,   153,  4313,  4376/
+data    (chrtab(i), i=0446,0450) /  4375,  4310,  4246,  4183,  4184/
+data    (chrtab(i), i=0451,0455) /  4250,  4315,  4508,  4764,  4955/
+data    (chrtab(i), i=0456,0460) /  5018,  5080,  5078,  5012,  4818/
+data    (chrtab(i), i=0461,0465) /  4496,  4367,  4237,  4170,  4167/
+data    (chrtab(i), i=0466,0470) /   858,  5016,  5014,  4948,   668/
+data    (chrtab(i), i=0471,0475) /  4891,  4952,  4950,  4884,  4754/
+data    (chrtab(i), i=0476,0480) /  4496,    73,  4234,  4362,  4681/
+data    (chrtab(i), i=0481,0485) /  4937,  5066,   266,  4680,  4936/
+data    (chrtab(i), i=0486,0490) /  5001,   266,  4679,  4935,  5000/
+data    (chrtab(i), i=0491,0495) /  5066,  5068,     0,   152,  4247/
+data    (chrtab(i), i=0496,0500) /  4311,  4312,  4248,   153,  4313/
+data    (chrtab(i), i=0501,0505) /  4376,  4375,  4310,  4246,  4183/
+data    (chrtab(i), i=0506,0510) /  4184,  4250,  4315,  4508,  4764/
+data    (chrtab(i), i=0511,0515) /  4955,  5017,  5014,  4948,  4755/
+data    (chrtab(i), i=0516,0520) /   795,  4953,  4950,  4884,   604/
+data    (chrtab(i), i=0521,0525) /  4827,  4889,  4886,  4820,  4691/
+data    (chrtab(i), i=0526,0530) /   467,  4755,  4882,  5008,  5070/
+data    (chrtab(i), i=0531,0535) /  5067,  5001,  4936,  4743,  4487/
+data    (chrtab(i), i=0536,0540) /  4296,  4233,  4171,  4172,  4237/
+data    (chrtab(i), i=0541,0545) /  4301,  4364,  4363,  4298,  4234/
+data    (chrtab(i), i=0546,0550) /   848,  5006,  5003,  4937,   595/
+data    (chrtab(i), i=0551,0555) /  4818,  4881,  4942,  4939,  4872/
+data    (chrtab(i), i=0556,0560) /  4743,   140,  4235,  4299,  4300/
+data    (chrtab(i), i=0561,0565) /  4236,     0,   601,  4679,   666/
+data    (chrtab(i), i=0566,0570) /  4744,   732,  4807,   732,  4109/
+data    (chrtab(i), i=0571,0575) /  5133,   391,  4999,   584,  4551/
+data    (chrtab(i), i=0576,0580) /   585,  4615,   713,  4871,   712/
+data    (chrtab(i), i=0581,0585) /  4935,     0,   220,  4178,  4308/
+data    (chrtab(i), i=0586,0590) /  4501,  4693,  4884,  5010,  5071/
+data    (chrtab(i), i=0591,0595) /  5069,  5002,  4872,  4679,  4487/
+data    (chrtab(i), i=0596,0600) /  4296,  4233,  4171,  4172,  4237/
+data    (chrtab(i), i=0601,0605) /  4301,  4364,  4363,  4298,  4234/
+data    (chrtab(i), i=0606,0610) /   850,  5008,  5004,  4938,   597/
+data    (chrtab(i), i=0611,0615) /  4820,  4883,  4944,  4940,  4873/
+data    (chrtab(i), i=0616,0620) /  4808,  4679,   140,  4235,  4299/
+data    (chrtab(i), i=0621,0625) /  4300,  4236,   220,  4956,   219/
+data    (chrtab(i), i=0626,0630) /  4827,   218,  4570,  4827,  4956/
+data    (chrtab(i), i=0631,0635) /     0,   793,  4888,  4952,  4953/
+data    (chrtab(i), i=0636,0640) /  4889,   858,  4890,  4825,  4824/
+data    (chrtab(i), i=0641,0645) /  4887,  4951,  5016,  5017,  4955/
+data    (chrtab(i), i=0646,0650) /  4828,  4636,  4443,  4313,  4247/
+data    (chrtab(i), i=0651,0655) /  4179,  4173,  4234,  4360,  4551/
+data    (chrtab(i), i=0656,0660) /  4679,  4872,  5002,  5069,  5070/
+data    (chrtab(i), i=0661,0665) /  5009,  4883,  4692,  4564,  4435/
+data    (chrtab(i), i=0666,0670) /  4370,  4304,   281,  4311,  4243/
+data    (chrtab(i), i=0671,0675) /  4237,  4298,  4361,   842,  5004/
+data    (chrtab(i), i=0676,0680) /  5007,  4945,   540,  4507,  4442/
+data    (chrtab(i), i=0681,0685) /  4376,  4308,  4301,  4362,  4424/
+data    (chrtab(i), i=0686,0690) /  4551,   583,  4808,  4873,  4940/
+data    (chrtab(i), i=0691,0695) /  4943,  4882,  4819,  4692,     0/
+data    (chrtab(i), i=0696,0700) /    92,  4182,   988,  5081,  5014/
+data    (chrtab(i), i=0701,0705) /  4753,  4687,  4619,  4615,   592/
+data    (chrtab(i), i=0706,0710) /  4622,  4555,  4551,   918,  4689/
+data    (chrtab(i), i=0711,0715) /  4558,  4491,  4487,  4615,    88/
+data    (chrtab(i), i=0716,0720) /  4250,  4380,  4508,  4825,  4953/
+data    (chrtab(i), i=0721,0725) /  5018,  5084,   218,  4379,  4507/
+data    (chrtab(i), i=0726,0730) /  4634,    88,  4249,  4378,  4506/
+data    (chrtab(i), i=0731,0735) /  4825,     0,   412,  4315,  4249/
+data    (chrtab(i), i=0736,0740) /  4246,  4308,  4499,  4755,  4948/
+data    (chrtab(i), i=0741,0745) /  5014,  5017,  4955,  4764,  4508/
+data    (chrtab(i), i=0746,0750) /   283,  4313,  4310,  4372,   788/
+data    (chrtab(i), i=0751,0755) /  4950,  4953,  4891,   412,  4443/
+data    (chrtab(i), i=0756,0760) /  4377,  4374,  4436,  4499,   659/
+data    (chrtab(i), i=0761,0765) /  4820,  4886,  4889,  4827,  4764/
+data    (chrtab(i), i=0766,0770) /   403,  4306,  4241,  4175,  4171/
+data    (chrtab(i), i=0771,0775) /  4233,  4296,  4487,  4743,  4936/
+data    (chrtab(i), i=0776,0780) /  5001,  5067,  5071,  5009,  4946/
+data    (chrtab(i), i=0781,0785) /  4755,   209,  4239,  4235,  4297/
+data    (chrtab(i), i=0786,0790) /   841,  5003,  5007,  4945,   403/
+data    (chrtab(i), i=0791,0795) /  4370,  4303,  4299,  4360,  4487/
+data    (chrtab(i), i=0796,0800) /   647,  4872,  4939,  4943,  4882/
+data    (chrtab(i), i=0801,0805) /  4755,     0,   203,  4298,  4362/
+data    (chrtab(i), i=0806,0810) /  4363,  4299,   851,  4881,  4816/
+data    (chrtab(i), i=0811,0815) /  4687,  4559,  4368,  4242,  4181/
+data    (chrtab(i), i=0816,0820) /  4182,  4249,  4379,  4572,  4700/
+data    (chrtab(i), i=0821,0825) /  4891,  5017,  5078,  5072,  5004/
+data    (chrtab(i), i=0826,0830) /  4938,  4808,  4615,  4423,  4296/
+data    (chrtab(i), i=0831,0835) /  4234,  4235,  4300,  4364,  4427/
+data    (chrtab(i), i=0836,0840) /  4426,  4361,  4297,   210,  4244/
+data    (chrtab(i), i=0841,0845) /  4247,  4313,   794,  4953,  5014/
+data    (chrtab(i), i=0846,0850) /  5008,  4940,  4874,   463,  4432/
+data    (chrtab(i), i=0851,0855) /  4369,  4308,  4311,  4378,  4443/
+data    (chrtab(i), i=0856,0860) /  4572,   604,  4827,  4889,  4950/
+data    (chrtab(i), i=0861,0865) /  4943,  4875,  4809,  4744,  4615/
+data    (chrtab(i), i=0866,0870) /     0,   213,  4244,  4243,  4306/
+data    (chrtab(i), i=0871,0875) /  4370,  4435,  4436,  4373,  4309/
+data    (chrtab(i), i=0876,0880) /   212,  4307,  4371,  4372,  4308/
+data    (chrtab(i), i=0881,0885) /   202,  4233,  4232,  4295,  4359/
+data    (chrtab(i), i=0886,0890) /  4424,  4425,  4362,  4298,   201/
+data    (chrtab(i), i=0891,0895) /  4296,  4360,  4361,  4297,     0/
+data    (chrtab(i), i=0896,0900) /   213,  4244,  4243,  4306,  4370/
+data    (chrtab(i), i=0901,0905) /  4435,  4436,  4373,  4309,   212/
+data    (chrtab(i), i=0906,0910) /  4307,  4371,  4372,  4308,   328/
+data    (chrtab(i), i=0911,0915) /  4359,  4295,  4232,  4233,  4298/
+data    (chrtab(i), i=0916,0920) /  4362,  4425,  4422,  4356,  4227/
+data    (chrtab(i), i=0921,0925) /   201,  4296,  4360,  4361,  4297/
+data    (chrtab(i), i=0926,0930) /   263,  4422,   328,  4356,     0/
+data    (chrtab(i), i=0931,0935) /  1177,  4240,  5255,     0,   149/
+data    (chrtab(i), i=0936,0940) /  5333,  5332,   149,  4244,  5332/
+data    (chrtab(i), i=0941,0945) /   141,  5325,  5324,   141,  4236/
+data    (chrtab(i), i=0946,0950) /  5324,     0,   153,  5264,  4231/
+data    (chrtab(i), i=0951,0955) /     0,   151,  4248,  4312,  4310/
+data    (chrtab(i), i=0956,0960) /  4182,  4184,  4250,  4315,  4444/
+data    (chrtab(i), i=0961,0965) /  4700,  4891,  4954,  5016,  5014/
+data    (chrtab(i), i=0966,0970) /  4948,  4883,  4625,   794,  4953/
+data    (chrtab(i), i=0971,0975) /  4949,  4884,   604,  4827,  4889/
+data    (chrtab(i), i=0976,0980) /  4885,  4819,  4754,   465,  4558/
+data    (chrtab(i), i=0981,0985) /  4622,  4625,  4561,   458,  4489/
+data    (chrtab(i), i=0986,0990) /  4488,  4551,  4615,  4680,  4681/
+data    (chrtab(i), i=0991,0995) /  4618,  4554,   457,  4552,  4616/
+data    (chrtab(i), i=0996,1000) /  4617,  4553,     0,  1044,  5078/
+data    (chrtab(i), i=1001,1005) /  4951,  4759,  4630,  4565,  4498/
+data    (chrtab(i), i=1006,1010) /  4495,  4557,  4684,  4876,  5005/
+data    (chrtab(i), i=1011,1015) /  5071,   663,  4629,  4562,  4559/
+data    (chrtab(i), i=1016,1020) /  4621,  4684,  1047,  5071,  5069/
+data    (chrtab(i), i=1021,1025) /  5196,  5324,  5454,  5521,  5523/
+data    (chrtab(i), i=1026,1030) /  5462,  5400,  5274,  5147,  4956/
+data    (chrtab(i), i=1031,1035) /  4764,  4571,  4442,  4312,  4246/
+data    (chrtab(i), i=1036,1040) /  4179,  4176,  4237,  4299,  4425/
+data    (chrtab(i), i=1041,1045) /  4552,  4743,  4935,  5128,  5257/
+data    (chrtab(i), i=1046,1050) /  5322,  1111,  5135,  5133,  5196/
+data    (chrtab(i), i=1051,1055) /     0,   540,  4168,   473,  4935/
+data    (chrtab(i), i=1056,1060) /   537,  4999,   540,  5063,   205/
+data    (chrtab(i), i=1061,1065) /  4877,     7,  4423,   647,  5191/
+data    (chrtab(i), i=1066,1070) /    72,  4103,    72,  4295,   840/
+data    (chrtab(i), i=1071,1075) /  4807,   841,  4871,   905,  5127/
+data    (chrtab(i), i=1076,1080) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=1081,1085) /   348,  4423,    28,  4892,  5083/
+data    (chrtab(i), i=1086,1090) /  5146,  5208,  5206,  5140,  5075/
+data    (chrtab(i), i=1091,1095) /  4882,   986,  5144,  5142,  5076/
+data    (chrtab(i), i=1096,1100) /   796,  5019,  5081,  5077,  5011/
+data    (chrtab(i), i=1101,1105) /  4882,   338,  4882,  5073,  5136/
+data    (chrtab(i), i=1106,1110) /  5198,  5195,  5129,  5064,  4871/
+data    (chrtab(i), i=1111,1115) /  4103,   976,  5134,  5131,  5065/
+data    (chrtab(i), i=1116,1120) /   786,  5009,  5071,  5066,  5000/
+data    (chrtab(i), i=1121,1125) /  4871,    92,  4315,   156,  4314/
+data    (chrtab(i), i=1126,1130) /   412,  4442,   476,  4443,   200/
+data    (chrtab(i), i=1131,1135) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=1136,1140) /   328,  4551,     0,   985,  5148/
+data    (chrtab(i), i=1141,1145) /  5142,  5081,  4955,  4828,  4636/
+data    (chrtab(i), i=1146,1150) /  4443,  4313,  4247,  4180,  4175/
+data    (chrtab(i), i=1151,1155) /  4236,  4298,  4424,  4615,  4807/
+data    (chrtab(i), i=1156,1160) /  4936,  5066,  5132,   281,  4311/
+data    (chrtab(i), i=1161,1165) /  4244,  4239,  4300,  4362,   540/
+data    (chrtab(i), i=1166,1170) /  4507,  4376,  4308,  4303,  4363/
+data    (chrtab(i), i=1171,1175) /  4488,  4615,     0,   220,  4295/
+data    (chrtab(i), i=1176,1180) /   283,  4360,   348,  4423,    28/
+data    (chrtab(i), i=1181,1185) /  4764,  4955,  5081,  5143,  5204/
+data    (chrtab(i), i=1186,1190) /  5199,  5132,  5066,  4936,  4743/
+data    (chrtab(i), i=1191,1195) /  4103,   921,  5079,  5140,  5135/
+data    (chrtab(i), i=1196,1200) /  5068,  5002,   668,  4891,  5016/
+data    (chrtab(i), i=1201,1205) /  5076,  5071,  5003,  4872,  4743/
+data    (chrtab(i), i=1206,1210) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1211,1215) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1216,1220) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1221,1225) /  4551,     0,   220,  4295,   283/
+data    (chrtab(i), i=1226,1230) /  4360,   348,  4423,    28,  5148/
+data    (chrtab(i), i=1231,1235) /  5142,   338,  4818,   726,  4814/
+data    (chrtab(i), i=1236,1240) /     7,  5127,  5133,    92,  4315/
+data    (chrtab(i), i=1241,1245) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1246,1250) /  4443,   732,  5147,   860,  5146/
+data    (chrtab(i), i=1251,1255) /   924,  5145,   988,  5142,   726/
+data    (chrtab(i), i=1256,1260) /  4754,  4814,   724,  4690,  4816/
+data    (chrtab(i), i=1261,1265) /   723,  4562,  4817,   200,  4167/
+data    (chrtab(i), i=1266,1270) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1271,1275) /  4551,   711,  5128,   839,  5129/
+data    (chrtab(i), i=1276,1280) /   903,  5130,   967,  5133,     0/
+data    (chrtab(i), i=1281,1285) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1286,1290) /  4423,    28,  5148,  5142,   338/
+data    (chrtab(i), i=1291,1295) /  4818,   726,  4814,     7,  4615/
+data    (chrtab(i), i=1296,1300) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1301,1305) /  4442,   476,  4443,   732,  5147/
+data    (chrtab(i), i=1306,1310) /   860,  5146,   924,  5145,   988/
+data    (chrtab(i), i=1311,1315) /  5142,   726,  4754,  4814,   724/
+data    (chrtab(i), i=1316,1320) /  4690,  4816,   723,  4562,  4817/
+data    (chrtab(i), i=1321,1325) /   200,  4167,   201,  4231,   329/
+data    (chrtab(i), i=1326,1330) /  4487,   328,  4551,     0,   985/
+data    (chrtab(i), i=1331,1335) /  5148,  5142,  5081,  4955,  4828/
+data    (chrtab(i), i=1336,1340) /  4636,  4443,  4313,  4247,  4180/
+data    (chrtab(i), i=1341,1345) /  4175,  4236,  4298,  4424,  4615/
+data    (chrtab(i), i=1346,1350) /  4807,  4936,  5064,  5127,  5135/
+data    (chrtab(i), i=1351,1355) /   281,  4311,  4244,  4239,  4300/
+data    (chrtab(i), i=1356,1360) /  4362,   540,  4507,  4376,  4308/
+data    (chrtab(i), i=1361,1365) /  4303,  4363,  4488,  4615,   974/
+data    (chrtab(i), i=1366,1370) /  5065,   911,  5001,  4936,   719/
+data    (chrtab(i), i=1371,1375) /  5327,   783,  5006,   847,  5005/
+data    (chrtab(i), i=1376,1380) /  1103,  5133,  1167,  5134,     0/
+data    (chrtab(i), i=1381,1385) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1386,1390) /  4423,   988,  5063,  1051,  5128/
+data    (chrtab(i), i=1391,1395) /  1116,  5191,    28,  4636,   796/
+data    (chrtab(i), i=1396,1400) /  5404,   338,  5074,     7,  4615/
+data    (chrtab(i), i=1401,1405) /   775,  5383,    92,  4315,   156/
+data    (chrtab(i), i=1406,1410) /  4314,   412,  4442,   476,  4443/
+data    (chrtab(i), i=1411,1415) /   860,  5083,   924,  5082,  1180/
+data    (chrtab(i), i=1416,1420) /  5210,  1244,  5211,   200,  4167/
+data    (chrtab(i), i=1421,1425) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1426,1430) /  4551,   968,  4935,   969,  4999/
+data    (chrtab(i), i=1431,1435) /  1097,  5255,  1096,  5319,     0/
+data    (chrtab(i), i=1436,1440) /   220,  4295,   283,  4360,   348/
+data    (chrtab(i), i=1441,1445) /  4423,    28,  4636,     7,  4615/
+data    (chrtab(i), i=1446,1450) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1451,1455) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1456,1460) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1461,1465) /  4551,     0,   476,  4555,  4488/
+data    (chrtab(i), i=1466,1470) /  4423,   539,  4619,  4552,   604/
+data    (chrtab(i), i=1471,1475) /  4683,  4616,  4423,  4295,  4168/
+data    (chrtab(i), i=1476,1480) /  4106,  4108,  4173,  4237,  4300/
+data    (chrtab(i), i=1481,1485) /  4299,  4234,  4170,    76,  4171/
+data    (chrtab(i), i=1486,1490) /  4235,  4236,  4172,   284,  4892/
+data    (chrtab(i), i=1491,1495) /   348,  4571,   412,  4570,   668/
+data    (chrtab(i), i=1496,1500) /  4698,   732,  4699,     0,   220/
+data    (chrtab(i), i=1501,1505) /  4295,   283,  4360,   348,  4423/
+data    (chrtab(i), i=1506,1510) /  1051,  4432,   530,  5063,   594/
+data    (chrtab(i), i=1511,1515) /  5127,   596,  5191,    28,  4636/
+data    (chrtab(i), i=1516,1520) /   860,  5340,     7,  4615,   775/
+data    (chrtab(i), i=1521,1525) /  5319,    92,  4315,   156,  4314/
+data    (chrtab(i), i=1526,1530) /   412,  4442,   476,  4443,   988/
+data    (chrtab(i), i=1531,1535) /  5147,  1180,  5147,   200,  4167/
+data    (chrtab(i), i=1536,1540) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1541,1545) /  4551,   969,  4935,   969,  5255/
+data    (chrtab(i), i=1546,1550) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=1551,1555) /   348,  4423,    28,  4636,     7/
+data    (chrtab(i), i=1556,1560) /  5063,  5069,    92,  4315,   156/
+data    (chrtab(i), i=1561,1565) /  4314,   412,  4442,   476,  4443/
+data    (chrtab(i), i=1566,1570) /   200,  4167,   201,  4231,   329/
+data    (chrtab(i), i=1571,1575) /  4487,   328,  4551,   647,  5064/
+data    (chrtab(i), i=1576,1580) /   775,  5065,   839,  5066,   903/
+data    (chrtab(i), i=1581,1585) /  5069,     0,   220,  4296,   220/
+data    (chrtab(i), i=1586,1590) /  4743,   284,  4746,   348,  4810/
+data    (chrtab(i), i=1591,1595) /  1116,  4743,  1116,  5191,  1179/
+data    (chrtab(i), i=1596,1600) /  5256,  1244,  5319,    28,  4444/
+data    (chrtab(i), i=1601,1605) /  1116,  5532,     7,  4487,   903/
+data    (chrtab(i), i=1606,1610) /  5511,    92,  4315,  1308,  5338/
+data    (chrtab(i), i=1611,1615) /  1372,  5339,   200,  4167,   200/
+data    (chrtab(i), i=1616,1620) /  4423,  1096,  5063,  1097,  5127/
+data    (chrtab(i), i=1621,1625) /  1225,  5383,  1224,  5447,     0/
+data    (chrtab(i), i=1626,1630) /   220,  4296,   220,  5191,   284/
+data    (chrtab(i), i=1631,1635) /  5130,   348,  5194,  1115,  5191/
+data    (chrtab(i), i=1636,1640) /    28,  4444,   924,  5404,     7/
+data    (chrtab(i), i=1641,1645) /  4487,    92,  4315,   988,  5211/
+data    (chrtab(i), i=1646,1650) /  1244,  5211,   200,  4167,   200/
+data    (chrtab(i), i=1651,1655) /  4423,     0,   540,  4443,  4313/
+data    (chrtab(i), i=1656,1660) /  4247,  4179,  4176,  4236,  4298/
+data    (chrtab(i), i=1661,1665) /  4424,  4615,  4743,  4936,  5066/
+data    (chrtab(i), i=1666,1670) /  5132,  5200,  5203,  5143,  5081/
+data    (chrtab(i), i=1671,1675) /  4955,  4764,  4636,   281,  4311/
+data    (chrtab(i), i=1676,1680) /  4244,  4239,  4300,  4362,   906/
+data    (chrtab(i), i=1681,1685) /  5068,  5135,  5140,  5079,  5017/
+data    (chrtab(i), i=1686,1690) /   540,  4507,  4376,  4308,  4303/
+data    (chrtab(i), i=1691,1695) /  4363,  4488,  4615,   647,  4872/
+data    (chrtab(i), i=1696,1700) /  5003,  5071,  5076,  5016,  4891/
+data    (chrtab(i), i=1701,1705) /  4764,     0,   220,  4295,   283/
+data    (chrtab(i), i=1706,1710) /  4360,   348,  4423,    28,  4892/
+data    (chrtab(i), i=1711,1715) /  5083,  5146,  5208,  5205,  5139/
+data    (chrtab(i), i=1716,1720) /  5074,  4881,  4433,   986,  5144/
+data    (chrtab(i), i=1721,1725) /  5141,  5075,   796,  5019,  5081/
+data    (chrtab(i), i=1726,1730) /  5076,  5010,  4881,     7,  4615/
+data    (chrtab(i), i=1731,1735) /    92,  4315,   156,  4314,   412/
+data    (chrtab(i), i=1736,1740) /  4442,   476,  4443,   200,  4167/
+data    (chrtab(i), i=1741,1745) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=1746,1750) /  4551,     0,   540,  4443,  4313/
+data    (chrtab(i), i=1751,1755) /  4247,  4179,  4176,  4236,  4298/
+data    (chrtab(i), i=1756,1760) /  4424,  4615,  4743,  4936,  5066/
+data    (chrtab(i), i=1761,1765) /  5132,  5200,  5203,  5143,  5081/
+data    (chrtab(i), i=1766,1770) /  4955,  4764,  4636,   281,  4311/
+data    (chrtab(i), i=1771,1775) /  4244,  4239,  4300,  4362,   906/
+data    (chrtab(i), i=1776,1780) /  5068,  5135,  5140,  5079,  5017/
+data    (chrtab(i), i=1781,1785) /   540,  4507,  4376,  4308,  4303/
+data    (chrtab(i), i=1786,1790) /  4363,  4488,  4615,   647,  4872/
+data    (chrtab(i), i=1791,1795) /  5003,  5071,  5076,  5016,  4891/
+data    (chrtab(i), i=1796,1800) /  4764,   330,  4492,  4621,  4685/
+data    (chrtab(i), i=1801,1805) /  4812,  4874,  4932,  4994,  5122/
+data    (chrtab(i), i=1806,1810) /  5188,  5190,   838,  4996,  5059/
+data    (chrtab(i), i=1811,1815) /  5123,   778,  4997,  5060,  5124/
+data    (chrtab(i), i=1816,1820) /  5189,     0,   220,  4295,   283/
+data    (chrtab(i), i=1821,1825) /  4360,   348,  4423,    28,  4892/
+data    (chrtab(i), i=1826,1830) /  5083,  5146,  5208,  5206,  5140/
+data    (chrtab(i), i=1831,1835) /  5075,  4882,  4434,   986,  5144/
+data    (chrtab(i), i=1836,1840) /  5142,  5076,   796,  5019,  5081/
+data    (chrtab(i), i=1841,1845) /  5077,  5011,  4882,   594,  4817/
+data    (chrtab(i), i=1846,1850) /  4879,  5001,  5063,  5191,  5257/
+data    (chrtab(i), i=1851,1855) /  5259,   907,  5065,  5128,  5192/
+data    (chrtab(i), i=1856,1860) /   721,  4880,  5066,  5129,  5193/
+data    (chrtab(i), i=1861,1865) /  5258,     7,  4615,    92,  4315/
+data    (chrtab(i), i=1866,1870) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1871,1875) /  4443,   200,  4167,   201,  4231/
+data    (chrtab(i), i=1876,1880) /   329,  4487,   328,  4551,     0/
+data    (chrtab(i), i=1881,1885) /   921,  5084,  5078,  5017,  4891/
+data    (chrtab(i), i=1886,1890) /  4700,  4508,  4315,  4185,  4182/
+data    (chrtab(i), i=1891,1895) /  4244,  4434,  4816,  4943,  5005/
+data    (chrtab(i), i=1896,1900) /  5002,  4936,   150,  4308,  4435/
+data    (chrtab(i), i=1901,1905) /  4817,  4944,  5006,   219,  4249/
+data    (chrtab(i), i=1906,1910) /  4247,  4309,  4436,  4818,  5008/
+data    (chrtab(i), i=1911,1915) /  5070,  5067,  5001,  4936,  4743/
+data    (chrtab(i), i=1916,1920) /  4551,  4360,  4234,  4173,  4167/
+data    (chrtab(i), i=1921,1925) /  4234,     0,    28,  4118,   476/
+data    (chrtab(i), i=1926,1930) /  4551,   539,  4616,   604,  4679/
+data    (chrtab(i), i=1931,1935) /  1052,  5142,    28,  5148,   263/
+data    (chrtab(i), i=1936,1940) /  4871,    92,  4118,   156,  4121/
+data    (chrtab(i), i=1941,1945) /   220,  4122,   348,  4123,   732/
+data    (chrtab(i), i=1946,1950) /  5147,   860,  5146,   924,  5145/
+data    (chrtab(i), i=1951,1955) /   988,  5142,   456,  4423,   457/
+data    (chrtab(i), i=1956,1960) /  4487,   585,  4743,   584,  4807/
+data    (chrtab(i), i=1961,1965) /     0,   220,  4301,  4362,  4488/
+data    (chrtab(i), i=1966,1970) /  4679,  4807,  5000,  5130,  5197/
+data    (chrtab(i), i=1971,1975) /  5211,   283,  4364,  4426,   348/
+data    (chrtab(i), i=1976,1980) /  4428,  4489,  4552,  4679,    28/
+data    (chrtab(i), i=1981,1985) /  4636,   924,  5404,    92,  4315/
+data    (chrtab(i), i=1986,1990) /   156,  4314,   412,  4442,   476/
+data    (chrtab(i), i=1991,1995) /  4443,   988,  5211,  1244,  5211/
+data    (chrtab(i), i=1996,2000) /     0,    92,  4615,   156,  4618/
+data    (chrtab(i), i=2001,2005) /  4615,   220,  4682,   987,  4615/
+data    (chrtab(i), i=2006,2010) /    28,  4508,   732,  5212,    28/
+data    (chrtab(i), i=2011,2015) /  4250,   284,  4314,   348,  4315/
+data    (chrtab(i), i=2016,2020) /   860,  5083,  1052,  5083,     0/
+data    (chrtab(i), i=2021,2025) /   156,  4487,   220,  4492,  4487/
+data    (chrtab(i), i=2026,2030) /   284,  4556,   668,  4556,  4487/
+data    (chrtab(i), i=2031,2035) /   668,  4999,   732,  5004,  4999/
+data    (chrtab(i), i=2036,2040) /   796,  5068,  1179,  5068,  4999/
+data    (chrtab(i), i=2041,2045) /    28,  4572,   668,  4892,   988/
+data    (chrtab(i), i=2046,2050) /  5468,    28,  4315,    92,  4314/
+data    (chrtab(i), i=2051,2055) /   348,  4378,   412,  4379,  1052/
+data    (chrtab(i), i=2056,2060) /  5275,  1308,  5275,     0,    92/
+data    (chrtab(i), i=2061,2065) /  4935,   156,  4999,   220,  5063/
+data    (chrtab(i), i=2066,2070) /   923,  4232,    28,  4508,   732/
+data    (chrtab(i), i=2071,2075) /  5212,     7,  4423,   647,  5191/
+data    (chrtab(i), i=2076,2080) /    28,  4314,   284,  4314,   348/
+data    (chrtab(i), i=2081,2085) /  4315,   796,  5019,  1052,  5019/
+data    (chrtab(i), i=2086,2090) /   136,  4103,   136,  4359,   840/
+data    (chrtab(i), i=2091,2095) /  4807,   841,  4871,   841,  5127/
+data    (chrtab(i), i=2096,2100) /     0,    92,  4625,  4615,   156/
+data    (chrtab(i), i=2101,2105) /  4689,  4680,   220,  4753,  4743/
+data    (chrtab(i), i=2106,2110) /  1051,  4753,    28,  4508,   860/
+data    (chrtab(i), i=2111,2115) /  5340,   327,  4935,    28,  4251/
+data    (chrtab(i), i=2116,2120) /   348,  4315,   924,  5147,  1180/
+data    (chrtab(i), i=2121,2125) /  5147,   520,  4487,   521,  4551/
+data    (chrtab(i), i=2126,2130) /   649,  4807,   648,  4871,     0/
+data    (chrtab(i), i=2131,2135) /   988,  4188,  4182,   860,  4167/
+data    (chrtab(i), i=2136,2140) /   924,  4231,   988,  4295,    71/
+data    (chrtab(i), i=2141,2145) /  5063,  5069,   156,  4182,   220/
+data    (chrtab(i), i=2146,2150) /  4185,   284,  4186,   412,  4187/
+data    (chrtab(i), i=2151,2155) /   647,  5064,   775,  5065,   839/
+data    (chrtab(i), i=2156,2160) /  5066,   903,  5069,     0,   160/
+data    (chrtab(i), i=2161,2165) /  4224,   224,  4288,   160,  4704/
+data    (chrtab(i), i=2166,2170) /   128,  4672,     0,    28,  4868/
+data    (chrtab(i), i=2171,2175) /     0,   480,  4544,   544,  4608/
+data    (chrtab(i), i=2176,2180) /    96,  4640,    64,  4608,     0/
+data    (chrtab(i), i=2181,2185) /   278,  4505,  4630,    83,  4504/
+data    (chrtab(i), i=2186,2190) /  4819,   408,  4487,     0,     5/
+data    (chrtab(i), i=2191,2195) /  4997,     0,   348,  4315,  4249/
+data    (chrtab(i), i=2196,2200) /  4246,  4309,  4373,  4438,  4439/
+data    (chrtab(i), i=2201,2205) /  4376,  4312,  4247,   215,  4310/
+data    (chrtab(i), i=2206,2210) /  4374,  4375,  4311,   219,  4247/
+data    (chrtab(i), i=2211,2215) /   153,  4312,     0,   210,  4307/
+data    (chrtab(i), i=2216,2220) /  4371,  4369,  4241,  4243,  4308/
+data    (chrtab(i), i=2221,2225) /  4437,  4693,  4820,  4883,  4945/
+data    (chrtab(i), i=2226,2230) /  4938,  5000,  5063,   723,  4881/
+data    (chrtab(i), i=2231,2235) /  4874,  4936,   597,  4756,  4818/
+data    (chrtab(i), i=2236,2240) /  4810,  4872,  5063,  5127,   720/
+data    (chrtab(i), i=2241,2245) /  4751,  4430,  4237,  4171,  4170/
+data    (chrtab(i), i=2246,2250) /  4232,  4423,  4615,  4744,  4810/
+data    (chrtab(i), i=2251,2255) /   205,  4235,  4234,  4296,   655/
+data    (chrtab(i), i=2256,2260) /  4494,  4365,  4299,  4298,  4360/
+data    (chrtab(i), i=2261,2265) /  4423,     0,   220,  4295,  4360/
+data    (chrtab(i), i=2266,2270) /  4488,   283,  4361,    28,  4444/
+data    (chrtab(i), i=2271,2275) /  4424,   338,  4500,  4629,  4757/
+data    (chrtab(i), i=2276,2280) /  4948,  5074,  5135,  5133,  5066/
+data    (chrtab(i), i=2281,2285) /  4936,  4743,  4615,  4488,  4426/
+data    (chrtab(i), i=2286,2290) /   914,  5072,  5068,  5002,   661/
+data    (chrtab(i), i=2291,2295) /  4884,  4947,  5008,  5004,  4937/
+data    (chrtab(i), i=2296,2300) /  4872,  4743,    92,  4315,   156/
+data    (chrtab(i), i=2301,2305) /  4314,     0,   849,  4946,  4882/
+data    (chrtab(i), i=2306,2310) /  4880,  5008,  5010,  4884,  4757/
+data    (chrtab(i), i=2311,2315) /  4565,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2316,2320) /  4234,  4360,  4551,  4679,  4872/
+data    (chrtab(i), i=2321,2325) /  5002,   210,  4240,  4236,  4298/
+data    (chrtab(i), i=2326,2330) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2331,2335) /  4361,  4424,  4551,     0,   796/
+data    (chrtab(i), i=2336,2340) /  4871,  5191,   859,  4936,   604/
+data    (chrtab(i), i=2341,2345) /  5020,  4999,   786,  4820,  4693/
+data    (chrtab(i), i=2346,2350) /  4565,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2351,2355) /  4234,  4360,  4551,  4679,  4808/
+data    (chrtab(i), i=2356,2360) /  4874,   210,  4240,  4236,  4298/
+data    (chrtab(i), i=2361,2365) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2366,2370) /  4361,  4424,  4551,   668,  4891/
+data    (chrtab(i), i=2371,2375) /   732,  4890,   905,  5063,   904/
+data    (chrtab(i), i=2376,2380) /  5127,     0,   207,  5007,  5009/
+data    (chrtab(i), i=2381,2385) /  4947,  4884,  4693,  4565,  4372/
+data    (chrtab(i), i=2386,2390) /  4242,  4175,  4173,  4234,  4360/
+data    (chrtab(i), i=2391,2395) /  4551,  4679,  4872,  5002,   848/
+data    (chrtab(i), i=2396,2400) /  4945,  4883,   210,  4240,  4236/
+data    (chrtab(i), i=2401,2405) /  4298,   783,  4882,  4820,  4693/
+data    (chrtab(i), i=2406,2410) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2411,2415) /  4361,  4424,  4551,     0,   666/
+data    (chrtab(i), i=2416,2420) /  4763,  4699,  4697,  4825,  4827/
+data    (chrtab(i), i=2421,2425) /  4764,  4572,  4443,  4378,  4311/
+data    (chrtab(i), i=2426,2430) /  4295,   346,  4375,  4360,   476/
+data    (chrtab(i), i=2431,2435) /  4507,  4441,  4423,    21,  4693/
+data    (chrtab(i), i=2436,2440) /     7,  4615,   200,  4167,   201/
+data    (chrtab(i), i=2441,2445) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2446,2450) /     0,   852,  5011,  5076,  5013/
+data    (chrtab(i), i=2451,2455) /  4949,  4820,  4755,   405,  4372/
+data    (chrtab(i), i=2456,2460) /  4307,  4241,  4239,  4301,  4364/
+data    (chrtab(i), i=2461,2465) /  4491,  4619,  4748,  4813,  4879/
+data    (chrtab(i), i=2466,2470) /  4881,  4819,  4756,  4629,  4501/
+data    (chrtab(i), i=2471,2475) /   275,  4305,  4303,  4365,   653/
+data    (chrtab(i), i=2476,2480) /  4815,  4817,  4755,   405,  4436/
+data    (chrtab(i), i=2481,2485) /  4370,  4366,  4428,  4491,   523/
+data    (chrtab(i), i=2486,2490) /  4684,  4750,  4754,  4692,  4629/
+data    (chrtab(i), i=2491,2495) /   205,  4236,  4170,  4169,  4231/
+data    (chrtab(i), i=2496,2500) /  4294,  4485,  4741,  4932,  4995/
+data    (chrtab(i), i=2501,2505) /   199,  4486,  4742,  4933,    73/
+data    (chrtab(i), i=2506,2510) /  4232,  4423,  4743,  4934,  4996/
+data    (chrtab(i), i=2511,2515) /  4995,  4929,  4736,  4352,  4161/
+data    (chrtab(i), i=2516,2520) /  4099,  4100,  4166,  4359,   256/
+data    (chrtab(i), i=2521,2525) /  4225,  4163,  4164,  4230,  4359/
+data    (chrtab(i), i=2526,2530) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=2531,2535) /    28,  4444,  4423,   337,  4499/
+data    (chrtab(i), i=2536,2540) /  4564,  4693,  4885,  5012,  5075/
+data    (chrtab(i), i=2541,2545) /  5136,  5127,   915,  5072,  5064/
+data    (chrtab(i), i=2546,2550) /   789,  4948,  5009,  4999,     7/
+data    (chrtab(i), i=2551,2555) /  4615,   711,  5319,    92,  4315/
+data    (chrtab(i), i=2556,2560) /   156,  4314,   200,  4167,   201/
+data    (chrtab(i), i=2561,2565) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2566,2570) /   904,  4871,   905,  4935,  1033/
+data    (chrtab(i), i=2571,2575) /  5191,  1032,  5255,     0,   220/
+data    (chrtab(i), i=2576,2580) /  4314,  4442,  4444,  4316,   284/
+data    (chrtab(i), i=2581,2585) /  4378,   219,  4443,   213,  4295/
+data    (chrtab(i), i=2586,2590) /   276,  4360,    21,  4437,  4423/
+data    (chrtab(i), i=2591,2595) /     7,  4615,    85,  4308,   149/
+data    (chrtab(i), i=2596,2600) /  4307,   200,  4167,   201,  4231/
+data    (chrtab(i), i=2601,2605) /   329,  4487,   328,  4551,     0/
+data    (chrtab(i), i=2606,2610) /   348,  4442,  4570,  4572,  4444/
+data    (chrtab(i), i=2611,2615) /   412,  4506,   347,  4571,   341/
+data    (chrtab(i), i=2616,2620) /  4420,  4353,  4288,   404,  4485/
+data    (chrtab(i), i=2621,2625) /  4418,   149,  4565,  4549,  4482/
+data    (chrtab(i), i=2626,2630) /  4417,  4288,  4096,  4097,  4099/
+data    (chrtab(i), i=2631,2635) /  4163,  4161,  4097,  4098,   213/
+data    (chrtab(i), i=2636,2640) /  4436,   277,  4435,     0,   220/
+data    (chrtab(i), i=2641,2645) /  4295,   283,  4360,    28,  4444/
+data    (chrtab(i), i=2646,2650) /  4423,   916,  4427,   591,  5127/
+data    (chrtab(i), i=2651,2655) /   590,  5063,   526,  4999,   725/
+data    (chrtab(i), i=2656,2660) /  5269,     7,  4615,   711,  5255/
+data    (chrtab(i), i=2661,2665) /    92,  4315,   156,  4314,   789/
+data    (chrtab(i), i=2666,2670) /  5012,  1109,  5012,   200,  4167/
+data    (chrtab(i), i=2671,2675) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=2676,2680) /  4551,   905,  4871,   841,  5191/
+data    (chrtab(i), i=2681,2685) /     0,   220,  4295,   283,  4360/
+data    (chrtab(i), i=2686,2690) /    28,  4444,  4423,     7,  4615/
+data    (chrtab(i), i=2691,2695) /    92,  4315,   156,  4314,   200/
+data    (chrtab(i), i=2696,2700) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=2701,2705) /   328,  4551,     0,   213,  4295/
+data    (chrtab(i), i=2706,2710) /   276,  4360,    21,  4437,  4423/
+data    (chrtab(i), i=2711,2715) /   337,  4499,  4564,  4693,  4885/
+data    (chrtab(i), i=2716,2720) /  5012,  5075,  5136,  5127,   915/
+data    (chrtab(i), i=2721,2725) /  5072,  5064,   789,  4948,  5009/
+data    (chrtab(i), i=2726,2730) /  4999,  1041,  5203,  5268,  5397/
+data    (chrtab(i), i=2731,2735) /  5589,  5716,  5779,  5840,  5831/
+data    (chrtab(i), i=2736,2740) /  1619,  5776,  5768,  1493,  5652/
+data    (chrtab(i), i=2741,2745) /  5713,  5703,     7,  4615,   711/
+data    (chrtab(i), i=2746,2750) /  5319,  1415,  6023,    85,  4308/
+data    (chrtab(i), i=2751,2755) /   149,  4307,   200,  4167,   201/
+data    (chrtab(i), i=2756,2760) /  4231,   329,  4487,   328,  4551/
+data    (chrtab(i), i=2761,2765) /   904,  4871,   905,  4935,  1033/
+data    (chrtab(i), i=2766,2770) /  5191,  1032,  5255,  1608,  5575/
+data    (chrtab(i), i=2771,2775) /  1609,  5639,  1737,  5895,  1736/
+data    (chrtab(i), i=2776,2780) /  5959,     0,   213,  4295,   276/
+data    (chrtab(i), i=2781,2785) /  4360,    21,  4437,  4423,   337/
+data    (chrtab(i), i=2786,2790) /  4499,  4564,  4693,  4885,  5012/
+data    (chrtab(i), i=2791,2795) /  5075,  5136,  5127,   915,  5072/
+data    (chrtab(i), i=2796,2800) /  5064,   789,  4948,  5009,  4999/
+data    (chrtab(i), i=2801,2805) /     7,  4615,   711,  5319,    85/
+data    (chrtab(i), i=2806,2810) /  4308,   149,  4307,   200,  4167/
+data    (chrtab(i), i=2811,2815) /   201,  4231,   329,  4487,   328/
+data    (chrtab(i), i=2816,2820) /  4551,   904,  4871,   905,  4935/
+data    (chrtab(i), i=2821,2825) /  1033,  5191,  1032,  5255,     0/
+data    (chrtab(i), i=2826,2830) /   469,  4372,  4242,  4175,  4173/
+data    (chrtab(i), i=2831,2835) /  4234,  4360,  4551,  4679,  4872/
+data    (chrtab(i), i=2836,2840) /  5002,  5069,  5071,  5010,  4884/
+data    (chrtab(i), i=2841,2845) /  4693,  4565,   210,  4240,  4236/
+data    (chrtab(i), i=2846,2850) /  4298,   842,  5004,  5008,  4946/
+data    (chrtab(i), i=2851,2855) /   469,  4436,  4371,  4304,  4300/
+data    (chrtab(i), i=2856,2860) /  4361,  4424,  4551,   583,  4808/
+data    (chrtab(i), i=2861,2865) /  4873,  4940,  4944,  4883,  4820/
+data    (chrtab(i), i=2866,2870) /  4693,     0,   213,  4288,   276/
+data    (chrtab(i), i=2871,2875) /  4353,    21,  4437,  4416,   338/
+data    (chrtab(i), i=2876,2880) /  4500,  4629,  4757,  4948,  5074/
+data    (chrtab(i), i=2881,2885) /  5135,  5133,  5066,  4936,  4743/
+data    (chrtab(i), i=2886,2890) /  4615,  4488,  4426,   914,  5072/
+data    (chrtab(i), i=2891,2895) /  5068,  5002,   661,  4884,  4947/
+data    (chrtab(i), i=2896,2900) /  5008,  5004,  4937,  4872,  4743/
+data    (chrtab(i), i=2901,2905) /     0,  4608,    85,  4308,   149/
+data    (chrtab(i), i=2906,2910) /  4307,   193,  4160,   194,  4224/
+data    (chrtab(i), i=2911,2915) /   322,  4480,   321,  4544,     0/
+data    (chrtab(i), i=2916,2920) /   788,  4864,   851,  4929,   724/
+data    (chrtab(i), i=2921,2925) /  4948,  5013,  4992,   786,  4820/
+data    (chrtab(i), i=2926,2930) /  4693,  4565,  4372,  4242,  4175/
+data    (chrtab(i), i=2931,2935) /  4173,  4234,  4360,  4551,  4679/
+data    (chrtab(i), i=2936,2940) /  4808,  4874,   210,  4240,  4236/
+data    (chrtab(i), i=2941,2945) /  4298,   469,  4436,  4371,  4304/
+data    (chrtab(i), i=2946,2950) /  4300,  4361,  4424,  4551,   576/
+data    (chrtab(i), i=2951,2955) /  5184,   769,  4736,   770,  4800/
+data    (chrtab(i), i=2956,2960) /   898,  5056,   897,  5120,     0/
+data    (chrtab(i), i=2961,2965) /   213,  4295,   276,  4360,    21/
+data    (chrtab(i), i=2966,2970) /  4437,  4423,   787,  4884,  4820/
+data    (chrtab(i), i=2971,2975) /  4818,  4946,  4948,  4885,  4757/
+data    (chrtab(i), i=2976,2980) /  4628,  4498,  4431,     7,  4615/
+data    (chrtab(i), i=2981,2985) /    85,  4308,   149,  4307,   200/
+data    (chrtab(i), i=2986,2990) /  4167,   201,  4231,   329,  4487/
+data    (chrtab(i), i=2991,2995) /   328,  4551,     0,   723,  4885/
+data    (chrtab(i), i=2996,3000) /  4881,  4819,  4756,  4629,  4373/
+data    (chrtab(i), i=3001,3005) /  4244,  4179,  4177,  4239,  4366/
+data    (chrtab(i), i=3006,3010) /  4685,  4812,  4873,   148,  4177/
+data    (chrtab(i), i=3011,3015) /   144,  4367,  4686,  4813,   780/
+data    (chrtab(i), i=3016,3020) /  4808,    83,  4241,  4368,  4687/
+data    (chrtab(i), i=3021,3025) /  4814,  4876,  4873,  4808,  4679/
+data    (chrtab(i), i=3026,3030) /  4423,  4296,  4233,  4171,  4167/
+data    (chrtab(i), i=3031,3035) /  4233,     0,   218,  4300,  4361/
+data    (chrtab(i), i=3036,3040) /  4424,  4551,  4679,  4808,  4874/
+data    (chrtab(i), i=3041,3045) /   282,  4363,  4425,   218,  4444/
+data    (chrtab(i), i=3046,3050) /  4427,  4488,  4551,    21,  4693/
+data    (chrtab(i), i=3051,3055) /     0,   213,  4300,  4361,  4424/
+data    (chrtab(i), i=3056,3060) /  4551,  4743,  4872,  4937,  5003/
+data    (chrtab(i), i=3061,3065) /   276,  4363,  4425,    21,  4437/
+data    (chrtab(i), i=3066,3070) /  4427,  4488,  4551,   917,  4999/
+data    (chrtab(i), i=3071,3075) /  5319,   980,  5064,   725,  5141/
+data    (chrtab(i), i=3076,3080) /  5127,    85,  4308,   149,  4307/
+data    (chrtab(i), i=3081,3085) /  1033,  5191,  1032,  5255,     0/
+data    (chrtab(i), i=3086,3090) /    85,  4551,   149,  4553,   213/
+data    (chrtab(i), i=3091,3095) /  4617,   852,  4617,  4551,    21/
+data    (chrtab(i), i=3096,3100) /  4501,   597,  5077,    21,  4307/
+data    (chrtab(i), i=3101,3105) /   341,  4308,   725,  4948,   917/
+data    (chrtab(i), i=3106,3110) /  4948,     0,   149,  4487,   213/
+data    (chrtab(i), i=3111,3115) /  4490,   277,  4554,   661,  4554/
+data    (chrtab(i), i=3116,3120) /  4487,   661,  4999,   725,  5002/
+data    (chrtab(i), i=3121,3125) /   661,  4885,  5066,  1172,  5066/
+data    (chrtab(i), i=3126,3130) /  4999,    21,  4565,   981,  5461/
+data    (chrtab(i), i=3131,3135) /    21,  4308,   405,  4372,  1045/
+data    (chrtab(i), i=3136,3140) /  5268,  1301,  5268,     0,   149/
+data    (chrtab(i), i=3141,3145) /  4871,   213,  4935,   277,  4999/
+data    (chrtab(i), i=3146,3150) /   852,  4296,    21,  4565,   661/
+data    (chrtab(i), i=3151,3155) /  5141,     7,  4487,   583,  5127/
+data    (chrtab(i), i=3156,3160) /    85,  4308,   405,  4372,   725/
+data    (chrtab(i), i=3161,3165) /  4948,   981,  4948,   200,  4167/
+data    (chrtab(i), i=3166,3170) /   200,  4423,   776,  4743,   840/
+data    (chrtab(i), i=3171,3175) /  5063,     0,   149,  4615,   213/
+data    (chrtab(i), i=3176,3180) /  4617,   277,  4681,   916,  4681/
+data    (chrtab(i), i=3181,3185) /  4483,  4353,  4224,  4096,  4097/
+data    (chrtab(i), i=3186,3190) /  4099,  4163,  4161,  4097,  4098/
+data    (chrtab(i), i=3191,3195) /    21,  4565,   661,  5141,    85/
+data    (chrtab(i), i=3196,3200) /  4371,   405,  4372,   789,  5012/
+data    (chrtab(i), i=3201,3205) /   981,  5012,     0,   725,  4167/
+data    (chrtab(i), i=3206,3210) /   789,  4231,   853,  4295,   853/
+data    (chrtab(i), i=3211,3215) /  4181,  4177,    71,  4935,  4939/
+data    (chrtab(i), i=3216,3220) /   149,  4177,   213,  4178,   277/
+data    (chrtab(i), i=3221,3225) /  4179,   405,  4180,   519,  4936/
+data    (chrtab(i), i=3226,3230) /   647,  4937,   711,  4938,   775/
+data    (chrtab(i), i=3231,3235) /  4939,     0,   480,  4447,  4382/
+data    (chrtab(i), i=3236,3240) /  4316,  4314,  4376,  4439,  4501/
+data    (chrtab(i), i=3241,3245) /  4499,  4369,   351,  4381,  4379/
+data    (chrtab(i), i=3246,3250) /  4441,  4504,  4566,  4564,  4498/
+data    (chrtab(i), i=3251,3255) /  4240,  4494,  4556,  4554,  4488/
+data    (chrtab(i), i=3256,3260) /  4423,  4357,  4355,  4417,   271/
+data    (chrtab(i), i=3261,3265) /  4493,  4491,  4425,  4360,  4294/
+data    (chrtab(i), i=3266,3270) /  4292,  4354,  4417,  4544,     0/
+data    (chrtab(i), i=3271,3275) /   160,  4224,     0,   224,  4447/
+data    (chrtab(i), i=3276,3280) /  4510,  4572,  4570,  4504,  4439/
+data    (chrtab(i), i=3281,3285) /  4373,  4371,  4497,   351,  4509/
+data    (chrtab(i), i=3286,3290) /  4507,  4441,  4376,  4310,  4308/
+data    (chrtab(i), i=3291,3295) /  4370,  4624,  4366,  4300,  4298/
+data    (chrtab(i), i=3296,3300) /  4360,  4423,  4485,  4483,  4417/
+data    (chrtab(i), i=3301,3305) /   399,  4365,  4363,  4425,  4488/
+data    (chrtab(i), i=3306,3310) /  4550,  4548,  4482,  4417,  4288/
+data    (chrtab(i), i=3311,3315) /     0,    77,  4175,  4242,  4371/
+data    (chrtab(i), i=3316,3320) /  4499,  4626,  4879,  5006,  5134/
+data    (chrtab(i), i=3321,3325) /  5263,  5329,    79,  4241,  4370/
+data    (chrtab(i), i=3326,3330) /  4498,  4625,  4878,  5005,  5133/
+data    (chrtab(i), i=3331,3335) /  5262,  5329,  5331,     0,   284/
+data    (chrtab(i), i=3336,3340) /  4251,  4185,  4183,  4245,  4372/
+data    (chrtab(i), i=3341,3345) /  4500,  4629,  4695,  4697,  4635/
+data    (chrtab(i), i=3346,3350) /  4508,  4380,   284,  4185,  4245/
+data    (chrtab(i), i=3351,3355) /  4500,  4695,  4635,  4380,   412/
+data    (chrtab(i), i=3356,3360) /  4251,  4183,  4372,  4629,  4697/
+data    (chrtab(i), i=3361,3362) /  4508,     0/
diff --git a/sys/gio/sgikern/font.h b/sys/gio/sgikern/font.h
new file mode 100644
index 00000000..eb2e72f4
--- /dev/null
+++ b/sys/gio/sgikern/font.h
@@ -0,0 +1,29 @@
+# FONT.H -- Font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/sgikern/greek.com b/sys/gio/sgikern/greek.com
new file mode 100644
index 00000000..cb9fffdc
--- /dev/null
+++ b/sys/gio/sgikern/greek.com
@@ -0,0 +1,501 @@
+# GCHTAB -- Table of strokes for the printable GREEK characters.  Each
+# character is encoded as a series of strokes.  Each stroke is ex-
+# pressed by a single integer containing the following bitfields:
+#
+#       2                   1
+#       0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1
+#                 | | | |         | |         |
+#                 | | | +---------+ +---------+
+#                 | | |      |           |
+#                 | | |      X           Y
+#                 | | |
+#                 | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#----------------------------------------------------------------------------
+
+# Define the database.
+
+short   gchidx[97]	# character index in gchtab
+short   gchwid[97]	# character width table
+short   gchtab[2140]	# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP)
+
+data    (gchidx(i), i=001,005) /    1,    3,   16,   29,   38/
+data    (gchidx(i), i=006,010) /   77,  107,  154,  162,  181/
+data    (gchidx(i), i=011,015) /  200,  205,  212,  233,  240/
+data    (gchidx(i), i=016,020) /  246,  259,  297,  306,  348/
+data    (gchidx(i), i=021,025) /  392,  402,  437,  483,  510/
+data    (gchidx(i), i=026,030) /  568,  614,  645,  658,  666/
+data    (gchidx(i), i=031,035) /  673,  681,  688,  741,  767/
+data    (gchidx(i), i=036,040) /  793,  795,  806,  821,  863/
+data    (gchidx(i), i=041,045) /  874,  883,  888,  899,  901/
+data    (gchidx(i), i=046,050) /  912,  921,  930,  972,  987/
+data    (gchidx(i), i=051,055) / 1037, 1067, 1083, 1088, 1117/
+data    (gchidx(i), i=056,060) / 1143, 1182, 1207, 1242, 1244/
+data    (gchidx(i), i=061,065) / 1253, 1256, 1265, 1267, 1276/
+data    (gchidx(i), i=066,070) / 1284, 1321, 1373, 1394, 1436/
+data    (gchidx(i), i=071,075) / 1465, 1500, 1525, 1554, 1568/
+data    (gchidx(i), i=076,080) / 1610, 1635, 1655, 1679, 1699/
+data    (gchidx(i), i=081,085) / 1729, 1746, 1788, 1817, 1849/
+data    (gchidx(i), i=086,090) / 1862, 1891, 1893, 1934, 1975/
+data    (gchidx(i), i=091,095) / 2006, 2036, 2074, 2079, 2117/
+data    (gchidx(i), i=096,096) / 2126/
+
+
+# Width data.
+
+data    (gchwid(i), i=001,005) /   21,   15,   15,   26,   25/
+data    (gchwid(i), i=006,010) /   29,   30,   15,   19,   19/
+data    (gchwid(i), i=011,015) /   27,   29,   30,   29,   15/
+data    (gchwid(i), i=016,020) /   31,   25,   25,   25,   25/
+data    (gchwid(i), i=021,025) /   25,   25,   25,   25,   25/
+data    (gchwid(i), i=026,030) /   25,   29,   15,   29,   31/
+data    (gchwid(i), i=031,035) /   29,   31,   32,   25,   30/
+data    (gchwid(i), i=036,040) /   21,   25,   29,   26,   23/
+data    (gchwid(i), i=041,045) /   26,   19,   25,   21,   25/
+data    (gchwid(i), i=046,050) /   21,   21,   27,   29,   27/
+data    (gchwid(i), i=051,055) /   29,   26,   19,   24,   25/
+data    (gchwid(i), i=056,060) /   27,   27,   28,   21,   19/
+data    (gchwid(i), i=061,065) /   19,   19,   21,   31,   27/
+data    (gchwid(i), i=066,070) /   28,   26,   23,   24,   23/
+data    (gchwid(i), i=071,075) /   27,   25,   27,   17,   24/
+data    (gchwid(i), i=076,080) /   25,   25,   28,   25,   23/
+data    (gchwid(i), i=081,085) /   27,   28,   24,   26,   25/
+data    (gchwid(i), i=086,090) /   25,   21,   28,   22,   28/
+data    (gchwid(i), i=091,095) /   23,   19,   19,   19,   31/
+data    (gchwid(i), i=096,096) /   19/
+
+
+# Stroke data.
+
+data    (gchtab(i), i=0001,0005) /    35,     0,   220,  4250,  4302/
+data    (gchtab(i), i=0006,0010) /  4378,  4316,   218,  4308,   201/
+data    (gchtab(i), i=0011,0015) /  4232,  4295,  4360,  4297,     0/
+data    (gchtab(i), i=0016,0020) /   213,  4244,  4307,  4372,  4309/
+data    (gchtab(i), i=0021,0025) /   199,  4232,  4297,  4360,  4358/
+data    (gchtab(i), i=0026,0030) /  4292,  4227,     0,   604,  4224/
+data    (gchtab(i), i=0031,0035) /   988,  4608,   145,  5137,    75/
+data    (gchtab(i), i=0036,0040) /  5067,     0,   416,  4483,   672/
+data    (gchtab(i), i=0041,0045) /  4739,   921,  4952,  5015,  5080/
+data    (gchtab(i), i=0046,0050) /  5081,  4955,  4764,  4508,  4315/
+data    (gchtab(i), i=0051,0055) /  4185,  4183,  4245,  4308,  4435/
+data    (gchtab(i), i=0056,0060) /  4817,  4944,  5070,    87,  4309/
+data    (gchtab(i), i=0061,0065) /  4436,  4818,  4945,  5008,  5070/
+data    (gchtab(i), i=0066,0070) /  5066,  4936,  4743,  4487,  4296/
+data    (gchtab(i), i=0071,0075) /  4170,  4171,  4236,  4299,  4234/
+data    (gchtab(i), i=0076,0080) /     0,  1244,  4167,   412,  4634/
+data    (gchtab(i), i=0081,0085) /  4632,  4566,  4437,  4309,  4183/
+data    (gchtab(i), i=0086,0090) /  4185,  4251,  4380,  4508,  4635/
+data    (gchtab(i), i=0091,0095) /  4826,  5018,  5211,  5340,   974/
+data    (gchtab(i), i=0096,0100) /  4941,  4875,  4873,  4999,  5127/
+data    (gchtab(i), i=0101,0105) /  5256,  5322,  5324,  5198,  5070/
+data    (gchtab(i), i=0106,0110) /     0,  1236,  5267,  5330,  5395/
+data    (gchtab(i), i=0111,0115) /  5396,  5333,  5269,  5204,  5138/
+data    (gchtab(i), i=0116,0120) /  5005,  4874,  4744,  4615,  4423/
+data    (gchtab(i), i=0121,0125) /  4232,  4170,  4173,  4239,  4627/
+data    (gchtab(i), i=0126,0130) /  4757,  4823,  4825,  4763,  4636/
+data    (gchtab(i), i=0131,0135) /  4507,  4441,  4439,  4500,  4625/
+data    (gchtab(i), i=0136,0140) /  4938,  5064,  5255,  5319,  5384/
+data    (gchtab(i), i=0141,0145) /  5385,   327,  4296,  4234,  4237/
+data    (gchtab(i), i=0146,0150) /  4303,  4433,   343,  4501,  5002/
+data    (gchtab(i), i=0151,0155) /  5128,  5255,     0,   218,  4251/
+data    (gchtab(i), i=0156,0160) /  4316,  4379,  4377,  4311,  4246/
+data    (gchtab(i), i=0161,0165) /     0,   608,  4574,  4443,  4311/
+data    (gchtab(i), i=0166,0170) /  4242,  4238,  4297,  4421,  4546/
+data    (gchtab(i), i=0171,0175) /  4672,   478,  4442,  4375,  4306/
+data    (gchtab(i), i=0176,0180) /  4302,  4361,  4422,  4546,     0/
+data    (gchtab(i), i=0181,0185) /    96,  4318,  4443,  4567,  4626/
+data    (gchtab(i), i=0186,0190) /  4622,  4553,  4421,  4290,  4160/
+data    (gchtab(i), i=0191,0195) /   222,  4442,  4503,  4562,  4558/
+data    (gchtab(i), i=0196,0200) /  4489,  4422,  4290,     0,   151/
+data    (gchtab(i), i=0201,0205) /  5129,  1047,  4233,     0,   664/
+data    (gchtab(i), i=0206,0210) /  4743,   144,  5264,   135,  5255/
+data    (gchtab(i), i=0211,0215) /     0,  1227,  5195,  5068,  4942/
+data    (gchtab(i), i=0216,0220) /  4754,  4691,  4564,  4436,  4307/
+data    (gchtab(i), i=0221,0225) /  4241,  4239,  4301,  4428,  4556/
+data    (gchtab(i), i=0226,0230) /  4685,  4750,  4946,  5076,  5205/
+data    (gchtab(i), i=0231,0235) /  5333,     0,   664,  4743,   152/
+data    (gchtab(i), i=0236,0240) /  5272,   144,  5264,     0,   201/
+data    (gchtab(i), i=0241,0245) /  4232,  4295,  4360,  4297,     0/
+data    (gchtab(i), i=0246,0250) /   729,  4760,  4823,  4888,  4825/
+data    (gchtab(i), i=0251,0255) /   144,  5392,   713,  4744,  4807/
+data    (gchtab(i), i=0256,0260) /  4872,  4809,     0,   476,  4379/
+data    (gchtab(i), i=0261,0265) /  4248,  4179,  4176,  4235,  4360/
+data    (gchtab(i), i=0266,0270) /  4551,  4679,  4872,  5003,  5072/
+data    (gchtab(i), i=0271,0275) /  5075,  5016,  4891,  4700,  4572/
+data    (gchtab(i), i=0276,0280) /   476,  4443,  4378,  4312,  4243/
+data    (gchtab(i), i=0281,0285) /  4240,  4299,  4361,  4424,  4551/
+data    (gchtab(i), i=0286,0290) /   583,  4808,  4873,  4939,  5008/
+data    (gchtab(i), i=0291,0295) /  5011,  4952,  4890,  4827,  4700/
+data    (gchtab(i), i=0296,0300) /     0,   280,  4505,  4700,  4679/
+data    (gchtab(i), i=0301,0305) /   539,  4615,   263,  4935,     0/
+data    (gchtab(i), i=0306,0310) /   152,  4311,  4246,  4183,  4184/
+data    (gchtab(i), i=0311,0315) /  4250,  4315,  4508,  4764,  4955/
+data    (gchtab(i), i=0316,0320) /  5018,  5080,  5078,  5012,  4818/
+data    (gchtab(i), i=0321,0325) /  4496,  4367,  4237,  4170,  4167/
+data    (gchtab(i), i=0326,0330) /   668,  4891,  4954,  5016,  5014/
+data    (gchtab(i), i=0331,0335) /  4948,  4754,  4496,    73,  4234/
+data    (gchtab(i), i=0336,0340) /  4362,  4680,  4872,  5001,  5066/
+data    (gchtab(i), i=0341,0345) /   266,  4679,  4935,  5000,  5066/
+data    (gchtab(i), i=0346,0350) /  5068,     0,   152,  4311,  4246/
+data    (gchtab(i), i=0351,0355) /  4183,  4184,  4250,  4315,  4508/
+data    (gchtab(i), i=0356,0360) /  4764,  4955,  5017,  5014,  4948/
+data    (gchtab(i), i=0361,0365) /  4755,  4563,   668,  4891,  4953/
+data    (gchtab(i), i=0366,0370) /  4950,  4884,  4755,   659,  4882/
+data    (gchtab(i), i=0371,0375) /  5008,  5070,  5067,  5001,  4936/
+data    (gchtab(i), i=0376,0380) /  4743,  4487,  4296,  4233,  4171/
+data    (gchtab(i), i=0381,0385) /  4172,  4237,  4300,  4235,   849/
+data    (gchtab(i), i=0386,0390) /  5006,  5003,  4937,  4872,  4743/
+data    (gchtab(i), i=0391,0395) /     0,   666,  4743,   732,  4807/
+data    (gchtab(i), i=0396,0400) /   732,  4109,  5133,   455,  4999/
+data    (gchtab(i), i=0401,0405) /     0,   220,  4178,    82,  4308/
+data    (gchtab(i), i=0406,0410) /  4501,  4693,  4884,  5010,  5071/
+data    (gchtab(i), i=0411,0415) /  5069,  5002,  4872,  4679,  4487/
+data    (gchtab(i), i=0416,0420) /  4296,  4233,  4171,  4172,  4237/
+data    (gchtab(i), i=0421,0425) /  4300,  4235,   597,  4820,  4946/
+data    (gchtab(i), i=0426,0430) /  5007,  5005,  4938,  4808,  4679/
+data    (gchtab(i), i=0431,0435) /   220,  4956,   219,  4635,  4956/
+data    (gchtab(i), i=0436,0440) /     0,   857,  4888,  4951,  5016/
+data    (gchtab(i), i=0441,0445) /  5017,  4955,  4828,  4636,  4443/
+data    (gchtab(i), i=0446,0450) /  4313,  4247,  4179,  4173,  4234/
+data    (gchtab(i), i=0451,0455) /  4360,  4551,  4679,  4872,  5002/
+data    (gchtab(i), i=0456,0460) /  5069,  5070,  5009,  4883,  4692/
+data    (gchtab(i), i=0461,0465) /  4628,  4435,  4305,  4238,   540/
+data    (gchtab(i), i=0466,0470) /  4507,  4377,  4311,  4243,  4237/
+data    (gchtab(i), i=0471,0475) /  4298,  4424,  4551,   583,  4808/
+data    (gchtab(i), i=0476,0480) /  4938,  5005,  5006,  4945,  4819/
+data    (gchtab(i), i=0481,0485) /  4692,     0,    92,  4182,    88/
+data    (gchtab(i), i=0486,0490) /  4250,  4380,  4508,  4825,  4953/
+data    (gchtab(i), i=0491,0495) /  5018,  5084,   154,  4379,  4507/
+data    (gchtab(i), i=0496,0500) /  4825,   988,  5081,  5014,  4753/
+data    (gchtab(i), i=0501,0505) /  4687,  4620,  4615,   918,  4689/
+data    (gchtab(i), i=0506,0510) /  4623,  4556,  4551,     0,   412/
+data    (gchtab(i), i=0511,0515) /  4315,  4249,  4246,  4308,  4499/
+data    (gchtab(i), i=0516,0520) /  4755,  4948,  5014,  5017,  4955/
+data    (gchtab(i), i=0521,0525) /  4764,  4508,   412,  4379,  4313/
+data    (gchtab(i), i=0526,0530) /  4310,  4372,  4499,   659,  4884/
+data    (gchtab(i), i=0531,0535) /  4950,  4953,  4891,  4764,   403/
+data    (gchtab(i), i=0536,0540) /  4306,  4241,  4175,  4171,  4233/
+data    (gchtab(i), i=0541,0545) /  4296,  4487,  4743,  4936,  5001/
+data    (gchtab(i), i=0546,0550) /  5067,  5071,  5009,  4946,  4755/
+data    (gchtab(i), i=0551,0555) /   403,  4370,  4305,  4239,  4235/
+data    (gchtab(i), i=0556,0560) /  4297,  4360,  4487,   647,  4872/
+data    (gchtab(i), i=0561,0565) /  4937,  5003,  5007,  4945,  4882/
+data    (gchtab(i), i=0566,0570) /  4755,     0,   917,  4946,  4816/
+data    (gchtab(i), i=0571,0575) /  4623,  4559,  4368,  4242,  4181/
+data    (gchtab(i), i=0576,0580) /  4182,  4249,  4379,  4572,  4700/
+data    (gchtab(i), i=0581,0585) /  4891,  5017,  5078,  5072,  5004/
+data    (gchtab(i), i=0586,0590) /  4938,  4808,  4615,  4423,  4296/
+data    (gchtab(i), i=0591,0595) /  4234,  4235,  4300,  4363,  4298/
+data    (gchtab(i), i=0596,0600) /   463,  4432,  4306,  4245,  4246/
+data    (gchtab(i), i=0601,0605) /  4313,  4443,  4572,   604,  4827/
+data    (gchtab(i), i=0606,0610) /  4953,  5014,  5008,  4940,  4874/
+data    (gchtab(i), i=0611,0615) /  4744,  4615,     0,  1247,  5278/
+data    (gchtab(i), i=0616,0620) /  5341,  5406,  5407,  5344,  5216/
+data    (gchtab(i), i=0621,0625) /  5087,  4957,  4891,  4824,  4756/
+data    (gchtab(i), i=0626,0630) /  4616,  4548,  4482,   926,  4956/
+data    (gchtab(i), i=0631,0635) /  4888,  4748,  4680,  4613,  4547/
+data    (gchtab(i), i=0636,0640) /  4417,  4288,  4160,  4097,  4098/
+data    (gchtab(i), i=0641,0645) /  4163,  4226,  4161,     0,   213/
+data    (gchtab(i), i=0646,0650) /  4244,  4307,  4372,  4309,   199/
+data    (gchtab(i), i=0651,0655) /  4232,  4297,  4360,  4358,  4292/
+data    (gchtab(i), i=0656,0660) /  4227,     0,  1180,  4245,  5262/
+data    (gchtab(i), i=0661,0665) /   140,  5260,   135,  5255,     0/
+data    (gchtab(i), i=0666,0670) /   149,  5397,   144,  5392,   139/
+data    (gchtab(i), i=0671,0675) /  5387,     0,   156,  5269,  4238/
+data    (gchtab(i), i=0676,0680) /   140,  5260,   135,  5255,     0/
+data    (gchtab(i), i=0681,0685) /  1177,  4359,   147,  5395,   141/
+data    (gchtab(i), i=0686,0690) /  5389,     0,  1044,  5078,  4951/
+data    (gchtab(i), i=0691,0695) /  4759,  4630,  4565,  4498,  4495/
+data    (gchtab(i), i=0696,0700) /  4557,  4684,  4876,  5005,  5071/
+data    (gchtab(i), i=0701,0705) /   663,  4629,  4562,  4559,  4621/
+data    (gchtab(i), i=0706,0710) /  4684,  1047,  5071,  5069,  5196/
+data    (gchtab(i), i=0711,0715) /  5324,  5454,  5521,  5523,  5462/
+data    (gchtab(i), i=0716,0720) /  5400,  5274,  5147,  4956,  4764/
+data    (gchtab(i), i=0721,0725) /  4571,  4442,  4312,  4246,  4179/
+data    (gchtab(i), i=0726,0730) /  4176,  4237,  4299,  4425,  4552/
+data    (gchtab(i), i=0731,0735) /  4743,  4935,  5128,  5257,  5322/
+data    (gchtab(i), i=0736,0740) /  1111,  5135,  5133,  5196,     0/
+data    (gchtab(i), i=0741,0745) /   473,  4167,   601,  5063,   537/
+data    (gchtab(i), i=0746,0750) /  4999,   205,  4877,     7,  4423/
+data    (gchtab(i), i=0751,0755) /   711,  5191,   480,  4447,  4381/
+data    (gchtab(i), i=0756,0760) /  4379,  4441,  4568,  4696,  4825/
+data    (gchtab(i), i=0761,0765) /  4891,  4893,  4831,  4704,  4576/
+data    (gchtab(i), i=0766,0770) /     0,  1295,  5325,  5196,  5068/
+data    (gchtab(i), i=0771,0775) /  4941,  4878,  4690,  4627,  4500/
+data    (gchtab(i), i=0776,0780) /  4372,  4243,  4177,  4175,  4237/
+data    (gchtab(i), i=0781,0785) /  4364,  4492,  4621,  4686,  4882/
+data    (gchtab(i), i=0786,0790) /  4947,  5076,  5204,  5331,  5393/
+data    (gchtab(i), i=0791,0795) /  5391,     0,    35,     0,   540/
+data    (gchtab(i), i=0796,0800) /  4103,   540,  5127,   537,  5063/
+data    (gchtab(i), i=0801,0805) /    72,  5064,     7,  5127,     0/
+data    (gchtab(i), i=0806,0810) /  1176,  4824,  4567,  4438,  4308/
+data    (gchtab(i), i=0811,0815) /  4241,  4239,  4300,  4426,  4553/
+data    (gchtab(i), i=0816,0820) /  4808,  5256,   144,  5008,     0/
+data    (gchtab(i), i=0821,0825) /   540,  4615,   604,  4679,   407/
+data    (gchtab(i), i=0826,0830) /  4310,  4245,  4179,  4176,  4238/
+data    (gchtab(i), i=0831,0835) /  4301,  4492,  4812,  5005,  5070/
+data    (gchtab(i), i=0836,0840) /  5136,  5139,  5077,  5014,  4823/
+data    (gchtab(i), i=0841,0845) /  4503,   407,  4374,  4309,  4243/
+data    (gchtab(i), i=0846,0850) /  4240,  4302,  4365,  4492,   716/
+data    (gchtab(i), i=0851,0855) /  4941,  5006,  5072,  5075,  5013/
+data    (gchtab(i), i=0856,0860) /  4950,  4823,   348,  4892,   327/
+data    (gchtab(i), i=0861,0865) /  4871,     0,   220,  4295,   284/
+data    (gchtab(i), i=0866,0870) /  4359,    28,  5084,  5078,  5020/
+data    (gchtab(i), i=0871,0875) /     7,  4551,     0,   608,  4224/
+data    (gchtab(i), i=0876,0880) /   992,  4608,   147,  5139,    77/
+data    (gchtab(i), i=0881,0885) /  5069,     0,   160,  4224,   544/
+data    (gchtab(i), i=0886,0890) /  4608,     0,    28,  4615,    92/
+data    (gchtab(i), i=0891,0895) /  4617,  1052,  4615,    28,  5148/
+data    (gchtab(i), i=0896,0900) /    91,  5083,     0,    35,     0/
+data    (gchtab(i), i=0901,0905) /   540,  4167,   540,  5063,   537/
+data    (gchtab(i), i=0906,0910) /  4999,     7,  4423,   711,  5191/
+data    (gchtab(i), i=0911,0915) /     0,   278,  4505,  4630,    83/
+data    (gchtab(i), i=0916,0920) /  4504,  4819,   408,  4487,     0/
+data    (gchtab(i), i=0921,0925) /   266,  4487,  4618,    77,  4488/
+data    (gchtab(i), i=0926,0930) /  4813,   409,  4488,     0,   540/
+data    (gchtab(i), i=0931,0935) /  4443,  4313,  4247,  4179,  4176/
+data    (gchtab(i), i=0936,0940) /  4236,  4298,  4424,  4615,  4743/
+data    (gchtab(i), i=0941,0945) /  4936,  5066,  5132,  5200,  5203/
+data    (gchtab(i), i=0946,0950) /  5143,  5081,  4955,  4764,  4636/
+data    (gchtab(i), i=0951,0955) /   540,  4507,  4377,  4311,  4243/
+data    (gchtab(i), i=0956,0960) /  4240,  4300,  4362,  4488,  4615/
+data    (gchtab(i), i=0961,0965) /   647,  4872,  5002,  5068,  5136/
+data    (gchtab(i), i=0966,0970) /  5139,  5079,  5017,  4891,  4764/
+data    (gchtab(i), i=0971,0975) /     0,   220,  4295,   284,  4359/
+data    (gchtab(i), i=0976,0980) /  1052,  5127,  1116,  5191,    28/
+data    (gchtab(i), i=0981,0985) /  5404,     7,  4551,   839,  5383/
+data    (gchtab(i), i=0986,0990) /     0,   540,  4443,  4313,  4247/
+data    (gchtab(i), i=0991,0995) /  4179,  4176,  4236,  4298,  4424/
+data    (gchtab(i), i=0996,1000) /  4615,  4743,  4936,  5066,  5132/
+data    (gchtab(i), i=1001,1005) /  5200,  5203,  5143,  5081,  4955/
+data    (gchtab(i), i=1006,1010) /  4764,  4636,   540,  4507,  4377/
+data    (gchtab(i), i=1011,1015) /  4311,  4243,  4240,  4300,  4362/
+data    (gchtab(i), i=1016,1020) /  4488,  4615,   647,  4872,  5002/
+data    (gchtab(i), i=1021,1025) /  5068,  5136,  5139,  5079,  5017/
+data    (gchtab(i), i=1026,1030) /  4891,  4764,   405,  4494,   789/
+data    (gchtab(i), i=1031,1035) /  4878,   402,  4882,   401,  4881/
+data    (gchtab(i), i=1036,1040) /     0,  1244,  4167,   412,  4634/
+data    (gchtab(i), i=1041,1045) /  4632,  4566,  4437,  4309,  4183/
+data    (gchtab(i), i=1046,1050) /  4185,  4251,  4380,  4508,  4635/
+data    (gchtab(i), i=1051,1055) /  4826,  5018,  5211,  5340,   974/
+data    (gchtab(i), i=1056,1060) /  4941,  4875,  4873,  4999,  5127/
+data    (gchtab(i), i=1061,1065) /  5256,  5322,  5324,  5198,  5070/
+data    (gchtab(i), i=1066,1070) /     0,    92,  4626,  4103,    28/
+data    (gchtab(i), i=1071,1075) /  4562,    28,  5084,  5142,  5020/
+data    (gchtab(i), i=1076,1080) /    72,  5000,     7,  5063,  5133/
+data    (gchtab(i), i=1081,1085) /  4999,     0,   160,  4224,   544/
+data    (gchtab(i), i=1086,1090) /  4608,     0,    23,  4121,  4187/
+data    (gchtab(i), i=1091,1095) /  4252,  4380,  4443,  4505,  4565/
+data    (gchtab(i), i=1096,1100) /  4551,    25,  4251,  4379,  4505/
+data    (gchtab(i), i=1101,1105) /   983,  5081,  5019,  4956,  4828/
+data    (gchtab(i), i=1106,1110) /  4763,  4697,  4629,  4615,   985/
+data    (gchtab(i), i=1111,1115) /  4955,  4827,  4697,   263,  4807/
+data    (gchtab(i), i=1116,1120) /     0,   473,  4167,   601,  5063/
+data    (gchtab(i), i=1121,1125) /   537,  4999,   205,  4877,     7/
+data    (gchtab(i), i=1126,1130) /  4423,   711,  5191,   480,  4447/
+data    (gchtab(i), i=1131,1135) /  4381,  4379,  4441,  4568,  4696/
+data    (gchtab(i), i=1136,1140) /  4825,  4891,  4893,  4831,  4704/
+data    (gchtab(i), i=1141,1145) /  4576,     0,    74,  4231,  4487/
+data    (gchtab(i), i=1146,1150) /  4363,  4239,  4178,  4182,  4249/
+data    (gchtab(i), i=1151,1155) /  4379,  4572,  4828,  5019,  5145/
+data    (gchtab(i), i=1156,1160) /  5206,  5202,  5135,  5003,  4871/
+data    (gchtab(i), i=1161,1165) /  5127,  5194,   267,  4302,  4242/
+data    (gchtab(i), i=1166,1170) /  4246,  4313,  4443,  4572,   732/
+data    (gchtab(i), i=1171,1175) /  4955,  5081,  5142,  5138,  5070/
+data    (gchtab(i), i=1176,1180) /  5003,   136,  4424,   840,  5128/
+data    (gchtab(i), i=1181,1185) /     0,   157,  4184,  1117,  5144/
+data    (gchtab(i), i=1186,1190) /   404,  4431,   852,  4879,   139/
+data    (gchtab(i), i=1191,1195) /  4166,  1099,  5126,   155,  5147/
+data    (gchtab(i), i=1196,1200) /   154,  5146,   402,  4882,   401/
+data    (gchtab(i), i=1201,1205) /  4881,   137,  5129,   136,  5128/
+data    (gchtab(i), i=1206,1210) /     0,   604,  4679,   668,  4743/
+data    (gchtab(i), i=1211,1215) /    21,  4182,  4309,  4369,  4431/
+data    (gchtab(i), i=1216,1220) /  4494,  4621,    86,  4245,  4305/
+data    (gchtab(i), i=1221,1225) /  4367,  4430,  4621,  4813,  5006/
+data    (gchtab(i), i=1226,1230) /  5071,  5137,  5205,  5270,   717/
+data    (gchtab(i), i=1231,1235) /  4942,  5007,  5073,  5141,  5270/
+data    (gchtab(i), i=1236,1240) /  5333,   412,  4956,   391,  4935/
+data    (gchtab(i), i=1241,1245) /     0,    35,     0,   160,  4224/
+data    (gchtab(i), i=1246,1250) /   224,  4288,   160,  4704,   128/
+data    (gchtab(i), i=1251,1255) /  4672,     0,    28,  4868,     0/
+data    (gchtab(i), i=1256,1260) /   480,  4544,   544,  4608,    96/
+data    (gchtab(i), i=1261,1265) /  4640,    64,  4608,     0,    35/
+data    (gchtab(i), i=1266,1270) /     0,  1106,  5392,  5198,   917/
+data    (gchtab(i), i=1271,1275) /  5328,  5003,   144,  5328,     0/
+data    (gchtab(i), i=1276,1280) /    85,  4437,  4809,   277,  4807/
+data    (gchtab(i), i=1281,1285) /  1312,  4807,     0,   533,  4436/
+data    (gchtab(i), i=1286,1290) /  4306,  4240,  4173,  4170,  4232/
+data    (gchtab(i), i=1291,1295) /  4423,  4551,  4680,  4875,  5006/
+data    (gchtab(i), i=1296,1300) /  5138,  5205,   533,  4500,  4370/
+data    (gchtab(i), i=1301,1305) /  4304,  4237,  4234,  4296,  4423/
+data    (gchtab(i), i=1306,1310) /   533,  4757,  4884,  4946,  5066/
+data    (gchtab(i), i=1311,1315) /  5128,  5191,   661,  4820,  4882/
+data    (gchtab(i), i=1316,1320) /  5002,  5064,  5191,  5255,     0/
+data    (gchtab(i), i=1321,1325) /   732,  4635,  4505,  4373,  4306/
+data    (gchtab(i), i=1326,1330) /  4238,  4168,  4096,   732,  4699/
+data    (gchtab(i), i=1331,1335) /  4569,  4437,  4370,  4302,  4232/
+data    (gchtab(i), i=1336,1340) /  4160,   732,  4956,  5083,  5146/
+data    (gchtab(i), i=1341,1345) /  5143,  5077,  5012,  4819,  4563/
+data    (gchtab(i), i=1346,1350) /   860,  5082,  5079,  5013,  4948/
+data    (gchtab(i), i=1351,1355) /  4819,   467,  4818,  4944,  5006/
+data    (gchtab(i), i=1356,1360) /  5003,  4937,  4872,  4679,  4551/
+data    (gchtab(i), i=1361,1365) /  4424,  4361,  4300,   467,  4754/
+data    (gchtab(i), i=1366,1370) /  4880,  4942,  4939,  4873,  4808/
+data    (gchtab(i), i=1371,1375) /  4679,     0,    21,  4245,  4372/
+data    (gchtab(i), i=1376,1380) /  4434,  4739,  4801,  4864,   149/
+data    (gchtab(i), i=1381,1385) /  4308,  4370,  4675,  4737,  4864/
+data    (gchtab(i), i=1386,1390) /  4992,   981,  5011,  4880,  4229/
+data    (gchtab(i), i=1391,1395) /  4098,  4096,     0,   724,  4693/
+data    (gchtab(i), i=1396,1400) /  4565,  4372,  4241,  4174,  4171/
+data    (gchtab(i), i=1401,1405) /  4233,  4296,  4423,  4551,  4744/
+data    (gchtab(i), i=1406,1410) /  4875,  4942,  4945,  4883,  4632/
+data    (gchtab(i), i=1411,1415) /  4570,  4572,  4637,  4765,  4892/
+data    (gchtab(i), i=1416,1420) /  5018,   469,  4436,  4305,  4238/
+data    (gchtab(i), i=1421,1425) /  4234,  4296,   455,  4680,  4811/
+data    (gchtab(i), i=1426,1430) /  4878,  4882,  4820,  4695,  4633/
+data    (gchtab(i), i=1431,1435) /  4635,  4700,  4828,  5018,     0/
+data    (gchtab(i), i=1436,1440) /   850,  4820,  4693,  4437,  4308/
+data    (gchtab(i), i=1441,1445) /  4306,  4432,  4623,   341,  4372/
+data    (gchtab(i), i=1446,1450) /  4370,  4496,  4623,   527,  4302/
+data    (gchtab(i), i=1451,1455) /  4172,  4170,  4232,  4423,  4615/
+data    (gchtab(i), i=1456,1460) /  4744,  4874,   527,  4366,  4236/
+data    (gchtab(i), i=1461,1465) /  4234,  4296,  4423,     0,   404/
+data    (gchtab(i), i=1466,1470) /  4371,  4241,  4174,  4171,  4233/
+data    (gchtab(i), i=1471,1475) /  4296,  4423,  4615,  4808,  5002/
+data    (gchtab(i), i=1476,1480) /  5133,  5200,  5203,  5077,  4949/
+data    (gchtab(i), i=1481,1485) /  4819,  4687,  4554,  4352,    75/
+data    (gchtab(i), i=1486,1490) /  4297,  4424,  4616,  4809,  5003/
+data    (gchtab(i), i=1491,1495) /  5133,  1107,  5076,  4948,  4818/
+data    (gchtab(i), i=1496,1500) /  4687,  4553,  4416,     0,    18/
+data    (gchtab(i), i=1501,1505) /  4180,  4309,  4437,  4564,  4627/
+data    (gchtab(i), i=1506,1510) /  4688,  4684,  4616,  4416,    19/
+data    (gchtab(i), i=1511,1515) /  4244,  4500,  4627,  1045,  5074/
+data    (gchtab(i), i=1516,1520) /  5008,  4681,  4484,  4352,   981/
+data    (gchtab(i), i=1521,1525) /  5010,  4944,  4681,     0,    17/
+data    (gchtab(i), i=1526,1530) /  4115,  4245,  4437,  4500,  4498/
+data    (gchtab(i), i=1531,1535) /  4430,  4295,   277,  4436,  4434/
+data    (gchtab(i), i=1536,1540) /  4366,  4231,   334,  4562,  4692/
+data    (gchtab(i), i=1541,1545) /  4821,  4949,  5076,  5139,  5136/
+data    (gchtab(i), i=1546,1550) /  5067,  4864,   853,  5075,  5072/
+data    (gchtab(i), i=1551,1555) /  5003,  4800,     0,   277,  4238/
+data    (gchtab(i), i=1556,1560) /  4170,  4168,  4231,  4423,  4553/
+data    (gchtab(i), i=1561,1565) /  4619,   341,  4302,  4234,  4232/
+data    (gchtab(i), i=1566,1570) /  4295,     0,   848,  4883,  4820/
+data    (gchtab(i), i=1571,1575) /  4693,  4565,  4372,  4241,  4174/
+data    (gchtab(i), i=1576,1580) /  4171,  4233,  4296,  4423,  4551/
+data    (gchtab(i), i=1581,1585) /  4744,  4874,  4941,  5010,  5015/
+data    (gchtab(i), i=1586,1590) /  4954,  4891,  4764,  4572,  4443/
+data    (gchtab(i), i=1591,1595) /  4378,  4377,  4441,  4442,   469/
+data    (gchtab(i), i=1596,1600) /  4436,  4305,  4238,  4234,  4296/
+data    (gchtab(i), i=1601,1605) /   455,  4680,  4810,  4877,  4946/
+data    (gchtab(i), i=1606,1610) /  4951,  4890,  4764,     0,   277/
+data    (gchtab(i), i=1611,1615) /  4103,   341,  4167,   917,  5076/
+data    (gchtab(i), i=1616,1620) /  5140,  5077,  4949,  4820,  4560/
+data    (gchtab(i), i=1621,1625) /  4431,  4303,   335,  4558,  4680/
+data    (gchtab(i), i=1626,1630) /  4743,   335,  4494,  4616,  4679/
+data    (gchtab(i), i=1631,1635) /  4807,  4936,  5067,     0,    92/
+data    (gchtab(i), i=1636,1640) /  4316,  4443,  4506,  4568,  4938/
+data    (gchtab(i), i=1641,1645) /  5000,  5063,   220,  4442,  4504/
+data    (gchtab(i), i=1646,1650) /  4874,  4936,  5063,  5127,   533/
+data    (gchtab(i), i=1651,1655) /  4103,   533,  4167,     0,   341/
+data    (gchtab(i), i=1656,1660) /  4096,   405,  4096,   338,  4364/
+data    (gchtab(i), i=1661,1665) /  4361,  4487,  4615,  4744,  4874/
+data    (gchtab(i), i=1666,1670) /  5005,  1045,  4938,  4936,  4999/
+data    (gchtab(i), i=1671,1675) /  5191,  5321,  5387,  1109,  5002/
+data    (gchtab(i), i=1676,1680) /  5000,  5063,     0,   277,  4231/
+data    (gchtab(i), i=1681,1685) /   341,  4367,  4298,  4231,   981/
+data    (gchtab(i), i=1686,1690) /  5009,  4877,  1045,  5074,  5008/
+data    (gchtab(i), i=1691,1695) /  4877,  4747,  4553,  4424,  4231/
+data    (gchtab(i), i=1696,1700) /    85,  4437,     0,   469,  4372/
+data    (gchtab(i), i=1701,1705) /  4241,  4174,  4171,  4233,  4296/
+data    (gchtab(i), i=1706,1710) /  4423,  4551,  4744,  4875,  4942/
+data    (gchtab(i), i=1711,1715) /  4945,  4883,  4820,  4693,  4565/
+data    (gchtab(i), i=1716,1720) /   469,  4436,  4305,  4238,  4234/
+data    (gchtab(i), i=1721,1725) /  4296,   455,  4680,  4811,  4878/
+data    (gchtab(i), i=1726,1730) /  4882,  4820,     0,   468,  4295/
+data    (gchtab(i), i=1731,1735) /   468,  4359,   852,  4935,   852/
+data    (gchtab(i), i=1736,1740) /  4999,    18,  4244,  4437,  5269/
+data    (gchtab(i), i=1741,1745) /    18,  4243,  4436,  5268,     0/
+data    (gchtab(i), i=1746,1750) /    17,  4115,  4245,  4437,  4500/
+data    (gchtab(i), i=1751,1755) /  4498,  4429,  4426,  4488,  4551/
+data    (gchtab(i), i=1756,1760) /   277,  4436,  4434,  4365,  4362/
+data    (gchtab(i), i=1761,1765) /  4424,  4551,  4679,  4808,  4938/
+data    (gchtab(i), i=1766,1770) /  5069,  5136,  5205,  5209,  5147/
+data    (gchtab(i), i=1771,1775) /  5020,  4892,  4762,  4760,  4821/
+data    (gchtab(i), i=1776,1780) /  4946,  5072,  5262,   712,  4939/
+data    (gchtab(i), i=1781,1785) /  5005,  5072,  5141,  5145,  5083/
+data    (gchtab(i), i=1786,1790) /  5020,     0,   140,  4297,  4360/
+data    (gchtab(i), i=1791,1795) /  4487,  4615,  4808,  4939,  5006/
+data    (gchtab(i), i=1796,1800) /  5009,  4947,  4884,  4757,  4629/
+data    (gchtab(i), i=1801,1805) /  4436,  4305,  4238,  4096,   519/
+data    (gchtab(i), i=1806,1810) /  4744,  4875,  4942,  4946,  4884/
+data    (gchtab(i), i=1811,1815) /   533,  4500,  4369,  4302,  4096/
+data    (gchtab(i), i=1816,1820) /     0,  1109,  4565,  4372,  4241/
+data    (gchtab(i), i=1821,1825) /  4174,  4171,  4233,  4296,  4423/
+data    (gchtab(i), i=1826,1830) /  4551,  4744,  4875,  4942,  4945/
+data    (gchtab(i), i=1831,1835) /  4883,  4820,  4693,   469,  4436/
+data    (gchtab(i), i=1836,1840) /  4305,  4238,  4234,  4296,   455/
+data    (gchtab(i), i=1841,1845) /  4680,  4811,  4878,  4882,  4820/
+data    (gchtab(i), i=1846,1850) /   724,  5204,     0,   596,  4487/
+data    (gchtab(i), i=1851,1855) /   596,  4551,    18,  4244,  4437/
+data    (gchtab(i), i=1856,1860) /  5141,    18,  4243,  4436,  5140/
+data    (gchtab(i), i=1861,1865) /     0,    17,  4115,  4245,  4437/
+data    (gchtab(i), i=1866,1870) /  4500,  4498,  4364,  4361,  4487/
+data    (gchtab(i), i=1871,1875) /   277,  4436,  4434,  4300,  4297/
+data    (gchtab(i), i=1876,1880) /  4360,  4487,  4551,  4744,  4874/
+data    (gchtab(i), i=1881,1885) /  5005,  5072,  5075,  5013,  4948/
+data    (gchtab(i), i=1886,1890) /  5011,  5072,   909,  5075,     0/
+data    (gchtab(i), i=1891,1895) /    35,     0,   145,  4371,  4564/
+data    (gchtab(i), i=1896,1900) /  4501,  4372,  4241,  4174,  4171/
+data    (gchtab(i), i=1901,1905) /  4232,  4295,  4423,  4552,  4683/
+data    (gchtab(i), i=1906,1910) /  4750,    75,  4233,  4296,  4424/
+data    (gchtab(i), i=1911,1915) /  4553,  4683,   590,  4683,  4744/
+data    (gchtab(i), i=1916,1920) /  4807,  4935,  5064,  5195,  5262/
+data    (gchtab(i), i=1921,1925) /  5265,  5204,  5141,  5076,  5203/
+data    (gchtab(i), i=1926,1930) /  5265,   587,  4745,  4808,  4936/
+data    (gchtab(i), i=1931,1935) /  5065,  5195,     0,   604,  4571/
+data    (gchtab(i), i=1936,1940) /  4506,  4505,  4568,  4759,  4951/
+data    (gchtab(i), i=1941,1945) /   663,  4502,  4373,  4307,  4305/
+data    (gchtab(i), i=1946,1950) /  4431,  4622,  4814,   663,  4566/
+data    (gchtab(i), i=1951,1955) /  4437,  4371,  4369,  4495,  4622/
+data    (gchtab(i), i=1956,1960) /   526,  4365,  4236,  4170,  4168/
+data    (gchtab(i), i=1961,1965) /  4294,  4612,  4675,  4673,  4544/
+data    (gchtab(i), i=1966,1970) /  4416,   526,  4429,  4300,  4234/
+data    (gchtab(i), i=1971,1975) /  4232,  4358,  4612,     0,   860/
+data    (gchtab(i), i=1976,1980) /  4544,   924,  4480,    17,  4115/
+data    (gchtab(i), i=1981,1985) /  4245,  4437,  4500,  4498,  4429/
+data    (gchtab(i), i=1986,1990) /  4426,  4552,  4744,  4873,  5068/
+data    (gchtab(i), i=1991,1995) /  5199,   277,  4436,  4434,  4365/
+data    (gchtab(i), i=1996,2000) /  4362,  4424,  4551,  4743,  4872/
+data    (gchtab(i), i=2001,2005) /  5002,  5133,  5199,  5333,     0/
+data    (gchtab(i), i=2006,2010) /   604,  4571,  4506,  4505,  4568/
+data    (gchtab(i), i=2011,2015) /  4759,  5079,  5080,  4887,  4629/
+data    (gchtab(i), i=2016,2020) /  4435,  4240,  4173,  4171,  4233/
+data    (gchtab(i), i=2021,2025) /  4423,  4613,  4675,  4673,  4608/
+data    (gchtab(i), i=2026,2030) /  4480,  4417,   662,  4499,  4304/
+data    (gchtab(i), i=2031,2035) /  4237,  4235,  4297,  4423,     0/
+data    (gchtab(i), i=2036,2040) /   480,  4447,  4382,  4316,  4314/
+data    (gchtab(i), i=2041,2045) /  4376,  4439,  4501,  4499,  4369/
+data    (gchtab(i), i=2046,2050) /   351,  4381,  4379,  4441,  4504/
+data    (gchtab(i), i=2051,2055) /  4566,  4564,  4498,  4240,  4494/
+data    (gchtab(i), i=2056,2060) /  4556,  4554,  4488,  4423,  4357/
+data    (gchtab(i), i=2061,2065) /  4355,  4417,   271,  4493,  4491/
+data    (gchtab(i), i=2066,2070) /  4425,  4360,  4294,  4292,  4354/
+data    (gchtab(i), i=2071,2075) /  4417,  4544,     0,   160,  4224/
+data    (gchtab(i), i=2076,2080) /   544,  4608,     0,   224,  4447/
+data    (gchtab(i), i=2081,2085) /  4510,  4572,  4570,  4504,  4439/
+data    (gchtab(i), i=2086,2090) /  4373,  4371,  4497,   351,  4509/
+data    (gchtab(i), i=2091,2095) /  4507,  4441,  4376,  4310,  4308/
+data    (gchtab(i), i=2096,2100) /  4370,  4624,  4366,  4300,  4298/
+data    (gchtab(i), i=2101,2105) /  4360,  4423,  4485,  4483,  4417/
+data    (gchtab(i), i=2106,2110) /   399,  4365,  4363,  4425,  4488/
+data    (gchtab(i), i=2111,2115) /  4550,  4548,  4482,  4417,  4288/
+data    (gchtab(i), i=2116,2120) /     0,   338,  4240,  4430,   533/
+data    (gchtab(i), i=2121,2125) /  4304,  4619,   208,  5392,     0/
+data    (gchtab(i), i=2126,2130) /   284,  4251,  4185,  4183,  4245/
+data    (gchtab(i), i=2131,2135) /  4372,  4500,  4629,  4695,  4697/
+data    (gchtab(i), i=2136,2139) /  4635,  4508,  4380,     0/
diff --git a/sys/gio/sgikern/ltype.dat b/sys/gio/sgikern/ltype.dat
new file mode 100644
index 00000000..a5509e21
--- /dev/null
+++ b/sys/gio/sgikern/ltype.dat
@@ -0,0 +1,28 @@
+# LTYPE.DAT -- Initialize the builtin line types for the SGI kernel.  Data
+# is given in GKI units (1.0 = 32768 units).  A segment of 32 GKI units is
+# resolved on a device with 1024 resolved pixels.
+
+data	p_seg		/1, 1, 1/
+data	p_segleft	/320, 32, 512/
+
+data	p_nseg[1]	/2/		# PL_DASHED
+data	p_penup[1,1]	/false/
+data	p_penup[1,2]	/true/
+data	p_seglen[1,1]	/320/
+data	p_seglen[1,2]	/128/
+
+data	p_nseg[2]	/2/		# PL_DOTTED
+data	p_penup[2,1]	/false/
+data	p_penup[2,2]	/true/
+data	p_seglen[2,1]	/32/
+data	p_seglen[2,2]	/128/
+
+data	p_nseg[3]	/4/		# PL_DOTDASH
+data	p_penup[3,1]	/false/
+data	p_penup[3,2]	/true/
+data	p_penup[3,3]	/false/
+data	p_penup[3,4]	/true/
+data	p_seglen[3,1]	/512/
+data	p_seglen[3,2]	/128/
+data	p_seglen[3,3]	/32/
+data	p_seglen[3,4]	/128/
diff --git a/sys/gio/sgikern/mkpkg b/sys/gio/sgikern/mkpkg
new file mode 100644
index 00000000..3dd9e943
--- /dev/null
+++ b/sys/gio/sgikern/mkpkg
@@ -0,0 +1,53 @@
+# Make the GIO/SGIKERN simple graphics kernel.
+
+$checkout libsgi.a lib$
+$update   libsgi.a
+$checkin  libsgi.a lib$
+$call     relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:	
+	$omake  x_sgikern.x
+	$link	x_sgikern.o -lsgi
+	;
+
+install:				# install in system library
+	$move	x_sgikern.e bin$
+	;
+
+libsgi.a:
+	sgicancel.x	sgi.com sgi.h
+	sgiclear.x	sgi.com sgi.h <mach.h>
+	sgiclose.x	sgi.com sgi.h
+	sgiclws.x	sgi.h sgi.com
+	sgicolor.x	sgi.com sgi.h
+	sgidrawch.x	font.com font.h greek.com sgi.com sgi.h \
+			<gki.h> <gset.h> <math.h>
+	sgiescape.x	
+	sgifa.x		sgi.com sgi.h
+	sgifaset.x	sgi.com sgi.h <gki.h>
+	sgiflush.x	sgi.com sgi.h
+	sgifont.x	sgi.com sgi.h <gki.h> <gset.h>
+	sgigcell.x	
+	sgiinit.x	sgi.com sgi.h <ctype.h> <gki.h> <mach.h>
+	sgiline.x	sgi.com sgi.h <gset.h>
+	sgiopen.x	sgi.com sgi.h <gki.h>
+	sgiopenws.x	sgi.com sgi.h <error.h> <gki.h> <mach.h>
+	sgipcell.x	sgi.com sgi.h <gki.h>
+	sgipl.x		ltype.dat sgi.com sgi.h <gki.h> <gset.h>
+	sgiplset.x	sgi.com sgi.h <gki.h>
+	sgipm.x		sgi.com sgi.h <gki.h>
+	sgipmset.x	sgi.com sgi.h <gki.h>
+	sgireset.x	sgi.com sgi.h <gset.h> <gki.h>
+	sgitx.x		font.com font.h greek.com sgi.com sgi.h \
+			<gki.h> <gset.h> <math.h>
+	sgitxset.x	sgi.com sgi.h <gki.h> <gset.h>
+	sgk.x		sgk.com sgk.h <chars.h> <gki.h> <mach.h>
+	t_sgideco.x	sgk.h <error.h> <gki.h>
+	t_sgikern.x	<error.h> <gki.h>
+	;
diff --git a/sys/gio/sgikern/sgi.com b/sys/gio/sgikern/sgi.com
new file mode 100644
index 00000000..e050183b
--- /dev/null
+++ b/sys/gio/sgikern/sgi.com
@@ -0,0 +1,17 @@
+# SGI common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The stdgraph data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.
+
+pointer	g_kt				# kernel transform graphics descriptor
+pointer	g_tty				# graphcap descriptor
+int	g_nframes			# number of frames written
+int	g_maxframes			# max frames per device metafile
+int	g_ndraw				# no draw instr. in current frame
+int	g_in, g_out			# input, output files
+int	g_xres, g_yres			# desired device resolution
+char	g_device[SZ_GDEVICE]		# force output to named device
+
+common	/sgicom/ g_kt, g_tty, g_nframes, g_maxframes, g_ndraw,
+	g_in, g_out, g_xres, g_yres, g_device
diff --git a/sys/gio/sgikern/sgi.h b/sys/gio/sgikern/sgi.h
new file mode 100644
index 00000000..a9f1da20
--- /dev/null
+++ b/sys/gio/sgikern/sgi.h
@@ -0,0 +1,76 @@
+# SGI global definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		1024			# initial string buffer size
+define	SZ_GDEVICE	31			# maxsize forced device name
+define	DEF_MAXFRAMES	16			# maximum frames/metafile
+
+# The SGI state/device descriptor.
+
+define	LEN_SGI		81
+
+define	SGI_SBUF	Memi[$1]		# string buffer
+define	SGI_SZSBUF	Memi[$1+1]		# size of string buffer
+define	SGI_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	SGI_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	SGI_POLYLINE	Memi[$1+4]		# device supports polyline
+define	SGI_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	SGI_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	SGI_CELLARRAY	Memi[$1+7]		# device supports cell array
+define	SGI_XRES	Memi[$1+8]		# device resolution in X
+define	SGI_YRES	Memi[$1+9]		# device resolution in Y
+define	SGI_ZRES	Memi[$1+10]		# device resolution in Z
+define	SGI_FILLSTYLE	Memi[$1+11]		# number of fill styles
+define	SGI_ROAM	Memi[$1+12]		# device supports roam
+define	SGI_ZOOM	Memi[$1+13]		# device supports zoom
+define	SGI_SELERASE	Memi[$1+14]		# device has selective erase
+define	SGI_PIXREP	Memi[$1+15]		# device supports pixel replic.
+define	SGI_STARTFRAME	Memi[$1+16]		# frame advance at metafile BOF
+define	SGI_ENDFRAME	Memi[$1+17]		# frame advance at metafile EOF
+	# extra space
+define	SGI_CURSOR	Memi[$1+20]		# last cursor accessed
+define	SGI_COLOR	Memi[$1+21]		# last color set
+define	SGI_TXSIZE	Memi[$1+22]		# last text size set
+define	SGI_TXFONT	Memi[$1+23]		# last text font set
+define	SGI_TYPE	Memi[$1+24]		# last line type set
+define	SGI_WIDTH	Memi[$1+25]		# last line width set
+define	SGI_DEVNAME	Memi[$1+26]		# name of open device
+	# extra space
+define	SGI_CHARHEIGHT	Memi[$1+30+$2-1]	# character height
+define	SGI_CHARWIDTH 	Memi[$1+40+$2-1]	# character width
+define	SGI_CHARSIZE	Memr[P2R($1+50+$2-1)]	# text sizes permitted
+define	SGI_PLAP	($1+60)			# polyline attributes
+define	SGI_PMAP	($1+64)			# polymarker attributes
+define	SGI_FAAP	($1+68)			# fill area attributes
+define	SGI_TXAP	($1+71)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
diff --git a/sys/gio/sgikern/sgicancel.x b/sys/gio/sgikern/sgicancel.x
new file mode 100644
index 00000000..d9249d4b
--- /dev/null
+++ b/sys/gio/sgikern/sgicancel.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_CANCEL -- Cancel any buffered output.
+
+procedure sgi_cancel (dummy)
+
+int	dummy			# not used at present
+include	"sgi.com"
+
+begin
+	if (g_kt == NULL)
+	    return
+	call sgi_reset()
+end
diff --git a/sys/gio/sgikern/sgiclear.x b/sys/gio/sgikern/sgiclear.x
new file mode 100644
index 00000000..f2a63d29
--- /dev/null
+++ b/sys/gio/sgikern/sgiclear.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"sgi.h"
+
+# SGI_CLEAR -- Advance a frame on the plotter.  All attribute packets are
+# initialized to their default values.  Redundant calls or calls immediately
+# after a workstation open (before anything has been drawn) are ignored.
+
+procedure sgi_clear (dummy)
+
+int	dummy			# not used at present
+
+int	sgk_open()
+errchk	sgk_open
+include	"sgi.com"
+
+begin
+	# This is a no-op if nothing has been drawn.
+	if (g_kt == NULL || g_ndraw == 0)
+	    return
+
+	# Start a new frame.  This is done either by issuing the frame advance
+	# instruction or by starting a new metafile.  Close the output file and 
+	# start a new metafile if the maximum frame count has been reached.
+	# This disposes of the metafile to the system, causing the actual
+	# plots to be drawn.  Open a new metafile ready to receive next frame.
+
+	g_nframes = g_nframes + 1
+	if (g_nframes >= g_maxframes) {
+
+	    # Does this device require a frame advance at end of metafile?
+	    if (SGI_ENDFRAME(g_kt) == YES)
+		call sgk_frame (g_out)
+
+	    g_nframes = 0
+	    call sgk_close (g_out)
+	    g_out = sgk_open (Memc[SGI_DEVNAME(g_kt)], g_tty)
+
+	    # Does this device require a frame advance at beginning of metafile?
+	    if (SGI_STARTFRAME(g_kt) == YES)
+		call sgk_frame (g_out)
+
+	} else {
+	    # Merely output frame instruction to start a new frame in the same
+	    # metafile.
+
+	    call sgk_frame (g_out)
+	}
+
+	# Init kernel data structures.
+	call sgi_reset()
+	g_ndraw = 0
+end
diff --git a/sys/gio/sgikern/sgiclose.x b/sys/gio/sgikern/sgiclose.x
new file mode 100644
index 00000000..380cd01f
--- /dev/null
+++ b/sys/gio/sgikern/sgiclose.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_CLOSE -- Close the SGI translation kernel.  Close the spool file so
+# the output is finally plotted.  Free up storage.
+
+procedure sgi_close()
+
+include	"sgi.com"
+
+begin
+	# If there is anything in the metafile, flush it and add a frame
+	# advance if required for the device.
+
+	if (g_ndraw > 0 || g_nframes > 0) {
+	    # Does this device require a frame advance at end of metafile?
+	    if (SGI_ENDFRAME(g_kt) == YES)
+		call sgk_frame (g_out)
+	}
+
+	# Close output metafile, disposing of it to the host system.
+	call sgk_close (g_out)
+
+	# Free kernel data structures.
+	call mfree (SGI_SBUF(g_kt), TY_CHAR)
+	call mfree (g_kt, TY_STRUCT)
+
+	g_kt = NULL
+end
diff --git a/sys/gio/sgikern/sgiclws.x b/sys/gio/sgikern/sgiclws.x
new file mode 100644
index 00000000..e7d29dd7
--- /dev/null
+++ b/sys/gio/sgikern/sgiclws.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_CLOSEWS -- Close the named workstation.  Flush the output.
+# The spool file is closed only on the next plot or at gktclose time.
+# If the spool file is closed here, APPEND mode would not work.
+
+procedure sgi_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+include "sgi.com"
+
+begin
+	call sgk_flush (g_out)
+end
diff --git a/sys/gio/sgikern/sgicolor.x b/sys/gio/sgikern/sgicolor.x
new file mode 100644
index 00000000..cdd13708
--- /dev/null
+++ b/sys/gio/sgikern/sgicolor.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_COLOR -- Set line drawing color.
+
+procedure sgi_color (index)
+
+int	index		# index for color switch statement
+include	"sgi.com"
+
+begin
+	# switch (index) {
+	# case WHITE:
+	# case RED:
+	# case GREEN:
+	# case BLUE:
+	# default:
+	# }
+end
diff --git a/sys/gio/sgikern/sgidrawch.x b/sys/gio/sgikern/sgidrawch.x
new file mode 100644
index 00000000..ab7500ea
--- /dev/null
+++ b/sys/gio/sgikern/sgidrawch.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gki.h>
+include	<gset.h>
+include	"sgi.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+
+
+# SGI_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+int procedure sgi_drawchar (ch, x, y, xsize, ysize, orien, font)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# width, height of char in GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+
+int	mx, my
+real	px, py, coso, sino, theta
+int	stroke, tab1, tab2, i, pen, width
+int	bitupk()
+include	"font.com"
+include	"greek.com"
+include	"sgi.com"
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	# Set the font.
+	call sgi_font (font)
+
+	if (font == GT_GREEK) {
+	    width = gchwid[i]
+	    tab1 = gchidx[i]
+	    tab2 = gchidx[i+1] - 1
+	} else {
+	    width = chrwid[i]
+	    tab1 = chridx[i]
+	    tab2 = chridx[i+1] - 1
+	}
+
+	theta = -DEGTORAD(orien)
+	coso = cos(theta)
+	sino = sin(theta)
+
+	do i = tab1, tab2 {
+	    if (font == GT_GREEK)
+	        stroke = gchtab[i]
+	    else
+	        stroke = chrtab[i]
+
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    # Scale size of character.
+	    px = px / width  * xsize
+	    py = py / FONT_HEIGHT * ysize
+
+	    # The italic font is implemented applying a tilt.
+	    if (font == GT_ITALIC)
+		px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+	    # Rotate and shift.
+	    mx = x + px * coso + py * sino
+	    my = y - px * sino + py * coso
+
+	    # Draw the line segment or move pen.
+	    if (pen == 0)
+		call sgk_move (g_out, mx, my)
+	    else
+		call sgk_draw (g_out, mx, my)
+	}
+
+	return (int(real(width) / real(FONT_WIDTH) * xsize))
+end
diff --git a/sys/gio/sgikern/sgiescape.x b/sys/gio/sgikern/sgiescape.x
new file mode 100644
index 00000000..ff2480cd
--- /dev/null
+++ b/sys/gio/sgikern/sgiescape.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SGI_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# The SGK kernel does not have any escape functions at present.
+
+procedure sgi_escape (fn, instruction, nwords)
+
+int	fn			# function code
+short	instruction[ARB]	# instruction data words
+int	nwords			# length of instruction
+
+begin
+end
diff --git a/sys/gio/sgikern/sgifa.x b/sys/gio/sgikern/sgifa.x
new file mode 100644
index 00000000..37793f22
--- /dev/null
+++ b/sys/gio/sgikern/sgifa.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_FILLAREA -- Fill a closed area.
+
+procedure sgi_fillarea (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+include	"sgi.com"
+
+begin
+	# This kernel doesn't have any real fill area capability yet; if
+	# fill area is enabled in the graphcap entry, just draw the outline
+	# of the area.
+
+	if (SGI_FILLAREA(g_kt) == YES)
+	    call sgi_polyline (p, npts)
+end
diff --git a/sys/gio/sgikern/sgifaset.x b/sys/gio/sgikern/sgifaset.x
new file mode 100644
index 00000000..c3810252
--- /dev/null
+++ b/sys/gio/sgikern/sgifaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_FASET -- Set the fillarea attributes.
+
+procedure sgi_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"sgi.com"
+
+begin
+	fa = SGI_FAAP(g_kt)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/sgikern/sgiflush.x b/sys/gio/sgikern/sgiflush.x
new file mode 100644
index 00000000..e3e1b805
--- /dev/null
+++ b/sys/gio/sgikern/sgiflush.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"sgi.h"
+
+# SGI_FLUSH -- Flush output.
+
+procedure sgi_flush (dummy)
+
+int	dummy			# not used at present
+include	"sgi.com"
+
+begin
+	call sgk_flush (g_out)
+end
diff --git a/sys/gio/sgikern/sgifont.x b/sys/gio/sgikern/sgifont.x
new file mode 100644
index 00000000..808c7f56
--- /dev/null
+++ b/sys/gio/sgikern/sgifont.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gset.h>
+include	"sgi.h"
+
+# SGI_FONT -- Set the character font.  The roman font is normal.  Bold is
+# implemented by increasing the vector line width; care must be taken to
+# set SGI_WIDTH so that the other vector drawing procedures remember to
+# change the width back.  The italic font is implemented in the character
+# generator by a geometric transformation.
+
+procedure sgi_font (font)
+
+int	font			# code for font to be set
+
+int	normal, bold
+int	pk1, pk2, width
+include	"sgi.com"
+
+begin
+	width = SGI_WIDTH(g_kt)
+	normal = 0
+	bold = 1
+
+	pk1 = GKI_PACKREAL(real(normal))
+	pk2 = GKI_PACKREAL(real(bold))
+
+	if (font == GT_BOLD) {
+	    if (width != pk2) {
+		call sgk_linewidth (g_out, bold)
+		width = pk2
+	    }
+	} else {
+	    if (width != pk1) {
+	        call sgk_linewidth (g_out, normal)
+		width = pk1
+	    }
+	}
+
+	SGI_WIDTH(g_kt) = width
+end
diff --git a/sys/gio/sgikern/sgigcell.x b/sys/gio/sgikern/sgigcell.x
new file mode 100644
index 00000000..4c2bfe06
--- /dev/null
+++ b/sys/gio/sgikern/sgigcell.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SGI_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure sgi_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+begin
+	# Not implemented yet.
+end
diff --git a/sys/gio/sgikern/sgiinit.x b/sys/gio/sgikern/sgiinit.x
new file mode 100644
index 00000000..54caf25d
--- /dev/null
+++ b/sys/gio/sgikern/sgiinit.x
@@ -0,0 +1,162 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_INIT -- Initialize the gkt data structures from the graphcap entry
+# for the device.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine SGI_RESET initializes the attribute
+# packets when the frame is flushed.
+
+procedure sgi_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+int	maxch, i
+real	char_height, char_width, char_size
+
+bool	ttygetb()
+real	ttygetr()
+int	ttygeti(), btoi(), gstrcpy()
+include	"sgi.com"
+
+begin
+	# Allocate the gkt descriptor and the string buffer.
+	if (g_kt == NULL) {
+	    call calloc (g_kt, LEN_SGI, TY_STRUCT)
+	    call malloc (SGI_SBUF(g_kt), SZ_SBUF, TY_CHAR)
+	}
+
+	# Get the maximum frame count and the flags controlling frame advance
+	# at start and end of metafile.
+
+	g_maxframes = ttygeti (tty, "MF")
+	if (g_maxframes == 0)
+	    g_maxframes = DEF_MAXFRAMES
+	SGI_STARTFRAME(g_kt) = btoi (ttygetb (tty, "FS"))
+	SGI_ENDFRAME(g_kt)   = btoi (ttygetb (tty, "FE"))
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	SGI_SZSBUF(g_kt) = SZ_SBUF
+	SGI_NEXTCH(g_kt) = SGI_SBUF(g_kt) + 1
+	Memc[SGI_SBUF(g_kt)] = EOS
+
+	# Get the device resolution from the graphcap entry.
+
+	g_xres = ttygeti (tty, "xr")
+	if (g_xres <= 0)
+	    g_xres = 1024
+	g_yres = ttygeti (tty, "yr")
+	if (g_yres <= 0)
+	    g_yres = 1024
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the device has a set of discreet character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+
+	SGI_NCHARSIZES(g_kt) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = SGI_NEXTCH(g_kt)
+
+	if (SGI_NCHARSIZES(g_kt) <= 0) {
+	    SGI_NCHARSIZES(g_kt) = 1
+	    SGI_CHARSIZE(g_kt,1) = 1.0
+	    SGI_CHARHEIGHT(g_kt,1) = char_height
+	    SGI_CHARWIDTH(g_kt,1)  = char_width
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= SGI_NCHARSIZES(g_kt);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		SGI_CHARSIZE(g_kt,i)   = char_size
+		SGI_CHARHEIGHT(g_kt,i) = char_height * char_size
+		SGI_CHARWIDTH(g_kt,i)  = char_width  * char_size
+	    }
+	}
+
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the gkt
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	SGI_POLYLINE(g_kt)   = btoi (ttygetb (tty, "pl"))
+	SGI_POLYMARKER(g_kt) = btoi (ttygetb (tty, "pm"))
+	SGI_FILLAREA(g_kt)   = btoi (ttygetb (tty, "fa"))
+	SGI_FILLSTYLE(g_kt)  =       ttygeti (tty, "fs")
+	SGI_ROAM(g_kt)	     = btoi (ttygetb (tty, "ro"))
+	SGI_ZOOM(g_kt)	     = btoi (ttygetb (tty, "zo"))
+	SGI_XRES(g_kt)	     =       ttygeti (tty, "xr")
+	SGI_YRES(g_kt)	     =       ttygeti (tty, "yr")
+	SGI_ZRES(g_kt)	     =       ttygeti (tty, "zr")
+	SGI_CELLARRAY(g_kt)  = btoi (ttygetb (tty, "ca"))
+	SGI_SELERASE(g_kt)   = btoi (ttygetb (tty, "se"))
+	SGI_PIXREP(g_kt)     = btoi (ttygetb (tty, "pr"))
+
+	# Initialize the input parameters.
+
+	SGI_CURSOR(g_kt)     = 1
+
+	# Save the device string in the descriptor.
+	nextch = SGI_NEXTCH(g_kt)
+	SGI_DEVNAME(g_kt) = nextch
+	maxch = SGI_SBUF(g_kt) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+	SGI_NEXTCH(g_kt) = nextch
+end
+
+
+# SGI_GSTRING -- Get a string value parameter from the graphcap table,
+# placing the string at the end of the string buffer.  If the device does
+# not have the named capability return a pointer to the null string,
+# otherwise return a pointer to the string.  Since pointers are used,
+# rather than indices, the string buffer is fixed in size.  The additional
+# degree of indirection required with an index was not considered worthwhile
+# in this application since the graphcap entries are never very large.
+
+pointer procedure sgi_gstring (cap)
+
+char	cap[ARB]		# device capability to be fetched
+pointer	strp, nextch
+int	maxch, nchars
+int	ttygets()
+include	"sgi.com"
+
+begin
+	nextch = SGI_NEXTCH(g_kt)
+	maxch = SGI_SBUF(g_kt) + SZ_SBUF - nextch + 1
+
+	nchars = ttygets (g_tty, cap, Memc[nextch], maxch)
+	if (nchars > 0) {
+	    strp = nextch
+	    nextch = nextch + nchars + 1
+	} else
+	    strp = SGI_SBUF(g_kt)
+
+	SGI_NEXTCH(g_kt) = nextch
+	return (strp)
+end
diff --git a/sys/gio/sgikern/sgiline.x b/sys/gio/sgikern/sgiline.x
new file mode 100644
index 00000000..086ac158
--- /dev/null
+++ b/sys/gio/sgikern/sgiline.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gset.h>
+include	"sgi.h"
+
+# SGI_LINETYPE -- Set the line type option.
+
+procedure sgi_linetype (index)
+
+int	index		# index for line type switch statement
+
+int	linetype
+include	"sgi.com"
+
+begin
+	switch (index) {
+	case GL_CLEAR:
+	    linetype = 0
+	case GL_DASHED:
+	    linetype = 2
+	case GL_DOTTED:
+	    linetype = 3
+	case GL_DOTDASH:
+	    linetype = 4
+	default:
+	    linetype = 1		# solid
+	}
+
+	# This will be done in software in a future version of the SGI kernel.
+	# call sgk_linetype (g_out, linetype)
+end
diff --git a/sys/gio/sgikern/sgiopen.x b/sys/gio/sgikern/sgiopen.x
new file mode 100644
index 00000000..5164ecd7
--- /dev/null
+++ b/sys/gio/sgikern/sgiopen.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_OPEN -- Install the SGI kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  If a driver does not implement a particular
+# instruction the table entry for that procedure may be set to zero, causing
+# the interpreter to ignore the instruction.
+
+procedure sgi_open (devname, dd)
+
+char	devname[ARB]		# nonnull for forced output to a device
+int	dd[ARB]			# device table to be initialized
+
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+extern	sgi_openws(), sgi_closews(), sgi_clear(), sgi_cancel()
+extern	sgi_flush(), sgi_polyline(), sgi_polymarker(), sgi_text()
+extern	sgi_fillarea(), sgi_putcellarray(), sgi_plset()
+extern	sgi_pmset(), sgi_txset(), sgi_faset()
+extern	sgi_escape()
+include	"sgi.com"
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	# Flag first pass.  Save forced device name in common for OPENWS.
+	# Zero the frame and instruction counters.
+
+	g_kt = NULL
+	g_nframes = 0
+	g_ndraw = 0
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+
+	dd[GKI_OPENWS]		= locpr (sgi_openws)
+	dd[GKI_CLOSEWS]		= locpr (sgi_closews)
+	dd[GKI_DEACTIVATEWS]	= 0
+	dd[GKI_REACTIVATEWS]	= 0
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (sgi_clear)
+	dd[GKI_CANCEL]		= locpr (sgi_cancel)
+	dd[GKI_FLUSH]		= locpr (sgi_flush)
+	dd[GKI_POLYLINE]	= locpr (sgi_polyline)
+	dd[GKI_POLYMARKER]	= locpr (sgi_polymarker)
+	dd[GKI_TEXT]		= locpr (sgi_text)
+	dd[GKI_FILLAREA]	= locpr (sgi_fillarea)
+	dd[GKI_PUTCELLARRAY]	= locpr (sgi_putcellarray)
+	dd[GKI_SETCURSOR]	= 0
+	dd[GKI_PLSET]		= locpr (sgi_plset)
+	dd[GKI_PMSET]		= locpr (sgi_pmset)
+	dd[GKI_TXSET]		= locpr (sgi_txset)
+	dd[GKI_FASET]		= locpr (sgi_faset)
+	dd[GKI_GETCURSOR]	= 0
+	dd[GKI_GETCELLARRAY]	= 0
+	dd[GKI_ESCAPE]		= locpr (sgi_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call sgi_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/sgikern/sgiopenws.x b/sys/gio/sgikern/sgiopenws.x
new file mode 100644
index 00000000..a2a5a7eb
--- /dev/null
+++ b/sys/gio/sgikern/sgiopenws.x
@@ -0,0 +1,98 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include	<gki.h>
+include	<error.h>
+include	"sgi.h"
+
+# SGI_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, following by initialization of the device itself.
+
+procedure sgi_openws (devname, n, mode)
+
+short	devname[ARB]		# device name
+int	n			# length of device name
+int	mode			# access mode
+
+pointer	sp, buf
+pointer	ttygdes()
+bool	streq()
+int	sgk_open()
+bool	need_open, same_dev
+include	"sgi.com"
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_FNAME, n), TY_CHAR)
+
+	# If a device was named when the kernel was opened then output will
+	# always go to that device (g_device) regardless of the device named
+	# in the OPENWS instruction.  If no device was named (null string)
+	# then unpack the device name, passed as a short integer array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Find out if first time, and if not, if same device as before
+	# note that if (g_kt == NULL), then same_dev is false.
+
+	same_dev = false
+	need_open = true
+
+	if (g_kt != NULL) {
+	    same_dev = (streq (Memc[SGI_DEVNAME(g_kt)], Memc[buf]))
+	    if (!same_dev) {
+		# Does this device require a frame advance at end of metafile?
+		if (SGI_ENDFRAME(g_kt) == YES)
+		    call sgk_frame (g_out)
+		call sgk_close (g_out)
+	    } else
+		need_open = false
+	}
+
+	# Initialize the kernel data structures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+	# graphcap entry for device must exist.
+
+	if (need_open) {
+	    if (!same_dev) {
+		if (g_kt != NULL)
+		    call ttycdes (g_tty)
+	        iferr (g_tty = ttygdes (Memc[buf]))
+		    call erract (EA_ERROR)
+
+		# Initialize data structures if we had to open a new device.
+		call sgi_init (g_tty, Memc[buf])
+		call sgi_reset()
+	    }
+
+	    # Open the output file.  Metacode output to the device will be
+	    # spooled and then disposed of to the device at CLOSEWS time.
+
+	    iferr (g_out = sgk_open (Memc[SGI_DEVNAME(g_kt)], g_tty)) {
+	        call ttycdes (g_tty)
+	        call erract (EA_ERROR)
+	    } else {
+		# Does this device require a frame advance at start of metafile?
+		if (SGI_STARTFRAME(g_kt) == YES)
+		    call sgk_frame (g_out)
+		g_nframes = 0
+		g_ndraw = 0
+	    }
+	}
+
+	# Clear the screen if device is being opened in new_file mode.
+	# This is a nop if we really opened a new device, but it will clear
+	# the screen if this is just a reopen of the same device in new file
+	# mode.
+
+	if (mode == NEW_FILE)
+	    call sgi_clear (0)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/sgikern/sgipcell.x b/sys/gio/sgikern/sgipcell.x
new file mode 100644
index 00000000..b39e6377
--- /dev/null
+++ b/sys/gio/sgikern/sgipcell.x
@@ -0,0 +1,195 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+define	DEF_YRES	2048	# default height of device pixel in GKI units
+define	ZSTEP		4	# bit to be tested (step function width)
+
+
+# SGI_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).  The algorithm used here maps 8 bits in into 1 bit
+# out, using a step function lookup table.  The result is a band-contoured
+# image, where the spacing and width of the contour bands decreases as the
+# rate of change of intensity in the input cell array increases.
+
+procedure sgi_putcellarray (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+bool	ttygetb()
+include	"sgi.com"
+
+begin
+	if (ttygetb (g_tty, "BI"))
+	    call sgi_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+	else
+	    call sgi_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+end
+
+
+# SGI_BCELL -- Put cell array, optimized for a bitmap device.  In this case,
+# to get the maximum resolution at maximum efficiency it is desirable for the
+# main loop to be over device pixels, mapping the device pixel into the
+# nearest line of the input cell array.
+
+procedure sgi_bcell (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	my, i1, i2, v, i, j, k
+include	"sgi.com"
+int	and()
+
+begin
+	# Count drawing instruction, set polyline width to 1 for max y-res.
+	g_ndraw = g_ndraw + 1
+	call sgk_linewidth (g_out, 1)
+	SGI_WIDTH(g_kt) = 0
+
+	# Determine the width of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+
+	# Determine the height of a device pixel in GKI units.
+	if (SGI_YRES(g_kt) <= 0)
+	    dy = GKI_MAXNDC / DEF_YRES
+	else
+	    dy = max (1.0, real(GKI_MAXNDC) / real(SGI_YRES(g_kt)))
+
+	# Process the cell array.  The outer loop runs over device pixels in Y;
+	# each iteration writes one line of the output raster.  The inner loop
+	# runs down a line of the cell array.
+
+	k = 0
+	for (my = ay1 + dy/2;  my < ay2;  my = k * dy + ay1) {
+	    j = max(1, min(ny, int (real(my-ay1) / real(ay2-ay1) * (ny-1)) + 1))
+	    my = min (my, int (ay2 - dy/2))
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i1 + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call sgk_move (g_out, int ((i1-1) * dx + ax1), my)
+		    call sgk_draw (g_out, int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+
+	    k = k + 1
+	}
+end
+
+
+# SGI_MCELL -- Put cell array, optimized for a metafile device.  In this case,
+# it is prohibitively expensive to draw into each resolvable line of the
+# output device.  It is better to set the linewidth to the width of a cell
+# array pixel, output the minimum number of drawing instructions, and let the
+# metafile device widen the lines.
+
+procedure sgi_mcell (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	yres, my, i1, i2, v, i, j
+include	"sgi.com"
+int	and()
+
+begin
+	# Count drawing instruction, clobber saved polyline width.
+	g_ndraw = g_ndraw + 1
+	SGI_WIDTH(g_kt) = 0
+
+	# Determine the width and height of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+	dy = real (ay2 - ay1) / ny
+
+	# Set the SGK line width to the height of a pixel in the cell array.
+	yres = SGI_YRES(g_kt)
+	if (yres <= 0)
+	    yres = DEF_YRES
+	call sgk_linewidth (g_out,
+	    max (1, nint (dy / (real(GKI_MAXNDC) / real(yres)))))
+
+	# Process the cell array.  The outer loop runs over lines of the input
+	# cell array; each iteration writes only one line of the output raster,
+	# but the width of the line is adjusted to the height of a pixel in
+	# the cell array (the resolution of the cell array should not exceed
+	# that of the device).
+
+	for (j=1;  j <= ny;  j=j+1) {
+	    my = int ((j - 0.5) * dy) + ay1
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call sgk_move (g_out, int ((i1-1) * dx + ax1), my)
+		    call sgk_draw (g_out, int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+	}
+end
diff --git a/sys/gio/sgikern/sgipl.x b/sys/gio/sgikern/sgipl.x
new file mode 100644
index 00000000..e3eea44f
--- /dev/null
+++ b/sys/gio/sgikern/sgipl.x
@@ -0,0 +1,183 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include	"sgi.h"
+
+define	MAX_LTYPES	3	# max software line type patterns (excl. solid)
+define	MAX_LSEGMENTS	4	# max line segments per pattern
+define	LT_OFFSET	1	# offset to be subtracted from ltype code
+
+
+# SGI_POLYLINE -- Draw a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted but rather defines the start of the polyline.  The remaining
+# points define line segments to be drawn.
+
+procedure sgi_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl
+int	x, y
+int	len_p, i
+include	"sgi.com"
+
+begin
+	if (npts < 2)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polyline attributes if necessary.
+	pl = SGI_PLAP(g_kt)
+
+	if (SGI_WIDTH(g_kt) != PL_WIDTH(pl)) {
+	    call sgk_linewidth (g_out, nint (GKI_UNPACKREAL(PL_WIDTH(pl))))
+	    SGI_WIDTH(g_kt) = PL_WIDTH(pl)
+	}
+	if (SGI_COLOR(g_kt) != PL_COLOR(pl)) {
+	    call sgi_color (PL_COLOR(pl))
+	    SGI_COLOR(g_kt) = PL_COLOR(pl)
+	}
+
+	if (PL_LTYPE(pl) == GL_CLEAR) {
+	    # Ignore clear (erase) polylines.
+	    ;
+
+	} else if (PL_LTYPE(pl) != GL_SOLID) {
+	    # Draw a dashed or dotted polyline of the indicated type.
+	    call sgi_dashline (g_out, p, npts, PL_LTYPE(pl))
+
+	} else {
+	    # Draw a solid polyline (usual case, optimized).
+
+	    # Move to the first point.
+	    x = p[1]
+	    y = p[2]
+	    call sgk_move (g_out, x, y)
+
+	    # Draw the polyline.
+	    for (i=3;  i <= len_p;  i=i+2) {
+		x = p[i]
+		y = p[i+1]
+		call sgk_draw (g_out, x, y)
+	    }
+	}
+end
+
+
+# SGI_DASHLINE -- Draw a dashed or dotted polyline using the indicated line
+# style.
+
+procedure sgi_dashline (g_out, p, npts, ltype)
+
+int	g_out			# output file
+short	p[ARB]			# the polyline points
+int	npts			# number of points, i.e., (x,y) pairs
+int	ltype			# desired line type
+
+bool	penup
+int	len_p, i
+real	vlen, vpos, seglen, dx, dy
+int	oldx, oldy, newx, newy, penx, peny
+int	sgi_getseg()
+
+begin
+	len_p = npts * 2
+
+	oldx = p[1]; oldy = p[2]
+	call sgk_move (g_out, oldx, oldy)
+
+	# Process each line segment in the polyline.
+	do i = 3, len_p, 2 {
+	    newx = p[i]
+	    newy = p[i+1]
+
+	    # Compute VLEN, the length of the polyline line segment to be
+	    # drawn, VPOS, the relative position along the line segment,
+	    # and DX and DY, the scale factors to be applied to VPOS to get
+	    # the x and y coordinates of a point along the line segment.
+
+	    dx = newx - oldx
+	    dy = newy - oldy
+	    vlen = sqrt (dx*dx + dy*dy)
+	    if (vlen < 1.0)			# GKI units
+		next
+
+	    dx = dx / vlen
+	    dy = dy / vlen
+	    vpos = 0.0
+
+	    # For each line segment, get segments of the line type pattern
+	    # until all of the current line segment has been drawn.  The pattern
+	    # wraps around indefinitely, following the polyline around the
+	    # vertices with concern only for the total length traversed.
+
+	    while (vlen - vpos >= 1.0) {
+		seglen = sgi_getseg (int (vlen - vpos), penup, ltype)
+		if (seglen < 1.0)
+		    break
+
+		vpos = vpos + seglen
+		penx = oldx + vpos * dx
+		peny = oldy + vpos * dy
+
+		if (penup)
+		    call sgk_move (g_out, penx, peny)
+		else
+		    call sgk_draw (g_out, penx, peny)
+	    }
+
+	    oldx = newx
+	    oldy = newy
+	}
+end
+
+
+# SGI_GETSEG -- Get a segment of a line style pattern.  The segment extends
+# from the current position in the pattern to either the next penup/pendown
+# breakpoint in the pattern, or to the point MAXLEN units further along in
+# the pattern.  When the end of the pattern is reached wrap around and
+# duplicate the pattern indefinitely.
+
+int procedure sgi_getseg (maxlen, penup, ltype)
+
+int	maxlen			# max length segment to be returned
+bool	penup			# [out] pen up or pen down type segment?
+int	ltype			# line type code
+
+int	seglen, seg, lt
+int	p_seg[MAX_LTYPES]
+int	p_nseg[MAX_LTYPES]
+int	p_segleft[MAX_LTYPES]
+bool	p_penup[MAX_LTYPES,MAX_LSEGMENTS]
+int	p_seglen[MAX_LTYPES,MAX_LSEGMENTS]
+include	"ltype.dat"
+
+begin
+	lt = max (1, min (MAX_LTYPES, ltype - LT_OFFSET))
+	seg = p_seg[lt]
+	penup = p_penup[lt,seg]
+
+	repeat {
+	    if (maxlen < p_segleft[lt]) {
+		seglen = maxlen
+		p_segleft[lt] = p_segleft[lt] - seglen
+	    } else {
+		seglen = p_segleft[lt]
+		seg = seg + 1
+		if (seg > p_nseg[lt])
+		    seg = 1
+		p_seg[lt] = seg
+		p_segleft[lt] = p_seglen[lt,seg]
+	    }
+	} until (seglen > 0)
+
+	return (seglen)
+end
diff --git a/sys/gio/sgikern/sgiplset.x b/sys/gio/sgikern/sgiplset.x
new file mode 100644
index 00000000..30038437
--- /dev/null
+++ b/sys/gio/sgikern/sgiplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure sgi_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"sgi.com"
+
+begin
+	pl = SGI_PLAP(g_kt)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = gki[GKI_PLSET_LW]
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/sgikern/sgipm.x b/sys/gio/sgikern/sgipm.x
new file mode 100644
index 00000000..e53f3f03
--- /dev/null
+++ b/sys/gio/sgikern/sgipm.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	"sgi.h"
+
+# SGI_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs.
+
+procedure sgi_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+int	i, len_p
+int	x, y, oldx, oldy
+include	"sgi.com"
+
+begin
+	if (npts <= 0)
+	    return
+
+	len_p = npts * 2
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Update polymarker attributes if necessary.
+
+	pm = SGI_PMAP(g_kt)
+
+	if (SGI_TYPE(g_kt) != PM_LTYPE(pm)) {
+	    call sgi_linetype (PM_LTYPE(pm))
+	    SGI_TYPE(g_kt) = PM_LTYPE(pm)
+	}
+	if (SGI_WIDTH(g_kt) != PM_WIDTH(pm)) {
+	    call sgk_linewidth (g_out, nint (GKI_UNPACKREAL(PM_WIDTH(pm))))
+	    SGI_WIDTH(g_kt) = PM_WIDTH(pm)
+	}
+	if (SGI_COLOR(g_kt) != PM_COLOR(pm)) {
+	    call sgi_color (PM_COLOR(pm))
+	    SGI_COLOR(g_kt) = PM_COLOR(pm)
+	}
+
+	# Draw the polymarker.
+	oldx = 0; oldy = 0
+	for (i=1;  i <= len_p;  i=i+2) {
+	    x = p[i]; y = p[i+1]
+	    if (x != oldx || y != oldy) {
+		call sgk_move (g_out, x, y)
+		call sgk_draw (g_out, x, y)
+	    }
+	    oldx = x; oldy = y
+	}
+end
diff --git a/sys/gio/sgikern/sgipmset.x b/sys/gio/sgikern/sgipmset.x
new file mode 100644
index 00000000..0d72392f
--- /dev/null
+++ b/sys/gio/sgikern/sgipmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_PMSET -- Set the polymarker attributes.
+
+procedure sgi_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"sgi.com"
+
+begin
+	pm = SGI_PMAP(g_kt)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = gki[GKI_PMSET_MW]
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/sgikern/sgireset.x b/sys/gio/sgikern/sgireset.x
new file mode 100644
index 00000000..a97034eb
--- /dev/null
+++ b/sys/gio/sgikern/sgireset.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include	<gset.h>
+include	"sgi.h"
+
+# SGI_RESET -- Reset the state of the transform common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure sgi_reset()
+
+pointer	pl, pm, fa, tx
+include	"sgi.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = SGI_PLAP(g_kt)
+	pm = SGI_PMAP(g_kt)
+	fa = SGI_FAAP(g_kt)
+	tx = SGI_TXAP(g_kt)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	= 1
+	PL_WIDTH(pl)	= GKI_PACKREAL(1.)
+	PL_COLOR(pl)	= 1
+	PM_LTYPE(pm)	= 1
+	PM_WIDTH(pm)	= GKI_PACKREAL(1.)
+	PM_COLOR(pm)	= 1
+	FA_STYLE(fa)	= 1
+	FA_COLOR(fa)	= 1
+	TX_UP(tx)	= 90
+	TX_SIZE(tx)	= GKI_PACKREAL(1.)
+	TX_PATH(tx)	= GT_RIGHT
+	TX_HJUSTIFY(tx)	= GT_LEFT
+	TX_VJUSTIFY(tx)	= GT_BOTTOM
+	TX_FONT(tx)	= GT_ROMAN
+	TX_COLOR(tx)	= 1
+	TX_SPACING(tx)	= 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	SGI_TYPE(g_kt)		= -1
+	SGI_WIDTH(g_kt)		= -1
+	SGI_COLOR(g_kt)		= -1
+	SGI_TXSIZE(g_kt)	= -1
+	SGI_TXFONT(g_kt)	= -1
+end
diff --git a/sys/gio/sgikern/sgitx.x b/sys/gio/sgikern/sgitx.x
new file mode 100644
index 00000000..d0db5c58
--- /dev/null
+++ b/sys/gio/sgikern/sgitx.x
@@ -0,0 +1,459 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"sgi.h"
+include	"font.h"
+
+define	BASECS_X	12	# Base (size 1.0) char width in GKI coords.
+define	BASECS_Y	12	# Base (size 1.0) char height in GKI coords.
+
+
+# SGI_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.
+
+procedure sgi_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+real	x, y, dx, dy, tsz, offset, cosv, sinv
+int	x1, x2, y1, y2, orien
+int	x0, y0, gki_dx, gki_dy, ch, cw
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen, totwidth
+pointer	sp, seg, ip, op, tx, first
+int	stx_segment(), sgi_drawchar()
+include	"sgi.com"
+
+real	g_dx, g_dy		# scale GKI to window coords
+int	g_x1, g_y1		# origin of device window
+int	g_x2, g_y2		# upper right corner of device window
+data	g_dx /1.0/, g_dy /1.0/
+data	g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	# Keep track of the number of drawing instructions since the last frame
+	# clear.
+	g_ndraw = g_ndraw + 1
+
+	# Set pointer to the text attribute structure.
+	tx = SGI_TXAP(g_kt)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  The text size was
+	# set by sgi_txset, and is just a scaling factor.
+
+	SGI_TXSIZE(g_kt) = TX_SIZE(tx)
+	if (TX_COLOR(tx) != SGI_COLOR(g_kt)) {
+	    call sgi_color (TX_COLOR(tx))
+	    SGI_COLOR(g_kt) = TX_COLOR(tx)
+	}
+
+	# Set the linetype to a solid line.
+	if (SGI_TYPE(g_kt) != GL_SOLID) {
+	    call sgi_linetype (GL_SOLID)
+	    SGI_TYPE(g_kt) = GL_SOLID
+	}
+
+	# No discreet character sizes, so just scale the base sizes.
+	tsz = GKI_UNPACKREAL(TX_SIZE(tx))	# scale factor
+	ch = SGI_CHARHEIGHT(g_kt,1) * tsz
+	cw = SGI_CHARWIDTH(g_kt,1) * tsz
+
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx), cw, totwidth)
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call stx_parameters (xc,yc, totlen, totwidth, x0,y0, gki_dx,gki_dy,
+	    polytext, orien)
+
+	# Draw the segments, setting the font at the beginning of each segment.
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+
+	x  = x0 * g_dx + g_x1
+	y  = y0 * g_dy + g_y1
+	dx = gki_dx * g_dx
+	dy = gki_dy * g_dy
+	cosv = cos (-DEGTORAD(orien))
+	sinv = sin (-DEGTORAD(orien))
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2)
+			break
+		    else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    offset = sgi_drawchar (Memc[ip], nint(x), nint(y), cw, ch,
+			orien, font)
+		    ip = ip + 1
+		    seglen = seglen - 1
+		    x = x + (offset * cosv)
+		    y = y - (offset * sinv)
+		}
+
+		x = newx
+		y = newy
+		ip = op
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure stx_segment (text, n, out, start_font, cw, totwidth)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+int	cw			# default character width
+int	totwidth		# seg width in GKI units
+
+int 	i
+int	ip, op
+int	totlen, font
+
+include	"font.com"
+include	"greek.com"
+
+begin
+	out[1] = start_font
+	font = start_font
+	totlen = 0
+	totwidth = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+                if (text[ip] < CHARACTER_START || text[ip] > CHARACTER_END)
+                    i = '?' - CHARACTER_START + 1
+                else
+                    i = text[ip]  - CHARACTER_START + 1
+ 
+		if (font == GT_GREEK) {
+		    totwidth = totwidth + 
+			int(real(gchwid[i]) / real(FONT_WIDTH) * cw)
+		} else {
+		    totwidth = totwidth + 
+			int(real(chrwid[i]) / real(FONT_WIDTH) * cw)
+		}
+
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure stx_parameters (xc, yc, totlen, totwidth, x0, y0, dx, dy, polytext,
+   orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	totwidth		# width of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+int	up, path
+real	dir, sz, ch, cw, cosv, sinv, space
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q
+include	"sgi.com"
+
+begin
+	tx = SGI_TXAP(g_kt)
+
+	# Get character sizes in GKI coords.
+	sz = GKI_UNPACKREAL (TX_SIZE(tx))
+	ch = SGI_CHARHEIGHT(g_kt,1) * sz
+	cw = SGI_CHARWIDTH(g_kt,1) * sz
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated).
+	space = (1.0 + TX_SPACING(tx))
+	if (path == GT_UP || path == GT_DOWN)
+	    p = ch * space
+	else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation.
+	dx =  p * cosv + q * sinv
+	dy = -p * sinv + q * cosv
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	#xvlen = dx * (totlen - 1)
+	if (dx > 0)
+	    xvlen = totwidth - dx 
+	else
+	    xvlen = 0
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character in size X and Y.
+	xsize = abs ( cw * cosv + ch * sinv)
+	ysize = abs (-cw * sinv + ch * cosv)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	x0 = x0 + ( p * cosv + q * sinv)
+	y0 = y0 + (-p * sinv + q * cosv)
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
diff --git a/sys/gio/sgikern/sgitxset.x b/sys/gio/sgikern/sgitxset.x
new file mode 100644
index 00000000..c064d556
--- /dev/null
+++ b/sys/gio/sgikern/sgitxset.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"sgi.h"
+
+# SGI_TXSET -- Set the text drawing attributes.
+
+procedure sgi_txset (gki)
+
+short	gki[ARB]		# attribute structure
+
+pointer	tx
+include	"sgi.com"
+
+begin
+	tx = SGI_TXAP(g_kt)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+	TX_SIZE(tx)     = gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/sgikern/sgk.com b/sys/gio/sgikern/sgk.com
new file mode 100644
index 00000000..a919e147
--- /dev/null
+++ b/sys/gio/sgikern/sgk.com
@@ -0,0 +1,49 @@
+# SGK.COM -- The common for the SGK kernel.  A common is used here for maximum
+# efficiency (minimum indirection) when rasterizing vectors and encoding
+# metacode.  The maximum bitmap size is set at compile time in sgk.h.
+
+# Booleans put here to avoid possible alignment problems.
+
+bool	mf_bitmap			# metafile type, metacode or bitmap
+bool	mf_rotate			# rotate (swap x and y)
+bool	mf_yflip			# flip y axis end for end
+bool	mf_update			# update bitmap
+bool	mf_delete			# delete metacode file after dispose
+bool	mf_debug			# print kernel debugging messages
+bool	mf_swap2			# swap every 2 bytes on output
+bool	mf_swap4			# swap every 4 bytes on output
+bool	mf_oneperfile			# store each frame in a new file
+
+common	/sgkboo/ mf_bitmap, mf_rotate, mf_yflip, mf_update, mf_delete, mf_debug,
+	mf_swap2, mf_swap4, mf_oneperfile
+
+# Everything else goes here.
+
+int	mf_fd				# file descriptor of output file
+int	mf_frame			# frame counter
+char	mf_fname[SZ_PATHNAME]		# metafile filename
+char	mf_dispose[SZ_OSCMD]		# host dispose command
+
+int	mf_op				# [MCODE] index into obuf
+short	mf_obuf[LEN_OBUF]		# metacode buffer
+
+int	mf_cx, mf_cy			# [BITMAPS] current pen position
+int	mf_nbpb				# packing factor, bits per byte
+int	mf_pxsize, mf_pysize		# physical x, y size of bitmap, bits
+int	mf_wxsize, mf_wysize		# x, y size of bitmap window, bits
+int	mf_xorigin, mf_yorigin		# origin of bitmap window
+real	mf_xscale, mf_yscale		# to convert from NDC to device coords
+int	mf_xmin, mf_xmax		# x clipping limits
+int	mf_ymin, mf_ymax		# y clipping limits
+int	mf_lenframe			# frame size, words
+int	mf_linewidth			# relative line width
+int	mf_lworigin			# device width of line size 1.0
+real	mf_lwslope			# device pixels per line size increment
+int	mf_fbuf[LEN_FBUF]		# frame buffer (BIG)
+int	mf_bitmask[BPW]			# bit mask table
+
+common	/sgkcom/ mf_fd, mf_frame, mf_op, mf_cx, mf_cy, mf_nbpb, mf_pxsize,
+	mf_pysize, mf_wxsize, mf_wysize, mf_xorigin, mf_yorigin, mf_xscale,
+	mf_yscale, mf_xmin, mf_xmax, mf_ymin, mf_ymax, mf_lenframe,
+	mf_linewidth, mf_lworigin, mf_lwslope, mf_fbuf, mf_bitmask, mf_obuf,
+	mf_fname, mf_dispose
diff --git a/sys/gio/sgikern/sgk.h b/sys/gio/sgikern/sgk.h
new file mode 100644
index 00000000..09c62d95
--- /dev/null
+++ b/sys/gio/sgikern/sgk.h
@@ -0,0 +1,7 @@
+# SGK.H -- SGK metacode definitions.
+
+define	SGK_LENMCI	3		# SGK instruction length
+define	SGK_FRAME	1		# new frame instruction
+define	SGK_MOVE	2		# move pen
+define	SGK_DRAW	3		# draw pen
+define	SGK_SETLW	4		# set line width
diff --git a/sys/gio/sgikern/sgk.x b/sys/gio/sgikern/sgk.x
new file mode 100644
index 00000000..3ed77f76
--- /dev/null
+++ b/sys/gio/sgikern/sgk.x
@@ -0,0 +1,853 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <chars.h>
+include <gki.h>
+include "sgk.h"
+
+.help sgk
+.nf ---------------------------------------------------------------------------
+SGK -- Simple graphics device interface.  The purpose of this interface is
+to provide a simple means for interfacing new plotter devices to IRAF/GIO.
+The interface works by writing a binary metacode file and then disposing of
+it by issuing a command to the host system.
+
+       g_out = sgk_open (device, tty)		# device open
+	      sgk_close (g_out)			# device close
+	      sgk_flush (g_out)			# flush output
+
+	      sgk_frame (g_out)			# start a new frame
+	       sgk_move (g_out, x, y)		# move to (x,y)
+	       sgk_draw (g_out, x, y)		# draw a vector to (x,y)
+	  sgk_linewidth (g_out, width)		# set line width (>=1)
+
+The procedures comprising the top end of the SGK interface are summarized
+above and the code is included in this file.  These procedures could be
+rewritten by the user to talk directly to a graphics device if desired,
+although the metacode file interface is likely to be simpler in most cases.
+
+The SGK kernel can produce either metacode or bitmap output.  Metacode output
+is normally preferred for intelligent plotters and for pen plotters.  Bitmap
+output is normally preferred for raster plotters.  The type of output file
+to be generated is selected by the graphcap entry for an SGI/SGK device.
+
+The METACODE FORMAT written by the SGK interface is a sequence of 16 bit integer
+words containing binary opcodes and data.  The metacode is extremely simple,
+consisting of only two drawing instructions (pen up move and pen down draw),
+a frame instruction, and an optional set line width instruction.  All text is
+rendered into vectors by the SGI kernel hence there are no text drawing
+instructions.  The SGK metacode instruction formats are summarized below.
+
+     opcode / data words 
+
+          1  0  0               # frame instruction
+          2  X  Y               # move to (x,y)
+          3  X  Y               # draw to (x,y)
+          4  W  0               # set line width (>= 1, 1=normal, 2=bold)
+
+All opcodes and data words are 16 bit positive integers encoded in the machine
+independent MII format, i.e., most significant byte first.  Only 15 bits of
+each 16 bit word are actually used.  Coordinates are specified in the range 0
+to 32767.  All instructions are zero padded to 3 words to simplify metacode
+translation programs.
+
+The BITMAP FORMAT written by the SGK is even simpler than the metacode format.
+Output consists of a binary raster file containing one or more bitmaps with no
+embedded header information.  All bitmaps in a raster file are of the same
+size.  The size is specified in the graphcap entry for the device and may be
+passed to the host dispose task on the foreign task command line if desired.
+Page offsets may also be passed on the command line, e.g., to position the
+plot on the plotter page.
+
+The following graphcap fields apply to both metacode and bitmap devices.
+
+	DD	host command to dispose of metacode file ($F)
+	DB	have the kernel print debug messages during execution
+	RM	boolean; if present, SGK will delete metacode file
+	MF	multiframe count (max frames per job)
+	NF	store each frame in a new file (rather than all in one file)
+	RO	rotate plot (swap x and y)
+	YF	y-flip plot (flip y axis) (done after rotate)
+
+The following additional fields are defined for bitmap devices.
+
+	BI	boolean; presence indicates a bitmapped or raster device
+	LO	width in device pixels of a line of size 1.0
+	LS	difference in device pixels between line sizes
+	PX	physical x size (linelen) of bitmap as stored in memory, bits
+	PY	physical y size of bitmap, i.e., number of lines in bitmap
+	XO,YO	origin of plotting window in device pixels
+	XW,YW	width of plotting window in device pixels
+	NB	number of bits to be set in each 8 bit byte output
+	BF	bit-flip each byte in bitmap (easier here than later)
+	BS	byte swap the bitmap when output (swap every two bytes)
+	WS	word swap the bitmap when output (swap every four bytes)
+
+The multiframe count (MF) limits the number of frames per job, where a job
+refers to the dispose command submitted to the host to process the frames.
+If the new file flag (NF) is absent, all frames will be stored in the same
+physical file (this holds for both metacode and bitmap frames).  If the new
+file flag (NF) is set, each frame will be stored in a separate file, with
+the N files having the names $F.1, $F.2, ... $F.N, where $F is the unique
+(root) filename generated from the template given in the DD string.  The $F
+is replaced by the root filename, rather than by a list of all the filenames,
+to keep the OS command to a reasonable length and to permit the use of host
+file templates to perform operate upon the full set of files (and to avoid
+having to choose between spaces and commas to delimit the filenames).
+For example, if MF=8 and NF=yes, then "$F.[1-8]" will match the file set
+on a UNIX host.  The template "$F.*" is less precise but would also work.
+
+The output raster will consist of PY lines each of length PX bits.  If PX is
+chosen to be a multiple of 8, there will be PX/8 bytes per line of the output
+raster.  Note that the values of PX and PY are arbitrary and should be chosen
+to simplify the code of the translator and maximize efficiency.  In particular,
+PX and PY do not in general define the maximum physical resolution of the
+device, although if NB=8 the value of PX will typically approximate the
+physical resolution in X.  If there are multiple bitmap frames per file,
+each frame will occupy an integral number of SPP char units of storage in the
+output file, with the values of any extra bits at the end of the bitmap being
+undefined (a char is 16 bits on most IRAF host machines).
+
+The plot will be rasterized in a logical window XW one-bit pixels wide and YW
+pixels high.  The first YO lines of the output raster will be zero, with the
+plotting window beginning at line YO+1.  The first XO bits of each output line
+will be zeroed, with the plotting window beginning at bit XO+1.  The bytes in
+each output line may be bit-flipped if desired, and all of the bits in each
+output byte need not be used for pixel data.  If the bit packing factor NB is
+set to 8 the plotting window will map into XW bits of storage of each output
+line.  If fewer than 8 bits are used in each output byte more than XW physical
+bits of storage will be used, e.g., if NB=4, XW*2 bits of storage are required
+for a line of the plotting window.  The unused bits are set to zero.  The
+translator can later "or" a mask into the zeroed bits, flip the data bits,
+or perform any other bytewise operation using simple lookup table mapping
+techniques.
+.endhelp ----------------------------------------------------------------------
+
+# NOTE -- The mf_physbit lookup table, used to map logical screen bits into
+# physical bits in the bitmap (for NB != 8) is equivalenced to the mf_obuf
+# array which is not otherwise used for bitmap devices.  The length of the
+# mf_obuf array must therefore be >= PX.
+
+define	mf_physbit	mf_obuf		# union these two arrays [[[NOTE]]]
+define	BPW		NBITS_INT	# nbits in an integer
+define	LEN_FBUF	(2550*3300/BPW)	# max size bitmap / frame buffer
+define	LEN_OBUF	3300		# nwords in output buffer
+define	SZ_DDSTR	256		# max size graphcap.DD
+define	SZ_OSCMD	256		# OS dispose command from graphcap.DD
+
+
+# SGK_OPEN -- Open the metacode file.  Parse the DD string from the graphcap
+# entry for the device to get the file template and OS dispose command.
+# Generate a unique file name and open the metacode file as a NEW_FILE.
+# Save the dispose command for later.
+
+int procedure sgk_open (device, tty)
+
+char	device[ARB]		# device name [NOT USED]
+pointer	tty			# pointer to graphcap descriptor
+
+char	cap[2]
+int	len_nodeprefix, byte, off, op, i, j
+pointer	sp, raw_ddstr, ddstr, devname, spool, fname, tempfn, val, ip
+
+bool	ttygetb()
+real	ttygetr()
+int	open(), ttygets(), ttygeti(), gstrcpy(), shifti()
+errchk	open, ttygets, ttygeti, ttygetb
+include	"sgk.com"
+
+begin
+	call smark (sp)
+	call salloc (raw_ddstr, SZ_DDSTR, TY_CHAR)
+	call salloc (ddstr, SZ_DDSTR, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+	call salloc (spool, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (tempfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (val, SZ_FNAME, TY_CHAR)
+
+	# The DB flag may be set in the graphcap entry for an SGI device to
+	# print debug messages during execution.
+
+	mf_debug = ttygetb (tty, "DB")
+
+	# The DD string is used to pass device dependent information to the
+	# graphics device driver.
+
+	if (ttygets (tty, "DD", Memc[raw_ddstr], SZ_DDSTR) <= 0)
+	    call error (1, "sgikern: missing DD parameter in graphcap")
+
+	# Expand any $(XX) graphcap parameter references in the DD string.
+	op = ddstr
+	for (ip=raw_ddstr;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == '$' && Memc[ip+1] == '(' && Memc[ip-1] != '\\') {
+		# Graphcap parameter substitution.
+		call strcpy (Memc[ip+2], cap, 2)
+		if (ttygets (tty, cap, Memc[val], SZ_FNAME) <= 0) {
+		    call eprintf ("Warning: graphcap field `%s' not found\n")
+			call pargstr (cap)
+		} else {
+		    for (off=val;  Memc[off] == '#';  off=off+1)
+			;
+		    for (;  Memc[off] != EOS;  off=off+1) {
+			Memc[op] = Memc[off]
+			op = op + 1
+		    }
+		}
+		ip = ip + 4
+		    
+	    } else {
+		# Ordinary character.
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	Memc[op] = EOS
+
+	# Parse the DD string into the node/device name, temp file name,
+	# and host dispose command.
+
+	# Get node and device name (e.g., "node!device,...").
+	len_nodeprefix = 0
+	ip = ddstr
+	for (op=devname;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == ',') {
+		if (Memc[ip-1] == '\\') {
+		    Memc[op-1] = ','
+		    ip = ip - 1
+		} else {
+		    ip = ip + 1
+		    break
+		}
+	    } else {
+		if (Memc[ip] == FNNODE_CHAR)
+		    len_nodeprefix = op - devname + 1
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	Memc[op] = EOS
+
+	# Get spoolfile root name.
+	op = spool + gstrcpy (Memc[devname], Memc[spool], len_nodeprefix)
+	for (;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == ',') {
+		if (Memc[ip-1] == '\\') {
+		    Memc[op-1] = ','
+		    ip = ip - 1
+		} else {
+		    ip = ip + 1
+		    break
+		}
+	    } else {
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	Memc[op] = EOS
+
+	# Get OS pathname of spoofile.
+	call mktemp (Memc[spool], Memc[tempfn], SZ_PATHNAME)
+	call fmapfn (Memc[tempfn], mf_fname, SZ_PATHNAME)
+	call strupk (mf_fname, mf_fname, SZ_PATHNAME)
+
+	# Get pathname of spoolfile on the remote node.  The call to
+	# ki_fmapfn() is currently necessary to translate the filename for
+	# the remote node, but may be replaced by the usual fmapfn() in a
+	# future version of the kernel interface.
+
+	call ki_fmapfn (Memc[tempfn], Memc[fname], SZ_PATHNAME)
+	call strupk (Memc[fname], Memc[fname], SZ_PATHNAME)
+
+	if (mf_debug) {
+	    call eprintf ("sgk: open device %s, outfile = %s\n")
+		call pargstr (Memc[devname])
+		call pargstr (mf_fname)
+	}
+
+	# Copy OS command for disposing of metacode file into common, replacing
+	# all $F sequences in the command by the OS pathname of the spool file.
+
+	op = gstrcpy (Memc[devname], mf_dispose, len_nodeprefix) + 1
+
+	for (;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == '$' && Memc[ip-1] == '\\') {
+		# Escape a $.
+		mf_dispose[op-1] = '$'
+
+	    } else if (Memc[ip] == '$' && Memc[ip+1] == 'F') {
+		# Filename substitution.
+		for (i=fname;  Memc[i] != EOS;  i=i+1) {
+		    mf_dispose[op] = Memc[i]
+		    op = op + 1
+		}
+		ip = ip + 1
+
+	    } else {
+		# Ordinary character.
+		mf_dispose[op] = Memc[ip]
+		op = op + 1
+	    }
+
+	mf_dispose[op] = EOS
+
+	# Remove (delete) metacode file after issuing OS dispose command?
+	mf_delete = ttygetb (tty, "RM")
+
+	# Store each frame in a new file?
+	mf_oneperfile = ttygetb (tty, "NF")
+
+	mf_update = false
+	mf_frame = 1
+
+	# Open a new metacode file.
+	if (mf_oneperfile)
+	    call sgk_mkfname (mf_fname, mf_frame, Memc[fname], SZ_FNAME)
+	else
+	    call strcpy (mf_fname, Memc[fname], SZ_FNAME)
+
+	if (mf_debug) {
+	    call eprintf ("sgk: open frame %2d, outfile = %s\n")
+		call pargi (mf_frame)
+		call pargstr (Memc[fname])
+	}
+	mf_fd = open (Memc[fname], NEW_FILE, BINARY_FILE)
+
+	# Rotate plot (swap x,y)?  Y-flip plot?
+	mf_rotate = ttygetb (tty, "RO")
+	mf_yflip  = ttygetb (tty, "YF")
+
+	# Raster (bitmap) or metacode device?
+	mf_bitmap = ttygetb (tty, "BI")
+
+	if (mf_bitmap) {
+	    # Bitmap output; initialize bitmap parameters.
+
+	    mf_pxsize   = ttygeti (tty, "PX")
+	    mf_pysize   = ttygeti (tty, "PY")
+	    mf_xorigin  = ttygeti (tty, "XO")
+	    mf_yorigin  = ttygeti (tty, "YO")
+	    mf_wxsize   = ttygeti (tty, "XW")
+	    mf_wysize   = ttygeti (tty, "YW")
+	    mf_nbpb	= ttygeti (tty, "NB")
+	    mf_swap2	= ttygetb (tty, "BS")
+	    mf_swap4	= ttygetb (tty, "WS")
+
+	    mf_lworigin = max (1, ttygeti (tty, "LO"))
+	    mf_lwslope  = ttygetr (tty, "LS")
+	    mf_lenframe = (mf_pxsize * mf_pysize + BPW-1) / BPW
+
+	    if (mf_wxsize == 0)
+		mf_wxsize = mf_pxsize - mf_xorigin
+	    if (mf_wysize == 0)
+		mf_wysize = mf_pysize - mf_yorigin
+	    if (mf_nbpb == 0)
+		mf_nbpb = NBITS_BYTE
+
+	    mf_linewidth = mf_lworigin
+	    mf_cx = 0
+	    mf_cy = 0
+
+	    mf_xmin = mf_xorigin
+	    mf_ymin = mf_yorigin
+	    mf_xmax = mf_xmin + mf_wxsize - 1
+	    mf_ymax = mf_ymin + mf_wysize - 1
+
+	    mf_xscale = real(mf_wxsize) / real(GKI_MAXNDC)
+	    mf_yscale = real(mf_wysize) / real(GKI_MAXNDC)
+
+	    if (mf_lenframe > LEN_FBUF)
+		call error (1, "sgikern: bitmap too large")
+
+	    # Initialize the bit mask table.  If it is necessary to bit-flip
+	    # bytes in the bitmap, we can do that here by flipping each byte
+	    # of the word mask.  Bit flipping can be done during rasterization
+	    # at no additional cost, but is an expensive operation if done
+	    # later with a filter.
+
+	    if (ttygetb (tty, "BF")) {
+		do j = 1, (BPW/NBITS_BYTE)
+		    do i = 1, NBITS_BYTE {
+			off = (j - 1) * NBITS_BYTE
+			mf_bitmask[off+i] = shifti (1, off + NBITS_BYTE - i)
+		    }
+	    } else {
+		do i = 1, BPW
+		    mf_bitmask[i] = shifti (1, i - 1)
+	    }
+
+	    # Initialize the bit offset lookup table.  This gives the physical
+	    # x-offset into the lookup table of each addressable x-coordinate
+	    # on the device.  If NB is NBITS_BYTE the mapping is one-to-one.
+	    # Note that the table contains zero-indexed bit offsets.
+
+	    do i = 1, mf_pxsize {
+		byte = (i - 1) / mf_nbpb
+		mf_physbit[i] = min (mf_pxsize,
+		    byte * NBITS_BYTE + (i - (byte * mf_nbpb))) - 1
+	    }
+
+	    if (mf_debug) {
+		call eprintf ("bitmap [%d,%d] origin=[%d,%d] wsize=[%d,%d]\n")
+		    call pargi (mf_pxsize);  call pargi (mf_pysize)
+		    call pargi (mf_xorigin); call pargi (mf_yorigin)
+		    call pargi (mf_wxsize);  call pargi (mf_wysize)
+	    }
+
+	} else {
+	    # Metacode output; initialize the metacode output buffer.
+	    mf_op = 1
+	    if (mf_debug)
+		call eprintf ("metafile device\n")
+	}
+
+	call sfree (sp)
+	return (mf_fd)
+end
+
+
+# SGK_CLOSE -- Close the metacode spool file and dispose of it to a host system
+# metacode translation task.  Delete the spool file when the OS command
+# completes, unless it has already been deleted by the task run.
+
+procedure sgk_close (fd)
+
+int	fd			# output stream [NOT USED]
+
+int	i
+pointer	sp, fname
+int	oscmd()
+errchk	sgk_flush, close, oscmd
+include	"sgk.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	if (mf_debug)
+	    call eprintf ("close device\n")
+
+	if (mf_bitmap)
+	    call sgk_frame (mf_fd)
+	else
+	    call sgk_flush (mf_fd)
+
+	if (mf_debug) {
+	    call eprintf ("dispose: %s\n")
+		call pargstr (mf_dispose)
+	}
+
+	if (mf_fd != NULL) {
+	    call close (mf_fd)
+	    mf_fd = NULL
+	}
+
+	# Send the dispose command to the host system.
+	if (mf_dispose[1] != EOS)
+	    if (oscmd (mf_dispose, "", "", "") != OK)
+		call eprintf ("Warning: SGK graphics output dispose error\n")
+
+	# Delete the metacode or raster file if so indicated in the graphcap
+	# entry for the device.
+
+	if (mf_delete) {
+	    if (mf_debug) {
+		call eprintf ("delete metafile %s\n")
+		    call pargstr (mf_fname)
+	    }
+	    if (mf_oneperfile) {
+		do i = 1, mf_frame {
+		    call sgk_mkfname (mf_fname, i, Memc[fname], SZ_FNAME)
+		    iferr (call delete (Memc[fname]))
+			;
+		}
+	    } else iferr (call delete (mf_fname))
+		;
+	}
+
+	call sfree (sp)
+end
+
+
+# SGK_FLUSH -- Flush any buffered metacode output.
+
+procedure sgk_flush (fd)
+
+int	fd			# output stream [NOT USED]
+include	"sgk.com"
+
+begin
+	if (!mf_bitmap && mf_op > 1) {
+	    if (mf_debug)
+		call eprintf ("flush graphics output\n")
+	    call miiwrites (mf_fd, mf_obuf, mf_op-1)
+	    mf_op = 1
+	}
+
+	if (mf_fd != NULL)
+	    call flush (mf_fd)
+end
+
+
+# SGK_FRAME -- Output a frame advance instruction.
+
+procedure sgk_frame (fd)
+
+int	fd			# output stream [NOT USED]
+include	"sgk.com"
+
+begin
+	# Ignore frame commands if frame is empty.
+	if (!mf_update)
+	    return
+
+	if (mf_debug)
+	    call eprintf ("start a new frame\n")
+
+	if (mf_bitmap) {
+	    # Write the bitmap to the output raster-file.
+
+	    if (mf_swap2)
+		call bswap2 (mf_fbuf, 1, mf_fbuf, 1,
+		    mf_lenframe * SZ_INT * SZB_CHAR)
+	    if (mf_swap4)
+		call bswap4 (mf_fbuf, 1, mf_fbuf, 1,
+		    mf_lenframe * SZ_INT * SZB_CHAR)
+
+	    call write (mf_fd, mf_fbuf, mf_lenframe * SZ_INT)
+
+	} else {
+	    # Write the SGI frame instruction to the output mcode-file.
+
+	    if (mf_op + SGK_LENMCI > LEN_OBUF) {
+		call miiwrites (mf_fd, mf_obuf, mf_op-1)
+		mf_op = 1
+	    }
+
+	    mf_obuf[mf_op] = SGK_FRAME
+	    mf_obuf[mf_op+1] = 0
+	    mf_obuf[mf_op+2] = 0
+	    mf_op = mf_op + SGK_LENMCI
+	}
+
+	mf_frame = mf_frame + 1
+	mf_update = false
+end
+
+
+# SGK_MOVE -- Output a pen move instruction.
+
+procedure sgk_move (fd, x, y)
+
+int	fd			# output stream [NOT USED]
+int	x, y			# point to move to
+
+include	"sgk.com"
+
+begin
+	if (mf_bitmap) {
+	    if (mf_rotate) {
+		mf_cx = y
+		mf_cy = x
+	    } else {
+		mf_cx = x
+		mf_cy = y
+	    }
+
+	    if (mf_yflip)
+		mf_cy = GKI_MAXNDC - mf_cy
+
+	    # Convert to zero indexed coordinates and clip at boundary.
+	    # Allow room for line width shift near boundary.
+
+	    mf_cx = max (mf_xmin, min (mf_xmax,
+		int (mf_cx * mf_xscale) + mf_xorigin))
+	    mf_cy = max (mf_ymin, min (mf_ymax,
+		int (mf_cy * mf_yscale) + mf_yorigin))
+
+	} else {
+	    if (mf_op + SGK_LENMCI > LEN_OBUF) {
+		call miiwrites (mf_fd, mf_obuf, mf_op-1)
+		mf_op = 1
+	    }
+
+	    mf_obuf[mf_op] = SGK_MOVE
+	    if (mf_rotate) { 
+		mf_obuf[mf_op+1] = y
+		mf_obuf[mf_op+2] = x
+	    } else {
+		mf_obuf[mf_op+1] = x
+		mf_obuf[mf_op+2] = y
+	    }
+	    if (mf_yflip)
+		mf_obuf[mf_op+2] = GKI_MAXNDC - mf_obuf[mf_op+2]
+	    mf_op = mf_op + SGK_LENMCI
+	}
+end
+
+
+# SGK_DRAW -- Output a pen draw instruction.
+
+procedure sgk_draw (fd, a_x, a_y)
+
+int	fd			# output stream [NOT USED]
+int	a_x, a_y		# point to draw to
+
+char	fname[SZ_FNAME]
+int	xshift, yshift, dx, dy
+int	new_x, new_y, x1, y1, x2, y2, n, i
+int	open()
+errchk	open, close
+include	"sgk.com"
+
+begin
+	if (mf_rotate) {
+	    new_x = a_y
+	    new_y = a_x
+	} else {
+	    new_x = a_x
+	    new_y = a_y
+	}
+
+	if (mf_yflip)
+	    new_y = GKI_MAXNDC - new_y
+
+	if (!mf_update) {
+	    # We are called when the first drawing instruction is output for a
+	    # new frame.  We clear the bitmap or close and open a new frame
+	    # file here, rather than at sgk_frame() time, as we do not want
+	    # to initialize the frame buffer or open a new frame file unless
+	    # we are actually going to write into the frame.
+
+	    # Zero out all the bits in a bitmap.
+	    if (mf_bitmap)
+		call aclri (mf_fbuf, mf_lenframe)
+
+	    # Open a new frame file if the one frame per file flag is set.
+	    if (mf_oneperfile && mf_frame > 1) {
+		if (mf_fd != NULL)
+		    call close (mf_fd)
+		call sgk_mkfname (mf_fname, mf_frame, fname, SZ_FNAME)
+		if (mf_debug) {
+		    call eprintf ("sgk: open frame %2d, outfile = %s\n")
+			call pargi (mf_frame)
+			call pargstr (fname)
+		}
+		mf_fd = open (fname, NEW_FILE, BINARY_FILE)
+	    }
+
+	    mf_update = true
+	}
+
+	if (mf_bitmap) {
+	    # Convert to zero indexed coordinates and clip at boundary.
+	    # Allow room for line width shift near boundary.
+
+	    new_x = max (mf_xmin, min (mf_xmax,
+		int (new_x * mf_xscale) + mf_xorigin))
+	    new_y = max (mf_ymin, min (mf_ymax,
+		int (new_y * mf_yscale) + mf_yorigin))
+
+	    if (mf_linewidth <= 1)
+		call sgk_vector (mf_cx, mf_cy, new_x, new_y)
+	    else {
+		# Redraw the vector several times with small normal shifts to
+		# produce a wider line.
+
+		xshift = 0
+		yshift = 0
+
+		if (abs (new_x - mf_cx) > abs (new_y - mf_cy)) {
+		    dx = 0
+		    dy = 1
+		} else {
+		    dx = 1
+		    dy = 0
+		}
+
+		do i = 1, mf_linewidth {
+		    x1 = mf_cx + xshift
+		    y1 = mf_cy + yshift
+		    x2 = new_x + xshift
+		    y2 = new_y + yshift
+
+		    call sgk_vector (x1, y1, x2, y2)
+
+		    n = (i + 1) / 2
+		    if (and (i, 1) == 0) {
+			xshift =  dx * n
+			yshift =  dy * n
+		    } else {
+			xshift = -dx * n
+			yshift = -dy * n
+		    }
+		}
+	    }
+
+	    # Update the current pen position, and set the update flag so that
+	    # the bitmap will be written to the output file.
+
+	    mf_cx = new_x
+	    mf_cy = new_y
+
+	} else {
+	    # Output a metacode draw instruction.
+	    if (mf_op + SGK_LENMCI > LEN_OBUF) {
+		call miiwrites (mf_fd, mf_obuf, mf_op-1)
+		mf_op = 1
+	    }
+
+	    mf_obuf[mf_op] = SGK_DRAW
+	    mf_obuf[mf_op+1] = new_x
+	    mf_obuf[mf_op+2] = new_y
+	    mf_op = mf_op + SGK_LENMCI
+	}
+end
+
+
+# SGK_VECTOR -- Write a vector (line) of unit width into the bitmap.  The line
+# endpoints are expressed in physical device coordinates.
+
+procedure sgk_vector (a_x1, a_y1, a_x2, a_y2)
+
+int	a_x1, a_y1			# start point of line
+int	a_x2, a_y2			# end point of line
+
+real	dydx, dxdy
+long	fbit, wbit, word
+int	wpln, mask, dx, dy, x, y, x1, y1, x2, y2, or()
+include	"sgk.com"
+
+begin
+	x1 = a_x1; y1 = a_y1
+	x2 = a_x2; y2 = a_y2
+
+	dx = x2 - x1
+	dy = y2 - y1
+
+	if (abs(dx) > abs(dy)) {
+	    if (x1 > x2) {
+		x1 = a_x2; x2 = a_x1; dx = -dx
+		y1 = a_y2; y2 = a_y1; dy = -dy
+	    }
+
+	    if (dy == 0 && mf_nbpb == NBITS_BYTE) {
+		# Somewhat optimized code for the case of a horiz. vector.
+
+		fbit = y1 * mf_pxsize + x1
+		word = fbit / BPW
+		wbit = and (fbit, BPW-1)
+
+		do x = x1, x2 {
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		    wbit = wbit + 1
+		    if (wbit >= BPW) {
+			wbit = 0
+			word = word + 1
+		    }
+		}
+
+	    } else {
+		# The general case for a mostly-X vector.
+
+		dydx = real(dy) / real(dx)
+		do x = x1, x2 {
+		    y = int ((x - x1) * dydx) + y1
+		    fbit = y * mf_pxsize + mf_physbit[x+1]
+		    word = fbit / BPW
+		    wbit = and (fbit, BPW-1)
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		}
+	    }
+
+	} else if (dy != 0) {
+	    if (y1 > y2) {
+		x1 = a_x2; x2 = a_x1; dx = -dx
+		y1 = a_y2; y2 = a_y1; dy = -dy
+	    }
+
+	    if (dx == 0) {
+		# Optimized code for the case of a vertical vector.
+
+		fbit = y1 * mf_pxsize + mf_physbit[x1+1]
+		word = fbit / BPW + 1
+		wbit = and (fbit, BPW-1)
+		wpln = (mf_pxsize + BPW-1) / BPW
+		mask = mf_bitmask[wbit+1]
+
+		do y = y1, y2 {
+		    mf_fbuf[word] = or (mf_fbuf[word], mask)
+		    word = word + wpln
+		}
+
+	    } else {
+		# The general case of a mostly-Y vector.
+
+		dxdy = real(dx) / real(dy)
+		do y = y1, y2 {
+		    x = int ((y - y1) * dxdy) + x1
+		    fbit = y * mf_pxsize + mf_physbit[x+1]
+		    word = fbit / BPW
+		    wbit = and (fbit, BPW-1)
+		    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+		}
+	    }
+
+	} else {
+	    # Plot a single point (dx=dy=0).
+
+	    fbit = y1 * mf_pxsize + mf_physbit[x1+1]
+	    word = fbit / BPW
+	    wbit = and (fbit, BPW-1)
+	    mf_fbuf[word+1] = or (mf_fbuf[word+1], mf_bitmask[wbit+1])
+	}
+end
+
+
+# SGK_LINEWIDTH -- Output a line width set instruction.
+
+procedure sgk_linewidth (fd, width)
+
+int	fd			# output stream [NOT USED]
+int	width			# new line width
+
+int	gap
+include	"sgk.com"
+
+begin
+	if (mf_bitmap) {
+	    # Set the line width in device pixels.
+	    mf_linewidth = max (1, mf_lworigin + int ((width-1) * mf_lwslope))
+
+	    # Set the clipping limits.  Allow for shifting to widen lines.
+	    gap = mf_linewidth - 1
+	    mf_xmin = mf_xorigin + gap
+	    mf_ymin = mf_yorigin + gap
+	    mf_xmax = mf_xorigin + (mf_wxsize - 1) - gap
+	    mf_ymax = mf_yorigin + (mf_wysize - 1) - gap
+
+	} else {
+	    if (mf_op + SGK_LENMCI > LEN_OBUF) {
+		call miiwrites (mf_fd, mf_obuf, mf_op-1)
+		mf_op = 1
+	    }
+
+	    mf_obuf[mf_op] = SGK_SETLW
+	    mf_obuf[mf_op+1] = width
+	    mf_obuf[mf_op+2] = 0
+	    mf_op = mf_op + SGK_LENMCI
+	}
+end
+
+
+# SGK_MKFNAME -- Make the name of file N of a multiframe set.
+
+procedure sgk_mkfname (root, num, outstr, maxch)
+
+char	root[ARB]		# root filename
+int	num			# file number
+char	outstr[maxch]		# receives new filename
+int	maxch
+
+begin
+	call sprintf (outstr, maxch, "%s.%d")
+	    call pargstr (root)
+	    call pargi (num)
+end
diff --git a/sys/gio/sgikern/t_sgideco.x b/sys/gio/sgikern/t_sgideco.x
new file mode 100644
index 00000000..57dae876
--- /dev/null
+++ b/sys/gio/sgikern/t_sgideco.x
@@ -0,0 +1,106 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+include	"sgk.h"
+
+define	LEN_MCBUF	3000
+
+
+# SGIDECODE -- Decode an SGI metacode file, printing the decoded metacode
+# instructions on the standard output.
+
+procedure t_sgidecode()
+
+pointer	sp, fname, mcbuf, ip, itop
+int	fd, list, verbose, gkiunits, nwords
+
+bool	clgetb()
+int	clpopni(), clgfil(), clplen(), open(), btoi(), miireads()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (mcbuf, LEN_MCBUF, TY_SHORT)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	if (clgetb ("generic")) {
+	    verbose = NO
+	    gkiunits = NO
+	} else {
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	}
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Print header if new file.
+	    if (clplen (list) > 1) {
+		call printf ("\n# METAFILE `%s':\n")
+		    call pargstr (Memc[fname])
+	    }
+
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode.
+
+	    itop = mcbuf
+	    ip   = mcbuf
+
+	    repeat {
+		if (ip >= itop) {
+		    # Refill buffer.
+		    nwords = miireads (fd, Mems[mcbuf], LEN_MCBUF)
+		    if (nwords == EOF)
+			break
+		    itop = mcbuf + nwords
+		    ip = mcbuf
+		}
+		
+		switch (Mems[ip]) {
+		case SGK_FRAME:
+		    call printf ("new_frame\n")
+		case SGK_MOVE:
+		    if (gkiunits == YES) {
+			call printf ("move (%d, %d)\n")
+			    call pargs (Mems[ip+1])
+			    call pargs (Mems[ip+2])
+		    } else {
+			call printf ("move (%0.5f, %0.5f)\n")
+			    call pargr (real(Mems[ip+1]) / real(GKI_MAXNDC))
+			    call pargr (real(Mems[ip+2]) / real(GKI_MAXNDC))
+		    }
+		case SGK_DRAW:
+		    if (gkiunits == YES) {
+			call printf ("draw (%d, %d)\n")
+			    call pargs (Mems[ip+1])
+			    call pargs (Mems[ip+2])
+		    } else {
+			call printf ("draw (%0.5f, %0.5f)\n")
+			    call pargr (real(Mems[ip+1]) / real(GKI_MAXNDC))
+			    call pargr (real(Mems[ip+2]) / real(GKI_MAXNDC))
+		    }
+		case SGK_SETLW:
+		    call printf ("set_linewidth (%d)\n")
+			call pargs (Mems[ip+1])
+		default:
+		    call printf ("unknown instruction\n")
+		}
+
+		ip = ip + SGK_LENMCI
+	    }
+
+	    call close (fd)
+	}
+
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/sgikern/t_sgikern.x b/sys/gio/sgikern/t_sgikern.x
new file mode 100644
index 00000000..359a87ad
--- /dev/null
+++ b/sys/gio/sgikern/t_sgikern.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+
+# SGIKERN -- Generic graphics kernel for the standard plotter output.  The whole
+# package is copied as much as possible from the stdgraph package.
+
+procedure t_sgikern()
+
+int	fd, list
+pointer	gki, sp, fname, devname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits
+bool	clgetb()
+int	clpopni(), clgfil(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+	if (clgetb ("generic")) {
+	    debug = NO
+	    verbose = NO
+	    gkiunits = NO
+	} else {
+	    debug   = btoi (clgetb ("debug"))
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	}
+
+	# Open the graphics kernel.
+	call sgi_open (Memc[devname], dev)
+	call gkp_install (deb, STDERR, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF) {
+		if (debug == YES)
+		    call gki_execute (Mems[gki], deb)
+		call gki_execute (Mems[gki], dev)
+	    }
+
+	    call close (fd)
+	}
+
+	call gkp_close()
+	call sgi_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/sgikern/x_sgikern.x b/sys/gio/sgikern/x_sgikern.x
new file mode 100644
index 00000000..797820c2
--- /dev/null
+++ b/sys/gio/sgikern/x_sgikern.x
@@ -0,0 +1,5 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	stdplot		= t_sgikern,
+	sgikern		= t_sgikern,
+	sgidecode	= t_sgidecode
diff --git a/sys/gio/stdgraph/README b/sys/gio/stdgraph/README
new file mode 100644
index 00000000..6007b9b1
--- /dev/null
+++ b/sys/gio/stdgraph/README
@@ -0,0 +1,77 @@
+gio$stdgraph
+
+    This directory contains the source and executables for the STDGRAPH and
+GKIDECODE graphics kernels.  The two kernels are implemented both as libraries
+and as executable tasks.
+
+	gkidecode	This kernel is used standalone to examine GKI
+			metafiles.  The real work is done by the GKIPRINT
+			library module in the GIO package.
+
+	stdgraph	A graphics kernel for graphics terminals.  Implemented
+			both as the library "libstdg.a" and as the kernel task
+			STDGRAPH.  The library is required for this kernel to
+			permit inclusion of the stdgraph kernel in the CL
+			process.
+
+Both kernels are available as CL callable tasks in the executable file
+x_kernel.e.
+
+
+GKIPRINT -- Graphics kernel for decoding metacode.  This graphics kernel
+formats metacode instructions into readable form and prints them on the output
+file.  The gkiprint kernel is useful for examining metafiles and for
+debugging kernels which drive specific devices.  The driver consists of the
+following procedures:
+
+	     gkp_openws (devname, n, mode)
+	    gkp_closews (devname, n)
+	    gkp_mftitle (title, n)			**
+	      gkp_clear (dummy)
+	     gkp_cancel (dummy)
+	      gkp_flush (dummy)
+	   gkp_polyline (p, npts)
+	 gkp_polymarker (p, npts)
+	       gkp_text (x, y, text, n)
+	   gkp_fillarea (p, npts)
+       gkp_getcellarray (m, nx, ny, x1,y1, x2,y2)
+       gkp_putcellarray (m, nx, ny, x1,y1, x2,y2)
+	  gkp_setcursor (x, y, cursor)
+	      gkp_plset (gki)
+	      gkp_pmset (gki)
+	      gkp_txset (gki)
+	      gkp_faset (gki)
+	  gkp_getcursor (cursor)
+	     gkp_escape (fn, instruction, nwords)	**
+	     gkp_setwcs (wcs, nwords)			**
+	     gkp_getwcs (wcs, nwords)			**
+	    gkp_unknown (gki)				**
+
+A GKI driven device driver may implement any subset of these procedures.
+The starred procedures should be omitted by most drivers.  In particular,
+the SETWCS and GETWCS instructions are internal instructions which should
+be ignored by ordinary device drivers.  The procedure names may be anything,
+but the arguments lists must be as shown.  All coordinates are in GKI units,
+0 to 32767.  Character strings are passed in ASCII, one character per metacode
+word.  Whenever a GKI character string appears as an array argument in the
+argument list of a procedure, the count N of the number of characters in the
+string follows as the next argument.  GKI character strings are not EOS
+delimited.  Polyline, polymarker, and fillarea data is passed as an array
+of (x,y) points P, in GKI coordinates, defining the polyline or polygon to
+be plotted.
+
+One additional procedure, GKP_INSTALL, is called by the main program of the
+graphics kernel task to install the debugging driver, i.e., to fill the DD
+array with the entry point addresses of the driver procedures.  For a normal
+driver this function is performed by a user supplied procedure named
+GKOPEN (graphics kernel open).  The user supplied kernel procedures will
+be called to execute each instruction as the instructions are decoded by the
+main routine.  The user supplied procedure GKCLOSE will be called when
+interpretation ends and the task is about to exit.
+
+		 gkopen (dd)
+		gkclose ()
+
+Do not confuse GKOPEN and GKCLOSE, which open and close the graphics kernel,
+with GKI_OPENWS and GKI_CLOSEWS, the metacode instructions used to direct
+an opened kernel to open and close workstations.
diff --git a/sys/gio/stdgraph/font.com b/sys/gio/stdgraph/font.com
new file mode 100644
index 00000000..ec1b0ec9
--- /dev/null
+++ b/sys/gio/stdgraph/font.com
@@ -0,0 +1,207 @@
+# CHRTAB -- Table of strokes for the printable ASCII characters.  Each character
+# is encoded as a series of strokes.  Each stroke is expressed by a single
+# integer containing the following bitfields:
+#
+#	2                   1
+#	0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 
+#	          | | | |         | |         |
+#		  | | | +---------+ +---------+
+#		  | | |      |           |
+#		  | | |      X           Y
+#		  | | |
+#	          | | +-- pen up/down
+#                 | +---- begin paint (not used at present)
+#                 +------ end paint (not used at present)
+#
+#------------------------------------------------------------------------------
+
+# Define the database.
+
+short	chridx[96]		# character index in chrtab
+short	chrtab[800]		# stroke data to draw the characters
+
+# Index into CHRTAB of each printable character (starting with SP).
+
+data    (chridx(i), i=01,05) /   1,   3,  12,  21,  30/
+data    (chridx(i), i=06,10) /  45,  66,  79,  85,  92/
+data    (chridx(i), i=11,15) /  99, 106, 111, 118, 121/
+data    (chridx(i), i=16,20) / 128, 131, 141, 145, 154/
+data    (chridx(i), i=21,25) / 168, 177, 187, 199, 203/
+data    (chridx(i), i=26,30) / 221, 233, 246, 259, 263/
+data    (chridx(i), i=31,35) / 268, 272, 287, 307, 314/
+data    (chridx(i), i=36,40) / 327, 336, 344, 352, 359/
+data    (chridx(i), i=41,45) / 371, 378, 385, 391, 398/
+data    (chridx(i), i=46,50) / 402, 408, 413, 425, 433/
+data    (chridx(i), i=51,55) / 445, 455, 468, 473, 480/
+data    (chridx(i), i=56,60) / 484, 490, 495, 501, 506/
+data    (chridx(i), i=61,65) / 511, 514, 519, 523, 526/
+data    (chridx(i), i=66,70) / 529, 543, 554, 563, 574/
+data    (chridx(i), i=71,75) / 585, 593, 607, 615, 625/
+data    (chridx(i), i=76,80) / 638, 645, 650, 663, 671/
+data    (chridx(i), i=81,85) / 681, 692, 703, 710, 723/
+data    (chridx(i), i=86,90) / 731, 739, 743, 749, 754/
+data    (chridx(i), i=91,95) / 759, 764, 776, 781, 793/
+data    (chridx(i), i=96,96) / 801/
+
+# Stroke data.
+
+data	(chrtab(i), i=001,005) /    36,  1764,   675, 29328,   585/
+data	(chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/
+data	(chrtab(i), i=011,015) /  1764,   355, 29023,   351, 29027/
+data	(chrtab(i), i=016,020) /   931, 29599,   927, 29603,  1764/
+data	(chrtab(i), i=021,025) /   603, 29066,   842, 29723,  1302/
+data	(chrtab(i), i=026,030) / 28886,   143, 29839,  1764,   611/
+data	(chrtab(i), i=031,035) / 29256,    78, 20810, 21322, 21581/
+data	(chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/
+data	(chrtab(i), i=041,045) / 20833, 21345, 29789,  1764,   419/
+data	(chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/
+data	(chrtab(i), i=051,055) / 21022, 21025, 20899,  1187, 28744/
+data	(chrtab(i), i=056,060) /   717, 21194, 21320, 21512, 21642/
+data	(chrtab(i), i=061,065) / 21645, 21519, 21327, 21197,  1764/
+data	(chrtab(i), i=066,070) /  1160, 20700, 20704, 20835, 21027/
+data	(chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/
+data	(chrtab(i), i=076,080) / 21192, 29841,  1764,   611, 21023/
+data	(chrtab(i), i=081,085) / 21087, 21155, 21091,  1764,   739/
+data	(chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/
+data	(chrtab(i), i=091,095) /  1764,   547, 21151, 21210, 21201/
+data	(chrtab(i), i=096,100) / 21132, 29192,  1764,    93, 29774/
+data	(chrtab(i), i=101,105) /   608, 29259,    78, 29789,  1764/
+data	(chrtab(i), i=106,110) /   604, 29260,    84, 29780,  1764/
+data	(chrtab(i), i=111,115) /   516, 21062, 21065, 21001, 21000/
+data	(chrtab(i), i=116,120) / 21064,  1764,    84, 29780,  1764/
+data	(chrtab(i), i=121,125) /   585, 21063, 21191, 21193, 21065/
+data	(chrtab(i), i=126,130) / 21191,  1764,    72, 29859,  1764/
+data	(chrtab(i), i=131,135) /   419, 20573, 20558, 20872, 21320/
+data	(chrtab(i), i=136,140) / 21646, 21661, 21347, 20899,  1764/
+data	(chrtab(i), i=141,145) /   221, 21155, 29320,  1764,    95/
+data	(chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/
+data	(chrtab(i), i=151,155) / 20552, 29832,  1764,    95, 20899/
+data	(chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/
+data	(chrtab(i), i=161,165) /   854,  5266, 21644, 21320, 20872/
+data	(chrtab(i), i=166,170) / 28749,  1764,   904, 21411, 21283/
+data	(chrtab(i), i=171,175) / 20561, 20559, 21391,   911, 13455/
+data	(chrtab(i), i=176,180) /  1764,   136, 21320, 21645, 21652/
+data	(chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/
+data	(chrtab(i), i=186,190) /  1764,    83, 20888, 21336, 21651/
+data	(chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/
+data	(chrtab(i), i=196,200) / 20635, 29347,  1764,    99, 21667/
+data	(chrtab(i), i=201,205) / 29064,  1764,   355, 20575, 20570/
+data	(chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/
+data	(chrtab(i), i=211,215) / 21644, 21650, 21398, 20822,   918/
+data	(chrtab(i), i=216,220) /  5274, 21663, 21411, 20835,  1764/
+data	(chrtab(i), i=221,225) /   648, 21584, 21656, 21662, 21347/
+data	(chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/
+data	(chrtab(i), i=231,235) / 21656,  1764,   602, 21210, 21207/
+data	(chrtab(i), i=236,240) / 21079, 21082, 21207,   592, 21069/
+data	(chrtab(i), i=241,245) / 21197, 21200, 21072, 21197,  1764/
+data	(chrtab(i), i=246,250) /   602, 21146, 21143, 21079, 21082/
+data	(chrtab(i), i=251,255) / 21143,   585, 21132, 21136, 21072/
+data	(chrtab(i), i=256,260) / 21071, 21135,  1764,   988, 20628/
+data	(chrtab(i), i=261,265) / 29644,  1764,  1112, 28824,   144/
+data	(chrtab(i), i=266,270) / 29776,  1764,   156, 21460, 28812/
+data	(chrtab(i), i=271,275) /  1764,   221, 20704, 20899, 21218/
+data	(chrtab(i), i=276,280) / 21471, 21466, 21011, 21007,   521/
+data	(chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/
+data	(chrtab(i), i=286,290) /  1764,   908, 20812, 20560, 20571/
+data	(chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/
+data	(chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/
+data	(chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/
+data	(chrtab(i), i=306,310) /  1764,    72, 20963, 21219, 29768/
+data	(chrtab(i), i=311,315) /   210,  5074,  1764,    99, 21411/
+data	(chrtab(i), i=316,320) / 21663, 21658, 21398, 20566,   918/
+data	(chrtab(i), i=321,325) /  5266, 21644, 21384, 20552, 20579/
+data	(chrtab(i), i=326,330) /  1764,  1165, 21320, 20872, 20557/
+data	(chrtab(i), i=331,335) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=336,340) /    99, 21347, 21662, 21645, 21320/
+data	(chrtab(i), i=341,345) / 20552, 20579,  1764,    99, 20552/
+data	(chrtab(i), i=346,350) / 29832,    86, 13078,    99, 29859/
+data	(chrtab(i), i=351,355) /  1764,    99, 20552,    86, 13078/
+data	(chrtab(i), i=356,360) /    99, 29859,  1764,   722, 21650/
+data	(chrtab(i), i=361,365) / 29832,  1165,  4936, 20872, 20557/
+data	(chrtab(i), i=366,370) / 20574, 20899, 21347, 29854,  1764/
+data	(chrtab(i), i=371,375) /    99, 28744,    85,  5269,  1160/
+data	(chrtab(i), i=376,380) / 29859,  1764,   291, 29603,   611/
+data	(chrtab(i), i=381,385) /  4680,   328, 29576,  1764,    77/
+data	(chrtab(i), i=386,390) / 20872, 21256, 21581, 29795,  1764/
+data	(chrtab(i), i=391,395) /    99, 28744,  1160, 20887,    82/
+data	(chrtab(i), i=396,400) / 13475,  1764,    99, 20552, 29832/
+data	(chrtab(i), i=401,405) /  1764,    72, 20579, 21077, 21603/
+data	(chrtab(i), i=406,410) / 29768,  1764,    72, 20579, 21640/
+data	(chrtab(i), i=411,415) / 29859,  1764,    94, 20899, 21347/
+data	(chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/
+data	(chrtab(i), i=421,425) / 20574,   862, 29859,  1764,    72/
+data	(chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/
+data	(chrtab(i), i=431,435) / 20564,  1764,    94, 20557, 20872/
+data	(chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/
+data	(chrtab(i), i=441,445) / 20574,   536, 29828,  1764,    72/
+data	(chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/
+data	(chrtab(i), i=451,455) / 20566,   918, 13448,  1764,    76/
+data	(chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/
+data	(chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/
+data	(chrtab(i), i=466,470) / 29855,  1764,   648, 21155,    99/
+data	(chrtab(i), i=471,475) / 29923,  1764,    99, 20557, 20872/
+data	(chrtab(i), i=476,480) / 21320, 21645, 29859,  1764,    99/
+data	(chrtab(i), i=481,485) / 21064, 29795,  1764,    99, 20808/
+data	(chrtab(i), i=486,490) / 21141, 21448, 29923,  1764,    99/
+data	(chrtab(i), i=491,495) / 29832,    72, 29859,  1764,    99/
+data	(chrtab(i), i=496,500) / 21079, 29256,   599, 13411,  1764/
+data	(chrtab(i), i=501,505) /    99, 21667, 20552, 29832,  1764/
+data	(chrtab(i), i=506,510) /   805, 20965, 20935, 29447,  1764/
+data	(chrtab(i), i=511,515) /    99, 29832,  1764,   421, 21221/
+data	(chrtab(i), i=516,520) / 21191, 29063,  1764,   288, 21091/
+data	(chrtab(i), i=521,525) / 29600,  1764,     3, 29891,  1764/
+data	(chrtab(i), i=526,530) /   547, 29341,  1764,   279, 21207/
+data	(chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/
+data	(chrtab(i), i=536,540) / 20558, 20753, 21201, 21391,   907/
+data	(chrtab(i), i=541,545) / 13447,  1764,    99, 28744,    76/
+data	(chrtab(i), i=546,550) /  4424, 21256, 21516, 21523, 21271/
+data	(chrtab(i), i=551,555) / 20823, 20563,  1764,   981, 21271/
+data	(chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/
+data	(chrtab(i), i=561,565) / 29642,  1764,  1043,  4887, 20823/
+data	(chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=571,575) /  1032, 29731,  1764,    80,  5136/
+data	(chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/
+data	(chrtab(i), i=581,585) / 20808, 21256, 29707,  1764,   215/
+data	(chrtab(i), i=586,590) / 29591,   456, 20958, 21153, 21409/
+data	(chrtab(i), i=591,595) / 29727,  1764,    67, 20800, 21248/
+data	(chrtab(i), i=596,600) / 21508, 29719,  1043, 21271, 20823/
+data	(chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=606,610) /  1764,    99, 28744,    83,  4439/
+data	(chrtab(i), i=611,615) / 21271, 21523, 29704,  1764,   541/
+data	(chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=621,625) /   533, 21077, 29256,  1764,   541/
+data	(chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/
+data	(chrtab(i), i=631,635) /   533, 21077, 21058, 20928, 20736/
+data	(chrtab(i), i=636,640) / 28802,  1764,    99, 28744,    84/
+data	(chrtab(i), i=641,645) / 29530,   342, 13320,  1764,   483/
+data	(chrtab(i), i=646,650) / 21089, 21066, 29384,  1764,    87/
+data	(chrtab(i), i=651,655) / 28744,   584, 21076,    84,  4375/
+data	(chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/
+data	(chrtab(i), i=661,665) / 29768,  1764,    87, 28744,    83/
+data	(chrtab(i), i=666,670) / 20823, 21271, 21523, 29704,  1764/
+data	(chrtab(i), i=671,675) /    83, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=676,680) / 21523, 21271, 20823, 20563,  1764/
+data	(chrtab(i), i=681,685) /    87, 28736,    83, 20823, 21271/
+data	(chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/
+data	(chrtab(i), i=691,695) /  1764,  1047, 29696,  1036, 21256/
+data	(chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/
+data	(chrtab(i), i=701,705) / 21523,  1764,    87, 28744,    83/
+data	(chrtab(i), i=706,710) / 20823, 21271, 29716,  1764,    74/
+data	(chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/
+data	(chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/
+data	(chrtab(i), i=721,725) / 21461,  1764,   279, 29591,   970/
+data	(chrtab(i), i=726,730) / 21320, 21128, 21002, 21025,  1764/
+data	(chrtab(i), i=731,735) /    87, 20556, 20808, 21256, 21516/
+data	(chrtab(i), i=736,740) /  1032, 29719,  1764,   151, 21064/
+data	(chrtab(i), i=741,745) / 29719,  1764,    87, 20808, 21077/
+data	(chrtab(i), i=746,750) / 21320, 29783,  1764,   151, 29704/
+data	(chrtab(i), i=751,755) /   136, 29719,  1764,    87, 21064/
+data	(chrtab(i), i=756,760) /   320, 29783,  1764,   151, 21527/
+data	(chrtab(i), i=761,765) / 20616, 29704,  1764,   805, 21157/
+data	(chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/
+data	(chrtab(i), i=771,775) / 21011, 21001, 21127, 21255,  1764/
+data	(chrtab(i), i=776,780) /   611, 29273,   594, 29256,  1764/
+data	(chrtab(i), i=781,785) /   485, 21093, 21218, 21209, 21271/
+data	(chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/
+data	(chrtab(i), i=791,795) / 29127,  1764,    83, 20758, 20950/
+data	(chrtab(i), i=796,800) / 21265, 21457, 29844,  1764,     0/
diff --git a/sys/gio/stdgraph/font.h b/sys/gio/stdgraph/font.h
new file mode 100644
index 00000000..c33dc6ee
--- /dev/null
+++ b/sys/gio/stdgraph/font.h
@@ -0,0 +1,29 @@
+# NCAR font definitions.
+
+define	CHARACTER_START 	32
+define	CHARACTER_END 		126
+define	CHARACTER_HEIGHT 	26
+define	CHARACTER_WIDTH 	17
+
+define	FONT_LEFT 		0
+define	FONT_CENTER 		9
+define	FONT_RIGHT 		27
+define	FONT_TOP 		36
+define	FONT_CAP 		34
+define	FONT_HALF 		23
+define	FONT_BASE 		9
+define	FONT_BOTTOM 		0
+define	FONT_WIDTH 		27
+define	FONT_HEIGHT 		36
+
+define	COORD_X_START 		7
+define	COORD_Y_START 		1
+define	COORD_PEN_START 	13
+define	COORD_X_LEN 		6
+define	COORD_Y_LEN 		6
+define	COORD_PEN_LEN 		1
+
+define	PAINT_BEGIN_START	14
+define	PAINT_END_START 	15
+define	PAINT_BEGIN_LEN 	1
+define	PAINT_END_LEN 		1
diff --git a/sys/gio/stdgraph/mkpkg b/sys/gio/stdgraph/mkpkg
new file mode 100644
index 00000000..8530f2c9
--- /dev/null
+++ b/sys/gio/stdgraph/mkpkg
@@ -0,0 +1,80 @@
+# Make the STDGRAPH GIO graphics kernel.
+
+$checkout libstg.a lib$
+$update   libstg.a
+$checkin  libstg.a lib$
+$exit
+
+update:					# update lib$x_stdgraph.e
+	$call	relink
+	$call	install
+	;
+
+relink:					# make x_stdgraph.e in local directory
+	$omake	x_stdgraph.x
+	$link	x_stdgraph.o -lstg
+	;
+
+install:				# install in system library
+	$move	x_stdgraph.e bin$
+	;
+
+libstg.a:
+	# $set xflags = "$(xflags) -qfx"
+
+	stgcancel.x	stdgraph.com stdgraph.h <fset.h>
+	stgclear.x	stdgraph.com stdgraph.h
+	stgclose.x	stdgraph.com stdgraph.h
+	stgclws.x	stdgraph.h <ttset.h> stdgraph.com
+	stgctrl.x	stdgraph.com stdgraph.h
+	stgdeact.x	stdgraph.com stdgraph.h <gset.h> <ttset.h>
+	stgdraw.x	stdgraph.com stdgraph.h
+	stgdrawch.x	font.com font.h stdgraph.com stdgraph.h <gki.h>\
+			<gset.h> <math.h>
+	stgencode.x	stdgraph.com stdgraph.h <ctype.h>
+	stgescape.x	
+	stgfa.x		stdgraph.com stdgraph.h
+	stgfaset.x	stdgraph.com stdgraph.h <gki.h>
+	stgfilter.x	stdgraph.com stdgraph.h <ttset.h> <chars.h> <fset.h>
+	stgflush.x	stdgraph.com stdgraph.h
+	stggcell.x	
+	stggcur.x	stdgraph.com stdgraph.h
+	stggdisab.x	stdgraph.com stdgraph.h
+	stggim.x	stdgraph.com stdgraph.h <chars.h> <ctype.h> <fset.h>\
+			<mach.h> <gescape.h> <gki.h> <gim.h>
+	stggenab.x	stdgraph.com stdgraph.h
+	stggrstr.x	stdgraph.com stdgraph.h
+	stginit.x	stdgraph.com stdgraph.h <ctype.h> <gki.h> <gset.h>\
+			<mach.h>
+	stglkcur.x	stdgraph.com stdgraph.h <gset.h>
+	stgmove.x	stdgraph.com stdgraph.h
+	stgonerr.x	stdgraph.com stdgraph.h
+	stgonint.x	stdgraph.h <config.h> <xwhen.h>
+	stgopen.x	stdgraph.com stdgraph.h <gki.h> <gset.h>
+	stgopenws.x	stdgraph.com stdgraph.h <error.h> <gki.h> <ttset.h>\
+			<chars.h> <finfo.h>
+	stgoutput.x	stdgraph.com stdgraph.h
+	stgoutstr.x	stdgraph.com stdgraph.h
+	stgpcell.x	stdgraph.com stdgraph.h <gki.h>
+	stgpl.x		stdgraph.com stdgraph.h
+	stgplset.x	stdgraph.com stdgraph.h <gki.h>
+	stgpm.x		stdgraph.com stdgraph.h
+	stgpmset.x	stdgraph.com stdgraph.h <gki.h>
+	stgrcur.x	stdgraph.com stdgraph.h <chars.h> <config.h> <error.h>\
+			<fset.h> <gki.h> <gset.h> <ttset.h>
+	stgreact.x	stdgraph.com stdgraph.h <gset.h> <ttset.h>
+	stgres.x	stdgraph.com stdgraph.h <gki.h>
+	stgreset.x	stdgraph.com stdgraph.h <gset.h>
+	stgrtty.x	stdgraph.com stdgraph.h <chars.h> <fset.h>
+	stgscur.x	stdgraph.com stdgraph.h
+	stgtx.x		stdgraph.com stdgraph.h <gki.h> <gset.h> <mach.h>\
+			<math.h>
+	stgtxqual.x	stdgraph.com stdgraph.h <gset.h>
+	stgtxset.x	stdgraph.com stdgraph.h <gki.h> <gset.h>
+	stgtxsize.x	stdgraph.com stdgraph.h <gki.h>
+	stgunkown.x	
+	stgwtty.x	stdgraph.com stdgraph.h <ctype.h> <chars.h>
+	t_gkideco.x	<error.h> <gki.h>
+	t_showcap.x	stdgraph.h <ctype.h>
+	t_stdgraph.x	<error.h> <gki.h> <gset.h>
+	;
diff --git a/sys/gio/stdgraph/stdgraph.com b/sys/gio/stdgraph/stdgraph.com
new file mode 100644
index 00000000..3d3c43c5
--- /dev/null
+++ b/sys/gio/stdgraph/stdgraph.com
@@ -0,0 +1,46 @@
+# STDGRAPH common.  A common is necessary since there is no graphics descriptor
+# in the argument list of the kernel procedures.  The stdgraph data structures
+# are designed along the lines of FIO: a small common is used to hold the time
+# critical data elements, and an auxiliary dynamically allocated descriptor is
+# used for everything else.  For maximum efficiency the polyline generation and
+# coordinate transformation datums are kept in the common.
+
+pointer	g_sg				# stdgraph graphics descriptor
+pointer	g_tty				# graphcap descriptor
+pointer	g_term				# termcap descriptor for terminal
+pointer	g_pbtty				# script graphcap, playback mode
+int	g_nopen				# open count for the kernel
+int	g_active			# workstation is open for graphics i/o
+int	g_enable			# graphics is enabled
+int	g_message			# message mode (output text)
+pointer	g_msgbuf			# message buffer (input text)
+int	g_msgbuflen			# allocated size of message buffer
+int	g_msglen			# amount of data in message
+int	g_keycol			# used to show keys in playback mode
+int	g_keyline			# used to show keys in playback mode
+pointer	g_xy				# pointer to coord encoding string
+int	g_stream			# graphics stream (metacode)
+int	g_in, g_out			# input, output streams to device
+int	g_ucaseout			# stty ucaseout status flag
+int	g_xres, g_yres			# desired device resolution
+int	g_dxres, g_dyres		# scale down to resolution coords
+real	g_dx, g_dy			# scale GKI to window coords
+int	g_x1, g_y1			# origin of device window
+int	g_x2, g_y2			# upper right corner of device window
+int	g_lastx, g_lasty		# used to clip unresolved points
+int	g_hardchar			# controls use of hardware character gen
+int	g_cursor			# user override of logical cursor
+int	g_reg[NREGISTERS]		# encoder registers
+char	g_mem[SZ_MEMORY]		# encoder memory
+char	g_device[SZ_GDEVICE]		# device name for forced device output
+char	g_pbdevice[SZ_GDEVICE]		# device name of playback script
+char	g_hixy[TEK_XRES]		# lookup tables for tek encoding
+char	g_lox[TEK_XRES]			# 	"		"
+char	g_loy[TEK_YRES]			# 	"		"
+
+common	/stgcom/ g_sg, g_tty, g_term, g_pbtty, g_nopen, g_active, g_enable,
+	g_message, g_msgbuf, g_msgbuflen, g_msglen,
+	g_keycol, g_keyline, g_xy, g_stream, g_in, g_out,
+	g_ucaseout, g_xres, g_yres, g_dxres, g_dyres, g_dx, g_dy, g_x1,
+	g_y1, g_x2, g_y2, g_lastx, g_lasty, g_hardchar, g_cursor, g_reg,
+	g_mem, g_device, g_pbdevice, g_hixy, g_lox, g_loy
diff --git a/sys/gio/stdgraph/stdgraph.h b/sys/gio/stdgraph/stdgraph.h
new file mode 100644
index 00000000..de216065
--- /dev/null
+++ b/sys/gio/stdgraph/stdgraph.h
@@ -0,0 +1,98 @@
+# STDGRAPH definitions.
+
+define	MAX_CHARSIZES	10			# max discreet device char sizes
+define	SZ_SBUF		2048			# initial string buffer size
+define	SZ_MEMORY	1024			# encoder memory size
+define	SZ_GDEVICE	256			# force output to named device
+define	SZ_UIFNAME	199			# user interface file name
+define	SZ_MSGBUF	4096			# default size message buffer
+define	FLUSH_MEMORY	117			# time to flush encoded polyline
+define	LEN_STACK	20			# encoder stack size
+define	NREGISTERS	12			# number of encoder registers
+define	E_IOP		11			# encoder i/o pointer register
+define	E_TOP		12			# encoder top memory register
+define	LONG_POLYLINE	50			# big enough to post X_INT
+define	PADCHAR		0			# used to gen. delays
+
+# The user can have private copies of UI specifications in GUIDIR.
+define	GUIDIR		"guidir"
+
+# The STDGRAPH state/device descriptor.
+
+define	LEN_SG		91
+
+define	SG_SBUF		Memi[$1]		# string buffer
+define	SG_SZSBUF	Memi[$1+1]		# size of string buffer
+define	SG_NEXTCH	Memi[$1+2]		# next char pos in string buf
+define	SG_NCHARSIZES	Memi[$1+3]		# number of character sizes
+define	SG_POLYLINE	Memi[$1+4]		# polyline output permitted
+define	SG_POLYMARKER	Memi[$1+5]		# device supports polymarker
+define	SG_FILLAREA	Memi[$1+6]		# device supports fillarea
+define	SG_ENCODEXY	Memi[$1+7]		# format for encoding coords
+define	SG_STARTDRAW	Memi[$1+8]		# pointer to DS string
+define	SG_ENDDRAW	Memi[$1+9]		# pointer to DE string
+define	SG_STARTMOVE	Memi[$1+10]		# pointer to VS string
+define	SG_ENDMOVE	Memi[$1+11]		# pointer to VE string
+define	SG_STARTMARK	Memi[$1+12]		# pointer to MS string
+define	SG_ENDMARK	Memi[$1+13]		# pointer to ME string
+define	SG_STARTFILL	Memi[$1+14]		# pointer to FS string
+define	SG_ENDFILL	Memi[$1+15]		# pointer to FE string
+define	SG_STARTTEXT	Memi[$1+16]		# start text draw
+define	SG_ENDTEXT	Memi[$1+17]		# end text draw
+define	SG_CURSOR	Memi[$1+18]		# last cursor accessed
+define	SG_UPDCURSOR	Memi[$1+19]		# update cursor pos before read
+define	SG_CURSOR_X	Memi[$1+20]		# current cursor X position
+define	SG_CURSOR_Y	Memi[$1+21]		# current cursor Y position
+define	SG_COLOR	Memi[$1+22]		# last color set
+define	SG_TXSIZE	Memi[$1+23]		# last text size set
+define	SG_TXFONT	Memi[$1+24]		# last text font set
+define	SG_PLTYPE	Memi[$1+25]		# last line type set
+define	SG_FASTYLE	Memi[$1+26]		# last fill area style set
+define	SG_PLWIDTH	Memi[$1+27]		# last line width set
+define	SG_DEVNAME	Memi[$1+28]		# name of open device
+define	SG_UIFNAME	Memi[$1+29]		# user interface file name
+define	SG_UIFDATE	Memi[$1+30]		# UI file date
+			# empty
+define	SG_CHARHEIGHT	Memi[$1+40+$2-1]	# character height
+define	SG_CHARWIDTH 	Memi[$1+50+$2-1]	# character width
+define	SG_CHARSIZE	Memr[P2R($1+60+$2-1)]	# text sizes permitted
+define	SG_PLAP		($1+70)			# polyline attributes
+define	SG_PMAP		($1+74)			# polymarker attributes
+define	SG_FAAP		($1+78)			# fill area attributes
+define	SG_TXAP		($1+81)			# default text attributes
+
+# Substructure definitions.
+
+define	LEN_PL		4
+define	PL_STATE	Memi[$1]		# polyline attributes
+define	PL_LTYPE	Memi[$1+1]
+define	PL_WIDTH	Memi[$1+2]
+define	PL_COLOR	Memi[$1+3]
+
+define	LEN_PM		4
+define	PM_STATE	Memi[$1]		# polymarker attributes
+define	PM_LTYPE	Memi[$1+1]
+define	PM_WIDTH	Memi[$1+2]
+define	PM_COLOR	Memi[$1+3]
+
+define	LEN_FA		3			# fill area attributes
+define	FA_STATE	Memi[$1]
+define	FA_STYLE	Memi[$1+1]
+define	FA_COLOR	Memi[$1+2]
+
+define	LEN_TX		10			# text attributes
+define	TX_STATE	Memi[$1]
+define	TX_UP		Memi[$1+1]
+define	TX_SIZE		Memi[$1+2]
+define	TX_PATH		Memi[$1+3]
+define	TX_SPACING	Memr[P2R($1+4)]
+define	TX_HJUSTIFY	Memi[$1+5]
+define	TX_VJUSTIFY	Memi[$1+6]
+define	TX_FONT		Memi[$1+7]
+define	TX_QUALITY	Memi[$1+8]
+define	TX_COLOR	Memi[$1+9]
+
+# TEK 4012 definitions for optimized tek coordinate encoding.
+
+define	TEK_XRES	1024
+define	TEK_YRES	780
diff --git a/sys/gio/stdgraph/stgcancel.x b/sys/gio/stdgraph/stgcancel.x
new file mode 100644
index 00000000..d47e24df
--- /dev/null
+++ b/sys/gio/stdgraph/stgcancel.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	"stdgraph.h"
+
+# STG_CANCEL -- Cancel any buffered output.
+
+procedure stg_cancel (dummy)
+
+int	dummy			# not used at present
+include	"stdgraph.com"
+
+begin
+	call fseti (g_out, F_CANCEL, YES)
+	call stg_reset()
+end
diff --git a/sys/gio/stdgraph/stgclear.x b/sys/gio/stdgraph/stgclear.x
new file mode 100644
index 00000000..9573c972
--- /dev/null
+++ b/sys/gio/stdgraph/stgclear.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_CLEAR -- Clear the workstation screen.  All attribute packets are
+# initialized to their default values when the screen is cleared.
+
+procedure stg_clear (dummy)
+
+int	dummy			# not used at present
+include	"stdgraph.com"
+
+begin
+	call stg_ctrl ("CL")
+	call stg_reset()
+end
diff --git a/sys/gio/stdgraph/stgclose.x b/sys/gio/stdgraph/stgclose.x
new file mode 100644
index 00000000..3d7eb70b
--- /dev/null
+++ b/sys/gio/stdgraph/stgclose.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_CLOSE -- Close the STDGRAPH kernel.  Free all storage associated with the
+# stdgraph descriptor.  Note that the stdgraph kernel may be multiply opened
+# (connected to two or more graphics steams, e.g., both STDGRAPH and STDIMAGE),
+# hence we do not physically close down until the last stream is closed.
+
+procedure stg_close()
+
+include	"stdgraph.com"
+
+begin
+	g_nopen = g_nopen - 1
+
+	if (g_nopen <= 0) {
+	    call stg_deactivatews (0)
+	    call flush (g_out)
+	    call mfree (SG_SBUF(g_sg), TY_CHAR)
+	    call mfree (g_sg, TY_STRUCT)
+
+	    if (g_tty != NULL) {
+		call ttycdes (g_tty)
+		g_tty = NULL
+	    }
+
+	    if (g_term != NULL) {
+		call ttycdes (g_term)
+		g_term = NULL
+	    }
+
+	    if (g_pbtty != NULL) {
+		call ttycdes (g_pbtty)
+		g_pbtty = NULL
+	    }
+
+	    if (g_msgbuf != NULL) {
+		call mfree (g_msgbuf, TY_CHAR)
+		g_msgbuf = NULL
+		g_msgbuflen = 0
+		g_msglen = 0
+	    }
+
+	    g_nopen = 0
+	}
+end
diff --git a/sys/gio/stdgraph/stgclws.x b/sys/gio/stdgraph/stgclws.x
new file mode 100644
index 00000000..137784cd
--- /dev/null
+++ b/sys/gio/stdgraph/stgclws.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttset.h>
+include	"stdgraph.h"
+
+# STG_CLOSEWS -- Close the named workstation.  Output the termination string,
+# if any, and flush the output.  Buffer deallocation is handled by STGCLOSE.
+
+procedure stg_closews (devname, n)
+
+short	devname[ARB]		# device name (not used)
+int	n			# length of device name
+
+include "stdgraph.com"
+
+begin
+	call stg_ctrl ("CW")
+	call flush (g_out)
+
+	g_active = NO
+	g_enable = NO
+
+	# Reenable stty ucaseout mode if it was set when the workstation
+	# was activated.
+
+	if (g_ucaseout == YES)
+	    call ttseti (g_out, TT_UCASEOUT, YES)
+end
diff --git a/sys/gio/stdgraph/stgctrl.x b/sys/gio/stdgraph/stgctrl.x
new file mode 100644
index 00000000..6689de8a
--- /dev/null
+++ b/sys/gio/stdgraph/stgctrl.x
@@ -0,0 +1,82 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+define	SZ_PROGRAM	256
+
+# STG_CTRL -- Fetch an encoder format string from the graphcap entry and
+# use it to encode zero, one, or two integer arguments into a control string.
+# Put the control string to the output device.
+
+procedure stg_ctrl (cap)
+
+char	cap[ARB]		# name of device capability to be encoded
+pointer	sp, prog
+int	stg_encode(), ttygets()
+include	"stdgraph.com"
+
+begin
+	call smark (sp)
+	call salloc (prog, SZ_PROGRAM, TY_CHAR)
+
+	# Fetch the program from the graphcap file.  Zero is returned if the
+	# device does not have the named capability, in which case the function
+	# is inapplicable and should be ignored.
+
+	if (ttygets (g_tty, cap, Memc[prog], SZ_PROGRAM) > 0) {
+	    # Encode the output string and write the encoded string to the
+	    # output file.
+	    g_reg[E_IOP] = 1
+	    if (stg_encode (Memc[prog], g_mem, g_reg) == OK) {
+		g_mem[g_reg[E_IOP]] = EOS
+		call ttyputs (g_out, g_tty, g_mem, 1)
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STG_CTRL1 -- Encode one integer argument.
+
+procedure stg_ctrl1 (cap, arg1)
+
+char	cap[ARB]		# device capability
+int	arg1
+include	"stdgraph.com"
+
+begin
+	g_reg[1] = arg1
+	call stg_ctrl (cap)
+end
+
+
+# STG_CTRL2 -- Encode two integer arguments.
+
+procedure stg_ctrl2 (cap, arg1, arg2)
+
+char	cap[ARB]		# device capability
+int	arg1, arg2
+include	"stdgraph.com"
+
+begin
+	g_reg[1] = arg1
+	g_reg[2] = arg2
+	call stg_ctrl (cap)
+end
+
+
+# STG_CTRL3 -- Encode three integer arguments.
+
+procedure stg_ctrl3 (cap, arg1, arg2, arg3)
+
+char	cap[ARB]		# device capability
+int	arg1, arg2, arg3
+include	"stdgraph.com"
+
+begin
+	g_reg[1] = arg1
+	g_reg[2] = arg2
+	g_reg[3] = arg3
+	call stg_ctrl (cap)
+end
diff --git a/sys/gio/stdgraph/stgdeact.x b/sys/gio/stdgraph/stgdeact.x
new file mode 100644
index 00000000..b11e4a07
--- /dev/null
+++ b/sys/gio/stdgraph/stgdeact.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttset.h>
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_DEACTIVATEWS -- Deactivate the workstation, i.e., disable graphics,
+# leaving the terminal in text mode.  Note that it is the CW (close
+# workstation) sequence which is actually output, since the GD sequence is
+# used only to write single lines of text to the status line.
+
+procedure stg_deactivatews (flags)
+
+int	flags			# action modifier flags
+
+char	buf[1]
+int	stg_readtty(), and()
+include	"stdgraph.com"
+
+begin
+	if (g_out <= 0)
+	    return
+
+	# The g_active and g_out test permits us to be called before the
+	# kernel is opened and causes redundant calls to be ignored.
+
+	if (g_active == YES) {
+	    # Pause before deactivating?
+	    if (and (flags, AW_PAUSE) != 0) {
+		call stg_putline (g_out, "\n[Hit return to continue]\n")
+		while (stg_readtty (STDIN, buf, 1) != EOF)
+		    if (buf[1] == '\r' || buf[1] == '\n')
+			break
+	    }
+
+	    # Deactivate the workstation.
+	    call stgctrl ("CW")
+
+	    g_active = NO
+	    g_enable = NO
+
+	    # Reenable stty ucaseout mode if it was set when the workstation
+	    # was activated.
+
+	    if (g_ucaseout == YES)
+		call ttseti (g_out, TT_UCASEOUT, YES)
+	}
+
+	# Clear the text screen?
+	if (and (flags, AW_CLEAR) != 0 && g_term != NULL)
+	    call ttyclear (g_out, g_term)
+
+	call flush (g_out)
+end
diff --git a/sys/gio/stdgraph/stgdraw.x b/sys/gio/stdgraph/stgdraw.x
new file mode 100644
index 00000000..ae5a4ace
--- /dev/null
+++ b/sys/gio/stdgraph/stgdraw.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_DRAW -- Output a device draw line-segment instruction to draw from the
+# current position to the position (x,y) in GKI coordinates.
+
+procedure stg_draw (x, y)
+
+int	x, y			# destination
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	# Transform the first point from GKI coords to device coords and
+	# draw to the transformed point.
+
+	call ttyputs (g_out, g_tty, Memc[SG_STARTDRAW(g_sg)], 1)
+
+	g_reg[1] = x * g_dx + g_x1
+	g_reg[2] = y * g_dy + g_y1
+	g_reg[E_IOP] = 1
+	if (stg_encode (Memc[g_xy], g_mem, g_reg) == OK)
+	    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+	
+	call ttyputs (g_out, g_tty, Memc[SG_ENDDRAW(g_sg)], 1)
+end
diff --git a/sys/gio/stdgraph/stgdrawch.x b/sys/gio/stdgraph/stgdrawch.x
new file mode 100644
index 00000000..fd317d2b
--- /dev/null
+++ b/sys/gio/stdgraph/stgdrawch.x
@@ -0,0 +1,144 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<gset.h>
+include	<gki.h>
+include	"stdgraph.h"
+include	"font.h"
+
+define	ITALIC_TILT	0.30	# fraction of xsize to tilt italics at top
+define	MAXPTS		40	# max points in a char drawing polyline
+
+
+# STG_DRAWCHAR -- Draw a character of the given size and orientation at the
+# given position.
+
+procedure stg_drawchar (ch, x, y, xsize, ysize, orien, font)
+
+char	ch			# character to be drawn
+int	x, y			# lower left GKI coords of character
+int	xsize, ysize		# width, height of char in GKI units
+int	orien			# orientation of character (0 degrees normal)
+int	font			# desired character font
+
+pointer	pl, tx
+real	px, py, coso, sino, theta
+int	stroke, tab1, tab2, i, pen, mx, my
+int	save_ltype, save_lwidth, save_color
+int	bitupk()
+include	"font.com"
+include	"stdgraph.com"
+
+begin
+	if (ch < CHARACTER_START || ch > CHARACTER_END)
+	    i = '?' - CHARACTER_START + 1
+	else
+	    i = ch  - CHARACTER_START + 1
+
+	# Set the font.
+	if (SG_TXFONT(g_sg) != font) {
+	    call stg_ctrl1 ("TF", font - GT_ROMAN + 1)
+	    SG_TXFONT(g_sg) = font
+	}
+
+	# Since we will be using the polyline generator, set the polyline
+	# linetype to solid and save the current linetype for later restoration.
+
+	pl = SG_PLAP(g_sg)
+	tx = SG_TXAP(g_sg)
+	save_color = PL_COLOR(pl)
+	save_ltype = PL_LTYPE(pl)
+	save_lwidth = PL_WIDTH(pl)
+	PL_COLOR(pl) = TX_COLOR(tx)
+	PL_LTYPE(pl) = GL_SOLID
+	PL_WIDTH(pl) = 1
+
+	tab1 = chridx[i]
+	tab2 = chridx[i+1] - 1
+
+	theta = -DEGTORAD(orien)
+	coso = cos(theta)
+	sino = sin(theta)
+
+	do i = tab1, tab2 {
+	    stroke = chrtab[i]
+	    px  = bitupk (stroke, COORD_X_START,   COORD_X_LEN)
+	    py  = bitupk (stroke, COORD_Y_START,   COORD_Y_LEN)
+	    pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+	    # Scale size of character.
+	    px = px / FONT_WIDTH  * xsize
+	    py = py / FONT_HEIGHT * ysize
+
+	    # The italic font is implemented applying a tilt.
+	    if (font == GT_ITALIC)
+		px = px + ((py / ysize) * xsize * ITALIC_TILT)
+
+	    # Rotate and shift.
+	    mx = x + px * coso + py * sino
+	    my = y - px * sino + py * coso
+
+	    # Draw the line segment or move pen.
+	    if (pen == 0)
+		call sgch_move (mx, my)
+	    else
+		call sgch_draw (mx, my)
+	}
+
+	# Flush any remaining points.
+	call sgch_flush()
+
+	# Restore polyline linetype and color.
+	PL_LTYPE(pl) = save_ltype
+	PL_WIDTH(pl) = save_lwidth
+	PL_COLOR(pl) = save_color
+end
+
+
+# SGCH_MOVE -- Start accumulating a new polyline.
+
+procedure sgch_move (mx, my)
+
+int	mx, my
+short	pl[MAXPTS], op
+common	/sgchcm/ pl, op
+
+begin
+	call sgch_flush()
+
+	pl[1] = mx
+	pl[2] = my
+	op = 3
+end
+
+
+# SGCH_DRAW -- Add a point to the polyline.
+
+procedure sgch_draw (mx, my)
+
+int	mx, my
+short	pl[MAXPTS], op
+common	/sgchcm/ pl, op
+
+begin
+	pl[op] = mx
+	pl[op+1] = my
+	op = min (MAXPTS, op + 2)
+end
+
+
+# SGCH_FLUSH -- Flush the polyline to the output device.
+
+procedure sgch_flush()
+
+int	npts
+short	pl[MAXPTS], op
+common	/sgchcm/ pl, op
+
+begin
+	if (op > 2) {
+	    npts = op / 2
+	    call stg_polyline (pl, npts)
+	}
+	op = 1
+end
diff --git a/sys/gio/stdgraph/stgencode.x b/sys/gio/stdgraph/stgencode.x
new file mode 100644
index 00000000..3c7a6ffb
--- /dev/null
+++ b/sys/gio/stdgraph/stgencode.x
@@ -0,0 +1,539 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stdgraph.h"
+
+.help stg_encode
+.nf _________________________________________________________________________
+STG_ENCODE -- Table driven binary encoder/decoder.  The encoder (which can
+also decode) processes a format string, also referred to as a program, to
+either encode an output string or decode an input string.  Internally the
+encoder operates in two modes, copy mode and execute mode.  In copy mode
+all format characters are copied to the output except the following special
+characters:
+
+	'	escape next character (literal)
+	%	begin a formatted output string
+	(	switch to execute mode (stack driven, RPN interpreter)
+
+An ( appearing in the format string causes a mode switch to execute mode.
+In execute mode characters are metacode instructions to be executed.  An
+unescaped ) causes reversion to copy mode.  Parens may not be nested; an
+( in execute mode is an instruction to push the binary value of ( on the
+stack, and an ) in copy mode is copied to the output as a character.  In
+execute mode the following characters are recognized as special instructions.
+All other characters are instructions too, telling the encoder to push the
+ASCII value of the character on the stack.
+
+	'	escape next character (recognized everywhere)
+	%	formatted output
+	)	revert to copy mode
+	#nnn	push signed decimal integer number nnn
+	$ 	switch case construct
+	.	pop number from stack and place in output string
+	,	get next character from input string and push on stack
+	&	modulus (similar to AND of low bits)
+	+	add (similar to OR)
+	-	subtract (similar to AND)
+	*	multiply (shift left if pwr of 2)
+	/	divide (shift right if pwr of 2)
+	<	less than (0=false, 1=true)
+	> 	greater than (0=false, 1=true)
+	=	equals (0=false, 1=true)
+	;	branch if: <bool> <offset> ;.  The ; is at offset zero.
+       0-9	push register
+	!N	pop stack into register N
+	!!	pop N from stack and output an N millisecond delay
+
+The encoder communicates with the outside world via three general purpose
+data structures.
+
+	registers	0-9 (integer only)
+	memory		char array
+	program		char array
+
+The registers are used for parameter input and output as well as for storing
+intermediate results.  R 1-3 are used for input and output arguments.  R 4-9
+and R0 (R10) are reserved for use by the program.  R11 is the i/o pointer into
+encoder memory, used for character input and output.  R12 should contain the
+maximum memory address upon input.  Memory may be used for anything but is
+normally used only for the input string or output string.  The program is the
+format string.
+
+Further documentation is given in the GIO reference manual.
+.endhelp _____________________________________________________________________
+
+define	SZ_FORMAT	10		# max length printf format
+define	SZ_NUMSTR	10		# encoded numeric string
+
+define	R1	registers[1]		# argument
+define	R2	registers[2]		# argument
+define	R3	registers[3]		# argument
+define	R4	registers[4]		# scratch
+define	R5	registers[5]		# scratch
+define	R6	registers[6]		# scratch
+define	R7	registers[7]		# scratch
+define	R8	registers[8]		# scratch
+define	R9	registers[9]		# scratch
+define	R0	registers[10]		# scratch
+define	IOP	registers[11]		# i/o pointer into encoder memory
+define	TOP	registers[12]		# max memory location
+
+# Inline macros.
+
+define	memory_overflow_	1
+define	stack_underflow_	2
+define	stack_overflow_		3
+
+define	input	{$1=memory[iop];iop=iop+1}
+define	output	{memory[iop]=($1);iop=iop+1;if(iop>top)goto memory_overflow_}
+define	push	{stack[sp]=($1);sp=sp+1}
+define	pop	{sp=sp-1;$1=stack[sp]}
+
+
+# STG_ENCODE -- Interpret a program, encoding values passed in registers into
+# memory, or decoding memory into registers.
+
+int procedure stg_encode (program, memory, registers)
+
+char	program[ARB]			# program to be executed
+char	memory[ARB]			# data space
+int	registers[NREGISTERS]		# general purpose registers
+
+int	x, y, num, ch, status
+int	stack[LEN_STACK]
+int	sp, pc, iop, top, incase
+common	/sgecom/ pc, sp, iop, top, incase, stack
+int	sge_execute()
+include	"stdgraph.com"
+
+begin
+	# TEK format, %t.  This format deserves special treatment due to the
+	# prevalence of tektronix compatible graphics terminals.
+
+	if (program[1] == '%' && program[2] == 't') {
+	    x = R1
+	    y = R2
+	    iop = IOP + 4
+	    if (iop > top)
+		goto memory_overflow_
+
+	    memory[iop-4] = g_hixy[y+1]
+	    memory[iop-3] = g_loy[y+1]
+	    memory[iop-2] = g_hixy[x+1]
+	    memory[iop-1] = g_lox[x+1]
+
+	    IOP = iop
+	    if (program[3] == EOS)
+		return (OK)
+	}
+
+	# Process a general format string (as well as any chars following the
+	# %t format).
+
+	incase = NO
+	iop    = IOP
+	top    = TOP
+	pc     = 1
+	sp     = 1
+
+	for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+	    pc = pc + 1
+	    if (ch == '%' && program[pc] != EOS) {
+		if (program[pc] == 't') {
+		    # Tek format again.
+		    pc = pc + 1
+		    x = R1
+		    y = R2
+		    iop = iop + 4
+		    if (iop > top)
+			goto memory_overflow_
+
+		    memory[iop-4] = g_hixy[y+1]
+		    memory[iop-3] = g_loy[y+1]
+		    memory[iop-2] = g_hixy[x+1]
+		    memory[iop-1] = g_lox[x+1]
+
+		} else {
+		    # Extract a general format specification and use it to
+		    # encode the number on top of the stack.
+		    pop (num)
+		    if (sp < 1) {
+			IOP = iop
+			return (stack_underflow_)
+		    } else
+			call sge_printf (num, memory, iop, top, program, pc)
+		}
+
+	    } else if (ch == '(' && program[pc] != EOS) {
+		# Switch to execute mode.
+		status = sge_execute (program, memory, registers)
+		if (status != OK)
+		    return (status)
+
+	    } else if (ch == '\'' && program[pc] != EOS) {
+		# Escape next character.
+		output (program[pc])
+		pc = pc + 1
+
+	    } else {
+		# Copy an ordinary character to the output string.
+		output (ch)
+	    }
+	}
+
+	IOP = iop
+	return (OK)
+
+memory_overflow_
+	IOP = iop
+	return (memory_overflow_)
+end
+
+
+# SGE_EXECUTE -- Execute a metacode program stored in encoder memory starting
+# at the location of the PC.  The stack, program counter, i/o pointer, and
+# registers are shared by the copy and execute mode procedures via common.
+
+int procedure sge_execute (program, memory, registers)
+
+char	program[ARB]			# program to be executed
+char	memory[ARB]			# data space
+int	registers[NREGISTERS]		# general purpose registers
+
+int	num, ch, a, b, neg, x, y
+int	stack[LEN_STACK]
+int	sp, pc, iop, top, incase, msec, npad, baud, envgeti(), btoi()
+common	/sgecom/ pc, sp, iop, top, incase, stack
+include	"stdgraph.com"
+errchk	envgeti
+
+begin
+	# Execute successive single character instructions until either ) or
+	# EOS is seen.  On a good host machine this case will be compiled as
+	# a vectored goto with a loop overhead of only a dozen or so machine
+	# instructions per loop.
+
+	for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+	    pc = pc + 1
+
+	    switch (ch) {
+	    case '\'':
+		# Escape next character (recognized everywhere).
+		ch = program[pc]
+		if (ch != EOS) {
+		    # Push ASCII value of character.
+		    push (ch)
+		    pc = pc + 1
+		}
+
+	    case '%':
+		if (program[pc] == 't') {
+		    # Tek format again.
+		    pc = pc + 1
+		    x = R1
+		    y = R2
+		    iop = iop + 4
+		    if (iop > top)
+			goto memory_overflow_
+
+		    memory[iop-4] = g_hixy[y+1]
+		    memory[iop-3] = g_loy[y+1]
+		    memory[iop-2] = g_hixy[x+1]
+		    memory[iop-1] = g_lox[x+1]
+
+		} else {
+		    # Formatted output.
+		    if (program[pc] != EOS) {
+			pop (num)
+			call sge_printf (num, memory, iop, top, program, pc)
+		    } else
+			output (ch)
+		}
+
+	    case ')':
+		# End interpreter mode.
+		return (OK)
+
+	    case '#':
+		# Push signed decimal integer number.
+		neg = NO
+		if (program[pc] == '-') {
+		    neg = YES
+		    pc = pc + 1
+		}
+
+		num = 0
+		while (IS_DIGIT (program[pc])) {
+		    num = num * 10 + TO_INTEG (program[pc])
+		    pc = pc + 1
+		}
+
+		if (neg == YES)
+		    push (-num)
+		else
+		    push (num)
+
+	    case '$':
+		# Switch case instruction.
+
+		if (incase == NO) {
+		    # Pop the switch off the stack.
+		    pop (num)
+
+		    # Search for case number 'num'.
+		    for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+			if (ch == '$') {
+			    # End of switch statement.
+			    pc = pc + 1
+			    incase = NO
+			    break
+
+			} else if (program[pc+1] == '-') {
+			    # Range of cases.
+			    a = TO_INTEG (ch)
+			    b = TO_INTEG (program[pc+2])
+			    pc = pc + 3
+			    if (a <= num && num <= b) {
+				incase = YES
+				break
+			    }
+			} else if (ch == 'D' || TO_INTEG(ch) == num) {
+			    # Default or requested case.
+			    pc = pc + 1
+			    incase = YES
+			    break
+
+			}
+
+			# Advance to the next case.  Leave pc pointing to the
+			# N of case $N.
+
+			if (ch != '$' && incase == NO) {
+			    while (program[pc] != EOS && program[pc] != '$')
+				pc = pc + 1
+			    if (program[pc] == '$')
+				pc = pc + 1
+			}
+		    }
+
+		} else {
+		    # $ encountered delimiting a case.  Search forward for
+		    # $$ or EOS.
+
+		    if (program[pc] != '$')
+			for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+			    pc = pc + 1
+			    if (ch == '$' && program[pc] == '$')
+				break
+			}
+
+		    if (program[pc] == '$')
+			pc = pc + 1
+
+		    incase = NO
+		}
+
+	    case '.':
+		# Pop number from stack and place in output string as a
+		# binary character.
+		pop (num)
+		output (num)
+
+	    case ',':
+		# Get next character from input string and push on stack.
+		input (num)
+		push (num)
+
+	    case '&':
+		# Modulus (similar to AND of low bits).
+		pop (b)
+		pop (a)
+		push (mod (a, b))
+
+	    case '+':
+		# Add (similar to OR).
+		pop (b)
+		pop (a)
+		push (a + b)
+
+	    case '-':
+		# Subtract (similar to AND).
+		pop (b)
+		pop (a)
+		push (a - b)
+
+	    case '*':
+		# Multiply (shift left if pwr of 2).
+		pop (b)
+		pop (a)
+		push (a * b)
+
+	    case '/':
+		# Divide (shift right if pwr of 2).
+		pop (b)
+		pop (a)
+		push (a / b)
+
+	    case '<':
+		# Less than (0=false, 1=true).
+		pop (b)
+		pop (a)
+		push (btoi (a < b))
+
+	    case '>':
+		# Greater than (0=false, 1=true).
+		pop (b)
+		pop (a)
+		push (btoi (a > b))
+
+	    case '=':
+		# Equals (0=false, 1=true).
+		pop (b)
+		pop (a)
+		push (btoi (a == b))
+
+	    case ';':
+		# If 2nd value on stack is true add 1st value on stack to PC.
+		# Example: "12<#-8;".  The ; is at offset zero.
+		pop (a)
+		pop (b)
+		if (b != 0)
+		    pc = pc - 1 + a
+
+	    case '0':
+		# Push contents of register 0 (10).
+		push (R0)
+	    case '1':
+		# Push contents of register 1.
+		push (R1)
+	    case '2':
+		# Push contents of register 2.
+		push (R2)
+	    case '3':
+		# Push contents of register 3.
+		push (R3)
+	    case '4':
+		# Push contents of register 4.
+		push (R4)
+	    case '5':
+		# Push contents of register 5.
+		push (R5)
+	    case '6':
+		# Push contents of register 6.
+		push (R6)
+	    case '7':
+		# Push contents of register 7.
+		push (R7)
+	    case '8':
+		# Push contents of register 8.
+		push (R8)
+	    case '9':
+		# Push contents of register 9.
+		push (R9)
+
+	    case '!':
+		if (program[pc] == '!') {
+		    # !!: Pop stack and generate delay.
+		    pc = pc + 1
+		    pop (msec)
+		    iferr (baud = envgeti ("ttybaud"))
+			baud = 9600
+		    npad = real(msec) * (real(baud) / 8. / 1000.)
+		    while (npad > 0) {
+			output (PADCHAR)
+			npad = npad - 1
+		    }
+		} else {
+		    # !N: Pop stack into register N.
+		    num = TO_INTEG (program[pc])
+		    if (num >= 0 && num <= 9) {
+			if (num == 0)
+			    num = 10
+			pop (registers[num])
+			pc = pc + 1
+		    } else
+			output (ch)
+		}
+
+	    default:
+		# Push ASCII value of character.
+		push (ch)
+	    }
+
+	    if (sp <= 0)
+		return (stack_underflow_)
+	    if (sp > LEN_STACK)
+		return (stack_overflow_)
+	}
+
+	return (OK)
+
+memory_overflow_
+	return (memory_overflow_)
+end
+
+
+# SGE_PRINTF -- Process a %.. format specification.  The number to be encoded
+# has already been popped from the stack into the first argument.  The encoded
+# number is returned in memory at IOP, leaving IOP positioned to the first
+# char following the encoded number.  The format used to encode the number is
+# extracted from the program starting at PC.  PC is left pointing to the first
+# character following the format.
+
+procedure sge_printf (number, memory, iop, top, program, pc)
+
+int	number			# number to be encoded
+char	memory[top]		# output buffer
+int	iop			# index of first char to be written	(in/out)
+int	top			# size of output buffer
+char	program[ARB]		# contains printf format string
+int	pc			# index of first char of format string	(in/out)
+
+char	format[SZ_FORMAT]
+char	numstr[SZ_NUMSTR]
+int	op, ch, junk
+int	gstrcpy(), itoc()
+
+begin
+	# Extract format %w.dC, a string of digits, -, or ., delimited by a
+	# letter.  The format %w.dr is followed by a single character which
+	# must also be included in the format string.
+
+	format[1] = '%'
+	op = 2
+	for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+	    pc = pc + 1
+	    format[op] = ch
+	    op = op + 1
+	    if (IS_LOWER(ch)) {
+		if (ch == 'r' && program[pc] != EOS) {
+		    # Radix digit follows %r.
+		    format[op] = program[pc]
+		    op = op + 1
+		    pc = pc + 1
+		}
+		break
+	    }
+	}
+	format[op] = EOS
+
+	# Encode the number using the extracted format string.  The case of
+	# a simple decimal encoding is optimized.
+
+	if (format[2] == 'd')
+	    junk = itoc (number, numstr, SZ_NUMSTR)
+	else {
+	    iferr {
+		call sprintf (numstr, SZ_NUMSTR, format)
+		    call pargi (number)
+	    } then
+		numstr[1] = EOS
+	}
+
+	# Move the encoded number to encoder memory, advancing the i/o
+	# pointer and taking care not to overrun memory.  Leave the iop
+	# pointing AT, not after, the EOS output by gstrcpy.
+
+	iop = iop + gstrcpy (numstr, memory[iop], top - iop + 1)
+end
diff --git a/sys/gio/stdgraph/stgescape.x b/sys/gio/stdgraph/stgescape.x
new file mode 100644
index 00000000..b52ffd0c
--- /dev/null
+++ b/sys/gio/stdgraph/stgescape.x
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STGESCAPE.X -- Stdgraph kernel escape handing code.  This is the interface
+# between the stdgraph kernel and any supported escape packages.  These driver
+# routines return TRUE if they recognize the escape and it is private to the
+# package, FALSE if the other escape packages may also be interested in the
+# routine.
+#
+#	stg_escape		standard GKI escape entry point
+#
+#	sge_wstran		transform and output escape
+#	sge_spoolesc		process and escape into frame buffer	
+#
+# To add support for a new package of escapes, and entry for the driver routine
+# for each family of escapes must be added to each of these procedures.
+
+
+# STG_ESCAPE -- Pass a device dependent instruction on to the kernel.  
+# The stdgraph kernel does not have any escape functions at present.
+
+procedure stg_escape (fn, instruction, nwords)
+
+int	fn			#I function code
+short	instruction[ARB]	#I instruction data words
+int	nwords			#I length of instruction
+
+bool	sgm_execute()		# GIM (Gterm) imaging excapes
+
+begin
+	if (sgm_execute (fn, instruction, nwords))
+	    return
+end
+
+
+# SGE_WSTRAN -- Stdgraph escape handling routine called by an interactive
+# client (e.g the CL in cursor mode) to apply the workstation transformation
+# to a escape and execute the escape.  This routine is called for all
+# escapes regardless of whether any transformation is necessary, leaving
+# it up to the escape code to decide what to do.
+
+procedure sge_wstran (fn, instruction, x1,y1, x2,y2)
+
+int	fn			#I escape sequence function opcode
+short	instruction[ARB]	#I escape instruction data
+real	x1, y1			#I NDC coords of display rect
+real	x2, y2			#I NDC coords of display rect
+
+bool	sgm_wstran()		# GIM (Gterm) imaging excapes
+
+begin
+	if (sgm_wstran (fn, instruction, x1,y1, x2,y2))
+	    return
+end
+
+
+# SGE_WSENABLE -- Stdgraph escape handling routine called by an
+# interactive client (e.g the CL in cursor mode) to test whether cursor mode
+# scaling of graphics instructions is enabled when cursor mode zoom/pan is
+# done.  Cursor mode scaling may be disabled if the kernel or graphics device
+# does the scaling itself.
+
+bool procedure sge_wsenable ()
+
+bool	enable
+bool	sgm_wsenable()
+
+begin
+	if (sgm_wsenable (enable))
+	    return (enable)
+end
+
+
+# SGE_SPOOLESC -- Stdgraph escape handling routine called by an interactive
+# client (e.g the CL in cursor mode) to retain, delete, or edit an escape
+# instruction stored in a frame buffer.  Ordinary drawing instructions are
+# normally retained.  If the instruction should only be executed when issued
+# it should be deleted.  Sometimes an instruction is edited or replaced by
+# a different one to be executed the next time the buffered graphics is drawn.
+# Sometimes when an instruction is seen earlier instructions must be edited
+# or deleted.  This routine is called for all escapes, it is up to the escape
+# code to decide what to do.  The delete instruction callback is called as
+# delete_fcn(tr,gki) to delete the instruction pointed to by GKI.
+
+procedure sge_spoolesc (tr, gki, fn, instruction, bp, buftop, delete_fcn)
+
+pointer	tr			#I arg to delete_fcn
+pointer	gki			#I pointer to escape instruction
+int	fn			#U escape sequence function opcode
+short	instruction[ARB]	#U escape instruction data
+pointer	bp			#I frame buffer pointer
+pointer	buftop			#I top+1 of buffered data
+int	delete_fcn		#I function called to delete an instruction
+
+bool	sgm_spoolesc()		# GIM (Gterm) imaging excapes
+
+begin
+	if (sgm_spoolesc (tr, gki, fn, instruction, bp, buftop, delete_fcn))
+	    return
+end
diff --git a/sys/gio/stdgraph/stgfa.x b/sys/gio/stdgraph/stgfa.x
new file mode 100644
index 00000000..10cf4d61
--- /dev/null
+++ b/sys/gio/stdgraph/stgfa.x
@@ -0,0 +1,115 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_FILLAREA -- Fill a closed area.  The area is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs outlining the
+# area to be filled.
+
+procedure stg_fillarea (p, npts)
+
+short	p[ARB]			#I points defining area outline
+int	npts			#I number of points, i.e., (x,y) pairs
+
+pointer	fa
+bool	tek_encoding
+int	lowres_x, lowres_y
+int	ip, n, sx, sy, len_p, iop, i
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	if (g_enable == NO)
+	    call stg_genab()
+
+	len_p = npts * 2
+
+	# Update fillarea attributes if necessary.
+
+	fa = SG_FAAP(g_sg)
+	if (SG_COLOR(g_sg) != FA_COLOR(fa)) {
+	    call stg_ctrl1 ("FC", FA_COLOR(fa))
+	    SG_COLOR(g_sg) = FA_COLOR(fa)
+	}
+	if (SG_FASTYLE(g_sg) != FA_STYLE(fa)) {
+	    call stg_ctrl1 ("FT", FA_STYLE(fa))
+	    SG_FASTYLE(g_sg) = FA_STYLE(fa)
+	}
+
+	# Tektronix encoding is treated as a special case for max efficiency.
+	tek_encoding =
+	    (Memc[g_xy] == '%' && Memc[g_xy+1] == 't' && Memc[g_xy+2] == EOS)
+
+	# Draw the fillarea.  If the startfill sequence is defined we assume
+	# that the device can draw a multipoint fillarea.
+
+	if (Memc[SG_STARTFILL(g_sg)] != EOS) {
+	    for (ip=1;  ip <= len_p;  ip=ip+2) {
+		# Output start fillarea sequence.
+		call ttyputs (g_out, g_tty, Memc[SG_STARTFILL(g_sg)], 1)
+		n = len_p
+
+		# Encode the points of the fillarea outline (or move to the
+		# single point to be drawn).
+
+		g_lastx = -1	# clip unresolved points only in the interior
+		g_lasty = -1	# of the area being drawn.
+
+		g_reg[E_IOP] = 1
+		do i = ip, n, 2 {
+		    sx = p[i]
+		    sy = p[i+1]
+
+		    # Discard the point if it is not resolved.
+		    lowres_x = sx / g_dxres
+		    lowres_y = sy / g_dyres
+		    if (lowres_x == g_lastx && lowres_y == g_lasty)
+			next
+
+		    g_lastx = lowres_x
+		    g_lasty = lowres_y
+
+		    # Transform point into the device window.
+		    sx = int (sx * g_dx) + g_x1
+		    sy = int (sy * g_dy) + g_y1
+
+		    # Encode the point, appending encoded bytes to g_mem.
+		    # Tek encoding is treated as a special case since it is
+		    # so common; the encoder is used for non-Tek encodings.
+
+		    if (tek_encoding) {
+			iop = g_reg[E_IOP] + 4
+			g_mem[iop-4] = g_hixy[sy+1]
+			g_mem[iop-3] = g_loy[sy+1]
+			g_mem[iop-2] = g_hixy[sx+1]
+			g_mem[iop-1] = g_lox[sx+1]
+			g_reg[E_IOP] = iop
+		    } else {
+			g_reg[1] = sx
+			g_reg[2] = sy
+			if (stg_encode (Memc[g_xy], g_mem, g_reg) != OK)
+			    break
+		    }
+
+		    # Flush buffer if nearly full.
+		    if (g_reg[E_IOP] > FLUSH_MEMORY) {
+			call write (g_out, g_mem, g_reg[E_IOP] - 1)
+			g_reg[E_IOP] = 1
+		    }
+		}
+		ip = n
+
+		# Flush any output remaining in encoder memory.
+		if (g_reg[E_IOP] > 1) {
+		    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		    g_reg[E_IOP] = 1
+		}
+
+		# Output end polymarker sequence, or draw the point.
+		call ttyputs (g_out, g_tty, Memc[SG_ENDFILL(g_sg)], 1)
+	    }
+	} else {
+	    # If can't do a fill area, just draw the area outline.
+	    call stg_polyline (p, npts)
+	}
+end
diff --git a/sys/gio/stdgraph/stgfaset.x b/sys/gio/stdgraph/stgfaset.x
new file mode 100644
index 00000000..d5b4c4e7
--- /dev/null
+++ b/sys/gio/stdgraph/stgfaset.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_FASET -- Set the fillarea attributes.
+
+procedure stg_faset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	fa
+include	"stdgraph.com"
+
+begin
+	fa = SG_FAAP(g_sg)
+	FA_STYLE(fa) = gki[GKI_FASET_FS]
+	FA_COLOR(fa) = gki[GKI_FASET_CI]
+end
diff --git a/sys/gio/stdgraph/stgfilter.x b/sys/gio/stdgraph/stgfilter.x
new file mode 100644
index 00000000..674f190f
--- /dev/null
+++ b/sys/gio/stdgraph/stgfilter.x
@@ -0,0 +1,165 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttset.h>
+include	<chars.h>
+include	<fset.h>
+include	"stdgraph.h"
+
+define	MAXCH	16
+define	RESET	"reset"
+
+
+# SGF_POST_FILTER -- Post the stdgraph tty input filter to the VOS tty driver.
+# This input filter is used to intercept and process escape sequences sent by
+# the terminal to the IRAF client, to notify the client of events such as a
+# terminal reset.
+
+procedure sgf_post_filter (fd)
+
+int	fd			#I terminal file
+
+int	locpr()
+extern	sgf_ttyfilter()
+
+begin
+	# Install stdgraph filter in terminal driver.
+	call ttseti (fd, TT_FILTER, locpr(sgf_ttyfilter))
+	call ttseti (fd, TT_FILTERKEY, ESC)
+
+	# Register escapes with terminal.
+	call stg_outstr ("EZ", RESET)
+	call stg_outstr ("ER", "R")
+end
+
+
+# SGF_TTYFILTER -- Terminal input filter.
+
+procedure sgf_ttyfilter (fd, buf, maxch, status)
+
+int	fd			#I input file
+char	buf[ARB]		#U input buffer
+int	maxch			#I max chars in buffer
+int	status			#U number of chars in buffer
+
+char	escape[MAXCH]
+char	svbuf[MAXCH+4]
+int	ip, op, sp, ch, iomode
+
+bool	streq()
+int	sgf_getchar(), fstati()
+include	"stdgraph.com"
+define	failed_ 91
+
+begin
+	# Disable the filter if reading from the terminal in nonblocking
+	# raw mode.  We shouldn't receive a stdgraph escape at such a time,
+	# and this code isn't prepared to deal with nonblocking i/o.  This
+	# case occurs, e.g., during a screen size query, where the terminal
+	# returns an escape sequence to the client (in nonblocking raw mode).
+
+	iomode = fstati (STDIN, F_IOMODE)
+	if (and (iomode, IO_NDELAY) != 0)
+	    return
+
+	# The escape sequence is of the form "ESC P <text> ESC \", the ANSI
+	# device control string (DCS).  This escape sequence is recognized by
+	# the vt100 terminal emulator in xgterm, which will accumulate and
+	# ignore the sequence.  This is important because when a terminal
+	# (xgterm) reset occurs when IRAF is not reading from the terminal in
+	# raw mode, the character are echoed to the terminal and would be
+	# printed on the screen if not recognized by the terminal as an
+	# escape.  By using a known escape which xgterm ignores the escape is
+	# transmitted without being seen by (and probably confusing) the
+	# user.  If the reset occurs while in graphics mode and a cursor read
+	# is in progress, the terminal will be in raw mode and the sequence
+	# will not be echoed, hence the problem does not occur.
+
+	ip = 1
+	sp = 1
+	ch = sgf_getchar (fd, svbuf, sp, buf, ip, maxch, status)
+	if (ch != ESC)
+	    goto failed_
+	ch = sgf_getchar (fd, svbuf, sp, buf, ip, maxch, status)
+	if (ch != 'P')
+	    goto failed_
+
+	# Accumulate escape data string.
+	op = 1
+	repeat {
+	    ch = sgf_getchar (fd, svbuf, sp, buf, ip, maxch, status)
+	    if (ch < 0 || op > MAXCH)
+		goto failed_
+	    if (ch == ESC) {
+		escape[op] = EOS
+		ch = sgf_getchar (fd, svbuf, sp, buf, ip, maxch, status)
+		break
+	    } else {
+		escape[op] = ch
+		op = op + 1
+	    }
+	}
+
+	# Process the escape.
+	if (streq (escape, RESET)) {
+	    call stg_reset()
+	    call ttseti (fd, TT_FILTER, NULL)
+	    if (g_sg != NULL)
+		SG_UIFDATE(g_sg) = 0
+	} else				# add additional escapes here
+	    goto failed_
+
+	# Edit the input buffer to remove the escape.
+	op = 1
+	for (  ;  ip <= status && op <= maxch;  ip=ip+1) {
+	    buf[op] = buf[ip]
+	    op = op + 1
+	}
+	status = op - 1
+	return
+
+failed_
+	# Unrecognized escape.  Append any newly read data to the input
+	# buffer and return all the data.
+
+	if (sp > 1) {
+	    call amovc (svbuf, buf[status+1], sp - 1)
+	    status = status + sp - 1
+	}
+end
+
+
+# SGF_GETCHAR -- Get a character from the input terminal.  ERR or EOF is
+# returned if the input is exhausted.  If reading in raw mode additional
+# reads will be performed as necessary.
+
+int procedure sgf_getchar (fd, svbuf, sp, buf, ip, maxch, nchars)
+
+int	fd			#I input file
+char	svbuf[ARB]		#O save chars as they are read
+int	sp			#U pointer into save buffer
+char	buf[ARB]		#U input buffer
+int	ip			#I input index
+int	maxch			#I max chars in buffer
+int	nchars			#U number of chars in buffer
+
+int	ch
+int	status
+
+begin
+	if (ip > nchars) {
+	    if (maxch == 1) {
+		call zgetty (fd, svbuf[sp], maxch, status)
+		if (status <= 0)
+		    return (ERR)
+		ch = svbuf[sp]
+		sp = sp + 1
+		return (ch)
+	    } else
+		return (EOF)
+	}
+
+	ch = buf[ip]
+	ip = ip + 1
+
+	return (ch)
+end
diff --git a/sys/gio/stdgraph/stgflush.x b/sys/gio/stdgraph/stgflush.x
new file mode 100644
index 00000000..aada3927
--- /dev/null
+++ b/sys/gio/stdgraph/stgflush.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_FLUSH -- Flush output.
+
+procedure stg_flush (dummy)
+
+int	dummy			# not used at present
+include	"stdgraph.com"
+
+begin
+	call flush (g_out)
+end
diff --git a/sys/gio/stdgraph/stggcell.x b/sys/gio/stdgraph/stggcell.x
new file mode 100644
index 00000000..2a9aea8c
--- /dev/null
+++ b/sys/gio/stdgraph/stggcell.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STG_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure stg_getcellarray (nx, ny, x1,y1, x2,y2)
+
+int	nx, ny			# number of pixels in X and Y
+int	x1, y1			# lower left corner of input window
+int	x2, y2			# lower left corner of input window
+
+begin
+	# Not implemented yet.  Won't do much for a graphics terminal,
+	# but should be functionional.
+end
diff --git a/sys/gio/stdgraph/stggcur.x b/sys/gio/stdgraph/stggcur.x
new file mode 100644
index 00000000..08f2b8b7
--- /dev/null
+++ b/sys/gio/stdgraph/stggcur.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_GETCURSOR -- Get the position of a cursor.  The cursor value is returned
+# as a GKI structure on the graphics metacode stream.
+
+procedure stg_getcursor (cursor)
+
+int	cursor			#I cursor to be read or 0
+
+int	cur, cn
+int	key, sx, sy, raster, rx, ry
+include	"stdgraph.com"
+
+begin
+	# If cursor=0 read the last cursor referenced, e.g., in a write.
+	if (cursor > 0) {
+	    SG_CURSOR(g_sg) = cursor
+	    cur = cursor
+	} else
+	    cur = max (1, SG_CURSOR(g_sg))
+
+	# Restore graphics mode in case the user has forgotten the \n while
+	# writing to the status line.
+
+	if (g_enable == NO)
+	    call stg_genab()
+
+	# If the user has locked the logical cursor override runtime selection.
+	if (g_cursor > 0)
+	    cur = g_cursor
+
+	# Restore the software cursor position before reading?
+	if (SG_UPDCURSOR(g_sg) == YES) {
+	    sx = SG_CURSOR_X(g_sg)
+	    sy = SG_CURSOR_Y(g_sg)
+	    if (sx != 0 && sy != 0)
+		call stg_setcursor (sx, sy, cur)
+	}
+
+	# Physically read the cursor and return value to caller.
+	call stg_readcursor (cur, cn, key, sx, sy, raster, rx, ry)
+	call gki_retcursorvalue (g_stream, cn, key, sx, sy, raster, rx, ry)
+	call flush (g_stream)
+
+	# Save the new position of the cursor for next time.
+	if (SG_UPDCURSOR(g_sg) == YES) {
+	    SG_CURSOR_X(g_sg) = sx
+	    SG_CURSOR_Y(g_sg) = sy
+	}
+end
diff --git a/sys/gio/stdgraph/stggdisab.x b/sys/gio/stdgraph/stggdisab.x
new file mode 100644
index 00000000..42ddec62
--- /dev/null
+++ b/sys/gio/stdgraph/stggdisab.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_GDISAB -- Disable graphics, i.e., issue the GD control sequence.
+
+procedure stg_gdisab()
+
+include	"stdgraph.com"
+
+begin
+	if (g_active == YES && g_out > 0) {
+	    call stgctrl ("GD")
+	    call flush (g_out)
+	    g_enable = NO
+	}
+end
diff --git a/sys/gio/stdgraph/stggenab.x b/sys/gio/stdgraph/stggenab.x
new file mode 100644
index 00000000..5e350e33
--- /dev/null
+++ b/sys/gio/stdgraph/stggenab.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_GENAB -- Enable graphics, i.e., issue the GE control sequence.
+
+procedure stg_genab()
+
+include	"stdgraph.com"
+
+begin
+	if (g_active == YES && g_out > 0) {
+	    call stgctrl ("GE")
+	    call flush (g_out)
+	    g_enable = YES
+	}
+end
diff --git a/sys/gio/stdgraph/stggim.x b/sys/gio/stdgraph/stggim.x
new file mode 100644
index 00000000..a71cd448
--- /dev/null
+++ b/sys/gio/stdgraph/stggim.x
@@ -0,0 +1,919 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<chars.h>
+include	<ctype.h>
+include	<fset.h>
+include	<gescape.h>
+include	<gki.h>
+include	<gim.h>
+include	"stdgraph.h"
+
+# STGGIM.X -- GIO.GIM gterm imaging escapes for the stdgraph kernel.  The
+# routines in this file decode GKI escape instructions and encode serial
+# byte sequences which are sent to the server to execute the instruction.
+# In some cases the server returns a response which is decoded here and
+# encoded as a GKI return value which is returned to the client.
+
+define	SZ_PATBUF	512
+define	MAX_ARGS	32
+define  TIMEOUT		10000
+
+
+# SGM_EXECUTE -- Test whether the given instruction is a GIM escape, and
+# if so execute it.  Return true if the instruction was recognized and
+# executed.
+
+bool procedure sgm_execute (fn, gim, nwords)
+
+int	fn			#I function code
+short	gim[ARB]		#I instruction data words
+int	nwords			#I length of gim
+
+int	raster
+common	/sgmcom/ raster
+
+begin
+	switch (fn) {
+	case GKI_OPENWS, GKI_CLEAR:
+	    call sgm_output ("RI", gim, GIM_RASTERINIT_LEN)
+	    return (false)
+
+	case GIM_RASTERINIT:
+	    call sgm_output ("RI", gim, GIM_RASTERINIT_LEN)
+	case GIM_CREATERASTER:
+	    call sgm_output ("CR", gim, GIM_CREATERASTER_LEN)
+	case GIM_DESTROYRASTER:
+	    call sgm_output ("DR", gim, GIM_DESTROYRASTER_LEN)
+	case GIM_QUERYRASTER:
+	    call sgm_queryraster (gim)
+	case GIM_SETRASTER:
+	    raster = gim[GIM_SETRASTER_RN]
+	    call sgm_output ("SR", gim, GIM_SETRASTER_LEN)
+	case GIM_WRITEPIXELS:
+	    call sgm_writepixels (gim)
+	case GIM_READPIXELS:
+	    call sgm_readpixels (gim)
+	case GIM_REFRESHPIXELS:
+	    call sgm_output ("RX", gim, GIM_REFRESHPIXELS_LEN)
+	case GIM_SETPIXELS:
+	    call sgm_output ("SP", gim, GIM_SETPIXELS_LEN)
+	case GIM_WRITECMAP:
+	    call sgm_writecmap (gim)
+	case GIM_READCMAP:
+	    call sgm_readcmap (gim)
+	case GIM_LOADCMAP:
+	    call sgm_output ("LM", gim, GIM_LOADCMAP_LEN)
+	case GIM_FREECMAP:
+	    call sgm_output ("FL", gim, GIM_FREECMAP_LEN)
+	case GIM_WRITEIOMAP:
+	    call sgm_iomapwrite (gim)
+	case GIM_READIOMAP:
+	    call sgm_iomapread (gim)
+	case GIM_INITMAPPINGS:
+	    call sgm_output ("IM", gim, GIM_INITMAPPINGS_LEN)
+	case GIM_FREEMAPPING:
+	    call sgm_output ("FM", gim, GIM_FREEMAPPING_LEN)
+	case GIM_COPYRASTER:
+	    call sgm_output ("CP", gim, GIM_COPYRASTER_LEN)
+	case GIM_SETMAPPING:
+	    call sgm_output ("SM", gim, GIM_SETMAPPING_LEN)
+	case GIM_GETMAPPING:
+	    call sgm_getmapping (gim)
+	case GIM_ENABLEMAPPING:
+	    call sgm_output ("MN", gim, GIM_ENABLEMAPPING_LEN)
+	case GIM_DISABLEMAPPING:
+	    call sgm_output ("MD", gim, GIM_DISABLEMAPPING_LEN)
+	case GIM_REFRESHMAPPING:
+	    call sgm_output ("RF", gim, GIM_REFRESHMAPPING_LEN)
+
+	default:
+	    return (false)
+	}
+
+	return (true)
+end
+
+
+# SGM_WSTRAN -- Transform and output a GIM escape.  Ignore escapes we
+# know nothing about.  TRUE is returned if the escape is one which is private
+# to the GIM interface.
+
+bool procedure sgm_wstran (fn, gim, rx1,ry1, rx2,ry2)
+
+int	fn			#I escape sequence function opcode
+short	gim[ARB]		#I escape instruction data
+real	rx1,ry1			#I NDC coords of display rect
+real	rx2,ry2			#I NDC coords of display rect
+
+real	scale
+pointer	sp, n_gim
+bool	status, xflip, yflip
+int	width, height, dst, src, dt
+int	wx1, wy1, wx2, wy2, p1, p2
+int	sx1, sy1, sx2, sy2, snx, sny
+int	dx1, dy1, dx2, dy2, dnx, dny
+int	n_dx1, n_dy1, n_dx2, n_dy2, n_dnx, n_dny
+int	n_sx1, n_sy1, n_sx2, n_sy2
+int	w_dx1, w_dy1, w_dx2, w_dy2
+bool	sgm_execute()
+define	exe_ 91
+
+begin
+	switch (fn) {
+	case GIM_RASTERINIT, GIM_INITMAPPINGS,
+	    GIM_CREATERASTER, GIM_DESTROYRASTER, GIM_QUERYRASTER,
+	    GIM_GETMAPPING, GIM_ENABLEMAPPING, GIM_DISABLEMAPPING,
+	    GIM_REFRESHMAPPING, GIM_FREEMAPPING,
+	    GIM_READPIXELS, GIM_WRITEPIXELS, GIM_REFRESHPIXELS, GIM_SETPIXELS,
+	    GIM_WRITECMAP, GIM_READCMAP, GIM_LOADCMAP, GIM_FREECMAP,
+	    GIM_WRITEIOMAP, GIM_READIOMAP,
+	    GIM_COPYRASTER, GIM_SETRASTER:
+
+	    # These instructions do not require any transformation.
+	    status = sgm_execute (fn, gim, 0)
+
+	case GIM_SETMAPPING:
+	    # Edit setmapping instructions which write to the display window.
+	    # Raster 0 is the display window; only display window coordinates
+	    # are affected by the workstation transformation.
+
+	    src = gim[GIM_SETMAPPING_SR]
+	    dst = gim[GIM_SETMAPPING_DR]
+	    dt  = gim[GIM_SETMAPPING_DT]
+
+	    if (dst == 0 && src != dst) {
+		call smark (sp)
+		call salloc (n_gim, GIM_SETMAPPING_LEN, TY_SHORT)
+
+		xflip = false
+		yflip = false
+
+		# Convert the display rect NDC coordinates to window pixels
+		# or GKI units, depending upon which coordinate system is
+		# in use.  Note that for NDC the Y axis is flipped relative
+		# to display window pixel coordinates.
+
+		if (dt == CT_PIXEL) {
+		    call sgm_winsize (width, height)
+		    wx1 = rx1 * (width - 1);  wy1 = (1.0 - ry2) * (height - 1)
+		    wx2 = rx2 * (width - 1);  wy2 = (1.0 - ry1) * (height - 1)
+		} else {
+		    width = GKI_MAXNDC + 1;  height = GKI_MAXNDC + 1
+		    wx1 = rx1 * (width - 1);  wy1 = ry1 * (height - 1)
+		    wx2 = rx2 * (width - 1);  wy2 = ry2 * (height - 1)
+		}
+
+		sx1 = gim[GIM_SETMAPPING_SX]
+		snx = gim[GIM_SETMAPPING_SW]
+		sy1 = gim[GIM_SETMAPPING_SY]
+		sny = gim[GIM_SETMAPPING_SH]
+		sx2 = sx1 + snx - 1;  sy2 = sy1 + sny - 1 
+
+		dx1 = gim[GIM_SETMAPPING_DX]
+		dnx = gim[GIM_SETMAPPING_DW]
+		if (dnx < 0) {
+		    dnx = -dnx
+		    xflip = !xflip
+		}
+		dy1 = gim[GIM_SETMAPPING_DY]
+		dny = gim[GIM_SETMAPPING_DH]
+		if (dny < 0) {
+		    dny = -dny
+		    yflip = !yflip
+		}
+		dx2 = dx1 + dnx - 1;  dy2 = dy1 + dny - 1 
+
+		# Compute the intersection of the destination (screen) rect
+		# of the mapping with the region of the screen WS mapped by
+		# the workstation transformation.
+
+		n_dx1 = max (wx1, dx1);  n_dy1 = max (wy1, dy1)
+		n_dx2 = min (wx2, dx2);  n_dy2 = min (wy2, dy2)
+
+		# If the rectangles do not intersect set up a null mapping
+		# to temporarily disable the mapping.
+
+		n_dnx = n_dx2 - n_dx1 + 1;  n_dny = n_dy2 - n_dy1 + 1
+		if (n_dnx <= 0 || n_dny <= 0) {
+		    call amovs (gim, Mems[n_gim], GIM_SETMAPPING_LEN)
+		    Mems[n_gim+GIM_SETMAPPING_SX-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_SW-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_SY-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_SH-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_DX-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_DW-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_DY-1] = 0
+		    Mems[n_gim+GIM_SETMAPPING_DH-1] = 0
+		    goto exe_
+		}
+
+		# Compute the source rect which maps to the new (intersection)
+		# destination rect.
+
+		if (snx == 1 || dnx == 1) {
+		    n_sx1 = sx1
+		    n_sx2 = sx2
+		} else {
+		    scale = real(snx - 1) / real(dnx - 1)
+		    n_sx1 = max(0, min(GKI_MAXNDC,
+			nint((n_dx1 - dx1) * scale + sx1)))
+		    n_sx2 = max(0, min(GKI_MAXNDC,
+			nint((n_dx2 - dx2) * scale + sx2)))
+		    if (xflip) {
+			p1 = sx1 + (sx2 - n_sx2)
+			p2 = sx2 - (n_sx1 - sx1)
+			n_sx1 = p1;  n_sx2 = p2
+		    }
+		}
+
+		if (sny == 1 || dny == 1) {
+		    n_sy1 = sy1
+		    n_sy2 = sy2
+		} else {
+		    scale = real(sny - 1) / real(dny - 1)
+		    n_sy1 = max(0, min(GKI_MAXNDC,
+			nint((n_dy1 - dy1) * scale + sy1)))
+		    n_sy2 = max(0, min(GKI_MAXNDC,
+			nint((n_dy2 - dy2) * scale + sy2)))
+		    if (yflip) {
+			p1 = sy1 + (sy2 - n_sy2)
+			p2 = sy2 - (n_sy1 - sy1)
+			n_sy1 = p1;  n_sy2 = p2
+		    }
+		}
+
+		# Scale the destination rect by the amount needed to make the
+		# WS rect fill the full display window.
+
+		if (wx1 == wx2) {
+		    w_dx1 = 0
+		    w_dx1 = width - 1
+		} else {
+		    scale = real(width - 1) / real(wx2 - wx1)
+		    w_dx1 = max(0, min(GKI_MAXNDC,
+			nint((n_dx1 - wx1) * scale)))
+		    w_dx2 = max(0, min(GKI_MAXNDC,
+			nint((n_dx2 - wx1) * scale)))
+		}
+
+		if (wy1 == wy2) {
+		    w_dy1 = 0
+		    w_dy1 = height - 1
+		} else {
+		    scale = real(height - 1) / real(wy2 - wy1)
+		    w_dy1 = max(0, min(GKI_MAXNDC,
+			nint((n_dy1 - wy1) * scale)))
+		    w_dy2 = max(0, min(GKI_MAXNDC,
+			nint((n_dy2 - wy1) * scale)))
+		}
+
+		# Construct the edited instruction.
+		call amovs (gim, Mems[n_gim], GIM_SETMAPPING_LEN)
+		Mems[n_gim+GIM_SETMAPPING_SX-1] = n_sx1
+		Mems[n_gim+GIM_SETMAPPING_SW-1] = n_sx2 - n_sx1 + 1
+		Mems[n_gim+GIM_SETMAPPING_SY-1] = n_sy1
+		Mems[n_gim+GIM_SETMAPPING_SH-1] = n_sy2 - n_sy1 + 1
+		Mems[n_gim+GIM_SETMAPPING_DX-1] = w_dx1
+		Mems[n_gim+GIM_SETMAPPING_DY-1] = w_dy1
+
+		n_dnx = max(0, min(GKI_MAXNDC, w_dx2 - w_dx1 + 1))
+		if (gim[GIM_SETMAPPING_DW] < 0)
+		    n_dnx = -n_dnx
+		Mems[n_gim+GIM_SETMAPPING_DW-1] = n_dnx
+
+		n_dny = max(0, min(GKI_MAXNDC, w_dy2 - w_dy1 + 1))
+		if (gim[GIM_SETMAPPING_DH] < 0)
+		    n_dny = -n_dny
+		Mems[n_gim+GIM_SETMAPPING_DH-1] = n_dny
+
+exe_
+		# Execute the edited instruction.
+		status = sgm_execute (fn, Mems[n_gim], 0)
+		call sfree (sp)
+
+	    } else
+		status = sgm_execute (fn, gim, 0)
+
+	default:
+	    status = false
+	}
+
+	return (status)
+end
+
+
+# SGM_WSENABLE -- Test if client scaling of graphics drawing instructions is
+# enabled.  For the stdgraph kernel, these transformations are disabled if
+# the raster is other than zero, in which case the graphics server does the
+# scaling.
+
+bool procedure sgm_wsenable (enable)
+
+bool	enable
+int	raster
+common	/sgmcom/ raster
+
+begin
+	enable = (raster == 0)
+	return (true)
+end
+
+
+# SGM_SPOOLESC -- Process a GIM escape into a frame buffer.  All GIM escapes 
+# are executed when first issued; we just determine whether the escapes are
+# preserved in the frame buffer to be executed when the frame is redrawn.
+# Ignore escapes we know nothing about.  TRUE is returned if the escape is
+# one which is private to the GIM interface, i.e., if the escape has been
+# processed fully by sgm_spoolesc.
+
+bool procedure sgm_spoolesc (tr, gki, fn, gim, bp, buftop, delete_fcn)
+
+pointer tr			#I arg to delete_fcn
+pointer gki			#I pointer to escape instruction
+int	fn			#U escape sequence function opcode
+short	gim[ARB]		#U escape instruction data
+pointer bp			#I frame buffer pointer
+pointer buftop			#I top+1 of buffered data
+int	delete_fcn		#I function called to delete an instruction
+
+pointer	ip, itop, esc
+int	nleft, length, opcode, escape, mp
+
+begin
+	switch (fn) {
+	case GIM_RASTERINIT, GIM_INITMAPPINGS, GIM_FREEMAPPING,
+	    GIM_CREATERASTER, GIM_DESTROYRASTER, GIM_QUERYRASTER,
+	    GIM_GETMAPPING, GIM_ENABLEMAPPING, GIM_DISABLEMAPPING,
+	    GIM_REFRESHMAPPING, GIM_WRITEPIXELS, GIM_READPIXELS,
+	    GIM_REFRESHPIXELS, GIM_SETPIXELS, GIM_COPYRASTER,
+	    GIM_WRITEIOMAP, GIM_READIOMAP, GIM_WRITECMAP, GIM_READCMAP,
+	    GIM_LOADCMAP, GIM_FREECMAP:
+
+	    # These escapes are only executed once.
+	    call zcall2 (delete_fcn, tr, gki)
+
+	case GIM_SETRASTER:
+	    ;  # Preserve this instruction.
+
+	case GIM_SETMAPPING:
+	    # This escape is saved in the frame buffer and rexecuted when
+	    # the frame is redrawn.  This allows the server to buffer the
+	    # image data, but still allows the graphics to be redrawn and
+	    # possibly rescaled in cursor mode.  Rexecution of copyraster
+	    # after a screen clear will cause any rasters created and written
+	    # to with createraster/writepixels to be redrawn on the screen.
+
+	    ip = bp
+	    itop = gki
+
+	    while (ip < itop) {
+		# Search for the beginning of the next instruction.
+		while (Mems[ip] != BOI && ip < itop)
+		    ip = ip + 1
+
+		nleft = itop - ip
+		if (nleft < 3)
+		    break
+		else {
+		    length = Mems[ip+GKI_HDR_LENGTH-1]
+		    if (length > nleft)
+			break
+
+		    opcode = Mems[ip+GKI_HDR_OPCODE-1]
+		    escape = Mems[ip+GKI_ESCAPE_FN-1]
+
+		    # Disable instruction if same mapping number.
+		    if (opcode == GKI_ESCAPE && escape == GIM_SETMAPPING) {
+			esc = ip + GKI_ESCAPE_DC - 1
+			mp = Mems[esc+GIM_SETMAPPING_MP-1]
+			if (mp == gim[GIM_SETMAPPING_MP])
+			    Mems[ip+GKI_HDR_OPCODE-1] = GKI_UNKNOWN
+		    }
+
+		    ip = ip + length
+		}
+	    }
+
+	default:
+	    return (false)
+	}
+
+	return (true)
+end
+
+
+# SGM_WINSIZE -- Get the graphics window size in display pixels.
+
+procedure sgm_winsize (width, height)
+
+int	width, height		#O window size
+
+short	gim_query[GIM_QUERYRASTER_LEN]
+short	retval[GIM_RET_QRAS_LEN]
+
+begin
+	gim_query[GIM_QUERYRASTER_RN] = 0
+	call sgm_query ("QR", gim_query, GIM_QUERYRASTER_LEN,
+	    "Qr", retval, GIM_RET_QRAS_LEN)
+	width  = retval[GIM_RET_QRAS_NX]
+	height = retval[GIM_RET_QRAS_NY]
+end
+
+
+# SGM Private Functions.
+# ---------------------------
+
+# SGM_QUERYRASTER -- Return the attributes of a raster.
+
+procedure sgm_queryraster (gim)
+
+short	gim[ARB]			#I encoded instruction
+short	retval[GIM_RET_QRAS_LEN]
+include	"stdgraph.com"
+
+begin
+	call sgm_query ("QR", gim, GIM_QUERYRASTER_LEN,
+	    "Qr", retval, GIM_RET_QRAS_LEN)
+	call write (g_stream, retval, GIM_RET_QRAS_LEN * SZ_SHORT)
+	call flush (g_stream)
+end
+
+
+# SGM_WRITEPIXELS -- Write a block of pixels to a raster.
+
+procedure sgm_writepixels (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+char	bias
+pointer	sp, bp
+int	nx, ny, npix, i
+include	"stdgraph.com"
+
+begin
+	# Send the write-pixels escape sequence.
+	call sgm_output ("WP", gim, GIM_WRITEPIXELS_LEN)
+
+	# For the moment this code assumes 8 bit pixels.
+	nx = gim[GIM_WRITEPIXELS_NX]
+	ny = gim[GIM_WRITEPIXELS_NY]
+	npix = nx * ny
+
+	call smark (sp)
+	call salloc (bp, npix, TY_CHAR)
+	bias = 040B
+
+	# Send the pixel data encoded in printable ASCII.
+	call achtbc (gim[GIM_WRITEPIXELS_DATA], Memc[bp], npix)
+	do i = 1, npix
+	    Memc[bp+i-1] = Memc[bp+i-1] + bias
+	call write (g_out, Memc[bp], npix)
+	call putci (g_out, GS)
+
+	call sfree (sp)
+end
+
+
+# SGM_READPIXELS -- Read a block of pixels from a raster and return it
+# to the client.
+
+procedure sgm_readpixels (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+pointer	sp, bp
+int	sv_iomode, ch
+int	npix, nx, ny, i
+short	retval[GIM_RET_RPIX_LEN]
+int	fstati(), getci()
+include	"stdgraph.com"
+
+begin
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	# Send the read-pixels escape sequence.
+	call sgm_output ("RP", gim, GIM_READPIXELS_LEN)
+	call flush (g_out)
+
+	# For the moment this code assumes 8 bit pixels.
+	nx = gim[GIM_READPIXELS_NX]
+	ny = gim[GIM_READPIXELS_NY]
+	npix = nx * ny
+
+	call smark (sp)
+	call salloc (bp, npix, TY_CHAR)
+
+	# Get the pixel data.  This is a block of pixel data encoded as for
+	# writepixels (040 bias), bracked by ESC at the front and a single
+	# control character such as \r or \n at the end.
+
+	while (getci (g_in, ch) != EOF)
+	    if (ch == ESC)
+		break
+	for (i=0;  getci (g_in, ch) >= 040B;  )
+	    if (i < npix) {
+		Memc[bp+i] = ch - 040B
+		i = i + 1
+	    }
+	npix = i
+
+	# Send the RPIX header to the client.
+	retval[GIM_RET_RPIX_NP] = npix
+	call write (g_stream, retval, GIM_RET_RPIX_LEN * SZ_SHORT)
+
+	# Return the data to the client.
+	call achtcb (Memc[bp], Memc[bp], npix)
+	call write (g_stream, Memc[bp], (npix + SZB_CHAR-1) / SZB_CHAR)
+	call flush (g_stream)
+
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+	call sfree (sp)
+end
+
+
+# SGM_WRITECMAP -- Write to a segment of the colormap.
+
+procedure sgm_writecmap (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+short	mask
+pointer	sp, bp, op
+int	ncells, nchars, ip, i
+include	"stdgraph.com"
+
+begin
+	call smark (sp)
+
+	# Send the write-colormap escape sequence.
+	call sgm_output ("WM", gim, GIM_WRITECMAP_LEN)
+
+	# Each cell consists of a RGB triplet encoded 2 chars per color.
+	ncells = gim[GIM_WRITECMAP_NC]
+	nchars = ncells * 3 * 2
+
+	call salloc (bp, nchars, TY_CHAR)
+	ip = GIM_WRITECMAP_DATA
+	op = bp
+
+	mask = 017B
+	do i = 1, ncells*3 {
+	    Memc[op] =      gim[ip] / 16   + 040B;  op = op + 1
+	    Memc[op] = and (gim[ip], mask) + 040B;  op = op + 1
+	    ip = ip + 1
+	}
+
+	call write (g_out, Memc[bp], nchars)
+	call putci (g_out, GS)
+
+	call sfree (sp)
+end
+
+
+# SGM_READCMAP -- Read a segment of the colormap.
+
+procedure sgm_readcmap (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+pointer	sp, bp, cm, ip
+int	sv_iomode, ncells, nchars, ch, i
+short	retval[GIM_RET_RCMAP_LEN]
+int	fstati(), getci()
+include	"stdgraph.com"
+
+begin
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	# Send the read-cmap escape sequence.
+	call sgm_output ("RM", gim, GIM_READCMAP_LEN)
+	call flush (g_out)
+
+	# Each cell consists of a RGB triplet encoded 2 chars per color.
+	ncells = gim[GIM_READCMAP_NC]
+	nchars = ncells * 3 * 2
+
+	call smark (sp)
+	call salloc (bp, nchars, TY_CHAR)
+	call salloc (cm, ncells * 3, TY_SHORT)
+
+	# Get the colormap data.  This is a block of RGB colormap triplets
+	# encoded 2 bytes per color, bracked by a ESC at the front and a
+	# single control character such as \r or \n at the end.
+
+	while (getci (g_in, ch) != EOF)
+	    if (ch == ESC)
+		break
+	for (i=0;  getci (g_in, ch) >= 040B;  )
+	    if (i < nchars) {
+		Memc[bp+i] = ch - 040B
+		i = i + 1
+	    }
+	ncells = i / (3 * 2)
+
+	# Decode the packed colormap data.
+	ip = bp
+	do i = 1, ncells * 3 {
+	    Mems[cm+i-1] = (Memc[ip] - 040B) * 16 + (Memc[ip+1] - 040B)
+	    ip = ip + 2
+	}
+
+	# Send the read-cmap header to the client.
+	retval[GIM_RET_RCMAP_NC] = ncells
+	call write (g_stream, retval, GIM_RET_RCMAP_LEN * SZ_SHORT)
+
+	# Return the colormap data to the client.
+	call write (g_stream, Mems[cm], (ncells * 3) * SZ_SHORT)
+	call flush (g_stream)
+
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+	call sfree (sp)
+end
+
+
+# SGM_IOMAPWRITE -- Write to the iomap.
+
+procedure sgm_iomapwrite (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+short	mask
+pointer	sp, bp, op
+int	ncells, nchars, ip, i
+include	"stdgraph.com"
+
+begin
+	call smark (sp)
+
+	# Send the write-iomap escape sequence.
+	call sgm_output ("WO", gim, GIM_WRITEIOMAP_LEN)
+
+	# Each cell consists of a single short integer colormap index
+	# encoded 2 chars per cell.
+
+	ncells = gim[GIM_WRITEIOMAP_NC]
+	nchars = ncells * 2
+
+	call salloc (bp, nchars, TY_CHAR)
+	ip = GIM_WRITEIOMAP_DATA
+	op = bp
+
+	mask = 017B
+	do i = 1, ncells {
+	    Memc[op] =      gim[ip] / 16   + 040B;  op = op + 1
+	    Memc[op] = and (gim[ip], mask) + 040B;  op = op + 1
+	    ip = ip + 1
+	}
+
+	call write (g_out, Memc[bp], nchars)
+	call putci (g_out, GS)
+
+	call sfree (sp)
+end
+
+
+# SGM_IOMAPREAD -- Read a segment of the iomap.
+
+procedure sgm_iomapread (gim)
+
+short	gim[ARB]			#I encoded instruction
+
+pointer	sp, bp, data, ip
+int	sv_iomode, ncells, nchars, ch, i
+short	retval[GIM_RET_RIOMAP_LEN]
+int	fstati(), getci()
+include	"stdgraph.com"
+
+begin
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	# Send the read-iomap escape sequence.
+	call sgm_output ("RO", gim, GIM_READIOMAP_LEN)
+	call flush (g_out)
+
+	# The data is encoded two bytes per short integer value.
+	ncells = gim[GIM_READIOMAP_NC]
+	nchars = ncells * 2
+
+	call smark (sp)
+	call salloc (bp, nchars, TY_CHAR)
+	call salloc (data, ncells, TY_SHORT)
+
+	# Get the iomap data.  This is a block of iomap values encoded
+	# 2 bytes per value, bracked by a ESC at the front and a single
+	# control character such as \r or \n at the end.
+
+	while (getci (g_in, ch) != EOF)
+	    if (ch == ESC)
+		break
+	for (i=0;  getci (g_in, ch) >= 040B;  )
+	    if (i < nchars) {
+		Memc[bp+i] = ch - 040B
+		i = i + 1
+	    }
+	ncells = i / 2
+
+	# Decode the packed iomap data.
+	ip = bp
+	do i = 1, ncells {
+	    Mems[data+i-1] = (Memc[ip] - 040B) * 16 + (Memc[ip+1] - 040B)
+	    ip = ip + 2
+	}
+
+	# Send the read-iomap header to the client.
+	retval[GIM_RET_RIOMAP_NC] = ncells
+	call write (g_stream, retval, GIM_RET_RIOMAP_LEN * SZ_SHORT)
+
+	# Return the iomap data to the client.
+	call write (g_stream, Mems[data], ncells * SZ_SHORT)
+	call flush (g_stream)
+
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+	call sfree (sp)
+end
+
+
+# SGM_GETMAPPING -- Return the attributes of a mapping.
+
+procedure sgm_getmapping (gim)
+
+short	gim[ARB]			#I encoded instruction
+short	retval[GIM_RET_GMAP_LEN]
+include	"stdgraph.com"
+
+begin
+	call sgm_query ("GM", gim, GIM_GETMAPPING_LEN,
+	    "Gm", retval, GIM_RET_GMAP_LEN)
+	call write (g_stream, retval, GIM_RET_GMAP_LEN * SZ_SHORT)
+	call flush (g_stream)
+end
+
+
+# SGM_OUTPUT -- Format and output a control sequence to the graphics server
+# device.
+
+procedure sgm_output (cap, gim, nargs)
+
+char	cap[ARB]			#I graphcap capability name
+short	gim[ARB]			#I instruction (array of int args)
+int	nargs				#I number of arguments
+
+int	ival, i
+pointer	sp, fmt, ctrl
+include	"stdgraph.com"
+int	ttygets()
+errchk	ttygets
+
+begin
+	call smark (sp)
+	call salloc (fmt, SZ_LINE, TY_CHAR)
+	call salloc (ctrl, SZ_LINE, TY_CHAR)
+
+	if (ttygets (g_tty, cap, Memc[fmt], SZ_LINE) > 0) {
+	    call sprintf (Memc[ctrl], SZ_LINE, Memc[fmt])
+		do i = 1, nargs {
+		    # Pass the argument as an integer to avoid INDEF
+		    # processing of -32767, a valid GKI value.
+		    ival = gim[i]
+		    iferr (call pargi (ival))
+			;
+		}
+	    call ttyputs (g_out, g_tty, Memc[ctrl], 1)
+	}
+
+	call sfree (sp)
+end
+
+
+# SGM_QUERY -- Output an inquiry control sequence to the server and read and
+# decode the server's response.
+
+procedure sgm_query (query_cap, gim, nargs, retval_cap, retval, nout)
+
+char	query_cap[ARB]			#I server query cap name
+short	gim[ARB]			#I query instruction (args)
+int	nargs				#I number of args for server query
+char	retval_cap[ARB]			#I cap name for return value format
+short	retval[ARB]			#O decoded output arguments
+int	nout				#I number of output arguments
+
+int	index[MAX_ARGS]
+pointer	sp, ctrl, patbuf, pat, buf, ip, op
+int	sv_iomode, arg, ch, nchars, start, value, ival, i
+int	patmake(), patindex(), ttyread(), ctoi()
+int	ttygets(), fstati(), gstrcpy()
+include	"stdgraph.com"
+define	done_ 91
+errchk	ttygets
+
+begin
+	call smark (sp)
+	call salloc (ctrl, SZ_LINE, TY_CHAR)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (pat, SZ_LINE, TY_CHAR)
+	call salloc (patbuf, SZ_PATBUF, TY_CHAR)
+
+	call aclrs (retval, nout)
+
+	# Set raw mode i/o.
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	# Pass the query on to the server.
+	if (ttygets (g_tty, query_cap, Memc[pat], SZ_LINE) > 0) {
+	    call sprintf (Memc[ctrl], SZ_LINE, Memc[pat])
+		do i = 1, nargs {
+		    # Pass the argument as an integer to avoid INDEF
+		    # processing of -32767, a valid GKI value.
+		    ival = gim[i]
+		    iferr (call pargi (ival))
+			;
+		}
+	    call ttyputs (g_out, g_tty, Memc[ctrl], 1)
+	    call flush (g_out)
+
+	} else
+	    goto done_
+
+	# Encode a pattern to match the server's response as given by the
+	# pattern in retval_cap.
+
+        if (ttygets (g_tty, retval_cap, Memc[pat], SZ_LINE) <= 0)
+	    goto done_
+
+        # Process the retval_cap string, used to specify the format of the
+	# string returned by the server, to map the %N fields therein into
+        # the pattern strings "%[0-9]*", noting the index positions of the
+        # pattern substrings for later decoding.
+
+	call aclri (index, MAX_ARGS)
+	arg = 0
+
+	op = buf
+	for (ip=pat;  Memc[ip] != EOS;  ip=ip+1) {
+	    if (Memc[ip] == '%') {
+		if (Memc[ip+1] == '%') {
+		    Memc[op] = Memc[ip]
+		    op = op + 1
+		    ip = ip + 1
+		} else {
+		    op = op + gstrcpy ("%[0-9]*", Memc[op], ARB)
+		    ip = ip + 1
+
+		    # Arguments are %1 ... %9, %a, %b, etc.
+		    ch = Memc[ip]
+		    if (IS_DIGIT(ch))
+			i = TO_INTEG(ch)
+		    else if (IS_UPPER(ch))
+			i = ch - 'A' + 10
+		    else
+			i = ch - 'a' + 10
+
+		    arg = arg + 1
+		    i = min(MAX_ARGS, max(1, i))
+		    index[i] = arg
+		}
+	    } else if (Memc[ip] == '[') {
+		Memc[op] = '\\';  op = op + 1
+		Memc[op] = '[' ;  op = op + 1
+	    } else {
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	}
+
+	Memc[op] = EOS
+	if (patmake (Memc[buf], Memc[patbuf], SZ_PATBUF) >= SZ_PATBUF)
+	    goto done_
+
+	# Scan the input stream from the server until data matching the
+	# response pattern is received, or a timeout occurs.
+
+	nchars = ttyread (g_in, g_tty,Memc[buf],SZ_LINE,Memc[patbuf], TIMEOUT)
+	if (nchars > 0) {
+	    do i = 1, nout {
+		value = 0
+		if (index[i] > 0) {
+		    start = patindex (Memc[patbuf], index[i])
+		    if (ctoi (Memc[buf], start, value) <= 0)
+			value = 0
+		}
+		retval[i] = value
+	    }
+	}
+done_
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stggrstr.x b/sys/gio/stdgraph/stggrstr.x
new file mode 100644
index 00000000..946b52d9
--- /dev/null
+++ b/sys/gio/stdgraph/stggrstr.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_GRSTREAM -- Set the FD of the graphics stream, from which we shall read
+# metacode instructions and to which we shall return cell arrays and cursor
+# values.
+
+procedure stg_grstream (stream)
+
+int	stream			# FD of the new graphics stream
+include	"stdgraph.com"
+
+begin
+	g_stream = stream
+end
diff --git a/sys/gio/stdgraph/stginit.x b/sys/gio/stdgraph/stginit.x
new file mode 100644
index 00000000..3e393be4
--- /dev/null
+++ b/sys/gio/stdgraph/stginit.x
@@ -0,0 +1,193 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<gki.h>
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_INIT -- Initialize the stdgraph data structures from the graphcap entry
+# for the device.  Called once, at OPENWS time, with the TTY pointer already
+# set in the common.  The companion routine STG_RESET initializes the attribute
+# packets when the screen is cleared.
+
+procedure stg_init (tty, devname)
+
+pointer	tty			# graphcap descriptor
+char	devname[ARB]		# device name
+
+pointer	nextch
+bool	first_time
+int	maxch, i, junk
+real	char_height, char_width, char_size
+
+bool	ttygetb()
+real	ttygetr()
+pointer	stg_gstring()
+int	ttygets(), ttygeti(), btoi(), stg_encode(), gstrcpy()
+include	"stdgraph.com"
+data	first_time /true/
+
+begin
+	# One time initialization.
+	if (first_time) {
+	    # Initialize the Tek 4012 coordinate encoding lookup tables.
+	    do i = 1, TEK_XRES {
+		g_hixy[i] = (i-1) / 40B + 40B
+		g_lox[i]  = mod ((i-1), 40B) + 100B
+	    }
+	    do i = 1, TEK_YRES
+		g_loy[i]  = mod ((i-1), 40B) + 140B
+
+	    first_time = false
+	}
+
+	# Allocate the stdgraph descriptor and the string buffer.
+	call calloc (g_sg, LEN_SG, TY_STRUCT)
+	call malloc (SG_SBUF(g_sg), SZ_SBUF, TY_CHAR)
+
+	# Init string buffer parameters.  The first char of the string buffer
+	# is reserved as a null string, used for graphcap control strings
+	# omitted from the graphcap entry for the device.
+
+	SG_SZSBUF(g_sg) = SZ_SBUF
+	SG_NEXTCH(g_sg) = SG_SBUF(g_sg) + 1
+	Memc[SG_SBUF(g_sg)] = EOS
+
+	# Set the software device resolution and the coordinate transformations
+	# to the resolution space and from GKI to device coords.  The values
+	# g_[xy]res were initialized when the kernel was opened by the main
+	# program.
+
+	call stg_resolution (g_xres, g_yres)
+
+	# Initialize the encoder.  The graphcap parameter LR contains encoder
+	# instructions to perform any device dependent initialization required.
+
+	call aclri (g_reg, NREGISTERS)
+	nextch = SG_NEXTCH(g_sg)
+
+	g_reg[E_IOP] = 1
+	g_reg[E_TOP] = SZ_MEMORY
+	if (ttygets (tty, "LR", Memc[nextch], SZ_SBUF-1) > 0)
+	    junk = stg_encode (Memc[nextch], g_mem, g_reg)
+
+	# If the device does not support hardware character generation, set
+	# txquality to high to get software character generation.
+
+	if (!ttygetb (tty, "tx"))
+	    g_hardchar = GT_HIGH
+
+	# Initialize the character scaling parameters, required for text
+	# generation.  The heights are given in NDC units in the graphcap
+	# file, which we convert to GKI units.  Estimated values are
+	# supplied if the parameters are missing in the graphcap entry.
+
+	char_height = ttygetr (tty, "ch")
+	if (char_height < EPSILON)
+	    char_height = 1.0 / 35.0
+	char_height = char_height * GKI_MAXNDC
+
+	char_width = ttygetr (tty, "cw")
+	if (char_width < EPSILON)
+	    char_width = 1.0 / 80.0
+	char_width = char_width * GKI_MAXNDC
+
+	# If the device has a set of discrete character sizes, get the
+	# size of each by fetching the parameter "tN", where the N is
+	# a digit specifying the text size index.  Compute the height and
+	# width of each size character from the "ch" and "cw" parameters
+	# and the relative scale of character size I.
+
+	SG_NCHARSIZES(g_sg) = min (MAX_CHARSIZES, ttygeti (tty, "th"))
+	nextch = SG_NEXTCH(g_sg)
+
+	if (SG_NCHARSIZES(g_sg) <= 0) {
+	    SG_NCHARSIZES(g_sg) = 1
+	    SG_CHARSIZE(g_sg,1) = 1.0
+	} else {
+	    Memc[nextch+2] = EOS
+	    for (i=1;  i <= SG_NCHARSIZES(g_sg);  i=i+1) {
+		Memc[nextch] = 't'
+		Memc[nextch+1] = TO_DIGIT(i)
+		char_size = ttygetr (tty, Memc[nextch])
+		SG_CHARSIZE(g_sg,i)   = char_size
+		SG_CHARHEIGHT(g_sg,i) = char_height * char_size
+		SG_CHARWIDTH(g_sg,i)  = char_width  * char_size
+	    }
+	}
+
+	# Initialize the output parameters.  All boolean parameters are stored
+	# as integer flags.  All string valued parameters are stored in the
+	# string buffer, saving a pointer to the string in the stdgraph
+	# descriptor.  If the capability does not exist the pointer is set to
+	# point to the null string at the beginning of the string buffer.
+
+	SG_POLYLINE(g_sg)   = btoi (ttygetb (tty, "PL"))
+	SG_POLYMARKER(g_sg) = btoi (ttygetb (tty, "pm"))
+	SG_FILLAREA(g_sg)   = btoi (ttygetb (tty, "fa"))
+
+	SG_ENCODEXY(g_sg)   = stg_gstring ("XY")
+	g_xy = SG_ENCODEXY(g_sg)
+
+	SG_STARTDRAW(g_sg)  = stg_gstring ("DS")
+	SG_ENDDRAW(g_sg)    = stg_gstring ("DE")
+	SG_STARTMOVE(g_sg)  = stg_gstring ("VS")
+	SG_ENDMOVE(g_sg)    = stg_gstring ("VE")
+	SG_STARTMARK(g_sg)  = stg_gstring ("MS")
+	SG_ENDMARK(g_sg)    = stg_gstring ("ME")
+	SG_STARTFILL(g_sg)  = stg_gstring ("FS")
+	SG_ENDFILL(g_sg)    = stg_gstring ("FE")
+	SG_STARTTEXT(g_sg)  = stg_gstring ("TS")
+	SG_ENDTEXT(g_sg)    = stg_gstring ("TE")
+
+	# Initialize the input parameters.
+	SG_CURSOR(g_sg) = 0
+	SG_UPDCURSOR(g_sg)  = btoi (ttygetb (tty, "UC"))
+	SG_CURSOR_X(g_sg)   = 0
+	SG_CURSOR_Y(g_sg)   = 0
+
+	# Save the device string in the descriptor.
+	nextch = SG_NEXTCH(g_sg)
+	SG_DEVNAME(g_sg) = nextch
+	maxch = SG_SBUF(g_sg) + SZ_SBUF - nextch + 1
+	nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1
+
+	# Initialize the UIFNAME field.
+	SG_UIFNAME(g_sg) = nextch
+	Memc[nextch] = EOS
+	nextch = nextch + SZ_UIFNAME + 1
+	SG_NEXTCH(g_sg) = nextch
+end
+
+
+# STG_GSTRING -- Get a string value parameter from the graphcap table,
+# placing the string at the end of the string buffer.  If the device does
+# not have the named capability return a pointer to the null string,
+# otherwise return a pointer to the string.  Since pointers are used,
+# rather than indices, the string buffer is fixed in size.  The additional
+# degree of indirection required with an index was not considered worthwhile
+# in this application since the graphcap entries are never very large.
+
+pointer procedure stg_gstring (cap)
+
+char	cap[ARB]		# device capability to be fetched
+pointer	strp, nextch
+int	maxch, nchars
+int	ttygets()
+include	"stdgraph.com"
+
+begin
+	nextch = SG_NEXTCH(g_sg)
+	maxch = SG_SBUF(g_sg) + SZ_SBUF - nextch + 1
+
+	nchars = ttygets (g_tty, cap, Memc[nextch], maxch)
+	if (nchars > 0) {
+	    strp = nextch
+	    nextch = nextch + nchars + 1
+	} else
+	    strp = SG_SBUF(g_sg)
+
+	SG_NEXTCH(g_sg) = nextch
+	return (strp)
+end
diff --git a/sys/gio/stdgraph/stglkcur.x b/sys/gio/stdgraph/stglkcur.x
new file mode 100644
index 00000000..6152534b
--- /dev/null
+++ b/sys/gio/stdgraph/stglkcur.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_LOCKCURSOR -- Lock the logical cursor number.  Called interactively by
+# cursor mode in response to a ":.cursor N" command by the user.  When the
+# cursor is not locked the logical cursor may be selected under program
+# control.
+
+procedure stg_lockcursor (new_cursor)
+
+int	new_cursor		# desired new logical cursor
+include	"stdgraph.com"
+
+begin
+	g_cursor = new_cursor
+end
diff --git a/sys/gio/stdgraph/stgmove.x b/sys/gio/stdgraph/stgmove.x
new file mode 100644
index 00000000..5f7396a3
--- /dev/null
+++ b/sys/gio/stdgraph/stgmove.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_MOVE -- Output a device move instruction to move to the position (x,y)
+# in GKI coordinates.
+
+procedure stg_move (x, y)
+
+int	x, y			# destination
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	# Transform the first point from GKI coords to device coords and
+	# move to the transformed point.
+
+	call ttyputs (g_out, g_tty, Memc[SG_STARTMOVE(g_sg)], 1)
+
+	g_reg[1] = x * g_dx + g_x1
+	g_reg[2] = y * g_dy + g_y1
+	g_reg[E_IOP] = 1
+	if (stg_encode (Memc[g_xy], g_mem, g_reg) == OK)
+	    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+	
+	call ttyputs (g_out, g_tty, Memc[SG_ENDMOVE(g_sg)], 1)
+end
diff --git a/sys/gio/stdgraph/stgonerr.x b/sys/gio/stdgraph/stgonerr.x
new file mode 100644
index 00000000..047c6152
--- /dev/null
+++ b/sys/gio/stdgraph/stgonerr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_ONERROR -- Called when error recovery takes place to deactivate the
+# stdgraph workstation, i.e., take the terminal out of graphics mode.  If
+# this is not done error messages will be written as vectors.
+
+procedure stg_onerror (errcode)
+
+int	errcode
+include	"stdgraph.com"
+
+begin
+	if (g_active == YES)
+	    call stg_deactivatews (0)
+end
diff --git a/sys/gio/stdgraph/stgonint.x b/sys/gio/stdgraph/stgonint.x
new file mode 100644
index 00000000..2aed03ee
--- /dev/null
+++ b/sys/gio/stdgraph/stgonint.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<xwhen.h>
+include	"stdgraph.h"
+
+# STG_ONINT -- Interrupt handler for the stdgraph kernel.  If an interrupt
+# occurs while we are posted to an exception, branch to the last ZSVJMP.
+# (This library procedure is not currently used by the kernel).
+
+procedure stg_onint (vex, next_handler)
+
+int	vex			# virtual exception
+int	next_handler		# next exception handler in chain
+int	jmpbuf[LEN_JUMPBUF]
+common	/stgxin/ jmpbuf
+
+begin
+	call xer_reset()
+	call zdojmp (jmpbuf, vex)
+end
diff --git a/sys/gio/stdgraph/stgopen.x b/sys/gio/stdgraph/stgopen.x
new file mode 100644
index 00000000..47fb2b61
--- /dev/null
+++ b/sys/gio/stdgraph/stgopen.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_OPEN -- Install the STDGRAPH kernel as a graphics kernel device driver.
+# The device table DD consists of an array of the entry point addresses for
+# the driver procedures.  If a driver does not implement a particular
+# instruction the table entry for that procedure may be set to zero, causing
+# the interpreter to ignore the instruction.
+
+procedure stg_open (devname, dd, in, out, xres, yres, hardchar)
+
+char	devname[ARB]		# if nonnull, force output to device
+int	dd[ARB]			# device table to be initialized
+int	in			# input file
+int	out			# output file
+int	xres			# number of resolved pixels in X
+int	yres			# number of resolved pixels in Y
+int	hardchar		# use hardware character generator
+
+bool	first_time
+pointer	sp, devns
+int	len_devname
+int	locpr(), strlen()
+
+extern	stg_openws(), stg_closews(), stg_clear(), stg_cancel()
+extern	stg_flush(), stg_polyline(), stg_polymarker(), stg_text()
+extern	stg_fillarea(), stg_putcellarray(), stg_setcursor(), stg_plset()
+extern	stg_pmset(), stg_txset(), stg_faset(), stg_getcursor()
+extern	stg_getcellarray(), stg_escape()
+extern	stg_reactivatews(), stg_deactivatews()
+include	"stdgraph.com"
+data	first_time /true/
+
+begin
+	call smark (sp)
+	call salloc (devns, SZ_FNAME, TY_SHORT)
+
+	if (first_time) {
+	    g_nopen = 0
+	    g_sg = NULL
+	    g_tty = NULL
+	    g_term = NULL
+	    g_pbtty = NULL
+	    g_cursor = 0
+	    first_time = false
+	}
+
+	g_in   = in
+	g_out  = out
+	g_xres = xres
+	g_yres = yres
+	g_nopen = g_nopen + 1
+	g_stream = STDGRAPH
+	g_hardchar = hardchar
+	g_active = NO
+	g_enable = NO
+	g_message = NO
+	g_msgbuf = NULL
+	g_msgbuflen = 0
+	g_msglen = 0
+	call strcpy (devname, g_device, SZ_GDEVICE)
+
+	# Install the device driver.
+	dd[GKI_OPENWS]		= locpr (stg_openws)
+	dd[GKI_CLOSEWS]		= locpr (stg_closews)
+	dd[GKI_REACTIVATEWS]	= locpr (stg_reactivatews)
+	dd[GKI_DEACTIVATEWS]	= locpr (stg_deactivatews)
+	dd[GKI_MFTITLE]		= 0
+	dd[GKI_CLEAR]		= locpr (stg_clear)
+	dd[GKI_CANCEL]		= locpr (stg_cancel)
+	dd[GKI_FLUSH]		= locpr (stg_flush)
+	dd[GKI_POLYLINE]	= locpr (stg_polyline)
+	dd[GKI_POLYMARKER]	= locpr (stg_polymarker)
+	dd[GKI_TEXT]		= locpr (stg_text)
+	dd[GKI_FILLAREA]	= locpr (stg_fillarea)
+	dd[GKI_PUTCELLARRAY]	= locpr (stg_putcellarray)
+	dd[GKI_SETCURSOR]	= locpr (stg_setcursor)
+	dd[GKI_PLSET]		= locpr (stg_plset)
+	dd[GKI_PMSET]		= locpr (stg_pmset)
+	dd[GKI_TXSET]		= locpr (stg_txset)
+	dd[GKI_FASET]		= locpr (stg_faset)
+	dd[GKI_GETCURSOR]	= locpr (stg_getcursor)
+	dd[GKI_GETCELLARRAY]	= locpr (stg_getcellarray)
+	dd[GKI_ESCAPE]		= locpr (stg_escape)
+	dd[GKI_SETWCS]		= 0
+	dd[GKI_GETWCS]		= 0
+	dd[GKI_UNKNOWN]		= 0
+
+	# If a device was named open the workstation as well.  This is
+	# necessary to permit processing of metacode files which do not
+	# contain the open workstation instruction.
+
+	len_devname = strlen (devname)
+	if (len_devname > 0) {
+	    call achtcs (devname, Mems[devns], len_devname)
+	    call stg_openws (Mems[devns], len_devname, NEW_FILE)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stgopenws.x b/sys/gio/stdgraph/stgopenws.x
new file mode 100644
index 00000000..a70a51f7
--- /dev/null
+++ b/sys/gio/stdgraph/stgopenws.x
@@ -0,0 +1,220 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<ttset.h>
+include	<error.h>
+include	<chars.h>
+include	<finfo.h>
+include	"stdgraph.h"
+
+# STG_OPENWS -- Open the named workstation.  Once a workstation has been
+# opened we leave it open until some other workstation is opened or the
+# kernel is closed.  Opening a workstation involves initialization of the
+# kernel data structures, followed by initialization of the device itself.
+
+procedure stg_openws (devname, n, mode)
+
+short	devname[ARB]		#I device name (actually device[,uifname])
+int	n			#I length of device name
+int	mode			#I access mode
+
+bool	reinit
+long	fi[LEN_FINFO]
+int	dummy, init_file
+pointer	sp, ip, op, buf, device, uifname, fname
+
+pointer	ttygdes(), ttyodes()
+bool	ttygetb(), strne(), streq()
+int	ttygets(), open(), ttstati(), finfo(), gstrcpy()
+int	nowhite(), envfind(), strlen(), fnroot(), access()
+extern	stg_onerror()
+include	"stdgraph.com"
+define	ow_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, max (SZ_PATHNAME, n), TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Open a termcap descriptor for the terminal too, in case we need
+	# to talk to the terminal as a terminal.
+
+	if (g_term == NULL)
+	    iferr (g_term = ttyodes ("terminal"))
+		g_term = NULL
+
+	# If we are appending merely reactivate the device without performing
+	# any initialization.
+
+	if (g_sg != NULL && mode == APPEND) {
+	    if (g_active == NO) {
+		g_ucaseout = ttstati (g_out, TT_UCASEOUT)
+		if (g_ucaseout == YES)
+		    call ttseti (g_out, TT_UCASEOUT, NO)
+
+		g_active = YES
+		g_enable = YES
+	    }
+	    goto ow_
+	}
+
+	# If a device was named when the kernel was opened then output will
+	# always go to that device (g_device) regardless of the device named
+	# in the OPENWS instruction.  If no device was named (null string)
+	# then unpack the device name, passed as a short integer array.
+
+	if (g_device[1] == EOS) {
+	    call achtsc (devname, Memc[buf], n)
+	    Memc[buf+n] = EOS
+	} else
+	    call strcpy (g_device, Memc[buf], SZ_FNAME)
+
+	# Parse the "device,uifname" specification into the two fields.
+	device = buf
+	uifname = NULL
+	for (ip=buf;  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == ',') {
+		Memc[ip] = EOS
+		if (Memc[ip+1] != EOS)
+		    uifname = ip + 1
+		if (nowhite (Memc[uifname], Memc[uifname], ARB) == 0)
+		    uifname = NULL
+		break
+	    }
+
+	# If the kernel is already open for this device skip most of the
+	# initialization.  If already open for a different device free
+	# storage before reinitialization.
+
+	reinit = true
+	if (g_sg != NULL)
+	    if (strne (Memc[device], Memc[SG_DEVNAME(g_sg)])) {
+		call mfree (SG_SBUF(g_sg), TY_CHAR)
+		call mfree (g_sg, TY_STRUCT)
+		reinit = true
+	    } else
+		reinit = false
+
+	# Reinitialize the kernel datastructures.  Open graphcap descriptor
+	# for the named device, allocate and initialize descriptor and common.
+
+	if (reinit) {
+	    if (g_tty != NULL) {
+		call ttycdes (g_tty)
+		g_tty = NULL
+	    }
+
+	    iferr (g_tty = ttygdes (Memc[device])) {
+		g_tty = ttygdes ("4012")
+		call erract (EA_WARN)
+	    }
+
+	    # Initialize data structures.
+	    call stg_init (g_tty, Memc[device])
+	}
+
+	call stg_reset()
+
+	if (g_active == NO) {
+	    # Must disable stty ucaseout mode when in graphics mode, else
+	    # plotting commands may be modified by the terminal driver.
+
+	    g_ucaseout = ttstati (g_out, TT_UCASEOUT)
+	    if (g_ucaseout == YES)
+		call ttseti (g_out, TT_UCASEOUT, NO)
+
+	    # Post ONERROR cleanup routine.
+	    call onerror (stg_onerror)
+	    g_active = YES
+	    g_enable = YES
+	}
+
+	# If no UI file was specified but the device has the EM capability,
+	# use the default UI if any specified in the graphcap entry.  If the
+	# EM capability is missing, ignore any uifname specified when the
+	# device was opened.
+
+	if (ttygetb (g_tty, "EM")) {
+	    if (uifname == NULL) {
+		uifname = buf + strlen(Memc[device]) + 1
+		if (ttygets (g_tty, "ED", Memc[uifname], ARB) <= 0)
+		    uifname = NULL
+	    }
+
+	    # If the user has a version of the named UI file in their GUIDIR,
+	    # use that instead.
+
+	    if (envfind (GUIDIR, Memc[fname], SZ_PATHNAME) > 0) {
+		op = fname + strlen (Memc[fname])
+		op = op + fnroot (Memc[uifname], Memc[op],
+		    fname + SZ_PATHNAME - op)
+		op = op + gstrcpy (".gui", Memc[op], fname + SZ_PATHNAME - op)
+		if (access (Memc[fname], 0, 0) == YES)
+		    uifname = fname
+	    }
+
+	    # If the UI is already running and has not been modified there
+	    # is no need to download it again.
+
+	    if (g_sg != NULL)
+		if (streq (Memc[uifname], Memc[SG_UIFNAME(g_sg)]))
+		    if (finfo (Memc[uifname], fi) != ERR)
+			if (SG_UIFDATE(g_sg) == FI_MTIME(fi))
+			    uifname = NULL
+	} else {
+	    # Ignore UI file if no EM capability.
+	    Memc[SG_UIFNAME(g_sg)] = EOS
+	    SG_UIFDATE(g_sg) = 0
+	    uifname = NULL
+	}
+
+	# Open and Initialize the device.  Output contents of UI definition
+	# file if any, followed by graphics device initialization file,
+	# if any.
+
+	if (mode == NEW_FILE) {
+	    # Output UI definition file.
+	    if (uifname != NULL) {
+		iferr (init_file = open (Memc[uifname], READ_ONLY, TEXT_FILE)) {
+		    call erract (EA_WARN)
+		    call stg_ctrl ("OW")
+		} else {
+		    call flush (g_out)
+		    call stg_ctrl ("EM")
+
+		    # Download the UI.
+		    call putline (g_out, "server ")
+		    iferr (call fcopyo (init_file, g_out))
+			call erract (EA_WARN)
+		    call close (init_file)
+
+		    # Record particulars of active UI file.
+		    call strcpy (Memc[uifname], Memc[SG_UIFNAME(g_sg)],
+			SZ_UIFNAME)
+		    if (finfo (Memc[uifname], fi) != ERR)
+			SG_UIFDATE(g_sg) = FI_MTIME(fi)
+		    call sgf_post_filter (g_out)
+
+		    call putci (g_out, US)
+		    call flush (g_out)
+		}
+	    } else
+		call stg_ctrl ("OW")
+
+	    # Output device graphics initialization file if any.
+	    if (ttygets (g_tty, "IF", Memc[buf], SZ_FNAME) > 0) {
+		iferr (init_file = open (Memc[buf], READ_ONLY, TEXT_FILE))
+		    call erract (EA_WARN)
+		iferr (call fcopyo (init_file, g_out))
+		    call erract (EA_WARN)
+		call close (init_file)
+	    }
+
+	    # Clear the screen if device is being opened in new_file mode.
+	    call stg_clear (dummy)
+
+	} else
+ow_	    call stg_ctrl ("OW")
+
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stgoutput.x b/sys/gio/stdgraph/stgoutput.x
new file mode 100644
index 00000000..098af6e7
--- /dev/null
+++ b/sys/gio/stdgraph/stgoutput.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_OUTPUT2 -- Encode two arguments using the program given and write the
+# encoded character string to the output file.
+
+procedure stg_output2 (fd, program, arg1, arg2)
+
+int	fd			# output file
+char	program[ARB]		# encoder program defining encoding
+int	arg1			# argument to be placed in register 1
+int	arg2			# argument to be placed in register 2
+
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	# Set up encoder.
+	g_reg[1] = arg1
+	g_reg[2] = arg2
+	g_reg[E_IOP] = 1
+
+	# Encode the output string and write the encoded string to the output
+	# file.
+	if (stg_encode (g_xy, g_mem, g_reg) == OK)
+	    call write (fd, g_mem, g_reg[E_IOP] - 1)
+end
diff --git a/sys/gio/stdgraph/stgoutstr.x b/sys/gio/stdgraph/stgoutstr.x
new file mode 100644
index 00000000..2d854e75
--- /dev/null
+++ b/sys/gio/stdgraph/stgoutstr.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_OUTSTR -- Format and output a control sequence containing a string
+# string argument to the output device.
+
+procedure stg_outstr (cap, strval)
+
+char	cap[ARB]			#I graphcap capability name
+char	strval[ARB]			#I string data
+
+pointer	sp, fmt, ctrl
+include	"stdgraph.com"
+int	ttygets()
+errchk	ttygets
+
+begin
+	call smark (sp)
+	call salloc (fmt, SZ_LINE, TY_CHAR)
+	call salloc (ctrl, SZ_LINE, TY_CHAR)
+
+	if (ttygets (g_tty, cap, Memc[fmt], SZ_LINE) > 0) {
+	    call sprintf (Memc[ctrl], SZ_LINE, Memc[fmt])
+		call pargstr (strval)
+	    call ttyputs (g_out, g_tty, Memc[ctrl], 1)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stgpcell.x b/sys/gio/stdgraph/stgpcell.x
new file mode 100644
index 00000000..476d90cf
--- /dev/null
+++ b/sys/gio/stdgraph/stgpcell.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+define	ZSTEP		4	# bit to be tested (step function width)
+
+
+# STG_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).  The algorithm used here maps 8 bits in into 1 bit
+# out, using a step function lookup table.  The result is a band-contoured
+# image, where the spacing and width of the contour bands decreases as the
+# rate of change of intensity in the input cell array increases.
+
+procedure stg_putcellarray (m, nx, ny, ax1,ay1, ax2,ay2)
+
+short	m[nx,ny]		# cell array
+int	nx, ny			# number of pixels in X and Y
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+real	dx, dy
+int	my, i1, i2, v, i, j, k
+include	"stdgraph.com"
+int	and()
+
+begin
+	# Set polyline width to 1 for max y-res.
+	call stg_ctrl1 ("LW", 1)
+	SG_PLWIDTH(g_sg) = 1
+
+	# Determine the width of a cell array pixel in GKI units.
+	dx = real (ax2 - ax1) / nx
+
+	# Determine the height of a device pixel in GKI units.
+	dy = max (1.0, real(GKI_MAXNDC) / real(g_yres))
+
+	# Process the cell array.  The outer loop runs over device pixels in Y;
+	# each iteration writes one line of the output raster.  The inner loop
+	# runs down a line of the cell array.
+
+	k = 0
+	for (my = ay1 + dy/2;  my < ay2;  my = k * dy + ay1) {
+	    j = max(1, min(ny, int (real(my-ay1) / real(ay2-ay1) * (ny-1)) + 1))
+	    my = min (my, int (ay2 - dy/2))
+
+	    for (i=1;  i <= nx;  ) {
+		do i = i, nx {
+		    v = m[i,j]
+		    if (and (v, ZSTEP) != 0)
+			break
+		}
+
+		if (i <= nx) {
+		    i1 = i
+		    i2 = nx
+		    do i = i1 + 1, nx {
+			v = m[i,j]
+			if (and (v, ZSTEP) == 0) {
+			    i2 = i
+			    break
+			}
+		    }
+
+		    # The following decreases the length of dark line segments
+		    # to make features more visible.
+
+		    if (i2 - i1 >= 2)
+			if (i1 > 1 && i2 < nx) {
+			    i1 = i1 + 1
+			    i2 = i2 - 1
+			}
+
+		    # Draw the line segment.
+		    call stg_move (int ((i1-1) * dx + ax1), my)
+		    call stg_draw (int (i2 * dx + ax1), my)
+
+		    if (i2 >= nx)
+			i = nx + 1
+		}
+	    }
+
+	    k = k + 1
+	}
+end
diff --git a/sys/gio/stdgraph/stgpl.x b/sys/gio/stdgraph/stgpl.x
new file mode 100644
index 00000000..894a92c3
--- /dev/null
+++ b/sys/gio/stdgraph/stgpl.x
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_POLYLINE -- Draw a polyline.  The polyline is defined by the array of
+# points P, consisting of successive (x,y) coordinate pairs.  The first point
+# is not plotted but rather defines the start of the polyline.  The remaining
+# points define line segments to be drawn.
+
+procedure stg_polyline (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pl
+bool	tek_encoding
+int	lowres_x, lowres_y
+int	ip, n, sx, sy, len_p, iop, i
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	if (g_enable == NO)
+	    call stg_genab()
+
+	len_p = npts * 2
+
+	# Update polyline attributes if necessary.
+
+	pl = SG_PLAP(g_sg)
+	if (SG_PLTYPE(g_sg) != PL_LTYPE(pl)) {
+	    call stg_ctrl1 ("LT", PL_LTYPE(pl))
+	    SG_PLTYPE(g_sg) = PL_LTYPE(pl)
+	}
+	if (SG_PLWIDTH(g_sg) != PL_WIDTH(pl)) {
+	    call stg_ctrl1 ("LW", PL_WIDTH(pl))
+	    SG_PLWIDTH(g_sg) = PL_WIDTH(pl)
+	}
+	if (SG_COLOR(g_sg) != PL_COLOR(pl)) {
+	    call stg_ctrl1 ("LC", PL_COLOR(pl))
+	    SG_COLOR(g_sg) = PL_COLOR(pl)
+	}
+
+	# Transform the first point from GKI coords to device coords and
+	# move to the transformed point.
+
+	sx = p[1]; sy = p[2]
+	call stg_move (sx, sy)
+
+	# Tektronix encoding is treated as a special case for max efficiency.
+	tek_encoding =
+	    (Memc[g_xy] == '%' && Memc[g_xy+1] == 't' && Memc[g_xy+2] == EOS)
+
+	# Draw the polyline.  If the device has the "polyline" capability
+	# we can encode and output successive points without enclosing each
+	# individual point in the startdraw and enddraw strings.
+
+	for (ip=3;  ip <= len_p;  ip=ip+2) {
+	    # Output start draw sequence.
+	    call ttyputs (g_out, g_tty, Memc[SG_STARTDRAW(g_sg)], 1)
+
+	    # Determine number of points to output.
+	    if (SG_POLYLINE(g_sg) == YES)
+		n = len_p
+	    else
+		n = ip + 2
+
+	    # Encode the points of the polyline.
+
+	    g_lastx = -1	# clip unresolved points only in the interior
+	    g_lasty = -1	# of the polyline being drawn.
+
+	    g_reg[E_IOP] = 1
+	    do i = ip, n, 2 {
+		sx = p[i]
+		sy = p[i+1]
+
+		# Discard the point if it is not resolved.
+		lowres_x = sx / g_dxres
+		lowres_y = sy / g_dyres
+		if (lowres_x == g_lastx && lowres_y == g_lasty)
+		    next
+
+		g_lastx = lowres_x
+		g_lasty = lowres_y
+
+		# Transform point into the device window.
+		sx = int (sx * g_dx) + g_x1
+		sy = int (sy * g_dy) + g_y1
+
+		# Encode the point, appending encoded bytes to g_mem.  Tek
+		# encoding is treated as a special case since it is so common;
+		# the encoder is used for non-Tek encodings.
+
+		if (tek_encoding) {
+		    iop = g_reg[E_IOP] + 4
+		    g_mem[iop-4] = g_hixy[sy+1]
+		    g_mem[iop-3] = g_loy[sy+1]
+		    g_mem[iop-2] = g_hixy[sx+1]
+		    g_mem[iop-1] = g_lox[sx+1]
+		    g_reg[E_IOP] = iop
+		} else {
+		    g_reg[1] = sx
+		    g_reg[2] = sy
+		    if (stg_encode (Memc[g_xy], g_mem, g_reg) != OK)
+			break
+		}
+
+		# Flush buffer if nearly full.
+		if (g_reg[E_IOP] > FLUSH_MEMORY) {
+		    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		    g_reg[E_IOP] = 1
+		}
+	    }
+	    ip = n
+
+	    # Flush any output remaining in encoder memory.
+	    if (g_reg[E_IOP] > 1) {
+		call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		g_reg[E_IOP] = 1
+	    }
+
+	    # Output end draw sequence.
+	    call ttyputs (g_out, g_tty, Memc[SG_ENDDRAW(g_sg)], 1)
+	}
+end
diff --git a/sys/gio/stdgraph/stgplset.x b/sys/gio/stdgraph/stgplset.x
new file mode 100644
index 00000000..c435feb5
--- /dev/null
+++ b/sys/gio/stdgraph/stgplset.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_PLSET -- Set the polyline attributes.  The polyline width parameter is
+# passed to the encoder as a packed floating point number, i.e., int(LWx100).
+
+procedure stg_plset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pl
+include	"stdgraph.com"
+
+begin
+	pl = SG_PLAP(g_sg)
+	PL_LTYPE(pl) = gki[GKI_PLSET_LT]
+	PL_WIDTH(pl) = max (1, nint (GKI_UNPACKREAL (gki[GKI_PLSET_LW])))
+	PL_COLOR(pl) = gki[GKI_PLSET_CI]
+end
diff --git a/sys/gio/stdgraph/stgpm.x b/sys/gio/stdgraph/stgpm.x
new file mode 100644
index 00000000..3808d63b
--- /dev/null
+++ b/sys/gio/stdgraph/stgpm.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_POLYMARKER -- Draw a polymarker.  The polymarker is defined by the array
+# of points P, consisting of successive (x,y) coordinate pairs, each of which
+# is to be plotted as a point.  If the marker start sequence MS is defined the
+# polymarker will be drawn as <markstart> <p1> ... <pN> <markend>, otherwise
+# ther marker is draw using the polyline move and draw commands to draw each
+# individual point.
+
+procedure stg_polymarker (p, npts)
+
+short	p[ARB]			# points defining line
+int	npts			# number of points, i.e., (x,y) pairs
+
+pointer	pm
+bool	tek_encoding
+int	lowres_x, lowres_y
+int	ip, n, sx, sy, len_p, iop, i
+int	stg_encode()
+include	"stdgraph.com"
+
+begin
+	if (g_enable == NO)
+	    call stg_genab()
+
+	len_p = npts * 2
+
+	# Update polymarker attributes if necessary.
+
+	pm = SG_PMAP(g_sg)
+	if (SG_COLOR(g_sg) != PM_COLOR(pm)) {
+	    call stg_ctrl1 ("MC", PM_COLOR(pm))
+	    SG_COLOR(g_sg) = PM_COLOR(pm)
+	}
+
+	# Tektronix encoding is treated as a special case for max efficiency.
+	tek_encoding =
+	    (Memc[g_xy] == '%' && Memc[g_xy+1] == 't' && Memc[g_xy+2] == EOS)
+
+	# Draw the polymarker.  If the startmark sequence is defined we assume
+	# that the device can draw a multipoint polymarker, else low level move
+	# and draw sequences are used.
+
+	if (Memc[SG_STARTMARK(g_sg)] != EOS) {
+	    for (ip=1;  ip <= len_p;  ip=ip+2) {
+		# Output start marker sequence [revised to use the encoder].
+		call ttyputs (g_out, g_tty, Memc[SG_STARTMARK(g_sg)], 1)
+		n = len_p
+
+		# Encode the points of the polymarker (or move to the single
+		# point to be drawn).
+
+		g_lastx = -1	# clip unresolved points only in the interior
+		g_lasty = -1	# of the polymarker being drawn.
+
+		g_reg[E_IOP] = 1
+		do i = ip, n, 2 {
+		    sx = p[i]
+		    sy = p[i+1]
+
+		    # Discard the point if it is not resolved.
+		    lowres_x = sx / g_dxres
+		    lowres_y = sy / g_dyres
+		    if (lowres_x == g_lastx && lowres_y == g_lasty)
+			next
+
+		    g_lastx = lowres_x
+		    g_lasty = lowres_y
+
+		    # Transform point into the device window.
+		    sx = int (sx * g_dx) + g_x1
+		    sy = int (sy * g_dy) + g_y1
+
+		    # Encode the point, appending encoded bytes to g_mem.
+		    # Tek encoding is treated as a special case since it is
+		    # so common; the encoder is used for non-Tek encodings.
+
+		    if (tek_encoding) {
+			iop = g_reg[E_IOP] + 4
+			g_mem[iop-4] = g_hixy[sy+1]
+			g_mem[iop-3] = g_loy[sy+1]
+			g_mem[iop-2] = g_hixy[sx+1]
+			g_mem[iop-1] = g_lox[sx+1]
+			g_reg[E_IOP] = iop
+		    } else {
+			g_reg[1] = sx
+			g_reg[2] = sy
+			if (stg_encode (Memc[g_xy], g_mem, g_reg) != OK)
+			    break
+		    }
+
+		    # Flush buffer if nearly full.
+		    if (g_reg[E_IOP] > FLUSH_MEMORY) {
+			call write (g_out, g_mem, g_reg[E_IOP] - 1)
+			g_reg[E_IOP] = 1
+		    }
+		}
+		ip = n
+
+		# Flush any output remaining in encoder memory.
+		if (g_reg[E_IOP] > 1) {
+		    call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		    g_reg[E_IOP] = 1
+		}
+
+		# Output end polymarker sequence, or draw the point.
+		call ttyputs (g_out, g_tty, Memc[SG_ENDMARK(g_sg)], 1)
+	    }
+	} else {
+	    for (ip=1;  ip <= len_p;  ip=ip+2) {
+		sx = p[ip];  sy = p[ip+1]
+		call stg_move (sx, sy)
+		call stg_draw (sx, sy)
+	    }
+	}
+end
diff --git a/sys/gio/stdgraph/stgpmset.x b/sys/gio/stdgraph/stgpmset.x
new file mode 100644
index 00000000..6651564f
--- /dev/null
+++ b/sys/gio/stdgraph/stgpmset.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_PMSET -- Set the polymarker attributes.
+
+procedure stg_pmset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	pm
+include	"stdgraph.com"
+
+begin
+	pm = SG_PMAP(g_sg)
+	PM_LTYPE(pm) = gki[GKI_PMSET_MT]
+	PM_WIDTH(pm) = max (1, nint (GKI_UNPACKREAL (gki[GKI_PMSET_MW])))
+	PM_COLOR(pm) = gki[GKI_PMSET_CI]
+end
diff --git a/sys/gio/stdgraph/stgrcur.x b/sys/gio/stdgraph/stgrcur.x
new file mode 100644
index 00000000..e0ab890a
--- /dev/null
+++ b/sys/gio/stdgraph/stgrcur.x
@@ -0,0 +1,425 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<error.h>
+include	<chars.h>
+include	<ttset.h>
+include	<gset.h>
+include	<fset.h>
+include	<gki.h>
+include	"stdgraph.h"
+
+define	MAX_LENCUR	17
+define	MAX_KEYLINES	30
+define	KEYSIZE		1
+define	QUIT		'q'
+define	GO		'g'
+
+# STG_READCURSOR -- Physically read the cursor, returning the cursor position
+# in GKI coordinates and the keystroke value as output arguments.  The cursor
+# value string is read in raw mode with interrupts disabled.  Receipt of the
+# EOF character or CR causes EOF to be returned as the key value.
+#
+# The cursor is described by two parameters, a pattern string (CD) and a string
+# length parameter (CN).
+#
+#	CD	A pattern specifying either the delimiter sequence if
+#		len_curval > 0, or the entire cursor value string if
+#		len_curval <= 0.
+#
+#	CN	If no pattern is given, CN is the number of characters to be
+#		read and automatic error detection is not possible.  If a
+#		pattern is given, a negative CN specifies the minimum number
+# 		of characters in the cursor value string, with the pattern
+#		being used to match the characters in the actual cursor value
+#		string.  A positive CN specifies a fixed length cursor value
+#		string, which which case the pattern is used only to determine
+#		when a valid cursor value string has been received.
+#
+# The cursor read algorithm tries to ignore unsolicited input and recover from
+# bad cursor reads, or loss of hardware cursor mode during a cursor read, e.g.,
+# if the screen is accidentally cleared or the terminal otherwise initialized.
+#
+# The physical cursor read sequence is implemented by the stg_rdcursor routine.
+# The purpose of the higher level routine is to support STTY playback mode.
+# In playback mode, terminal input is taken from a logfile rather than from
+# the physical terminal; this is used to prepare automatic scripts to test
+# software and for demos.  If playback mode is enabled and `verify' is enabled,
+# the logged cursor position will be read, a WC will be issued to move the
+# cursor to that position, and then the physical cursor will be read and the
+# return value discard, returning the logged position to the calling program.
+# In playback mode with `verify' disabled, we need only disable the RC
+# instruction and read the logged cursor position; the physical cursor is
+# never turned on.
+
+procedure stg_readcursor (cursor, cn, key, sx, sy, raster, rx, ry)
+
+int	cursor		#I cursor to be read
+int	cn		#O cursor which was read
+int	key		#O keystroke which terminated cursor read
+int	sx, sy		#O screen coordinates of cursor in GKI units
+int	raster		#O raster number
+int	rx, ry		#O raster coordinates of cursor in GKI units
+
+short	texts[4]
+char	textc[4], ch
+pointer	sp, pbdevice, tx, o_tx
+int	delay, nchars, mx, my, i, j, k
+bool	playback_mode, pbverify_mode
+
+bool	strne()
+pointer	ttygdes()
+int	ttstati(), ttstats(), ctocc()
+errchk	ttygdes, syserr
+include	"stdgraph.com"
+define	samedev_ 91
+
+begin
+	playback_mode = (ttstati (STDIN, TT_PLAYBACK) == YES)
+
+	if (!playback_mode) {
+	    call stg_rdcursor (g_tty, cursor, YES,
+		cn, key, sx, sy, raster, rx, ry)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (pbdevice, SZ_GDEVICE, TY_CHAR)
+	call salloc (o_tx, LEN_TX, TY_STRUCT)
+
+	# The playback script may have been generated on a different graphics
+	# terminal than the one we are playing it back on.  Open the graphcap
+	# descriptor for the device used when the script was recorded.  This
+	# must be used when decoding cursor input from the logfile.  If device
+	# name not recorded in logfile, try to make do with the descriptor for
+	# the current stdgraph device.
+
+	if (ttstats (STDIN, TT_GDEVICE, Memc[pbdevice], SZ_GDEVICE) <= 0) {
+	    # Device name not recorded in logfile.
+	    call syserr (SYS_STTYNOGDEV)
+
+	} else if (g_pbtty == NULL || strne (g_pbdevice, Memc[pbdevice])) {
+	    # Device name was recorded; try to load graphcap for it if not
+	    # already loaded.
+
+	    if (g_pbtty != NULL)
+		call ttycdes (g_pbtty)
+	    iferr (g_pbtty = ttygdes (Memc[pbdevice])) {
+		g_pbtty = NULL
+		call erract (EA_ERROR)
+	    }
+
+	    call strcpy (Memc[pbdevice], g_pbdevice, SZ_GDEVICE)
+	}
+
+	# Set the playback delay to 0 msec while reading the cursor, else
+	# the multicharacter cursor read will take forever.  We issue the
+	# delay below, ourselves, one per cursor read.
+
+	delay = ttstati (STDIN, TT_PBDELAY)
+	call ttseti (STDIN, TT_PBDELAY, 0)
+
+	# Read the logged cursor position with RC disabled.
+	call stg_rdcursor (g_pbtty, cursor, NO,
+	    cn, key, sx, sy, raster, rx, ry)
+
+	# Determine if verify mode is set for this cursor read.  This must
+	# be done after the call to stg_rdcursor to permit processing of
+	# any \{ .. \} in the logfile.
+
+	pbverify_mode = (ttstati (STDIN, TT_PBVERIFY) == YES)
+
+	# Set passthru mode to read/write the device directly.
+	call ttseti (STDIN, TT_PASSTHRU, YES)
+
+	# Encode the logged keystroke as a character string.
+	if (key == EOF) {
+	    call strcpy ("EOF", textc, 4)
+	    nchars = 3
+	} else if (key <= ' ') {
+	    ch = key
+	    nchars = ctocc (ch, textc, 4)
+	} else {
+	    nchars = 1
+	    textc[1] = key
+	}
+
+	# Pack the string in a short array for the GKI operator.
+	call achtcs (textc, texts, nchars)
+
+	# Set the text drawing attributes.
+	tx = SG_TXAP(g_sg)
+	call amovi (Memi[tx], Memi[o_tx], LEN_TX)
+	TX_SIZE(tx) = KEYSIZE
+	TX_HJUSTIFY(tx) = GT_LEFT
+	TX_VJUSTIFY(tx) = GT_BOTTOM
+
+	# Echo the key character in graphics mode on the top line of the screen,
+	# duplicating the text drawn at the cursor position.
+
+	mx = nint ((g_keycol + 0.5) * SG_CHARWIDTH(g_sg,1))
+	my = GKI_MAXNDC - nint ((g_keyline + 0.2) * SG_CHARHEIGHT(g_sg,KEYSIZE))
+
+	call stg_text (mx, my, texts, nchars)
+	g_keyline = g_keyline + 1
+	if (g_keyline > MAX_KEYLINES) {
+	    g_keycol = g_keycol + 1
+	    g_keyline = 1
+	}
+
+	# Echo the logged keystroke at the position of the cursor.  This may
+	# not always be readable, but at least it marks the cursor position.
+
+	call stg_text (sx, sy, texts, nchars)
+
+	if (pbverify_mode) {
+	    # Issue a WC to set the cursor position, and perform a normal
+	    # cursor read in passthru mode, discarding the return value.
+
+	    call stg_setcursor (sx, sy, cursor)
+	    call stg_rdcursor (g_tty, cursor, YES, i, i, j, k, i, j, k)
+
+	    # User wants to terminate playback mode?
+	    if (k == QUIT || k == INTCHAR) {
+		call ttseti (STDIN, TT_PLAYBACK, NO)
+		call stg_ctrl ("GD")
+		call putline (STDOUT, "[playback mode terminated]")
+		call stg_ctrl ("GE")
+		call flush (STDOUT)
+		call zwmsec (500)
+		if (k == INTCHAR)
+		    key = EOF
+	    } else if (k == GO)
+		call ttseti (STDIN, TT_PBVERIFY, NO)
+	} else
+	    call zwmsec (delay)
+
+	# Restore everything modified earlier.
+	call ttseti (STDIN, TT_PASSTHRU, NO)
+	call ttseti (STDIN, TT_PBDELAY, delay)
+	call amovi (Memi[o_tx], Memi[tx], LEN_TX)
+
+	call sfree (sp)
+end
+
+
+# STG_RDCURSOR -- Physically read the cursor; an internal routine called only
+# by the stg_readcursor procedure.  A lower level routine is needed since
+# two cursor reads may be required in STTY playback mode, one to read the
+# logged cursor position and another to read the physical cursor to synch
+# with the user.  This is the real cursor read routine; the only concession
+# to playback mode is the `output_rc' switch, to disable output of the RC
+# instruction to the terminal, so that the routine does only input from the
+# logical device.
+
+procedure stg_rdcursor (tty, cursor, output_rc, cn, key, sx,sy, raster, rx,ry)
+
+pointer	tty		#I graphcap descriptor
+int	cursor		#I cursor to be read
+int	output_rc	#I flag to output the RC instruction
+int	cn		#O cursor which was read
+int	key		#O keystroke which terminated cursor read
+int	sx, sy		#O cursor screen position in GKI coords
+int	raster		#O raster number
+int	rx, ry		#O cursor raster position in GKI coords
+
+pointer	decodecur, delimcur, pattern, patbuf, sp, otop
+int	len_pattern, len_curval, sv_iomode, nchars, ip, op, i1, i2, ch
+
+bool	ttygetb()
+int	getci(), stg_encode()
+int	ttygets(), ttygeti(), gstrcpy(), gpatmatch(), patmake(), fstati()
+include	"stdgraph.com"
+define	quit_ 91
+
+begin
+	call smark (sp)
+	call salloc (pattern, SZ_LINE, TY_CHAR)
+	call salloc (patbuf, SZ_LINE, TY_CHAR)
+	call salloc (decodecur, SZ_LINE, TY_CHAR)
+	call salloc (delimcur, SZ_FNAME, TY_CHAR)
+
+	key = EOF
+
+	# Make sure there is a cursor before going any further.
+	if (!ttygetb (g_tty, "RC"))
+	    goto quit_
+
+	len_curval = ttygeti (tty, "CN")
+	if (ttygets (tty, "SC", Memc[decodecur], SZ_LINE) <= 0)
+	    goto quit_
+
+	len_pattern = 0
+	if (ttygets (tty, "CD", Memc[delimcur], SZ_FNAME) > 0)
+	    len_pattern = gstrcpy (Memc[delimcur], Memc[pattern], SZ_LINE)
+
+	# Either len_curval or pattern must be given, preferably both.
+	if (len_curval == 0 && len_pattern == 0)
+	    goto quit_
+
+	# Encode the cursor value pattern, which may be either a pattern
+	# matching the entire cursor value, or just the delimiter.  The value
+	# of len_curval may be negative if a pattern is given, but must be
+	# positive otherwise.  If the pattern is a delimiter string, append
+	# the $ metacharacter to match only at the end of the string.
+
+	if (len_pattern > 0) {
+	    if (len_curval > 0) {
+		Memc[pattern+len_pattern] = '$'
+		len_pattern = len_pattern + 1
+		Memc[pattern+len_pattern] = EOS
+	    }
+	    if (patmake (Memc[pattern], Memc[patbuf], SZ_LINE) == ERR)
+		goto quit_
+	} else if (len_curval < 0)
+	    len_curval = -len_curval
+
+	# Set raw mode on the input file (the graphics terminal).
+	call flush (STDOUT); call flush (STDERR)
+	sv_iomode = fstati (g_in, F_IOMODE)
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, IO_RAW)
+
+	repeat {
+	    # Initiate a cursor read.
+	    if (output_rc == YES) {
+		call stg_ctrl1 ("RC", cursor)
+		call flush (g_out)
+	    }
+
+	    # Read the cursor value string.  If a pattern is given accumulate
+	    # at least abs(len_curval) characters and stop when the pattern
+	    # is matched, returning the last len_curval characters if
+	    # len_curval > 0, else the matched substring.  If no pattern is
+	    # given simply accumulate len_curval characters.  The number of
+	    # characters we will accumulate in one iteration is limited to
+	    # MAX_LENCUR to permit retransmission of the RC control sequence
+	    # in the event that hardware cursor mode is accidentally cleared.
+
+	    for (op=1;  op <= MAX_LENCUR;  op=op+1) {
+		g_mem[op] = getci (g_in, key)
+		g_mem[op+1] = EOS
+
+		if (key == EOF) {
+		    # Turn off raw input mode and return EOF.
+		    key = EOF
+		    if (sv_iomode != IO_RAW)
+			call fseti (g_in, F_IOMODE, sv_iomode)
+		    goto quit_
+
+		} else if (len_pattern > 0) {
+		    # A pattern string was given.  Once the minimum number of
+		    # chars have been accumulated, try to match the pattern,
+		    # which may match either the cursor string delimiter (in
+		    # the case of a fixed length cursor value), or the entire
+		    # cursor string (which may then be variable length).
+
+		    if (op < abs(len_curval))
+			next
+		    else if (gpatmatch (g_mem[1], Memc[patbuf], i1,i2) > 0) {
+			if (len_curval > 0)
+			    ip = op - len_curval + 1 	# fixed length cur
+			else
+			    ip = i1			# variable length cur
+			break
+		    }
+
+		} else if (op >= len_curval) {
+		    # No pattern was given.  Terminate the cursor read once
+		    # the len_curval characters have been accumulated.
+
+		    ip = 1
+		    break
+		}
+	    }
+
+	    # We have received too many characters, indicating that cursor
+	    # mode was lost and the user has been pounding on the keyboard
+	    # trying to get the cursor back.  Discard the chars, restart
+	    # the cursor and try again.
+
+	    if (op > MAX_LENCUR)
+		op = -1
+
+	} until (op >= abs(len_curval) || len_curval == 0)
+
+	# Decode the cursor value string and return the position and key
+	# as output values.  Return the cursor position in GKI coordinates.
+	# If extra characters were typed, e.g., before the cursor was turned
+	# on, and the cursor has a delimiter string, the extra characters will
+	# have been read into low memory and we should be able to ignore them
+	# and still get a valid read.
+
+	g_reg[E_IOP] = ip
+	call aclri (g_reg, 7)
+	if (stg_encode (Memc[decodecur], g_mem, g_reg) != OK)
+	    call syserr (SYS_GGCUR)
+
+	# Multiple cursors are not implemented yet so just echo input.
+	cn  = cursor
+
+	# Standard cursor value.
+	sx  = nint ((g_reg[1] - g_x1) / g_dx)
+	sy  = nint ((g_reg[2] - g_y1) / g_dy)
+	key = g_reg[3]
+
+	# Only some devices return the following fields.  Note that FX,FY
+	# are returned by stg_encode in GKI coordinates.
+
+	nchars = g_reg[4]
+	raster = g_reg[5]
+	if (raster == 0) {
+	    rx = sx
+	    ry = sy
+	} else {
+	    rx = g_reg[6]
+	    ry = g_reg[7]
+	}
+
+	# If the NCHARS field is nonzero then a data block of length nchars
+	# follows the cursor value struct returned by the terminal.  Read this
+	# into the g_msgbuf message buffer.  The client makes a subsequent
+	# call to stg_readtty to access this data, otherwise it is discarded
+	# in the next cursor read.
+
+	if (nchars > 0) {
+	    if (nchars > g_msgbuflen) {
+		g_msgbuflen = (nchars + SZ_MSGBUF - 1) / SZ_MSGBUF * SZ_MSGBUF
+		call realloc (g_msgbuf, g_msgbuflen, TY_CHAR)
+	    }
+
+	    # We should encode this data transfer in a way that permits
+	    # detection and recovery from lost data.  For the moment, the
+	    # following assumes that nchars of data will actually be received.
+
+	    op = g_msgbuf
+	    otop = g_msgbuf + nchars
+	    while (op < otop && getci (g_in, ch) != EOF) {
+		Memc[op] = ch
+	        op = op + 1
+	    }
+	    g_msglen = op - g_msgbuf
+	    Memc[op] = EOS
+
+	} else
+	    g_msglen = 0
+
+	# Turn off raw input mode.
+	if (sv_iomode != IO_RAW)
+	    call fseti (g_in, F_IOMODE, sv_iomode)
+
+	# Return EOF if any EOF character (e.g., <ctrl/z> or <ctrl/d>) or the
+	# interrupt character is typed.
+
+	if (key == EOFCHAR || key == INTCHAR || key == '\004' || key == '\032')
+	    key = EOF
+quit_
+	# Terminate the cursor read.
+	if (output_rc == YES) {
+	    call stg_ctrl1 ("RE", cursor)
+	    call flush (g_out)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/stgreact.x b/sys/gio/stdgraph/stgreact.x
new file mode 100644
index 00000000..21c2a821
--- /dev/null
+++ b/sys/gio/stdgraph/stgreact.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<ttset.h>
+include	"stdgraph.h"
+
+# STG_REACTIVATEWS -- Reactivate the workstation, i.e., enable graphics.
+
+procedure stg_reactivatews (flags)
+
+int	flags			# action flags (handled by cursor mode)
+
+int	junk
+int	ttstati(), ttyctrl(), and()
+extern	stg_onerror()
+include	"stdgraph.com"
+
+begin
+	if (g_active == NO) {
+	    junk = ttyctrl (g_out, g_tty, "OW", 1)
+
+	    # Post error handler to be called if we abort.
+	    call onerror (stg_onerror)
+
+	    g_active = YES
+	    g_enable = YES
+
+	    # Must disable stty ucaseout mode when in graphics mode, else
+	    # plotting commands may be modified by the terminal driver.
+
+	    g_ucaseout = ttstati (g_out, TT_UCASEOUT)
+	    if (g_ucaseout == YES)
+		call ttseti (g_out, TT_UCASEOUT, NO)
+
+	    # Clear the graphics screen?
+	    if (and (flags, AW_CLEAR) != 0)
+		call stg_clear (0)
+
+	    call flush (g_out)
+	}
+end
diff --git a/sys/gio/stdgraph/stgres.x b/sys/gio/stdgraph/stgres.x
new file mode 100644
index 00000000..d6355bd9
--- /dev/null
+++ b/sys/gio/stdgraph/stgres.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_RESOLUTION -- Set the "soft" device resolution.  When plotting GKI
+# coordinates are transformed into a space with the indicated resolution and
+# unresolved points are discarded, before transforming to device coordinates.
+# We must set up both the transformation to resolution space and the
+# transformation to device space.
+
+procedure stg_resolution (xres, yres)
+
+int	xres				# device X resolution
+int	yres				# device Y resolution
+int	nx, ny
+int	ttygeti()
+include	"stdgraph.com"
+
+begin
+	if (g_tty == NULL) {
+	    g_xres = xres
+	    g_yres = yres
+	    return
+	}
+
+	# Set the resolution value in the stdgraph common only if a nonzero
+	# value is given.  A value of zero does not change the resolution.
+
+	if (xres > 0)
+	    g_xres = xres
+	if (yres > 0)
+	    g_yres = yres
+
+
+	# If we still have a zero resolution then we use the full resolution
+	# of the device.  The 3/4 reduction in resolution is needed to clip
+	# points that would be unresolved due to integer truncation effects.
+
+	if (g_xres <= 0) {
+	    g_xres = ttygeti (g_tty, "xr")
+	    if (g_xres <= 0)
+		g_xres = 1024
+	    g_xres = max (2, g_xres * 3 / 4)
+	}
+	if (g_yres <= 0) {
+	    g_yres = ttygeti (g_tty, "yr")
+	    if (g_yres <= 0)
+		g_yres = 1024
+	    g_yres = max (2, g_yres * 3 / 4)
+	}
+
+	# Set up coordinate transformations.  The first transformation is from
+	# GKI coordinates to device resolution coordinates (0:xres-1,0:yres-1)
+	# and is defined by xres, yres, and GKI_MAXNDC.  Clipping of unresolved
+	# points is performed after this first transformation.  The second
+	# transformation maps resolved points into the device window.
+
+	# GKI -> resolution coords.
+	g_dxres = max (1, (GKI_MAXNDC + 1) / g_xres)
+	g_dyres = max (1, (GKI_MAXNDC + 1) / g_yres)
+
+	g_x1 = ttygeti (g_tty, "X1")
+	g_y1 = ttygeti (g_tty, "Y1")
+	g_x2 = ttygeti (g_tty, "X2")
+	g_y2 = ttygeti (g_tty, "Y2")
+	nx   = g_x2 - g_x1 + 1
+	ny   = g_y2 - g_y1 + 1
+
+	if (nx <= 1 || ny <= 1) {
+	    call eprintf ("openws: illegal graphics device window\n")
+	    nx = g_xres
+	    ny = g_yres
+	}
+
+	# GKI -> window coords.
+	g_dx = real (nx - 1) / GKI_MAXNDC
+	g_dy = real (ny - 1) / GKI_MAXNDC
+
+	# The last point in resolution coords is used to clip unresolved
+	# points when drawing polylines.
+
+	g_lastx = -1
+	g_lasty = -1
+end
diff --git a/sys/gio/stdgraph/stgreset.x b/sys/gio/stdgraph/stgreset.x
new file mode 100644
index 00000000..0f2fd1e2
--- /dev/null
+++ b/sys/gio/stdgraph/stgreset.x
@@ -0,0 +1,54 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_RESET -- Reset the state of the stdgraph common, i.e., in response to
+# a clear or a cancel.  Initialize all attribute packets to their default
+# values and set the current state of the device to undefined, forcing the
+# device state to be reset when the next output instruction is executed.
+
+procedure stg_reset()
+
+pointer	pl, pm, fa, tx
+include	"stdgraph.com"
+
+begin
+	# Set pointers to attribute substructures.
+	pl = SG_PLAP(g_sg)
+	pm = SG_PMAP(g_sg)
+	fa = SG_FAAP(g_sg)
+	tx = SG_TXAP(g_sg)
+
+	# Initialize the attribute packets.
+	PL_LTYPE(pl)	  = 1
+	PL_WIDTH(pl)	  = 1
+	PL_COLOR(pl)	  = 1
+	PM_COLOR(pm)	  = 1
+	FA_STYLE(fa)	  = 1
+	FA_COLOR(fa)	  = 1
+	TX_UP(tx)	  = 90
+	TX_SIZE(tx)	  = 1
+	TX_PATH(tx)	  = GT_RIGHT
+	TX_HJUSTIFY(tx)	  = GT_LEFT
+	TX_VJUSTIFY(tx)	  = GT_BOTTOM
+	TX_FONT(tx)	  = GT_ROMAN
+	TX_COLOR(tx)	  = 1
+	TX_SPACING(tx)	  = 0.0
+
+	# Set the device attributes to undefined, forcing them to be reset
+	# when the next output instruction is executed.
+
+	SG_COLOR(g_sg)	  = -1
+	SG_TXSIZE(g_sg)	  = -1
+	SG_TXFONT(g_sg)	  = -1
+	SG_PLTYPE(g_sg)   = -1
+	SG_FASTYLE(g_sg)  = -1
+	SG_PLWIDTH(g_sg)  = -1
+	g_lastx		  = -1
+	g_lasty		  = -1
+	g_keycol	  = 1
+	g_keyline	  = 1
+	g_message	  = NO
+	g_msglen	  = 0
+end
diff --git a/sys/gio/stdgraph/stgrtty.x b/sys/gio/stdgraph/stgrtty.x
new file mode 100644
index 00000000..237a7c7b
--- /dev/null
+++ b/sys/gio/stdgraph/stgrtty.x
@@ -0,0 +1,137 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<fset.h>
+include	<chars.h>
+include	"stdgraph.h"
+
+# STG_READTTY -- Read a line of text from the graphics terminal.
+# If the workstation is currently activated the read is performed in raw mode,
+# presumably with the cursor positioned to the end of a prompt string on the
+# status line.  The workstation will have been put into text mode and the
+# cursor positioned to the status line by an immediately preceding call to
+# stg_writetty, which is called by pseudofile i/o when the user task writes
+# to STDOUT or STDERR while the workstation is activated.  The input sequence
+# terminates when the user types return or newline, causing exit with
+# transmission of the GE sequence to restore the terminal to graphics mode.
+
+int procedure stg_readtty (fd, obuf, maxch)
+
+int	fd			#I input stream	[NOT USED]
+char	obuf[ARB]		#O output buffer
+int	maxch			#I max chars to read
+
+int	nchars, op, ch
+int	read(), getci(), fstati()
+include	"stdgraph.com"
+errchk	read, getci, ttyctrl
+string	delstr "\010 \010"
+
+begin
+	call flush (STDERR)
+	call flush (STDOUT)
+
+	if (g_active == NO) {
+	    # Workstation in normal text mode; normal text input.
+	    return (read (STDIN, obuf, maxch))
+
+	} else if (g_msglen > 0) {
+	    # The message data has already been transmitted and resides in
+	    # the message buffer.
+
+	    nchars = min (maxch, g_msglen)
+	    call amovc (Memc[g_msgbuf], obuf, nchars)
+	    obuf[nchars+1] = EOS
+	    g_msglen = 0
+	    return (nchars)
+
+	} else {
+	    # Workstation is activated; read status line in raw mode.
+	    # If already in rew mode, read a single char with no echo.
+	    # Note that genable is not automatic in raw input mode.
+
+	    if (g_enable == YES)
+		call stg_gdisab()
+
+	    if (fstati (g_in, F_RAW) == YES) {
+		if (getci (g_in, ch) == EOF) {
+		    obuf[1] = EOS
+		    return (EOF)
+		} else if (ch == '\004' || ch == '\032') {
+		    obuf[1] = EOS
+		    return (EOF)
+		} else {
+		    obuf[1] = ch
+		    obuf[2] = EOS
+		    return (1)
+		}
+	    } else
+		call fseti (g_in, F_RAW, YES)
+
+	    for (op=1;  getci (g_in, ch) != EOF;  op=min(maxch,op)) {
+		switch (ch) {
+		case EOF, '\004', '\032':		# EOF
+		    call stg_genab()
+		    break
+		case '\n', '\r':
+		    obuf[op] = '\n'
+		    op = op + 1
+		    call putline (g_out, "\r\n")
+		    call stg_genab()
+		    break
+		case INTCHAR, '\025':			# <ctrl/u>
+		    for (;  op > 1;  op=op-1)
+			call putline (g_out, delstr)
+		case BS, '\177':
+		    if (op > 1) {
+			call putline (g_out, delstr)
+			op = op - 1
+		    } else {
+			call stg_genab()
+			break				# exit
+		    }
+		default:
+		    call putci (g_out, ch)
+		    obuf[op] = ch
+		    op = op + 1
+		}
+		call flush (g_out)
+	    }
+
+	    obuf[op] = EOS
+	    call fseti (g_in, F_RAW, NO)
+
+	    if (op > 1)
+		return (op - 1)
+	    else
+		return (EOF)
+	}
+end
+
+
+# STG_GETLINE -- Get a line of text from the graphics terminal, reading from
+# the status line if the workstation is activated, and doing a normal text
+# read otherwise.
+
+int procedure stg_getline (fd, obuf)
+
+int	fd			#I input file
+char	obuf[SZ_LINE]		#O output buffer
+
+int	stg_readtty()
+
+begin
+	return (stg_readtty (fd, obuf, SZ_LINE))
+end
+
+
+# STG_MSGLEN -- This routine is called to determine if there is any message
+# data buffered in the kernel, to be returned in the next call to stg_readtty.
+
+int procedure stg_msglen (fd)
+
+int	fd			#I input file
+include	"stdgraph.com"
+
+begin
+	return (g_msglen)
+end
diff --git a/sys/gio/stdgraph/stgscur.x b/sys/gio/stdgraph/stgscur.x
new file mode 100644
index 00000000..e40d4a3d
--- /dev/null
+++ b/sys/gio/stdgraph/stgscur.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stdgraph.h"
+
+# STG_SETCURSOR -- Set the position of a cursor.
+
+procedure stg_setcursor (x, y, cursor)
+
+int	x, y			# new position of cursor
+int	cursor			# cursor to be set
+int	mx, my, cur
+include	"stdgraph.com"
+
+begin
+	# If cursor=0, write the cursor last referenced.
+	if (cursor > 0) {
+	    SG_CURSOR(g_sg) = cursor
+	    cur = cursor
+	} else
+	    cur = max (1, SG_CURSOR(g_sg))
+
+	# If the user has locked the logical cursor override runtime selection.
+	if (g_cursor > 0)
+	    cur = g_cursor
+
+	# Restore the software cursor position before reading?
+	if (SG_UPDCURSOR(g_sg) == YES) {
+	    SG_CURSOR_X(g_sg) = x
+	    SG_CURSOR_Y(g_sg) = y
+	}
+
+	mx = max(g_x1, min(g_x2, nint (x * g_dx) + g_x1))
+	my = max(g_y1, min(g_y2, nint (y * g_dy) + g_y1))
+
+	call stg_ctrl3 ("WC", mx, my, cur)
+end
diff --git a/sys/gio/stdgraph/stgtx.x b/sys/gio/stdgraph/stgtx.x
new file mode 100644
index 00000000..ff5abae2
--- /dev/null
+++ b/sys/gio/stdgraph/stgtx.x
@@ -0,0 +1,528 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<mach.h>
+include	<gki.h>
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_TEXT -- Draw a text string.  The string is drawn at the position (X,Y)
+# using the text attributes set by the last GKI_TXSET instruction.  The text
+# string to be drawn may contain embedded set font escape sequences of the
+# form \fR (roman), \fG (greek), etc.  We break the input text sequence up
+# into segments at font boundaries and draw these on the output device,
+# setting the text size, color, font, and position at the beginning of each
+# segment.  Two levels of character quality are implemented: MEDIUM and HIGH,
+# wherein characters are generated in software, and everything else, wherein
+# the characters are generated by the hardware.
+
+procedure stg_text (xc, yc, text, n)
+
+int	xc, yc			# where to draw text string
+short	text[ARB]		# text string
+int	n			# number of characters
+
+bool	hard
+real	x, y
+int	x1, x2, y1, y2, mx, my
+int	x0, y0, dx, dy, ch, cw, sz
+int	xstart, ystart, newx, newy
+int	totlen, polytext, font, seglen, orien, hwsz
+pointer	sp, seg, ip, op, tx, first
+int	stx_segment(), stg_encode()
+include	"stdgraph.com"
+
+begin
+	call smark (sp)
+	call salloc (seg, n + 2, TY_CHAR)
+
+	if (g_enable == NO)
+	    call stg_genab()
+
+	# Set pointer to the text attribute structure.
+	tx = SG_TXAP(g_sg)
+
+	# Break the text string into segments at font boundaries and count
+	# the total number of printable characters.
+
+	totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx))
+
+	# Compute the text drawing parameters, i.e., the coordinates of the
+	# first character to be drawn, the step between successive characters,
+	# and the polytext flag (GKI coords).
+
+	call stx_parameters (xc,yc, totlen, x0,y0, dx,dy, polytext, orien)
+
+	# Set the text size and color if not already set.  Both should be
+	# invalidated when the screen is cleared.  Text color should be
+	# invalidated whenever another color is set.  If software (!hard)
+	# character generation is indicated then size 1 is simply scaled by
+	# the indicated factor, otherwise the text size is  converted to a
+	# hardware size index by stg_txsize.
+
+	call stx_chars (tx, ch, cw, hwsz, hard, orien)
+	sz = TX_SIZE(tx)
+
+	if (hard)
+	    if (SG_TXSIZE(g_sg) != sz) {
+		call stg_ctrl1 ("TH", hwsz)
+		SG_TXSIZE(g_sg) = sz
+	    }
+
+	if (TX_COLOR(tx) != SG_COLOR(g_sg)) {
+	    call stg_ctrl1 ("TC", TX_COLOR(tx))
+	    SG_COLOR(g_sg) = TX_COLOR(tx)
+	}
+
+	# Draw the segments, setting the font at the beginning of each segment.
+	# The first segment is drawn at (X0,Y0).  The separation between
+	# characters is DX,DY.  A segment is drawn as a block if the polytext
+	# flag is set, otherwise each character is drawn individually.
+	# All computations are in GKI coordinates.
+
+	x = x0
+	y = y0
+
+	for (ip=seg;  Memc[ip] != EOS;  ip=ip+1) {
+	    # Process the font control character heading the next segment.
+	    font = Memc[ip]
+	    ip = ip + 1
+	    if (hard)
+		if (SG_TXFONT(g_sg) != font) {
+		    call stg_ctrl1 ("TF", font - GT_ROMAN + 1)
+		    SG_TXFONT(g_sg) = font
+		}
+	    
+	    # Draw the segment.
+	    while (Memc[ip] != EOS) {
+		# Clip leading out of bounds characters.
+		for (;  Memc[ip] != EOS;  ip=ip+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 >= 0 && x2 <= GKI_MAXNDC &&
+			y1 >= 0 && y2 <= GKI_MAXNDC) {
+
+			break
+
+		    } else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			ip = ip + 1
+			break
+		    }
+		}
+
+		# Coords of first char to be drawn.
+		xstart = x
+		ystart = y
+
+		# Move OP to first out of bounds char.
+		for (op=ip;  Memc[op] != EOS;  op=op+1) {
+		    x1 = x; x2 = x1 + cw
+		    y1 = y; y2 = y1 + ch
+
+		    if (x1 <= 0 || x2 >= GKI_MAXNDC ||
+			y1 <= 0 || y2 >= GKI_MAXNDC) {
+
+			break
+
+		    } else {
+			x = x + dx
+			y = y + dy
+		    }
+
+		    if (polytext == NO) {
+			op = op + 1
+			break
+		    }
+		}
+
+		# Count number of inbounds chars.
+		seglen = op - ip
+
+		# Leave OP pointing to the end of this segment.
+		if (polytext == NO)
+		    op = ip + 1
+		else {
+		    while (Memc[op] != EOS)
+			op = op + 1
+		}
+
+		# Compute X,Y of next segment.
+		newx = xstart + (dx * (op - ip))
+		newy = ystart +  dy
+
+		# Quit if no inbounds chars.
+		if (seglen == 0) {
+		    x = newx
+		    y = newy
+		    ip = op
+		    next
+		}
+
+		# Output the inbounds chars.
+		if (hard) {
+		    g_reg[1] = xstart * g_dx + g_x1
+		    g_reg[2] = ystart * g_dy + g_y1
+		    g_reg[E_IOP] = 1
+		    if (stg_encode (Memc[SG_STARTTEXT(g_sg)],g_mem,g_reg) == OK)
+			call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		}
+
+		first = ip
+		x = xstart
+		y = ystart
+
+		# Draw the characters.
+		while (seglen > 0 && (polytext == YES || ip == first)) {
+		    if (hard)
+			call putc (g_out, Memc[ip])
+		    else {
+			mx = nint(x)
+			my = nint(y)
+			call stg_drawchar (Memc[ip], mx,my, cw, ch, orien, font)
+			x = x + dx
+			y = y + dy
+		    }
+
+		    ip = ip + 1
+		    seglen = seglen - 1
+		}
+
+		x = newx
+		y = newy
+		ip = op
+
+		if (hard) {
+		    g_reg[E_IOP] = 1
+		    if (stg_encode (Memc[SG_ENDTEXT(g_sg)], g_mem, g_reg) == OK)
+			call write (g_out, g_mem, g_reg[E_IOP] - 1)
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# STX_SEGMENT -- Process the text string into segments, in the process
+# converting from type short to char.  The only text attribute that can
+# change within a string is the font, so segments are broken by \fI, \fG,
+# etc. font select sequences embedded in the text.  The segments are encoded
+# sequentially in the output string.  The first character of each segment is
+# the font number.  A segment is delimited by EOS.  A font number of EOS
+# marks the end of the segment list.  The output string is assumed to be
+# large enough to hold the segmented text string.
+
+int procedure stx_segment (text, n, out, start_font)
+
+short	text[ARB]		# input text
+int	n			# number of characters in text
+char	out[ARB]		# output string
+int	start_font		# initial font code
+
+int	ip, op
+int	totlen, font
+
+begin
+	out[1] = start_font
+	totlen = 0
+	op = 2
+
+	for (ip=1;  ip <= n;  ip=ip+1) {
+	    if (text[ip] == '\\' && text[ip+1] == 'f') {
+		# Select font.
+		out[op] = EOS
+		op = op + 1
+		ip = ip + 2
+
+		switch (text[ip]) {
+		case 'B':
+		    font = GT_BOLD
+		case 'I':
+		    font = GT_ITALIC
+		case 'G':
+		    font = GT_GREEK
+		default:
+		    font = GT_ROMAN
+		}
+
+		out[op] = font
+		op = op + 1
+
+	    } else {
+		# Deposit character in segment.
+		out[op] = text[ip]
+		op = op + 1
+		totlen = totlen + 1
+	    }
+	}
+
+	# Terminate last segment and add null segment.
+
+	out[op] = EOS
+	out[op+1] = EOS
+
+	return (totlen)
+end
+
+
+# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates
+# of the lower left corner of the first character to be drawn, the spacing
+# between characters, and the polytext flag.  Input consists of the coords
+# of the text string, the length of the string, and the text attributes
+# defining the character size, justification in X and Y of the coordinates,
+# and orientation of the string.  All coordinates are in GKI units.
+
+procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien)
+
+int	xc, yc			# coordinates at which string is to be drawn
+int	totlen			# number of characters to be drawn
+int	x0, y0			# lower left corner of first char to be drawn
+int	dx, dy			# step in X and Y between characters
+int	polytext		# OK to output text segment all at once
+int	orien			# rotation angle of characters
+
+pointer	tx
+bool	hard
+int	up, path, hwsz, ch, cw, i
+real	dir, cosv, sinv, space
+real	xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q
+include	"stdgraph.com"
+
+begin
+	tx = SG_TXAP(g_sg)
+
+	# Compute the character rotation angle.  This is independent of the
+	# direction in which characters are drawn.  A character up vector of
+	# 90 degrees (normal) corresponds to a rotation angle of zero.
+
+	up = TX_UP(tx)
+	orien = up - 90
+
+	# Get character sizes in GKI(NSPP) coords.
+	call stx_chars (tx, ch, cw, hwsz, hard, orien)
+
+	# Determine the direction in which characters are to be plotted.
+	# This depends on both the character up vector and the path, which
+	# is defined relative to the up vector.
+
+	path = TX_PATH(tx)
+	switch (path) {
+	case GT_UP:
+	    dir = up
+	case GT_DOWN:
+	    dir = up - 180
+	case GT_LEFT:
+	    dir = up + 90
+	default:		# GT_NORMAL, GT_RIGHT
+	    dir = up - 90
+	}
+
+	# If hardware character generation is enabled the character up vector
+	# is constrained to 90 degrees.  Flip the direction in which characters
+	# will be drawn if necessary to draw from left to right or from top
+	# down, the readable directions.
+
+	if (hard) {
+	    # Constrain the up vector.
+	    orien = 0
+
+	    # Flip direction vector if in 2nd or 3rd quadrant.
+	    i = nint(dir)
+	    if (i < 0)
+		i = i + 360
+	    if (i >= 90 && i < 180)
+		i = i + 180
+	    if (i >= 360)
+		i = i - 360
+	    dir = real(i)
+	}
+
+	# ------- DX, DY ---------
+	# Convert the direction vector into the step size between characters.
+	# Note CW and CH are in GKI coordinates, hence DX and DY are too.
+	# Additional spacing of some fraction of the character size is used
+	# if TX_SPACING is nonzero.
+
+	dir = -DEGTORAD(dir)
+	cosv = cos (dir)
+	sinv = sin (dir)
+
+	# Correct for spacing (unrotated).
+	space = (1.0 + TX_SPACING(tx))
+	if ((path == GT_UP || path == GT_DOWN) ||
+	    (hard && abs(cosv) < .9)) {
+	    p = ch * space
+	} else
+	    p = cw * space
+	q = 0
+
+	# Correct for rotation.
+	dx =  p * cosv + q * sinv
+	dy = -p * sinv + q * cosv
+
+	# ------- XU, YU ---------
+	# Determine the coordinates of the center of the first character req'd
+	# to justify the string, assuming dimensionless characters spaced on
+	# centers DX,DY apart.
+
+	xvlen = dx * (totlen - 1)
+	yvlen = dy * (totlen - 1)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xu = - (xvlen / 2.0)
+	case GT_RIGHT:
+	    # If right justify and drawing to the left, no offset req'd.
+	    if (xvlen < 0)
+		xu = 0
+	    else
+		xu = -xvlen
+	default:		# GT_LEFT, GT_NORMAL
+	    # If left justify and drawing to the left, full offset right req'd.
+	    if (xvlen < 0)
+		xu = -xvlen
+	    else
+		xu = 0
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yu = - (yvlen / 2.0)
+	case GT_TOP:
+	    # If top justify and drawing downward, no offset req'd.
+	    if (yvlen < 0)
+		yu = 0
+	    else
+		yu = -yvlen
+	default:		# GT_BOTTOM, GT_NORMAL
+	    # If bottom justify and drawing downward, full offset up req'd.
+	    if (yvlen < 0)
+		yu = -yvlen
+	    else
+		yu = 0
+	}
+
+	# ------- XV, YV ---------
+	# Compute the offset from the center of a single character required
+	# to justify that character, given a particular character up vector.
+	# (This could be combined with the above case but is clearer if
+	# treated separately.)
+
+	p = -DEGTORAD(orien)
+	cosv = cos(p)
+	sinv = sin(p)
+
+	# Compute the rotated character in size X and Y.
+	xsize = abs ( cw * cosv + ch * sinv)
+	ysize = abs (-cw * sinv + ch * cosv)
+
+	switch (TX_HJUSTIFY(tx)) {
+	case GT_CENTER:
+	    xv = 0
+	case GT_RIGHT:
+	    xv = - (xsize / 2.0)
+	default:		# GT_LEFT, GT_NORMAL
+	    xv = xsize / 2
+	}
+
+	switch (TX_VJUSTIFY(tx)) {
+	case GT_CENTER:
+	    yv = 0
+	case GT_TOP:
+	    yv = - (ysize / 2.0)
+	default:		# GT_BOTTOM, GT_NORMAL
+	    yv = ysize / 2
+	}
+
+	# ------- X0, Y0 ---------
+	# The center coordinates of the first character to be drawn are given
+	# by the reference position plus the string justification vector plus
+	# the character justification vector.
+
+	x0 = xc + xu + xv
+	y0 = yc + yu + yv
+
+	# The character drawing primitive requires the coordinates of the
+	# lower left corner of the character (irrespective of orientation).
+	# Compute the vector from the center of a character to the lower left
+	# corner of a character, rotate to the given orientation, and correct
+	# the starting coordinates by addition of this vector.
+
+	p = - (cw / 2.0)
+	q = - (ch / 2.0)
+
+	x0 = x0 + ( p * cosv + q * sinv)
+	y0 = y0 + (-p * sinv + q * cosv)
+
+	# ------- POLYTEXT ---------
+	# Set the polytext flag.  Polytext output is possible only if chars
+	# are to be drawn to the right with no extra spacing between chars.
+
+	if (abs(dy) == 0 && dx == cw)
+	    polytext = YES
+	else
+	    polytext = NO
+end
+
+
+# STX_CHARS -- Get the character drawing parameters, i.e., the size of a
+# character in X and Y and whether or not to use the hardware character
+# generator.  The decision whether or not to use the hardware character
+# generator is based on the text attribute QUALITY, unless overridden by
+# the g_hardchar switch in common (set explicitly in cursor mode or by a
+# stdgraph task parameter).
+
+procedure stx_chars (tx, ch, cw, hwsz, hard, orien)
+
+pointer	tx			# pointer to text attribute structure
+int	ch, cw			# character height, width, GKI coords
+int	hwsz			# size index if hardware character
+bool	hard			# use/dontuse hardware character generation
+int	orien			# rotation angle of character (0=normal)
+
+int	sz, quality
+real	txsize, aspect, q
+int	stg_txsize()
+real	ttygetr()
+include	"stdgraph.com"
+
+begin
+	sz = TX_SIZE(tx)
+	if (g_hardchar == 0)
+	    quality = TX_QUALITY(tx)
+	else
+	    quality = g_hardchar
+	hard = (quality != GT_MEDIUM && quality != GT_HIGH)
+
+	# Get character size in GKI units.
+	if (hard) {
+	    hwsz = stg_txsize (sz)
+	    ch = SG_CHARHEIGHT(g_sg,hwsz)
+	    cw = SG_CHARWIDTH (g_sg,hwsz)
+
+	} else {
+	    # If character generation is in software scale character sizes
+	    # by the size of the size 1 hardware character.  If the character
+	    # is rotated correct for the device aspect ratio so that the
+	    # character comes out the same size regardless of the orientation.
+
+	    txsize = GKI_UNPACKREAL(sz)
+	    cw = SG_CHARWIDTH (g_sg,1) * txsize
+	    ch = SG_CHARHEIGHT(g_sg,1) * txsize
+
+	    if (orien != 0) {
+		aspect = ttygetr (g_tty, "ar")
+		if (aspect > EPSILON && abs (aspect - 1.0) > .01) {
+		    q = 1.0 + abs(sin(real(orien))) * (aspect - 1.0)
+		    cw = cw / q
+		    ch = ch * q
+		}
+	    }
+	}
+end
diff --git a/sys/gio/stdgraph/stgtxqual.x b/sys/gio/stdgraph/stgtxqual.x
new file mode 100644
index 00000000..122cf303
--- /dev/null
+++ b/sys/gio/stdgraph/stgtxqual.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"stdgraph.h"
+
+# STG_TXQUALITY -- Select the type of character generator to be used.  If the
+# selected flag value is 0 this decision will be deferred to the set text
+# attribute instruction at runtime (default).
+
+procedure stg_txquality (quality)
+
+int	quality			# text generation quality flag
+include	"stdgraph.com"
+
+begin
+	g_hardchar = quality
+end
diff --git a/sys/gio/stdgraph/stgtxset.x b/sys/gio/stdgraph/stgtxset.x
new file mode 100644
index 00000000..8db3e8c3
--- /dev/null
+++ b/sys/gio/stdgraph/stgtxset.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_TXSET -- Set the text drawing attributes.
+
+procedure stg_txset (gki)
+
+short	gki[ARB]		# attribute structure
+pointer	tx
+include	"stdgraph.com"
+
+begin
+	tx = SG_TXAP(g_sg)
+
+	TX_UP(tx)	= gki[GKI_TXSET_UP] 
+	TX_PATH(tx)	= gki[GKI_TXSET_P ] 
+	TX_HJUSTIFY(tx)	= gki[GKI_TXSET_HJ] 
+	TX_VJUSTIFY(tx)	= gki[GKI_TXSET_VJ] 
+	TX_FONT(tx)	= gki[GKI_TXSET_F ]
+	TX_QUALITY(tx)	= gki[GKI_TXSET_Q ] 
+	TX_COLOR(tx)	= gki[GKI_TXSET_CI] 
+
+	# Unpack the packed-real character spacing parameter.
+	TX_SPACING(tx)	= GKI_UNPACKREAL (gki[GKI_TXSET_SP])
+
+	# The character size is left as a packed real as we must defer the
+	# decision to use a discreet hardware character size or to draw
+	# characters in software.
+
+	TX_SIZE(tx)	= gki[GKI_TXSET_SZ]
+end
diff --git a/sys/gio/stdgraph/stgtxsize.x b/sys/gio/stdgraph/stgtxsize.x
new file mode 100644
index 00000000..71829e04
--- /dev/null
+++ b/sys/gio/stdgraph/stgtxsize.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	"stdgraph.h"
+
+# STG_TXSIZE -- Given the relative character size as a packed real, select
+# the discreet closest device character size.
+
+int procedure stg_txsize (pksize)
+
+int	pksize			# packed real relative character size
+int	i, best_size
+real	txsize, diff, least_diff
+include	"stdgraph.com"
+
+begin
+	txsize = GKI_UNPACKREAL (pksize)
+
+	best_size = 1
+	least_diff = abs (txsize - SG_CHARSIZE(g_sg,1))
+
+	do i = 2, SG_NCHARSIZES(g_sg) {
+	    diff = abs (txsize - SG_CHARSIZE(g_sg,i))
+	    if (diff < least_diff) {
+		best_size = i
+		least_diff = diff
+	    }
+	}
+
+	return (best_size)
+end
diff --git a/sys/gio/stdgraph/stgunkown.x b/sys/gio/stdgraph/stgunkown.x
new file mode 100644
index 00000000..55327b62
--- /dev/null
+++ b/sys/gio/stdgraph/stgunkown.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STG_UNKNOWN -- The unknown instruction.  Called by the interpreter whenever
+# an unrecognized opcode is encountered.  Should never be called.
+
+procedure stg_unknown (gki)
+
+short	gki[ARB]		# the GKI instruction
+int	fd, verbose
+common	/stgcom/ fd, verbose
+
+begin
+	call fprintf (fd, "unknown\n")
+end
diff --git a/sys/gio/stdgraph/stgwtty.x b/sys/gio/stdgraph/stgwtty.x
new file mode 100644
index 00000000..c01bd93c
--- /dev/null
+++ b/sys/gio/stdgraph/stgwtty.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	"stdgraph.h"
+
+# STG_WRITETTY -- Write one or more lines of text to the terminal in text
+# mode.  If the workstation is currently activated normal output is to the
+# status line, otherwise output is to the indicated stream (STDOUT or
+# STDERR).  If the worstation is activated and the text to be output is
+# preceded by the EM code, the text is a message being sent by GIO to a user
+# interface parameter, and the text is passed on as is without formatting for
+# the status line.
+#
+# Terminal output is directed to the status line by the GD sequence, and
+# graphics output is reenabled by the GE sequence.  The output text should
+# consist of only a single line, but if multiple lines are present they are
+# output line by line, without the trailing newline, since the status line
+# can display only a single line of text.
+#
+# NOTE - If output occurs while in graphics mode and the output text is newline
+# terminated, the GE (graphics enable) sequence is output to restore the
+# terminal to graphics mode before exiting.  If the text is not newline
+# terminated, e.g., if it is a prompt, the workstation is left in alpha mode,
+# ready for a read from STDIN.  Thus one can write a prompt to STDOUT and read
+# the user response from STDIN, while in graphics mode.
+#
+# This procedure is called by pseudofile i/o (gio/cursor/prpsio) whenever a
+# task writes to STDOUT or STDERR.
+
+procedure stg_writetty (fd, text, nchars)
+
+int	fd			#I output stream
+char	text[ARB]		#I text to be output
+int	nchars			#I nchars to be written
+
+int	ip, delim
+pointer	sp, lbuf, op
+include	"stdgraph.com"
+bool	ttygetb()
+errchk	write
+
+begin
+	if (g_active == NO) {
+	    # Workstation not activated (normal text mode); normal text output.
+	    call write (fd, text, nchars)
+	    call flush (fd)
+
+	} else if (text[1] == EM || g_message == YES) {
+	    # Workstation is activated; the output text is a message to be
+	    # sent to a UI parameter.  The output stream is assumed to be
+	    # flushed before and after a UI message, so we assume that the
+	    # control codes used to bracket the message are the first and
+	    # last characters in the output write packets.  Multiple writes
+	    # may be used to write output text, and messages can be any
+	    # length.  If the output device does not support messaging (no
+	    # "EM" capability) the messages are discarded.
+
+	    g_message = YES
+	    if (ttygetb (g_tty, "EM"))
+		call write (g_out, text, nchars)
+	    delim = text[nchars]
+	    if (delim == GS || delim == US)
+		g_message = NO
+
+	} else {
+	    # Workstation is activated; write to status line.  Writing
+	    # anything when graphics is enabled causes the status line to be
+	    # cleared; newline causes a graphics enable; the string "\n\n"
+	    # will always clear the status line and leave the terminal in
+	    # graphics mode, regardless of the state of g_enable when issued.
+
+	    call smark (sp)
+	    call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	    if (g_enable == YES)
+		call stg_gdisab()
+
+	    op = lbuf
+	    for (ip=1;  ip <= nchars;  ip=ip+1) {
+		if (text[ip] == '\n') {
+		    if (g_enable == YES)
+			call stg_gdisab()
+		    if (op > lbuf)
+			call write (g_out, Memc[lbuf], op-lbuf)
+		    call stg_genab()
+		    op = lbuf
+		} else {
+		    Memc[op] = text[ip]
+		    op = min (lbuf+SZ_LINE, op+1)
+		}
+	    }
+
+	    # Output a partial line, leaving graphics disabled.
+	    if (op > lbuf) {
+		if (g_enable == YES)
+		    call stg_gdisab()
+		call write (g_out, Memc[lbuf], op-lbuf)
+	    }
+
+	    call flush (g_out)
+	    call sfree (sp)
+	}
+end
+
+
+# STG_PUTLINE -- Output an EOS delimited line of text to the graphics terminal
+# with stg_writetty.
+
+procedure stg_putline (fd, text)
+
+int	fd			# output file
+char	text[ARB]		# EOS delimited line of text
+int	strlen()
+
+begin
+	call stg_writetty (fd, text, strlen(text))
+end
diff --git a/sys/gio/stdgraph/t_gkideco.x b/sys/gio/stdgraph/t_gkideco.x
new file mode 100644
index 00000000..200cf33a
--- /dev/null
+++ b/sys/gio/stdgraph/t_gkideco.x
@@ -0,0 +1,63 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gki.h>
+
+# GKIDECODE -- Decode the contents of one or more metacode files, printing
+# the decoded metacode instructions in readable form on the standard output.
+
+procedure t_gkidecode()
+
+int	fd, list, verbose, gkiunits
+pointer	gki, sp, fname
+int	dd[LEN_GKIDD]
+
+bool	clgetb()
+int	clpopni(), clgfil(), clplen(), open(), btoi()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	if (clgetb ("generic")) {
+	    verbose = NO
+	    gkiunits = NO
+	} else {
+	    verbose = btoi (clgetb ("verbose"))
+	    gkiunits = btoi (clgetb ("gkiunits"))
+	}
+
+	# Set up the decoding graphics kernel.
+	call gkp_install (dd, STDOUT, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Print header if new file.
+	    if (clplen (list) > 1) {
+		call printf ("\n# METAFILE '%s':\n")
+		    call pargstr (Memc[fname])
+	    }
+
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    } else
+		call gkp_grstream (fd)
+
+	    # Process the metacode.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF)
+		call gki_execute (Mems[gki], dd)
+
+	    call close (fd)
+	}
+
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/t_showcap.x b/sys/gio/stdgraph/t_showcap.x
new file mode 100644
index 00000000..ddb8407c
--- /dev/null
+++ b/sys/gio/stdgraph/t_showcap.x
@@ -0,0 +1,210 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stdgraph.h"
+
+define	SZ_PROGRAM		256
+define	MAXARGSTR		15
+
+
+# SHOWCAP - Show the ascii control string sent to a device to implement a
+# control function.  Useful for testing graphcap entries.
+
+procedure t_showcap()
+
+char	cap[2]
+int	g_reg[NREGISTERS]
+char	g_mem[SZ_MEMORY]
+char	argstr[MAXARGSTR]
+int	arg1, arg2, arg3, op, len_prog, status, nchars
+pointer	tty, sp, prog, ip, cmd
+pointer	ttygdes(), ttycaps()
+int	stg_encode(), ctoi(), getline(), strncmp()
+int	ttygets(), ctowrd(), strlen()
+bool	ttygetb(), streq()
+define	getargs_ 91
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call salloc (prog, SZ_PROGRAM, TY_CHAR)
+
+	# Print instructions.
+	call printf ("cmd :  `set' device\n")
+	call printf ("    |  `*' (to dump full graphcap entry\n")
+	call printf ("    |  cc [arg1 [arg2 [arg3]]]\n")
+	call printf ("    ;\n")
+	call printf ("\n")
+	call printf ("cc  :   a two chararacter capcode (e.g., 'cm')\n")
+	call printf ("    |   an encoder program (non alpha first char)\n")
+	call printf ("    ;\n")
+	call printf ("\n")
+
+	# Interpret and translate control commands until EOF or "bye"
+	# is typed.
+
+	tty = NULL
+
+	repeat {
+	    # Prompt for input.
+	    call printf ("* ")
+	    call flush (STDOUT)
+
+	    if (getline (STDIN, Memc[cmd]) == EOF) {
+		call printf ("\n")
+		break
+	    }
+
+	    for (ip=cmd;  IS_WHITE (Memc[ip]);  ip=ip+1)
+		;
+
+	    if (Memc[ip] == '\n') {
+		next
+	    } else if (strncmp (Memc[ip], "set", 3) == 0) {
+		ip = ip + 3
+		len_prog = ctowrd (Memc, ip, Memc[prog], SZ_PROGRAM)
+		if (tty != NULL)
+		    call ttycdes (tty)
+		tty = ttygdes (Memc[prog])
+		call sgc_dump (STDOUT, Memc[ttycaps(tty)],
+		    strlen (Memc[ttycaps(tty)]))
+		next
+	    } else if (Memc[ip] == '*') {
+		call sgc_dump (STDOUT, Memc[ttycaps(tty)],
+		    strlen (Memc[ttycaps(tty)]))
+		next
+	    } else if (!IS_ALPHA (Memc[ip])) {
+		len_prog = ctowrd (Memc, ip, Memc[prog], SZ_PROGRAM)
+		cap[1] = EOS
+		goto getargs_
+	    } else if (strncmp (Memc[ip], "bye", 3) == 0)
+		break
+
+	    # Parse command with optional arguments, e.g., "RC 1".
+	    # Extract 2 character capability name (required).
+
+	    op = 1
+	    while (IS_ALNUM(Memc[ip])) {
+		cap[op] = Memc[ip]
+		ip = ip + 1
+		op = min (2, op + 1)
+	    }
+	    cap[3] = EOS
+getargs_
+	    # Argument type depends on whether encoding or decoding.
+	    if (streq ("SC", cap)) {
+		nchars = ctowrd (Memc, ip, argstr, MAXARGSTR)
+		if (nchars == 0) {
+		    call printf ("SC must have 1 contiguous string argument\n")
+		    next
+		}
+
+	    } else {
+		# Extract up to three arguments (optional).
+		if (ctoi (Memc, ip, arg1) <= 0)
+		    arg1 = 0
+		if (ctoi (Memc, ip, arg2) <= 0)
+		    arg2 = 0
+		if (ctoi (Memc, ip, arg3) <= 0)
+		    arg3 = 0
+	    }
+
+	    # Fetch the program from the graphcap file.  Zero is returned if
+	    # the device does not have the named capability, in which case
+	    # the function is inapplicable and should be ignored.
+
+	    if (cap[1] != EOS)
+		if (tty == NULL) {
+		    call printf ("use `set' to specify device name\n")
+		    next
+		} else
+		    len_prog = ttygets (tty, cap, Memc[prog], SZ_PROGRAM)
+
+	    if (len_prog > 0) {
+		if (Memc[prog] == '#')
+		    call sgc_dump (STDOUT, Memc[prog+1], len_prog - 1)
+		else {
+		    # Dump the program on the standard output.
+		    if (cap[1] != EOS) {
+			call printf ("program:  ")
+			call sgc_dump (STDOUT, Memc[prog], len_prog)
+		    }
+
+		    # Set memory or registers depending on whether encoding or
+		    # decoding.
+		    if (streq ("SC", cap))
+			call strcpy (argstr, g_mem, nchars)
+
+		    else {
+			g_reg[1] = arg1
+			g_reg[2] = arg2
+			g_reg[3] = arg3
+		    }
+		    g_reg[E_IOP] = 1
+		    g_reg[E_TOP] = SZ_MEMORY
+
+		    # If scan_cursor, decode the input string and write the
+		    # registers to the output file.  Else, encode the output
+		    # string and write the encoded string to the output file.
+
+		    status = stg_encode (Memc[prog], g_mem, g_reg) 
+		    if (status == OK) {
+			nchars = g_reg[E_IOP] - 1
+
+			if (streq ("SC", cap)) {
+			    call printf ("X(R1)=%d, Y(R2)=%d, key=%c\n")
+				call pargi (g_reg[1])
+				call pargi (g_reg[2])
+				call pargi (g_reg[3])
+			} else {
+			    call printf ("encoding: ")
+			    call sgc_dump (STDOUT, g_mem, nchars)
+			}
+
+		    } else
+			call printf ("error encoding control string\n")
+			call printf ("      status = %d\n")
+			    call pargi (status)
+		}
+
+	    } else if (len_prog == 0)
+		if (ttygetb (tty, cap))
+		    call printf ("boolean capability is true\n")
+
+	    else {
+		call printf ("device capability `%s' not found\n")
+		    call pargstr (cap)
+	    }
+	}
+
+	if (tty != NULL)
+	    call ttycdes (tty)
+	call sfree (sp)
+end
+
+
+# SGC_DUMP -- Dump a sequence of ascii characters in printable form.
+
+procedure sgc_dump (fd, data, nchars)
+
+int	fd			# output file
+char	data[ARB]		# chars to be dumped
+int	nchars
+
+int	ip
+int	col
+
+begin
+	col = 1
+	for (ip=1;  ip <= nchars;  ip=ip+1) {
+	    call putcc (fd, data[ip])
+	    if (data[ip] == ':' && col > 60) {
+		call putci (fd, '\\')
+		call putci (fd, '\n')
+		col = 1
+	    } else
+		col = col + 1
+	}
+
+	call putci (fd, '\n')
+end
diff --git a/sys/gio/stdgraph/t_stdgraph.x b/sys/gio/stdgraph/t_stdgraph.x
new file mode 100644
index 00000000..8d6856fc
--- /dev/null
+++ b/sys/gio/stdgraph/t_stdgraph.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gset.h>
+include	<gki.h>
+
+define	SZ_TXQUALITY	1
+
+# STDGRAPH -- Graphics kernel for the standard graphics output (interactive
+# graphics terminal).
+
+procedure t_stdgraph()
+
+int	fd, list
+char	txquality[SZ_TXQUALITY]
+pointer	gki, sp, fname, devname
+int	dev[LEN_GKIDD], deb[LEN_GKIDD]
+int	debug, verbose, gkiunits, xres, yres, quality
+bool	clgetb()
+int	clpopni(), clgfil(), open(), btoi(), clgeti()
+int	gki_fetch_next_instruction()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (devname, SZ_FNAME, TY_CHAR)
+
+	# Open list of metafiles to be decoded.
+	list = clpopni ("input")
+
+	# Get parameters.
+	call clgstr ("device", Memc[devname], SZ_FNAME)
+
+	if (clgetb ("generic")) {
+	    debug = NO
+	    verbose = NO
+	    gkiunits = NO
+	    quality = 0
+	    xres = 0
+	    yres = 0
+
+	} else {
+	    debug = btoi (clgetb ("debug"))
+	    if (debug == YES) {
+		verbose = btoi (clgetb ("verbose"))
+		gkiunits = btoi (clgetb ("gkiunits"))
+	    }
+
+	    # Get the quality parameter for the text generator.
+	    call clgstr ("txquality", txquality, SZ_TXQUALITY)
+	    switch (txquality[1]) {
+	    case 'l':
+		quality = GT_LOW
+	    case 'm':
+		quality = GT_MEDIUM
+	    case 'h':
+		quality = GT_HIGH
+	    default:
+		quality = 0
+	    }
+
+	    xres     = clgeti ("xres")
+	    yres     = clgeti ("yres")
+	}
+
+	# Open the graphics kernel.
+
+	call stg_open (Memc[devname], dev, STDIN, STDOUT, xres, yres, quality)
+	call gkp_install (deb, STDERR, verbose, gkiunits)
+
+	# Process a list of metacode files, writing the decoded metacode
+	# instructions on the standard output.
+
+	while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+	    # Open input file.
+	    iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		call erract (EA_WARN)
+		next
+	    } else
+		call stg_grstream (fd)
+
+	    # Process the metacode instruction stream.
+	    while (gki_fetch_next_instruction (fd, gki) != EOF)
+		switch (Mems[gki+GKI_HDR_OPCODE-1]) {
+		case GKI_CLOSEWS, GKI_DEACTIVATEWS, GKI_REACTIVATEWS:
+		    # These instructions are passed directly to the kernel via
+		    # the PSIOCTRL stream at runtime, but are ignored in
+		    # metacode to avoid unnecessary mode switching of the
+		    # terminal.
+		    ;
+		default:
+		    if (debug == YES)
+			call gki_execute (Mems[gki], deb)
+		    call gki_execute (Mems[gki], dev)
+		}
+
+	    call close (fd)
+	}
+
+	# Make sure we finish with CLOSEWS so that the terminal is left in
+	# text mode.
+
+	call stg_closews (NULL, NULL)
+
+	# Finish up.
+	call gkp_close()
+	call stg_close()
+	call clpcls (list)
+	call sfree (sp)
+end
diff --git a/sys/gio/stdgraph/x_stdgraph.x b/sys/gio/stdgraph/x_stdgraph.x
new file mode 100644
index 00000000..37c5a055
--- /dev/null
+++ b/sys/gio/stdgraph/x_stdgraph.x
@@ -0,0 +1,5 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	gkidecode = t_gkidecode,
+	stdgraph  = t_stdgraph,
+	showcap   = t_showcap
diff --git a/sys/gio/stdgraph/zzdebug.x b/sys/gio/stdgraph/zzdebug.x
new file mode 100644
index 00000000..ce11d4ea
--- /dev/null
+++ b/sys/gio/stdgraph/zzdebug.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	slio = t_slio
+
+procedure t_slio()
+
+pointer	gp
+char	lbuf[SZ_LINE]
+real	x[5], y[5]
+
+pointer	gopen()
+int	getline()
+
+begin
+	x[1] = .25;  y[1] = .25
+	x[2] = .75;  y[2] = .25
+	x[3] = .75;  y[3] = .75
+	x[4] = .25;  y[4] = .75
+	x[5] = .25;  y[5] = .25
+
+	gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+	call gpline (gp, x, y, 5)
+	call gflush (gp)
+
+	call putline (STDOUT, "enter text: ")
+	call flush (STDOUT)
+
+	if (getline (STDIN, lbuf) != EOF) {
+	    call zwmsec (3000)
+	    call printf ("text = %s")
+		call pargstr (lbuf)
+	    call flush (STDOUT)
+	}
+
+	call zwmsec (3000)
+	call gclose (gp)
+end
diff --git a/sys/gio/wcstogki.x b/sys/gio/wcstogki.x
new file mode 100644
index 00000000..e0591402
--- /dev/null
+++ b/sys/gio/wcstogki.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gki.h>
+include	<gio.h>
+
+# GPL_WCSTOGKI -- Transform world coordinates to GKI coordinates using the
+# cached transformation parameters.  There are three possible types of scaling
+# on either axis, linear, log, and "elog".  The latter is a piecewise log
+# scaling function defined for all X, i.e., for negative as well as positive
+# X (see elogr.x).  If a negative number is transformed with normal log
+# scaling it is treated as an indefinite, i.e., plotted as a gap in the plot.
+
+procedure gpl_wcstogki (gp, wx, wy, mx, my)
+
+pointer	gp			# graphics device descriptor
+real	wx, wy			# world coordinates of point
+real	mx, my			# metacode coordinates of point
+
+real	x, y
+real	elogr()
+include	"gpl.com"
+
+begin
+	# Update cached transformation parameters if device changes, cache
+	# has been invalidated, or the current WCS has been changed.
+
+	if (gp != gp_out || GP_WCS(gp) != wcs)
+	    call gpl_cache (gp)
+	    
+	# Transform the coordinates.
+
+	if (xtran == LINEAR) {
+	    x = wx
+	} else if (xtran == LOG) {
+	    if (wx <= 0) {
+		call gpl_flush()
+		return
+	    } else
+		x = log10 (wx)
+	} else
+	    x = elogr (wx)
+
+	if (ytran == LINEAR) {
+	    y = wy
+	} else if (ytran == LOG) {
+	    if (wy <= 0) {
+		call gpl_flush()
+		return
+	    } else
+		y = log10 (wy)
+	} else
+	    y = elogr (wy)
+
+	# Return real rather than int GKI coordinates to avoid digitization
+	# errors in a sequence of draws relative to the current pen position.
+
+	mx = max (0.0, min (real(GKI_MAXNDC),
+	    ((x - wxorigin) * xscale) + mxorigin))
+	my = max (0.0, min (real(GKI_MAXNDC),
+	    ((y - wyorigin) * yscale) + myorigin))
+end
diff --git a/sys/gio/zzdebug.x b/sys/gio/zzdebug.x
new file mode 100644
index 00000000..e806ee23
--- /dev/null
+++ b/sys/gio/zzdebug.x
@@ -0,0 +1,392 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<gset.h>
+
+define	MAXPTS		20
+
+task	plot1, plot2, plot3, plot4, plot5, plot6, plot7, plot8,
+	balls, ticks, vdm
+
+
+procedure plot1()
+
+real	v[5]
+int	i
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 5
+	    v[i] = i ** 2
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gswind (gp, 1., 5., INDEF, INDEF)
+	call gascale (gp, v, 5, 2)
+	call glabax (gp, "Y = X ** 2", "X-AXIS", "Y-AXIS")
+	call gvline (gp, v, 5, 1., 5.)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot2()
+
+int	i
+real	x[512], y[512]
+real	xc, yc, xs, ys
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 512 {
+	    x[i] = ((i - 256.0) / 16.)
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 1.0
+	    else
+		y[i] = sin (x[i]) / x[i]
+	}
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gascale (gp, x, 512, 1)
+	call gascale (gp, y, 512, 2)
+	call glabax (gp, "The SINC Function", "X-AXIS", "Y-AXIS")
+	call gpline (gp, x, y, 512)
+
+	xc = 8
+	yc = .25
+	xs = 3.2
+	ys = 0.1
+
+	do i = 1, 10 {
+	    call gmark (gp, xc, yc, GM_CIRCLE, -xs, -ys)
+	    xc = xc + xs / 5
+	    yc = yc + ys / 5
+	    xs = xs * 1.25
+	    ys = ys * 1.5
+	}
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot3()
+
+int	i
+real	x[512], y[512]
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 512 {
+	    x[i] = ((i - 256.0) / 8.)
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 1.0
+	    else
+		y[i] = sin (x[i]) / x[i]
+	}
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_DRAWGRID, YES)
+	call gascale (gp, x, 512, 1)
+	call gascale (gp, y, 512, 2)
+	call glabax (gp, "The SINC Function", "X-AXIS", "Y-AXIS")
+	call gpline (gp, x, y, 512)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot4()
+
+int	i
+real	x[512], y[512]
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 512 {
+	    x[i] = (i - 256.0) / 4.
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 2.0 * 1E4
+	    else
+		y[i] = (sin (x[i]) / x[i] + 1.0) * 1E4
+	}
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_YTRAN, GW_LOG)
+	call gascale (gp, x, 512, 1)
+	call gascale (gp, y, 512, 2)
+	call glabax (gp, "Log of The SINC Function", "X-AXIS", "Y-AXIS")
+	call gpline (gp, x, y, 512)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot5()
+
+int	fd
+int	open(), clgeti()
+real	x1, x2, clgetr()
+pointer	gp, gopen()
+
+begin
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	x1 = clgetr ("x1")
+	x2 = clgetr ("x2")
+
+	call gseti (gp, G_NMINOR, clgeti ("nminor"))
+	call gseti (gp, G_XTRAN, GW_LOG)
+	call gseti (gp, G_YTRAN, GW_LOG)
+	call gsetr (gp, G_MINORWIDTH, 1.0)
+	call gswind (gp, x1, x2, 0.001, 1000.0)
+	call glabax (gp, "Log Scaling", "X-AXIS", "Y-AXIS")
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot6()
+
+int	i
+long	seed
+real	size, urand()
+int	fd, open(), clgeti()
+pointer	gp, gopen()
+data	seed /3/
+
+begin
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_ASPECT, clgeti("aspect"))
+	call glabax (gp, "", "", "")
+
+	do i = 1, 300 {
+	    size = real (nint (urand(seed) * 4 + .5))
+	    call gmark (gp, urand(seed), urand(seed), GM_BOX, size, size)
+	}
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure plot7()
+
+int	i
+real	x[8192], y[8192]
+int	fd, open()
+pointer	gp, gopen()
+
+begin
+	do i = 1, 8192 {
+	    x[i] = ((i - 4096.0) / 128.)
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 1.0
+	    else
+		y[i] = sin (x[i]) / x[i]
+	    y[i] = y[i] + cos ((i-1) * 0.392699) * .001
+	}
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_DRAWGRID, YES)
+	call gascale (gp, x, 8192, 1)
+	call gascale (gp, y, 8192, 2)
+	call glabax (gp, "The SINC Function", "X-AXIS", "Y-AXIS")
+	call gpline (gp, x, y, 8192)
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure balls()
+
+int	i, j, m, npts, nsteps
+long	seed
+real	p[MAXPTS,2], d[MAXPTS,2]
+real	urand()
+int	fd, open(), clgeti()
+pointer	gp, gopen()
+
+begin
+	npts = max(1, min(MAXPTS, clgeti ("npoints")))
+	nsteps = max (10, clgeti ("nsteps"))
+
+	# iferr (call delete ("x_mc"))
+	    # ;
+	# fd = open ("x_mc", NEW_FILE, BINARY_FILE)
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	# call glabax (gp, "Bouncing Balls", "", "")
+
+	# Set the initial conditions.
+	do i = 1, npts
+	    do j = 1, 2 {
+		p[i,j] = urand (seed)
+		d[i,j] = max (0.01, urand (seed) * .1)
+		if (mod (i, 2) == 0)
+		    d[i,j] = -d[i,j]
+	    }
+
+	# Draw the trajectories.
+	do m = 1, nsteps
+	    do i = 1, npts {
+		call gseti (gp, G_PMLTYPE, GL_CLEAR)
+		call gmark (gp, p[i,1], p[i,2], GM_DIAMOND, 4., 4.)
+
+		do j = 1, 2 {
+		    p[i,j] = p[i,j] + d[i,j]
+		    if (p[i,j] < 0) {
+			p[i,j] = -p[i,j]
+			d[i,j] = -d[i,j]
+		    } else if (p[i,j] > 1) {
+			p[i,j] = 1 - (p[i,j] - 1)
+			d[i,j] = -d[i,j]
+		    }
+		}
+	    
+		call gseti (gp, G_PMLTYPE, GL_SOLID)
+		call gmark (gp, p[i,1], p[i,2], GM_DIAMOND, 4., 4.)
+
+		call gflush (gp)
+	    }
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+procedure ticks()
+
+real	x1, x2, p1, p2
+int	rough_nticks
+int	logflag
+real	tick1, step, linearity
+
+bool	clgetb()
+int	btoi(), clgeti()
+real	gt_linearity(), clgetr(), elogr()
+
+begin
+	x1 = clgetr ("x1")
+	x2 = clgetr ("x2")
+	rough_nticks = clgeti ("nticks")
+	logflag = btoi (clgetb ("log"))
+
+	if (logflag == YES) {
+	    p1 = elogr (x1)
+	    p2 = elogr (x2)
+	} else {
+	    p1 = x1
+	    p2 = x2
+	}
+
+	linearity = gt_linearity (x1, x2)
+	call gtickr (p1, p2, rough_nticks, logflag, tick1, step)
+
+	call printf ("tick1=%g, step=%g, linearity=%g\n")
+	    call pargr (tick1)
+	    call pargr (step)
+	    call pargr (linearity)
+end
+
+
+procedure plot8()
+
+int	i
+real	x[512], y[512]
+int	fd
+pointer	gp, gopen()
+
+begin
+	do i = 1, 512 {
+	    x[i] = ((i - 256.0) / 8.)
+	    if (abs(x[i]) < EPSILON)
+		y[i] = 1.0
+	    else
+		y[i] = sin (x[i]) / x[i]
+	}
+
+	fd = STDGRAPH
+	gp = gopen ("stdgraph", NEW_FILE, fd)
+
+	call gseti (gp, G_DRAWAXES, 1)
+	call gseti (gp, G_SETAXISPOS, YES)
+	call gsetr (gp, G_AXISPOS1, 0.0)
+
+	call gseti (gp, G_DRAWGRID, YES)
+	call gascale (gp, x, 512, 1)
+	call gascale (gp, y, 512, 2)
+	call glabax (gp, "", "", "")
+	call gpline (gp, x, y, 512)
+	call gtext (gp, -20., 0.80, "The Sinc Function", "hj=c,vj=b")
+	call gtext (gp, -20., 0.75, "y = sin(x) / x", "hj=c,vj=b")
+
+	call gclose (gp)
+	call close (fd)
+end
+
+
+# VDM -- Test output of a plot to the virtual device metafile.
+
+procedure vdm()
+
+real	v[5]
+int	i
+pointer	gp, gopen()
+
+begin
+	do i = 1, 5
+	    v[i] = i ** 2
+
+	gp = gopen ("vdm", NEW_FILE, STDGRAPH)
+
+	call gswind (gp, 1., 5., INDEF, INDEF)
+	call gascale (gp, v, 5, 2)
+	call glabax (gp, "Y = X ** 2", "X-AXIS", "Y-AXIS")
+	call gvline (gp, v, 5, 1., 5.)
+
+	call gclose (gp)
+end