Initial commit

76 files changed, 16328 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/stxtools/changt.x b/pkg/utilities/nttools/stxtools/changt.x
new file mode 100644
index 00000000..c3d4e511
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/changt.x
@@ -0,0 +1,98 @@
+#---------------------------------------------------------------------------
+.help change_ext Jun93 xtools
+.ih
+NAME
+change_ext -- Put the specified extension on a file name.
+.ih
+USAGE
+call change_ext (in_name, newext, out_name, max_size)
+.ih
+ARGUMENTS
+.ls in_name (I: char[ARB])
+The input pathname with which to change the arguments.
+.le
+.ls newext (I: char[ARB])
+The extension to replace the original extension with.
+.le
+.ls out_name (O: char[max_size])
+The resultant pathname with the new extension inserted.  May be the
+same as the in_name.
+.le
+.ls max_size (I: int)
+The maximum length of the string out_name.
+.le
+.ih
+DESCRIPTION
+This routine replaces the old extension on a pathname with the new
+extension specified in the argument "newext".  Thus:
+
+.nf
+        dir$root.ext --> dir$root.newext
+.fi
+.ih
+SEE ALSO
+fparse
+.endhelp
+#---------------------------------------------------------------------------
+procedure change_ext (in_name, newext, out_name, max_size)
+
+char    in_name[ARB]            # I:  Original input name.
+char    newext[ARB]             # I:  Extension to replace old one.
+char    out_name[max_size]      # O:  File name with new extension.
+int     max_size                # I:  Maximum size out_name.
+
+# Misc.
+pointer dir                     # Directory part of pathname.
+int     index                   # Group index in pathname.
+pointer ksection                # Unparsable part of pathname.
+int     ngroup                  # Number of groups.
+pointer root                    # Root part of pathname.
+pointer section                 # Section part of pathname.
+pointer sp                      # Stack pointer.
+pointer sx                      # Generic string.
+
+begin
+        call smark (sp)
+        call salloc (dir, SZ_LINE, TY_CHAR)
+        call salloc (root, SZ_LINE, TY_CHAR)
+        call salloc (section, SZ_LINE, TY_CHAR)
+        call salloc (ksection, SZ_LINE, TY_CHAR)
+        call salloc (sx, SZ_LINE, TY_CHAR)
+
+        # Parse the file name COMPLETELY.
+        call fparse (in_name, Memc[dir], SZ_LINE, Memc[root], SZ_LINE,
+                     Memc[sx], SZ_LINE, index, ngroup,
+                     Memc[section], SZ_LINE, Memc[ksection], SZ_LINE)
+
+        # Put directory and root together.
+        call strcpy (Memc[dir], out_name, max_size)
+        call strcat (Memc[root], out_name, max_size)
+
+        # Change the extension.
+        call strcat (".", out_name, max_size)
+        call strcat (newext, out_name, max_size)
+
+        # Handle group syntax.
+        if (index > 0) {
+            call sprintf (Memc[sx], SZ_LINE, "[%d")
+            call pargi (index)
+            call strcat (Memc[sx], out_name, max_size)
+            if (ngroup > 0) {
+                call sprintf (Memc[sx], SZ_LINE, "/%d")
+                call pargi (ngroup)
+                call strcat (Memc[sx], out_name, max_size)
+            }
+            call strcat ("]", out_name, max_size)
+        }
+
+        # Append the "unparsable" parts.
+        call strcat (Memc[ksection], out_name, max_size)
+
+        # Finally image sections.
+        call strcat (Memc[section], out_name, max_size)
+
+        call sfree (sp)
+end
+#---------------------------------------------------------------------------
+# End of change_ext
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/checkdim.x b/pkg/utilities/nttools/stxtools/checkdim.x
new file mode 100644
index 00000000..ef9ed017
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/checkdim.x
@@ -0,0 +1,24 @@
+include	<imhdr.h>
+
+#* HISTORY*
+#* B.Simon	04-Mar-93	original
+
+# CHECKDIM -- Get the real dimension of an image
+
+int procedure checkdim (im)
+
+pointer	im		# i: image descriptor
+#--
+int	idim, jdim
+
+begin
+	# Ignore higher dimesions that only have length one
+
+	jdim = 1
+	do idim = 1, IM_NDIM(im) {
+	    if (IM_LEN(im,idim) > 1)
+		jdim = idim
+	}
+
+	return (jdim)
+end
diff --git a/pkg/utilities/nttools/stxtools/cif.h b/pkg/utilities/nttools/stxtools/cif.h
new file mode 100644
index 00000000..55d87ab5
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/cif.h
@@ -0,0 +1,95 @@
+#---------------------------------------------------------------------------
+.help cif.h Apr94 source
+.ih
+NAME
+cif.h -- Definitions for the Coordinated Input File object.
+.endhelp
+#---------------------------------------------------------------------------
+#====
+# Below are the PUBLIC definitions of the CIF object.  These may be
+# used by any external application as desired.
+#====
+
+# Generic size of file names/character strings used by CIF.
+define	CIF_SZ_FNAME	SZ_PATHNAME
+
+# Possible values for the operation code passed to the 'cif_next' routine.
+define	CIF_NEXT_GROUP	1		# Get next, if any groups
+define	CIF_NEXT_FILE	2		# Get next primary file
+
+# Status of the secondary files after a 'cif_next" call.
+define	CIF_OK		1		# New file which is accessable.
+define	CIF_NONE	2		# No accessable file found.
+define	CIF_SAME	3		# File name is the same as previous.
+define	CIF_EXISTS	4		# Output file exists.
+
+# CIF structure variables: Primary file
+define	CIF_p_file_list		CIF_file_list(CIF_p($1))
+define	CIF_p_file		CIF_file(CIF_p($1))
+define	CIF_p_ext	       	CIF_ext(CIF_p($1))
+define	CIF_p_status		CIF_status(CIF_p($1))
+define	CIF_p_nloop		CIF_nloop(CIF_p($1))
+
+# CIF structure variables: Input Files
+define	CIF_in_file_list	CIF_file_list(CIF_in($1,$2))
+define	CIF_in_file		CIF_file(CIF_in($1,$2))
+define	CIF_in_ext	       	CIF_ext(CIF_in($1,$2))
+define	CIF_in_status		CIF_status(CIF_in($1,$2))
+define	CIF_in_nloop		CIF_nloop(CIF_in($1,$2))
+
+# CIF structure variables: Output Files.
+define	CIF_out_file_list	CIF_file_list(CIF_out($1,$2))
+define	CIF_out_file		CIF_file(CIF_out($1,$2))
+define	CIF_out_ext	       	CIF_ext(CIF_out($1,$2))
+define	CIF_out_status		CIF_status(CIF_out($1,$2))
+
+#===========================================================================
+#===========================================================================
+# The Private definitions to be used by the object code alone.  Any use
+# of the below macros constitutes an interface violation.
+#===========================================================================
+
+# Type of file which the current file name represents.
+define	CIF_GENERIC	1
+define	CIF_IMAGE	2
+define	CIF_DIRECTORY	3
+define	CIF_SAME_ROOT	4
+
+#====
+# The CIF object structure.
+#====
+define	CIF_p			Memi[$1]
+define	CIF_in_ptr		Memi[$1+1]
+define	CIF_n_in		Memi[$1+2]
+define	CIF_out_ptr		Memi[$1+3]
+define	CIF_n_out		Memi[$1+4]
+define	CIF_loop		Memi[$1+5]
+define	CIF_SZ			6
+
+define	CIF_in			Memi[CIF_in_ptr($1)+$2-1]
+define	CIF_out			Memi[CIF_out_ptr($1)+$2-1]
+
+#====
+# CIF File Object Structure
+#====
+define	CIF_list		Memi[$1]
+define	CIF_group		Memi[$1+1]
+define	CIF_status		Memi[$1+2]
+define	CIF_nloop		Memi[$1+3]
+define	CIF_cg			Memi[$1+5]
+define	CIF_type		Memi[$1+6]
+define	CIF_cbuf		Memi[$1+7]
+define	CIF_SZ_FILE		8
+
+define	CIF_file_list		Memc[CIF_cbuf($1)]
+define	CIF_file		Memc[CIF_cbuf($1)+CIF_SZ_FNAME+1]
+define	CIF_ext			Memc[CIF_cbuf($1)+2*(CIF_SZ_FNAME+1)]
+define	CIF_base		Memc[CIF_cbuf($1)+3*(CIF_SZ_FNAME+1)]
+define	CIF_SZ_FILE_CBUF	4*(CIF_SZ_FNAME+1)
+
+# Indexed versions of some strings.
+define	CIF_basei		Memc[CIF_CBUF($1)+3*(CIF_SZ_FNAME+1)+$2-1]
+
+#---------------------------------------------------------------------------
+# End of cif.h
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/cif.x b/pkg/utilities/nttools/stxtools/cif.x
new file mode 100644
index 00000000..6fa3a7f2
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/cif.x
@@ -0,0 +1,806 @@
+include <imhdr.h>
+include "cif.h"
+
+#---------------------------------------------------------------------------
+.help cif Apr94 source
+.ih
+NAME
+cif -- Coordinated Input File object
+.ih
+DESCRIPTION
+The Coordinated Input File (CIF) object manages multiple input/output
+files that are keyed on a single input file list.  This is useful for
+tasks whose input data may come from several different types of input
+files.  These input files are coordinated, or linked with, some
+primary input file.  This object also handles the creation of output
+files, again linked in some way with the primary input file list.
+
+An explanation of the problem for which this interface was developed
+should help demonstrate the point of the CIF object.  For GHRS, the
+calibrated output products includes a flux file, indicated by a file
+extension of C1H, and a wavelength vector file, indicated by a file
+extension of C0H.  The number of groups in each file is the same, with
+each group of the wavelength file corresponding to each group of the
+flux file.  The primary input file list would be the flux files and
+the one of the secondary input files would be the rootname of the flux
+file but with the C0H extension.  The CIF object ensures that the
+files are opened "in lock step".  As output, there probably is only
+one output list, each file with the same number of groups as the
+primary input file, but with a new extension, some addition to the
+rootname, or placed in another directory with the same root/extension.
+
+The following sections discuss the public and private
+interfaces.
+.ih
+PUBLIC INTERFACE
+The public interface to CIF consists of three subroutines and a number
+of variables.  The subroutines are:
+
+.nf
+	cif_alloc
+	cif_next
+	cif_free
+.fi
+
+Detailed description of the subroutines are:
+
+.ls pointer = cif_alloc (n_in, n_out)
+This routine creates the CIF object.  It requires the number of input
+files and output files that will be coordinated with the primary input
+file.  Note, the primary input file is NOT counted as one of the
+inputs.  The CIF variables are initialized to default or undefined
+values.
+.ls n_in (int)
+Number of input files that will be coordinated.  0 if no input files
+are required.
+.le
+.ls n_out (int)
+Number of output files that will be coordinated.  0 if no output files
+are requierd.
+.le
+.ls RETURNS (pointer)
+Pointer to the CIF object.  This pointer will be used in other
+subroutine calls and accessing the CIF object variables.
+.le
+.le
+.ls boolean = cif_next (o, type)
+This is the main loop call for the CIF object.  The CIF variables are
+populated with the next set of file names.  This can either be the
+next groups of files, or a new set of files depending on the type
+specified.  If the value of cif_next is TRUE, then there are more
+files.  If FALSE, the end of the list has been reached, i.e. there are
+no more primary files to be had.  On return, the CIF variables *_file
+and *_status are set.  See the description below of the CIF
+variables for more information.  
+.ls o (pointer)
+The pointer to a CIF object created with cif_alloc.
+.le
+.ls type (int)
+What "type" to get next.  Possible values are
+.nf
+	CIF_FILE  - Get next primary file and associated
+	            in/out files.
+	CIF_GROUP - Get next group
+.fi
+.le
+.ls RETURNS (bool)
+TRUE if there is another set of file names available.  FALSE if no
+more primary files are found.
+.le
+.le
+.ls cif_free (o)
+Deallocates the CIF object.
+.ls o (pointer)
+The pointer to the CIF object to destroy.  Value will be NULL on
+return.
+.le
+.le
+
+The CIF variables can be found in the include file 'cif.h' under the
+public definition section.  Below is the current list followed by a
+detailed explanation.
+
+.nf
+	# CIF structure variables: Primary file
+	CIF_p_file_list(o)
+	CIF_p_file(o)
+	CIF_p_ext(o)
+	CIF_p_status(o)
+	CIF_p_nloop(o)
+	
+	# CIF structure variables: Input Files
+	CIF_in_file_list(o,i)
+	CIF_in_file(o,i)
+	CIF_in_ext(o,i)
+	CIF_in_status(o,i)
+	CIF_in_nloop(o,i)
+
+	# CIF structure variables: Output Files.
+	CIF_out_file_list(o,i)
+	CIF_out_file(o,i)
+	CIF_out_ext(o,i)
+	CIF_out_status(o,i)
+.fi
+
+For all of the above variables, 'o' is the pointer to the CIF object
+and 'i' is the particular input/output file list to access, since
+there can be multiple input/output files.  The definition of each
+variable is as follows:
+.ls CIF_p_file_list, CIF_in_file_list, CIF_out_file_list (char[CIF_SZ_FNAME])
+These variables contain the initial file lists for the primary, input,
+and output files.  The lists can contain wildcards, substitution, and
+"@file" specifications.  Anything that is consistent with the IRAF
+'imtopen' IMIO call.  These variables have to be set after the call to
+'cif_alloc' but before calling 'cif_next'.
+
+The output list is used a bit differently from the input lists.  If
+the next file name from an output list is a directory, the output file
+name will be the same as the current primary file, but with this
+directory.  If the output list is empty, and the last name retrieved
+from the output list is not a directory, then the output filename will
+be the same as the current primary file, depending on the value of
+CIF_out_ext, see below.  If the output list is empty and the last file
+from the output list was a directory, that directory will be used for
+all subsequent primary files.
+.le
+.ls CIF_p_ext, CIF_in_ext, CIF_out_ext (char[CIF_SZ_FNAME])
+These variables contain the default file name extension to use for
+each file.  The default extensions do not have to be specified, i.e.
+the value of these variables is an empty string.  In that case, the
+actions described below for each variable does not occur.  The
+symantics of the _EXT variable is slightly different for each type of
+file:
+.ls CIF_p_ext
+If the next primary file, as retrieved from the primary file list,
+does not exist, replace the original extension with this extension.
+If the file still does not exist, the call to cif_next will error.
+.le
+.ls CIF_in_ext
+This variable is used in two different ways.  If the input file list
+is empty, then this extension is placed on the current primary file
+and the file is looked for.  If the input list is not empty but the
+next input file does not exist, this extension replaces the original
+extension and existance is checked again.
+.le
+.ls CIF_out_ext
+If specified, this extension is always placed on the output file name.
+.le
+.le
+.ls CIF_p_nloop, CIF_in_nloop (int)
+These variable specify how many calls to 'cif_next' must occur before
+the next group/file is retrieved from the particular primary or input
+list.  The default value is 1, or every time 'cif_next' is called,
+retrieve the next group/file.  This is useful when a single group in
+either the primary or input file corresponds to a number of groups in
+another input file (or primary file).  
+
+The output files don't have a counter, since the output file names are
+created based on the primary file.
+.le
+.ls CIF_p_file, CIF_in_file, CIF_out_file (char[CIF_SZ_FNAME])
+On return from 'cif_next', these variables contain the next set of
+file names.  The validity of the name contained in each variable is
+determined by the corresponding *_STATUS variable, see below.  If any
+of the files are images, a group specification is appended.
+.le
+.ls CIF_p_status, CIF_in_status, CIF_out_status (int)
+The status or validity of the names contained in the *_FILE variables
+after a call to 'cif_next'.  The possible values are:
+.ls CIF_OK
+The name represents another file, different from the name returned by
+a previous call to 'cif_next'.  For the primary and input files, the
+file exists.  For output files, the file does not exist.
+.le
+.ls CIF_NONE
+For input files, there is no more files in that particular input list.
+The value of CIF_in_file is invalid, i.e. contains "garbage".  The
+primary file and output files will never have this status value.  This
+is because, when there are no more primary files, 'cif_next' returns
+FALSE and the output files are created based on the primary files.
+.le
+.ls CIF_SAME
+For primary and input values, this value indicates that the file name
+is the same as that returned from a previous call to 'cif_next'.  A
+file name will not change only because the value of *_NLOOP and the
+current call to 'cif_next' implied to not change the file name.
+
+For output files, this status indicates that the output file name is
+the same as the current primary file.  This can occur if the output
+file list is empty and either no default extension was specified, or
+the default extension happens to be the same as the current primary
+file.  Note, this indicates that the character string of the output
+file matches the character string of the current primary file.  There
+is no check whether the created files would actually be the same.
+For example, if the current primary file is "root.ext", and the output
+file is "./root.ext", the status would be CIF_OK, not CIF_SAME.  See
+CIF_EXISTS. 
+.le
+.ls CIF_EXISTS
+For output files only, this indicates that the file exists.
+.le
+.le
+The one constant in use is CIF_SZ_FNAME, size of all character
+variables used by CIF.
+.ih
+PRIVATE INTERFACE
+Note: There won't be much discussion here.  Remember: "Use the force,
+read the source".
+
+The CIF object consists of two structures.  The CIF file object, which
+maintains the individual files, and the CIF structure which
+manages the number of files.
+
+.ls Subroutines
+The subroutines are as follows:
+.ls pointer = cif_alloc_file_obj()
+Create the CIF file object.  This contains the information specific to
+an individual file list.
+.ls RETURNS (pointer)
+Returns a pointer to a CIF FILE object.
+.le
+.le
+.ls cif_free_file_obj (o)
+Destroy a CIF FILE object.
+.ls o (pointer)
+The FILE object to destroy.  On return, the value will be NULL.
+.le
+.le
+.ls bool = cif_next_primary (o)
+Get the next primary file and all input/output files.  Besides the
+routines in the public interface, this is the only one that deals with
+the CIF structure.  This routine, regardless of the group counts and
+whether there are any groups left, retrieve the next files from the
+primary, input, and output lists and populates the CIF public
+variables appropriately.
+.ls o (pointer)
+A pointer to the CIF object.
+.le
+.ls RETURNS (boolean)
+TRUE if there is another set of files.  FALSE if there are no more
+primary files.
+.le
+.le
+.ls cif_base2name (o, p)
+Get the next file name for the specified FILE object, using
+information from the primary FILE object.
+.ls o (pointer)
+The FILE object to get the next name for.  This should only be a
+primary FILE object or an input FILE object.  Output FILE objects use
+'cif_out'.
+.le
+.ls p (pointer)
+The FILE object for the primary file list.
+.le
+.le
+.ls int = cif_file_type (fname)
+Determine the type of file specified.  If the file does not exist, the
+routine generates an error.
+.ls fname (char[ARB])
+The name of the file to determine the type of.
+.le
+.ls RETURNS (int)
+A file type id.  See 'cif.h' under the Private definitions for a list
+of file types.
+.le
+.le
+.ls bool = cif_next_group (o, loop)
+Get the file name representing the next group of the specified file.
+.ls o
+The primary or input FILE object to get the next group of.
+.le
+.ls loop (int)
+The number of times 'cif_next' has been called.  Used to decide
+whether another group should be returned or not.
+.le
+.ls RETURNS (bool)
+TRUE if there is another group, even if the group has not changed.
+FALSE if there are no more groups in the current image.
+.le
+.le
+.ls cif_out (o, p)
+Find the next output file name based on the primary file.
+.ls o (pointer)
+The output FILE object to get the name for.
+.le
+.ls p (pointer)
+The primary FILE object.
+.le
+.le
+.le
+.endhelp
+#---------------------------------------------------------------------------
+pointer	procedure cif_alloc (n_in, n_out)
+
+int	n_in			# I:  Number of secondary input files.
+int	n_out			# I:  Number of output files.
+
+# Declarations.
+pointer	cif_alloc_file_obj()	# Alloce a CIF FILE object.
+pointer	o			# The CIF object.
+int	i			# Generic.
+
+errchk	cif_alloc_file_obj, malloc
+
+begin
+	# Allocate the CIF object.
+	call malloc (o, CIF_SZ, TY_STRUCT)
+	
+	# Allocate the CIF FILE object for the primary file.
+	CIF_p(o) = cif_alloc_file_obj()
+
+	# Allocate FILE objects for each input file.
+	CIF_n_in(o) = n_in
+	call malloc (CIF_in_ptr(o), CIF_n_in(o), TY_POINTER)
+	do i = 1, CIF_n_in(o) {
+	    CIF_in(o,i) = cif_alloc_file_obj ()
+	}
+	
+	# Allocate FILE objects for each output file.
+	CIF_n_out(o) = n_out
+	call malloc (CIF_out_ptr(o), CIF_n_out(o), TY_POINTER)
+	do i = 1, CIF_n_out(o) {
+	    CIF_out(o,i) = cif_alloc_file_obj ()
+	}
+
+	# Initialize the loop count
+	CIF_loop(o) = 0
+	
+	# That's all folks.
+        return (o)
+end
+#---------------------------------------------------------------------------
+# End of cif_alloc
+#---------------------------------------------------------------------------
+procedure cif_free (o)
+
+pointer	o			# IO: CIF object, NULL on return.
+
+# Declarations.
+int	i			# generic.
+
+errchk	cif_free_file_obj, mfree
+
+begin
+	# Free FILE objects for each output file.
+	do i = 1, CIF_n_out(o)
+	   call cif_free_file_obj (CIF_out(o,i))
+	call mfree (CIF_out_ptr(o), TY_POINTER)
+	
+	# Free FILE objects for each input file.
+	do i = 1, CIF_n_in(o)
+	   call cif_free_file_obj (CIF_in(o,i))
+	call mfree (CIF_in_ptr(o), TY_POINTER)
+
+	# Free the primary FILE object.
+	call cif_free_file_obj (CIF_p(o))
+	
+	# Remove the object.
+	call mfree (o, TY_STRUCT)
+end
+#---------------------------------------------------------------------------
+# End of cif_free
+#---------------------------------------------------------------------------
+pointer procedure cif_alloc_file_obj ()
+
+# Declarations.
+pointer	o			# The CIF FILE object.
+
+errchk	malloc
+
+begin
+	# Get memory.
+	call malloc (o, CIF_SZ_FILE, TY_STRUCT)
+	call malloc (CIF_cbuf(o), CIF_SZ_FILE_CBUF, TY_CHAR)
+
+	# Setup initial values.
+	call strcpy ("", CIF_file_list(o), CIF_SZ_FNAME)
+	call strcpy ("", CIF_file(o), CIF_SZ_FNAME)
+	CIF_list(o) = NULL
+	CIF_group(o) = NULL
+	call strcpy ("", CIF_ext(o), CIF_SZ_FNAME)
+	CIF_status(o) = CIF_NONE
+	CIF_nloop(o) = 1
+	CIF_cg(o) = INDEFI
+	call strcpy ("", CIF_base(o), CIF_SZ_FNAME)
+	CIF_type(o) = INDEFI
+
+	# That's all folks.
+	return (o)
+end
+#---------------------------------------------------------------------------
+# End of cif_alloc_file_obj
+#---------------------------------------------------------------------------
+procedure cif_free_file_obj (o)
+
+pointer	o			# IO:  CIF FILE object, NULL on return.
+
+# Declarations.
+errchk	imtclose, mfree, tp_close
+
+begin
+	# Close other opened objects.
+	if (CIF_list(o) != NULL)
+	    call imtclose (CIF_list(o))
+	if (CIF_group(o) != NULL)
+	    call tp_close (CIF_group(o))
+
+	# That's all folks.
+	call mfree (CIF_cbuf(o), TY_CHAR)
+	call mfree (o, TY_STRUCT)
+end
+#---------------------------------------------------------------------------
+# End of cif_free_file_obj
+#---------------------------------------------------------------------------
+bool procedure cif_next (o, type)
+
+pointer	o			# I:  The CIF object.
+int	type			# I:  Get a group or file.
+
+# Declarations
+bool	another			# True if another set of files are available.
+bool	bx			# Generic.
+bool	cif_next_group()	# Get next group.
+bool	cif_next_primary()	# Get next primary files.
+int	i			# Generic.
+int	imtlen()		# Length of a file list.
+pointer	imtopen()		# Open an file list.
+
+errchk	imtlen, imtopen
+
+begin
+	# Increment the loop count.
+	CIF_loop(o) = CIF_loop(o) + 1
+	
+	# If the lists have not been opened, do it now.
+	if (CIF_list(CIF_p(o)) == NULL) {
+	    CIF_list(CIF_p(o)) = imtopen (CIF_file_list(CIF_p(o)))
+	    if (imtlen (CIF_list(CIF_p(O))) <= 0)
+		call error (1, "cif: no input files specified")
+	    do i = 1, CIF_n_in(o)
+		CIF_list(CIF_in(o,i)) = imtopen (CIF_file_list(CIF_in(o,i)))
+	    do i = 1, CIF_n_out(o)
+		CIF_list(CIF_out(o,i)) = imtopen (CIF_file_list(CIF_out(o,i)))
+	    another = cif_next_primary (o)
+	}
+
+	# Else, if type is FILE, just get next set of files.
+	else if (type == CIF_NEXT_FILE)
+	    another = cif_next_primary (o)
+
+	# Else, loop through groups.
+	else {
+	    if (cif_next_group (CIF_p(o), CIF_loop(o))) {
+
+		# Loop through all the inputs.
+		do i = 1, CIF_n_in(o)
+		    bx = cif_next_group (CIF_in(o,i), CIF_loop(o))
+
+		# Loop through all the outputs.
+		do i = 1, CIF_n_out(o)
+		    call cif_out (CIF_out(o,i), CIF_p(o))
+
+		# There is another file.
+		another = true
+	    }
+
+	    # Else, get the next set of files.
+	    else
+		another = cif_next_primary (o)
+	}
+
+        # That's all folks.
+        return (another)
+end
+#---------------------------------------------------------------------------
+# End of cif_next
+#---------------------------------------------------------------------------
+bool procedure cif_next_primary (o)
+
+pointer	o			# I:  The CIF object.
+
+# Declarations.
+bool	another			# True if another set of files is available.
+int	i			# Generic.
+int	imtgetim()		# Get next file from file list.
+char	sx[SZ_LINE]		# Generic string.
+
+errchk	imtgetim
+
+begin
+	# Open next primary image.  If there are no more, then
+	# that's all.
+	if (imtgetim (CIF_list(CIF_p(o)), CIF_base(CIF_p(o)),
+		      CIF_SZ_FNAME) != EOF) {
+	    call cif_base2name (CIF_p(o), CIF_p(o))
+	    if (CIF_status(CIF_p(o)) == CIF_NONE) {
+		call sprintf (sx, SZ_LINE, "cif: no primary file %s")
+		call pargstr (CIF_base(CIF_p(o)))
+		call error (1, sx)
+	    }
+	    
+	    # Open the next set of input files.
+	    do i = 1,CIF_n_in(o) {
+		if (imtgetim (CIF_list(CIF_in(o,i)), CIF_base(CIF_in(o,i)),
+			      CIF_SZ_FNAME) == EOF)
+		    call strcpy ("", CIF_base(CIF_in(o,i)), CIF_SZ_FNAME)
+		call cif_base2name (CIF_in(o,i), CIF_p(o))
+	    }
+	    
+	    # Open the next set of output files.
+	    do i = 1, CIF_n_out(o) {
+		CIF_status(CIF_out(o,i)) = CIF_OK
+		if (imtgetim (CIF_list(CIF_out(o,i)), CIF_base(CIF_out(o,i)),
+			      CIF_SZ_FNAME) == EOF) {
+		    if (IS_INDEFI(CIF_type(CIF_out(o,i))))
+			CIF_type(o,i) = CIF_GENERIC
+		    else
+			CIF_status(CIF_out(o,i)) = CIF_SAME
+		}
+
+		call cif_out (CIF_out(o,i), CIF_p(o))
+	    }
+
+	    # Indicate that another set of files are available.
+	    another = true
+	    
+	} else
+	    another = false
+
+	# That's all folks.
+	return (another)
+end
+#---------------------------------------------------------------------------
+# End of cif_next_primary
+#---------------------------------------------------------------------------
+procedure cif_base2name (o, p)
+
+pointer	o			# I:  CIF FILE Object to find name for.
+pointer	p			# I:  CIF FILE Object of primary file.
+
+# Declarations
+bool    bx			# Generic.
+int	cif_file_type()		# Determine file type of file.
+int	i			# Generic.
+int	strlen()		# Get length of string.
+bool	tp_fetch()		# Get next group.
+pointer	tp_open()		# Open a group list.
+
+errchk	tp_close, tp_fetch, tp_open
+
+begin
+	# If there is a group list open, close it.
+	if (CIF_group(o) != NULL)
+	    call tp_close (CIF_group(o))
+	
+	# Determine file type.  If there is an error, try with
+	# the default extension.  If that doesn't exist, try default
+	# extension of the primary name.
+	CIF_status(o) = CIF_OK
+	if (strlen(CIF_base(o)) <= 0) {
+	    call change_ext (CIF_base(p), CIF_ext(o), CIF_file(o),
+			     CIF_SZ_FNAME)
+	    iferr (CIF_type(o) = cif_file_type (CIF_file(o)))
+		CIF_status(o) = CIF_NONE
+	} else {
+	    call strcpy (CIF_base(o), CIF_file(o), CIF_SZ_FNAME)
+	    iferr (CIF_type(o) = cif_file_type (CIF_file(o))) {
+		call change_ext (CIF_file(o), CIF_ext(o), CIF_file(o),
+				 CIF_SZ_FNAME)
+		iferr (CIF_type(o) = cif_file_type (CIF_file(o)))
+		    CIF_status(o) = CIF_NONE
+	    }
+	}
+
+	# Make the new name the base.
+	if (CIF_status(o) == CIF_OK) {
+	    call strcpy (CIF_file(o), CIF_base(o), CIF_SZ_FNAME)
+	    
+	    # If the file is an image, open the group list.
+	    if (CIF_type(o) == CIF_IMAGE) {
+		CIF_group(o) = tp_open (CIF_file(o), 0, i)
+		bx = tp_fetch (CIF_group(o), CIF_file(o))
+	    }
+	    CIF_cg(o) = 1
+	}
+end
+#---------------------------------------------------------------------------
+# End of cif_base2name
+#---------------------------------------------------------------------------
+int procedure cif_file_type (fname)
+
+char	fname[ARB]		# I:  The file to determine type of.
+
+# Declarations.
+int	access()		# Get file access.
+pointer	immap()			# Open an image.
+pointer	px			# Generic.
+int	strlen()		# Get length of string.
+int	type			# Type of file.
+
+errchk	access, imunmap
+
+begin
+	if (strlen (fname) <= 0)
+	    call error (1, "cif: Unknown type")
+	else ifnoerr (px = immap (fname, READ_ONLY, NULL)) {
+	    type = CIF_IMAGE
+	    call imunmap (px)
+	} else if (access (fname, 0, 0) == YES)
+	    type = CIF_GENERIC
+	else
+	    call error (1, "cif: Unknown type")
+
+	return (type)
+end
+#---------------------------------------------------------------------------
+# End of cif_file_type
+#---------------------------------------------------------------------------
+bool procedure cif_next_group (o, loop)
+
+pointer	o			# I:  The CIF FILE object.
+int	loop			# I:  Current loop count.
+
+# Declarations
+bool	tp_fetch()		# Get next group.
+
+errchk	tp_fetch
+
+begin
+	# Is this file a type to have groups?
+	if (CIF_type(o) == CIF_IMAGE) {
+	    
+	    # Is this loop one to change on?
+	    if (mod (loop-1, CIF_nloop(o)) == 0) {
+
+		# Get the next group.
+		if (tp_fetch (CIF_group(o), CIF_file(o))) {
+		    CIF_status(o) = CIF_OK
+		    CIF_cg(o) = CIF_cg(o) + 1
+		}
+
+		# Else, no more data.
+		else
+		    CIF_status(o) = CIF_NONE
+	    }
+
+	    # Nope, keep it the same.
+	    else
+		CIF_status(o) = CIF_SAME
+	}
+
+	# Else, nope, no groups here.
+	else
+	    CIF_status(o) = CIF_NONE
+
+	# Return true if a file exists.
+	return (CIF_status(o) != CIF_NONE)
+end
+#---------------------------------------------------------------------------
+# End of cif_next_group
+#---------------------------------------------------------------------------
+procedure cif_out (o, p)
+
+pointer	o			# I:  CIF FILE Object to get output name.
+pointer	p			# I:  Primary CIF FILE Object to get info.
+
+# Declarations
+int	access()		# Is file accessable?
+int	cl_index, cl_size	# Cluster info.
+char	dir[CIF_SZ_FNAME]	# Directory of the file name.
+char	ext[CIF_SZ_FNAME]	# Extension of the file name.
+int	i			# Generic.
+int	isdirectory()		# Is a file a directory?
+char	ksection[CIF_SZ_FNAME]	# Ksection of the file name.
+char	root[CIF_SZ_FNAME]	# Root of the file name.
+char	section[CIF_SZ_FNAME]	# Section of the file name.
+bool	streq()			# Are strings equal?
+int	strlen()		# Get length of string.
+char	sx[1]			# Generic.
+
+errchk	access, fbuild, fparse, isdirectory
+
+begin
+	# If a new input, determine what it is.
+	if (CIF_status(o) != CIF_SAME) {
+	    if (strlen (CIF_base(o)) <= 0)
+		CIF_type(o) = CIF_SAME_ROOT
+	    else if (isdirectory (CIF_base(o), root, SZ_PATHNAME) > 0)
+		CIF_type(o) = CIF_DIRECTORY
+	    else
+		CIF_type(o) = CIF_GENERIC
+	}
+
+	# Create the new file name.
+	call fparse (CIF_file(p), dir, CIF_SZ_FNAME, root, CIF_SZ_FNAME,
+		     ext, CIF_SZ_FNAME, cl_index, cl_size, section,
+		     CIF_SZ_FNAME, ksection, CIF_SZ_FNAME)
+	switch (CIF_type(o)) {
+	case CIF_DIRECTORY:
+	    call strcpy (CIF_base(o), dir, CIF_SZ_FNAME)
+
+	case CIF_GENERIC:
+            call fparse (CIF_base(o), dir, CIF_SZ_FNAME, root, CIF_SZ_FNAME,
+                         ext, CIF_SZ_FNAME, i, i, sx, 1, sx, 1)
+	}
+
+	# If a different extension is supplied, use it.
+	if (strlen (CIF_ext(o)) > 0) {
+	    call strcpy (".", ext, CIF_SZ_FNAME)
+	    call strcat (CIF_ext(o), ext, CIF_SZ_FNAME)
+	}
+	
+	# Build the new file name.
+	call fbuild (dir, root, ext, cl_index, cl_size, section, ksection,
+		     CIF_file(o), CIF_SZ_FNAME)
+
+	# Set status if the name is the same as the primary file.
+	if (streq (CIF_file(p), CIF_file(o)))
+	    CIF_status(o) = CIF_SAME
+	else {
+	    if (access (CIF_file(o), 0, 0) == YES)
+		CIF_status(o) = CIF_EXISTS
+	    else
+		CIF_status(o) = CIF_OK
+	}
+end
+#---------------------------------------------------------------------------
+# End of cif_out
+#---------------------------------------------------------------------------
+procedure cif_test()
+
+pointer	cif, cif_alloc()
+bool	cif_next()
+int	clgeti(), i
+
+begin
+	cif = cif_alloc (2, 1)
+	
+	call clgstr ("primary", CIF_p_file_list(cif), CIF_SZ_FNAME)
+	call clgstr ("p_ext", CIF_p_ext(cif), CIF_SZ_FNAME)
+	CIF_p_nloop(cif) = clgeti ("p_loop")
+	call clgstr ("in1", CIF_in_file_list(cif,1), CIF_SZ_FNAME)
+	call clgstr ("in1_ext", CIF_in_ext(cif,1), CIF_SZ_FNAME)
+	CIF_in_nloop(cif,1) = clgeti ("in1_loop")
+	call clgstr ("in2", CIF_in_file_list(cif,2), CIF_SZ_FNAME)
+	call clgstr ("in2_ext", CIF_in_ext(cif,2), CIF_SZ_FNAME)
+	CIF_in_nloop(cif,2) = clgeti ("in2_loop")
+	call clgstr ("out1", CIF_out_file_list(cif,1), CIF_SZ_FNAME)
+	call clgstr ("out1_ext", CIF_out_ext(cif,1), CIF_SZ_FNAME)
+	
+	while (cif_next (cif, CIF_NEXT_GROUP)) {
+	    call printf ("Primary file == '%s'")
+	    call pargstr (CIF_p_file(cif))
+	    if (CIF_p_status(cif) == CIF_SAME)
+		call printf (" (same as previous)")
+	    call printf ("\n")
+
+	    do i = 1, 2 {
+		switch (CIF_in_status(cif,i)) {
+		case CIF_OK:
+		    call printf ("	Input %d is '%s'\n")
+		    call pargi (i)
+		    call pargstr (CIF_in_file(cif,i))
+		case CIF_NONE:
+		    call printf ("	No files for input %d\n")
+		    call pargi (i)
+		case CIF_SAME:
+		    call printf ("	Input %d is '%s' (same as previous)\n")
+		    call pargi (i)
+		    call pargstr (CIF_in_file(cif,i))
+		}	
+	    }
+
+	    call printf ("	Output file is '%s'")
+	    call pargstr (CIF_out_file(cif,1))
+	    if (CIF_out_status(cif,1) == CIF_EXISTS)
+		call printf (" (file exists)")
+	    else if (CIF_out_status(cif,1) == CIF_SAME)
+		call printf (" (same as input)")
+	    call printf ("\n")
+	}
+
+	call cif_free (cif)
+end
+#---------------------------------------------------------------------------
+# End of cif_test
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/clgnone.x b/pkg/utilities/nttools/stxtools/clgnone.x
new file mode 100644
index 00000000..b6fde15c
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/clgnone.x
@@ -0,0 +1,37 @@
+# CLGNONE -- Get a string parameter whose value may be "none"
+#
+# B.Simon	20-Jun-94	original
+# B.Simon	30-Jan-95	moved to stxtools
+
+procedure clgnone (param, value, maxch)
+
+char	param[ARB]	# i: parameter name
+char	value[ARB]	# o: parameter value
+int	maxch		# i: maximum length of value
+#--
+pointer	sp, temp1, temp2
+bool	streq()
+
+begin
+	# Allocate memory for temporary strings
+
+	call smark (sp)
+	call salloc (temp1, maxch, TY_CHAR)
+	call salloc (temp2, maxch, TY_CHAR)
+
+	# Read parameter and convert to lower case for simpler comparison
+
+	call clgstr (param, Memc[temp1], maxch)
+	call strcpy (Memc[temp1], Memc[temp2], maxch)
+	call strjust (Memc[temp2])
+
+	# If value is none, set to null string
+
+	if (Memc[temp2] == EOS || streq (Memc[temp2], "none")) {
+	    value[1] = EOS
+	} else {
+	    call strcpy (Memc[temp1], value, maxch)
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/stxtools/copyimg.x b/pkg/utilities/nttools/stxtools/copyimg.x
new file mode 100644
index 00000000..0248cfa9
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/copyimg.x
@@ -0,0 +1,78 @@
+include	<imhdr.h>
+
+# COPYIMG -- Copy one image to another
+#
+# B.Simon	02-Mar-92	Original
+# B.Simon	16-Mar-94	Delete fast copy, check for existing image
+
+procedure copyimg (old, new)
+
+char	old[ARB]	# i: old image
+char	new[ARB]	# i: new image
+#--
+int	npix, junk
+pointer	buf1, buf2, im1, im2
+long	v1[IM_MAXDIM], v2[IM_MAXDIM]
+
+int	imaccess()
+int	imgnls(), imgnll(), imgnlr(), imgnld(), imgnlx()
+int	impnls(), impnll(), impnlr(), impnld(), impnlx()
+pointer	immap()
+
+errchk	immap, imunmap
+
+begin
+	# Map the input and output images
+	# Code adapted from iraf's imcopy task
+
+	im1 = immap (old, READ_ONLY, 0)
+	if (imaccess (new, READ_WRITE) == NO) {
+	    im2 = immap (new, NEW_COPY, im1)
+	} else {
+	    im2 = immap (new, READ_WRITE, NULL)
+	}
+
+	# Setup start vector for sequential reads and writes
+
+	call amovkl (long(1), v1, IM_MAXDIM)
+	call amovkl (long(1), v2, IM_MAXDIM)
+
+	# Copy the image.
+
+	npix = IM_LEN(im1, 1)
+	switch (IM_PIXTYPE(im1)) {
+	case TY_SHORT:
+	    while (imgnls (im1, buf1, v1) != EOF) {
+		junk = impnls (im2, buf2, v2)
+		call amovs (Mems[buf1], Mems[buf2], npix)
+	    }
+	case TY_USHORT, TY_INT, TY_LONG:
+	    while (imgnll (im1, buf1, v1) != EOF) {
+		junk = impnll (im2, buf2, v2)
+		call amovl (Meml[buf1], Meml[buf2], npix)
+	    }
+	case TY_REAL:
+	    while (imgnlr (im1, buf1, v1) != EOF) {
+		junk = impnlr (im2, buf2, v2)
+		call amovr (Memr[buf1], Memr[buf2], npix)
+	    }
+	case TY_DOUBLE:
+	    while (imgnld (im1, buf1, v1) != EOF) {
+		junk = impnld (im2, buf2, v2)
+		call amovd (Memd[buf1], Memd[buf2], npix)
+	    }
+	case TY_COMPLEX:
+	    while (imgnlx (im1, buf1, v1) != EOF) {
+	        junk = impnlx (im2, buf2, v2)
+		call amovx (Memx[buf1], Memx[buf2], npix)
+	    }
+	default:
+	    call error (1, "unknown pixel datatype")
+	}
+
+	# Unmap the images
+
+	call imunmap (im2)
+	call imunmap (im1)
+
+end
diff --git a/pkg/utilities/nttools/stxtools/doc/wcs.doc b/pkg/utilities/nttools/stxtools/doc/wcs.doc
new file mode 100644
index 00000000..8154a944
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/doc/wcs.doc
@@ -0,0 +1,177 @@
+Routines for conversion between pixel coordinates and world coordinates.
+
+     This package contains the following high-level routines for converting
+between world coordinates and pixel coordinates:
+
+xt_wcs_init             initialize structure for world coordinate system
+xt_wcs_init_c           initialize from input cdelt, crota, etc
+xt_wcs_init_cd          initialize from input CD matrix, etc
+xt_wc_pix               convert from world coordinates to pixel coordinates
+xt_pix_wc               convert from pixel coordinates to world coordinates
+xt_wcs_free             deallocate wcs struct
+
+After calling any one of the three initialization routines, either or both
+of the conversion routines (xt_wc_pix, xt_pix_wc) may be called any number
+of times.  When finished, xt_wcs_free should be called to deallocate memory
+that was allocated by the initialization routine.
+
+     Eight different projection geometries are currently implemented for
+spherical coordinates.  The projection type is obtained from the CTYPE
+parameter, or the type defaults to gnomonic if nothing is specified in
+CTYPE.  Here is a list of CTYPE values for the right ascension axis with
+the various projection types.  For Aitoff and Mercator projections the
+reference pixel is assumed to be on the equator.  In addition, for Aitoff
+projection the difference between right ascension and RA at the reference
+pixel is limited to 180 degrees.
+
+         CTYPE          projection type
+         -----          ---------------
+        RA---TAN        gnomonic (tangent)
+        RA---SIN        radial distance proportional to sine of angle
+        RA---ARC        radial distance proportional to angle
+        RA---NCP        north celestial pole
+        RA---GBS        global sine (equal area)
+        RA---STG        stereographic
+        RA---AIT        Aitoff equal area
+        RA---MER        Mercator
+
+
+     To use the following sample program, extract into a file "ttt.x"
+and compile and link with:
+
+	xc -p tables ttt.x -lstxtools
+
+task    ttt
+
+include <imhdr.h>
+
+procedure ttt()
+
+pointer im, wcs
+double  phys[IM_MAXDIM]
+real    pix[IM_MAXDIM], opix[IM_MAXDIM]
+int     naxis, k
+char    input[SZ_FNAME]
+pointer immap()
+int     scan()
+
+begin
+        call clgstr ("input", input, SZ_FNAME)
+        im = immap (input, READ_ONLY, NULL)
+        naxis = IM_NDIM(im)
+        call xt_wcs_init (im, wcs)                      # initialize
+        call imunmap (im)
+
+        call printf ("naxis = %d\n")
+            call pargi (naxis)
+        call printf ("enter pixel coordinates\n")
+
+        while (scan() != EOF) {
+            do k = 1, naxis
+                call gargr (pix[k])
+            call xt_pix_wc (wcs, pix, phys, naxis)      # to world coords
+            call xt_wc_pix (wcs, phys, opix, naxis)     # to pixel coords
+            # Print the input pixel coordinates, the world coordinates,
+            # and the output pixel coordinates (which should be the same
+            # as the input).
+            do k = 1, naxis {
+                call printf ("%.3f  %18.10g  %.3f\n")
+                    call pargr (pix[k])
+                    call pargd (phys[k])
+                    call pargr (opix[k])
+            }
+        }
+        call xt_wcs_free (wcs)                          # free memory
+end
+
+
+
+# xt_wcs_init -- initialize wcs struct
+# This routine allocates space for a structure describing the world
+# coordinate system for an image, fills in the values or defaults, and
+# returns a pointer to that structure.
+
+call xt_wcs_init (im, wcs)
+
+pointer im                      # i: pointer to image descriptor
+pointer wcs                     # o: pointer to world coord system struct
+
+
+# xt_wcs_init_c -- initialize wcs struct
+# xt_wcs_init_c and xt_wcs_init_cd allocate space for a structure
+# describing the world coordinate system for an image, fill in the values
+# or defaults, and return a pointer to that structure.  They differ from
+# xt_wcs_init in that these take the coordinate parameters as arguments
+# rather than getting them from the image.
+# xt_wcs_init_c takes cdelt & crota, and xt_wcs_init_cd takes the CD matrix.
+
+call xt_wcs_init_c (crval, crpix, cdelt, crota, ctype, naxis, wcs)
+
+double  crval[naxis]            # i: coordinate values at reference pixel
+real    crpix[naxis]            # i: reference pixel
+real    cdelt[naxis]            # i: pixel spacing
+real    crota                   # i: rotation angle (if 2-D)
+char    ctype[SZ_CTYPE,naxis]   # i: e.g. "RA---TAN"
+int     naxis                   # i: size of arrays
+pointer wcs                     # o: pointer to world coord system struct
+
+
+call xt_wcs_init_cd (crval, crpix, cd, ctype, naxis, wcs)
+
+double  crval[naxis]            # i: coordinate values at reference pixel
+real    crpix[naxis]            # i: reference pixel
+real    cd[naxis,naxis]         # i: CD matrix
+char    ctype[SZ_CTYPE,naxis]   # i: e.g. "RA---TAN"
+int     naxis                   # i: size of arrays
+pointer wcs                     # o: pointer to world coord system struct
+
+
+# xt_wcs_free -- deallocate wcs struct
+# This routine deallocates space for a wcs structure.
+
+call xt_wcs_free (wcs)
+
+pointer wcs             # io: pointer to world coord system struct
+
+
+
+# xt_wc_pix -- wcs to pixels
+# This routine converts world coordinates to pixel coordinates.
+#
+# In the 1-D case, CRVAL is subtracted from the coordinate, the
+# result is divided by CDELT (same as CD1_1), and CRPIX is added.
+#
+# For 2-D or higher dimension, if two of the axes are like RA and Dec,
+# the input coordinates are converted to standard coordinates Xi
+# and Eta.  The (Xi, Eta) vector is then multiplied on the left by
+# the inverse of the CD matrix, and CRPIX is added.
+# The units for axes like Ra & Dec are degrees, not hours or radians.
+# For linear axes the conversion is the same as for 1-D.
+
+call xt_wc_pix (wcs, phys, pix, naxis)
+
+pointer wcs             # i: pointer to world coord system struct
+double  phys[naxis]     # i: physical (world) coordinates (e.g. degrees)
+real    pix[naxis]      # o: pixel coordinates
+int     naxis           # i: size of arrays
+
+
+
+# xt_pix_wc -- pixels to wcs
+# This routine converts pixel coordinates to world coordinates.
+#
+# In the 1-D case, CRPIX is subtracted from the pixel coordinate,
+# the result is multiplied by CDELT (same as CD1_1), and CRVAL is added.
+#
+# For 2-D or higher dimension, CRPIX is subtracted, and the result is
+# multiplied on the left by the CD matrix.  If two of the axes are like
+# RA and Dec, the pixel coordinates are converted to standard coordinates
+# Xi and Eta.  The (Xi, Eta) vector is then converted to differences
+# between RA and Dec and CRVAL, and then CRVAL is added to each coordinate.
+
+call xt_pix_wc (wcs, pix, phys, naxis)
+
+pointer wcs             # i: pointer to world coord system struct
+real    pix[naxis]      # i: pixel coordinates
+double  phys[naxis]     # o: physical (world) coordinates (e.g. degrees)
+int     naxis           # i: size of arrays
diff --git a/pkg/utilities/nttools/stxtools/errxit.x b/pkg/utilities/nttools/stxtools/errxit.x
new file mode 100644
index 00000000..45b5a7a3
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/errxit.x
@@ -0,0 +1,30 @@
+# ERRXIT -- Take an error exit and set the error code
+
+# This error exit routine is used on VMS system. The VMS symbol $status
+# will be set to the exit_code, so that the process running this program
+# will know the error condition that terminated the program. In order
+# to avoid conflict with other VMS exit codes, it would be best if the
+# exit_code is set to an odd value greater than one.
+#
+# Nelson Zarate		30-Nov-95	original
+# Perry Greenfield      18-Apr-95	change exit code from 122 to 2
+#					so that misleading DCL error message
+#					is not given (severity level remains
+#					the same: 2 --> ERROR). 122 results
+#					in a "DEVICE NOT MOUNTED" message.
+
+procedure errxit (exit_code)
+
+int	exit_code
+#--
+
+begin
+        # Reset the exit code to a constant value for this routine that 
+	# will be called on a VMS system. Other system will run the
+	# errxit.c that lives in tables$lib/stxtools/errxit.c to be inserted
+	# at compilation time by mkpkg.sf..
+	# NZ Nov 30 1995
+	exit_code = 2
+
+	call exit (exit_code)
+end
diff --git a/pkg/utilities/nttools/stxtools/fbuild.x b/pkg/utilities/nttools/stxtools/fbuild.x
new file mode 100644
index 00000000..1dcf6448
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/fbuild.x
@@ -0,0 +1,97 @@
+#---------------------------------------------------------------------------
+.help fbuild Nov93 source
+.ih
+NAME
+fbuild -- Build a file name based on components.
+.ih
+USAGE
+call fbuild (dir, root, ext, clindex, clsize, section, ksection,
+	     file, sz_file)
+.ih
+ARGUMENTS
+.ls dir (Input: char[ARB])
+The directory specification.  This may be blank.  If not, it should
+include the directory separator, i.e. a '$' or '/' at the end of the
+directory.
+.le
+.ls root (Input: char[ARB])
+The rootname specification.  This may be left blank.  No other
+punctuation besides what goes into a rootname is required.
+.le
+.ls ext (Input: char[ARB])
+The file extension specification.  This may be left blank.  If
+specified, the extension separater must be prepended, i.e. a period
+'.' must be the first character.
+.le
+.ls clindex (Input: int)
+The cl index or group number.  If zero, it will not be placed into the
+pathname.
+.le
+.ls clsize (Input: int)
+The cl size (or maximum group) number.  If zero, it will not be placed
+into the pathname.
+.le
+.ls section (Input: char[ARB])
+The section specification.  Must include the surrounding '[' and ']'
+section separators.
+.le
+.ls ksection (Input: char[ARB])
+The ksection specification.  Must include the surrounding '[' and ']'
+ksection separators.
+.le
+.ls file (Output: char[sz_file])
+The output pathname.
+.le
+.ls sz_file (Input: int)
+The maximum size of the output file specification.
+.le
+.ih
+DESCRIPTION
+fbuild builds a pathname based on individual components.  This
+complements the routine fparse.  For example, if a full pathname
+exists, a call to fparse followed by a call to fbuild should reproduce
+the pathname.
+.ih
+REFERENCES
+Jonathan Eisenhamer, STSDAS
+.ih
+SEE ALSO
+fparse
+.endhelp
+#---------------------------------------------------------------------------
+procedure fbuild (dir, root, ext, clindex, clsize, section, ksection,
+		  file, sz_file)
+
+char	dir[ARB]		# I:  Directory specification.
+char	root[ARB]		# I:  Rootname specification.
+char	ext[ARB]		# I:  Extension specification.
+int	clindex			# I:  Index number.
+int	clsize			# I:  Size number.
+char	section[ARB]		# I:  Section specification.
+char	ksection[ARB]		# I:  KSection specification.
+char	file[sz_file]		# O:  File name.
+int	sz_file			# I:  Maximum size of the file name.
+
+char Index[SZ_PATHNAME]		# The Group specification.
+
+begin
+		call strcpy (dir, file, sz_file)
+		call strcat (root, file, sz_file)
+		call strcat (ext, file, sz_file)
+		call strcpy ("", Index, SZ_PATHNAME)
+		if (clindex > 0)
+		    if (clsize > 0) {
+			call sprintf (Index, SZ_PATHNAME, "[%d/%d]")
+			call pargi (clindex)
+			call pargi (clsize)
+		    } else {
+			call sprintf (Index, SZ_PATHNAME, "[%d]")
+			call pargi (clindex)
+		    }
+		call strcat (Index, file, sz_file)
+		call strcat (section, file, sz_file)
+		call strcat (ksection, file, sz_file)
+end
+#---------------------------------------------------------------------------
+# End of fbuild
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/fparse.x b/pkg/utilities/nttools/stxtools/fparse.x
new file mode 100644
index 00000000..33dee6ff
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/fparse.x
@@ -0,0 +1,170 @@
+#---------------------------------------------------------------------------
+.help fparse Aug98 xtools
+.ih
+NAME
+fparse -- Parse a file name
+.ih
+USAGE
+call fparse (input, dir, dir_size, root, root_size, ext, ext_size,
+             cl_index, cl_size, section, section_size, ksection,
+             ksection_size)
+.ih
+ARGUMENTS
+.ls input (I: char[ARB])
+The input file name to parse into its components.
+.le
+.ls dir (O: char[dir_size])
+The directory component of the file name.  Includes the directory
+separator character.
+.le
+.ls dir_size (I: int)
+The maximum length of the string to place in the dir argument.
+.le
+.ls root (O: char[root_size])
+The root component of the file name.  Includes any wildcard characters
+specified for the root.
+.le
+.ls root_size (I: int)
+The maximum length of the string to place in the root argument.
+.le
+.ls ext (O: char[ext_size])
+The extension component of the file name.  DOES NOT INCLUDE the
+extension separator, i.e. the ".".
+.le
+.ls ext_size (I: int)
+The maximum length of the string to place in the ext argument.
+.le
+.ls cl_index (O: int)
+The cluster or group index found in the file name.  If none is found,
+this returns -1.  Before IRAF v2.11, returned 0.
+.le
+.ls cl_size (O: int)
+The number of clusters or groups found in the file name.  If none is
+found, this returns -1.  Before IRAF v2.11, returned 0.
+.le
+.ls section (O: char[section_size])
+The image section specification part of the file name.  Will contain
+the standard image section specifications.
+.le
+.ls section_size (I: int)
+The maximum length of the string to place in the section argument.
+.le
+.ls ksection (O: char[ksection_size])
+This is the "catchall".  If the filename cannot be parsed into the
+form "dir$root.ext[cl_index/cl_size][section]", ksection will contain
+the extra.
+.le
+.ih
+DESCRIPTION
+This routine basically performs the individual functions of fnldir,
+fnext, and fnroot, and the "illegal" imparse.  The only distinct
+advantage to this routine is that wildcard characters, and the
+relative directory characters ".", and ".." can be present in the file
+name.
+.ih
+BUGS
+This routine calls the illegal routine imparse.  If the image naming
+conventions in IMIO ever change, this routine will surely break all to
+pieces.
+.endhelp
+#---------------------------------------------------------------------------
+#
+# M.D. De La Pena - 11 August 1998: updated internal documentation for
+#   cl_index and cl_size to reflect changes made for IRAF v2.11.
+#
+procedure fparse (input, dir, dir_size, root, root_size, ext, ext_size,
+                  cl_index, cl_size, section, section_size, ksection,
+                  ksection_size)
+
+char    input[ARB]              # I:  Input pathname
+char    dir[dir_size]           # O:  Directory part of pathname.
+int     dir_size                # I:  Max size of dir.
+char    root[root_size]         # O:  Root part of pathname.
+int     root_size               # I:  Max size of root.
+char    ext[ext_size]           # O:  Extension part of pathname.
+int     ext_size                # I:  Max size of extension.
+int     cl_index                # O:  The cluster index.
+int     cl_size                 # O:  The cluster size.
+char    section[section_size]   # O:  The section part of pathname.
+int     section_size            # I:  Max size of section.
+char    ksection[ksection_size] # O:  The remainder of the pathname.
+int     ksection_size           # I:  Max size of ksection.
+
+# Declarations
+int     i                       # Generic.
+int     len_dir                 # Length of the directory spec.
+
+pointer cluster                 # Cluster.
+pointer last_period             # Pointer to the last period.
+pointer new_cluster             # Cluster without the directory spec.
+pointer ptr                     # Pointer into strings.
+pointer sp                      # Stack pointer.
+
+string  wildcards       "*?"
+
+# Function prototypes.
+int     fnldir(), stridxs()
+bool    streq()
+
+begin
+        
+        call smark(sp)
+        call salloc (cluster, SZ_LINE, TY_CHAR)
+        
+        # Parse the name with the (illegal) call imparse.
+        call imparse (input, Memc[cluster], SZ_LINE, ksection,
+                      ksection_size, section, section_size, cl_index,
+                      cl_size)
+
+        # Further parse the the cluster name into directory, root,
+        # and extension.
+        # Wildcards are a problem.  The above only deals with fully qualified
+        # pathnames, not templates.  But, it seems it could be done.  Scan
+        # the directory for wildcards and try to parse out a bit more.  The
+        # assumption made is that directories cannot be wildcarded.
+        root[1] = EOS
+        ext[1] = EOS
+        len_dir = fnldir (Memc[cluster], dir, dir_size)
+        i = stridxs (wildcards, dir)
+        if (i > 0) {
+            dir[i] = EOS
+            len_dir = fnldir (dir, dir, dir_size)
+        }
+
+        # Now there is just root and extension.  Check to see if root is just
+        # the relative directory names.  If so, append them to the directory
+        # specification.
+        new_cluster = cluster + len_dir
+        if (streq (Memc[new_cluster], ".") || streq (Memc[new_cluster], "..")) {
+            call strcat (Memc[new_cluster], dir, dir_size)
+            call strcat ("/", dir, dir_size)
+        }
+
+        # Else, find the extension.  This is just the last found "." in the
+        # specification.
+        else {
+            last_period = NULL
+            ptr = new_cluster
+            while (Memc[ptr] != EOS) {
+                if ( Memc[ptr] == '.')
+                    last_period = ptr
+                ptr = ptr + 1
+            }
+            if (last_period == NULL) {
+                call strcpy (Memc[new_cluster], root, root_size)
+                ext[1] = EOS
+            } else {
+                Memc[last_period] = EOS
+                call strcpy (Memc[new_cluster], root, root_size )
+                Memc[last_period] = '.'
+                call strcpy (Memc[last_period], ext, ext_size)
+            }
+        }
+
+        # That's all folks.
+        call sfree(sp)
+        
+end
+#---------------------------------------------------------------------------
+# End of fparse
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/grmimy.x b/pkg/utilities/nttools/stxtools/grmimy.x
new file mode 100644
index 00000000..bd30f93e
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/grmimy.x
@@ -0,0 +1,68 @@
+include <imhdr.h>
+
+#---------------------------------------------------------------------------
+.help grm_imcopy Oct92 source
+.ih
+NAME
+grm_imcopy -- Copy images given their image descriptors.
+.endhelp
+#---------------------------------------------------------------------------
+procedure grm_imcopy (in, out)
+
+pointer in                      # I:  Input image descriptor of image to copy.
+pointer out                     # I:  Output image descriptor of resultant image.
+
+# Declarations.
+long    v1[IM_MAXDIM], v2[IM_MAXDIM]    # Line and section counters.
+
+int     junk                            # Generic.
+int     npix                            # Length of a line of data.
+
+pointer buf1, buf2                      # Data buffers.
+
+# Function Prototypes.
+int	imgnls(), imgnll(), imgnlr(), imgnld(), imgnlx()
+int	impnls(), impnll(), impnlr(), impnld(), impnlx()
+
+begin
+        
+	# Setup start vector for sequential reads and writes.
+	call amovkl (long(1), v1, IM_MAXDIM)
+	call amovkl (long(1), v2, IM_MAXDIM)
+        
+	# Copy the image.
+	npix = IM_LEN(in, 1)
+	switch (IM_PIXTYPE(in)) {
+	case TY_SHORT:
+	    while (imgnls (in, buf1, v1) != EOF) {
+		junk = impnls (out, buf2, v2)
+		call amovs (Mems[buf1], Mems[buf2], npix)
+	    }
+	case TY_USHORT, TY_INT, TY_LONG:
+	    while (imgnll (in, buf1, v1) != EOF) {
+		junk = impnll (out, buf2, v2)
+		call amovl (Meml[buf1], Meml[buf2], npix)
+	    }
+	case TY_REAL:
+	    while (imgnlr (in, buf1, v1) != EOF) {
+		junk = impnlr (out, buf2, v2)
+		call amovr (Memr[buf1], Memr[buf2], npix)
+	    }
+	case TY_DOUBLE:
+	    while (imgnld (in, buf1, v1) != EOF) {
+		junk = impnld (out, buf2, v2)
+		call amovd (Memd[buf1], Memd[buf2], npix)
+	    }
+	case TY_COMPLEX:
+	    while (imgnlx (in, buf1, v1) != EOF) {
+	        junk = impnlx (out, buf2, v2)
+		call amovx (Memx[buf1], Memx[buf2], npix)
+	    }
+	default:
+	    call error (1, "unknown pixel datatype")
+	}
+        
+end
+#---------------------------------------------------------------------------
+# End of grm_imcopy
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/isblank.x b/pkg/utilities/nttools/stxtools/isblank.x
new file mode 100644
index 00000000..85edb9d7
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/isblank.x
@@ -0,0 +1,18 @@
+include	<ctype.h>
+
+# ISBLANK -- Return true if the string is entirely white space
+#
+# B.Simon	11-Nov-87	First Code
+
+bool procedure isblank (str)
+
+char	str[ARB]	# i: string to be tested
+int	ip
+
+begin
+	do ip = 1, ARB
+	    if (str[ip] == EOS)
+		return (true)
+	    else if (! IS_WHITE(str[ip]) )
+		return (false)
+end
diff --git a/pkg/utilities/nttools/stxtools/lubksb.f b/pkg/utilities/nttools/stxtools/lubksb.f
new file mode 100644
index 00000000..429cf2e4
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/lubksb.f
@@ -0,0 +1,50 @@
+	SUBROUTINE LUBKSB (A, N, NP, INDX, B)
+
+C Solves a matrix equation AX = B.  Before using this routine you must
+C call ludcmp to decompose the matrix A (in-place) into lower and upper
+C triangular portions.  The vector B is input to this routine, and the
+C answer X is returned in B.
+C
+C	real	a(np,np)	i: matrix returned by ludcmp
+C	int	n		i: logical size of a is n x n
+C	int	np		i: space allocated for a is np x np
+C	int	indx(n)		i: index returned by ludcmp
+C	real	b(n)		io: input b, output x in equation ax = b
+C
+C 1988 Oct 28  From Numerical Recipes
+
+	INTEGER N, NP
+	REAL	A(NP,NP)
+	INTEGER INDX(N)
+	REAL	B(N)
+
+	REAL	SUM
+	INTEGER II, LL, I, J
+
+	II = 0
+	DO 20 I = 1, N
+	    LL = INDX(I)
+	    SUM = B(LL)
+	    B(LL) = B(I)
+	    IF (II .NE. 0) THEN
+		DO 10 J = II, I-1
+		    SUM = SUM - A(I,J) * B(J)
+ 10		CONTINUE
+	    ELSE IF (SUM .NE. 0.) THEN
+		II = I
+	    ENDIF
+	    B(I) = SUM
+ 20	CONTINUE
+
+	DO 40 I = N, 1, -1
+	    SUM = B(I)
+	    IF (I .LT. N) THEN
+		DO 30 J = I+1, N
+		    SUM = SUM - A(I,J) * B(J)
+ 30		CONTINUE
+	    ENDIF
+	    B(I) = SUM / A(I,I)
+ 40	CONTINUE
+
+	RETURN
+	END
diff --git a/pkg/utilities/nttools/stxtools/lubksd.f b/pkg/utilities/nttools/stxtools/lubksd.f
new file mode 100644
index 00000000..04e17c6c
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/lubksd.f
@@ -0,0 +1,53 @@
+	SUBROUTINE LUBKSD (A, N, NP, INDX, B)
+
+C Double-precision version of LUBKSB.
+C
+C Solves a matrix equation AX = B.  Before using this routine you must
+C call ludcmd to decompose the matrix A (in-place) into lower and upper
+C triangular portions.  The vector B is input to this routine, and the
+C answer X is returned in B.
+C
+C	double	a(np,np)	i: matrix returned by ludcmp
+C	int	n		i: logical size of a is n x n
+C	int	np		i: space allocated for a is np x np
+C	int	indx(n)		i: index returned by ludcmp
+C	double	b(n)		io: input b, output x in equation ax = b
+C
+C 1988 Oct 28  From Numerical Recipes.
+C 1992 Sep 10  Rename from LUBKSB and convert to double precision.
+
+	INTEGER N, NP
+	DOUBLE PRECISION A(NP,NP)
+	INTEGER INDX(N)
+	DOUBLE PRECISION B(N)
+
+	DOUBLE PRECISION SUM
+	INTEGER II, LL, I, J
+
+	II = 0
+	DO 20 I = 1, N
+	    LL = INDX(I)
+	    SUM = B(LL)
+	    B(LL) = B(I)
+	    IF (II .NE. 0) THEN
+		DO 10 J = II, I-1
+		    SUM = SUM - A(I,J) * B(J)
+ 10		CONTINUE
+	    ELSE IF (SUM .NE. 0.) THEN
+		II = I
+	    ENDIF
+	    B(I) = SUM
+ 20	CONTINUE
+
+	DO 40 I = N, 1, -1
+	    SUM = B(I)
+	    IF (I .LT. N) THEN
+		DO 30 J = I+1, N
+		    SUM = SUM - A(I,J) * B(J)
+ 30		CONTINUE
+	    ENDIF
+	    B(I) = SUM / A(I,I)
+ 40	CONTINUE
+
+	RETURN
+	END
diff --git a/pkg/utilities/nttools/stxtools/ludcmd.x b/pkg/utilities/nttools/stxtools/ludcmd.x
new file mode 100644
index 00000000..708a9df9
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/ludcmd.x
@@ -0,0 +1,99 @@
+define	TINY	1.d-20
+
+# ludcmd -- lower-upper decomposition
+# Double-precision version of ludcmp from Numerical Recipes.
+# This differs from the Numerical Recipes version in the following ways:
+# (1) the calling sequence also includes an ISTAT parameter, (2) memory
+# is allocated instead of using the fixed array VV, and (3) double
+# precision is used.
+# This routine decomposes a matrix (in-place) into lower and upper
+# triangular portions.  Use lubksd to obtain a solution to A * X = B
+# or to compute the inverse of the matrix A.
+# If the matrix is singular, ISTAT is set to one.
+#
+# Phil Hodge, 28-Oct-1988  Subroutine copied from Numerical Recipes.
+# Phil Hodge, 10-Sep-1992  Convert to double precision and rename from ludcmp.
+
+procedure ludcmd (a, n, np, indx, d, istat)
+
+double	a[np,np]	# io: input a, output decomposed a
+int	n		# i: logical size of a is n x n
+int	np		# i: space allocated for a
+int	indx[n]		# o: index to be used by xt_lubksb
+double	d		# o: +1 or -1
+int	istat		# o: OK if no problem; 1 if matrix is singular
+#--
+pointer sp
+pointer vv		# scratch space
+double	aamax
+double	sum
+double	dum
+int	i, j, k
+int	imax
+
+begin
+	istat = OK				# initial value
+
+	call smark (sp)
+	call salloc (vv, n, TY_DOUBLE)
+
+	d = 1.d0
+	do i = 1, n {
+	    aamax = 0.d0
+	    do j = 1, n
+		if (abs(a[i,j]) > aamax)
+		    aamax = abs(a[i,j])
+	    if (aamax == 0.d0) {
+		istat = 1
+		return
+	    }
+	    Memd[vv+i-1] = 1.d0 / aamax
+	}
+	do j = 1, n {
+	    if (j > 1) {
+		do i = 1, j-1 {
+		    sum = a[i,j]
+		    if (i > 1) {
+			do k = 1, i-1
+			    sum = sum - a[i,k] * a[k,j]
+			a[i,j] = sum
+		    }
+		}
+	    }
+	    aamax = 0.d0
+	    do i = j, n {
+		sum = a[i,j]
+		if (j > 1) {
+		    do k = 1, j-1
+			sum = sum - a[i,k] * a[k,j]
+		    a[i,j] = sum
+		}
+		dum = Memd[vv+i-1] * abs[sum]
+		if (dum >= aamax) {
+		    imax = i
+		    aamax = dum
+		}
+	    }
+	    if (j != imax) {
+		do k = 1, n {
+		    dum = a[imax,k]
+		    a[imax,k] = a[j,k]
+		    a[j,k] = dum
+		}
+		d = -d
+		Memd[vv+imax-1] = Memd[vv+j-1]
+	    }
+	    indx[j] = imax
+	    if (j != n) {
+		if (a[j,j] == 0.d0)
+		    a[j,j] = TINY
+		dum = 1.d0 / a[j,j]
+		do i = j+1, n
+		    a[i,j] = a[i,j] * dum
+	    }
+	}
+	if (a[n,n] == 0.d0)
+	    a[n,n] = TINY
+
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/stxtools/ludcmp.x b/pkg/utilities/nttools/stxtools/ludcmp.x
new file mode 100644
index 00000000..cb2ce43d
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/ludcmp.x
@@ -0,0 +1,87 @@
+define	TINY	1.e-20
+
+# ludcmp -- lower-upper decomposition
+# This routine decomposes a matrix (in-place) into lower and upper
+# triangular portions.  This is the same as the Numerical Recipes version
+# except that memory is allocated instead of using the fixed array VV.
+#
+# Phil Hodge, 28-Oct-1988  Subroutine copied from Numerical Recipes.
+
+procedure ludcmp (a, n, np, indx, d)
+
+real	a[np,np]	# io: input a, output decomposed a
+int	n		# i: logical size of a is n x n
+int	np		# i: space allocated for a
+int	indx[n]		# o: index to be used by xt_lubksb
+real	d		# o: +1 or -1
+#--
+pointer sp
+pointer vv		# scratch space
+real	aamax
+real	sum
+real	dum
+int	i, j, k
+int	imax
+
+begin
+	call smark (sp)
+	call salloc (vv, n, TY_REAL)
+
+	d = 1.
+	do i = 1, n {
+	    aamax = 0.
+	    do j = 1, n
+		if (abs(a[i,j]) > aamax)
+		    aamax = abs(a[i,j])
+	    if (aamax == 0.)
+		call error (0, "singular matrix")
+	    Memr[vv+i-1] = 1. / aamax
+	}
+	do j = 1, n {
+	    if (j > 1) {
+		do i = 1, j-1 {
+		    sum = a[i,j]
+		    if (i > 1) {
+			do k = 1, i-1
+			    sum = sum - a[i,k] * a[k,j]
+			a[i,j] = sum
+		    }
+		}
+	    }
+	    aamax = 0.
+	    do i = j, n {
+		sum = a[i,j]
+		if (j > 1) {
+		    do k = 1, j-1
+			sum = sum - a[i,k] * a[k,j]
+		    a[i,j] = sum
+		}
+		dum = Memr[vv+i-1] * abs[sum]
+		if (dum >= aamax) {
+		    imax = i
+		    aamax = dum
+		}
+	    }
+	    if (j != imax) {
+		do k = 1, n {
+		    dum = a[imax,k]
+		    a[imax,k] = a[j,k]
+		    a[j,k] = dum
+		}
+		d = -d
+		Memr[vv+imax-1] = Memr[vv+j-1]
+	    }
+	    indx[j] = imax
+	    if (j != n) {
+		if (a[j,j] == 0.)
+		    a[j,j] = TINY
+		dum = 1. / a[j,j]
+		do i = j+1, n
+		    a[i,j] = a[i,j] * dum
+	    }
+	}
+	if (a[n,n] == 0.)
+	    a[n,n] = TINY
+
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/stxtools/mkpkg b/pkg/utilities/nttools/stxtools/mkpkg
new file mode 100644
index 00000000..218ad5f5
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/mkpkg
@@ -0,0 +1,54 @@
+# Update the xtools library.
+# Author: Phil Hodge, 16-NOV-1988
+# Modified to include similar.x : B.Simon 14-Mar-1989
+# Modified to include group template expansion routines : B.Simon 14-Feb-1990
+# Modified to include word.x and vex*.x : B.Simon 21-May-1990
+# Modified to include copyimg.x: B.Simon 02-Mar-1992
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+
+libpkg.a:
+	@od
+	@sp_util
+	@wcslab
+	changt.x	
+	checkdim.x	<imhdr.h>
+	cif.x		"cif.h"
+	clgnone.x
+	copyimg.x	<imhdr.h>
+	errxit.x
+	fbuild.x
+	fparse.x	
+	grmimy.x	<imhdr.h>
+	isblank.x	<ctype.h>
+	lubksb.f       		
+	lubksd.f
+	ludcmd.x
+	ludcmp.x       	
+	postexit.x	<clset.h>
+	savgol.x	
+	sbuf.x		"sbuf.h"
+	sgcone.x		
+	similar.x
+	strjust.x	<ctype.h>
+	stxgetcoord.x	<imhdr.h> <mwset.h> <math.h>
+	tpbreak.x	
+	tpclose.x	"template.h"
+	tpcount.x	"template.h"
+	tpfetch.x	"template.h"
+	tpgroup.x	<ctype.h>  <imio.h>
+	tpimtype.x	<ctype.h>  "template.h"
+	tpopen.x	"template.h"
+	tpparse.x	<imio.h>
+	vexcompile.x	<lexnum.h>  <ctype.h>  <fset.h>  "vex.h"  "vex.com" 
+	vexeval.x	"vex.h"
+	vexfree.x	"vex.h"
+	vexfunc.x	<mach.h>  "vex.h"
+	vexstack.x	"vex.h"
+	word.x
+	xtwcs.x        	<imhdr.h> <math.h> 
+	;
diff --git a/pkg/utilities/nttools/stxtools/od/mkpkg b/pkg/utilities/nttools/stxtools/od/mkpkg
new file mode 100644
index 00000000..a72fbad9
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/mkpkg
@@ -0,0 +1,15 @@
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+        odget.x         "od.h"
+        odmap.x         <error.h> <imhdr.h> <imio.h> <tbset.h> "od.h"
+        odopep.x        "od.h"
+        odpare.x
+        odput.x         "od.h"
+        odsetn.x        <imhdr.h> "od.h"
+        odunmp.x        "od.h"
+        odwcsn.x        <mwset.h> "od.h"
+        ;
diff --git a/pkg/utilities/nttools/stxtools/od/od.h b/pkg/utilities/nttools/stxtools/od/od.h
new file mode 100644
index 00000000..2070d551
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/od.h
@@ -0,0 +1,32 @@
+#---------------------------------------------------------------------------
+.help od.h Feb93 source
+.ih
+NAME
+od.h -- Include parameters for the 1D I/O data system.
+.endhelp
+#---------------------------------------------------------------------------
+#-----
+# Below describes the structure and access to the OD descriptor.
+define  OD_FD           Memi[$1]        # The image/table descriptor
+define  OD_TYPE         Memi[$1+1]      # TABLE/IMAGE flag.
+define  OD_CD_PTR       Memi[$1+2]      # Table column descriptor.
+define  OD_CD           Memi[OD_CD_PTR($1)+$2-1]
+define  OD_LEN          Memi[$1+3]      # Dimension of the data.
+define  OD_NGRP         Memi[$1+4]      # Number of groups in image.
+define  OD_GRP          Memi[$1+5]      # Current open group.
+define  OD_NAME_PTR     Memi[$1+6]      # Specified file name.
+define  OD_NAME         Memc[OD_NAME_PTR($1)]
+define  OD_MW           Memi[$1+7]      # MWCS descriptor.
+define  OD_WL           Memi[$1+8]      # World-to-Logical transformation.
+define  OD_LW           Memi[$1+9]      # Logical-to-World transformation.
+define  OD_WSYS_PTR     Memi[$1+10]     # WCS system type.
+define  OD_WSYS         Memc[OD_WSYS_PTR($1)]
+define  OD_OLD          Memi[$1+11]     # Template which opened this OD.
+define  OD_SZ_OD        12              # Size of structure.
+
+# The flag of what type of file we are dealing with.
+define  OD_TABLE         1
+define  OD_IMAGE         2
+#---------------------------------------------------------------------------
+# End of od.h
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/od/odget.x b/pkg/utilities/nttools/stxtools/od/odget.x
new file mode 100644
index 00000000..013acc67
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/odget.x
@@ -0,0 +1,56 @@
+include "od.h"
+
+#---------------------------------------------------------------------------
+.help od_get Feb93 source
+.ih
+NAME
+od_get -- Retrieve data from file.
+.ih
+USAGE
+.nf
+call od_getd (od, data)
+.fi
+.ih
+ARGUMENTS
+.ls od (pointer :input)
+The OD I/O descriptor.
+.le
+.ls data (double[ARB] :output)
+The data from the OD file.
+.le
+.endhelp
+#---------------------------------------------------------------------------
+procedure od_get (od, data)
+
+pointer od                      # I:  The OD I/O descriptor.
+double  data[ARB]               # O:  The data.
+
+pointer null                    # Null flag array for table IO.
+
+# Functions
+pointer imgl1d()
+
+errchk  gf_opengr, imgl1d, malloc, mfree, tbcgtd
+
+begin
+        # Check if a file is actually opened.  If not, do nothing.
+        if (od != NULL) {
+
+            # Get data depending on file type.
+            switch (OD_TYPE(od)) {
+            case OD_TABLE:
+                call malloc (null, OD_LEN(od), TY_BOOL)
+                call tbcgtd (OD_FD(od), OD_CD(od,OD_GRP(od)), data, Memb[null],
+                             1, OD_LEN(od))
+                call mfree (null, TY_BOOL)
+
+            case OD_IMAGE:
+
+                # Retrieve the data.
+                call amovd (Memd[imgl1d(OD_FD(od))], data, OD_LEN(od))
+            }
+        }
+end
+#---------------------------------------------------------------------------
+# End of od_get
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/od/odmap.x b/pkg/utilities/nttools/stxtools/od/odmap.x
new file mode 100644
index 00000000..f41ad5e1
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/odmap.x
@@ -0,0 +1,250 @@
+include <error.h>
+include <imhdr.h>
+include <imio.h>
+include <tbset.h>
+include "od.h"
+
+# Define the default column number to retrieve table data from
+define  DEFAULT_COL     1
+
+#---------------------------------------------------------------------------
+.help od_map Feb93 source
+.ih
+NAME
+.nf
+od_map          -- Open a file as either an image or table.
+
+od_image_map    -- Internal: Map an image.
+od_table_map    -- Internal: Map a table.
+.fi
+.ih
+USAGE
+.nf
+od = od_map (name, mode, old)
+
+call od_image_map (name, od)
+call od_table_map (name, mode, od)
+.fi
+.ih
+ARGUMENTS
+.ls name (char[ARB] :input)
+The name of the file to open.
+.le
+.ls mode (int :input)
+The access mode to open the file in.  Same as the standard IRAF open
+modes.
+.le
+.ls old (pointer :input)
+If creating a new file, use this as a template.  If NULL, no template will
+be assumed.  This is the OD descriptor, not an IMIO or TABLE descriptor.
+.le
+.ls od (pointer :input)
+The OD I/O descriptor.
+.le
+.ih
+RETURNS
+An od i/o file descriptor containing the image/table descriptor, a flag
+indicating whether it is an image or table, and, if a table, the column
+descriptor to retrieve the data from.
+.ih
+DESCRIPTION
+This provides a common interface to retrieve one dimensional data from
+either an image or a table.  This is vary basic and is not intended to
+handle a full i/o interface.  Just need to open, close, and read data.
+
+Added some syntax to the table name specification.  We will allow the
+column names/numbers to be specified in a "section" notation.  An
+example:
+
+.nf
+        tablename[columnname1,...]
+.fi
+
+where columnnameX are either names or numbers.  If no column
+specification is used, then it is assumed all columns of the table are
+to be used and will be considered with the appropriate "group" of
+multigroup input.
+.endhelp
+#---------------------------------------------------------------------------
+pointer procedure od_map(name, mode, old)
+
+char    name[ARB]               # I: The file name to open.
+int     mode                    # I:  The mode to open the file in.
+pointer old                     # I:  Template OD I/O descriptor as template.
+
+# Declarations.
+pointer od                      # OD I/O descriptor.
+pointer sp                      # Stack Pointer.
+pointer sx                      # Generic string.
+
+# Function prototypes
+pointer immap()
+
+errchk  malloc, od_image_map, od_table_map
+
+begin
+        call smark (sp)
+        call salloc (sx, SZ_LINE, TY_CHAR)
+
+        # Allocate the od i/o descriptor.
+        call malloc (od, OD_SZ_OD, TY_STRUCT)
+        call malloc (OD_NAME_PTR(od), SZ_LINE, TY_CHAR)
+        call malloc (OD_WSYS_PTR(od), SZ_LINE, TY_CHAR)
+
+        # If an old descriptor is given, base what open occurs on
+        # its type.
+        OD_OLD(od) = old
+        if (old != NULL)
+            switch (OD_TYPE(old)) {
+            case OD_IMAGE:
+                OD_FD(od) = immap (name, mode, OD_FD(old))
+                call od_image_map (name, od)
+            case OD_TABLE:
+                call od_table_map (name, mode, OD_FD(old), od)
+            }
+
+        # Else, just open up that data file.  If the image call doesn't fail,
+        # then assume its an image.
+        else ifnoerr (OD_FD(od) = immap (name, mode, NULL))
+            call od_image_map (name, od)
+
+        # If it cannot be opened as a table, try changing the extension.
+        # If that fails, then give it up.
+        else iferr (call od_table_map (name, mode, NULL, od)) {
+            call change_ext (name, "c1h", Memc[sx], SZ_LINE)
+            iferr (OD_FD(od) = immap (Memc[sx], mode, NULL)) {
+                call erract (EA_ERROR)
+            }
+            call od_image_map (Memc[sx], od)
+        }
+
+        # That's all folks.
+        call sfree (sp)
+        return (od)
+end
+#---------------------------------------------------------------------------
+# End of od_map
+#---------------------------------------------------------------------------
+procedure od_image_map (name, od)
+
+char    name[ARB]               # I:  Full specified name.
+pointer od                      # I:  OD I/O descriptor.
+
+# Declarations.
+int     i                       # Generic.
+
+pointer sp                      # Stack pointer.
+pointer sx
+
+begin
+        call smark (sp)
+        call salloc (sx, SZ_LINE, TY_CHAR)
+
+        # Fill the OD I/O descriptor.
+        OD_TYPE(od) = OD_IMAGE
+        OD_CD_PTR(od) = NULL
+        OD_LEN(od) = IM_LEN(OD_FD(od),1)
+        OD_NGRP(od) = max(1,IM_CLSIZE(OD_FD(od)))
+        call strcpy (IM_HDRFILE(OD_FD(od)), OD_NAME(od), SZ_LINE)
+
+        # See whether a specific group was opened.
+        call fparse (name, Memc[sx], SZ_LINE, Memc[sx], SZ_LINE, Memc[sx],
+                     SZ_LINE, OD_GRP(od), i, Memc[sx], SZ_LINE, Memc[sx],
+                     SZ_LINE)
+        if (OD_GRP(od) > 0)
+            OD_NGRP(od) = 1
+        else
+            OD_GRP(od) = 1
+
+        # Get world coordinate information.
+        call od_wcs_open (od)
+
+        # That's all folks.
+        call sfree (sp)
+end
+#---------------------------------------------------------------------------
+# End of od_image_map
+#---------------------------------------------------------------------------
+procedure od_table_map (name, mode, old, od)
+
+char    name[ARB]               # I:  The specified file name.
+int     mode                    # I:  The file access mode.
+pointer old                     # I:  Original OD descriptor.
+pointer od                      # I:  The OD I/O descriptor.
+
+# Declarations.
+int     i, j, k                 # Generic.
+int     ic                      # Pointer into section list.
+
+pointer colname                 # Current column name.
+pointer section                 # Section specification.
+pointer sp                      # Stack pointer.
+pointer sx                    # Generic.
+
+# Functions.
+int     ctoi(), strlen(), word_count(), word_fetch(), tbpsta()
+pointer tbcnum(), tbtopn()
+
+errchk  tbcnum, tbpsta, tbtopn, word_count, word_fetch
+
+begin
+        call smark (sp)
+        call salloc (colname, SZ_LINE, TY_CHAR)
+        call salloc (section, SZ_LINE, TY_CHAR)
+        call salloc (sx, SZ_LINE, TY_CHAR)
+
+        # Set what type of file.
+        OD_TYPE(od) = OD_TABLE
+
+        # Get the base filename and section.
+        call od_parse (name, OD_NAME(od), SZ_LINE, Memc[section], SZ_LINE)
+
+        # Open up and get some parameters.
+        OD_FD(od) = tbtopn (OD_NAME(od), mode, old)
+        OD_LEN(od) = tbpsta (OD_FD(od), TBL_NROWS)
+        OD_GRP(od) = 1
+        OD_MW(od) = NULL
+        OD_WL(od) = NULL
+        OD_LW(od) = NULL
+
+        # Now retrieve the columns.  If no columns are specified, then use
+        # all the columns.
+        if (strlen (Memc[section]) <= 0) {
+            OD_NGRP(od) = tbpsta (OD_FD(od), TBL_NCOLS)
+            call malloc (OD_CD_PTR(od), OD_NGRP(od), TY_POINTER)
+            do i = 1, OD_NGRP(od) {
+                OD_CD(od,i) = tbcnum (OD_FD(od), i)
+                if (OD_CD(od,i) == NULL) {
+                    call sprintf (Memc[sx], SZ_LINE, "Cannot open column %d in table %s")
+                    call pargi (i)
+                    call pargstr (OD_NAME(od))
+                    call error (1, Memc[sx])
+                }
+            }
+        } else {
+            OD_NGRP(od) = word_count (Memc[section])
+            call malloc (OD_CD_PTR(od), OD_NGRP(od), TY_POINTER)
+            i = 0
+            ic = 1
+            while (word_fetch (Memc[section], ic, Memc[colname], SZ_LINE) > 0) {
+                i = i + 1
+                k = 1
+                if (ctoi (Memc[colname], k, j) > 0)
+                    OD_CD(od,i) = tbcnum (OD_FD(od), j)
+                else
+                    call tbcfnd (OD_FD(od), Memc[colname], OD_CD(od,i), 1)
+            }
+            if (OD_CD(od,i) == NULL) {
+                call sprintf (Memc[sx], SZ_LINE, "Cannot open column %s in table %s")
+                call pargstr (Memc[colname])
+                call pargstr (OD_NAME(od))
+                call error (1, Memc[sx])
+            }
+        }
+        
+        # That's all folks.
+        call sfree (sp)
+end
+#---------------------------------------------------------------------------
+# End of od_table_map
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/od/odopep.x b/pkg/utilities/nttools/stxtools/od/odopep.x
new file mode 100644
index 00000000..cd757f93
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/odopep.x
@@ -0,0 +1,56 @@
+include "od.h"
+
+#---------------------------------------------------------------------------
+.help od_open_group 11Jul95 source
+.ih
+NAME
+od_open_group -- Open another "group" of the file
+.ih
+USAGE
+call od_open_group (od, group)
+.fi
+.ih
+ARGUMENTS
+.ls od (pointer :input)
+The OD I/O descriptor.
+.le
+.ls group (int :input)
+The "group" to open.  For tables, this means the column number to open.
+.le
+.endhelp
+#---------------------------------------------------------------------------
+procedure od_open_group (od, group)
+
+pointer od                      # I:  The 1D descriptor.
+int     group                   # I:  The group to open.
+
+# Misc.
+real    rx                      # Generic.
+
+errchk	gf_opengr, mw_close, od_wcs_open
+
+begin
+        switch (OD_TYPE(od)) {
+        case OD_TABLE:
+            if (group > OD_NGRP(od))
+                call error (1, "Attempt to open non-existant column")
+            OD_GRP(od) = group
+
+        case OD_IMAGE:
+            if (group > OD_NGRP(od))
+                call error (1, "Attempt to open non-existant group")
+
+            call mw_close (OD_MW(od))
+
+            if (OD_OLD(od) != NULL)
+                call gf_opengr (OD_FD(od), group, rx, rx, OD_FD(OD_OLD(od)))
+            else
+                call gf_opengr (OD_FD(od), group, rx, rx, NULL)
+            OD_GRP(od) = group
+
+            call od_wcs_open (od)
+        }       
+end
+#---------------------------------------------------------------------------
+# End of od_open_group
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/od/odpare.x b/pkg/utilities/nttools/stxtools/od/odpare.x
new file mode 100644
index 00000000..0bea6112
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/odpare.x
@@ -0,0 +1,84 @@
+#---------------------------------------------------------------------------
+.help od_parse Feb93 source
+.ih
+NAME
+od_parse -- Parse a section for column names.
+.ih
+USAGE
+call od_parse
+.ih
+ARGUMENTS
+.ih
+DESCRIPTION
+Taken from Bernie Simon's aspare without any modifications.
+.endhelp
+#---------------------------------------------------------------------------
+#* HISTORY *
+#* D.Ball	18-Apr-88	original
+#* B.Simon	06-Aug-92	removed code which deletes commas
+
+# OD_PARSE -- Parse a file name specification into file name and section fields
+#
+#	Syntax:		filename[section]
+#
+# The [ character must be escaped to be included in the filename.
+# This syntax is similar to the image section syntax in imio, but
+# is intended to extract variable names or numbers, column names, etc.
+# for the Astronomical Survival analysis suite of programs.
+# The section field is returned as a string with no leading or trailing 
+# brackets.
+
+procedure od_parse (filespec, file, sz_file, section, sz_section)
+
+char	filespec[ARB]		# i: full file specification
+char	file[sz_file]		# o: receives file name
+int	sz_file			# i: max chars in file name
+char	section[sz_section]	# o: receives section
+int	sz_section		# i: max chars in section name
+#--
+int	ch, ip, op, right
+
+int	strlen()
+
+begin
+	ip = 1
+	op = 1
+
+	# Extract file name.  The first (unescaped) [ marks the start of
+	# the section field.
+
+	for (ch=filespec[ip];  ch != EOS && ch != '[';  ch=filespec[ip]) {
+	    if (ch == '\\' && filespec[ip+1] == '[') {
+		file[op] = '\\'
+		op = op + 1
+		file[op] = '['
+		ip = ip + 1
+	    } else
+		file[op] = ch
+
+	    op = min (sz_file, op + 1)
+	    ip = ip + 1
+	}
+
+	file[op] = EOS
+	section[1]  = EOS
+
+	if (ch == EOS)
+	    return
+
+	# If we have a [...] field, copy the section string,
+	# removing the brackets, and any commas used as delimiters.
+
+	# Eliminate the leading "["
+	ip = ip + 1
+	call strcpy (filespec[ip], section, sz_section)
+
+	# Remove the trailing "]"
+	right = strlen (section)
+	if (section[right] == ']')
+	    section[right] = EOS
+
+end
+#---------------------------------------------------------------------------
+# End of od_parse
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/od/odput.x b/pkg/utilities/nttools/stxtools/od/odput.x
new file mode 100644
index 00000000..d02f59a5
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/odput.x
@@ -0,0 +1,50 @@
+include "od.h"
+
+#---------------------------------------------------------------------------
+.help od_put Feb93 source
+.ih
+NAME
+od_put -- Put the data in the file.
+.ih
+USAGE
+.nf
+call od_putd (od, data)
+.fi
+.ih
+ARGUMENTS
+.ls od (input: pointer)
+The OD I/O descriptor.
+.le
+.ls data (input: double[ARB])
+The data to put in the OD file.
+.le
+.endhelp
+#---------------------------------------------------------------------------
+procedure od_put (od, data)
+
+pointer od                      # I:  The OD I/O descriptor.
+double  data[ARB]               # I:  The data.
+
+# Functions
+pointer impl1d()
+
+errchk  impl1d, tbcptd
+
+begin
+        # Check if a file is actually opened.  If not, do nothing.
+        if (od != NULL) {
+
+            # Get data depending on file type.
+            switch (OD_TYPE(od)) {
+            case OD_TABLE:
+                call tbcptd (OD_FD(od), OD_CD(od,OD_GRP(od)), data,
+                             1, OD_LEN(od))
+
+            case OD_IMAGE:
+                call amovd (data, Memd[impl1d (OD_FD(od))], OD_LEN(od))
+            }
+        }
+end
+#---------------------------------------------------------------------------
+# End of od_put
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/od/odsetn.x b/pkg/utilities/nttools/stxtools/od/odsetn.x
new file mode 100644
index 00000000..3abf97f7
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/odsetn.x
@@ -0,0 +1,29 @@
+include <imhdr.h>
+include "od.h"
+
+#---------------------------------------------------------------------------
+.help od_set_len Jun93 source
+.ih
+NAME
+od_set_len -- Set the length of data.
+.ih
+DESCRIPTION
+This sets how much data is read/written from the OD file.  For images,
+the dimensionality is changed.	For tables, it just changes how much
+is read/written; nothing is physically changed about the table.
+.endhelp
+#---------------------------------------------------------------------------
+procedure od_set_len (od, len)
+
+pointer	od			# I: OD descriptor.
+int	len			# I: New length.
+
+begin
+	OD_LEN(od) = len
+	if (OD_TYPE(od) == OD_IMAGE) {
+	    IM_LEN(OD_FD(od),1) = len
+	}
+end
+#---------------------------------------------------------------------------
+# End of od_set_len
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/od/odunmp.x b/pkg/utilities/nttools/stxtools/od/odunmp.x
new file mode 100644
index 00000000..e776ecd7
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/odunmp.x
@@ -0,0 +1,44 @@
+include "od.h"
+
+#---------------------------------------------------------------------------
+.help od_unmap Feb93 source
+.ih
+NAME
+od_unmap -- Close the 1D image.
+.ih
+USAGE
+call od_unmap (od)
+.ih
+ARGUMENTS
+.ls od (input/output: pointer)
+The OD I/O descriptor.  On return, the value will be NULL.
+.le
+.endhelp
+#---------------------------------------------------------------------------
+procedure od_unmap (od)
+
+pointer od                     # I:  The OD I/O descriptor.
+
+errchk  tbtclo, imunmap, mfree
+
+begin
+        if (od != NULL) {
+            switch (OD_TYPE(od)) {
+            case OD_TABLE:
+                call tbtclo (OD_FD(od))
+                call mfree (OD_CD_PTR(od), TY_POINTER)
+            case OD_IMAGE:
+                call mw_ctfree (OD_WL(od))
+                call mw_ctfree (OD_LW(od))
+                call mw_close (OD_MW(od))
+                call imunmap (OD_FD(od))
+            }
+
+            call mfree (OD_WSYS_PTR(od), TY_CHAR)
+            call mfree (OD_NAME_PTR(od), TY_CHAR)
+            call mfree (od, TY_STRUCT)
+        }
+end
+#---------------------------------------------------------------------------
+# End of od_unmap
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/od/odwcsn.x b/pkg/utilities/nttools/stxtools/od/odwcsn.x
new file mode 100644
index 00000000..e79a4154
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/od/odwcsn.x
@@ -0,0 +1,39 @@
+include <mwset.h>
+include "od.h"
+
+#---------------------------------------------------------------------------
+.help od_wcs_open May93 source
+.ih
+NAME
+od_wcs_open -- Open the WCS information for an image.
+.endhelp
+#---------------------------------------------------------------------------
+procedure od_wcs_open (od)
+
+pointer od                      # I:  Image descriptor.
+
+pointer mw_openim()
+pointer mw_sctran()
+bool    streq()
+
+begin
+	if (OD_TYPE(od) == OD_IMAGE) {
+	    OD_MW(od) = mw_openim (OD_FD(od))
+	    call mw_gwattrs (OD_MW(od), 0, "system", OD_WSYS(od), SZ_LINE)
+	    if (streq ("multispec", OD_WSYS(od))) {
+		call mw_seti (OD_MW(od), MW_USEAXMAP, NO)
+		OD_WL(od) = mw_sctran (OD_MW(od), "multispec", "logical", 3b)
+		OD_LW(od) = mw_sctran (OD_MW(od), "logical", "multispec", 3b)
+	    } else {
+		OD_WL(od) = mw_sctran (OD_MW(od), "world", "logical", 1)
+		OD_LW(od) = mw_sctran (OD_MW(od), "logical", "world", 1)
+	    }
+	} else {
+	    OD_MW(od) = NULL
+	    OD_LW(od) = NULL
+	    OD_WL(od) = NULL
+	}
+end
+#---------------------------------------------------------------------------
+# End of od_wcs_open
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/postexit.x b/pkg/utilities/nttools/stxtools/postexit.x
new file mode 100644
index 00000000..ebad32f9
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/postexit.x
@@ -0,0 +1,52 @@
+include <clset.h>
+
+# POST_EXIT_HANDLER -- Post an error handler that exits with an error code
+
+# The standard behavior of an iraf program is to exit with an error code
+# of zero regardless of whether program execution is halted with an error.
+# This behavior complicates control of tasks by user scripts. To change this
+# behavor, this procedure posts an error handler that exits the program with
+# its error code set to the value passed to the error procedure. The exit
+# procedure is only called of the program terminates with a non-zero error
+# status and the program is being run at the host level. The latter 
+# restriction is in place because exiting a program running under the iraf
+# command language (cl) hangs the command language. Since error handlers
+# a run in the order that they are posted, this procedure should be called
+# after any other error handlers you may have in your program.
+#
+# Nelson Zarate		30-Nov-95	original
+
+procedure post_exit_handler ()
+
+#--
+extern 	exit_handler()
+int 	clstati()
+
+begin
+	# Only post the exit handler if the task is being run in host mode
+
+	if (clstati(CL_PRTYPE) == PR_HOST)
+	    call onerror(exit_handler)
+end
+
+# EXIT_HANDLER -- Error handler that exits the program, setting the error code
+
+procedure exit_handler (status)
+
+int	status		# i: program exit status
+#--
+
+begin
+	# Only take exit if error status is non-zero (not OK)
+
+	if (status != OK) {
+	    # Must clean up file i/o first
+	    # The OK flag flushes the buffers
+
+	    call fio_cleanup (OK)
+
+	    # Take the error exit with the specified status
+
+	    call errxit (status)
+	}
+end
diff --git a/pkg/utilities/nttools/stxtools/savgol.x b/pkg/utilities/nttools/stxtools/savgol.x
new file mode 100644
index 00000000..48958ede
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/savgol.x
@@ -0,0 +1,140 @@
+# Define some memory management.
+define	A		Memd[a+((($2)-1)*(m+1))+($1)-1]
+define	B		Memd[b+($1)-1]
+
+#---------------------------------------------------------------------------
+.help savgol Jun93 source
+.ih
+NAME
+savgol -- Create a kernel for Savitzky-Golay smoothing.
+.ih
+USAGE
+call savgol (c, np, nl, nr, ld, m)
+.ih
+ARGUMENTS
+.ls c (O: double[np])
+The smoothing kernel in "wrap-around" order.  See discussion for
+details.
+.le
+.ls np (I: int)
+The number of points allocated in the array represented by the "c"
+argument.
+.le
+.ls nl (I: int)
+Size of the kernel "to the left" of the central point.  See discussion
+for more details.
+.le
+.ls nr (I: int)
+Size of the kernel "to the right" of the central point. See discussion
+for more details.
+.le
+.ls ld (I: int)
+Order of the derivative desired.  Should be 0 for smoothing, higher
+for smoothed versions of the specified derivative.
+.le
+.ls m (I: int)
+Order of the smoothing polynomial.  Should be 0 or 1 for standard
+"boxcar" or "moving window" averaging.
+.le
+.ih
+DISCUSSION
+For an introduction to Savitzky-Golay filtering, see:
+
+.nf
+	Press, Teukolsky, Vetterling, & Falnnery, "Numeric Recipies:
+        The Art of Scientifitc Computing, Second Edition", Cambridge,
+	1992.
+.fi
+
+This routine returns the set of Savitzky-Golay smoothing coefficients
+given the size, order of smoothing polynomial, and derivative to
+return.  The coefficients are returned in "wrap-around" order.  Thus,
+if the smoothing coefficients are C[-nl]...C[0]...C[nr], they are
+returned in the array, c[i], as follows:
+
+.nf
+	c[1], c[2],  c[3], ..., c[nl+1],c[nl+2],...,c[np-1],c[np]
+
+	C[0], C[-1], C[-2],..., C[-nl], C[nr],  ...,C[2],   C[1]
+.fi
+
+A code fragment to transform the array c[i] to the orginal order,
+k[i], is: 
+
+.nf
+        do i = 1, nl+1 
+            k[i] = c[nl+2-i]
+        do i = 1, nr
+            k[nl+1+i] = c[np+1-i]
+.fi
+
+Array k[i], is now suitable for routines such as the IRAF VOPS routine
+acnvrd.
+.endhelp
+#---------------------------------------------------------------------------
+procedure savgol (c, np, nl, nr, ld, m)
+
+double	c[np]			# O:  The kernel.
+int	np			# I:  Size of the smoothing kernel.
+int	nl			# I:  Points to the left of center.
+int	nr			# I:  Points to the right of center.
+int	ld			# I:  Order of derivative to return.
+int	m			# I:  Order of the smoothing polynomial.
+
+int	imj, ipj, j, k, kk, mm, ix 
+double	d, fac, sum
+pointer	indx, a, b, sp
+int	shifti()
+
+begin
+	call smark (sp)
+	# Check input parameters.
+	if (np < nl+nr+1 || nl < 0 || nr < 0 || ld > m || nl+nr < m)
+	    call error (1, "savgol: invalid inputs")
+
+	# Allocate memory.
+	call salloc (indx, m+1, TY_INT)
+	call salloc (a, (m+1)**2, TY_DOUBLE)
+	call salloc (b, m+1, TY_DOUBLE)
+
+	# Do it.
+	ipj = shifti (m, 1)
+	do ipj = 0, shifti (m, 1) {
+	    if (ipj != 0)
+		sum = 0.d0
+	    else
+		sum = 1.d0
+	    do k = 1, nr
+		sum = sum + k**ipj
+	    do k = 1, nl
+		sum = sum + (-k)**ipj
+	    mm = min (ipj, 2*m-ipj)
+	    do imj = -mm, mm, 2
+		A(1+(ipj-imj)/2,1+(ipj+imj)/2) = sum
+	}
+	call ludcmd (Memd[a], m+1, m+1, Memi[indx], d, ix)
+	if (ix != OK)
+	    call error (1, "savgol: singular matrix")
+	do j = 1, m+1
+	    B(j) = 0.d0
+	B(ld+1) = 1.d0;
+	call lubksd (Memd[a], m+1, m+1, Memi[indx], Memd[b])
+	do kk = 1, np
+	    c[kk] = 0.d0
+	do k = -nl, nr {
+	    sum = B(1)
+	    fac = 1.d0
+	    do mm = 1, m {
+		fac = fac * k
+		sum = sum + B(mm+1) * fac
+	    }
+	    kk = mod (np - k, np) + 1
+	    c[kk] = sum
+	}
+
+	# That's all folks.
+	call sfree (sp)
+end
+#---------------------------------------------------------------------------
+# End of savgol
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sbuf.h b/pkg/utilities/nttools/stxtools/sbuf.h
new file mode 100644
index 00000000..cda82d9b
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sbuf.h
@@ -0,0 +1,15 @@
+#---------------------------------------------------------------------------
+.help sbuf.h Feb93 source
+.ih
+NAME
+sbuf.h -- Memory structure for long strings.
+.endhelp
+#---------------------------------------------------------------------------
+define  SB_LEN          Memi[$1]        # Current length of string.
+define  SB_MAXLEN       Memi[$1+1]      # Current maximum size of buffer.
+define  SB_PTR          Memi[$1+2]      # Pointer to the string array.
+define  SB_BUF          Memc[SB_PTR($1)+$2]
+define  SB_SZ_SB        3               # Size of memory structure.
+#---------------------------------------------------------------------------
+# End of sbuf.h
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sbuf.x b/pkg/utilities/nttools/stxtools/sbuf.x
new file mode 100644
index 00000000..a5bead52
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sbuf.x
@@ -0,0 +1,110 @@
+include "sbuf.h"
+
+#---------------------------------------------------------------------------
+.help sbuf Mar93 source
+.ih
+NAME
+.nf
+sb_open   -- Open an sbuf.
+sb_cat    -- Add a string to the end of sbuf.
+sb_close  -- Close an sbuf.
+sb_string -- Get the string to an sbuf.
+.fi
+.ih
+USAGE
+.nf
+sb = sb_open()
+call sb_cat (sb, str)
+call sb_close (sb)
+str_ptr = sb_string (sb)
+.fi
+.ih
+ARGUMENTS
+.ls sb (pointer :input/output)
+The string buffer descriptor.
+.le
+.ls str (char[ARB] :input)
+The string to append to the string buffer.
+.le
+.ls str_ptr (pointer :output)
+A pointer to a string array containing the contents of the string buffer.
+When done, the user is required to deallocate this memory using the call
+"call mfree (str_ptr, TY_CHAR)".
+.le
+.ih
+DISCUSSION
+This interface allows one to handle arbitrarily long strings without
+having to worry about the memory management.
+
+There may be other utility routines to add; feel free to do so.
+.endhelp
+#---------------------------------------------------------------------------
+pointer procedure sb_open
+
+pointer sb                      # The sbuf pointer
+
+errchk  malloc
+
+begin
+        call malloc (sb, SB_SZ_SB, TY_STRUCT)
+        call malloc (SB_PTR(sb), SZ_LINE, TY_CHAR)
+        SB_LEN(sb) = 0
+        SB_MAXLEN(sb) = SZ_LINE
+        
+        return (sb)
+end
+#---------------------------------------------------------------------------
+# End of sb_open
+#---------------------------------------------------------------------------
+procedure sb_close (sb)
+
+pointer sb                      # IO: The sbuf descriptor, NULL on exit.
+
+errchk  mfree
+
+begin
+	if (sb != NULL) {
+	    call mfree (SB_PTR(sb), TY_CHAR)
+	    call mfree (sb, TY_STRUCT)
+	}
+end
+#---------------------------------------------------------------------------
+# End of sb_close
+#---------------------------------------------------------------------------
+pointer procedure sb_string (sb)
+
+pointer sb                      # I:  The sbuf descriptor.
+
+pointer str                     # New string pointer.
+
+begin
+        call malloc (str, SB_LEN(sb), TY_CHAR)
+        call strcpy (SB_BUF(sb,0), Memc[str], SB_LEN(sb))
+
+        return (str)
+end
+#---------------------------------------------------------------------------
+# End of sb_string
+#---------------------------------------------------------------------------
+procedure sb_cat (sb, str)
+
+pointer sb                      # I: The sbuf descriptor.
+char    str[ARB]                # I:  The string to concatenate.
+
+int     i, strlen()             # Length of input string.
+
+errchk  realloc
+
+begin
+        i = strlen (str)
+        if (i + SB_LEN(sb) >= SB_MAXLEN(sb)) {
+            SB_MAXLEN(sb) = SB_MAXLEN(sb) + i + SZ_LINE
+            call realloc (SB_PTR(sb), SB_MAXLEN(sb), TY_CHAR)
+        }
+
+        call strcpy (str, SB_BUF(sb,SB_LEN(sb)), i)
+        SB_LEN(sb) = SB_LEN(sb) + i
+end
+#---------------------------------------------------------------------------
+# End of sb_cat
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sgcone.x b/pkg/utilities/nttools/stxtools/sgcone.x
new file mode 100644
index 00000000..074f4089
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sgcone.x
@@ -0,0 +1,94 @@
+#---------------------------------------------------------------------------
+.help sg_convolve Jun93 source
+.ih
+NAME
+sg_convolve -- Convolve an array using Savitzky-Golay filter.
+.ih
+USAGE
+call sg_convolve (size, order, in, out, n)
+.ih
+ARGUMENTS
+.ls size (I: int)
+The full size of the smoothing kernel.  If less than or equal to 1,
+then no convolving takes place.
+.le
+.ls order (I: int)
+The order of the smoothing polynomial.  For normal "boxcar" smoothing,
+this should be 0 or 1.  Greater values preserve higher order terms in the
+original data.  Larger sizes are needed for this to be effective.
+.le
+.ls in (I: double[n])
+The data array to be convolved.
+.le
+.ls out (O: double[n])
+The convolved array.  May be the same as the input array.
+.le
+.ih
+DESCRIPTION
+The routine, savgol, is used to calculate a Savitsky-Golay convolving
+kernel.  This kernel is then applied, using standard routines, to the
+input data.  See the routine savgol for more information.
+.ih
+SEE ALSO
+savgol
+.endhelp
+#---------------------------------------------------------------------------
+procedure sg_convolve (size, order, in, out, n)
+
+int     size                    # I:  The size of the filter.
+int     order                   # I:  The order to preserve while filtering.
+double  in[n]                   # I:  Data to be convolved.
+double  out[n]                  # O:  The convolved data.
+int     n                       # I:  Length of the arrays.
+
+# Kernel parameters.
+int     half                    # Half size of kernel.
+int     isize                   # Odd size of kernel.
+pointer k, kx                   # The kernel in real/double-wrap versions.
+
+# Misc.
+pointer adx                     # Generic double array.
+int     i                       # Generic.
+pointer sp                      # Stack pointer.
+
+begin
+        call smark (sp)
+
+        # Fix the kernel size to be odd.
+        half = size / 2
+        isize = half * 2 + 1
+
+        # Make sure there is something to convolve.  If not, just copy and
+        # run.
+        if (isize <= 1)
+            call amovd (in, out, n)
+        else {
+            call salloc (k, isize, TY_REAL)
+            call salloc (kx, isize, TY_DOUBLE)
+            call salloc (adx, n+isize, TY_DOUBLE)
+
+            # Compute the kernel.
+            call savgol (Memd[kx], isize, half, half, 0, order)
+            do i = 0, half
+                Memr[k+i] = Memd[kx+half-i]
+            do i = 0, half-1
+                Memr[k+half+i+1] = Memd[kx+isize -i-1]
+
+            # Put the data in the extended array and pad the ends as
+            # constants.
+            call amovd (in, Memd[adx+half], n)
+            do i = 1, half {
+                Memd[adx+half-i] = in[1]
+                Memd[adx+half+n+i-1] = in[n]
+            }
+
+            # Filter it.
+            call acnvrd (Memd[adx], out, n, Memr[k], isize)
+        }
+
+        # That's all folks.
+        call sfree (sp)
+end
+#---------------------------------------------------------------------------
+# End of sg_convolve
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/similar.x b/pkg/utilities/nttools/stxtools/similar.x
new file mode 100644
index 00000000..a7b1a644
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/similar.x
@@ -0,0 +1,127 @@
+define	SZ_STACK	25
+
+# SIMILAR -- Return a score base on the similarity between two strings
+
+# This procedure returns a number representing the similarity between 
+# two strings. The number is computed by finding the combined length of 
+# all the common substrings between the two strings, normalized to a value
+# between zero and one hundred.
+#
+# B.Simon	13-Mar-89	Original
+
+int procedure similar (str1, str2)
+
+char	str1[ARB]	# i: First string
+char	str2[ARB]	# i: Second string
+#--
+int	score, istack, len1, len2, maxch, ic, nc
+pointer	stack[4,SZ_STACK]
+pointer	sp, word1, word2, s1, s2
+pointer	start1, end1, start2, end2, newstart1, newend1, newstart2, newend2
+
+string	overflow  "Stack overflow in procedure similar"
+
+int	strlen()
+
+begin
+	# If either string is zero length, return zero as score
+
+	score = 0
+	len1 = strlen (str1)
+	len2 = strlen (str2)
+	if (len1 == 0 || len2 == 0)
+	    return (score)
+
+	# Compare the lower case version of the strings
+
+	call smark (sp)
+	call salloc (word1, len1, TY_CHAR)
+	call salloc (word2, len2, TY_CHAR)
+
+	call strcpy (str1, Memc[word1], len1)
+	call strlwr (Memc[word1])
+
+	call strcpy (str2, Memc[word2], len2)
+	call strlwr (Memc[word2])
+
+	# The first substrings to compare are the entire strings
+
+	istack = 1
+	stack[1,istack] = word1
+	stack[2,istack] = word1 + len1 - 1
+	stack[3,istack] = word2
+	stack[4,istack] = word2 + len2 - 1
+	
+	# While there are more substrings on the stack
+
+	while (istack > 0) {
+
+	    # Find the longest match between the substrings
+
+	    maxch = 0
+	    start1 = stack[1,istack]
+	    end1 = stack[2,istack]
+	    start2 = stack[3,istack]
+	    end2 = stack[4,istack]
+
+	    for (s1 = start1; s1 <= end1 - maxch; s1 = s1 + 1) {
+
+		nc = end1 - s1
+
+		for (s2 = start2; s2 <= end2 - maxch; s2 = s2 + 1) {
+
+		    if (Memc[s1] == Memc[s2]) {
+
+			# Compute the length of the match
+
+			for (ic = 1; 
+			     ic <= nc && Memc[s1+ic] == Memc[s2+ic]; 
+			     ic = ic + 1)
+			    ;
+
+			# If this is the longest match so far, save
+			# the length and start and end points
+
+			if (ic > maxch) {
+			   maxch = ic
+			   newstart1 = s1
+			   newstart2 = s2
+			   newend1 = s1 + ic - 1
+			   newend2 = s2 + ic - 1
+			}
+			s2 = s2 + ic - 1
+		    }
+		}
+	    }
+
+	    # Pop the stack and push the new substings on the stack
+
+	    istack = istack - 1
+	    if (maxch > 0) {
+		score = score + 2 * maxch
+
+		if (start1 != newstart1 && start2 != newstart2) {
+		    if (istack == SZ_STACK)
+			call error (1, overflow)
+		    istack = istack + 1
+		    stack[1,istack] = start1
+		    stack[2,istack] = newstart1 - 1
+		    stack[3,istack] = start2
+		    stack[4,istack] = newstart2 - 1
+		}
+
+		if (end1 != newend1 && end2 != newend2) {
+		    if (istack == SZ_STACK)
+			call error (1, overflow)
+		    istack = istack + 1
+		    stack[1,istack] = newend1 + 1
+		    stack[2,istack] = end1
+		    stack[3,istack] = newend2 + 1
+		    stack[4,istack] = end2
+		}
+	    }
+	}
+
+	call sfree (sp)
+	return (100 * score / (len1 + len2))
+end
diff --git a/pkg/utilities/nttools/stxtools/sp_util/mkpkg b/pkg/utilities/nttools/stxtools/sp_util/mkpkg
new file mode 100644
index 00000000..52a93adb
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/mkpkg
@@ -0,0 +1,16 @@
+# Make the wcslab package
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	spchag.x
+	spdise.x
+	spmapt.x	<gset.h>
+	sprote.x	<math.h>
+	spstry.x
+	sptras.x
+	spw2ld.x
+        spwcss.x        <ctype.h>
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spchag.x b/pkg/utilities/nttools/stxtools/sp_util/spchag.x
new file mode 100644
index 00000000..f6292a4e
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spchag.x
@@ -0,0 +1,64 @@
+# sp_change_string - Replace a string  with the indicated string.
+#
+# History
+#   1Apr91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_change_string( input, old, new, output, max )
+
+char input[ARB]   # I:  The input string.
+char old[ARB]     # I:  The string segment to be replaced.
+char new[ARB]     # I:  The string to replace the old with.
+char output[ARB]  # O:  The modified input string.
+int  max          # I:  The maximun length of the output string.
+
+# Declarations.
+int after         # Next character position after match.
+int first         # First character position of matched string.
+int ilen          # Length of input.
+int ip            # Pointer into input.
+int last          # Last character position of matched string.
+int old_len       # Length of old.
+int op            # Pointer into output.
+
+# Function declarations.
+int gstrcpy(), strlen(), gstrmatch()
+
+begin
+
+  # Initialize the string pointers.
+  ip = 1
+  op = 1
+  ilen = strlen( input )
+  old_len = strlen( old )
+
+  # Keep going until either the input string has been completely copied
+  # or the output string is full.
+  while( ip < ( ilen + 1 ) && op < ( max + 1 ) ) {
+
+    # Search for the old string.
+    after = gstrmatch( input[ip], old, first, last )
+
+    # If the string is not found, then copy the rest of the input to the
+    # output.
+    if( after == 0 ) {
+      call strcpy( input[ip], output[op], max - op + 1 )
+      ip = ilen + 1
+    }
+
+    # The old string is found, copy the input up to the old string
+    # and replace the old string.
+    else {
+      first = min( first - 1, max - op + 1 )
+      call sp_strncpy( input[ip], first, output[op] )
+      ip = ip + last
+      op = op + first
+      op = op + gstrcpy( new, output[op], max - op + 1 )
+    }
+
+  }
+
+end
+#---------------------------------------------------------------------------
+# End of sp_change_string
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spdise.x b/pkg/utilities/nttools/stxtools/sp_util/spdise.x
new file mode 100644
index 00000000..9985c790
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spdise.x
@@ -0,0 +1,44 @@
+# sp_distanced - Determine the distance between two points.
+#
+# History
+#   4Dec90 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+double procedure sp_distanced( x1, y1, x2, y2 )
+
+double x1, y1, x2, y2
+
+double a, b
+
+begin
+
+  a = x1 - x2
+  b = y1 - y2
+  return( sqrt( ( a * a ) + ( b * b ) ) )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_distanced
+#---------------------------------------------------------------------------
+# sp_distancer - Determine the distance between two points.
+#
+# History
+#   4Dec90 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+real procedure sp_distancer( x1, y1, x2, y2 )
+
+real x1, y1, x2, y2
+
+real a, b
+
+begin
+
+  a = x1 - x2
+  b = y1 - y2
+  return( sqrt( ( a * a ) + ( b * b ) ) )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_distancer
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spmapt.x b/pkg/utilities/nttools/stxtools/sp_util/spmapt.x
new file mode 100644
index 00000000..cef87fed
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spmapt.x
@@ -0,0 +1,94 @@
+include <gset.h>
+
+# Default viewport edges.
+define  EDGE1  0.1
+define  EDGE2  0.9
+define  EDGE3  0.12
+define  EDGE4  0.85
+
+#---------------------------------------------------------------------------
+.help sp_map_viewport Sep92 source
+.ih
+NAME
+sp_map_viewport -- set device viewport for contour plots.
+.endhelp
+#---------------------------------------------------------------------------
+
+procedure sp_map_viewport (gp, ncols, nlines, ux1, ux2, uy1, uy2, pre, perim)
+
+pointer gp                      # I:  pointer to graphics descriptor
+real    ncols, nlines           # I:  size of image area, after block reduction
+real    ux1, ux2, uy1, uy2      # I:  NDC coordinates of requested viewort
+bool    pre                     # I:  Preserve aspect ratio.
+bool    perim                   # I:  draw perimeter
+
+real  xcen, ycen, x, y
+real  aspect_ratio
+real  x1, x2, y1, y2, ext, xdis, ydis
+data    ext /0.0625/
+real  ggetr()
+
+begin
+        # Determine the standard window sizes.
+        if (!pre && !perim) {
+            x1 = 0.0;  x2 = 1.0
+            y1 = 0.0;  y2 = 1.0
+        } else {
+            x1 = EDGE1;  x2 = EDGE2
+            y1 = EDGE3;  y2 = EDGE4
+            
+        }
+        
+        # If any values were specified, then replace them here.
+        if( !IS_INDEFR( ux1 ) )
+            x1 = ux1
+        if( !IS_INDEFR( ux2 ) )
+            x2 = ux2
+        if( !IS_INDEFR( uy1 ) )
+            y1 = uy1
+        if( !IS_INDEFR( uy2 ) )
+            y2 = uy2
+        
+        xdis = x2 - x1
+        ydis = y2 - y1
+        xcen = ( x2 + x1 ) / 2.
+        ycen = ( y2 + y1 ) / 2.
+        
+        # So far, the viewport has been calculated so that equal numbers of
+        # image pixels map to equal distances in NDC space, regardless of 
+        # the aspect ratio of the device.  If preserving aspect ratio,
+        # modify viewport to correctly display the contour aspect.
+        if (pre) {
+            aspect_ratio = ggetr (gp, "ar")
+            if (aspect_ratio == 0.0) {
+                x = ggetr (gp, "xr")
+                y = ggetr (gp, "yr")
+                if ( x != 0.0 && y != 0.0)
+                    aspect_ratio = y / x
+                else
+                    aspect_ratio = 1.0
+            }
+            aspect_ratio = nlines / ncols / aspect_ratio
+            x = ydis / aspect_ratio
+            y = ydis
+            if ( x > xdis) {
+                y = aspect_ratio * xdis
+                x = xdis
+            }
+            xdis = x
+            ydis = y
+        }
+
+        # All set.
+        ux1 = xcen - (xdis / 2.0)
+        ux2 = xcen + (xdis / 2.0)
+        uy1 = ycen - (ydis / 2.0)
+        uy2 = ycen + (ydis / 2.0)
+        
+        call gsview (gp, ux1, ux2, uy1, uy2)
+        call gswind (gp, 1.0, ncols, 1.0, nlines)
+        
+end
+#---------------------------------------------------------------------------
+# End of sp_map_viewport
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/sprote.x b/pkg/utilities/nttools/stxtools/sp_util/sprote.x
new file mode 100644
index 00000000..c9baeb65
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/sprote.x
@@ -0,0 +1,49 @@
+include <math.h>
+
+# The dimensionality.
+define N_DIM 2
+
+# Define some memory management.
+define ONER Memr[$1+$2-1]
+
+# sp_rotate - Rotate a vector.
+#
+# History
+#    8Mar91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_rotate( x, y, npts, angle, nx, ny )
+
+real x[npts], y[npts]    # I:  The vectors to rotate.
+int  npts                # I:  The number of points in the vectors.
+real angle               # I:  The angle to rotate (radians).
+real nx[npts], ny[npts]  # O:  The translated vectors.
+
+# Declarations
+pointer center          # To specify the center.
+pointer mw              # MWCS structure.
+pointer sp              # Stack pointer.
+
+# Function prototypes.
+pointer mw_open(), mw_sctran()
+
+begin
+
+  # Suck some memory.
+  call smark( sp )
+  call salloc( center, N_DIM, TY_REAL )
+
+  mw = mw_open( NULL, N_DIM )
+  ONER(center,1) = 0.
+  ONER(center,2) = 0.
+  call mw_rotate( mw, -DEGTORAD( angle ), ONER(center,1), 3b )
+  call mw_v2tranr( mw_sctran( mw, "physical", "logical", 3b ),
+                  x, y, nx, ny, npts )
+
+  call mw_close( mw )
+  call sfree( sp )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_rotate
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spstry.x b/pkg/utilities/nttools/stxtools/sp_util/spstry.x
new file mode 100644
index 00000000..545b0b06
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spstry.x
@@ -0,0 +1,24 @@
+# sp_strncpy - Counted character copy.
+#
+# History
+#   1Apr91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_strncpy( input, n_chars, output )
+
+char input[ARB]   # I:  The input string to copy to the output.
+int  n_chars      # I:  The number of characters to copy.
+char output[ARB]  # O:  The output string.
+
+# Declarations.
+int i             # Index.
+
+begin
+
+  for( i = 1; i <= n_chars; i = i + 1 )
+    output[i] = input[i]
+
+end
+#---------------------------------------------------------------------------
+# End of sp_strncpy.
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/sptras.x b/pkg/utilities/nttools/stxtools/sp_util/sptras.x
new file mode 100644
index 00000000..f62e9ceb
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/sptras.x
@@ -0,0 +1,35 @@
+# Set the dimensionality
+define N_DIM 2
+
+# sp_trans - Translate the origin to a new center.
+#
+# History
+#   11Mar91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_trans( x, y, npts, center, nx, ny )
+
+real x[npts], y[npts]    # I:  The x, y vectors to translate.
+int  npts                # I:  The number of points in the vectors.
+real center[N_DIM]       # I:  The new coordinate center.
+real nx[npts], ny[npts]  # O:  The translated vectors.
+
+# Declarations
+pointer mw              # MWCS structure.
+
+# Function prototypes.
+pointer mw_open(), mw_sctran()
+
+begin
+
+  mw = mw_open( NULL, N_DIM )
+  call mw_shift( mw, center, 3b )
+  call mw_v2tranr( mw_sctran( mw, "physical", "logical", 3b ),
+                   x, y, nx, ny, npts )
+
+  call mw_close( mw )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_trans
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spw2ld.x b/pkg/utilities/nttools/stxtools/sp_util/spw2ld.x
new file mode 100644
index 00000000..a31ce22d
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spw2ld.x
@@ -0,0 +1,50 @@
+# sp_w2ld - Transform world coordinates to logical coordinates (double).
+#
+# History
+#   24Jun91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_w2ld( wlct, flip, wx, wy, lx, ly, npts )
+
+pointer wlct                # I:  The MWCS coordinate trans. descriptor.
+bool    flip                # I:  True if the axes are transposed.
+double  wx[npts], wy[npts]  # I: The world coordinates.
+double  lx[npts], ly[npts]  # O: The logical coordinates.
+int     npts                # I: The number of points to translate.
+
+begin
+
+  if( flip )
+    call mw_v2trand( wlct, wx, wy, ly, lx, npts )
+  else
+    call mw_v2trand( wlct, wx, wy, lx, ly, npts )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_w2ld
+#---------------------------------------------------------------------------
+# sp_l2wd - Transform logical coordinates to world coordinates (double).
+#
+# History
+#   24Jun91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_l2wd( lwct, flip, lx, ly, wx, wy, npts )
+
+pointer lwct                # I:  The MWCS coordinate trans. descriptor.
+bool    flip                # I:  True if the axes are transposed.
+double  lx[npts], ly[npts]  # I:  The logical coordinates.
+double  wx[npts], wy[npts]  # O:  The world coordinates.
+int     npts                # I:  The number of points to translate.
+
+begin
+
+  if( flip )
+    call mw_v2trand( lwct, ly, lx, wx, wy, npts )
+  else
+    call mw_v2trand( lwct, lx, ly, wx, wy, npts )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_l2wd
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spwcss.x b/pkg/utilities/nttools/stxtools/sp_util/spwcss.x
new file mode 100644
index 00000000..bb2feb49
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spwcss.x
@@ -0,0 +1,90 @@
+include <ctype.h>
+include	<imhdr.h>
+
+#---------------------------------------------------------------------------
+.help sp_wcsparams 3Aug95 source
+.ih
+NAME
+sp_wcsparams -- Read the WCS descriptor from the parameters.
+.ih
+DESCRIPTION
+This procedure returns the WCS descriptor created from task parameters
+and the logical space that will be graphed.
+.ih
+BUGS
+This only deals with two axes.
+.endhelp
+#---------------------------------------------------------------------------
+procedure sp_wcsparams( mw, log_x1, log_x2, log_y1, log_y2 )
+
+pointer mw              # O: The MWCS descriptor.
+real    log_x1, log_x2,
+        log_y1, log_y2  # O: The extent of the logical space to graph.
+
+# Declarations.
+pointer	b		# Buffer pointer.
+double	clgetd()	# Get double-valued parameter.
+real	clgetr()	# Get real-valued parameter.
+pointer	im		# Temporary image descriptor.
+pointer	immap()		# Open an image.
+pointer	impl2s()	# Put line in 2d image.
+pointer	imw		# Temporary MWCS descriptor.
+pointer	mw_newcopy()	# Copy MWCS descriptor.
+pointer	mw_openim()	# Get MWCS descriptor from image.
+char	s[SZ_LINE]	# Generic string.
+
+string	tmpimage ".SPWCSS"
+
+begin
+	# Since no one knows how mwcs really works, we cheat.
+	# Create an image and set the header keywords to what
+	# the parameters are.  Then use the image load to get the
+	# mwcs instead of trying to create it from scratch.
+
+	# Create an image.
+	iferr (call imdelete (tmpimage))
+	    ;
+	im = immap (tmpimage, NEW_IMAGE, 20000)
+	IM_NDIM(im) = 2
+	IM_LEN(im,1) = 1
+	IM_LEN(im,2) = 1
+	IM_PIXTYPE(im) = TY_SHORT
+
+	# Now populate the WCS-relevant keywords.
+	call clgstr ("ctype1", s, SZ_LINE)
+	call imastr (im, "ctype1", s)
+	call clgstr ("ctype2", s, SZ_LINE)
+	call imastr (im, "ctype2", s)
+	call imaddd (im, "crpix1", clgetd ("crpix1"))
+	call imaddd (im, "crpix2", clgetd ("crpix2"))
+	call imaddd (im, "crval1", clgetd ("crval1"))
+	call imaddd (im, "crval2", clgetd ("crval2"))
+	call imaddd (im, "cd1_1", clgetd ("cd1_1"))
+	call imaddd (im, "cd1_2", clgetd ("cd1_2"))
+	call imaddd (im, "cd2_1", clgetd ("cd2_1"))
+	call imaddd (im, "cd2_2", clgetd ("cd2_2"))
+
+	# Write a pixel, close and reopen the image.
+	b = impl2s (im, 1)
+	call imunmap (im)
+	im = immap (tmpimage, READ_ONLY, 0)
+
+	# Retrieve the MWCS descriptor.  Make a copy so we can close the
+	# temporary image.
+	imw = mw_openim (im)
+	mw = mw_newcopy (imw)
+
+	# Get the logical workspace.
+	log_x1 = clgetr ("log_x1")
+	log_x2 = clgetr ("log_x2")
+	log_y1 = clgetr ("log_y1")
+	log_y2 = clgetr ("log_y2")
+
+	# That's all folks.
+	call mw_close (imw)
+	call imunmap (im)
+	call imdelete (tmpimage)
+end
+#---------------------------------------------------------------------------
+# End of sp_wcsparams
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/strjust.x b/pkg/utilities/nttools/stxtools/strjust.x
new file mode 100644
index 00000000..5f50f080
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/strjust.x
@@ -0,0 +1,31 @@
+include	<ctype.h>
+
+# STRJUST -- Remove whitspace from a string and convert to lower case
+#
+# B.Simon	30-Jan-95	copied from synphot$strfix
+
+procedure strjust (str)
+
+char	str[ARB]	# u: string to convert
+#--
+int ic, jc
+
+begin
+	jc = 1
+	for (ic = 1; str[ic] != EOS; ic = ic + 1) {
+	    if (IS_WHITE(str[ic]))
+		next
+
+	    if (IS_UPPER(str[ic])) {
+		str[jc] = TO_LOWER(str[ic])
+
+	    } else if (jc < ic) {
+		str[jc] = str[ic]
+	    }
+
+	    jc = jc + 1
+	}
+
+	str[jc] = EOS
+end
+
diff --git a/pkg/utilities/nttools/stxtools/stxgetcoord.x b/pkg/utilities/nttools/stxtools/stxgetcoord.x
new file mode 100644
index 00000000..0fc9842c
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/stxgetcoord.x
@@ -0,0 +1,182 @@
+include	<imhdr.h>
+include <mwset.h>
+include	<math.h>
+
+define	SZ_PNAME	8
+
+# stx_getcoord -- get coordinate parameters
+# This procedure gets the coordinate parameters from an image.
+# The parameter values are gotten via mwcs, and the lterm is factored
+# into the wterm so that the parameters are relative to the actual image
+# section that was opened rather than to the "original" image.
+#
+# Phil Hodge,  5-Jan-1993  Copied from fourier$lib/loadct.x.
+# Phil Hodge,  2-Feb-1994  Errchk mwcs routines.
+
+procedure stx_getcoord (im, crpix, crval, cd, maxdim, ctype, maxch)
+
+pointer im			# i: pointer to imhdr struct for input image
+double	crpix[ARB]		# o: reference pixel
+double	crval[ARB]		# o: coordinates at reference pixel
+double	cd[maxdim,maxdim]	# o: derivatives of l & m with respect to x & y
+int	maxdim			# i: dimension of arrays (e.g. IM_MAXDIM)
+char	ctype[maxch,maxdim]	# o: coord. type of each axis (e.g. "RA---TAN")
+int	maxch			# i: size of ctype string (e.g. SZ_CTYPE)
+#--
+pointer mw
+
+double	o_crval[IM_MAXDIM]		# world coordinates at reference pixel
+double	o_crpix[IM_MAXDIM]		# not corrected for image section
+double	o_cd[IM_MAXDIM,IM_MAXDIM]	# wterm only (not corr. for section)
+
+double	n_crpix[IM_MAXDIM]		# corrected for image section
+double	n_cd[IM_MAXDIM,IM_MAXDIM]	# CD matrix corrected for section
+
+double	ltm[IM_MAXDIM,IM_MAXDIM]	# lterm matrix
+double	i_ltm[IM_MAXDIM,IM_MAXDIM]	# inverse of ltm
+double	ltv[IM_MAXDIM]			# lterm vector
+
+int	ndim				# dimension of image
+int	wcsdim				# dimension of mwcs coordinates
+pointer mw_openim()
+int	mw_stati()
+errchk	mw_openim, mw_stati, mw_gwtermd, mw_gltermd, mw_invertd, mw_close,
+	stx_extract
+
+begin
+	ndim = IM_NDIM(im)
+	if (ndim > maxdim)
+	    call error (1,
+		"stx_getcoord:  dimension of image is larger than array size")
+
+	mw = mw_openim (im)
+	wcsdim = mw_stati (mw, MW_NPHYSDIM)		# get mwcs dimension
+
+	# Get the wterm and the lterm.
+	call mw_gwtermd (mw, o_crpix, o_crval, o_cd, wcsdim)
+	call mw_gltermd (mw, ltm, ltv, wcsdim)
+
+	# Convert the wterm to be the values relative to the current
+	# image section.  (Comments & code copied from mwcs.)
+
+	# Output CRPIX = R' =  (LTM * R + LTV).
+	call mw_vmuld (ltm, o_crpix, n_crpix, wcsdim)
+	call aaddd (ltv, n_crpix, n_crpix, wcsdim)
+
+	# Output CD matrix = CD' =  (CD * inv(LTM)).
+	call mw_invertd (ltm, i_ltm, wcsdim)
+	call mw_mmuld (o_cd, i_ltm, n_cd, wcsdim)
+
+	# Extract the coordinate parameters, and get ctype.
+	call stx_extract (im, mw, n_crpix, o_crval, n_cd, wcsdim,
+		crpix, crval, cd, maxdim, ctype, maxch)
+
+	call mw_close (mw)
+
+	# Check for invalid CD matrix.
+	if (ndim == 1) {
+	    if (cd[1,1] == 0.d0) {
+		call eprintf ("warning:  pixel spacing = 0; reset to 1\n")
+		cd[1,1] = 1.d0
+	    }
+	} else if (ndim == 2) {
+	    if (cd[1,1] * cd[2,2] - cd[1,2] * cd[2,1] == 0.d0) {
+		call eprintf (
+		"warning:  CD matrix is singular; reset to identity matrix\n")
+		cd[1,1] = 1.d0
+		cd[2,1] = 0.d0
+		cd[1,2] = 0.d0
+		cd[2,2] = 1.d0
+	    }
+	}
+end
+
+# stx_extract -- extract coordinate parameters
+# This routine is needed to take care of the situation where the dimension
+# of the input image was reduced by taking an image section.  In that case,
+# the coordinate information gotten using mwcs has the dimension of the
+# original image, which results in two problems.  (1) We need to know which
+# axis of the original image maps to which axis of the image that we've
+# got.  (2) We have to dimension the CD matrix differently.  When MWCS
+# puts values into a 2-D array it is dimensioned wcsdim X wcsdim, but we
+# declared it maxdim X maxdim in the calling routine.  In this routine
+# we declare the input CD matrix to be wcsdim X wcsdim, while the output
+# CD matrix is maxdim X maxdim.
+
+procedure stx_extract (im, mw, n_crpix, n_crval, n_cd, wcsdim,
+		crpix, crval, cd, maxdim, ctype, maxch)
+
+pointer im			# i: pointer to imhdr struct for input image
+pointer mw			# i: mwcs pointer
+double	n_crpix[wcsdim]		# i: crpix
+double	n_crval[wcsdim]		# i: crval
+double	n_cd[wcsdim,wcsdim]	# i: CD matrix
+int	wcsdim			# i: dimension of wcs
+double	crpix[maxdim]		# o: crpix extracted from n_crpix
+double	crval[maxdim]		# o: crval extracted from n_crval
+double	cd[maxdim,maxdim]	# o: CD matrix extracted from n_cd
+int	maxdim			# i: dimension of arrays (e.g. IM_MAXDIM)
+char	ctype[maxch,maxdim]	# o: coord. type of each axis (e.g. "RA---TAN")
+int	maxch			# i: size of ctype string (e.g. SZ_CTYPE)
+#--
+char	keyword[SZ_PNAME]	# keyword for getting ctype
+int	ndim			# actual dimension of image
+int	axno[IM_MAXDIM]		# axis numbers
+int	axval[IM_MAXDIM]	# ignored
+int	ax[IM_MAXDIM]		# physical axis number for each logical axis
+int	i, j
+bool	ax_ok			# for checking that axis numbers were found
+int	imaccf()
+errchk	mw_gaxmap
+
+begin
+	ndim = IM_NDIM(im)
+
+	# Get the axis mapping.
+	call mw_gaxmap (mw, axno, axval, wcsdim)
+
+	# Find the image axis numbers corresponding to the mwcs numbers.
+	do i = 1, ndim				# initialize
+	    ax[i] = 0
+	do j = 1, wcsdim {
+	    do i = 1, ndim {
+		if (axno[j] == i) {
+		    ax[i] = j
+		    break
+		}
+	    }
+	}
+
+	# It's an error if any axis number was not found.
+	ax_ok = true				# initial value
+	do i = 1, ndim {
+	    if (ax[i] < 1)
+		ax_ok = false
+	}
+	if (!ax_ok) {
+#	    call error (1, "stx_extract:  mwcs axis mapping is messed up")
+# This is a temporary fix to prevent crashing on a vax.
+	    do i = 1, ndim
+		ax[i] = i
+	}
+
+	# Extract crpix, crval and the CD matrix.
+	# Note that we transpose the CD matrix because of different
+	# conventions regarding how a matrix is stored.
+	do i = 1, ndim {
+	    crpix[i] = n_crpix[ax[i]]
+	    crval[i] = n_crval[ax[i]]
+	    do j = 1, ndim
+		cd[i,j] = n_cd[ax[j],ax[i]]	# transpose
+	}
+
+	# Get ctype.
+	do i = 1, ndim {
+	    call sprintf (keyword, SZ_PNAME, "ctype%d")
+		call pargi (ax[i])			# physical axis number
+	    if (imaccf (im, keyword) == YES)
+		call imgstr (im, keyword, ctype[1,i], maxch)
+	    else
+		call strcpy ("PIXEL", ctype[1,i], maxch)
+	}
+end
diff --git a/pkg/utilities/nttools/stxtools/template.h b/pkg/utilities/nttools/stxtools/template.h
new file mode 100644
index 00000000..9df66f37
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/template.h
@@ -0,0 +1,21 @@
+# TEMPLATE.H -- Structure used to expand image names over groups
+
+define	LEN_TPSTRUCT	5
+
+define	TP_ROOTPTR	Memi[$1]	# Pointer to image root name
+define	TP_SECTPTR	Memi[$1+1]	# Pointer to image section
+define	TP_START	Memi[$1+2]	# First group
+define	TP_COUNT	Memi[$1+3]	# Total number of groups
+define	TP_INDEX	Memi[$1+4]	# Current group
+
+define	TP_ROOT		Memc[TP_ROOTPTR($1)]
+define	TP_SECT		Memc[TP_SECTPTR($1)]
+
+define	TP_EXT_LIST	"|stf|fxf|oif|plf|qpf|"
+
+define	TP_UNKNOWN	0
+define	TP_GEIS		1
+define	TP_FITS		2
+define	TP_IRAF		3
+define	TP_PIXLIST	4
+define	TP_QPOE		5
diff --git a/pkg/utilities/nttools/stxtools/tpbreak.x b/pkg/utilities/nttools/stxtools/tpbreak.x
new file mode 100644
index 00000000..be5aed1d
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/tpbreak.x
@@ -0,0 +1,80 @@
+# TP_BREAK -- Break an image name into bracket delimeted substrings
+#
+# B.Simon	02-Jun-89	Original
+
+procedure tp_break (imname, part, npart, maxch)
+
+char	imname[ARB]		# i: Image name
+char	part[maxch,ARB]		# o: Array of image name parts
+int	npart			# i: Maximum number of parts
+int	maxch			# i: Maximum length of part
+#--
+bool	inside
+char	ch
+int	ic, jc, ipart
+pointer	sp, errmsg
+
+string	syntax  "Syntax error in image name (%s)"
+
+begin
+	# Allocate memory for error message
+
+	call smark (sp)
+	call salloc (errmsg, SZ_LINE, TY_CHAR)
+
+	# Initialize output to null string
+
+	do ipart = 1, npart
+	    part[1,ipart] = EOS
+
+	# Break image name into bracket delimeted components
+	# The variable inside is used as a check that brackets are paired
+
+	jc = 1
+	ipart = 1
+	inside = false
+
+	for (ic = 1; ipart <= npart && imname[ic] != EOS; ic = ic + 1) {
+
+	    ch = imname[ic]
+	    if (ch == '\\') {
+		ic = ic + 1
+
+	    } else if (ch == '[') {
+		if (inside) {
+		    call sprintf (Memc[errmsg], SZ_LINE, syntax)
+		    call pargstr (imname)
+		    call error (1, Memc[errmsg])
+		}
+		part[jc,ipart] = EOS
+		ipart = ipart + 1
+		inside = true
+		jc = 1
+
+	    } else if (ch == ']') {
+		if (! inside) {
+		    call sprintf (Memc[errmsg], SZ_LINE, syntax)
+		    call pargstr (imname)
+		    call error (1, Memc[errmsg])
+		}
+		inside = false
+
+	    } else if (ipart > 1 && ! inside) {
+		call sprintf (Memc[errmsg], SZ_LINE, syntax)
+		call pargstr (imname)
+		call error (1, Memc[errmsg])
+	    }
+
+	    part[jc,ipart] = imname[ic]
+	    jc = jc + 1
+
+	    if (jc > maxch) {
+		call sprintf (Memc[errmsg], SZ_LINE, syntax)
+		call pargstr (imname)
+		call error (1, Memc[errmsg])
+	    }
+	}
+
+	part[jc,ipart] = EOS
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/stxtools/tpclose.x b/pkg/utilities/nttools/stxtools/tpclose.x
new file mode 100644
index 00000000..8afac19c
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/tpclose.x
@@ -0,0 +1,21 @@
+include	"template.h"
+
+# TP_CLOSE -- Close the group template expansion routines
+
+# Free the dynamic memory used to store the group template structure
+#
+# B.Simon	28-Feb-89	Original
+# B.Simon	21-Aug-91	Changed template structure
+
+procedure tp_close (ptr)
+
+pointer	ptr		# u: Pointer to list of file names
+#--
+errchk mfree
+
+begin
+	call mfree (TP_ROOTPTR(ptr), TY_CHAR)
+	call mfree (TP_SECTPTR(ptr), TY_CHAR)
+	call mfree (ptr, TY_STRUCT)
+	ptr = NULL
+end
diff --git a/pkg/utilities/nttools/stxtools/tpcount.x b/pkg/utilities/nttools/stxtools/tpcount.x
new file mode 100644
index 00000000..f233aa26
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/tpcount.x
@@ -0,0 +1,134 @@
+include "template.h"
+
+# TP_COUNT -- Count the number of groups in an image
+#
+# B.Simon	02-Oct-98	Original
+# B.Simon	26-Apr-99	Check value of NEXTEND before using
+
+int procedure tp_count (root)
+
+char	root[ARB]	# i: image name minus any sections
+#--
+int	imtype, count, lo, hi, mid
+pointer	sp, image, im
+
+int	imgeti(), imaccf(), tp_imtype(), tp_hasgroup()
+pointer	immap()
+
+begin
+	# If the image is not a geis or fits file it can only have one group
+
+	imtype = tp_imtype (root) 
+	if (imtype != TP_GEIS && imtype != TP_FITS)
+	    return (1)
+
+	# Open the image to read the number of groups or extensions
+	# as recorded in the appropriate header keyword
+
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+	call strcpy (root, Memc[image], SZ_FNAME)
+	call strcat ("[0]", Memc[image], SZ_FNAME)
+
+	iferr (im = immap (Memc[image], READ_ONLY, NULL)) {
+	    # If image can't be opened, report an error condition
+
+	    count = ERR
+
+	} else if (imtype == TP_GEIS) {
+	    # Number of groups is trustworthy, report it to user
+
+	    count = imgeti (im, "GCOUNT")
+	    call imunmap (im)
+
+	} else {
+	    # Number of extensions is not, it must be checked
+
+	    lo = 1
+	    hi = 0
+
+	    # Check number of extensions
+
+	    if (imaccf (im, "NEXTEND") == YES) {
+		mid = imgeti (im, "NEXTEND")
+
+		if (mid > 0) {
+		    if (tp_hasgroup (root, mid) == NO) {
+			hi = mid
+
+		    } else {
+			lo = mid
+			mid = mid + 1
+
+			if (tp_hasgroup (root, mid) == NO) {
+			    hi = mid
+			} else {
+			    lo = mid
+			}
+		    }
+		}
+	    }
+
+	    # Find bracket for number of extensions
+
+	    while (hi < lo) {
+		mid = 2 * lo
+
+		if (tp_hasgroup (root, mid) == NO) {
+		    hi = mid
+		} else {
+		    lo = mid
+		}
+	    }
+
+	    # Use binary search to find actual number of extensions
+
+	    while (hi - lo > 1) {
+		mid = (hi + lo) / 2
+
+		if (tp_hasgroup (root, mid) == NO) {
+		    hi = mid
+		} else {
+		    lo = mid
+		}
+	    }
+
+	    count = lo
+	    call imunmap (im)
+	}
+
+	call sfree (sp)
+	return (count)
+end
+
+# TP_HASGROUP -- Determine if group is preent in image
+
+int procedure tp_hasgroup (root, index)
+
+char	root[ARB]	# i: image name
+int	index		# i: index of group to check
+#--
+int	has
+pointer	sp, image, im
+
+pointer	immap()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[image], SZ_FNAME, "%s[%d]")
+	call pargstr (root)
+	call pargi (index)
+
+	iferr (im = immap (Memc[image], READ_ONLY, NULL)) {
+	    has = NO
+	} else {
+	    call imunmap (im)
+	    has = YES
+	}
+
+	call sfree (sp)
+	return (has)
+end
diff --git a/pkg/utilities/nttools/stxtools/tpfetch.x b/pkg/utilities/nttools/stxtools/tpfetch.x
new file mode 100644
index 00000000..885fd847
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/tpfetch.x
@@ -0,0 +1,43 @@
+include	"template.h"
+
+# TP_FETCH -- Fetch the next image name from the group image template
+#
+# Create the next file name from the structure created by tp_open. 
+# Return true if another group exists, false otherwise.
+#
+# B.Simon	28-Feb-89	Original
+# B.Simon	21-Aug-91	Changed template structure
+# B.Simon	24-Jul-98	Revised to handle unparsable sections
+
+bool procedure tp_fetch (ptr, file_name)
+
+pointer	ptr			# i: A pointer to a list of file names
+char	file_name[SZ_FNAME]	# o: The next file name in the list
+#--
+
+begin
+	if ((TP_INDEX(ptr) - TP_START(ptr)) + 1 > TP_COUNT(ptr))
+	    return (false)
+
+	if (TP_START(ptr) == ERR) {
+	    call sprintf (file_name, SZ_FNAME, "%s%s")
+	    call pargstr (TP_ROOT(ptr))
+	    call pargstr (TP_SECT(ptr))
+
+	} else if (TP_COUNT(ptr) > 1 && TP_INDEX(ptr) == TP_START(ptr)) {
+	    call sprintf (file_name, SZ_FNAME, "%s[%d/%d]%s")
+	    call pargstr (TP_ROOT(ptr))
+	    call pargi (TP_INDEX(ptr))
+	    call pargi (TP_COUNT(ptr))
+	    call pargstr (TP_SECT(ptr))
+
+	} else {
+	    call sprintf (file_name, SZ_FNAME, "%s[%d]%s")
+	    call pargstr (TP_ROOT(ptr))
+	    call pargi (TP_INDEX(ptr))
+	    call pargstr (TP_SECT(ptr))
+	}
+
+	TP_INDEX(ptr) = TP_INDEX(ptr) + 1
+	return (true)
+end
diff --git a/pkg/utilities/nttools/stxtools/tpgroup.x b/pkg/utilities/nttools/stxtools/tpgroup.x
new file mode 100644
index 00000000..1dac1895
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/tpgroup.x
@@ -0,0 +1,87 @@
+include	<ctype.h>
+include	<imio.h>
+
+# TP_GROUP -- Extract the group index and count from an image name 
+#
+# B.Simon	02-Jun-89	Original
+# B.Simon	10-Jul-98	Revised to ignore what it can't parse
+# B.Simon	02-Oct-98	added call to tp_count
+# B.Simon	26-Apr-99	set index to ERR if undefined
+
+procedure tp_group (root, gsect, def_count, index, count)
+
+char	root[ARB]	# i: Root section of image name
+char	gsect[ARB]	# i: Group section of image name
+int	def_count	# i: Default count if not specified
+int	index		# o: Starting group index
+int	count		# o: Group count
+#--
+bool	star
+int	ic, inum, num[2]
+
+int	tp_count()
+
+begin
+	inum = 0
+	num[1] = 0
+	num[2] = 0
+	star = false
+
+	# Extract the numeric fields from the group section
+	# Set a flag if a star was found
+
+	for (ic = 1; gsect[ic] != EOS; ic = ic + 1) {
+	    switch (gsect[ic]) {
+	    case ' ':
+		;
+	    case '[':
+		inum = 1
+	    case ']':
+		break
+	    case '*':
+		star = true
+		inum = inum - 1
+	    case '/':
+		inum = inum + 1
+	    default:
+		if (! star && IS_DIGIT(gsect[ic])) {
+		    if (inum > 2) {
+			inum = 2
+			break
+		    }
+		    num[inum] = 10 * num[inum] + TO_INTEG(gsect[ic])
+
+		} else {
+		    inum = 0
+		    star = false
+		    break
+		}
+	    }
+	}
+
+	# Set the output variables according to the number of fields found
+
+	switch (inum) {
+	case 0:
+	    index = ERR
+	    count = ERR
+	case 1:
+	    index = num[1]
+	    count = 1
+	case 2:
+	    index = num[1]
+	    count = max (1, num[2])
+	}
+
+	# Either use the default count or if the default is zero,
+	# Open the image and read the count from it
+
+	if (star) {
+	    if (def_count > 0) {
+		count = def_count
+
+	    } else {
+		count = tp_count (root)
+	    }
+	}
+end
diff --git a/pkg/utilities/nttools/stxtools/tpimtype.x b/pkg/utilities/nttools/stxtools/tpimtype.x
new file mode 100644
index 00000000..3ed7580f
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/tpimtype.x
@@ -0,0 +1,116 @@
+include <ctype.h>
+include "template.h"
+
+define	MAXEXT		25
+
+# TP_IMTYPE -- Determine image type from image extension
+#
+# B.Simon	02-Oct-98	Original
+
+int procedure tp_imtype (root)
+
+int	root[ARB]	# i: image extension
+#--
+int	loadext
+pointer	extlist[MAXEXT]
+pointer	extbuf
+
+data	loadext  / NO /
+
+int	nc, iext, imtype
+pointer	sp, ext
+
+int	fnextn(), strdic(), iki_validextn()
+
+begin
+	call smark (sp)
+	call salloc (ext, SZ_FNAME, TY_CHAR)
+
+	if (loadext == NO) {
+	    call tp_loadext (extlist, extbuf)
+	    loadext = YES
+	}
+
+	nc = fnextn (root, Memc[ext], SZ_FNAME)
+	iext = iki_validextn (0, Memc[ext])
+
+	if (iext == 0) {
+	    imtype = TP_UNKNOWN
+
+	} else {
+	    call strcpy (Memc[extlist[iext]], Memc[ext], SZ_FNAME)
+	    imtype = strdic (Memc[ext], Memc[ext], SZ_FNAME, TP_EXT_LIST)
+	}
+
+	call sfree (sp)
+	return (imtype)
+end
+
+# TP_LOADEXT -- Load list of image kernel names indexed by extension
+
+procedure tp_loadext (extlist, extbuf)
+
+pointer	extlist[MAXEXT]		# o: pointers to kernel names
+int	extbuf			# o: string buffer containing names
+#--
+int	fd, flags, taglen, iext, ic, jc, nc
+pointer	sp, line, jstr, kstr
+
+string	kernel_tag  "installed kernels "
+
+int	open(), strlen(), getline(), strncmp(), ctoi()
+
+begin
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	# Initialize the image kernel tables
+
+	call iki_init ()
+
+	# Call the kernel debug routine to dump the information
+	# about which kernels are associated with which indices
+
+	fd = open ("tp_spool", READ_WRITE, SPOOL_FILE)
+	call iki_debug ("Kernel Names", fd, flags)
+
+	# Search the file for the line containing the image kernel info
+
+	call seek (fd, BOF)
+	taglen = strlen (kernel_tag)
+
+	while (getline (fd, Memc[line]) != EOF) {
+	   if (strncmp (Memc[line], kernel_tag, taglen) != 0)
+	       next
+
+	    # Parse the line to extract the info
+
+	    call malloc (extbuf, strlen (Memc[line+taglen]), TY_CHAR)
+	    jstr = extbuf
+	    kstr = extbuf
+
+	    for (ic = taglen; Memc[line+ic] != EOS; ic = ic + 1) {
+		if (Memc[line+ic] == '=') {
+		    Memc[jstr] = EOS
+		    jstr = jstr + 1
+
+		    jc = 1
+		    nc = ctoi (Memc[line+ic+1], jc, iext)
+		    ic = ic + 1
+
+		    extlist[iext] = kstr
+		    kstr = jstr
+
+		} else if (! IS_WHITE (Memc[line+ic])) {
+		    Memc[jstr] = Memc[line+ic]
+		    jstr = jstr + 1
+		}
+	    }
+
+	    break
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
+ 
diff --git a/pkg/utilities/nttools/stxtools/tpopen.x b/pkg/utilities/nttools/stxtools/tpopen.x
new file mode 100644
index 00000000..d9b7a2af
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/tpopen.x
@@ -0,0 +1,38 @@
+include	"template.h"
+
+# TP_OPEN -- Expand a group image template into a list of image names.
+
+# Create an array of image names that contain the group specification. 
+# Return a pointer to the list of names and the total number of names.
+#
+# B.Simon	28-Feb-89	Original
+# B.Simon	23-Jun-89	Hint character added
+# B.Simon	21-Aug-91	Changed template structure
+
+pointer procedure tp_open (imname, def_count, count)
+
+char	imname[ARB]		# i: image template
+int	def_count		# i: default image name count
+int	count			# o: number of image names
+#--
+pointer	ptr
+
+errchk	tp_parse, malloc
+
+begin
+	# Allocate data structure
+
+	call malloc (ptr, LEN_TPSTRUCT, TY_STRUCT)
+	call malloc (TP_ROOTPTR(ptr), SZ_FNAME, TY_CHAR)
+	call malloc (TP_SECTPTR(ptr), SZ_FNAME, TY_CHAR)
+
+	# Parse the template into a root name, starting group number,
+	# and group count
+
+	call tp_parse (imname, def_count, TP_ROOT(ptr), TP_SECT(ptr),
+		       TP_START(ptr), TP_COUNT(ptr))
+
+	TP_INDEX(ptr) = TP_START(ptr)
+	count = TP_COUNT(ptr)
+	return(ptr)
+end             
diff --git a/pkg/utilities/nttools/stxtools/tpparse.x b/pkg/utilities/nttools/stxtools/tpparse.x
new file mode 100644
index 00000000..f261a763
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/tpparse.x
@@ -0,0 +1,108 @@
+include	<imio.h>
+
+define	NFIELD		4
+define	FIELD		Memc[($1)+($2-1)*(SZ_FNAME+1)]
+
+# TP_PARSE -- Parse an image name into its component parts
+#
+# Parse an image name to obtain the root name, the image section, the 
+# group index, and the group count. 
+#
+# B.Simon	28-Feb-89	Original
+# B.Simon	02-Jun-89	imparse replaced
+# B.Simon	16-Jul-98	Revised to flag unparsable sections
+# B.Simon	02-Oct-98	added call to tp_count
+# B.Simon	26-Apr-99	check for data in extension zero
+# B.Simon	06-May-99	set index to one for new files w/o sections
+# B.Simon	14-Jun-99	set count to one if section could not be parsed
+# B.Simon	20-Nov-00	get default extension with iki_access
+
+procedure tp_parse (imname, def_count, root, section, index, count)
+
+char	imname[ARB]		# i: image name
+int	def_count		# i: default group count
+char	root[ARB]		# o: root name
+char	section[ARB]		# o: image section
+int	index			# o: group index
+int 	count			# o: group count
+#--
+int	ifield, nc
+pointer	sp, image, root2, sect, ext
+
+int	access(), strlen(), fnextn(), envgets(), iki_access()
+int	tp_count(), tp_hasgroup()
+
+string	ambiguous  " Ambiguous image name, extension required"
+
+errchk	immap, imunmap
+
+begin
+	# Allocate dynamic memory for error string
+
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (root2, SZ_FNAME, TY_CHAR)
+	call salloc (sect, (SZ_FNAME+1)*NFIELD, TY_CHAR)
+	call salloc (ext, SZ_FNAME, TY_CHAR)
+
+	# Break the image name into its component parts and
+	# get the group index and count
+
+	call tp_break (imname, Memc[sect], NFIELD, SZ_FNAME)
+
+	call tp_group (FIELD(sect,1), FIELD(sect,2), def_count, index, count)
+
+	call strcpy (FIELD(sect,1), root, SZ_FNAME)
+	call strcpy (FIELD(sect,2), section, SZ_FNAME)
+
+	# Copy the remaining fields into the section
+
+	do ifield = 3, NFIELD
+	    call strcat (FIELD(sect,ifield), section, SZ_FNAME)
+
+	# Add default extension onto image if no extension given
+
+	nc = strlen (root)
+	if (root[nc] != '.' && fnextn (root, Memc[ext], SZ_FNAME) == 0) {
+	    # Determine the access mode from the default grou[ count
+
+	    if (def_count > 0) {
+		nc = envgets ("imtype", Memc[ext], SZ_FNAME)
+
+	    } else {
+		if (iki_access (root, Memc[root2], 
+				Memc[ext], READ_ONLY) == ERR)
+		    call error (1, ambiguous)
+	    }
+	    
+	    call strcat (".", root, SZ_FNAME)
+	    call strcat (Memc[ext], root, SZ_FNAME)
+	}
+
+	# Set index and count when the image does not contain a section
+
+	if (section[1] == EOS) {
+	    if (access (root, 0, 0) == NO) {
+		index = 1
+	    } else if (tp_hasgroup (root, 1) == YES) {
+		index = 1
+	    } else {
+		index = 0
+	    }
+	}
+
+	if (count != ERR) {
+	    count = max (count, 1)
+
+	} else if (index == ERR) {
+	    count = 1
+
+	} else if (def_count > 0) {
+	    count = def_count
+
+	} else {
+	    count = tp_count (root)
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/stxtools/vex.com b/pkg/utilities/nttools/stxtools/vex.com
new file mode 100644
index 00000000..d89b8788
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/vex.com
@@ -0,0 +1,11 @@
+# VEX.COM -- Global variables used by vex parsing routine
+
+pointer	line		# Buffer containing next line in expression
+pointer	ch		# Pointer to next character in expression
+int	ncode		# Length of code array
+int	maxcode		# Maximum length of code array
+pointer	code		# Pointer to next available code
+pointer	stack		# Pointer to stack structure
+
+common	/vex/  line, ch, ncode, maxcode, code, stack
+
diff --git a/pkg/utilities/nttools/stxtools/vex.h b/pkg/utilities/nttools/stxtools/vex.h
new file mode 100644
index 00000000..200d717c
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/vex.h
@@ -0,0 +1,107 @@
+# VEX.H -- Structures and constants used by vex
+
+# Strings
+
+define	FN1STR  "abs acos asin atan cos cosh cube double exp int log log10 \
+nint real sin sinh sqr sqrt tan tanh"
+
+define	FN2STR  "atan2 dim max min mod sign"
+
+# Characters
+
+define	BLANK		' '
+define	CMTCHAR		'#'
+define	DOLLAR		'$'
+define	DOT		'.'
+
+# Function codes
+
+define	FN1_ABS 	1
+define	FN1_ACOS 	2
+define	FN1_ASIN 	3
+define	FN1_ATAN 	4
+define	FN1_COS 	5
+define	FN1_COSH	6
+define	FN1_CUBE	7
+define	FN1_DOUBLE	8
+define	FN1_EXP 	9
+define	FN1_INT 	10
+define	FN1_LOG 	11
+define	FN1_LOG10	12
+define	FN1_NINT	13
+define	FN1_REAL	14
+define	FN1_SIN 	15
+define	FN1_SINH	16
+define	FN1_SQR 	17
+define	FN1_SQRT	18
+define	FN1_TAN 	19
+define	FN1_TANH	20
+
+define	FN2_ATAN2	1
+define	FN2_DIM 	2
+define	FN2_MAX 	3
+define	FN2_MIN 	4
+define	FN2_MOD 	5
+define	FN2_SIGN	6
+
+# These constants are taken from the output of xyacc run on vexcompile.y
+
+define	Y_WRONG		257
+define	Y_LPAR		258
+define	Y_RPAR		259
+define	Y_COMMA		260
+define	Y_VAR		261
+define	Y_INT		262
+define	Y_REAL		263
+define	Y_DOUBLE	264
+define	Y_FN1		265
+define	Y_FN2		266
+define	Y_IF		267
+define	Y_THEN		268
+define	Y_ELSE		269
+define	Y_DONE		270
+define	Y_OR		271
+define	Y_AND		272
+define	Y_NOT		273
+define	Y_EQ		274
+define	Y_NE		275
+define	Y_LT		276
+define	Y_GT		277
+define	Y_LE		278
+define	Y_GE		279
+define	Y_ADD		280
+define	Y_SUB		281
+define	Y_MUL		282
+define	Y_DIV		283
+define	Y_NEG		284
+define	Y_POW		285
+
+# Array lengths
+
+define	MAX_TOKEN	31
+define	MAX_STACK	64
+
+# Pseudocode structure
+
+define	SZ_VEXSTRUCT	2
+
+define	VEX_CODE	Memi[$1]	# pointer to code array
+define	VEX_STACK	Memi[$1+1]	# pointer to stack structure
+
+# Stack structure
+
+define	SZ_STKSTRUCT	6
+
+define	STK_TOP		Memi[$1]	# top of stack
+define	STK_HIGH	Memi[$1+1]	# high water mark in stack
+define	STK_LENVAL	Memi[$1+2]	# length of each value array
+define	STK_NULLARY	Memi[$1+3]	# pointer to array of null values
+define	STK_VALARY	Memi[$1+4]	# pointer to value stack
+define	STK_TYPARY	Memi[$1+5]	# pointer to type stack
+
+define	STK_NULL	Memb[STK_NULLARY($1)+$2]
+define	STK_VALUE	Memi[STK_VALARY($1)+$2]
+define	STK_TYPE	Memi[STK_TYPARY($1)+$2]
+
+define	TOP		-1		# Symbolic constant for top of stack
+
diff --git a/pkg/utilities/nttools/stxtools/vexcompile.x b/pkg/utilities/nttools/stxtools/vexcompile.x
new file mode 100644
index 00000000..c7054b2d
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/vexcompile.x
@@ -0,0 +1,973 @@
+include	<lexnum.h>
+include	<ctype.h>
+include <fset.h>
+include	"vex.h"
+
+#* HISTORY *
+#* B.Simon	??		original
+#  Phil Hodge	12-Jul-2005	Add 'int vex_gettok()' and declare 'debug'
+#				to be bool rather than int, in vex_compile.
+
+define	YYMAXDEPTH	64
+define	YYOPLEN		1
+define	yyparse		vex_parse
+
+# Tokens generated by xyacc have been moved to vex.h
+
+define	yyclearin	yychar = -1
+define	yyerrok		yyerrflag = 0
+define	YYMOVE		call amovi (Memi[$1], Memi[$2], YYOPLEN)
+define	YYERRCODE	256
+
+# line 148 "vexcompile.y"
+
+
+# VEX_COMPILE -- Compile an expression, producing pseudocode
+#
+# This procedure takes a string containing a fortran expression and produces
+# pseudocode that can be evaluated by vex_eval(). The pseudocode is stored in
+# structure adressed by the pointer returned as the function value. This 
+# structure is freed by calling vex_free(). If the string begins with an @ 
+# symbol, the rest of the string is treated as a the name of a file which
+# contains the expression. The expression can contain all the fortran 
+# operators, including logical and relational operators and supports all the
+# fortran intrinsic functions which can take real arguments. It also supports
+# conditional expressions of the form: if <expr> then <expr> else <expr>
+# Variables must follow the fortran rules, and may be up to 31 characters long.
+# All variables and constants are treated as real numbers. A variable may
+# contain non-alphanumeric characters if it is preceded by a dollar sign, in
+# which case all characters until the next blank are part of the variable name.
+#
+# B.Simon	21-May-90	Original
+# B.Simon	19-Apr-91	Revised to handle multiple types
+# B.Simon	31-Mar-94	Better syntax error message
+# B.Simon	15-Oct-98	Embed strings in pseudocode
+
+pointer procedure vex_compile (expr)
+
+char	expr[ARB]	# i: Expression to be parsed
+#--
+include	"vex.com"
+
+int	ic, fd, len
+bool	debug
+pointer	sp, pcode
+
+data	debug	/ false /
+
+int	open(), stropen(), strlen(), fstati(), yyparse()
+
+int	vex_gettok()
+extern	vex_gettok
+
+begin
+	# Open the expression as a file
+
+	for (ic = 1; IS_WHITE(expr[ic]); ic = ic + 1)
+	    ;
+
+	if (expr[ic] == '@') {
+	    fd = open (expr[ic+1], READ_ONLY, TEXT_FILE)
+	    len = fstati (fd, F_FILESIZE) + 1
+
+	} else {
+	    len = strlen (expr[ic]) + 1
+	    fd = stropen (expr[ic], len, READ_ONLY)
+	}
+
+	# Create pseudocode structure
+
+	call malloc (pcode, SZ_VEXSTRUCT, TY_STRUCT)
+
+	call malloc (VEX_CODE(pcode), 2 * len, TY_INT)
+	call stk_init (VEX_STACK(pcode))
+
+	# Initialize parsing common block
+
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	ch = line
+	Memc[line] = EOS
+
+	ncode = 0
+	maxcode = 2 * len
+	code = VEX_CODE(pcode)
+	stack = VEX_STACK(pcode)
+
+	# Parse expression to produce reverse polish code
+
+	if (yyparse (fd, debug, vex_gettok) == ERR) {
+	    call eprintf ("%s\n%*t^\n")
+	    call pargstr (Memc[line])
+	    call pargi (ch-line)
+
+	    call error (1, "Syntax error in expression")
+	}
+
+	# Clean up and return pseudocode structure
+
+	call stk_clear (VEX_STACK(pcode))
+
+	call close (fd)
+	call sfree (sp)
+	return (pcode)
+end
+
+# VEX_GETTOK -- Get the next token from the input
+
+int procedure vex_gettok (fd, value)
+
+int	fd		# i: File containing expression to be lexed
+pointer	value		# o: Address on parse stack to store token
+#--
+include	"vex.com"
+
+double	constant
+int	ic, jc, nc, type, index
+int	idftype[4], keytype[3], btype[9]
+pointer	sp, errmsg, token
+
+string  fn1tok	FN1STR
+string	fn2tok	FN2STR
+
+string	idftok	"indefi indefr indefd indef"
+data	idftype	/ Y_INT, Y_REAL, Y_DOUBLE, Y_REAL /
+
+string	keytok	"if then else"
+data	keytype	/ Y_IF, Y_THEN, Y_ELSE /
+
+string	btoken  ".or. .and. .eq. .ne. .lt. .gt. .le. .ge. .not."
+data	btype   / Y_OR, Y_AND, Y_EQ, Y_NE, Y_LT, Y_GT, Y_LE, Y_GE, Y_NOT /
+
+string	badsymb "Operator not recognized (%s)"
+
+int	getline(), lexnum(), ctod(), stridxs(), word_match()
+
+begin
+	# Allocate dynamic memory for strings
+
+	call smark (sp)
+	call salloc (errmsg, SZ_LINE, TY_CHAR)
+	call malloc (token, MAX_TOKEN, TY_CHAR)
+
+	# Skip over leading white space and comments
+
+	while (Memc[ch] <= BLANK || Memc[ch] == CMTCHAR) {
+
+	    # If all characters have been read from the current line 
+	    # or a comment character was found, get the next line
+
+	    if (Memc[ch] == EOS || Memc[ch] == CMTCHAR) {
+		ch = line
+		if (getline (fd, Memc[line]) == EOF) {
+		    Memc[ch] = EOS
+		    break
+		}
+	    } else {
+		ch = ch + 1
+	    }
+	}
+
+	# The token type is determined from the first character in the token
+
+	Memc[token] = EOS
+
+	# End of expression token
+
+	if (Memc[ch] == EOS) {
+	    type = Y_DONE
+
+	# Numeric constant is too difficult to parse,
+	# Pass the job to lexnum and ctod
+
+	} else if (IS_DIGIT(Memc[ch])) {
+
+	    ic = 1
+	    index = lexnum (Memc[ch], ic, nc)
+	    if (index != LEX_REAL) {
+		type = Y_INT
+	    } else if (nc > 8) {
+		type = Y_DOUBLE
+	    } else {
+		jc = stridxs ("dD", Memc[ch])
+		if (jc == 0 || jc > nc) {
+		    type = Y_REAL
+		} else {
+		    type = Y_DOUBLE
+		}
+	    }
+
+	    ic = 1
+	    nc = ctod (Memc[ch], ic, constant)
+	    nc = min (nc, MAX_TOKEN)
+
+	    call strcpy (Memc[ch], Memc[token], nc)
+	    ch = ch + ic - 1
+
+	# Token is alphanumeric. Determine what type of token
+
+	} else if (IS_ALPHA (Memc[ch])) {
+
+	    # Gather characters in token
+
+	    for (ic = 1; ic <= MAX_TOKEN; ic = ic + 1) {
+		if (Memc[ch] != '_' && ! IS_ALNUM(Memc[ch]))
+		    break
+
+		if (IS_UPPER(Memc[ch]))	
+		    Memc[token+ic-1] = TO_LOWER(Memc[ch])
+		else
+		    Memc[token+ic-1] = Memc[ch]
+		ch = ch + 1
+	    }
+	    Memc[token+ic-1] = EOS
+
+	    # Check to see if token is string "INDEF"
+
+	    index = word_match (Memc[token], idftok)
+
+	    if (index > 0) {
+		type = idftype[index]
+		call strupr (Memc[token])
+
+	    } else {
+
+		# Check to see if token is function or keyword name
+		# If not, add it as a new variable
+
+		index = word_match (Memc[token], fn1tok)
+		if (index > 0) {
+		    type = Y_FN1
+
+		} else {
+		    index = word_match (Memc[token], fn2tok)
+		    if (index > 0) {
+			type = Y_FN2
+
+		    } else {
+			index = word_match (Memc[token], keytok)
+			if (index > 0) {
+			    type = keytype[index]
+			    Memc[token] = EOS
+			} else {
+			    type = Y_VAR
+			}
+		    }
+		}
+	    }
+
+	# Tokens beginning with a dot are numbers or boolean operators
+
+	} else if (Memc[ch] == DOT) {
+
+	    if (IS_DIGIT (Memc[ch+1])) {
+		ic = 1
+		index = lexnum (Memc[ch], ic, nc)
+
+		if (index != LEX_REAL) {
+		    type = Y_INT
+		} else if (nc < 9) {
+		    type = Y_REAL
+		} else {
+		    type = Y_DOUBLE
+		}
+
+		ic = 1
+		nc = ctod (Memc[ch], ic, constant)
+		nc = min (nc, MAX_TOKEN)
+
+		call strcpy (Memc[ch], Memc[token], nc)
+		ch = ch + ic - 1
+
+	    } else {
+
+		# Gather characters in token
+
+		ch = ch + 1
+		Memc[token] = DOT
+		for (ic = 2; ic < MAX_TOKEN && Memc[ch] != DOT; ic = ic + 1) {
+		    if (Memc[ch] == EOS)
+			break
+		    if (IS_UPPER(Memc[ch]))	
+			Memc[token+ic-1] = TO_LOWER(Memc[ch])
+		    else
+			Memc[token+ic-1] = Memc[ch]
+		    ch = ch + 1
+		}
+
+		Memc[token+ic-1] = Memc[ch]
+		Memc[token+ic] = EOS
+		ch = ch + 1
+
+		index = word_match (Memc[token], btoken)
+		if (type > 0) {
+		    type = btype[index]
+		} else {
+		    call sprintf (Memc[errmsg], SZ_LINE, badsymb)
+		    call pargstr (Memc[token])
+		    call error (1, Memc[errmsg])
+		}
+	    }
+
+	# Characters preceded by a dollar sign are identifiers
+
+	} else if (Memc[ch] == DOLLAR) {
+
+	    ch = ch + 1
+	    for (ic = 1; ic <= MAX_TOKEN && Memc[ch] > BLANK; ic = ic + 1) {
+		if (IS_UPPER(Memc[ch]))	
+		    Memc[token+ic-1] = TO_LOWER(Memc[ch])
+		else
+		    Memc[token+ic-1] = Memc[ch]
+		ch = ch + 1
+	    }
+	    Memc[token+ic-1] = EOS
+
+	    type = Y_VAR
+
+	# Anything else is a symbol
+	
+	} else {
+	    switch (Memc[ch]) {
+	    case '*':
+		if (Memc[ch+1] != '*') {
+		    type = Y_MUL
+		} else {
+		    type = Y_POW
+		    ch = ch + 1
+		}
+	    case '/':
+		type = Y_DIV
+	    case '+':
+		type = Y_ADD
+	    case '-':
+		type = Y_SUB
+	    case '(':
+		type = Y_LPAR
+	    case ')':
+		type = Y_RPAR
+	    case ',':
+		type = Y_COMMA
+	    case '<':
+		if (Memc[ch+1] != '=') {
+		   type = Y_LT
+		} else {
+		   type = Y_LE
+		   ch = ch + 1
+		}
+	    case '>':
+		if (Memc[ch+1] != '=') {
+		   type = Y_GT
+		} else {
+		   type = Y_GE
+		   ch = ch + 1
+		}
+	    case '|':
+		if (Memc[ch+1] != '|') {
+		   type = Y_WRONG
+		} else {
+		   type = Y_OR
+		   ch = ch + 1
+		}
+	    case '&':
+		if (Memc[ch+1] != '&') {
+		   type = Y_WRONG
+		} else {
+		   type = Y_AND
+		   ch = ch + 1
+		}
+	    case '=':
+		if (Memc[ch+1] != '=') {
+		   type = Y_WRONG
+		} else {
+		   type = Y_EQ
+		   ch = ch + 1
+		}
+	    case '!':
+		if (Memc[ch+1] != '=') {
+		   type = Y_NOT
+		} else {
+		   type = Y_NE
+		   ch = ch + 1
+		}
+	    default:
+		Memc[ch+1] = EOS
+		call sprintf (Memc[errmsg], SZ_LINE, badsymb)
+		    call pargstr (Memc[ch])
+		call error (1, Memc[errmsg])
+	    }
+
+	    ch = ch + 1
+	}
+
+	# 
+	if (Memc[token] == EOS) {
+	    call mfree (token, TY_CHAR)
+	    token = NULL
+	}
+
+	Memi[value] = token
+	return (type)
+end
+
+# VEX_ADDCODE -- Add an instruction to the code array
+
+procedure vex_addcode (type)
+
+int	type		# i: Instruction type
+#--
+include	"vex.com"
+
+begin
+
+	if (ncode == maxcode)
+	    call error (1, "Expression too complex")
+	else {
+	    Memi[code] = type
+	    code = code + 1
+	    ncode = ncode + 1
+	}
+
+end
+
+# VEX_ADDSTR -- Embed a string constant in the pseudo-code
+
+procedure vex_addstr (token)
+
+pointer	token		# u: Pointer to token string
+#--
+include "vex.com"
+
+int	ic
+
+begin
+	if (token == NULL)
+	    call error (1, "Expression token missing")
+
+	if (Memc[token] == EOS)
+	    call error (1, "Expression token blank")
+
+	ic = 0
+	repeat {
+	    ic = ic + 1
+
+	    if (ncode == maxcode)
+		call error (1, "Expression too complex")
+	    else {
+		Memi[code] = Memc[token+ic-1]
+		code = code + 1
+		ncode = ncode + 1
+	    }
+
+	} until (Memc[token+ic-1] == EOS)
+
+	call mfree (token, TY_CHAR)
+end
+
+# VEX_GETSTR -- Retrieve a token string from the pseudocode array
+
+procedure vex_getstr (op, token, maxch)
+
+pointer	op		# u: Location of token string in pseudocode
+char	token[ARB]	# o: Token string
+int	maxch		# i: Maximum length of token
+#--
+int	ic
+
+begin
+	# The token begins one position after op and is 
+	# termminated by an EOS
+
+	ic = 0
+	repeat {
+	    ic = ic + 1
+	    op = op + 1
+	    if (ic <= maxch)
+		token[ic] = Memi[op]
+
+	} until (Memi[op] == EOS)
+
+end
+define	YYNPROD		27
+define	YYLAST		264
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Parser for yacc output, translated to the IRAF SPP language.  The contents
+# of this file form the bulk of the source of the parser produced by Yacc.
+# Yacc recognizes several macros in the yaccpar input source and replaces
+# them as follows:
+#	A	user suppled "global" definitions and declarations
+# 	B	parser tables
+# 	C	user supplied actions (reductions)
+# The remainder of the yaccpar code is not changed.
+
+define	yystack_	10		# statement labels for gotos
+define	yynewstate_	20
+define	yydefault_	30
+define	yyerrlab_	40
+define	yyabort_	50
+
+define	YYFLAG		(-1000)		# defs used in user actions
+define	YYERROR		goto yyerrlab_
+define	YYACCEPT	return (OK)
+define	YYABORT		return (ERR)
+
+
+# YYPARSE -- Parse the input stream, returning OK if the source is
+# syntactically acceptable (i.e., if compilation is successful),
+# otherwise ERR.  The parameters YYMAXDEPTH and YYOPLEN must be
+# supplied by the caller in the %{ ... %} section of the Yacc source.
+# The token value stack is a dynamically allocated array of operand
+# structures, with the length and makeup of the operand structure being
+# application dependent.
+
+int procedure yyparse (fd, yydebug, yylex)
+
+int	fd			# stream to be parsed
+bool	yydebug			# print debugging information?
+int	yylex()			# user-supplied lexical input function
+extern	yylex()
+
+short	yys[YYMAXDEPTH]		# parser stack -- stacks tokens
+pointer	yyv			# pointer to token value stack
+pointer	yyval			# value returned by action
+pointer	yylval			# value of token
+int	yyps			# token stack pointer
+pointer	yypv			# value stack pointer
+int	yychar			# current input token number
+int	yyerrflag		# error recovery flag
+int	yynerrs			# number of errors
+
+short	yyj, yym		# internal variables
+pointer	yysp, yypvt
+short	yystate, yyn
+int	yyxi, i
+errchk	salloc, yylex
+
+
+
+short	yyexca[70]
+data	(yyexca(i),i=  1,  8)	/  -1,   1,   0,  -1,  -2,   0,  -1,  41/
+data	(yyexca(i),i=  9, 16)	/ 276,   0, 277,   0, 278,   0, 279,   0/
+data	(yyexca(i),i= 17, 24)	/  -2,  18,  -1,  42, 276,   0, 277,   0/
+data	(yyexca(i),i= 25, 32)	/ 278,   0, 279,   0,  -2,  19,  -1,  43/
+data	(yyexca(i),i= 33, 40)	/ 276,   0, 277,   0, 278,   0, 279,   0/
+data	(yyexca(i),i= 41, 48)	/  -2,  20,  -1,  44, 276,   0, 277,   0/
+data	(yyexca(i),i= 49, 56)	/ 278,   0, 279,   0,  -2,  21,  -1,  45/
+data	(yyexca(i),i= 57, 64)	/ 274,   0, 275,   0,  -2,  22,  -1,  46/
+data	(yyexca(i),i= 65, 70)	/ 274,   0, 275,   0,  -2,  23/
+short	yyact[264]
+data	(yyact(i),i=  1,  8)	/  58,  22,  23,  24,  25,  20,  21,  18/
+data	(yyact(i),i=  9, 16)	/  19,  17,  17,  31,  29,  28,  15,  26/
+data	(yyact(i),i= 17, 24)	/  27,  22,  23,  24,  25,  20,  21,  18/
+data	(yyact(i),i= 25, 32)	/  19,  55,  17,  29,  28,  30,  26,  27/
+data	(yyact(i),i= 33, 40)	/  22,  23,  24,  25,  20,  21,  18,  19/
+data	(yyact(i),i= 41, 48)	/  54,  17,  20,  21,  18,  19,   1,  17/
+data	(yyact(i),i= 49, 56)	/   0,   0,   0,  29,  28,   0,  26,  27/
+data	(yyact(i),i= 57, 64)	/  22,  23,  24,  25,  20,  21,  18,  19/
+data	(yyact(i),i= 65, 72)	/  53,  17,  18,  19,   0,  17,   0,   0/
+data	(yyact(i),i= 73, 80)	/   0,   0,   2,   0,  29,  28,   0,  26/
+data	(yyact(i),i= 81, 88)	/  27,  22,  23,  24,  25,  20,  21,  18/
+data	(yyact(i),i= 89, 96)	/  19,  51,  17,   0,   0,   0,   0,   0/
+data	(yyact(i),i= 97,104)	/   0,   0,   0,   0,   0,  29,  28,   0/
+data	(yyact(i),i=105,112)	/  26,  27,  22,  23,  24,  25,  20,  21/
+data	(yyact(i),i=113,120)	/  18,  19,  35,  17,   0,  29,  28,   0/
+data	(yyact(i),i=121,128)	/  26,  27,  22,  23,  24,  25,  20,  21/
+data	(yyact(i),i=129,136)	/  18,  19,  57,  17,  29,  28,   0,  26/
+data	(yyact(i),i=137,144)	/  27,  22,  23,  24,  25,  20,  21,  18/
+data	(yyact(i),i=145,152)	/  19,  28,  17,  26,  27,  22,  23,  24/
+data	(yyact(i),i=153,160)	/  25,  20,  21,  18,  19,   0,  17,  26/
+data	(yyact(i),i=161,168)	/  27,  22,  23,  24,  25,  20,  21,  18/
+data	(yyact(i),i=169,176)	/  19,   3,  17,  14,   0,   0,   6,   7/
+data	(yyact(i),i=177,184)	/   8,   9,  10,  11,   4,   0,   0,   0/
+data	(yyact(i),i=185,192)	/  14,   0,  13,   6,   7,   8,   9,  10/
+data	(yyact(i),i=193,200)	/  11,   4,  12,   0,   0,  14,   0,  13/
+data	(yyact(i),i=201,208)	/   6,   7,   8,   9,  10,  11,   0,  12/
+data	(yyact(i),i=209,216)	/   5,   0,   0,   0,  13,  16,   0,   0/
+data	(yyact(i),i=217,224)	/   0,   0,   0,   0,  12,  32,  33,  34/
+data	(yyact(i),i=225,232)	/   0,   0,  36,  37,  38,  39,  40,  41/
+data	(yyact(i),i=233,240)	/  42,  43,  44,  45,  46,  47,  48,  49/
+data	(yyact(i),i=241,248)	/  50,   0,   0,   0,  52,   0,   0,   0/
+data	(yyact(i),i=249,256)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=257,264)	/   0,   0,   0,   0,   0,   0,   0,  56/
+short	yypact[59]
+data	(yypact(i),i=  1,  8)	/ -87,-1000,-256,-1000, -61,-139,-1000,-1000/
+data	(yypact(i),i=  9, 16)	/-1000,-1000,-229,-247, -61, -61, -61,-1000/
+data	(yypact(i),i= 17, 24)	/-154, -61, -61, -61, -61, -61, -61, -61/
+data	(yypact(i),i= 25, 32)	/ -61, -61, -61, -61, -61, -61, -61, -61/
+data	(yypact(i),i= 33, 40)	/-276,-115,-170, -61,-276,-276,-276,-216/
+data	(yypact(i),i= 41, 48)	/-216,-238,-238,-238,-238,-275,-275,-115/
+data	(yypact(i),i= 49, 56)	/-127,-195,-220,-1000,-244,-1000, -61, -74/
+data	(yypact(i),i= 57, 59)	/-259,-1000,-1000/
+short	yypgo[4]
+data	(yypgo(i),i=  1,  4)	/   0,  46,  74, 208/
+short	yyr1[27]
+data	(yyr1(i),i=  1,  8)	/   0,   1,   1,   2,   2,   3,   3,   3/
+data	(yyr1(i),i=  9, 16)	/   3,   3,   3,   3,   3,   3,   3,   3/
+data	(yyr1(i),i= 17, 24)	/   3,   3,   3,   3,   3,   3,   3,   3/
+data	(yyr1(i),i= 25, 27)	/   3,   3,   3/
+short	yyr2[27]
+data	(yyr2(i),i=  1,  8)	/   0,   2,   1,   6,   1,   1,   1,   1/
+data	(yyr2(i),i=  9, 16)	/   1,   4,   6,   2,   2,   3,   3,   3/
+data	(yyr2(i),i= 17, 24)	/   3,   3,   3,   3,   3,   3,   3,   3/
+data	(yyr2(i),i= 25, 27)	/   3,   3,   3/
+short	yychk[59]
+data	(yychk(i),i=  1,  8)	/-1000,  -1,  -2, 256, 267,  -3, 261, 262/
+data	(yychk(i),i=  9, 16)	/ 263, 264, 265, 266, 281, 273, 258, 270/
+data	(yychk(i),i= 17, 24)	/  -3, 285, 282, 283, 280, 281, 276, 277/
+data	(yychk(i),i= 25, 32)	/ 278, 279, 274, 275, 272, 271, 258, 258/
+data	(yychk(i),i= 33, 40)	/  -3,  -3,  -3, 268,  -3,  -3,  -3,  -3/
+data	(yychk(i),i= 41, 48)	/  -3,  -3,  -3,  -3,  -3,  -3,  -3,  -3/
+data	(yychk(i),i= 49, 56)	/  -3,  -3,  -3, 259,  -3, 259, 260, 269/
+data	(yychk(i),i= 57, 59)	/  -3,  -2, 259/
+short	yydef[59]
+data	(yydef(i),i=  1,  8)	/   0,  -2,   0,   2,   0,   4,   5,   6/
+data	(yydef(i),i=  9, 16)	/   7,   8,   0,   0,   0,   0,   0,   1/
+data	(yydef(i),i= 17, 24)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yydef(i),i= 25, 32)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yydef(i),i= 33, 40)	/  11,  12,   0,   0,  13,  14,  15,  16/
+data	(yydef(i),i= 41, 48)	/  17,  -2,  -2,  -2,  -2,  -2,  -2,  24/
+data	(yydef(i),i= 49, 56)	/  25,   0,   0,  26,   0,   9,   0,   0/
+data	(yydef(i),i= 57, 59)	/   0,   3,  10/
+
+begin
+	call smark (yysp)
+	call salloc (yyv, (YYMAXDEPTH+2) * YYOPLEN, TY_STRUCT)
+
+	# Initialization.  The first element of the dynamically allocated
+	# token value stack (yyv) is used for yyval, the second for yylval,
+	# and the actual stack starts with the third element.
+
+	yystate = 0
+	yychar = -1
+	yynerrs = 0
+	yyerrflag = 0
+	yyps = 0
+	yyval = yyv
+	yylval = yyv + YYOPLEN
+	yypv = yylval
+
+yystack_
+	# SHIFT -- Put a state and value onto the stack.  The token and
+	# value stacks are logically the same stack, implemented as two
+	# separate arrays.
+
+	if (yydebug) {
+	    call printf ("state %d, char 0%o\n")
+		call pargs (yystate)
+		call pargi (yychar)
+	}
+	yyps = yyps + 1
+	yypv = yypv + YYOPLEN
+	if (yyps > YYMAXDEPTH) {
+	    call sfree (yysp)
+	    call eprintf ("yacc stack overflow\n")
+	    return (ERR)
+	}
+	yys[yyps] = yystate
+	YYMOVE (yyval, yypv)
+
+yynewstate_
+	# Process the new state.
+	yyn = yypact[yystate+1]
+
+	if (yyn <= YYFLAG)
+	    goto yydefault_			# simple state
+
+	# The variable "yychar" is the lookahead token.
+	if (yychar < 0) {
+	    yychar = yylex (fd, yylval)
+	    if (yychar < 0)
+		yychar = 0
+	}
+	yyn = yyn + yychar
+	if (yyn < 0 || yyn >= YYLAST)
+	    goto yydefault_
+
+	yyn = yyact[yyn+1]
+	if (yychk[yyn+1] == yychar) {		# valid shift
+	    yychar = -1
+	    YYMOVE (yylval, yyval)
+	    yystate = yyn
+	    if (yyerrflag > 0)
+		yyerrflag = yyerrflag - 1
+	    goto yystack_
+	}
+
+yydefault_
+	# Default state action.
+
+	yyn = yydef[yystate+1]
+	if (yyn == -2) {
+	    if (yychar < 0) {
+		yychar = yylex (fd, yylval)
+		if (yychar < 0)
+		    yychar = 0
+	    }
+
+	    # Look through exception table.
+	    yyxi = 1
+	    while ((yyexca[yyxi] != (-1)) || (yyexca[yyxi+1] != yystate))
+		yyxi = yyxi + 2
+	    for (yyxi=yyxi+2;  yyexca[yyxi] >= 0;  yyxi=yyxi+2) {
+		if (yyexca[yyxi] == yychar)
+		    break
+	    }
+
+	    yyn = yyexca[yyxi+1]
+	    if (yyn < 0) {
+		call sfree (yysp)
+		return (OK)			# ACCEPT -- all done
+	    }
+	}
+
+
+	# SYNTAX ERROR -- resume parsing if possible.
+
+	if (yyn == 0) {
+	    switch (yyerrflag) {
+	    case 0, 1, 2:
+		if (yyerrflag == 0) {		# brand new error
+		    call eprintf ("syntax error\n")
+yyerrlab_
+		    yynerrs = yynerrs + 1
+		    # fall through...
+		}
+
+	    # case 1:
+	    # case 2: incompletely recovered error ... try again
+		yyerrflag = 3
+
+		# Find a state where "error" is a legal shift action.
+		while (yyps >= 1) {
+		    yyn = yypact[yys[yyps]+1] + YYERRCODE
+		    if ((yyn >= 0) && (yyn < YYLAST) &&
+			(yychk[yyact[yyn+1]+1] == YYERRCODE)) {
+			    # Simulate a shift of "error".
+			    yystate = yyact[yyn+1]
+			    goto yystack_
+		    }
+		    yyn = yypact[yys[yyps]+1]
+
+		    # The current yyps has no shift on "error", pop stack.
+		    if (yydebug) {
+			call printf ("error recovery pops state %d, ")
+			    call pargs (yys[yyps])
+			call printf ("uncovers %d\n")
+			    call pargs (yys[yyps-1])
+		    }
+		    yyps = yyps - 1
+		    yypv = yypv - YYOPLEN
+		}
+
+		# ABORT -- There is no state on the stack with an error shift.
+yyabort_
+		call sfree (yysp)
+		return (ERR)
+
+
+	    case 3: # No shift yet; clobber input char.
+
+		if (yydebug) {
+		    call printf ("error recovery discards char %d\n")
+			call pargi (yychar)
+		}
+
+		if (yychar == 0)
+		    goto yyabort_		# don't discard EOF, quit
+		yychar = -1
+		goto yynewstate_		# try again in the same state
+	    }
+	}
+
+
+	# REDUCE -- Reduction by production yyn.
+
+	if (yydebug) {
+	    call printf ("reduce %d\n")
+		call pargs (yyn)
+	}
+	yyps  = yyps - yyr2[yyn+1]
+	yypvt = yypv
+	yypv  = yypv - yyr2[yyn+1] * YYOPLEN
+	YYMOVE (yypv + YYOPLEN, yyval)
+	yym   = yyn
+
+	# Consult goto table to find next state.
+	yyn = yyr1[yyn+1]
+	yyj = yypgo[yyn+1] + yys[yyps] + 1
+	if (yyj >= YYLAST)
+	    yystate = yyact[yypgo[yyn+1]+1]
+	else {
+	    yystate = yyact[yyj+1]
+	    if (yychk[yystate+1] != -yyn)
+		yystate = yyact[yypgo[yyn+1]+1]
+	}
+
+	# Perform action associated with the grammar rule, if any.
+	switch (yym) {
+	    
+case 1:
+# line 34 "vexcompile.y"
+{
+			# Normal exit. Code a stop instruction
+			call vex_addcode (Y_DONE)
+			return (OK)
+		}
+case 2:
+# line 39 "vexcompile.y"
+{
+			return (ERR)
+		}
+case 3:
+# line 44 "vexcompile.y"
+{
+			# Code an if instruction
+			call vex_addcode (Y_IF)
+		}
+case 4:
+# line 48 "vexcompile.y"
+{
+			# Null action
+		}
+case 5:
+# line 53 "vexcompile.y"
+{
+			# Code a push variable instruction
+			call vex_addcode (Y_VAR)
+			call vex_addstr (Memi[yypvt])
+		}
+case 6:
+# line 58 "vexcompile.y"
+{
+			# Code a push variable instruction
+			call vex_addcode (Y_INT)
+			call vex_addstr (Memi[yypvt])
+		}
+case 7:
+# line 63 "vexcompile.y"
+{
+			# Code a push variable instruction
+			call vex_addcode (Y_REAL)
+			call vex_addstr (Memi[yypvt])
+		}
+case 8:
+# line 68 "vexcompile.y"
+{
+			# Code a push variable instruction
+			call vex_addcode (Y_DOUBLE)
+			call vex_addstr (Memi[yypvt])
+		}
+case 9:
+# line 73 "vexcompile.y"
+{
+			# Code a single argument function call
+			call vex_addcode (Y_FN1)
+			call vex_addstr (Memi[yypvt-3*YYOPLEN])
+		}
+case 10:
+# line 78 "vexcompile.y"
+{
+			# Code a double argument function call
+			call vex_addcode (Y_FN2)
+			call vex_addstr (Memi[yypvt-5*YYOPLEN])
+		}
+case 11:
+# line 83 "vexcompile.y"
+{
+			# Code a negation instruction
+			call vex_addcode (Y_NEG)
+		}
+case 12:
+# line 87 "vexcompile.y"
+{
+			# Code a logical not
+			call vex_addcode (Y_NOT)
+		}
+case 13:
+# line 91 "vexcompile.y"
+{
+			# Code an exponentiation instruction
+			call vex_addcode (Y_POW)
+		}
+case 14:
+# line 95 "vexcompile.y"
+{
+			# Code a multiply instruction
+			call vex_addcode (Y_MUL)
+		}
+case 15:
+# line 99 "vexcompile.y"
+{
+			# Code a divide instruction
+			call vex_addcode (Y_DIV)
+		}
+case 16:
+# line 103 "vexcompile.y"
+{
+			# Code an addition instruction
+			call vex_addcode (Y_ADD)
+		}
+case 17:
+# line 107 "vexcompile.y"
+{
+			# Code a subtraction instruction
+			call vex_addcode (Y_SUB)
+		}
+case 18:
+# line 111 "vexcompile.y"
+{
+			# Code a less than instruction
+			call vex_addcode (Y_LT)
+		}
+case 19:
+# line 115 "vexcompile.y"
+{
+			# Code a greater than instruction
+			call vex_addcode (Y_GT)
+		}
+case 20:
+# line 119 "vexcompile.y"
+{
+			# Code a less than or equal instruction
+			call vex_addcode (Y_LE)
+		}
+case 21:
+# line 123 "vexcompile.y"
+{
+			# Code a greater than instruction
+			call vex_addcode (Y_GE)
+		}
+case 22:
+# line 127 "vexcompile.y"
+{
+			# Code a logical equality instruction
+			call vex_addcode (Y_EQ)
+		}
+case 23:
+# line 131 "vexcompile.y"
+{
+			# Code a logical inequality instruction
+			call vex_addcode (Y_NE)
+		}
+case 24:
+# line 135 "vexcompile.y"
+{
+			# Code a logical and instruction
+			call vex_addcode (Y_AND)
+		}
+case 25:
+# line 139 "vexcompile.y"
+{
+			# Code a logical or instruction
+			call vex_addcode (Y_OR)
+		}
+case 26:
+# line 143 "vexcompile.y"
+{
+			# Null action
+		}	}
+
+	goto yystack_				# stack new state and value
+end
diff --git a/pkg/utilities/nttools/stxtools/vexcompile.y b/pkg/utilities/nttools/stxtools/vexcompile.y
new file mode 100644
index 00000000..4b2cd958
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/vexcompile.y
@@ -0,0 +1,616 @@
+%{
+
+include	<lexnum.h>
+include	<ctype.h>
+include <fset.h>
+include	"vex.h"
+
+define	YYMAXDEPTH	64
+define	YYOPLEN		1
+define	yyparse		vex_parse
+
+# Tokens generated by xyacc have been moved to vex.h
+
+%L
+
+%}
+
+%token		Y_WRONG Y_LPAR Y_RPAR Y_COMMA 
+%token		Y_VAR Y_INT Y_REAL Y_DOUBLE
+%token		Y_FN1 Y_FN2 Y_IF Y_THEN Y_ELSE Y_DONE 
+
+%left		Y_OR
+%left		Y_AND
+%right		Y_NOT
+%nonassoc	Y_EQ Y_NE
+%nonassoc	Y_LT Y_GT Y_LE Y_GE
+%left		Y_ADD Y_SUB
+%left		Y_MUL Y_DIV
+%right		Y_NEG
+%right		Y_POW
+
+%%
+
+stmt	:	ifexpr Y_DONE {
+			# Normal exit. Code a stop instruction
+			call vex_addcode (Y_DONE)
+			return (OK)
+		}
+	|	error {
+			return (ERR)
+		}
+	;
+
+ifexpr	:	Y_IF expr Y_THEN expr Y_ELSE ifexpr {
+			# Code an if instruction
+			call vex_addcode (Y_IF)
+		}
+	|	expr {
+			# Null action
+		}
+	;
+
+expr	:	Y_VAR {
+			# Code a push variable instruction
+			call vex_addcode (Y_VAR)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_INT {
+			# Code a push variable instruction
+			call vex_addcode (Y_INT)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_REAL {
+			# Code a push variable instruction
+			call vex_addcode (Y_REAL)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_DOUBLE {
+			# Code a push variable instruction
+			call vex_addcode (Y_DOUBLE)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_FN1 Y_LPAR expr Y_RPAR {
+			# Code a single argument function call
+			call vex_addcode (Y_FN1)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_FN2 Y_LPAR expr Y_COMMA expr Y_RPAR {
+			# Code a double argument function call
+			call vex_addcode (Y_FN2)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_SUB expr %prec Y_NEG {
+			# Code a negation instruction
+			call vex_addcode (Y_NEG)
+		}
+	|	Y_NOT expr {
+			# Code a logical not
+			call vex_addcode (Y_NOT)
+		}
+	|	expr Y_POW expr {
+			# Code an exponentiation instruction
+			call vex_addcode (Y_POW)
+		}
+	|	expr Y_MUL expr {
+			# Code a multiply instruction
+			call vex_addcode (Y_MUL)
+		}
+	|	expr Y_DIV expr {
+			# Code a divide instruction
+			call vex_addcode (Y_DIV)
+		}
+	|	expr Y_ADD expr {
+			# Code an addition instruction
+			call vex_addcode (Y_ADD)
+		}
+	|	expr Y_SUB expr {
+			# Code a subtraction instruction
+			call vex_addcode (Y_SUB)
+		}
+	|	expr Y_LT expr {
+			# Code a less than instruction
+			call vex_addcode (Y_LT)
+		}
+	|	expr Y_GT expr {
+			# Code a greater than instruction
+			call vex_addcode (Y_GT)
+		}
+	|	expr Y_LE expr {
+			# Code a less than or equal instruction
+			call vex_addcode (Y_LE)
+		}
+	|	expr Y_GE expr {
+			# Code a greater than instruction
+			call vex_addcode (Y_GE)
+		}
+	|	expr Y_EQ expr {
+			# Code a logical equality instruction
+			call vex_addcode (Y_EQ)
+		}
+	|	expr Y_NE expr {
+			# Code a logical inequality instruction
+			call vex_addcode (Y_NE)
+		}
+	|	expr Y_AND expr {
+			# Code a logical and instruction
+			call vex_addcode (Y_AND)
+		}
+	|	expr Y_OR expr {
+			# Code a logical or instruction
+			call vex_addcode (Y_OR)
+		}
+	|	Y_LPAR expr Y_RPAR {
+			# Null action
+		}
+	;
+
+%%
+
+# VEX_COMPILE -- Compile an expression, producing pseudocode
+#
+# This procedure takes a string containing a fortran expression and produces
+# pseudocode that can be evaluated by vex_eval(). The pseudocode is stored in
+# structure adressed by the pointer returned as the function value. This 
+# structure is freed by calling vex_free(). If the string begins with an @ 
+# symbol, the rest of the string is treated as a the name of a file which
+# contains the expression. The expression can contain all the fortran 
+# operators, including logical and relational operators and supports all the
+# fortran intrinsic functions which can take real arguments. It also supports
+# conditional expressions of the form: if <expr> then <expr> else <expr>
+# Variables must follow the fortran rules, and may be up to 31 characters long.
+# All variables and constants are treated as real numbers. A variable may
+# contain non-alphanumeric characters if it is preceded by a dollar sign, in
+# which case all characters until the next blank are part of the variable name.
+#
+# B.Simon	21-May-90	Original
+# B.Simon	19-Apr-91	Revised to handle multiple types
+# B.Simon	31-Mar-94	Better syntax error message
+# B.Simon	15-Oct-98	Embed strings in pseudocode
+
+pointer procedure vex_compile (expr)
+
+char	expr[ARB]	# i: Expression to be parsed
+#--
+include	"vex.com"
+
+int	ic, fd, len
+bool	debug
+pointer	sp, pcode
+
+data	debug	/ false /
+
+int	open(), stropen(), strlen(), fstati(), yyparse()
+
+int	vex_gettok ()
+extern	vex_gettok
+
+begin
+	# Open the expression as a file
+
+	for (ic = 1; IS_WHITE(expr[ic]); ic = ic + 1)
+	    ;
+
+	if (expr[ic] == '@') {
+	    fd = open (expr[ic+1], READ_ONLY, TEXT_FILE)
+	    len = fstati (fd, F_FILESIZE) + 1
+
+	} else {
+	    len = strlen (expr[ic]) + 1
+	    fd = stropen (expr[ic], len, READ_ONLY)
+	}
+
+	# Create pseudocode structure
+
+	call malloc (pcode, SZ_VEXSTRUCT, TY_STRUCT)
+
+	call malloc (VEX_CODE(pcode), 2 * len, TY_INT)
+	call stk_init (VEX_STACK(pcode))
+
+	# Initialize parsing common block
+
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	ch = line
+	Memc[line] = EOS
+
+	ncode = 0
+	maxcode = 2 * len
+	code = VEX_CODE(pcode)
+	stack = VEX_STACK(pcode)
+
+	# Parse expression to produce reverse polish code
+
+	if (yyparse (fd, debug, vex_gettok) == ERR) {
+	    call eprintf ("%s\n%*t^\n")
+	    call pargstr (Memc[line])
+	    call pargi (ch-line)
+
+	    call error (1, "Syntax error in expression")
+	}
+
+	# Clean up and return pseudocode structure
+
+	call stk_clear (VEX_STACK(pcode))
+
+	call close (fd)
+	call sfree (sp)
+	return (pcode)
+end
+
+# VEX_GETTOK -- Get the next token from the input
+
+int procedure vex_gettok (fd, value)
+
+int	fd		# i: File containing expression to be lexed
+pointer	value		# o: Address on parse stack to store token
+#--
+include	"vex.com"
+
+double	constant
+int	ic, jc, nc, type, index
+int	idftype[4], keytype[3], btype[9]
+pointer	sp, errmsg, token
+
+string  fn1tok	FN1STR
+string	fn2tok	FN2STR
+
+string	idftok	"indefi indefr indefd indef"
+data	idftype	/ Y_INT, Y_REAL, Y_DOUBLE, Y_REAL /
+
+string	keytok	"if then else"
+data	keytype	/ Y_IF, Y_THEN, Y_ELSE /
+
+string	btoken  ".or. .and. .eq. .ne. .lt. .gt. .le. .ge. .not."
+data	btype   / Y_OR, Y_AND, Y_EQ, Y_NE, Y_LT, Y_GT, Y_LE, Y_GE, Y_NOT /
+
+string	badsymb "Operator not recognized (%s)"
+
+int	getline(), lexnum(), ctod(), stridxs(), word_match()
+
+begin
+	# Allocate dynamic memory for strings
+
+	call smark (sp)
+	call salloc (errmsg, SZ_LINE, TY_CHAR)
+	call malloc (token, MAX_TOKEN, TY_CHAR)
+
+	# Skip over leading white space and comments
+
+	while (Memc[ch] <= BLANK || Memc[ch] == CMTCHAR) {
+
+	    # If all characters have been read from the current line 
+	    # or a comment character was found, get the next line
+
+	    if (Memc[ch] == EOS || Memc[ch] == CMTCHAR) {
+		ch = line
+		if (getline (fd, Memc[line]) == EOF) {
+		    Memc[ch] = EOS
+		    break
+		}
+	    } else {
+		ch = ch + 1
+	    }
+	}
+
+	# The token type is determined from the first character in the token
+
+	Memc[token] = EOS
+
+	# End of expression token
+
+	if (Memc[ch] == EOS) {
+	    type = Y_DONE
+
+	# Numeric constant is too difficult to parse,
+	# Pass the job to lexnum and ctod
+
+	} else if (IS_DIGIT(Memc[ch])) {
+
+	    ic = 1
+	    index = lexnum (Memc[ch], ic, nc)
+	    if (index != LEX_REAL) {
+		type = Y_INT
+	    } else if (nc > 8) {
+		type = Y_DOUBLE
+	    } else {
+		jc = stridxs ("dD", Memc[ch])
+		if (jc == 0 || jc > nc) {
+		    type = Y_REAL
+		} else {
+		    type = Y_DOUBLE
+		}
+	    }
+
+	    ic = 1
+	    nc = ctod (Memc[ch], ic, constant)
+	    nc = min (nc, MAX_TOKEN)
+
+	    call strcpy (Memc[ch], Memc[token], nc)
+	    ch = ch + ic - 1
+
+	# Token is alphanumeric. Determine what type of token
+
+	} else if (IS_ALPHA (Memc[ch])) {
+
+	    # Gather characters in token
+
+	    for (ic = 1; ic <= MAX_TOKEN; ic = ic + 1) {
+		if (Memc[ch] != '_' && ! IS_ALNUM(Memc[ch]))
+		    break
+
+		if (IS_UPPER(Memc[ch]))	
+		    Memc[token+ic-1] = TO_LOWER(Memc[ch])
+		else
+		    Memc[token+ic-1] = Memc[ch]
+		ch = ch + 1
+	    }
+	    Memc[token+ic-1] = EOS
+
+	    # Check to see if token is string "INDEF"
+
+	    index = word_match (Memc[token], idftok)
+
+	    if (index > 0) {
+		type = idftype[index]
+		call strupr (Memc[token])
+
+	    } else {
+
+		# Check to see if token is function or keyword name
+		# If not, add it as a new variable
+
+		index = word_match (Memc[token], fn1tok)
+		if (index > 0) {
+		    type = Y_FN1
+
+		} else {
+		    index = word_match (Memc[token], fn2tok)
+		    if (index > 0) {
+			type = Y_FN2
+
+		    } else {
+			index = word_match (Memc[token], keytok)
+			if (index > 0) {
+			    type = keytype[index]
+			    Memc[token] = EOS
+			} else {
+			    type = Y_VAR
+			}
+		    }
+		}
+	    }
+
+	# Tokens beginning with a dot are numbers or boolean operators
+
+	} else if (Memc[ch] == DOT) {
+
+	    if (IS_DIGIT (Memc[ch+1])) {
+		ic = 1
+		index = lexnum (Memc[ch], ic, nc)
+
+		if (index != LEX_REAL) {
+		    type = Y_INT
+		} else if (nc < 9) {
+		    type = Y_REAL
+		} else {
+		    type = Y_DOUBLE
+		}
+
+		ic = 1
+		nc = ctod (Memc[ch], ic, constant)
+		nc = min (nc, MAX_TOKEN)
+
+		call strcpy (Memc[ch], Memc[token], nc)
+		ch = ch + ic - 1
+
+	    } else {
+
+		# Gather characters in token
+
+		ch = ch + 1
+		Memc[token] = DOT
+		for (ic = 2; ic < MAX_TOKEN && Memc[ch] != DOT; ic = ic + 1) {
+		    if (Memc[ch] == EOS)
+			break
+		    if (IS_UPPER(Memc[ch]))	
+			Memc[token+ic-1] = TO_LOWER(Memc[ch])
+		    else
+			Memc[token+ic-1] = Memc[ch]
+		    ch = ch + 1
+		}
+
+		Memc[token+ic-1] = Memc[ch]
+		Memc[token+ic] = EOS
+		ch = ch + 1
+
+		index = word_match (Memc[token], btoken)
+		if (type > 0) {
+		    type = btype[index]
+		} else {
+		    call sprintf (Memc[errmsg], SZ_LINE, badsymb)
+		    call pargstr (Memc[token])
+		    call error (1, Memc[errmsg])
+		}
+	    }
+
+	# Characters preceded by a dollar sign are identifiers
+
+	} else if (Memc[ch] == DOLLAR) {
+
+	    ch = ch + 1
+	    for (ic = 1; ic <= MAX_TOKEN && Memc[ch] > BLANK; ic = ic + 1) {
+		if (IS_UPPER(Memc[ch]))	
+		    Memc[token+ic-1] = TO_LOWER(Memc[ch])
+		else
+		    Memc[token+ic-1] = Memc[ch]
+		ch = ch + 1
+	    }
+	    Memc[token+ic-1] = EOS
+
+	    type = Y_VAR
+
+	# Anything else is a symbol
+	
+	} else {
+	    switch (Memc[ch]) {
+	    case '*':
+		if (Memc[ch+1] != '*') {
+		    type = Y_MUL
+		} else {
+		    type = Y_POW
+		    ch = ch + 1
+		}
+	    case '/':
+		type = Y_DIV
+	    case '+':
+		type = Y_ADD
+	    case '-':
+		type = Y_SUB
+	    case '(':
+		type = Y_LPAR
+	    case ')':
+		type = Y_RPAR
+	    case ',':
+		type = Y_COMMA
+	    case '<':
+		if (Memc[ch+1] != '=') {
+		   type = Y_LT
+		} else {
+		   type = Y_LE
+		   ch = ch + 1
+		}
+	    case '>':
+		if (Memc[ch+1] != '=') {
+		   type = Y_GT
+		} else {
+		   type = Y_GE
+		   ch = ch + 1
+		}
+	    case '|':
+		if (Memc[ch+1] != '|') {
+		   type = Y_WRONG
+		} else {
+		   type = Y_OR
+		   ch = ch + 1
+		}
+	    case '&':
+		if (Memc[ch+1] != '&') {
+		   type = Y_WRONG
+		} else {
+		   type = Y_AND
+		   ch = ch + 1
+		}
+	    case '=':
+		if (Memc[ch+1] != '=') {
+		   type = Y_WRONG
+		} else {
+		   type = Y_EQ
+		   ch = ch + 1
+		}
+	    case '!':
+		if (Memc[ch+1] != '=') {
+		   type = Y_NOT
+		} else {
+		   type = Y_NE
+		   ch = ch + 1
+		}
+	    default:
+		Memc[ch+1] = EOS
+		call sprintf (Memc[errmsg], SZ_LINE, badsymb)
+		    call pargstr (Memc[ch])
+		call error (1, Memc[errmsg])
+	    }
+
+	    ch = ch + 1
+	}
+
+	# 
+	if (Memc[token] == EOS) {
+	    call mfree (token, TY_CHAR)
+	    token = NULL
+	}
+
+	Memi[value] = token
+	return (type)
+end
+
+# VEX_ADDCODE -- Add an instruction to the code array
+
+procedure vex_addcode (type)
+
+int	type		# i: Instruction type
+#--
+include	"vex.com"
+
+begin
+
+	if (ncode == maxcode)
+	    call error (1, "Expression too complex")
+	else {
+	    Memi[code] = type
+	    code = code + 1
+	    ncode = ncode + 1
+	}
+
+end
+
+# VEX_ADDSTR -- Embed a string constant in the pseudo-code
+
+procedure vex_addstr (token)
+
+pointer	token		# u: Pointer to token string
+#--
+include "vex.com"
+
+int	ic
+
+begin
+	if (token == NULL)
+	    call error (1, "Expression token missing")
+
+	if (Memc[token] == EOS)
+	    call error (1, "Expression token blank")
+
+	ic = 0
+	repeat {
+	    ic = ic + 1
+
+	    if (ncode == maxcode)
+		call error (1, "Expression too complex")
+	    else {
+		Memi[code] = Memc[token+ic-1]
+		code = code + 1
+		ncode = ncode + 1
+	    }
+
+	} until (Memc[token+ic-1] == EOS)
+
+	call mfree (token, TY_CHAR)
+end
+
+# VEX_GETSTR -- Retrieve a token string from the pseudocode array
+
+procedure vex_getstr (op, token, maxch)
+
+pointer	op		# u: Location of token string in pseudocode
+char	token[ARB]	# o: Token string
+int	maxch		# i: Maximum length of token
+#--
+int	ic
+
+begin
+	# The token begins one position after op and is 
+	# termminated by an EOS
+
+	ic = 0
+	repeat {
+	    ic = ic + 1
+	    op = op + 1
+	    if (ic <= maxch)
+		token[ic] = Memi[op]
+
+	} until (Memi[op] == EOS)
+
+end
diff --git a/pkg/utilities/nttools/stxtools/vexeval.x b/pkg/utilities/nttools/stxtools/vexeval.x
new file mode 100644
index 00000000..40b10fbd
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/vexeval.x
@@ -0,0 +1,228 @@
+include	"vex.h"
+
+# VEX_EVAL -- Evaluate the pseudocode
+#
+# This procedure evaluates the pseudocode produced by vex_compile(). Evaluation
+# is performed on an entire vector at a time. The calling program must
+# supply a subroutine which returns the vector associated with a variable name.
+# The procedure is called as follows: call getvar(stack, name), where
+# stack is a pointer to the stack structure and name is the variable name.
+# This procedure should call stk_alloc(stack, len, type) passing it the stack
+# pointer, the length of the new array, and the type of the new array. The 
+# pointer to the new array is returned as the function value. The procedure
+# should then fill in the values in the array. Code is the pointer returned 
+# by vex_compile(). Nil is a value substituted for the result of an illegal 
+# operation, such as division by zero. Type is the data type of expression.
+# To retrieve the results of the expression, call vex_copy[dir], which
+# retrieves the result as a double, integer, or real array and clears the
+# stack for the next call of vex_eval.
+#
+# B.Simon	21-May-90	Original
+# B.Simon	24-Apr-91	Revised to handle multiple types
+# B.Simon	15-Oct-98	Embed strings in pseudocode
+
+procedure vex_eval (code, getvar, nil, type)
+
+pointer	code		# i: Pointer to pseudocode structure
+extern	getvar		# i: Function which returns a vector given a name
+double	nil		# i: Nil value used to replace illegal ops
+int	type		# o: Data type of expression
+#--
+double	junk
+int	len, toktype
+pointer	sp, token, errmsg, stack, op, var
+
+string	fn1tok  FN1STR
+string	fn2tok  FN2STR
+
+int	word_match
+double	vex_nilf()
+errchk	vex_push
+
+string	badcode  "vex_eval : Illegal opcode (%d)"
+string	badfunc  "vex_eval : Illegal function name (%s)"
+
+begin
+	# Allocate dynamic memory for strings
+
+	call smark (sp)
+	call salloc (token, MAX_TOKEN, TY_CHAR)
+	call salloc (errmsg, SZ_LINE, TY_CHAR)
+
+	# Initialize the undefined operation function
+
+	junk = vex_nilf (nil)
+
+	# Execute each code token until stop token found
+
+	stack = VEX_STACK(code)
+	for (op = VEX_CODE(code); Memi[op] != Y_DONE; op = op + 1) {
+	    call pargi (Memi[op])
+
+	    # Perform the indicated operation on the stack variables
+
+	    switch (Memi[op]) {
+	    case Y_VAR, Y_INT, Y_REAL, Y_DOUBLE:
+		toktype = Memi[op]
+		call vex_getstr (op, Memc[token], MAX_TOKEN)
+		call vex_push (stack, getvar, toktype, Memc[token])
+
+	    case Y_FN1:
+		call vex_getstr (op, Memc[token], MAX_TOKEN)
+
+		switch (word_match (Memc[token], fn1tok)) {
+		case FN1_ABS:
+		    call vex_abs (stack)
+
+		case FN1_ACOS:
+		    call vex_acos (stack)
+
+		case FN1_ASIN:
+		    call vex_asin (stack)
+
+		case FN1_ATAN:
+		    call vex_atan (stack)
+
+		case FN1_COS:
+		    call vex_cos (stack)
+
+		case FN1_COSH:
+		    call vex_cosh (stack)
+
+		case FN1_CUBE:
+		    call vex_cube (stack)
+
+		case FN1_DOUBLE:
+		    call vex_double (stack)
+
+		case FN1_EXP:
+		    call vex_exp (stack)
+
+		case FN1_INT:
+		    call vex_int (stack)
+
+		case FN1_LOG:
+		    call vex_log (stack)
+
+		case FN1_LOG10:
+		    call vex_log10 (stack)
+
+		case FN1_NINT:
+		    call vex_nint (stack)
+
+		case FN1_REAL:
+		    call vex_real (stack)
+
+		case FN1_SIN:
+		    call vex_sin (stack)
+
+		case FN1_SINH:
+		    call vex_sinh (stack)
+
+		case FN1_SQR:
+		    call vex_sqr (stack)
+
+		case FN1_SQRT:
+		    call vex_sqrt (stack)
+
+		case FN1_TAN:
+		    call vex_tan (stack)
+
+		case FN1_TANH:
+		    call vex_tanh (stack)
+
+		default:
+		    call sprintf (Memc[errmsg], SZ_LINE, badfunc)
+		    call pargstr (Memc[token])
+		    call error (1, Memc[errmsg])
+		}
+
+	    case Y_FN2:
+		call vex_getstr (op, Memc[token], MAX_TOKEN)
+
+		switch (word_match (Memc[token], fn2tok)) {
+		case FN2_ATAN2:
+		    call vex_atan2 (stack)
+
+		case FN2_DIM:
+		    call vex_dim (stack)
+
+		case FN2_MAX:
+		    call vex_max (stack)
+
+		case FN2_MIN:
+		    call vex_min (stack)
+
+		case FN2_MOD:
+		    call vex_mod (stack)
+
+		case FN2_SIGN:
+		    call vex_sig (stack)
+
+		default:
+		    call sprintf (Memc[errmsg], SZ_LINE, badfunc)
+		    call pargstr (Memc[token])
+		    call error (1, Memc[errmsg])
+		}
+
+	    case Y_IF:
+		call vex_if (stack)
+ 
+ 	    case Y_OR:
+		call vex_or (stack)
+
+ 	    case Y_AND:
+		call vex_and (stack)
+
+	    case Y_NOT:
+		call vex_not (stack)
+
+ 	    case Y_EQ:
+		call vex_eq (stack)
+
+ 	    case Y_NE:
+		call vex_ne (stack)
+
+ 	    case Y_LT:
+		call vex_lt (stack)
+
+ 	    case Y_GT:
+		call vex_gt (stack)
+
+ 	    case Y_LE:
+		call vex_le (stack)
+
+ 	    case Y_GE:
+		call vex_ge (stack)
+
+	    case Y_ADD:
+		call vex_add (stack)
+
+	    case Y_SUB:
+		call vex_sub (stack)
+
+ 	    case Y_MUL:
+		call vex_mul (stack)
+
+	    case Y_DIV:
+		call vex_div (stack)
+
+	    case Y_NEG:
+		call vex_neg (stack)
+
+	    case Y_POW:
+		call vex_pow (stack)
+
+	    default:
+		call sprintf (Memc[errmsg], SZ_LINE, badcode)
+		    call pargs (Memi[op])
+		call error (1, Memc[errmsg])
+	    }
+	}
+
+	# Retrieve the result of the expression,
+	# but only return the type to the user
+
+	call stk_fetch (stack, 1, var, len, type)
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/stxtools/vexfree.x b/pkg/utilities/nttools/stxtools/vexfree.x
new file mode 100644
index 00000000..f98bee57
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/vexfree.x
@@ -0,0 +1,22 @@
+include	"vex.h"
+
+# VEX_FREE -- Free the pseudocode structure
+#
+# This procedure frees the structure created by vex_compile() and evaluated
+# by vex_eval()
+#
+# B.Simon	21-May-90	Original
+# B.Simon	19-Apr-91	Revised to handle multiple types
+
+procedure vex_free (code)
+
+pointer	code		# i: Pointer to pseudocode structure
+#--
+
+begin
+	call stk_free (VEX_STACK(code))
+
+	call mfree (VEX_CODE(code), TY_INT)
+	call mfree (code, TY_STRUCT)
+end
+
diff --git a/pkg/utilities/nttools/stxtools/vexfunc.x b/pkg/utilities/nttools/stxtools/vexfunc.x
new file mode 100644
index 00000000..b4e40ae6
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/vexfunc.x
@@ -0,0 +1,2011 @@
+include <mach.h>
+include	"vex.h"
+
+define	MAX_EXP		(2.3 * MAX_EXPONENT)
+define	MIN_REAL	1.0e-20
+define	MIN_DOUBLE	1.0d-20
+
+# VEX_FUNC -- Miscelaneous procedures used by the vex expression evaluator.
+# 
+# Mostly these functions implement single opcodes such as add, sin, and 
+# push. However, it also includes vex_copy[dir], which copies the array
+# on the top of the stack into a user array and vex_errf, which returns
+# the substitute value used when an opcode would return an undefined 
+# value. The only functions which should be called directly from a user's
+# program are vex_copy[dir]. 
+#
+# B.Simon	24-Apr-91	Original
+# B.Simon	15-Oct-98	Rewrite vex_push to use embedded strings
+
+# VEX_ABS -- Absolute value function
+
+procedure vex_abs (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = abs (Memi[in+i])
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = abs (Memr[in+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = abs (Memd[in+i])
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_ACOS -- Arc cosine function
+
+procedure vex_acos (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in+i] < -1 || Memi[in+i] > 1) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = acos (real (Memi[in+i]))
+		}
+	    }
+
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in+i] < -1.0 || Memr[in+i] > 1.0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = acos (Memr[in+i])
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in+i] < -1.0 || Memd[in+i] > 1.0) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		    Memd[out+i] = acos (Memd[in+i])
+		}
+	    }
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_ADD -- Addition function
+
+procedure vex_add (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = Memi[in[1]+i] + Memi[in[2]+i]
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = Memr[in[1]+i] + Memr[in[2]+i]
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = Memd[in[1]+i] + Memd[in[2]+i]
+
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_AND -- Logical and
+
+procedure vex_and (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, TY_INT)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] != 0 && Memi[in[2]+i] != 0) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in[1]+i] != 0.0 && Memr[in[2]+i] != 0.0) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in[1]+i] != 0.0 && Memd[in[2]+i] != 0.0) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_ASIN -- Arc sine function
+
+procedure vex_asin (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in+i] < -1 || Memi[in+i] > 1) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = asin (real (Memi[in+i]))
+		}
+	    }
+
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in+i] < -1.0 || Memr[in+i] > 1.0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = asin (Memr[in+i])
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in+i] < -1.0 || Memd[in+i] > 1.0) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		    Memd[out+i] = asin (Memd[in+i])
+		}
+	    }
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_ATAN -- Arc tangent function with one argument
+
+procedure vex_atan (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memr[out+i] = atan (real (Memi[in+i]))
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = atan (Memr[in+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = atan (Memd[in+i])
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_ATAN2 -- Arc tangent function with two arguments
+
+procedure vex_atan2 (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] == 0 && Memi[in[2]+i] == 0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = atan2 (real (Memi[in[1]+i]), 
+					 real (Memi[in[2]+i]))
+		}
+	    }
+
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in[1]+i] == 0.0 && Memr[in[2]+i] == 0.0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = atan2 (Memr[in[1]+i], Memr[in[2]+i])
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in[1]+i] == 0.0 && Memd[in[2]+i] == 0.0) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		    Memd[out+i] = atan2 (Memd[in[1]+i], Memd[in[2]+i])
+		}
+	    }
+
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_COPYD -- Copy the top element of the stack into a double array
+
+procedure vex_copyd (code, nullval, buffer, maxbuf)
+
+pointer	code		# i: Pseudocode structure pointer
+double	nullval		# i: Value to substitute for nulls
+double	buffer[ARB]	# o: Output array
+int	maxbuf		# i: Length of buffer
+#--
+int	len, type, ibuf
+pointer	stack, var, nullbuf
+
+string	badsize   "Cannot copy more elements than stack contains"
+
+begin
+	stack = VEX_STACK(code)
+	call stk_get (stack, TOP, var, len, type)
+
+	if (type != TY_DOUBLE)
+	    call stk_coerce (stack, TOP, TY_DOUBLE, var)
+
+	if (maxbuf <= len) {
+	    do ibuf = 1, maxbuf {
+		buffer[ibuf] = Memd[var]
+		var = var + 1
+	    }
+
+	} else if (len != 0) {
+	    call error (1, badsize)
+
+	} else {
+	    do ibuf = 1, maxbuf
+		buffer[ibuf] = Memd[var]
+	}
+
+	# Set the null value in the output array
+
+	call stk_getnull (stack, nullbuf)
+	if (nullbuf != NULL) {
+	    do ibuf = 1, maxbuf {
+		if (Memb[nullbuf])
+		    buffer[ibuf] = nullval
+		if (len > 0)
+		    nullbuf = nullbuf + 1
+	    }
+	}
+
+	call stk_clear (stack)
+end
+
+# VEX_COPYI -- Copy the top element of the stack into an integer array
+
+procedure vex_copyi (code, nullval, buffer, maxbuf)
+
+pointer	code		# i: Pseudocode structure pointer
+int	nullval		# i: Value to substitute for nulls
+int	buffer[ARB]	# o: Output array
+int	maxbuf		# i: Length of buffer
+#--
+int	len, type, ibuf
+pointer	stack, var, nullbuf
+
+string	badsize   "Cannot copy more elements than stack contains"
+
+begin
+	stack = VEX_STACK(code)
+	call stk_get (stack, TOP, var, len, type)
+
+	if (type != TY_INT)
+	    call stk_coerce (stack, TOP, TY_INT, var)
+
+	if (maxbuf <= len) {
+	    do ibuf = 1, maxbuf {
+		buffer[ibuf] = Memi[var]
+		var = var + 1
+	    }
+
+	} else if (len != 0) {
+	    call error (1, badsize)
+
+	} else {
+	    do ibuf = 1, maxbuf
+		buffer[ibuf] = Memi[var]
+	}
+
+	# Set the null value in the output array
+
+	call stk_getnull (stack, nullbuf)
+	if (nullbuf != NULL) {
+	    do ibuf = 1, maxbuf {
+		if (Memb[nullbuf])
+		    buffer[ibuf] = nullval
+		if (len > 0)
+		    nullbuf = nullbuf + 1
+	    }
+	}
+
+	call stk_clear (stack)
+end
+
+# VEX_COPYR -- Copy the top element of the stack into a real array
+
+procedure vex_copyr (code, nullval, buffer, maxbuf)
+
+pointer	code		# i: Pseudocode structure pointer
+real	nullval		# i: Value to substitute for nulls
+real	buffer[ARB]	# o: Output array
+int	maxbuf		# i: Length of buffer
+#--
+int	len, type, ibuf
+pointer	stack, var, nullbuf
+
+string	badsize   "Cannot copy more elements than stack contains"
+
+begin
+	stack = VEX_STACK(code)
+	call stk_get (stack, TOP, var, len, type)
+
+	if (type != TY_REAL)
+	    call stk_coerce (stack, TOP, TY_REAL, var)
+
+	if (maxbuf <= len) {
+	    do ibuf = 1, maxbuf {
+		buffer[ibuf] = Memr[var]
+		var = var + 1
+	    }
+
+	} else if (len != 0) {
+	    call error (1, badsize)
+
+	} else {
+	    do ibuf = 1, maxbuf
+		buffer[ibuf] = Memr[var]
+	}
+
+	# Set the null value in the output array
+
+	call stk_getnull (stack, nullbuf)
+	if (nullbuf != NULL) {
+	    do ibuf = 1, maxbuf {
+		if (Memb[nullbuf])
+		    buffer[ibuf] = nullval
+		if (len > 0)
+		    nullbuf = nullbuf + 1
+	    }
+	}
+
+	call stk_clear (stack)
+end
+
+# VEX_COS -- Cosine function
+
+procedure vex_cos (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memr[out+i] = cos (real (Memi[in+i]))
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = cos (Memr[in+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = cos (Memd[in+i])
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_COSH -- Hyperbolic cosine function
+
+procedure vex_cosh (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in+i] > MAX_EXP) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = cosh (real (Memi[in+i]))
+		}
+	    }
+
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in+i] > MAX_EXP) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = cosh (Memr[in+i])
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in+i] > MAX_EXP) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		    Memd[out+i] = cosh (Memd[in+i])
+		}
+	    }
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_CUBE -- Third power
+
+procedure vex_cube (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = Memi[in+i] * Memi[in+i] * Memi[in+i]
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = Memr[in+i] * Memr[in+i] * Memr[in+i]
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = Memd[in+i] * Memd[in+i] * Memd[in+i]
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_DIM -- Positive difference
+
+procedure vex_dim (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = dim (Memi[in[1]+i], Memi[in[2]+i])
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = dim (Memr[in[1]+i], Memr[in[2]+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = dim (Memd[in[1]+i], Memd[in[2]+i])
+
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_DIV -- Division function
+
+procedure vex_div (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[2]+i] == 0) {
+		    Memi[out+i] = vex_errf (stack, i)
+		} else {
+		    Memi[out+i] = Memi[in[1]+i] / Memi[in[2]+i]
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (abs(Memr[in[2]+i]) < MIN_REAL) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = Memr[in[1]+i] / Memr[in[2]+i]
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (abs(Memd[in[2]+i]) < MIN_DOUBLE) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		    Memd[out+i] = Memd[in[1]+i] / Memd[in[2]+i]
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_DOUBLE -- Convert to double
+
+procedure vex_double (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+pointer	out
+
+begin
+	call stk_coerce (stack, TOP, TY_DOUBLE, out)
+
+end
+
+# VEX_EQ -- Logical equality
+
+procedure vex_eq (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, TY_INT)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] == Memi[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in[1]+i] == Memr[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in[1]+i] == Memd[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_ERRF -- Called when a function cannot be evaluated
+
+double procedure vex_errf (stack, index)
+
+pointer	stack		# u: Stack descriptor
+int	index		# i: Index to row with illegal operation
+double	nil		# i: Value substituted for illegal operation
+#--
+double	substitute
+double	temp
+
+data	substitute  / 0.0 /
+
+double	vex_nilf()
+
+begin
+	call stk_initnull (stack, false)
+	call stk_setnull (stack, index)
+
+	return (substitute)
+
+	entry vex_nilf (nil)
+
+	temp = substitute
+	substitute = nil
+	return (temp)
+
+end
+
+# VEX_EXP -- Exponentiation function
+
+procedure vex_exp (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in+i] > MAX_EXP) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = exp (real (Memi[in+i]))
+		}
+	    }
+
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in+i] > MAX_EXP) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = exp (Memr[in+i])
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in+i] > MAX_EXP) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		    Memd[out+i] = exp (Memd[in+i])
+		}
+	    }
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_GE -- Greater than or equal to function
+
+procedure vex_ge (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, TY_INT)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] >= Memi[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in[1]+i] >= Memr[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in[1]+i] >= Memd[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_GT -- Greater than function
+
+procedure vex_gt (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, TY_INT)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] > Memi[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in[1]+i] > Memr[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in[1]+i] > Memd[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_IF -- Conditional evaluation
+
+procedure vex_if (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, index, i
+pointer	out, in[3]
+
+int	stk_pos()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 3, in, len, type)
+	index = stk_pos (stack, 3)
+	call stk_coerce (stack, index, TY_INT, in[1])
+
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] != 0) {
+		    Memi[out+i] = Memi[in[2]+i]
+		} else {
+		    Memi[out+i] = Memi[in[3]+i]
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] != 0) {
+		    Memr[out+i] = Memr[in[2]+i]
+		} else {
+		    Memr[out+i] = Memr[in[3]+i]
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] != 0) {
+		    Memd[out+i] = Memd[in[2]+i]
+		} else {
+		    Memd[out+i] = Memd[in[3]+i]
+		}
+	    }
+	}
+
+	call stk_pop (stack, 3)
+end
+
+# VEX_INT -- Convert to integer
+
+procedure vex_int (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+pointer	out
+
+begin
+	call stk_coerce (stack, TOP, TY_INT, out)
+
+end
+
+# VEX_LE -- Less than or equal to function
+
+procedure vex_le (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, TY_INT)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] <= Memi[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in[1]+i] <= Memr[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in[1]+i] <= Memd[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_LT -- Less than function
+
+procedure vex_lt (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, TY_INT)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] < Memi[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in[1]+i] < Memr[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in[1]+i] < Memd[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_LOG -- Natural log function
+
+procedure vex_log (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in+i] <= 0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = log (real (Memi[in+i]))
+		}
+	    }
+
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in+i] <= 0.0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = log (Memr[in+i])
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in+i] <= 0.0) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		    Memd[out+i] = log (Memd[in+i])
+		}
+	    }
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_LOG10 -- Common log function
+
+procedure vex_log10 (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in+i] <= 0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = log10 (real (Memi[in+i]))
+		}
+	    }
+
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in+i] <= 0.0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = log10 (Memr[in+i])
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in+i] <= 0.0) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		    Memd[out+i] = log10 (Memd[in+i])
+		}
+	    }
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_MAX -- Maximum of two numbers
+
+procedure vex_max (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = max (Memi[in[1]+i], Memi[in[2]+i])
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = max (Memr[in[1]+i], Memr[in[2]+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = max (Memd[in[1]+i], Memd[in[2]+i])
+
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_MIN -- Minimum of two numbers
+
+procedure vex_min (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = min (Memi[in[1]+i], Memi[in[2]+i])
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = min (Memr[in[1]+i], Memr[in[2]+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = min (Memd[in[1]+i], Memd[in[2]+i])
+
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_MOD -- Remainder function
+
+procedure vex_mod (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = mod (Memi[in[1]+i], Memi[in[2]+i])
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = mod (Memr[in[1]+i], Memr[in[2]+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = mod (Memd[in[1]+i], Memd[in[2]+i])
+
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_MUL -- Multiplication function
+
+procedure vex_mul (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = Memi[in[1]+i] * Memi[in[2]+i]
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = Memr[in[1]+i] * Memr[in[2]+i]
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = Memd[in[1]+i] * Memd[in[2]+i]
+
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_NE -- Logical inequality
+
+procedure vex_ne (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, TY_INT)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] != Memi[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in[1]+i] != Memr[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in[1]+i] != Memd[in[2]+i]) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_NEG -- Negation function
+
+procedure vex_neg (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = - Memi[in+i]
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = - Memr[in+i]
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = - Memd[in+i]
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_NINT -- Nearest integer
+
+procedure vex_nint (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	in, out
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 
+		Memi[out+i] = Memi[in+i]
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = anint (Memr[in+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = anint (Memd[in+i])
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_NOT -- Logical negation
+
+procedure vex_not (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	out = stk_alloc (stack, len, TY_INT)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in+i] != 0) {
+		    Memi[out+i] = 0
+		} else {
+		    Memi[out+i] = 1
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in+i] != 0.0) {
+		    Memi[out+i] = 0
+		} else {
+		    Memi[out+i] = 1
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in+i] != 0.0) {
+		    Memi[out+i] = 0
+		} else {
+		    Memi[out+i] = 1
+		}
+	    }
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_OR -- Logical or
+
+procedure vex_or (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, TY_INT)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in[1]+i] != 0 || Memi[in[2]+i] != 0) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in[1]+i] != 0.0 || Memr[in[2]+i] != 0.0) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in[1]+i] != 0.0 || Memd[in[2]+i] != 0.0) {
+		    Memi[out+i] = 1
+		} else {
+		    Memi[out+i] = 0
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_POW -- Exponentiation function
+
+procedure vex_pow (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+double	dtemp
+int	index, len, type, i
+pointer	out, in[2]
+real	rtemp
+
+double	vex_errf()
+int	stk_pos()
+pointer stk_alloc()
+
+begin
+	# If the exponent is an integer, use the normal exponentiation
+	# otherwise, use the logarithmic formulation
+
+	call stk_get (stack, TOP, in[2], len, type)
+
+	if (type == TY_INT) {
+	    index = stk_pos (stack, 2)
+	    call stk_get (stack, index, in[1], len, type)
+
+	    out = stk_alloc (stack, len, type)
+	    len = max (len, 1)
+
+	    switch (type) {
+	    case TY_INT, TY_LONG:
+		do i = 0, len-1
+		    Memi[out+i] = Memi[in[1]+i] ** Memi[in[2]+i]
+	    case TY_REAL:
+		do i = 0, len-1
+		    Memr[out+i] = Memr[in[1]+i] ** Memi[in[2]+i]
+	    case TY_DOUBLE:
+		do i = 0, len-1
+		    Memd[out+i] = Memd[in[1]+i] ** Memi[in[2]+i]
+	    }
+
+	} else {
+	    call stk_fetch (stack, 2, in, len, type)
+	    out = stk_alloc (stack, len, type)
+	    len = max (len, 1)
+
+	    switch (type) {
+	    case TY_REAL:
+		do i = 0, len-1 {
+		    if (Memr[in[1]+i] <= 0.0) {
+			Memr[out+i] = vex_errf (stack, i)
+		    } else {
+			rtemp = Memr[in[2]+i] * log(Memr[in[1]+i])
+			if (rtemp > MAX_EXP) {
+			    Memr[out+i] = vex_errf (stack, i)
+			} else {
+			    Memr[out+i] = exp (rtemp)
+			}
+		    }
+		}
+
+	    case TY_DOUBLE:
+		do i = 0, len-1 {
+		    if (Memd[in[1]+i] <= 0.0) {
+			Memd[out+i] = vex_errf (stack, i)
+		    } else {
+			dtemp = Memd[in[2]+i] * log(Memd[in[1]+i])
+			if (dtemp > MAX_EXP) {
+			    Memd[out+i] = vex_errf (stack, i)
+			} else {
+			    Memd[out+i] = exp (dtemp)
+			}
+		    }
+		}
+	    }
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_PUSH -- Push a token onto the stack
+
+procedure vex_push (stack, getvar, type, token)
+
+pointer	stack		# i: Stack structure
+extern	getvar		# i: Function to return a variable
+int	type		# i: Token type
+char	token[ARB]	# i: Token string
+#--
+double	dval
+int	len, ic, nc, ival
+pointer	sp, errmsg, var
+real	rval
+
+string	badtype  "Unrecognized token type (%d)"
+
+int	ctoi(), ctor(), ctod()
+pointer stk_alloc()
+errchk	getvar
+
+begin
+	call smark (sp)
+	call salloc (errmsg, SZ_LINE, TY_CHAR)
+
+	len = STK_LENVAL(stack)
+
+	switch (type) {
+	case Y_VAR:
+	    call getvar (stack, token)
+
+	case Y_INT:
+	    var = stk_alloc (stack, len, TY_INT)
+
+	    ic = 1
+	    len = max (len, 1)
+	    nc = ctoi (token, ic, ival)
+	    call amovki (ival, Memi[var], len)
+
+	case Y_REAL:
+	    var = stk_alloc (stack, len, TY_REAL)
+
+	    ic = 1
+	    len = max (len, 1)
+	    nc = ctor (token, ic, rval)
+	    call amovkr (rval, Memr[var], len)
+
+	case Y_DOUBLE:
+	    var = stk_alloc (stack, len, TY_DOUBLE)
+
+	    ic = 1
+	    len = max (len, 1)
+	    nc = ctod (token, ic, dval)
+	    call amovkd (dval, Memd[var], len)
+
+	default:
+	    call sprintf (Memc[errmsg], SZ_LINE, badtype)
+	    call pargi (type)
+	    call error (1, Memc[errmsg])
+	}
+
+	call sfree (sp)
+end
+
+# VEX_REAL -- Convert to real
+
+procedure vex_real (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+pointer	out
+
+begin
+	call stk_coerce (stack, TOP, TY_REAL, out)
+
+end
+
+# VEX_SIG -- Sign transfer function
+
+procedure vex_sig (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = sign (Memi[in[1]+i], Memi[in[2]+i])
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = sign (Memr[in[1]+i], Memr[in[2]+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = sign (Memd[in[1]+i], Memd[in[2]+i])
+
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_SIN -- Sine function
+
+procedure vex_sin (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memr[out+i] = sin (real (Memi[in+i]))
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = sin (Memr[in+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = sin (Memd[in+i])
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_SINH -- Hyperbolic sine function
+
+procedure vex_sinh (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in+i] > MAX_EXP) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = sinh (real (Memi[in+i]))
+		}
+	    }
+
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in+i] > MAX_EXP) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = sinh (Memr[in+i])
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in+i] > MAX_EXP) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		Memd[out+i] = sinh (Memd[in+i])
+		}
+	    }
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_SQR -- Second power
+
+procedure vex_sqr (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = Memi[in+i] * Memi[in+i]
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = Memr[in+i] * Memr[in+i]
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = Memd[in+i] * Memd[in+i]
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_SQRT -- Square root function
+
+procedure vex_sqrt (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+double	vex_errf()
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1 {
+		if (Memi[in+i] < 0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = sqrt (real (Memi[in+i]))
+		}
+	    }
+
+	case TY_REAL:
+	    do i = 0, len-1 {
+		if (Memr[in+i] < 0.0) {
+		    Memr[out+i] = vex_errf (stack, i)
+		} else {
+		    Memr[out+i] = sqrt (Memr[in+i])
+		}
+	    }
+
+	case TY_DOUBLE:
+	    do i = 0, len-1 {
+		if (Memd[in+i] < 0.0) {
+		    Memd[out+i] = vex_errf (stack, i)
+		} else {
+		    Memd[out+i] = sqrt (Memd[in+i])
+		}
+	    }
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_SUB -- Subtraction function
+
+procedure vex_sub (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in[2]
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 2, in, len, type)
+	out = stk_alloc (stack, len, type)
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memi[out+i] = Memi[in[1]+i] - Memi[in[2]+i]
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = Memr[in[1]+i] - Memr[in[2]+i]
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = Memd[in[1]+i] - Memd[in[2]+i]
+
+	}
+
+	call stk_pop (stack, 2)
+end
+
+# VEX_TAN -- Tangent function
+
+procedure vex_tan (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memr[out+i] = tan (real (Memi[in+i]))
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = tan (Memr[in+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = tan (Memd[in+i])
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+# VEX_TANH -- Hyperbolic tangent function
+
+procedure vex_tanh (stack)
+
+pointer	stack		# u: Stack descriptor
+#--
+int	len, type, i
+pointer	out, in
+
+pointer stk_alloc()
+
+begin
+	call stk_fetch (stack, 1, in, len, type)
+	if (type == TY_INT) {
+	    out = stk_alloc (stack, len, TY_REAL)
+	} else {
+	    out = stk_alloc (stack, len, type)
+	}
+	len = max (len, 1)
+
+	switch (type) {
+	case TY_INT, TY_LONG:
+	    do i = 0, len-1
+		Memr[out+i] = tanh (real (Memi[in+i]))
+
+	case TY_REAL:
+	    do i = 0, len-1
+		Memr[out+i] = tanh (Memr[in+i])
+
+	case TY_DOUBLE:
+	    do i = 0, len-1
+		Memd[out+i] = tanh (Memd[in+i])
+
+	}
+
+	call stk_pop (stack, 1)
+end
+
+
+
+
diff --git a/pkg/utilities/nttools/stxtools/vexstack.x b/pkg/utilities/nttools/stxtools/vexstack.x
new file mode 100644
index 00000000..8f51b2bb
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/vexstack.x
@@ -0,0 +1,585 @@
+include "vex.h"
+
+# VEX_STACK -- Procedures which manipulate the vex stack
+#
+# The expression evaluator, vex_eval, uses a stack to hold intermediate
+# results, constants, and variable names in the expression. There are
+# actually two stacks, a type stack wich contains the data types of the
+# elements on the stack, and a value stack, which contains pointers to
+# the stack elements. Constants and variable names are stored in two
+# buffers which are part of the stack structure and pointers to their
+# locations are placed on the stack. Intermediate results are stored in 
+# malloc'ed arrays and their pointers are also placed on the stack. The
+# stack structure contains three indices, bottom, an index one greater
+# than the last constant or variable name, top, an index that is one 
+# greater than the current top of stack, and high, an index that is one 
+# greater than the last valid pointer on the stack. Valid pointers exist
+# beyond the top of stack because the arrays which store intermediate 
+# results are not mfree'd when the stack is popped, instead, they are 
+# kept in case they may be needed for a future intermediate result. The 
+# only user callable procedure in this file is stk_alloc, which should 
+# be called by getvar, the user's function which fills an array when
+# passed the name of a variable.
+#
+# B.Simon	24-Apr-91	Original
+# B.Simon	15-Oct-98	Store strings in pseudocode, not on stack
+
+# STK_ALLOC -- Allocate an array of the specified length and type
+
+pointer procedure stk_alloc (stack, len, type)
+
+pointer	stack		# i: Stack structure
+int	len		# i: Length of array to allocate
+int	type		# i: Data type of array (spp type)
+#--
+int	index, stype, top
+pointer	var, svar
+
+string	badstack  "stk_alloc: illegal type on stack"
+string	badsize   "Requested array size does not match previous requests"
+
+errchk	stk_find
+
+begin
+	# Check to see if array length is being defined for the first time
+
+	if (STK_LENVAL(stack) == 0 && len != 0) {
+
+	    # Store length in stack structure
+
+	    STK_LENVAL(stack) = len
+
+	    # Free all stack arrays not currently being used
+
+	    index = STK_TOP(stack)
+	    while (index < STK_HIGH(stack)) {
+		svar = STK_VALUE(stack,index)
+		stype = STK_TYPE(stack,index)
+		call mfree (svar, stype)
+		index = index + 1
+	    }
+	    STK_HIGH(stack) = STK_TOP(stack)
+
+	    # Reallocate the null buffer
+
+	    if (STK_NULLARY(stack) != NULL) {
+		call stk_freenull (stack)
+		call stk_initnull (stack, true)
+	    }
+
+	    # Convert length one arrays to their full length
+
+	    index = 0
+	    while (index < STK_TOP(stack)) {
+	        svar = STK_VALUE(stack,index)
+		stype = STK_TYPE(stack,index)
+
+		call malloc (var, len, stype)
+		STK_VALUE(stack,index) = var
+		switch (stype) {
+		case TY_INT,TY_LONG:
+		    call amovki (Memi[svar], Memi[var], len)
+		    call mfree (svar, TY_INT)
+		case TY_REAL:
+		    call amovkr (Memr[svar], Memr[var], len)
+		    call mfree (svar, TY_REAL)
+		case TY_DOUBLE:
+		    call amovkd (Memd[svar], Memd[var], len)
+		    call mfree (svar, TY_DOUBLE)
+		default:
+		    call error (1, badstack)
+		}		
+		index = index + 1
+	    }
+	}
+
+	# Check requested size
+
+	if (len != 0 && len != STK_LENVAL(stack))
+	    call error (1, badsize)
+
+	# Look for an existing array of the same type
+
+	call stk_find (stack, type, index)
+
+	# Increment top of stack pointer
+
+	top = STK_TOP(stack)
+	STK_TOP(stack) = top + 1
+
+	# Swap array with one currently at top of stack
+
+	if (top != index) {
+	    stype = STK_TYPE(stack,top)
+	    STK_TYPE(stack,top) = STK_TYPE(stack,index)
+	    STK_TYPE(stack,index) = stype
+
+	    svar = STK_VALUE(stack,top)
+	    STK_VALUE(stack,top) = STK_VALUE(stack,index)
+	    STK_VALUE(stack,index) = svar
+	}
+
+	var = STK_VALUE(stack,top)
+	return (var)
+end
+
+# STK_CLEAR -- Clear all stack elements above the bottom
+
+procedure stk_clear (stack)
+
+pointer	stack		# u: Stack pointer
+#--
+int	index
+
+begin
+	# Free all value arrays above the bottom of stack
+
+	index = 0
+	while (index < STK_HIGH(stack)) {
+	    call mfree (STK_VALUE(stack,index), STK_TYPE(stack,index))
+	    index = index + 1
+	}
+
+	# Free null array
+
+	call stk_freenull (stack)
+
+	# Reset scalars
+
+	STK_TOP(stack) = 0
+	STK_HIGH(stack) = 0
+	STK_LENVAL(stack) = 0
+end
+
+# STK_COERCE -- Coerce an array in the stack to the specified type
+
+procedure stk_coerce (stack, pos, type, var)
+
+pointer	stack		# i: Stack descriptor
+int	pos		# i: Position of array in stack
+int	type		# i: New type for array
+pointer	var		# o: New pointer to array
+#--
+int	index, last, stype, len, i
+pointer	svar
+
+string	underflow  "stk_coerce: underflow in expression evaluator"
+
+errchk	stk_find
+
+begin
+	# Convert relative to absolute position
+
+	if (pos == TOP) {
+	    index = STK_TOP(stack) - 1
+	    if (index < 0)
+		call error (1, underflow)
+	} else {
+	    index = pos
+	}
+
+	# If type of array matches requested type, return pointer to array
+	# Otherwise, get new array and copy old array to it
+
+	if (type == STK_TYPE(stack,index)) {
+	    var = STK_VALUE(stack,index)
+
+	} else {
+	    # Find array of correct type
+
+	    last = index
+	    call stk_find (stack, type, index)
+
+	    # Copy array, converting to new type
+
+	    len = max (1, STK_LENVAL(stack))
+	    var = STK_VALUE(stack,index)
+
+	    stype = STK_TYPE(stack,last)
+	    svar = STK_VALUE(stack,last)
+
+	    switch (type) {
+	    case TY_INT,TY_LONG:
+		switch (stype) {
+		case TY_INT,TY_LONG:
+		    ; # can't happen
+		case TY_REAL:
+		    do i = 0, len-1 {
+			if (IS_INDEFR(Memr[svar+i])) {
+			    Memi[var+i] = INDEFI
+			} else {
+			    Memi[var+i] = Memr[svar+i]
+			}
+		    }
+		case TY_DOUBLE:
+		    do i = 0, len-1 {
+			if (IS_INDEFD(Memd[svar+i])) {
+			    Memi[var+i] = INDEFI
+			} else {
+			    Memi[var+i] = Memd[svar+i]
+			}
+		    }
+		}
+	    case TY_REAL:
+		switch (stype) {
+		case TY_INT,TY_LONG:
+		    do i = 0, len-1 {
+			if (IS_INDEFI(Memi[svar+i])) {
+			    Memr[var+i] = INDEFR
+			} else {
+			    Memr[var+i] = Memi[svar+i]
+			}
+		    }
+		case TY_REAL:
+		    ; # can't happen
+		case TY_DOUBLE:
+		    do i = 0, len-1 {
+			if (IS_INDEFD(Memd[svar+i])) {
+			    Memr[var+i] = INDEFR
+			} else {
+			    Memr[var+i] = Memd[svar+i]
+			}
+		    }
+		}
+	    case TY_DOUBLE:
+		switch (stype) {
+		case TY_INT,TY_LONG:
+		    do i = 0, len-1 {
+			if (IS_INDEFI(Memi[svar+i])) {
+			    Memd[var+i] = INDEFD
+			} else {
+			    Memd[var+i] = Memi[svar+i]
+			}
+		    }
+		case TY_REAL:
+		    do i = 0, len-1 {
+			if (IS_INDEFR(Memr[svar+i])) {
+			    Memd[var+i] = INDEFD
+			} else {
+			    Memd[var+i] = Memr[svar+i]
+			}
+		    }
+		case TY_DOUBLE:
+		    ; # can't happen
+		}
+	    }
+
+	    # Swap position of new and old arrays on stack
+
+	    STK_TYPE(stack,last) = STK_TYPE(stack,index)
+	    STK_TYPE(stack,index) = stype
+
+	    STK_VALUE(stack,last) = STK_VALUE(stack,index)
+	    STK_VALUE(stack,index) = svar
+	}
+	
+end
+
+# STK_FETCH -- Fetch the specified number of arrays from the stack
+
+procedure stk_fetch (stack, nvar, var, len, type)
+
+pointer	stack		# i: Stack descriptor
+int	nvar		# i: Number of pointers requested
+pointer	var[ARB]	# o: Array pointers
+int	len		# o: Length of arrays
+int	type		# o: Type of arrays
+#--
+int	one, two, index, ivar
+
+string	underflow  "stk_fetch: underflow in expression evaluator"
+
+errchk	stk_coerce
+
+begin
+	# If length is not yet defined, STK_LENVAL equals zero
+
+	len = STK_LENVAL(stack)
+
+	# Find the highest type in the pointers to be returned
+
+	one = STK_TOP(stack) - 1
+	two = STK_TOP(stack) - 2
+
+	type = STK_TYPE(stack,one)
+	if (nvar > 1) {
+	    switch (STK_TYPE(stack,two)) {
+	    case TY_INT, TY_LONG:
+		;
+	    case TY_REAL:
+		if (type == TY_INT)
+		    type = TY_REAL
+	    case TY_DOUBLE:
+		type = TY_DOUBLE
+	    }
+	}
+
+	# Retrieve pointers to arrays from stack. var[nvar] is top of stack
+	# Convert arrays to output type when the type differs
+
+	index = STK_TOP(stack) - nvar
+	do ivar = 1, nvar {
+	    if (index < 0)
+		call error (1, underflow)
+
+	    if (type == STK_TYPE(stack,index) || index < two) {
+		var[ivar] = STK_VALUE(stack,index)
+	    } else {
+	        call stk_coerce (stack, index, type, var[ivar])
+	    }
+	    index = index + 1
+	}
+
+end
+
+# STK_FIND -- Find a free array of the proper type on the stack
+
+procedure stk_find (stack, type, index)
+
+pointer	stack		# i: Stack descriptor
+int	type		# i: Required type
+int	index		# o: Position on the stack
+#--
+int	len
+pointer	var
+
+string	overflow  "Expression too complex to be evaluated"
+
+begin
+	# Try to find an array of the proper type already on the stack
+
+	index = STK_TOP(stack)
+	while (index < STK_HIGH(stack)) {
+	    if (type == STK_TYPE(stack,index))
+		break
+
+	    index = index + 1
+	}
+
+	# If not found, allocate a new array
+
+	if (index == MAX_STACK) {
+	    call error (1, overflow)
+
+	} else if (index == STK_HIGH(stack)) {
+	    len = max (1, STK_LENVAL(stack))
+	    call malloc (var, len, type)
+
+	    STK_TYPE(stack,index) = type
+	    STK_VALUE(stack,index) = var
+	    STK_HIGH(stack) = STK_HIGH(stack) + 1
+	}
+
+end
+
+# STK_FREE -- Free memory used by the stack
+
+procedure stk_free (stack)
+
+pointer	stack		# u: Stack pointer
+#--
+
+begin
+	# Free all values above the stack bottom
+
+	call stk_clear (stack)
+
+	# Free substructures in stack
+
+	if (STK_NULLARY(stack) != NULL)
+	    call mfree (STK_NULLARY(stack), TY_BOOL)
+
+	call mfree (STK_VALARY(stack), TY_INT)
+	call mfree (STK_TYPARY(stack), TY_INT)
+
+	# Free the stack structure
+	call mfree (stack, TY_INT)
+end
+
+# STK_FREENULL -- Free the null array in the stack
+
+procedure stk_freenull (stack)
+
+pointer	stack		# u: Stack structure
+#--
+
+begin
+	if (STK_NULLARY(stack) != NULL)
+	    call mfree (STK_NULLARY(stack), TY_BOOL)
+
+	STK_NULLARY(stack) = NULL
+end
+
+# STK_GET -- Get a single array from the stack
+
+procedure stk_get (stack, pos, var, len, type)
+
+pointer	stack		# i: Stack descriptor
+int	pos		# i: Position on the stack
+pointer	var		# o: Pointer to array
+int	len		# o: Length of array
+int	type		# o: Type of the array
+#--
+int	index
+
+string	underflow  "stk_get: underflow in expression evaluator"
+
+begin
+	# Convert relative to absolute position
+
+	if (pos == TOP) {
+	    index = STK_TOP(stack) - 1
+	    if (index < 0)
+		call error (1, underflow)
+	} else {
+	    index = pos
+	}
+
+	var = STK_VALUE(stack,index)
+	len = STK_LENVAL(stack)
+	type = STK_TYPE(stack,index)
+end
+
+# STK_GETNULL -- Get the null array from the stack
+
+procedure stk_getnull (stack, nullvec)
+
+pointer	stack		# i: Stack structure
+pointer nullvec		# o: Null array
+#--
+
+begin
+	nullvec = STK_NULLARY(stack)
+end
+
+# STK_INIT -- Initialize the stack
+
+procedure stk_init (stack)
+
+pointer	stack		# o: Stack pointer
+#--
+
+begin
+	# Allocate stack and initialize members to zero
+
+	call calloc (stack, SZ_STKSTRUCT, TY_INT)
+
+	# Allocate substructures in stack
+
+	call malloc (STK_VALARY(stack), MAX_STACK, TY_INT)
+	call malloc (STK_TYPARY(stack), MAX_STACK, TY_INT)
+
+end
+
+# STK_INITNULL -- Initialize the null array on the stack
+
+procedure stk_initnull (stack, value)
+
+pointer	stack		# u: Stack structure
+bool	value		# i: Value used in initialization
+#--
+int	len, i
+pointer	nullvec
+
+begin
+	# Only initialize if array doesn't exist
+
+	if (STK_NULLARY(stack) == NULL) {
+	    len = STK_LENVAL(stack)
+
+	    # Allocate array
+	    call malloc (nullvec, len, TY_BOOL)
+	    STK_NULLARY(stack) = nullvec
+
+	    # Initialize to value
+	    do i = 0, len-1
+		Memb[nullvec+i] = value
+	}
+
+end
+
+# STK_ORNULL -- Update null array by doing a logical or
+
+procedure stk_ornull (stack, newvec, newlen)
+
+pointer	stack		# u: Stack structure
+bool	newvec[ARB]	# i: Array of new values
+int	newlen		# i: Length of new array 
+#--
+int	len, i
+pointer	nullvec
+
+string	badlength  "stk_ornull: length of array does not match null array"
+
+begin
+	len = STK_LENVAL(stack)
+	if (len != newlen)
+	    call error (1, badlength)
+
+	call stk_initnull (stack, false)
+	nullvec = STK_NULLARY(stack)
+
+	do i = 1, len {
+	    Memb[nullvec] = Memb[nullvec] || newvec[i]
+	    nullvec = nullvec + 1
+	}
+
+end
+
+# STK_POP -- Remove the specified number of arrays from the stack
+
+procedure stk_pop (stack, npop)
+
+pointer	stack		# u: Stack structure
+int	npop		# i: Number of arrays to pop
+#--
+int	top, index, type
+pointer	var
+
+string	underflow  "stk_pop: underflow in expression evaluator"
+
+begin
+
+	top = STK_TOP(stack) - 1
+	index = top - npop
+
+	if (index < 0) {
+	    call error (1, underflow)
+	} else {
+	    STK_TOP(stack) = index + 1
+	}
+
+	var = STK_VALUE(stack,index)
+	STK_VALUE(stack,index) = STK_VALUE(stack,top)
+	STK_VALUE(stack,top) = var
+
+	type = STK_TYPE(stack,index)
+	STK_TYPE(stack,index) = STK_TYPE(stack,top)
+	STK_TYPE(stack,top) = type
+
+end
+
+# STK_POS -- Compute absolute position on stack
+
+int procedure stk_pos (stack, pos)
+
+pointer	stack		# i: Stack structure
+int	pos		# i: Position relative to top of stack
+#--
+
+begin
+	return (STK_TOP(stack) - pos)
+end
+
+# STK_SETNULL -- Set a single value in the null array to true
+
+procedure stk_setnull (stack, index)
+
+pointer	stack		# u: Stack structure
+int	index		# i: Index into null array
+#--
+
+begin
+	STK_NULL(stack,index) = true
+end
+
diff --git a/pkg/utilities/nttools/stxtools/wcslab/mkpkg b/pkg/utilities/nttools/stxtools/wcslab/mkpkg
new file mode 100644
index 00000000..f5083925
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/mkpkg
@@ -0,0 +1,17 @@
+# WCSLAB 
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	wlutil.x	<imio.h> <imhdr.h> <gset.h> <math.h>
+	wcslab.x	<gset.h> <imhdr.h> <mwset.h> <math.h> "wcslab.h"\
+			"wcs_desc.h"
+	wlwcslab.x	<gio.h> <gset.h> "wcslab.h" "wcs_desc.h"
+	wlsetup.x	<gset.h> <mach.h> <math.h> <math/curfit.h>\
+			"wcslab.h" "wcs_desc.h"
+	wlgrid.x	<gset.h> <math.h> "wcslab.h" "wcs_desc.h"
+	wllabel.x	<gset.h> <math.h> "psiescape.h" "wcslab.h" "wcs_desc.h"
+	;
diff --git a/pkg/utilities/nttools/stxtools/wcslab/mkpkg.ori b/pkg/utilities/nttools/stxtools/wcslab/mkpkg.ori
new file mode 100644
index 00000000..7108366c
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/mkpkg.ori
@@ -0,0 +1,18 @@
+# WCSLAB 
+
+$checkout libpkg.a ../
+$update libpkg.a
+$checkin libpkg.a ../
+$exit
+
+libpkg.a:
+	t_wcslab.x	<gset.h> <imhdr.h>
+	wlutil.x	<imio.h> <imhdr.h> <gset.h> <math.h>
+	wcslab.x	<gset.h> <imhdr.h> <mwset.h> <math.h> "wcslab.h"\
+			"wcs_desc.h"
+	wlwcslab.x	<gio.h> <gset.h> "wcslab.h" "wcs_desc.h"
+	wlsetup.x	<gset.h> <mach.h> <math.h> <math/curfit.h>\
+			"wcslab.h" "wcs_desc.h"
+	wlgrid.x	<gset.h> <math.h> "wcslab.h" "wcs_desc.h"
+	wllabel.x	<gset.h> <math.h> "wcslab.h" "wcs_desc.h"
+	;
diff --git a/pkg/utilities/nttools/stxtools/wcslab/psiescape.h b/pkg/utilities/nttools/stxtools/wcslab/psiescape.h
new file mode 100644
index 00000000..46da4ea2
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/psiescape.h
@@ -0,0 +1,80 @@
+.help psiescape.h 1May92 plot
+.ih
+.NAME
+psiescape.h -- Define the special GIO escape instructions.
+.ih
+DESCRIPTION
+The following escape instructions are defined for the PostScript GKI
+Interpreter:
+
+  PS_CODE - Send the raw PostScript code to the output.
+  PS_IMAGE_RED_LUT - Download a new lookup table for the Red component
+                     of an image.
+  PS_IMAGE_GREEN_LUT - Download a new lookup table for the Green component
+                       of an image.
+  PS_IMAGE_BLUE_LUT  - Download a new lookup table for the Blue component
+                       of an image.
+  PS_GR_RED_LUT      - Download a new lookup table for the Red component
+                       for the graphics.
+  PS_GR_GREEN_LUT    - Download a new lookup table for the Green component
+                       for the graphics.
+  PS_GR_BLUE_LUT     - Download a new lookup table for the Blue component
+                       for the graphics.
+  PS_ROMAN_FONT      - Specify a new font for the normal font.
+  PS_GREEK_FONT      - Specify a new font for the greek font.
+  PS_ITALIC_FONT     - Specify a new font for the italic font.
+  PS_BOLD_FONT       - Specify a new font for the bold font.
+  PS_VARIABLE_SPACE  - Change whether characters are mono-spaced or
+                       variable-spaced.
+  PS_DASH, PS_DOT,
+  PS_SPACE           - Change the sizes of a dash, a dot, and the space
+                       between them.
+  PS_FILL_PATTERN    - Add/change fill patterns.
+
+The size of the instruction array should have the following minimums:
+  - For the PS_CODE instruction, the array should be the length of the string
+    being passed.
+  - The size of each image LUT array is PS_IMAGE_LUT_SIZE.
+  - The size of each graphics LUT array is PS_GR_LUT_SIZE.
+  - The font arrays should be the length of the string containing the name
+    of the font to use.
+  - For the PS_VARIABLE_SPACE, the size is PS_VARIABLE_SPACE_SIZE.
+  - For PS_FILL_PATTERN, the size is PS_FILL_SIZE.
+  
+.ih
+SEE ALSO
+t_psikern
+.endhelp
+#---------------------------------------------------------------------------
+
+# Define the escape instructions.
+define	PS_CODE               	1001
+define 	PS_IMAGE_RED_LUT      	1002
+define 	PS_IMAGE_GREEN_LUT    	1003
+define 	PS_IMAGE_BLUE_LUT     	1004
+define 	PS_GR_RED_LUT         	1005
+define 	PS_GR_GREEN_LUT       	1006
+define 	PS_GR_BLUE_LUT        	1007
+define 	PS_ROMAN_FONT         	1008
+define 	PS_GREEK_FONT         	1009
+define 	PS_ITALIC_FONT        	1010
+define 	PS_BOLD_FONT          	1011
+define 	PS_VARIABLE_SPACE     	1012
+define 	PS_DOT                	1013
+define 	PS_DASH               	1014
+define 	PS_SPACE              	1015
+define 	PS_FILL_PATTERN       	1016
+define	PS_IMAGE_LUT		1017
+define	PS_GRAPHICS_LUT		1018
+
+# Define the sizes of the instruction arrays.
+define 	PS_MAX_LUT_VALUE	255
+define 	PS_IMAGE_LUT_SIZE	256
+define 	PS_GR_LUT_SIZE		16
+define 	PS_VARIABLE_SPACE_SIZE	1
+define 	PS_FILL_SIZE		9
+
+# Define how to pack/unpack a LUT defined as reals from 0-1 into
+# a short array from 0-PS_MAX_LUT_VALUE.
+define 	PS_PACKLUT    		(int($1*PS_MAX_LUT_VALUE))
+define 	PS_UNPACKLUT  		($1/real(PS_MAX_LUT_VALUE))
diff --git a/pkg/utilities/nttools/stxtools/wcslab/t_wcslab.x b/pkg/utilities/nttools/stxtools/wcslab/t_wcslab.x
new file mode 100644
index 00000000..acafdf2f
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/t_wcslab.x
@@ -0,0 +1,136 @@
+include <gset.h>
+include <imhdr.h>
+
+# T_WCSLAB -- Procedure to draw labels and grids in sky projection coordinates.
+#
+# Description
+#  T_wcslab produces a labelling and grid based on the MWCS of a 
+#  specified image.  This is the task interface to the programmer interface
+#  wcslab.  See wcslab.x for more information.
+#
+# Bugs 
+#  Can only handle sky projections for Right Ascension/Declination.   This
+#  should be able to deal with any of the projections for this system, but
+#  has only been tested with the Tangent projection.
+#
+
+procedure t_wcslab()
+
+pointer image           # I: name of the image
+int	frame		# I: display frame containing the image
+bool	do_fill         # I: true if the graph fills the specified viewport
+int	mode            # I: the graphics stream mode 
+pointer	device          # I: the name of the graphics device
+real	vl, vr, vb, vt  # I: the edges of the graphics viewport
+
+pointer	sp, title, gp, im, mw
+real	c1, c2, l1, l2
+bool	clgetb()
+int	clgeti(), strncmp()
+pointer	gopen(), immap(), mw_openim()
+real	clgetr()
+
+begin
+	# Get memory.
+	call smark (sp)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (title, SZ_LINE, TY_CHAR)
+
+	# Since all the MWCS information comes from an image open it.
+	call clgstr ("image", Memc[image], SZ_FNAME)
+
+	if (Memc[image] != EOS) {
+
+	    # Open the image.
+	    im = immap (Memc[image], READ_ONLY, 0)
+
+	    # Quit if the image is not 2-dimensional.
+	    if (IM_NDIM(im) != 2) {
+	        call eprintf ("Image: %s is not 2-dimensional\n")
+		    call pargstr (Memc[image])
+	        call sfree (sp)
+	        return
+	    }
+
+	    # Set the default input image column and line limits.
+	    c1 = 1.0
+	    c2 = real (IM_LEN(im,1))
+	    l1 = 1.0
+	    l2 = real (IM_LEN(im,2))
+
+	    # Open the WCS.
+	    mw = mw_openim (im)
+
+	    # Set up the default image title.
+	    call strcpy (Memc[image], Memc[title], SZ_LINE)
+	    call strcat (": ", Memc[title], SZ_LINE)
+	    call strcat (IM_TITLE(im), Memc[title], SZ_LINE)
+
+	} else {
+
+	    # Set the image information to undefined. All this will
+	    # be determined in wcslab.
+	    Memc[title] = EOS
+	    im = NULL
+	    mw = NULL
+	    c1 = 0.0
+	    c2 = 1.0
+	    l1 = 0.0
+	    l2 = 1.0
+	}
+
+	# Set the graphics mode depending on whether we are appending to a plot
+	# or starting a new plot.
+	do_fill = clgetb ("fill")
+	if (clgetb ("append")) 
+	    mode = APPEND
+	else
+	    mode = NEW_FILE
+
+	# Open graphics.
+	call clgstr ("device", Memc[device], SZ_FNAME)
+
+	# If we are appending, get the previous viewing parameters.
+	if (mode == APPEND) {
+
+	    gp = gopen (Memc[device], APPEND, STDGRAPH)
+	    call ggview (gp, vl, vr, vb, vt)
+	    do_fill = true
+
+	# If drawing on the image display device try to match viewports.
+	} else if (strncmp (Memc[device], "imd", 3) == 0) {
+
+	    frame = clgeti ("frame")
+	    vl = clgetr ("vl")
+	    vr = clgetr ("vr")
+	    vb = clgetr ("vb")
+	    vt = clgetr ("vt")
+	    call wl_imd_viewport (frame, im, c1, c2, l1, l2, vl, vr, vb, vt)
+	    gp = gopen (Memc[device], NEW_FILE, STDGRAPH)
+
+	# Otherwise set up a standard viewport.
+	} else {
+	    vl = clgetr ("vl")
+	    vr = clgetr ("vr")
+	    vb = clgetr ("vb")
+	    vt = clgetr ("vt")
+	    gp = gopen (Memc[device], NEW_FILE, STDGRAPH)
+	}
+
+	# Set the viewport.
+	call gseti (gp, G_WCS, 1)
+	call wl_map_viewport (gp, c1, c2, l1, l2, vl, vr, vb, vt, do_fill)
+
+	# All reading from CL parameters is now done.  Everything necessary to
+	# do the plotting is in the WCSLAB descriptor.  Do it.
+	call wcslab (mw, c1, c2, l1, l2, gp, Memc[title])
+
+	# Release the memory.
+	call gclose (gp) 
+	if (mw != NULL)
+	    call mw_close (mw)
+	if (im != NULL)
+	    call imunmap (im) 
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/stxtools/wcslab/wcs_desc.h b/pkg/utilities/nttools/stxtools/wcslab/wcs_desc.h
new file mode 100644
index 00000000..4f6b2a30
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/wcs_desc.h
@@ -0,0 +1,219 @@
+# WCS_DESC - The definition of the WCSLAB descriptor memory structure.
+#
+# Description
+#   This include file defines the memory structures and macros needed to
+#   access elements of a WCSLAB descriptor.  The descriptor provides all
+#   the necessary elements for the routine wcslab to produce a labeled
+#   graph.
+#
+# History
+#   9May91 - Created the descriptor.  Jonathan D. Eisenhamer, STScI.
+#  15May91 - Modified the descriptor to contain only pointers to arrays.
+#            Two routines, wcs_create and wcs_destroy are required to
+#            create the arrays that are pointed to in the descriptor. 
+#            Also seperated the include file from the wcslab.h file. jde
+#  12Jun91 - Rewrote some of the labelling parameters. jde
+#  20Jun91 - Redesigned much of the parameters. jde
+#---------------------------------------------------------------------------
+
+# Value of opposite axis that polar labels should appear along.
+define WL_POLAR_LABEL_POSITION   Memd[P2D($1)]
+
+# The rotation between the Logical and World coordinate systems.
+define WL_ROTA                   Memd[P2D($1+2)]
+
+# Size of the axis titles.
+define WL_AXIS_TITLE_SIZE        Memr[P2R($1+4)]
+
+# The offset required to properly calculate positions in the image display.
+define WL_IMAGE_X_OFF            Memr[P2R($1+5)]
+define WL_IMAGE_Y_OFF            Memr[P2R($1+6)]
+
+# Size of the grid labels.
+define WL_LABEL_SIZE             Memr[P2R($1+7)]
+
+# Major tick mark size.
+define WL_MAJ_TICK_SIZE          Memr[P2R($1+8)]
+
+# Minor tick mark size.
+define WL_MIN_TICK_SIZE          Memr[P2R($1+9)]
+
+# Magnification of the text size for the title.
+define WL_TITLE_SIZE             Memr[P2R($1+10)]
+
+# The side in polar/near-polar plots not to put Axis 1 labels.
+define WL_BAD_LABEL_SIDE         Memi[$1+11]
+
+# The type of graph that will be produced.  The possible value are:
+#
+#   UNKNOWN    -> Graph type will be determined
+#   NORMAL     -> Approximate a cartesian grid
+#   POLAR      -> Graph center on a pole
+#   NEAR_POLAR -> Graph very close to a pole
+
+define WL_GRAPH_TYPE             Memi[$1+12]
+
+# Number of segments each line should be broken into to plot it.
+define WL_LINE_SEGMENTS          Memi[$1+13]
+
+# The grid line type for major grids.  The possible values are to standard 
+# IRAF GIO polyline types.
+define WL_MAJ_LINE_TYPE          Memi[$1+14]
+
+# The grid line type for minor grids.  The possible values are to standard 
+# IRAF GIO polyline types.
+define WL_MIN_LINE_TYPE          Memi[$1+15]
+
+# The number of label points.
+define WL_N_LABELS               Memi[$1+16]
+
+# The graphic WCS that is set to NDC units.
+define WL_NDC_WCS                Memi[$1+17]
+
+# The graphic WCS used to plot the grid lines.
+define WL_PLOT_WCS               Memi[$1+18]
+
+# The direction of the latitude labelling on polar graphs. Possible values are:
+#
+#   BOTTOM -> Towards the bottom of the graph.
+#   TOP -> Towards the top of the graph.
+#   RIGHT -> Towards the right of the graph.
+#   LEFT -> Towards the left of the graph.
+
+define WL_POLAR_LABEL_DIRECTION  Memi[$1+19]
+
+# The possible axis types.  The possible values are:
+#
+#   RA_DEC_TAN - The tangential display in right ascension and declination.
+#   LINEAR     - General linear systems.
+
+define WL_SYSTEM_TYPE            Memi[$1+20]
+
+# Define which side of the graph will have the title.
+define WL_TITLE_SIDE             Memi[$1+21]
+
+# True if the axis mapping has reversed the order of the axis relative
+# to the logical system.
+define WL_AXIS_FLIP              Memi[$1+22]
+
+# TRUE if the labels should always be printed in full form.
+define WL_ALWAYS_FULL_LABEL      Memi[$1+23]
+
+# TRUE if the grid labels should rotate with the grid lines.
+define WL_LABEL_ROTATE           Memi[$1+26]
+
+# True if coordinate labels are to be written.
+define WL_LABON                  Memi[$1+27]
+
+# True if we are to write labels outside the window borders.  Else, write 
+# them inside.
+define WL_LABOUT                 Memi[$1+28]
+
+# True if we are to draw the major grid lines.
+define WL_MAJ_GRIDON             Memi[$1+29]
+
+# True if we are to draw the minor grid lines.
+define WL_MIN_GRIDON             Memi[$1+30]
+
+# True if the graph parameters should be written back out to the 
+# parameter file.
+define WL_REMEMBER               Memi[$1+31]
+
+# TRUE if tick marks should point into the graph.
+define WL_TICK_IN                Memi[$1+32]
+
+# Titles to label each axis.
+define WL_AXIS_TITLE_PTR         Memi[$1+33]
+define WL_AXIS_TITLE             Memc[WL_AXIS_TITLE_PTR($1)+(($2-1)*SZ_LINE)] 
+
+# The sides the axis titles will appear.
+define WL_AXIS_TITLE_SIDE_PTR    Memi[$1+34]
+define WL_AXIS_TITLE_SIDE        Memi[WL_AXIS_TITLE_SIDE_PTR($1)+$2-1]
+
+# Beginning values to start labeling the axes.
+define WL_BEGIN_PTR              Memi[$1+35]
+define WL_BEGIN                  Memd[WL_BEGIN_PTR($1)+$2-1]
+
+# The name of the graphics device.
+#define WL_DEVICE_PTR             Memi[$1+36]
+#define WL_DEVICE                 Memc[WL_DEVICE_PTR($1)]
+
+# Value to stop labeling the axes.
+define WL_END_PTR                Memi[$1+37]
+define WL_END                    Memd[WL_END_PTR($1)+$2-1]
+
+# The graphics descriptor.
+define WL_GP                     Memi[$1+38]
+
+# The angle of text at this label point.
+define WL_LABEL_ANGLE_PTR        Memi[$1+40]
+define WL_LABEL_ANGLE            Memd[WL_LABEL_ANGLE_PTR($1)+$2-1]
+
+# Which axis the label represents.
+define WL_LABEL_AXIS_PTR         Memi[$1+41]
+define WL_LABEL_AXIS             Memi[WL_LABEL_AXIS_PTR($1)+$2-1]
+
+# The positions of tick mark/grid labels.
+define WL_LABEL_POSITION_PTR     Memi[$1+42]
+define WL_LABEL_POSITION         Memd[WL_LABEL_POSITION_PTR($1)+$2-1+(($3-1)*MAX_LABEL_POINTS)]
+#
+# NOTE:  If the axis are transposed, the positions represented here are
+#        the corrected, transposed values.
+
+# The sides the labels for each axis should appear on.
+define WL_LABEL_SIDE_PTR         Memi[$1+43]
+define WL_LABEL_SIDE             Memb[WL_LABEL_SIDE_PTR($1)+$2-1+(($3-1)*N_SIDES)]
+
+# The value of the label.
+define WL_LABEL_VALUE_PTR        Memi[$1+44]
+define WL_LABEL_VALUE            Memd[WL_LABEL_VALUE_PTR($1)+$2-1]
+
+# The center of the transformations in the logical system.  
+define WL_LOGICAL_CENTER_PTR     Memi[$1+45]
+define WL_LOGICAL_CENTER         Memd[WL_LOGICAL_CENTER_PTR($1)+$2-1]
+
+# The coordinate transformation from Logical to World.
+define WL_LWCT                   Memi[$1+46]
+
+# Major grid intervals for the axis.
+define WL_MAJ_I_PTR              Memi[$1+47]
+define WL_MAJOR_INTERVAL         Memd[WL_MAJ_I_PTR($1)+$2-1]
+
+# The minor intervals for the axis.
+define WL_MIN_I_PTR              Memi[$1+48]
+define WL_MINOR_INTERVAL         Memi[WL_MIN_I_PTR($1)+$2-1]
+
+# Remember the extent of the labels around the plot box.
+define WL_NV_PTR                 Memi[$1+49]
+define WL_NEW_VIEW               Memr[WL_NV_PTR($1)+$2-1]
+
+# The MWL structure.
+define WL_MW                     Memi[$1+50]
+
+# The values of the sides of the screen.  The indexes are defined as follows:
+#
+#   TOP -> Y-axis value at the top of display.
+#   BOTTOM -> Y-axis value at bottom of display
+#   RIGHT  -> X-axis value at right of display.
+#   LEFT   -> X-axis value at left of display.
+#
+define WL_SCREEN_BOUNDARY_PTR    Memi[$1+51]
+define WL_SCREEN_BOUNDARY        Memd[WL_SCREEN_BOUNDARY_PTR($1)+$2-1]
+
+# The title that will be placed on the plot.
+define WL_TITLE_PTR              Memi[$1+52]
+define WL_TITLE                  Memc[WL_TITLE_PTR($1)]
+
+# The coordinate transformation from World to Logical.
+define WL_WLCT                   Memi[$1+53]
+
+# The center of the transformations in the world system.
+define WL_WORLD_CENTER_PTR       Memi[$1+54]
+define WL_WORLD_CENTER           Memd[WL_WORLD_CENTER_PTR($1)+$2-1]
+
+# The length of this structure.
+define WL_LEN                    55+1
+
+#---------------------------------------------------------------------------
+# End of wcs_desc
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/wcslab/wcslab.h b/pkg/utilities/nttools/stxtools/wcslab/wcslab.h
new file mode 100644
index 00000000..cf088323
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/wcslab.h
@@ -0,0 +1,98 @@
+# Definitions file for WCSLAB
+
+# Define various important dimensions
+
+define MAX_DIM		10   # Maximum number of dimensions
+define N_DIM 		2    # Dimensionality of plotting space 
+define N_SIDES    	4    # Number of sides to a window
+define MAX_LABEL_POINTS 100  # The maximum number of possible label points
+define N_EDGES    	20   # Number of edges being examined from the window
+
+# Define the types of graphs possible.
+
+define GRAPHTYPES	"|normal|polar|near_polar|"
+define NORMAL     	1
+define POLAR      	2
+define NEAR_POLAR	3
+
+# Define the graph sides. The ordering matches the calls to the GIO package.
+
+define	GRAPHSIDES	"|left|right|bottom|top|"
+define	LEFT   1
+define	RIGHT  2
+define	BOTTOM 3
+define	TOP    4
+
+# Define which index refers to the X-axis and which refers to the Y-axis.
+
+define X_DIM 1
+define Y_DIM 2
+define AXIS1 1
+define AXIS2 2
+
+# Define which axis is longitude and which axis is latitude.
+
+define LONGITUDE 1
+define LATITUDE  2
+
+# Define the available precisions for labelling
+
+define HOUR        1
+define DEGREE      1
+define MINUTE      2
+define SECOND      3
+define SUBSEC_LOW  4
+define SUBSEC_HIGH 5
+
+# Define the possible MWCS transformation types.
+
+define	RA_DEC_DICTIONARY	"|tan|arc|sin|"
+define	LINEAR_DICTIONARY	"|linear|"
+
+define NUMBER_OF_SUPPORTED_TYPES 2
+define RA_DEC                    1
+define LINEAR                    2
+
+define AXIS 3B			# transform all axes in any MWCS call
+
+# Some useful graphics definitions and defaults
+
+define NDC_WCS		0	    # the base graphics WCS
+define POLE_MARK_SHAPE	4           # the pole mark is a cross
+define POLE_MARK_SIZE	3.0         # the half-size of the cross
+define DISTANCE_TO_POLE 0.1	    # % distance to pole for lines of longitude
+define LINE_SIZE	1.	    # line width for lines and ticks
+define MIN_ANGLE	10.	    # minimum angle for text rotation
+define BOTTOM_LEFT	.1	    # default bottom left corner of viewport
+define TOP_RIGHT	.9	    # default top right corner of viewport
+
+# Units conversion macros
+
+define  RADTOST    (240*RADTODEG($1))      # Radians to seconds of time
+define  RADTOSA    (3600*RADTODEG($1))     # Radians to seconds of arc
+define  STTORAD    (DEGTORAD(($1)/240))    # Seconds of time to radians
+define  SATORAD    (DEGTORAD(($1)/3600))   # Seconds of arc to radians
+define  RADTOHRS   (RADTODEG(($1)/15))     # Radians to hours
+define  HRSTORAD   (DEGTORAD(15*($1)))     # Hours to radians
+define  DEGTOST    (240*($1))              # Degrees to seconds of time.
+define  STTODEG    (($1)/240)              # Seconds of time to degrees.
+define  DEGTOSA    (3600*($1))             # Degrees to seconds of arc.
+define  SATODEG    (($1)/3600)             # Seconds of arc to degrees.
+define  HRSTODEG   (($1)*15)               # Hours to degrees.
+define  DEGTOHRS   (($1)/15)               # Degrees to hours.
+define  STPERDAY   86400                   # Seconds per day
+
+# Other useful macros
+
+define INVERT ($1 < 45 || $1 > 315 || ( $1 > 135 && $1 < 225 ))
+
+# Define the latitudes of the north and south poles
+
+define	NORTH_POLE_LATITUDE 90.0D0
+define	SOUTH_POLE_LATITUDE -90.0D0
+
+# Define sections of a circle
+
+define QUARTER_CIRCLE 90.0D0
+define HALF_CIRCLE    180.0D0
+define FULL_CIRCLE    360.0D0
diff --git a/pkg/utilities/nttools/stxtools/wcslab/wcslab.x b/pkg/utilities/nttools/stxtools/wcslab/wcslab.x
new file mode 100644
index 00000000..2e6974c6
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/wcslab.x
@@ -0,0 +1,935 @@
+include <gset.h>
+include <imhdr.h>
+include <math.h>
+include <mwset.h>
+include "wcslab.h"
+include "wcs_desc.h"
+include <ctype.h>
+
+
+# WCSLAB -- Procedure to draw labels and grids in sky projection coordinates.
+#
+# Description
+#  Wcslab produces a labelling and grid based on the MWCS of a 
+#  specified image.
+#
+#  The only things necessary to run this routine are:
+#    1) Open an image and pass the image descriptor in im.
+#    2) Open the graphics device and set the desired viewport (with a
+#       gsview call).
+#    3) Make sure that the wlpars pset is available.
+#
+#  Upon return, the graphics system will be in the state that it had been
+#  left in and a "virtual viewport" will be returned in the arguments
+#  left, right, bottom, top.  This viewport defines the region where labels
+#  and/or titles were written.  If any graphics is performed within this
+#  region, chances are that something will be overwritten.  If any other
+#  graphics remain outside this region, then what was produced by this
+#  subroutine will remain untouched.
+#
+# Bugs 
+#  Can only handle sky projections for Right Ascension/Declination.   This
+#  should be able to deal with any of the projections for this system, but
+#  has only been tested with the Tangent projection.
+
+procedure wcslab (mw, log_x1, log_x2, log_y1, log_y2, gp, title)
+
+pointer	mw                        # I:   the wcs descriptor
+real    log_x1, log_x2            # I/O: the viewport
+real    log_y1, log_y2            # I/O: the viewport
+pointer gp                        # I:   the graphics descriptor
+char    title[ARB]                # I:   the image title
+
+pointer	wd
+real	junkx1, junkx2, junky1, junky2 
+bool	clgetb()
+pointer wl_create()
+errchk	clgstr
+
+begin
+	# Allocate the descriptor.
+	wd = wl_create()
+
+	# Set the title name.
+	call strcpy (title, WL_TITLE(wd), SZ_LINE)
+
+	# Set the WCS descriptor. If the descriptor is NULL or if
+	# the use_wcs parameter is yes, retrieve the parameter 
+	# specified wcs.
+	if (mw == NULL)
+	    call wl_wcs_params (mw, log_x1, log_x2, log_y1, log_y2)
+	else if (clgetb ("usewcs"))
+	    call wl_wcs_params (mw, junkx1, junkx2, junky1, junky2)
+	WL_MW(wd) = mw
+
+	# Determine axis types.
+	call wl_get_system_type (WL_MW(wd), WL_SYSTEM_TYPE(wd),
+            WL_LOGICAL_CENTER(wd,1), WL_WORLD_CENTER(wd,1), WL_AXIS_FLIP(wd))
+	if (IS_INDEFI(WL_SYSTEM_TYPE(wd)))
+    	    call error (0, "WCSLAB: Image WCS is unsupported\n")
+
+	# Get the parameters.
+	call wl_gr_inparams (wd)
+
+	# Copy the graphics descriptor.
+	WL_GP(wd) = gp
+
+	# Set the plot window in pixels (the logical space of the WCS).
+	WL_SCREEN_BOUNDARY(wd,LEFT) = log_x1
+	WL_SCREEN_BOUNDARY(wd,RIGHT) = log_x2
+	WL_SCREEN_BOUNDARY(wd,BOTTOM) = log_y1
+	WL_SCREEN_BOUNDARY(wd,TOP) = log_y2
+
+	# Plot and label the coordinate grid.
+	call wl_wcslab (wd)
+
+	# Return the possibly modified graphics descriptor and viewport.
+	gp = WL_GP(wd)
+	call gsview (gp, WL_NEW_VIEW(wd,LEFT), WL_NEW_VIEW(wd,RIGHT),
+	    WL_NEW_VIEW(wd,BOTTOM), WL_NEW_VIEW(wd,TOP))
+
+	# Save the current parameters.
+	if (WL_REMEMBER(wd) == YES)
+	    call wl_gr_remparams (wd)
+
+  	# Release the memory.
+  	call wl_destroy (wd)
+end
+
+
+# WL_CREATE -- Create a WCSLAB descriptor and initialize it.
+#
+# Description
+#   This routine allocates the memory for the WCSLAB descriptor and
+#   subarrays and initializes values.
+#
+# Returns
+#   the pointer to the WCSLAB descriptor.
+
+pointer procedure wl_create()
+
+int	i,j
+pointer	wd
+
+begin
+	# Allocate the descriptor memory.
+	call malloc (wd, WL_LEN, TY_STRUCT)
+
+	# Allocate the subarrays.
+	call malloc (WL_AXIS_TITLE_PTR(wd), SZ_LINE * N_DIM, TY_CHAR)
+	call malloc (WL_AXIS_TITLE_SIDE_PTR(wd), N_SIDES * N_DIM, TY_BOOL)
+	call malloc (WL_BEGIN_PTR(wd), N_DIM, TY_DOUBLE)
+	call malloc (WL_END_PTR(wd), N_DIM, TY_DOUBLE)
+	call malloc (WL_LABEL_ANGLE_PTR(wd), MAX_LABEL_POINTS, TY_DOUBLE)
+	call malloc (WL_LABEL_AXIS_PTR(wd), MAX_LABEL_POINTS, TY_INT)
+	call malloc (WL_LABEL_POSITION_PTR(wd), N_DIM * MAX_LABEL_POINTS,
+	    TY_DOUBLE)
+	call malloc (WL_LABEL_SIDE_PTR(wd), N_DIM * N_SIDES, TY_BOOL)
+	call malloc (WL_LABEL_VALUE_PTR(wd), MAX_LABEL_POINTS, TY_DOUBLE)
+	call malloc (WL_LOGICAL_CENTER_PTR(wd), N_DIM, TY_DOUBLE)
+	call malloc (WL_MAJ_I_PTR(wd), N_DIM, TY_DOUBLE)
+	call malloc (WL_MIN_I_PTR(wd), N_DIM, TY_INT)
+	call malloc (WL_NV_PTR(wd), N_SIDES, TY_REAL)
+	call malloc (WL_SCREEN_BOUNDARY_PTR(wd), N_SIDES, TY_DOUBLE)
+	call malloc (WL_TITLE_PTR(wd), SZ_LINE, TY_CHAR)
+	call malloc (WL_WORLD_CENTER_PTR(wd), N_DIM, TY_DOUBLE)
+
+	# Initialize the simple values (should be the same as the parameter
+	# file).
+	WL_POLAR_LABEL_POSITION(wd) = INDEF
+	WL_AXIS_TITLE_SIZE(wd) = 1.5
+	WL_LABEL_SIZE(wd) = 1.0
+	WL_MAJ_TICK_SIZE(wd) = .03
+	WL_MIN_TICK_SIZE(wd) = .01
+	WL_TITLE_SIZE(wd) = 2.0
+	WL_GRAPH_TYPE(wd) = INDEFI
+	WL_MAJ_LINE_TYPE(wd) = GL_SOLID
+	WL_MIN_LINE_TYPE(wd) = GL_DOTTED
+	WL_TITLE_SIDE(wd) = TOP
+	WL_ALWAYS_FULL_LABEL(wd) = NO
+	WL_LABEL_ROTATE(wd) = YES
+	WL_LABON(wd) = YES
+	WL_LABOUT(wd) = YES
+	WL_MAJ_GRIDON(wd) = YES
+	WL_MIN_GRIDON(wd) = NO
+	WL_REMEMBER(wd) = NO
+	WL_TICK_IN(wd) = YES
+
+	# Initialize any strings.
+	call strcpy ("imtitle", WL_TITLE(wd), SZ_LINE)
+
+	# Initialize the axis dependent values.
+	do i = 1, N_DIM {
+	    WL_AXIS_TITLE(wd,i) = EOS
+	    WL_AXIS_TITLE_SIDE(wd,i) = INDEFI
+	    WL_BEGIN(wd,i) = INDEFD
+	    WL_END(wd,i) = INDEFD
+	    WL_MAJOR_INTERVAL(wd,i) = INDEFD
+	    WL_MINOR_INTERVAL(wd,i) = 5
+    	    do j = 1, N_SIDES
+      	        WL_LABEL_SIDE(wd,j,i) = false
+	}
+
+        # Return the descriptor.
+	return (wd) 
+end
+
+
+# WL_WCS_PARAMS -- Read the WCS descriptor from the parameters.
+#
+# Description
+#  This procedure returns the WCS descriptor created from task parameters
+#  and the logical space that will be graphed.
+#
+# Bugs
+#  This only deals with two axes.
+
+procedure wl_wcs_params (mw, log_x1, log_x2, log_y1, log_y2)
+
+pointer mw              # O: The MWCS descriptor.
+real    log_x1, log_x2, # O: The extent of the logical space to graph.
+real	log_y1, log_y2
+
+real    cd[2,2], r[2], w[2]
+pointer sp, input, pp
+pointer clopset(), mw_open()
+real    clgpsetr()
+
+begin
+        call smark (sp)
+        call salloc (input, SZ_LINE, TY_CHAR)
+
+	# Open the pset.
+	pp = clopset ("wcspars")
+
+        # Create an MWCS descriptor.
+        mw = mw_open (NULL, 2)
+
+        # Get the types.
+        call clgpset (pp, "ctype1", Memc[input], SZ_LINE)
+        call wl_decode_ctype (mw, Memc[input], 1)
+        call clgpset (pp, "ctype2", Memc[input], SZ_LINE)
+        call wl_decode_ctype (mw, Memc[input], 2)
+
+        # Get the reference coordinates.
+        r[1] = clgpsetr (pp, "crpix1")
+        r[2] = clgpsetr (pp, "crpix2")
+        w[1] = clgpsetr (pp, "crval1")
+        w[2] = clgpsetr (pp, "crval2")
+
+        # Get the CD matrix.
+        cd[1,1] = clgpsetr (pp, "cd1_1")
+        cd[1,2] = clgpsetr (pp, "cd1_2")
+        cd[2,1] = clgpsetr (pp, "cd2_1")
+        cd[2,2] = clgpsetr (pp, "cd2_2")
+
+        # Set the Wterm.
+        call mw_swtermr (mw, r, w, cd, 2)
+
+        # Get the extent of the logical space.
+        log_x1 = clgpsetr (pp, "log_x1")
+        log_x2 = clgpsetr (pp, "log_x2")
+        log_y1 = clgpsetr (pp, "log_y1")
+        log_y2 = clgpsetr (pp, "log_y2")
+
+	# Close the pset.
+	call clcpset (pp)
+
+        call sfree (sp)
+end
+
+
+# WL_DECODE_CTYPE -- Decode the ctype string into axis type and system type.
+#
+# Description
+#   The CTYPE is what is found in FITS keywords CTYPEn.  The value may
+#   contain two pieces of information, always the system type and possibly
+#   an individual axis type.  For systems such as plain old linear systems
+#   just a system type is defined.  However, for celestial systems, both
+#   types are defined in the form "axistype-systemtype".  There may be
+#   any number of '-' in between the values.
+
+procedure wl_decode_ctype (mw, input, axno)
+
+pointer mw              # I: the MWCS descriptor
+char    input[ARB]      # I: the string input
+int     axno            # I: the axis being worked on
+
+int     i, input_len
+int     strncmp(), strldx(), strlen()
+string  empty ""
+
+begin
+
+        input_len = strlen (input)
+
+        # Fix some characters.
+        do i = 1, input_len {
+          if (input[i] == ' ' || input[i] == '\'')
+            break
+          else if (IS_UPPER(input[i]))
+            input[i] = TO_LOWER(input[i])
+          else if (input[i] == '_')
+            input[i] = '-'
+        }
+
+        # Determine the type of function on this axis.
+        if (strncmp (input, "linear", 6) == 0) {
+          call mw_swtype (mw, 1, 2, "linear", empty)
+
+        } else if (strncmp (input, "ra--", 4) == 0) {
+          i = strldx ("-", input) + 1
+          call mw_swtype (mw, 1, 2, input[i], empty)
+          call mw_swattrs (mw, axno, "axtype", "ra")
+
+        } else if (strncmp (input, "dec-", 4) == 0) {
+          i = strldx ("-", input) + 1
+          call mw_swtype (mw, 1, 2, input[i], empty) 
+          call mw_swattrs (mw, axno, "axtype", "dec")
+
+        } else {
+          # Since we have to be able to read any FITS header, we have
+          # no control over the value of CTYPEi.  If the value is
+          # something we don't know about, assume a LINEAR axis, using
+          # the given value of CTYPEi as the default axis label.
+          call mw_swtype (mw, 1, 2, "linear", empty)
+          call mw_swattrs (mw, axno, "label", input)
+        }
+        
+end
+
+
+# WL_GET_SYSTEM_TYPE -- Determine type of transformation the MWCS represents.
+#
+# Note
+#   For some systems, the axis mapping reverses the order to make
+#   the rest of the code tractable.  The only problem is that when graphing,
+#   the graph routines need to "fix" this reversal.  Also note that this
+#   occurs only for systems that have distinct axis types, such as RA and
+#   DEC.
+#
+# Bugs
+#   A potential problem:  For a WCS that has more axes than necessary
+#   for the sky projections, those axis are set such that during
+#   transformations, the first index position is used.  For the one
+#   example I have seen, the "third" axis is time and this interpretation
+#   works.  But, I am sure something will fall apart because of this.
+
+procedure wl_get_system_type (mw, system_type, logical_center, world_center,
+	flip)
+
+pointer mw                    # I: the MWCS descriptor.
+int	system_type           # O: the transformation type:
+                              #    RA_DEC     -> tan, sin, or arc projection
+                              #                  in right ascension and
+			      #                  declination
+                              #    LINEAR     -> any regular linear system
+                              #    INDEFI     -> could not be determined
+double  logical_center[N_DIM] # O: the center point in the logical system.
+double  world_center[N_DIM]   # O: the center point in the world system.
+int	flip                  # O: true if the order of the axes have been
+                              #    changed by axis mappins
+
+double	tmp_logical[MAX_DIM], tmp_world[MAX_DIM]
+int	wcs_dim, axis, index_sys1, index_sys2, found_axis
+int	axno[MAX_DIM], axval[MAX_DIM], found_axis_list[N_DIM]
+pointer	sp, axtype, cd, cur_type
+int	mw_stati(), strncmp(), strdic()
+errchk	mw_gwattrs
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (axtype, SZ_LINE, TY_CHAR)
+	call salloc (cur_type, SZ_LINE, TY_CHAR)
+	call salloc (cd, MAX_DIM, TY_DOUBLE)
+
+	# Get the dimensionality of the WCS.
+	call mw_seti (mw, MW_USEAXMAP, NO)
+	wcs_dim = mw_stati (mw, MW_NDIM)
+
+	# Initialize the two dimensions.
+	index_sys1 = INDEFI
+	index_sys2 = INDEFI
+
+	# Look through the possible supported axis types.  When a type has
+	# exactly N_DIM axes defined, that will be the one used.
+
+	for (system_type = 1; system_type <= NUMBER_OF_SUPPORTED_TYPES;
+	    system_type = system_type + 1) {
+
+	    # Determine the string that should be looked for.
+	    switch (system_type)  {
+	    case RA_DEC:
+	        call strcpy (RA_DEC_DICTIONARY, Memc[cur_type], SZ_LINE)
+	    case LINEAR:
+	        call strcpy (LINEAR_DICTIONARY, Memc[cur_type], SZ_LINE)
+	    }
+
+	    # Initialize the number of found axis.
+	    found_axis = 0
+
+	    # Examine each axis to determine whether the current axis type is
+	    # the one to use.
+	    for (axis = 1; axis <= wcs_dim; axis = axis + 1) {
+
+		# If the current physical axis is not mapped, ignore it.
+		# This statement is causing a problem in 2.10.3, not sure
+		# why but am removing it for now.
+		#if (axno[axis] == 0)
+		    #next
+
+	        ifnoerr (call mw_gwattrs( mw, axis, "wtype", Memc[axtype],
+	            SZ_LINE)) {
+        	    call strlwr (Memc[axtype]) 
+
+		    # If this axis type matches the one being looked for, add
+		    # it to the axis list. If there are too many axis of the
+		    # current type found, don't add to the found axis list.
+
+		    if (strdic (Memc[axtype], Memc[axtype], SZ_LINE,
+                         Memc[cur_type]) > 0) {
+		        found_axis = found_axis + 1
+		        if (found_axis <= N_DIM)
+			    found_axis_list[found_axis] = axis
+		    }
+	        }
+	    }
+
+	    # Check to see whether we have the right number axes.
+	    if (found_axis == N_DIM)
+		break
+
+	}
+
+	# If any axes were found, then further check axis types.
+	# Depending on the axis type, there may be need to distinguish
+	# between the two possible axis further.
+
+	if  (found_axis == N_DIM) 
+	    switch (system_type) {
+	    case RA_DEC:
+	        for (axis = 1; axis <= N_DIM; axis = axis + 1)
+		    ifnoerr (call mw_gwattrs (mw, found_axis_list[axis], 
+                        "axtype", Memc[axtype], SZ_LINE)) {
+		    call strlwr( Memc[axtype] )
+		    if (strncmp (Memc[axtype], "ra", 2) == 0)
+			index_sys1 = found_axis_list[axis]
+		    else if (strncmp (Memc[axtype], "dec", 3) == 0)
+			index_sys2 = found_axis_list[axis]
+		}
+
+	    # The "default" seems to be the LINEAR case for MWCS.
+	    # Since no other information is provided, this is all we know.
+	    default:
+		index_sys1 = found_axis_list[1]
+		index_sys2 = found_axis_list[2]
+	    }
+
+	# If either axis is unknown, something is wrong.  If the WCS has two
+	# axes defined, then make some grand assumptions.  If not, then there
+	# is nothing more to be done.
+
+	if (IS_INDEFI (index_sys1) || IS_INDEFI (index_sys2)) {
+	    if (wcs_dim >= N_DIM) {
+	        index_sys1 = 1
+	        index_sys2 = 2
+	    } else
+	        call error (0, "Wcslab: Fewer than two defined axes")
+	}
+
+	# Zero the axis values and set any "unknown" axis to always use the
+	# "first" position in that axis direction.  This will more than likely
+	# be a problem, but no general solution comes to mind this second.
+
+	call amovki (0, axno, wcs_dim)
+	call amovki (0, axval, wcs_dim)
+
+	# Setup so that the desired axes are set as the X and Y axis.
+	axno[index_sys1] = X_DIM
+	axno[index_sys2] = Y_DIM
+	call mw_saxmap (mw, axno, axval, wcs_dim)
+
+	# Recover the center points of the Logical and World systems.
+	call mw_gwtermd (mw, tmp_logical, tmp_world, Memd[cd], wcs_dim)
+
+	logical_center[X_DIM] = tmp_logical[index_sys1]
+	logical_center[Y_DIM] = tmp_logical[index_sys2]
+	world_center[X_DIM] = tmp_world[index_sys1]
+	world_center[Y_DIM] = tmp_world[index_sys2]
+
+	# Check for reversal of axes
+	if (index_sys1 > index_sys2)
+	    flip = YES
+	else
+	    flip = NO
+
+	# Release the memory.
+	call sfree (sp) 
+end
+
+
+# WL_GR_INPARAMS -- Read in the graphics parameters for wcslab.
+#	
+# Description
+#  Read all the parameters in and make some decisions about what
+#  will be done.
+
+procedure wl_gr_inparams (wd) 
+
+pointer wd                       # I: the WCSLAB descriptor
+
+pointer sp, aline, pp
+bool	clgpsetb(), streq()
+double	wl_string_to_internal()
+int	btoi(), strdic(), wl_line_type(), clgpseti()
+pointer	clopset()
+real	clgpsetr()
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (aline, SZ_LINE, TY_CHAR)
+
+	# Open the pset.
+	pp = clopset ("wlpars")
+
+	# Get the title if other than the default.
+	call clgpset (pp, "title", Memc[aline], SZ_LINE)
+	if (! streq (Memc[aline], "imtitle"))
+	    call strcpy (Memc[aline], WL_TITLE(wd), SZ_LINE)
+
+	# Get the axis titles.
+	call clgpset (pp, "axis1_title", WL_AXIS_TITLE(wd,AXIS1), SZ_LINE)
+	call clgpset (pp, "axis2_title", WL_AXIS_TITLE(wd,AXIS2), SZ_LINE)
+
+	# Get the parameters.
+	WL_ALWAYS_FULL_LABEL(wd) = btoi (clgpsetb (pp,"full_label"))
+	WL_AXIS_TITLE_SIZE(wd) = clgpsetr (pp, "axis_title_size")
+	WL_LABEL_ROTATE(wd) = btoi (clgpsetb (pp, "rotate"))
+	WL_LABEL_SIZE(wd) = clgpsetr (pp, "label_size")
+	WL_LABON(wd) = btoi (clgpsetb (pp, "dolabel"))
+	WL_LABOUT(wd) = btoi (clgpsetb (pp, "labout"))
+	WL_MAJ_GRIDON(wd) = btoi (clgpsetb (pp, "major_grid"))
+	WL_MAJ_TICK_SIZE(wd) = clgpsetr (pp, "major_tick")
+	WL_MIN_GRIDON(wd) = btoi (clgpsetb (pp, "minor_grid"))
+	WL_MINOR_INTERVAL(wd,AXIS1) = clgpseti (pp, "axis1_minor")
+	WL_MINOR_INTERVAL(wd,AXIS2) = clgpseti (pp, "axis2_minor")
+	WL_MIN_TICK_SIZE(wd) = clgpsetr (pp, "minor_tick")
+	WL_REMEMBER(wd) = btoi (clgpsetb (pp, "remember"))
+	WL_TICK_IN(wd) = btoi (clgpsetb (pp, "tick_in"))
+	WL_TITLE_SIZE(wd) = clgpsetr (pp, "title_size")
+
+	# Set what type of graph will be plotted.
+	call clgpset (pp, "graph_type", Memc[aline], SZ_LINE)
+	call strlwr (Memc[aline])
+	WL_GRAPH_TYPE(wd) = strdic (Memc[aline], Memc[aline], SZ_LINE,
+	    GRAPHTYPES)
+	if (WL_GRAPH_TYPE(wd) <= 0)
+	    WL_GRAPH_TYPE(wd) = INDEFI
+
+	# Get which sides labels will appear on.
+	call clgpset (pp, "axis1_side", Memc[aline], SZ_LINE)
+	call strlwr (Memc[aline])
+	call wl_label_side (Memc[aline], WL_LABEL_SIDE(wd,1,AXIS1))
+
+	call clgpset (pp, "axis2_side", Memc[aline], SZ_LINE)
+	call strlwr (Memc[aline])
+	call wl_label_side (Memc[aline], WL_LABEL_SIDE(wd,1,AXIS2))
+
+	# Get the polar justification direction.
+	call clgpset (pp, "justify", Memc[aline], SZ_LINE)
+	call strlwr (Memc[aline])
+	WL_POLAR_LABEL_DIRECTION(wd) = strdic (Memc[aline], Memc[aline],
+	    SZ_LINE, GRAPHSIDES)
+	if (WL_POLAR_LABEL_DIRECTION(wd) <= 0)
+	    WL_POLAR_LABEL_DIRECTION(wd) = INDEFI
+
+  	# Decode the graphing parameters.
+  	call clgpset (pp, "axis1_int", Memc[aline], SZ_LINE)
+	WL_MAJOR_INTERVAL(wd,AXIS1) = wl_string_to_internal (Memc[aline], 
+            WL_SYSTEM_TYPE(wd), AXIS1)
+	call clgpset (pp, "axis1_beg", Memc[aline], SZ_LINE)
+	WL_BEGIN(wd,AXIS1) = wl_string_to_internal (Memc[aline],
+	    WL_SYSTEM_TYPE(wd), AXIS1)
+	call clgpset (pp, "axis1_end", Memc[aline], SZ_LINE)
+	WL_END(wd,AXIS1) = wl_string_to_internal (Memc[aline],
+	    WL_SYSTEM_TYPE(wd), AXIS1)
+
+	call clgpset (pp, "axis2_int", Memc[aline], SZ_LINE)
+	WL_MAJOR_INTERVAL(wd,AXIS2) = wl_string_to_internal (Memc[aline], 
+            WL_SYSTEM_TYPE(wd), AXIS2)
+	call clgpset (pp, "axis2_beg", Memc[aline], SZ_LINE)
+	WL_BEGIN(wd,AXIS2) = wl_string_to_internal(Memc[aline],
+	    WL_SYSTEM_TYPE(wd), AXIS2 )
+	call clgpset (pp, "axis2_end", Memc[aline], SZ_LINE)
+	WL_END(wd,AXIS2) = wl_string_to_internal (Memc[aline],
+	    WL_SYSTEM_TYPE(wd), AXIS2)
+
+	# Get the polar label position.
+	call clgpset (pp, "axis2_dir", Memc[aline], SZ_LINE)
+	WL_POLAR_LABEL_POSITION(wd) = wl_string_to_internal( Memc[aline],
+	    WL_SYSTEM_TYPE(wd), AXIS1)
+
+	# Get the axis titles.
+	call clgpset (pp, "axis1_title_side", Memc[aline], SZ_LINE)
+	call strlwr (Memc[aline])
+	WL_AXIS_TITLE_SIDE(wd,AXIS1) = strdic (Memc[aline], Memc[aline],
+	    SZ_LINE, GRAPHSIDES)
+	if (WL_AXIS_TITLE_SIDE(wd,AXIS1) <= 0)
+	    WL_AXIS_TITLE_SIDE(wd,AXIS1) = INDEFI
+
+	call clgpset (pp, "axis2_title_side", Memc[aline], SZ_LINE) 
+	call strlwr (Memc[aline])
+	WL_AXIS_TITLE_SIDE(wd,AXIS2) = strdic (Memc[aline], Memc[aline],
+	    SZ_LINE, GRAPHSIDES)
+	if (WL_AXIS_TITLE_SIDE(wd,AXIS2) <= 0)
+	    WL_AXIS_TITLE_SIDE(wd,AXIS2) = INDEFI
+
+	# Decode the grid line types.
+	call clgpset (pp, "major_line", Memc[aline], SZ_LINE)
+	WL_MAJ_LINE_TYPE(wd) = wl_line_type (Memc[aline])
+	call clgpset (pp, "minor_line", Memc[aline], SZ_LINE)
+	WL_MIN_LINE_TYPE(wd) = wl_line_type (Memc[aline])
+
+	# Get the title side.
+	call clgpset (pp, "title_side", Memc[aline], SZ_LINE)
+	call strlwr (Memc[ aline])
+	WL_TITLE_SIDE(wd) = strdic (Memc[aline], Memc[aline], SZ_LINE,
+	    GRAPHSIDES)
+
+	# Close the pset.
+	call clcpset (pp)
+
+	# Free memory.
+	call sfree (sp)
+end
+
+
+# WL_GR_REMPARAMS -- Write out the graphing parameters.
+
+procedure wl_gr_remparams (wd)
+
+pointer wd  		# I: the WCSLAB descriptor.
+
+pointer sp, output, pp
+pointer	clopset()
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (output, SZ_LINE, TY_CHAR)
+
+	# Open the pset.
+	pp = clopset ("wlpars")
+
+	# Set the graph type.
+	switch (WL_GRAPH_TYPE(wd)) {
+	case NORMAL:
+	    call clppset (pp, "graph_type", "normal")
+	case POLAR:
+	    call clppset (pp, "graph_type", "polar")
+	case NEAR_POLAR:
+	    call clppset (pp, "graph_type", "near_polar")
+	default:
+	    call clppset (pp, "graph_type", "default")
+	}
+
+	# Write back the labelling parameters.
+	call wl_internal_to_string (WL_MAJOR_INTERVAL(wd,AXIS1),
+	    WL_SYSTEM_TYPE(wd), AXIS1, Memc[output])
+	call clppset (pp, "axis1_int", Memc[output])
+	call wl_internal_to_string (WL_BEGIN(wd,AXIS1), WL_SYSTEM_TYPE(wd), 
+	    AXIS1, Memc[output])
+	call clppset (pp, "axis1_beg", Memc[output])
+	call wl_internal_to_string (WL_END(WD,AXIS1), WL_SYSTEM_TYPE(wd), 
+            AXIS1, Memc[output])
+	call clppset (pp, "axis1_end", Memc[output])
+	call wl_internal_to_string (WL_MAJOR_INTERVAL(wd,AXIS2),
+	    WL_SYSTEM_TYPE(wd), AXIS2, Memc[output])
+	call clppset (pp, "axis2_int", Memc[output])
+	call wl_internal_to_string (WL_BEGIN(wd,AXIS2), WL_SYSTEM_TYPE(wd), 
+            AXIS2, Memc[output])
+	call clppset (pp, "axis2_beg", Memc[output])
+	call wl_internal_to_string (WL_END(wd,AXIS2), WL_SYSTEM_TYPE(wd), 
+            AXIS2, Memc[output])
+	call clppset (pp, "axis2_end", Memc[output])
+	call wl_internal_to_string (WL_POLAR_LABEL_POSITION(wd),
+	    WL_SYSTEM_TYPE(wd), AXIS1, Memc[output])
+	call clppset (pp, "axis2_dir", Memc[output])
+
+	# Write back labelling justification.
+	call wl_side_to_string (WL_POLAR_LABEL_DIRECTION(wd), Memc[output],
+	    SZ_LINE)
+	call clppset (pp, "justify", Memc[output])
+
+	# Put the axis title sides out. 
+	call wl_side_to_string (WL_AXIS_TITLE_SIDE(wd,AXIS1), Memc[output],
+	    SZ_LINE)
+	call clppset (pp, "axis1_title_side", Memc[output])
+	call wl_side_to_string (WL_AXIS_TITLE_SIDE(wd,AXIS2), Memc[output],
+	    SZ_LINE )
+	call clppset (pp, "axis2_title_side", Memc[output])
+
+	# Put the label sides out.
+	call wl_put_label_sides (WL_LABEL_SIDE(wd,1,AXIS1), Memc[output],
+	    SZ_LINE )
+	call clppset (pp, "axis1_side", Memc[output])
+	call wl_put_label_sides (WL_LABEL_SIDE(wd,1,AXIS2), Memc[output],
+	    SZ_LINE)
+	call clppset (pp, "axis2_side", Memc[output])
+
+	# Close the pset.
+	call clcpset (pp)
+
+	# Free memory.
+	call sfree (sp) 
+end
+
+
+# WL_DESTROY -- Deallocate the WCSLAB descriptor.
+
+procedure wl_destroy (wd)
+
+pointer wd  	# I: the WCSLAB descriptor to be destroyed
+
+begin
+	# Deallocate all the subarrays.
+	call mfree (WL_WORLD_CENTER_PTR(wd), TY_DOUBLE)
+	call mfree (WL_TITLE_PTR(wd), TY_CHAR)
+	call mfree (WL_SCREEN_BOUNDARY_PTR(wd), TY_DOUBLE)
+	call mfree (WL_NV_PTR(wd), TY_REAL)
+	call mfree (WL_MIN_I_PTR(wd), TY_INT)
+	call mfree (WL_MAJ_I_PTR(wd), TY_DOUBLE)
+	call mfree (WL_LOGICAL_CENTER_PTR(wd), TY_DOUBLE)
+	call mfree (WL_LABEL_VALUE_PTR(wd), TY_DOUBLE)
+	call mfree (WL_LABEL_SIDE_PTR(wd), TY_BOOL)
+	call mfree (WL_LABEL_POSITION_PTR(wd), TY_DOUBLE)
+	call mfree (WL_LABEL_AXIS_PTR(wd), TY_INT)
+	call mfree (WL_LABEL_ANGLE_PTR(wd), TY_DOUBLE)
+	call mfree (WL_END_PTR(wd), TY_DOUBLE)
+	call mfree (WL_BEGIN_PTR(wd), TY_DOUBLE)
+	call mfree (WL_AXIS_TITLE_SIDE_PTR(wd), TY_BOOL)
+	call mfree (WL_AXIS_TITLE_PTR(wd), TY_CHAR)
+
+	# Now deallocate the structure.
+	call mfree (wd, TY_STRUCT)
+end
+
+
+# WL_LABEL_SIDE -- Decode string into set of booleans  sides.
+
+procedure wl_label_side (input, flag)
+
+char	input[ARB]     # I: string listing the sides to be labeled
+bool	flag[N_SIDES]  # O: the flags indicating which sides wll be labeled
+
+int	i 
+int	strmatch()
+
+begin
+	# Initialize all the flags to false.
+	do i = 1, N_SIDES
+	    flag[i] = false
+
+	# Now set each side that is in the list.
+	if (strmatch (input, "right") != 0)
+	    flag[RIGHT] = true
+	if (strmatch (input, "left") != 0)
+	    flag[LEFT] = true
+	if (strmatch (input, "top") != 0)
+	    flag[TOP] = true
+	if (strmatch (input, "bottom") != 0)
+	    flag[BOTTOM] = true
+end
+
+
+# WL_STRING_TO_INTERVAL -- Convert from a string to a number.
+#
+# Description
+#  Since (ideally) the wcslab task should be able to handle any sky
+#  map transformation, there are a number of potential units that can be
+#  transformed from.  The specification of coordinates in these systems
+#  are also quite varied.  Thus, for input purposes, coordinates are entered
+#  as strings.  This routine decodes the strings to a common unit (degrees)
+#  based on the type of system being graphed.
+#
+# Function Returns
+#  This returns the single coordinate value converted to a base system 
+#  (degrees).
+
+double procedure wl_string_to_internal (input, axis_type, which_axis)
+
+char	input[ARB]	# I; the string containing the numerical value
+int	axis_type   	# I: the type of wcs
+int	which_axis	# I: the axis number
+
+double	value
+int	strlen(), nscan()
+
+begin
+	# It is possible that the value was not defined.
+	if (strlen (input)  <= 0)
+	    value = INDEFD
+
+	# Decode based on the system.
+	else
+	    switch (axis_type) {
+
+	    # The RA and DEC systems.
+	    case RA_DEC:
+
+	        # Since SPP FMTIO can handle the HH:MM:SS format, just let it
+		# read in the value.  However, there is no way to distinquish
+		# H:M:S from D:M:S. If the axis being read is RA, assume that
+		# it was H:M:S.
+
+	        call sscan (input)
+	            call gargd (value)
+
+		# If the axis is Longitude == RA, then convert the hours to
+		# degrees.
+		if (nscan() < 1) {
+		    value = INDEFD
+		} else {
+		    if  (which_axis == AXIS1)
+		        value = HRSTODEG (value)
+		}
+
+	    # Default- unknown system, just read the string as a double
+	    # precision and return it.
+	    default:
+		call sscan (input)
+		    call gargd (value)
+		if (nscan() < 1)
+		    value = INDEFD
+	    }
+
+	return (value)
+end
+
+
+# WL_LINE_TYPE -- Decode a string into an IRAF GIO polyline type.
+
+int procedure wl_line_type (line_type_string)
+
+char	line_type_string[ARB]  # I: the string specifying the line type
+                               #      "solid" -> GL_SOLID
+                               #      "dotted" -> GL_DOTTED
+                               #      "dashed" -> GL_DASHED
+                               #      "dotdash" -> GL_DOTDASH
+int	type
+bool	streq()
+
+begin
+	if (streq (line_type_string, "solid"))
+	    type = GL_SOLID
+	else if (streq (line_type_string, "dotted"))
+	    type = GL_DOTTED
+	else if  (streq( line_type_string, "dashed"))
+	    type = GL_DASHED
+	else if  (streq (line_type_string, "dotdash"))
+	    type = GL_DOTDASH
+	else {
+	    call eprintf ("Pattern unknown, using 'solid'.\n")
+	    type = GL_SOLID
+	}
+
+	return (type)
+end
+
+
+# WL_INTERNAL_TO_STRING - Convert internal representation to a string.
+
+procedure wl_internal_to_string (value, system_type, which_axis, output)
+
+double	value          # I: the value to convert
+int	system_type    # I: the wcs type
+int	which_axis     # I: the axis
+char	output[ARB]    # O: the output string
+
+begin
+	# If the value is undefined, write an empty string.
+	if (IS_INDEFD (value))
+	    output[1] = EOS
+
+	# Else, convert the value depending on the axis types.
+	else
+	    switch (system_type)  {
+
+	    # Handle the RA, DEC
+	    case RA_DEC:
+
+		# If this is Axis1 == Right Ascension, then convert to hours.
+		if  (which_axis == AXIS1)
+		    value = value / 15.0D0
+
+		call sprintf (output, SZ_LINE, "%.6h")
+		    call pargd (value)
+
+	    # Else, just write a value.
+	    default:
+		call sprintf (output, SZ_LINE, "%.7g")
+		call pargd (value)
+	    }
+
+end
+
+
+# WL_SIDE_TO_STRING -- Convert a side to its string representation.
+
+procedure wl_side_to_string (side, output, max_len)
+
+int	side              # I: the side to convert
+char	output[max_len]   # O: the string representation of the side
+int	 max_len          # I: the maximum length of the output string
+
+begin
+	switch (side) {
+	case RIGHT:
+	    call strcpy ("right", output, max_len)
+	case LEFT:
+	    call strcpy ("left", output, max_len)
+	case TOP:
+	    call strcpy ("top", output, max_len)
+	case BOTTOM:
+	    call strcpy ("bottom", output, max_len)
+	default:
+	    call strcpy ("default", output, max_len)
+	}
+end
+
+
+# WL_PUT_LABEL_SIDES -- Create a string containing the sides specified.
+
+procedure wl_put_label_sides (side_flags, output, max_len)
+
+bool	side_flags[N_SIDES]  # I: the boolean array of sides
+char	output[ARB]          # O: the output comma separated list of sides
+int	max_len              # I: maximum length of the output string
+
+int	i
+pointer sp, side
+int	strlen()
+
+begin
+	# Get memory.
+	call smark (sp)
+	call salloc (side, max_len, TY_CHAR)
+
+	# Build the list.
+	output[1] = EOS
+	do i = 1, N_SIDES
+	    if (side_flags[i]) {
+	        if (strlen (output) != 0)
+                    call strcat (",", output, max_len)
+		call wl_side_to_string (i, Memc[side], max_len)
+		call strcat (Memc[side], output, max_len)
+	    }
+
+	if (strlen (output) == 0)
+	    call strcat ("default", output, max_len)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/stxtools/wcslab/wlgrid.x b/pkg/utilities/nttools/stxtools/wcslab/wlgrid.x
new file mode 100644
index 00000000..4f457af4
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/wlgrid.x
@@ -0,0 +1,448 @@
+include <gset.h>
+include <math.h>
+include "wcslab.h"
+include "wcs_desc.h"
+
+
+# WL_GRID -- Put the grid lines/tick marks on the plot.
+#
+# Description
+#  Based on previously determined parameters., draw the grid lines and/or
+#  tick marks onto the graph.  While in the process of doing this, create
+#  a list of possible label points for use by the label_grid routine.
+
+procedure wl_grid (wd)
+
+pointer wd		# I: the WCSLAB descriptor
+
+double	current, tmp_begin, tmp_end, tmp_minor_interval
+int	old_type, old_n_labels, min_counter
+int	gstati()
+
+begin
+	# Initialize the label counter.
+	WL_N_LABELS(wd) = 0
+
+	# Remember what line type is currently active.
+	old_type = gstati (WL_GP(wd), G_PLTYPE)
+
+	# Determine integer range for axis 1.
+	tmp_minor_interval = WL_MAJOR_INTERVAL(wd,AXIS1) / 
+	    double (WL_MINOR_INTERVAL(wd,AXIS1))
+
+	# If near-polar, the lines should go all the way to the poles.
+	if (WL_GRAPH_TYPE(wd) == NEAR_POLAR)
+	    if (abs (WL_BEGIN(wd,AXIS2)) < abs (WL_END(wd,AXIS2))) {
+	        tmp_begin = WL_BEGIN(wd,AXIS2)
+	        tmp_end = NORTH_POLE_LATITUDE
+	    } else {
+	        tmp_begin = SOUTH_POLE_LATITUDE
+	        tmp_end = WL_END(wd,AXIS2)
+	    }
+	else {
+	    tmp_begin = WL_BEGIN(wd,AXIS2)
+	    tmp_end = WL_END(wd,AXIS2)
+	}
+
+	# Plot lines of constant value in axis 1.
+	current = WL_BEGIN(wd,AXIS1)
+	min_counter = 0
+	repeat {
+
+	    if  (mod (min_counter, WL_MINOR_INTERVAL(wd,AXIS1)) == 0) {
+	        call gseti  (WL_GP(wd), G_PLTYPE, WL_MAJ_LINE_TYPE(wd))
+	        call wl_graph_constant_axis1 (wd, current, tmp_begin, tmp_end, 
+	            WL_MAJ_GRIDON(wd), WL_LABON(wd), WL_MAJ_TICK_SIZE(wd))
+	    } else {
+	        call gseti  (WL_GP(wd), G_PLTYPE, WL_MIN_LINE_TYPE(wd))
+	        call wl_graph_constant_axis1 (wd, current, tmp_begin, tmp_end,
+	            WL_MIN_GRIDON(wd), NO, WL_MIN_TICK_SIZE(wd))
+	    }
+
+	    min_counter = min_counter + 1
+	    current = WL_BEGIN(wd,AXIS1) + tmp_minor_interval * min_counter
+
+	} until  (real (current) > real (WL_END(wd,AXIS1)))
+
+	# Determine the interval range for the second axis.
+	tmp_minor_interval = WL_MAJOR_INTERVAL(wd,AXIS2) / 
+	    double (WL_MINOR_INTERVAL(wd,AXIS2))
+
+	# Plot lines of constant value in axis 2.
+	if  (WL_END(wd,AXIS2) < WL_BEGIN(wd,AXIS2)) {
+	    current = WL_END(wd,AXIS2)
+	    tmp_minor_interval = -tmp_minor_interval
+	    tmp_end = WL_BEGIN(wd,AXIS2)
+	} else {
+	    current = WL_BEGIN(wd,AXIS2)
+	    tmp_end = WL_END(wd,AXIS2)
+	}
+
+	min_counter = 0
+	tmp_begin = current 
+	repeat {
+	    if  (mod (min_counter, WL_MINOR_INTERVAL(wd,AXIS2)) == 0) {
+
+	        call gseti  (WL_GP(wd), G_PLTYPE, WL_MAJ_LINE_TYPE(wd))
+	        old_n_labels = WL_N_LABELS(wd)
+	        call wl_graph_constant_axis2 (wd, current, WL_BEGIN(wd,AXIS1), 
+	            WL_END(wd,AXIS1), WL_MAJ_GRIDON(wd), WL_LABON(wd), 
+	            WL_MAJ_TICK_SIZE(wd))
+
+	        # If this is a polar or near_polar plot, the latitudes
+		# should be placed near the line, not where it crosses the
+		# window boundary.
+
+	        if  (WL_GRAPH_TYPE(wd) == POLAR &&
+	            (WL_MAJ_GRIDON(wd) == YES) && (WL_LABON(wd) == YES)) {
+	    	    WL_N_LABELS(wd) = old_n_labels + 1
+	    	    call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), 
+	                WL_POLAR_LABEL_POSITION(wd), current,
+	                WL_LABEL_POSITION(wd,WL_N_LABELS(wd),X_DIM),
+	                WL_LABEL_POSITION(wd,WL_N_LABELS(wd),Y_DIM), 1)
+	    	    WL_LABEL_VALUE(wd,WL_N_LABELS(wd)) = current
+	    	    WL_LABEL_AXIS(wd,WL_N_LABELS(wd)) = AXIS2
+	        }
+
+	    } else {
+	        call gseti  (WL_GP(wd), G_PLTYPE, WL_MIN_LINE_TYPE(wd))
+	        call wl_graph_constant_axis2 (wd, current, WL_BEGIN(wd,AXIS1),
+		    WL_END(wd,AXIS1), WL_MIN_GRIDON(wd), NO,
+		    WL_MIN_TICK_SIZE(wd)) 
+	    }
+
+	    # Increment and continue
+	    min_counter = min_counter + 1
+	    current = tmp_begin + tmp_minor_interval * min_counter
+
+	} until  (real (current) > real (tmp_end))
+
+	# Set the line type back to the way it was.
+	call gseti (WL_GP(wd), G_PLTYPE, old_type)
+end
+
+
+# WL_GRAPH_CONSTANT_AXIS1 - Graph lines of constant X-axis values.
+#
+# Description
+#  Because projections are rarely linear, the basic GIO interface to draw
+#  lines cannot be used.  Instead, this routine handles the line drawing.
+#  Also, possible label points are found and added to a label list array.
+#
+# CLUDGE! Finding labels here is WRONG.  Ideally, crossing points (where the
+# line crosses a screen boundary) should be determined analytically.  However,
+# the MWCS interface lacks the required "cross-transformations".  It can
+# still be done, but requires a total bypassing of MWCS.  Instead, this
+# simplistic approach is used.
+
+procedure wl_graph_constant_axis1 (wd, x, ymin, ymax, gridon, label, tick_size)
+
+pointer wd          	# I: the WCSLAB descriptor
+double  x               # I: X value to hold constant
+double  ymin, ymax      # I: Y values to vary between
+int	gridon          # I: true if gridding is on
+int     label           # I: true if the points should be labelled
+real    tick_size       # I: size of tick marks
+
+bool	done
+double	lastx, lasty, lx, ly, y, yinc
+real	rlx, rly
+
+begin
+	# Determine the scale at which Y should be incremented.
+	yinc =  (ymax - ymin) / WL_LINE_SEGMENTS(wd)
+
+	# Now graph the line segments.
+	y = ymin
+	call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), x, y, lastx, lasty, 1)
+
+	rlx = lastx
+	rly = lasty
+	call gamove (WL_GP(wd), rlx, rly)
+
+	repeat {
+	    call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), x, y, lx, ly, 1)
+	    call wl_point_to_label (wd, lastx, lasty, lx, ly, AXIS1, x, gridon,
+	        label, tick_size)
+	    if (gridon == YES) {
+		rlx = lx
+		rly = ly
+	        call gadraw (WL_GP(wd), rlx, rly)
+	    }
+	    if (yinc < 0.)
+	        done = y < ymax
+	    else
+	        done = y > ymax
+	    y = y + yinc
+	    lastx = lx
+	    lasty = ly
+	} until  (done)
+end
+
+
+# WL_GRAPH_CONSTANT_AXIS2 -- Graph lines of constant Y-axis values.
+#
+# Description
+#  Because projections are rarely linear, the basic GIO interface to draw
+#  lines cannot be used.  Instead, this routine handles the line drawing.
+#  Also, possible label points are found and added to an label list array.
+#
+# CLUDGE! Finding labels here is WRONG.  Ideally, crossing points (where the
+# line crosses a screen boundary) should be determined analytically.  However,
+# the MWCS interface lacks the required "cross-transformations".  It can
+# still be done, but requires a total bypassing of MWCS.  Instead, this
+# simplistic approach is used.
+
+procedure wl_graph_constant_axis2 (wd, y, xmin, xmax, gridon, label, tick_size)
+
+pointer wd              # I: the WCSLAB descriptor
+double  y               # I: Y value to hold constant
+double  xmin, xmax      # I: X values to vary between
+int	gridon          # I: true if gridding is on
+int	label           # I: true if points should be labelled
+real    tick_size       # I: tick mark size
+
+bool	done
+double	lx, ly, lastx, lasty, x, xinc
+real	rlx, rly
+
+begin
+	# Determine the scale at which X should be incremented.
+	xinc =  (xmax - xmin) / WL_LINE_SEGMENTS(wd)
+
+	# Now graph the line segments.
+	x = xmin
+	call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), x, y, lastx, lasty, 1)
+
+	rlx = lastx
+	rly = lasty
+	call gamove (WL_GP(wd), rlx, rly)
+
+	repeat {
+	    call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), x, y, lx, ly, 1)
+	    call wl_point_to_label (wd, lastx, lasty, lx, ly, AXIS2, y, gridon,
+	        label, tick_size)
+	    if  (gridon == YES) {
+		rlx = lx
+		rly = ly
+	        call gadraw (WL_GP(wd), rlx, rly)
+	    }
+	    if  (xinc < 0.)
+	        done = x < xmax
+	    else
+		done = x > xmax
+	    lastx = lx
+	    lasty = ly
+	    x = x + xinc
+	} until  (done)
+end
+
+
+# Define the inside and outside of the window.
+
+define OUT (($1<=WL_SCREEN_BOUNDARY(wd,LEFT))||($1>=WL_SCREEN_BOUNDARY(wd,RIGHT))||($2<=WL_SCREEN_BOUNDARY(wd,BOTTOM))||($2>=WL_SCREEN_BOUNDARY(wd,TOP)))
+
+define IN (($1>WL_SCREEN_BOUNDARY(wd,LEFT))&&($1<WL_SCREEN_BOUNDARY(wd,RIGHT))&&($2>WL_SCREEN_BOUNDARY(wd,BOTTOM))&&($2<WL_SCREEN_BOUNDARY(wd,TOP)))
+
+
+# WL_POINT_TO_LABEL - Record a points position along a window boundary.
+#
+# Description
+#  Since the MWCS interface lacks "cross-transformations", i.e. If given
+#  RA and and X axis location, find DEC and Y axis, we need a different
+#  method of determining when lines of constant Axis 1/Axis 2 cross
+#  the window boundary.  Since each line is drawn by small increments, each
+#  increment is watched to see if a window boundary has been crossed.  This
+#  is what this routine does:  Confirms that a boundary has been crossed,
+#  records this position and label value.  Tick marks are also drawn here
+#  because all the necessary information is known at this point.
+#
+# NOTE: THIS WAY IS A CLUDGE !  A more formal method of finding
+# cross-transformations is needed- most likely an iterative method.  This
+# way was just "convenient at the time".
+
+procedure wl_point_to_label (wd, x1, y1, x2, y2, axis, axis_value, gridon, 
+	label, tick_size)
+
+pointer wd                  # I: the WCSLAB descriptor
+double  x1, y1, x2, y2      # I: the two possible points to label
+int     axis                # I: which axis are we dealing with ?
+double  axis_value          # I: the value of the axis at this point
+int	gridon              # I: true if gridding is on
+int	label               # I: true if this point should have a label
+real    tick_size           # I: size of the tick mark
+
+double	nx, ny, tick_x, tick_y
+double	wl_vector_angle()
+
+begin
+	# Determine whether the two points straddle a window boundary. If they 
+	# do, then this is the point to label.
+	if  (OUT (x1, y1) && IN (x2, y2)) {
+
+	    call wl_axis_on_line (x1, y1, x2, y2, WL_SCREEN_BOUNDARY(wd,1),
+	        nx, ny)
+
+	    if  (gridon == NO) {
+	        call wl_mark_tick (WL_GP(wd), WL_NDC_WCS(wd), tick_size, 
+	            WL_TICK_IN(wd), x1, y1, x2, y2, nx, ny, tick_x, tick_y)
+	        if (WL_TICK_IN(wd) != WL_LABOUT(wd)) {
+	            nx = tick_x
+	            ny = tick_y
+	        }
+	    } 
+
+	    if  ((label == YES) && WL_N_LABELS(wd) < MAX_LABEL_POINTS) {
+	        WL_N_LABELS(wd) = WL_N_LABELS(wd) + 1
+	        WL_LABEL_POSITION(wd,WL_N_LABELS(wd),AXIS1) = nx
+	        WL_LABEL_POSITION(wd,WL_N_LABELS(wd),AXIS2) = ny
+	        WL_LABEL_VALUE(wd,WL_N_LABELS(wd)) = axis_value
+	        WL_LABEL_AXIS(wd,WL_N_LABELS(wd)) = axis
+	    	WL_LABEL_ANGLE(wd,WL_N_LABELS(wd)) =
+		    wl_vector_angle (WL_GP(wd), x1, y1, x2, y2)
+	    }
+	}
+
+	if  (IN (x1, y1) && OUT (x2, y2)) {
+
+	    call wl_axis_on_line (x2, y2, x1, y1, WL_SCREEN_BOUNDARY(wd,1), 
+	        nx, ny)
+
+	    if  (gridon == NO) {
+	        call wl_mark_tick (WL_GP(wd), WL_NDC_WCS(wd), tick_size, 
+	            WL_TICK_IN(wd), x2, y2, x1, y1, nx, ny, tick_x, tick_y)
+	        if (WL_TICK_IN(wd) != WL_LABOUT(wd)) {
+	      	    nx = tick_x
+	      	    ny = tick_y
+	        }
+	    }
+
+	    if  ((label == YES) && WL_N_LABELS(wd) < MAX_LABEL_POINTS) {
+		WL_N_LABELS(wd) = WL_N_LABELS(wd) + 1
+		WL_LABEL_POSITION(wd,WL_N_LABELS(wd),AXIS1) = nx
+		WL_LABEL_POSITION(wd,WL_N_LABELS(wd),AXIS2) = ny
+		WL_LABEL_VALUE(wd,WL_N_LABELS(wd)) = axis_value
+		WL_LABEL_AXIS(wd,WL_N_LABELS(wd)) = axis
+		WL_LABEL_ANGLE(wd,WL_N_LABELS(wd)) =
+		    wl_vector_angle (WL_GP(wd), x1, y1, x2, y2)
+	    }
+	}
+
+end
+
+
+# WL_MARK_TICK - Draw the tick mark at the point.
+#
+# Description
+#  Draw a tick mark rooted at (sx,sy), whose direction is defined by
+#  the vector (x0,y0) to (x1,y1). The other end of the tick mark is
+# returned in (tick_x,tick_y).
+
+procedure wl_mark_tick (gp, wcs, tick_size, in, x0, y0, x1, y1, sx, sy,
+	tick_x, tick_y)
+
+pointer gp              # I: the graphics pointer
+int     wcs             # I: the WCS to use to draw the tick marks
+real    tick_size       # I: size of the tick mark
+int	in              # I: true if ticks should be into the graph
+double  x0, y0, x1, y1  # I: the points defining the tick direction
+double	sx, sy		# I: the root point of the tick mark
+double  tick_x, tick_y  # O: the end point of the tick mark
+
+int	old_line, old_wcs
+real	dx, dy, t, ndc_x0, ndc_y0, ndc_x1, ndc_y1, ndc_x2, ndc_y2
+real	ndc_sx, ndc_sy
+int	gstati()
+real	wl_distancer()
+
+begin
+	# Change graphics coordinates to NDC.
+	old_wcs = gstati (gp, G_WCS)
+	old_line = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_WCS, wcs)
+	call gseti (gp, G_PLTYPE, GL_SOLID)
+
+	# Convert the points to NDC coordinates.
+	ndc_x2 = real (sx)
+	ndc_y2 = real (sy)
+	call gctran (gp, ndc_x2, ndc_y2, ndc_sx, ndc_sy, old_wcs, wcs)
+	ndc_x2 = real (x0)
+	ndc_y2 = real (y0)
+	call gctran (gp, ndc_x2, ndc_y2, ndc_x0, ndc_y0, old_wcs, wcs)
+	ndc_x2 = real (x1)
+	ndc_y2 = real (y1)
+	call gctran (gp, ndc_x2, ndc_y2, ndc_x1, ndc_y1, old_wcs, wcs)
+
+	# Determine the parameterized line parameters.
+	dx = ndc_x1 - ndc_x0
+	dy = ndc_y1 - ndc_y0
+
+	# Determine how large in "time" the tick mark is.
+	t = tick_size / wl_distancer (ndc_x0, ndc_y0, ndc_x1, ndc_y1)
+
+	# If tick marks are to point out of the graph, reverse the sign of t.
+	# Also need to turn clipping off for the ticks appear.
+	if (in == NO) {
+	  t = -t
+	  call gseti (gp, G_CLIP, NO)
+	}
+
+	# Determine the end point of the tick mark.
+	ndc_x2 = t * dx + ndc_sx
+	ndc_y2 = t * dy + ndc_sy
+
+	# Now draw the tick mark.
+	call gamove (gp, ndc_sx, ndc_sy)
+	call gadraw (gp, ndc_x2, ndc_y2)
+
+	# Restore clipping if necessary.
+	if (in == NO)
+	  call gseti (gp, G_CLIP, YES)
+
+	# Restore previous settings.
+	call gseti (gp, G_WCS, old_wcs)
+	call gseti (gp, G_PLTYPE, old_line)
+
+	# Transform the end of the tick mark.
+	call gctran (gp, ndc_x2, ndc_y2, dx, dy, wcs, old_wcs)
+	tick_x = double (dx)
+	tick_y = double (dy)
+end
+
+
+# WL_VECTOR_ANGLE -- Return the angle represented by the given vector.
+#
+# Returns
+#   The angle of the given vector.
+
+double procedure wl_vector_angle (gp, x1, y1, x2, y2)
+
+pointer gp                  # I: the graphics descriptor
+double  x1, y1, x2, y2      # I: the end points of the vector
+
+double	dangle
+real	angle, delx, dely, ndc_x1, ndc_x2, ndc_y1, ndc_y2
+bool	fp_equalr()
+int	gstati()
+
+begin
+	# Translate the input points to NDC coordinates.
+	ndc_x1 = real (x1)
+	ndc_x2 = real (x2)
+	ndc_y1 = real (y1)
+	ndc_y2 = real (y2)
+	call gctran (gp, ndc_x1, ndc_y1, ndc_x1, ndc_y1, gstati (gp, G_WCS), 
+	    NDC_WCS)
+	call gctran (gp, ndc_x2, ndc_y2, ndc_x2, ndc_y2, gstati (gp, G_WCS), 
+	    NDC_WCS)
+
+	dely = ndc_y2 - ndc_y1
+	delx = ndc_x2 - ndc_x1
+	if (fp_equalr (delx, 0.) && fp_equalr (dely, 0.))
+	    angle = 0.0
+	else
+	    angle = RADTODEG (atan2 (dely, delx))
+	dangle = angle
+
+	return (dangle)
+end
diff --git a/pkg/utilities/nttools/stxtools/wcslab/wllabel.x b/pkg/utilities/nttools/stxtools/wcslab/wllabel.x
new file mode 100644
index 00000000..4578f89c
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/wllabel.x
@@ -0,0 +1,1100 @@
+include <gset.h>
+include <math.h>
+include "psiescape.h"
+include "wcslab.h"
+include "wcs_desc.h"
+
+
+# Define the offset array.
+define OFFSET Memr[$1+$2-1]
+
+# Define the postscript kernel
+define PSIKERN "psikern"
+
+# WL_LABEL  -- Place the labels on the grids.
+#
+# Description
+#  Format and write the labels for the grid/tick marks.  Much of this
+#  is wading through conditions to decide whether a label should be
+#  written or not.
+
+procedure wl_label (wd)
+
+pointer wd                  # I: the WCSLAB descriptor
+
+bool	no_side_axis1, no_side_axis2, streq()
+int	i, axis1_side, axis2_side
+short	flag
+pointer	kernel, sp, offset_ptr
+real	offset
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (offset_ptr, N_SIDES, TY_REAL)
+	do i = 1, N_SIDES
+	    OFFSET(offset_ptr,i) = 0.
+        call salloc (kernel, SZ_LINE, TY_CHAR )
+
+	# Decide whether any sides were specified for either axis.
+	no_side_axis1 = true
+	no_side_axis2 = true
+	do i = 1, N_SIDES {
+	    if (WL_LABEL_SIDE(wd,i,AXIS1))
+	        no_side_axis1 = false
+	    if (WL_LABEL_SIDE(wd,i,AXIS2))
+	        no_side_axis2 = false
+	}
+
+	# If polar, then label the axis 2's next to their circles on the
+	# graph and allow the Axis 1s to be labeled on all sides of the graph.
+
+	if  (WL_GRAPH_TYPE(wd) == POLAR) {
+
+	    call wl_polar_label (wd)
+
+	    if (no_side_axis1) {
+	        do i = 1, N_SIDES {
+	          WL_LABEL_SIDE(wd,i,AXIS1) = true
+	        }
+	        if (IS_INDEFI (WL_AXIS_TITLE_SIDE(WD,AXIS1)))
+	    	    WL_AXIS_TITLE_SIDE(WD,AXIS1) = BOTTOM
+	    }
+
+	# If we are near-polar, label the Axis 2 as if polar, and label
+	# Axis1 on all sides except the side closest to the pole.
+
+	} else if  (WL_GRAPH_TYPE(wd) == NEAR_POLAR) {
+
+	    if (no_side_axis1) {
+	        WL_LABEL_SIDE(wd,WL_BAD_LABEL_SIDE(wd),AXIS1) = true
+	        if (IS_INDEFI (WL_AXIS_TITLE_SIDE(wd,AXIS1)))
+	    	    WL_AXIS_TITLE_SIDE(wd,AXIS1) = WL_BAD_LABEL_SIDE(wd)
+	    }
+
+	    if (no_side_axis2) {
+	        WL_LABEL_SIDE(wd,WL_POLAR_LABEL_DIRECTION(wd),AXIS2) = true
+	        if (IS_INDEFI (WL_AXIS_TITLE_SIDE(wd,AXIS2)))
+	        WL_AXIS_TITLE_SIDE(wd,AXIS2) = WL_POLAR_LABEL_DIRECTION(wd)
+	    }
+
+	# Final case- adjacent sides should be labelled.
+
+	} else {
+
+	    # Determine the best sides for labelling.
+	    if  (INVERT (WL_ROTA(wd))) {
+	        axis1_side = LEFT
+	        axis2_side = BOTTOM
+	    } else {
+	        axis1_side = BOTTOM
+	        axis2_side = LEFT
+	    }
+
+	    # If no sides were specified, use the calculated ones above.
+	    if (no_side_axis1)
+	        WL_LABEL_SIDE(wd,axis1_side,AXIS1) = true
+	    if (no_side_axis2)
+	        WL_LABEL_SIDE(wd,axis2_side,AXIS2) = true
+	}
+
+        # Check to see if this is a psikern printer.  If so, set text
+        # so that it is mono-spaced.  The superscripting algorithm
+        # doesn't work too well in a proportional-spaced system.
+        call ggets (WL_GP(wd), "tn", Memc[kernel], SZ_LINE )
+        if (streq (Memc[kernel], PSIKERN)) {
+            flag = NO
+            call gescape (WL_GP(wd), PS_VARIABLE_SPACE, flag,
+                          PS_VARIABLE_SPACE_SIZE)
+        }
+
+	# Now draw the labels for axis 1.
+	do i = 1, N_SIDES {
+
+	    if (WL_LABEL_SIDE(wd,i,AXIS1)) {
+	        call wl_lab_edges (wd, AXIS1, i, offset)
+	        if (IS_INDEFI (WL_AXIS_TITLE_SIDE(WD,AXIS1)))
+	  	    WL_AXIS_TITLE_SIDE(WD,AXIS1) = i
+	    } else
+	        offset = 0.
+
+	  # Modify the bounding box for the new viewport.
+	  if (abs (offset) > abs (OFFSET(offset_ptr,i)))
+	    OFFSET(offset_ptr,i) = offset
+	}
+
+	# Draw the labels for axis 2.
+	if (WL_GRAPH_TYPE(wd) != POLAR) 
+	    do i = 1, N_SIDES {
+
+	        if (WL_LABEL_SIDE(wd,i,AXIS2)) {
+	      	    call wl_lab_edges (wd, AXIS2, i, offset)
+	      	    if (IS_INDEFI (WL_AXIS_TITLE_SIDE(wd,AXIS2)))
+	            WL_AXIS_TITLE_SIDE(wd,AXIS2) = i
+	        } else
+	    	    offset = 0.
+
+	        # Modify the bounding box for the new viewport.
+	        if (abs (offset) > abs (OFFSET(offset_ptr,i)))
+	    	    OFFSET(offset_ptr,i) = offset
+	    }
+
+        # Reset to variable spacing.
+        if (streq (Memc[kernel], PSIKERN)) {
+            flag = YES
+            call gescape (WL_GP(wd), PS_VARIABLE_SPACE, flag,
+                          PS_VARIABLE_SPACE_SIZE)
+        }
+
+	# Set the bounding box.
+	do i = 1, N_SIDES
+	    WL_NEW_VIEW(wd,i) = WL_NEW_VIEW(wd,i) + OFFSET(offset_ptr,i)
+
+	# Now write the graph title.
+	call wl_title (WL_GP(wd), WL_AXIS_TITLE(wd,AXIS1), 
+	    WL_AXIS_TITLE_SIDE(wd,AXIS1), WL_AXIS_TITLE_SIZE(wd),
+	    WL_NEW_VIEW(wd,1))
+	if (WL_GRAPH_TYPE(wd) != POLAR)
+	    call wl_title (WL_GP(wd), WL_AXIS_TITLE(wd,AXIS2), 
+	        WL_AXIS_TITLE_SIDE(wd,AXIS2), WL_AXIS_TITLE_SIZE(WD),
+		WL_NEW_VIEW(wd,1))
+	if (! IS_INDEFI (WL_TITLE_SIDE(wd)))
+	    call wl_title (WL_GP(wd), WL_TITLE(wd), WL_TITLE_SIDE(wd),
+	        WL_TITLE_SIZE(wd), WL_NEW_VIEW(wd,1))
+
+	# Release memory.
+	call sfree (sp)
+end
+
+
+# Define what is in the screen.
+
+define IN (($1>WL_SCREEN_BOUNDARY(wd,LEFT))&&($1<WL_SCREEN_BOUNDARY(wd,RIGHT))&&($2>WL_SCREEN_BOUNDARY(wd,BOTTOM))&&($2<WL_SCREEN_BOUNDARY(wd,TOP)))
+
+# WL_POLAR_LABEL -- Place Latitude labels next to Latitude circles.
+#
+# Description
+#  Since Lines of constant Latitude on a polar graph are usually circles
+#  around the pole, the lines may never cross edges.  Instead, the labels
+#  are placed next to circles.  The grid-drawing routines should setup
+#  the label position array such that each line has only one label point.
+
+procedure wl_polar_label (wd)
+
+pointer wd            # I: the WCSLAB descriptor
+
+int	i, prec
+pointer sp, label, units, label_format, units_format
+real	char_height, char_width, ndc_textx, ndc_texty, old_text_size
+real	textx, texty
+int	wl_precision()
+real	gstatr(), ggetr()
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+	call salloc (label_format, SZ_LINE, TY_CHAR)
+	call salloc (units_format, SZ_LINE, TY_CHAR)
+
+	# Get the character height and width.  This is used to ensure that we
+	# have moved the label strings off the border.
+
+	char_height = ggetr (WL_GP(wd), "ch") * gstatr (WL_GP(wd), G_TXSIZE) /
+	    2.
+	char_width = ggetr (WL_GP(wd), "cw") * gstatr (WL_GP(wd), G_TXSIZE) /
+	    2.
+
+	# Get the text size and cut it in half for on the plot labelling.
+	old_text_size = gstatr (WL_GP(wd), G_TXSIZE)
+	call gsetr (WL_GP(wd), G_TXSIZE, old_text_size)
+	call gsetr (WL_GP(wd), G_TXSIZE, old_text_size * 0.80)
+
+	# Determine the precision of the output.
+	prec = wl_precision (wd, AXIS2)
+
+	# Place the labels.
+	for  (i = 1; i <= WL_N_LABELS(wd); i = i + 1)
+	    if  (WL_LABEL_AXIS(wd,i) == AXIS2) {
+
+	        # Decode the coordinate into a text string.
+	        call wl_dms (WL_LABEL_VALUE(wd,i), Memc[label], Memc[units],
+	            SZ_LINE, prec, true)
+
+	        # Convert text position from "unknown" coordinates to NDC.
+	        call gctran (WL_GP(wd), real (WL_LABEL_POSITION(wd,i,AXIS1)), 
+	            real (WL_LABEL_POSITION(wd,i,AXIS2)), ndc_textx, ndc_texty,
+		    WL_PLOT_WCS(wd), WL_NDC_WCS(wd))
+
+	        # Determine the text justification.
+	        switch  (WL_POLAR_LABEL_DIRECTION(wd)) {
+	        case BOTTOM: 
+	            call strcpy ("h=c;v=t", Memc[label_format], SZ_LINE)
+	            call strcpy ("h=c;v=c", Memc[units_format], SZ_LINE)
+	            ndc_texty = ndc_texty - char_height
+	        case TOP: 
+	            call strcpy ("h=c;v=c", Memc[label_format], SZ_LINE)
+	            call strcpy ("h=c;v=b", Memc[units_format], SZ_LINE)
+	            ndc_texty = ndc_texty + char_height
+	        case LEFT: 
+	            call strcpy ("h=r;v=c", Memc[label_format], SZ_LINE)
+	            call strcpy ("h=r;v=b", Memc[units_format], SZ_LINE)
+	            ndc_textx = ndc_textx - char_width
+	        case RIGHT: 
+	            call strcpy ("h=l;v=c", Memc[label_format], SZ_LINE)
+	            call strcpy ("h=l;v=b", Memc[units_format], SZ_LINE)
+	            ndc_textx = ndc_textx + char_width
+	        }
+
+	        # Convert the text position from NDC back to the "unknown"
+		# system.
+	        call gctran (WL_GP(wd), ndc_textx, ndc_texty, textx, texty, 
+	            WL_NDC_WCS(wd), WL_PLOT_WCS(wd))
+	  
+	        # Print the label.
+	        if (IN (textx, texty)) {
+	    	    call gtext (WL_GP(wd), textx, texty, Memc[label], 
+	                Memc[label_format])
+	    	    call gtext (WL_GP(wd), textx, texty, Memc[units], 
+	                Memc[units_format])
+	        }
+
+	    }
+
+	# Set the text size back.
+	call gsetr (WL_GP(wd), G_TXSIZE, old_text_size)
+
+	# Release memory.
+	call sfree (sp)
+
+end
+
+
+# Memory management for labels
+
+define LABEL_LIST Memi[labels+$1-1]
+
+# WL_LAB_EDGES  -- Place labels along the edges of the window.
+#
+# Description
+#  Place labels on the specified side of the graph.
+
+procedure wl_lab_edges (wd, axis, side, offset)
+
+pointer wd      	# I: the WCSLAB descriptor
+int     axis    	# I: the type of axis being labeled
+int     side    	# I: the side to place the labels
+real    offset  	# O: offset in NDC units for titles
+
+bool	do_full
+double	angle, tangle
+int	i, full_label, nlabels, old_wcs, prec
+pointer sp, labels 
+real	ndc_textx, ndc_texty, old_text_size, textx, texty
+
+int	wl_full_label_position(), wl_find_side()
+double	wl_string_angle(), wl_angle()
+int	gstati(), wl_precision()
+real	gstatr()
+
+begin
+	call smark (sp)
+
+	# All label placement is done in NDC coordinates.
+	old_wcs = gstati (WL_GP(wd), G_WCS)
+	call gseti (WL_GP(wd), G_WCS, WL_NDC_WCS(wd))
+
+	# Set text labelling size.
+	old_text_size = gstatr (WL_GP(wd), G_TXSIZE)
+	call gsetr (WL_GP(wd), G_TXSIZE, WL_LABEL_SIZE(wd))
+
+	# Get the precision of the axis interval.
+	prec = wl_precision (wd, axis)
+
+	# Initialize string size.
+	offset = 0.
+
+	# Build a list of possible labels for this side. The conditions are
+	# that the label should be for the current axis and that it lies on
+	# the current side.
+
+	call salloc (labels, WL_N_LABELS(wd), TY_INT)
+	nlabels = 0
+	for (i = 1; i <= WL_N_LABELS(wd); i = i + 1)
+	    if  (WL_LABEL_AXIS(wd,i) == axis && 
+	        wl_find_side (WL_LABEL_POSITION(wd,i,AXIS1),
+	        WL_LABEL_POSITION(wd,i,AXIS2), 
+	        WL_SCREEN_BOUNDARY(wd,1)) == side) {
+	        nlabels = nlabels + 1
+	        LABEL_LIST(nlabels) = i
+	    }  
+	
+	# If no labels found, then just forget it.  If labels found, well
+	# write them out.
+
+	if (nlabels != 0) {
+
+	    # Determine which label should be written out in full.
+	    full_label = wl_full_label_position (wd, Memi[labels], nlabels,
+	        axis, side, prec)
+
+	    # Determine the angle that all the labels will be written at.
+	    if ((WL_LABOUT(wd) == NO) && (WL_GRAPH_TYPE(wd) != NORMAL) &&
+	        (WL_LABEL_ROTATE(wd) == YES))
+		angle = INDEFR
+	    else if ((WL_GRAPH_TYPE(wd) == NORMAL) && ((WL_LABEL_ROTATE(wd) ==
+		YES) || ((WL_LABOUT(wd) == NO) && (WL_MAJ_GRIDON(wd) == YES))))
+	        angle = wl_angle (wd, Memi[labels], nlabels)
+	    else
+		angle = 0.0
+
+	    # Place the labels.
+	    for  (i = 1; i <= nlabels; i = i + 1) {
+	
+	        # Save some pertinent information.
+	        textx = real (WL_LABEL_POSITION(wd,LABEL_LIST(i),AXIS1))
+	        texty = real (WL_LABEL_POSITION(wd,LABEL_LIST(i),AXIS2))
+	        do_full =  ((LABEL_LIST(i) == full_label) ||
+	    	    (WL_ALWAYS_FULL_LABEL(wd) == YES))
+	
+	        # Transform the "unknown" coordinate system to a known
+		# coordinate system, NDC, for text placement.
+	        call gctran (WL_GP(wd), textx, texty, ndc_textx, ndc_texty, 
+	            old_wcs, WL_NDC_WCS(wd))
+
+		# If angle is undefined, determine the angle for each label.
+		if (IS_INDEFR(angle))
+		    tangle = wl_string_angle (WL_LABEL_ANGLE(wd,
+		        LABEL_LIST(i)), WL_LABOUT(wd))
+		else
+		    tangle = angle
+	
+	        # Format and write the label.
+	        call wl_write_label (wd, WL_LABEL_VALUE(wd,LABEL_LIST(i)), 
+	            side, ndc_textx, ndc_texty, tangle, axis, prec, do_full,
+		    offset)
+	    }
+	}
+	
+	# Reset the graphics WCS.
+	call gsetr (WL_GP(wd), G_TXSIZE, old_text_size)
+	call gseti (WL_GP(wd), G_WCS, old_wcs)
+
+	call sfree (sp)
+end
+
+
+# WL_TITLE - Write the title of the graph.
+
+procedure wl_title (gp, title, side, size, viewport)
+
+pointer gp                 # I: the graphics descriptor
+char    title[ARB]         # I: the title to write
+int     side               # I: which side the title will go
+real    size               # I: the character size to write the title
+real    viewport[N_SIDES]  # I: the viewport in NDC to keep the title out of
+
+int	old_wcs
+real	char_height, char_width, left, right, top, bottom, old_rotation
+real	old_text_size, x, y
+int	gstati(), strlen()
+real	ggetr(), gstatr()
+
+begin
+	# Make sure there is a title to write.  If not, then punt.
+	if (strlen (title) <= 0)
+	  return
+
+	# Get/Set pertinent graphics info.
+	call ggview (gp, left, right, bottom, top)
+
+	old_text_size = gstatr (gp, G_TXSIZE)
+	call gsetr (gp, G_TXSIZE, size)
+	old_rotation = gstatr (gp, G_TXUP)
+
+	char_height = ggetr (gp, "ch") * size
+	char_width = ggetr (gp, "cw") * size
+
+	old_wcs = gstati (gp, G_WCS)
+	call gseti (gp, G_WCS, NDC_WCS)
+
+	# Depending on side, set text position and rotation.
+	switch (side) {
+	case TOP:
+	    call gsetr (gp, G_TXUP, 90.)
+	    x =  (right + left) / 2.
+	    y = viewport[TOP] +  (2 * char_height)
+	    viewport[TOP] = y +  (char_height / 2.)
+	case BOTTOM:
+	    call gsetr (gp, G_TXUP, 90.)
+	    x =  (right + left) / 2.
+	    y = viewport[BOTTOM] -  (2 * char_height)
+	    viewport[BOTTOM] = y -  (char_height / 2.)
+	case RIGHT:
+	    call gsetr (gp, G_TXUP, 180.)
+	    x = viewport[RIGHT] +  (2 * char_width)
+	    y =  (top + bottom) / 2.
+	    viewport[RIGHT] = x +  (char_width / 2.)
+	case LEFT:
+	    call gsetr (gp, G_TXUP, 180.)
+	    x = viewport[LEFT] -  (2 * char_width)
+	    y =  (top + bottom) / 2.
+	    viewport[LEFT] = x -  (char_width / 2.)
+	}
+
+	# Write the puppy out.
+	call gtext (gp, x, y, title, "h=c;v=c")
+
+	# Set the graphics state back.
+	call gseti (gp, G_WCS, old_wcs)
+	call gsetr (gp, G_TXSIZE, old_text_size)
+	call gsetr (gp, G_TXUP, old_rotation)
+end
+
+
+# WL_PRECISION -- Determine the precision of the interval.
+
+int procedure wl_precision (wd, axis)
+
+pointer wd    	  # I: the WCSLAB descriptor
+int     axis      # I: which axis is being examined ?
+
+int	prec 
+
+begin
+	# Handle the sky coordinates.
+	if (WL_SYSTEM_TYPE(wd) == RA_DEC)
+
+	    if (axis == AXIS1) {
+	        if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (3600.0D0))
+	    	    prec = HOUR
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (60.0D0))
+	    	    prec = MINUTE
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (1.0D0))
+	    	    prec = SECOND
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (.01D0))
+	    	    prec = SUBSEC_LOW
+	        else
+	    	    prec = SUBSEC_HIGH
+	    } else {
+	        if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (3600.0D0))
+	    	    prec = DEGREE
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (60.0D0))
+	    	    prec = MINUTE
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (1.0D0))
+	    	    prec = SECOND
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (.01D0))
+	    	    prec = SUBSEC_LOW
+	        else
+	    	    prec = SUBSEC_HIGH
+	    }
+
+	# Handle other coordinate types.
+	else
+	    prec = INDEFI
+
+	return (prec)
+
+end
+
+
+# Define some value constraints.
+
+define LOW_ACCURACY .01
+define HIGH_ACCURACY .0001
+
+# WL_HMS -- Convert value to number in hours, minutes, and seconds.
+
+procedure wl_hms (rarad, hms, units, maxch, precision, all)
+
+double  rarad            # I: the value to format into a string (degrees)
+char    hms[ARB]         # O: string containing formatted value
+char    units[ARB]       # O: string containing formatted units
+int     maxch            # I: the maximum number of characters allowed
+int     precision        # I: how precise the output should be
+bool    all              # I: true if all relevent fields should be formatted
+
+double  accuracy, fraction
+int	sec, h, m, s
+pointer sp, temp_hms, temp_units 
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (temp_hms, maxch, TY_CHAR)
+	call salloc (temp_units, maxch, TY_CHAR)
+
+	units[1] = EOS
+	hms[1]   = EOS
+
+	# Define how close to zero is needed.
+	accuracy = LOW_ACCURACY
+	if (precision == SUBSEC_HIGH)
+	    accuracy = HIGH_ACCURACY
+
+	# Seconds of time.
+	fraction = double (abs(DEGTOST (rarad)))
+	if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) {
+	    sec = int (fraction)
+	    fraction = fraction - double (sec)
+	} else {
+	    sec = int (fraction + 0.5)
+	    fraction = 0.
+	}
+
+	# Range:  0 to 24 hours.
+	if (sec < 0)
+	    sec = sec + STPERDAY
+	else if (sec >= STPERDAY)
+	    sec = mod (sec, STPERDAY)
+
+	# Separater fields.
+	s = mod (sec, 60)
+	m = mod (sec / 60, 60)
+	h = sec / 3600
+
+	# Format fields.
+
+	# Subseconds.
+	if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) {
+	    fraction = s + fraction
+	    if (precision == SUBSEC_LOW) {
+	        call sprintf (hms, 6, "%05.2f")
+	    	    call pargd (fraction)
+	        call strcpy ("  s  ", units, maxch)
+	    } else {
+	        call sprintf (hms, 8, "%07.4f")
+	    	    call pargd (fraction)
+	        call strcpy ("  s    ", units, maxch)
+	    }
+	    if (!all)
+	        all =  (fraction < accuracy)
+
+	# Seconds
+	} else if (precision == SECOND) {
+
+	    # NOTE: The all is not part of the if statement because if
+	    # SUBSEC's have been printed, then seconds have already been
+	    # dealt with.  If SUBSEC's have not been dealt with, then this
+	    # is the first field to be checked anyways.
+
+	    call sprintf (hms, 3, "%02d ")
+	        call pargi (s)
+	    call strcpy ("  s", units, maxch)
+	    if (! all) 
+		all =  (s == 0)
+	}
+
+	# Minutes.
+	if (precision == MINUTE ||  (precision > MINUTE && all)) {
+	    if (all) {
+	        call strcpy (hms, Memc[temp_hms], maxch)
+	        call strcpy (units, Memc[temp_units], maxch)
+	    }
+	    call sprintf (hms, 3, "%02d ")
+		call pargi (m)
+	    call strcpy ("  m", units, maxch)
+	    if (all) {
+	        call strcat (Memc[temp_hms], hms, maxch)
+	        call strcat (Memc[temp_units], units, maxch)
+	    } else
+	        all =  (m == 0)
+	}
+
+	# Non-zero hours.
+	if  (precision == HOUR || all) {
+	    if (all) {
+	        call strcpy (hms, Memc[temp_hms], maxch)
+	        call strcpy (units, Memc[temp_units], maxch)
+	    }
+	    call sprintf (hms, 3, "%2.2d ")
+		call pargi (h)
+	    call strcpy("  h", units, maxch)
+	    if (all) {
+		call strcat (Memc[temp_hms], hms, maxch)
+	        call strcat (Memc[temp_units], units, maxch)
+	    }
+	}
+
+	# Release memory
+	call sfree (sp)
+end
+
+
+# WL_DMS - Convert value to number in degrees, minutes, and seconds.
+
+procedure wl_dms (arcrad, dms, units, maxch, precision, all)
+
+double  arcrad           # I: the value to format into a string (degrees)
+char    dms[ARB]         # O: string containing formatted value
+char    units[ARB]       # O: string containing formatted units
+int     maxch            # I: the maximum number of characters allowed
+int     precision        # I: how precise the output should be ?
+bool    all              # I: true if all relavent fields should be formatted
+
+double  accuracy, fraction 
+int	sec, h, m, s
+pointer sp, temp_dms, temp_units
+int	strlen()
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (temp_dms, maxch, TY_CHAR)
+	call salloc (temp_units, maxch, TY_CHAR)
+
+	units[1] = EOS
+	dms[1]   = EOS
+
+	# Define how close to zero is needed.
+	accuracy = LOW_ACCURACY
+	if (precision == SUBSEC_HIGH)
+	    accuracy = HIGH_ACCURACY
+
+	# Seconds of time.
+	fraction = double (abs (DEGTOSA (arcrad)))
+	if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) {
+	    sec = int (fraction)
+	    fraction = fraction - double (sec)
+	} else {
+	    sec = nint  (fraction)
+	    fraction = 0.
+	}
+
+	# Separater fields.
+	s = mod (abs(sec), 60)
+	m = mod (abs(sec) / 60, 60)
+	h = abs(sec) / 3600
+
+	# Format fields
+	#
+	# Subseconds.
+	if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) {
+
+	    fraction = s + fraction
+	    call strcpy (dms, Memc[temp_dms], maxch)
+	    call strcpy (units, Memc[temp_units], maxch)
+	    if (precision == SUBSEC_LOW) {
+	        call sprintf (dms, 6, "%05.2f\"")
+	    	    call pargd (fraction)
+	        call strcpy ("      ", units, maxch)
+	    } else {
+	        call sprintf (dms, 8, "%07.4f\"")
+	            call pargd (fraction)
+	        call strcpy ("        ", units, maxch)
+	    }
+	    if (! all)
+	        all =  (fraction < accuracy)
+	    call strcat (Memc[temp_dms], dms, maxch)
+	    call strcat (Memc[temp_units], units, maxch)
+
+	# Seconds
+	} else if (precision == SECOND) {
+
+	    # NOTE: The all is not part of the if statement because if
+	    # SUBSEC's have been printed, then seconds have already been
+	    # dealt with.  If SUBSEC's have not been dealt with, then this
+	    # is the first field to be checked anyways.
+
+	    call strcpy (dms, Memc[temp_dms], maxch)
+	    call strcpy (units, Memc[temp_units], maxch)
+	    call sprintf (dms, 3, "%02d\"")
+		call pargi (s)
+	    call strcpy ("   ", units, maxch)
+	    if (! all) 
+	    	all =  (s == 0)
+	    call strcat (Memc[temp_dms], dms, maxch)
+	    call strcat (Memc[temp_units], units, maxch)
+	}
+
+	# Minutes.
+	if (precision == MINUTE ||  (precision > MINUTE && all)) {
+	    call strcpy (dms, Memc[temp_dms], maxch)
+	    call strcpy (units, Memc[temp_units], maxch)
+	    call sprintf (dms, 3, "%02d'")
+		call pargi (m)
+	    call strcpy ("   ", units, maxch)
+	    call strcat (Memc[temp_dms], dms, maxch)
+	    call strcat (Memc[temp_units], units, maxch)
+	    if (! all)
+	        all =  (m == 0)
+	}
+
+	# Hours.
+	if (precision == DEGREE || all) {
+	    call strcpy (dms, Memc[temp_dms], maxch)
+	    call strcpy (units, Memc[temp_units], maxch)
+	    if (sec + fraction < accuracy)
+	        call strcpy (" 0 ", dms, maxch)
+	    else if (arcrad < 0.) {
+	        call sprintf (dms, 4, "-%d ")
+	    	    call pargi (h)
+	    } else {
+	        call sprintf (dms, 4, "+%d ")
+	    	    call pargi (h)
+	    }
+	    call sprintf(units, 4, "%*wo")
+		call pargi (strlen (dms) - 1)
+	    call strcat (Memc[temp_dms], dms, maxch)
+	    call strcat (Memc[temp_units], units, maxch)
+	}
+
+	# Release memory.
+	call sfree (sp)
+end
+
+
+# WL_FULL_LABEL_POSTION -- Find the position where the full label should be.
+#
+# Description
+#   This routine returns the index to the label that should be printed
+#   in its full form, regardless of its value.  This is so there is always
+#   at least one labelled point with the full information.  This point is
+#   choosen by examining which label is the closest to the passed point
+#   (usually one of the four corners of the display).
+#
+# Returns
+#   Index into the labell arrays of the label to be fully printed.
+#   If the return index is 0, then there are no labels for the given
+#   side.
+
+int procedure wl_full_label_position (wd, labels, nlabels, axis, side,
+	precision)
+
+pointer wd                   # I: the WCSLAB descriptor
+int     labels[nlabels]      # I: array of indexes of labels to be printed
+int     nlabels              # I: the number of labels in labels
+int     axis                 # I: the axis being dealt with
+int     side                 # I: the side being dealt with
+int	precision	     # I: precision of the label
+
+bool	all
+double	cur_dist, dist
+int	i, cur_label, xside, yside
+pointer	sp, temp1
+double	wl_distanced()
+
+begin
+	# Allocate some working space.
+	call smark (sp)
+	call salloc (temp1, SZ_LINE, TY_CHAR)
+
+	# Initialize.
+	xside = INDEFI
+	yside = INDEFI
+
+	# Determine which corner will have the full label.
+	if (side == TOP || side == BOTTOM) {
+	    yside = side
+	    if (axis == AXIS1) {
+	        if (WL_LABEL_SIDE(wd,RIGHT,AXIS2))
+	    	    xside = RIGHT
+	        if (WL_LABEL_SIDE(wd,LEFT,AXIS2))
+	    	    xside = LEFT
+	    } else {
+	        if (WL_LABEL_SIDE(wd,RIGHT,AXIS1))
+	    	    xside = RIGHT
+	        if (WL_LABEL_SIDE(wd,LEFT,AXIS1))
+	    	    xside = LEFT
+	    }
+	    if (IS_INDEFI (xside))
+	    	xside = LEFT
+	} else {
+	    xside = side
+	    if (axis == AXIS1) {
+	        if (WL_LABEL_SIDE(wd,TOP,AXIS2))
+	    	    yside = TOP
+	        if (WL_LABEL_SIDE(wd,BOTTOM,AXIS2))
+	    	    yside = BOTTOM
+	    } else {
+	        if (WL_LABEL_SIDE(wd,TOP,AXIS1))
+	    	    yside = TOP
+	        if (WL_LABEL_SIDE(wd,BOTTOM,AXIS1))
+	    	    yside = BOTTOM
+	    }
+	    if (IS_INDEFI (yside))
+	        yside = BOTTOM
+	}
+
+	# Find the full label.
+	cur_label = labels[1]
+	cur_dist = wl_distanced (WL_SCREEN_BOUNDARY(wd,xside), 
+	    WL_SCREEN_BOUNDARY(wd,yside),
+	    WL_LABEL_POSITION(wd,cur_label,AXIS1),
+	    WL_LABEL_POSITION(wd,cur_label,AXIS2))
+	
+	# Now go through the rest of the labels to find a closer label.
+	for (i = 2; i <= nlabels; i = i + 1) {
+
+	    # Check to see if the label would be written in full anyways.
+	    all = false
+	    if (WL_SYSTEM_TYPE(wd) == RA_DEC) {
+		if (WL_LABEL_AXIS(wd, labels[i]) == LONGITUDE)
+		    call wl_hms (WL_LABEL_VALUE(wd, labels[i]),
+		        Memc[temp1], Memc[temp1], SZ_LINE, precision, all)
+		else
+		    call wl_dms (WL_LABEL_VALUE(wd, labels[i]),
+		        Memc[temp1], Memc[temp1], SZ_LINE, precision, all)
+	    }
+
+	    # If so, don't figure out which label should be full, there
+	    # will be one someplace.
+	    if (all) {
+		cur_label = INDEFI
+		break
+	    }
+
+	    dist = wl_distanced (WL_SCREEN_BOUNDARY(wd,xside), 
+	        WL_SCREEN_BOUNDARY(wd,yside), 
+	        WL_LABEL_POSITION(wd,labels[i],AXIS1), 
+	        WL_LABEL_POSITION(wd,labels[i],AXIS2))
+	    if (dist < cur_dist) {
+	        cur_dist = dist
+	        cur_label = labels[i]
+	    }
+	}
+
+	# Release memory.
+	call sfree (sp)
+
+	# Return the label index.
+	return (cur_label)
+end
+
+
+# WL_WRITE_LABEL - Write the label in the format specified by the WCS type.
+
+procedure wl_write_label (wd, value, side, x, y, angle, axis, precision,
+	do_full, offset)
+
+pointer wd                   # I:   the WCSLAB descriptor
+double  value                # I:   the value to use as the label
+int     side                 # I:   the side the label is going on
+real    x, y                 # I:   position of the label in NDC coordinates
+double  angle                # I:   the angle the text should be written at
+int     axis                 # I:   which axis is being labelled
+int     precision            # I:   level of precision for labels
+bool    do_full              # I:   true if the full label should be printed
+real    offset               # I/O: offset for titles in NDC units
+
+int	tside
+pointer	sp, label, label_format, units, units_format
+real	char_height, char_width, in_off_x, in_off_y, length
+real	lx, ly, new_offset, rx, ry, text_angle
+real	unit_off_x, unit_off_y, ux, uy
+
+bool	fp_equalr()
+double	wl_string_angle()
+int	wl_opposite_side(), strlen()
+real	ggetr(), gstatr()
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+	call salloc (label_format, SZ_LINE, TY_CHAR)
+	call salloc (units_format, SZ_LINE, TY_CHAR)
+
+	# Get character size.  This info is used to move the character string
+	# by the appropriate amounts.
+
+	char_height = ggetr (WL_GP(wd), "ch") * gstatr (WL_GP(wd), G_TXSIZE)
+	char_width = ggetr (WL_GP(wd), "cw") * gstatr (WL_GP(wd), G_TXSIZE)
+
+	# Determine the "corrected" angle to write text in.
+	text_angle = wl_string_angle (angle, WL_LABOUT(wd))
+
+	# Determine the units offset.
+	call wl_rotate (0., char_height / 2., 1, text_angle - 90., unit_off_x, 
+	    unit_off_y)
+
+	# If the labels are to appear inside the graph and the major grid lines
+	# have been drawn, then determine the necessary offset to get the label
+	# off the line.
+
+	if ((WL_LABOUT(wd) == NO) && (WL_MAJ_GRIDON(wd) == YES))
+	    call wl_rotate (0., 0.75 * char_height, 1, text_angle - 90.,
+	        in_off_x, in_off_y)
+	else {
+	    in_off_x = 0.
+	    in_off_y = 0.
+	}
+
+	# Decode the coordinate into a text string.
+	switch (WL_SYSTEM_TYPE(wd)) {
+	case RA_DEC:
+	    if  (axis == LONGITUDE)
+	        call wl_hms (value, Memc[label], Memc[units], SZ_LINE,
+		    precision, do_full)
+	    else 
+	        call wl_dms (value, Memc[label], Memc[units], SZ_LINE,
+		    precision, do_full)
+	default:
+	    call sprintf (Memc[label], SZ_LINE, "%.2g")
+	    call pargd (value)
+	}
+
+	# Set the text justification.
+	call sprintf (Memc[label_format], SZ_LINE, "h=c;v=c;u=%f")
+	    call pargr (text_angle)
+	call sprintf (Memc[units_format], SZ_LINE, "h=c;v=c;u=%f")
+	    call pargr (text_angle)
+
+	# Determine offset needed to rotate text about the point of placement.
+	# NOTE: The STDGRAPH kernel messes up rotate text placement.  Try to
+	# accomodate with extra offset.
+
+	length = .5 * char_width *  (2 + strlen (Memc[label]))
+	call wl_rotate (length, 0., 1, text_angle - 90., rx, ry)
+	rx = abs (rx)
+	ry = abs (ry)
+
+	# If labels are to appear inside the graph, then justification should
+	# appear as if it were done for the opposite side.
+	if (WL_LABOUT(wd) == YES)
+	    tside = side
+	else
+	    tside = wl_opposite_side (side)
+
+	# Now add the offsets appropriately.
+	switch (tside) {
+	case TOP:
+	    ly = y + ry + in_off_y + unit_off_y
+	    if (fp_equalr (text_angle, 90.)) {
+	        lx = x
+	        ly = ly + unit_off_y
+	    } else if (text_angle < 90.)
+	        lx = x - rx
+	    else
+	        lx = x + rx
+	    lx = lx + in_off_x
+	    new_offset = ry + ry
+
+	case BOTTOM:
+	    ly = y - ry - in_off_y - unit_off_y
+	    if (fp_equalr (text_angle, 90.)) {
+	        lx = x
+	        ly = ly - unit_off_y
+	    } else if (text_angle < 90.)
+	        lx = x + rx
+	    else
+	        lx = x - rx
+	    lx = lx - in_off_x
+	    new_offset = ry + ry
+
+	case LEFT:
+	    lx = x - rx - abs (unit_off_x)
+	    if (text_angle < 90.) {
+	        ly = y + ry - in_off_y
+	        lx = lx - in_off_x
+	    } else {
+	        ly = y - ry + in_off_y
+	        lx = lx + in_off_x
+	    }
+	    new_offset = rx + rx + abs (unit_off_x)
+
+	case RIGHT:
+	    lx = x + rx + abs (unit_off_x)
+	    if (text_angle < 90.) {
+	        ly = y - ry + in_off_y
+	        lx = lx + in_off_x
+	    } else {
+	        ly = y + ry - in_off_y
+	        lx = lx - in_off_x
+	    }
+	    new_offset = rx + rx + abs (unit_off_x)
+	}
+
+	lx = lx - (unit_off_x / 2.)
+	ly = ly - (unit_off_y / 2.)
+	ux = lx + unit_off_x
+	uy = ly + unit_off_y
+	  
+	# Print the label.
+	call gtext (WL_GP(wd), lx, ly, Memc[label], Memc[label_format])
+
+	# Print the units (if appropriate).
+	if (WL_SYSTEM_TYPE(wd) == RA_DEC)
+	    call gtext (WL_GP(wd), ux, uy, Memc[units], Memc[units_format])
+
+	# Determine new maximum string size.
+	if  ((WL_LABOUT(wd) == YES) &&  (abs (offset) < new_offset))
+	    if (side == LEFT || side == BOTTOM)
+	        offset = -new_offset
+	    else
+	        offset = new_offset
+
+	# Release memory.
+	call sfree (sp)
+end
+
+
+# WL_STRING_ANGLE -- Produce the angle that a label string should be written to.
+#
+# Description
+#   Fixes the input angle so that the output angle is in the range 0 to 180.
+#
+# Returns
+#   the angle that the label should be written as.
+
+double procedure wl_string_angle (angle, right_to_up)
+
+double	angle            # I: the input angle in degrees
+int	right_to_up      # I: true if angle near horizontal/vertical are fixed
+
+double	output_angle
+
+begin
+	# Try to ensure that the angle is "upright", i.e. the string will not
+	# be printed upside-down.
+
+	output_angle = angle
+	if (output_angle > QUARTER_CIRCLE)
+	    output_angle = output_angle - HALF_CIRCLE
+	if (output_angle < -QUARTER_CIRCLE)
+	    output_angle = output_angle + HALF_CIRCLE
+
+	# If the angle is close to parallel with one of the axis, then just
+	# print it normally.
+
+	if ((right_to_up == YES) && ((mod (abs (output_angle),
+	    QUARTER_CIRCLE) < MIN_ANGLE) || (QUARTER_CIRCLE -
+	    mod (abs (output_angle), QUARTER_CIRCLE) < MIN_ANGLE)))
+	    output_angle = 0.
+
+	# Return the angle modified for the idiocincracy of GIO text angle
+	# specification.
+
+	return (output_angle + QUARTER_CIRCLE)
+end
+
+
+# WL_ANGLE -- Return the average angle of the labels in the list.
+#
+# Returns
+#  Average angle
+#
+# Description
+#  So that labels on a side are uniform (in some sense), the average angle
+#  of all the labels is taken and is defined as the angle that all the labels
+#  will be printed at.
+
+double procedure wl_angle (wd, labels, nlabels)
+
+pointer wd                   # I: the WCSLAB descriptor
+int     labels[nlabels]      # I: the indexes of the labels to be printed out
+int     nlabels              # I: the number of indexes in the list
+
+double	total, average
+int	i
+
+begin
+	total = 0.0
+	for (i = 1; i <= nlabels; i = i + 1)
+	    total = total + WL_LABEL_ANGLE(wd,labels[i])
+	average = real (total / nlabels)
+
+	return (average)
+end
diff --git a/pkg/utilities/nttools/stxtools/wcslab/wllabel.x.ori b/pkg/utilities/nttools/stxtools/wcslab/wllabel.x.ori
new file mode 100644
index 00000000..33e86878
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/wllabel.x.ori
@@ -0,0 +1,1077 @@
+include <gset.h>
+include <math.h>
+include "wcslab.h"
+include "wcs_desc.h"
+
+
+# Define the offset array.
+define OFFSET Memr[$1+$2-1]
+
+# WL_LABEL  -- Place the labels on the grids.
+#
+# Description
+#  Format and write the labels for the grid/tick marks.  Much of this
+#  is wading through conditions to decide whether a label should be
+#  written or not.
+
+procedure wl_label (wd)
+
+pointer wd                  # I: the WCSLAB descriptor
+
+bool	no_side_axis1, no_side_axis2
+int	i, axis1_side, axis2_side
+pointer	sp, offset_ptr
+real	offset
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (offset_ptr, N_SIDES, TY_REAL)
+	do i = 1, N_SIDES
+	    OFFSET(offset_ptr,i) = 0.
+
+	# Decide whether any sides were specified for either axis.
+	no_side_axis1 = true
+	no_side_axis2 = true
+	do i = 1, N_SIDES {
+	    if (WL_LABEL_SIDE(wd,i,AXIS1))
+	        no_side_axis1 = false
+	    if (WL_LABEL_SIDE(wd,i,AXIS2))
+	        no_side_axis2 = false
+	}
+
+	# If polar, then label the axis 2's next to their circles on the
+	# graph and allow the Axis 1s to be labeled on all sides of the graph.
+
+	if  (WL_GRAPH_TYPE(wd) == POLAR) {
+
+	    call wl_polar_label (wd)
+
+	    if (no_side_axis1) {
+	        do i = 1, N_SIDES {
+	          WL_LABEL_SIDE(wd,i,AXIS1) = true
+	        }
+	        if (IS_INDEFI (WL_AXIS_TITLE_SIDE(WD,AXIS1)))
+	    	    WL_AXIS_TITLE_SIDE(WD,AXIS1) = BOTTOM
+	    }
+
+	# If we are near-polar, label the Axis 2 as if polar, and label
+	# Axis1 on all sides except the side closest to the pole.
+
+	} else if  (WL_GRAPH_TYPE(wd) == NEAR_POLAR) {
+
+	    if (no_side_axis1) {
+	        WL_LABEL_SIDE(wd,WL_BAD_LABEL_SIDE(wd),AXIS1) = true
+	        if (IS_INDEFI (WL_AXIS_TITLE_SIDE(wd,AXIS1)))
+	    	    WL_AXIS_TITLE_SIDE(wd,AXIS1) = WL_BAD_LABEL_SIDE(wd)
+	    }
+
+	    if (no_side_axis2) {
+	        WL_LABEL_SIDE(wd,WL_POLAR_LABEL_DIRECTION(wd),AXIS2) = true
+	        if (IS_INDEFI (WL_AXIS_TITLE_SIDE(wd,AXIS2)))
+	        WL_AXIS_TITLE_SIDE(wd,AXIS2) = WL_POLAR_LABEL_DIRECTION(wd)
+	    }
+
+	# Final case- adjacent sides should be labelled.
+
+	} else {
+
+	    # Determine the best sides for labelling.
+	    if  (INVERT (WL_ROTA(wd))) {
+	        axis1_side = LEFT
+	        axis2_side = BOTTOM
+	    } else {
+	        axis1_side = BOTTOM
+	        axis2_side = LEFT
+	    }
+
+	    # If no sides were specified, use the calculated ones above.
+	    if (no_side_axis1)
+	        WL_LABEL_SIDE(wd,axis1_side,AXIS1) = true
+	    if (no_side_axis2)
+	        WL_LABEL_SIDE(wd,axis2_side,AXIS2) = true
+	}
+
+	# Now draw the labels for axis 1.
+	do i = 1, N_SIDES {
+
+	    if (WL_LABEL_SIDE(wd,i,AXIS1)) {
+	        call wl_lab_edges (wd, AXIS1, i, offset)
+	        if (IS_INDEFI (WL_AXIS_TITLE_SIDE(WD,AXIS1)))
+	  	    WL_AXIS_TITLE_SIDE(WD,AXIS1) = i
+	    } else
+	        offset = 0.
+
+	  # Modify the bounding box for the new viewport.
+	  if (abs (offset) > abs (OFFSET(offset_ptr,i)))
+	    OFFSET(offset_ptr,i) = offset
+	}
+
+	# Draw the labels for axis 2.
+	if (WL_GRAPH_TYPE(wd) != POLAR) 
+	    do i = 1, N_SIDES {
+
+	        if (WL_LABEL_SIDE(wd,i,AXIS2)) {
+	      	    call wl_lab_edges (wd, AXIS2, i, offset)
+	      	    if (IS_INDEFI (WL_AXIS_TITLE_SIDE(wd,AXIS2)))
+	            WL_AXIS_TITLE_SIDE(wd,AXIS2) = i
+	        } else
+	    	    offset = 0.
+
+	        # Modify the bounding box for the new viewport.
+	        if (abs (offset) > abs (OFFSET(offset_ptr,i)))
+	    	    OFFSET(offset_ptr,i) = offset
+	    }
+
+	# Set the bounding box.
+	do i = 1, N_SIDES
+	    WL_NEW_VIEW(wd,i) = WL_NEW_VIEW(wd,i) + OFFSET(offset_ptr,i)
+
+	# Now write the graph title.
+	call wl_title (WL_GP(wd), WL_AXIS_TITLE(wd,AXIS1), 
+	    WL_AXIS_TITLE_SIDE(wd,AXIS1), WL_AXIS_TITLE_SIZE(wd),
+	    WL_NEW_VIEW(wd,1))
+	if (WL_GRAPH_TYPE(wd) != POLAR)
+	    call wl_title (WL_GP(wd), WL_AXIS_TITLE(wd,AXIS2), 
+	        WL_AXIS_TITLE_SIDE(wd,AXIS2), WL_AXIS_TITLE_SIZE(WD),
+		WL_NEW_VIEW(wd,1))
+	if (! IS_INDEFI (WL_TITLE_SIDE(wd)))
+	    call wl_title (WL_GP(wd), WL_TITLE(wd), WL_TITLE_SIDE(wd),
+	        WL_TITLE_SIZE(wd), WL_NEW_VIEW(wd,1))
+
+	# Release memory.
+	call sfree (sp)
+end
+
+
+# Define what is in the screen.
+
+define IN (($1>WL_SCREEN_BOUNDARY(wd,LEFT))&&($1<WL_SCREEN_BOUNDARY(wd,RIGHT))&&($2>WL_SCREEN_BOUNDARY(wd,BOTTOM))&&($2<WL_SCREEN_BOUNDARY(wd,TOP)))
+
+# WL_POLAR_LABEL -- Place Latitude labels next to Latitude circles.
+#
+# Description
+#  Since Lines of constant Latitude on a polar graph are usually circles
+#  around the pole, the lines may never cross edges.  Instead, the labels
+#  are placed next to circles.  The grid-drawing routines should setup
+#  the label position array such that each line has only one label point.
+
+procedure wl_polar_label (wd)
+
+pointer wd            # I: the WCSLAB descriptor
+
+int	i, prec
+pointer sp, label, units, label_format, units_format
+real	char_height, char_width, ndc_textx, ndc_texty, old_text_size
+real	textx, texty
+int	wl_precision()
+real	gstatr(), ggetr()
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+	call salloc (label_format, SZ_LINE, TY_CHAR)
+	call salloc (units_format, SZ_LINE, TY_CHAR)
+
+	# Get the character height and width.  This is used to ensure that we
+	# have moved the label strings off the border.
+
+	char_height = ggetr (WL_GP(wd), "ch") * gstatr (WL_GP(wd), G_TXSIZE) /
+	    2.
+	char_width = ggetr (WL_GP(wd), "cw") * gstatr (WL_GP(wd), G_TXSIZE) /
+	    2.
+
+	# Get the text size and cut it in half for on the plot labelling.
+	old_text_size = gstatr (WL_GP(wd), G_TXSIZE)
+	call gsetr (WL_GP(wd), G_TXSIZE, old_text_size)
+	call gsetr (WL_GP(wd), G_TXSIZE, old_text_size * 0.80)
+
+	# Determine the precision of the output.
+	prec = wl_precision (wd, AXIS2)
+
+	# Place the labels.
+	for  (i = 1; i <= WL_N_LABELS(wd); i = i + 1)
+	    if  (WL_LABEL_AXIS(wd,i) == AXIS2) {
+
+	        # Decode the coordinate into a text string.
+	        call wl_dms (WL_LABEL_VALUE(wd,i), Memc[label], Memc[units],
+	            SZ_LINE, prec, true)
+
+	        # Convert text position from "unknown" coordinates to NDC.
+	        call gctran (WL_GP(wd), real (WL_LABEL_POSITION(wd,i,AXIS1)), 
+	            real (WL_LABEL_POSITION(wd,i,AXIS2)), ndc_textx, ndc_texty,
+		    WL_PLOT_WCS(wd), WL_NDC_WCS(wd))
+
+	        # Determine the text justification.
+	        switch  (WL_POLAR_LABEL_DIRECTION(wd)) {
+	        case BOTTOM: 
+	            call strcpy ("h=c;v=t", Memc[label_format], SZ_LINE)
+	            call strcpy ("h=c;v=c", Memc[units_format], SZ_LINE)
+	            ndc_texty = ndc_texty - char_height
+	        case TOP: 
+	            call strcpy ("h=c;v=c", Memc[label_format], SZ_LINE)
+	            call strcpy ("h=c;v=b", Memc[units_format], SZ_LINE)
+	            ndc_texty = ndc_texty + char_height
+	        case LEFT: 
+	            call strcpy ("h=r;v=c", Memc[label_format], SZ_LINE)
+	            call strcpy ("h=r;v=b", Memc[units_format], SZ_LINE)
+	            ndc_textx = ndc_textx - char_width
+	        case RIGHT: 
+	            call strcpy ("h=l;v=c", Memc[label_format], SZ_LINE)
+	            call strcpy ("h=l;v=b", Memc[units_format], SZ_LINE)
+	            ndc_textx = ndc_textx + char_width
+	        }
+
+	        # Convert the text position from NDC back to the "unknown"
+		# system.
+	        call gctran (WL_GP(wd), ndc_textx, ndc_texty, textx, texty, 
+	            WL_NDC_WCS(wd), WL_PLOT_WCS(wd))
+	  
+	        # Print the label.
+	        if (IN (textx, texty)) {
+	    	    call gtext (WL_GP(wd), textx, texty, Memc[label], 
+	                Memc[label_format])
+	    	    call gtext (WL_GP(wd), textx, texty, Memc[units], 
+	                Memc[units_format])
+	        }
+
+	    }
+
+	# Set the text size back.
+	call gsetr (WL_GP(wd), G_TXSIZE, old_text_size)
+
+	# Release memory.
+	call sfree (sp)
+
+end
+
+
+# Memory management for labels
+
+define LABEL_LIST Memi[labels+$1-1]
+
+# WL_LAB_EDGES  -- Place labels along the edges of the window.
+#
+# Description
+#  Place labels on the specified side of the graph.
+
+procedure wl_lab_edges (wd, axis, side, offset)
+
+pointer wd      	# I: the WCSLAB descriptor
+int     axis    	# I: the type of axis being labeled
+int     side    	# I: the side to place the labels
+real    offset  	# O: offset in NDC units for titles
+
+bool	do_full
+double	angle, tangle
+int	i, full_label, nlabels, old_wcs, prec
+pointer sp, labels 
+real	ndc_textx, ndc_texty, old_text_size, textx, texty
+
+int	wl_full_label_position(), wl_find_side()
+double	wl_string_angle(), wl_angle()
+int	gstati(), wl_precision()
+real	gstatr()
+
+begin
+	call smark (sp)
+
+	# All label placement is done in NDC coordinates.
+	old_wcs = gstati (WL_GP(wd), G_WCS)
+	call gseti (WL_GP(wd), G_WCS, WL_NDC_WCS(wd))
+
+	# Set text labelling size.
+	old_text_size = gstatr (WL_GP(wd), G_TXSIZE)
+	call gsetr (WL_GP(wd), G_TXSIZE, WL_LABEL_SIZE(wd))
+
+	# Get the precision of the axis interval.
+	prec = wl_precision (wd, axis)
+
+	# Initialize string size.
+	offset = 0.
+
+	# Build a list of possible labels for this side. The conditions are
+	# that the label should be for the current axis and that it lies on
+	# the current side.
+
+	call salloc (labels, WL_N_LABELS(wd), TY_INT)
+	nlabels = 0
+	for (i = 1; i <= WL_N_LABELS(wd); i = i + 1)
+	    if  (WL_LABEL_AXIS(wd,i) == axis && 
+	        wl_find_side (WL_LABEL_POSITION(wd,i,AXIS1),
+	        WL_LABEL_POSITION(wd,i,AXIS2), 
+	        WL_SCREEN_BOUNDARY(wd,1)) == side) {
+	        nlabels = nlabels + 1
+	        LABEL_LIST(nlabels) = i
+	    }  
+	
+	# If no labels found, then just forget it.  If labels found, well
+	# write them out.
+
+	if (nlabels != 0) {
+
+	    # Determine which label should be written out in full.
+	    full_label = wl_full_label_position (wd, Memi[labels], nlabels,
+	        axis, side, prec)
+
+	    # Determine the angle that all the labels will be written at.
+	    if ((WL_LABOUT(wd) == NO) && (WL_GRAPH_TYPE(wd) != NORMAL) &&
+	        (WL_LABEL_ROTATE(wd) == YES))
+		angle = INDEFR
+	    else if ((WL_GRAPH_TYPE(wd) == NORMAL) && ((WL_LABEL_ROTATE(wd) ==
+		YES) || ((WL_LABOUT(wd) == NO) && (WL_MAJ_GRIDON(wd) == YES))))
+	        angle = wl_angle (wd, Memi[labels], nlabels)
+	    else
+		angle = 0.0
+
+	    # Place the labels.
+	    for  (i = 1; i <= nlabels; i = i + 1) {
+	
+	        # Save some pertinent information.
+	        textx = real (WL_LABEL_POSITION(wd,LABEL_LIST(i),AXIS1))
+	        texty = real (WL_LABEL_POSITION(wd,LABEL_LIST(i),AXIS2))
+	        do_full =  ((LABEL_LIST(i) == full_label) ||
+	    	    (WL_ALWAYS_FULL_LABEL(wd) == YES))
+	
+	        # Transform the "unknown" coordinate system to a known
+		# coordinate system, NDC, for text placement.
+	        call gctran (WL_GP(wd), textx, texty, ndc_textx, ndc_texty, 
+	            old_wcs, WL_NDC_WCS(wd))
+
+		# If angle is undefined, determine the angle for each label.
+		if (IS_INDEFR(angle))
+		    tangle = wl_string_angle (WL_LABEL_ANGLE(wd,
+		        LABEL_LIST(i)), WL_LABOUT(wd))
+		else
+		    tangle = angle
+	
+	        # Format and write the label.
+	        call wl_write_label (wd, WL_LABEL_VALUE(wd,LABEL_LIST(i)), 
+	            side, ndc_textx, ndc_texty, tangle, axis, prec, do_full,
+		    offset)
+	    }
+	}
+	
+	# Reset the graphics WCS.
+	call gsetr (WL_GP(wd), G_TXSIZE, old_text_size)
+	call gseti (WL_GP(wd), G_WCS, old_wcs)
+
+	call sfree (sp)
+end
+
+
+# WL_TITLE - Write the title of the graph.
+
+procedure wl_title (gp, title, side, size, viewport)
+
+pointer gp                 # I: the graphics descriptor
+char    title[ARB]         # I: the title to write
+int     side               # I: which side the title will go
+real    size               # I: the character size to write the title
+real    viewport[N_SIDES]  # I: the viewport in NDC to keep the title out of
+
+int	old_wcs
+real	char_height, char_width, left, right, top, bottom, old_rotation
+real	old_text_size, x, y
+int	gstati(), strlen()
+real	ggetr(), gstatr()
+
+begin
+	# Make sure there is a title to write.  If not, then punt.
+	if (strlen (title) <= 0)
+	  return
+
+	# Get/Set pertinent graphics info.
+	call ggview (gp, left, right, bottom, top)
+
+	old_text_size = gstatr (gp, G_TXSIZE)
+	call gsetr (gp, G_TXSIZE, size)
+	old_rotation = gstatr (gp, G_TXUP)
+
+	char_height = ggetr (gp, "ch") * size
+	char_width = ggetr (gp, "cw") * size
+
+	old_wcs = gstati (gp, G_WCS)
+	call gseti (gp, G_WCS, NDC_WCS)
+
+	# Depending on side, set text position and rotation.
+	switch (side) {
+	case TOP:
+	    call gsetr (gp, G_TXUP, 90.)
+	    x =  (right + left) / 2.
+	    y = viewport[TOP] +  (2 * char_height)
+	    viewport[TOP] = y +  (char_height / 2.)
+	case BOTTOM:
+	    call gsetr (gp, G_TXUP, 90.)
+	    x =  (right + left) / 2.
+	    y = viewport[BOTTOM] -  (2 * char_height)
+	    viewport[BOTTOM] = y -  (char_height / 2.)
+	case RIGHT:
+	    call gsetr (gp, G_TXUP, 180.)
+	    x = viewport[RIGHT] +  (2 * char_width)
+	    y =  (top + bottom) / 2.
+	    viewport[RIGHT] = x +  (char_width / 2.)
+	case LEFT:
+	    call gsetr (gp, G_TXUP, 180.)
+	    x = viewport[LEFT] -  (2 * char_width)
+	    y =  (top + bottom) / 2.
+	    viewport[LEFT] = x -  (char_width / 2.)
+	}
+
+	# Write the puppy out.
+	call gtext (gp, x, y, title, "h=c;v=c")
+
+	# Set the graphics state back.
+	call gseti (gp, G_WCS, old_wcs)
+	call gsetr (gp, G_TXSIZE, old_text_size)
+	call gsetr (gp, G_TXUP, old_rotation)
+end
+
+
+# WL_PRECISION -- Determine the precision of the interval.
+
+int procedure wl_precision (wd, axis)
+
+pointer wd    	  # I: the WCSLAB descriptor
+int     axis      # I: which axis is being examined ?
+
+int	prec 
+
+begin
+	# Handle the sky coordinates.
+	if (WL_SYSTEM_TYPE(wd) == RA_DEC)
+
+	    if (axis == AXIS1) {
+	        if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (3600.0D0))
+	    	    prec = HOUR
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (60.0D0))
+	    	    prec = MINUTE
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (1.0D0))
+	    	    prec = SECOND
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (.01D0))
+	    	    prec = SUBSEC_LOW
+	        else
+	    	    prec = SUBSEC_HIGH
+	    } else {
+	        if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (3600.0D0))
+	    	    prec = DEGREE
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (60.0D0))
+	    	    prec = MINUTE
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (1.0D0))
+	    	    prec = SECOND
+	        else if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (.01D0))
+	    	    prec = SUBSEC_LOW
+	        else
+	    	    prec = SUBSEC_HIGH
+	    }
+
+	# Handle other coordinate types.
+	else
+	    prec = INDEFI
+
+	return (prec)
+
+end
+
+
+# Define some value constraints.
+
+define LOW_ACCURACY .01
+define HIGH_ACCURACY .0001
+
+# WL_HMS -- Convert value to number in hours, minutes, and seconds.
+
+procedure wl_hms (rarad, hms, units, maxch, precision, all)
+
+double  rarad            # I: the value to format into a string (degrees)
+char    hms[ARB]         # O: string containing formatted value
+char    units[ARB]       # O: string containing formatted units
+int     maxch            # I: the maximum number of characters allowed
+int     precision        # I: how precise the output should be
+bool    all              # I: true if all relevent fields should be formatted
+
+double  accuracy, fraction
+int	sec, h, m, s
+pointer sp, temp_hms, temp_units 
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (temp_hms, maxch, TY_CHAR)
+	call salloc (temp_units, maxch, TY_CHAR)
+
+	units[1] = EOS
+	hms[1]   = EOS
+
+	# Define how close to zero is needed.
+	accuracy = LOW_ACCURACY
+	if (precision == SUBSEC_HIGH)
+	    accuracy = HIGH_ACCURACY
+
+	# Seconds of time.
+	fraction = double (abs(DEGTOST (rarad)))
+	if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) {
+	    sec = int (fraction)
+	    fraction = fraction - double (sec)
+	} else {
+	    sec = int (fraction + 0.5)
+	    fraction = 0.
+	}
+
+	# Range:  0 to 24 hours.
+	if (sec < 0)
+	    sec = sec + STPERDAY
+	else if (sec >= STPERDAY)
+	    sec = mod (sec, STPERDAY)
+
+	# Separater fields.
+	s = mod (sec, 60)
+	m = mod (sec / 60, 60)
+	h = sec / 3600
+
+	# Format fields.
+
+	# Subseconds.
+	if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) {
+	    fraction = s + fraction
+	    if (precision == SUBSEC_LOW) {
+	        call sprintf (hms, 6, "%05.2f")
+	    	    call pargd (fraction)
+	        call strcpy ("  s  ", units, maxch)
+	    } else {
+	        call sprintf (hms, 8, "%07.4f")
+	    	    call pargd (fraction)
+	        call strcpy ("  s    ", units, maxch)
+	    }
+	    if (!all)
+	        all =  (fraction < accuracy)
+
+	# Seconds
+	} else if (precision == SECOND) {
+
+	    # NOTE: The all is not part of the if statement because if
+	    # SUBSEC's have been printed, then seconds have already been
+	    # dealt with.  If SUBSEC's have not been dealt with, then this
+	    # is the first field to be checked anyways.
+
+	    call sprintf (hms, 3, "%02d ")
+	        call pargi (s)
+	    call strcpy ("  s", units, maxch)
+	    if (! all) 
+		all =  (s == 0)
+	}
+
+	# Minutes.
+	if (precision == MINUTE ||  (precision > MINUTE && all)) {
+	    if (all) {
+	        call strcpy (hms, Memc[temp_hms], maxch)
+	        call strcpy (units, Memc[temp_units], maxch)
+	    }
+	    call sprintf (hms, 3, "%02d ")
+		call pargi (m)
+	    call strcpy ("  m", units, maxch)
+	    if (all) {
+	        call strcat (Memc[temp_hms], hms, maxch)
+	        call strcat (Memc[temp_units], units, maxch)
+	    } else
+	        all =  (m == 0)
+	}
+
+	# Non-zero hours.
+	if  (precision == HOUR || all) {
+	    if (all) {
+	        call strcpy (hms, Memc[temp_hms], maxch)
+	        call strcpy (units, Memc[temp_units], maxch)
+	    }
+	    call sprintf (hms, 3, "%2.2d ")
+		call pargi (h)
+	    call strcpy("  h", units, maxch)
+	    if (all) {
+		call strcat (Memc[temp_hms], hms, maxch)
+	        call strcat (Memc[temp_units], units, maxch)
+	    }
+	}
+
+	# Release memory
+	call sfree (sp)
+end
+
+
+# WL_DMS - Convert value to number in degrees, minutes, and seconds.
+
+procedure wl_dms (arcrad, dms, units, maxch, precision, all)
+
+double  arcrad           # I: the value to format into a string (degrees)
+char    dms[ARB]         # O: string containing formatted value
+char    units[ARB]       # O: string containing formatted units
+int     maxch            # I: the maximum number of characters allowed
+int     precision        # I: how precise the output should be ?
+bool    all              # I: true if all relavent fields should be formatted
+
+double  accuracy, fraction 
+int	sec, h, m, s
+pointer sp, temp_dms, temp_units
+int	strlen()
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (temp_dms, maxch, TY_CHAR)
+	call salloc (temp_units, maxch, TY_CHAR)
+
+	units[1] = EOS
+	dms[1]   = EOS
+
+	# Define how close to zero is needed.
+	accuracy = LOW_ACCURACY
+	if (precision == SUBSEC_HIGH)
+	    accuracy = HIGH_ACCURACY
+
+	# Seconds of time.
+	fraction = double (abs (DEGTOSA (arcrad)))
+	if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) {
+	    sec = int (fraction)
+	    fraction = fraction - double (sec)
+	} else {
+	    sec = nint  (fraction)
+	    fraction = 0.
+	}
+
+	# Separater fields.
+	s = mod (abs(sec), 60)
+	m = mod (abs(sec) / 60, 60)
+	h = abs(sec) / 3600
+
+	# Format fields
+	#
+	# Subseconds.
+	if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) {
+
+	    fraction = s + fraction
+	    call strcpy (dms, Memc[temp_dms], maxch)
+	    call strcpy (units, Memc[temp_units], maxch)
+	    if (precision == SUBSEC_LOW) {
+	        call sprintf (dms, 6, "%05.2f\"")
+	    	    call pargd (fraction)
+	        call strcpy ("      ", units, maxch)
+	    } else {
+	        call sprintf (dms, 8, "%07.4f\"")
+	            call pargd (fraction)
+	        call strcpy ("        ", units, maxch)
+	    }
+	    if (! all)
+	        all =  (fraction < accuracy)
+	    call strcat (Memc[temp_dms], dms, maxch)
+	    call strcat (Memc[temp_units], units, maxch)
+
+	# Seconds
+	} else if (precision == SECOND) {
+
+	    # NOTE: The all is not part of the if statement because if
+	    # SUBSEC's have been printed, then seconds have already been
+	    # dealt with.  If SUBSEC's have not been dealt with, then this
+	    # is the first field to be checked anyways.
+
+	    call strcpy (dms, Memc[temp_dms], maxch)
+	    call strcpy (units, Memc[temp_units], maxch)
+	    call sprintf (dms, 3, "%02d\"")
+		call pargi (s)
+	    call strcpy ("   ", units, maxch)
+	    if (! all) 
+	    	all =  (s == 0)
+	    call strcat (Memc[temp_dms], dms, maxch)
+	    call strcat (Memc[temp_units], units, maxch)
+	}
+
+	# Minutes.
+	if (precision == MINUTE ||  (precision > MINUTE && all)) {
+	    call strcpy (dms, Memc[temp_dms], maxch)
+	    call strcpy (units, Memc[temp_units], maxch)
+	    call sprintf (dms, 3, "%02d'")
+		call pargi (m)
+	    call strcpy ("   ", units, maxch)
+	    call strcat (Memc[temp_dms], dms, maxch)
+	    call strcat (Memc[temp_units], units, maxch)
+	    if (! all)
+	        all =  (m == 0)
+	}
+
+	# Hours.
+	if (precision == DEGREE || all) {
+	    call strcpy (dms, Memc[temp_dms], maxch)
+	    call strcpy (units, Memc[temp_units], maxch)
+	    if (sec + fraction < accuracy)
+	        call strcpy (" 0 ", dms, maxch)
+	    else if (arcrad < 0.) {
+	        call sprintf (dms, 4, "-%d ")
+	    	    call pargi (h)
+	    } else {
+	        call sprintf (dms, 4, "+%d ")
+	    	    call pargi (h)
+	    }
+	    call sprintf(units, 4, "%*wo")
+		call pargi (strlen (dms) - 1)
+	    call strcat (Memc[temp_dms], dms, maxch)
+	    call strcat (Memc[temp_units], units, maxch)
+	}
+
+	# Release memory.
+	call sfree (sp)
+end
+
+
+# WL_FULL_LABEL_POSTION -- Find the position where the full label should be.
+#
+# Description
+#   This routine returns the index to the label that should be printed
+#   in its full form, regardless of its value.  This is so there is always
+#   at least one labelled point with the full information.  This point is
+#   choosen by examining which label is the closest to the passed point
+#   (usually one of the four corners of the display).
+#
+# Returns
+#   Index into the labell arrays of the label to be fully printed.
+#   If the return index is 0, then there are no labels for the given
+#   side.
+
+int procedure wl_full_label_position (wd, labels, nlabels, axis, side,
+	precision)
+
+pointer wd                   # I: the WCSLAB descriptor
+int     labels[nlabels]      # I: array of indexes of labels to be printed
+int     nlabels              # I: the number of labels in labels
+int     axis                 # I: the axis being dealt with
+int     side                 # I: the side being dealt with
+int	precision	     # I: precision of the label
+
+bool	all
+double	cur_dist, dist
+int	i, cur_label, xside, yside
+pointer	sp, temp1
+double	wl_distanced()
+
+begin
+	# Allocate some working space.
+	call smark (sp)
+	call salloc (temp1, SZ_LINE, TY_CHAR)
+
+	# Initialize.
+	xside = INDEFI
+	yside = INDEFI
+
+	# Determine which corner will have the full label.
+	if (side == TOP || side == BOTTOM) {
+	    yside = side
+	    if (axis == AXIS1) {
+	        if (WL_LABEL_SIDE(wd,RIGHT,AXIS2))
+	    	    xside = RIGHT
+	        if (WL_LABEL_SIDE(wd,LEFT,AXIS2))
+	    	    xside = LEFT
+	    } else {
+	        if (WL_LABEL_SIDE(wd,RIGHT,AXIS1))
+	    	    xside = RIGHT
+	        if (WL_LABEL_SIDE(wd,LEFT,AXIS1))
+	    	    xside = LEFT
+	    }
+	    if (IS_INDEFI (xside))
+	    	xside = LEFT
+	} else {
+	    xside = side
+	    if (axis == AXIS1) {
+	        if (WL_LABEL_SIDE(wd,TOP,AXIS2))
+	    	    yside = TOP
+	        if (WL_LABEL_SIDE(wd,BOTTOM,AXIS2))
+	    	    yside = BOTTOM
+	    } else {
+	        if (WL_LABEL_SIDE(wd,TOP,AXIS1))
+	    	    yside = TOP
+	        if (WL_LABEL_SIDE(wd,BOTTOM,AXIS1))
+	    	    yside = BOTTOM
+	    }
+	    if (IS_INDEFI (yside))
+	        yside = BOTTOM
+	}
+
+	# Find the full label.
+	cur_label = labels[1]
+	cur_dist = wl_distanced (WL_SCREEN_BOUNDARY(wd,xside), 
+	    WL_SCREEN_BOUNDARY(wd,yside),
+	    WL_LABEL_POSITION(wd,cur_label,AXIS1),
+	    WL_LABEL_POSITION(wd,cur_label,AXIS2))
+	
+	# Now go through the rest of the labels to find a closer label.
+	for (i = 2; i <= nlabels; i = i + 1) {
+
+	    # Check to see if the label would be written in full anyways.
+	    all = false
+	    if (WL_SYSTEM_TYPE(wd) == RA_DEC) {
+		if (WL_LABEL_AXIS(wd, labels[i]) == LONGITUDE)
+		    call wl_hms (WL_LABEL_VALUE(wd, labels[i]),
+		        Memc[temp1], Memc[temp1], SZ_LINE, precision, all)
+		else
+		    call wl_dms (WL_LABEL_VALUE(wd, labels[i]),
+		        Memc[temp1], Memc[temp1], SZ_LINE, precision, all)
+	    }
+
+	    # If so, don't figure out which label should be full, there
+	    # will be one someplace.
+	    if (all) {
+		cur_label = INDEFI
+		break
+	    }
+
+	    dist = wl_distanced (WL_SCREEN_BOUNDARY(wd,xside), 
+	        WL_SCREEN_BOUNDARY(wd,yside), 
+	        WL_LABEL_POSITION(wd,labels[i],AXIS1), 
+	        WL_LABEL_POSITION(wd,labels[i],AXIS2))
+	    if (dist < cur_dist) {
+	        cur_dist = dist
+	        cur_label = labels[i]
+	    }
+	}
+
+	# Release memory.
+	call sfree (sp)
+
+	# Return the label index.
+	return (cur_label)
+end
+
+
+# WL_WRITE_LABEL - Write the label in the format specified by the WCS type.
+
+procedure wl_write_label (wd, value, side, x, y, angle, axis, precision,
+	do_full, offset)
+
+pointer wd                   # I:   the WCSLAB descriptor
+double  value                # I:   the value to use as the label
+int     side                 # I:   the side the label is going on
+real    x, y                 # I:   position of the label in NDC coordinates
+double  angle                # I:   the angle the text should be written at
+int     axis                 # I:   which axis is being labelled
+int     precision            # I:   level of precision for labels
+bool    do_full              # I:   true if the full label should be printed
+real    offset               # I/O: offset for titles in NDC units
+
+int	tside
+pointer	sp, label, label_format, units, units_format
+real	char_height, char_width, in_off_x, in_off_y, length
+real	lx, ly, new_offset, rx, ry, text_angle
+real	unit_off_x, unit_off_y, ux, uy
+
+bool	fp_equalr()
+double	wl_string_angle()
+int	wl_opposite_side(), strlen()
+real	ggetr(), gstatr()
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+	call salloc (label_format, SZ_LINE, TY_CHAR)
+	call salloc (units_format, SZ_LINE, TY_CHAR)
+
+	# Get character size.  This info is used to move the character string
+	# by the appropriate amounts.
+
+	char_height = ggetr (WL_GP(wd), "ch") * gstatr (WL_GP(wd), G_TXSIZE)
+	char_width = ggetr (WL_GP(wd), "cw") * gstatr (WL_GP(wd), G_TXSIZE)
+
+	# Determine the "corrected" angle to write text in.
+	text_angle = wl_string_angle (angle, WL_LABOUT(wd))
+
+	# Determine the units offset.
+	call wl_rotate (0., char_height / 2., 1, text_angle - 90., unit_off_x, 
+	    unit_off_y)
+
+	# If the labels are to appear inside the graph and the major grid lines
+	# have been drawn, then determine the necessary offset to get the label
+	# off the line.
+
+	if ((WL_LABOUT(wd) == NO) && (WL_MAJ_GRIDON(wd) == YES))
+	    call wl_rotate (0., 0.75 * char_height, 1, text_angle - 90.,
+	        in_off_x, in_off_y)
+	else {
+	    in_off_x = 0.
+	    in_off_y = 0.
+	}
+
+	# Decode the coordinate into a text string.
+	switch (WL_SYSTEM_TYPE(wd)) {
+	case RA_DEC:
+	    if  (axis == LONGITUDE)
+	        call wl_hms (value, Memc[label], Memc[units], SZ_LINE,
+		    precision, do_full)
+	    else 
+	        call wl_dms (value, Memc[label], Memc[units], SZ_LINE,
+		    precision, do_full)
+	default:
+	    call sprintf (Memc[label], SZ_LINE, "%.2g")
+	    call pargd (value)
+	}
+
+	# Set the text justification.
+	call sprintf (Memc[label_format], SZ_LINE, "h=c;v=c;u=%f")
+	    call pargr (text_angle)
+	call sprintf (Memc[units_format], SZ_LINE, "h=c;v=c;u=%f")
+	    call pargr (text_angle)
+
+	# Determine offset needed to rotate text about the point of placement.
+	# NOTE: The STDGRAPH kernel messes up rotate text placement.  Try to
+	# accomodate with extra offset.
+
+	length = .5 * char_width *  (2 + strlen (Memc[label]))
+	call wl_rotate (length, 0., 1, text_angle - 90., rx, ry)
+	rx = abs (rx)
+	ry = abs (ry)
+
+	# If labels are to appear inside the graph, then justification should
+	# appear as if it were done for the opposite side.
+	if (WL_LABOUT(wd) == YES)
+	    tside = side
+	else
+	    tside = wl_opposite_side (side)
+
+	# Now add the offsets appropriately.
+	switch (tside) {
+	case TOP:
+	    ly = y + ry + in_off_y + unit_off_y
+	    if (fp_equalr (text_angle, 90.)) {
+	        lx = x
+	        ly = ly + unit_off_y
+	    } else if (text_angle < 90.)
+	        lx = x - rx
+	    else
+	        lx = x + rx
+	    lx = lx + in_off_x
+	    new_offset = ry + ry
+
+	case BOTTOM:
+	    ly = y - ry - in_off_y - unit_off_y
+	    if (fp_equalr (text_angle, 90.)) {
+	        lx = x
+	        ly = ly - unit_off_y
+	    } else if (text_angle < 90.)
+	        lx = x + rx
+	    else
+	        lx = x - rx
+	    lx = lx - in_off_x
+	    new_offset = ry + ry
+
+	case LEFT:
+	    lx = x - rx - abs (unit_off_x)
+	    if (text_angle < 90.) {
+	        ly = y + ry - in_off_y
+	        lx = lx - in_off_x
+	    } else {
+	        ly = y - ry + in_off_y
+	        lx = lx + in_off_x
+	    }
+	    new_offset = rx + rx + abs (unit_off_x)
+
+	case RIGHT:
+	    lx = x + rx + abs (unit_off_x)
+	    if (text_angle < 90.) {
+	        ly = y - ry + in_off_y
+	        lx = lx + in_off_x
+	    } else {
+	        ly = y + ry - in_off_y
+	        lx = lx - in_off_x
+	    }
+	    new_offset = rx + rx + abs (unit_off_x)
+	}
+
+	lx = lx - (unit_off_x / 2.)
+	ly = ly - (unit_off_y / 2.)
+	ux = lx + unit_off_x
+	uy = ly + unit_off_y
+	  
+	# Print the label.
+	call gtext (WL_GP(wd), lx, ly, Memc[label], Memc[label_format])
+
+	# Print the units (if appropriate).
+	if (WL_SYSTEM_TYPE(wd) == RA_DEC)
+	    call gtext (WL_GP(wd), ux, uy, Memc[units], Memc[units_format])
+
+	# Determine new maximum string size.
+	if  ((WL_LABOUT(wd) == YES) &&  (abs (offset) < new_offset))
+	    if (side == LEFT || side == BOTTOM)
+	        offset = -new_offset
+	    else
+	        offset = new_offset
+
+	# Release memory.
+	call sfree (sp)
+end
+
+
+# WL_STRING_ANGLE -- Produce the angle that a label string should be written to.
+#
+# Description
+#   Fixes the input angle so that the output angle is in the range 0 to 180.
+#
+# Returns
+#   the angle that the label should be written as.
+
+double procedure wl_string_angle (angle, right_to_up)
+
+double	angle            # I: the input angle in degrees
+int	right_to_up      # I: true if angle near horizontal/vertical are fixed
+
+double	output_angle
+
+begin
+	# Try to ensure that the angle is "upright", i.e. the string will not
+	# be printed upside-down.
+
+	output_angle = angle
+	if (output_angle > QUARTER_CIRCLE)
+	    output_angle = output_angle - HALF_CIRCLE
+	if (output_angle < -QUARTER_CIRCLE)
+	    output_angle = output_angle + HALF_CIRCLE
+
+	# If the angle is close to parallel with one of the axis, then just
+	# print it normally.
+
+	if ((right_to_up == YES) && ((mod (abs (output_angle),
+	    QUARTER_CIRCLE) < MIN_ANGLE) || (QUARTER_CIRCLE -
+	    mod (abs (output_angle), QUARTER_CIRCLE) < MIN_ANGLE)))
+	    output_angle = 0.
+
+	# Return the angle modified for the idiocincracy of GIO text angle
+	# specification.
+
+	return (output_angle + QUARTER_CIRCLE)
+end
+
+
+# WL_ANGLE -- Return the average angle of the labels in the list.
+#
+# Returns
+#  Average angle
+#
+# Description
+#  So that labels on a side are uniform (in some sense), the average angle
+#  of all the labels is taken and is defined as the angle that all the labels
+#  will be printed at.
+
+double procedure wl_angle (wd, labels, nlabels)
+
+pointer wd                   # I: the WCSLAB descriptor
+int     labels[nlabels]      # I: the indexes of the labels to be printed out
+int     nlabels              # I: the number of indexes in the list
+
+double	total, average
+int	i
+
+begin
+	total = 0.0
+	for (i = 1; i <= nlabels; i = i + 1)
+	    total = total + WL_LABEL_ANGLE(wd,labels[i])
+	average = real (total / nlabels)
+
+	return (average)
+end
diff --git a/pkg/utilities/nttools/stxtools/wcslab/wlsetup.x b/pkg/utilities/nttools/stxtools/wcslab/wlsetup.x
new file mode 100644
index 00000000..c37e24ca
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/wlsetup.x
@@ -0,0 +1,1000 @@
+include <gset.h>
+include <mach.h>
+include <math.h>
+include <math/curfit.h>
+include "wcslab.h"
+include "wcs_desc.h"
+
+# WL_SETUP -- Determine all the basic characteristics of the plot.
+#
+# Description
+#  Determine basic characteristics of the plot at hand.  This involved
+#  "discovering" what part of the world system covers the screen, the
+#  orientation of the world to logical systems, what type of graph will
+#  be produced, etc.  Many of the parameters determined here can be 
+#  over-ridden by user-specified values.
+
+procedure wl_setup (wd)
+
+pointer wd                       # I: the WCSLAB descriptor
+
+bool	north
+double	array[N_EDGES,N_DIM], max_value[N_DIM], min_value[N_DIM]
+double	range[N_DIM], pole_position[N_DIM], view_edge[N_EDGES,N_DIM]
+double	wl_coord_rotation()
+pointer mw_sctran()
+string	logtran "logical"
+string	wrldtran "world"
+
+begin
+	# Calculate the transformations from the Logical (pixel space) system
+	# to the World (possibly anything) system and back.
+	WL_LWCT(wd) = mw_sctran (WL_MW(wd), logtran, wrldtran, AXIS)
+	WL_WLCT(wd) = mw_sctran (WL_MW(wd), wrldtran, logtran, AXIS)
+
+	# Indicate whether the center of the transformation is north.
+	if (WL_SYSTEM_TYPE(wd) == RA_DEC)
+	    north = (WL_WORLD_CENTER(wd,LATITUDE) > 0.0D0)
+
+	# Determine the poles position.
+	if (WL_SYSTEM_TYPE(wd) == RA_DEC)
+	    call wl_pole_position (WL_WLCT(wd), WL_AXIS_FLIP(wd), 
+	        WL_WORLD_CENTER(wd,LONGITUDE), north, WL_SYSTEM_TYPE(wd),
+		pole_position)
+
+	# Determine graph type based on the system type.
+	call wl_determine_graph_type (WL_SYSTEM_TYPE(wd), pole_position,
+	    WL_SCREEN_BOUNDARY(wd,1), WL_GRAPH_TYPE(wd))
+
+	# Now find the extent of the WCS the window views, by constructing
+	# x,y vectors containing evenly spaced points around the edges of
+	# the viewing window.
+
+	call wl_construct_edge_vectors (WL_SCREEN_BOUNDARY(wd,1),
+	    view_edge[1,X_DIM], view_edge[1,Y_DIM], N_EDGES)
+	
+	# Find the range of the axes over the graphics viewport.
+	call wl_l2wd (WL_LWCT(wd), WL_AXIS_FLIP(wd), view_edge[1,X_DIM], 
+	     view_edge[1,Y_DIM], array[1,AXIS1], array[1,AXIS2], N_EDGES)
+	call alimd (array[1,AXIS1], N_EDGES, min_value[AXIS1], max_value[AXIS1])
+	call alimd (array[1,AXIS2], N_EDGES, min_value[AXIS2], max_value[AXIS2])
+	range[AXIS1] = abs (max_value[AXIS1] - min_value[AXIS1])
+	range[AXIS2] = abs (max_value[AXIS2] - min_value[AXIS2])
+
+	# The above isn't good enough for the sky projections.  Deal with those.
+	if (WL_SYSTEM_TYPE(wd) == RA_DEC)
+	    call wl_sky_extrema (wd, array[1,AXIS1], N_EDGES, pole_position,
+	        north, min_value[AXIS1], max_value[AXIS1], range[AXIS1],
+		min_value[AXIS2], max_value[AXIS2], range[AXIS2])
+
+	# Determine the rotation between the systems.
+	WL_ROTA(wd) = wl_coord_rotation (WL_WLCT(wd), WL_AXIS_FLIP(wd),
+	    WL_WORLD_CENTER(wd,AXIS1), max_value[AXIS2],
+	    WL_WORLD_CENTER(wd,AXIS1), min_value[AXIS2])
+
+	# Round the intervals.  This is done to make the labelling "nice" and
+	# to smooth edge effects.
+	if (IS_INDEFD (WL_MAJOR_INTERVAL(wd,AXIS1)) ||
+	    IS_INDEFD (WL_BEGIN(wd,AXIS1)) || IS_INDEFD (WL_END(wd,AXIS1)))
+	    call wl_round_axis (wd, AXIS1, min_value[AXIS1], max_value[AXIS1],
+	        range[AXIS1])
+
+	if (IS_INDEFD (WL_MAJOR_INTERVAL(wd,AXIS2)) ||
+	    IS_INDEFD (WL_BEGIN(wd,AXIS2)) || IS_INDEFD (WL_END(wd,AXIS2)))
+	    call wl_round_axis (wd, AXIS2, min_value[AXIS2], max_value[AXIS2],
+	        range[AXIS2])
+end
+
+
+# WL_POLE_POSITION -- Determine logical coordinates of a pole.
+#
+# Description
+#  Calculate the pole's position in the Logical system.
+#
+# Bugs
+#  Can only deal with Right Ascension/Declination.
+
+procedure wl_pole_position (wlct, flip, longitude, north, system_type, 
+	pole_position)
+
+pointer wlct                  # I: the world-to-logical transformation
+int	flip                  # I: true if the axes are transposed
+double  longitude             # I: the longitude to determine latitude
+bool    north                 # I: true if the pole is in the north
+int     system_type           # I: type of system being examined
+double  pole_position[N_DIM]  # O: the pole's logical coordinates
+
+double	sgn
+
+begin
+	switch (system_type) {
+
+	# For Right Ascension/Declination, the pole is at any longitude but
+	# at only 90 degrees (north) or -90 degrees (south) latitude.
+	case RA_DEC:
+	    if  (north)
+		sgn = NORTH_POLE_LATITUDE
+	    else
+		sgn = SOUTH_POLE_LATITUDE
+	    call wl_w2ld (wlct, flip, longitude, sgn, pole_position[X_DIM],
+                pole_position[Y_DIM], 1)
+	}
+
+	# Sanity check on the pole position.  It is very likely that there is
+	# no valid position in pixel space for the pole.  This is checked for
+	# by looking for extremely large numbers.
+	if  (abs (pole_position[X_DIM]) > abs (double (MAX_INT)))
+	    pole_position[X_DIM] = real (MAX_INT)
+	if  (abs (pole_position[Y_DIM]) > abs (double (MAX_INT)))
+	    pole_position[Y_DIM] = real (MAX_INT)
+end
+
+
+# How close can the pole be to the center of the screen to be near-polar.
+define	HOW_CLOSE	3.
+
+# WL_DETERMINE_GRAPH_TYPE -- Determine the actual graph type.
+
+procedure wl_determine_graph_type (system_type, pole_position,
+	screen_boundary, graph_type)
+
+int	system_type               # I: the type of WCS being dealt with
+double	pole_position[N_DIM]      # I: the location of the pole
+double	screen_boundary[N_SIDES]  # I: the edges of the display
+int	graph_type                # O: the graph type
+
+double	max_dist, pole_dist, xcen, ycen
+
+begin
+	# Determine graph type based on axis type.
+	switch (system_type) {
+
+	# If the pole is on the graph then force a graph_type of polar.
+	case RA_DEC:
+
+	    xcen = (screen_boundary[LEFT] + screen_boundary[RIGHT]) / 2.
+	    ycen =  (screen_boundary[BOTTOM] + screen_boundary[TOP]) / 2.
+	    max_dist = min ((screen_boundary[LEFT] - xcen) ** 2,
+	        (screen_boundary[TOP] - ycen)**2)
+	    pole_dist = (pole_position[X_DIM] - xcen) ** 2 +
+	        (pole_position[Y_DIM] - ycen) ** 2
+	
+	    # Check to see whether the graph is "polar", "near_polar"
+	    # or "normal".  If the pole lies within middle part of the
+	    # viewport, then the graph is "polar". If the pole is within
+	    # a certain maximum distance then it is "near_polar".
+	    # Otherwise it is normal.
+
+	    switch (graph_type) {
+	    case NORMAL:
+		# do nothing
+	    case POLAR:
+		# do nothing
+	    case NEAR_POLAR:
+		# do nothing
+	    default:
+	        if (pole_dist < max_dist)
+	            graph_type = POLAR
+	        else if  (pole_dist < HOW_CLOSE * max_dist)
+	            graph_type = NEAR_POLAR
+	        else
+	            graph_type = NORMAL
+	    }
+
+	# For all other cases, explicitely set this to normal.
+	default:
+	    graph_type = NORMAL
+	}
+end
+
+
+# WL_CONSTRUCT_EDGE_VECTORS -- Construct vectors of values along window's edge.
+#
+# Description
+#  This routines filles two arrays, with the x-values and y-values of
+#  evenly spaced points along the edges of the screen.  This is used to
+#  make transformation of the logical edges into the world system
+#  more convenient.
+
+procedure wl_construct_edge_vectors (screen_boundary, x, y, vector_size)
+
+double	screen_boundary[N_SIDES]       # I: the side values
+double	x[vector_size], y[vector_size] # O: the edge vector points
+int	vector_size                    # I: the number of edge vector points
+
+double	current, interval
+int	i, left_over, offset1, offset2, side_length
+
+begin
+	# Divide the vectors into equal amounts for each side.
+	side_length = vector_size / N_SIDES
+	left_over = mod (vector_size, N_SIDES)
+
+	# Calculate the horizontal components.
+	interval =  (screen_boundary[RIGHT] - screen_boundary[LEFT]) /
+	    side_length
+	current = screen_boundary[LEFT]
+	offset1 = side_length
+	for  (i = 1; i <= side_length; i = i + 1) {
+	    x[i] = current + interval
+	    y[i] = screen_boundary[BOTTOM]
+	    x[i+offset1] = current
+	    y[i+offset1] = screen_boundary[TOP]
+	    current = current + interval 
+	}
+
+	# Calculate the verticle components.
+	interval = (screen_boundary[TOP] - screen_boundary[BOTTOM]) /
+	    side_length
+	current = screen_boundary[BOTTOM]
+	offset1 = 2 * side_length
+	offset2 = 3 * side_length
+	for  (i = 1; i <= side_length; i = i + 1) {
+	    x[i+offset1] = screen_boundary[LEFT]
+	    y[i+offset1] = current
+	    x[i+offset2] = screen_boundary[RIGHT]
+	    y[i+offset2] = current + interval
+	    current = current + interval 
+	}
+
+	# Fill in the left over with a single point.
+	offset1 = 4 * side_length
+	for  (i = 1; i <= left_over; i = i + 1) {
+	    x[i+offset1] = screen_boundary[LEFT]
+	    y[i+offset1] = screen_boundary[BOTTOM]
+	}
+
+end
+
+
+# WL_SKY_EXTREMA -- Determine what range the view window covers in the sky.
+# This routine is only called if the WCS RA,DEC.
+#
+# Description
+#   Because of the different graph types and the fact that axis 1 usually
+#   wraps, more work needs to be done to determine what part of the sky
+#   is covered by the viewing window.
+
+procedure wl_sky_extrema (wd, ax1_array, n_points, pole_position, north,
+	ax1min, ax1max, ax1ran, ax2min, ax2max, ax2ran)
+
+pointer	wd                         # I: the WCSLAB descriptor
+double  ax1_array[n_points]        # I: the axis 1 edge vector
+int     n_points                   # I: the length of the edge vector
+double  pole_position[N_DIM]       # I: the pole position
+bool    north                      # I: is the pole in the north ?
+double  ax1min, ax1max, ax1ran     # I/O: the minimum, maximum, range in axis 1
+double  ax2min, ax2max, ax2ran     # I/O: the minimum, maximum, range in axis 2
+
+bool	is_pole
+double	nx, ny, xcen, ycen
+int	wl_direction_from_axis1(), wl_find_side(), wl_opposite_side()
+
+begin
+	# Is the pole on the graph ?
+	if ((pole_position[X_DIM] < WL_SCREEN_BOUNDARY(wd,LEFT))   ||
+	    (pole_position[X_DIM] > WL_SCREEN_BOUNDARY(wd,RIGHT))  ||
+	    (pole_position[Y_DIM] < WL_SCREEN_BOUNDARY(wd,BOTTOM)) ||
+	    (pole_position[Y_DIM] > WL_SCREEN_BOUNDARY(wd,TOP)))
+	    is_pole = false
+	else
+	    is_pole = true
+
+	# If so adjust the RA and DEC ranges appropriately.
+	if (is_pole) {
+
+	    # Set the RA range.
+	    ax1min = 0.0D0
+	    ax1max = 359.9D0
+	    ax1ran = 360.0D0
+
+	    # Set the dec range.
+	    if (north)
+	        ax2max = NORTH_POLE_LATITUDE - ((NORTH_POLE_LATITUDE -
+		    ax2min) * DISTANCE_TO_POLE )
+	    else
+	        ax2min = SOUTH_POLE_LATITUDE + ((NORTH_POLE_LATITUDE +
+		    ax2max) * DISTANCE_TO_POLE)
+	    ax2ran = abs (ax2max - ax2min)
+
+	    # Mark the pole.
+	    call gmark (WL_GP(wd), real (pole_position[X_DIM]),
+		real (pole_position[Y_DIM]), POLE_MARK_SHAPE, POLE_MARK_SIZE,
+		POLE_MARK_SIZE)
+
+	} else {
+	     # Only the RA range needs adjusting.
+	     call wl_ra_range (ax1_array, n_points, ax1min, ax1max, ax1ran)
+	}
+
+	# Adjust the labelling characteristics appropritatley for various
+	# types of graphs.
+
+	if  (WL_GRAPH_TYPE(wd) == POLAR) {
+
+	    # Determine which direction the axis 2's will be labeled on polar
+	    # graphs.
+	    if (IS_INDEFD (WL_POLAR_LABEL_POSITION(wd))) {
+	        call wl_get_axis2_label_direction (WL_LWCT(wd),
+		    WL_AXIS_FLIP(wd), pole_position, WL_SCREEN_BOUNDARY(wd,1),
+		    WL_POLAR_LABEL_POSITION(wd), WL_BAD_LABEL_SIDE(wd))
+	    } else {
+	        WL_BAD_LABEL_SIDE(wd) = wl_direction_from_axis1 (WL_WLCT(wd),
+	            WL_AXIS_FLIP(wd), pole_position, north,
+		    WL_POLAR_LABEL_POSITION(wd), WL_BEGIN(wd,AXIS2),
+	            WL_END(wd,AXIS2), WL_SCREEN_BOUNDARY(wd,1))
+		if (IS_INDEFI (WL_BAD_LABEL_SIDE(wd)))
+		    WL_BAD_LABEL_SIDE(wd) = BOTTOM
+	    }
+
+	    # If the graph type is polar, then determine how to justify
+	    # the labels.
+
+	    if (IS_INDEFI (WL_POLAR_LABEL_DIRECTION(wd)))
+	        WL_POLAR_LABEL_DIRECTION(wd) =
+	            wl_opposite_side (WL_BAD_LABEL_SIDE(wd))
+
+	# If the graph_type is near-polar, then handle the directions a bit
+	# differently.
+	} else if (WL_GRAPH_TYPE(wd) == NEAR_POLAR) {
+
+	    # Find the side that the pole is on.  
+	    xcen = (WL_SCREEN_BOUNDARY(wd,LEFT) +
+	        WL_SCREEN_BOUNDARY(wd,RIGHT)) / 2.
+	    ycen = (WL_SCREEN_BOUNDARY(wd,BOTTOM) +
+	        WL_SCREEN_BOUNDARY(wd,TOP)) / 2.
+	    call wl_axis_on_line (xcen, ycen, pole_position[X_DIM],
+	        pole_position[Y_DIM], WL_SCREEN_BOUNDARY(wd,1), nx, ny)
+
+	    if (IS_INDEFD(nx) || IS_INDEFD(ny)) {
+		WL_BAD_LABEL_SIDE(wd) = BOTTOM
+		WL_POLAR_LABEL_DIRECTION(wd) = LEFT
+	    } else {
+	        WL_BAD_LABEL_SIDE(wd) = wl_find_side (nx, ny,
+	            WL_SCREEN_BOUNDARY(wd,1))
+	        if (WL_BAD_LABEL_SIDE(wd) == LEFT || WL_BAD_LABEL_SIDE(wd) ==
+	            RIGHT)
+		    if (abs (ny - WL_SCREEN_BOUNDARY(wd,BOTTOM)) <
+	                abs (ny - WL_SCREEN_BOUNDARY(wd,TOP)))
+		        WL_POLAR_LABEL_DIRECTION(wd) = BOTTOM
+		    else
+		        WL_POLAR_LABEL_DIRECTION(wd) = TOP
+	        else
+		    if (abs (nx - WL_SCREEN_BOUNDARY(wd,LEFT)) <
+	                abs (nx - WL_SCREEN_BOUNDARY(wd,RIGHT)))
+		        WL_POLAR_LABEL_DIRECTION(wd) = LEFT
+		    else
+		        WL_POLAR_LABEL_DIRECTION(wd) = RIGHT
+	    }
+
+	}
+end
+
+
+# WL_COORD_ROTATION -- Determine "rotation" between the coordinate systems.
+#
+# Description
+#  This routine takes the world-to-logical coordinate transformation and
+#  two points in the world system which should define the positive verticle
+#  axis in the world system.  These points are translated into the logical
+#  system and the angle between the logical vector and its positive verticle
+#  vector is calculated and returned.  The rotation angle is returned
+#  in degrees and is always positive.
+
+double	procedure wl_coord_rotation (wlct, flip, wx1, wy1, wx2, wy2)
+
+pointer	wlct               # I: the world-to-logical transformation
+int	flip               # I: true if the coordinates are transposed
+double	wx1, wy1, wx2, wy2 # I: points in world space to figure rotation from
+
+double	delx, dely, rota, x1, y1, x2, y2
+bool	fp_equald()
+
+begin
+	# Transform the points to the logical system.
+	call wl_w2ld (wlct, flip, wx1, wy1, x1, y1, 1)
+	call wl_w2ld (wlct, flip, wx2, wy2, x2, y2, 1)
+
+	# Determine the rotation.
+	delx = x2 - x1
+	dely = y2 - y1
+	if (fp_equald (delx, 0.0D0) && fp_equald (dely, 0.0D0))
+	    rota = 0.
+	else
+	    rota = RADTODEG (atan2 (dely, delx))
+
+	if  (rota < 0.0D0)
+	    rota = rota + FULL_CIRCLE
+
+	return (rota)
+end
+
+
+# Define how many axis one should go for.
+
+define RA_NUM_TRY         6
+define DEC_NUM_TRY        6
+define DEC_POLAR_NUM_TRY  4
+
+# WL_ROUND_AXIS - Round values for the axis.
+
+procedure wl_round_axis (wd, axis, minimum, maximum, range)
+
+pointer wd                       # I: the WCSLAB descriptor
+int     axis                     # I: the axis being worked on
+double  minimum, maximum, range  # I: raw values to be rounded
+
+int	num_try
+
+begin
+	# Depending on axis type, round the values.
+	switch (WL_SYSTEM_TYPE(wd)) {
+	case RA_DEC:
+	    if (axis == LONGITUDE)
+	        call wl_round_ra (minimum, maximum, range, RA_NUM_TRY,
+	            WL_BEGIN(wd,LONGITUDE), WL_END(wd,LONGITUDE),
+		    WL_MAJOR_INTERVAL(wd,LONGITUDE))
+	    else {
+	        if (WL_GRAPH_TYPE(wd) == POLAR)
+	            num_try = DEC_POLAR_NUM_TRY
+	        else
+	            num_try = DEC_NUM_TRY
+	        call wl_round_dec (minimum, maximum, range, num_try,
+	            WL_BEGIN(wd,LATITUDE), WL_END(wd,LATITUDE), 
+	            WL_MAJOR_INTERVAL(wd,LATITUDE))
+	    }
+
+	default:
+	    call wl_generic_round (minimum, maximum, range, WL_BEGIN(wd,axis),
+	        WL_END(wd,axis), WL_MAJOR_INTERVAL(wd,axis))
+	}
+
+end
+
+
+# WL_GET_AXIS2_LABEL_DIRECTION -- Dertermine label direction for latitides.
+#
+# Description
+#  Determine from which edge of the graph the axis 2 labels are to
+#  appear.  This (in general) is the opposite edge from which the pole
+#  is nearest to.  Move the pole to the closest edges, determine which
+#  side it is, then chose the direction as the opposite.  Also determines
+#  the Axis 1 at which the Axis 2 labels will appear.
+
+procedure wl_get_axis2_label_direction (lwct, flip, pole_position, 
+	screen_boundary, pole_label_position, bad_label_side)
+
+pointer lwct                      # I: logical-to-world transformation
+int	flip                      # I: true if the axis are transposed
+double  pole_position[N_DIM]      # I: the position of the pole
+double  screen_boundary[N_SIDES]  # I: the edges of the screen
+double  pole_label_position       # O: the axis 1 that axis 2 labels should
+	                          #    appear for polar|near-polar graphs
+int     bad_label_side            # O: side not to place axis 1 labels
+
+double	dif, tdif, dummy
+
+begin
+	# Determine which direction, up or down, the axis 2's will be labelled.
+	dif = abs (screen_boundary[TOP] - pole_position[AXIS2])
+	bad_label_side= TOP
+	tdif = abs (screen_boundary[BOTTOM] - pole_position[AXIS2])
+	if (tdif < dif) {
+	  dif = tdif
+	  bad_label_side = BOTTOM
+	}
+
+	# Determine at what value of Axis 1 the Axis 2 labels should appear.
+	switch (bad_label_side) {
+	case TOP: 
+	    call wl_l2wd (lwct, flip, pole_position[AXIS1],
+	        screen_boundary[BOTTOM], pole_label_position, dummy, 1)
+	case BOTTOM: 
+	    call wl_l2wd (lwct, flip, pole_position[AXIS1],
+	        screen_boundary[TOP], pole_label_position, dummy, 1)
+	case LEFT: 
+	    call wl_l2wd (lwct, flip, screen_boundary[RIGHT],
+	        pole_position[AXIS2], pole_label_position, dummy, 1)
+	case RIGHT:  
+	    call wl_l2wd (lwct, flip, screen_boundary[LEFT],
+	        pole_position[AXIS2], pole_label_position, dummy, 1)
+	}
+
+end
+
+
+# WL_DIRECTION_FROM_AXIS1 -- Determine axis 2 label direction from axis 1.
+#
+# Function Returns
+#   This returns the side where Axis 1 should not be labelled.
+
+int procedure wl_direction_from_axis1 (wlct, flip, pole_position, north,
+	polar_label_position, lbegin, lend, screen_boundary)
+
+pointer wlct                      # I: world-to-logical transformation
+int	flip                      # I: true if the axes are transposed
+double  pole_position[N_DIM]      # I: the pole position
+bool    north                     # I: true if the pole is the north pole
+double  polar_label_position      # I: the axis 1 where axis 2 will be 
+	                          #    marked
+double  lbegin                    # I: low end of axis 2
+double  lend                      # I: high end of axis 2
+double  screen_boundary[N_SIDES]  # I: the window boundary
+
+double	nx, ny, cx, cy
+int	wl_find_side()
+
+begin
+	# Determine the point in logical space where the axis 1 and the
+	# minimum axis 2 meet.
+
+	if (north)
+	    call wl_w2ld (wlct, flip, polar_label_position, lbegin, nx, ny, 1)
+	else
+	    call wl_w2ld (wlct, flip, polar_label_position, lend, nx, ny, 1)
+
+	# This line should cross a window boundary.  Find that point.
+
+	call wl_axis_on_line (pole_position[X_DIM], pole_position[Y_DIM],
+	    screen_boundary, nx, ny, cx, cy)
+
+	# Get the side that the crossing point is. This is the axis 2 labelling
+	# direction.
+
+	if (IS_INDEFD(cx) || IS_INDEFD(cy))
+	    return (INDEFI)
+	else
+	    return (wl_find_side (cx, cy, screen_boundary))
+end
+
+
+# WL_OPPOSITE_SIDE - Return the opposite of the given side.
+#
+# Returns
+#   The opposite side of the specified side as follows:
+#           RIGHT  -> LEFT
+#           LEFT   -> RIGHT
+#           TOP    -> BOTTOM
+#           BOTTOM -> TOP
+
+int procedure wl_opposite_side (side)
+
+int	side		# I: the side to find the opposite of
+
+int	new_side
+
+begin
+	switch (side) {
+	case LEFT:
+	    new_side = RIGHT
+	case RIGHT:
+	    new_side = LEFT
+	case TOP:
+	    new_side = BOTTOM
+	case BOTTOM:
+	    new_side = TOP
+	}
+
+	return (new_side)
+end
+
+
+# Define whether things are on the screen boundary or on them.
+
+define IN (($1>=screen_boundary[LEFT])&&($1<=screen_boundary[RIGHT])&&($2>=screen_boundary[BOTTOM])&&($2<=screen_boundary[TOP]))
+
+
+# WL_AXIS_ON_LINE - Determine intersection of line and a screen boundary.
+#
+# Description
+#  Return the point where the line defined by the two input points 
+#  crosses a screen boundary.  The boundary is choosen by determining
+#  which one is between the two points.
+
+procedure wl_axis_on_line (x0, y0, x1, y1, screen_boundary, nx, ny)
+
+double	x0, y0, x1, y1            # I: random points in space
+double	screen_boundary[N_SIDES]  # I: sides of the window
+double	nx, ny                    # O: the closest point on a window boundary
+
+double	x_val[N_SIDES], y_val[N_SIDES], tx0, ty0, tx1, ty1, w[2]
+int	i
+pointer	cvx, cvy
+double	dcveval()
+
+begin
+	# Get the line parameters.
+	x_val[1] = x0
+	x_val[2] = x1
+	y_val[1] = y0
+	y_val[2] = y1
+
+	iferr (call dcvinit (cvx, CHEBYSHEV, 2, min (x0, x1), max (x0, x1)))
+	    cvx = NULL
+	else {
+	    call dcvfit (cvx, x_val, y_val, w, 2, WTS_UNIFORM, i)
+	    if (i != OK)
+	        call error (i, "wlaxie: Error solving on X")
+	}
+
+	iferr (call dcvinit (cvy, CHEBYSHEV, 2, min (y0, y1), max (y0, y1)))
+	    cvy = NULL
+	else {
+	    call dcvfit (cvy, y_val, x_val, w, 2, WTS_UNIFORM, i)
+	    if (i != OK)
+	        call error (i, "wlaxie: Error solving on Y")
+	}
+
+	# Solve for each side.
+	x_val[LEFT] = screen_boundary[LEFT]
+	if (cvx == NULL)
+	    y_val[LEFT] = screen_boundary[LEFT]
+	else
+	    y_val[LEFT] = dcveval (cvx, x_val[LEFT])
+
+	x_val[RIGHT] = screen_boundary[RIGHT]
+	if (cvx == NULL )
+	    y_val[RIGHT] = screen_boundary[RIGHT]
+	else
+	    y_val[RIGHT] = dcveval (cvx, x_val[RIGHT])
+
+	y_val[TOP] = screen_boundary[TOP]
+	if (cvy == NULL)
+	    x_val[TOP] = screen_boundary[TOP]
+	else
+	    x_val[TOP] = dcveval (cvy, y_val[TOP])
+
+	y_val[BOTTOM] = screen_boundary[BOTTOM]
+	if (cvy == NULL)
+	    x_val[BOTTOM] = screen_boundary[BOTTOM]
+	else
+	    x_val[BOTTOM] = dcveval (cvy, y_val[BOTTOM])
+
+	# Rearrange the input points to be in ascending order.
+	if  (x0 < x1) {
+	    tx0 = x0
+	    tx1 = x1
+	} else {
+	    tx0 = x1
+	    tx1 = x0
+	}
+
+	if  (y0 < y1) {
+	    ty0 = y0
+	    ty1 = y1
+	} else {
+	    ty0 = y1
+	    ty1 = y0
+	}
+
+	# Now find which point is between the two given points and is within
+	# the viewing area.
+	# NOTE: Conversion to real for the check- if two points are so close
+	# for double, any of them would serve as the correct answer.
+
+	nx = INDEFD
+	ny = INDEFD
+	for  (i = 1; i <= N_SIDES; i = i + 1)
+	    if  (real (tx0) <= real (x_val[i]) && 
+	        real (x_val[i]) <= real (tx1)  &&
+	        real (ty0) <= real (y_val[i])  && 
+	        real (y_val[i]) <= real (ty1)  &&
+	        IN (x_val[i], y_val[i]) ) {
+	        nx = x_val[i]
+	        ny = y_val[i]
+	    }
+
+	# Release the curve fit descriptors.
+	if (cvx != NULL)
+	    call dcvfree (cvx)
+	if (cvy != NULL)
+	    call dcvfree (cvy)
+end
+
+
+# WL_FIND_SIDE -- Return the side that the given point is lying on.
+#
+# Function Returns
+#  Return the side, TOP, BOTTOM, LEFT, or RIGHT, that the specified
+#  point is lying on.  One of the coordinates must be VERY CLOSE to one of 
+#  the sides or INDEFI will be returned.
+
+int procedure wl_find_side (x, y, screen_boundary)
+
+double x, y                      # I: the point to inquire about
+double screen_boundary[N_SIDES]  # I: the edges of the screen
+
+double	dif, ndif
+int	side
+
+begin
+	dif = abs (x - screen_boundary[LEFT])
+	side = LEFT
+
+	ndif = abs (x - screen_boundary[RIGHT])
+	if  (ndif < dif) {
+	  side = RIGHT
+	  dif = ndif
+	}
+	
+	ndif = abs (y - screen_boundary[BOTTOM])
+	if  (ndif < dif) {
+	  side = BOTTOM
+	  dif = ndif
+	}
+	
+	ndif = abs (y - screen_boundary[TOP])
+	if  (ndif < dif)
+	  side = TOP
+
+	return (side)
+end
+
+
+# WL_RA_RANGE -- Determine the range in RA given a list of possible values.
+#
+# Description
+#  Determine the largest range in RA from the provided list of values.
+#  The problem here is that it is unknown which way the graph is oriented.
+#  To simplify the problem, it is assume that the graph range does not extend
+#  beyond a hemisphere and that all distances in RA is less than a hemisphere.
+#  This assumption is needed to decide when the 0 hour is on the graph.
+
+procedure wl_ra_range (ra, n_values, min, max, diff)
+
+double	ra[ARB]		# I:   the possible RA values
+int	n_values	# I:   the number of possible RA values
+double	min		# I/O: the minimum RA
+double	max		# I/O: the maximum RA
+double	diff		# I/O: the difference between minimum and maximum
+
+bool	wrap
+int	i, j, n_diffs
+pointer	sp, max_array, min_array, ran_array
+int	wl_max_element_array()
+
+begin
+	call smark (sp)
+	call salloc (max_array, n_values * n_values, TY_DOUBLE)
+	call salloc (min_array, n_values * n_values, TY_DOUBLE)
+	call salloc (ran_array, n_values * n_values, TY_DOUBLE)
+
+	# Check whether the RA is wrapped or not.
+	n_diffs = 0
+	do i = 1, n_values {
+	    if (ra[i] >= min && ra[i] <= max)
+		next
+	    n_diffs = n_diffs + 1
+	}
+	if (n_diffs > 0)
+	    wrap = true
+	else
+	    wrap = false
+
+	n_diffs = 0
+	for  (i = 1; i <= n_values; i = i + 1) {
+	    for  (j = i + 1; j <= n_values; j = j + 1) {
+	        n_diffs = n_diffs + 1
+	        call wl_getradif (ra[i], ra[j], Memd[min_array+n_diffs-1],
+		    Memd[max_array+n_diffs-1], Memd[ran_array+n_diffs-1],
+		    wrap)
+	    }
+	}
+
+	i = wl_max_element_array (Memd[ran_array], n_diffs)
+	min = Memd[min_array+i-1]
+	max = Memd[max_array+i-1]
+	diff = Memd[ran_array+i-1]
+
+	call sfree (sp)
+end
+
+
+# WL_GETRADIFF -- Get differences in RA based on degrees.
+#
+# Description
+#  This procedure determines, given two values in degrees, the minimum,
+#  maximum, and difference of those values.  The assumption is that no
+#  difference should be greater than half a circle.  Based on this assumption,
+#  a difference is found and the minimum and maximum are determined.  The
+#  maximum can be greater than 360 degrees.
+
+procedure wl_getradif (val1, val2, min, max, diff, wrap)
+
+double	val1, val2  # I: the RA values
+double	min, max    # O: the min RA and max RA (possibly > 360.0)
+double	diff        # O: the min, max difference
+bool	wrap	    # I: is the ra wrapped ?
+
+begin
+	if (! wrap && (abs (val1 - val2) > HALF_CIRCLE))
+	    if (val1 < val2) {
+	        min = val2
+	        max = val1 + FULL_CIRCLE
+	    } else {
+	        min = val1
+	        max = val2 + FULL_CIRCLE
+	    }
+	else
+	    if (val1 < val2) {
+		min = val1
+		max = val2
+	    } else {
+		min = val2
+		max = val1
+	    }
+	diff = max - min
+end
+
+
+define	NRAGAP    26
+
+# WL_ROUND_RA -- Modify the RA limits and calculate an interval to label.
+#
+# Description
+#  The RA limits determine by just the extremes of the window ususally do
+#  not fall on "reasonable" boundaries; i.e. essentially they are random
+#  numbers.  However, for labelling purposes, it is nice to have grids and
+#  tick marks for "rounded" numbers-  For RA, this means values close to
+#  whole hours, minutes, or seconds.  For example, if the span across the
+#  plot is a few hours, the marks and labels should represent simply whole
+#  hours.  This routine determines new RA limits based on this and some 
+#  interval to produce marks between the newly revised limits.
+
+procedure wl_round_ra (longmin, longmax, longran, num_try, minimum, maximum, 
+	major_interval)
+
+double	longmin          # I: longitude minimum
+double	longmax          # I: longitude maximum
+double	longran          # I: longitude range
+int	num_try          # I: the number of intervals to try for
+double	minimum          # O: the minimum RA value (in degrees)
+double	maximum          # O: the maximum RA value (in degrees)
+double	major_interval   # O: the appropriate interval (in degrees) for the
+	                 #    major line marks.
+
+double  ragap[NRAGAP]
+double	wl_check_arrayd(), wl_round_upd()
+data	ragap / 1.0D-4, 2.0D-4, 5.0D-4,  1.0D-3,  2.0D-3,  5.0D-3,
+	        0.01D0, 0.02D0, 0.05D0, 0.1D0,  0.2D0,  0.5D0,   1.0D0,
+		2.0D0,   5.0D0, 10.0D0, 20.0D0, 30.0D0, 60.0D0, 120.0D0,
+		300.0D0, 600.0D0,  1.2D3,  1.8D3,  3.6D3,  7.2D3 /
+
+
+begin
+	major_interval = wl_check_arrayd (DEGTOST (longran) / num_try, 
+	    ragap, NRAGAP)
+	minimum = STTODEG (wl_round_upd (DEGTOST (longmin), major_interval) - 
+	    major_interval)
+	maximum = STTODEG (wl_round_upd (DEGTOST (longmax), major_interval))
+	major_interval = STTODEG (major_interval)
+end
+
+
+define	NDECGAP    28
+
+# WL_ROUND_DEC -- Modify the DEC limits and calculate an interval to label.
+#
+# Description
+#  The DEC limits determine by just the extremes of the window ususally do
+#  not fall on "reasonable" boundaries; i.e. essentially they are random
+#  numbers.  However, for labelling purposes, it is nice to have grids and
+#  tick marks for "rounded" numbers-  For DEC, this means values close to
+#  whole degrees, minutes, or seconds.  For example, if the span across the
+#  plot is a few degrees, the marks and labels should represent simply whole
+#  degrees.  This routine determines new DEC limits based on this and some 
+#  interval to produce marks between the newly revised limits.
+
+procedure wl_round_dec (latmin, latmax, latran, num_try, minimum, maximum, 
+	major_interval)
+
+double latmin              # I: the latitude minimum
+double latmax              # I: the latitude maximum
+double latran              # I: the latitude range
+int    num_try             # I: number of intervals to try for
+double minimum             # O: the DEC minimum
+double maximum             # O: the DEC maximum
+double major_interval      # O: the labelling interval to use for major lines
+
+double  decgap[NDECGAP]
+double	wl_check_arrayd(), wl_round_upd()
+data	decgap / 1.0D-4, 2.0D-4,  5.0D-4, 1.0D-3, 2.0D-3,  5.0D-3,
+	         0.01D0, 0.02D0,  0.05D0, 0.1D0,  0.2D0,   0.5D0,   1.0D0,
+		 2.0D0, 5.0D0, 10.0D0,20.0D0, 30.0D0, 60.0D0, 120.0d0,
+		 300.0D0, 600.0D0, 1.2D3, 1.8D3, 3.6D3, 7.2D3, 1.8D4, 3.6D4 /
+
+begin
+	major_interval = wl_check_arrayd (DEGTOSA (latran) / num_try, 
+	    decgap, NDECGAP)
+	minimum = SATODEG (wl_round_upd (DEGTOSA (latmin), major_interval) -
+	    major_interval)
+	maximum = SATODEG (wl_round_upd (DEGTOSA (latmax), major_interval))
+	major_interval = SATODEG (major_interval)
+
+	# Make sure that the grid marking does not include the pole.
+	maximum = min (maximum, NORTH_POLE_LATITUDE - major_interval)
+	minimum = max (minimum, SOUTH_POLE_LATITUDE + major_interval)
+end
+
+
+# WL_GENERIC_ROUND -- Round the values (if possible).
+#
+# History
+#   7Feb91 - Created by Jonathan D. Eisenhamer, STScI.
+
+procedure wl_generic_round (minimum, maximum, range, lbegin, lend, interval)
+
+double	minimum, maximum, range  # I: the raw input values
+double	lbegin, lend             # O: the begin and end label points
+double	interval                 # O: the major label interval
+
+double	amant, diff
+int	iexp, num
+double	wl_round_upd()
+
+begin
+	diff = log10 (abs (range) / 4.D0)
+	iexp = int (diff)
+	if (diff < 0)
+	    iexp = iexp - 1
+
+	amant = diff - double (iexp)
+	if (amant < 0.15D0)
+	  num = 1
+	else if (amant < 0.50D0)
+	  num = 2
+	else if (amant < 0.85D0)
+	  num = 5
+	else
+	  num = 10
+
+	interval = double (num) * 10.0D0 ** iexp
+	lbegin = wl_round_upd (minimum, interval) - interval
+	lend = wl_round_upd (maximum, interval)
+end
+
+
+#  WL_ROUND_UPD -- Round X up to nearest whole multiple of Y.
+
+double procedure wl_round_upd (x, y)
+
+double	x		# I: value to be rounded
+double	y		# I: multiple of X is to be rounded up in
+
+double	z, r
+
+begin
+	if (x < 0.0D0)
+	    z = 0.0D0
+	else
+	    z = y
+	r = y * double (int ((x + z) / y))
+
+	return (r)
+end
+
+
+
+#  WL_CHECK_ARRAYD -- Check proximity of array elements to each other.
+#
+# Description
+#  Returns the element of the array arr(n) which is closest to an exact
+#  value EX.
+
+double procedure wl_check_arrayd (ex, arr, n)
+
+double	ex		# I: the exact value
+double	arr[ARB]	# I: the array of rounded values
+int	n		# I: dimension of array  of rounded values
+
+int	j
+
+begin
+	for (j = 1;  j < n && (ex - arr[j]) > 0.0D0;  j = j + 1)
+	    ;
+	if (j > 1 && j < n)
+	    if (abs (ex - arr[j-1]) < abs (ex - arr[j])) 
+		j = j - 1
+
+	return (arr[j])
+end
diff --git a/pkg/utilities/nttools/stxtools/wcslab/wlutil.x b/pkg/utilities/nttools/stxtools/wcslab/wlutil.x
new file mode 100644
index 00000000..c79b8f5e
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/wlutil.x
@@ -0,0 +1,390 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imio.h>
+include <imhdr.h>
+include <gset.h>
+include <math.h>
+
+# WL_IMD_VIEWPORT -- Map the viewport and window of the image display.
+
+procedure wl_imd_viewport (frame, im, c1, c2, l1, l2, vl, vr, vb, vt)
+
+int	frame			# I:   display frame to be overlayed
+pointer	im			# I:   pointer to the input image
+real	c1, c2, l1, l2		# I/O: input/output window
+real	vl, vr, vb, vt		# I/O: input/output viewport
+
+int	wcs_status, dim1, dim2, step1, step2
+pointer	sp, frimage, frim, iw
+real	x1, x2, y1, y2, fx1, fx2, fy1, fy2, junkx, junky
+real	vx1, vx2, vy1, vy2, nx1, nx2, ny1, ny2
+pointer	imd_mapframe(), iw_open()
+
+
+begin
+	# If all of the viewport parameters were defined by the user
+	# use the default viewport and window.
+	if (! IS_INDEFR(vl) && ! IS_INDEFR(vr) && ! IS_INDEFR(vb) &&
+	    ! IS_INDEFR(vt))
+	    return
+
+	# Allocate some memory.
+	call smark (sp)
+	call salloc (frimage, SZ_FNAME, TY_CHAR)
+
+	# Open the requested display frame and get the loaded image name.
+	# If this name is blank, use the default viewport and window.
+
+	frim = imd_mapframe (frame, READ_ONLY, YES)
+	iw = iw_open (frim, frame, Memc[frimage], SZ_FNAME, wcs_status)
+	if (Memc[frimage] == EOS || wcs_status == ERR) {
+	    call iw_close (iw)
+	    call imunmap (frim)
+	    call sfree (sp)
+	    return
+	}
+
+	# Find the beginning and end points of the requested image section.
+	# We already know at this point that the input logical image is
+	# 2-dimensional. However this 2-dimensional section may be part of
+	# n-dimensional image.
+
+	# X dimension.
+	dim1 = IM_VMAP(im,1)
+	step1 = IM_VSTEP(im,1)
+	if (step1 >= 0) {
+	    x1 = IM_VOFF(im,dim1) + 1
+	    x2 = x1 + IM_LEN(im,1) - 1
+	} else {
+	    x1 = IM_VOFF(im,dim1) - 1
+	    x2 = x1 - IM_LEN(im,1) + 1
+	}
+
+	# Y dimension.
+	dim2 = IM_VMAP(im,2)
+	step2 = IM_VSTEP(im,2)
+	if (step2 >= 0) {
+	    y1 = IM_VOFF(im,dim2) + 1
+	    y2 = y1 + IM_LEN(im,2) - 1
+	} else {
+	    y1 = IM_VOFF(im,dim2) - 1
+	    y2 = y1 - IM_LEN(im,2) + 1
+	}
+
+	# Get the frame buffer coordinates corresponding to the lower left
+	# and upper right corners of the image section.
+
+	call iw_im2fb (iw, x1, y1, fx1, fy1)
+	call iw_im2fb (iw, x2, y2, fx2, fy2)
+	if (fx1 > fx2) {
+	    junkx = fx1
+	    fx1 = fx2 
+	    fx2 = junkx
+	}
+	if (fy1 > fy2) {
+	    junky = fy1
+	    fy1 = fy2 
+	    fy2 = junky
+	}
+
+	# Check that some portion of the input image is in the display.
+	# If not select the default viewport and window coordinates.
+	if (fx1 > IM_LEN(frim,1) || fx2 < 1.0 || fy1 > IM_LEN(frim,2) ||
+	    fy2 < 1.0) {
+	    call iw_close (iw)
+	    call imunmap (frim)
+	    call sfree (sp)
+	    return
+	}
+
+	# Compute a new viewport and window for X.
+	if (fx1 >= 1.0) {
+	    vx1 = max (0.0, min (1.0, (fx1 - 0.5) / IM_LEN(frim,1)))
+	    nx1 = 1.0
+	} else {
+	    vx1 = 0.0
+	    call iw_fb2im (iw, 1.0, 1.0, junkx, junky)
+	    if (step1 >= 0)
+	        nx1 = max (1.0, junkx - x1 + 1.0)
+	    else
+	        nx2 = max (1.0, junkx - x2 + 1.0)
+	}
+	if (fx2 <= IM_LEN(frim,1)) {
+	    vx2 = max (0.0, min (1.0, (fx2 + 0.5) / IM_LEN(frim,1)))
+	    nx2 = IM_LEN(im,1)
+	} else {
+	    vx2 = 1.0
+	    call iw_fb2im (iw, real(IM_LEN(frim,1)), real (IM_LEN(frim,2)),
+	        junkx, junky)
+	    if (step1 >= 0)
+	        nx2 = min (real (IM_LEN(im,1)),  junkx - x1 + 1.0)
+	    else
+	        nx1 = min (real (IM_LEN(im,1)),  junkx - x2 + 1.0)
+	}
+
+	# Compute a new viewport and window for Y.
+	if (fy1 >= 1.0) {
+	    vy1 = max (0.0, min (1.0, (fy1 - 0.5) / IM_LEN(frim,2)))
+	    ny1 = 1.0
+	} else {
+	    vy1 = 0.0
+	    call iw_fb2im (iw, 1.0, 1.0, junkx, junky)
+	    if (step2 >= 0)
+	        ny1 = max (1.0, junky - y1 + 1)
+	    else
+	        ny2 = max (1.0, junky - y2 + 1)
+	}
+	if (fy2 <= IM_LEN(frim,2)) {
+	    vy2 = max (0.0, min (1.0, (fy2 + 0.5)  / IM_LEN(frim,2)))
+	    ny2 = IM_LEN(im,2)
+	} else {
+	    vy2 = 1.0
+	    call iw_fb2im (iw, real (IM_LEN(frim,1)), real (IM_LEN(frim,2)),
+	        junkx, junky)
+	    if (step2 >= 0)
+	        ny2 = min (real (IM_LEN(im,2)), junky - y1 + 1.0)
+	    else
+	        ny1 = min (real (IM_LEN(im,2)), junky - y2 + 1.0)
+	}
+
+	# Define a the new viewport and window. 
+	if (IS_INDEFR(vl)) {
+	    vl = vx1
+	    c1 = nx1
+	}
+	if (IS_INDEFR(vr)) {
+	    vr = vx2
+	    c2 = nx2
+	}
+	if (IS_INDEFR(vb)) {
+	    vb = vy1
+	    l1 = ny1
+	}
+	if (IS_INDEFR(vt)) {
+	    vt = vy2
+	    l2 = ny2
+	}
+
+	# Clean up.
+	call iw_close (iw)
+	call imunmap (frim)
+	call sfree (sp)
+end
+
+
+define  EDGE1  0.1
+define  EDGE2  0.9
+define  EDGE3  0.12
+define  EDGE4  0.92
+
+# WL_MAP_VIEWPORT -- Set device viewport wcslab plots. If not specified by
+# user, a default viewport centered on the device is used.
+
+procedure wl_map_viewport (gp, c1, c2, l1, l2, ux1, ux2, uy1, uy2, fill)
+
+pointer	gp			# I:   pointer to graphics descriptor
+real	c1, c2, l1, l2		# I:   the column and line limits
+real	ux1, ux2, uy1, uy2	# I/O: NDC coordinates of requested viewort
+bool	fill			# I:   fill viewport (vs preserve aspect ratio)
+
+int	ncols, nlines
+real	xcen, ycen, ncolsr, nlinesr, ratio, aspect_ratio
+real	x1, x2, y1, y2, ext, xdis, ydis
+bool	fp_equalr()
+real	ggetr()
+data	ext /0.0625/
+
+begin
+	ncols = nint (c2 - c1) + 1
+	ncolsr = real (ncols)
+	nlines = nint (l2 - l1) + 1
+	nlinesr = real (nlines)
+
+	# Determine the standard window sizes.
+	if (fill) {
+    	    x1 = 0.0;  x2 = 1.0
+    	    y1 = 0.0;  y2 = 1.0
+	} else {
+    	    x1 = EDGE1;  x2 = EDGE2
+    	    y1 = EDGE3;  y2 = EDGE4
+	}
+
+	# If any values were specified, then replace them here.
+	if (! IS_INDEFR(ux1))
+	    x1 = ux1
+	if (! IS_INDEFR(ux2))
+	    x2 = ux2
+	if (! IS_INDEFR(uy1))
+	    y1 = uy1
+	if (! IS_INDEFR(uy2))
+	    y2 = uy2
+
+	# Calculate optimum viewport, as in NCAR's conrec, hafton.
+	if (! fill) {
+    	    ratio = min (ncolsr, nlinesr) / max (ncolsr, nlinesr)
+    	    if (ratio >= ext) {
+      	        if (ncols > nlines) 
+        	    y2 = (y2 - y1) * nlinesr / ncolsr + y1
+      		else 
+                    x2 = (x2 - x1) * ncolsr / nlinesr + x1
+    	    }
+	}
+
+	xdis = x2 - x1
+	ydis = y2 - y1
+	xcen = (x2 + x1) / 2.
+	ycen = (y2 + y1) / 2.
+
+	# So far, the viewport has been calculated so that equal numbers of
+	# image pixels map to equal distances in NDC space, regardless of 
+	# the aspect ratio of the device.  If the parameter "fill" has been
+	# set to no, the user wants to compensate for a non-unity aspect 
+	# ratio and make equal numbers of image pixels map to into the same 
+	# physical distance on the device, not the same NDC distance.
+
+	if (! fill) {
+	    aspect_ratio = ggetr (gp, "ar")
+	    if (fp_equalr (aspect_ratio, 0.0))
+	        aspect_ratio = 1.0
+
+            if (aspect_ratio < 1.0)
+                # Landscape
+                xdis = xdis * aspect_ratio
+            else if (aspect_ratio > 1.0)
+                # Portrait
+                ydis = ydis / aspect_ratio
+        }
+
+	ux1 = xcen - (xdis / 2.0)
+	ux2 = xcen + (xdis / 2.0)
+	uy1 = ycen - (ydis / 2.0)
+	uy2 = ycen + (ydis / 2.0)
+
+	call gsview (gp, ux1, ux2, uy1, uy2)
+	call gswind (gp, c1, c2, l1, l2)
+end
+
+
+# WL_W2LD -- Transform world coordinates to logical coordinates.
+
+procedure wl_w2ld (wlct, flip, wx, wy, lx, ly, npts)
+
+pointer wlct                # I: the MWCS coordinate transformation descriptor
+int	flip                # I: true if the axes are transposed
+double  wx[npts], wy[npts]  # I: the world coordinates
+double  lx[npts], ly[npts]  # O: the logical coordinates
+int     npts                # I: the number of points to translate
+
+begin
+	if (flip == YES)
+	    call mw_v2trand (wlct, wx, wy, ly, lx, npts)
+	else
+	    call mw_v2trand (wlct, wx, wy, lx, ly, npts)
+end
+
+
+# WL_L2WD -- Transform logical coordinates to world coordinates.
+
+procedure wl_l2wd (lwct, flip, lx, ly, wx, wy, npts)
+
+pointer lwct                # I: the MWCS coordinate transformation descriptor
+int	flip                # I: true if the axes are transposed
+double  lx[npts], ly[npts]  # I: the logical coordinates
+double  wx[npts], wy[npts]  # O: the world coordinates
+int     npts                # I: the number of points to translate
+
+begin
+	if (flip == YES)
+	    call mw_v2trand (lwct, ly, lx, wx, wy, npts)
+	else
+	    call mw_v2trand (lwct, lx, ly, wx, wy, npts)
+end
+
+
+# WL_MAX_ELEMENT_ARRAY -- Return the index of the maximum array element.
+#
+# Description
+#  This function returns the index of the maximum value of the input array.
+
+int procedure wl_max_element_array (array, npts)
+
+double	array[ARB] 	 # I: the array to look through for the maximum
+int	npts             # I: the number of points in the array
+
+int	i, maximum
+
+begin
+	maximum = 1
+	for (i = 2; i <= npts; i = i + 1)
+	    if (array[i] > array[maximum])
+		maximum = i
+
+	return (maximum)
+end
+
+
+# WL_DISTANCED - Determine the distance between two points.
+
+double procedure wl_distanced (x1, y1, x2, y2)
+
+double	x1, y1		# I: coordinates of point 1
+double	x2, y2		# I: coordinates of point 2
+
+double	a, b
+
+begin
+	a = x1 - x2
+	b = y1 - y2
+	return (sqrt ((a * a) + (b * b)))
+end
+
+
+# WL_DISTANCER -- Determine the distance between two points.
+
+real procedure wl_distancer (x1, y1, x2, y2)
+
+real	x1, y1		# I: coordinates of point 1
+real	x2, y2		# I: coordinates of point 2
+
+real a, b
+
+begin
+	a = x1 - x2
+	b = y1 - y2
+	return (sqrt ((a * a) + (b * b)))
+end
+
+
+# The dimensionality.
+define N_DIM 2
+
+# Define some memory management.
+define ONER Memr[$1+$2-1]
+
+# WL_ROTATE -- Rotate a vector.
+
+procedure wl_rotate (x, y, npts, angle, nx, ny)
+
+real	x[npts], y[npts]    # I: the vectors to rotate
+int	npts                # I: the number of points in the vectors
+real	angle               # I: the angle to rotate (radians)
+real	nx[npts], ny[npts]  # O: the transformed vectors
+
+pointer sp, center, mw
+pointer mw_open(), mw_sctran()
+
+begin
+	# Get some memory.
+	call smark (sp)
+	call salloc (center, N_DIM, TY_REAL)
+
+	mw = mw_open (NULL, N_DIM)
+	ONER(center,1) = 0.
+	ONER(center,2) = 0.
+	call mw_rotate (mw, -DEGTORAD( angle ), ONER(center,1), 3b)
+	call mw_v2tranr (mw_sctran (mw, "physical", "logical", 3b),
+            x, y, nx, ny, npts)
+
+	call mw_close (mw)
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/stxtools/wcslab/wlwcslab.x b/pkg/utilities/nttools/stxtools/wcslab/wlwcslab.x
new file mode 100644
index 00000000..156c9a8a
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/wcslab/wlwcslab.x
@@ -0,0 +1,181 @@
+include <gio.h>
+include <gset.h>
+include "wcslab.h"
+include "wcs_desc.h"
+
+# Define the memory structure for saving the graphics wcs.
+define SAVE_BLOCK_SIZE  16
+define OLD_NDC_VIEW     Memr[wcs_save_block-1+$1]
+define OLD_NDC_WIND     Memr[wcs_save_block+3+$1]
+define OLD_PLT_VIEW     Memr[wcs_save_block+7+$1]
+define OLD_PLT_WIND     Memr[wcs_save_block+11+$1]
+
+# WL_WCSLAB -- Label using a defined wcs.
+#
+# Description
+#   This routine uses the information in the WCSLAB descriptor to perform
+#   labelling.
+#
+#   Before this routine can be called, several things must have already
+#   occured.  They are as follows:
+#      1 A call to wl_create must be made to create the WCSLAB descriptor.
+#      2 The WCS_MW component must be set to the MWCS object of the
+#        desired transformations.
+#      3 A call to wl_get_system_type must be made.
+#      4 The graphics device must have been opened and the window defined.
+#        The WCS_GP component of the WCSLAB descriptor must be set to the
+#        graphics window descriptor.
+#
+#   When done with this routine, the WL_GP and WL_MW components must be
+#   deallocated seperately.  Then only wlab_destroy need be called to
+#   remove the WCSLAB descriptor.
+#
+#---------------------------------------------------------------------------
+
+procedure wl_wcslab (wd)
+
+pointer wd 	 # I: the WCSLAB descriptor
+
+int	old_clip, old_pltype, old_txquality, old_wcs
+pointer	sp, wcs_save_block
+real	old_plwidth, old_txsize, old_txup
+int	gstati()
+real	gstatr()
+
+begin
+	# Allocate working space.
+	call smark(sp)
+	call salloc(wcs_save_block, SAVE_BLOCK_SIZE, TY_STRUCT)
+
+	# Store certain graphics parameters.
+	old_plwidth = gstatr (WL_GP(wd), G_PLWIDTH)
+	old_txsize = gstatr (WL_GP(wd), G_TXSIZE)
+	old_txup = gstatr (WL_GP(wd), G_TXUP)
+	old_clip = gstati (WL_GP(wd), G_CLIP)
+	old_pltype = gstati (WL_GP(wd), G_PLTYPE)
+	old_txquality= gstati (WL_GP(wd), G_TXQUALITY)
+	old_wcs = gstati (WL_GP(wd), G_WCS)
+
+	# Choose two other graphics wcs' for internal use.  Save the wcs for
+	# later restoration.
+	if( old_wcs < MAX_WCS - 2 ) {
+	    WL_NDC_WCS(wd) = old_wcs + 1
+	    WL_PLOT_WCS(wd) = WL_NDC_WCS(wd) + 1
+	} else {
+	    WL_NDC_WCS(wd) = old_wcs - 1
+	    WL_PLOT_WCS(wd) = WL_NDC_WCS(wd) - 1
+	}
+	call gseti(WL_GP(wd), G_WCS, WL_NDC_WCS(wd))
+	call ggview(WL_GP(wd), OLD_NDC_VIEW(LEFT), OLD_NDC_VIEW(RIGHT),
+	    OLD_NDC_VIEW(BOTTOM), OLD_NDC_VIEW(TOP))
+	call ggwind(WL_GP(wd), OLD_NDC_WIND(LEFT), OLD_NDC_WIND(RIGHT),
+	    OLD_NDC_WIND(BOTTOM), OLD_NDC_WIND(TOP))
+	call gseti(WL_GP(wd), G_WCS, WL_PLOT_WCS(wd))
+	call ggview(WL_GP(wd), OLD_PLT_VIEW(LEFT), OLD_PLT_VIEW(RIGHT),
+	    OLD_PLT_VIEW(BOTTOM), OLD_PLT_VIEW(TOP))
+	call ggwind(WL_GP(wd), OLD_PLT_WIND(LEFT), OLD_PLT_WIND(RIGHT),
+	    OLD_PLT_WIND(BOTTOM), OLD_PLT_WIND(TOP))
+
+	# Set the graphics device the way wcslab requires it.
+	call gseti (WL_GP(wd), G_WCS, old_wcs)
+	call wl_graphics (wd)
+
+	# Determine basic characteristics of the plot.
+	call wl_setup (wd) 
+
+	# Plot the grid lines.
+	call wl_grid (wd)
+
+	# Put the grid labels on the lines.
+	if (WL_LABON(wd) == YES)
+	    call wl_label (wd)
+
+	# Restore the original graphics wcs.
+        call gseti(WL_GP(wd), G_WCS, WL_NDC_WCS(wd))
+        call gsview(WL_GP(wd), OLD_NDC_VIEW(LEFT), OLD_NDC_VIEW(RIGHT),
+	    OLD_NDC_VIEW(BOTTOM), OLD_NDC_VIEW(TOP))
+        call gswind(WL_GP(wd), OLD_NDC_WIND(LEFT), OLD_NDC_WIND(RIGHT),
+            OLD_NDC_WIND(BOTTOM), OLD_NDC_WIND(TOP))
+        call gseti(WL_GP(wd), G_WCS, WL_PLOT_WCS(wd))
+        call gsview(WL_GP(wd), OLD_PLT_VIEW(LEFT), OLD_PLT_VIEW(RIGHT),
+            OLD_PLT_VIEW(BOTTOM), OLD_PLT_VIEW(TOP))
+        call gswind(WL_GP(wd), OLD_PLT_WIND(LEFT), OLD_PLT_WIND(RIGHT),
+            OLD_PLT_WIND(BOTTOM), OLD_PLT_WIND(TOP))
+
+	# Restore original graphics state.
+	call gsetr (WL_GP(wd), G_PLWIDTH, old_plwidth)
+	call gsetr (WL_GP(wd), G_TXSIZE, old_txsize)
+	call gsetr (WL_GP(wd), G_TXUP, old_txup)
+	call gseti (WL_GP(wd), G_CLIP, old_clip)
+	call gseti (WL_GP(wd), G_PLTYPE, old_pltype)
+	call gseti (WL_GP(wd), G_TXQUALITY, old_txquality)
+	call gseti (WL_GP(wd), G_WCS, old_wcs)
+
+	call sfree (sp)
+end
+
+
+# WL_GRAPHICS -- Setup the graphics device appropriate for the occasion.
+
+procedure wl_graphics (wd)
+
+pointer wd		  # I: the WCSLAB descriptor
+
+real	relative_size, vl, vr, vb, vt
+real	ggetr()
+
+begin
+	# Setup a graphics WCS that mimics the NDC coordinate WCS,
+	# but with clipping.
+	call ggview (WL_GP(wd), vl, vr, vb, vt)
+	call gseti (WL_GP(wd), G_WCS, WL_NDC_WCS(wd))
+	call gsview (WL_GP(wd), vl, vr, vb, vt)
+	call gswind (WL_GP(wd), vl, vr, vb, vt)
+	call gseti (WL_GP(wd), G_CLIP, YES)
+
+	# Setup the initial viewport.
+	WL_NEW_VIEW(wd,LEFT) = vl
+	WL_NEW_VIEW(wd,RIGHT) = vr
+	WL_NEW_VIEW(wd,BOTTOM) = vb
+	WL_NEW_VIEW(wd,TOP) = vt
+
+	# Setup some parameters.
+	call gseti (WL_GP(wd), G_PLTYPE, GL_SOLID)
+	call gsetr (WL_GP(wd), G_PLWIDTH, LINE_SIZE)
+
+	# Draw the edges of the viewport.
+	call gamove (WL_GP(wd), vl, vb)
+	call gadraw (WL_GP(wd), vr, vb)
+	call gadraw (WL_GP(wd), vr, vt)
+	call gadraw (WL_GP(wd), vl, vt)
+	call gadraw (WL_GP(wd), vl, vb)
+
+	# Determine the tick mark size.
+	relative_size = max (abs (vr - vl), abs (vt - vb ))
+	WL_MAJ_TICK_SIZE(wd) = relative_size * WL_MAJ_TICK_SIZE(wd)
+	WL_MIN_TICK_SIZE(wd) = relative_size * WL_MIN_TICK_SIZE(wd)
+
+	# Determine various character sizes.
+	WL_TITLE_SIZE(wd) = WL_TITLE_SIZE(wd) * relative_size
+	WL_AXIS_TITLE_SIZE(wd) = WL_AXIS_TITLE_SIZE(wd) * relative_size
+	WL_LABEL_SIZE(wd) = WL_LABEL_SIZE(wd) * relative_size
+
+	# Now setup the general plotting WCS.
+	call gseti (WL_GP(wd), G_WCS, WL_PLOT_WCS(WD))
+	call gsview (WL_GP(wd), vl, vr, vb, vt)
+	vl = real (WL_SCREEN_BOUNDARY(wd,LEFT))
+	vr = real (WL_SCREEN_BOUNDARY(wd,RIGHT))
+	vb = real (WL_SCREEN_BOUNDARY(wd,BOTTOM))
+	vt = real (WL_SCREEN_BOUNDARY(wd,TOP))
+	call gswind (WL_GP(wd), vl, vr, vb, vt)
+	call gseti (WL_GP(wd), G_CLIP, YES)
+
+	# Set some characteristics of the graphics device.
+	call gseti (WL_GP(wd), G_TXQUALITY, GT_HIGH)
+	call gseti (WL_GP(wd), G_CLIP, YES)
+	call gsetr (WL_GP(wd), G_PLWIDTH, LINE_SIZE)
+
+	# Determine the number of segments a "line" should consist of.
+	WL_LINE_SEGMENTS(wd) = int (min (ggetr (WL_GP(wd), "xr"), 
+	    ggetr (WL_GP(wd), "yr")) / 5)
+end
diff --git a/pkg/utilities/nttools/stxtools/word.x b/pkg/utilities/nttools/stxtools/word.x
new file mode 100644
index 00000000..c6b33191
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/word.x
@@ -0,0 +1,229 @@
+# Definition of delimeters used in parsing words
+
+define	IS_DELIM	(($1) <= ' ' || ($1) == ',')
+define	NOT_DELIM	(($1) > ' ' && ($1) != ',')
+
+.help
+.nf_________________________________________________________________________
+
+The procedures in this file perform simple processing on lists of
+words.  These procedures count the number of words in a list, fetch
+the next word in a list, find the n-th word in a list, check for an
+exact match between a word and a list of words.  A word is any group
+of contiguous characters which are neither whitespace or commas. The
+definition of whitespace is anomalous, it includes any character whose
+integer value is less than or equal to a blank. Note that words cannot
+be delimeted by quotes and that escape processing is not done.
+
+.endhelp____________________________________________________________________
+
+#______________________________HISTORY______________________________________
+#
+# B.Simon	20-Apr-1990	Modified versions of CDBS routines adb_*tok.x
+#
+#___________________________________________________________________________
+
+# WORD_COUNT -- Return the number of words in a list of words
+
+int procedure word_count (list)
+
+char	list[ARB]	# i: List of words
+#--
+char	ch
+int	count, ic
+
+begin
+
+	# The absolute value of count is the number of the current
+	# word of the list, count is negative if we are currently
+	# between words.
+
+	count = 0
+
+	# Loop over all characters in the list
+
+	for (ic = 1 ; list[ic] != EOS; ic = ic + 1) {
+	    ch = list[ic]
+
+	    if (count > 0) {
+		if (IS_DELIM(ch))
+		    count = - count
+
+	    } else if (NOT_DELIM(ch)) {
+		count = - count + 1
+	    }
+	}
+
+	return (abs(count))
+end
+
+# WORD_FETCH -- Retrieve next word from string
+
+int procedure word_fetch (str, ic, word, maxch)
+
+char	str[ARB]	#  i: String containing words
+int	ic		# io: Index of starting character
+char	word[ARB]	#  o: Word string
+int	maxch		#  i: Declared length of output string
+#--
+char	ch
+int	jc
+
+begin
+	# Skip leading whitespace or commas. Don't go past string terminator.
+
+	for (ch = str[ic]; IS_DELIM(ch); ch = str[ic]) {
+	    if (ch == EOS)
+		break
+	    ic = ic + 1
+	}
+
+	# Copy characters to word. End when maxch is reached, or
+	# when commas, whitespace, or EOS is found
+
+	for (jc = 1; jc <= maxch; jc = jc + 1) {
+	    if (IS_DELIM(ch))
+		break
+
+	    word[jc] = ch
+	    ic = ic + 1
+	    ch = str[ic]
+	}
+	word[jc] = EOS
+
+	# If loop is terminated because of maxch, eat remaining characters
+	# in field
+
+	while (NOT_DELIM(ch)) {
+	    ic = ic + 1
+	    ch = str[ic]
+	}
+
+	# Return number of characters in word
+
+	return (jc - 1)
+
+end
+
+# WORD_FIND -- Find the i-th word in a list of words
+
+int procedure word_find (index, list, word, maxch)
+
+int	index		# i: Index to word within list
+char	list[ARB]	# i: List of words
+char	word[ARB]	# o: Word returned by this procedure
+int	maxch		# i: Declared length of output string
+#--
+char	ch
+int	count, ic, jc
+
+begin
+	# The absolute value of count is the number of the current
+	# word of the list, count is negative if we are currently
+	# between words
+
+	count = 0
+
+	# Loop until i-th word is reached in list
+
+	for (ic = 1 ; count < index && list[ic] != EOS; ic = ic + 1) {
+	    ch = list[ic]
+
+	    if (count > 0) {
+		if (IS_DELIM(ch))
+		    count = - count
+
+	    } else if (NOT_DELIM(ch)) {
+		count = - count + 1
+	    }
+	}
+
+	# If index is out of bounds, return zero
+
+	if (index < 0 || index > count)
+	    return (0)
+
+	jc = 1
+	for (ic = ic - 1; NOT_DELIM(list[ic]); ic = ic + 1) {
+	    if (jc > maxch)
+		break
+
+	    word[jc] = list[ic]
+	    jc = jc + 1
+	}
+	word[jc] = EOS
+
+	# Return number of characters in word
+
+	return (jc - 1)
+end
+
+# WORD_MATCH -- Return number of the word in the list which matches the word
+
+int procedure word_match (word, list)
+
+char	word[ARB]	# i: Word to be matched
+char	list[ARB]	# i: List of words
+#--
+char	ch
+int	match, inword, ic, jc
+
+begin
+	# The absolute value of inword is the number of the current
+	# word of the list, inword is negative if we are currently
+	# between words in the list
+
+	jc = 1
+	match = 0
+	inword = 0
+
+	# Loop over all characters in the list
+
+	for (ic = 1 ; list[ic] != EOS; ic = ic + 1) {
+	    ch = list[ic]
+
+	    # First case: current character is within a word
+
+	    if (inword > 0) {
+
+		# Check for conversion to second case
+
+		if (IS_DELIM(ch)) {
+		    inword = - inword
+
+		    # Simultaneous end of word in list and word 
+		    # means a match has been found
+
+		    if (match != 0 && word[jc] == EOS)
+			break
+		    else
+			match = 0
+
+		} else if (match != 0) {
+
+		    # Check for match between list and word
+
+		    if (ch == word[jc])
+			jc = jc + 1
+		    else 
+			match = 0
+		}
+
+	    # Second case: current character is between words
+	    # Check for conversion to first case
+
+	    } else if (NOT_DELIM(ch)) {
+		jc = 1
+		ic = ic - 1
+		inword = - inword + 1
+		match = inword
+	    }
+	}
+
+	# If list ended before word, there was no match
+
+	if (word[jc] != EOS)
+	    match = 0
+
+	return (match)
+end
diff --git a/pkg/utilities/nttools/stxtools/xtwcs.x b/pkg/utilities/nttools/stxtools/xtwcs.x
new file mode 100644
index 00000000..aa8b2798
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/xtwcs.x
@@ -0,0 +1,1286 @@
+include <imhdr.h>
+include <math.h>
+
+# This file contains the following high-level routines for converting
+# between world coordinates and pixel coordinates:
+#
+# xt_wcs_init		initialize struct for world coordinate system
+# xt_wcs_init_c		initialize from input cdelt, crota, etc
+# xt_wcs_init_cd	initialize from input CD matrix, etc
+# xt_wcs_free		deallocate wcs struct
+# xt_wc_pix		convert from world coordinates to pixel coordinates
+# xt_pix_wc		convert from pixel coordinates to world coordinates
+#
+# Phil Hodge, 27-Sept-1988  Created, based on code by Nelson & Zolt.
+# Phil Hodge, 6-April-1990  CD matrix mult. was transposed in xt_pix_wc.
+# Phil Hodge, 26-July-1991  In xt_e_ctype, change GBS to GLS (global sine).
+
+define	LEN_WCS		136	# size of wcs struct for naxis <= 7
+
+define	W_VALID		Memi[$1]	# coordinates valid, YES or NO?
+define	W_NAXIS		Memi[$1+1]	# number of axes
+define	W_RA_AX		Memi[$1+2]	# which axis is RA?  zero if none
+define	W_DEC_AX	Memi[$1+3]	# which axis is Dec?  zero if none
+define	W_PROJECTION	Memi[$1+4]	# projection type
+
+#   6 is currently not used
+
+#   7 -  55:  full CD matrix (7x7); units = e.g. degrees
+#  56 - 104:  LU decomposition of CD matrix
+# 105 - 111:  index returned by ludcmp for use by lubksb
+# 112 - 118:  reference pixel location
+# 119 - 122:  cosine & sine of declination at the reference pixel
+# 123 - 136:  coordinates at crpix; units = e.g. degrees
+
+define	W_CD		Memr[P2R($1+6 +($2-1)+($3-1)*7)]
+define	W_CDLU		Memr[P2R($1+55 +($2-1)+($3-1)*7)]
+define	W_CDINDX	Memr[P2R($1+104)]		# this is an array of 7
+define	W_CRPIX		Memr[P2R($1+110+$2)]
+define	W_COSDEC	Memd[P2D($1+118)]
+define	W_SINDEC	Memd[P2D($1+120)]
+define	W_CRVAL		Memd[P2D($1+120)+$2]
+
+# Projection types.
+
+define	W_LINEAR	0
+define	W_GNOMONIC	1	# TAN
+define	W_SINE		2	# SIN
+define	W_ARC		3	# ARC
+define	W_NORTH_POLAR	4	# NCP, north celestial pole (Westerbork)
+define	W_STEREOGRAPHIC	5	# STG (conformal)
+define	W_AITOFF	6	# AIT (equal-area)
+define	W_GLOBAL_SINE	7	# GLS (equal-area)
+define	W_MERCATOR	8	# MER (conformal)
+
+
+# xt_wcs_init -- initialize wcs struct
+# This routine allocates space for a structure describing the world
+# coordinate system for an image, fills in the values or defaults, and
+# returns a pointer to that structure.
+
+procedure xt_wcs_init (im, wcs)
+
+pointer im			# i: pointer to image descriptor
+pointer wcs			# o: pointer to world coord system struct
+#--
+real	dummy			# returned by ludcmp and ignored
+int	ira, idec		# index of RA, Dec axes
+int	j, k			# loop indexes
+errchk	xt_load_ctstruct
+
+begin
+	call calloc (wcs, LEN_WCS, TY_STRUCT)
+
+	W_VALID(wcs) = YES			# initial value
+	W_NAXIS(wcs) = IM_NDIM(im)
+
+	call xt_load_wcsstruct (im, wcs)	# get CRVAL, etc from image
+
+	if (W_NAXIS(wcs) >= 2) {
+
+	    ira = W_RA_AX(wcs)
+	    idec = W_DEC_AX(wcs)
+
+	    if (idec > 0) {
+		W_COSDEC(wcs) = cos (DEGTORAD(W_CRVAL(wcs,idec)))
+		W_SINDEC(wcs) = sin (DEGTORAD(W_CRVAL(wcs,idec)))
+	    } else {
+		W_COSDEC(wcs) = 1.d0
+		W_SINDEC(wcs) = 0.d0
+	    }
+
+	    # Copy the CD matrix to W_CDLU, and do the LU decomposition
+	    # on W_CDLU in-place.
+	    do k = 1, IM_MAXDIM
+		do j = 1, IM_MAXDIM
+		    W_CDLU(wcs,j,k) = W_CD(wcs,j,k)
+
+	    iferr {
+		call ludcmp (W_CDLU(wcs,1,1), W_NAXIS(wcs), IM_MAXDIM,
+			W_CDINDX(wcs), dummy)
+	    } then {
+		call mfree (wcs, TY_STRUCT)
+		call error (0, "xt_wcs_init:  cd matrix is singular")
+	    }
+	}
+end
+
+
+# xt_wcs_free -- deallocate wcs struct
+# This routine deallocates space for a wcs structure.
+
+procedure xt_wcs_free (wcs)
+
+pointer wcs		# io: pointer to world coord system struct
+#--
+
+begin
+	if (wcs != NULL)
+	    call mfree (wcs, TY_STRUCT)
+end
+
+
+# xt_wcs_init_c -- initialize wcs struct
+# xt_wcs_init_c and xt_wcs_init_cd allocate space for a structure
+# describing the world coordinate system for an image, fill in the values
+# or defaults, and return a pointer to that structure.  They differ from
+# xt_wcs_init in that these take the coordinate parameters as arguments
+# rather than getting them from the image.
+# xt_wcs_init_c takes cdelt & crota, and xt_wcs_init_cd takes the CD matrix.
+
+procedure xt_wcs_init_c (crval, crpix, cdelt, crota, ctype, naxis, wcs)
+
+double	crval[naxis]		# i: coordinate values at reference pixel
+real	crpix[naxis]		# i: reference pixel
+real	cdelt[naxis]		# i: pixel spacing
+real	crota			# i: rotation angle (if 2-D)
+char	ctype[SZ_CTYPE,naxis]	# i: e.g. "RA---TAN"
+int	naxis			# i: size of arrays
+pointer wcs			# o: pointer to world coord system struct
+#--
+real	dummy			# returned by ludcmp and ignored
+int	ira, idec		# index of RA, Dec axes
+int	j, k			# loop indexes
+errchk	ludcmp
+
+begin
+	do k = 1, naxis
+	    if (cdelt[k] == 0.)
+		call error (0, "xt_wcs_init_c:  zero value of CDELT")
+
+	call calloc (wcs, LEN_WCS, TY_STRUCT)
+
+	W_NAXIS(wcs) = naxis
+	W_VALID(wcs) = YES		# initial value
+
+	# Examine ctype to get ira, idec, proj_type.
+	call xt_e_ctype (ctype, naxis, ira, idec, W_PROJECTION(wcs))
+	W_RA_AX(wcs) = ira
+	W_DEC_AX(wcs) = idec
+
+	do k = 1, naxis {
+	    W_CRVAL(wcs,k) = crval[k]
+	    W_CRPIX(wcs,k) = crpix[k]
+	}
+	do k = naxis+1, IM_MAXDIM {
+	    W_CRVAL(wcs,k) = 0.d0
+	    W_CRPIX(wcs,k) = 1.
+	}
+
+	if (naxis == 1) {
+
+	    W_CD(wcs,1,1) = cdelt[1]
+
+	} else if (naxis >= 2) {
+
+	    if (idec > 0) {
+		W_COSDEC(wcs) = cos (DEGTORAD(W_CRVAL(wcs,idec)))
+		W_SINDEC(wcs) = sin (DEGTORAD(W_CRVAL(wcs,idec)))
+	    } else {
+		W_COSDEC(wcs) = 1.d0
+		W_SINDEC(wcs) = 0.d0
+	    }
+
+	    # Convert cdelt & crota to the CD matrix.
+	    call xt_to_cd (wcs, cdelt, crota, naxis)
+
+	    # Copy the CD matrix, and do the LU decomposition on W_CDLU.
+	    do k = 1, IM_MAXDIM
+		do j = 1, IM_MAXDIM
+		    W_CDLU(wcs,j,k) = W_CD(wcs,j,k)
+
+	    call ludcmp (W_CDLU(wcs,1,1), naxis, IM_MAXDIM,
+			W_CDINDX(wcs), dummy)
+	}
+end
+
+
+# xt_wcs_init_cd -- initialize wcs struct (CD)
+
+procedure xt_wcs_init_cd (crval, crpix, cd, ctype, naxis, wcs)
+
+double	crval[naxis]		# i: coordinate values at reference pixel
+real	crpix[naxis]		# i: reference pixel
+real	cd[naxis,naxis]		# i: CD matrix
+char	ctype[SZ_CTYPE,naxis]	# i: e.g. "RA---TAN"
+int	naxis			# i: size of arrays
+pointer wcs			# o: pointer to world coord system struct
+#--
+real	dummy			# returned by ludcmp and ignored
+int	ira, idec		# index of RA, Dec axes
+int	j, k			# loop indexes
+
+begin
+	call calloc (wcs, LEN_WCS, TY_STRUCT)
+
+	W_NAXIS(wcs) = naxis
+	W_VALID(wcs) = YES		# initial value
+
+	# Examine ctype to get ira, idec, proj_type.
+	call xt_e_ctype (ctype, naxis, ira, idec, W_PROJECTION(wcs))
+	W_RA_AX(wcs) = ira
+	W_DEC_AX(wcs) = idec
+
+	do k = 1, naxis {
+	    W_CRVAL(wcs,k) = crval[k]
+	    W_CRPIX(wcs,k) = crpix[k]
+	}
+	do k = naxis+1, IM_MAXDIM {
+	    W_CRVAL(wcs,k) = 0.d0
+	    W_CRPIX(wcs,k) = 1.
+	}
+
+	if (naxis == 1) {
+
+	    W_CD(wcs,1,1) = cd[1,1]
+
+	} else if (naxis >= 2) {
+
+	    if (idec > 0) {
+		W_COSDEC(wcs) = cos (DEGTORAD(W_CRVAL(wcs,idec)))
+		W_SINDEC(wcs) = sin (DEGTORAD(W_CRVAL(wcs,idec)))
+	    } else {
+		W_COSDEC(wcs) = 1.d0
+		W_SINDEC(wcs) = 0.d0
+	    }
+
+	    # Assign initial values to the CD matrix.
+	    do k = 1, IM_MAXDIM {
+		do j = 1, IM_MAXDIM {
+		    if (j == k) {
+			W_CD(wcs,k,k) = 1.
+			W_CDLU(wcs,k,k) = 1.
+		    } else {
+			W_CD(wcs,j,k) = 0.
+			W_CDLU(wcs,j,k) = 0.
+		    }
+		}
+	    }
+
+	    # Copy the CD matrix, and do the LU decomposition on W_CDLU.
+	    do k = 1, naxis {
+		do j = 1, naxis {
+		    W_CD(wcs,j,k) = cd[j,k]
+		    W_CDLU(wcs,j,k) = cd[j,k]
+		}
+	    }
+
+	    iferr {
+		call ludcmp (W_CDLU(wcs,1,1), naxis, IM_MAXDIM,
+			W_CDINDX(wcs), dummy)
+	    } then {
+		call mfree (wcs, TY_STRUCT)
+		call error (0, "xt_wcs_init_cd:  cd matrix is singular")
+	    }
+	}
+end
+
+# xt_to_cd -- from cdelt & crota to cd matrix
+# This routine computes the CD matrix from CDELT and CROTA.
+
+procedure xt_to_cd (wcs, cdelt, crota, naxis)
+
+pointer wcs			# i: pointer to world coord system struct
+real	cdelt[naxis]		# i: pixel spacing
+real	crota			# i: rotation angle (if 2-D)
+int	naxis			# i: size of arrays
+#--
+real	cosrota, sinrota	# cosine & sine of crota
+real	sign_cdelt[2]		# one, with sign of cdelt1 or cdelt2
+int	ira, idec		# index of RA, Dec axes
+int	j, k			# loop indexes
+
+begin
+	ira = W_RA_AX(wcs)
+	idec = W_DEC_AX(wcs)
+
+	if ( ! IS_INDEFD(crota) ) {
+	    cosrota = cos (DEGTORAD(crota))
+	    sinrota = sin (DEGTORAD(crota))
+	} else {
+	    cosrota = 1.d0
+	    sinrota = 0.d0
+	}
+
+	# Initial values for CD matrix.
+	do k = 1, IM_MAXDIM {
+	    do j = 1, IM_MAXDIM {
+		if (j == k)
+		    W_CD(wcs,k,k) = 1.
+		else
+		    W_CD(wcs,j,k) = 0.
+	    }
+	}
+	do k = 1, naxis
+	    W_CD(wcs,k,k) = cdelt[k]
+
+	if (ira > 0 && idec > 0) {
+
+	    if (cdelt[ira] >= 0.)
+		sign_cdelt[1] = 1.
+	    else
+		sign_cdelt[1] = -1.
+
+	    if (cdelt[idec] >= 0.)
+		sign_cdelt[2] = 1.
+	    else
+		sign_cdelt[2] = -1.
+
+	    W_CD(wcs,ira,ira) = cdelt[ira] * cosrota
+	    W_CD(wcs,ira,idec) = abs (cdelt[idec]) * sign_cdelt[1] * sinrota
+	    W_CD(wcs,idec,ira) = -abs (cdelt[ira]) * sign_cdelt[2] * sinrota
+	    W_CD(wcs,idec,idec) = cdelt[idec] * cosrota
+	}
+end
+
+# xt_e_ctype -- examine ctype
+# Examine each element of the ctype array to find which axes (if any)
+# are RA & Dec (or glon & glat, etc).  Also get the projection type,
+# such as gnomonic, if this was specified in ctype.
+
+procedure xt_e_ctype (ctype, naxis, ra_axis, dec_axis, proj_type)
+
+char	ctype[SZ_CTYPE,naxis]	# i: coordinate type, e.g. "RA---TAN"
+int	naxis			# i: dimension
+int	ra_axis			# o: which axis is RA (or glon, etc)?
+int	dec_axis		# o: which axis is Dec (or glat, etc)?
+int	proj_type		# o: type of projection
+#--
+char	lctype[SZ_CTYPE]	# local copy of an element of ctype
+char	dash			# '-'
+int	k
+int	index			# index of '-' in ctype
+int	strncmp(), strldx()
+
+begin
+	# Assign defaults.
+	ra_axis = 0
+	dec_axis = 0
+	if (naxis == 1)
+	    proj_type = W_LINEAR
+	else
+	    proj_type = W_GNOMONIC
+
+	# Search for "RA", "DEC", etc.
+	do k = 1, naxis {
+	    # Make a local copy of ctype & make sure it's upper case.
+	    call strcpy (ctype[1,k], lctype, SZ_CTYPE)
+	    call strupr (lctype)
+
+	    if (strncmp (lctype, "RA", 2) == 0)
+		ra_axis = k
+	    else if (strncmp (lctype, "DEC", 3) == 0)
+		dec_axis = k
+
+	    else if (strncmp (lctype, "GLON", 4) == 0)
+		ra_axis = k
+	    else if (strncmp (lctype, "LL", 2) == 0)
+		ra_axis = k
+	    else if (strncmp (lctype, "UU", 2) == 0)
+		ra_axis = k
+	    else if (strncmp (lctype, "ELON", 4) == 0)
+		ra_axis = k
+
+	    else if (strncmp (lctype, "GLAT", 4) == 0)
+		dec_axis = k
+	    else if (strncmp (lctype, "MM", 2) == 0)
+		dec_axis = k
+	    else if (strncmp (lctype, "VV", 2) == 0)
+		dec_axis = k
+	    else if (strncmp (lctype, "ELAT", 4) == 0)
+		dec_axis = k
+	}
+
+	if (ra_axis > 0)
+	    k = ra_axis
+	else if (dec_axis > 0)
+	    k = dec_axis
+	else
+	    k = 0
+
+	# If at least one of the axes is like RA or Dec, check to see
+	# whether a projection type was specified.
+	if (k > 0) {
+	    dash = '-'
+	    index = strldx (dash, lctype)
+	    if (index > 0) {
+		index = index + 1
+		if (strncmp (lctype[index], "TAN", 3) == 0)
+		    proj_type = W_GNOMONIC
+		else if (strncmp (lctype[index], "SIN", 3) == 0)
+		    proj_type = W_SINE
+		else if (strncmp (lctype[index], "ARC", 3) == 0)
+		    proj_type = W_ARC
+		else if (strncmp (lctype[index], "NCP", 3) == 0)
+		    proj_type = W_NORTH_POLAR
+		else if (strncmp (lctype[index], "STG", 3) == 0)
+		    proj_type = W_STEREOGRAPHIC
+		else if (strncmp (lctype[index], "AIT", 3) == 0)
+		    proj_type = W_AITOFF
+		else if (strncmp (lctype[index], "GLS", 3) == 0)
+		    proj_type = W_GLOBAL_SINE
+		else if (strncmp (lctype[index], "MER", 3) == 0)
+		    proj_type = W_MERCATOR
+	    }
+	}
+end
+
+
+define	SZ_PNAME	8
+
+# xt_load_wcsstruct -- load coordinate information
+# Get the coordinate information from the image, and load
+# that info into the wcs structure.
+
+procedure xt_load_wcsstruct (im, wcs)
+
+pointer im		# i: pointer to image header struct
+pointer wcs		# i: pointer to world coord system struct
+#--
+char	pname[SZ_PNAME]
+char	ctype[SZ_CTYPE,IM_MAXDIM]
+int	naxis, iax		# dimension of image; loop index for axis
+bool	cdm_found		# true if CD matrix present in image
+int	imaccf()
+double	imgetd()
+real	imgetr()
+errchk	imgstr, imgetd, imgetr, xt_g_cd_matrix, xt_c_cd_matrix
+
+begin
+	naxis = IM_NDIM(im)
+
+	# Get the coordinate info.  If anything is missing set W_VALID to NO.
+	do iax = 1, naxis {
+
+	    # CTYPE for each axis.
+	    call sprintf (pname, SZ_PNAME, "ctype%d")
+		call pargi (iax)
+	    if (imaccf (im, pname) == YES) {
+		call imgstr (im, pname, ctype[1,iax], SZ_CTYPE)
+	    } else {
+		call strcpy ("PIXEL", ctype[1,iax], SZ_CTYPE)
+		W_VALID(wcs) = NO
+	    }
+
+	    # CRVAL for each axis
+	    call sprintf (pname, SZ_PNAME, "crval%d")
+		call pargi (iax)
+	    if (imaccf (im, pname) == YES) {
+		W_CRVAL(wcs,iax) = imgetd (im, pname)
+	    } else {
+		W_CRVAL(wcs,iax) = 0.d0
+		W_VALID(wcs) = NO
+	    }
+
+	    # CRPIX for each axis
+	    call sprintf (pname, SZ_PNAME, "crpix%d")
+		call pargi (iax)
+	    if (imaccf (im, pname) == YES) {
+		W_CRPIX(wcs,iax) = imgetr (im, pname)
+	    } else {
+		W_CRPIX(wcs,iax) = 1.
+		W_VALID(wcs) = NO
+	    }
+	}
+	# Assign reasonable values to the unused elements.
+	do iax = naxis+1, IM_MAXDIM {
+	    W_CRVAL(wcs,iax) = 0.d0
+	    W_CRPIX(wcs,iax) = 1.
+	}
+
+	# Examine ctype array.
+	call xt_e_ctype (ctype, naxis,
+		W_RA_AX(wcs), W_DEC_AX(wcs), W_PROJECTION(wcs))
+
+	# First try to get the CD matrix, and if it isn't there
+	# get CDELT and CROTA and convert to CD.
+
+	call xt_g_cd_matrix (im, wcs, naxis, cdm_found)
+
+	if ( ! cdm_found )
+	    call xt_c_cd_matrix (im, wcs, naxis)
+end
+
+
+# xt_g_cd_matrix -- get CD matrix
+# If the CD matrix is present, get the values and place them into the
+# wcs structure.  Note that we assume that if *any* of the CD matrix
+# parameters are there, they are *all* there.
+
+define	TOLER	1.e-5
+
+procedure xt_g_cd_matrix (im, wcs, naxis, cdm_found)
+
+pointer	im			# i: image pointer
+pointer wcs			# i: pointer to wcs structure
+int	naxis			# i: number of axes in image
+bool	cdm_found		# o: true if CD matrix found
+#--
+real	cd_matrix[IM_MAXDIM,IM_MAXDIM]	# the CD matrix
+char	pname[SZ_PNAME]
+int	i, j
+int	imaccf()
+real	imgetr()
+errchk	imgetr
+
+begin
+	# This is reset below if any element of the CD matrix is found.
+	cdm_found = false
+
+	# Assign default values.
+	do j = 1, IM_MAXDIM
+	    do i= 1, IM_MAXDIM
+		if (i == j)
+		    cd_matrix[i,j] = 1.
+		else
+		    cd_matrix[i,j] = 0.
+
+	# Get each element of the CD matrix.
+	do j = 1, naxis {
+	    do i = 1, naxis {
+		call sprintf (pname, SZ_PNAME, "cd%d_%d")
+		    call pargi (i)
+		    call pargi (j)
+		if (imaccf (im, pname) == YES) {
+		    cd_matrix[i,j] = imgetr (im, pname)
+		    cdm_found = true
+		}
+	    }
+	}
+
+	# Copy to the wcs structure.
+	do j = 1, IM_MAXDIM
+	    do i = 1, IM_MAXDIM
+		W_CD(wcs,i,j) = cd_matrix[i,j]
+end
+
+
+# xt_c_cd_matrix -- create CD matrix
+# If the CD matrix is not present, get the values of CDELT & CROTA,
+# convert to the CD matrix, and store the values in the wcs structure.
+# Since this is called after trying unsuccessfully to get the CD matrix,
+# if cdelt or crota is not present W_VALID will be reset to NO.
+
+procedure xt_c_cd_matrix (im, wcs, naxis)
+
+pointer	im			# i: image pointer
+pointer wcs			# i: pointer to wcs structure
+int	naxis			# i: number of axes in image
+#--
+char	pname[SZ_PNAME]		# parameter name (e.g. "cdelt1")
+real	cdelt[IM_MAXDIM]	# pixel spacing
+real	crota			# rotation angle in degrees
+int	k			# loop index for axis
+int	imaccf()
+real	imgetr()
+errchk	imgetr
+
+begin
+	do k = 1, naxis {
+
+	    # CDELT for each axis.
+	    call sprintf (pname, SZ_PNAME, "cdelt%d")
+		call pargi (k)
+	    if (imaccf (im, pname) == YES) {
+		cdelt[k] = imgetr (im, pname)
+		if (cdelt[k] == 0.)
+		    call error (0, "xt_c_cd_matrix:  cdelt is zero")
+	    } else {
+		cdelt[k] = 1.
+		W_VALID(wcs) = NO
+	    }
+	}
+
+	# For a 1-D image, assign CD1_1 and return.
+	if (naxis == 1) {
+	    W_CD(wcs,1,1) = cdelt[1]
+	    return
+	}
+
+	# CROTA (only one).
+	call strcpy ("crota1", pname, SZ_PNAME)
+	if (imaccf (im, pname) == YES) {
+	    crota = imgetr (im, pname)
+	} else {
+	    crota = 0.
+	    W_VALID(wcs) = NO
+	}
+
+	# Compute CD matrix from CDELT & CROTA.
+	call xt_to_cd (wcs, cdelt, crota, naxis)
+end
+
+
+# xt_wc_pix -- wcs to pixels
+# This routine converts world coordinates to pixel coordinates.
+#
+# In the 1-D case, CRVAL is subtracted from the coordinate, the
+# result is divided by CDELT (same as CD1_1), and CRPIX is added.
+#
+# For 2-D or higher dimension, if two of the axes are like RA and Dec,
+# the input coordinates are converted to standard coordinates Xi
+# and Eta.  The (Xi, Eta) vector is then multiplied on the left by
+# the inverse of the CD matrix, and CRPIX is added.
+# The units for axes like Ra & Dec are degrees, not hours or radians.
+# For linear axes the conversion is the same as for 1-D.
+
+procedure xt_wc_pix (wcs, phys, pix, naxis)
+
+pointer wcs		# i: pointer to world coord system struct
+double	phys[naxis]	# i: physical (world) coordinates (e.g. degrees)
+real	pix[naxis]	# o: pixel coordinates
+int	naxis		# i: size of arrays
+#--
+double	delta_ra		# RA of object - RA at reference pixel
+double	dra_r, dec_r		# delta_ra & declination in radians
+double	xi_r, eta_r		# xi & eta in radians
+real	dphys[IM_MAXDIM]	# phys coord - reference coord
+int	ira, idec		# index of RA, Dec axes
+int	k			# loop index
+errchk	xt_wp_ncp, xt_wp_mer
+
+begin
+	do k = 1, naxis
+	    dphys[k] = phys[k] - W_CRVAL(wcs,k)
+
+	if (naxis == 1) {
+
+	    pix[1] = dphys[1] / W_CD(wcs,1,1) + W_CRPIX(wcs,1)
+
+	} else {
+
+	    ira = W_RA_AX(wcs)
+	    idec = W_DEC_AX(wcs)
+
+	    # Convert RA & Dec to Xi & Eta (standard coordinates).
+	    if (ira > 0 && idec > 0) {
+
+		delta_ra = phys[ira] - W_CRVAL(wcs,ira)		# double prec
+		dra_r = DEGTORAD (delta_ra)
+		dec_r = DEGTORAD (phys[idec])
+
+		switch (W_PROJECTION(wcs)) {
+		case W_GNOMONIC:
+		    call xt_wp_tan (wcs, dra_r, dec_r, xi_r, eta_r)
+		case W_SINE:
+		    call xt_wp_sin (wcs, dra_r, dec_r, xi_r, eta_r)
+		case W_ARC:
+		    call xt_wp_arc (wcs, dra_r, dec_r, xi_r, eta_r)
+		case W_NORTH_POLAR:
+		    call xt_wp_ncp (wcs, dra_r, dec_r, xi_r, eta_r)
+		case W_STEREOGRAPHIC:
+		    call xt_wp_stg (wcs, dra_r, dec_r, xi_r, eta_r)
+		case W_AITOFF:
+		    call xt_wp_ait (wcs, dra_r, dec_r, xi_r, eta_r)
+		case W_GLOBAL_SINE:
+		    call xt_wp_gls (wcs, dra_r, dec_r, xi_r, eta_r)
+		case W_MERCATOR:
+		    call xt_wp_mer (wcs, dra_r, dec_r, xi_r, eta_r)
+		}
+
+		dphys[ira] = RADTODEG (xi_r)		# xi, eta in degrees
+		dphys[idec] = RADTODEG (eta_r)
+	    }
+
+	    # Use LU backsubstitution to get pixel coords from physical coords.
+	    call lubksb (W_CDLU(wcs,1,1), naxis, IM_MAXDIM,
+			W_CDINDX(wcs), dphys)	# dphys is modified in-place
+	    do k = 1, naxis
+		pix[k] = dphys[k] + W_CRPIX(wcs,k)	# copy to output
+	}
+end
+
+
+# xt_pix_wc -- pixels to wcs
+# This routine converts pixel coordinates to world coordinates.
+#
+# In the 1-D case, CRPIX is subtracted from the pixel coordinate,
+# the result is multiplied by CDELT (same as CD1_1), and CRVAL is added.
+#
+# For 2-D or higher dimension, CRPIX is subtracted, and the result is
+# multiplied on the left by the CD matrix.  If two of the axes are like
+# RA and Dec, the pixel coordinates are converted to standard coordinates
+# Xi and Eta.  The (xi, eta) vector is then converted to differences
+# between RA and Dec and CRVAL, and then CRVAL is added to each coordinate.
+
+procedure xt_pix_wc (wcs, pix, phys, naxis)
+
+pointer wcs		# i: pointer to world coord system struct
+real	pix[naxis]	# i: pixel coordinates
+double	phys[naxis]	# o: physical (world) coordinates
+int	naxis		# i: size of arrays
+#--
+double	dpix[IM_MAXDIM]		# pix coord - crpix
+double	sum			# for matrix multiplication
+double	dra_r, dec_r		# delta_ra & declination in radians
+double	xi_r, eta_r		# xi & eta in radians
+int	ira, idec		# index of RA, Dec axes
+int	j, k			# loop indexes
+
+begin
+	do k = 1, naxis
+	    dpix[k] = pix[k] - W_CRPIX(wcs,k)
+
+	if (naxis == 1) {
+
+	    phys[1] = dpix[1] * W_CD(wcs,1,1) + W_CRVAL(wcs,1)
+
+	} else {
+
+	    do j = 1, naxis {
+		sum = 0.d0
+		do k = 1, naxis
+		    sum = sum + W_CD(wcs,j,k) * dpix[k]
+		phys[j] = sum
+	    }
+
+	    ira = W_RA_AX(wcs)
+	    idec = W_DEC_AX(wcs)
+
+	    # Convert Xi & Eta (standard coordinates) to RA & Dec.
+	    if (ira > 0 && idec > 0) {
+		xi_r = DEGTORAD (phys[ira])
+		eta_r = DEGTORAD (phys[idec])
+
+		switch (W_PROJECTION(wcs)) {
+		case W_GNOMONIC:
+		    call xt_pw_tan (wcs, xi_r, eta_r, dra_r, dec_r)
+		case W_SINE:
+		    call xt_pw_sin (wcs, xi_r, eta_r, dra_r, dec_r)
+		case W_ARC:
+		    call xt_pw_arc (wcs, xi_r, eta_r, dra_r, dec_r)
+		case W_NORTH_POLAR:
+		    call xt_pw_ncp (wcs, xi_r, eta_r, dra_r, dec_r)
+		case W_STEREOGRAPHIC:
+		    call xt_pw_stg (wcs, xi_r, eta_r, dra_r, dec_r)
+		case W_AITOFF:
+		    call xt_pw_ait (wcs, xi_r, eta_r, dra_r, dec_r)
+		case W_GLOBAL_SINE:
+		    call xt_pw_gls (wcs, xi_r, eta_r, dra_r, dec_r)
+		case W_MERCATOR:
+		    call xt_pw_mer (wcs, xi_r, eta_r, dra_r, dec_r)
+		}
+
+		phys[idec] = RADTODEG (dec_r)
+		phys[ira] = RADTODEG (dra_r) + W_CRVAL(wcs,ira)
+		if (phys[ira] < 0.d0)
+		    phys[ira] = phys[ira] + 360.d0
+	    }
+	    do k = 1, naxis
+		if (k != ira && k != idec)
+		    phys[k] = phys[k] + W_CRVAL(wcs,k)
+	}
+end
+
+
+# xt_wp_tan -- convert from ra & dec using gnomonic projection
+
+procedure xt_wp_tan (wcs, dra_r, dec_r, xi_r, eta_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	dra_r		# i: RA of object - RA at reference pixel (radians)
+double	dec_r		# i: declination of object (radians)
+double	xi_r		# o: standard coordinate (radians)
+double	eta_r		# o: standard coordinate (radians)
+#--
+double	cosdra, sindra	# cos & sin of dra_r
+double	cosdec, sindec	# cos & sin of object declination
+double	cosdist		# cos of dist from ref pixel to object
+
+begin
+	cosdra = cos (dra_r)
+	sindra = sin (dra_r)
+
+	cosdec = cos (dec_r)
+	sindec = sin (dec_r)
+
+	cosdist = sindec * W_SINDEC(wcs) + cosdec * W_COSDEC(wcs) * cosdra
+
+	xi_r = cosdec * sindra / cosdist
+	eta_r = (sindec * W_COSDEC(wcs) -
+			cosdec * W_SINDEC(wcs) * cosdra) / cosdist
+end
+
+
+# xt_pw_tan -- convert to ra & dec using gnomonic projection
+# In rectangular coordinates the vector (1, xi, eta) points toward
+# the object; the origin is the observer's location, the x-axis points
+# toward the reference pixel, the y-axis is in the direction of increasing
+# right ascension, and the z-axis is in the direction of increasing
+# declination.  The coordinate system is then rotated by the declination so
+# the x-axis passes through the equator at the RA of the reference pixel;
+# the components of the vector in this coordinate system are used to
+# compute (RA - reference_RA) and declination.
+
+procedure xt_pw_tan (wcs, xi_r, eta_r, dra_r, dec_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	xi_r		# i: standard coordinate (radians)
+double	eta_r		# i: standard coordinate (radians)
+double	dra_r		# o: RA of object - RA at reference pixel (radians)
+double	dec_r		# o: declination of object (radians)
+#--
+double	x, y, z		# vector (not unit length) pointing toward object
+
+begin
+	# Rotate the rectangular coordinate system of the vector (1, xi, eta)
+	# by the declination so the x-axis will pass through the equator.
+	x = W_COSDEC(wcs) - eta_r * W_SINDEC(wcs)
+	y = xi_r
+	z = W_SINDEC(wcs) + eta_r * W_COSDEC(wcs)
+
+	if (x == 0.d0 && y == 0.d0)
+	    dra_r = 0.d0
+	else
+	    dra_r = atan2 (y, x)
+	dec_r = atan2 (z, sqrt (x*x + y*y))
+end
+
+
+# xt_wp_sin -- convert from ra & dec using sine projection
+#
+# Reference:  AIPS Memo No. 27 by Eric W. Greisen
+
+procedure xt_wp_sin (wcs, dra_r, dec_r, xi_r, eta_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	dra_r		# i: RA of object - RA at reference pixel (radians)
+double	dec_r		# i: declination of object (radians)
+double	xi_r		# o: standard coordinate (radians)
+double	eta_r		# o: standard coordinate (radians)
+#--
+double	cosdra, sindra	# cos & sin of delta_ra
+double	cosdec, sindec	# cos & sin of object declination
+
+begin
+	cosdra = cos (dra_r)
+	sindra = sin (dra_r)
+
+	cosdec = cos (dec_r)
+	sindec = sin (dec_r)
+
+	xi_r = cosdec * sindra
+	eta_r = sindec * W_COSDEC(wcs) - cosdec * W_SINDEC(wcs) * cosdra
+end
+
+
+# xt_pw_sin -- convert to ra & dec using sine projection
+# In rectangular coordinates the vector (v1, xi, eta), where
+# v1 = sqrt (1 - xi**2 - eta**2), is the location of the object on the
+# unit celestial sphere.  The x-axis points toward the reference pixel,
+# the y-axis is in the direction of increasing right ascension, and the
+# z-axis is in the direction of increasing declination.  The coordinate
+# system is then rotated (around the y-axis) by the declination so the
+# x-axis passes through the equator at the RA of the reference pixel;
+# the components of the vector in this coordinate system are used to
+# compute (RA - reference_RA) and declination.
+
+procedure xt_pw_sin (wcs, xi_r, eta_r, dra_r, dec_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	xi_r		# i: standard coordinate (radians)
+double	eta_r		# i: standard coordinate (radians)
+double	dra_r		# o: RA of object - RA at reference pixel (radians)
+double	dec_r		# o: declination of object (radians)
+#--
+double	v1		# x component of unit vector
+double	x, y, z		# unit vector with x[1] pointing toward equator
+
+begin
+	v1 = sqrt (1.d0 - xi_r*xi_r - eta_r*eta_r)
+
+	# Rotate the rectangular coordinate system of the vector (v1, xi, eta)
+	# by the declination so the x-axis will pass through the equator.
+	x = v1 * W_COSDEC(wcs) - eta_r * W_SINDEC(wcs)
+	y = xi_r
+	z = v1 * W_SINDEC(wcs) + eta_r * W_COSDEC(wcs)
+
+	if (x == 0.d0 && y == 0.d0)
+	    dra_r = 0.d0
+	else
+	    dra_r = atan2 (y, x)
+	dec_r = atan2 (z, sqrt (x*x + y*y))
+end
+
+
+# xt_wp_arc -- convert from ra & dec using arc projection
+#
+# Reference:  AIPS Memo No. 27 by Eric W. Greisen
+
+procedure xt_wp_arc (wcs, dra_r, dec_r, xi_r, eta_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	dra_r		# i: RA of object - RA at reference pixel (radians)
+double	dec_r		# i: declination of object (radians)
+double	xi_r		# o: standard coordinate (radians)
+double	eta_r		# o: standard coordinate (radians)
+#--
+double	cosdra, sindra	# cos & sin of delta_ra
+double	cosdec, sindec	# cos & sin of object declination
+double	theta		# distance (radians) from ref pixel to object
+double	r		# theta / sin (theta)
+
+begin
+	cosdra = cos (dra_r)
+	sindra = sin (dra_r)
+
+	cosdec = cos (dec_r)
+	sindec = sin (dec_r)
+
+	theta = acos (sindec * W_SINDEC(wcs) + cosdec * W_COSDEC(wcs) * cosdra)
+	if (theta == 0.d0)
+	    r = 1.d0
+	else
+	    r = theta / sin (theta)
+
+	xi_r = r * cosdec * sindra
+	eta_r = r * (sindec * W_COSDEC(wcs) - cosdec * W_SINDEC(wcs) * cosdra)
+end
+
+
+# xt_pw_arc -- convert to ra & dec using arc projection
+# The rectangular coordinates of the pixel on a unit celestial sphere
+# are computed in a coordinate system such that the x-axis points toward
+# the reference pixel, the y-axis is in the direction of increasing right
+# ascension, and the z-axis is in the direction of increasing declination.
+# The coordinate system is then rotated (around the y-axis) by the
+# declination so the x-axis passes through the equator at the RA of the
+# reference pixel; the components of the vector in this coordinate system
+# are used to compute (RA - reference_RA) and declination.
+
+procedure xt_pw_arc (wcs, xi_r, eta_r, dra_r, dec_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	xi_r		# i: standard coordinate (radians)
+double	eta_r		# i: standard coordinate (radians)
+double	dra_r		# o: RA of object - RA at reference pixel (radians)
+double	dec_r		# o: declination of object (radians)
+#--
+double	theta		# arc length, i.e. sqrt (xi**2 + eta**2)
+double	v[3]		# unit vector with v[1] pointing toward ref pixel
+double	x, y, z		# vector with x[1] pointing toward equator
+
+begin
+	theta = sqrt (xi_r*xi_r + eta_r*eta_r)
+	if (theta == 0.d0) {
+	    v[1] = 1.d0
+	    v[2] = 0.d0
+	    v[3] = 0.d0
+	} else {
+	    v[1] = cos (theta)
+	    v[2] = sin (theta) / theta * xi_r
+	    v[3] = sin (theta) / theta * eta_r
+	}
+
+	# Rotate the rectangular coordinate system of the vector v by the
+	# declination so the x-axis will pass through the equator.
+	x = v[1] * W_COSDEC(wcs) - v[3] * W_SINDEC(wcs)
+	y = v[2]
+	z = v[1] * W_SINDEC(wcs) + v[3] * W_COSDEC(wcs)
+
+	if (x == 0.d0 && y == 0.d0)
+	    dra_r = 0.d0
+	else
+	    dra_r = atan2 (y, x)
+	dec_r = atan2 (z, sqrt (x*x + y*y))
+end
+
+
+# xt_wp_ncp -- convert from ra & dec using ncp projection
+#
+# References:
+#	AIPS Memo No. 27 by Eric W. Greisen
+#	Data Processing for the Westerbork Synthesis Radio Telescope
+#		by W. N. Brouw
+
+procedure xt_wp_ncp (wcs, dra_r, dec_r, xi_r, eta_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	dra_r		# i: RA of object - RA at reference pixel (radians)
+double	dec_r		# i: declination of object (radians)
+double	xi_r		# o: standard coordinate (radians)
+double	eta_r		# o: standard coordinate (radians)
+#--
+double	cosdra, sindra	# cos & sin of delta_ra
+double	cosdec		# cos of object declination
+
+begin
+	if (W_SINDEC(wcs) == 0.)
+	    call error (1, "NCP projection:  dec is zero")
+
+	cosdra = cos (dra_r)
+	sindra = sin (dra_r)
+
+	cosdec = cos (dec_r)
+
+	xi_r = - cosdec * sindra
+	eta_r = (W_COSDEC(wcs) - cosdec * cosdra) / W_SINDEC(wcs)
+end
+
+
+# xt_pw_ncp -- convert to ra & dec using ncp projection
+#
+# References:
+#	AIPS Memo No. 27 by Eric W. Greisen
+#	Data Processing for the Westerbork Synthesis Radio Telescope
+#		by W. N. Brouw
+
+procedure xt_pw_ncp (wcs, xi_r, eta_r, dra_r, dec_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	xi_r		# i: standard coordinate (radians)
+double	eta_r		# i: standard coordinate (radians)
+double	dra_r		# o: RA of object - RA at reference pixel (radians)
+double	dec_r		# o: declination of object (radians)
+#--
+double	temp
+
+begin
+	temp = W_COSDEC(wcs) - eta_r * W_SINDEC(wcs)
+
+	dra_r = atan2 (-xi_r, temp)
+	dec_r = acos (temp / cos (dra_r))
+	if (W_SINDEC(wcs) < 0)
+	    dec_r = -dec_r
+end
+
+
+# xt_wp_gls -- convert from ra & dec using global-sine projection
+#
+# Reference:  AIPS Memo No. 46 by Eric W. Greisen
+
+procedure xt_wp_gls (wcs, dra_r, dec_r, xi_r, eta_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	dra_r		# i: RA of object - RA at reference pixel (radians)
+double	dec_r		# i: declination of object (radians)
+double	xi_r		# o: standard coordinate (radians)
+double	eta_r		# o: standard coordinate (radians)
+#--
+double	cosdec		# cos of object declination
+double	temp		# delta RA
+int	idec		# which axis is declination axis
+
+begin
+	cosdec = cos (dec_r)
+	idec = W_DEC_AX(wcs)
+
+	temp = dra_r
+
+	# Put dra_r on the interval (-180,+180] degrees.
+	if (temp <= -PI)
+	    temp = temp + TWOPI
+	if (temp > PI)
+	    temp = temp - TWOPI
+
+	xi_r = temp * cosdec
+
+	if (idec > 0)
+	    eta_r = dec_r - DEGTORAD (W_CRVAL(wcs,idec))
+	else
+	    eta_r = dec_r
+end
+
+
+# xt_pw_gls -- convert to ra & dec using global-sine projection
+#
+# Reference:  AIPS Memo No. 46 by Eric W. Greisen
+
+procedure xt_pw_gls (wcs, xi_r, eta_r, dra_r, dec_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	xi_r		# i: standard coordinate (radians)
+double	eta_r		# i: standard coordinate (radians)
+double	dra_r		# o: RA of object - RA at reference pixel (radians)
+double	dec_r		# o: declination of object (radians)
+#--
+double	cosdec		# cosine of object declination
+int	idec		# which axis is declination axis
+
+begin
+	idec = W_DEC_AX(wcs)
+	if (idec > 0)
+	    dec_r = eta_r + DEGTORAD (W_CRVAL(wcs,idec))
+	else
+	    dec_r = eta_r
+
+	cosdec = cos (dec_r)
+	if (cosdec > 0.d0)
+	    dra_r = xi_r / cosdec
+	else
+	    dra_r = 0.d0
+end
+
+# xt_wp_stg -- convert from ra & dec using stereographic projection
+#
+# Reference:  AIPS Memo No. 46 by Eric W. Greisen
+
+procedure xt_wp_stg (wcs, dra_r, dec_r, xi_r, eta_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	dra_r		# i: RA of object - RA at reference pixel (radians)
+double	dec_r		# i: declination of object (radians)
+double	xi_r		# o: standard coordinate (radians)
+double	eta_r		# o: standard coordinate (radians)
+#--
+double	cosdra, sindra	# cos & sin of dra_r
+double	cosdec, sindec	# cos & sin of object declination
+double	cosdist		# cos of dist from ref pixel to object
+double	sincos		# sin (theta) * cos (phi)
+
+begin
+	cosdra = cos (dra_r)
+	sindra = sin (dra_r)
+
+	cosdec = cos (dec_r)
+	sindec = sin (dec_r)
+
+	cosdist = sindec * W_SINDEC(wcs) + cosdec * W_COSDEC(wcs) * cosdra
+	sincos = sindec * W_COSDEC(wcs) - cosdec * W_SINDEC(wcs) * cosdra
+
+	xi_r = 2.d0 * cosdec * sindra / (1.d0 + cosdist)
+	eta_r = 2.d0 * sincos / (1.d0 + cosdist)
+end
+
+
+# xt_pw_stg -- convert to ra & dec using stereographic projection
+
+procedure xt_pw_stg (wcs, xi_r, eta_r, dra_r, dec_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	xi_r		# i: standard coordinate (radians)
+double	eta_r		# i: standard coordinate (radians)
+double	dra_r		# o: RA of object - RA at reference pixel (radians)
+double	dec_r		# o: declination of object (radians)
+#--
+double	rho2		# square of distance from reference pixel
+double	scale		# factor to reduce xi, eta to y, z
+double	x, y, z		# unit vector toward object
+double	temp
+
+begin
+	rho2 = xi_r * xi_r + eta_r * eta_r
+
+	x = (4.d0 - rho2) / (4.d0 + rho2)
+	scale = (x + 1.d0) / 2.d0
+
+	y = xi_r * scale
+	z = eta_r * scale
+
+	temp = x * W_COSDEC(wcs) - z * W_SINDEC(wcs)
+	z    = x * W_SINDEC(wcs) + z * W_COSDEC(wcs)
+	x = temp
+
+	if (x == 0.d0 && y == 0.d0)
+	    dra_r = 0.d0
+	else
+	    dra_r = atan2 (y, x)
+	dec_r = atan2 (z, sqrt (x*x + y*y))
+end
+
+
+# xt_wp_ait -- convert from ra & dec using Aitoff projection
+#
+# Note that the declination at the reference pixel is ignored and is
+# assumed to be zero.  The algorithms given in the AIPS reference do
+# allow for a non-zero declination at the reference pixel.
+#
+# Reference:  AIPS Memo No. 46 by Eric W. Greisen
+
+procedure xt_wp_ait (wcs, dra_r, dec_r, xi_r, eta_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	dra_r		# i: RA of object - RA at reference pixel (radians)
+double	dec_r		# i: declination of object (radians)
+double	xi_r		# o: standard coordinate (radians)
+double	eta_r		# o: standard coordinate (radians)
+#--
+double	z		# temp variable
+double	cosdec		# cosine of declination
+
+begin
+	cosdec = cos (dec_r)
+	z = sqrt ((1.d0 + cosdec * cos (dra_r/2.d0)) / 2.d0)
+
+	xi_r = 2.d0 * cosdec * sin (dra_r/2.d0) / z
+	eta_r = sin (dec_r) / z
+end
+
+
+# xt_pw_ait -- convert to ra & dec using Aitoff projection
+#
+# Note that the declination at the reference pixel is ignored and is
+# assumed to be zero.  The algorithms given in the AIPS reference do
+# allow for a non-zero declination at the reference pixel.
+#
+# Reference:  AIPS Memo No. 46 by Eric W. Greisen
+
+procedure xt_pw_ait (wcs, xi_r, eta_r, dra_r, dec_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	xi_r		# i: standard coordinate (radians)
+double	eta_r		# i: standard coordinate (radians)
+double	dra_r		# o: RA of object - RA at reference pixel (radians)
+double	dec_r		# o: declination of object (radians)
+#--
+double	z		# temp variable
+double	cosdec		# cosine of declination
+
+begin
+	z = sqrt (1.d0 - xi_r*xi_r/16.d0 - eta_r*eta_r/4.d0)
+
+	dec_r = asin (eta_r * z)
+	cosdec = cos (dec_r)
+
+	if (cosdec > 0.d0) {
+	    dra_r = 2.d0 * asin (xi_r * z / (2.d0 * cosdec))
+	} else {
+	    dra_r = 0.d0
+	}
+end
+
+
+# xt_wp_mer -- convert from ra & dec using Mercator projection
+#
+# Note that the declination at the reference pixel is ignored and is
+# assumed to be zero.  The algorithms given in the AIPS reference do
+# allow for a non-zero declination at the reference pixel.
+#
+# Reference:  AIPS Memo No. 46 by Eric W. Greisen
+
+procedure xt_wp_mer (wcs, dra_r, dec_r, xi_r, eta_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	dra_r		# i: RA of object - RA at reference pixel (radians)
+double	dec_r		# i: declination of object (radians)
+double	xi_r		# o: standard coordinate (radians)
+double	eta_r		# o: standard coordinate (radians)
+#--
+double	temp
+
+begin
+	xi_r = dra_r
+	temp = (dec_r + HALFPI) / 2.d0
+	if (temp >= HALFPI || temp <= 0.d0)
+	    call error (1, "invalid declination for Mercator projection")
+	eta_r = log (tan (temp))
+end
+
+
+# xt_pw_mer -- convert to ra & dec using Mercator projection
+#
+# Reference:  AIPS Memo No. 46 by Eric W. Greisen
+
+procedure xt_pw_mer (wcs, xi_r, eta_r, dra_r, dec_r)
+
+pointer wcs		# i: pointer to world coord system struct
+double	xi_r		# i: standard coordinate (radians)
+double	eta_r		# i: standard coordinate (radians)
+double	dra_r		# o: RA of object - RA at reference pixel (radians)
+double	dec_r		# o: declination of object (radians)
+#--
+
+begin
+	dra_r = xi_r
+	dec_r = 2.d0 * atan (exp (eta_r)) - HALFPI
+end