Repatch (from linux) of OSX IRAF

9 files changed, 2630 insertions, 0 deletions

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