Initial commit

438 files changed, 57419 insertions, 0 deletions

diff --git a/pkg/xtools/README b/pkg/xtools/README
new file mode 100644
index 00000000..394f71f6
--- /dev/null
+++ b/pkg/xtools/README
@@ -0,0 +1,12 @@
+
+This directory contains miscellaneous tools written in the spp language.
+While not really system routines or mathematical library routines, these
+library routines are nonetheless sufficiently general purpose to justify
+making them publically available.  Reference library "libxtools.a" (-lxtools
+on the xc command line) to access these routines.
+
+IRAF Group members are encouraged to add to the tools.  To install a new
+tool: (1) copy the .x source into the directory or subdirectory, (2) Enter
+the name of each file followed by any dependency files into the mkpkg file,
+and (3) enter the UNIX command "mkpkg". This will compile the new modules and
+add them to the "libxtools.a" library.
diff --git a/pkg/xtools/Revisions b/pkg/xtools/Revisions
new file mode 100644
index 00000000..053bfc48
--- /dev/null
+++ b/pkg/xtools/Revisions
@@ -0,0 +1,1008 @@
+.help revisions Jun88 pkg.xtools
+.nf
+
+inlfit/ingfit.gx
+    The 'oldwts' pointer was being used explicitly with Memr, changed to use
+    'Mem$t' so the appropriate type is used (5/4/13, MJF)
+
+rmsorted.x
+    A 64-bit problem was fixed.  (12/5/11, Valdes)
+
+catquery/cqdef.x
+catquery/cqquery.x
+catquery/cqimquery.x
+    Modified the URL access to use the new url_get() procedure as a
+    compile-time option.  This allows access to servers that may
+    redirect the URL or return some other http error. (10/5/11, MJF)
+
+fixpix/ytpmmap.x
+    The world matching was not right.  It may still have bugs but the
+    discovered problem has been fixed.  (3/3/11, Valdes)
+
+=======
+2.15.1a
+=======
+
+pkg/xtools/icfit/icdeviant.gx
+    There were two bugs related to growing.  First, the logic was wrong.
+    Second, in one place the grow parameter was treated as being in pixels
+    and in another as being in user coordinate units.
+    (6/28/10, Valdes)
+
+pkg/xtools/xtextns.x
+     Pixel list masks were not recognized as images.
+     (2/13/09, Valdes)
+
+lib/pkg/rmsorted.h
+pkg/xtools/rmmed.x
+pkg/xtools/rmsorted.x
+     Modified the running median library to allow running minimum and
+     running maximum.  An argument addition required a change in the 
+     runmed task but there was no functional change.
+     (10/29/08, Valdes)
+
+xtextns.x
+    1.  The wrong ranges package was used for the extension versions.  Calling		the correct one requires extension versions to be positive integers.
+    2.  The extension version was not being matched correctly.  This may
+    	have happened when switching to using the mef library.
+    (8/25/08, Valdes)
+
+fixpix/ytpmmap.x
+    The inefficiencies in evaluating the WCS were addressed.
+    (3/18/08, Valdes)
+
+fixpix/ytpmmap.x
+    Fixed a couple of bugs that could result in a floating point exception.
+    (3/17/08, Valdes)
+
+rmsorted.x
+    This routine was modified, including adding and argument, to
+    support the clipping of bright values.
+    (2/29/08, Valdes)
+
+rmmed.x
+    This general package of running median routines was moved from
+    images$imfilter/src.  It was enhanced by allowing clipping of
+    bright sources.  This means a new argument, nclip, is required.
+    (2/29/08, Valdes)
+
+fixpix/ytpmmap.x
+    1.	Any number of '^' characters can be in the name at any point to
+	invert or uninvert a mask.  This is needed if an application wants
+	to invert the mask specified by the user which may also include '^'.
+	This also allows strings like !^foo or ^!foo.
+    2.	The pmmatch variable may not be "world N" where N is the maximum
+	input mask value to be preserved in the output mask.  This value
+	is used to optimize the internal bit array to the smallest it
+	can be consistent with the desired value.  A value of "world"
+	is equivalent to "world 1".
+    (2/5/08, Valdes)
+
+xtbitarray.x
+    Generalized to support different number of bits per element.  The
+    value is now set by specifying a maximum value.  All values greater
+    than the maximum are set to the maximum.  (2/5/08, valdes)
+
+inlfit/innlinit.gx
+    Removed an extra argument from the nlfree$t() call (1/16/08, MJF)
+
+fixpix/ytpmmap.x
+    1.  A feature to match masks in world coordinates, but only as a
+	boolean mask, was added.
+    2.  The way the pixel mask matching is selected was generalized.
+	The matching type is specified as a string with values
+	"logical", "physical", "world", or "offset".  An application
+	may also specify an environment variable which the user may
+	use to specify the type.  If the application specifies one of
+	the types then the environment variable "pmmatch" may be used
+	to override the application.
+    (1/9/08, Valdes)
+
+xtbitarray.x	+
+mkpkg
+    This provides a package for creating an in-memory 2D bit array.
+    This can be used for large boolean masks with random access.  It
+    is being added for use with pixel mask matching in world coordinates.
+    (1/9/08, Valdes)
+
+=====
+V2.14
+=====
+
+fixpix/setfp.x	+
+    This routine transforms the input mask values into the output mask
+    values.  It allows the input mask to have two classes of bad pixels;
+    those which are interpolated and those which are not.
+
+fixpix/ytpmmap.x
+    Adds a procedure yt_mappm and internal argument to allow control of
+    the WCS matching of masks to images.  The earlier versions always
+    matched masks using the physical coordinate system.  Applications can
+    the new procedure to have some control over this.
+    (11/26/07, Valdes)
+
+t_txtcompile.x	+
+txtcompile	+
+mkpkg
+    This application compiles a text file into an SPP procedure that
+    can be called by the xt_txtopen procedure.  The application is intended
+    to be used as a host preprocessing command in mkpkg files to support
+    things like host callable applications (e.g. see syshost).  The
+    code is in xtools for savvy developers awaiting full integration.
+    (11/26/07, Valdes)
+
+xttxtfio.x	+
+mkpkg
+    The routines xt_txtopen and xt_txtclose follow the usual FIO
+    interface.  They allow calling a procedure that sets a string file as
+    if it was a read-only file.  (See the t_txtcompile.x procedure for a
+    way to create a procedure from a text file.)  The file name for this
+    special case of a procedure uses the syntax "proc:NNNNNN" where NNNNNN
+    is the value returned by locpr.  The application would construct this
+    name for the procedure it declares as extern.  The intended purpose is
+    to allow building in configuration files, including a parameter file,
+    into a host callable executable where unsatisfied parameter values
+    default to a built-in file rather than issuing a prompt (see syshost).
+    When called with an actual file normal read-only FIO is used.
+    (11/26/07, Valdes)
+
+syshost.x	+
+mkpkg
+    This routine may be used by an application to set default
+    parameter values when the executable is called directly by the
+    host.  The routine provides three files to search in order; two
+    keyword=value files and a par file.  These files, primarily the
+    par file, may be encoded as compiled procedures (see txtcompile
+    and xt_txtopen/xt_txtclose) so that the binary can be distributed
+    without any configuration files.  (11/26/07, Valdes)
+
+xtextns.x
+    Further restructuring of these routines to support binary tables.  This
+    makes use the mef routines.  (11/26/07, Valdes)
+
+=====
+V2.13
+=====
+
+catquery/cqgfields.x
+    The documentation says that the offset field in the catalog description
+    file for simple text is the field number.  However, the implementation
+    did not work this way.  The changes makes the catalog parsing work as
+    described.  (7/17/07, Valdes)
+
+xtextns.x		+
+doc/xtextns.hlp		+
+doc/xtools.hd
+mkpkg
+    Routines for expanding MEF image extensions.  The first version of
+    this functionality was developed for proto.imextensions and then
+    expanded for mscred.mscextensions.  Since then these routines have
+    been used in other tasks and so these are now being escalated to
+    generic xtools routines.  (3/20/07, Valdes)
+
+xtmaskname.x
+doc/xtmaskname.hlp	+
+doc/xtools.hd
+    The case where masktype=pl and the input name doesn't have a .pl
+    extension was wrong.  (3/19/07, Valdes)
+
+fixpix/ytfixpix.x	+
+    This version uses an internal copy of the input mask rather than
+    modifying the input mask.  (3/19/07, Valdes)
+
+fixpix/xtpmmap.x
+fixpix/ytpmmap.x	+
+fixpix/mkpkg
+doc/xtpmmap.hlp		+
+doc/xtools.hd
+    1.	Uses xt_maskname to handle mask names.
+    2.	Minor bug fixes.
+    3.	The xt_ and yt_ versions are the same but the yt_version is
+	present to allow external packages to check for the presence
+	of ytpmmap.x and if not present use their own copy of the file.
+	This allows these packages to be compiled with earlier versions.
+	Eventually the yt versions should be obsoleted.
+	(3/19/07, Valdes)
+
+xtargs.x	+
+mkpkg
+	Simple interface to parse an argument string consisting of a list
+	of whitespace separated keyword=value pairs.  (8/31/05, Valdes)
+
+=======
+V2.12.3
+=======
+
+rmsorted.x
+lib$pkg/rmsorted.h
+    This implements a sorted running median algorithm.
+    (5/12/05, Valdes)
+
+rmturlach.x
+    This implements the Turlach running median algorithm from the R package.
+    (5/12/05, Valdes)
+
+xtsample.gx
+    Utility to get a sample of pixels from an image.  (5/6/05, Valdes)
+
+xtstat.gx
+    Utility to compute a mean, sigma, median, and mode.  This is commonly
+    used with xt_sample.  (5/6/05, Valdes)
+
+fixpix/xtfp.x
+    Wrong fix was made.  (1/4/05, Valdes)
+
+fixpix/xtfp.x
+    For reasons I can't understand, the column interpolation was broken.
+    A loop over the columns was using ncols=FP_NCOLS, the number of bad pixels
+    across columns, instead of nc=IM_LEN(im,1), the number of columns in
+    the image.
+    (6/22/04, Valdes)
+
+numrecipes.x
+    Added LU decomposition.  (6/18/04, 2004)
+
+fixpix/xtpmmap.x
+    1. The routines now allow selecting whether to match masks in physical
+       coordinates or logical coordinates.  When matching in logical
+       coordinates this simply means extending or trimming the mask if
+       the sizes are not the same.
+    2. Added a new routine xt_mappm which is now the prefered routine
+       that allows selecting the matching type.  The previous xt_pmmap
+       could not be changed since it used by various tasks.
+    (6/18/04, Valdes)
+
+xtmasknames.x
+    Added routines that hand pixel mask names.  This is fairly sophisticated
+    in dealing with whether or not the user specifies file extensions,
+    image extensions, and flags.  It will produced masks in FITS extensions
+    by default.  (6/16/04, Valdes)
+
+=======
+V2.12.2
+=======
+
+fixpix/xtpmmap.x
+    If the mask and data are offset by a fraction of a pixel it was possible
+    to get an out-of-bounds error.  (8/14/03, Valdes)
+
+fixpix/xtpmmap.x
+    The loop over the range list in xt_match should start at 2 rather
+    than 1.  (8/14/03, Valdes)
+
+fixpix/xtpmmap.x
+    Added some error checks to avoid a segmentation violation in xt_pmtext
+    when there is an error in im_pmmapo.  (9/16/02, Valdes)
+
+fixpix/xtpmmap.x
+    A common case of matching a mask to an image is where the pixel sizes
+    are the same but there are offsets and/or different sizes.  An optimized
+    mask matching based on using range lists and not calling mwcs was
+    added.  (9/12/02, Valdes)
+
+fixpix/xtpmmap.x
+    Added test for a pm pointer in xt_pmmap.  I can't remember why this
+    is was added in the version in ACE but it seems right.  (9/10/02, Valdes)
+
+fixpix/xtpmmap.x
+    In the mask matching if there is no offset or sampling difference it
+    was returning the mask unchanged even if the sizes are not the same.
+    (9/10/02, Valdes)
+
+=======
+V2.12.1
+=======
+
+=====
+V2.12
+=====
+
+xtools$fixpix/xtpmmap.x
+    The change to IMIO for mapping bad pixel files in FITS extensions
+    resulted in a different error code when failing to open the file.
+    This code needed to be recognized by this routine in order to
+    continue on to try other possible formats.  (2/27/02, Valdes)
+
+xtools$rngranges.x
+    Further modification for INDEF range limits.  (2/4/02, Valdes)
+
+xtools$rngranges.x
+    Added missing rstr argument to 2 rng_error calls. (01/07/02, Davis)
+
+xtools$catquery/cqquery.x
+    Fixed a couple of typos in the code which detects the end of the http
+    header. (01/03/02, Davis)
+
+xtools$rngranges.x
+xtools$rngranges.xBAK +
+    Modified rng_add to handle INDEFs better.  This was the change found
+    in the nmisc version.  There are some other differences but since the
+    records of why the changes were made are missing I fixed only the
+    immediate problem found with OBSUTIL.SPECFOCUS.
+    (11/14/01, Valdes)
+
+xtools$skywcs/doc/skdecim.hlp
+xtools$skywcs/doc/skequatorial.hlp
+xtools$skywcs/doc/sklltran.hlp
+xtools$skywcs/doc/skultran.hlp
+xtools$skywcs/doc/skywcs.hlp
+xtools$catquery/doc/catquery.hlp
+xtools$catquery/doc/cqsqpar.hlp
+xtools$catquery/doc/cqsqparn.hlp
+    Fixed various formatting problems in the skywcs and catquery library
+    help pages. (19/09/01, Davis)
+
+xtools$catquery/
+    Added the prototype catalog and survey access tools to the xtools package.
+    (27/08/01, Davis)
+
+xtools$fixpix/xtpmmap.x
+    Added missing argument to mw_ctrand calls.  (6/15/01, Valdes)
+
+xtools$fixpix/xtpmmap.x
+    Fixed problems with xt_match.  The new version is more robust and
+    correct.  A bad pixel for the reference image is the maximum of all
+    pixels in the pixel mask which fall within the reference pixel.   This
+    version still does not allow any relative rotations but does allow
+    non-integer offsets.  (4/24/01, Valdes)
+
+xtools$fixpix/xtfixpix.x
+    Added a call to pm_compress to compress the pixel mask if there are
+    more than a certain number of edits to avoid the memory inefficiency
+    in plio.  (2/2/01, Valdes)
+
+xtools$fixpix/xtpmmap.x
+    A mask name beginning with '^' is used to invert a mask.
+    (2/1/01, Valdes)
+
+xtools$inlfit.gx
+xtools$inlfitr.x
+xtools$inlfitd.x
+xtools$inlrefit.gx
+xtools$inlreffitr.x
+xtools$inlrefitd.x
+    Added a check for the condition case where the number of data points
+    minus the number of deleted points (i.e. those with weights of 0.0)
+    is less than the number of fitting parameters. The previous checks did
+    not task into account the number of deleted points and could produce
+    solutions that were correct but non-physical (1/2/01, Davis)
+
+xtools$fixpix/xtpmmap.x
+    1. The test for matching offsets was incorrect.
+    2. The use of BPM was broken.
+    3. There was a memory leak because imunmap does not free the pl
+	pointer set with im_pmmapo (also there was an imio bug in
+	freeing the pl pointer set with im_pmmap which has now been
+	fixed).  A new procedure xt_pmunmap should be used whenever
+	xt_pmmap is used to insure any internal pointer created by
+	xt_match to match the mask to a reference image is freed.
+    (12/12/00, Valdes)
+
+xtools$skywcs/
+    Added the sky coordinates transformation tools to the xtools package.
+    (10/12/00, Davis)
+
+=========
+V2.11.3p1
+=========
+
+xtools/fixpix/xtpmmap.x
+    A mask name begining with '!' is now treated as a reference to a
+    header keyword.  (9/4/00, Valdes)
+
+xtools/fixpix/xtpmmap.x
+    When a pixel mask (overlay or bad pixel) needed to be matched to
+    the data in physical coordinates the internal generation of a
+    new mask was being done in short integers.  This would truncate
+    any masks with values greater than 16 bits.  All uses of short
+    where changed to integer.  (5/16/00, Valdes)
+
+=========
+V2.11.3p1
+=========
+
+=======
+V2.11.3
+=======
+
+xtools$fixpix/xtfp.gx
+    The formating of the verbose pixel printing was missing a couple of
+    blanks.  (12/15/99, Valdes)
+
+=======
+V2.11.2
+=======
+
+xtools$ranges/mkpkg
+xtools$icfit/mkpkg
+xtools$fixpix/mkpkg
+xtools$mkpkg
+    Added missing dependencies.  (10/11/99, Valdes)
+
+xtools$inlfit/mkpkg
+    Removed an uncessary file dependency from the mkpkg file. (20/9/99, Davis)
+
+=======
+V2.11.2
+=======
+xtools$fixpix/xtpmmap.x
+    Removed extra argument to imgl1i.  (8/11/99, Valdes)
+
+xtools$imtools.x
+    fnext is a function not a subroutine.  (8/11/99, Valdes)
+
+xtools$xtanswer.x
+    Fixed incorrect number of arguments in getline call.  (8/11/99, Valdes)
+
+xtools$nlfit/inreject.x
+xtools$nlfit/inrejectr.x
+xtools$nlfit/inrejectd.x
+    Rearranged the code to remove a missing sfree statement problem
+    detected by spplint. (8/10/99, Davis)
+
+xtools$center1d.x
+    The step of finding a local maxima was not correct.  (4/19/99, Valdes)
+
+xtools$fixpix/xtfp.gx
+    If there was no column interpolation the pixel type for the allocated
+    data array was not set resulting in an error during xt_fpfree.
+    (7/20/98, Valdes)
+
+xtools$%xtimnames.x
+    Modified extension testing code to use iki_validextn.
+    (7/13/98, Valdes)
+
+xtools$fixpix/xtfp.gx
+    Fixed a bug allowing out-of-bounds reference to FP_COL.
+    (6/6/98, Valdes)
+
+xtools$fixpix/xtpmmap.x
+    The steps to check if an image and mask have an integer relationship
+    (integer sampling and integer offsets) in their physical coordinate
+    systems could fail because real precision was not high enough
+    in MWCS transformation calls.  Changed variables and MWCS calls
+    to double.  (5/29/98, Valdes)
+
+xtools$fixpix/xtpmmap.x
+    The XT_PMINVERT function has a bug in using the range list.
+    (4/22/98, Valdes)
+
+xtools$fixpix/xtfixpix.h
+xtools$fixpix/xtfixpix.x
+xtools$fixpix/xtfp.gx
+    The modified data buffer returned by xt_fps$t used the imgl2$t buffer
+    which might be invalidated by subsequent imio activity such as
+    impl2$t.  This was found with proto.fixpix.  The routines were modified
+    to allocate and use a separate line buffer.  Note that this only
+    applies to lines which are modified.  If the requested line does
+    not have any bad pixels to fix then the input buffer is still returned.
+    (1/29/98, Valdes)
+
+xtools$fixpix/xtfp.gx
+    When a segment of bad pixels contains a mixture of column and line
+    interpolations and the first pixel is column interpolation then the
+    line interpolations could be wrong because interpolation coefficients are
+    not initialized.  A second minor fix is that the column interpolation
+    endpoints printed in pixel listing mode could be incorrect.
+    (1/29/98, Valdes)
+
+=======
+V2.11.1
+=======
+
+xtools$imtools.x
+     XT_MKIMTEMP was modified to append the same extension as the input
+     image when creating a temporary image name.  (10/30/97, Valdes)
+
+xtools$ranges.x
+     Returned the EOLIST marker to zero since some programs rely on this.
+     This means that zero cannot be a range element.  Added some
+     checks against a zero step size.  (8/22/97, Valdes)
+
+xtools$fixpix/xtpmmap.x
+     There was a bug in the code which gives "Warning: PLIO: reference out
+     of bounds on mask".  This was introduced with the changes to allow
+     masks and images to have different binning.  (8/21/97, Valdes)
+
+xtools$ranges.x
+xtools$doc/ranges.hlp
+    Now allows zero as a valid range element though the default for a
+    null string is still 1.  (7/15/97, Valdes)
+
+=========
+V2.11Beta
+=========
+
+xtools$fixpix/xtpmmap.x
+    Improved xt_match to match when the sampling is different.
+    (5/21/97, Valdes)
+
+xtools$obsdb.x
+    File date was changed but the code was not changed (5/7/97, Valdes)
+
+xtools$dttext.x
+    Added the new routine dtgetd to the dttext package. (1/16/97, Davis)
+
+xtools$fixpix/xtpmmap.x
+    Fixed some bugs.  (12/30/96, Valdes)
+
+xtools$mkpkg
+xtools$fixpix/	+
+    Added some new tools for dealing with masks.  (12/6/96, Valdes)
+
+xtools$center1d.x
+    When the width parameter is less than or equal to 1 pixel the algorithm
+    is supposed to return the nearest local maximum.  There was a bug
+    such that the nearest pixel to the starting point was returned
+    unless that pixel is a local minimum.  (10/24/96, Valdes)
+
+xtools$numrecipes.x
+    Modified the Poisson deviate routine to return zero for input
+    values less than or equal to zero.  (10/1/96, Valdes)
+
+xtools$xtimnames.x
+    Added "fits" and "fit" as extensions.  (7/30/96, Valdes)
+
+xtools$inlfit/ingresults.gx
+    Changed several INDEFR references to INDEF references so that INDEF
+    has the correct type (real or double) in the output .x files.
+    (18/7/96, Davis)
+
+xtools$dttext.x
+    The dtunmap procedure now returns if a null pointer is received.
+    (1/6/95, Valdes)
+
+xtools$center1d.x
+    Added a routine that allows setting some of the previously hardwired
+    parameters.  By default the routines behave as before unless
+    c1d_params is called to set the parameters.  (10/2/95, Valdes)
+
+xtools$incopy.gx
+    Changed 4 MEMP references to Mem$t references. The in_copyr and
+    in_copyd routines are not used anywhere in the system so this should
+    not be a problem. (8/2/95, Davis)
+
+xtools$rngranges.x
+    Added missing argument to rng_error calls.  (8/2/95, Valdes)
+
+=======
+V2.10.4
+=======
+
+xtools$obsdb.x
+    Changed the "timezone" parameter to be a double instead of an integer.
+    There are non-integer timezones such as India.  (12/29/94, Valdes)
+
+xtools$numrecipes.x
+    The POIDEV routine can still have a problem in that the tan function
+    can return a very large number triggering either an overflow in
+    the evaluation of em or in the int truncation of em as addressed
+    below.  A test is now made on the value of the tan function.
+    (9/14/94, Valdes)
+
+xtools$numrecipes.x
+    The POIDEV routine from Numerical Recipes can try to coerce a large
+    floating point number to an integer which can cause an exception.
+    If the value is 100 or greater a Gaussian deviate is now returned.
+    (8/11/93, Valdes)
+
+============
+V2.10.3 beta
+============
+
+xtools$center1d.x
+    For EMISSION features the threshold is applied as an absolute threshold
+    if the minimum data value is above zero and as a threshold relative to the
+    minimum data value if the minimum data value is below zero.  Without
+    this change centering would fail if the data was all below zero.
+    (5/5/93, Valdes)
+
+xtools$obsdb.x
+    Fixed a couple of typos in comments.  No code changes.  (4/28/93, Valdes)
+
+xtools$rngranges.x
+    Yet another ranges package.  This ranges package allows real number
+    ranges (including negative values) and @ lists.  It is an object
+    oriented package using a pointer.
+
+    RNG_OPEN     -- Open a range string.  Return a pointer to the ranges.
+    RNG_CLOSE    -- Close range structure.
+    RNG_INDEX    -- Get ith range element.  Return EOF if index is out of range.
+    RNG_NEAREST  -- Get nearest range index and value to input value.
+		     Return the difference.
+    RNG_INRANGER -- Check if real value is within a range.
+    RNG_INRANGEI -- Check if integer value is within a range.
+    RNG_ELEMENTR -- Check if real value is an element.
+    RNG_ELEMENTI -- Check if integer value is an element.
+    RNG_ADD      -- Add a range.
+    RNG_ERROR    -- Set error flag and free memory.
+    (2/16/93, Valdes)
+
+xtools$center1d.x
+    If the initial center was more than three pixels from the true center
+    the interation would stop prematurely because of the dxcheck criterion.
+    Changed dxabs to be the full dx rather than the the limit of 1 pixel
+    per interation.  This allows the interation to step as often as
+    it needs in one pixel steps until the dx estimate begins to become
+    small.  It still preserves the checks for flipping back and forth
+    about the center and for a maximum number of times the dxabs
+    is greater than the previous minimum dxabs = dxlast.
+    (9/22/92, Valdes)
+
+=======
+V2.10.2
+=======
+
+=======
+V2.10.1
+=======
+
+lib$pkx/dttext.h
+pkg$xtools/dttext.x
+    Added a new routine, dtremap, which allows keeping the database
+    open across multiple calls and remapping when a new database file
+    is specified.  It is also optimized when switching back and forth
+    between read and append modes.  The data structure was modified
+    to record the current database and file names for checking when
+    the name changes.  (4/30/92, Valdes)
+
+pkg$xtools/obsdb.x
+    1.  Removed obsimcheck procedure.  Did not like the defaulting
+	to last set observatory if OBSERVAT not found.
+    2.  Added obsimopen procedure.  This is the procedure to call when
+	dealing with images.  It returns flags to determine whether a
+	new observatory was opened and whether the observatory was
+	define by the image header
+    3.  Added a verbose obsvopen to allow tracking what the interface is
+	doing.
+    4.  These changes made in conjunction with changes to the
+	astutil.observatory task.
+    (2/4/92, Valdes)
+
+pkg$xtools/xtimnames.x +
+    Added some tools for dealing with image kernel extensions in image names.
+    (1/22/92, Valdes)
+
+pkg$xtools/inlfit/infit.gx
+pkg$xtools/inlfit/infitr.x
+pkg$xtools/inlfit/infitd.x
+    The fit status was not being updated correctly if point were 
+    automatically rejected from the fit as opposed to being deleted.
+    (1/8/92, Davis)
+
+pkg$numrecipes.x
+    Added some fourier routines.  Note that this is still a source only
+    entry and is not part of libxtools.  (9/4/91, Valdes for MJF)
+
+pkg$numrecipes.x
+    mr = 0.1 * mr --> mr = max (EPSILONR, 0.1 * mr)	(9/2/91, Valdes)
+
+pkg$xtools/inlfit/
+    The interactive non-linear least squares fitting package used by PHOTCAL
+    was installed in XTOOLS. (8/6/91)
+
+pkg$obsdb.x +
+    New observatory database routines.  (11/6/90, Valdes)
+
+====
+V2.9
+====
+
+pkg$xtools/center1d.x
+    In the case that the position correction flipped back and forth about the
+    center no center would be found.  In this case I added a check to
+    divide the correction factor in half.  (3/13/90, Valdes)
+
+pkg$xtools/numrecipes.x +
+    Add some procedures for generating Gaussian and Possion deviates
+    as well as an implementation of the Levenberg-Marquardt nonlinear
+    chi square minimization algorithm.  These routines are either
+    direct implementations from Numerical Recipes or based on descriptions
+    in that book. (10/25/89, Valdes)
+
+pkg$xtools/dttext.x
+    Commented out the diagnostic message in dtlocate.  (7/19/89, Valdes)
+
+pkg$xtools/center1d.x
+pkg$xtools/doc/center1d.hlp
+    If the centering width is less than or equal to 1 the nearest minima or
+    maxima is found.  As before, a minimum width of 3 is used if
+    the width is between 1 and 3.  (7/13/89, Valdes)
+
+===========
+Version 2.8
+===========
+
+pkg$xtools/logfiles.x
+    Added these routines to open and to close a list of logfiles.
+    (6/2/89, Seaman)
+
+pkg$xtools/ranges.x
+    Fixed a bunch of bugs in the zero handling, the MAX_INT handling and
+    that made the step notation flaky.  Made a comma a hard separator
+    between two ranges rather than mere whitespace.  (6/2/89, Seaman)
+
+pkg$xtools/xtmksections.x
+    A 2D image with second dimension length of 1 is returned without
+    an image section from xt_mk1d and xt_mksection.  (1/31/89, Valdes)
+ 
+pkg$xtools/xtsort.x
+    Added a double precision version of the three vector sorter, named
+    xt_sort3d.  It required a double precision version of xts_compared.
+    This change was to support the utilities.curfit task, which now
+    sorts its input list data before fitting.  (6/24/88 ShJ)
+
+pkg$xtools/xtsums.x
+    When the number of lines or columns is 1 and the line or column is the
+    same as a previous call and a data is null then a new vector is not read
+    causing uninitialized data to be returned.  Added l1=0 and c1=0 to fix
+    problem.  This problem appeared in proto.toonedspec.  (2/12/88 Valdes)
+
+pkg$xtools/mksection.x
+    User specified section strings of the form "column 051" are now
+    converted to [51,*] instead of [051,*]. (11/9/87 Valdes)
+
+====
+V2.5
+====
+
+pkg$xtools/center1d.x
+pkg$xtools/doc/center1d.hlp
+    Valdes, April 2, 1987:
+    1.  A bug with testing the right edge of the data was fixed.  This caused
+	FPE errors on AOS/IRAF.
+    2.  The centering fails if the maximum number of iterations is reached
+	or the changes do not continue to decrease within 3 iterations of
+	the last minimum change.
+    3.  Defined parameters replaced constants used in the code.
+
+pkg$xtools/center1d.x
+pkg$xtools/doc/center1d.hlp
+    Valdes, March 5, 1987:
+    1.  A silent minimum of 3 is imposed on the width parameter.  If there
+	is ever a need to allow smaller widths then the procedure can
+	be changed and the application relinked.
+    2.  The help page was modified to reflect this change.
+
+pkg$xtools/center1d.x
+    Valdes, October 29, 1986:
+    1.  The first use of threshold was only as a data range limit.
+	Now it is used to eliminate all peaks less than threshold from
+	the continuum.  This fixes ever finding weak features less
+	than threshold.
+
+pkg$xtools/center1d.x
+    Valdes, August 18, 1986:
+    1.  Added a detection threshold parameter to CENTER1D.
+
+====================================
+Version 2.3 Release, August 18, 1986
+====================================
+
+cogetr.x: Valdes, July 3, 1986
+    1.  Error in initializing the procedure cogetr fixed.
+
+icfit$: Valdes, July 3, 1986
+    1.  ICFIT package replaced by a new version.
+
+=====================================
+STScI Pre-release and SUN 2.3 release
+=====================================
+
+icfit$icgfuncs.gx:  Valdes, June 18, 1986
+    1.  DCVEVAL was being called in ICGFUNCS with a real argument when
+	selecting the nonlinear plot (key 'l').  This caused an error
+	on the SUN.  Changed "real" to PIXEL.
+
+gtools$gtwindow.x:  Valdes, June 11, 1986
+    1.  Added new procedure gt_window.  It is a cursor driven procedure
+	for windowing graphs using the gtools pointer.  The help
+	page for gtools was also modified to show the windowing options.
+
+gtools$gtcur.x:  Valdes, May 10, 1986
+    1.  Took out "Confirm:" prompt so that cursor input from a file does
+	not cause anything to be printed.  Two EOF's (carriage return or
+	actual EOF) or a 'q' are required to exit thus protecting the user
+	from an inadvertent carriage return.
+
+imt.x:  Valdes April 29, 1986
+    1.  Modified the image template package to sort wildcard expansions.
+
+icfit$icgfit.gx,icgfit2.x,icgcolon.x:  Valdes, April 7, 1986
+    1.  Fixed use of STRIDX with a character constant to STRIDXS.
+    2.  Fixed problem with colon usage for ":sample" and ":function"
+
+xtools:  Valdes, March 24, 1985
+    1.  Added XT_PHISTORY to put dated history string.
+
+pkg$xtools/imtools.x:  Valdes, March 18, 1985
+    1.  XT_MKIMTEMP modified to create the temporary image header in the
+	user current directory with the prefix "tmp".
+    2.  XT_DELIMTEMP modified to call IMRENAME instead of RENAME.
+
+From Valdes March 13, 1986:
+
+1.  Added procedure dtgad (database get array double) to dttext tools.
+It's purpose is to accomodate double precisions curve fits.
+
+2.  Added COGETR procedures for efficient column access.  A help page
+is available.
+
+3.  Added XTSUMS procedures for buffered sums (both column and line).
+They are particularly useful for moving sums type of operations.  A help
+page is available
+
+4.  Added help pages for COGETR and XTSUMS procedures to help database.
+------
+From Valdes March 10, 1986:
+
+1.  Added IMTREW rewind procedure to image template tools.
+
+2.  Added IMTGIM procedure to get an image from the template by index number.
+------
+From Valdes March 5, 1986:
+
+1.  Modified dttext to allow deleting a database.
+===========
+Release 2.2
+===========
+From Valdes Feb. 8, 1986:
+
+1.  Modified XT_DELIMTEMP and DEL_IMTEMP to update the pixel header
+file so that it correctly points to the header file after the header
+file is renamed.
+------
+From Valdes Jan. 13, 1986:
+
+1.  Changes in DTTEXT.X:
+	a.  Size of OS filename in DTMAP1 extended from SZ_FNAME to
+	    SZ_PATHNAME + SZ_FNAME.
+	b.  Database directories do not allow periods in the names when
+	    created.
+2.  XTMKSECTION was computing the middle line (or column) as
+len / 2 which gave zero for an image of length 1.  Changed to
+(len + 1) / 2.
+------
+From Valdes Dec. 31, 1985:
+
+1.  A bug in imt.x due to incorrect indexing in a string has been fixed.
+------
+From Valdes Nov. 22, 1985:
+
+1.  A new procedure XT_GIDS has been added to find identifier tokens in a
+string and match the identifiers against a dictionary string.  An array
+of YES/NO values for each dictionary entry, up to a maximum of maxids,
+is returned.  This procedure is useful for parsing an option string.
+It is nice because identifiers can be abbreviated and delimiters can be
+anything which is not an identifier token (whitespace, commas, colons,
+semicolons, etc).
+-----
+From Valdes Nov. 15, 1985:
+
+1.  Added DTMAP1 to DTTEXT.X text database package.  This procedure
+takes a directory name as the database and stores or access text database
+files in the directory under the file name key.  It maps the name
+"database/key" and calls DTMAP.  This allows better organization of
+database information into subfiles of a database rather than one massive
+text file.  It calls DTMAP with the database name directly if the database
+name is a regular file and not a directory.  Thus, it is backwards
+compatible with older single file text databases.
+
+2.  Added ISDIRECTORY.  This procedure tests a virtual file name to see
+if it is a directory and returns the os pathname suitable for concatentation.
+The function value is the number of characters in the pathname which is
+0 for a nondirectory file.
+cogetr.x: Valdes, July 3, 1986
+    1.  Error in initializing the procedure cogetr fixed.
+
+icfit$: Valdes, July 3, 1986
+    1.  ICFIT package replaced by a new version.
+
+=====================================
+STScI Pre-release and SUN 2.3 release
+=====================================
+
+icfit$icgfuncs.gx:  Valdes, June 18, 1986
+    1.  DCVEVAL was being called in ICGFUNCS with a real argument when
+	selecting the nonlinear plot (key 'l').  This caused an error
+	on the SUN.  Changed "real" to PIXEL.
+
+gtools$gtwindow.x:  Valdes, June 11, 1986
+    1.  Added new procedure gt_window.  It is a cursor driven procedure
+	for windowing graphs using the gtools pointer.  The help
+	page for gtools was also modified to show the windowing options.
+
+gtools$gtcur.x:  Valdes, May 10, 1986
+    1.  Took out "Confirm:" prompt so that cursor input from a file does
+	not cause anything to be printed.  Two EOF's (carriage return or
+	actual EOF) or a 'q' are required to exit thus protecting the user
+	from an inadvertent carriage return.
+
+imt.x:  Valdes April 29, 1986
+    1.  Modified the image template package to sort wildcard expansions.
+
+icfit$icgfit.gx,icgfit2.x,icgcolon.x:  Valdes, April 7, 1986
+    1.  Fixed use of STRIDX with a character constant to STRIDXS.
+    2.  Fixed problem with colon usage for ":sample" and ":function"
+
+xtools:  Valdes, March 24, 1985
+    1.  Added XT_PHISTORY to put dated history string.
+
+pkg$xtools/imtools.x:  Valdes, March 18, 1985
+    1.  XT_MKIMTEMP modified to create the temporary image header in the
+	user current directory with the prefix "tmp".
+    2.  XT_DELIMTEMP modified to call IMRENAME instead of RENAME.
+
+From Valdes March 13, 1986:
+
+1.  Added procedure dtgad (database get array double) to dttext tools.
+It's purpose is to accomodate double precisions curve fits.
+
+2.  Added COGETR procedures for efficient column access.  A help page
+is available.
+
+3.  Added XTSUMS procedures for buffered sums (both column and line).
+They are particularly useful for moving sums type of operations.  A help
+page is available
+
+4.  Added help pages for COGETR and XTSUMS procedures to help database.
+------
+From Valdes March 10, 1986:
+
+1.  Added IMTREW rewind procedure to image template tools.
+
+2.  Added IMTGIM procedure to get an image from the template by index number.
+------
+From Valdes March 5, 1986:
+
+1.  Modified dttext to allow deleting a database.
+===========
+Release 2.2
+===========
+From Valdes Feb. 8, 1986:
+
+1.  Modified XT_DELIMTEMP and DEL_IMTEMP to update the pixel header
+file so that it correctly points to the header file after the header
+file is renamed.
+------
+From Valdes Jan. 13, 1986:
+
+1.  Changes in DTTEXT.X:
+	a.  Size of OS filename in DTMAP1 extended from SZ_FNAME to
+	    SZ_PATHNAME + SZ_FNAME.
+	b.  Database directories do not allow periods in the names when
+	    created.
+2.  XTMKSECTION was computing the middle line (or column) as
+len / 2 which gave zero for an image of length 1.  Changed to
+(len + 1) / 2.
+------
+From Valdes Dec. 31, 1985:
+
+1.  A bug in imt.x due to incorrect indexing in a string has been fixed.
+------
+From Valdes Nov. 22, 1985:
+
+1.  A new procedure XT_GIDS has been added to find identifier tokens in a
+string and match the identifiers against a dictionary string.  An array
+of YES/NO values for each dictionary entry, up to a maximum of maxids,
+is returned.  This procedure is useful for parsing an option string.
+It is nice because identifiers can be abbreviated and delimiters can be
+anything which is not an identifier token (whitespace, commas, colons,
+semicolons, etc).
+-----
+From Valdes Nov. 15, 1985:
+
+1.  Added DTMAP1 to DTTEXT.X text database package.  This procedure
+takes a directory name as the database and stores or access text database
+files in the directory under the file name key.  It maps the name
+"database/key" and calls DTMAP.  This allows better organization of
+database information into subfiles of a database rather than one massive
+text file.  It calls DTMAP with the database name directly if the database
+name is a regular file and not a directory.  Thus, it is backwards
+compatible with older single file text databases.
+
+2.  Added ISDIRECTORY.  This procedure tests a virtual file name to see
+if it is a directory and returns the os pathname suitable for concatentation.
+The function value is the number of characters in the pathname which is
+0 for a nondirectory file.
+.endhelp
diff --git a/pkg/xtools/catquery/cq.h b/pkg/xtools/catquery/cq.h
new file mode 100644
index 00000000..9d9f801f
--- /dev/null
+++ b/pkg/xtools/catquery/cq.h
@@ -0,0 +1,100 @@
+# Public definitions file for the catalog query interface.
+
+# The catalog access interface parameter definitions
+
+define	CQNRECS		1	# the number of records in the catalog database
+define	CQSZRECLIST	2	# the length of the record name list in chars
+define	CQRECLIST	3	# the record name @list
+define	CQCATDB		4	# the catalog database file name
+define	CQCATNO		5	# the current catalog record number
+define	CQCATNAME	6	# the current catalog name
+
+# The max size of a query parameter name, value, units, and formats string.
+
+define	CQ_SZ_QPNAME	19
+define	CQ_SZ_QPVALUE	79
+define	CQ_SZ_QPUNITS	19
+define	CQ_SZ_QPFMTS	11
+
+# The maximum number of fields or columns in the result.
+
+define	CQ_MAX_NFIELDS	100
+
+# The catalog access results parameter definitions
+
+define	CQRCATDB	1   # the catalog database file
+define	CQRCATNAME	2   # the catalog name 
+define	CQRADDRESS	3   # the address
+define	CQRQUERY	4   # the query
+define	CQRNQPARS	5   # the number of query parameters 
+define	CQRQPNAMES	6   # the query parameter names
+define	CQRQPVALUES	7   # the query parameter values
+define	CQRQPUNITS	8   # the query parameter units
+
+define	CQRTYPE		9   # the results format (currently stext or btext)
+define	CQRECSIZE	10  # the record length in characters (default = 0)
+define	CQRHSKIP	11  # the number of header lines to skip (default = 0)
+define	CQRTSKIP	12  # the number of trailing lines to skip (default = 0)
+define	CQRTRIML	13  # the number of leading characters to trim
+define	CQRTRIMR	14  # the number of trailing characters to trim
+
+define	CQRNRECS	15  # The number of records in the results
+define	CQNHEADER	16  # The number of header keywords in the results
+define	CQNFIELDS	17  # The number of record fields in the results
+define	CQRECPTR	18  # the current record pointer
+
+# The surveys access results parameter definitions
+
+define  CQIMCATDB	1	
+define  CQIMCATNAME	2	
+define  CQIMADDRESS	3	
+define  CQIMQUERY	4	
+define	CQINQPARS	5
+define	CQIQPNAMES	6
+define	CQIQPVALUES	7
+define	CQIQPUNITS	8
+define  CQIMNAME	9	
+define	CQIMTYPE	10
+define	CQWCS		11
+define	CQNWCS		12
+define	CQNIMPARS	13
+
+
+# The max size of a field name, value, units, and formats string.
+
+define	CQ_SZ_FNAME	19
+define	CQ_SZ_FVALUE	79
+define	CQ_SZ_FUNITS	19
+define	CQ_SZ_FFMTS	11
+
+
+# Define the default input catalog file types
+
+define  CQ_RTYPESTR     "|stext|btext|"
+
+define  CQ_STEXT        1       # Simple text (free format fields)
+                                #     Newline delimited records
+                                #     Whitespace delimited fields
+                                #     No embedded whitespace unless in ""
+                                #     Skip nlines header
+                                #     Skip nchars at beginning / end of record
+                                #     Skip nlines trailer
+
+
+define  CQ_BTEXT        2       # Blocked text (fixed format fields)
+                                #     Fixed size newline delimited records
+                                #     Offset and size delimited fields
+                                #     Embedded whitespace permitted
+                                #     Skip nlines header
+                                #     Skip nchars at beginning / end of record
+                                #     Skip nlines trailer
+
+
+define	CQ_ITYPESTR	"|fits|"
+define	CQ_FITS		1
+
+
+define	CQ_WTYPESTR	"|fits|dss|none|"
+define	CQ_WFITS	1
+define	CQ_WDSS		2
+define	CQ_WNONE	3
diff --git a/pkg/xtools/catquery/cqdb.x b/pkg/xtools/catquery/cqdb.x
new file mode 100644
index 00000000..13434ca4
--- /dev/null
+++ b/pkg/xtools/catquery/cqdb.x
@@ -0,0 +1,442 @@
+include		<ctype.h>
+include		"cqdef.h"
+include		"cq.h"
+
+# These are the catalog configuration file access routines used by the
+# catalog access interface. These routines should not normally be called
+# directly from the applications program.
+
+
+# CQ_DGETI -- Get an integer field from the database record.
+
+int procedure cq_dgeti (cq, record, field)
+
+pointer	cq				#I The catalog database descriptor
+int	record				#I The catalog record index
+char	field[ARB]			#I The record field
+
+int	ival				#O Field value
+char	name[SZ_LINE]
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > CQ_NRECS(cq)))
+	    call error (0, "The catalog record is out of bounds")
+
+	call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
+
+	while (fscan (CQ_FD(cq)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (ival)
+		if (nscan() == 2)
+		   return (ival)
+		else
+		   call error (0, "Error reading catalog integer field value")
+	    }
+	}
+
+	call error (0, "Catalog record field not found")
+end
+
+
+# CQ_DGETR -- Get a real field from the catalog database record.
+
+real procedure cq_dgetr (cq, record, field)
+
+pointer	cq				#I The catalog database descriptor
+int	record				#I The catalog database record index
+char	field[ARB]			#I The catalog record field
+
+real	rval
+char	name[SZ_LINE]
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > CQ_NRECS(cq)))
+	    call error (0, "The catalog record is out of bounds")
+
+	call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
+
+	while (fscan (CQ_FD(cq)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargr (rval)
+		if (nscan() == 2)
+		   return (rval)
+		else
+		   call error (0, "Error reading real catalog field value")
+	    }
+	}
+
+	call error (0, "Catalog record field not found")
+end
+
+
+# CQ_DGETD -- Get a double precision field from a record.
+
+double procedure cq_dgetd (cq, record, field)
+
+pointer cq                              #I The catalog database descriptor
+int     record                          #I The catalog database index
+char    field[ARB]                      #I The catalog database field
+
+double  dval
+char    name[SZ_LINE]
+
+int     fscan(), nscan()
+bool    streq()
+
+begin
+        if ((record < 1) || (record > CQ_NRECS(cq)))
+            call error (0, "The catalog record is out of bounds")
+
+        call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
+
+        while (fscan (CQ_FD(cq)) != EOF) {
+            call gargwrd (name, SZ_LINE)
+
+            if (streq (name, "begin"))
+                break
+            else if (streq (name, field)) {
+                call gargd (dval)
+                if (nscan() == 2)
+                   return (dval)
+                else
+                   call error (0, "Error reading double catalog field value")
+            }
+        }
+
+        call error (0, "Catalog record field not found")
+end
+
+
+# CQ_DGWRD -- Get a string field from the database file.
+
+procedure cq_dgwrd (cq, record, field, str, maxchar)
+
+pointer	cq				#I The catalog access descriptor
+int	record				#I The catalog record index
+char	field[ARB]			#I The field name
+char	str[maxchar]			#O The output string value
+int	maxchar				#I The maximum characters for string
+
+char	name[SZ_LINE]
+int	i, fscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > CQ_NRECS(cq)))
+	    call error (0, "Catalog record is out of bounds")
+
+	call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
+
+	while (fscan (CQ_FD(cq)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargwrd (str, maxchar)
+		for (i=1; IS_WHITE(str[i]); i=i+1)
+		    ;
+		if (i > 1)
+		    call strcpy (str[i], str, maxchar)
+		return
+	    }
+	}
+
+	call error (0, "Catalog record field not found")
+end
+
+
+# CQ_DGSTR -- Get a string field from the database file.
+
+procedure cq_dgstr (cq, record, field, str, maxchar)
+
+pointer	cq				#I The catalog access descriptor
+int	record				#I The catalog record index
+char	field[ARB]			#I The field name
+char	str[maxchar]			#O The output string value
+int	maxchar				#I The maximum characters for string
+
+char	name[SZ_LINE]
+int	i, fscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > CQ_NRECS(cq)))
+	    call error (0, "Catalog record is out of bounds")
+
+	call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
+
+	while (fscan (CQ_FD(cq)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargstr (str, maxchar)
+		for (i=1; IS_WHITE(str[i]); i=i+1)
+		    ;
+		if (i > 1)
+		    call strcpy (str[i], str, maxchar)
+		return
+	    }
+	}
+
+	call error (0, "Catalog record field not found")
+end
+
+
+# CQ_DGAI -- Get an integer array field from a record.
+
+procedure cq_dgai (cq, record, field, array, len_array, npts)
+
+pointer	cq				#I The database catalog record
+int	record				#I The database record index
+char	field[ARB]			#I The database field
+int	array[len_array]		#O The output array values
+int	len_array			#I The length of array
+int	npts				#O The number of points in the array
+
+char	name[SZ_LINE]
+int	i
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > CQ_NRECS(cq)))
+	    call error (0, "The catalog record is out of bounds")
+
+	call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
+
+	while (fscan (CQ_FD(cq)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (npts)
+		if (nscan() != 2)
+		    call error (0, "Error reading size of integer array")
+
+		npts = min (npts, len_array)
+		for (i = 1; i <= npts; i = i + 1) {
+		    if (fscan (CQ_FD(cq)) == EOF)
+		        call error (0, "The integer array is truncated")
+
+		    call gargi (array[i])
+		    if (nscan() != 1)
+		        call error (0, "Error decoding integer array")
+		}
+		return
+	    }
+	}
+
+	call error (0, "The catalog record field not found")
+end
+
+
+# CQ_DGAR -- Get a real array field from a record.
+
+procedure cq_dgar (cq, record, field, array, len_array, npts)
+
+pointer	cq				#I The database catalog record
+int	record				#I The database record index
+char	field[ARB]			#I The database field
+real	array[len_array]		#O The output array values
+int	len_array			#I The length of array
+int	npts				#O The number of points in the array
+
+char	name[SZ_LINE]
+int	i
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > CQ_NRECS(cq)))
+	    call error (0, "The catalog record is out of bounds")
+
+	call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
+
+	while (fscan (CQ_FD(cq)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (npts)
+		if (nscan() != 2)
+		    call error (0, "Error reading real array size value")
+
+		npts = min (npts, len_array)
+		for (i = 1; i <= npts; i = i + 1) {
+		    if (fscan (CQ_FD(cq)) == EOF)
+		        call error (0, "The real array is truncated")
+
+		    call gargr (array[i])
+		    if (nscan() != 1)
+		        call error (0, "Error reading real array")
+		}
+		return
+	    }
+	}
+
+	call error (0, "The catalog record field not found")
+end
+
+
+# CQ_DGAD -- Get a double array field from a catalog.
+
+procedure cq_dgad (cq, record, field, array, len_array, npts)
+
+pointer	cq				#I The catalog database descriptor
+int	record				#I The catalog record index
+char	field[ARB]			#I The database field
+double	array[len_array]		#O The array values
+int	len_array			#I The length of array
+int	npts				#O The number of points in the array
+
+char	name[SZ_LINE]
+int	i
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > CQ_NRECS(cq)))
+	    call error (0, "The catalog record is out of bounds")
+
+	call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
+
+	while (fscan (CQ_FD(cq)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (npts)
+		if (nscan() != 2)
+		    call error (0, "Error the double array size")
+
+		npts = min (npts, len_array)
+		for (i = 1; i <= npts; i = i + 1) {
+		    if (fscan (CQ_FD(cq)) == EOF)
+		        call error (0, "The double array is truncated")
+
+		    call gargd (array[i])
+		    if (nscan() != 1)
+		        call error (0, "Error reading the double array")
+		}
+		return
+	    }
+	}
+
+	call error (0, "Catalog record field not found")
+end
+
+
+# CQ_DGATXT -- Get newline delimited text from a database file.
+
+procedure cq_dgatxt (cq, record, field, str, maxchar, nlines)
+
+pointer	cq				#I The catalog access descriptor
+int	record				#I The catalog record index
+char	field[ARB]			#I The field name
+char	str[maxchar]			#O The output string value
+int	maxchar				#I The maximum characters for string
+int	nlines				#I the number of text lines
+
+char	name[SZ_LINE]
+int	i, op
+int	fscan(), nscan(), gstrcpy()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > CQ_NRECS(cq)))
+	    call error (0, "Catalog record is out of bounds")
+
+	call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
+
+	while (fscan (CQ_FD(cq)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (nlines)
+		if (nscan() != 2)
+		    call error (0, "Error text array length")
+		op = 1
+		do i = 1, nlines {
+		    if (fscan (CQ_FD(cq)) == EOF)
+		        call error (0, "The text array is truncated")
+		    call gargstr (name, SZ_LINE)
+		    op = op + gstrcpy (name, str[op], maxchar - op +1)
+		    if (op > maxchar)
+			break
+		    str[op] = '\n'
+		    op = op  + 1
+		    str[op] = EOS
+		}
+
+		return
+	    }
+	}
+
+	call error (0, "Catalog record field not found")
+end
+
+
+## DTPTIME -- Put a time string with a comment
+#
+#procedure dtptime (dt)
+#
+#pointer	dt				# DTTEXT pointer
+#
+#char	timestr[SZ_TIME]
+#long	time, clktime()
+#
+#begin
+#	time = clktime (0)
+#	call cnvtime (time, timestr, SZ_TIME)
+#	call fprintf (DT(dt), "# %s\n")
+#	    call pargstr (timestr)
+#end
+#
+#
+## DTPUT -- Print to database.
+#
+#procedure dtput (dt, format)
+#
+#pointer	dt				# DTTEXT pointer
+#char	format[ARB]			# String format
+#
+#begin
+#	call fprintf (DT(dt), format)
+#end
+
+# CQ_DSCAN -- Scan database.
+
+int procedure cq_dscan (cq)
+
+pointer	cq				# The catalog database descriptor.
+
+int	fscan()
+
+begin
+	return (fscan (CQ_FD(cq)))
+end
diff --git a/pkg/xtools/catquery/cqdef.h b/pkg/xtools/catquery/cqdef.h
new file mode 100644
index 00000000..6337bd9f
--- /dev/null
+++ b/pkg/xtools/catquery/cqdef.h
@@ -0,0 +1,133 @@
+# Private definitions file for the catalog query interface.
+
+
+# Miscellaneous definitions mostly concerning buffer sizes.
+
+#define CQ_SZ_LINE    SZ_LINE           # The text storage size in chars
+define CQ_SZFNAME    (1+SZ_FNAME) / 2   # The file name storage size in structs
+define CQ_SZLINE     (1+SZ_LINE) / 2    # The text storage size in structs
+define CQ_ALLOC       20		# The record allocation block size
+
+define USE_URLGET	TRUE
+
+
+# The catalog record map descriptor (borrowed from dttext interface). 
+
+define	CQ_LEN	     (8 + 2 * CQ_SZFNAME)
+
+define	CQ_FD	      Memi[$1]		        # The database FIO channel
+define	CQ_MODE	      Memi[$1+1]	        # The database access mode
+define	CQ_NRECS      Memi[$1+2]		# The number of records
+define	CQ_MAP	      Memi[$1+3]		# The pointer to record names
+define	CQ_NAMES      Memi[$1+4]		# The pointer to name indices
+define	CQ_OFFSETS    Memi[$1+5]		# The pointer to record offsets
+define	CQ_CATNO      Memi[$1+6]		# The current catalog number
+define	CQ_CAT	      Memi[$1+7]  		# The current catalog descriptor
+define	CQ_CATDB      Memc[P2C($1+8)]           # The database file name
+define	CQ_CATNAME    Memc[P2C($1+8+CQ_SZFNAME)]# The current catalog name
+
+define	CQ_NAMEI      Memi[CQ_NAMES($1)+$2-1]
+define	CQ_NAME	      Memc[CQ_MAP($1)+CQ_NAMEI($1,$2)]
+define	CQ_OFFSET     Meml[CQ_OFFSETS($1)+$2-1]
+
+
+# The current catalog desciptor. 
+
+define	CQ_LEN_CC    (15 + 2 * CQ_SZLINE) 
+define	QOFFSET	      P2C($1+15+$2*CQ_SZLINE)
+
+define	CQ_NQPARS     Memi[$1]	                # The no of query params
+define	CQ_PQPNAMES   Memi[$1+1]	        # The query param names ptr
+define	CQ_PQPDVALUES Memi[$1+2]	        # The query param defaults ptr
+define	CQ_PQPVALUES  Memi[$1+3]	        # The query param values ptr
+define	CQ_PQPUNITS   Memi[$1+4]	        # The query param units ptr
+define	CQ_PQPFMTS    Memi[$1+5]                # The query param format ptr
+define	CQ_HFMT	      Memi[$1+6]		# The header format 
+define	CQ_ADDRESS    Memc[QOFFSET($1,0)]       # The catalog address
+define	CQ_QUERY      Memc[QOFFSET($1,1)]       # The network query
+
+# The catalog results descriptor.
+
+define	CQ_LEN_RES	(30+2*CQ_SZFNAME+2*CQ_SZLINE)
+define	ROFFSET	        P2C($1+30+$2*CQ_SZFNAME+$3*CQ_SZLINE)
+
+define	CQ_RNQPARS	Memi[$1]        # The number of query params
+define	CQ_RQPNAMES     Memi[$1+1]      # The query param names ptr
+define	CQ_RQPVALUES    Memi[$1+2]      # The query param values ptr
+define	CQ_RQPUNITS     Memi[$1+3]      # The query param units ptr
+
+define	CQ_RTYPE	Memi[$1+4]	# The results data format
+define	CQ_RECSIZE	Memi[$1+5]      # The results record size 
+define	CQ_RHSKIP	Memi[$1+6]      # The number of header records to skip
+define	CQ_RTRIML	Memi[$1+7]      # The beginning of record trim 
+define	CQ_RTRIMR	Memi[$1+8]      # The end of record trim 
+define	CQ_RTSKIP	Memi[$1+9]      # The number of trailer records to skip
+
+define	CQ_NHEADER	Memi[$1+10]	# The number of header keywords
+define	CQ_HKNAMES	Memi[$1+11]     # The results keyword names
+define	CQ_HKVALUES	Memi[$1+12]     # The result keyword values
+
+define	CQ_NFIELDS	Memi[$1+13]	# The number of record fields
+define	CQ_FNAMES	Memi[$1+14]     # The record field names
+define	CQ_FTYPES	Memi[$1+15]     # The record field data types ptr
+define	CQ_FOFFSETS	Memi[$1+16]     # The record field offsets ptr
+define	CQ_FSIZES	Memi[$1+17]     # The record field sizes ptr
+define	CQ_FUNITS	Memi[$1+18]     # The record field units
+define	CQ_FFMTS	Memi[$1+19]     # The record field formats
+
+define	CQ_RFD		Memi[$1+20]     # The results file descriptor
+define	CQ_RBUF		Memi[$1+21]     # The results data descriptor
+define	CQ_RNRECS	Memi[$1+22]     # The number of results records
+define	CQ_RINDEX	Memi[$1+23]	# The results record index pointer
+
+define	CQ_RECPTR	Memi[$1+24] 	# The current record
+define	CQ_FNFIELDS	Memi[$1+25]     # The number of fields in current record
+define	CQ_FINDICES	Memi[$1+26]     # The current record indices pointer
+
+define	CQ_RCATDB	Memc[ROFFSET($1,0,0)] # The catalog database name
+define	CQ_RCATNAME	Memc[ROFFSET($1,1,0)] # The catalog name
+
+define	CQ_RADDRESS	Memc[ROFFSET($1,2,0)] # Query address
+define	CQ_RQUERY	Memc[ROFFSET($1,2,1)] # Query string
+
+# The image survey descriptor. May need to extend this structure as more
+# experience with different image formats is obtained. May not need wcs and
+# keyword default value strings ...
+
+define	CQ_LEN_IM	(30+3*CQ_SZFNAME+2*CQ_SZLINE)
+define	IOFFSET	        P2C($1+30+$2*CQ_SZFNAME+$3*CQ_SZLINE)
+
+define	CQ_INQPARS	Memi[$1]        # The number of query params
+define	CQ_IQPNAMES     Memi[$1+1]      # The query param names ptr
+define	CQ_IQPVALUES    Memi[$1+2]      # The query param values ptr
+define	CQ_IQPUNITS     Memi[$1+3]      # The query param units ptr
+define	CQ_IMTYPE	Memi[$1+4]	# The image data format
+
+define	CQ_WCS		Memi[$1+10]      # The image wcs type
+define	CQ_NWCS		Memi[$1+11]	# The number of wcs keywords
+define	CQ_WPNAMES	Memi[$1+12]     # The wcs parameter names
+define	CQ_WKNAMES	Memi[$1+13]	# The wcs keyword names	
+define	CQ_WKDVALUES	Memi[$1+14]	# The wcs keyword default values
+define	CQ_WKVALUES	Memi[$1+15]	# The wcs keyword values
+define	CQ_WKTYPES	Memi[$1+16]	# The wcs keyword data types
+define	CQ_WKUNITS	Memi[$1+17]	# The wcs keyword value units
+
+define	CQ_NIMPARS	Memi[$1+19]	# The number of header keywords
+define	CQ_IPNAMES	Memi[$1+20]     # The results keyword names
+define	CQ_IKNAMES	Memi[$1+21]     # The result keyword values
+define	CQ_IKDVALUES	Memi[$1+22]     # The result keyword values
+define	CQ_IKVALUES	Memi[$1+23]     # The result keyword values
+define	CQ_IKTYPES	Memi[$1+24]     # The result keyword values
+define	CQ_IKUNITS	Memi[$1+25]     # The result keyword values
+
+define	CQ_IMCATDB	Memc[IOFFSET($1,0,0)] # The survey database name
+define	CQ_IMCATNAME	Memc[IOFFSET($1,1,0)] # The survey name
+define	CQ_IMNAME	Memc[IOFFSET($1,2,0)] # The image name
+
+define	CQ_IMADDRESS	Memc[IOFFSET($1,3,0)] # Query address
+define	CQ_IMQUERY	Memc[IOFFSET($1,3,1)] # Query string
+
+
+define	CQ_HFMTSTR	"|none|http|"
+define	CQ_HNONE	1
+define	CQ_HHTTP	2
diff --git a/pkg/xtools/catquery/cqdtype.x b/pkg/xtools/catquery/cqdtype.x
new file mode 100644
index 00000000..e0088590
--- /dev/null
+++ b/pkg/xtools/catquery/cqdtype.x
@@ -0,0 +1,53 @@
+# CQ_DTYPE -- Decode the field data type.
+
+define	NTYPES	6
+
+# CQ_DTYPE -- Given a single character data type from the set [csilrd] return
+# the appropriate integer type,
+
+int procedure cq_dtype (c)
+
+char    c
+
+int     type_codes[NTYPES], i
+string  types "csilrd"
+int     stridx()
+data    type_codes /TY_CHAR, TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE/
+begin
+        i = stridx (c, types)
+        if (i == 0)
+            return (TY_CHAR)
+        else
+            return (type_codes[stridx(c,types)])
+end
+
+# CQ_ITYPE -- Given an integer code from the set TY_CHAR, TY_SHORT, TY_INT,
+# TY_LONG, TY_REAL, and TY_DOUBLE return the appropriate character code
+# from the set [csilrd].
+
+char procedure cq_itype (itype)
+
+int	itype		#I the integer data type
+
+char	c
+
+begin
+	switch (itype) {
+	case TY_CHAR:
+	    c = 'c'
+	case TY_SHORT:
+	    c = 's'
+	case TY_INT:
+	    c = 'i'
+	case TY_LONG:
+	    c = 'l'
+	case TY_REAL:
+	    c = 'r'
+	case TY_DOUBLE:
+	    c = 'd'
+	default:
+	    c = 'c'
+	}
+
+	return (c)
+end
diff --git a/pkg/xtools/catquery/cqget.x b/pkg/xtools/catquery/cqget.x
new file mode 100644
index 00000000..ea259bb5
--- /dev/null
+++ b/pkg/xtools/catquery/cqget.x
@@ -0,0 +1,225 @@
+include "cqdef.h"
+include "cq.h"
+
+# These routines fetch fields from the catalog configuation by field name.
+# They can be used by the calling program to read quantities of interest
+# directly from the configuration file. In most applications it should
+# not be necessary to use these routines as the main interface routines
+# provide most of the desired functionality, but they are included for
+# completeness.
+
+# CQ_FGETI -- Fetch an integer field from the current catalog.
+
+int procedure cq_fgeti (cq, field)
+
+pointer	cq				#I the catalog descriptor
+char	field[ARB]			#I the field name
+
+int	ival
+int	cq_dgeti()
+errchk	cq_dgeti()
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    call error (0, "The current catalog is undefined")
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    call error (0, "The current catalog is undefined")
+
+	ival = cq_dgeti (cq, CQ_CATNO(cq), field)
+
+	return (ival)
+end
+
+
+# CQ_FGETR -- Fetch a real field from the current catalog.
+
+real procedure cq_fgetr (cq, field)
+
+pointer	cq				#I the catalog descriptor
+char	field[ARB]			#I the field name
+
+real	rval
+real	cq_dgetr()
+errchk	cq_dgetr()
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    call error (0, "The current catalog is undefined")
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    call error (0, "The current catalog is undefined")
+
+	rval = cq_dgetr (cq, CQ_CATNO(cq), field)
+
+	return (rval)
+end
+
+
+# CQ_FGETD -- Fetch a double precision field from the current catalog.
+
+double procedure cq_fgetd (cq, field)
+
+pointer	cq				#I the catalog descriptor
+char	field[ARB]			#I the field name
+
+double	dval
+double	cq_dgetd()
+errchk	cq_dgetd()
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    call error (0, "The current catalog is undefined")
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    call error (0, "The current catalog is undefined")
+
+	dval = cq_dgetd (cq, CQ_CATNO(cq), field)
+
+	return (dval)
+end
+
+
+# CQ_FGAI -- Get an array valued integer parameter.
+
+int procedure cq_fgai (cq, field, array, max_len)
+
+pointer	cq				#I the catalog descriptor
+char	field[ARB]			#I the field name
+int	array[ARB]			#O the output array
+int	max_len				#I the maximum length of the array
+
+int	npts
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    call error (0, "The current catalog is undefined")
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    call error (0, "The current catalog is undefined")
+
+	call cq_dgai (cq, CQ_CATNO(cq), field, array, max_len, npts)
+
+	return (npts)
+end
+
+
+# CQ_FGAR -- Get an array valued real parameter.
+
+int procedure cq_fgar (cq, field, array, max_len)
+
+pointer	cq				#I the catalog descriptor
+char	field[ARB]			#I the field name
+real	array[ARB]			#O the output array
+int	max_len				#I the maximum length of the array
+
+int	npts
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    call error (0, "The current catalog is undefined")
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    call error (0, "The current catalog is undefined")
+
+	call cq_dgar (cq, CQ_CATNO(cq), field, array, max_len, npts)
+
+	return (npts)
+end
+
+
+# CQ_FGAD -- Get an array valued double parameter.
+
+int procedure cq_fgad (cq, field, array, max_len)
+
+pointer	cq				#I the catalog descriptor
+char	field[ARB]			#I the field name
+double	array[ARB]			#O the output array
+int	max_len				#I the maximum length of the array
+
+int	npts
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    call error (0, "The current catalog is undefined")
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    call error (0, "The current catalog is undefined")
+
+	call cq_dgad (cq, CQ_CATNO(cq), field, array, max_len, npts)
+
+	return (npts)
+end
+
+
+# CQ_FGWRD -- Fetch a single word field from the current catalog.
+
+procedure cq_fgwrd (cq, field, str, maxch)
+
+pointer	cq				#I the catalog descriptor
+char	field[ARB]			#I the field name
+char	str[ARB]			#O the output string
+int	maxch				#I the maximum number of characters
+
+errchk	cq_dgwrd()
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    call error (0, "The current catalog is undefined")
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    call error (0, "The current catalog is undefined")
+
+	call cq_dgwrd (cq, CQ_CATNO(cq), field, str, maxch)
+end
+
+
+# CQ_FGSTR -- Fetch a string field from the current catalog.
+
+procedure cq_fgstr (cq, field, str, maxch)
+
+pointer	cq				#I the catalog descriptor
+char	field[ARB]			#I the field name
+char	str[ARB]			#O the output string
+int	maxch				#I the maximum number of characters
+
+errchk	cq_dgwrd()
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    call error (0, "The current catalog is undefined")
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    call error (0, "The current catalog is undefined")
+
+	call cq_dgstr (cq, CQ_CATNO(cq), field, str, maxch)
+end
+
+
+# CQ_FGTEXT -- Fetch a multi-line text field from the current catalog.
+
+int procedure cq_fgtext (cq, field, str, maxch)
+
+pointer	cq				#I the catalog descriptor
+char	field[ARB]			#I the field name
+char	str[ARB]			#O the output string
+int	maxch				#I the maximum number of characters
+
+int	nlines
+errchk	cq_dgatxt()
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    call error (0, "The current catalog is undefined")
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    call error (0, "The current catalog is undefined")
+
+	call cq_dgatxt (cq, CQ_CATNO(cq), field, str, maxch, nlines)
+
+	return (nlines)
+end
+
+
+# CQ_SCAN -- Scan the database at the current position.
+
+int procedure cq_scan (cq)
+
+pointer cq                              # The catalog database descriptor.
+
+int     fscan()
+
+begin
+        return (fscan (CQ_FD(cq)))
+end
diff --git a/pkg/xtools/catquery/cqgfields.x b/pkg/xtools/catquery/cqgfields.x
new file mode 100644
index 00000000..23b94221
--- /dev/null
+++ b/pkg/xtools/catquery/cqgfields.x
@@ -0,0 +1,483 @@
+include <ctype.h>
+include "cqdef.h"
+include "cq.h"
+
+# CQ_SETRECORD -- Set the the current record. What action this procedure takes
+# depends on the input data type. In the case of text files this task
+# sets the current record pointer and figures where in the record each
+# column begins. For blocked text files the foffsets determine where each
+# record begins.
+
+int procedure cq_setrecord (res, recptr)
+
+pointer	res			#I the results descriptor
+int	recptr			#U the current record pointer
+
+pointer	buf
+
+begin
+	# The record is outside the record data range.
+	if (recptr <= 0) {
+	    CQ_RECPTR(res) = 0
+	    CQ_FNFIELDS(res) = 0
+	    call aclri (Memi[CQ_FINDICES(res)], CQ_MAX_NFIELDS + 1)
+	    return (BOF)
+	}
+	if (recptr > CQ_RNRECS(res))
+	    return (EOF)
+
+	CQ_RECPTR(res) = recptr
+	switch (CQ_RTYPE(res)) {
+	case CQ_STEXT:
+	    buf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    call cq_find_fields (Memc[buf], Memi[CQ_FINDICES(res)],
+	        CQ_MAX_NFIELDS, CQ_FNFIELDS(res))
+	case CQ_BTEXT:
+	    ;
+	default:
+	}
+
+	return (recptr)
+end
+
+
+# CQ_GVALC -- Fetch a record field as a string value.
+
+int procedure cq_gvalc (res, recptr, field, str, maxch)
+
+pointer	res			#I the results descriptor
+int	recptr			#I the current record pointer
+char	field[ARB]		#I the record field name.
+char	str[ARB]		#O the output string parameter
+int	maxch			#I the maximum number of characters
+
+pointer	fbuf
+int	fnum, fip, fsize
+int	cq_fnumber(), cq_setrecord()
+
+begin
+	# The record is outside the record data range.
+	str[1] = EOS
+	if (recptr <= 0 || recptr > CQ_RNRECS(res))
+	    return (0)
+
+	# Find the field number.
+	fnum = cq_fnumber (res, field)
+	if (fnum <= 0)
+	    return (0)
+
+	# Set the current record if necessary.
+	if (recptr != CQ_RECPTR(res)) {
+	    if (cq_setrecord (res, recptr) != recptr)
+		return (0)
+	}
+
+	# Extract the requested field as a string. If the data is in binary
+	# internally this will require formatting a string. If the data is
+	# text this requires extracting the appropriate piece of text.
+
+	switch (CQ_RTYPE(res)) {
+
+	case CQ_STEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fnum = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fip = Memi[CQ_FINDICES(res)+fnum-1]
+	    fsize = min (maxch, Memi[CQ_FINDICES(res)+fnum] -
+	        Memi[CQ_FINDICES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], str, fsize)
+
+	case CQ_BTEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fip = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fsize = min (maxch, Memi[CQ_FSIZES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], str, fsize)
+
+	default:
+	    fsize = 0
+
+	}
+
+	return (fsize)
+end
+
+
+# CQ_GVALD -- Return a double precision field value 
+
+int procedure cq_gvald (res, recptr, field, dval)
+
+pointer	res			#I the results descriptor
+int	recptr			#I the current record pointer
+char	field[ARB]		#I the record field name.
+double	dval			#O the output double value
+
+pointer	fbuf, sp, line
+int	fnum, fip, fsize, nchars
+int	cq_fnumber(), ctod(), cq_setrecord()
+
+begin
+	dval = INDEFD
+
+	# The record is outside the record data range.
+	if (recptr <= 0 || recptr > CQ_RNRECS(res))
+	    return (0)
+
+	# Find the field number.
+	fnum = cq_fnumber (res, field)
+	if (fnum <= 0)
+	    return (0)
+
+	# Set the current record if necessary.
+	if (recptr != CQ_RECPTR(res)) {
+	    if (cq_setrecord (res, recptr) != recptr)
+		return (0)
+	}
+
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	# Extract the requested field as a double precision value. If the data
+	# is in binary internally this may imply a type conversion. If the data
+	# is text this requires decoding the string value.
+
+	switch (CQ_RTYPE(res)) {
+
+	case CQ_STEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fnum = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fip = Memi[CQ_FINDICES(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] -
+	        Memi[CQ_FINDICES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctod (Memc[line], fip, dval) 
+
+	case CQ_BTEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fip = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctod (Memc[line], fip, dval)
+
+	default:
+	    nchars = 0
+
+	}
+
+	call sfree (sp)
+
+	return (nchars)
+end
+
+
+# CQ_GVALR -- Return a real precision field value.
+
+int procedure cq_gvalr (res, recptr, field, rval)
+
+pointer	res			#I the results descriptor
+int	recptr			#I the current record pointer
+char	field[ARB]		#I the record field name.
+real	rval			#O the output real value
+
+pointer	fbuf, sp, line
+int	fnum, fip, fsize, nchars
+int	cq_fnumber(), ctor(), cq_setrecord()
+
+begin
+	rval = INDEFR
+
+	# The record is outside the record data range.
+	if (recptr <= 0 || recptr > CQ_RNRECS(res))
+	    return (0)
+
+	# Find the field number.
+	fnum = cq_fnumber (res, field)
+	if (fnum <= 0)
+	    return (0)
+
+	# Set the current record if necessary.
+	if (recptr != CQ_RECPTR(res)) {
+	    if (cq_setrecord (res, recptr) != recptr)
+		return (0)
+	}
+
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	# Extract the requested field as a double precision value. If the data
+	# is in binary internally this may imply a type conversion. If the data
+	# is text this requires decoding the string value.
+
+	switch (CQ_RTYPE(res)) {
+
+	case CQ_STEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fnum = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fip = Memi[CQ_FINDICES(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] -
+	        Memi[CQ_FINDICES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctor (Memc[line], fip, rval)
+
+	case CQ_BTEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fip = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctor (Memc[line], fip, rval)
+
+	default:
+	    nchars = 0
+
+	}
+
+	call sfree (sp)
+
+	return (nchars)
+end
+
+
+# CQ_GVALL -- Return a long integer field value.
+
+int procedure cq_gvall (res, recptr, field, lval)
+
+pointer	res			#I the results descriptor
+int	recptr			#I the current record pointer
+char	field[ARB]		#I the record field name.
+long	lval			#I the output long value
+
+pointer	fbuf, sp, line
+int	fnum, fip, fsize, nchars
+int	cq_fnumber(), ctol(), cq_setrecord()
+
+begin
+	lval = INDEFL
+
+	# The record is outside the record data range.
+	if (recptr <= 0 || recptr > CQ_RNRECS(res))
+	    return (0)
+
+	# Find the field number.
+	fnum = cq_fnumber (res, field)
+	if (fnum <= 0)
+	    return (0)
+
+	# Set the current record if necessary.
+	if (recptr != CQ_RECPTR(res)) {
+	    if (cq_setrecord (res, recptr) != recptr)
+		return(0)
+	}
+
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	# Extract the requested field as a double precision value. If the data
+	# is in binary internally this may imply a type conversion. If the data
+	# is text this requires decoding the string value.
+
+	switch (CQ_RTYPE(res)) {
+
+	case CQ_STEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fnum = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fip = Memi[CQ_FINDICES(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] -
+	        Memi[CQ_FINDICES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctol (Memc[line], fip, lval)
+
+	case CQ_BTEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fip = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctol (Memc[line], fip, lval) 
+
+	default:
+	    nchars = 0
+
+	}
+
+	call sfree (sp)
+
+	return (nchars)
+end
+
+
+# CQ_GVALI -- Return an integer field value 
+
+int procedure cq_gvali (res, recptr, field, ival)
+
+pointer	res			#I the results descriptor
+int	recptr			#I the current record pointer
+char	field[ARB]		#I the record field name.
+int	ival			#I the output int value
+
+pointer	fbuf, sp, line
+int	fnum, fip, fsize, nchars
+int	cq_fnumber(), ctoi(), cq_setrecord()
+
+begin
+	ival = INDEFI
+
+	# The record is outside the record data range.
+	if (recptr <= 0 || recptr > CQ_RNRECS(res))
+	    return (0)
+
+	# Find the field number.
+	fnum = cq_fnumber (res, field)
+	if (fnum <= 0)
+	    return (0)
+
+	# Set the current record if necessary.
+	if (recptr != CQ_RECPTR(res)) {
+	    if (cq_setrecord (res, recptr) != recptr)
+		return (0)
+	}
+
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	# Extract the requested field as a double precision value. If the data
+	# is in binary internally this may imply a type conversion. If the data
+	# is text this requires decoding the string value.
+
+	switch (CQ_RTYPE(res)) {
+
+	case CQ_STEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fnum = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fip = Memi[CQ_FINDICES(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] -
+	        Memi[CQ_FINDICES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctoi (Memc[line], fip, ival)
+
+	case CQ_BTEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fip = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctoi (Memc[line], fip, ival) 
+
+	default:
+	    nchars = 0
+	}
+
+	call sfree (sp)
+
+	return (nchars)
+end
+
+
+# CQ_GVALS -- Return a short integer field value 
+
+int procedure cq_gvals (res, recptr, field, sval)
+
+pointer	res			#I the results descriptor
+int	recptr			#I the current record pointer
+char	field[ARB]		#I the record field name.
+short	sval			#O the output short value
+
+pointer	fbuf, sp, line
+int	fnum, fip, fsize, nchars, ival
+int	cq_fnumber(), ctoi(), cq_setrecord()
+
+begin
+	sval = INDEFS
+
+	# The record is outside the record data range.
+	if (recptr <= 0 || recptr > CQ_RNRECS(res))
+	    return (0)
+
+	# Find the field number.
+	fnum = cq_fnumber (res, field)
+	if (fnum <= 0)
+	    return (0)
+
+	# Set the current record if necessary.
+	if (recptr != CQ_RECPTR(res)) {
+	    if (cq_setrecord (res, recptr) != recptr)
+		return (0)
+	}
+
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	# Extract the requested field as a double precision value. If the data
+	# is in binary internally this may imply a type conversion. If the data
+	# is text this requires decoding the string value.
+
+	switch (CQ_RTYPE(res)) {
+
+	case CQ_STEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fnum = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fip = Memi[CQ_FINDICES(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] -
+	        Memi[CQ_FINDICES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctoi (Memc[line], fip, ival)
+	    if (nchars > 0)
+	        sval = ival
+
+	case CQ_BTEXT:
+	    fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1
+	    fip = Memi[CQ_FOFFSETS(res)+fnum-1]
+	    fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1])
+	    call strcpy (Memc[fbuf+fip-1], Memc[line], fsize)
+	    fip = 1
+	    nchars = ctoi (Memc[line], fip, ival)
+	    if (nchars > 0)
+		sval = ival
+
+	default:
+	    nchars = 0
+
+	}
+
+	call sfree (sp)
+
+	return (nchars)
+end
+
+
+# CQ_FIND_FIELDS -- This procedure finds the starting column for each field
+# in the input line.  These column numbers are returned in the array
+# field_pos; the number of fields is also returned.
+
+procedure cq_find_fields (linebuf, field_pos, max_fields, nfields)
+
+char    linebuf[ARB]                    #I the input buffer
+int     field_pos[max_fields]           #O the output field positions
+int     max_fields                      #I the maximum number of fields
+int     nfields                         #O the computed number of fields
+
+bool    in_field
+int     ip, field_num
+
+begin
+        field_num = 1
+        field_pos[1] = 1
+        in_field = false
+
+        for (ip=1; linebuf[ip] != '\n' && linebuf[ip] != EOS; ip=ip+1) {
+            if (! IS_WHITE(linebuf[ip]))
+                in_field = true
+            else if (in_field) {
+                in_field = false
+                field_num = field_num + 1
+                field_pos[field_num] = ip
+            }
+        }
+
+        field_pos[field_num+1] = ip
+        nfields = field_num
+end
diff --git a/pkg/xtools/catquery/cqgqpars.x b/pkg/xtools/catquery/cqgqpars.x
new file mode 100644
index 00000000..627dd053
--- /dev/null
+++ b/pkg/xtools/catquery/cqgqpars.x
@@ -0,0 +1,99 @@
+include "cqdef.h"
+
+
+# CQ_GQPAR -- Get the default value, units, and format for a query parameter
+# by name.
+
+int procedure cq_gqpar (cq, name, pname, max_name, value, max_val, units,
+	max_units, format, max_format)
+
+pointer	cq				#I the catalog descriptor
+char	name[ARB]			#I the input query parameter name
+char	pname[ARB]			#I the output query parameter name
+int	max_name			#I the max size of the parameter name
+char	value[ARB]			#O the default value size
+int	max_val				#I the max size of the parameter value
+char	units[ARB]			#O the units string
+int	max_units			#I the max size of the parameter units
+char	format[ARB]			#O the format string
+int	max_format			#I the max size of the parameter format
+
+pointer	cc
+int	parno
+int	strdic(), cq_wrdstr()
+
+begin
+	# Check that the current catalog is defined.
+	if (CQ_CAT(cq) == NULL)
+	    return (0)
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    return (0)
+	cc = CQ_CAT(cq)
+
+	parno = strdic (name, pname, max_name, Memc[CQ_PQPNAMES(cc)])
+	if (parno <= 0)
+	    return (0)
+
+	parno = cq_wrdstr (parno, value, max_val, Memc[CQ_PQPDVALUES(cc)])
+	if (parno <= 0)
+	    return (0)
+
+	parno = cq_wrdstr (parno, units, max_units, Memc[CQ_PQPUNITS(cc)])
+	if (parno <= 0)
+	    return (0)
+
+	parno = cq_wrdstr (parno, format, max_format, Memc[CQ_PQPFMTS(cc)])
+	if (parno <= 0)
+	    return (0)
+
+	return (parno)
+end
+
+
+# CQ_GQPARN -- Get the default value, units, and format for a query parameter
+# by number.
+
+int procedure cq_gqparn (cq, parno, pname, max_name, value, max_val, units,
+	max_units, format, max_format)
+
+pointer	cq				#I the catalog descriptor
+int	parno				#I the parameter number
+char	pname[ARB]			#I the output query parameter name
+int	max_name			#I the max size of the parameter name
+char	value[ARB]			#O the default value size
+int	max_val				#I the max size of the parameter value
+char	units[ARB]			#O the units string
+int	max_units			#I the max size of the parameter units
+char	format[ARB]			#O the format string
+int	max_format			#I the max size of the parameter format
+
+pointer	cc
+int	pnum
+int	cq_wrdstr()
+
+begin
+	# Check that the current catalog is defined.
+	if (CQ_CAT(cq) == NULL)
+	    return (0)
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    return (0)
+	cc = CQ_CAT(cq)
+
+	pnum = cq_wrdstr (parno, pname, max_name, Memc[CQ_PQPNAMES(cc)])
+	if (pnum <= 0)
+	    return (0)
+
+	pnum = cq_wrdstr (parno, value, max_val, Memc[CQ_PQPDVALUES(cc)])
+	if (pnum <= 0)
+	    return (0)
+
+	pnum = cq_wrdstr (parno, units, max_units, Memc[CQ_PQPUNITS(cc)])
+	if (pnum <= 0)
+	    return (0)
+
+	pnum = cq_wrdstr (parno, format, max_format, Memc[CQ_PQPFMTS(cc)])
+	if (pnum <= 0)
+	    return (0)
+
+	return (pnum)
+end
diff --git a/pkg/xtools/catquery/cqgrecords.x b/pkg/xtools/catquery/cqgrecords.x
new file mode 100644
index 00000000..f7debe94
--- /dev/null
+++ b/pkg/xtools/catquery/cqgrecords.x
@@ -0,0 +1,83 @@
+include "cqdef.h"
+include "cq.h"
+
+
+# CQ_GNRECORD -- Get next record from the results descriptor.
+
+int procedure cq_gnrecord (res, buf, maxch, recptr)
+
+pointer	res			#I the results descriptor
+char	buf[ARB]		#O the output record buffer
+int	maxch			#I the maximum buffer size 
+int	recptr			#U the current record pointer
+
+int	nchars
+int	getline()
+
+begin
+	# The record is outside the record data range.
+	if (recptr < 0)
+	    return (BOF)
+	if (recptr >= CQ_RNRECS(res))
+	    return (EOF)
+
+	# Use file mechanism to extract record. Could also use buffer pointer
+	# and offsets 
+
+	switch (CQ_RTYPE(res)) {
+
+	# Don't worry about maxch at the moment. Just assume that the
+	# buffer is at least SZ_LINE long. Can use recsize to return
+	# a buffer, SZ_LINE is the default. May need to use getlline 
+	# in future.
+
+	case CQ_STEXT, CQ_BTEXT:
+	    call seek (CQ_RFD(res), Meml[CQ_RINDEX(res)+recptr])
+	    nchars = getline (CQ_RFD(res), buf)
+	    recptr = recptr + 1
+	    return (nchars)
+
+	default:
+	    return (EOF)
+	}
+end
+
+
+# CQ_GRECORD -- Get a specified record from the results descriptor.
+
+int procedure cq_grecord (res, buf, maxch, recptr)
+
+pointer	res			#I the results descriptor
+char	buf[ARB]		#O the output record buffer
+int	maxch			#I the maximum buffer size 
+int	recptr			#I the record to be extracted
+
+int	nchars
+int	getline()
+
+begin
+	# Check for out-of-bounds record requests.
+	if (recptr < 1)
+	    return (BOF)
+	if (recptr > CQ_RNRECS(res))
+	    return (EOF)
+
+	# Use file mechanism to extract record. Could also use buffer pointer
+	# and offsets 
+
+	switch (CQ_RTYPE(res)) {
+
+	# Don't worry about maxch at the moment. Just assume that the
+	# buffer is at least SZ_LINE long. Can use recsize to return
+	# a buffer, SZ_LINE is the default. May need to use getlline
+	# in future.
+
+	case CQ_STEXT, CQ_BTEXT:
+	    call seek (CQ_RFD(res), Meml[CQ_RINDEX(res)+recptr-1])
+	    nchars = getline (CQ_RFD(res), buf)
+	    return (nchars)
+
+	default:
+	    return (EOF)
+	}
+end
diff --git a/pkg/xtools/catquery/cqiminfo.x b/pkg/xtools/catquery/cqiminfo.x
new file mode 100644
index 00000000..898d1ed2
--- /dev/null
+++ b/pkg/xtools/catquery/cqiminfo.x
@@ -0,0 +1,220 @@
+include "cqdef.h"
+include "cq.h"
+
+
+# CQ_WINFO -- Get the WCS field description by field name.
+
+int procedure cq_winfo (res, wfield, wkname, sz_wkname, wkvalue, sz_wkvalue,
+	wktype, wkunits, sz_wkunits)
+
+pointer	res			#I the results descriptor
+char	wfield[ARB]		#I the field name
+char	wkname[ARB]		#O the output keyword name
+int	sz_wkname		#I the maximum size of the keyword name string
+char	wkvalue[ARB]		#O the current value string
+int	sz_wkvalue		#I the maximum size of the current value string
+int	wktype			#O the output field datatype 
+char	wkunits[ARB]		#O the outpit field units string
+int	sz_wkunits		#I the maximum size of the units string
+
+pointer	sp, fname
+int	fieldno
+int	strdic(), cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NWCS(res) <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	fieldno = strdic (wfield, Memc[fname], CQ_SZ_FNAME,
+	    Memc[CQ_WPNAMES(res)])
+	if (fieldno <= 0) {
+	    call sfree (sp)
+	    return (0)
+	}
+
+	# Get the field keyword name.
+	if (cq_wrdstr (fieldno, wkname, sz_wkname, Memc[CQ_WKNAMES(res)]) <= 0)
+	    wkname[1] = EOS
+
+	# Get the field keyword value.
+	if (cq_wrdstr (fieldno, wkvalue, sz_wkvalue,
+	    Memc[CQ_WKVALUES(res)]) <= 0)
+	    wkvalue[1] = EOS
+
+	# Get the field type.
+	wktype = Memi[CQ_WKTYPES(res)+fieldno-1]
+
+	# Get the field units.
+	if (cq_wrdstr (fieldno, wkunits, sz_wkunits,
+	    Memc[CQ_WKUNITS(res)]) <= 0)
+	    wkunits[1] = EOS
+
+	call sfree (sp)
+
+	return (fieldno)
+end
+
+
+# CQ_WINFON -- Get the WCS field description by field number.
+
+int procedure cq_winfon (res, fieldno, wfield, sz_wfield, wkname, sz_wkname,
+	wkvalue, sz_wkvalue, wktype, wkunits, sz_wkunits)
+
+pointer	res			#I the results descriptor
+int	fieldno			#I the input field number
+char	wfield[ARB]		#O the field name
+int	sz_wfield		#I the maximum size of the field string
+char	wkname[ARB]		#O the output keyword name
+int	sz_wkname		#I the maximum size of the keyword name string
+char	wkvalue[ARB]		#O the current value string
+int	sz_wkvalue		#I the maximum size of the current value string
+int	wktype			#O the output field datatype 
+char	wkunits[ARB]		#O the outpit field units string
+int	sz_wkunits		#I the maximum size of the units string
+
+int	cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NWCS(res) <= 0)
+	    return (0)
+	if (fieldno <= 0 || fieldno > CQ_NWCS(res))
+	    return (0)
+
+	# Get the field name.
+	if (cq_wrdstr (fieldno, wfield, sz_wfield, Memc[CQ_WPNAMES(res)]) <= 0)
+	    return (0)
+
+	# Get the field keyword name.
+	if (cq_wrdstr (fieldno, wkname, sz_wkname, Memc[CQ_WKNAMES(res)]) <= 0)
+	    wkname[1] = EOS
+
+	# Get the field keyword value.
+	if (cq_wrdstr (fieldno, wkvalue, sz_wkvalue,
+	    Memc[CQ_WKVALUES(res)]) <= 0)
+	    wkvalue[1] = EOS
+
+	# Get the field type.
+	wktype = Memi[CQ_WKTYPES(res)+fieldno-1]
+
+	# Get the field units.
+	if (cq_wrdstr (fieldno, wkunits, sz_wkunits,
+	    Memc[CQ_WKUNITS(res)]) <= 0)
+	    wkunits[1] = EOS
+
+	return (fieldno)
+end
+
+
+# CQ_KINFO -- Get the keyword field description by field name.
+
+int procedure cq_kinfo (res, kfield, ikname, sz_ikname, ikvalue, sz_ikvalue,
+	iktype, ikunits, sz_ikunits)
+
+pointer	res			#I the results descriptor
+char	kfield[ARB]		#I the field name
+char	ikname[ARB]		#O the output keyword name
+int	sz_ikname		#I the maximum size of the keyword name string
+char	ikvalue[ARB]		#O the current value string
+int	sz_ikvalue		#I the maximum size of the current value string
+int	iktype			#O the output field datatype 
+char	ikunits[ARB]		#O the outpit field units string
+int	sz_ikunits		#I the maximum size of the units string
+
+pointer	sp, fname
+int	fieldno
+int	strdic(), cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NIMPARS(res) <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	fieldno = strdic (kfield, Memc[fname], CQ_SZ_FNAME,
+	    Memc[CQ_IPNAMES(res)])
+	if (fieldno <= 0) {
+	    call sfree (sp)
+	    return (0)
+	}
+
+	# Get the field keyword name.
+	if (cq_wrdstr (fieldno, ikname, sz_ikname, Memc[CQ_IKNAMES(res)]) <= 0)
+	    ikname[1] = EOS
+
+	# Get the field keyword value.
+	if (cq_wrdstr (fieldno, ikvalue, sz_ikvalue,
+	    Memc[CQ_IKVALUES(res)]) <= 0)
+	    ikvalue[1] = EOS
+
+	# Get the field type.
+	iktype = Memi[CQ_IKTYPES(res)+fieldno-1]
+
+	# Get the field units.
+	if (cq_wrdstr (fieldno, ikunits, sz_ikunits,
+	    Memc[CQ_IKUNITS(res)]) <= 0)
+	    ikunits[1] = EOS
+
+	call sfree (sp)
+
+	return (fieldno)
+end
+
+
+# CQ_KINFON -- Get the image keyword field description by field number.
+
+int procedure cq_kinfon (res, fieldno, kfield, sz_kfield, ikname, sz_ikname,
+	ikvalue, sz_ikvalue, iktype, ikunits, sz_ikunits)
+
+pointer	res			#I the results descriptor
+int	fieldno			#I the input field number
+char	kfield[ARB]		#O the field name
+int	sz_kfield		#I the maximum size of the field string
+char	ikname[ARB]		#O the output keyword name
+int	sz_ikname		#I the maximum size of the keyword name string
+char	ikvalue[ARB]		#O the current value string
+int	sz_ikvalue		#I the maximum size of the current value string
+int	iktype			#O the output field datatype 
+char	ikunits[ARB]		#O the outpit field units string
+int	sz_ikunits		#I the maximum size of the units string
+
+int	cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NIMPARS(res) <= 0)
+	    return (0)
+	if (fieldno <= 0 || fieldno > CQ_NIMPARS(res))
+	    return (0)
+
+	# Get the field name.
+	if (cq_wrdstr (fieldno, kfield, sz_kfield, Memc[CQ_IPNAMES(res)]) <= 0)
+	    return (0)
+
+	# Get the field keyword name.
+	if (cq_wrdstr (fieldno, ikname, sz_ikname, Memc[CQ_IKNAMES(res)]) <= 0)
+	    ikname[1] = EOS
+
+	# Get the field keyword value.
+	if (cq_wrdstr (fieldno, ikvalue, sz_ikvalue, Memc[CQ_IKVALUES(res)]) <=
+	    0)
+	    ikvalue[1] = EOS
+
+	# Get the field type.
+	iktype = Memi[CQ_IKTYPES(res)+fieldno-1]
+
+	# Get the field units.
+	if (cq_wrdstr (fieldno, ikunits, sz_ikunits, Memc[CQ_IKUNITS(res)]) <=
+	    0)
+	    ikunits[1] = EOS
+
+	return (fieldno)
+end
diff --git a/pkg/xtools/catquery/cqimquery.x b/pkg/xtools/catquery/cqimquery.x
new file mode 100644
index 00000000..28a2957c
--- /dev/null
+++ b/pkg/xtools/catquery/cqimquery.x
@@ -0,0 +1,931 @@
+include <fset.h>
+include <ctype.h>
+include "cqdef.h"
+include "cq.h"
+
+
+define	DEF_SZ_INBUF	32768	# the maximum network transfer buffer size
+
+
+# CQ_FIMQUERY -- Send a dummy image query on an existing image. The immage
+# may be any supported IRAF images.
+
+pointer	procedure cq_fimquery (cq, imname)
+
+pointer	cq			#I the catalog database descriptor
+char	imname[ARB]		#I the input image name
+
+pointer	res	
+int	cc
+pointer	cq_firinit()
+int	imaccess()
+
+begin
+	# Check that the current catalog is defined.
+        if (CQ_CAT(cq) == NULL)
+            return (NULL)
+        if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+            return (NULL)
+	cc = CQ_CAT(cq)
+
+	# Open the network connection.
+	if (imaccess (imname, READ_WRITE) != YES)
+	    return (NULL)
+
+	# Initialize the image results structure.
+	res = cq_firinit (cq)
+
+	# Return the results pointer.
+	return (res)
+end
+
+
+# CQ_IMQUERY -- Send an image survey query and return the image as a file. 
+# Currently only FITS files are supported. The calling program is responsible
+# for generating an IRAF compatible image name. If the file already exists
+# no file is created but a valid results descriptor is still created.
+
+pointer	procedure cq_imquery (cq, imname)
+
+pointer	cq			#I the catalog database descriptor
+char	imname[ARB]		#I the image name
+
+pointer	res, inbuf
+char	url[SZ_PATHNAME], addr[SZ_LINE], query[SZ_LINE], buf[SZ_LINE]
+int	cc, fd, outfd, nchars, ip, op
+bool	done
+pointer	cq_irinit()
+int	ndopen(), strlen(), open(), read(), getline(), url_get()
+errchk	ndopen(), awriteb(), open(), read(), getline()
+
+begin
+	# Check that the current catalog is defined.
+        if (CQ_CAT(cq) == NULL)
+            return (NULL)
+        if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+            return (NULL)
+	cc = CQ_CAT(cq)
+
+
+	if (USE_URLGET) {
+	    # Initialize the image results structure.
+	    res = cq_irinit (cq)
+
+	    call strcpy (CQ_ADDRESS(cc), buf, SZ_LINE)
+	    for (ip=1; buf[ip] != ':'; ip=ip+1) ;	# skip 'inet:'
+	    ip = ip + 1
+	    for (    ; buf[ip] != ':'; ip=ip+1) ;	# skip '80:'
+	    ip = ip + 1
+	    for (op=1; buf[ip] != ':'; ip=ip+1) {
+		addr[op] = buf[ip]
+		op = op + 1
+	    }
+	    addr[op] = EOS
+
+	    call strcpy (CQ_IMQUERY(res), buf, SZ_LINE)
+	    for (op=1; !IS_WHITE(buf[op+4]); op=op+1)
+		query[op] = buf[op+4]
+	    query[op] = EOS
+
+	    call sprintf (url, SZ_LINE, "http://%s%s")
+		call pargstr (addr)
+		call pargstr (query)
+
+	    iferr {
+	        call malloc (inbuf, DEF_SZ_INBUF, TY_CHAR)
+		if (url_get (url, imname, inbuf) < 0)
+		    call error (0, "Cannot access url")
+		call mfree (inbuf, TY_CHAR)
+	    } then {
+	        if (res != NULL)
+	            call cq_imclose (res)
+		return (NULL)
+	    }
+
+	    return (res)
+	}
+
+
+	# Open the network connection.
+	iferr (fd = ndopen (CQ_ADDRESS(cc), READ_WRITE))
+	    return (NULL)
+
+	# Initialize the image results structure.
+	res = cq_irinit (cq)
+
+	# Formulate the query.
+	iferr {
+	    switch (CQ_IMTYPE(res)) {
+	    case CQ_FITS:
+	        nchars = strlen (CQ_IMQUERY(res))
+		call write (fd, CQ_IMQUERY(res), nchars)
+	    default:
+	        nchars = strlen (CQ_IMQUERY(res))
+		call write (fd, CQ_IMQUERY(res), nchars)
+	    }
+	    call flush (fd)
+	    call fseti (fd, F_CANCEL, OK)
+	} then {
+	    if (fd != NULL)
+	        call close (fd)
+	    if (res != NULL)
+	        call cq_imclose (res)
+	    return (NULL)
+	}
+
+	# Open the output file.
+	outfd = NULL
+	iferr {
+	    # Open the output file. Worry about legal image names at a
+	    # higher level.
+	    switch (CQ_IMTYPE(res)) {
+	    case CQ_FITS:
+	        outfd = open (imname, NEW_FILE, TEXT_FILE)
+	    default:
+	        outfd = open (imname, NEW_FILE, TEXT_FILE)
+	    }
+	} then {
+	    if (fd != NULL)
+	        call close (fd)
+	    if (res != NULL)
+	        call cq_imclose (res)
+	    return (NULL)
+	}
+
+	# Send the query and get back the results.
+	inbuf = NULL
+	iferr {
+
+	    # Allocate the maximum buffer size.
+	    call malloc (inbuf, DEF_SZ_INBUF, TY_CHAR)
+
+	    # Skip a fixed number of bytes. Dangerous unless the header
+	    # is always the same size.
+	    switch (CQ_HFMT(cc)) {
+	    case CQ_HNONE:
+		;
+	    case CQ_HHTTP:
+                repeat {
+                    nchars = getline (fd, Memc[inbuf])
+                    if (nchars <= 0)
+                        break
+		    Memc[inbuf+nchars] = EOS
+                } until ((Memc[inbuf] == '\r' && Memc[inbuf+1] == '\n') ||
+	            (Memc[inbuf] == '\n'))
+	    default:
+		;
+	    }
+
+	    # Get the data.
+	    repeat {
+	        nchars = read (fd, Memc[inbuf], DEF_SZ_INBUF)
+	        if (nchars > 0) {
+		    Memc[inbuf+nchars] = EOS
+	            call write (outfd, Memc[inbuf], nchars)
+		    done = false
+	        } else {
+		    done = true
+	        }
+	    } until (done)
+
+	    # Cleanup.
+	    call mfree (inbuf, TY_CHAR)
+	    inbuf = NULL
+	    call flush (outfd)
+	    call close (outfd)
+	    outfd = NULL
+	    call close (fd)
+	    fd = NULL
+
+	} then {
+	    if (inbuf != NULL)
+		call mfree (inbuf, TY_CHAR)
+	    if (outfd != NULL) {
+		call close (outfd)
+		call delete (imname)
+	    }
+	    if (fd != NULL)
+	        call close (fd)
+	    if (res != NULL)
+	        call cq_imclose (res)
+	    return (NULL)
+	}
+
+	# Return the results pointer.
+	return (res)
+end
+
+
+# CQ_IMCLOSE -- Close the results structure,
+
+procedure cq_imclose (res)
+
+pointer	res			#U the results descriptor.
+
+begin
+	call cq_irfree (res)
+end
+
+
+# CQ_FIRINIT -- Initialize an image results descriptor.
+
+pointer procedure cq_firinit (cq)
+
+pointer	cq			#I the catalog descriptor
+
+pointer	cc, res
+pointer	sp, value, wpname, wkname, wkdvalue, wkvalue, wkunits
+int	i, ncount, sz1, sz2, sz3, sz4, sz5, op1, op2, op3, op4, op5
+char	ftype
+int	cq_dgeti(), strdic(), cq_dscan(), nscan()
+int	gstrcpy(), cq_dtype()
+errchk	cq_dgwrd(), cq_dgeti(), cq_dscan()
+
+begin
+	# Check that the current catalog is defined.
+        if (CQ_CAT(cq) == NULL)
+            return (NULL)
+        if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+            return (NULL)
+	cc = CQ_CAT(cq)
+
+	# Allocate the results structure.
+	call calloc (res, CQ_LEN_IM, TY_STRUCT)
+
+	# Format the query.
+	call smark (sp)
+	call salloc (value, CQ_SZ_QPVALUE, TY_CHAR)
+	call salloc (wpname, CQ_SZ_QPNAME, TY_CHAR)
+	call salloc (wkname, CQ_SZ_QPNAME, TY_CHAR)
+	call salloc (wkdvalue, CQ_SZ_QPVALUE, TY_CHAR)
+	call salloc (wkvalue, CQ_SZ_QPVALUE, TY_CHAR)
+	call salloc (wkunits, CQ_SZ_QPUNITS, TY_CHAR)
+
+	# Save the survey informaton and query in the results structure.
+	call strcpy (CQ_CATDB(cq), CQ_IMCATDB(res), SZ_FNAME)
+	call strcpy (CQ_CATNAME(cq), CQ_IMCATNAME(res), SZ_FNAME)
+	call strcpy ("", CQ_IMADDRESS(res), SZ_LINE)
+	call strcpy ("", CQ_IMQUERY(res), SZ_LINE)
+
+	# Copy the query parameters to the results descriptor.
+	CQ_INQPARS(res) = 0
+	CQ_IQPNAMES(res) = NULL
+	CQ_IQPVALUES(res) = NULL
+	CQ_IQPUNITS(res) = NULL
+
+	# Get the input image data type.
+	iferr {
+	    call cq_dgwrd (cq, CQ_CATNO(cq), "type", Memc[value],
+	        CQ_SZ_QPVALUE)
+	} then {
+	    Memc[value] = EOS
+	   CQ_IMTYPE(res) = CQ_FITS
+	} else {
+	    CQ_IMTYPE(res) = strdic (Memc[value], Memc[value], CQ_SZ_QPVALUE,
+	        CQ_ITYPESTR)
+	}
+
+	# Get the input image data type.
+	iferr {
+	    call cq_dgwrd (cq, CQ_CATNO(cq), "wcs", Memc[value],
+	        CQ_SZ_QPVALUE)
+	} then {
+	    CQ_IMTYPE(res) = CQ_WNONE
+	} else {
+	    CQ_WCS(res) = strdic (Memc[value], Memc[value], CQ_SZ_QPVALUE,
+	        CQ_WTYPESTR)
+	}
+
+	# Get the number of wcs parameters.
+	iferr (CQ_NWCS(res) = cq_dgeti (cq, CQ_CATNO(cq), "nwcs"))
+	    CQ_NWCS(res) = 0
+
+	# Allocate space for the wcs parameters.
+	call calloc (CQ_WPNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_WKNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_WKDVALUES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_WKVALUES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_WKTYPES(res), CQ_NWCS(res), TY_INT)
+	call calloc (CQ_WKUNITS(res), SZ_LINE, TY_CHAR)
+
+	# Get the wcs parameters.
+	ncount = 0
+	if (CQ_NWCS(res) > 0) {
+
+	    # Initialize the header parameter keywords and values.
+	    sz1 = SZ_LINE; op1 = 2
+	    sz2 = SZ_LINE; op2 = 2
+	    sz3 = SZ_LINE; op3 = 2
+	    sz4 = SZ_LINE; op4 = 2
+	    sz5 = SZ_LINE; op5 = 2
+	    call strcpy ("|", Memc[CQ_WPNAMES(res)], sz1)
+	    call strcpy ("|", Memc[CQ_WKNAMES(res)], sz2)
+	    call strcpy ("|", Memc[CQ_WKDVALUES(res)], sz3)
+	    call strcpy ("|", Memc[CQ_WKVALUES(res)], sz4)
+	    call strcpy ("|", Memc[CQ_WKUNITS(res)], sz5)
+
+	    do i = 1, CQ_NWCS(res) {
+
+		# Get the wcs parameter name, keyword, default value,
+		# data type and units value.
+		if (cq_dscan (cq) == EOF)
+		    break
+		call gargwrd (Memc[wpname], CQ_SZ_QPNAME)
+		call gargwrd (Memc[wkname], CQ_SZ_QPNAME)
+		call gargwrd (Memc[wkdvalue], CQ_SZ_QPVALUE)
+		call gargc (ftype)
+		call gargwrd (Memc[wkunits], CQ_SZ_QPUNITS)
+		if (nscan() != 5)
+		    break
+
+		# Add the parameter name to the list.
+		if ((sz1 - op1 + 1) < (CQ_SZ_QPNAME + 1)) {
+		    sz1 = sz1 + SZ_LINE
+		    call realloc (CQ_WPNAMES(res), sz1, TY_CHAR)
+		}
+		op1 = op1 + gstrcpy (Memc[wpname], Memc[CQ_WPNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+		op1 = op1 + gstrcpy ("|", Memc[CQ_WPNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+
+		# Add the keyword name to the list.
+		if ((sz2 - op2 + 1) < (CQ_SZ_QPNAME + 1)) {
+		    sz2 = sz2 + SZ_LINE
+		    call realloc (CQ_WKNAMES(res), sz2, TY_CHAR)
+		}
+		op2 = op2 + gstrcpy (Memc[wkname], Memc[CQ_WKNAMES(res)+op2-1],
+		    sz2 - op2 + 1)
+		op2 = op2 + gstrcpy ("|", Memc[CQ_WKNAMES(res)+op2-1],
+		    sz2 - op2 + 1)
+
+		# Add the default keyword value to the list.
+		if ((sz3 - op3 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		    sz3 = sz3 + SZ_LINE
+		    call realloc (CQ_WKDVALUES(res), sz3, TY_CHAR)
+		}
+		op3 = op3 + gstrcpy (Memc[wkdvalue],
+		    Memc[CQ_WKDVALUES(res)+op3-1], sz3 - op3 + 1)
+		op3 = op3 + gstrcpy ("|", Memc[CQ_WKDVALUES(res)+op3-1],
+		    sz3 - op3 + 1)
+
+		# Add the keyword value to the list.
+		if ((sz4 - op4 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		    sz4 = sz4 + SZ_LINE
+		    call realloc (CQ_WKVALUES(res), sz4, TY_CHAR)
+		}
+		op4 = op4 + gstrcpy (Memc[wkdvalue],
+		    Memc[CQ_WKVALUES(res)+op4-1], sz4 - op4 + 1)
+		op4 = op4 + gstrcpy ("|", Memc[CQ_WKVALUES(res)+op4-1],
+		    sz4 - op4 + 1)
+
+		# Compute the data type.
+		Memi[CQ_WKTYPES(res)+i-1] = cq_dtype (ftype)
+
+		# Add the default keyword value to the list.
+		if ((sz5 - op5 + 1) < (CQ_SZ_QPUNITS + 1)) {
+		    sz5 = sz5 + SZ_LINE
+		    call realloc (CQ_WKUNITS(res), sz5, TY_CHAR)
+		}
+		op5 = op5 + gstrcpy (Memc[wkunits],
+		    Memc[CQ_WKUNITS(res)+op5-1], sz5 - op5 + 1)
+		op5 = op5 + gstrcpy ("|", Memc[CQ_WKUNITS(res)+op5-1],
+		    sz5 - op5 + 1)
+
+		ncount = ncount + 1
+	    }
+	}
+
+	# Resize the wcs parameter arrays.
+	if (ncount != CQ_NWCS(res)) {
+	    CQ_NWCS(res) = 0
+	    call realloc (CQ_WPNAMES(res), 1, TY_CHAR)
+	    call realloc (CQ_WKNAMES(res), 1, TY_CHAR)
+	    call realloc (CQ_WKDVALUES(res), 1, TY_CHAR)
+	    call realloc (CQ_WKVALUES(res), 1, TY_CHAR)
+	    call mfree (CQ_WKTYPES(res), TY_INT)
+	    CQ_WKTYPES(res) = NULL
+	    call realloc (CQ_WKUNITS(res), 1, TY_CHAR)
+	} else {
+	    call realloc (CQ_WPNAMES(res), op1, TY_CHAR)
+	    call realloc (CQ_WKNAMES(res), op2, TY_CHAR)
+	    call realloc (CQ_WKDVALUES(res), op3, TY_CHAR)
+	    call realloc (CQ_WKVALUES(res), op4, TY_CHAR)
+	    call realloc (CQ_WKUNITS(res), op5, TY_CHAR)
+	    Memc[CQ_WPNAMES(res)+op1] = EOS
+	    Memc[CQ_WKNAMES(res)+op2] = EOS
+	    Memc[CQ_WKDVALUES(res)+op3] = EOS
+	    Memc[CQ_WKVALUES(res)+op4] = EOS
+	    Memc[CQ_WKUNITS(res)+op5] = EOS
+	}
+
+	# Get the number of keyword parameters.
+	iferr (CQ_NIMPARS(res) = cq_dgeti (cq, CQ_CATNO(cq), "nkeys"))
+	    CQ_NIMPARS(res) = 0
+
+	# Allocate space for the keyword parameters.
+	call calloc (CQ_IPNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_IKNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_IKDVALUES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_IKVALUES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_IKTYPES(res), CQ_NIMPARS(res), TY_INT)
+	call calloc (CQ_IKUNITS(res), SZ_LINE, TY_CHAR)
+
+	# Get the keyword parameters.
+	ncount = 0
+	if (CQ_NIMPARS(res) > 0) {
+
+	    # Initialize the header parameter keywords and values.
+	    sz1 = SZ_LINE; op1 = 2
+	    sz2 = SZ_LINE; op2 = 2
+	    sz3 = SZ_LINE; op3 = 2
+	    sz4 = SZ_LINE; op4 = 2
+	    sz5 = SZ_LINE; op5 = 2
+	    call strcpy ("|", Memc[CQ_IPNAMES(res)], sz1)
+	    call strcpy ("|", Memc[CQ_IKNAMES(res)], sz2)
+	    call strcpy ("|", Memc[CQ_IKDVALUES(res)], sz3)
+	    call strcpy ("|", Memc[CQ_IKVALUES(res)], sz4)
+	    call strcpy ("|", Memc[CQ_IKUNITS(res)], sz5)
+
+	    do i = 1, CQ_NIMPARS(res) {
+
+		# Get the wcs parameter name, keyword, default value,
+		# data type and units value.
+		if (cq_dscan (cq) == EOF)
+		    break
+		call gargwrd (Memc[wpname], CQ_SZ_QPNAME)
+		call gargwrd (Memc[wkname], CQ_SZ_QPNAME)
+		call gargwrd (Memc[wkdvalue], CQ_SZ_QPVALUE)
+		call gargc (ftype)
+		call gargwrd (Memc[wkunits], CQ_SZ_QPUNITS)
+		if (nscan() != 5)
+		    break
+
+		# Add the parameter name to the list.
+		if ((sz1 - op1 + 1) < (CQ_SZ_QPNAME + 1)) {
+		    sz1 = sz1 + SZ_LINE
+		    call realloc (CQ_IPNAMES(res), sz1, TY_CHAR)
+		}
+		op1 = op1 + gstrcpy (Memc[wpname], Memc[CQ_IPNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+		op1 = op1 + gstrcpy ("|", Memc[CQ_IPNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+
+		# Add the keyword name to the list.
+		if ((sz2 - op2 + 1) < (CQ_SZ_QPNAME + 1)) {
+		    sz2 = sz2 + SZ_LINE
+		    call realloc (CQ_IKNAMES(res), sz2, TY_CHAR)
+		}
+		op2 = op2 + gstrcpy (Memc[wkname], Memc[CQ_IKNAMES(res)+op2-1],
+		    sz2 - op2 + 1)
+		op2 = op2 + gstrcpy ("|", Memc[CQ_IKNAMES(res)+op2-1],
+		    sz2 - op2 + 1)
+
+		# Add the default keyword value to the list.
+		if ((sz3 - op3 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		    sz3 = sz3 + SZ_LINE
+		    call realloc (CQ_IKDVALUES(res), sz3, TY_CHAR)
+		}
+		op3 = op3 + gstrcpy (Memc[wkdvalue],
+		    Memc[CQ_IKDVALUES(res)+op3-1], sz3 - op3 + 1)
+		op3 = op3 + gstrcpy ("|", Memc[CQ_IKDVALUES(res)+op3-1],
+		    sz3 - op3 + 1)
+
+		# Add the keyword value to the list.
+		if ((sz4 - op4 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		    sz4 = sz4 + SZ_LINE
+		    call realloc (CQ_IKVALUES(res), sz4, TY_CHAR)
+		}
+		op4 = op4 + gstrcpy (Memc[wkdvalue],
+		    Memc[CQ_IKVALUES(res)+op4-1], sz4 - op4 + 1)
+		op4 = op4 + gstrcpy ("|", Memc[CQ_IKVALUES(res)+op4-1],
+		    sz4 - op4 + 1)
+
+		# Compute the data type.
+		Memi[CQ_IKTYPES(res)+i-1] = cq_dtype (ftype)
+
+		# Add the default keyword value to the list.
+		if ((sz5 - op5 + 1) < (CQ_SZ_QPUNITS + 1)) {
+		    sz5 = sz5 + SZ_LINE
+		    call realloc (CQ_IKUNITS(res), sz5, TY_CHAR)
+		}
+		op5 = op5 + gstrcpy (Memc[wkunits],
+		    Memc[CQ_IKUNITS(res)+op5-1], sz5 - op5 + 1)
+		op5 = op5 + gstrcpy ("|", Memc[CQ_IKUNITS(res)+op5-1],
+		    sz5 - op5 + 1)
+
+		ncount = ncount + 1
+
+	    }
+	}
+
+	# Resize the wcs parameter arrays.
+	if (ncount != CQ_NIMPARS(res)) {
+	    CQ_NIMPARS(res) = 0
+	    call realloc (CQ_IPNAMES(res), 1, TY_CHAR)
+	    call realloc (CQ_IKNAMES(res), 1, TY_CHAR)
+	    call realloc (CQ_IKDVALUES(res), 1, TY_CHAR)
+	    call realloc (CQ_IKVALUES(res), 1, TY_CHAR)
+	    call mfree (CQ_IKTYPES(res), TY_INT)
+	    CQ_IKTYPES(res) = NULL
+	    call realloc (CQ_IKUNITS(res), 1, TY_CHAR)
+	} else {
+	    call realloc (CQ_IPNAMES(res), op1, TY_CHAR)
+	    call realloc (CQ_IKNAMES(res), op2, TY_CHAR)
+	    call realloc (CQ_IKDVALUES(res), op3, TY_CHAR)
+	    call realloc (CQ_IKVALUES(res), op4, TY_CHAR)
+	    call realloc (CQ_IKUNITS(res), op5, TY_CHAR)
+	    Memc[CQ_IPNAMES(res)+op1] = EOS
+	    Memc[CQ_IKNAMES(res)+op2] = EOS
+	    Memc[CQ_IKDVALUES(res)+op3] = EOS
+	    Memc[CQ_IKVALUES(res)+op4] = EOS
+	    Memc[CQ_IKUNITS(res)+op5] = EOS
+	}
+
+	call sfree (sp)
+
+	return (res)
+end
+
+
+# CQ_IRINIT -- Initialize an image results descriptor.
+
+pointer procedure cq_irinit (cq)
+
+pointer	cq			#I the catalog descriptor
+
+pointer	cc, res
+pointer	sp, query, value, wpname, wkname, wkdvalue, wkvalue, wkunits
+int	i, fsize, ncount, sz1, sz2, sz3, sz4, sz5, op1, op2, op3, op4, op5
+char	ftype
+int	cq_wrdstr(), cq_dgeti(), strlen(), strdic(), cq_dscan(), nscan()
+int	gstrcpy(), cq_dtype()
+errchk	cq_dgwrd(), cq_dgeti(), cq_dscan()
+
+begin
+	# Check that the current catalog is defined.
+        if (CQ_CAT(cq) == NULL)
+            return (NULL)
+        if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+            return (NULL)
+	cc = CQ_CAT(cq)
+
+	# Allocate the results structure.
+	call calloc (res, CQ_LEN_IM, TY_STRUCT)
+
+	# Format the query.
+	call smark (sp)
+	call salloc (query, SZ_LINE, TY_CHAR)
+	call salloc (value, CQ_SZ_QPVALUE, TY_CHAR)
+	call sprintf (Memc[query], SZ_LINE, CQ_QUERY(cc))
+	do i = 1, CQ_NQPARS(cc) {
+	    if (cq_wrdstr (i, Memc[value], CQ_SZ_QPVALUE,
+	        Memc[CQ_PQPVALUES(cc)]) <= 0)
+		next
+	    call pargstr (Memc[value])
+	}
+
+	# Save the survey informaton and query in the results structure.
+	call strcpy (CQ_CATDB(cq), CQ_IMCATDB(res), SZ_FNAME)
+	call strcpy (CQ_CATNAME(cq), CQ_IMCATNAME(res), SZ_FNAME)
+	call strcpy (CQ_ADDRESS(cc), CQ_IMADDRESS(res), SZ_LINE)
+	call strcpy (Memc[query], CQ_IMQUERY(res), SZ_LINE)
+
+	# Copy the query parameters to the results descriptor.
+	CQ_INQPARS(res) = CQ_NQPARS(cc)
+	fsize = strlen (Memc[CQ_PQPNAMES(cc)])
+	call malloc (CQ_IQPNAMES(res), fsize, TY_CHAR)
+	call strcpy (Memc[CQ_PQPNAMES(cc)], Memc[CQ_IQPNAMES(res)], fsize)
+	fsize = strlen (Memc[CQ_PQPVALUES(cc)])
+	call malloc (CQ_IQPVALUES(res), fsize, TY_CHAR)
+	call strcpy (Memc[CQ_PQPVALUES(cc)], Memc[CQ_IQPVALUES(res)], fsize)
+	fsize = strlen (Memc[CQ_PQPUNITS(cc)])
+	call malloc (CQ_IQPUNITS(res), fsize, TY_CHAR)
+	call strcpy (Memc[CQ_PQPUNITS(cc)], Memc[CQ_IQPUNITS(res)], fsize)
+
+	# Get the input image data type.
+	iferr {
+	    call cq_dgwrd (cq, CQ_CATNO(cq), "type", Memc[value],
+	        CQ_SZ_QPVALUE)
+	} then {
+	    Memc[value] = EOS
+	   CQ_IMTYPE(res) = CQ_FITS
+	} else {
+	    CQ_IMTYPE(res) = strdic (Memc[value], Memc[value], CQ_SZ_QPVALUE,
+	        CQ_ITYPESTR)
+	}
+
+	call salloc (wpname, CQ_SZ_QPNAME, TY_CHAR)
+	call salloc (wkname, CQ_SZ_QPNAME, TY_CHAR)
+	call salloc (wkdvalue, CQ_SZ_QPVALUE, TY_CHAR)
+	call salloc (wkvalue, CQ_SZ_QPVALUE, TY_CHAR)
+	call salloc (wkunits, CQ_SZ_QPUNITS, TY_CHAR)
+
+	# Get the input image data type.
+	iferr {
+	    call cq_dgwrd (cq, CQ_CATNO(cq), "wcs", Memc[value],
+	        CQ_SZ_QPVALUE)
+	} then {
+	    CQ_IMTYPE(res) = CQ_WNONE
+	} else {
+	    CQ_WCS(res) = strdic (Memc[value], Memc[value], CQ_SZ_QPVALUE,
+	        CQ_WTYPESTR)
+	}
+
+	# Get the number of wcs parameters.
+	iferr (CQ_NWCS(res) = cq_dgeti (cq, CQ_CATNO(cq), "nwcs"))
+	    CQ_NWCS(res) = 0
+
+	# Allocate space for the wcs parameters.
+	call calloc (CQ_WPNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_WKNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_WKDVALUES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_WKVALUES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_WKTYPES(res), CQ_NWCS(res), TY_INT)
+	call calloc (CQ_WKUNITS(res), SZ_LINE, TY_CHAR)
+
+	# Get the wcs parameters.
+	ncount = 0
+	if (CQ_NWCS(res) > 0) {
+
+	    # Initialize the header parameter keywords and values.
+	    sz1 = SZ_LINE; op1 = 2
+	    sz2 = SZ_LINE; op2 = 2
+	    sz3 = SZ_LINE; op3 = 2
+	    sz4 = SZ_LINE; op4 = 2
+	    sz5 = SZ_LINE; op5 = 2
+	    call strcpy ("|", Memc[CQ_WPNAMES(res)], sz1)
+	    call strcpy ("|", Memc[CQ_WKNAMES(res)], sz2)
+	    call strcpy ("|", Memc[CQ_WKDVALUES(res)], sz3)
+	    call strcpy ("|", Memc[CQ_WKVALUES(res)], sz4)
+	    call strcpy ("|", Memc[CQ_WKUNITS(res)], sz5)
+
+
+	    do i = 1, CQ_NWCS(res) {
+
+		# Get the wcs parameter name, keyword, default value,
+		# data type and units value.
+		if (cq_dscan (cq) == EOF)
+		    break
+		call gargwrd (Memc[wpname], CQ_SZ_QPNAME)
+		call gargwrd (Memc[wkname], CQ_SZ_QPNAME)
+		call gargwrd (Memc[wkdvalue], CQ_SZ_QPVALUE)
+		call gargc (ftype)
+		call gargwrd (Memc[wkunits], CQ_SZ_QPUNITS)
+		if (nscan() != 5)
+		    break
+
+		# Add the parameter name to the list.
+		if ((sz1 - op1 + 1) < (CQ_SZ_QPNAME + 1)) {
+		    sz1 = sz1 + SZ_LINE
+		    call realloc (CQ_WPNAMES(res), sz1, TY_CHAR)
+		}
+		op1 = op1 + gstrcpy (Memc[wpname], Memc[CQ_WPNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+		op1 = op1 + gstrcpy ("|", Memc[CQ_WPNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+
+		# Add the keyword name to the list.
+		if ((sz2 - op2 + 1) < (CQ_SZ_QPNAME + 1)) {
+		    sz2 = sz2 + SZ_LINE
+		    call realloc (CQ_WKNAMES(res), sz2, TY_CHAR)
+		}
+		op2 = op2 + gstrcpy (Memc[wkname], Memc[CQ_WKNAMES(res)+op2-1],
+		    sz2 - op2 + 1)
+		op2 = op2 + gstrcpy ("|", Memc[CQ_WKNAMES(res)+op2-1],
+		    sz2 - op2 + 1)
+
+		# Add the default keyword value to the list.
+		if ((sz3 - op3 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		    sz3 = sz3 + SZ_LINE
+		    call realloc (CQ_WKDVALUES(res), sz3, TY_CHAR)
+		}
+		op3 = op3 + gstrcpy (Memc[wkdvalue],
+		    Memc[CQ_WKDVALUES(res)+op3-1], sz3 - op3 + 1)
+		op3 = op3 + gstrcpy ("|", Memc[CQ_WKDVALUES(res)+op3-1],
+		    sz3 - op3 + 1)
+
+		# Add the keyword value to the list.
+		if ((sz4 - op4 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		    sz4 = sz4 + SZ_LINE
+		    call realloc (CQ_WKVALUES(res), sz4, TY_CHAR)
+		}
+		op4 = op4 + gstrcpy (Memc[wkdvalue],
+		    Memc[CQ_WKVALUES(res)+op4-1], sz4 - op4 + 1)
+		op4 = op4 + gstrcpy ("|", Memc[CQ_WKVALUES(res)+op4-1],
+		    sz4 - op4 + 1)
+
+		# Compute the data type.
+		Memi[CQ_WKTYPES(res)+i-1] = cq_dtype (ftype)
+
+		# Add the default keyword value to the list.
+		if ((sz5 - op5 + 1) < (CQ_SZ_QPUNITS + 1)) {
+		    sz5 = sz5 + SZ_LINE
+		    call realloc (CQ_WKUNITS(res), sz5, TY_CHAR)
+		}
+		op5 = op5 + gstrcpy (Memc[wkunits],
+		    Memc[CQ_WKUNITS(res)+op5-1], sz5 - op5 + 1)
+		op5 = op5 + gstrcpy ("|", Memc[CQ_WKUNITS(res)+op5-1],
+		    sz5 - op5 + 1)
+
+		ncount = ncount + 1
+	    }
+	}
+
+	# Resize the wcs parameter arrays.
+	if (ncount != CQ_NWCS(res)) {
+	    CQ_NWCS(res) = 0
+	    call realloc (CQ_WPNAMES(res), 1, TY_CHAR)
+	    call realloc (CQ_WKNAMES(res), 1, TY_CHAR)
+	    call realloc (CQ_WKDVALUES(res), 1, TY_CHAR)
+	    call realloc (CQ_WKVALUES(res), 1, TY_CHAR)
+	    call mfree (CQ_WKTYPES(res), TY_INT)
+	    CQ_WKTYPES(res) = NULL
+	    call realloc (CQ_WKUNITS(res), 1, TY_CHAR)
+	} else {
+	    call realloc (CQ_WPNAMES(res), op1, TY_CHAR)
+	    call realloc (CQ_WKNAMES(res), op2, TY_CHAR)
+	    call realloc (CQ_WKDVALUES(res), op3, TY_CHAR)
+	    call realloc (CQ_WKVALUES(res), op4, TY_CHAR)
+	    call realloc (CQ_WKUNITS(res), op5, TY_CHAR)
+	    Memc[CQ_WPNAMES(res)+op1] = EOS
+	    Memc[CQ_WKNAMES(res)+op2] = EOS
+	    Memc[CQ_WKDVALUES(res)+op3] = EOS
+	    Memc[CQ_WKVALUES(res)+op4] = EOS
+	    Memc[CQ_WKUNITS(res)+op5] = EOS
+	}
+
+	# Get the number of keyword parameters.
+	iferr (CQ_NIMPARS(res) = cq_dgeti (cq, CQ_CATNO(cq), "nkeys"))
+	    CQ_NIMPARS(res) = 0
+
+	# Allocate space for the keyword parameters.
+	call calloc (CQ_IPNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_IKNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_IKDVALUES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_IKVALUES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_IKTYPES(res), CQ_NIMPARS(res), TY_INT)
+	call calloc (CQ_IKUNITS(res), SZ_LINE, TY_CHAR)
+
+	# Get the keyword parameters.
+	ncount = 0
+	if (CQ_NIMPARS(res) > 0) {
+
+	    # Initialize the header parameter keywords and values.
+	    sz1 = SZ_LINE; op1 = 2
+	    sz2 = SZ_LINE; op2 = 2
+	    sz3 = SZ_LINE; op3 = 2
+	    sz4 = SZ_LINE; op4 = 2
+	    sz5 = SZ_LINE; op5 = 2
+	    call strcpy ("|", Memc[CQ_IPNAMES(res)], sz1)
+	    call strcpy ("|", Memc[CQ_IKNAMES(res)], sz2)
+	    call strcpy ("|", Memc[CQ_IKDVALUES(res)], sz3)
+	    call strcpy ("|", Memc[CQ_IKVALUES(res)], sz4)
+	    call strcpy ("|", Memc[CQ_IKUNITS(res)], sz5)
+
+	    do i = 1, CQ_NIMPARS(res) {
+
+		# Get the wcs parameter name, keyword, default value,
+		# data type and units value.
+		if (cq_dscan (cq) == EOF)
+		    break
+		call gargwrd (Memc[wpname], CQ_SZ_QPNAME)
+		call gargwrd (Memc[wkname], CQ_SZ_QPNAME)
+		call gargwrd (Memc[wkdvalue], CQ_SZ_QPVALUE)
+		call gargc (ftype)
+		call gargwrd (Memc[wkunits], CQ_SZ_QPUNITS)
+		if (nscan() != 5)
+		    break
+
+		# Add the parameter name to the list.
+		if ((sz1 - op1 + 1) < (CQ_SZ_QPNAME + 1)) {
+		    sz1 = sz1 + SZ_LINE
+		    call realloc (CQ_IPNAMES(res), sz1, TY_CHAR)
+		}
+		op1 = op1 + gstrcpy (Memc[wpname], Memc[CQ_IPNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+		op1 = op1 + gstrcpy ("|", Memc[CQ_IPNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+
+		# Add the keyword name to the list.
+		if ((sz2 - op2 + 1) < (CQ_SZ_QPNAME + 1)) {
+		    sz2 = sz2 + SZ_LINE
+		    call realloc (CQ_IKNAMES(res), sz2, TY_CHAR)
+		}
+		op2 = op2 + gstrcpy (Memc[wkname], Memc[CQ_IKNAMES(res)+op2-1],
+		    sz2 - op2 + 1)
+		op2 = op2 + gstrcpy ("|", Memc[CQ_IKNAMES(res)+op2-1],
+		    sz2 - op2 + 1)
+
+		# Add the default keyword value to the list.
+		if ((sz3 - op3 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		    sz3 = sz3 + SZ_LINE
+		    call realloc (CQ_IKDVALUES(res), sz3, TY_CHAR)
+		}
+		op3 = op3 + gstrcpy (Memc[wkdvalue],
+		    Memc[CQ_IKDVALUES(res)+op3-1], sz3 - op3 + 1)
+		op3 = op3 + gstrcpy ("|", Memc[CQ_IKDVALUES(res)+op3-1],
+		    sz3 - op3 + 1)
+
+		# Add the keyword value to the list.
+		if ((sz4 - op4 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		    sz4 = sz4 + SZ_LINE
+		    call realloc (CQ_IKVALUES(res), sz4, TY_CHAR)
+		}
+		op4 = op4 + gstrcpy (Memc[wkdvalue],
+		    Memc[CQ_IKVALUES(res)+op4-1], sz4 - op4 + 1)
+		op4 = op4 + gstrcpy ("|", Memc[CQ_IKVALUES(res)+op4-1],
+		    sz4 - op4 + 1)
+
+		# Compute the data type.
+		Memi[CQ_IKTYPES(res)+i-1] = cq_dtype (ftype)
+
+		# Add the default keyword value to the list.
+		if ((sz5 - op5 + 1) < (CQ_SZ_QPUNITS + 1)) {
+		    sz5 = sz5 + SZ_LINE
+		    call realloc (CQ_IKUNITS(res), sz5, TY_CHAR)
+		}
+		op5 = op5 + gstrcpy (Memc[wkunits],
+		    Memc[CQ_IKUNITS(res)+op5-1], sz5 - op5 + 1)
+		op5 = op5 + gstrcpy ("|", Memc[CQ_IKUNITS(res)+op5-1],
+		    sz5 - op5 + 1)
+
+		ncount = ncount + 1
+
+	    }
+	}
+
+	# Resize the wcs parameter arrays.
+	if (ncount != CQ_NIMPARS(res)) {
+	    CQ_NIMPARS(res) = 0
+	    call realloc (CQ_IPNAMES(res), 1, TY_CHAR)
+	    call realloc (CQ_IKNAMES(res), 1, TY_CHAR)
+	    call realloc (CQ_IKDVALUES(res), 1, TY_CHAR)
+	    call realloc (CQ_IKVALUES(res), 1, TY_CHAR)
+	    call mfree (CQ_IKTYPES(res), TY_INT)
+	    CQ_IKTYPES(res) = NULL
+	    call realloc (CQ_IKUNITS(res), 1, TY_CHAR)
+	} else {
+	    call realloc (CQ_IPNAMES(res), op1, TY_CHAR)
+	    call realloc (CQ_IKNAMES(res), op2, TY_CHAR)
+	    call realloc (CQ_IKDVALUES(res), op3, TY_CHAR)
+	    call realloc (CQ_IKVALUES(res), op4, TY_CHAR)
+	    call realloc (CQ_IKUNITS(res), op5, TY_CHAR)
+	    Memc[CQ_IPNAMES(res)+op1] = EOS
+	    Memc[CQ_IKNAMES(res)+op2] = EOS
+	    Memc[CQ_IKDVALUES(res)+op3] = EOS
+	    Memc[CQ_IKVALUES(res)+op4] = EOS
+	    Memc[CQ_IKUNITS(res)+op5] = EOS
+	}
+
+	call sfree (sp)
+
+	return (res)
+end
+
+
+# CQ_IRFREE -- Free the image results structure.
+
+procedure cq_irfree (res)
+
+pointer	res			#U the results descriptor.
+
+begin
+	# Free the query parameter names, values, and units.
+	if (CQ_IQPNAMES(res) != NULL)
+	    call mfree (CQ_IQPNAMES(res), TY_CHAR)
+	if (CQ_IQPVALUES(res) != NULL)
+	    call mfree (CQ_IQPVALUES(res), TY_CHAR)
+	if (CQ_IQPUNITS(res) != NULL)
+	    call mfree (CQ_IQPUNITS(res), TY_CHAR)
+
+	# Free the wcs parameters.
+	if (CQ_WPNAMES(res) != NULL)
+	    call mfree (CQ_WPNAMES(res), TY_CHAR)
+	if (CQ_WKNAMES(res) != NULL)
+	    call mfree (CQ_WKNAMES(res), TY_CHAR)
+	if (CQ_WKDVALUES(res) != NULL)
+	    call mfree (CQ_WKDVALUES(res), TY_CHAR)
+	if (CQ_WKVALUES(res) != NULL)
+	    call mfree (CQ_WKVALUES(res), TY_CHAR)
+	if (CQ_WKTYPES(res) != NULL)
+	    call mfree (CQ_WKTYPES(res), TY_INT)
+	if (CQ_WKUNITS(res) != NULL)
+	    call mfree (CQ_WKUNITS(res), TY_CHAR)
+
+	# Free the image keyword parameters.
+	if (CQ_IPNAMES(res) != NULL)
+	    call mfree (CQ_IPNAMES(res), TY_CHAR)
+	if (CQ_IKNAMES(res) != NULL)
+	    call mfree (CQ_IKNAMES(res), TY_CHAR)
+	if (CQ_IKDVALUES(res) != NULL)
+	    call mfree (CQ_IKDVALUES(res), TY_CHAR)
+	if (CQ_IKVALUES(res) != NULL)
+	    call mfree (CQ_IKVALUES(res), TY_CHAR)
+	if (CQ_IKTYPES(res) != NULL)
+	    call mfree (CQ_IKTYPES(res), TY_INT)
+	if (CQ_IKUNITS(res) != NULL)
+	    call mfree (CQ_IKUNITS(res), TY_CHAR)
+
+	if (res != NULL)
+	    call mfree (res, TY_STRUCT)
+end
diff --git a/pkg/xtools/catquery/cqistat.x b/pkg/xtools/catquery/cqistat.x
new file mode 100644
index 00000000..0ae35527
--- /dev/null
+++ b/pkg/xtools/catquery/cqistat.x
@@ -0,0 +1,161 @@
+include "cqdef.h"
+include "cq.h"
+
+
+# CQ_ISTATI -- Get an integer image results parameter.
+
+int procedure cq_istati (res, param)
+
+pointer res                     #I pointer to the results descriptor
+int     param                   #I the integer parameter to be retrieved
+
+begin
+        switch (param) {
+	case CQINQPARS:
+            return (CQ_INQPARS(res))
+        case CQIMTYPE:
+            return (CQ_IMTYPE(res))
+        case CQWCS:
+            return (CQ_WCS(res))
+        case CQNWCS:
+            return (CQ_NWCS(res))
+        case CQNIMPARS:
+            return (CQ_NIMPARS(res))
+        default:
+            call error (0, "Error fetching integer image results parameter")
+        }
+end
+
+
+# CQ_ISTATR -- Get a real image results parameter.
+
+real procedure cq_istatr (res, param)
+
+pointer res                     #I pointer to the image results descriptor
+int     param                   #I the real image parameter to be retrieved
+
+begin
+        switch (param) {
+        default:
+            call error (0, "Error fetching real results parameter")
+        }
+end
+
+
+# CQ_ISTATD -- Get a double precision image results parameter.
+
+double procedure cq_istatd (res, param)
+
+pointer res                     #I pointer to the image results descriptor
+int     param                   #I the double parameter to be retrieved
+
+begin
+        switch (param) {
+        default:
+            call error (0, "Error fetching double results parameter")
+        }
+end
+
+
+# CQ_ISTATS -- Get a string image results parameter.
+
+procedure cq_istats (res, param, str, maxch)
+
+pointer res                     #I pointer to the results descriptor
+int     param                   #I the string parameter to be retrieved
+char    str[ARB]                #O the output string parameter
+int     maxch                   #I the maximum size of the string parameter
+
+begin
+        switch (param) {
+        case CQIQPNAMES:
+            call strcpy (Memc[CQ_IQPNAMES(res)], str, maxch)
+        case CQIQPVALUES:
+            call strcpy (Memc[CQ_IQPVALUES(res)], str, maxch)
+        case CQIQPUNITS:
+            call strcpy (Memc[CQ_IQPUNITS(res)], str, maxch)
+        case CQIMCATDB:
+            call strcpy (CQ_IMCATDB(res), str, maxch)
+        case CQIMCATNAME:
+            call strcpy (CQ_IMCATNAME(res), str, maxch)
+        case CQIMADDRESS:
+            call strcpy (CQ_IMADDRESS(res), str, maxch)
+        case CQIMQUERY:
+            call strcpy (CQ_IMQUERY(res), str, maxch)
+        case CQIMNAME:
+            call strcpy (CQ_IMNAME(res), str, maxch)
+        default:
+            call error (0, "Error fetching string results parameter")
+        }
+end
+
+
+# CQ_ISTATT -- Get a text list results parameter. A text list is a
+# string with items separated from each other by newlines.
+
+int procedure cq_istatt (res, param, str, maxch)
+
+pointer res                     #I pointer to the results descriptor
+int     param                   #I the list parameter to be retrieved
+char    str[ARB]                #O the output string parameter
+int     maxch                   #I the maximum size of the string parameter
+
+pointer	sp, tstr
+int     i, fd
+int     stropen(), cq_wrdstr()
+
+begin
+        switch (param) {
+
+        case CQIQPNAMES:
+	    call smark (sp)
+	    call salloc (tstr, CQ_SZ_QPNAME, TY_CHAR)
+            fd = stropen (str, maxch, NEW_FILE)
+	    str[1] = EOS
+            do i = 1, CQ_INQPARS(res) {
+		if (cq_wrdstr (i, Memc[tstr], CQ_SZ_QPNAME,
+		    Memc[CQ_IQPNAMES(res)]) > 0) {
+                    call fprintf (fd, "%s\n")
+                        call pargstr (Memc[tstr])
+		}
+            }
+            call close (fd)
+	    call sfree (sp)
+            return (CQ_INQPARS(res))
+
+        case CQIQPVALUES:
+	    call smark (sp)
+	    call salloc (tstr, CQ_SZ_QPVALUE, TY_CHAR)
+            fd = stropen (str, maxch, NEW_FILE)
+	    str[1] = EOS
+            do i = 1, CQ_INQPARS(res) {
+		if (cq_wrdstr (i, Memc[tstr], CQ_SZ_QPVALUE,
+		    Memc[CQ_IQPVALUES(res)]) > 0) {
+                    call fprintf (fd, "%s\n")
+                        call pargstr (Memc[tstr])
+		}
+            }
+            call close (fd)
+	    call sfree (sp)
+            return (CQ_INQPARS(res))
+
+        case CQIQPUNITS:
+	    call smark (sp)
+	    call salloc (tstr, CQ_SZ_QPUNITS, TY_CHAR)
+            fd = stropen (str, maxch, NEW_FILE)
+	    str[1] = EOS
+            do i = 1, CQ_INQPARS(res) {
+		if (cq_wrdstr (i, Memc[tstr], CQ_SZ_QPUNITS,
+		    Memc[CQ_IQPUNITS(res)]) > 0) {
+                    call fprintf (fd, "%s\n")
+                        call pargstr (Memc[tstr])
+		}
+            }
+            call close (fd)
+	    call sfree (sp)
+            return (CQ_INQPARS(res))
+
+        default:
+            call error (0, "Error fetching list image results parameter")
+        }
+end
diff --git a/pkg/xtools/catquery/cqlocate.x b/pkg/xtools/catquery/cqlocate.x
new file mode 100644
index 00000000..7070f8c0
--- /dev/null
+++ b/pkg/xtools/catquery/cqlocate.x
@@ -0,0 +1,40 @@
+include	"cqdef.h"
+
+# CQ_LOCATE -- Locate a catalog by name. Return 0 if the catalog is not found.
+
+int procedure cq_locate (cq, name)
+
+pointer	cq				#I the catalog descriptor
+char	name[ARB]			#I the catalog name
+
+int	i
+bool	streq()
+
+begin
+	do i = 1, CQ_NRECS(cq) {
+	    if (streq (name, CQ_NAME(cq, i)))
+		return (i)
+	}
+
+	return (0)
+end
+
+
+# CQ_LOCATEN -- Locate a catalog by number and retrieve its name. Return 0 if
+# the catalog is not found.
+
+int procedure cq_locaten (cq, catno, name, maxch)
+
+pointer	cq				#I the catalog descriptor
+int	catno				#I the catalog sequence record number
+char	name[ARB]			#O the output catalog name
+int	maxch				#I the maximum size of the catalog name
+
+begin
+	if (catno > 0 && catno <= CQ_NRECS(cq)) {
+	    call strcpy (CQ_NAME(cq, catno), name, maxch)
+	    return (catno)
+	}
+
+	return (0)
+end
diff --git a/pkg/xtools/catquery/cqmap.x b/pkg/xtools/catquery/cqmap.x
new file mode 100644
index 00000000..75ad4c2f
--- /dev/null
+++ b/pkg/xtools/catquery/cqmap.x
@@ -0,0 +1,112 @@
+include	<ctype.h>
+include	"cqdef.h"
+
+# CQ_MAP -- Map a catalog database.
+
+pointer procedure cq_map (database, mode)
+
+char	database[ARB]			#I The database file
+int	mode				#I The database file access mode
+
+int	i, nrec, cq_alloc1, cq_alloc2
+pointer	cq, str
+
+long	note()
+int	open(), fscan(), strlen()
+bool	streq()
+errchk	open()
+
+begin
+	if (mode != READ_ONLY && mode != NEW_FILE && mode != APPEND)
+	    return (NULL)
+
+	iferr (i = open (database, mode, TEXT_FILE))
+	    return (NULL)
+
+	call calloc (cq, CQ_LEN, TY_STRUCT)
+	call strcpy (database, CQ_CATDB(cq), SZ_FNAME)
+	CQ_FD(cq) = i
+
+	if (mode != READ_ONLY)
+	    return (cq)
+
+	cq_alloc1 = CQ_ALLOC
+	cq_alloc2 = CQ_ALLOC * SZ_LINE
+	call malloc (CQ_OFFSETS(cq), cq_alloc1, TY_LONG)
+	call malloc (CQ_NAMES(cq), cq_alloc1, TY_INT)
+	call malloc (CQ_MAP(cq), cq_alloc2, TY_CHAR)
+	call malloc (str, SZ_LINE, TY_CHAR)
+
+	nrec = 1
+	CQ_NRECS(cq) = 0
+	CQ_NAMEI(cq, nrec) = 0
+
+	while (fscan (CQ_FD(cq)) != EOF) {
+	    call gargwrd (CQ_NAME(cq, nrec), SZ_LINE)
+
+	    if (streq (CQ_NAME(cq, nrec), "begin")) {
+	        call gargstr (Memc[str], SZ_LINE)
+		for (i=str; IS_WHITE(Memc[i]); i=i+1)
+		    ;
+		call strcpy (Memc[i], CQ_NAME(cq,nrec), SZ_LINE)
+
+		for (i = 1; i < nrec; i = i + 1)
+		    if (streq (CQ_NAME(cq, i), CQ_NAME(cq, nrec)))
+			break
+
+		if (i < nrec)
+		    CQ_OFFSET(cq, i) = note (CQ_FD(cq))
+		else {
+		    CQ_NRECS(cq) = nrec
+		    CQ_OFFSET(cq, nrec) = note (CQ_FD(cq))
+		    CQ_NAMEI(cq, nrec+1) = CQ_NAMEI(cq, nrec) +
+			strlen (CQ_NAME(cq, nrec)) + 1
+		    nrec = nrec + 1
+		}
+
+		if (nrec == cq_alloc1) {
+		    cq_alloc1 = cq_alloc1 + CQ_ALLOC
+		    call realloc (CQ_OFFSETS(cq), cq_alloc1, TY_LONG)
+		    call realloc (CQ_NAMES(cq), cq_alloc1, TY_INT)
+		}
+		if (CQ_NAMEI(cq, nrec) + SZ_LINE >= cq_alloc2) {
+		    cq_alloc2 = cq_alloc2 + CQ_ALLOC * SZ_LINE
+		    call realloc (CQ_MAP(cq), cq_alloc2, TY_CHAR)
+		}
+	    }
+	}
+
+	call realloc (CQ_MAP(cq), CQ_NAMEI(cq, nrec), TY_CHAR)
+	call realloc (CQ_OFFSETS(cq), CQ_NRECS(cq), TY_LONG)
+	call realloc (CQ_NAMES(cq), CQ_NRECS(cq), TY_INT)
+	call mfree (str, TY_CHAR)
+
+	return (cq)
+end
+
+
+# CQ_UNMAP -- Close the database.
+
+procedure cq_unmap (cq)
+
+pointer	cq				#U The database file descriptor
+
+begin
+	if (cq == NULL)
+	    return
+
+	# Free the current catalog structure.
+	call cq_ccfree (cq)
+
+	# Close the catalog database file.
+	if (CQ_FD(cq) != NULL)
+	    call close (CQ_FD(cq))
+
+	# Free the record mapping arrays.
+	call mfree (CQ_MAP(cq), TY_CHAR)
+	call mfree (CQ_OFFSETS(cq), TY_LONG)
+	call mfree (CQ_NAMES(cq), TY_INT)
+
+	# Free the structure.
+	call mfree (cq, TY_STRUCT)
+end
diff --git a/pkg/xtools/catquery/cqnqpars.x b/pkg/xtools/catquery/cqnqpars.x
new file mode 100644
index 00000000..d7769925
--- /dev/null
+++ b/pkg/xtools/catquery/cqnqpars.x
@@ -0,0 +1,18 @@
+include "cqdef.h"
+
+
+# CQ_NQPARS -- Return the number of query parameters.  Do we really need
+# a special routine ?
+
+int procedure cq_nqpars (cq)
+
+pointer	cq				#I the catalog descriptor
+
+begin
+	if (CQ_CAT(cq) == NULL)
+	    return (0)
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    return (0)
+
+	return (CQ_NQPARS(CQ_CAT(cq)))
+end
diff --git a/pkg/xtools/catquery/cqquery.x b/pkg/xtools/catquery/cqquery.x
new file mode 100644
index 00000000..1806484c
--- /dev/null
+++ b/pkg/xtools/catquery/cqquery.x
@@ -0,0 +1,998 @@
+include <fset.h>
+include <ctype.h>
+include "cqdef.h"
+include "cq.h"
+
+
+define	DEF_SZ_INBUF	32768	# the maximum network transfer buffer size
+define	DEF_SZ_INDEX	1000    # the record index length increment
+
+# CQ_QUERY -- Send a query and return the data.
+
+pointer	procedure cq_query (cq)
+
+pointer	cq			#I the catalog database descriptor
+
+pointer	cc, res, inbuf, line, sp, spfname
+char    url[SZ_PATHNAME], addr[SZ_LINE], query[SZ_LINE], buf[SZ_LINE]
+int	j, fd, nchars, nlines, nrecs, szindex, ip, op
+bool	done
+long	note()
+pointer	cq_rinit()
+int	ndopen(), strlen(), read(), open(), getline(), fstati(), url_get()
+errchk	ndopen(), fprintf(), areadb(), awriteb(), open(), read()
+
+begin
+	# Check that the current catalog is defined.
+        if (CQ_CAT(cq) == NULL)
+            return (NULL)
+        if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+            return (NULL)
+	cc = CQ_CAT(cq)
+
+
+        if (0<1&& USE_URLGET) {
+            # Initialize the image results structure.
+	    res = cq_rinit (cq)
+
+            call strcpy (CQ_ADDRESS(cc), buf, SZ_LINE)
+            for (ip=1; buf[ip] != ':'; ip=ip+1) ;       # skip 'inet:'
+            ip = ip + 1
+            for (    ; buf[ip] != ':'; ip=ip+1) ;       # skip '80:'
+            ip = ip + 1
+            for (op=1; buf[ip] != ':'; ip=ip+1) {
+                addr[op] = buf[ip]
+                op = op + 1
+            }
+            addr[op] = EOS
+
+            call strcpy (CQ_RQUERY(res), buf, SZ_LINE)
+            for (op=1; !IS_WHITE(buf[op+4]); op=op+1)
+                query[op] = buf[op+4]
+            query[op] = EOS
+
+            call sprintf (url, SZ_LINE, "http://%s%s")
+                call pargstr (addr)
+                call pargstr (query)
+
+            iferr {
+	        call smark (sp)
+	        call salloc (spfname, SZ_FNAME, TY_CHAR)
+
+                call malloc (inbuf, DEF_SZ_INBUF, TY_CHAR)
+
+	        # Open the output spool file.
+	        call mktemp ("query", Memc[spfname], SZ_FNAME)
+
+                if (url_get (url, Memc[spfname], inbuf) < 0)
+                    call error (0, "Cannot access url")
+
+	        fd = open (Memc[spfname], READ_ONLY, TEXT_FILE)
+	        CQ_RFD(res) = open (Memc[spfname], READ_WRITE, SPOOL_FILE)
+	        repeat {
+	 	    call aclrc (Memc[inbuf], DEF_SZ_INBUF)
+	            nchars = read (fd, Memc[inbuf], DEF_SZ_INBUF)
+	            if (nchars > 0) {
+		        Memc[inbuf+nchars] = EOS
+	                call write (CQ_RFD(res), Memc[inbuf], nchars)
+		        done = false
+	            } else
+	                done = true
+	        } until (done)
+	        call flush (CQ_RFD(res))
+		call close (fd)
+
+	        CQ_RBUF(res) = fstati (CQ_RFD(res), F_BUFPTR)
+	        call seek (CQ_RFD(res), BOF)
+
+                call mfree (inbuf, TY_CHAR)
+		call sfree (sp)
+
+            } then {
+                if (res != NULL)
+	    	    call cq_rfree (res)
+                return (NULL)
+            }
+
+        } else {
+
+	    # Open the network connection.
+	    iferr (fd = ndopen (CQ_ADDRESS(cc), READ_WRITE))
+	        return (NULL)
+
+	    # Initialize the results structure.
+	    res = cq_rinit (cq)
+
+	    # Send the query and get back the results.
+	    iferr {
+
+	        call smark (sp)
+
+	        # Formulate the query.
+	        switch (CQ_RTYPE(res)) {
+	        case CQ_STEXT, CQ_BTEXT:
+	            call fprintf (fd, "%s")
+	                call pargstr (CQ_RQUERY(res))
+	        default:
+	            nchars = strlen (CQ_RQUERY(res))
+		    call write (fd, CQ_RQUERY(res), nchars)
+	        }
+	        call flush (fd)
+
+	        # Open the output spool file.
+	        call salloc (spfname, SZ_FNAME, TY_CHAR)
+	        call mktemp ("query", Memc[spfname], SZ_FNAME)
+	        CQ_RFD(res) = open (Memc[spfname], READ_WRITE, SPOOL_FILE)
+	        call sfree (sp)
+
+	        # Get the data.
+	        call malloc (inbuf, DEF_SZ_INBUF, TY_CHAR)
+	        call fseti (fd, F_CANCEL, OK)
+
+	        switch (CQ_HFMT(cc)) {
+	        case CQ_HNONE:
+		    ;
+	        case CQ_HHTTP:
+	            repeat {
+	                nchars = getline (fd, Memc[inbuf])
+	                if (nchars <= 0)
+		            break
+		        Memc[inbuf+nchars] = EOS
+	            } until ((Memc[inbuf] == '\r' && Memc[inbuf+1] == '\n') ||
+	                (Memc[inbuf] == '\n'))
+	        default:
+		    ;
+	        }
+
+	        repeat {
+	            nchars = read (fd, Memc[inbuf], DEF_SZ_INBUF)
+	            if (nchars > 0) {
+		        Memc[inbuf+nchars] = EOS
+	                call write (CQ_RFD(res), Memc[inbuf], nchars)
+		        done = false
+	            } else {
+	                done = true
+	            }
+	        } until (done)
+
+	        # Cleanup.
+	        call flush (CQ_RFD(res))
+	        call mfree (inbuf, TY_CHAR)
+	        CQ_RBUF(res) = fstati (CQ_RFD(res), F_BUFPTR)
+	        call seek (CQ_RFD(res), BOF)
+	        call close (fd)
+
+	    } then {
+	        call cq_rfree (res)
+	        call close (fd)
+	        return (NULL)
+	    }
+
+	}
+
+	# Construct the record index.
+	CQ_RNRECS(res) = 0
+	switch (CQ_RTYPE(res)) {
+	case CQ_STEXT, CQ_BTEXT:
+
+	    # Initialize.
+	    nlines = 0
+	    nrecs = 0
+
+	    # Iniitialize the index array.
+	    szindex = DEF_SZ_INDEX
+	    call malloc (line, SZ_LINE, TY_CHAR)
+	    call calloc (CQ_RINDEX(res), szindex, TY_LONG)
+
+	    # Create the index array.
+	    repeat {
+		Meml[CQ_RINDEX(res)+nrecs] = note (CQ_RFD(res)) 
+		nchars = getline (CQ_RFD(res), Memc[line])
+		if (nchars == EOF)
+		    break
+		nlines = nlines + 1
+		if (nlines <= CQ_RHSKIP(res))
+		    next
+		if (Memc[line] == '\n')
+		    next
+		#if (CQ_RECSIZE(res) > 0 && nchars != CQ_RECSIZE(res))
+		if (CQ_RECSIZE(res) > 0 && nchars > CQ_RECSIZE(res))
+		    Meml[CQ_RINDEX(res)+nrecs] = EOF
+	        else if (CQ_RTRIML(res) > 0 || CQ_RTRIMR(res) > 0) {
+		    inbuf = CQ_RBUF(res) + Meml[CQ_RINDEX(res)+nrecs] - 1 
+		    do j = 1, min (CQ_RTRIML(res), nchars)
+			Memc[inbuf+j-1] = ' '
+		    do j = nchars - CQ_RTRIMR(res), nchars - 1
+			Memc[inbuf+j-1] = ' '
+		}
+		nrecs = nrecs + 1
+		if (nrecs >= szindex) {
+		    szindex = szindex + DEF_SZ_INDEX
+	    	    call realloc (CQ_RINDEX(res), szindex, TY_LONG)
+		    call aclrl (Meml[CQ_RINDEX(res)+szindex-DEF_SZ_INDEX],
+		        DEF_SZ_INDEX)
+		}
+	    }
+	    call mfree (line, TY_CHAR)
+	    CQ_RNRECS(res) = nrecs
+
+	    # Remove the incorrectly sized and trailing records.
+	    nrecs = 0
+	    do j = 0, CQ_RNRECS(res) - CQ_RTSKIP(res) - 1 {
+		if (Meml[CQ_RINDEX(res)+j] == EOF)
+		    next
+		Meml[CQ_RINDEX(res)+nrecs] = Meml[CQ_RINDEX(res)+j]
+		nrecs = nrecs + 1
+	    }
+	    CQ_RNRECS(res) = nrecs
+
+	    # Resize the index array.
+	    call realloc (CQ_RINDEX(res), max (1, CQ_RNRECS(res) + 1), TY_LONG)
+
+	default:
+	    ;
+	}
+
+	# Return the results pointer.
+	return (res)
+end
+
+
+# CQ_FQUERY -- Treat a catalog file file as thought it were the results
+# of a query. The catalog file file name and file description are passed
+# to the routine as arguments.
+
+pointer	procedure cq_fquery (cq, catfile, catfmt)
+
+pointer	cq			#I the catalog database descriptor
+char	catfile[ARB]		#I the input catalog file
+char	catfmt[ARB]		#I the input catalog description
+
+pointer	res, inbuf, line, sp, spfname
+int	j, fd, nchars, nlines, nrecs, szindex
+bool	done
+pointer	cq_frinit()
+long	note()
+int	access(), open(), read(), fstati(), getline()
+errchk	open(), read()
+
+begin
+	# Check that the current catalog is defined.
+        if (CQ_CAT(cq) == NULL)
+            return (NULL)
+        if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+            return (NULL)
+
+	# Check to see if the catalog file exists.
+	if (access (catfile, 0, 0) == NO)
+	    return (NULL)
+
+	# Check to see if the fmt string is defined.
+	if (catfmt[1] == EOS)
+	    return (NULL)
+
+	# Open the catalog file.
+	if (access (catfile, READ_ONLY, TEXT_FILE) == YES) {
+	    iferr (fd = open (catfile, READ_ONLY, TEXT_FILE))
+		return (NULL)
+	} else {
+	    iferr (fd = open (catfile, READ_ONLY, BINARY_FILE))
+		return (NULL)
+	}
+
+	# Initialize the results structure using the file description.
+	res = cq_frinit (cq, catfmt)
+	if (res == NULL)
+	    return (NULL)
+
+	# Read in the results.
+	iferr {
+
+	    # Open the output spool file.
+	    call smark (sp)
+	    call salloc (spfname, SZ_FNAME, TY_CHAR)
+	    call mktemp ("query", Memc[spfname], SZ_FNAME)
+	    #CQ_RFD(res) = open ("dev$null", READ_WRITE, SPOOL_FILE)
+	    CQ_RFD(res) = open (Memc[spfname], READ_WRITE, SPOOL_FILE)
+	    call sfree (sp)
+
+	    # Get the data.
+	    call malloc (inbuf, DEF_SZ_INBUF, TY_CHAR)
+	    repeat {
+	        nchars = read (fd, Memc[inbuf], DEF_SZ_INBUF)
+	        if (nchars > 0) {
+		    Memc[inbuf+nchars] = EOS
+	            call write (CQ_RFD(res), Memc[inbuf], nchars)
+		    done = false
+	        } else {
+		    done = true
+	        }
+	    } until (done)
+
+	    # Cleanup.
+	    call flush (CQ_RFD(res))
+	    call mfree (inbuf, TY_CHAR)
+	    CQ_RBUF(res) = fstati (CQ_RFD(res), F_BUFPTR)
+	    call close (fd)
+
+	} then {
+	    call cq_rfree (res)
+	    call close (fd)
+	    return (NULL)
+	}
+
+	# Construct the record index.
+	CQ_RNRECS(res) = 0
+	switch (CQ_RTYPE(res)) {
+	case CQ_STEXT, CQ_BTEXT:
+
+	    # Initialize.
+	    nlines = 0
+	    nrecs = 0
+
+	    # Iniitialize the index array.
+	    szindex = DEF_SZ_INDEX
+	    call malloc (line, SZ_LINE, TY_CHAR)
+	    call calloc (CQ_RINDEX(res), szindex, TY_LONG)
+
+	    # Create the index array.
+	    call seek (CQ_RFD(res), BOF)
+	    repeat {
+		Meml[CQ_RINDEX(res)+nrecs] = note (CQ_RFD(res)) 
+		nchars = getline (CQ_RFD(res), Memc[line])
+		if (nchars == EOF)
+		    break
+		nlines = nlines + 1
+		if (nlines <= CQ_RHSKIP(res))
+		    next
+		if (Memc[line] == '\n')
+		    next
+		if (Memc[line] == '#')
+		    next
+		#if (CQ_RECSIZE(res) > 0 && nchars != CQ_RECSIZE(res))
+		if (CQ_RECSIZE(res) > 0 && nchars > CQ_RECSIZE(res))
+		    Meml[CQ_RINDEX(res)+nrecs] = EOF
+	        else if (CQ_RTRIML(res) > 0 || CQ_RTRIMR(res) > 0) {
+		    inbuf = CQ_RBUF(res) + Meml[CQ_RINDEX(res)+nrecs] - 1 
+		    do j = 1, min (CQ_RTRIML(res), nchars)
+			Memc[inbuf+j-1] = ' '
+		    do j = nchars - CQ_RTRIMR(res), nchars - 1
+			Memc[inbuf+j-1] = ' '
+		}
+		nrecs = nrecs + 1
+		if (nrecs >= szindex) {
+		    szindex = szindex + DEF_SZ_INDEX
+	    	    call realloc (CQ_RINDEX(res), szindex, TY_LONG)
+		    call aclrl (Meml[CQ_RINDEX(res)+szindex-DEF_SZ_INDEX],
+		        DEF_SZ_INDEX)
+		}
+	    }
+	    call mfree (line, TY_CHAR)
+	    CQ_RNRECS(res) = nrecs
+
+	    # Check for and reject short records and trim trailing records.
+	    nrecs = 0
+	    do j = 0, CQ_RNRECS(res) - CQ_RTSKIP(res)  - 1 {
+		if (Meml[CQ_RINDEX(res)+j] == EOF)
+		    next
+		Meml[CQ_RINDEX(res)+nrecs] = Meml[CQ_RINDEX(res)+j]
+		nrecs = nrecs + 1
+	    }
+	    CQ_RNRECS(res) = nrecs
+
+	    # Trim the trailing records.
+	    call realloc (CQ_RINDEX(res), max (1, CQ_RNRECS(res) + 1), TY_LONG)
+
+	default:
+	    ;
+	}
+
+	return (res)
+end
+
+
+# CQ_RCLOSE -- Close the results structure,
+
+procedure cq_rclose (res)
+
+pointer	res			#U the results descriptor.
+
+begin
+	call cq_rfree (res)
+end
+
+
+# CQ_RINIT -- Initialize a results descriptor.
+
+pointer procedure cq_rinit (cq)
+
+pointer	cq			#I the catalog descriptor
+
+pointer	cc, res, sp, query, value, kname, fname, funits, ffmt
+int	i, ncount, sz1, sz2, sz3, op1, op2, op3, foffset, fsize
+char	ftype
+int	cq_wrdstr(), strdic(), cq_dgeti(), cq_dscan(), nscan()
+int	cq_dtype(), strlen(), gstrcpy()
+errchk	cq_dgwrd(), cq_dgeti(), cq_dscan()
+
+begin
+	# Check that the current catalog is defined.
+        if (CQ_CAT(cq) == NULL)
+            return (NULL)
+        if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+            return (NULL)
+	cc = CQ_CAT(cq)
+
+	# Allocate the results structure.
+	call calloc (res, CQ_LEN_RES, TY_STRUCT)
+
+	# Format the query.
+	call smark (sp)
+	call salloc (query, SZ_LINE, TY_CHAR)
+	call salloc (value, CQ_SZ_QPVALUE, TY_CHAR)
+	call sprintf (Memc[query], SZ_LINE, CQ_QUERY(cc))
+	do i = 1, CQ_NQPARS(cc) {
+	    if (cq_wrdstr (i, Memc[value], CQ_SZ_QPVALUE,
+	        Memc[CQ_PQPVALUES(cc)]) <= 0)
+		next
+	    call pargstr (Memc[value])
+	}
+
+	# Save the catalog informaton and query in the results structure.
+	call strcpy (CQ_CATDB(cq), CQ_RCATDB(res), SZ_FNAME)
+	call strcpy (CQ_CATNAME(cq), CQ_RCATNAME(res), SZ_FNAME)
+	call strcpy (CQ_ADDRESS(cc), CQ_RADDRESS(res), SZ_LINE)
+	call strcpy (Memc[query], CQ_RQUERY(res), SZ_LINE)
+
+	# Copy the query parameters to the results descriptor.
+	CQ_RNQPARS(res) = CQ_NQPARS(cc)
+	fsize = strlen (Memc[CQ_PQPNAMES(cc)])
+	call malloc (CQ_RQPNAMES(res), fsize, TY_CHAR)
+	call strcpy (Memc[CQ_PQPNAMES(cc)], Memc[CQ_RQPNAMES(res)], fsize)
+	fsize = strlen (Memc[CQ_PQPVALUES(cc)])
+	call malloc (CQ_RQPVALUES(res), fsize, TY_CHAR)
+	call strcpy (Memc[CQ_PQPVALUES(cc)], Memc[CQ_RQPVALUES(res)], fsize)
+	fsize = strlen (Memc[CQ_PQPUNITS(cc)])
+	call malloc (CQ_RQPUNITS(res), fsize, TY_CHAR)
+	call strcpy (Memc[CQ_PQPUNITS(cc)], Memc[CQ_RQPUNITS(res)], fsize)
+
+	# Get the input data type.
+	iferr {
+	    call cq_dgwrd (cq, CQ_CATNO(cq), "type", Memc[value],
+	        CQ_SZ_QPVALUE)
+	} then {
+	    Memc[value] = EOS
+	   CQ_RTYPE(res) = CQ_STEXT
+	} else {
+	    CQ_RTYPE(res) = strdic (Memc[value], Memc[value], CQ_SZ_QPVALUE,
+	        CQ_RTYPESTR)
+	}
+
+	# Get the number of leading and trailing records to be skipped.
+	iferr (CQ_RHSKIP(res) = cq_dgeti (cq, CQ_CATNO(cq), "hskip"))
+	    CQ_RHSKIP(res) = 0
+	iferr (CQ_RTSKIP(res) = cq_dgeti (cq, CQ_CATNO(cq), "tskip"))
+	    CQ_RTSKIP(res) = 0
+
+	# Get the record size and trimming parameters.
+	iferr (CQ_RECSIZE(res) = cq_dgeti (cq, CQ_CATNO(cq), "recsize"))
+	    CQ_RECSIZE(res) = 0
+	iferr (CQ_RTRIML(res) = cq_dgeti (cq, CQ_CATNO(cq), "triml"))
+	    CQ_RTRIML(res) = 0
+	iferr (CQ_RTRIMR(res) = cq_dgeti (cq, CQ_CATNO(cq), "trimr"))
+	    CQ_RTRIMR(res) = 0
+
+	iferr (CQ_NHEADER(res) = cq_dgeti (cq, CQ_CATNO(cq), "nheader"))
+	    CQ_NHEADER(res) = 0
+
+	# Get the header parameters.
+	call calloc (CQ_HKNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_HKVALUES(res), SZ_LINE, TY_CHAR)
+	ncount = 0
+	if (CQ_NHEADER(res) > 0) {
+
+	    # Initialize the header parameter keywords and values.
+	    sz1 = SZ_LINE; op1 = 2
+	    sz2 = SZ_LINE; op2 = 2
+	    call strcpy ("|", Memc[CQ_HKNAMES(res)], sz1)
+	    call strcpy ("|", Memc[CQ_HKVALUES(res)], sz2)
+
+	    call salloc (kname, CQ_SZ_FNAME, TY_CHAR)
+	    do i = 1, CQ_NHEADER(res) {
+
+		# Get the keyword and value.
+		if (cq_dscan (cq) == EOF)
+		    break
+		call gargwrd (Memc[kname], CQ_SZ_QPNAME)
+		call gargwrd (Memc[query], SZ_LINE)
+		if (nscan() != 2)
+		    break
+
+		# Add the keyword name to the list.
+		if ((sz1 - op1 + 1) < (CQ_SZ_QPNAME + 1)) {
+		    sz1 = sz1 + SZ_LINE
+		    call realloc (CQ_HKNAMES(res), sz1, TY_CHAR)
+		}
+		op1 = op1 + gstrcpy (Memc[kname], Memc[CQ_HKNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+		op1 = op1 + gstrcpy ("|", Memc[CQ_HKNAMES(res)+op1-1],
+		    sz1 - op1 + 1)
+
+		# Add the keyword value to the list.
+		if ((sz2 - op2 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		    sz2 = sz2 + SZ_LINE
+		    call realloc (CQ_HKVALUES(res), sz2, TY_CHAR)
+		}
+		op2 = op2 + gstrcpy (Memc[query], Memc[CQ_HKVALUES(res)+op2-1],
+		    sz2 - op2 + 1)
+		op2 = op2 + gstrcpy ("|", Memc[CQ_HKVALUES(res)+op2-1],
+		    sz2 - op2 + 1)
+
+		ncount = ncount + 1
+	    }
+	}
+
+	# Resize the header keyword  and value arrays.
+	if (ncount != CQ_NHEADER(res)) {
+	    CQ_NHEADER(res) = 0
+	    call realloc (CQ_HKNAMES(res), 1, TY_CHAR)
+	    call realloc (CQ_HKVALUES(res), 1, TY_CHAR)
+	    Memc[CQ_HKNAMES(res)] = EOS
+	    Memc[CQ_HKVALUES(res)] = EOS
+	} else {
+	    call realloc (CQ_HKNAMES(res), op1, TY_CHAR)
+	    call realloc (CQ_HKVALUES(res), op2, TY_CHAR)
+	    Memc[CQ_HKNAMES(res)+op1] = EOS
+	    Memc[CQ_HKVALUES(res)+op2] = EOS
+	}
+
+	iferr (CQ_NFIELDS(res) = cq_dgeti (cq, CQ_CATNO(cq), "nfields"))
+	    CQ_NFIELDS(res) = 0
+
+	# Allocate the field description arrays.
+	call calloc (CQ_FNAMES(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_FOFFSETS(res), CQ_NFIELDS(res), TY_INT)
+	call calloc (CQ_FSIZES(res), CQ_NFIELDS(res), TY_INT)
+	call calloc (CQ_FTYPES(res), CQ_NFIELDS(res), TY_INT)
+	call calloc (CQ_FUNITS(res), SZ_LINE, TY_CHAR)
+	call calloc (CQ_FFMTS(res), SZ_LINE, TY_CHAR)
+
+	# Get the field decoding parameters.
+	ncount = 0
+	if (CQ_NFIELDS(res) > 0) {
+
+	    call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+	    call salloc (funits, CQ_SZ_FUNITS, TY_CHAR)
+	    call salloc (ffmt, CQ_SZ_FFMTS, TY_CHAR)
+
+	    # Initialize the name, units, and format string dictionaries.
+	    sz1 = SZ_LINE; op1 = 2
+	    sz2 = SZ_LINE; op2 = 2
+	    sz3 = SZ_LINE; op3 = 2
+	    call strcpy ("|", Memc[CQ_FNAMES(res)], sz1)
+	    call strcpy ("|", Memc[CQ_FUNITS(res)], sz2)
+	    call strcpy ("|", Memc[CQ_FFMTS(res)], sz3)
+
+	    do i =1, CQ_NFIELDS(res) {
+
+		# Get the field description.
+		if (cq_dscan (cq) == EOF)
+		    break
+		call gargwrd (Memc[fname], CQ_SZ_FNAME)
+		call gargi (foffset)
+		call gargi (fsize)
+		call gargc (ftype)
+		call gargwrd (Memc[funits], CQ_SZ_FUNITS)
+		call gargwrd (Memc[ffmt], CQ_SZ_FFMTS)
+		if (nscan() != 6)
+		    break
+
+		# Add the field name to the field name dictionary.
+                if ((sz1 - op1 + 1) < (CQ_SZ_FNAME + 1)) {
+                    sz1 = sz1 + SZ_LINE
+                    call realloc (CQ_FNAMES(res), sz1, TY_CHAR)
+                }
+                op1 = op1 + gstrcpy (Memc[fname], Memc[CQ_FNAMES(res)+op1-1],
+                    sz1 - op1 + 1)
+                op1 = op1 + gstrcpy ("|", Memc[CQ_FNAMES(res)+op1-1],
+                    sz1 - op1 + 1)
+
+		# Set the field offset, size, and type.
+		Memi[CQ_FOFFSETS(res)+i-1] = foffset
+		Memi[CQ_FTYPES(res)+i-1] = cq_dtype (ftype)
+		Memi[CQ_FSIZES(res)+i-1] = fsize
+
+		# Add the field units to the field units dictionary.
+                if ((sz2 - op2 + 1) < (CQ_SZ_FUNITS + 1)) {
+                    sz2 = sz2 + SZ_LINE
+                    call realloc (CQ_FUNITS(res), sz2, TY_CHAR)
+                }
+                op2 = op2 + gstrcpy (Memc[funits], Memc[CQ_FUNITS(res)+op2-1],
+                    sz2 - op2 + 1)
+                op2 = op2 + gstrcpy ("|", Memc[CQ_FUNITS(res)+op2-1],
+                    sz2 - op2 + 1)
+
+		# Add the field format to the field format dictionary.
+                if ((sz3 - op3 + 1) < (CQ_SZ_FFMTS + 1)) {
+                    sz3 = sz3 + SZ_LINE
+                    call realloc (CQ_FFMTS(res), sz3, TY_CHAR)
+                }
+                op3 = op3 + gstrcpy (Memc[ffmt], Memc[CQ_FFMTS(res)+op3-1],
+                    sz3 - op3 + 1)
+                op3 = op3 + gstrcpy ("|", Memc[CQ_FFMTS(res)+op3-1],
+                    sz3 - op3 + 1)
+
+		ncount = ncount + 1
+	    }
+	} 
+
+	# Adjust the field description size.
+	if (ncount != CQ_NFIELDS(res)) {
+	    CQ_NFIELDS(res) = 0
+	    call realloc (CQ_FNAMES(res), 1, TY_CHAR)
+	    Memc[CQ_FNAMES(res)] = EOS
+	    call mfree (CQ_FOFFSETS(res), TY_INT); CQ_FOFFSETS(res) = NULL
+	    call mfree (CQ_FSIZES(res), TY_INT); CQ_FSIZES(res) = NULL
+	    call mfree (CQ_FTYPES(res), TY_INT); CQ_FTYPES(res) = NULL
+	    call realloc (CQ_FUNITS(res), 1, TY_CHAR)
+	    Memc[CQ_FUNITS(res)] = EOS
+	    call realloc (CQ_FFMTS(res), 1, TY_CHAR)
+	    Memc[CQ_FFMTS(res)] = EOS
+	} else {
+	    call realloc (CQ_FNAMES(res), op1, TY_CHAR)
+	    call realloc (CQ_FUNITS(res), op2, TY_CHAR)
+	    call realloc (CQ_FFMTS(res), op3, TY_CHAR)
+	    Memc[CQ_FNAMES(res)+op1] = EOS
+	    Memc[CQ_FUNITS(res)+op2] = EOS
+	    Memc[CQ_FFMTS(res)+op3] = EOS
+	}
+
+	# Allocate space for the simple text field indices array.
+	call calloc (CQ_FINDICES(res), CQ_MAX_NFIELDS + 1, TY_INT)
+
+	# Initilize the records descriptor.
+	CQ_RFD(res) = NULL
+
+	call sfree (sp)
+
+	return (res)
+end
+
+
+# Temporary definitions to get stuff working. Move into header file at some
+# point ?
+
+define	DIC_FNAMES	"|type|hskip|tskip|recsize|triml|trimr|nheader|nfields|"
+define	DIC_TYPE	1 
+define	DIC_HSKIP	2 
+define	DIC_TSKIP	3 
+define	DIC_RECORD	4 
+define	DIC_TRIML	5 
+define	DIC_TRIMR	6 
+define	DIC_NHEADER	7 
+define	DIC_NFIELDS	8 
+
+# CQ_FRINIT -- Initialize a results descriptor from a file description.
+
+pointer procedure cq_frinit (cq, catfmt)
+
+pointer	cq			#I Initialize the results structure.
+char	catfmt[ARB]		#I the catalog format desciption
+
+pointer	res, sp, fname, funits, ffmt, fvalue
+int	i, ncount, sz1, sz2, sz3, op1, op2, op3, fd, foffset, fsize
+int	fscan(), nscan(), strdic(), strlen(), cq_dtype(), gstrcpy()
+char	ftype
+int	stropen()
+
+begin
+	# Check that the current catalog is defined.
+        if (CQ_CAT(cq) == NULL)
+            return (NULL)
+        if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+            return (NULL)
+
+	# Allocate the structure.
+	call calloc (res, CQ_LEN_RES, TY_STRUCT)
+
+	# Format the catalog information, the address, query, and query
+	# parameters.
+	call strcpy (CQ_CATDB(cq), CQ_RCATDB(res), SZ_LINE)
+	call strcpy (CQ_CATNAME(cq), CQ_RCATNAME(res), SZ_LINE)
+	call strcpy ("", CQ_RADDRESS(res), SZ_LINE)
+	call strcpy ("", CQ_RQUERY(res), SZ_LINE)
+	CQ_RNQPARS(res) = 0
+	call malloc (CQ_RQPNAMES(res), 1, TY_CHAR)
+	call malloc (CQ_RQPVALUES(res), 1, TY_CHAR)
+	call malloc (CQ_RQPUNITS(res), 1, TY_CHAR)
+	Memc[CQ_RQPNAMES(res)] = EOS
+	Memc[CQ_RQPVALUES(res)] = EOS
+	Memc[CQ_RQPUNITS(res)] = EOS
+
+	# Set default file formats.
+	CQ_RTYPE(res) = CQ_STEXT
+	CQ_RHSKIP(res) = 0
+	CQ_RTSKIP(res) = 0
+	CQ_RECSIZE(res) = 0
+	CQ_RTRIML(res) = 0
+	CQ_RTRIMR(res) = 0
+	CQ_NFIELDS(res) = 0
+
+	call smark(sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+	call salloc (funits, CQ_SZ_FUNITS, TY_CHAR)
+	call salloc (ffmt, CQ_SZ_FFMTS, TY_CHAR)
+	call salloc (fvalue, SZ_LINE, TY_CHAR)
+
+	# Read in the defined file formats.
+	fd = stropen (catfmt, strlen (catfmt), READ_ONLY)
+	while (fscan (fd) != EOF) {
+
+	    # Get the field name.
+	    call gargwrd (Memc[fname], CQ_SZ_FNAME)
+	    if (nscan () < 1 || Memc[fname] == EOS)
+		next
+	    i = strdic (Memc[fname], Memc[fname], CQ_SZ_FNAME, DIC_FNAMES) 
+
+	    # Decode the field.
+	    switch (i) {
+
+	    case DIC_TYPE:
+	        call gargwrd (Memc[fname], CQ_SZ_FNAME)
+		if (nscan () < 2 || Memc[fname] == EOS)
+		    CQ_RTYPE(res) = CQ_STEXT
+		else
+	    	    CQ_RTYPE(res) = strdic (Memc[fname], Memc[fname],
+		        CQ_SZ_FNAME, CQ_RTYPESTR)
+
+	    case DIC_HSKIP:
+		call gargi (CQ_RHSKIP(res))
+		if (nscan() < 2)
+		    CQ_RHSKIP(res) = 0
+
+	    case DIC_TSKIP:
+		call gargi (CQ_RTSKIP(res))
+		if (nscan() < 2)
+		    CQ_RTSKIP(res) = 0
+
+	    case DIC_RECORD:
+		call gargi (CQ_RECSIZE(res))
+		if (nscan() < 2)
+		    CQ_RECSIZE(res) = 0
+
+	    case DIC_TRIML:
+		call gargi (CQ_RTRIML(res))
+		if (nscan() < 2)
+		    CQ_RTRIML(res) = 0
+
+	    case DIC_TRIMR:
+		call gargi (CQ_RTRIMR(res))
+		if (nscan() < 2)
+		    CQ_RTRIMR(res) = 0
+
+	    case DIC_NHEADER:
+		call gargi (CQ_NHEADER(res))
+		if (nscan() < 2)
+		    CQ_NHEADER(res) = 0
+
+                call calloc (CQ_HKNAMES(res), SZ_LINE, TY_CHAR)
+                call calloc (CQ_HKVALUES(res), SZ_LINE, TY_CHAR)
+
+		ncount = 0
+		if (CQ_NHEADER(res) > 0) {
+
+		    # Initialize the header name and value dictionaries.
+                    sz1 = SZ_LINE; op1 = 2
+                    sz2 = SZ_LINE; op2 = 2
+                    call strcpy ("|", Memc[CQ_HKNAMES(res)], sz1)
+                    call strcpy ("|", Memc[CQ_HKVALUES(res)], sz2)
+
+	    	    do i = 1, CQ_NHEADER(res) {
+
+			# Get the keyword name and value.
+			if (fscan (fd) == EOF)
+			    break
+			call gargwrd (Memc[fname], CQ_SZ_QPNAME)
+			call gargwrd (Memc[fvalue], SZ_LINE)
+			if (nscan() != 2)
+		    	    break
+
+			# Add the keyword name to the keyword dictionary.
+                	if ((sz1 - op1 + 1) < (CQ_SZ_QPNAME + 1)) {
+                    	    sz1 = sz1 + SZ_LINE
+                    	    call realloc (CQ_HKNAMES(res), sz1, TY_CHAR)
+                        }
+                	op1 = op1 + gstrcpy (Memc[fname], Memc[CQ_HKNAMES(res)+
+			    op1-1], sz1 - op1 + 1)
+                	op1 = op1 + gstrcpy ("|", Memc[CQ_HKNAMES(res)+op1-1],
+                    	    sz1 - op1 + 1)
+
+			# Add the keyword value to the keyword value dictionary.
+                	if ((sz2 - op2 + 1) < (CQ_SZ_QPVALUE + 1)) {
+                    	    sz2 = sz2 + SZ_LINE
+                    	    call realloc (CQ_HKVALUES(res), sz2, TY_CHAR)
+                	}
+                	op2 = op2 + gstrcpy (Memc[fvalue],
+			    Memc[CQ_HKVALUES(res)+ op2-1], sz2 - op2 + 1)
+                	op2 = op2 + gstrcpy ("|", Memc[CQ_HKVALUES(res)+op2-1],
+                    	    sz2 - op2 + 1)
+
+			ncount = ncount + 1
+		    }
+		}
+
+		# Addjust the keyword dictionary sizes.
+	    	if (ncount != CQ_NHEADER(res)) {
+                    CQ_NHEADER(res) = 0
+                    call realloc (CQ_HKNAMES(res), 1, TY_CHAR)
+                    call realloc (CQ_HKVALUES(res), 1, TY_CHAR)
+                    Memc[CQ_HKNAMES(res)] = EOS
+                    Memc[CQ_HKVALUES(res)] = EOS
+		} else {
+                    call realloc (CQ_HKNAMES(res), op1, TY_CHAR)
+                    call realloc (CQ_HKVALUES(res), op2, TY_CHAR)
+                    Memc[CQ_HKNAMES(res)+op1] = EOS
+                    Memc[CQ_HKVALUES(res)+op2] = EOS
+		}
+
+	    case DIC_NFIELDS:
+		call gargi (CQ_NFIELDS(res))
+		if (nscan() < 2)
+		    CQ_NFIELDS(res) = 0
+
+		# Allocate space for the field descriptors.
+		call calloc (CQ_FNAMES(res), SZ_LINE, TY_CHAR)
+	    	call calloc (CQ_FOFFSETS(res), CQ_NFIELDS(res), TY_INT)
+	    	call calloc (CQ_FSIZES(res), CQ_NFIELDS(res), TY_INT)
+	    	call calloc (CQ_FTYPES(res), CQ_NFIELDS(res), TY_INT)
+		call calloc (CQ_FUNITS(res), SZ_LINE, TY_CHAR)
+		call calloc (CQ_FFMTS(res), SZ_LINE, TY_CHAR)
+
+		ncount = 0
+		if (CQ_NFIELDS(res) > 0) {
+
+		    sz1 = SZ_LINE; op1 = 2
+		    sz2 = SZ_LINE; op2 = 2
+		    sz3 = SZ_LINE; op3 = 2
+	    	    call strcpy ("|", Memc[CQ_FNAMES(res)], sz1)
+	    	    call strcpy ("|", Memc[CQ_FUNITS(res)], sz2)
+	    	    call strcpy ("|", Memc[CQ_FFMTS(res)], sz3)
+
+	    	    do i = 1, CQ_NFIELDS(res) {
+
+			# Get the field description.
+			if (fscan (fd) == EOF)
+			    break
+			call gargwrd (Memc[fname], CQ_SZ_FNAME)
+			call gargi (foffset)
+			call gargi (fsize)
+			call gargc (ftype)
+			call gargwrd (Memc[funits], CQ_SZ_FUNITS)
+			call gargwrd (Memc[ffmt], CQ_SZ_FFMTS)
+			if (nscan() != 6)
+		    	    break
+
+			# Add the field name to the field name dictionary.
+                	if ((sz1 - op1 + 1) < (CQ_SZ_FNAME + 1)) {
+                    	    sz1 = sz1 + SZ_LINE
+                    	    call realloc (CQ_FNAMES(res), sz1, TY_CHAR)
+                        }
+                	op1 = op1 + gstrcpy (Memc[fname], Memc[CQ_FNAMES(res)+
+			    op1-1], sz1 - op1 + 1)
+                	op1 = op1 + gstrcpy ("|", Memc[CQ_FNAMES(res)+op1-1],
+                    	    sz1 - op1 + 1)
+
+			Memi[CQ_FOFFSETS(res)+i-1] = foffset
+			Memi[CQ_FTYPES(res)+i-1] = cq_dtype (ftype)
+			Memi[CQ_FSIZES(res)+i-1] = fsize
+
+			# Add the field units to the field units dictionary.
+                	if ((sz2 - op2 + 1) < (CQ_SZ_FUNITS + 1)) {
+                    	    sz2 = sz2 + SZ_LINE
+                    	    call realloc (CQ_FUNITS(res), sz2, TY_CHAR)
+                	}
+                	op2 = op2 + gstrcpy (Memc[funits],
+			    Memc[CQ_FUNITS(res)+ op2-1], sz2 - op2 + 1)
+                	op2 = op2 + gstrcpy ("|", Memc[CQ_FUNITS(res)+op2-1],
+                    	    sz2 - op2 + 1)
+
+			# Add the field format to the field formats dictionary.
+                	if ((sz3 - op3 + 1) < (CQ_SZ_FFMTS + 1)) {
+                    	    sz3 = sz3 + SZ_LINE
+                    	    call realloc (CQ_FFMTS(res), sz3, TY_CHAR)
+                	}
+                	op3 = op3 + gstrcpy (Memc[ffmt],
+			    Memc[CQ_FFMTS(res)+ op3 -1], sz3 - op3 + 1)
+                	op3 = op3 + gstrcpy ("|", Memc[CQ_FFMTS(res)+op3-1],
+                    	    sz3 - op3 + 1)
+
+			ncount = ncount + 1
+	    	    }
+		}
+	    	if (ncount != CQ_NFIELDS(res)) {
+		    CQ_NFIELDS(res) = 0
+		    call realloc (CQ_FNAMES(res), 1, TY_CHAR) 
+		    Memc[CQ_FNAMES(res]) = EOS
+		    call mfree (CQ_FOFFSETS(res), TY_INT)
+		    CQ_FOFFSETS(res) = NULL
+		    call mfree (CQ_FSIZES(res), TY_INT)
+		    CQ_FSIZES(res) = NULL
+		    call mfree (CQ_FTYPES(res), TY_INT)
+		    CQ_FTYPES(res) = NULL
+		    call realloc (CQ_FUNITS(res), 1, TY_CHAR) 
+		    Memc[CQ_FUNITS(res)] = EOS
+		    call realloc (CQ_FFMTS(res), 1, TY_CHAR) 
+		    Memc[CQ_FFMTS(res)] = EOS
+	    	} else {
+		    call realloc (CQ_FNAMES(res), op1, TY_CHAR) 
+		    call realloc (CQ_FUNITS(res), op2, TY_CHAR) 
+		    call realloc (CQ_FFMTS(res), op3, TY_CHAR) 
+		    Memc[CQ_FNAMES(res]+op1) = EOS
+		    Memc[CQ_FUNITS(res)+op2] = EOS
+		    Memc[CQ_FFMTS(res)+op3] = EOS
+		}
+	    default:
+		;
+	    }
+	}
+	call close (fd)
+	call sfree (sp)
+
+	# Allocate space for the field indices array.
+	call calloc (CQ_FINDICES(res), CQ_MAX_NFIELDS + 1, TY_INT)
+
+	# Initilize the records descriptor.
+	CQ_RFD(res) = NULL
+
+	return (res)
+end
+
+
+# CQ_RFREE -- Free the results structure.
+
+procedure cq_rfree (res)
+
+pointer	res			#U the results descriptor.
+
+begin
+	# Free the query parameter names, values, and units.
+	if (CQ_RQPNAMES(res) != NULL)
+	    call mfree (CQ_RQPNAMES(res), TY_CHAR)
+	if (CQ_RQPVALUES(res) != NULL)
+	    call mfree (CQ_RQPVALUES(res), TY_CHAR)
+	if (CQ_RQPUNITS(res) != NULL)
+	    call mfree (CQ_RQPUNITS(res), TY_CHAR)
+
+	# Free the header names and values.
+	if (CQ_HKNAMES(res) != NULL)
+	    call mfree (CQ_HKNAMES(res), TY_CHAR)
+	if (CQ_HKVALUES(res) != NULL)
+	    call mfree (CQ_HKVALUES(res), TY_CHAR)
+
+	# Free the field offsets, sizes, and types.
+	if (CQ_FNAMES(res) != NULL)
+	    call mfree (CQ_FNAMES(res), TY_CHAR)
+	if (CQ_FOFFSETS(res) != NULL)
+	    call mfree (CQ_FOFFSETS(res), TY_INT)
+	if (CQ_FSIZES(res) != NULL)
+	    call mfree (CQ_FSIZES(res), TY_INT)
+	if (CQ_FTYPES(res) != NULL)
+	    call mfree (CQ_FTYPES(res), TY_INT)
+	if (CQ_FUNITS(res) != NULL)
+	    call mfree (CQ_FUNITS(res), TY_CHAR)
+	if (CQ_FFMTS(res) != NULL)
+	    call mfree (CQ_FFMTS(res), TY_CHAR)
+
+	# Free the record description.
+	if (CQ_FINDICES(res) != NULL)
+	    call mfree (CQ_FINDICES(res), TY_INT)
+
+	# Free the record buffer.
+	if (CQ_RINDEX(res) != NULL)
+	    call mfree (CQ_RINDEX(res), TY_LONG)
+	if (CQ_RFD(res) != NULL)
+	    call close (CQ_RFD(res))
+
+	if (res != NULL)
+	    call mfree (res, TY_STRUCT)
+end
diff --git a/pkg/xtools/catquery/cqrinfo.x b/pkg/xtools/catquery/cqrinfo.x
new file mode 100644
index 00000000..f61dc949
--- /dev/null
+++ b/pkg/xtools/catquery/cqrinfo.x
@@ -0,0 +1,390 @@
+include "cqdef.h"
+include "cq.h"
+
+
+# CQ_HINFO -- Get the header keyword value by keyword name.
+
+int procedure cq_hinfo (res, hkname, hkvalue, sz_hkvalue)
+
+pointer	res			#I the results descriptor
+char	hkname[ARB]		#I the header keyword name
+char	hkvalue[ARB]		#O the header keyword value
+int	sz_hkvalue		#I the maximum size of the keyword value
+
+pointer	sp, kname
+int	kwno
+int	strdic(), cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NHEADER(res) <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (kname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	kwno = strdic (hkname, Memc[kname], CQ_SZ_FNAME, Memc[CQ_HKNAMES(res)])
+	if (kwno <= 0) {
+	    call sfree (sp)
+	    return (0)
+	}
+
+	# Retrieve the keyword value.
+	if (cq_wrdstr (kwno, hkvalue, sz_hkvalue, Memc[CQ_HKVALUES(res)]) <= 0)
+	    hkvalue[1] = EOS
+
+	call sfree (sp)
+
+	return (kwno)
+end
+
+
+# CQ_HINFON -- Get the header keyword name and value using the keyword number.
+
+int procedure cq_hinfon (res, kwno, hkname, sz_hkname, hkvalue, sz_hkvalue)
+
+pointer	res			#I the results descriptor
+int	kwno			#I the keyword number
+char	hkname[ARB]		#O the header keyword name
+int	sz_hkname		#I the maximum size of the keyword name
+char	hkvalue[ARB]		#O the header keyword value
+int	sz_hkvalue		#I the maximum size of the keyword value
+
+int	cq_wrdstr()
+
+begin
+	# Return if there are no keywords.
+	if (CQ_NHEADER(res) <= 0)
+	    return (0)
+
+	# Return if the keyword is out of bounds.
+	if (kwno < 1 || kwno > CQ_NHEADER(res))
+	    return (0)
+
+	# Retrieve the keyword value.
+	if (cq_wrdstr (kwno, hkname, sz_hkname, Memc[CQ_HKNAMES(res)]) <= 0)
+	    hkname[1] = EOS
+
+	# Retrieve the keyword value.
+	if (cq_wrdstr (kwno, hkvalue, sz_hkvalue, Memc[CQ_HKVALUES(res)]) <= 0)
+	    hkvalue[1] = EOS
+
+	return (kwno)
+end
+
+
+# CQ_FINFO -- Get the field description by field name.
+
+int procedure cq_finfo (res, field, foffset, fsize, ftype, units, sz_units,
+	fmts, sz_fmts)
+
+pointer	res			#I the results descriptor
+char	field[ARB]		#I the field name
+int	foffset			#O the output field offset 
+int	fsize			#O the output field size
+int	ftype			#O the output field datatype 
+char	units[ARB]		#O the outpit field units string
+int	sz_units		#I the maximum size of the units string
+char	fmts[ARB]		#O the outpit field formats string
+int	sz_fmts			#I the maximum size of the formats string
+
+pointer	sp, fname
+int	fieldno
+int	strdic(), cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NFIELDS(res) <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	fieldno = strdic (field, Memc[fname], CQ_SZ_FNAME, Memc[CQ_FNAMES(res)])
+	if (fieldno <= 0) {
+	    call sfree (sp)
+	    return (0)
+	}
+
+	# Get the field offset, size, and type.
+	foffset = Memi[CQ_FOFFSETS(res)+fieldno-1]
+	fsize = Memi[CQ_FSIZES(res)+fieldno-1]
+	ftype = Memi[CQ_FTYPES(res)+fieldno-1]
+
+	# Get the field units and format.
+	if (cq_wrdstr (fieldno, units, sz_units, Memc[CQ_FUNITS(res)]) <= 0)
+	    units[1] = EOS
+	if (cq_wrdstr (fieldno, fmts, sz_fmts, Memc[CQ_FFMTS(res)]) <= 0)
+	    fmts[1] = EOS
+
+	call sfree (sp)
+
+	return (fieldno)
+end
+
+
+# CQ_FNUMBER -- Get the field number given the field name.
+
+int procedure cq_fnumber (res, field)
+
+pointer	res			#I the results descriptor
+char	field[ARB]		#I the field name
+
+pointer	sp, fname
+int	fieldno
+int	strdic()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NFIELDS(res) <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	fieldno = strdic (field, Memc[fname], CQ_SZ_FNAME, Memc[CQ_FNAMES(res)])
+
+	call sfree (sp)
+	return (fieldno)
+end
+
+
+# CQ_FOFFSET -- Get the field offset given the field name.
+
+int procedure cq_foffset (res, field)
+
+pointer	res			#I the results descriptor
+char	field[ARB]		#I the field name
+
+pointer	sp, fname
+int	fieldno
+int	strdic()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NFIELDS(res) <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	fieldno = strdic (field, Memc[fname], CQ_SZ_FNAME, Memc[CQ_FNAMES(res)])
+
+	call sfree (sp)
+
+	if (fieldno <= 0)
+	    return (0)
+	else
+	    return (Memi[CQ_FOFFSETS(res)+fieldno-1])
+end
+
+
+# CQ_FSIZE -- Get the field offset given the field name.
+
+int procedure cq_fsize (res, field)
+
+pointer	res			#I the results descriptor
+char	field[ARB]		#I the field name
+
+pointer	sp, fname
+int	fieldno
+int	strdic()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NFIELDS(res) <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	fieldno = strdic (field, Memc[fname], CQ_SZ_FNAME, Memc[CQ_FNAMES(res)])
+
+	call sfree (sp)
+
+	if (fieldno <= 0)
+	    return (0)
+	else
+	    return (Memi[CQ_FSIZES(res)+fieldno-1])
+end
+
+
+# CQ_FTYPE -- Get the field type given the field name.
+
+int procedure cq_ftype (res, field)
+
+pointer	res			#I the results descriptor
+char	field[ARB]		#I the field name
+
+pointer	sp, fname
+int	fieldno
+int	strdic()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NFIELDS(res) <= 0)
+	    return (0)
+
+	call smark (sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	fieldno = strdic (field, Memc[fname], CQ_SZ_FNAME, Memc[CQ_FNAMES(res)])
+
+	call sfree (sp)
+
+	if (fieldno <= 0)
+	    return (0)
+	else
+	    return (Memi[CQ_FTYPES(res)+fieldno-1])
+end
+
+
+# CQ_FUNITS -- Get the field units given the field name.
+
+procedure cq_funits (res, field, units, sz_units)
+
+pointer	res			#I the results descriptor
+char	field[ARB]		#I the field name
+char	units[ARB]		#O the output units string
+int	sz_units		#I the maximum size of the units string
+
+pointer	sp, fname
+int	fieldno
+int	strdic(), cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NFIELDS(res) <= 0) {
+	    units[1] = EOS
+	    return
+	}
+
+	call smark (sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	fieldno = strdic (field, Memc[fname], CQ_SZ_FNAME, Memc[CQ_FNAMES(res)])
+
+	# Get the units string.
+	if (fieldno > 0) {
+	    if (cq_wrdstr (fieldno, units, sz_units, Memc[CQ_FUNITS(res)]) <= 0)
+	        units[1] = EOS
+	} else
+	    units[1] = EOS
+
+	call sfree (sp)
+end
+
+
+# CQ_FFMTS -- Get the field format given the field name.
+
+procedure cq_ffmts (res, field, format, sz_format)
+
+pointer	res			#I the results descriptor
+char	field[ARB]		#I the field name
+char	format[ARB]		#O the output format string
+int	sz_format		#I the maximum size of the format string
+
+pointer	sp, fname
+int	fieldno
+int	strdic(), cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NFIELDS(res) <= 0) {
+	    format[1] = EOS
+	    return
+	}
+
+	call smark (sp)
+	call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+
+	# Find the requested field.
+	fieldno = strdic (field, Memc[fname], CQ_SZ_FNAME, Memc[CQ_FNAMES(res)])
+
+	# Get the units string.
+	if (fieldno > 0) {
+	    if (cq_wrdstr (fieldno, format, sz_format,
+	        Memc[CQ_FFMTS(res)]) <= 0)
+	        format[1] = EOS
+	} else
+	    format[1] = EOS
+
+	call sfree (sp)
+end
+
+
+# CQ_FINFON -- Get the field description by field number.
+
+int procedure cq_finfon (res, fieldno, fname, sz_fname, foffset, fsize, ftype,
+	units, sz_units, fmts, sz_fmts)
+
+pointer	res			#I the results descriptor
+int	fieldno			#I the input field number
+char	fname[ARB]		#O the field name
+int	sz_fname		#I the maximum field name size
+int	foffset			#O the output field offset 
+int	fsize			#O the output field size
+int	ftype			#O the output field datatype 
+char	units[ARB]		#O the outpit field units string
+int	sz_units		#I the maximum size of the units string
+char	fmts[ARB]		#O the outpit field formats string
+int	sz_fmts			#I the maximum size of the formats string
+
+int	cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NFIELDS(res) <= 0)
+	    return (0)
+	if (fieldno <= 0 || fieldno > CQ_NFIELDS(res))
+	    return (0)
+
+	# Get the field name.
+	if (cq_wrdstr (fieldno, fname, sz_fname, Memc[CQ_FNAMES(res)]) <= 0)
+	    return (0)
+
+	# Set the field offset, size, and type.
+	foffset = Memi[CQ_FOFFSETS(res)+fieldno-1]
+	fsize = Memi[CQ_FSIZES(res)+fieldno-1]
+	ftype = Memi[CQ_FTYPES(res)+fieldno-1]
+
+	if (cq_wrdstr (fieldno, units, sz_units, Memc[CQ_FUNITS(res)]) <= 0)
+	    units[1] = EOS
+	if (cq_wrdstr (fieldno, fmts, sz_fmts, Memc[CQ_FFMTS(res)]) <= 0)
+	    fmts[1] = EOS
+
+	return (fieldno)
+end
+
+
+# CQ_FNAME -- Get the field name given the field number.
+
+int procedure cq_fname (res, fieldno, fname, sz_fname)
+
+pointer	res			#I the results descriptor
+int	fieldno			#I the input field number
+char	fname[ARB]		#O the field name
+int	sz_fname		#I the maximum field name size
+
+int	cq_wrdstr()
+
+begin
+	# Return if there are no fields. 
+	if (CQ_NFIELDS(res) <= 0)
+	    return (0)
+	if (fieldno <= 0 || fieldno > CQ_NFIELDS(res))
+	    return (0)
+
+	# Get the field name.
+	if (cq_wrdstr (fieldno, fname, sz_fname, Memc[CQ_FNAMES(res)]) <= 0)
+	    return (0)
+
+	return (fieldno)
+end
diff --git a/pkg/xtools/catquery/cqrstat.x b/pkg/xtools/catquery/cqrstat.x
new file mode 100644
index 00000000..60319e77
--- /dev/null
+++ b/pkg/xtools/catquery/cqrstat.x
@@ -0,0 +1,171 @@
+include "cqdef.h"
+include "cq.h"
+
+
+# CQ_RSTATI -- Get an integer results parameter.
+
+int procedure cq_rstati (res, param)
+
+pointer res                     #I pointer to the results descriptor
+int     param                   #I the integer parameter to be retrieved
+
+begin
+        switch (param) {
+        case CQRNQPARS:
+            return (CQ_RNQPARS(res))
+	case CQRTYPE:
+            return (CQ_RTYPE(res))
+        case CQRNRECS:
+            return (CQ_RNRECS(res))
+        case CQRECSIZE:
+            return (CQ_RECSIZE(res))
+        case CQRHSKIP:
+            return (CQ_RHSKIP(res))
+        case CQRTSKIP:
+            return (CQ_RTSKIP(res))
+        case CQRTRIML:
+            return (CQ_RTRIML(res))
+        case CQRTRIMR:
+            return (CQ_RTRIMR(res))
+	case CQNHEADER:
+            return (CQ_NHEADER(res))
+	case CQNFIELDS:
+            return (CQ_NFIELDS(res))
+	case CQRECPTR:
+            return (CQ_RECPTR(res))
+        default:
+            call error (0, "Error fetching integer results parameter")
+        }
+end
+
+
+# CQ_RSTATR -- Get a real results parameter.
+
+real procedure cq_rstatr (res, param)
+
+pointer res                     #I pointer to the results descriptor
+int     param                   #I the real parameter to be retrieved
+
+begin
+        switch (param) {
+        default:
+            call error (0, "Error fetching real results parameter")
+        }
+end
+
+
+# CQ_RSTATD -- Get a double precision results parameter.
+
+double procedure cq_rstatd (res, param)
+
+pointer res                     #I pointer to the results descriptor
+int     param                   #I the double parameter to be retrieved
+
+begin
+        switch (param) {
+        default:
+            call error (0, "Error fetching double results parameter")
+        }
+end
+
+
+# CQ_RSTATS -- Get a string results parameter.
+
+procedure cq_rstats (res, param, str, maxch)
+
+pointer res                     #I pointer to the results descriptor
+int     param                   #I the string parameter to be retrieved
+char    str[ARB]                #O the output string parameter
+int     maxch                   #I the maximum size of the string parameter
+
+begin
+        switch (param) {
+        case CQRCATDB:
+            call strcpy (CQ_RCATDB(res), str, maxch)
+        case CQRCATNAME:
+            call strcpy (CQ_RCATNAME(res), str, maxch)
+        case CQRADDRESS:
+            call strcpy (CQ_RADDRESS(res), str, maxch)
+        case CQRQUERY:
+            call strcpy (CQ_RQUERY(res), str, maxch)
+        case CQRQPNAMES:
+            call strcpy (Memc[CQ_RQPNAMES(res)], str, maxch)
+        case CQRQPVALUES:
+            call strcpy (Memc[CQ_RQPVALUES(res)], str, maxch)
+        case CQRQPUNITS:
+            call strcpy (Memc[CQ_RQPUNITS(res)], str, maxch)
+        default:
+            call error (0, "Error fetching string results parameter")
+        }
+end
+
+
+# CQ_RSTATT -- Get a text list results parameter. A text list is a
+# string with items separated from each other by newlines.
+
+int procedure cq_rstatt (res, param, str, maxch)
+
+pointer res                     #I pointer to the results descriptor
+int     param                   #I the list parameter to be retrieved
+char    str[ARB]                #O the output string parameter
+int     maxch                   #I the maximum size of the string parameter
+
+pointer	sp, tstr
+int     i, fd
+int     stropen(), cq_wrdstr()
+
+begin
+        switch (param) {
+
+        case CQRQPNAMES:
+	    call smark (sp)
+	    call salloc (tstr, CQ_SZ_QPNAME, TY_CHAR)
+            fd = stropen (str, maxch, NEW_FILE)
+	    str[1] = EOS
+            do i = 1, CQ_RNQPARS(res) {
+		if (cq_wrdstr (i, Memc[tstr], CQ_SZ_QPNAME,
+		    Memc[CQ_RQPNAMES(res)]) > 0) {
+                    call fprintf (fd, "%s\n")
+                        call pargstr (Memc[tstr])
+		}
+            }
+            call close (fd)
+	    call sfree (sp)
+            return (CQ_RNQPARS(res))
+
+        case CQRQPVALUES:
+	    call smark (sp)
+	    call salloc (tstr, CQ_SZ_QPVALUE, TY_CHAR)
+            fd = stropen (str, maxch, NEW_FILE)
+	    str[1] = EOS
+            do i = 1, CQ_RNQPARS(res) {
+		if (cq_wrdstr (i, Memc[tstr], CQ_SZ_QPVALUE,
+		    Memc[CQ_RQPVALUES(res)]) > 0) {
+                    call fprintf (fd, "%s\n")
+                        call pargstr (Memc[tstr])
+		}
+            }
+            call close (fd)
+	    call sfree (sp)
+            return (CQ_RNQPARS(res))
+
+        case CQRQPUNITS:
+	    call smark (sp)
+	    call salloc (tstr, CQ_SZ_QPUNITS, TY_CHAR)
+            fd = stropen (str, maxch, NEW_FILE)
+	    str[1] = EOS
+            do i = 1, CQ_RNQPARS(res) {
+		if (cq_wrdstr (i, Memc[tstr], CQ_SZ_QPUNITS,
+		    Memc[CQ_RQPUNITS(res)]) > 0) {
+                    call fprintf (fd, "%s\n")
+                        call pargstr (Memc[tstr])
+		}
+            }
+            call close (fd)
+	    call sfree (sp)
+            return (CQ_RNQPARS(res))
+
+        default:
+            call error (0, "Error fetching list results parameter")
+        }
+end
diff --git a/pkg/xtools/catquery/cqsetcat.x b/pkg/xtools/catquery/cqsetcat.x
new file mode 100644
index 00000000..f64ae4c3
--- /dev/null
+++ b/pkg/xtools/catquery/cqsetcat.x
@@ -0,0 +1,293 @@
+include "cqdef.h"
+include "cq.h"
+
+
+# CQ_SETCAT -- Set the current catalog by name.
+
+int procedure cq_setcat (cq, name)
+
+pointer	cq				#I the catalog descriptor
+char	name[ARB]			#I the catalog name
+
+int	i, catno
+int	cq_ccrquery()
+bool	streq()
+
+begin
+	catno = 0
+	do i = 1, CQ_NRECS(cq) {
+	    if (streq (name, CQ_NAME(cq, i)))
+		catno = i
+	}
+	if (catno == 0)
+	    return (0)
+
+	# Free the previous current catalog descriptor if any.
+	call cq_ccfree (cq)
+
+	# Allocate the new descriptor.
+	call cq_ccinit (cq, catno)
+
+	# Get the new catalog parameters.
+	if (cq_ccrquery (cq) == ERR) {
+	    call cq_ccfree (cq)
+	    return (0)
+	}
+
+	return (catno)
+end
+
+
+# CQ_SETCATN -- Set the current catalog by number.
+
+int procedure cq_setcatn (cq, catno)
+
+pointer	cq				#I the catalog descriptor
+int	catno				#I the catalog number
+
+int	cq_ccrquery()
+
+begin
+	if (catno < 1 || catno > CQ_NRECS(cq))
+	    return (0)
+
+	# Free the previous current catalog descriptor if any.
+	call cq_ccfree (cq)
+
+	# Allocate the new descriptor.
+	call cq_ccinit (cq, catno)
+
+	# Get the new catalog parameters.
+	if (cq_ccrquery (cq) == ERR) {
+	    call cq_ccfree (cq)
+	    return (0)
+	}
+
+	return (catno)
+end
+
+
+# CQ_CCINIT -- Initialize the current catalog descriptor.
+
+procedure cq_ccinit (cq, catno)
+
+pointer	cq			#I the catalog database descriptor
+int	catno			#I the current catalog number
+
+pointer	cc
+
+begin
+	if (catno < 1 || catno > CQ_NRECS(cq))
+	    return
+	CQ_CATNO(cq) = catno
+	call strcpy (CQ_NAME(cq, catno), CQ_CATNAME(cq), SZ_FNAME)
+
+	call calloc (CQ_CAT(cq), CQ_LEN_CC, TY_STRUCT)
+	cc = CQ_CAT(cq)
+
+	CQ_NQPARS(cc) = 0
+	CQ_HFMT(cc) = CQ_HNONE
+
+	call calloc (CQ_PQPNAMES(cc), SZ_LINE, TY_CHAR)
+	call calloc (CQ_PQPDVALUES(cc), SZ_LINE, TY_CHAR)
+	call calloc (CQ_PQPVALUES(cc), SZ_LINE, TY_CHAR)
+	call calloc (CQ_PQPUNITS(cc), SZ_LINE, TY_CHAR)
+	call calloc (CQ_PQPFMTS(cc), SZ_LINE, TY_CHAR)
+
+	Memc[CQ_PQPNAMES(cc)] = EOS
+	Memc[CQ_PQPDVALUES(cc)] = EOS
+	Memc[CQ_PQPVALUES(cc)] = EOS
+	Memc[CQ_PQPUNITS(cc)] = EOS
+	Memc[CQ_PQPFMTS(cc)] = EOS
+
+	CQ_ADDRESS(cc) = EOS
+	CQ_QUERY(cc) = EOS
+
+end
+
+
+# CQ_CCRQUERY -- Read in the query related parameters from the catalog
+# database. May need to encode the field names at some point.
+
+int procedure cq_ccrquery (cq)
+
+pointer	cq			#I the catalog database descriptor
+
+pointer	cc, sp, str
+int	i, catno, nqpars, npars, sz1, sz2, sz3, sz4, sz5
+int	op1, op2, op3, op4, op5
+int	cq_dgeti(), cq_dscan(), nscan(), gstrcpy(), strdic()
+errchk	cq_dgwrd(), cq_dgeti(), cq_dscan()
+
+begin
+	# If the current catalog is not defined then return.
+	if (CQ_CAT(cq) == NULL)
+	    return (ERR)
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    return (ERR)
+	cc = CQ_CAT(cq)
+	catno = CQ_CATNO(cq)
+
+	call smark (sp)
+	call salloc (str, 4 * (SZ_LINE + 1), TY_CHAR)
+
+	iferr {
+
+	    # Get the catalog address and query string.
+	    call cq_dgwrd (cq, catno, "address", CQ_ADDRESS(cc), SZ_LINE)
+	    call cq_dgstr (cq, catno, "query", CQ_QUERY(cc), SZ_LINE)
+
+	    # Get the protocol.
+	    call cq_dgwrd (cq, catno, "protocol", Memc[str], SZ_LINE)
+	    CQ_HFMT(cc) = strdic (Memc[str], Memc[str], SZ_LINE,
+	        CQ_HFMTSTR)
+	    if (CQ_HFMT(cc) <= 0)
+		CQ_HFMT(cc) = CQ_HNONE
+
+	    # Determine the number of query parameters and position the
+	    # file to the correct place.
+	    nqpars = cq_dgeti (cq, catno, "nquery")
+
+	} then {
+
+	    # Reinitialize and return.
+	    CQ_ADDRESS(cc) = EOS
+	    CQ_QUERY(cc) = EOS
+	    call sfree (sp)
+	    return (ERR)
+	}
+
+
+	# Open the query parameter string dictionaries.
+	sz1 = SZ_LINE; op1 = 2
+	sz2 = SZ_LINE; op2 = 2
+	sz3 = SZ_LINE; op3 = 2
+	sz4 = SZ_LINE; op4 = 2
+	sz5 = SZ_LINE; op5 = 2
+	call strcpy ("|", Memc[CQ_PQPNAMES(cc)], sz1)
+	call strcpy ("|", Memc[CQ_PQPDVALUES(cc)], sz2)
+	call strcpy ("|", Memc[CQ_PQPVALUES(cc)], sz3)
+	call strcpy ("|", Memc[CQ_PQPUNITS(cc)], sz4)
+	call strcpy ("|", Memc[CQ_PQPFMTS(cc)], sz5)
+
+	# Scan the query parameter list.
+	npars = 0
+	for (i = 1; i <= nqpars; i = i + 1) {
+	    if (cq_dscan (cq) == EOF)
+		break
+
+	    # Get the query parameter fields.
+	    call gargwrd (Memc[str], SZ_LINE)
+	    call gargwrd (Memc[str+SZ_LINE+1], SZ_LINE)
+	    call gargwrd (Memc[str+2*(SZ_LINE+1)], SZ_LINE)
+	    call gargwrd (Memc[str+3*(SZ_LINE+1)], SZ_LINE)
+	    if (nscan() != 4)
+		break
+
+	    # Get the query parameter name.
+	    if ((sz1 - op1 + 1)  <  (CQ_SZ_QPNAME + 1)) {
+		sz1 = sz1 + SZ_LINE
+		call realloc (CQ_PQPNAMES(cc), sz1, TY_CHAR)
+	    }
+	    op1 = op1 + gstrcpy (Memc[str], Memc[CQ_PQPNAMES(cc)+op1-1],
+	        sz1 - op1 + 1)
+	    op1 = op1 + gstrcpy ("|", Memc[CQ_PQPNAMES(cc)+op1-1],
+	        sz1 - op1 + 1)
+
+	    # Get the default query parameter value and initialize the
+	    # user query parameter string.
+	    if ((sz2 - op2 + 1)  <  (CQ_SZ_QPVALUE + 1)) {
+		sz2 = sz2 + SZ_LINE
+		sz3 = sz3 + SZ_LINE
+		call realloc (CQ_PQPDVALUES(cc), sz2, TY_CHAR)
+		call realloc (CQ_PQPVALUES(cc), sz3, TY_CHAR)
+	    }
+	    op2 = op2 + gstrcpy (Memc[str+SZ_LINE+1],
+	        Memc[CQ_PQPDVALUES(cc)+op2-1], sz2 - op2 + 1)
+	    op2 = op2 + gstrcpy ("|", Memc[CQ_PQPDVALUES(cc)+op2-1],
+	        sz2 - op2 + 1)
+	    op3 = op3 + gstrcpy (Memc[str+SZ_LINE+1],
+	        Memc[CQ_PQPVALUES(cc)+op3-1], sz3 - op3 + 1)
+	    op3 = op3 + gstrcpy ("|", Memc[CQ_PQPVALUES(cc)+op3-1],
+	        sz3 - op3 + 1)
+
+	    # Get the query parameter units.
+	    if ((sz4 - op4 + 1)  <  (CQ_SZ_QPUNITS + 1)) {
+		sz4 = sz4 + SZ_LINE
+		call realloc (CQ_PQPUNITS(cc), sz4, TY_CHAR)
+	    }
+	    op4 = op4 + gstrcpy (Memc[str+2*(SZ_LINE+1)],
+	        Memc[CQ_PQPUNITS(cc)+op4-1], sz4 - op4 + 1)
+	    op4 = op4 + gstrcpy ("|", Memc[CQ_PQPUNITS(cc)+op4-1],
+	        sz4 - op4 + 1)
+
+	    # Get the query parameter formats.
+	    if ((sz5 - op5 + 1)  <  (CQ_SZ_QPFMTS + 1)) {
+		sz5 = sz5 + SZ_LINE
+		call realloc (CQ_PQPFMTS(cc), sz5, TY_CHAR)
+	    }
+	    op5 = op5 + gstrcpy (Memc[str+3*(SZ_LINE+1)],
+	        Memc[CQ_PQPFMTS(cc)+op5-1], sz5 - op5 + 1)
+	    op5 = op5 + gstrcpy ("|", Memc[CQ_PQPFMTS(cc)+op5-1],
+	        sz5 - op5 + 1)
+
+	    npars = npars + 1
+	}
+
+	# Return the appropriate status.
+	call sfree (sp)
+	if (npars != nqpars) {
+	    CQ_NQPARS(cc) = 0
+	    call realloc (CQ_PQPNAMES(cc), SZ_LINE, TY_CHAR)
+	    call realloc (CQ_PQPDVALUES(cc), SZ_LINE, TY_CHAR)
+	    call realloc (CQ_PQPVALUES(cc), SZ_LINE, TY_CHAR)
+	    call realloc (CQ_PQPUNITS(cc), SZ_LINE, TY_CHAR)
+	    call realloc (CQ_PQPFMTS(cc), SZ_LINE, TY_CHAR)
+	    Memc[CQ_PQPNAMES(cc)] = EOS
+	    Memc[CQ_PQPDVALUES(cc)] = EOS
+	    Memc[CQ_PQPVALUES(cc)] = EOS
+	    Memc[CQ_PQPUNITS(cc)] = EOS
+	    Memc[CQ_PQPFMTS(cc)] = EOS
+	    CQ_ADDRESS(cc) = EOS
+	    CQ_QUERY(cc) = EOS
+	    return (ERR)
+	} else {
+	    CQ_NQPARS(cc) = npars
+	    call realloc (CQ_PQPNAMES(cc), op1, TY_CHAR)
+	    call realloc (CQ_PQPDVALUES(cc), op2, TY_CHAR)
+	    call realloc (CQ_PQPVALUES(cc), op3, TY_CHAR)
+	    call realloc (CQ_PQPUNITS(cc), op4, TY_CHAR)
+	    call realloc (CQ_PQPFMTS(cc), op5, TY_CHAR)
+	    Memc[CQ_PQPNAMES(cc)+op1] = EOS
+	    Memc[CQ_PQPDVALUES(cc)+op2] = EOS
+	    Memc[CQ_PQPVALUES(cc)+op3] = EOS
+	    Memc[CQ_PQPUNITS(cc)+op4] = EOS
+	    Memc[CQ_PQPFMTS(cc)+op5] = EOS
+	    return (OK)
+	}
+end
+
+
+# CQ_CCFREE - Free the current catalog descriptor
+
+procedure cq_ccfree (cq)
+
+pointer	cq			#I the catalog database descriptor
+
+pointer	cc
+
+begin
+	CQ_CATNAME(cq) = EOS
+	CQ_CATNO(cq) = 0
+
+	if (CQ_CAT(cq) != NULL) {
+	    cc  = CQ_CAT(cq)
+	    call mfree (CQ_PQPNAMES(cc), TY_CHAR)
+	    call mfree (CQ_PQPDVALUES(cc), TY_CHAR)
+	    call mfree (CQ_PQPVALUES(cc), TY_CHAR)
+	    call mfree (CQ_PQPUNITS(cc), TY_CHAR)
+	    call mfree (CQ_PQPFMTS(cc), TY_CHAR)
+	    call mfree (CQ_CAT(cq), TY_STRUCT)
+	}
+	CQ_CAT(cq) = NULL
+end
diff --git a/pkg/xtools/catquery/cqsqpars.x b/pkg/xtools/catquery/cqsqpars.x
new file mode 100644
index 00000000..e2ab9c3c
--- /dev/null
+++ b/pkg/xtools/catquery/cqsqpars.x
@@ -0,0 +1,135 @@
+include "cqdef.h"
+include "cq.h"
+
+
+# CQ_SQPAR -- Set the value of a query parameter by name.
+
+int procedure cq_sqpar (cq, name, valuestr)
+
+pointer	cq				#I the catalog descriptor
+char	name[ARB]			#I the input query parameter name
+char	valuestr[ARB]			#I the parameter value string
+
+pointer	cc, sp, pname, tmpdic, pvalue
+int	i, parno, sz1, op1
+int	strdic(), strlen(), cq_wrdstr(), gstrcpy()
+
+begin
+	# Check that the current catalog is defined.
+	if (CQ_CAT(cq) == NULL)
+	    return (0)
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    return (0)
+	cc = CQ_CAT(cq)
+
+
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (pname, CQ_SZ_QPNAME, TY_CHAR)
+	call salloc (pvalue, CQ_SZ_QPVALUE, TY_CHAR)
+
+	# Locate the parameter.
+	parno = strdic (name, Memc[pname], CQ_SZ_QPNAME, Memc[CQ_PQPNAMES(cc)])
+	if (parno <= 0) {
+	    call sfree (sp)
+	    return (0)
+	}
+
+	# Initalize the temporary string.
+	sz1 = strlen (Memc[CQ_PQPVALUES(cc)]) + CQ_SZ_QPVALUE
+	call malloc (tmpdic, sz1, TY_CHAR)
+	call strcpy ("|", Memc[tmpdic], sz1)
+	op1 = 2
+
+
+	# Reformat the values string.
+	do i = 1, CQ_NQPARS(cc) {
+	    if ((sz1 - op1 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		sz1 = sz1 + SZ_LINE
+		call realloc (tmpdic, sz1, TY_CHAR)
+	    }
+	    if (i == parno) {
+		op1 = op1 + gstrcpy (valuestr, Memc[tmpdic+op1-1],
+		    sz1 - op1 + 1) 
+		op1 = op1 + gstrcpy ("|", Memc[tmpdic+op1-1], sz1 - op1 + 1) 
+	    } else if (cq_wrdstr (i, Memc[pvalue], CQ_SZ_QPNAME,
+	        Memc[CQ_PQPVALUES(cc)]) > 0) {
+		op1 = op1 + gstrcpy (Memc[pvalue], Memc[tmpdic+op1-1],
+		    sz1 - op1 + 1) 
+		op1 = op1 + gstrcpy ("|", Memc[tmpdic+op1-1], sz1 - op1 + 1) 
+	    }
+	}
+
+	# Update the values string. Leave as temp length for now.
+	call realloc (CQ_PQPVALUES(cc), op1 - 1, TY_CHAR)
+	call strcpy (Memc[tmpdic], Memc[CQ_PQPVALUES(cc)], op1 - 1)
+
+	call mfree (tmpdic, TY_CHAR)
+	call sfree (sp)
+
+	return (parno)
+end
+
+
+# CQ_SQPARN -- Set the value of a query parameter by number.
+
+int procedure cq_sqparn (cq, parno, valuestr)
+
+pointer	cq				#I the catalog descriptor
+int	parno				#I the query parameter number
+char	valuestr[ARB]			#I the parameter value string
+
+pointer	cc, sp, pname, tmpdic, pvalue
+int	i, sz1, op1
+int	strlen(), cq_wrdstr(), gstrcpy()
+
+begin
+	# Check that the current catalog is defined.
+	if (CQ_CAT(cq) == NULL)
+	    return (0)
+	if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+	    return (0)
+	cc = CQ_CAT(cq)
+
+	if (parno < 1 || parno > CQ_NQPARS(cc))
+	    return (0)
+
+	# Get some working space.
+	call smark (sp)
+	call salloc (pname, CQ_SZ_QPNAME, TY_CHAR)
+	call salloc (pvalue, CQ_SZ_QPVALUE, TY_CHAR)
+
+	# Initialize the new dictionary.
+	sz1 = strlen (Memc[CQ_PQPVALUES(cc)]) + CQ_SZ_QPVALUE
+	call calloc (tmpdic, sz1, TY_CHAR)
+	call strcpy ("|", Memc[tmpdic], sz1)
+	op1 = 2
+
+	# Reformat the values string.
+	do i = 1, CQ_NQPARS(cc) {
+	    if ((sz1 - op1 + 1) < (CQ_SZ_QPVALUE + 1)) {
+		sz1 = sz1 + SZ_LINE
+		call realloc (tmpdic, sz1, TY_CHAR)
+	    }
+	    if (i == parno) {
+		op1 = op1 + gstrcpy (valuestr, Memc[tmpdic+op1-1],
+		    sz1 - op1 + 1) 
+		op1 = op1 + gstrcpy ("|", Memc[tmpdic+op1-1], sz1 - op1 + 1) 
+	    } else if (cq_wrdstr (i, Memc[pvalue], CQ_SZ_QPNAME,
+	        Memc[CQ_PQPVALUES(cc)]) > 0) {
+		op1 = op1 + gstrcpy (Memc[pvalue], Memc[tmpdic+op1-1],
+		    sz1 - op1 + 1) 
+		op1 = op1 + gstrcpy ("|", Memc[tmpdic+op1-1], sz1 - op1 + 1) 
+	    }
+	}
+
+	# Update the values string.
+	call realloc (CQ_PQPVALUES(cc), op1, TY_CHAR)
+	call strcpy (Memc[tmpdic], Memc[CQ_PQPVALUES(cc)], op1 - 1)
+
+	# Free memory.
+	call mfree (tmpdic, TY_CHAR)
+	call sfree (sp)
+
+	return (parno)
+end
diff --git a/pkg/xtools/catquery/cqstat.x b/pkg/xtools/catquery/cqstat.x
new file mode 100644
index 00000000..152022a9
--- /dev/null
+++ b/pkg/xtools/catquery/cqstat.x
@@ -0,0 +1,74 @@
+include	"cqdef.h"
+include	"cq.h"
+
+
+# CQ_STATI -- Get an integer catalog database parameter.
+
+int procedure cq_stati (cq, param)
+
+pointer	cq			#I pointer to the catalog query structure.
+int	param			#I the integer parameter to be retrieved
+
+begin
+	switch (param) {
+	case CQNRECS:
+	    return (CQ_NRECS(cq))
+	case CQSZRECLIST:
+	    return (CQ_NAMEI(cq, CQ_NRECS(cq) + 1))
+	case CQCATNO:
+	    return (CQ_CATNO(cq))
+	default:
+	    call error (0, "Error fetching integer catalog database parameter")
+	}
+end
+
+
+
+# CQ_STATS -- Get a string catalog database parameter.
+
+procedure cq_stats (cq, param, str, maxch)
+
+pointer	cq			#I pointer to the catalog query structure.
+int	param			#I the string parameter to be retrieved
+char	str[ARB]		#O the output string parameter
+int	maxch			#I the maximum size of the string parameter
+
+begin
+	switch (param) {
+	case CQCATDB:
+	    call strcpy (CQ_CATDB(cq), str, maxch)
+	case CQCATNAME:
+	    call strcpy (CQ_CATNAME(cq), str, maxch)
+	default:
+	    call error (0, "Error fetching string catalog database parameter")
+	}
+end
+
+
+# CQ_STATT -- Get a text list catalog database parameter. A text list is a
+# string with items separated from each other by newlines.
+
+int procedure cq_statt (cq, param, str, maxch)
+
+pointer	cq			#I pointer to the catalog query structure.
+int	param			#I the list parameter to be retrieved
+char	str[ARB]		#O the output string parameter
+int	maxch			#I the maximum size of the string parameter
+
+int	i, fd
+int	stropen()
+
+begin
+	switch (param) {
+	case CQRECLIST:
+	    fd = stropen (str, maxch, NEW_FILE)
+	    do i = 1, CQ_NRECS(cq) {
+		call fprintf (fd, "%s\n")
+		    call pargstr (CQ_NAME(cq, i))
+	    }
+	    call strclose (fd)
+	    return (CQ_NRECS(cq))
+	default:
+	    call error (0, "Error fetching list catalog database parameter")
+	}
+end
diff --git a/pkg/xtools/catquery/cqwrdstr.x b/pkg/xtools/catquery/cqwrdstr.x
new file mode 100644
index 00000000..bfdf1088
--- /dev/null
+++ b/pkg/xtools/catquery/cqwrdstr.x
@@ -0,0 +1,56 @@
+
+# CQ_WRDSTR -- Search a dictionary string for a given string index number.
+# This is the opposite function of strdic(), that returns the index for
+# given string.  The entries in the dictionary string are separated by
+# a delimiter character which is the first character of the dictionary
+# string.  The index of the string found is returned as the function value.
+# Otherwise, if there is no string for that index, a zero is returned.
+
+int procedure cq_wrdstr (index, outstr, maxch, dict)
+
+int	index			# String index
+char	outstr[ARB]		# Output string as found in dictionary
+int	maxch			# Maximum length of output string
+char	dict[ARB]		# Dictionary string
+
+int	i, len, start, count
+
+int	strlen()
+
+begin
+	# Clear output string
+	outstr[1] = EOS
+
+	# Return if the dictionary is not long enough
+	if (dict[1] == EOS)
+	    return (0)
+
+	# Return if the index is less than or equal to zero.
+	if (index <= 0)
+	    return (0)
+
+	# Initialize counters
+	count = 1
+	len   = strlen (dict)
+
+	# Search the dictionary string. This loop only terminates
+	# successfully if the index is found. Otherwise the procedure
+	# returns with and error condition.
+	for (start = 2; count < index; start = start + 1) {
+	    if (dict[start] == dict[1])
+		count = count + 1
+	    if (start == len)
+		return (0)
+	}
+
+	# Extract the output string from the dictionary
+	for (i = start; dict[i] != EOS && dict[i] != dict[1]; i = i + 1) {
+	    if (i - start + 1 > maxch)
+		break
+	    outstr[i - start + 1] = dict[i]
+	}
+	outstr[i - start + 1] = EOS
+
+	# Return index for output string
+	return (count)
+end
diff --git a/pkg/xtools/catquery/doc/README b/pkg/xtools/catquery/doc/README
new file mode 100644
index 00000000..f17920ab
--- /dev/null
+++ b/pkg/xtools/catquery/doc/README
@@ -0,0 +1,322 @@
+		CATQUERY: The Catalog and Survey Access Routines
+
+1. Introduction
+
+    The catquery package provides a set of routines for local and remote
+catalog and image survey server access. The supported catalogs and image
+surveys are described in records stored in a catalog and image survey
+configuration file respectively. The catalog and image survey records
+specify the network address, the query format, and the output format for
+each supported catalog or image display server. More detailed information
+about catalogs and image survey access and configuration files can be
+found by typing "help catalogs" and "help surveys".
+
+    The results of each catalog query are stored in memory in an IRAF spool
+file.  Calling programs can access the catalog results sequentially or randomly
+by record number. Individual fields in each record can be decoded into
+floating point, integer, or string values.
+
+The results of each image survey query are written to an image file on disk,
+currently a fits image file. IRAF image i/o routines can be used to access
+the image. There must be enough space availale on the disk to receive the
+image.
+
+
+2. The Interface Routines
+
+The package prefix is cq. The interface routines are listed below.
+
+           cq = cq_map (file, mode)
+	 ival = cq_stati (cq, param)
+	        cq_stats (cq, param, str, maxch)
+       nlines = cq_statt (cq, param, text, maxch)
+
+	catno = cq_locate (cq, name)
+	catno = cq_locaten (cq, catno, catname, maxch)
+	catno = cq_setcat (cq, name)
+	catno = cq_setcatn (cq, catno)
+
+     [ird]val = cq_fget[ird] (cq, name)
+       nelems = cq_fga[ird] (cq, name, array[ird], max_nelems)
+                cq_fgstr (cq, name, str, maxch)
+                cq_fgwrd (cq, name, wrd, maxch)
+       nlines = cq_fgtext (cq, name, text, maxch)
+         stat = cq_scan (cq)
+
+	nqpars = cq_nqpars (cq)
+	qparno = cq_gqpar (cq, name, qpname, max_qpname, qpvalue,
+	         max_qpvalue, qpunits, max_qpunits, qpformat,
+		 max_qpformat)
+	qparno = cq_gqparn (cq, qparno, qpname, max_qpname, qpvalue,
+ 	         max_qpvalue, qpunits, max_qpunits, qpformat, max_qpformat)
+	qparno = cq_sqpar (cq, name, valuestr)
+	qparno = cq_sqparn (cq, qparno, valuestr)
+
+	   res = cq_query (cq)
+	   res = cq_fquery (cq, catfile, cathdr)
+	  ival = cq_rstati (res, param)
+	         cq_rstats (res, param, str, maxch)
+	nlines = cq_rstatt (res, param, text, maxch)
+	hparno = cq_hinfo (res, name, hpvalue, max_hpvalue)
+	hparno = cq_hinfon (res, hparno, hpname, max_hpname, hpvalue,
+	         max_hpvalue)
+	nchars = cq_grecord (res, buffer, maxch, recno)
+        nchars = cq_gnrecord (res, buffer, maxch, nextrec)
+       fieldno = cq_finfo (res, name, foffset, fsize, ftype, funits,
+		 max_funits, formats, max_formats)
+       fieldno = cq_finfon (res, fieldno, fname, max_fname, foffset, fsize,
+	         ftype, funits, max_funits, formats, max_formats)
+	         cq_rclose (res)
+       nchars = cq_gval[silrd] (res, name, [silrd]val)
+       nchars = cq_gvalc (res, name, str, maxch)
+
+	 imres = cq_imquery (cq, imname)
+	 imres = cq_fimquery (cq, imname)
+	  ival = cq_istati (imres, param)
+	         cq_istats (imres, param, str, maxch)
+	nlines = cq_istatt (imres, param, text, maxch)
+	wparno = cq_winfo (imres, name, wkname, max_wkname, wvalue,
+	         max_wvalue, wtype, wunits, max_wunits)
+	wparno = cq_winfon (imres, wparno, wpname, max_wpnane, wkname,
+	         max_wkname, wvalue, max_wvalue, wtype, wunits, max_wunits)
+	kparno = cq_kinfo (imres, name, skname, max_skname, svalue,
+	         max_svalue, stype, sunits, max_sunits)
+	kparno = cq_kinfon (imres, kparno, spname, max_spname, skname,
+	         max_skname, svalue, max_svalue, stype, sunits, max_sunits)
+	         cq_imclose (imres)
+
+        cq_unmap (cq)
+
+
+3. Notes
+
+    An "include <pkg/cq.h>" statement must appear in the calling program to
+make the catquery pacakge parameter definitions visible to the calling program. 
+
+    A "-lxtools" must be included in the calling program link line to link in
+the catquery routines.
+
+    The catalog and image surveys configuration files are mapped and unmapped
+with the routines cq_map and cq_unmap.
+
+    Before making a query the calling program must set the current catalog
+or image survey with the cq_setcat or cq_setcatn routines, and format
+and set the query parameters with the cq_gqpar, cq_gqparn, and cq_sqparn
+routines. 
+
+    Remote and locate catalog queries are made with the cq_query routine.
+The routines cq_rstat[ist] are used to retrieve the catalog results parameters.
+Header parameter values and field descriptions can be retrieved with
+the cq_hinfo / cq_hinfon and cq_finfo / cq_finfon routines respectively.
+Catalog records can be accessed sequentially or randomly with the cq_gnrecord
+and cq_grecord routines. The cq_gval[csilrd] routines can be used to decode
+the record fields into floating point, integer, or string values.  The
+cq_fquery routine is used to make a catalog file emulate the results of a
+catalog query. Cq_rclose frees the catalog results descriptor.
+
+    Remote and locate image survey queries are made with the cq_imquery routine.
+The routines cq_istat[ist] are used to retrieve the survey results parameters.
+The standard wcs and image parameter descriptions can be retrieved with the
+the cq_winfo / cq_winfon and cq_kinfo / cq_kinfon routines respectively. The
+cq_fimquery routine is used to make an existing image emulate the results of
+an image survey query. Cq_imclose frees the survey results descriptor.
+
+4. Examples
+
+Example 1: Query a catalog and dump the results to a catalog file.
+
+    include <cq.h>
+
+    ....
+
+    ra = clgetd ("ra")
+    dec = clgetd ("dec")
+    width = clgetd ("width")
+
+    ....
+
+    # Open the catalog configuration file.
+    cq = cq_map ("astromz$lib/catdb.dat", READ_ONLY)
+    if (cq == NULL)
+	...
+
+    # Set the catalog.
+    catno = cq_setcat (cq, "noao@usno2")
+    if (catno == 0)
+	...
+
+    # Set the query parameters. Assume the input input units match the
+    # the expected units. The input size is a width so divide by two 
+    # if the query expects a radius.
+    nqpars = cq_nqpars (cq)
+    do i = 1, nqpars {
+	parno = cq_gqparn (cq, i, qpname, CQ_SZ_QPNAME, qpvalue,
+    	    CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats
+	    CQ_SZ_QPFORMATS)
+	if (parno != i)
+	    next
+	if (streq (qpname, "ra")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (ra)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "dec")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (dec)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "radius")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width / 2.0d0)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "width")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "xwidth")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "ywidth")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	}
+    }
+
+    # Make the query.
+    res = cq_query (cq)
+    if (res == NULL)
+	...
+
+    # Write the results to a file.
+    recptr = 0
+    while (cq_gnrecord (res, buffer, SZ_LINE, rectpr) != EOF) {
+	call fprintf (outfd, "%s")
+	    call pargstr (buffer)
+    }
+
+    # Close the query.
+    call cq_rclose (res)
+
+    # Close the database.
+    call cq_unmap (cq)
+
+
+Example 2: Repeat the previous example but only output records for
+	   which magnitude values  <= 16.0.
+
+     include <cq.h>
+
+     ...
+
+     res = cq_query (cq)
+     if (res == NULL)
+	...
+
+     nrec = cq_rstati (res, CQNRECS)
+     do i = 1, nrecs {
+	nchars = cq_gvalr (res, i, "mag1", mag)
+	if (nchars <= 0)
+	    next
+	if (mag > 16.0)
+	    next
+	nchars = cq_grecord (res, buffer, SZ_LINE, i)
+	if (nchars <= 0)
+	    next
+	call fprintf (outfd, "%s")
+	    call pargstr (buffer)
+     }
+
+     call cq_rclose (res)
+
+     ...
+
+
+Example 3: Make an image survey query and dump the results to a fits file.
+
+    include <cq.h>
+
+    ....
+
+    ra = clgetd ("ra")
+    dec = clgetd ("dec")
+    width = clgetd ("width")
+
+    ....
+
+    # Open the catalog configuration file.
+    cq = cq_map ("astromz$lib/imdb.dat", READ_ONLY)
+    if (cq == NULL)
+	...
+
+    # Set the catalog.
+    catno = cq_setcat (cq, "dss1@cadc")
+    if (catno == 0)
+	...
+
+    # Set the query parameters. Assume the input input units match the
+    # the expected units. 
+    nqpars = cq_nqpars (cq)
+    do i = 1, nqpars {
+	parno = cq_gqparn (cq, i, qpname, CQ_SZ_QPNAME, qpvalue, CQ_SZ_QPVALUE,
+	    qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFORMATS)
+	if (parno != i)
+	    next
+	if (streq (qpname, "ra")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (ra)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "dec")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (dec)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "width")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "xwidth")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "ywidth")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	}
+    }
+
+    # Make the query.
+    imres = cq_imquery (cq, "outimage.fits")
+    if (imres == NULL)
+	...
+
+    # Free the results structure
+    call cq_imclose (imres)
+
+    # Unmap the database
+    call cq_unmap (cq)
+
+
+
+Example 4:  Repeat the previous example but convert the dss wcs to a fits wcs.
+At_mkdss is a routine which converts a dss wcs to a fits wcs
+
+    ...
+
+    # Make the query.
+    imres = cq_imquery (cq, "outimage.fits")
+    if (imres == NULL)
+        ...
+
+    wcstype = cq_istati (imres, CQWCS)
+    if (wcstype == CQWDSS) {
+        im = immap ("outimage.fits", READ_WRITE, 0)
+        stat = at_mkdss (im, true, false)
+        if (stat == ERR)
+            ...
+        call imunmap (im)
+    }
+
+    # Free the results structure
+    call cq_imclose (imres)
+
+    ...
diff --git a/pkg/xtools/catquery/doc/catalogs.hlp b/pkg/xtools/catquery/doc/catalogs.hlp
new file mode 100644
index 00000000..4109f810
--- /dev/null
+++ b/pkg/xtools/catquery/doc/catalogs.hlp
@@ -0,0 +1,233 @@
+.help catalogs Mar00 astromz
+.ih
+NAME
+catalogs -- describe the catalog configuration file
+.ih
+USAGE
+help catalogs
+.ih
+CATALOGS
+
+A catalog is a large set of tabular data records from which smaller 
+tabular data sets can be extracted by issuing a catalog server query. Catalogs
+may be installed locally or accessed remotely. Installing a catalog involves
+creating a record in the catalog configuration file which specifies the
+catalog network address, the catalog query format, and the catalog query
+output format. In the following sections the configuration file is
+described in the context of accessing astrometric catalogs.
+
+.ih
+THE CATALOG CONFIGURATION FILE
+
+A record in the catalog configuration file specifies the network address,
+the query format, and the output format of each supported catalog server.
+Catalog server records names have the form "catalog@site",
+e.g. "usno2@noao". Adding support for a new catalog server or responding
+to changes in the behavior of an already supported server requires either adding
+a new record to the configuration file or changing an existing record in
+the configuration file. It does not require changing the catalog
+access code.
+
+The catalog server network address tells the catalog access code where
+and how to connect to the network. Each network address has the syntax
+"domain:port:address:flags" e.g. "inet:80:www.noao.edu:text".
+
+The query format specifies the form of the query server string, and the
+names, default values, units, and format of the query parameters. A set of
+query parameter names are reserved for accessing astrometric catalogs
+including "ra", "dec", "radius", "hwidth", "width", "rawidth", "decwidth",
+rahwidth, and dechwidth. The names of these parameters are not part of the
+catalog access API. Other types of catalogs may have different reserved
+query parameter names. The user replaces the default query values with user
+query parameter values before making the query.
+
+The server query output format specifies the form of the expected server output:
+including the data stream type, the record size, and the name, location,
+size, data type, units and format of each field in the record. A set of
+standard field names is reserved for accessing the output of astrometric
+catalog servers including "id", "ra", "dec", and "mag[1-n]". These standard
+field names are not part of the catalog access API. Other catalog
+types may have a different set of standard field names in the future.
+
+.ih
+SAMPLE CATALOG RECORD
+
+The following two examples illustrate typical catalog configuration file
+records. Note that both records can be used to access the same catalog
+data. The first example accesses the catalog as simple text, the latter
+as blocked text.
+
+.nf
+Example 1: Accessing the catalog as simple text.
+
+begin susno2@noao
+address inet:80:www.noao.edu:text
+query GET /cgi-bin/usno/usnoextract?search=yes&ra=%-s&dec=%-s&width=%-s HTTP/1.0
+\n\n
+nquery 4
+    ra 00:00:00.00 hours %0.2h
+    dec 00:00:00.0 degrees %0.1h
+    radius 5.0 minutes %0.1f
+    qsystem J2000.0 INDEF %s
+type stext
+    hskip 10
+    tskip  6
+    recsize 0
+    triml 0
+    trimr 4
+nheader 1
+    csystem J2000.0
+nfields 4
+    ra 1 0 d hours %12.3h
+    dec 2 0 d degrees %12.2h
+    mag1 3 0 r INDEF %4.1f
+    mag2 4 0 r INDEF %4.1f
+.fi
+
+.nf
+Example 2: Accessing the catalog as blocked text.
+
+begin busno2@noao
+address inet:80:www.noao.edu:text
+query GET /cgi-bin/usno/usnoextract?search=yes&ra=%-s&dec=%-s&width=%-s HTTP/1.0
+\n\n
+nquery   4
+    ra 00:00:00.00 hours %0.2h
+    dec 00:00:00.0 degrees %0.1h
+    radius 5.0 minutes %0.1f
+    qsystem J2000.0 INDEF %s
+type btext
+    hskip 10
+    tskip 6
+    recsize 44
+    triml 0
+    trimr 4
+nheader 1
+    csystem J2000.0
+nfields 4
+    ra  1 13 d hours %12.3h
+    dec 14 14 d degrees %12.2h
+    mag1 28  6 r INDEF %4.1f
+    mag2 34  6 r INDEF %4.1f
+.fi
+
+The beginning of a new catalog record is indicated by a line of the form
+\fI"begin catname"\fR where catname is a unique name of the form
+\fI"catalog@site"\fR. If there is more than one record with the same
+name, the last record is the one that is read. The same catalog server
+may be accessed in more than one way by creating multiple records.
+For example if the catalog server supports an optional magnitude selection
+feature, then in one record this feature can be enabled and in another it
+can be disabled. 
+
+The \fIaddress\fR, \fIquery\fR and \fInquery\fR keywords are required and
+define the network address, query command, format and query parameters for
+the catalog.
+
+The \fIaddress\fR keyword  "domain", "port", and "flags" fields are almost
+always "inet", "80", and "text" respectively, so in most cases the only
+address keyword field that has to be filled in is the address
+field "www.noao.edu" in this case.
+
+The \fIquery\fR keyword defines the query command whose form is server
+dependent. The query parameter values are encoded via the %-s formatting
+strings. The calling program must encode the user query parameter values
+into a set a strings which then replace the -%s format statement in the
+query string.
+
+The number of query parameters is defined by the \fInquery\fR keyword. The
+number of query parameters must be greater than or equal to the number of "-%s"
+strings in the query keyword value. The name,  default value, units,
+and format of each query parameter are listed below the nquery keyword,
+one query parameter description per line. The query parameters should
+be defined in the catalog configuration file in the same order that they
+appear in the query keyword value. Alert readers will notice that in
+the examples above the number of query parameters is 4 but there are only
+3 "%-s" strings in the query keyword value. In these examples the qsystem
+query parameter, which defines the coordinate system of the ra and dec query
+parameter values is fixed at J2000. For some servers this parameter may
+be a true query parameter, i.e.  the server may accept coordinates in
+B1950 or J2000 or some other coordinate system.
+
+For astrometric catalogs the reserved query parameter names "ra", "dec", and
+"qysystem" should be used to define the extraction region center and its
+coordinate system, and one or more of "radius", "width", "xwidth", and
+"ywidth" should be used to define the extraction region size. The units
+of "ra" should be "hours", "degrees", or "radians", the units of dec
+should be "degrees" or "radians", and units of the size query parameter
+should be "degrees" or "minutes". The qsystem parameter value may be
+any one of the supported celestial coordinate systems. The most common
+qsystem values are "icrs", "J2000", or "B1950". The query parameter
+formats are used to convert numerical values supplied by the calling
+program to string values that can be passed to the query string.
+It should be emphasized that the reserved query parameter names and units
+are conventions that are adopted to simplify writing the configuration
+file and astrometric applications. They are not part of the catalog
+access API itself.
+
+The \fItype\fR keyword defines the form of the query output. The current options
+are "stext" for simple text and "btext" for blocked text. Simple text 
+contains newline delimited records with whitespace delimited fields.
+Blocked text contains newline delimited records and fixed position and size
+fields. If the type keyword is missing "stext" is assumed.
+
+The \fIrecsize\fR keyword is the length of the record in characters including
+the newline character. If the record size is variable recsize should be set
+t0 0. If undefined the recsize keyword defaults to 0 for variable record
+size.
+
+The \fIhskip\fR, \fItskip\fR, \fIltrim\fR, and \fItrim\fR define the number
+of leading and trailing records in the query output to sky, and the
+number of leading and trailing characters in each record to trim, i.e.
+replace with blanks. If absent these keywords default to zero.
+
+The \fInheader\fR keyword defines the number of header keywords. Header
+keyword values are global quantities which apply to the catalog server
+output as a whole. There may be 0 or many header keywords.
+
+For most astrometry catalog the most important and often only header keyword
+is \fIcsystem\fR which defines the coordinate system of the query output
+coordinates, i.e. if csystem is "J2000" then the coordinates of objects
+extracted from the catalog are in "J2000".
+
+The \fInfields\fR keyword defines the number of fields in the query output
+records.  The name, offset, size, datatype, units, and format of each field
+follow, one field description per line. For simple text files the offset
+is field or column number and the size is 0 meaning undefined. For blocked
+text files the offset is the 1-indexed position of the first character (which
+may be blank) in the field and size is the field size in characters where
+the field size includes trailing blanks. Using a blocked text description may
+be required for dealing with fields containing embedded blanks. The type
+defines the preferred data type of a field. In the examples above the ra and
+dec are assigned double precision data types. This means that for precision
+reasons the calling program should but is not required to read these
+quantities into double precision variables. The units information is
+used to perform any required coordinate conversions, and the format information
+is used in cases where the calling program must decode a field, perform
+some numerical operation on it, and reencode it with the original precision.
+
+For astrometric catalogs the reserved standard field names "id", "ra", "dec",
+"mag#" etc should be used to define the standard field names. The current
+standard field name list is \fIid\fR, \fIra\fR, \fIdec\fR, \fRera\fR,
+\fIedec\fR, \fIpmra\fR, \fIpmdec\fR, \fIepmra\fR, \fIepmdec\fR,
+\fIcatsystem\fR, \fIequinox\fR, \fIepoch\fR, \fIpx\fR, \fIrv\fR, \fIepx\fR,
+\fIerv\fR, \fImag\fR, \fIcolor\fR, \fIemag\fR, \fIecolor\fR, \fIxp\fR,
+\fIyp\fR, \fIxc\fR, \fIyc\fR, \fIexc\fR, \fIeyc\fR, \fIimag\fR, and \fIeimag\fR.
+At a minimum an astrometric catalog must contain the "ra" and "dec" fields.
+The units of the ra field must be "hours", "degrees", or "radians"
+and the units of the "dec" field must be "degrees" or "radians". The
+other standard fields are optional and define quantities like: proper
+motions in ra and dec, the coordinate system, equinox, and epoch
+of observation, parallax, radial velocity, magnitude and color information,
+and predicted image pixel coordinates. The definitions and default units
+for all these quantities are defined more fully in the help for the
+astrometry package.  It should be emphasized that the reserved field names
+and units names are conventions that are adopted to simplify writing the
+configuration file and astrometric applications. They are not part of
+the catalog access API itself.
+
+
+.ih
+SEE ALSO
+surveys
+.endhelp
diff --git a/pkg/xtools/catquery/doc/catquery.hd b/pkg/xtools/catquery/doc/catquery.hd
new file mode 100644
index 00000000..1ae79114
--- /dev/null
+++ b/pkg/xtools/catquery/doc/catquery.hd
@@ -0,0 +1,56 @@
+# Help directory for the CATQUERY library
+
+$doc		= "./"
+$source		= "../"
+
+cqmap		hlp=doc$cqmap.hlp,		src=source$cqmap.x
+cqstati		hlp=doc$cqstati.hlp,		src=source$cqstat.x
+cqstats		hlp=doc$cqstats.hlp,		src=source$cqstat.x
+cqstatt		hlp=doc$cqstatt.hlp,		src=source$cqstat.x
+cqlocate	hlp=doc$cqlocate.hlp,		src=source$cqlocate.x
+cqlocaten	hlp=doc$cqlocaten.hlp,		src=source$cqlocate.x
+cqsetcat	hlp=doc$cqsetcat.hlp,		src=source$cqsetcat.x
+cqsetcatn	hlp=doc$cqsetcatn.hlp,		src=source$cqsetcat.x
+cqget		hlp=doc$cqget.hlp,		src=source$cqget.x
+
+cqnqpars	hlp=doc$cqnqpars.hlp,		src=source$cqnqpars.x
+cqgqpar		hlp=doc$cqgqpar.hlp,		src=source$cqgqpar.x
+cqgqparn	hlp=doc$cqgqparn.hlp,		src=source$cqgqpar.x
+cqsqpar		hlp=doc$cqsqpar.hlp,		src=source$cqsqpar.x
+cqsqparn	hlp=doc$cqsqparn.hlp,		src=source$cqsqpar.x
+
+cqquery		hlp=doc$cqquery.hlp,		src=source$cqquery.x
+cqfquery	hlp=doc$cqfquery.hlp,		src=source$cqquery.x
+cqrstati	hlp=doc$cqrstati.hlp,		src=source$cqrstat.x
+cqrstats	hlp=doc$cqrstats.hlp,		src=source$cqrstat.x
+cqrstatt	hlp=doc$cqrstatt.hlp,		src=source$cqrstat.x
+cqhinfo		hlp=doc$cqhinfo.hlp,		src=source$cqrinfo.x
+cqhinfon	hlp=doc$cqhinfon.hlp,		src=source$cqrinfo.x
+cqfinfo		hlp=doc$cqfinfo.hlp,		src=source$cqrinfo.x
+cqfinfon	hlp=doc$cqfinfon.hlp,		src=source$cqrinfo.x
+cqgrecord	hlp=doc$cqgrecord.hlp,		src=source$cqrecords.x
+cqgnrecord	hlp=doc$cqgnrecord.hlp,		src=source$cqrecords.x
+cqgvalc		hlp=doc$cqgvalc.hlp,		src=source$cqgfields.x
+cqgvals		hlp=doc$cqgvals.hlp,		src=source$cqgfields.x
+cqgvali		hlp=doc$cqgvali.hlp,		src=source$cqgfields.x
+cqgvall		hlp=doc$cqgvall.hlp,		src=source$cqgfields.x
+cqgvalr		hlp=doc$cqgvalr.hlp,		src=source$cqgfields.x
+cqgvald		hlp=doc$cqgvald.hlp,		src=source$cqgfields.x
+cqrclose	hlp=doc$cqrclose.hlp,		src=source$cqquery.x
+
+cqimquery	hlp=doc$cqimquery.hlp,		src=source$cqimquery.x
+cqfimquery	hlp=doc$cqfimquery.hlp,		src=source$cqimquery.x
+cqistati	hlp=doc$cqistati.hlp,		src=source$cqistat.x
+cqistats	hlp=doc$cqistats.hlp,		src=source$cqistat.x
+cqistatt	hlp=doc$cqistatt.hlp,		src=source$cqistat.x
+cqwinfo		hlp=doc$cqwinfo.hlp,		src=source$cqiminfo.x
+cqwinfon	hlp=doc$cqwinfon.hlp,		src=source$cqiminfo.x
+cqkinfo		hlp=doc$cqkinfo.hlp,		src=source$cqiminfo.x
+cqkinfon	hlp=doc$cqkinfon.hlp,		src=source$cqiminfo.x
+cqimclose	hlp=doc$cqimclose.hlp,		src=source$cqimquery.x
+
+cqunmap		hlp=doc$cqunmap.hlp,		src=source$cqmap.x
+
+ccsystems	hlp=doc$ccsystems.hlp
+catalogs	hlp=doc$catalogs.hlp
+surveys		hlp=doc$surveys.hlp
diff --git a/pkg/xtools/catquery/doc/catquery.hlp b/pkg/xtools/catquery/doc/catquery.hlp
new file mode 100644
index 00000000..3521c62c
--- /dev/null
+++ b/pkg/xtools/catquery/doc/catquery.hlp
@@ -0,0 +1,322 @@
+.help catquery Aug01 xtools
+.ih
+NAME
+catquery -- catalog access package
+.ih
+SYNOPSIS
+
+.nf
+           cq = cq_map (file, mode)
+	 ival = cq_stati (cq, param)
+	        cq_stats (cq, param, str, maxch)
+       nlines = cq_statt (cq, param, text, maxch)
+
+	catno = cq_locate (cq, name)
+	catno = cq_locaten (cq, catno, catname, maxch)
+	catno = cq_setcat (cq, name)
+	catno = cq_setcatn (cq, catno)
+
+     [ird]val = cq_fget[ird] (cq, name)
+       nelems = cq_fga[ird] (cq, name, array[ird], max_nelems)
+                cq_fgstr (cq, name, str, maxch)
+                cq_fgwrd (cq, name, wrd, maxch)
+       nlines = cq_fgtext (cq, name, text, maxch)
+         stat = cq_scan (cq)
+
+	nqpars = cq_nqpars (cq)
+	qparno = cq_gqpar (cq, name, qpname, max_qpname, qpvalue,
+	         max_qpvalue, qpunits, max_qpunits, qpformat,
+		 max_qpformat)
+	qparno = cq_gqparn (cq, qparno, qpname, max_qpname, qpvalue,
+ 	         max_qpvalue, qpunits, max_qpunits, qpformat, max_qpformat)
+	qparno = cq_sqpar (cq, name, valuestr)
+	qparno = cq_sqparn (cq, qparno, valuestr)
+
+	   res = cq_query (cq)
+	   res = cq_fquery (cq, catfile, cathdr)
+	  ival = cq_rstati (res, param)
+	         cq_rstats (res, param, str, maxch)
+	nlines = cq_rstatt (res, param, text, maxch)
+	hparno = cq_hinfo (res, name, hpvalue, max_hpvalue)
+	hparno = cq_hinfon (res, hparno, hpname, max_hpname, hpvalue,
+	         max_hpvalue)
+	nchars = cq_grecord (res, buffer, maxch, recno)
+        nchars = cq_gnrecord (res, buffer, maxch, nextrec)
+       fieldno = cq_finfo (res, name, foffset, fsize, ftype, funits,
+		 max_funits, formats, max_formats)
+       fieldno = cq_finfon (res, fieldno, fname, max_fname, foffset, fsize,
+	         ftype, funits, max_funits, formats, max_formats)
+	         cq_rclose (res)
+       nchars = cq_gval[silrd] (res, name, [silrd]val)
+       nchars = cq_gvalc (res, name, str, maxch)
+
+	 imres = cq_imquery (cq, imname)
+	 imres = cq_fimquery (cq, imname)
+	  ival = cq_istati (imres, param)
+	         cq_istats (imres, param, str, maxch)
+	nlines = cq_istatt (imres, param, text, maxch)
+	wparno = cq_winfo (imres, name, wkname, max_wkname, wvalue,
+	         max_wvalue, wtype, wunits, max_wunits)
+	wparno = cq_winfon (imres, wparno, wpname, max_wpnane, wkname,
+	         max_wkname, wvalue, max_wvalue, wtype, wunits, max_wunits)
+	kparno = cq_kinfo (imres, name, skname, max_skname, svalue,
+	         max_svalue, stype, sunits, max_sunits)
+	kparno = cq_kinfon (imres, kparno, spname, max_spname, skname,
+	         max_skname, svalue, max_svalue, stype, sunits, max_sunits)
+	         cq_imclose (imres)
+
+        cq_unmap (cq)
+.fi
+.ih
+DESCRIPTION
+The catquery package provides a set of routines for local and remote
+catalog and image survey server access. The supported catalogs and image
+surveys are described in records stored in a catalog and image survey
+configuration file respectively. The catalog and image survey records
+specify the network address, the query format, and the output format for
+each supported catalog or image display server. More detailed information
+about catalogs and image survey access and configuration files can be
+found by typing "help catalogs" and "help surveys".
+
+The results of each catalog query are stored in memory in an IRAF spool file.
+Calling programs can access the catalog results sequentially or randomly
+by record number. Individual fields in each record can be decoded into
+floating point, integer, or string values.
+
+The results of each image survey query are written to an image file on disk,
+currently a fits image file. IRAF image i/o routines can be used to access
+the image. There must be enough space availale on the disk to receive the
+image.
+
+.ih
+NOTES
+
+The catquery package definitions file is cq.h.
+
+The catalog and image surveys configuration files are mapped and unmapped
+with the routines cq_map and cq_unmap.
+
+Before making a query the calling program must set the current catalog
+or image survey with the cq_setcat or cq_setcatn routines, and format
+and set the query parameters with the cq_gqpar, cq_gqparn, and cq_sqparn
+routines. 
+
+Remote and locate catalog queries are made with the cq_query routine.
+The routines cq_rstat[ist] are used to retrieve the catalog results parameters.
+Header parameter values and field descriptions can be retrieved with
+the cq_hinfo, cq_hinfon, cq_finfo, and cq_finfon routines. Catalog records
+can be accessed sequentially or randomly with the cq_gnrecord and
+cq_grecord routines. The cq_gval[csilrd] routines can be used to decode
+the record fields into floating point, integer, or string values.
+The cq_fquery routine is used to make a catalog file emulate
+the results of a catalog query. Cq_rclose frees the catalog results descriptor.
+
+Remote and locate image survey queries are made with the cq_imquery routine.
+The routines cq_istat[ist] are used to retrieve the survey results parameters.
+The standard wcs and image parameter descriptions can be retrieved with the
+the cq_winfo, cq_winfon, cq_kinfo, and cq_kinfon routines. The cq_fimquery
+routine is used to make an existing image emulate the results of an image
+survey query. Cq_imclose frees the survey results descriptor.
+
+.ih
+EXAMPLES
+.nf
+Example 1: Query a catalog and dump the results to a catalog file.
+
+    include <cq.h>
+
+    ....
+
+    ra = clgetd ("ra")
+    dec = clgetd ("dec")
+    width = clgetd ("width")
+
+    ....
+
+    # Open the catalog configuration file.
+    cq = cq_map ("astromz$lib/catdb.dat", READ_ONLY)
+    if (cq == NULL)
+	...
+
+    # Set the catalog.
+    catno = cq_setcat (cq, "noao@usno2")
+    if (catno == 0)
+	...
+
+    # Set the query parameters. Assume the input units match the
+    # the expected units. The input size is a width so divide by two 
+    # if the query expects a radius.
+    nqpars = cq_nqpars (cq)
+    do i = 1, nqpars {
+	parno = cq_gqparn (cq, i, qpname, CQ_SZ_QPNAME, qpvalue,
+    	    CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats
+	    CQ_SZ_QPFORMATS)
+	if (parno != i)
+	    next
+	if (streq (qpname, "ra")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (ra)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "dec")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (dec)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "radius")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width / 2.0d0)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "width")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "xwidth")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "ywidth")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	}
+    }
+
+    # Make the query.
+    res = cq_query (cq)
+    if (res == NULL)
+	...
+
+    # Write the results to a file.
+    recptr = 0
+    while (cq_gnrecord (res, buffer, SZ_LINE, rectpr) != EOF) {
+	call fprintf (outfd, "%s")
+	    call pargstr (buffer)
+    }
+
+    # Close the query.
+    call cq_rclose (res)
+
+    # Close the database.
+    call cq_unmap (cq)
+
+
+Example 2: Repeat the previous example but only output records for
+	   which magnitude values  <= 16.0.
+
+     include <cq.h>
+
+     ...
+
+     res = cq_query (cq)
+     if (res == NULL)
+	...
+
+     nrec = cq_rstati (res, CQNRECS)
+     do i = 1, nrecs {
+	nchars = cq_gvalr (res, i, "mag1", mag)
+	if (nchars <= 0)
+	    next
+	if (mag > 16.0)
+	    next
+	nchars = cq_grecord (res, buffer, SZ_LINE, i)
+	if (nchars <= 0)
+	    next
+	call fprintf (outfd, "%s")
+	    call pargstr (buffer)
+     }
+
+     call cq_rclose (res)
+
+     ...
+
+
+Example 3: Make an image survey query and dump the results to a fits file.
+
+    include <cq.h>
+
+    ....
+
+    ra = clgetd ("ra")
+    dec = clgetd ("dec")
+    width = clgetd ("width")
+
+    ....
+
+    # Open the catalog configuration file.
+    cq = cq_map ("astromz$lib/imdb.dat", READ_ONLY)
+    if (cq == NULL)
+	...
+
+    # Set the catalog.
+    catno = cq_setcat (cq, "dss1@cadc")
+    if (catno == 0)
+	...
+
+    # Set the query parameters. Assume the input units match the
+    # the expected units. 
+    nqpars = cq_nqpars (cq)
+    do i = 1, nqpars {
+	parno = cq_gqparn (cq, i, qpname, CQ_SZ_QPNAME, qpvalue, CQ_SZ_QPVALUE,
+	    qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFORMATS)
+	if (parno != i)
+	    next
+	if (streq (qpname, "ra")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (ra)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "dec")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (dec)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "width")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "xwidth")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	} else if (streq (qpname, "ywidth")) {
+	    call sprintf (qpvalue, CQ_SZ_QPVALUE, qpformats)
+		call pargd (width)
+	    parno = cq_sqpars (cq, qpname, qpvalue)
+	}
+    }
+
+    # Make the query.
+    imres = cq_imquery (cq, "outimage.fits")
+    if (imres == NULL)
+	...
+
+    # Free the results structure
+    call cq_imclose (imres)
+
+    # Unmap the database
+    call cq_unmap (cq)
+
+
+
+Example 4:  Repeat the previous example but convert the dss wcs to a fits wcs.
+            At_mkdss is a routine which converts a dss wcs to a fits wcs
+
+    ...
+
+    # Make the query.
+    imres = cq_imquery (cq, "outimage.fits")
+    if (imres == NULL)
+	...
+
+    wcstype = cq_istati (imres, CQWCS)
+    if (wcstype == CQWDSS) {
+	im = immap ("outimage.fits", READ_WRITE, 0)
+	stat = at_mkdss (im, true, false)
+	if (stat == ERR)
+	    ...
+	call imunmap (im)
+    }
+
+    # Free the results structure
+    call cq_imclose (imres)
+
+    ...
+.fi
+.endhelp
diff --git a/pkg/xtools/catquery/doc/catquery.men b/pkg/xtools/catquery/doc/catquery.men
new file mode 100644
index 00000000..ace43e7c
--- /dev/null
+++ b/pkg/xtools/catquery/doc/catquery.men
@@ -0,0 +1,28 @@
+         cqmap - Map the catalog / survey configuration file
+   cqstat[ist] - Get an integer, string, or text catalog / survey parameter
+   cqlocate[n] - Locate a catalog / survey by name or number
+   cqsetcat[n] - Set the current catalog / survey  by name or number
+         cqget - Read catalog / survey configuration file keywords directly
+
+      cqnqpars - Get the number of query parameters
+    cqgqpar[n] - Get query parameter info by name or number
+    cqsqpar[n] - Set query parameter value by name or number
+
+       cqquery - Query a catalog and return the results
+      cqfquery - Query a catalog file and return the results
+  cqrstat[ist] - Get catalog results integer, string, or text parameter
+    cqhinfo[n] - Get catalog results header value by name or number
+     cqgrecord - Get catalog results record
+    cqgnrecord - Get next catalog results record
+    cqfinfo[n] - Get catalog results field info by name or number
+cqgval[csilrd] - Get field value from record
+      cqrclose - Close the catalog results
+
+     cqimquery - Query an image survey and return the results
+    cqfimquery - Query an image file and return the results
+  cqistat[ist] - Get survey results integer, string, or text parameter
+    cqwinfo[n] - Get survey results wcs parameter info by name or number
+    cqkinfo[n] - Get survey results image parameter info by name or number
+     cqimclose - Close the survey results
+
+       cqunmap - Unmap the configuration file
diff --git a/pkg/xtools/catquery/doc/ccsystems.hlp b/pkg/xtools/catquery/doc/ccsystems.hlp
new file mode 100644
index 00000000..3c1235a6
--- /dev/null
+++ b/pkg/xtools/catquery/doc/ccsystems.hlp
@@ -0,0 +1,134 @@
+.help ccsystems Mar00 catquery
+.ih
+NAME
+ccsystems -- list and describe the supported sky coordinate systems
+.ih
+USAGE
+help ccsystems
+
+.ih
+SKY COORDINATE SYSTEMS
+
+The sky package supports the equatorial ("fk4", "fk4-noe", "fk5", "icrs"),
+ecliptic, galactic, and supergalactic celestial coordinate systems. In most
+cases and unless otherwise noted users can input their coordinates in
+any one of these systems as long as they specify the coordinate system
+correctly.
+
+Considerable flexibility is permitted in how the coordinate systems are
+specified, e.g. J2000.0, j2000.0, 2000.0, fk5, fk5 J2000, and fk5 2000.0
+all specify the mean place post-IAU 1976 or FK5 system. Missing equinox and
+epoch fields assume reasonable defaults. In most cases the
+systems of most interest to users are "icrs", "j2000", and "b1950"
+which stand for the ICRS J2000.0, FK5 J2000.0 and FK4 B1950.0 celestial
+coordinate systems respectively. The full set of options are listed below:
+
+.ls equinox [epoch]
+The equatorial mean place post-IAU 1976 (FK5) system if equinox is a
+Julian epoch, e.g. J2000.0 or 2000.0, or the equatorial mean place
+pre-IAU 1976 system (FK4) if equinox is a Besselian epoch, e.g. B1950.0
+or 1950.0. Julian equinoxes are prefixed by a J or j, Besselian equinoxes
+by a B or b. Equinoxes without the J / j or B / b prefix are treated as
+Besselian epochs if they are < 1984.0, Julian epochs if they are >= 1984.0.
+Epoch is the epoch of the observation and may be a Julian
+epoch, a Besselian epoch, or a Julian date. Julian epochs
+are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to the epoch type of
+equinox if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.  If undefined epoch defaults to equinox.
+.le
+.ls icrs [equinox] [epoch]
+The International Celestial Reference System where equinox is
+a Julian or Besselian epoch e.g. J2000.0  or B1980.0.
+Equinoxes without the J / j or B / b prefix are treated as Julian epochs.
+The default value of equinox is J2000.0.
+Epoch is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.  If undefined epoch defaults to equinox.
+.le
+.ls fk5 [equinox] [epoch]
+The equatorial mean place post-IAU 1976 (FK5) system where equinox is
+a Julian or Besselian epoch e.g. J2000.0  or B1980.0.
+Equinoxes without the J / j or B / b prefix are treated as Julian epochs.
+The default value of equinox is J2000.0.
+Epoch is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.  If undefined epoch defaults to equinox.
+.le
+.ls fk4 [equinox] [epoch]
+The equatorial mean place pre-IAU 1976 (FK4) system where equinox is a
+Besselian or Julian epoch e.g. B1950.0  or J2000.0,
+and epoch is the Besselian epoch, the Julian epoch, or the Julian date of the
+observation.
+Equinoxes without the J / j or B / b prefix are treated
+as Besselian epochs. The default value of equinox is B1950.0. Epoch
+is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.  If undefined epoch defaults to equinox.
+.le
+.ls noefk4 [equinox] [epoch]
+The equatorial mean place pre-IAU 1976 (FK4) system but without the E-terms
+where equinox is a Besselian or Julian epoch e.g. B1950.0 or J2000.0,
+and epoch is the Besselian epoch, the Julian epoch, or the Julian date of the
+observation.
+Equinoxes without the J / j or B / b prefix are treated
+as Besselian epochs. The default value of equinox is B1950.0.
+Epoch is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian day.  If undefined epoch defaults to equinox.
+.le
+.ls apparent epoch
+The equatorial geocentric apparent place post-IAU 1976 system where
+epoch is the epoch of observation.
+Epoch is a Besselian epoch, a Julian epoch or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian
+epochs if the epoch value < 1984.0, Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.
+.le
+.ls ecliptic epoch
+The ecliptic coordinate system where epoch is the epoch of observation.
+Epoch is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian epochs
+if the epoch values < 1984.0, Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian day.
+.le
+.ls galactic [epoch]
+The IAU 1958 galactic coordinate system.
+Epoch is a Besselian epoch, a Julian epoch or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian
+epochs if the epoch value < 1984.0, Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date. The default value of epoch is B1950.0.
+.le
+.ls supergalactic [epoch]
+The deVaucouleurs supergalactic coordinate system.
+Epoch is a Besselian epoch, a Julian epoch or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian
+epochs if the epoch value < 1984.0, Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date. The default value of epoch is B1950.0.
+.le
+
+Fields enclosed in [] are optional with the defaults as described. The epoch
+field for the "icrs" , "fk5", "galactic", and "supergalactic" coordinate
+systems is only used if the input coordinates are in the equatorial fk4,
+noefk4, fk5, or icrs systems and proper motions are used to transform from
+coordinate system to another.
+
+.ih
+SEE ALSO
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqfimquery.hlp b/pkg/xtools/catquery/doc/cqfimquery.hlp
new file mode 100644
index 00000000..d344c7ee
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqfimquery.hlp
@@ -0,0 +1,39 @@
+.help cqfimquery Mar00 "Catquery Package"
+.ih
+NAME
+cqfimquery -- return the results of an image file query
+.ih
+SYNOPSIS
+
+imres = cq_fimquery (cq, imname)
+
+.nf
+pointer	cq		# the configuration file descriptor
+char	imname		# the input image file name 
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls imname
+The file name of the image being queried.
+.le
+.ih
+DESCRIPTION
+Cq_fimquery queries an existing image and returns a results descriptor.
+Cq_fimquery is a pointer procedure which returns the results descriptor
+as its function value. NULL is returned if an error occurs in the query
+or the image does not exist.
+
+Cq_fimquery is used to make an image emulate the results of an image
+survey query.
+.ih
+NOTES
+Cq_setcat with the image survey name set to the reserved record name
+"imname@noao" must be called before any image survey query is made.
+
+.ih
+SEE ALSO
+cqimquery, cqimclose
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqfinfo.hlp b/pkg/xtools/catquery/doc/cqfinfo.hlp
new file mode 100644
index 00000000..b3bce18a
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqfinfo.hlp
@@ -0,0 +1,85 @@
+.help cqfinfo Mar00 "Catquery Package"
+.ih
+NAME
+cqfinfo -- get the requested description by name
+.ih
+SYNOPSIS
+
+fieldno = cq_finfo (res, name, fname, max_fname, foffset, fsize, ftype, funits,
+		    max_funits, format, max_format)
+
+.nf
+pointer	res		# the results descriptor
+char	name		# the input field name
+char	fname		# the returned field name
+int	max_fname	# the maximum size of the field name
+int	foffset		# the returned field offset 
+int	fsize		# the returned field size
+int	ftype		# the returned field type
+char	funits		# the returned field units
+int	max_funits	# the maximum size of the field units
+char	format		# the returned field format
+int	max_format	# the maximum size of the field format
+.fi
+.ih
+ARGUMENTS
+.ls res    
+The results descriptor.
+.le
+.ls name
+The name of the requested field.
+.le
+.ls fname
+The returned field name.
+.le
+.ls max_fname
+The maximum size of the returned field name.
+.le
+.ls foffset
+The returned field offset. Foffset is the field or column number if the
+results are in simple text format, or the one-indexed field offset in chars
+if the results are in blocked text format.
+.le
+.ls fsize
+The returned field size. Fsize is zero if the results are in simple text format,
+the field width in characters if the results are in blocked file format.
+.le
+.ls ftype
+The returned field data type. The options are TY_DOUBLE, TY_REAL, TY_LONG,
+TY_INT, TY_SHORT, and TY_CHAR.
+.le
+.ls funits
+The returned field units.
+.le
+.ls max_funits
+The maximum size of the returned field units.
+.le
+.ls format
+The returned field format.
+.le
+.ls max_format
+The maximum size of the returned field format.
+.le
+.ih
+DESCRIPTION
+Cq_finfo returns the name, offset, size, data type, units, and format of
+the requested field. Cq_finfo is an integer function which returns
+the field number of the requested field as its function value.
+
+.ih
+NOTES
+
+Related routines of interest are:
+
+.nf
+fieldno = cq_fnumber (res, fname)
+foffset = cq_foffset (res, fname)
+  fsize = cq_fsize (res, fname)
+  ftype = cq_ftype (res, fname)
+     call cq_funits (res, fname, units, max_units)
+     call cq_ffmts (res, fname, format, max_format)
+.fi
+.ih
+SEE ALSO
+cqfinfon
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqfinfon.hlp b/pkg/xtools/catquery/doc/cqfinfon.hlp
new file mode 100644
index 00000000..62f07dfd
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqfinfon.hlp
@@ -0,0 +1,79 @@
+.help cqfinfon Mar00 "Catquery Package"
+.ih
+NAME
+cqfinfon -- get the catalog results field description by number
+.ih
+SYNOPSIS
+
+fieldno = cq_finfon (res, fieldno, fname, max_fname, foffset, fsize,  ftype,
+		     funits, max_funits, format, max_format)
+
+.nf
+pointer	res		# the results descriptor
+int	fieldno		# the sequence number of the field to be returned
+char	fname		# the returned field name
+int	max_fname	# the maximum size of the returned field name
+int	foffset		# the field offset 
+int	fsize		# the field size
+int	ftype		# the field data type
+char	funits		# the field units
+int	max_funits	# the maximum size of the returned field units
+char	format		# the field format
+int	max_format	# the maximum size of the returned field format
+.fi
+.ih
+ARGUMENTS
+.ls res    
+The results descriptor.
+.le
+.ls fieldno
+The sequence number of the field for which information is to be returned.
+.le
+.ls fname
+The returned field name.
+.le
+.ls max_fname
+The maximum size of the returned field name.
+.le
+.ls foffset
+The field offset. Foffset is the field or column number if the
+results are in simple text format, or the one-indexed field offset in chars
+if the results are in blocked text format.
+.le
+.ls fsize
+The field size. Fsize is zero if the results are in simple text file format,
+the field width in characters if results are in blocked file format.
+.le
+.ls ftype
+The field data type. The options are TY_DOUBLE, TY_REAL, TY_LONG, TY_INT,
+TY_SHORT, and TY_CHAR.
+.le
+.ls units
+The returned field units string.
+.le
+.ls max_units
+The maximum size of the returned field units string.
+.le
+.ls format
+The returned field format string.
+.le
+.ls max_format
+The maximum size of the returned field format string.
+.le
+.ih
+DESCRIPTION
+Cq_finfon returns the name, offset, size, data type, units, and format of
+the requested field. Cq_finfon is an integer function which returns
+the field number of the requested field as its function value.
+
+.ih
+NOTES
+Related routines of interest are:
+
+.nf
+call cq_fname (res, fieldno, name, max_name)
+.fi
+.ih
+SEE ALSO
+cqfinfo
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqfquery.hlp b/pkg/xtools/catquery/doc/cqfquery.hlp
new file mode 100644
index 00000000..32f2d5b0
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqfquery.hlp
@@ -0,0 +1,78 @@
+.help cqfquery Mar00 "Catquery Package"
+.ih
+NAME
+cqfquery -- query a catalog file and return the results
+.ih
+SYNOPSIS
+
+res = cq_fquery (cq, catfile, hdrtxt)
+
+.nf
+pointer	cq		# the configuration file descriptor
+char	catfile		# the catalog file name
+char	hdrtext		# the catalog file header text
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls catfile
+The catalog file name.
+.le
+.ls hdrtext
+Text describing the format of the catalog file.
+.le
+.ih
+DESCRIPTION
+Cq_fquery is a pointer function which returns the results descriptor as its
+function value. NULL is returned if an error occurs in the catalog file query.
+
+Cq_fquery is used to make a catalog file emulate the results of
+a catalog query. The calling program must supply the catalog format
+description. A sample catalog file and catalog description are shown below.
+.ih
+NOTES
+Cq_setcat with the catalog name set to the reserved record name "filename@noao"
+must be called before any catalog file query is made.
+
+A sample catalog file is shown below.
+
+.nf
+ 00:00:01.443   -0:06:57.52  13.5  15.2
+ 00:00:01.574   -0:05:33.26  16.1  18.0
+ 00:00:01.904   -0:09:48.51  18.2  19.6
+ 00:00:02.529   -0:04:21.53  13.4  14.4
+ 00:00:04.154   -0:01:56.32  17.1  18.3
+ 00:00:04.438   -0:05:00.03  11.4  13.5
+ 00:00:04.697   -0:03:24.59  16.9  17.7
+ 00:00:05.989   -0:02:46.36  15.1  17.6
+ 00:00:07.118   -0:09:03.53  19.1  19.8
+ 00:00:07.260   -0:06:47.95  17.0  17.7
+ 00:00:07.314   -0:00:22.35  15.3  16.8
+.fi
+
+The accompanying catalog file header is shown below.
+
+.nf
+type stext
+nheader 1
+    csystem J2000
+nfields 4
+    ra 1 0 d hours %12.3h
+   dec 2 0 d degrees %12.2h
+  mag1 3 0 r INDEF %4.1f
+  mag2 4 0 r INDEF %4.1f
+.fi
+
+The catalog header specifies the type of file, "stext" for simple text in
+this example, the number of header parameters, the number of fields in each
+record, and the individual field descriptions. 
+
+More information about the catalog header shown here can be found by typing
+"help catalogs".
+
+.ih
+SEE ALSO
+cqquery, cqrclose
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqget.hlp b/pkg/xtools/catquery/doc/cqget.hlp
new file mode 100644
index 00000000..0229cdc1
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqget.hlp
@@ -0,0 +1,130 @@
+.help cqget Mar00 "Catquery Package"
+.ih
+NAME
+cqget -- read configuration file keywords directly
+.ih
+SYNOPSIS
+
+.nf
+      [ird]val = cq_fget[ird](cq, fname)
+        nelems = cq_fga[ird](cq, fname, [ird]array, max_nelems)
+            call cq_fgwrd (cq, fname, wrd, maxch)
+	    call cq_fgstr (cq, fname, str, maxch)
+	nlines = cq_fgtext (cq, fname, text, maxch)
+	  stat = cq_scan (cq)
+
+pointer	cq		# the configuration file descriptor
+char	fname		# the field or keyword to be located
+int	iarray		# the returned integer array
+int	rarray		# the returned real array
+int	darray		# the returned double array
+int	max_nelems	# the maximum size of the returned array
+char	wrd		# the keyword word value to be read
+char	str		# the keyword string value to be read
+char	text		# the keyword text value to be read
+int	maxch		# the maximum size of the word, string, text value
+.fi
+.ih
+SYNOPSIS
+.ls cq
+The configuration file descriptor.
+.le
+.ls fname
+The name of the field or keyword to be read.
+.le
+.ls [ird]array
+The integer, real, or double array returned by a call to cq_fga[ird].
+.le
+.ls max_nelems
+The maximum number of elements in the array returned by a call to
+cq_fga[ird].
+.le
+.ls wrd, str, text
+The word, string, or text value returned by a call to cq_fgwrd, cq_fgstr, or
+cq_fgtext.
+.le
+.ls maxch
+The maximum number of characters in the word, string, or text returned
+by cq_fgwrd, cq_fgstr, cq_fgtext.
+.le
+.ih
+DESCRIPTION
+
+Cq_fgval[ird] is an integer, real, or double function which returns the
+integer, real, or double value of the requested field or keyword as its
+function value.
+
+Cq_fga[ird] returns an integer, real, or double array for the requested
+field.  Cq_fga[ird] is an integer function which returns the number of elements
+in the retrieved array as its function value.
+
+Cq_fg[wrd/str/text] returns the next word, the entire string,  or the
+number of lines in the requested keyword. Cq_fgtext is an integer function
+which returns the number of lines in the returned text as its functions
+value.
+
+.ih
+NOTES
+The cqget routines are used to read keywords or fields in the current catalog
+or survey directly. The routines cq_setcat or cq_setcatn must be called before
+the cqget routines can be used.
+
+The cqget routines must be error checked to avoid task termination.
+.ih
+EXAMPLES
+
+Sample catalog configuration file  record.
+
+.nf
+begin usno2@noao
+address inet:80:www.noao.edu:text
+query GET /cgi-bin/usno/usnoextract?search=yes&ra=%-s&dec=%-s&width=%-s HTTP/1.0
+\n\n
+nquery 4
+    ra 00:00:00.00 hours %0.2h
+    dec 00:00:00.0 degrees %0.1h
+    radius 5.0 minutes %0.1f
+    qsystem J2000.0 INDEF %s
+type stext
+    hskip 10
+    tskip  6
+    recsize 44
+    triml 0
+    trimr 4
+nheader 1
+    csystem J2000.0
+nfields 4
+    ra 1 0 d hours %12.3h
+    dec 2 0 d degrees %12.2h
+    mag1 3 0 r INDEF %4.1f
+    mag2 4 0 r INDEF %4.1f
+.fi
+
+Example 1: To fetch the query field which includes embedded blanks use cq_fgstr.
+
+.nf
+call cq_fgstr (cq, "query", buffer, SZ_LINE)
+.fi
+
+Example 2: To fetch the type field use cq_fgwrd.
+
+.nf
+call cq_fgwrd (cq, "type", buffer, SZ_LINE)
+.fi
+
+Example 3: To determine the number of query parameters.
+
+.nf
+nquery = cq_fgeti (cq, "nquery")
+.fi
+
+Example4: To return a text array which follows a numerically valued parameter.
+
+.nf
+nquery = cq_fgeti (cq, "nquery")
+nlines = cq_fgtext (cq, "nquery", buffer, nquery * SZ_LINE)
+.fi
+
+.ih
+SEE ALSO
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgnrecord.hlp b/pkg/xtools/catquery/doc/cqgnrecord.hlp
new file mode 100644
index 00000000..6fd9ab53
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgnrecord.hlp
@@ -0,0 +1,61 @@
+.help cqgnrecord Mar00 "Catquery Package"
+.ih
+NAME
+cqgnrecord -- get the next record from the catalog results
+.ih
+SYNOPSIS
+
+stat = cq_gnrecord (res, buf, maxch, nextrec)
+
+.nf
+pointer	res		# the results descriptor
+char	buf		# the output record buffer
+int	maxch		# the maximum size of the output record buffer
+int	recno		# the next available record number 
+.fi
+.ih
+ARGUMENTS
+.ls res    
+The results descriptor.
+.le
+.ls buf
+The buffer containing the returned record.
+.le
+.ls maxch
+The maximum size of the output buffer.
+.le
+.ls recptr
+The next available record number. Recptr is updated after each call.
+.le
+.ih
+DESCRIPTION
+Cq_gnrecord returns the requested record. Cq_grecord is an integer function
+which returns BOF, the number of characters in the record, or EOF as
+its function value.
+
+.ih
+NOTES
+In most cases allocating a buffer size that is SZ_LINE chars long
+will be adequate to hold the output record. If the integer results parameter
+CQRECSIZE is defined, i.e. non-zero, then an output buffer  CQRECSIZE chars
+long can be allocated.
+
+.ih
+EXAMPLES
+
+pointer	cq_query()
+int cq_gnrecord()
+
+...
+
+res = cq_query (cq)
+recno = 0
+while (cq_gnrecord (res, record, SZ_LINE, recno) != EOF) {
+     call printf ("%s")
+	call pargstr (record)
+}
+call cq_rclose (res)
+.ih
+SEE ALSO
+cqgrecord
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgqpar.hlp b/pkg/xtools/catquery/doc/cqgqpar.hlp
new file mode 100644
index 00000000..72b14809
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgqpar.hlp
@@ -0,0 +1,72 @@
+.help cqgqpar Mar00 "Catquery Package"
+.ih
+NAME
+cqgqpar -- get a query parameter description by name
+.ih
+SYNOPSIS
+
+parno = cq_gqpar (cq, pname, qpname, max_qpname, qpvalue, max_qpvalue, qpunits,
+		  max_qpunits, qpformat, max_qpformat)
+
+.nf
+pointer	cq		# the configuration file descriptor
+char	pname		# the name of the requested query parameter 
+char	qpname		# the returned query parameter name
+int	max_qpname	# the maximum size of the returned parameter name
+char	qpvalue		# the returned query parameter value
+int	max_qpvalue	# the maximum size of the returned parameter value
+char	qpunits		# the returned query parameter units
+int	max_qpunits	# the maximum size of the returned parameter units
+char	qpformat	# the returned query parameter format
+int	max_qpformat	# the maximum size of the returned parameter format
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls pname
+The name of the requested query parameter.
+.le
+.ls qpname
+The returned query parameter name.
+.le
+.ls max_qpname
+The maximum size of the returned query parameter name.
+.le
+.ls qpvalue
+The returned query parameter value.
+.le
+.ls max_qpvalue
+The maximum size of the returned query parameter value.
+.le
+.ls qpunits
+The returned query parameter units.
+.le
+.ls max_qpunits
+The maximum size of the returned query parameter units.
+.le
+.ls qpformat
+The returned query parameter format.
+.le
+.ls max_qpformat
+The maximum size of the returned query parameter format.
+.le
+.ih
+DESCRIPTION
+Cq_gqpar returns the name, value, units, and format of the requested query
+parameter. Cq_gpar is an integer function  which returns the sequence number
+of the query parameter as its function value. Zero is returned if the requested
+query parameter is not found.
+.ih
+NOTES
+Cq_setcat or cq_setcatn must be called before a query parameter 
+request can be made.
+
+The defined constants CQ_SZ_QPNAME, CQ_SZ_QPVALUE, CQ_SZ_QPUNITS, and
+CQ_SZ_QPFMTS in the cq.h file can be used to assign values to the
+max_qpname, max_qpvalue, max_qpunits, and max_qpformat paramters.
+.ih
+SEE ALSO
+cqnqpars, cqgqparn, cqsqpar, cqsqparn
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgqparn.hlp b/pkg/xtools/catquery/doc/cqgqparn.hlp
new file mode 100644
index 00000000..10155fe7
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgqparn.hlp
@@ -0,0 +1,73 @@
+.help cqgqparn Mar00 "Catquery Package"
+.ih
+NAME
+cqgqparn -- get the query parameter description by sequence number
+.ih
+SYNOPSIS
+
+parno = cq_gqparn (cq, parno, qpname, max_qpname, qpvalue, max_qpvalue, qpunits,
+		  max_qpunits, qpformat, max_qpformat)
+
+.nf
+pointer	cq		# the configuration file descriptor
+int	parno		# the query parameter sequence number
+char	qpname		# the returned query parameter name
+int	max_qpname	# the maximum size of the returned parameter name
+char	qpvalue		# the returned query parameter value
+int	max_qpvalue	# the maximum size of the returned parameter value
+char	qpunits		# the returned query parameter units
+int	max_qpunits	# the maximum size of the returned parameter units
+char	qpformat	# the returned query parameter format
+int	max_qpformat	# the maximum size of the returned parameter format
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls parno
+The query parameter sequence number.
+.le
+.ls qpname
+The returned query parameter name.
+.le
+.ls max_qpname
+The maximum size of the returned query parameter name.
+.le
+.ls qpvalue
+The returned query parameter value.
+.le
+.ls max_qpvalue
+The maximum size of the returned query parameter value.
+.le
+.ls qpunits
+The returned query parameter units.
+.le
+.ls max_qpunits
+The maximum size of the returned query parameter units.
+.le
+.ls qpformat
+The returned query parameter format.
+.le
+.ls max_qpformat
+The maximum size of the returned query parameter format.
+.le
+.ih
+DESCRIPTION
+Cq_gqparn returns the name, value, units, and format of the requested query
+parameter by number. Cq_gparn is an integer function  which returns the
+sequence number of the query parameter as its function value. Zero is
+returned if the requested query parameter is not found.
+.ih
+NOTES
+Cq_setcat or cq_setcatn must be called before a query parameter
+request can be made.
+
+The defined constants CQ_SZ_QPNAME, CQ_SZ_QPVALUE, CQ_SZ_QPUNITS, and
+CQ_SZ_QPFMTS in the cq.h file can be used to assign values to the
+max_qpname, max_qpvalue, max_qpunits, and max_qpformat paramters.
+
+.ih
+SEE ALSO
+cqnqpars, cqgqpar, cqsqpar, cqsqparn
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgrecord.hlp b/pkg/xtools/catquery/doc/cqgrecord.hlp
new file mode 100644
index 00000000..732f43f5
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgrecord.hlp
@@ -0,0 +1,46 @@
+.help cqgrecord Mar00 "Catquery Package"
+.ih
+NAME
+cqgrecord -- get a record from the catalog results
+.ih
+SYNOPSIS
+
+stat = cq_grecord (res, buf, maxch, recno)
+
+.nf
+pointer	res		# the results descriptor
+char	buf		# the output buffer
+int	maxch		# the maximum size of the output buffer
+int	recno		# the record to be fetched
+.fi
+.ih
+ARGUMENTS
+.ls res    
+The results descriptor.
+.le
+.ls buf
+The buffer containing the returned record.
+.le
+.ls maxch
+The maximum size of the output buffer.
+.le
+.ls recptr
+The sequence number of the record to be fetched. Recptr should be set to
+to initialize sequential reading of all the catalog results.
+.le
+.ih
+DESCRIPTION
+Cq_grecord returns the requested record. Cq_grecord is an integer function
+which returns BOF, the number of characters in the record, or EOF as
+its function value.
+.ih
+NOTES
+In most cases allocating a buffer size that is SZ_LINE chars long
+will be adequate to hold the output record. If the integer results parameter
+CQRECSIZE is defined, i.e. non-zero, then an output buffer  CQRECSIZE chars
+long can be allocated.
+
+.ih
+SEE ALSO
+cqgnrecord
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgvalc.hlp b/pkg/xtools/catquery/doc/cqgvalc.hlp
new file mode 100644
index 00000000..a6313556
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgvalc.hlp
@@ -0,0 +1,42 @@
+.help cqgvalc Mar00 "Catquery Package"
+.ih
+NAME
+cqgvalc -- get a catalog results field as a string value
+.ih
+SYNOPSIS
+nchars = cq_gvalc (res, recno, fname, str, maxch)
+
+.nf
+pointer	res		# the results descriptor
+int	recno		# the record number
+char	fname		# the field name
+char	str		# the returned string value
+int	maxch		# the maximum size of the returned string value
+.fi
+.ih
+ARGUMENTS
+.ls res     
+The results descriptor.
+.le
+.ls recno
+The record number.
+.le
+.ls fname
+The field name.
+.le
+.ls str
+Array containing returned string value.
+.le
+.ls maxch
+The maximum size in characters of the returned string value.
+.le
+.ih
+DESCRIPTION
+Cq_gvalc returns the requested field value as a string. Cq_gvalc is an
+integer function which returns the number of decoded characters as its
+function value. Zero is returned if the field could not be decoded.
+
+.ih
+SEE ALSO
+cqgval[silrd]
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgvald.hlp b/pkg/xtools/catquery/doc/cqgvald.hlp
new file mode 100644
index 00000000..245371cb
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgvald.hlp
@@ -0,0 +1,40 @@
+.help cqgvald Mar00 "Catquery Package"
+.ih
+NAME
+cqgvald -- get a catalog results field as a double precision value
+.ih
+SYNOPSIS
+
+nchars = cq_gvald (res, recno, fname, dval)
+
+.nf
+pointer	res		# the results descriptor
+int	recno		# the record number
+char	fname		# the field name
+double	dval		# the returned field value
+.fi
+.ih
+ARGUMENTS
+.ls res     
+The results descriptor.
+.le
+.ls recno
+The record number.
+.le
+.ls fname
+The field name.
+.le
+.ls dval
+The returned double precision value.
+.le
+.ih
+DESCRIPTION
+Cq_gvald returns the requested field as a double precision value.
+Cq_gvald is an integer function which returns the number of characters
+that were successfully decoded as its function value. Zero is returned
+if the requested field could not be decoded.
+
+.ih
+SEE ALSO
+cqgval[csilr]
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgvali.hlp b/pkg/xtools/catquery/doc/cqgvali.hlp
new file mode 100644
index 00000000..8d5d3606
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgvali.hlp
@@ -0,0 +1,40 @@
+.help cqgvali Mar00 "Catquery Package"
+.ih
+NAME
+cqgvali -- get a catalog results field as an integer
+.ih
+SYNOPSIS
+
+nchars = cq_gvali (res, recno, fname, ival)
+
+.nf
+pointer	res		# the results descriptor
+int	recno		# the record number
+char	fname		# the field name
+int	ival		# the returned field value
+.fi
+.ih
+ARGUMENTS
+.ls res     
+The results descriptor.
+.le
+.ls recno
+The record number.
+.le
+.ls fname
+The field name.
+.le
+.ls ival
+The returned integer value.
+.le
+.ih
+DESCRIPTION
+Cq_gvali returns the requested field as an integer value.
+Cq_gvali is an integer function which returns the number of characters
+that were successfully decoded as its function value. Zero is returned
+if the requested field could not be decoded.
+
+.ih
+SEE ALSO
+cqgval[cslrd]
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgvall.hlp b/pkg/xtools/catquery/doc/cqgvall.hlp
new file mode 100644
index 00000000..0571850f
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgvall.hlp
@@ -0,0 +1,40 @@
+.help cqgvall Mar00 "Catquery Package"
+.ih
+NAME
+cqgvall -- get the catalog results field as a long integer value
+.ih
+SYNOPSIS
+
+nchars = cq_gvall (res, recno, fname, lval)
+
+.nf
+pointer	res		# the results descriptor
+int	recno		# the record number
+char	fname		# the field name
+long	lval		# the returned field value
+.fi
+.ih
+ARGUMENTS
+.ls res     
+The results descriptor.
+.le
+.ls recno
+The record number.
+.le
+.ls fname
+The field name.
+.le
+.ls lval
+The returned long integer value.
+.le
+.ih
+DESCRIPTION
+Cq_gvall returns the requested field as a long integer value.
+Cq_gvall is an integer function which returns the number of characters
+that were successfully decoded as its function value. Zero is returned
+if the requested field could not be decoded.
+
+.ih
+SEE ALSO
+cqgval[csird]
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgvalr.hlp b/pkg/xtools/catquery/doc/cqgvalr.hlp
new file mode 100644
index 00000000..f7229841
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgvalr.hlp
@@ -0,0 +1,40 @@
+.help cqgvalr Mar00 "Catquery Package"
+.ih
+NAME
+cqgvalr -- get the catalog results field as a real value
+.ih
+SYNOPSIS
+
+nchars = cq_gvalr (res, recno, fname, rval)
+
+.nf
+pointer	res		# the results descriptor
+int	recno		# the record number
+char	fname		# the field name
+real	rval		# the returned field value
+.fi
+.ih
+ARGUMENTS
+.ls res     
+The results descriptor.
+.le
+.ls recno
+The record number.
+.le
+.ls fname
+The field name.
+.le
+.ls rval
+The returned real value.
+.le
+.ih
+DESCRIPTION
+Cq_gvalr returns the requested field as a real value.
+Cq_gvalr is an integer function which returns the number of characters
+that were successfully decoded as its function value. Zero is returned
+if the requested field could not be decoded.
+
+.ih
+SEE ALSO
+cqgval[csild]
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqgvals.hlp b/pkg/xtools/catquery/doc/cqgvals.hlp
new file mode 100644
index 00000000..90f39544
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqgvals.hlp
@@ -0,0 +1,41 @@
+.help cqgvals Mar00 "Catquery Package"
+.ih
+NAME
+cqgvals -- get the catalog results field as a short integer
+.ih
+SYNOPSIS
+include <cq.h>
+
+nchars = cq_gvals (res, recno, fname, sval)
+
+.nf
+pointer	res		# the results descriptor
+int	recno		# the record number
+char	fname		# the field name
+short	sval		# the returned field value
+.fi
+.ih
+ARGUMENTS
+.ls res     
+The results descriptor.
+.le
+.ls recno
+The record number.
+.le
+.ls fname
+The field name.
+.le
+.ls sval
+The returned short integer value.
+.le
+.ih
+DESCRIPTION
+Cq_gvals returns the requested field as a short integer value.
+Cq_gvals is an integer function which returns the number of characters
+that were successfully decoded as its function value. Zero is returned
+if the requested field could not be decoded.
+
+.ih
+SEE ALSO
+cqgval[cilrd]
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqhinfo.hlp b/pkg/xtools/catquery/doc/cqhinfo.hlp
new file mode 100644
index 00000000..62db280c
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqhinfo.hlp
@@ -0,0 +1,39 @@
+.help cqhinfo Mar00 "Catquery Package"
+.ih
+NAME
+cqhinfo -- get catalog results header parameter value by name
+.ih
+SYNOPSIS
+
+hparno = cq_hinfo (res, hname, hvalue, max_hvalue)
+
+.nf
+pointer	res		# the results descriptor
+char	hname		# the results header parameter name
+char	hvalue		# the returned header parameter value
+int	max_hvalue	# the maximum size of the header parameter value
+.fi
+.ih
+ARGUMENTS
+.ls  res    
+The results descriptor.
+.le
+.ls hname
+The name of the results header parameter for which the value is to be returned.
+.le
+.ls hvalue
+The returned results header parameter value.
+.le
+.ls max_hvalue
+The maximum size of the returned results header parameter value.
+.le
+.ih
+DESCRIPTION
+Cq_hinfo returns the value of the requested header parameter. Cq_hinfo is
+an integer function which returns the header parameter sequence number
+as its function value.  Zero is returned if the header parameter
+cannot be found.
+.ih
+SEE ALSO
+cqhinfon
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqhinfon.hlp b/pkg/xtools/catquery/doc/cqhinfon.hlp
new file mode 100644
index 00000000..2654ce50
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqhinfon.hlp
@@ -0,0 +1,47 @@
+.help cqhinfon Mar00 "Catquery Package"
+.ih
+NAME
+cqhinfon -- get a catalog results header parameter value by number
+.ih
+SYNOPSIS
+
+hparno = cq_hinfon (res, hparno, hname, max_hname, hvalue, max_hvalue)
+
+.nf
+pointer	res		# the results descriptor
+int	hparno		# the results header parameter sequence number
+char	hname		# the returned results header parameter name
+int	max_hname	# the maximum size of the header parameter name
+char	hvalue		# the returned header parameter value
+int	max_hvalue	# the maximum size of the header parameter value
+.fi
+.ih
+ARGUMENTS
+.ls  res    
+The results descriptor.
+.le
+.ls hparno
+The requested results header parameter sequence number.
+.le
+.ls hname
+The returned name of the results header parameter.
+.le
+.ls max_hname
+The maximum size of the results header parameter name.
+.le
+.ls hvalue
+The returned results header parameter value.
+.le
+.ls max_hvalue
+The maximum size of the results header parameter value.
+.le
+.ih
+DESCRIPTION
+Cq_hinfon returns the name and value of the requested results header
+parameter. Cq_hinfon is an integer function which returns the
+sequence number of the requested parameter as its function value.
+Zero is returned if the results header parameter is not found.
+.ih
+SEE ALSO
+cqhinfo
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqimclose.hlp b/pkg/xtools/catquery/doc/cqimclose.hlp
new file mode 100644
index 00000000..4c3d105b
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqimclose.hlp
@@ -0,0 +1,24 @@
+.help cqimclose Mar00 "Catquery Package"
+.ih
+NAME
+cqimclose -- free the survey results descriptor
+.ih
+SYNOPSIS
+
+call cq_imclose (imres)
+
+.nf
+pointer	imres		# the results descriptor
+.fi
+.ih
+ARGUMENTS
+.ls imres    
+The survey results descriptor.
+.le
+.ih
+DESCRIPTION
+Cq_imclose frees the survey results descriptor.
+.ih
+SEE ALSO
+cqimquery, cqfimquery
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqimquery.hlp b/pkg/xtools/catquery/doc/cqimquery.hlp
new file mode 100644
index 00000000..12e71506
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqimquery.hlp
@@ -0,0 +1,44 @@
+.help cqimquery Mar00 "Catquery Package"
+.ih
+NAME
+cqimquery -- query the image survey and return the results
+.ih
+SYNOPSIS
+
+imres = cq_imquery (cq, imname)
+
+.nf
+pointer	cq		# the configuration file descriptor
+pointer	imname		# the name of the output image file
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls imname
+The name of the output image file. At the output image produced by an
+image survey query must be a single FITS image. The image name
+should include the suffix ".fits" in order to make the image
+visible to IRAF image i/o.
+.le
+.ih
+DESCRIPTION
+Cq_imquery queries the image survey, creates an output image file, and
+returns the survey results descriptor. Cq_imquery is a pointer function
+which returns the survey results descriptor as its function value.
+Null is returned if an error occurs in the survey query.
+.ih
+NOTES
+Cq_setcat or cq_setcatn must be called before any catalog or image
+survey query can be made.
+
+Cq_nqpars and either cq_gqpar or cq_gqparn must be called to determine
+the number of query parameters and get each query parameter description.
+
+Cq_sqpar or cq_sqparn must be called to replace the default query parameter
+values with the calling program values.
+.ih
+SEE ALSO
+cqfimquery, cqimclose
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqistati.hlp b/pkg/xtools/catquery/doc/cqistati.hlp
new file mode 100644
index 00000000..beeec2c9
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqistati.hlp
@@ -0,0 +1,49 @@
+.help cqistati Mar00 "Catquery Package"
+.ih
+NAME
+cqistati -- get an image survey results integer parameter
+.ih
+SYNOPSIS
+include <cq.h>
+
+ival = cq_istati (imres, parameter)
+
+.nf
+pointer	imres		# the survey results descriptor
+int	parameter	# the parameter to be returned
+.fi
+.ih
+ARGUMENTS
+.ls imres    
+The survey results descriptor.
+.le
+.ls parameter
+The survey parameter to be returned.  The currently supported survey
+parameters defined in cq.h are:
+.nf
+CQINQPARS	# the number of query params used to produce results
+CQIMTYPE	# the image results type, CQFITS
+CQIMRECSIZE	# the image record size, 0 if undefined 
+CQIMHSKIP	# the number of leading bytes to skip, 0 if undefined
+CQIMHREAD	# the number of leading dummy reads, 0 if undefined
+CQWCS		# the image wcs status, CQ_WFITS or CQ_WDSS or CQ_WNONE
+CQNWCS		# the number of wcs parameters, 0 if none defined
+CQNIMPARS	# the number of image parameters, 0 if none defined
+.fi
+.le
+.ih
+DESCRIPTION
+Cq_istati returns the values of image survey results integer parameters.
+Cq_istati is an integer function which returns the value of the requested
+parameter as its function value.
+
+.ih
+NOTES
+More information about the image survey results parameters and their
+relationship to the parent image survey is available by typing
+"help surveys".
+
+.ih
+SEE ALSO
+cq_istats, cq_istatt
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqistats.hlp b/pkg/xtools/catquery/doc/cqistats.hlp
new file mode 100644
index 00000000..700717f0
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqistats.hlp
@@ -0,0 +1,56 @@
+.help cqistats Mar00 "Catquery Package"
+.ih
+NAME
+cqistats -- get an image survey results string parameter
+.ih
+SYNOPSIS
+include <cq.h>
+
+call cq_istats (imres, parameter, str, maxch)
+
+.nf
+pointer	imres		# the image survey results descriptor
+int	parameter	# the parameter to be returned
+char	str		# the returned string parameter value
+int	maxch		# the maximum size of the string parameter
+.fi
+.ih
+ARGUMENTS
+.ls res     
+The image survey results descriptor.
+.le
+.ls parameter
+The image survey results parameter to be returned. The currently supported
+image survey parameters defined in cq.h are:
+
+.nf
+CQIMCATDB	# the name of the parent configuration file
+CQIMCATNAME	# the name of the parent image survey
+CQIMADDRESS	# the network address used to produce the results
+CQIMQUERY	# the query used to produce the results
+CQIMNAME	# the output image name
+CQIQPNAMES	# the results query parameter dictionary
+CQIQPVALUES	# the results query parameter values dictionary
+CQIQPUNITS	# the results query parameter units dictionary
+.fi
+.le
+.ls str
+Array containing returned string parameter value.
+.le
+.ls maxch
+The maximum size in characters of the returned string value.
+.le
+.ih
+DESCRIPTION
+Cq_istats returns the values of image survey results string parameters.
+
+.ih
+NOTES
+More information about the image survey results parameters and their
+relationship to the parent image survey is available by typing
+"help surveys".
+
+.ih
+SEE ALSO
+cq_istati, cq_istatt
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqistatt.hlp b/pkg/xtools/catquery/doc/cqistatt.hlp
new file mode 100644
index 00000000..0af9fb4a
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqistatt.hlp
@@ -0,0 +1,55 @@
+.help cqistatt Mar00 "Catquery Package"
+.ih
+NAME
+cqistatt -- get an image survey results text parameter
+.ih
+SYNOPSIS
+include <cq.h>
+
+nlines = cq_istatt (imres, parameter, text, maxch)
+
+.nf
+pointer	imres		# the survey results descriptor
+int	parameter	# the parameter to be returned
+char	text		# the returned text parameter value
+int	maxch		# the maximum size of the returned text parameter
+.fi
+.ih
+ARGUMENTS
+.ls imres    
+The results descriptor.
+.le
+.ls parameter
+The image survey parameter to be returned. The currently supported text
+image survey results text parameters defined in cq.h are:
+.nf
+CQIQPNAMES	# the list of survey results query parameter names
+CQIQPVALUES	# the list of survey results query parameter values
+CQIQPUNITS	# the list of survey results query parameter units
+.fi
+.le
+.ls text
+String containing returned text parameter value. Text parameters differ
+from string parameters only in that they contain embedded newline
+characters.
+.le
+.ls maxch
+The maximum size in characters of the returned text value.
+.le
+.ih
+DESCRIPTION
+Cq_istatt returns the values of catalog results string parameters.
+
+The buffer size for the returned text parameters can be estimated by getting
+the value of the integer parameter CQRNQPARS, and multiplying it by the maximum
+buffer sizes CQ_SZ_QPNAME, CQ_SZ_QPVALUE, CQ_SZ_QPUNITS respectively.
+
+.ih
+NOTES
+More information about the survey results parameters and their relationship
+to the parent image survey is available by typing "help surveys".
+
+.ih
+SEE ALSO
+cq_istati, cq_istats
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqkinfo.hlp b/pkg/xtools/catquery/doc/cqkinfo.hlp
new file mode 100644
index 00000000..30d869a8
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqkinfo.hlp
@@ -0,0 +1,65 @@
+.help cqkinfo Mar00 "Catquery Package"
+.ih
+NAME
+cqkinfo -- get the results standard image parameter description by name
+.ih
+SYNOPSIS
+
+ipno = cq_kinfo (imres, pname, pkname, max_pkname, pkvalue, max_pkvalue,
+	pktype, pkunits, max_pkunits)
+
+.nf
+pointer	imres		# the survey results descriptor
+char	pname		# the image parameter name
+char	pkname		# the default image keyword name (INDEF if undefined)
+int	max_pkname	# the maximum size of the keyword name
+char	pkvalue		# the default parameter value (INDEF if undefined)
+int	max_pkvalue	# the maximum size of the parameter value
+int	pktype		# the parameter data type
+char	pkunits		# the parameter units (INDEF if undefined)
+int	max_wpunits	# the maximum size of the parameter units
+.fi
+.ih
+ARGUMENTS
+.ls imres    
+The image results descriptor.
+.le
+.ls pname
+The name of the image parameter for which the description is to be returned.
+.le
+.ls pkname
+The returned image parameter keyword name. Pkname is "INDEF" if undefined. 
+.le
+.ls max_pkname
+The maximum size of the returned image parameter keyword name.
+.le
+.ls pkvalue
+The returned image parameter value. Pkvalue is "INDEF" if undefined.
+.le
+.ls max_pkvalue
+The maximum size of the returned image parameter value.
+.le
+.ls pktype
+The image parameter data type. The options are TY_DOUBLE, TY_REAL, TY_LONG,
+TY_INT, TY_SHORT, and TY_CHAR.
+.le
+.ls pkunits
+The returned image parameter units. Pkunits is "INDEF" if undefined.
+.le
+.ls max_pkunits
+The maximum size of the returned image parameter units.
+.le
+.ih
+DESCRIPTION
+Cq_kinfo returns the keyword name, default value, data type, and units
+of the requested standard image parameter. Cq_kinfo is an integer function
+which returns the sequence number of the standard image parameter as its
+function value. Zero is returned if the standard image parameter is not found.
+.ih
+NOTES
+For more information about the standard image parameters and their relationship
+to the image surveys configuration file type "help surveys".
+.ih
+SEE ALSO
+cqkinfon
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqkinfon.hlp b/pkg/xtools/catquery/doc/cqkinfon.hlp
new file mode 100644
index 00000000..e57f0d47
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqkinfon.hlp
@@ -0,0 +1,73 @@
+.help cqkinfon Mar00 "Catquery Package"
+.ih
+NAME
+cqkinfon -- get the results standard image parameter description by number
+.ih
+SYNOPSIS
+
+ipno = cq_kinfo (imres, ipno, pname, max_pname, pkname, max_pkname, pkvalue,
+	max_pkvalue, pktype, pkunits, max_pkunits)
+
+.nf
+pointer	imres		# the survey results descriptor
+int	ipno		# the image parameter sequence number
+char	pname		# the image parameter name
+int	max_pname	# the maximum size of the parameter name
+char	pkname		# the default image keyword name (INDEF if undefined)
+int	max_pkname	# the maximum size of the keyword name
+char	pkvalue		# the default parameter value (INDEF if undefined)
+int	max_pkvalue	# the maximum size of the parameter value
+int	pktype		# the parameter data type
+char	pkunits		# the parameter units (INDEF if undefined)
+int	max_wpunits	# the maximum size of the parameter units
+.fi
+.ih
+ARGUMENTS
+.ls imres    
+The image results descriptor.
+.le
+.ls ipno
+The sequence number of the requested parameter.
+.le
+.ls pname
+The returned image parameter name.
+.le
+.ls max_pname
+The maximum size of the returned parameter name.
+.le
+.ls pkname
+The returned image parameter keyword name. Pkname is "INDEF" if undefined. 
+.le
+.ls max_pkname
+The maximum size of the returned image parameter keyword name.
+.le
+.ls pkvalue
+The returned image parameter value. Pkvalue is "INDEF" if undefined.
+.le
+.ls max_pkvalue
+The maximum size of the returned image parameter value.
+.le
+.ls pktype
+The image parameter data type. The options are TY_DOUBLE, TY_REAL, TY_LONG,
+TY_INT, TY_SHORT, and TY_CHAR.
+.le
+.ls pkunits
+The returned image parameter units. Pkunits is "INDEF" if undefined.
+.le
+.ls max_pkunits
+The maximum size of the returned image parameter units.
+.le
+.ih
+DESCRIPTION
+Cq_kinfon returns the keyword name, default value, data type, and units
+of the requested standard image parameter. Cq_kinfon is an integer function
+which returns the sequence number of the standard image parameter as its
+function value. Zero is returned if the standard image parameter is not found.
+.ih
+NOTES
+For more information about the standard image parameters and their relationship
+to the image surveys configuration file type "help surveys".
+.ih
+SEE ALSO
+cqkinfo
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqlocate.hlp b/pkg/xtools/catquery/doc/cqlocate.hlp
new file mode 100644
index 00000000..12f7cbc0
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqlocate.hlp
@@ -0,0 +1,35 @@
+.help cqlocate Mar00 "Catquery Package"
+.ih
+NAME
+cqlocate -- locate a catalog / survey record by name
+.ih
+SYNOPSIS
+
+catno = cq_locate (cq, catname)
+
+.nf
+pointer	cq		# the configuration file descriptor
+char	catname		# the name of the catalog / survey record to be located
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls catname
+The name of the catalog / survey  record to be located.
+.le
+.ih
+DESCRIPTION
+Cq_locate locates a catalog / survey record in the configuration file by
+name. Cq_locate is an integer function which returns the catalog / survey
+record sequence number as its function value. Zero is returned if the catalog
+record is not located.
+.ih
+Cq_locate is used to determine whether the requested record exists. It does
+not set the current catalog / survey. This must be done with a call to
+cq_setcat or cq_setcatn.
+.ih
+SEE ALSO
+cqlocaten, cqsetcat, cqsetcatn
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqlocaten.hlp b/pkg/xtools/catquery/doc/cqlocaten.hlp
new file mode 100644
index 00000000..ca7011b0
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqlocaten.hlp
@@ -0,0 +1,47 @@
+.help cqlocaten Mar00 "Catquery Package"
+.ih
+NAME
+cqlocaten -- locate a catalog / survey record by number
+.ih
+SYNOPSIS
+
+catno = cq_locaten (cq, catno, catname, maxch)
+
+.nf
+pointer	cq		# the configuration file descriptor
+int catno		# the number of the catalog / survey to be located
+char	catname		# the name of the located catalog
+int	maxch		# the maximum size of the name of the located catalog
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls catno
+The sequence number of the catalog / survey record to be located.
+.le
+.ls catname
+The name of the located catalog.
+.le
+.ls maxch
+The maximum size of the name of the located catalog.
+.le
+.ih
+DESCRIPTION
+Cq_locaten locates a catalog / survey record in the configuration file by
+sequence number. Cq_locaten is an integer function which returns the catalog
+/ survey record sequence number as its function value. Zero is returned
+if the catalog record is not located. Cq_locaten also returns the name of the
+located catalog in the array catname.
+
+.ih
+NOTES
+Cq_locaten is used to determine whether the requested record exists. It does
+not set the current catalog / survey. This must be done with a call to
+cq_setcat or cq_setcatn.
+
+.ih
+SEE ALSO
+cqlocate, cqsetcat, cqsetcatn
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqmap.hlp b/pkg/xtools/catquery/doc/cqmap.hlp
new file mode 100644
index 00000000..1c87530d
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqmap.hlp
@@ -0,0 +1,33 @@
+.help cqmap Mar00 "Catquery Package"
+.ih
+NAME
+cq_map -- map the catalog / survey configuration file
+.ih
+SYNOPSIS
+cq = cq_map (file, mode)
+
+.nf
+char		file		# the catalog / survey configuration file
+int		mode		# the file access mode 
+.fi
+.ih
+ARGUMENTS
+.ls file
+The name of the catalog / survey configuration file.
+.le
+.ls mode
+The configuration file access mode. At present only READ_ONLY is supported.
+.le
+.ih
+DESCRIPTION
+Cq_map maps the record structure of the catalog / survey configuration file.
+Cq_map is a pointer function which returns the configuration file descriptor
+to the calling program.
+.ih
+NOTES
+Cq_map returns a NULL configuration file descriptor if an error occurs in
+the mapping process.
+.ih
+SEE ALSO
+cqunmap
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqnqpars.hlp b/pkg/xtools/catquery/doc/cqnqpars.hlp
new file mode 100644
index 00000000..63ac4ca8
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqnqpars.hlp
@@ -0,0 +1,32 @@
+.help cqnqpars Mar00 "Catquery Package"
+.ih
+NAME
+cqnqpars -- Get the number of query parameters
+.ih
+SYNOPSIS
+
+nqpars = cq_nqpars (cq)
+
+.nf
+pointer	cq		# the configuration file descriptor
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ih
+DESCRIPTION
+Cq_nqpars returns the number of expected catalog / survey query parameters.
+Cq_nqpars is an integer function which returns the number of expected
+catalog / survey parameters as its function value. The number of query
+parameters may be zero if the query is non-programmable. Not all query
+parameters are programmable.
+.ih
+NOTES
+The routines cq_setcat or cq_setcatn must be called before the number of
+query parameters can be requested.
+.ih
+SEE ALSO
+cqgqpar, cqgqparn, cqsqpar, cqsqparn
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqquery.hlp b/pkg/xtools/catquery/doc/cqquery.hlp
new file mode 100644
index 00000000..797cd72c
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqquery.hlp
@@ -0,0 +1,35 @@
+.help cqquery Mar00 "Catquery Package"
+.ih
+NAME
+cqquery -- query a catalog and return the results
+.ih
+SYNOPSIS
+
+res = cq_query (cq)
+
+.nf
+pointer	cq		# the configuration file descriptor
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ih
+DESCRIPTION
+Cq_query is a pointer function which returns the catalog results descriptor
+as its function value. NULL is returned if an error occurs in the catalog
+query.
+.ih
+NOTES
+Cq_setcat or cq_setcatn must be called before any catalog query can be made.
+
+Cq_nqpars and either cq_gqpar or cq_gqparn must be called to determine the
+number of query parameters and get each query parameter description.
+
+Cq_sqpar or cq_sqparn must be called to replace the default query parameter
+values with the calling program values.
+.ih
+SEE ALSO
+cqfquery, cqrclose
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqrclose.hlp b/pkg/xtools/catquery/doc/cqrclose.hlp
new file mode 100644
index 00000000..98dfb4b5
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqrclose.hlp
@@ -0,0 +1,24 @@
+.help cqrclose Mar00 "Catquery Package"
+.ih
+NAME
+cqrclose -- free the catalog results descriptor
+.ih
+SYNOPSIS
+
+call cq_rclose (res)
+
+.nf
+pointer	res		# the results descriptor
+.fi
+.ih
+ARGUMENTS
+.ls res    
+The results descriptor.
+.le
+.ih
+DESCRIPTION
+Cq_rclose frees the results descriptor.
+.ih
+SEE ALSO
+cqquery, cqfquery
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqrstati.hlp b/pkg/xtools/catquery/doc/cqrstati.hlp
new file mode 100644
index 00000000..943a5218
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqrstati.hlp
@@ -0,0 +1,53 @@
+.help cqrstati Mar00 "Catquery Package"
+.ih
+NAME
+cqrstati -- get a catalog results integer parameter
+.ih
+SYNOPSIS
+include <cq.h>
+
+ival = cq_rstati (res, parameter)
+
+.nf
+pointer	res		# the results descriptor
+int	parameter	# the parameter to be returned
+.fi
+.ih
+ARGUMENTS
+.ls res    
+The results descriptor.
+.le
+.ls parameter
+The catalog results parameter to be returned. The currently supported
+catalog results parameters defined in cq.h are:
+.nf
+CQRNQPARS	# the number of query params used to produce results
+CQRTYPE		# the data type of the results, CQSTEXT or CQBTEXT
+CQRNRECS	# the number of records in the results
+CQRECSIZE	# the record size, 0 if undefined
+CQRHSKIP	# the number of header records to skip, 0 if undefined
+CQRTSKIP	# the number of trailer records to skip, 0 if undefined
+CQRTRIML	# the number of leading chars to skip, 0 if undefined
+CQRTRIMR	# the number of trailing chars to skip, 0 if undefined
+CQNHEADER	# the number of header keyword value pairs, 0 if none defined
+CQNFIELDS	# the number of fields in a record
+CQRECPTR	# the current record number, BOF or number or EOF
+.fi
+.le
+.ih
+DESCRIPTION
+
+Cq_rstati returns the values of catalog results integer parameters.
+Cq_rstati is an integer function which returns the value of the requested
+parameter as its function value.
+
+.ih
+NOTES
+
+More information about the catalog results parameters and their relationship
+to the parent catalog is available by typing "help catalogs".
+
+.ih
+SEE ALSO
+cqrstats, cqrstatt
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqrstats.hlp b/pkg/xtools/catquery/doc/cqrstats.hlp
new file mode 100644
index 00000000..45487dfd
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqrstats.hlp
@@ -0,0 +1,54 @@
+.help cqrstats Mar00 "Catquery Package"
+.ih
+NAME
+cqsrtats -- get a catalog results string parameter
+.ih
+SYNOPSIS
+include <cq.h>
+
+call cq_rstats (res, parameter, str, maxch)
+
+.nf
+pointer	res		# the results descriptor
+int	parameter	# the parameter to be returned
+char	str		# the returned string parameter
+int	maxch		# the maximum size of the returned string parameter
+.fi
+.ih
+ARGUMENTS
+.ls res     
+The results descriptor.
+.le
+.ls parameter
+The catalog results parameter to be returned.  The currently supported
+catalog results parameters defined in cq.h are:
+
+.nf
+CQRCATDB	# the name of the parent configuration file
+CQRCATNAME	# the name of the parent catalog
+CQRADDRESS	# the network address used to produce the results
+CQRQUERY	# the network query used to produce the results
+CQRQPNAMES	# the results query parameter dictionary
+CQRQPVALUES	# the results query parameter values dictionary
+CQRQPUNITS	# the results query parameter units dictionary
+.fi
+.le
+.ls str
+Array containing returned string parameter value.
+.le
+.ls maxch
+The maximum size in characters of the returned string parameter value.
+.le
+.ih
+DESCRIPTION
+Cq_rstats returns the values of catalog results string parameters.
+
+.ih
+NOTES
+More information about the catalog results parameters and their relationship
+to the parent catalog is available by typing "help catalogs".
+
+.ih
+SEE ALSO
+cqrstati, cqrstatt
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqrstatt.hlp b/pkg/xtools/catquery/doc/cqrstatt.hlp
new file mode 100644
index 00000000..cbb13c44
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqrstatt.hlp
@@ -0,0 +1,56 @@
+.help cqrstatt Mar00 "Catquery Package"
+.ih
+NAME
+cqrstatt -- get a catalog results text parameter
+.ih
+SYNOPSIS
+include <cq.h>
+
+nlines = cq_rstatt (res, parameter, text, maxch)
+
+.nf
+pointer	res		# the results descriptor
+int	parameter	# the parameter to be returned
+char	text		# the returned text parameter value
+int	maxch		# the maximum size of the returned text parameter
+.fi
+.ih
+ARGUMENTS
+.ls res    
+The results descriptor.
+.le
+.ls parameter
+The catalog results parameter to be returned.  The currently supported
+catalog results text parameters defined in cq.h are:
+
+.nf
+CQRQPNAMES	# the list of catalog results query parameter names
+CQRQPVALUES	# the list of catalog results query parameter values
+CQRQPUNITS	# the list of catalog results query parameter units
+.fi
+.le
+.ls text
+String containing returned text parameter value. Text parameters differ
+from string parameters only in that they contain embedded newline
+characters.
+.le
+.ls maxch
+The maximum size in characters of the returned text value.
+.le
+.ih
+DESCRIPTION
+Cq_rstatt returns the values of catalog results string parameters.
+
+The buffer size for the returned text parameters can be estimated by getting
+the value of the integer parameter CQRNQPARS, and multiplying it by the maximum
+ buffer sizes CQ_SZ_QPNAME, CQ_SZ_QPVALUE, CQ_SZ_QPUNITS respectively.
+
+.ih
+NOTES
+More information about the catalog results parameters and their relationship
+to the parent catalog is available by typing "help catalogs".
+
+.ih
+SEE ALSO
+cq_rstati, cq_rstats
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqsetcat.hlp b/pkg/xtools/catquery/doc/cqsetcat.hlp
new file mode 100644
index 00000000..1a6a4f62
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqsetcat.hlp
@@ -0,0 +1,35 @@
+.help cqsetcat Mar00 "Catquery Package"
+.ih
+NAME
+cqsetcat -- set the current catalog / survey by name
+.ih
+SYNOPSIS
+
+catno = cq_setcat (cq, catname)
+
+.nf
+pointer	cq		# the configuration file descriptor
+char	catname		# the name of the catalog to be set
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls catname
+The name of the catalog / survey to be set.
+.le
+.ih
+DESCRIPTION
+Cq_setcat sets the current catalog. Cq_setcat is an integer function
+which returns the sequence number of the requested catalog / survey as
+its function value. Zero is returned if the requested catalog / survey
+cannot be set.
+.ih
+NOTES
+Cq_setcat or cq_setcatn must be called before any catalog or survey query can
+be made.
+.ih
+SEE ALSO
+cqlocate, cqlocaten, cqsetcatn
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqsetcatn.hlp b/pkg/xtools/catquery/doc/cqsetcatn.hlp
new file mode 100644
index 00000000..dac93a00
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqsetcatn.hlp
@@ -0,0 +1,35 @@
+.help cqsetcatn Mar00 "Catquery Package"
+.ih
+NAME
+cqsetcatn -- set the current catalog / survey  by number
+.ih
+SYNOPSIS
+
+catno = cq_setcatn (cq, catno)
+
+.nf
+pointer	cq		# the configuration file descriptor
+int	catno		# the sequence number of the catalog / survey to be set
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls catno
+The sequence number of the catalog / survey to be set.
+.le
+.ih
+DESCRIPTION
+Cq_setcatn sets the current catalog / survey by number. Cq_setcatn is an
+integer function which returns the catalog / survey
+record sequence number as its function value. Zero is returned if the catalog
+record is not set.
+.ih
+NOTES
+Cq_setcat or cq_setcatn must be called before any catalog or image
+survey query can be made.
+.ih
+SEE ALSO
+cqlocate, cqlocaten, cqsetcat
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqsqpar.hlp b/pkg/xtools/catquery/doc/cqsqpar.hlp
new file mode 100644
index 00000000..57a86255
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqsqpar.hlp
@@ -0,0 +1,39 @@
+.help cqsqpar Mar00 "Catquery Package"
+.ih
+NAME
+cqsqpar -- set the value of a query parameter by name
+.ih
+SYNOPSIS
+
+parno = cq_sqpar (cq, pname, value)
+
+.nf
+pointer	cq		# the configuration file descriptor
+char	pname		# the query parameter name
+char	value		# the query parameter value
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls pname
+The name of the query parameter to be set.
+.le
+.ls value
+The new query parameter value.
+.le
+.ih
+DESCRIPTION
+Cq_sqpar sets the value of the named query parameter. Qq_sqpar is an integer 
+function which returns the sequence number of the requested parameter
+as its function value.  Zero is returned if the requested query parameter
+is not found.
+.ih
+NOTES
+Cq_setcat or cq_setcatn must be called before a query parameter value
+can be changed.
+.ih
+SEE ALSO
+cqnqpars, cqgpar, cqgqparn, cqsqparn
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqsqparn.hlp b/pkg/xtools/catquery/doc/cqsqparn.hlp
new file mode 100644
index 00000000..f0cc92fc
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqsqparn.hlp
@@ -0,0 +1,39 @@
+.help cqsqparn Mar00 "Catquery Package"
+.ih
+NAME
+cqsqparn -- set the value of a query parameter by number
+.ih
+SYNOPSIS
+
+parno = cq_sqparn (cq, parno, value)
+
+.nf
+pointer	cq		# the configuration file descriptor
+int	parno		# the sequence number of the query parameter
+char	value		# the query parameter value
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls parno
+The sequence number of the query parameter to be set.
+.le
+.ls value
+The new query parameter value.
+.le
+.ih
+DESCRIPTION
+Cq_sqpar sets the value of the named query parameter. Qq_sqpar is an integer
+function which returns the sequence number of the requested parameter
+as its function value.  Zero is returned if the requested query parameter
+is not found.
+.ih
+NOTES
+Cq_setcat or cq_setcatn must be called before a query parameter value
+can be changed.
+.ih
+SEE ALSO
+cqnqpars, cqgqpar, cqgparn, cqsqpar
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqstati.hlp b/pkg/xtools/catquery/doc/cqstati.hlp
new file mode 100644
index 00000000..15fe1d9e
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqstati.hlp
@@ -0,0 +1,61 @@
+.help cqstati Mar00 "Catquery Package"
+.ih
+NAME
+cqstati -- get a catalog / survey integer parameter
+.ih
+SYNOPSIS
+include <cq.h>
+
+ival = cq_stati (cq, parameter)
+
+.nf
+pointer	cq		# the configuration file descriptor
+int	parameter	# the parameter to be returned
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration file descriptor.
+.le
+.ls parameter
+The parameter to be returned.  The currently supported parameters defined
+in cq.h are:
+.nf
+	CQNRECS		# the number of catalog / survey file records
+	CQSZRECLIST	# the length of the record name list in chars
+	CQCATNO		# the current catalog number
+.fi
+.le
+.ih
+DESCRIPTION
+Cq_stati returns the values of catalog / survey integer parameters.
+Cq_stati is an integer function which returns the value of the requested
+parameter as its function value.
+
+.ih
+NOTES
+The current catalog number CQCATNO is 0 if the current catalog has not been set
+by a call to cq_setcat or cq_setcatn.
+
+The length of the record list CQSZRECLIST can be used to preallocate the buffer
+required to fetch the text parameter CQRECLIST.
+
+.ih
+EXAMPLES
+.nf
+	include <cq.h>
+
+	int	cq_stati()
+
+	....
+
+	sz_buf = cq_stati (cq, CQSZRECLIST)
+	call malloc (buf, sz_buf, TY_CHAR)
+	nlines = cq_statt (cq, CQRECLIST, Memc[buf], sz_buf) 
+
+	...
+.fi
+.ih
+SEE ALSO
+cq_stats, cq_statt
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqstats.hlp b/pkg/xtools/catquery/doc/cqstats.hlp
new file mode 100644
index 00000000..1aabc590
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqstats.hlp
@@ -0,0 +1,48 @@
+.help cqstats Mar00 "Catquery Package"
+.ih
+NAME
+cqstats -- get a catalog / survey string parameter
+.ih
+SYNOPSIS
+include <cq.h>
+
+call cq_stats (cq, parameter, str, maxch)
+
+.nf
+pointer	cq		# the configuration file descriptor
+int	parameter	# the parameter to be returned
+char	str		# the returned string parameter value
+int	maxch		# the maximum size of the returned string parameter
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The catalog / survey configuration file descriptor.
+.le
+.ls parameter
+The parameter to be returned.  The string parameters defined
+in cq.h are:
+.nf
+	CQCATDB		# the name of the configuration file
+	CQCATNAME	# the name of the current catalog
+.fi
+.le
+.ls str
+Array containing returned string parameter.
+.le
+.ls maxch
+The maximum size of the returned string parameter.
+.le
+.ih
+DESCRIPTION
+Cq_stats returns the requested catalog / survey string parameters.
+
+.ih
+NOTES
+The current catalog name CQCATNAME is "" if the current catalog has not been
+set by a call to cq_setcat or cq_setcatn.
+
+.ih
+SEE ALSO
+cq_stati, cq_statt
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqstatt.hlp b/pkg/xtools/catquery/doc/cqstatt.hlp
new file mode 100644
index 00000000..082f5757
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqstatt.hlp
@@ -0,0 +1,45 @@
+.help cqstatt Mar00 "Catquery Package"
+.ih
+NAME
+cqstatt -- get a catalog / survey text parameter
+.ih
+SYNOPSIS
+include <cq.h>
+
+nlines = cq_statt (cq, parameter, text, maxch)
+
+.nf
+pointer	cq		# the configuration file descriptor
+int	parameter	# the parameter to be returned
+char	text		# the returned text parameter value
+int	maxch		# the maximum size of the returned text parameter
+.fi
+.ih
+ARGUMENTS
+.ls cq     
+The configuration catalog / survey file descriptor.
+.le
+.ls parameter
+The parameter to be returned.  The text parameters defined in cq.h are:
+.nf
+define	CQRECLIST	# the catalog configuration file record list
+.fi
+.le
+.ls text
+The returned text parameter value. Text parameters differ
+from string parameters only in that they may contain embedded newline
+characters.
+.le
+.ls maxch
+The maximum size in characters of the returned text.
+.le
+.ih
+DESCRIPTION
+Cq_statt returns the requested catalog / survey text parameters.
+Cq_statt is an integer function which returns the numbers of lines in the
+requested parameter value as its function value.
+
+.ih
+SEE ALSO
+cq_stati, cq_stats
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqunmap.hlp b/pkg/xtools/catquery/doc/cqunmap.hlp
new file mode 100644
index 00000000..e33128cf
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqunmap.hlp
@@ -0,0 +1,26 @@
+.help cqunmap Mar00 "Catquery Package"
+.ih
+NAME
+cq_unmap -- unmap the catalog / survey configuration file
+.ih
+SYNOPSIS
+call cq_unmap (cq)
+
+.nf
+pointer		cq		# the configuration file descriptor
+.fi
+.ih
+ARGUMENTS
+.ls cq
+The catalog / survey configuration file descriptor.
+.le
+.ih
+DESCRIPTION
+Unmap the configuration file. 
+.ih
+NOTES
+Cq_unmap should be called when catalog / survey access is terminated.
+.ih
+SEE ALSO
+cqmap
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqwinfo.hlp b/pkg/xtools/catquery/doc/cqwinfo.hlp
new file mode 100644
index 00000000..9bdc7edf
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqwinfo.hlp
@@ -0,0 +1,65 @@
+.help cqwinfo Mar00 "Catquery Package"
+.ih
+NAME
+cqwinfo -- get the results wcs parameter description by name
+.ih
+SYNOPSIS
+
+wcsno = cq_winfo (imres, wname, wkname, max_wkname, wkvalue, max_wkvalue,
+	wktype, wkunits, max_wkunits)
+
+.nf
+pointer	imres		# the survey results descriptor
+char	wname		# the wcs parameter name
+char	wkname		# the default wcs keyword name (INDEF if undefined)
+int	max_wkname	# the maximum size of the returned keyword name
+char	wkvalue		# the default wcs parameter value (INDEF if undefined)
+int	max_wkvalue	# the maximum size of the parameter value
+int	wktype		# the wcs parameter data type
+char	wkunits		# the wcs parameter units (INDEF if undefined)
+int	max_wkunits	# the maximum size of the returned wcs parameter units
+.fi
+.ih
+ARGUMENTS
+.ls imres    
+The image results descriptor.
+.le
+.ls wname
+The name of the wcs parameter for which the description is to be returned.
+.le
+.ls wkname
+The returned wcs parameter keyword name. Wkname is "INDEF" if undefined. 
+.le
+.ls max_wkname
+The maximum size of the returned wcs parameter keyword name.
+.le
+.ls wkvalue
+The returned wcs parameter value. Wkvalue is "INDEF" if undefined.
+.le
+.ls max_wkvalue
+The maximum size of the returned wcs parameter value.
+.le
+.ls wktype
+The wcs parameter data type. The options are TY_DOUBLE, TY_REAL, TY_LONG,
+TY_INT, TY_SHORT, and TY_CHAR.
+.le
+.ls wkunits
+The returned wcs parameter units. Wkunits is "INDEF" if undefined.
+.le
+.ls max_wkunits
+The maximum size of the returned wcs parameter units.
+.le
+.ih
+DESCRIPTION
+Cq_winfo returns the keyword name, default value, data type, and units
+of the requested wcs parameter. Cq_winfo is an integer function
+which returns the sequence number of the wcs parameter as its function
+value. Zero is returned if the wcs parameter is not found.
+.ih
+NOTES
+For more information about the wcs parameters and their relationship
+to the image surveys configuration file type "help surveys".
+.ih
+SEE ALSO
+cqwinfon
+.endhelp
diff --git a/pkg/xtools/catquery/doc/cqwinfon.hlp b/pkg/xtools/catquery/doc/cqwinfon.hlp
new file mode 100644
index 00000000..04fab301
--- /dev/null
+++ b/pkg/xtools/catquery/doc/cqwinfon.hlp
@@ -0,0 +1,75 @@
+.help cqwinfon Mar00 "Catquery Package"
+.ih
+NAME
+cqwinfon -- get the results wcs description by number
+.ih
+SYNOPSIS
+
+wcsno = cq_winfo (imres, wcsno, wname, max_wname, wkname, max_wkname, wkvalue,
+        max_wkvalue, wktype, wkunits, max_wkunits)
+
+.nf
+pointer	imres		# the image results descriptor
+int	wcsno		# the wcs parameter sequence number
+char	wname		# the wcs parameter name
+int	max_wname	# the maximum size of the wcs parameter name
+char	wkname		# the default wcs keyword name (INDEF if undefined)
+int	max_wkname	# the maximum size of the keyword name
+char	wkvalue		# the default wcs keyword value (INDEF if undefined)
+int	max_wkvalue	# the maximum size of the parameter value
+int	wktype		# the wcs parameter data type
+char	wkunits		# the wcs parameter units (INDEF if undefined)
+int	max_wkunits	# the maximum size of the wcs parameter units
+.fi
+.ih
+ARGUMENTS
+.ls imres    
+The image results descriptor.
+.le
+.ls wcsno
+The sequence number of the wcs parameter to be returned.
+.le
+.ls wname
+The returned wcs parameter name.
+.le
+.ls max_wname
+The maximum size of the returned wcs parameter name.
+.le
+.ls wkname
+The returned wcs parameter keyword name.
+.le
+.ls max_wkname
+The maximum size of the returned wcs parameter keyword name.
+.le
+.ls wkvalue
+The returned wcs parameter value.
+.le
+.ls max_wkvalue
+The maximum size of the returned wcs parameter value.
+.le
+.ls wktype
+The returned wcs parameter type. The options are TY_DOUBLE, TY_REAL, TY_LONG,
+TY_INT, TY_SHORT, and TY_CHAR.
+.le
+.ls wkunits
+The returned wcs parameter units.
+.le
+.ls max_wkunits
+The maximum size of the returned wcs parameter units.
+.le
+.ih
+DESCRIPTION
+Cq_winfon returns the parameter name, keyword name, default value, data type,
+and units of the requested wcs parameter. Cq_winfon is an integer function
+which returns the sequence number of the wcs parameter as its function
+value. Zero is returned if the wcs parameter is not found.
+
+.ih
+NOTES
+For more information about the wcs parameters and their relationship
+to the image surveys configuration file type "help surveys".
+
+.ih
+SEE ALSO
+cqwinfo
+.endhelp
diff --git a/pkg/xtools/catquery/doc/surveys.hlp b/pkg/xtools/catquery/doc/surveys.hlp
new file mode 100644
index 00000000..bfc50e69
--- /dev/null
+++ b/pkg/xtools/catquery/doc/surveys.hlp
@@ -0,0 +1,197 @@
+.help surveys Mar00 catquery
+.ih
+NAME
+surveys -- describe the image survey configuration file
+.ih
+USAGE
+help surveys
+.ih
+IMAGE SURVEYS
+
+An image survey contains image data for a large region of the sky from which
+image data for small regions of the sky can be extracted.
+Image surveys may be installed locally or accessed remotely. Each
+supported survey must have a record in the image survey configuration file,
+which define the image survey network address, the image survey query format,
+and the image survey query output format. 
+
+.ih
+THE IMAGE SURVEY CONFIGURATION FILE
+
+A record in the image survey configuration file specifies the network address,
+the query format, and the output image format for each supported image server.
+Each image server is accessed via a record name of the form
+"survey@server", e.g. "dss2@cadc". Adding support for a new image survey
+server or responding to changes in the behavior of an existing image survey
+server requires either adding a new record to the configuration file or
+changing an existing record.  No modification to the survey access
+code should be required.
+
+The server network address tells the image survey access code where and how to
+connect to the network. Each network address has the syntax
+"domain:port:address:flags" e.g. "inet:80:www.noao.edu:text".
+
+The query format specifies the form of the query server string, and the
+names, default values, units, and format of the query parameters. A set of
+standard query parameter names are reserved for accessing image surveys
+including "ra", "dec", "radius", "width", "xwidth", and "ywidth".
+
+The server output format specifies the format of the expected server output:
+including the image type, the world coordinate system type, and the
+standard keyword set. At present the only supported image type is FITS,
+the only supported world coordinate system types are FITS and DSS,
+and the standard keyword set includes keyword that are required or
+useful for astrometric analysis tasks.
+
+.ih
+SAMPLE IMAGE SURVEY RECORD
+
+The following example illustrates the main features of a typical image survey
+configuration file record.
+
+.nf
+begin dss1@cadc
+address inet:80:cadcwww.hia.nrc.ca:binary
+query  GET /cadcbin/dss-server?ra=%-s&dec=%-s&mime-type=application/x-fits&x=%-s
+&y=%-s HTTP/1.0\n\n
+nquery 5
+    ra 00:00:00.00 hours %0.2h
+    dec +00:00:00.0 degrees %0.1h
+    xwidth 10.0 minutes %0.1f
+    ywidth 10.0 minutes %0.1f
+    qsystem J2000.0 INDEF %s
+type fits
+wcs dss
+nwcs 10
+    wxref INDEF INDEF d pixels
+    wyref INDEF INDEF d pixels
+    wxmag INDEF 1.701 d arcsec/pixel
+    wymag INDEF 1.701 d arcsec/pixel
+    wxrot INDEF 180.0 d degrees
+    wyrot INDEF 0.0 d degrees
+    wraref OBJCTRA INDEF d hms
+    wdecref OBJCTDEC INDEF d dms
+    wproj INDEF tan c INDEF
+    wsystem INDEF J2000 c INDEF
+nkeys 13
+    observat INDEF Palomar c INDEF
+    esitelng INDEF +116:51:46.80 d degrees
+    esitelat INDEF +33:21:21.6 d degrees
+    esitealt INDEF 1706 r meters
+    esitetz INDEF 8 r INDEF
+    emjdobs INDEF INDEF d INDEF
+    edatamin INDEF INDEF r ADU
+    edatamax INDEF INDEF r ADU
+    gain INDEF INDEF r e-/ADU
+    erdnoise INDEF INDEF r e-
+    ewavlen INDEF INDEF r angstroms
+    etemp INDEF INDEF r degrees
+    epress INDEF INDEF r mbars
+.fi
+
+The beginning of a new image survey record is indicated by  a line
+of the form \fI"begin surveyname"\fR where surveyname is a unique name of the
+form \fI"survey@server"\fR. Any number of unique names can access the same
+image survey.  If more than one record with the same name exists in the
+configuration file the last record is the one read. Multiple entries for
+the same catalog can be used to define a different query format or different
+output type. For example if an image server supports more than one output
+formats then two records with two different queries can be defined,
+one which outputs one format, and another which outputs a different one.
+
+The \fIaddress\fR, \fIquery\fR and \fInquery\fR keywords are required, and
+define the network address, query command format and query parameters for
+the image survey.
+
+The \fIaddress\fR keyword  "domain", "port", and "flags" fields are almost
+always "inet", "80", and "binary" respectively for image surveys, so
+the only field that has to be defined is the address field
+":cadcwww.hia.nrc.ca" in this case.
+
+The \fIquery\fR keyword defines the query command whose form is server
+dependent. The query parameter values are encoded via the %-s formatting
+strings. The calling program must encode the user query parameter values
+into a set a strings which then replace the -%s format statement in the
+query string.
+
+The number of query parameters is defined by the \fInquery\fR parameter. The
+number of query parameters must be greater than or equal to the number of "-%s"
+strings in the query keyword value. The name,  default value, units,
+and format of each query parameter are listed below the nquery keyword
+one query parameter description per line. The query parameters should be
+defined in the configuration file in the same order that they appear
+in the query keyword value. Alert readers will notice that in the example above
+the number of query parameters is 5 but there are only 4 "%-s" strings
+in the query keyword value. In this example the qsystem query parameter which
+defined the coordinate system of the ra and dec query parameter values is
+fixed at J2000. For some servers this parameter may be a true query parameter,
+i.e. the server may accept coordinates in B1950 or J2000 or some other
+coordinate system.
+
+For "astrometric" image surveys the reserved query parameter names "ra", "dec",
+and "qsystem" should be used to define the extraction region center and its
+coordinate system, and one or more of "radius", "width", "xwidth", and
+"ywidth" should be used to define the extraction region size. The units
+of "ra" should be "hours", "degrees", or "radians", the units of dec
+should be "degrees" or "radians", and units of the size query parameter
+should be "degrees" or "minutes". The qsystem parameter value may be
+any one of the supported celestial coordinate systems. The most common
+qsystem values are "icrs", "J2000", or "B1950". The query parameter
+formats are used to convert numerical values supplied by the calling
+program to string values that can be passed to the query string.
+It should be emphasized that the reserved query parameter names and units
+are conventions that are adopted to simplify writing the configuration
+file and astrometric applications. They are not part of the image survey
+access API itself.
+
+The \fItype\fR keyword defines the format of the output image data. At
+present only FITS data is supported.
+
+The \fIwcs\fR keyword defines the wcs status of the image. The options
+are "fits" for an image which contains a valid FITS wcs, "dss" for an image
+which contains a valid DSS wcs, and "none" for an image contains no
+standard wcs information.
+
+The \fInwcs\fR keyword defines the number of following wcs parameters. Each
+wcs parameter definition consists of a standard keyword name, the actual
+keyword name or INDEF if no keyword exists, the default keyword value or
+INDEF is there is no default value, the data type which must be one of
+d(double), r(real), (i)integer, or c(character), and the units which may
+be INDEF if they are undefined.
+
+The reserved standard wcs keyword names \fIwxref\fR,
+\fIwyref\fR, \fIwxmag\fR, \fIwymag\fR, \fIwxref\fR, \fIwyref\fR, \fIwraref\fR,
+\fIwdecref\fR, \fIwproj\fR, and \fIwsystem\fR, should be used to define the 
+pixel reference coordinates, the pixel scale in "/ pixel, the coordinate
+system rotation and skew in degrees, the reference coordinates in some celestial
+coordinate system, the image projection, and the celestial coordinate system.
+The units of wraref may be "hours", "degrees" or "radians" and the units
+of wdecref may be "hours" and "degrees". At present the units for the
+remaining wcs keywords should be regarded as fixed.  It should be emphasized
+that the reserved standard wcs parameter names and units are conventions that
+are adopted to simplify writing the configuration file and astrometric image
+applications. They are not part of the image survey access API itself.
+
+The \fInkeys\fR keyword defines the number of following standard keyword
+parameters. Each parameter definition consists of a standard keyword name,
+the actual keyword name or INDEF is no keyword exists, the default value
+or INDEF is there is no default value, the data type which must be one of
+d(double), r(real), (i)integer, or c(character), and the parameter units
+which may be INDEF if they are undefined.
+
+The reserved standard keyword names \fIobservat\fR,
+\fIesitelng\fR, \fIesitelat\fR, \fIesitelat\fR, and \fIesitetz\fR should be
+used to define the site, \fIemjdobs\fR, \fIewavelen\fR, \fIetemp\fR,
+and \fIepress\fR to define the time and physical conditions of the observation,
+ and \fIedatamin\fR, \fIedatamax\fR,  \fIegain\fR, and \fIerdnoise\fR
+to define the detector parameters. At present the units of all these
+parameters should be regarded as fixed. 
+It should be emphasized that the reserved standard header parameter names and
+units are conventions that are adopted to simplify writing the configuration
+file and astrometric image applications. They are not part of the image survey
+access API itself.
+
+.ih
+SEE ALSO
+ccsystems, catalogs
+.endhelp
diff --git a/pkg/xtools/catquery/mkpkg b/pkg/xtools/catquery/mkpkg
new file mode 100644
index 00000000..91f0b557
--- /dev/null
+++ b/pkg/xtools/catquery/mkpkg
@@ -0,0 +1,32 @@
+# Catalog and survey access tools subdirectory
+
+$checkout libxtools.a lib$
+$update libxtools.a
+$checkin libxtools.a lib$
+$exit
+
+libxtools.a:
+	cqmap.x		<ctype.h> "cqdef.h" 
+	cqstat.x	"cqdef.h" "cq.h"
+	cqlocate.x	"cqdef.h"
+
+	cqsetcat.x	"cqdef.h" "cq.h"
+	cqnqpars.x	"cqdef.h"
+	cqgqpars.x	"cqdef.h"
+	cqsqpars.x	"cqdef.h" "cq.h"
+
+	cqquery.x	<fset.h> "cqdef.h" "cq.h"
+	cqrstat.x	"cqdef.h" "cq.h"
+	cqrinfo.x	"cqdef.h" "cq.h"
+	cqgrecords.x	"cqdef.h" "cq.h"
+	cqgfields.x	<ctype.h> "cqdef.h" "cq.h" 
+
+	cqimquery.x	<fset.h> "cqdef.h" "cq.h"
+	cqistat.x	"cqdef.h" "cq.h"
+	cqiminfo.x	"cqdef.h" "cq.h"
+
+	cqget.x		"cqdef.h" "cq.h"
+	cqdb.x		<ctype.h> "cqdef.h" "cq.h"
+        cqwrdstr.x
+	cqdtype.x
+	;
diff --git a/pkg/xtools/center1d.h b/pkg/xtools/center1d.h
new file mode 100644
index 00000000..c2d4972d
--- /dev/null
+++ b/pkg/xtools/center1d.h
@@ -0,0 +1,6 @@
+# Type of features for one dimensional centering.
+
+define	EMISSION	1		# Emission feature
+define	ABSORPTION	2		# Absorption feature
+
+define	FTYPES	"|emission|absorption|"	# Types for strdic and clgwrd.
diff --git a/pkg/xtools/center1d.x b/pkg/xtools/center1d.x
new file mode 100644
index 00000000..33a6ec3d
--- /dev/null
+++ b/pkg/xtools/center1d.x
@@ -0,0 +1,272 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/iminterp.h>
+include	<pkg/center1d.h>
+
+define	MIN_WIDTH	3.		# Minimum centering width
+define	EPSILON		0.001		# Accuracy of centering
+define	EPSILON1	0.005		# Tolerance for convergence check
+define	ITERATIONS	100		# Maximum number of iterations
+define	MAX_DXCHECK	3		# Look back for failed convergence
+define	INTERPTYPE	II_SPLINE3	# Image interpolation type
+
+
+# CENTER1D -- Locate the center of a one dimensional feature.
+# A value of INDEF is returned in the centering fails for any reason.
+# This procedure just sets up the data and adjusts for emission or
+# absorption features.  The actual centering is done by C1D_CENTER.
+# If twidth <= 1 return the nearest minima or maxima.
+
+real procedure center1d (x, data, npts, width, type, radius, threshold)
+
+real	x				# Initial guess
+int	npts				# Number of data points
+real	data[npts]			# Data points
+real	width				# Feature width
+int	type				# Feature type
+real	radius				# Centering radius
+real	threshold			# Minimum range in feature
+
+real	xc				# Center
+
+int	x1, x2, nx
+real	a, b, rad, wid
+pointer	sp, data1
+
+real	c1d_center()
+
+begin
+
+	# Check starting value.
+	if (IS_INDEF(x) || (x < 1) || (x > npts))
+	    return (INDEF)
+
+	# Set parameters.  The minimum in the error radius
+	# is for defining the data window.  The user error radius is used to
+	# check for an error in the derived center at the end of the centering.
+
+	call c1d_params (INDEFI, INDEFR)
+	wid = max (width, MIN_WIDTH)
+	rad = max (2., radius)
+
+	# Determine the pixel value range around the initial center, including
+	# the width and error radius buffer.  Check for a minimum range.
+
+	x1 = max (1., x - wid / 2 - rad - wid)
+	x2 = min (real (npts), x + wid / 2 + rad + wid + 1)
+	nx = x2 - x1 + 1
+	call alimr (data[x1], nx, a, b)
+	if (b - a < threshold)
+	    return (INDEF)
+
+	# Allocate memory for the continuum subtracted data vector.  The X
+	# range is just large enough to include the error radius and the
+	# half width.
+
+	x1 = max (1., x - wid / 2 - rad)
+	x2 = min (real (npts), x + wid / 2 + rad + 1)
+	nx = x2 - x1 + 1
+
+	call smark (sp)
+	call salloc (data1, nx, TY_REAL)
+	call amovr (data[x1], Memr[data1], nx)
+
+	# Make the centering data positive, subtract the continuum, and
+	# apply a threshold to eliminate noise spikes.
+
+	switch (type) {
+	case EMISSION:
+	    a = min (0., a)
+	    call asubkr (data[x1], a + threshold, Memr[data1], nx)
+	    call amaxkr (Memr[data1], 0., Memr[data1], nx)
+	case ABSORPTION:
+	    call anegr (data[x1], Memr[data1], nx)
+	    call asubkr (Memr[data1], threshold - b, Memr[data1], nx)
+	    call amaxkr (Memr[data1], 0., Memr[data1], nx)
+	default:
+	    call error (0, "Unknown feature type")
+	}
+
+	# Determine the center.
+	xc = c1d_center (x - x1 + 1, Memr[data1], nx, width)
+
+	# Check user centering error radius.
+	if (!IS_INDEF(xc)) {
+	    xc = xc + x1 - 1
+	    if (abs (x - xc) > radius)
+		xc = INDEF
+	}
+
+	# Free memory and return the center position.
+	call sfree (sp)
+	return (xc)
+end
+
+
+# C1D_PARAMS -- Set parameters.
+
+procedure c1d_params (interp, eps)
+
+int	interp		# Interpolation type
+real	eps		# Accuracy of centering
+
+int	first
+data	first /YES/
+
+int	interptype
+real	epsilon
+common	/c1d_common/ interptype, epsilon
+
+begin
+	if (!IS_INDEFI(interp))
+	    interptype = interp
+	else if (first == YES)
+	    interptype = INTERPTYPE
+
+	if (!IS_INDEFR(eps))
+	    epsilon = eps
+	else if (first == YES)
+	    epsilon = EPSILON
+
+	first = NO
+end
+
+
+# C1D_CENTER -- One dimensional centering algorithm.
+# If the width is <= 1. return the nearest local maximum.
+
+real procedure c1d_center (x, data, npts, width)
+
+real	x				# Starting guess
+int	npts				# Number of points in data vector
+real	data[npts]			# Data vector
+real	width				# Centering width
+
+int	i, j, iteration, dxcheck
+real	xc, wid, hwidth, dx, dxabs, dxlast
+real	a, b, sum1, sum2, intgrl1, intgrl2
+pointer	asi1, asi2, sp, data1
+
+real	asigrl()
+
+int	interptype
+real	epsilon
+common	/c1d_common/ interptype, epsilon
+
+define	done_	99
+
+begin
+	# Find the nearest local maxima as the starting point.
+	# This is required because the threshold limit may have set
+	# large regions of the data to zero and without a gradient
+	# the centering will fail.
+
+	for (i=x+.5; (i<npts) && (data[i]<=data[i+1]); i=i+1)
+	    ;
+	for (; (i>1) && (data[i]<=data[i-1]); i=i-1)
+	    ;
+	for (j=x+.5; (j>1) && (data[j]<=data[j-1]); j=j-1)
+	    ;
+	for (; (j<npts) && (data[j]<=data[j+1]); j=j+1)
+	    ;
+
+	if (abs(i-x) < abs(x-j))
+	    xc = i 
+	else
+	    xc = j
+
+	if (width <= 1.)
+	    return (xc)
+
+	wid = max (width, MIN_WIDTH)
+
+	# Check data range.
+	hwidth = wid / 2
+	if ((xc - hwidth < 1) || (xc + hwidth > npts))
+	    return (INDEF)
+
+	# Set interpolation functions.
+	call asiinit (asi1, interptype)
+	call asiinit (asi2, interptype)
+	call asifit (asi1, data, npts)
+
+	# Allocate, compute, and interpolate the x*y values.
+	call smark (sp)
+	call salloc (data1, npts, TY_REAL)
+	do i = 1, npts
+	    Memr[data1+i-1] = data[i] * i
+	call asifit (asi2, Memr[data1], npts)
+	call sfree (sp)
+
+	# Iterate to find center.  This loop exits when 1) the maximum
+	# number of iterations is reached, 2) the delta is less than
+	# the required accuracy (criterion for finding a center), 3)
+	# there is a problem in the computation, 4) successive steps
+	# continue to exceed the minimum delta.
+
+	dxlast = npts
+	do iteration = 1, ITERATIONS {
+	    # Ramp centering function.
+	    # a = xc - hwidth
+	    # b = xc + hwidth
+	    # intgrl1 = asigrl (asi1, a, b)
+	    # intgrl2 = asigrl (asi2, a, b)
+	    # sum1 = intgrl2 - xc * intgrl1
+	    # sum2 = intgrl1
+
+	    # Triangle centering function.
+	    a = xc - hwidth
+	    b = xc - hwidth / 2
+	    intgrl1 = asigrl (asi1, a, b)
+	    intgrl2 = asigrl (asi2, a, b)
+	    sum1 = (xc - hwidth) * intgrl1 - intgrl2
+	    sum2 = -intgrl1
+	    a = b
+	    b = xc + hwidth / 2
+	    intgrl1 = asigrl (asi1, a, b)
+	    intgrl2 = asigrl (asi2, a, b)
+	    sum1 = sum1 - xc * intgrl1 + intgrl2
+	    sum2 = sum2 + intgrl1
+	    a = b
+	    b = xc + hwidth
+	    intgrl1 = asigrl (asi1, a, b)
+	    intgrl2 = asigrl (asi2, a, b)
+	    sum1 = sum1 + (xc + hwidth) * intgrl1 - intgrl2
+	    sum2 = sum2 - intgrl1
+
+	    # Return no center if sum2 is zero.
+	    if (sum2 == 0.)
+		break
+
+	    # Limit dx change in one iteration to 1 pixel.
+	    dx = sum1 / abs (sum2)
+	    dxabs = abs (dx)
+	    xc = xc + max (-1., min (1., dx))
+
+	    # Check data range.  Return no center if at edge of data.
+	    if ((xc - hwidth < 1) || (xc + hwidth > npts))
+		break
+
+	    # Convergence tests.
+	    if (dxabs < epsilon)
+		goto done_
+	    if (dxabs > dxlast + EPSILON1) {
+		dxcheck = dxcheck + 1
+		if (dxcheck > MAX_DXCHECK)
+		    break
+	    } else if (dxabs > dxlast - EPSILON1) {
+		xc = xc - max (-1., min (1., dx)) / 2
+		dxcheck = 0
+	    } else {
+		dxcheck = 0
+	        dxlast = dxabs
+	    }
+	}
+
+	# If we get here then no center was found.
+	xc = INDEF
+
+done_	call asifree (asi1)
+	call asifree (asi2)
+	return (xc)
+end
diff --git a/pkg/xtools/clgcurfit.x b/pkg/xtools/clgcurfit.x
new file mode 100644
index 00000000..89818c1a
--- /dev/null
+++ b/pkg/xtools/clgcurfit.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+
+# CLGCURFIT -- Get the curve type and order for the curfit package.
+#
+# Prompt1 is issued for the curve type.  The curve type is entered
+# as a minimum abbreviation string with clgwrd.  The allowed strings
+# are legendre, chebyshev, and spline3.  Prompt2 is issued to get
+# the order.
+
+procedure clgcurfit (prompt1, prompt2, curve_type, order)
+
+char	prompt1[ARB], prompt2[ARB]
+int	curve_type
+int	order
+
+char	str[SZ_LINE]
+int	i, curtypes[3], clgwrd(), clgeti()
+errchk	clgwrd
+
+data	curtypes/LEGENDRE, CHEBYSHEV, SPLINE3/
+
+begin
+
+	i = clgwrd (prompt1, str, SZ_LINE, ",legendre,chebyshev,spline3,")
+	curve_type = curtypes[i]
+	order = clgeti (prompt2)
+end
diff --git a/pkg/xtools/clginterp.x b/pkg/xtools/clginterp.x
new file mode 100644
index 00000000..c65d69ca
--- /dev/null
+++ b/pkg/xtools/clginterp.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math/iminterp.h>
+
+# CLGINTERP -- Select an interpolator from a CL input string.  The procedure
+# is coded to be protected from changes in the values of the interpolator
+# types in interpdef.h.
+
+int procedure clginterp (param)
+
+char	param[ARB]		# CL parameter prompt string
+int	index, iicodes[5]
+pointer	sp, word
+int	clgwrd()
+errchk	clgwrd
+data	iicodes /II_NEAREST, II_LINEAR, II_POLY3, II_POLY5, II_SPLINE3/
+
+begin
+	call smark (sp)
+	call salloc (word, SZ_FNAME, TY_CHAR)
+
+	index = max (1, min (5, clgwrd (param, Memc[word], SZ_FNAME,
+	    "|nearest|linear|poly3|poly5|spline3|")))
+
+	call sfree (sp)
+	return (iicodes[index])
+end
diff --git a/pkg/xtools/clgsec.x b/pkg/xtools/clgsec.x
new file mode 100644
index 00000000..2c3149d8
--- /dev/null
+++ b/pkg/xtools/clgsec.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+include	<imhdr.h>
+
+define	FIRST	1
+define	LAST	MAX_LONG
+define	STEP	1
+
+# CLGSEC -- Get an image section and decode it.
+#
+# A section string may be either a null string or bracketed by [].
+# The arrays x1, x2, and step are initialized to FIRST, LAST, and STEP.
+# The number of subscripts decoded is returned in nsubscripts.
+# This routine uses the same decode routine as IMIO.
+
+procedure clgsec (prompt, section, x1, x2, step, nsubscripts)
+
+char	prompt[ARB]
+char	section[ARB]
+long	x1[IM_MAXDIM]
+long	x2[IM_MAXDIM]
+long	step[IM_MAXDIM]
+int	nsubscripts
+
+int	i, ip
+
+begin
+	# Get section string.
+	call clgstr (prompt, section ,SZ_LINE)
+
+	# Set default values.
+	nsubscripts = 0
+	call amovkl (long (FIRST), x1, IM_MAXDIM)
+	call amovkl (long (LAST), x2, IM_MAXDIM)
+	call amovkl (long (STEP), step, IM_MAXDIM)
+
+	# Skip leading whitespace.
+	ip = 1
+	while (IS_WHITE(section[ip]))
+	    ip = ip + 1
+
+	# Check for absent section.
+	if (section[ip] == EOS)
+	    return
+
+	# Check for start of section string.
+	if (section[ip] != '[')
+	    call error (0, "Invalid image section")
+
+	# Decode section.
+	ip = ip + 1
+	for (i=1;  i <= IM_MAXDIM && section[ip] != ']';  i=i+1)
+	    call im_decode_subscript (section, ip, x1[i], x2[i], step[i])
+	nsubscripts = i - 1
+end
diff --git a/pkg/xtools/cogetr.h b/pkg/xtools/cogetr.h
new file mode 100644
index 00000000..3e0f9762
--- /dev/null
+++ b/pkg/xtools/cogetr.h
@@ -0,0 +1,16 @@
+# Definitions for the image column procedure.
+
+define	LEN_CO		10
+
+define	CO_IM		Memi[$1]		# IMIO pointer
+define	CO_MAXBUF	Memi[$1+1]		# Maximum buffer size
+define	CO_DATA		Memi[$1+2]		# Column data pointer
+define	CO_BUF		Memi[$1+3]		# Buffer
+define	CO_NCOLS	Memi[$1+4]		# Number of columns in buffer
+define	CO_NLINES	Memi[$1+5]		# Number of lines in buffer
+define	CO_COL1		Memi[$1+6]		# First column of buffer
+define	CO_COL2		Memi[$1+7]		# Last column of buffer
+define	CO_LINE1	Memi[$1+8]		# First line of data
+define	CO_LINE2	Memi[$1+9]		# Last line of data
+
+define	EXTRA	2			# Number of extra lines in buffer
diff --git a/pkg/xtools/cogetr.x b/pkg/xtools/cogetr.x
new file mode 100644
index 00000000..823d54f3
--- /dev/null
+++ b/pkg/xtools/cogetr.x
@@ -0,0 +1,162 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"cogetr.h"
+
+# COGETR -- Get a real column vector from a 2D image.
+#
+# This procedure is designed to be efficient when:
+#	1.  The columns are accessed sequentially.
+#	2.  The number of lines does not change.
+#	3.  The first and last lines change slowly with column.
+# One such case is when the entire column of an image is required.  Then
+# the first and last lines do not change at all.  Another type of use
+# occurs when dealing with features which are aligned nearly
+# with the image lines.  For example objects in a long slit spectrum or
+# Echelle orders.
+#
+# As the columns are accessed sequentially new lines are added to a
+# scrolled buffer only when the first and last lines fall outside the
+# buffer.  If the buffer size is insufficient to hold the all the columns
+# then the buffer is set to contain a block of columns.  When the desired
+# column is outside the block of columns then a new block is read.
+# The buffer is created and initialized when the buffer pointer
+# is null or when the number of lines requested is changed.  Both the
+# buffer and the column data pointer are allocated in this procedure.
+# The user must free the buffers with the procedure COUNMAP.
+
+pointer procedure cogetr (co, col, line1, line2)
+
+pointer	co		# COIO pointer
+int	col		# Column
+int	line1		# First image line of column vector
+int	line2		# Last image line of column vector
+
+int	ncols, nlines, lastc1, lastl1, lastl2
+int	i, imlen1, imlen2, col1, nc
+pointer	im, coldata, buffer, buf, data
+
+pointer	imgl2r()
+
+begin
+	# Dereference the structure elements to improve the readability of
+	# the code and reduce the Mem index arithmetic.
+
+	im = CO_IM(co)
+	coldata = CO_DATA(co)
+	buffer = CO_BUF(co)
+	ncols = CO_NCOLS(co)
+	nlines = CO_NLINES(co)
+	lastc1 = CO_COL1(co)
+	lastl1 = CO_LINE1(co)
+	lastl2 = CO_LINE2(co)
+	imlen1 = IM_LEN (im, 1)
+	imlen2 = IM_LEN (im, 2)
+
+	# If memory has not been allocated then allocate it.
+	# If the number of lines changes reallocate the buffer and
+	# initialize lastc1 to zero to force a full buffer read.
+
+	i = min (imlen2, (line2 - line1 + 1) + 2 * EXTRA)
+
+	if ((buffer == NULL) || (nlines != i)) {
+	    nlines = i
+	    ncols = min (imlen1, CO_MAXBUF(co) / nlines)
+	    lastc1 = 0
+
+	    call mfree (coldata, TY_REAL)
+	    call mfree (buffer, TY_REAL)
+	    call malloc (coldata, line2 - line1 + 1, TY_REAL)
+	    call malloc (buffer, ncols * nlines, TY_REAL)
+
+	    CO_DATA(co) = coldata
+	    CO_BUF(co) = buffer
+	    CO_NCOLS(co) = ncols
+	    CO_NLINES(co) = nlines
+	}
+
+	# Determine the starting column and the number of columns per line.
+
+	col1 = ((col - 1) / ncols) * ncols + 1
+	nc = min (ncols, imlen1 - col1 + 1)
+
+	# If there is no overlap with the last buffer then read all the
+	# requested lines.  Otherwise read only the image lines with are
+	# different from the last buffer.
+
+	if ((col1 != lastc1) || (line1 > lastl2) || (line2 < lastl1)) {
+	    lastc1 = col1
+	    lastl1 = max (1, line1 - EXTRA)
+	    lastl2 = min (imlen2, line2 + EXTRA)
+	    do i = lastl1, lastl2 {
+	        buf = buffer + mod (i, nlines) * ncols
+		call amovr (Memr[imgl2r(im, i)+col1-1], Memr[buf], nc)
+	    }
+	    CO_COL1(co) = lastc1
+	    CO_LINE1(co) = lastl1
+	    CO_LINE2(co) = lastl2
+
+	} else if (line1 < lastl1) {
+	    do i = max (1, line1 - EXTRA), min (imlen2, lastl1 - 1) {
+	        buf = buffer + mod (i, nlines) * ncols
+		call amovr (Memr[imgl2r(im, i)+col1-1], Memr[buf], nc)
+	    }
+	    lastl1 = max (1, line1 - EXTRA)
+	    lastl2 = min (imlen2, line2 + EXTRA)
+	    CO_LINE1(co) = lastl1
+	    CO_LINE2(co) = lastl2
+
+	} else if (line2 > lastl2) {
+	    do i = max (1, lastl2 + 1), min (imlen2, line2 + EXTRA) {
+	        buf = buffer + mod (i, nlines) * ncols
+		call amovr (Memr[imgl2r(im, i)+col1-1], Memr[buf], nc)
+	    }
+	    lastl1 = max (1, line1 - EXTRA)
+	    lastl2 = min (imlen2, line2 + EXTRA)
+	    CO_LINE1(co) = lastl1
+	    CO_LINE2(co) = lastl2
+	}
+
+	# Set the column data vector.
+
+	data = coldata
+	do i = line1, line2 {
+	    buf = buffer + mod (i, nlines) * ncols
+	    Memr[data] = Memr[buf+col-col1]
+	    data = data + 1
+	}
+
+	return (coldata)
+end
+
+
+# COMAP -- Map the column access
+
+pointer procedure comap (im, maxbuf)
+
+pointer	im		# IMIO pointer
+int	maxbuf		# Maximum buffer size
+pointer	co		# Returned pointer
+
+begin
+	call malloc (co, LEN_CO, TY_LONG)
+	CO_IM(co) = im
+	CO_MAXBUF(co) = maxbuf
+	CO_DATA(co) = NULL
+	CO_BUF(co) = NULL
+
+	return (co)
+end
+
+
+# COUMAP -- Unmap the column access
+
+procedure counmap (co)
+
+pointer	co			# Pointer to buffer structure
+
+begin
+	call mfree (CO_DATA(co), TY_REAL)
+	call mfree (CO_BUF(co), TY_REAL)
+	call mfree (co, TY_LONG)
+end
diff --git a/pkg/xtools/doc/Notes b/pkg/xtools/doc/Notes
new file mode 100644
index 00000000..4fd91876
--- /dev/null
+++ b/pkg/xtools/doc/Notes
@@ -0,0 +1,42 @@
+------
+# GETDATATYPE -- Convert a character to an IRAF data type (one of TY_*)
+# Recognized character codes "bcusilrdx"
+
+int procedure getdatatype (c)
+
+char	c
+______
+DECODE_RANGES:  See help text in source code or ranges.doc.
+______
+GET_NEXT_NUMBER:   See help text in source code or ranges.doc.
+______
+IS_IN_RANGE:   See help text in source code or ranges.doc.
+______
+# EXTREMA -- Find the extrema in a set of x and y data points
+
+Help text is in the source code
+______
+# PEAKS -- Find the peaks in a set of x and y data points
+
+Help text is in the source code
+______
+# CLGSEC -- Get an image section and decode it.
+#
+# A section string may be either a null string or bracketed by [].
+# The arrays x1, x2, and step are initialized to FIRST, LAST, and STEP.
+# The number of subscripts decoded is returned in nsubscripts.
+# This routine uses the same decode routine as IMIO.
+
+
+define	FIRST	1
+define	LAST	MAX_LONG
+define	STEP	1
+
+procedure clgsec (prompt, section, x1, x2, step, nsubscripts)
+
+char	prompt[ARB]
+char	section[ARB]
+long	x1[IM_MAXDIM]
+long	x2[IM_MAXDIM]
+long	step[IM_MAXDIM]
+int	nsubscripts
diff --git a/pkg/xtools/doc/center1d.hlp b/pkg/xtools/doc/center1d.hlp
new file mode 100644
index 00000000..742fa7cb
--- /dev/null
+++ b/pkg/xtools/doc/center1d.hlp
@@ -0,0 +1,147 @@
+.help center1d May93 xtools
+.ih
+NAME
+center1d -- One dimensional centering
+.ih
+SYNOPSIS
+.nf
+center = center1d (initial, data, npts, width, type, radius, threshold)
+
+real	initial			# Initial guess
+real	data[npts]		# Data points
+int	npts			# Number of data points
+real	width			# Feature width
+int	type			# Feature type
+real	radius			# Centering radius
+real	threshold		# Detection threshold
+.fi
+.ih
+ARGUMENTS
+.ls initial
+Initial guess for the center of the feature.
+.le
+.ls data[npts]
+Pixel data vector.
+.le
+.ls npts
+Number of points in the data vector.
+.le
+.ls width
+Width used to define the convolution function.  If the width is 1 or less
+then the nearest minimum or maximum is returned.  If the width is greater
+than 1 then a minimum with of 3 is used in the algorithm.
+.le
+.ls type
+Type of feature.  The feature types are defined in the file <xtools/center1d.h>.
+Currently the types are emission and absorption features.
+.le
+.ls radius
+Centering radius or error limit about the initial guess.
+.le
+.ls threshold
+Minimum difference between the maximum and minimum pixel value in the
+region around the initial guess allowed for detecting a feature.  For
+data which is all positive and the type is emission then the
+threshold is also used as an absolute cutoff.
+.le
+.ih
+DESCRIPTION
+If the width is 1 or less then the nearest minimum or maximum is found.
+The centering radius is still applied as is the threshold.  If the width
+is greater than 1 then a minimum width of 3 is used in the algorithm.
+
+The one dimensional position of a feature is determined by solving the equation
+
+	(1)	integral {(I-I0) f(X-XC) dX} = 0
+
+where I is the intensity at position X, I0 is the continuum intensity, X is the
+pixel coordinate, and XC is the desired feature position.  Figure 1 shows
+the range of pixels used in determining the continuum intensity, the feature
+threshold, and solving the equation.
+
+.ks
+.nf
+		      Figure 1:  Data Feature Vector
+      +-----------------------------------------------------------+
+     -|                               *                           |
+     S|                              * *                          |
+      |                              * *                          |
+     t|                             *   **                        |
+      |                             *     *                       |
+     r|                            *       *                      |
+      |                           *        *                      |
+     e|                          *          *                     |
+      |                         *            *                    |
+     n|                      *                 *              *  *|
+      |                   *                       *  *  *  *      |
+     t|             *  *                                          |
+      |       *  *                                                |
+     h|    *                                                      |
+     -| *                                                         |
+      +---------+-----------------+---------------------+---------+
+     -B        -A                 0                     A         B
+
+			        X-XC
+
+	A = radius + 0.5 width		B = radius + 1.5 width
+.fi
+.ke
+
+The range -A to A is used to determine the continuum intensity and
+the strength of the feature.  For absorption features the continuum
+intensity is the maximum point in this range while for emission
+features the continuum is set to zero.  Admittedly these are not real
+measures of the continuum but they contain the fewest assumptions
+and are tolerant of nearby contaminating features.  The feature strength
+is the difference between the maximum and minimum values.  If the feature
+strength is less than the specified detection threshold then a value of
+INDEF is returned for the feature position.
+
+.ks
+The range -B to B includes the range of allowed feature positions plus the
+half-width of the feature.  This range is used in solving equation (1).
+The convolution function f(X-XC) is a sawtooth as shown in figure 2.
+For absorption features the negative of this function is used.
+
+.nf
+		           Figure 2:  f(X-XC)
+	        +-------------------+-------------------+
+	        |                   |     *             |
+	        |                   |   *   *           |
+	        |                   | *       *         |
+             0  +-*-*-*-*-----------*-----------*-*-*-*-+
+	        |         *       * |                   |
+	        |           *   *   |                   |
+	        |             *     |                   |
+	        +-------+-----------+-----------+-------+
+	            -width/2       0         width/2
+
+		                   X-XC
+.fi
+.ke
+
+The two figures graphically define the parameter \fIwidth\fR.  Generally
+it should be set to a value near the actual width of the emission or absorption
+feature.  If the width is too wide then the center will be affected by blending
+from nearby lines while if it is too narrow the accuracy of the centering is
+decreased.  The parameter \fBradius\fR determines how far from the initial
+estimate for XC the interactive solution of (1) may go.
+Equation (1) is solved iteratively starting with the initial position.
+When successive positions agree within 0.1% of a pixel the position is
+returned.  If the position wanders further than \fIradius\fR from the
+initial guess or outside of the data vector then the procedure returns
+the value INDEF.  If more than 100 iterations are required or the corrections
+per iteration exceed the minimum correction reached after 3 further iterations
+then the solution has failed to converge and INDEF is returned.  Note that
+this latter condition may occur if the width is too small in a flat topped
+profile.
+
+This task uses the one dimensional image interpolation package \fBiminterp\fR
+in solving equation (1).
+.ih
+BUGS
+Though the algorithm does not fail if the width is made very small the
+results become unreliable.  Therefore a silent limit of 3 is imposed
+by the algorithm.  If there is ever a need to allow smaller widths
+then the procedure can be changed and the applications relinked.
+.endhelp
diff --git a/pkg/xtools/doc/cogetr.hlp b/pkg/xtools/doc/cogetr.hlp
new file mode 100644
index 00000000..416935c9
--- /dev/null
+++ b/pkg/xtools/doc/cogetr.hlp
@@ -0,0 +1,88 @@
+.help cogetr.hlp Feb86 xtools
+.ih
+NAME
+.nf
+comap   -- Initialize buffered image column access
+cogetr  -- Get buffered image columns from 2D image
+counmap -- Free memory used in image column access
+.fi
+.ih
+SYNOPSIS
+.nf
+pointer	im		# IMIO pointer
+pointer	co		# COGETR pointer
+int	maxbuf		# Maximum buffer size
+int	col		# Column
+int	line1		# First image line of column vector
+int	line2		# Last image line of column vector
+pointer	buf		# Returned pointer
+
+pointer	immap()		# Map the image
+pointer	comap()		# Map the column access
+pointer	cogetr()	# Get columns
+
+	im = immap (image, mode, 0)
+	co = comap (im, maxbuf)
+	buf = cogetr (co, col, line1, line2)
+	call counmap (co)
+.fi
+.ih
+DESCRIPTION
+A pointer to a real image column vector between the limits \fIline1\fR
+and \fIline2\fR is returned.  Internally the image data is buffered as
+a scrolled two dimensional section to minimize the number of image
+reads.  This interface is designed to be efficient when:
+
+.nf
+(1) The columns are accessed sequentially.
+(2) The number of lines does not change.
+(3) The first and last lines change slowly with the column accessed.
+.fi
+
+The column access interface is initialized with the procedure
+\fBcomap\fR.  At this time the maximum size of the internal buffer is
+set.  The buffer should be reasonably large.
+
+When the first column
+access is made with \fBcogetr\fR a buffer is created containing the
+number of lines requested and as many columns as will fit within the
+maximum buffer size.  When the number of lines is small then the number
+of columns buffered will be large (as large as the image if possible).
+When the number of lines is large then the columns may be buffered in
+blocks across the image.  A pointer to the real column vector requested is
+returned.  Subsequent calls to \fBcogetr\fR will return columns from the
+buffer without reading the image until a new buffer is required
+provided that the line limits do not change.  If the columns are
+accessed sequentially (usually from the first column to
+the last column) then the image will be accessed a minimum number of
+times consistent with the buffer size.
+
+One type of application accesses entire columns from the image
+so that the first and last lines do not change.  Another type allows
+the line limits to change in such a way that the total number of lines
+does not change and the changes are only a few lines between calls.
+In this case only the new lines are added to the scrolled buffer
+without the entire buffer needing to be filled.
+Applications of this type occur when following a feature across an
+image such as objects in long slit spectra or echelle orders.
+
+The buffer is created and initialized when the buffer pointer
+is null or when the number of lines requested is changed.  Both the
+buffer and the column data pointer are allocated by \fBcogetr\fR.
+The user must free the buffers with the procedure \fBcounmap\fR.
+.ih
+RETURNED VALUES
+\fBComap\fR returns a pointer to a structure internal to the interface.
+\fBCogetr\fR returns a pointer to a real vector containing the requested
+image column.
+.ih
+TIMINGS
+When used in applications requiring sequential column access with
+the line limits changing slowly or not at all this interface provides
+access nearly as efficiently as accessing lines.  The actual difference
+with the same application applied to lines depends on the number of
+buffer reads required (i.e. on the size of the image).
+.ih
+SEE ALSO
+xtsums
+.endhelp
diff --git a/pkg/xtools/doc/extrema.hlp b/pkg/xtools/doc/extrema.hlp
new file mode 100644
index 00000000..cea82502
--- /dev/null
+++ b/pkg/xtools/doc/extrema.hlp
@@ -0,0 +1,27 @@
+.help extrema Dec83 xtools
+.ih
+NAME
+extrema -- find the extrema in an array of x and y points
+.ih
+SYNOPSIS
+.nf
+nextrema = extrema (x, y, curvature, npts, dx)
+
+real	x[npts], y[npts]	# Input data points and output extrema
+real	curvature[npts]		# 2nd deriv. of cubic spline at extrema
+int	npts			# Number of input data points
+real	dx			# Precision of extrema positions
+.fi
+.ih
+DESCRIPTION
+The input data points are fitted with a cubic interpolation spline.  The
+spline is then searched for points where the first derivative changes sign.
+The minimum step size of this search is controlled by the parameter dx.
+The positions of these extrema are returned in the x array, the value of the
+spline at the extrema are returned in the y array, and the curvature or
+second derivative of the spline at the extrema are returned in the
+curvature array.  The function returns the number of extrema found.
+.ih
+SEE ALSO
+xtools.peaks
+.endhelp
diff --git a/pkg/xtools/doc/inlfit.hlp b/pkg/xtools/doc/inlfit.hlp
new file mode 100644
index 00000000..db256302
--- /dev/null
+++ b/pkg/xtools/doc/inlfit.hlp
@@ -0,0 +1,259 @@
+.help inlfit Aug91 xtools
+.ih
+NAME
+inlfit -- The interactive non-linear least squares fitting package
+
+.ih
+SYNOPSIS
+
+The INLFIT package is a set of procedures, callable from any IRAF task,
+for interactively fitting an arbitrary function of n independent variables
+using non-linear least squares techniques.  The calling task
+must supply the function to be fit and its derivatives, initial values for
+various convergence and bad data rejection parameters, the data to be fit,
+and weights for all the data points. The INLFIT package is layered on the
+NLFIT package which does the actual fitting.
+
+.ih
+DESCRIPTION
+
+INLFIT fits an n-dimensional function to a set of data
+points iterating until the reduced chi-squared changes
+by less than \fItolerance\fR percent between successive iterations, or
+until machine precision is reached, or until
+the maximum number
+of iterations \fImaxiter\fR is reached.  If the maximum number
+of iterations is reached before convergence a status flag
+is set.
+
+After computing an initial fit, INLFIT presents the user with a plot of
+the fit and activates the graphics cursor.
+At this point the user may examine and/or interact with the fit by,
+for example, reprogramming the default graph keys,
+editing the default convergence or bad data rejection parameters,
+deleting and undeleting points, 
+altering which parameters in the fitting function are actually to be
+fit and which are to be held constant, and refitting the data.
+
+If \fInreject\fR is greater than zero the RMS of the residuals is computed
+and points whose residuals are less than \fIlow_reject\fR * RMS
+or greater than \fIhigh_reject\fR * RMS value are excluded from the fit.
+Points within
+a distance \fIgrow\fR of a rejected point are also excluded from
+the fit. The function is then refit without the rejected points.
+The rejection algorithm is executed until the number of rejection
+iterations reaches \fInreject\fR or no more points are rejected.
+
+.ih
+CURSOR COMMANDS
+
+The following interactive cursor keystroke commands are available from
+within the INLFIT package.
+.ls ?
+The terminal is cleared and a menu of cursor keystroke and colon commands
+is printed.
+.le
+.ls c
+The id, coordinates of the data point nearest the cursor, along with the
+function value, the fitted value and the residual, are printed on the status
+line.
+.le
+.ls d
+The data point nearest the cursor and not previously deleted is marked with an
+X. It will not be used in further fits until it is undeleted.
+.le
+.ls f
+The function is fit to the data and the fit is graphed using the default
+plot type.
+.le
+.ls g
+Redefine the graph keys "h-l" from their defaults. A prompt is issued for the
+graph key to be redefined. Another prompt is issued for the data to be
+plotted at which point the user must enter the x and y axis data to plot,
+delimited by a comma. The data types are the following (they can be
+abbreviated to up to three characters).
+.nf
+
+    function    Dependent variable or function
+    fit         Fitted value
+    residuals   Residuals (function - fit)
+    ratio       Ratio (function / fit)
+    nonlinear   Nonlinear component
+    identifier  Independent variable named "identifier" (if defined)
+    var n       Independent variable number "n"
+    user n      User defined plot equation "n"  (if defined)
+
+.fi
+The application program can define independent variable names and user plot 
+functions, aside from the standard options provided. If variable names are 
+supplied, the user can reference them by their names. Otherwise they can be 
+always referenced by "var n", where "n" is the variable number (the user has 
+to know the variable order in this case). The ":variables" command will
+list the currently defined variables by name and number.
+The application program may
+define any number of plot equations aside from the defaults provided. In this 
+case the user may reference them by "user n", where "n" is the plot function 
+number (the user must know the equation order in this case). 
+.le
+.ls h, i, j, k, l
+By default each key produces a different graph. The graphs are described by
+the data which is graphed along each axis as defined above. The default graph
+keys,
+which may be redefined by the application program or interactively by using 
+the 'g' key, are the following.
+.nf
+
+        h       function, fit
+        i       function, residuals
+        j       function, ratio
+        k       var 1, function
+        l       user 1, user 2 (default)
+
+.fi
+The initial graph key, if not redefined by the application program is 'h'.
+.le
+.ls o
+Overplot the next fit provided the graph format has not changed.
+.le
+.ls q
+Exit from the interactive curve fitting package.
+.le
+.ls r
+Redraw the current graph.
+.le
+.ls t
+Toggle fit overploting on and off. If this option is on the data
+and fitted values are overplotted. Otherwise only data points are plotted.
+The fitted values are marked using boxes.
+.le
+.ls u
+Undelete the data point nearest the cursor which has been previously deleted.
+This option does not work over points marked as deleted by the application
+program before calling inlfit.
+.le
+.ls w [key]
+Set the graph window or data range along each axis to be graphed.. This is a 
+\fBgtools\fR option which prints the prompt "window:". The available cursor
+keystroke commands are printed with '?' and on-line help is available by
+typing "help gtools".
+.le
+.ls I
+Interrupt the task immediately without saving the current fit.
+.le
+
+Colon commands are used to show or set the values of parameters.
+The application program calling \fBinlfit\fR can add more commands.
+Parameter names can be abbreviated. The following commands are supported. 
+.ls :show [file]
+Show the current values of the fitting parameters high_reject, 
+low_reject, niterate, grow, tol, itmax. The default output device
+is the terminal (STDOUT) and the screen is cleared before the information
+is output. If a file is specified then the information is appended
+to the named file.
+.le
+.ls :variables [file]
+List the currently loaded variables. The number, id, minimum value and maximum
+value of each variable is printed. The default output device is the terminal
+(STDOUT) and the screen is cleared before the information is output.
+If a file is specified then the information is appended to the named file.
+.le
+.ls :data [file]
+List the raw data. The value of each standard catalog and observations
+catalog variable  for each data point is printed. The default output device
+is the terminal (STDOUT) and the screen is cleared before the information
+is output.  If a file is specified then the information is appended to
+the named file.
+.le
+.ls :errors [file]
+Show the error analysis of the current fit.  The number of iterations,
+total number of points,
+the number of rejected and deleted points, the standard deviation,
+the reduced chi, the average error (always = 1.0 if weight=1.0, otherwise
+= 1.0 / <weight>), the average scatter (always 0.0 if no weights scatter term is
+fit),
+the reduce chi, and the rms are printed on the screen. The fitted parameters
+and their errors are also printed. The default output is the terminal
+(STDOUT) and the screen is cleared before the information is
+output. If a file is specified then the information is appended to
+the named file.
+.le
+.ls :results [file]
+List the results of the current fit. The function value, the fitted value,
+the residual, and the weight are printed for each data point. The default
+output device is the terminal (STDOUT) and the screen is cleared before
+the information is output. If a file is specified then the information is
+appended to the named file.
+.le
+.ls :vshow [file]
+A verbose version of ":show" which is equivalent to a ":show" plus a ":errors"
+plus a ":results". The default output device is the terminal (STDOUT)
+and the screen is cleared before the information is output.
+If a file is specified then the information is appended to the named file.
+.le
+.ls :page file
+Page through the named file.
+.le
+.ls :tolerance [value]
+Show or set the value of the fitting tolerance. Tolerance is the maximum
+fraction by which the reduced chi-squared can change from one iteration to the
+next for the fit to meet the convergence criteria.
+.le
+.ls :maxiter [value]
+Show or set the maximum number of fitting iterations.
+.le
+.ls :nreject [value]
+Show or set the maximum number of rejection iterations. A value of zero
+means that automatic bad data rejection is turned off. 
+.le
+.ls :low_reject [value], :high_reject [value]
+Show or set the values of the bad data rejection limits.
+If both low_reject and high_reject are zero then automatic bad data
+rejection is turned off.
+If either of the high or low rejection limits are greater than zero,
+and nreject is greater than zero, the rms of the initial fit is computed.
+Points with residuals
+more than low_reject * rms below zero and high_reject * rms above zero
+are removed before the final fit. Rejected points are marked on the 
+graphs with diamonds. 
+.le
+.ls :grow [value]
+Show or set the value of the rejection growing radius. Any points
+within this distance of a rejected point are also rejected. 
+.le
+.ls :fit [parameter] [value]
+Set the starting guess value for the named coefficient and allow the 
+parameter value to change (converge) during the fit.
+If the value is not specified inlfit will use the last starting guess.
+.le
+.ls :const [parameter] [value]
+Set the named parameter to be a constant with the specified value, i.e,
+its value won't change during the fit.
+If the value is not specified inlfit will use its last starting value.
+.le
+.ls :/help
+Print help for the graph formatting options.
+.le
+.ls :.help
+Print help for the general IRAF graphics options.
+.le
+
+.ih
+ALGORITHMS
+
+INLFIT uses the standard Levenberg-Marquardt non-linear least squares
+algorithm to fit the data. Detailed descriptions of the algorithm can
+be found in the following two references.
+.nf
+
+1. Bevington, P.R., 1969, Data Reduction and Error Analysis for the
+   Physical Sciences, Chapter 11, page 235.
+
+2. Press, W.H. et al., 1986, Numerical Recipes: The Art of Scientific
+   Computing, Chapter 14, page 523.
+
+.fi
+
+.ih
+SEE ALSO
+icfit,gtools
+.endhelp
diff --git a/pkg/xtools/doc/peaks.hlp b/pkg/xtools/doc/peaks.hlp
new file mode 100644
index 00000000..dc9eb763
--- /dev/null
+++ b/pkg/xtools/doc/peaks.hlp
@@ -0,0 +1,28 @@
+.help peaks Jan84 xtools
+.ih
+NAME
+peaks -- find the peaks in an array of x and y points
+.ih
+SYNOPSIS
+.nf
+npeaks = peaks (x, y, background, npts, dx)
+
+real	x[npts], y[npts]	# Input data points and output peaks
+real	background[npts]	# Background estimate
+int	npts			# Number of input data points
+real	dx			# Precision of peak positions
+.fi
+.ih
+DESCRIPTION
+The extrema in the input data points are found using extrema(xtools).
+The extrema are located to a precision of dx.
+The extrema with negative curvature (peaks) are selected and returned
+in the x array.  The spline value is returned in the y array.  The
+background is estimated by linear interpolation of the neighboring
+minima (extrema of positive curvature) to the position of the peak.
+The background is returned in the background array.  The number of
+peaks found is returned as the function value.
+.ih
+SEE ALSO
+xtools.extrema
+.endhelp
diff --git a/pkg/xtools/doc/ranges.hlp b/pkg/xtools/doc/ranges.hlp
new file mode 100644
index 00000000..8f924698
--- /dev/null
+++ b/pkg/xtools/doc/ranges.hlp
@@ -0,0 +1,105 @@
+.help ranges Jan84 xtools
+.ih
+PURPOSE
+These tools
+parse a string using a syntax to represent integer values, ranges, and
+steps.   The parsed string is used to generate a list of integers for various
+purposes such as specifying lines or columns in an image or tape file numbers.
+.ih
+SYNTAX
+The syntax for the range string consists of non-negative integers, '-' (minus),
+'x', ',' (comma), and whitespace.  The commas and whitespace are ignored
+and may be freely used for clarity.  The remainder of the string consists
+of sequences of five fields.  The first field is the beginning of a range,
+the second is a '-', the third is the end of the range, the fourth is
+a 'x', and the fifth is a step size.  Any of the five fields may be
+missing causing various default actions.  The defaults are illustrated in
+the following table.
+
+.nf
+-3x1	A missing starting value defaults to 1.
+2-x1	A missing ending value defaults to MAX_INT.
+2x1	A missing ending value defaults to MAX_INT.
+2-4	A missing step defaults to 1.
+4	A missing ending value and step defaults to an ending
+	value equal to the starting value and a step of 1.
+x2	Missing starting and ending values defaults to
+	the range 1 to MAX_INT with the specified step.
+""	The null string is equivalent to "1 - MAX_INT x 1",
+	i.e all positive integers.
+.fi
+
+The specification of several ranges yields the union of the ranges.
+Note that the default starting value is 1 though one may specify zero
+as a range limit.
+.ih
+EXAMPLES
+The following examples further illustrate the range syntax.
+
+.nf
+-	All positive integers.
+1,5,9	A list of integers equivalent to 1-1x1,5-5x1,9-9x1.
+x2	Every second positive integer starting with 1.
+2x3	Every third positive integer starting with 2.
+-10	All integers between 1 and 10.
+5-	All integers greater than or equal to 5.
+9-3x1	The integers 3,6,9.
+.fi
+.ih
+PROCEDURES
+
+.ls 4 decode_ranges
+
+.nf
+int procedure decode_ranges (range_string, ranges, max_ranges, nvalues)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	nvalues			# The number of values in the ranges
+.fi
+
+The range string is decoded into an integer array of maximum dimension
+3 * max_ranges.  Each range consists of three consecutive integers
+corresponding to the starting and ending points of the range and the
+step size.  The number of integers covered by the ranges is returned
+as nvalue.  The end of the set of ranges is marked by a NULL.
+The returned status is either ERR or OK.
+.le
+.ls 4 get_next_number, get_last_number
+
+.nf
+int procedure get_next_number (ranges, number)
+int procedure get_previous_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+.fi
+
+Given a value for number the procedures find the next (previous) number in
+increasing (decreasing)
+value within the set of ranges.  The next (previous) number is returned in
+the number argument.  A returned status is either OK or EOF.
+EOF indicates that there are no greater values.  The usual usage would
+be in a loop of the form:
+
+.nf
+	number = 0
+	while (get_next_number (ranges, number) != EOF) {
+	    <Statements using number>
+	}
+.fi
+.le
+.ls 4 is_in_range
+
+.nf
+bool procedure is_in_range (ranges, number)
+
+int	ranges[ARB]		# Ranges array
+int	number			# Number to check against ranges
+.fi
+
+A boolean value is returned indicating whether number is covered by
+the ranges.
+.le
+.endhelp
diff --git a/pkg/xtools/doc/xtextns.hlp b/pkg/xtools/doc/xtextns.hlp
new file mode 100644
index 00000000..f03f69ae
--- /dev/null
+++ b/pkg/xtools/doc/xtextns.hlp
@@ -0,0 +1,115 @@
+.help xt_extns Mar07 xtools
+.ih
+NAME
+.nf
+xt_extns -- Expand an MEF into a list of image extensions
+.fi
+.ih
+SYNOPSIS
+.nf
+int procedure xt_extns (files, index, extname, extver, lindex, lname, lver,
+	dataless, ikparams, err, imext)
+
+char	files[ARB]		#I List of MEF files
+char	index[ARB]		#I Range list of extension indexes
+char	extname[ARB]		#I Patterns for extension names
+char	extver[ARB]		#I Range list of extension versions
+int	lindex			#I List index number?
+int	lname			#I List extension name?
+int	lver			#I List extension version?
+int	dataless		#I Include dataless image headers?
+char	ikparams[ARB]		#I Image kernel parameters
+int	err			#I Print errors?
+int	imext			#O Image extensions?
+.fi
+.ih
+DESCRIPTION
+A list, \fIfiles\fR,  of regular images and multi-extension FITS (MEF)
+files is returned as a list of images.  In addition a flag, \fIimext\fR,
+is set indicating if image extensions are present.
+
+In order handle regular and MEF extension images in the same way one must
+understand that all images in IRAF may be addressed with a numeric index
+while those that are "regular" images may also be addressed without
+an index.  Non-FITS format images are considered to have an index of 1.
+For example, an image in the IRAF format may be addressed
+as pix.imh, pix, pix.imh[1], and pix[1].  FITS files start with index 0
+in order that index 1 may be used to refer to the first extension.
+So a plain FITS image, say foo.fits may also be addressed as foo, foo[0],
+or foo.fits[0].  If a FITS file has both a primary (index 0) image and
+extensions then the zero index must be explicitly used.
+
+For regular images the index range must include 0 for FITS images (or
+primary images in FITS files with extensions) and 1 for non-FITS images.
+In the resulting list, the index notation is dropped unless it is required;
+i.e. in a FITS file with both a primary image and extensions.
+
+The input set of candidate images may be filtered by index, extension
+name, extension version, and whether images are dataless.
+
+\fIindex\fR is a range list (see \fBranges\fR) of indices to be applied
+to each input file for identifying images.  If a null string is
+specified then all index values bet
+
+\fIindex\fR is a range list (see \fBranges\fR) of indices to be applied
+to each input file for identifying images.  If a null string is
+specified then all non-negative index values are examined.
+
+\fIextname\fR is a comma delimited list of patterns for extension names.
+If no list (a null string) or the string "*" is specified then no
+filtering on the extension name is done.  For a description of pattern
+matching syntax see \fBmatch\fR.  Extension names are those specified
+by the EXTNAME keyword.  For the purpose of explicit pattern matching
+strings a missing EXTNAME keyword is treated as the extension name "none".
+To include a comma in a pattern you must escape it by preceding it with
+'\', however, a comma in an extension name may cause other problems
+because IRAF image extension syntax using the extension name does not
+allow commas or whitespace.  Each pattern has '^' and '$' prepended
+and appended respectively which means the pattern must match the entire
+extension name.  A common mistake is that '*' in a pattern is different
+than '*' in a file template.  In this case use '?*'.
+
+The reasons for a list of patterns matching the entire extension name
+are to allow intuitive explicit lists of names, such as "im1,im11,im13",
+and to deal with names which are difficult to unambiguously specify with
+a single pattern.
+
+\fIextver\fR is a range list for extension version numbers.  If no
+list is given then no filtering on extension versions is performed.
+See \fBranges\fR for more on range lists.
+
+\fIdataless\fR is a boolean parameter that selects whether to filter out
+dataless images.  Dataless images are uncommon except for a class of MEF
+files where the primary image is used only for global inherited header
+keywords.  This parameter may be used to include this global header in
+expansions of this type of MEF files.
+
+The output of the list of selected images for FITS image extensions may
+be expressed either with the index notation (e.g. name[3]) or extension
+name and/or extension version (e.g. name[im3], name[im5,2]).  This is
+controlled by the \fIlindex\fR, \fIlname\fR and \fIlver\fR boolean
+parameters.  If the extension name and or version number are selected
+then that format is used even if \flindex\fR is also selected.  If
+there is no extension name or extension version then the index is used
+even if \fIlindex\fR is not selected.  Also remember that for regular
+images where an index or extension sections is not required none will
+be used.
+
+The output names may also include additional "image kernel" information.
+Different image types, currently mostly for FITS images, have parameters
+that may be specified in the image kernel section.  The \fIikparams\fR
+string may be used to add these additional parameters within the
+kernel section part of the name.
+
+Finally, the input files, including MEF files, in the input file list
+may include "image sections".  During processing image sections are
+stripped and then appended on the output.  For example, name[1:10,1:10]
+might expand to name[im1][1:10,1:10], name[im2][1:10,1:10], etc.
+
+\fIerr\fR may be used to print error messages when a particular image
+index fails to be opened.  Typically this would be to find nonexistent
+or read-protected images and files.
+.ih
+SEE ALSO
+mscextensions, imextensions, match, ranges
+.endhelp
diff --git a/pkg/xtools/doc/xtmaskname.hlp b/pkg/xtools/doc/xtmaskname.hlp
new file mode 100644
index 00000000..ddc8a07c
--- /dev/null
+++ b/pkg/xtools/doc/xtmaskname.hlp
@@ -0,0 +1,85 @@
+.help xt_maskname Mar07 xtools
+.ih
+NAME
+.nf
+xt_maskname -- create mask name 
+.fi
+.ih
+SYNOPSIS
+.nf
+procedure xt_maskname (fname, extname, mode, mname, maxchar)
+
+char	fname[ARB]			#I File name
+char	extname[ARB]			#I Default pixel mask extension name
+int	mode				#I Mode
+char	mname[maxchar]			#O Output mask name
+int	maxchar				#I Maximum characters in mask name
+.fi
+.ih
+DESCRIPTION
+This routine encapsulates creating a mask name from a user specified
+name, an optional extension name, and an optional environment variable.
+It checks if an explicit format is desired based on the presence of a
+".pl" extension for a pixel list file or the FITS kernel parameter
+"type=mask" (with the equal sign possibly escaped) for a FITS extension.
+If neither is specified then the default is a FITS extension unless the
+environment variable "masktype" is set to "pl".  If the application
+does not specify an extension name for FITS format the name "pl" is used.
+
+If the "masktype" environment variable is "pl" and the application requests
+an extension name then a directory with the specified filename is used (and
+created for a new mask) and the pixel list filename is the extension name.
+For example, if the filename is "obj1234" and the extension name is "im1"
+then the mask name is "obj1234/im1.pl".  As a fallback if a directory
+cannot be accessed the filename will have the form <fname>_<extname>.pl.
+
+Typically an application that specifically was designed to handle
+multi-extension FITS (MEF) files will use the same extension name for
+a mask as for the image extension to which it applies.
+.ih
+EXAMPLES
+1. When "masktype" is undefined and creating a new mask:
+
+.nf
+               fname extname		mname
+  --------------------------------------------------------
+                 abc ""         -->     abc[pl,type=mask]
+                 abc "def"      -->     abc[def,type=mask]
+  abc[def,type=mask] ""         -->     abc[def,type=mask]
+            abc[def] "ghi"      -->     abc[def,type=mask]
+              abc.pl ""         -->     abc.pl
+              abc.pl "def"      -->     abc.pl
+.fi
+
+2. When "masktype=pl" and creating a new mask:
+
+.nf
+               fname extname		mname
+  --------------------------------------------------------
+                 abc ""         -->     abc.pl
+                 abc "def"      -->     abc/def.pl
+  abc[def,type=mask] ""         -->     abc/def.pl
+            abc[def] "ghi"      -->     abc/def.pl
+              abc.pl ""         -->     abc.pl
+              abc.pl "def"      -->     abc.pl
+.fi
+
+3. When reading a mask it looks for either format unless an explicit
+".pl" extension is included.
+
+.nf
+               fname extname		mname
+  --------------------------------------------------------
+                 abc ""         -->     abc[pl]
+                 abc "def"      -->     abc[def]
+  abc[def,type=mask] ""         -->     abc[def,type=mask]
+            abc[def] "ghi"      -->     abc[def]
+              abc.pl ""         -->     abc.pl
+              abc.pl "def"      -->     abc.pl
+                 abc ""         -->     abc.pl
+                 abc "def"      -->     abc/def.pl
+            abc[def] ""         -->     abc/def.pl
+            abc[def] "ghi"      -->     abc/def.pl
+            abc[def] ""         -->     abc_def.pl
+.fi
+.endhelp
diff --git a/pkg/xtools/doc/xtools.hd b/pkg/xtools/doc/xtools.hd
new file mode 100644
index 00000000..38665086
--- /dev/null
+++ b/pkg/xtools/doc/xtools.hd
@@ -0,0 +1,45 @@
+# Help directory for the XTOOLS (programming tools) package.
+
+$xtools		= "pkg$xtools/"
+$fixpix		= "pkg$xtools/fixpix/"
+$icfit		= "pkg$xtools/icfit/"
+$gtools		= "pkg$xtools/gtools/"
+$ranges		= "pkg$xtools/ranges/"
+$skywcs		= "pkg$xtools/skywcs/doc/"
+$catquery	= "pkg$xtools/catquery/doc/"
+
+revisions	sys = xtools$Revisions
+dttext		hlp = xtools$dttext.x,		src = ..
+cogetr		hlp = cogetr.hlp,		src = xtools$cogetr.x
+comap		hlp = cogetr.hlp,		src = xtools$cogetr.x
+counmap		hlp = cogetr.hlp,		src = xtools$cogetr.x
+xt_extns	hlp = xtextns.hlp,		src = xtools$xtextns.x
+xt_lsum		hlp = xtsums.hlp,		src = xtools$xtsums.x
+xt_csum		hlp = xtsums.hlp,		src = xtools$xtsums.x
+xt_lsumb	hlp = xtsums.hlp,		src = xtools$xtsums.x
+xt_lsuml	hlp = xtsums.hlp,		src = xtools$xtsums.x
+xt_maskname	hlp = xtmaskname.hlp,		src = xtools$xtmaskname.x
+xt_pmmap	hlp = xtpmmap.hlp,		src = fixpix$xtpmmap.x
+clgsec		hlp = clgsec.hlp,		src = xtools$clgsec.x
+extrema		hlp = extrema.hlp,		src = xtools$extrema.x
+getdatatype	hlp = getdatatype.hlp,		src = xtools$getdatatype.x
+gstrdetab	hlp = gstrdetab.hlp,		src = xtools$gstrdetab.x
+gstrentab	hlp = gstrentab.hlp,		src = xtools$gstrentab.x
+gstrsettab	hlp = gstrsettab.hlp,		src = xtools$gstrsettab.x
+peaks		hlp = peaks.hlp,		src = xtools$peaks.x
+ranges		hlp = ranges.hlp,		src = xtools$ranges.x
+strdetab	hlp = strdetab.hlp,		src = xtools$strdetab.x
+strentab	hlp = strentab.hlp,		src = xtools$strentab.x
+center1d	hlp = center1d.hlp,		src = xtools$center1d.x
+icfit		hlp = icfit$icfit.hlp
+inlfit		hlp = xtools$doc/inlfit.hlp
+#gtools		hlp = gtools$gtools.hlp,	pkg = gtools$gtools.hd
+gtools		hlp = gtools$gtools.hlp
+
+skywcs		hlp = skywcs$skywcs.men,
+		sys = skywcs$skywcs.hlp,
+		pkg = skywcs$skywcs.hd
+
+catquery	hlp = catquery$catquery.men,
+		sys = catquery$catquery.hlp,
+		pkg = catquery$catquery.hd
diff --git a/pkg/xtools/doc/xtools.men b/pkg/xtools/doc/xtools.men
new file mode 100644
index 00000000..8fe85373
--- /dev/null
+++ b/pkg/xtools/doc/xtools.men
@@ -0,0 +1,23 @@
+       catquery - Catalog query package
+         clgsec - Get and decode an image section
+      clginterp - Get integer code for interpolator type
+         cogetr - Efficient image column access
+          comap - Map for column access procedure
+        counmap - Unmap for column access procedure
+	extrema - Find extrema in x and y data points
+    getdatatype - Convert type suffix character to TY_ type code
+      gstrdetab - Remove tabs from a string
+      gstrentab - Put tabs in a string where possible
+     gstrsettab - Set tab stops for gstrdetab, entab.
+	 gtools - Graphics tools
+	  icfit - Interactive curve fitting package
+	 inlfit - Interactive non-linear least squares fitting package
+	  peaks - Find peaks in x and y data points
+	 ranges - Parse a list of ranges "1,3,5-7,.."
+         skywcs - Celestial coordinates transformation package
+       strdetab - Simplified detab
+       strentab - Simplified entab
+        xt_csum - Sum of image columns using column access procedure
+       xt_csumb - Buffered sum of image columns using column access procedure
+        xt_lsum - Sum of image lines
+       xt_lsumb - Buffered sum of image lines for moving sums
diff --git a/pkg/xtools/doc/xtpmmap.hlp b/pkg/xtools/doc/xtpmmap.hlp
new file mode 100644
index 00000000..94752da3
--- /dev/null
+++ b/pkg/xtools/doc/xtpmmap.hlp
@@ -0,0 +1,144 @@
+.help xt_pmmap Mar07 xtools
+.ih
+NAME
+.nf
+xt_pmmap -- map a mask and match it to a reference image
+.fi
+.ih
+SYNOPSIS
+.nf
+# Open a mask.
+pointer procedure xt_pmmap (pmname, refim, mname, sz_mname)
+
+char	pmname[ARB]		#I Pixel mask name
+pointer	refim			#I Reference image pointer
+char	mname[ARB]		#O Expanded mask name
+int	sz_mname		#O Size of expanded mask name
+
+
+# Close the mask.
+procedure xt_pmunmap (im)
+
+pointer im                      #I IMIO pointer for mask
+.fi
+.ih
+DESCRIPTION
+This interface maps (opens) and unmaps (closes) a mask for use in an
+application.  It includes resolving mask files from image header keywords
+in a reference image, inverting masks, matching masks spatially to a
+reference image, and access to non-pixel list formats.
+
+The \fIpmname\fR argument is a file name or a reference to an image header
+keyword using the syntax "!<keyword>".  As a special case the name "BPM"
+is equivalent to "!BPM".  It is also legal for the file name to be a null
+string which returns a NULL pointer for the application to interpret
+as desired.  Most applications will treat this case as all image pixels
+are good.
+
+If the file name, or the file name obtained from a keyword reference,
+begins with the character '^' the mask will be inverted to a boolean mask.
+This means that input mask values which are zero are set to 1 and non-zero
+mask values are set to 0.
+
+The \fIrefim\fR argument is the IMIO image pointer for a reference image
+used to resolve keyword references and for spatial matching.
+
+The map routine returns the mask name through the \fImname\fR argument.
+Typically an application would use the mask name for logging purposes
+since it will expand keyword mask references.
+
+.sh
+SPATIAL MATCHING
+
+The matching of masks to a reference image is a powerful feature though it
+can also cause confusion.  The advantage of matching is that when images
+are modified by trimming or other linear geometric operations the mask,
+often referenced in the image header, will still correctly identify
+the bad pixels.  Note that this does not apply to non-linear coordinate
+transformations.
+
+The matching is based on a "physical" coordinate system.  This is typically
+the image pixel coordinate system prior to any linear transformation.
+IRAF tasks which extract subrasters, subsample, block average, block
+replicate, transpose, etc. update header keywords describing the mapping
+from the image pixel coordinate system (called the "logical" coordinate
+system) to the parent physical coordinate system.  Some applications
+also attach a meaning to the physical coordinate system such as detector
+array coordinates.
+
+The transformation between logical coordinates (lx,ly) and physical
+coordinates (px,py) is defined by the header keywords LTM1_1, LTM2_1,
+LTM1_2, LTM_2_2, LTV1, and LTV2 as shown below.
+
+.nf
+    lx = px * LTM1_1 + py * LTM2_1 + LTV1
+    ly = px * LTM1_2 + py * LTM2_2 + LTV2
+
+    px = ( LTM2_2 * (lx - LTV1) - LTM2_1 * (ly - LTV2)) /
+	 (LTM1_1 * LTM2_2 - LTM1_2 * LTM2_1)
+    py = (-LTM1_2 * (lx - LTV1) + LTM1_1 * (ly - LTV2)) /
+	 (LTM1_1 * LTM2_2 - LTM1_2 * LTM2_1)
+.fi
+
+Note that a missing keyword defaults to a value of zero.  When all
+LTM/LTV keywords are missing then the physical and logical coordinate
+systems are identical.  In other words the implied transformation is
+an identify transformation.  Note that one cannot just have
+LTV keywords because then the implied transformation matrix is
+ill-defined (all matrix elements are assumed zero).
+
+The matching consists of deriving a transformation between the
+logical pixels in the image and the mask by combining the two physical
+transformations.  This means that even if the logical to physical
+transformations are complex, such as a rotation, if the two are the same
+a identity or a simple offset relative transformation may still exist
+between the two.  In this combined logical-to-logical transformation
+the current version does not allow a rotation though, as just noted, the
+separate logical-to-pixel transformation may be rotated by the same amount.
+
+When the image is sampled more finely than the mask, that is the same mask
+pixel overlaps multiple image pixels, then the nearest mask value (pixel
+center to pixel center) is used for each image pixel.  When the image is
+more coarsely sampled, that is more than one mask pixel overlaps an image
+pixel, then the maximum mask value becomes the mask value for the pixel.
+This latter choice means that if an image pixel is touched by any bad
+pixel then it will be indicated as bad.
+
+If after matching the mask to the image the mask does not cover
+the image, the mask is extended by adding zero mask values.
+
+The above description is fairly general which makes this seem complex.
+However, by far the most common mismatch between an image and its mask
+is that an image has been derived as a subraster of a parent image.
+In this case the LTM values will be LTM1_1=LTM2_2=1 and LTM2_1=LTM1_2=0
+(or missing) and the matching just depends on the origin offset keywords
+LTV1 and LTV2.
+
+Note that to eliminate this matching one resets the physical coordinate
+system to be equivalent to the logical coordinate system.  The task
+\fIwcsreset\fR can be used or the above LTM/LTV keywords can be deleted
+using a header keyword editor.
+
+.sh
+ALTERNATIVE MASK DESCRIPTIONS
+
+This interface accepts alternate mask descriptions that are internally
+converted to the same mask structure for transparent use by the application.
+The preferred input mask description is a pixel mask in either pixel list
+format (.pl extension) or a FITS pixel mask (a binary table representation).
+The alternate representations are a regular image and a text description.
+
+The pixels values in a regular image are truncated (towards zero) to integers.
+Then negative values are set to 0.
+
+A text description consists of lines in a text file with either two or
+four values.  The values are truncated to integers if needed.  Two values
+define a mask value of 2 at the (x,y) coordinate.  Four values define a
+region, given as (x1,x2,y1,y2) of mask values.  The mask values are 2 if
+the width of the region is narrower or equal to the height.  Otherwise the
+value is 3.  This is a convention used by task which then interpolate
+across bad pixel regions.
+
+Note that a text description is always tied directly to the input
+image; that is, the physical and logical coordinate systems are the same.
+.endhelp
diff --git a/pkg/xtools/doc/xtsums.hlp b/pkg/xtools/doc/xtsums.hlp
new file mode 100644
index 00000000..c91ef644
--- /dev/null
+++ b/pkg/xtools/doc/xtsums.hlp
@@ -0,0 +1,83 @@
+.help xtsums Feb86 xtools
+.ih
+NAME
+.nf
+xt_lsum  -- Sum image lines
+xt_csum  -- Sum image columns
+xt_lsumb -- Sum image lines with buffering
+xt_csumb -- Sum image columns with buffering
+.fi
+.ih
+SYNOPSIS
+.nf
+pointer	im		# IMIO pointer
+pointer	co		# COGETR pointer
+int	col1, col2	# Column limits of the sum
+int	line1, line2	# Line limits
+pointer	data		# Data pointer returned
+
+	call xt_lsum (im, col1, col2, line1, line2, data)
+	call xt_csum (co, col1, col2, line1, line2, data)
+	call xt_lsumb (im, col1, col2, line1, line2, data)
+	call xt_csumb (co, col1, col2, line1, line2, data)
+.fi
+.ih
+DESCRIPTION
+The specified lines or columns in a 2D images are summed and a pointer to
+the real sum vector is returned.  For \fBxt_lsum\fR and \fBxt_lsumb\fR the
+lines between \fIline1\fR and \fIline2\fR are summed and a pointer to the summed
+vector between \fIcol1\fR and \fIcol2\fR is returned.  Similarly, for
+\fBxt_csum\fR and \fBxt_csumb\fR the columns between \fIcol1\fR and \fIcol2\fR
+are summed and a pointer to the summed vector between \fIline1\fR and
+\fIline2\fR is returned.  The data pointer is to a real vector.  The column
+sums use the efficient column access procedures described in \fBcogetr\fR.
+
+The procedures without the 'b' suffix read the set of lines or columns
+in the sum from the image every time.  The 'b' suffix procedures buffer
+the lines or columns such that if only a few lines or columns are different
+from the preceding sum then only those lines or columns are read.  Thus the
+"buffered" sums are used for moving sums while the unbuffered procedures are
+used when there is no overlap between the sums.
+.ih
+RETURN VALUE
+The returned pointer \fIdata\fR is to a vector of type real.
+.ih
+EXAMPLES
+Suppose a sum of "nsum" lines or columns is required through the image
+in steps of "nstep".  The following code fragment illustrates the usage.
+
+.nf
+	im = immap (image, READ_ONLY, 0)
+	switch (axis) {
+	case 1:
+	    col1 = 1
+	    col2 = IM_LEN(im, 1)
+	    for i = 1, IM_LEN(im, 2), nstep {
+	        if (nstep < nsum)
+		    call xt_lsumb (co, col1, col2, i, i+nsum-1, data)
+	        else
+		    call xt_lsum (co, i, i+nsum-1, line1, line2, data)
+
+	        # Do operations on vector Memr[data]
+	    }
+	case 2:
+	    co = comap (im, maxbuf)
+
+	    line1 = 1
+	    line2 = IM_LEN(im, 2)
+	    for i = 1, IM_LEN(im, 1), nstep {
+	        if (nstep < nsum)
+		    call xt_csumb (co, i, i+nsum-1, line1, line2, data)
+	        else
+		    call xt_csum (co, i, i+nsum-1, line1, line2, data)
+
+	        # Do operations on vector Memr[data]
+	    }
+	    call counmap (co)
+	}
+	call imunmap (im)
+.fi
+.ih
+SEE ALSO
+cogetr
+.endhelp
diff --git a/pkg/xtools/dttext.x b/pkg/xtools/dttext.x
new file mode 100644
index 00000000..387d8654
--- /dev/null
+++ b/pkg/xtools/dttext.x
@@ -0,0 +1,698 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<time.h>
+include	<ctype.h>
+include	<ctotok.h>
+include	<error.h>
+include	<fset.h>
+include	<pkg/dttext.h>
+
+.help dttext May85 "Simple Text Database Tools"
+.ih
+DESCRIPTION
+
+The database created, accessed, and modified by these procedures is
+a simple text file.  The purpose of these tools is to act as
+an interum database facility until the sophisticated IRAF database
+package is available.  The database model consists of
+comment lines which begin with a #, records, and fields within records.
+Records and fields (except array fields) have the same format, a keyword
+followed by data and terminated by a newline.  Records have the keyword
+'begin' and the data is any following text.  Thus a record can be identified
+by anything from a single character to an entire string.  A record contains
+all the following lines until the next record or the end of the file.
+Whitespace before and after the keyword is ignored.  The user is responsible
+for adding indentation to clarify the structure
+of the database.  However, the user can create a database with any
+style of whitespace that satisfies the keyword/value syntax.
+
+The array fields have a slightly different format.  The field begins just
+like an integer valued field; keyword followed by an integer.  The integer
+value is the number of array elements.  The following lines
+contain the array values, one per line.  Because the field name
+line has the same structure as an integer valued field the array
+length can be determined before reading the array values by reading
+the field as integer valued.
+
+For arrays with more than one column per line the dtscan procedure is
+used to scan a line and then the FMTIO garg procedures are used to
+decode the columns.  The user read the array field as an integer to get
+the number of lines and to position FIO to start reading the lines.
+
+There are four types of fields currently supported.  These are integer
+valued fields, real valued fields, string valued fields, and real arrays.
+It is up to the user to know the type of value for each field.  Note
+that the integer and real fields may be accessed as string valued.
+
+Records are referenced by a record number.  When a database is mapped
+each record which is unique is given a sequential record number.
+When more than one record has the same record identifier then only
+the last record is mapped.
+
+There are limitations imposed by the text file format.  A database
+may only be read or appended.  To update a record a new record must
+be written.  A later record with the same name takes precedence.
+
+Errors are handled through the standard error handling system of IRAF.
+Thus, uncaught errors will terminate the task with a message.  If it
+is possible that a field will not be present then the task can catch
+the error and take appropriate action.
+.ih
+DATABASE MAPPING
+
+When a database is mapped READ_ONLY then the records in the database
+are found and a structure created.  The structure is given in the file
+"dttext.h".  The important elements of the structure are:
+
+.nf
+
+	    DT(dt)		# Database FIO channel
+	    DT_NRECS(dt)	# Number of records
+	    DT_NAME(dt, rec)	# Record name
+	    DT_OFFSET(dt, rec)	# FIO offset
+.fi
+.ih
+PROCEDURES
+
+The procedures separate into three types, procedures to map and unmap
+the database, procedures to access the database, and procedures to make
+entries in the database.  The access routines reference a particular
+record.  To access a record by name the procedure dtlocate returns
+the record number or EOF.  The put routines write to the end of
+the database.  It is important to enter a record because otherwise
+added fields will be associated with the preceding record.  The put
+time command puts a comment line with the time.
+
+.nf
+	   dt = dtmap (database, mode)		# NEW_FILE, READ_ONLY or APPEND
+	   dt = dtmap1 (database, name, mode)	# Use a directory as a database
+		dtremap (dt, database, name,mode) # Remap a database
+		dtunmap (dt)
+
+       record = dtlocate (dt, recname)
+
+		dtgstr (dt, record, field, str, maxchar)
+	value = dtget[ird] (dt, record, field)
+		dtgar (dt, record, field, array, len_array, npts)
+
+		dtptime (dt)
+		dtput (dt, format)
+.fi
+.ih
+EXAMPLES
+
+The following is an example record from a database.
+
+.nf
+# Fri 15:13:13 05-Apr-85 Example
+begin	NGC1952 B
+	title	NGC1952 B filter centered
+	ra	12:40:20
+	dec	+5:20:15
+	flags	4
+		3.1
+		9.2
+		1
+		4
+	exp	3600
+.fi
+
+
+The following example reads the example record and writes a new record.
+
+.nf
+	iferr {
+	    dt = dtmap (database, READ_ONLY)
+	    record = dtlocate (dt, "NGC1952 B")
+	    call dtgstr (dt, record, "title", title, SZ_TITLE)
+	    ra = dtgetr (dt, record, "RA")
+	    dec = dtgetr (dt, record, "DEC")
+
+	    # Get length of array for dynamic allocation.
+	    nflags = dtgeti (dt, record, "flags")
+	    call salloc (flags, nflags, TY_REAL)
+	    call dtgar (dt, record, "flags", Memr[flags], nflags, nflags)
+	}
+
+	dt = dtmap (database, APPEND)
+	call dtptime (dt)
+	call dtput (dt, "begin\tNGC1952 Objects\n")
+	call dtput (dt, "\tobjects\t10\n)
+	do i = 1, 10 {
+	    call dtput (dt, "\t\t%g\n")
+		call pargr (objects[i])
+	}
+	call dtclose (dt)
+.fi
+
+The following is a database entry for a list which is read by the code below.
+
+.nf
+# Fri 15:13:13 05-Apr-85 Example
+begin	Table 1
+	1	apples		10	macintosh
+	2	oranges		8	valencia
+	3	potatoes	3	idaho
+
+
+	# Code to read database table.
+
+	record = dtlocate (dt, "Table 1")
+	call seek (DT(dt), DT_OFFSET(dt, record))
+	while (scan (DT(dt)) != EOF) {
+	    call gargi (n)
+	    call gargwrd (fruit[1, n])
+	    call gargi (number[n])
+	    call gargstr (comment[1, n])
+	}
+
+To read sequentially through a database:
+
+	# Code to read sequentially through a database.
+
+	do i = 1, DB_NRECS(db) {
+	    call printf ("%s\n")
+		call pargstr (DB_NAME(db, i))
+	}
+.fi
+.ih
+SEE ALSO
+Source code
+.endhelp
+
+
+# DTMAP -- Map a database.
+
+pointer procedure dtmap (database, mode)
+
+char	database[ARB]			# Database file
+int	mode				# FIO mode
+
+int	i, nrec
+int	dt_alloc1, dt_alloc2
+pointer	dt, str
+
+int	open(), fscan(), strlen()
+bool	streq()
+long	note()
+errchk	delete, open
+
+begin
+	if (mode == NEW_FILE)
+	    iferr (call delete (database))
+		;
+
+	i = open (database, mode, TEXT_FILE)
+
+	call calloc (dt, DT_LEN, TY_STRUCT)
+	DT(dt) = i
+
+	if (mode != READ_ONLY)
+	    return (dt)
+
+	dt_alloc1 = DT_ALLOC
+	dt_alloc2 = DT_ALLOC * SZ_LINE
+	call malloc (DT_OFFSETS(dt), dt_alloc1, TY_LONG)
+	call malloc (DT_NAMES(dt), dt_alloc1, TY_INT)
+	call malloc (DT_MAP(dt), dt_alloc2, TY_CHAR)
+	call malloc (str, SZ_LINE, TY_CHAR)
+
+	nrec = 1
+	DT_NRECS(dt) = 0
+	DT_NAMEI(dt, nrec) = 0
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (DT_NAME(dt, nrec), SZ_LINE)
+
+	    if (streq (DT_NAME(dt, nrec), "begin")) {
+	        call gargstr (Memc[str], SZ_LINE)
+		for (i=str; IS_WHITE(Memc[i]); i=i+1)
+		    ;
+		call strcpy (Memc[i], DT_NAME(dt,nrec), SZ_LINE)
+
+		for (i = 1; i < nrec; i = i + 1)
+		    if (streq (DT_NAME(dt, i), DT_NAME(dt, nrec)))
+			break
+
+		if (i < nrec)
+		    DT_OFFSET(dt, i) = note (DT(dt))
+		else {
+		    DT_NRECS(dt) = nrec
+		    DT_OFFSET(dt, nrec) = note (DT(dt))
+		    DT_NAMEI(dt, nrec+1) = DT_NAMEI(dt, nrec) +
+			strlen (DT_NAME(dt, nrec)) + 1
+		    nrec = nrec + 1
+		}
+
+		if (nrec == dt_alloc1) {
+		    dt_alloc1 = dt_alloc1 + DT_ALLOC
+		    call realloc (DT_OFFSETS(dt), dt_alloc1, TY_LONG)
+		    call realloc (DT_NAMES(dt), dt_alloc1, TY_INT)
+		}
+		if (DT_NAMEI(dt, nrec) + SZ_LINE >= dt_alloc2) {
+		    dt_alloc2 = dt_alloc2 + DT_ALLOC * SZ_LINE
+		    call realloc (DT_MAP(dt), dt_alloc2, TY_CHAR)
+		}
+	    }
+	}
+
+	call realloc (DT_MAP(dt), DT_NAMEI(dt, nrec), TY_CHAR)
+	call realloc (DT_OFFSETS(dt), DT_NRECS(dt), TY_LONG)
+	call realloc (DT_NAMES(dt), DT_NRECS(dt), TY_INT)
+	call mfree (str, TY_CHAR)
+
+	return (dt)
+end
+
+
+# DTCLOSE -- Close database.
+
+procedure dtunmap (dt)
+
+pointer	dt				# Database file descriptor
+
+begin
+	if (dt == NULL)
+	    return
+	call close (DT(dt))
+	call mfree (DT_MAP(dt), TY_CHAR)
+	call mfree (DT_OFFSETS(dt), TY_LONG)
+	call mfree (DT_NAMES(dt), TY_INT)
+	call mfree (dt, TY_STRUCT)
+end
+
+
+# DTLOCATE -- Locate a database record.
+
+int procedure dtlocate (dt, name)
+
+pointer	dt				# DTTEXT pointer
+char	name[ARB]			# Record name
+
+int	i
+
+bool	streq()
+
+begin
+	do i = 1, DT_NRECS(dt) {
+	    if (streq (name, DT_NAME(dt, i)))
+		return (i)
+	}
+
+#	call printf ("Record = %s\n")
+#	    call pargstr (name)
+#	call flush (STDOUT)
+	call error (0, "Database record not found")
+end
+
+
+# DTGSTR -- Get a string field
+
+procedure dtgstr (dt, record, field, str, maxchar)
+
+pointer	dt				# Database file descriptor
+int	record				# Database index
+char	field[ARB]			# Database field
+char	str[maxchar]			# String value
+int	maxchar				# Maximum characters for string
+
+char	name[SZ_LINE]
+int	i, fscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargstr (str, maxchar)
+		for (i=1; IS_WHITE(str[i]); i=i+1)
+		    ;
+		if (i > 1)
+		    call strcpy (str[i], str, maxchar)
+		return
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTGETI -- Get an integer field
+
+int procedure dtgeti (dt, record, field)
+
+pointer	dt				# DTTEXT pointer
+int	record				# Database index
+char	field[ARB]			# Database field
+
+int	ival				# Field value
+char	name[SZ_LINE]
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (ival)
+		if (nscan() == 2)
+		   return (ival)
+		else
+		   call error (0, "Error in database field value")
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTGETR -- Get an real field
+
+real procedure dtgetr (dt, record, field)
+
+pointer	dt				# DTTEXT pointer
+int	record				# Database index
+char	field[ARB]			# Database field
+
+real	rval
+char	name[SZ_LINE]
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargr (rval)
+		if (nscan() == 2)
+		   return (rval)
+		else
+		   call error (0, "Error in database field value")
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTGETD -- Get a doubel precision field.
+
+double procedure dtgetd (dt, record, field)
+
+pointer dt                              # DTTEXT pointer
+int     record                          # Database index
+char    field[ARB]                      # Database field
+
+double  dval
+char    name[SZ_LINE]
+
+int     fscan(), nscan()
+bool    streq()
+
+begin
+        if ((record < 1) || (record > DT_NRECS(dt)))
+            call error (0, "Database record request out of bounds")
+
+        call seek (DT(dt), DT_OFFSET(dt, record))
+
+        while (fscan (DT(dt)) != EOF) {
+            call gargwrd (name, SZ_LINE)
+
+            if (streq (name, "begin"))
+                break
+            else if (streq (name, field)) {
+                call gargd (dval)
+                if (nscan() == 2)
+                   return (dval)
+                else
+                   call error (0, "Error in database field value")
+            }
+        }
+
+        call error (0, "Database field not found")
+end
+
+
+# DTGAR -- Get a real array field
+
+procedure dtgar (dt, record, field, array, len_array, npts)
+
+pointer	dt				# DTTEXT pointer
+int	record				# Database index
+char	field[ARB]			# Database field
+real	array[len_array]		# Array values
+int	len_array			# Length of array
+int	npts				# Number of points in the array
+
+char	name[SZ_LINE]
+int	i
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (npts)
+		if (nscan() != 2)
+		    call error (0, "Error in database field value")
+
+		npts = min (npts, len_array)
+		for (i = 1; i <= npts; i = i + 1) {
+		    if (fscan (DT(dt)) == EOF)
+		        call error (0, "Error in database field value")
+
+		    call gargr (array[i])
+		    if (nscan() != 1)
+		        call error (0, "Error in database field value")
+		}
+		return
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTGAD -- Get a double array field
+
+procedure dtgad (dt, record, field, array, len_array, npts)
+
+pointer	dt				# DTTEXT pointer
+int	record				# Database index
+char	field[ARB]			# Database field
+double	array[len_array]		# Array values
+int	len_array			# Length of array
+int	npts				# Number of points in the array
+
+char	name[SZ_LINE]
+int	i
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (npts)
+		if (nscan() != 2)
+		    call error (0, "Error in database field value")
+
+		npts = min (npts, len_array)
+		for (i = 1; i <= npts; i = i + 1) {
+		    if (fscan (DT(dt)) == EOF)
+		        call error (0, "Error in database field value")
+
+		    call gargd (array[i])
+		    if (nscan() != 1)
+		        call error (0, "Error in database field value")
+		}
+		return
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTPTIME -- Put a time string with a comment
+
+procedure dtptime (dt)
+
+pointer	dt				# DTTEXT pointer
+
+char	timestr[SZ_TIME]
+long	time, clktime()
+
+begin
+	time = clktime (0)
+	call cnvtime (time, timestr, SZ_TIME)
+	call fprintf (DT(dt), "# %s\n")
+	    call pargstr (timestr)
+end
+
+
+# DTPUT -- Print to database.
+
+procedure dtput (dt, format)
+
+pointer	dt				# DTTEXT pointer
+char	format[ARB]			# String format
+
+begin
+	call fprintf (DT(dt), format)
+end
+
+# DTSCAN -- Scan database.
+
+int procedure dtscan (dt)
+
+pointer	dt				# DTTEXT pointer
+
+int	fscan()
+
+begin
+	return (fscan (DT(dt)))
+end
+
+
+include	<finfo.h>
+
+# DTMAP1 -- Map database.
+#
+# The database name may be a regular file or a directory.  If it is a
+# directory a database file with the name given by key is read or appended.
+
+pointer procedure dtmap1 (database, key, mode)
+
+char	database[ARB]		# Database
+char	key[ARB]		# Key
+int	mode			# Mode
+
+pointer	sp, dbfile, dt
+
+int	isdirectory(), access(), stridxs()
+pointer	dtmap()
+
+errchk	dtmap()
+
+begin
+	call smark (sp)
+	call salloc (dbfile, SZ_PATHNAME + SZ_FNAME, TY_CHAR)
+
+	# Check if the database does not exist create it as a directory.
+
+	if (access (database, READ_ONLY, DIRECTORY_FILE) == NO)
+	    if ((mode == APPEND) || (mode == NEW_FILE)) {
+		if (stridxs (".", database) != 0)
+		    call error (0,
+			"Periods not allowed in database directory name")
+		iferr (call fmkdir (database))
+		    call error (0, "Can't make database directory")
+	    }
+
+	if (isdirectory (database, Memc[dbfile], SZ_PATHNAME + SZ_FNAME) > 0)
+	    call strcat (key, Memc[dbfile], SZ_PATHNAME + SZ_FNAME)
+	else
+	    call strcpy (database, Memc[dbfile], SZ_PATHNAME + SZ_FNAME)
+
+	dt = dtmap (Memc[dbfile], mode)
+	call strcpy (database, DT_DNAME(dt), DT_SZFNAME)
+	call strcpy (key, DT_FNAME(dt), DT_SZFNAME)
+	DT_MODE(dt) = mode
+
+	call sfree (sp)
+	return (dt)
+end
+
+
+# DTREMAP -- Check if database needs to be remapped.
+#
+# If the pointer is null simply map the database.
+# If the pointer is not null check if the requested database is the same
+# as the current one and if not close the current database and map the
+# new one.  Note that remapping between read and append will not update
+# the entry data structure to include any information written.
+
+procedure dtremap (dt, dname, fname, mode)
+
+pointer	dt			# Database pointer
+char	dname[ARB]		# Directory name
+char	fname[ARB]		# File name
+int	mode			# Mode
+
+int	i, open()
+bool	strne()
+pointer	dbfile, dtmap1()
+errchk	dtmap1, dtunmap
+
+begin
+	if (dt != NULL) {
+	    if (strne (dname, DT_DNAME(dt)) || strne (fname, DT_FNAME(dt))) {
+		call dtunmap (dt)
+	    } else if (mode != DT_MODE(dt)) {
+		i = SZ_PATHNAME + SZ_FNAME
+		call malloc (dbfile, i, TY_CHAR)
+		call fstats (DT(dt), F_FILENAME, Memc[dbfile], i)
+		call close (DT(dt))
+		iferr (i = open (Memc[dbfile], mode, TEXT_FILE)) {
+		    DT(dt) = NULL
+		    call dtunmap (dt)
+		    call mfree (dbfile, TY_CHAR)
+		    call erract (EA_ERROR)
+		}
+		DT(dt) = i
+		DT_MODE(dt) = mode
+		call mfree (dbfile, TY_CHAR)
+	    }
+	}
+
+	if (dt == NULL) {
+	    i = dtmap1 (dname, fname, mode)
+	    dt = i
+	}
+end
diff --git a/pkg/xtools/extrema.x b/pkg/xtools/extrema.x
new file mode 100644
index 00000000..0a373aa5
--- /dev/null
+++ b/pkg/xtools/extrema.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	ORDER		4	# The order of the spline
+
+# EXTREMA -- Find the extrema in an array of x and y points.
+# The input data points are fitted with a cubic interpolation spline.  The
+# spline is then searched for points where the first derivative changes sign.
+# The minimum step size of this search is controlled by the parameter dx.
+# The positions of these extrema are returned in the x array, the value of the
+# spline at the extrema are returned in the y array, and the curvature or
+# second derivative of the spline at the extrema are returned in the
+# curvature array.  The function returns the number of extrema found.
+
+int procedure extrema (x, y, curvature, npts, dx)
+
+real	x[npts], y[npts]	# Input data points and output extrema
+real	curvature[npts]		# 2nd deriv. of cubic spline at extrema
+int	npts			# Number of input data points
+real	dx			# Precision of extrema positions
+
+int	i, ier, nextrema
+real	xeval, left_deriv, right_deriv
+pointer	sp, bspln, q
+real	seval()
+errchk	salloc, seval
+
+begin
+	# Allocate working arrays for spline routines
+	call smark (sp)
+	call salloc (bspln, 2 * npts + 30, TY_REAL)
+	call salloc (q, (2 * ORDER - 1) * npts, TY_REAL)
+
+	# Calculate the spline coefficients
+	call spline (x, y, npts, Memr[bspln], Memr[q], ORDER, ier)
+	if (ier != 0) {
+	    call sfree (sp)
+	    return (0)
+	}
+
+	# Initialize the curvature array
+	call aclrr (curvature, npts)
+
+	# Find the extrema defined by a change in sign in the first derivative.
+	nextrema = 0
+	left_deriv = seval (x[1], 1, Memr[bspln])
+	do i = 2, npts {
+	    xeval = x[i]
+	    right_deriv = seval (xeval, 1, Memr[bspln])
+	    if (left_deriv * right_deriv <= 0.) {
+		for (xeval = x[i - 1] + dx; xeval <= x[i]; xeval = xeval + dx) {
+		    right_deriv = seval (xeval, 1, Memr[bspln])
+	    	    if (left_deriv * right_deriv <= 0.)
+			break
+		    left_deriv = right_deriv
+		}
+		nextrema = nextrema + 1
+		x[nextrema] = xeval
+		y[nextrema] = seval (xeval, 0, Memr[bspln])
+		curvature[nextrema] = seval (xeval, 2, Memr[bspln])
+		if (curvature[nextrema] == 0.)
+		    nextrema = nextrema - 1
+		if (nextrema == npts)
+		    break
+	    }
+	    left_deriv = right_deriv
+	}
+
+	call sfree (sp)
+	return (nextrema)
+end
diff --git a/pkg/xtools/fixpix/mkpkg b/pkg/xtools/fixpix/mkpkg
new file mode 100644
index 00000000..4d91ae71
--- /dev/null
+++ b/pkg/xtools/fixpix/mkpkg
@@ -0,0 +1,25 @@
+# XT_FIXPIX package.
+
+$checkout libxtools.a lib$
+$update	  libxtools.a
+$checkin  libxtools.a lib$
+$exit
+
+generic:
+	$set	GEN = "$$generic -k"
+	$ifolder (xtfp.x, xtfp.gx)
+	    $(GEN) xtfp.gx -o xtfp.x $endif
+	;
+
+libxtools.a:
+	$ifeq (USE_GENERIC, yes) $call generic $endif
+
+	setfp.x		<imhdr.h> <imset.h> <pmset.h>
+	xtfixpix.x	<imhdr.h> <imset.h> <pmset.h> xtfixpix.h
+	xtfp.x		<imhdr.h> <pmset.h> xtfixpix.h
+	xtpmmap.x	<ctype.h> <error.h> <imhdr.h> <imset.h> <mach.h>\
+			<mwset.h> <pmset.h>
+	ytfixpix.x	<imhdr.h> <imset.h> <pmset.h> xtfixpix.h
+	ytpmmap.x	<ctype.h> <error.h> <imhdr.h> <imset.h> <mach.h>\
+			<mwset.h> <pmset.h>
+	;
diff --git a/pkg/xtools/fixpix/setfp.x b/pkg/xtools/fixpix/setfp.x
new file mode 100644
index 00000000..5fe2f5c1
--- /dev/null
+++ b/pkg/xtools/fixpix/setfp.x
@@ -0,0 +1,72 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imset.h>
+include	<pmset.h>
+
+
+# SET_FP -- Set the fixpix mask.
+#
+# This routine transforms the input mask values into the output mask
+# values.  It allows the input mask to have two classes of bad pixels;
+# those which are interpolated and those which are not.
+
+procedure set_fp (im, fp)
+
+pointer	im			#I Input mask image pointer
+pointer	fp			#O FIXPIX interpolation pointer
+
+int	i, j, nc, nl
+long	v[2]
+pointer	data1, data2, pm, pmi
+
+int	imstati(), pm_newcopy()
+pointer	yt_fpinit()
+errchk	malloc, yt_fpinit
+
+begin
+	# Set the image size and data buffers.
+	nc = IM_LEN(im,1)
+	nl = IM_LEN(im,2)
+	call malloc (data1, nc, TY_SHORT)
+	call malloc (data2, nc, TY_SHORT)
+
+	# Get the pixel mask from the image.
+	pm = imstati (im, IM_PMDES)
+
+	# Extract the pixels to be interpolated.
+	pmi = pm_newcopy (pm)
+	v[1] = 1
+	do j = 1, nl {
+	    v[2] = j
+	    call pmglps (pm, v, Mems[data1], 0, nc, PIX_SRC)
+	    do i = 0, nc-1 {
+	        if (Mems[data1+i] > 1)
+		    Mems[data1+i] = 0
+	    }
+	    call pmplps (pmi, v, Mems[data1], 0, nc, PIX_SRC)
+	}
+
+	# Set the interpolation.
+	fp = yt_fpinit (pmi, 2, 3)
+
+	# Merge back the bad pixels which are not interpolated.
+	v[1] = 1
+	do j = 1, nl {
+	    v[2] = j
+	    call pmglps (pm, v, Mems[data1], 0, nc, PIX_SRC)
+	    call pmglps (pmi, v, Mems[data2], 0, nc, PIX_SRC)
+	    do i = 0, nc-1 {
+	        if (Mems[data2+i] != 0)
+		    Mems[data1+i] = Mems[data2+i]
+		else if (Mems[data1+i] > 1)
+		    Mems[data1+i] = 6
+	    }
+	    call pmplps (pm, v, Mems[data1], 0, nc, PIX_SRC)
+	}
+
+	# Finish up.
+	call mfree (data1, TY_SHORT)
+	call mfree (data2, TY_SHORT)
+	#call pm_close (pmi)
+end
diff --git a/pkg/xtools/fixpix/xtfixpix.h b/pkg/xtools/fixpix/xtfixpix.h
new file mode 100644
index 00000000..de30f65d
--- /dev/null
+++ b/pkg/xtools/fixpix/xtfixpix.h
@@ -0,0 +1,24 @@
+# XT_FIXPIX data structure.
+define	FP_LEN		13		# Length of FP structure
+define	FP_PM		Memi[$1]	# Pixel mask pointer
+define	FP_LVAL		Memi[$1+1]	# Mask value for line interpolation
+define	FP_CVAL		Memi[$1+2]	# Mask value for column interpolation
+define	FP_NCOLS	Memi[$1+3]	# Number of columns to interpolate
+define	FP_PCOL		Memi[$1+4]	# Pointer to columns
+define	FP_PL1		Memi[$1+5]	# Pointer to start lines
+define	FP_PL2		Memi[$1+6]	# Pointer to end lines
+define	FP_PV1		Memi[$1+7]	# Pointer to start values	
+define	FP_PV2		Memi[$1+8]	# Pointer to end values	
+define	FP_LMIN		Memi[$1+9]	# Minimum line
+define	FP_LMAX		Memi[$1+10]	# Maximum line
+define	FP_PIXTYPE	Memi[$1+11]	# Pixel type for values
+define	FP_DATA		Memi[$1+12]	# Data values
+
+define	FP_COL		Memi[FP_PCOL($1)+$2-1]
+define	FP_L1		Memi[FP_PL1($1)+$2-1]
+define	FP_L2		Memi[FP_PL2($1)+$2-1]
+define	FP_V1		(FP_PV1($1)+$2-1)
+define	FP_V2		(FP_PV2($1)+$2-1)
+
+define	FP_LDEF		1		# Default line interpolation code
+define	FP_CDEF		2		# Default column interpolation code
diff --git a/pkg/xtools/fixpix/xtfixpix.x b/pkg/xtools/fixpix/xtfixpix.x
new file mode 100644
index 00000000..500824b5
--- /dev/null
+++ b/pkg/xtools/fixpix/xtfixpix.x
@@ -0,0 +1,270 @@
+include	<imhdr.h>
+include	<imset.h>
+include	<pmset.h>
+include	"xtfixpix.h"
+
+
+# XT_FPINIT -- Initialize FIXPIX data structure.
+# If the mask is null or empty a null pointer is returned.
+# If the mask is not empty the mask is examined for bad pixels requiring
+# column interpolation.  The columns and interpolation endpoints are
+# recorded.  Note that line interpolation does not need to be mapped since
+# this can be done efficiently as the reference image is accessed line by
+# line.
+
+pointer procedure xt_fpinit (pm, lvalin, cvalin)
+
+pointer	pm			#I Pixel mask
+int	lvalin			#I Input line interpolation code
+int	cvalin			#I Input column interpolation code
+
+int	i, j, k, l, n, nc, nl, l1, l2, lmin, lmax, ncols, lval, cval, ncompress
+short	val
+long	v[IM_MAXDIM]
+pointer	fp, ptr, col, pl1, pl2
+pointer	sp, buf, cols
+
+bool	pm_empty()
+errchk	pmglrs, pmplrs()
+
+begin
+	# Check for empty mask.
+	if (pm == NULL)
+	    return (NULL)
+	if (pm_empty (pm))
+	    return (NULL)
+
+	# Get mask size.
+	call pm_gsize (pm, i, v, j)
+	nc = v[1]
+	nl = v[2]
+
+	# Allocate memory and data structure.
+	call smark (sp)
+	call salloc (buf, 3*max(nc, nl), TY_SHORT) 
+	call salloc (cols, nc, TY_SHORT)
+	call calloc (fp, FP_LEN, TY_STRUCT)
+
+	# Set the mask codes.  Go through the mask and change any mask codes
+	# that match the input mask code to the output mask code (if they are
+	# different).  This is done to move the mask codes to a range that
+	# won't conflict with the length values.  For any other code replace
+	# the value by the length of the bad region along the line.  This
+	# value will be used in comparison to the length along the column for
+	# setting the interpolation for the narrower dimension.
+
+	if ((IS_INDEFI(lvalin)||lvalin<1) && (IS_INDEFI(cvalin)||cvalin<1)) {
+	    lval = FP_LDEF
+	    cval = FP_CDEF
+	} else if (IS_INDEFI(lvalin) || lvalin < 1) {
+	    lval = FP_LDEF
+	    cval = mod (cvalin - 1, nc) + 1
+	    if (lval == cval)
+		lval = FP_CDEF
+	} else if (IS_INDEFI(cvalin) || cvalin < 1) {
+	    lval = mod (lvalin - 1, nc) + 1
+	    cval = FP_CDEF
+	    if (cval == lval)
+		cval = FP_LDEF
+	} else if (lvalin != cvalin) {
+	    lval = mod (lvalin - 1, nc) + 1
+	    cval = mod (cvalin - 1, nc) + 1
+	} else {
+	    call mfree (fp, TY_STRUCT)
+	    call sfree (sp)
+	    call error (1, "Interpolation codes cannot be the same")
+	}
+	call xt_fpsinterp (pm, nc, nl, v, Mems[buf], lvalin, cvalin, lval, cval)
+
+	# Go through and check if there is any need for column interpolation;
+	# i.e. are there any mask values different from the line interpolation.
+
+	call aclrs (Mems[cols], nc)
+	call amovkl (long(1), v, IM_MAXDIM)
+	do l = 1, nl {
+	    v[2] = l
+	    call pmglrs (pm, v, Mems[buf], 0, nc, 0)
+	    ptr = buf + 3
+	    do i = 2, Mems[buf] {
+		val = Mems[ptr+2]
+		if (val != lval) {
+		    val = 1
+		    n = Mems[ptr+1] 
+		    call amovks (val, Mems[cols+Mems[ptr]-1], n)
+		}
+		ptr = ptr + 3
+	    }
+	}
+	n = 0
+	do i = 1, nc
+	    if (Mems[cols+i-1] != 0)
+		n = n + 1
+
+	# If there are mask codes for either column interpolation or
+	# interpolation lengths along lines to compare against column
+	# interpolation check the interpolation length against the
+	# column and set the line interpolation endpoints to use.
+	# compute the minimum and maximum lines that are endpoints
+	# to restrict the random access pass that will be needed to
+	# get the endpoint values.
+
+	if (n > 0) {
+	    n = n + 10
+	    call malloc (col, n, TY_INT)
+	    call malloc (pl1, n, TY_INT)
+	    call malloc (pl2, n, TY_INT)
+	    ncols = 0
+	    lmin = nl
+	    lmax = 0
+	    ncompress = 0
+	    do i = 1, nc {
+		if (Mems[cols+i-1] == 0)
+		    next
+		v[1] = i
+		do l = 1, nl {
+		    v[2] = l
+		    call pmglps (pm, v, Mems[buf+l-1], 0, 1, 0)
+		}
+		for (l1=1; l1<=nl && Mems[buf+l1-1]==0; l1=l1+1)
+		    ;
+		while (l1 <= nl) {
+		    l1 = l1 - 1
+		    for (l2=l1+1; l2<=nl && Mems[buf+l2-1]!=0; l2=l2+1)
+			;
+		    j = 0
+		    k = nc + l2 - l1 - 1
+		    do l = l1+1, l2-1 {
+			val = Mems[buf+l-1]
+			if (val == cval)
+			    j = j + 1
+			else if (val > nc) {
+			    if (val > k) {
+				j = j + 1
+				val = cval
+			    } else
+				val = lval
+			    v[2] = l
+			    call pmplps (pm, v, val, 0, 1, PIX_SRC)
+			    ncompress = ncompress + 1
+			}
+		    }
+		    if (ncompress > 100) {
+			call pm_compress (pm)
+			ncompress = 0
+		    }
+		    if (j > 0) {
+			if (ncols == n) {
+			    n = n + 10
+			    call realloc (col, n, TY_INT)
+			    call realloc (pl1, n, TY_INT)
+			    call realloc (pl2, n, TY_INT)
+			}
+			j = 1 + l1 - 1
+			k = 1 + l2 - 1
+			lmin = min (lmin, j, k)
+			lmax = max (lmax, j, k)
+			Memi[col+ncols] = i
+			Memi[pl1+ncols] = j
+			Memi[pl2+ncols] = k
+			ncols = ncols + 1
+		    }
+		    for (l1=l2+1; l1<=nl && Mems[buf+l1-1]==0; l1=l1+1)
+			;
+		}
+	    }
+
+	    FP_LMIN(fp) = lmin
+	    FP_LMAX(fp) = lmax
+	    FP_NCOLS(fp) = ncols
+	    FP_PCOL(fp) = col
+	    FP_PL1(fp) = pl1
+	    FP_PL2(fp) = pl2
+	}
+
+	FP_PM(fp) = pm
+	FP_LVAL(fp) = lval
+	FP_CVAL(fp) = cval
+
+	call sfree (sp)
+	return (fp)
+end
+
+
+# XT_SINTERP -- Set length of line interpolation regions.
+# The mask values are set to the length of any column interpolation
+# plus an offset leaving any line and column interpolation codes
+# unchanged.  These values will be used in a second pass to compare
+# to the lengths of line interpolation and then the mask values will
+# be reset to one of the line or column interpolation codes based on
+# the minimum distance.
+
+procedure xt_fpsinterp (pm, nc, nl, v, data, lvalin, cvalin, lvalout, cvalout)
+
+pointer	pm		#I Pixel mask
+int	nc, nl		#I Mask size
+long	v[ARB]		#I Coordinate vector
+short	data[ARB]	#I Data buffer
+int	lvalin		#I Input line interpolation code
+int	cvalin		#I Input column interpolation code
+int	lvalout		#I Output line interpolation code
+int	cvalout		#I Output column interpolation code
+
+int	c, l, c1, c2, val
+bool	pm_linenotempty()
+
+begin
+	call amovkl (long(1), v, IM_MAXDIM)
+	do l = 1, nl {
+	    v[2] = l
+	    if (!pm_linenotempty (pm, v))
+		next
+	    
+	    call pmglps (pm, v, data, 0, nc, 0)
+
+	    for (c1=1; c1<=nc && data[c1]==0; c1=c1+1)
+		;
+	    while (c1 <= nc) {
+		for (c2=c1+1; c2<=nc && data[c2]!=0; c2=c2+1)
+		    ;
+		c2 = c2 - 1
+		do c = c1, c2 {
+		    val = data[c]
+		    if (val == lvalin) {
+			if (lvalin != lvalout)
+			    data[c] = lvalout
+		    } else if (val == cvalin) {
+			if (cvalin != cvalout)
+			    data[c] = cvalout
+		    } else {
+			data[c] = nc + c2 - c1 + 1
+		    }
+		}
+		for (c1=c2+2; c1<=nc && data[c1]==0; c1=c1+1)
+		    ;
+	    }
+
+	    call pmplps (pm, v, data, 0, nc, PIX_SRC)
+	}
+end
+
+
+# XT_FPFREE -- Free FIXPIX data structures.
+
+procedure xt_fpfree (fp)
+
+pointer	fp		#U FIXPIX data structure
+
+begin
+	if (fp == NULL)
+	    return
+	call mfree (FP_PCOL(fp), TY_INT)
+	call mfree (FP_PL1(fp), TY_INT)
+	call mfree (FP_PL2(fp), TY_INT)
+	if (FP_PV1(fp) != NULL)
+	    call mfree (FP_PV1(fp), FP_PIXTYPE(fp))
+	if (FP_PV2(fp) != NULL)
+	    call mfree (FP_PV2(fp), FP_PIXTYPE(fp))
+	if (FP_DATA(fp) != NULL)
+	    call mfree (FP_DATA(fp), FP_PIXTYPE(fp))
+	call mfree (fp, TY_STRUCT)
+end
diff --git a/pkg/xtools/fixpix/xtfp.gx b/pkg/xtools/fixpix/xtfp.gx
new file mode 100644
index 00000000..70893ff8
--- /dev/null
+++ b/pkg/xtools/fixpix/xtfp.gx
@@ -0,0 +1,275 @@
+include	<imhdr.h>
+include	<pmset.h>
+include	"xtfixpix.h"
+
+
+$for (silrd)
+
+# XT_FP -- Get the specified line of image data and replace bad pixels by
+# interpolation.
+
+pointer procedure xt_fp$t (fp, im, line, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+pointer	imgl2$t(), xt_fps$t()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2$t (im, line))
+
+	col1 = 1
+	col2 = IM_LEN(im,1)
+	line1 = 1
+	line2 = IM_LEN(im,2)
+
+	return (xt_fps$t (fp, im, line, col1, col2, line1, line2, fd))
+end
+
+
+# XT_FXS -- Get the specified line of image data and replace bad pixels by
+# interpolation within a specified section.
+
+pointer procedure xt_fps$t (fp, im, line, col1, col2, line1, line2, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+int	i, j, nc, nl, ncols, c1, c2, l1, l2, l3, l4
+long	v[IM_MAXDIM]
+$if (datatype == silr)
+real	a, b, c, d, val
+$else
+PIXEL	a, b, c, d, val
+$endif
+PIXEL	indef
+pointer	pm, data, bp
+
+bool	pm_linenotempty()
+pointer	imgl2$t(), xt_fpval$t()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2$t (im, line))
+
+	# Initialize
+	pm = FP_PM(fp)
+	nc = IM_LEN(im,1)
+	nl = IM_LEN(im,2)
+	ncols = FP_NCOLS(fp)
+	call amovkl (long(1), v, IM_MAXDIM)
+	v[2] = line
+
+	# If there might be column interpolation initialize value arrays.
+	if (ncols > 0 && FP_PV1(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_PIXEL
+	    call malloc (FP_PV1(fp), ncols, FP_PIXTYPE(fp))
+	    call malloc (FP_PV2(fp), ncols, FP_PIXTYPE(fp))
+	    indef = INDEF
+	    call amovk$t (indef, Mem$t[FP_V1(fp,1)], ncols)
+	    call amovk$t (indef, Mem$t[FP_V2(fp,1)], ncols)
+	}
+
+	# If there are no bad pixels in the line and the line contains
+	# no column interpolation endpoints return the data directly.
+	# Otherwise get the line and fill in any endpoints that may
+	# be used later.
+
+	if (!pm_linenotempty (pm, v)) {
+	    if (line < FP_LMIN(fp) || line > FP_LMAX(fp))
+		return (imgl2$t (im, line))
+	    else
+		return (xt_fpval$t (fp, im, line))
+	}
+
+	# Get the pixel mask.
+	call malloc (bp, nc, TY_SHORT)
+	call pmglps (pm, v, Mems[bp], 0, nc, PIX_SRC)
+	bp = bp - 1
+
+	# Check if any column interpolation endpoints are needed and
+	# set them.  Set any other endpoints on the same lines at
+	# the same time.
+
+	if (line >= FP_LMIN(fp) && line < FP_LMAX(fp)) {
+	    j = 1
+	    do i = col1, col2 {
+		if (Mems[bp+i] == FP_CVAL(fp)) {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			if (line>FP_L1(fp,j) && line<FP_L2(fp,j)) {
+			    if (IS_INDEF(Mem$t[FP_V1(fp,j)]))
+				data = xt_fpval$t (fp, im, FP_L1(fp,j))
+			    if (IS_INDEF(Mem$t[FP_V2(fp,j)]))
+				data = xt_fpval$t (fp, im, FP_L2(fp,j))
+			}
+		    }
+		}
+	    }
+	}
+
+	# Fix pixels by column or line interpolation.
+	if (FP_DATA(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_PIXEL
+	    call malloc (FP_DATA(fp), nc, FP_PIXTYPE(fp))
+	}
+	data = FP_DATA(fp)
+	call amov$t (Mem$t[xt_fpval$t(fp,im,line)], Mem$t[data], nc)
+	j = 1
+	for (c1=col1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+	    ;
+	while (c1 <= col2) {
+	    c1 = c1 - 1
+	    for (c2=c1+2; c2<=col2 && Mems[bp+c2]!=0; c2=c2+1)
+		;
+	    a = INDEF
+	    do i = c1+1, c2-1 {
+		if (Mems[bp+i] == FP_LVAL(fp)) {
+		    if (IS_INDEF(a)) {
+			if (c1 < col1 && c2 > col2) {
+			    c1 = c2 + 1
+			    next
+			}
+			if (c1 >= col1)
+			    a = Mem$t[data+c1-1]
+			else
+			    a = Mem$t[data+c2-1]
+			if (c2 <= col2)
+			    b = (Mem$t[data+c2-1] - a) / (c2 - c1)
+			else
+			    b = 0.
+		    }
+		    val = a + b * (i - c1)
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call parg$t (Mem$t[data+i-1])
+			    $if (datatype == silr)
+			    call pargr (val)
+			    $else
+			    call parg$t (val)
+			    $endif
+			if (c1 >= col1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c1)
+			    call pargi (line)
+			}
+			if (c2 <= col2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c2)
+			    call pargi (line)
+			}
+			call fprintf (fd, "\n")
+		    }
+		} else {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			l1 = FP_L1(fp,j)
+			l2 = FP_L2(fp,j)
+			if (l1 < line1 && l2 > line2)
+			    next
+			if (line > l1 && line < l2) {
+			    if (l1 >= line1)
+				c = Mem$t[FP_V1(fp,j)]
+			    else
+				c = Mem$t[FP_V2(fp,j)]
+			    if (l2 <= line2) {
+				d = (Mem$t[FP_V2(fp,j)] - c) / (l2 - l1)
+				val = c + d * (line - l1)
+			    } else
+				val = c
+			    l3 = l1
+			    l4 = l2
+			}
+		    }
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call parg$t (Mem$t[data+i-1])
+			    $if (datatype == silr)
+			    call pargr (val)
+			    $else
+			    call parg$t (val)
+			    $endif
+			if (l1 >= line1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l3)
+			}
+			if (l2 <= line2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l4)
+			}
+			call fprintf (fd, "\n")
+		    }
+		}
+		$if (datatype == sil)
+		Mem$t[data+i-1] = nint (val)
+		$else
+		Mem$t[data+i-1] = val
+		$endif
+	    }
+	    for (c1=c2+1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+		;
+	}
+
+	call mfree (bp, TY_SHORT)
+	return (data)
+end
+
+
+# XT_FPVAL -- Get data for the specified line and set the values for
+# all column interpolation endpoints which occur at that line.
+
+pointer procedure xt_fpval$t (fp, im, line)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+
+int	i
+pointer	data, imgl2$t()
+
+begin
+	# Set out of bounds values to 0.  These are not used but we need
+	# to cancel the INDEF values.
+	if (line < 1 || line > IM_LEN(im,2)) {
+	    do i = 1, FP_NCOLS(fp) {
+		if (line == FP_L1(fp,i))
+		    Mem$t[FP_V1(fp,i)] = 0.
+		else if (line == FP_L2(fp,i))
+		    Mem$t[FP_V2(fp,i)] = 0.
+	    }
+	    return (NULL)
+	}
+
+	data = imgl2$t (im, line)
+	do i = 1, FP_NCOLS(fp) {
+	    if (line == FP_L1(fp,i))
+		Mem$t[FP_V1(fp,i)] = Mem$t[data+FP_COL(fp,i)-1]
+	    else if (line == FP_L2(fp,i))
+		Mem$t[FP_V2(fp,i)] = Mem$t[data+FP_COL(fp,i)-1]
+	}
+
+	return (data)
+end
+
+$endfor
diff --git a/pkg/xtools/fixpix/xtfp.x b/pkg/xtools/fixpix/xtfp.x
new file mode 100644
index 00000000..774ffa12
--- /dev/null
+++ b/pkg/xtools/fixpix/xtfp.x
@@ -0,0 +1,1271 @@
+include	<imhdr.h>
+include	<pmset.h>
+include	"xtfixpix.h"
+
+
+
+
+# XT_FP -- Get the specified line of image data and replace bad pixels by
+# interpolation.
+
+pointer procedure xt_fps (fp, im, line, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+pointer	imgl2s(), xt_fpss()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2s (im, line))
+
+	col1 = 1
+	col2 = IM_LEN(im,1)
+	line1 = 1
+	line2 = IM_LEN(im,2)
+
+	return (xt_fpss (fp, im, line, col1, col2, line1, line2, fd))
+end
+
+
+# XT_FXS -- Get the specified line of image data and replace bad pixels by
+# interpolation within a specified section.
+
+pointer procedure xt_fpss (fp, im, line, col1, col2, line1, line2, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+int	i, j, nc, nl, ncols, c1, c2, l1, l2, l3, l4
+long	v[IM_MAXDIM]
+real	a, b, c, d, val
+short	indef
+pointer	pm, data, bp
+
+bool	pm_linenotempty()
+pointer	imgl2s(), xt_fpvals()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2s (im, line))
+
+	# Initialize
+	pm = FP_PM(fp)
+	nc = IM_LEN(im,1)
+	nl = IM_LEN(im,2)
+	ncols = FP_NCOLS(fp)
+	call amovkl (long(1), v, IM_MAXDIM)
+	v[2] = line
+
+	# If there might be column interpolation initialize value arrays.
+	if (ncols > 0 && FP_PV1(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_SHORT
+	    call malloc (FP_PV1(fp), ncols, FP_PIXTYPE(fp))
+	    call malloc (FP_PV2(fp), ncols, FP_PIXTYPE(fp))
+	    indef = INDEFS
+	    call amovks (indef, Mems[FP_V1(fp,1)], ncols)
+	    call amovks (indef, Mems[FP_V2(fp,1)], ncols)
+	}
+
+	# If there are no bad pixels in the line and the line contains
+	# no column interpolation endpoints return the data directly.
+	# Otherwise get the line and fill in any endpoints that may
+	# be used later.
+
+	if (!pm_linenotempty (pm, v)) {
+	    if (line < FP_LMIN(fp) || line > FP_LMAX(fp))
+		return (imgl2s (im, line))
+	    else
+		return (xt_fpvals (fp, im, line))
+	}
+
+	# Get the pixel mask.
+	call malloc (bp, nc, TY_SHORT)
+	call pmglps (pm, v, Mems[bp], 0, nc, PIX_SRC)
+	bp = bp - 1
+
+	# Check if any column interpolation endpoints are needed and
+	# set them.  Set any other endpoints on the same lines at
+	# the same time.
+
+	if (line >= FP_LMIN(fp) && line < FP_LMAX(fp)) {
+	    j = 1
+	    do i = col1, col2 {
+		if (Mems[bp+i] == FP_CVAL(fp)) {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			if (line>FP_L1(fp,j) && line<FP_L2(fp,j)) {
+			    if (IS_INDEFS(Mems[FP_V1(fp,j)]))
+				data = xt_fpvals (fp, im, FP_L1(fp,j))
+			    if (IS_INDEFS(Mems[FP_V2(fp,j)]))
+				data = xt_fpvals (fp, im, FP_L2(fp,j))
+			}
+		    }
+		}
+	    }
+	}
+
+	# Fix pixels by column or line interpolation.
+	if (FP_DATA(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_SHORT
+	    call malloc (FP_DATA(fp), nc, FP_PIXTYPE(fp))
+	}
+	data = FP_DATA(fp)
+	call amovs (Mems[xt_fpvals(fp,im,line)], Mems[data], nc)
+	j = 1
+	for (c1=col1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+	    ;
+	while (c1 <= col2) {
+	    c1 = c1 - 1
+	    for (c2=c1+2; c2<=col2 && Mems[bp+c2]!=0; c2=c2+1)
+		;
+	    a = INDEFS
+	    do i = c1+1, c2-1 {
+		if (Mems[bp+i] == FP_LVAL(fp)) {
+		    if (IS_INDEFS(a)) {
+			if (c1 < col1 && c2 > col2) {
+			    c1 = c2 + 1
+			    next
+			}
+			if (c1 >= col1)
+			    a = Mems[data+c1-1]
+			else
+			    a = Mems[data+c2-1]
+			if (c2 <= col2)
+			    b = (Mems[data+c2-1] - a) / (c2 - c1)
+			else
+			    b = 0.
+		    }
+		    val = a + b * (i - c1)
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargs (Mems[data+i-1])
+			    call pargr (val)
+			if (c1 >= col1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c1)
+			    call pargi (line)
+			}
+			if (c2 <= col2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c2)
+			    call pargi (line)
+			}
+			call fprintf (fd, "\n")
+		    }
+		} else {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			l1 = FP_L1(fp,j)
+			l2 = FP_L2(fp,j)
+			if (l1 < line1 && l2 > line2)
+			    next
+			if (line > l1 && line < l2) {
+			    if (l1 >= line1)
+				c = Mems[FP_V1(fp,j)]
+			    else
+				c = Mems[FP_V2(fp,j)]
+			    if (l2 <= line2) {
+				d = (Mems[FP_V2(fp,j)] - c) / (l2 - l1)
+				val = c + d * (line - l1)
+			    } else
+				val = c
+			    l3 = l1
+			    l4 = l2
+			}
+		    }
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargs (Mems[data+i-1])
+			    call pargr (val)
+			if (l1 >= line1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l3)
+			}
+			if (l2 <= line2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l4)
+			}
+			call fprintf (fd, "\n")
+		    }
+		}
+		Mems[data+i-1] = nint (val)
+	    }
+	    for (c1=c2+1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+		;
+	}
+
+	call mfree (bp, TY_SHORT)
+	return (data)
+end
+
+
+# XT_FPVAL -- Get data for the specified line and set the values for
+# all column interpolation endpoints which occur at that line.
+
+pointer procedure xt_fpvals (fp, im, line)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+
+int	i
+pointer	data, imgl2s()
+
+begin
+	# Set out of bounds values to 0.  These are not used but we need
+	# to cancel the INDEF values.
+	if (line < 1 || line > IM_LEN(im,2)) {
+	    do i = 1, FP_NCOLS(fp) {
+		if (line == FP_L1(fp,i))
+		    Mems[FP_V1(fp,i)] = 0.
+		else if (line == FP_L2(fp,i))
+		    Mems[FP_V2(fp,i)] = 0.
+	    }
+	    return (NULL)
+	}
+
+	data = imgl2s (im, line)
+	do i = 1, FP_NCOLS(fp) {
+	    if (line == FP_L1(fp,i))
+		Mems[FP_V1(fp,i)] = Mems[data+FP_COL(fp,i)-1]
+	    else if (line == FP_L2(fp,i))
+		Mems[FP_V2(fp,i)] = Mems[data+FP_COL(fp,i)-1]
+	}
+
+	return (data)
+end
+
+
+
+# XT_FP -- Get the specified line of image data and replace bad pixels by
+# interpolation.
+
+pointer procedure xt_fpi (fp, im, line, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+pointer	imgl2i(), xt_fpsi()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2i (im, line))
+
+	col1 = 1
+	col2 = IM_LEN(im,1)
+	line1 = 1
+	line2 = IM_LEN(im,2)
+
+	return (xt_fpsi (fp, im, line, col1, col2, line1, line2, fd))
+end
+
+
+# XT_FXS -- Get the specified line of image data and replace bad pixels by
+# interpolation within a specified section.
+
+pointer procedure xt_fpsi (fp, im, line, col1, col2, line1, line2, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+int	i, j, nc, nl, ncols, c1, c2, l1, l2, l3, l4
+long	v[IM_MAXDIM]
+real	a, b, c, d, val
+int	indef
+pointer	pm, data, bp
+
+bool	pm_linenotempty()
+pointer	imgl2i(), xt_fpvali()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2i (im, line))
+
+	# Initialize
+	pm = FP_PM(fp)
+	nc = IM_LEN(im,1)
+	nl = IM_LEN(im,2)
+	ncols = FP_NCOLS(fp)
+	call amovkl (long(1), v, IM_MAXDIM)
+	v[2] = line
+
+	# If there might be column interpolation initialize value arrays.
+	if (ncols > 0 && FP_PV1(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_INT
+	    call malloc (FP_PV1(fp), ncols, FP_PIXTYPE(fp))
+	    call malloc (FP_PV2(fp), ncols, FP_PIXTYPE(fp))
+	    indef = INDEFI
+	    call amovki (indef, Memi[FP_V1(fp,1)], ncols)
+	    call amovki (indef, Memi[FP_V2(fp,1)], ncols)
+	}
+
+	# If there are no bad pixels in the line and the line contains
+	# no column interpolation endpoints return the data directly.
+	# Otherwise get the line and fill in any endpoints that may
+	# be used later.
+
+	if (!pm_linenotempty (pm, v)) {
+	    if (line < FP_LMIN(fp) || line > FP_LMAX(fp))
+		return (imgl2i (im, line))
+	    else
+		return (xt_fpvali (fp, im, line))
+	}
+
+	# Get the pixel mask.
+	call malloc (bp, nc, TY_SHORT)
+	call pmglps (pm, v, Mems[bp], 0, nc, PIX_SRC)
+	bp = bp - 1
+
+	# Check if any column interpolation endpoints are needed and
+	# set them.  Set any other endpoints on the same lines at
+	# the same time.
+
+	if (line >= FP_LMIN(fp) && line < FP_LMAX(fp)) {
+	    j = 1
+	    do i = col1, col2 {
+		if (Mems[bp+i] == FP_CVAL(fp)) {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			if (line>FP_L1(fp,j) && line<FP_L2(fp,j)) {
+			    if (IS_INDEFI(Memi[FP_V1(fp,j)]))
+				data = xt_fpvali (fp, im, FP_L1(fp,j))
+			    if (IS_INDEFI(Memi[FP_V2(fp,j)]))
+				data = xt_fpvali (fp, im, FP_L2(fp,j))
+			}
+		    }
+		}
+	    }
+	}
+
+	# Fix pixels by column or line interpolation.
+	if (FP_DATA(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_INT
+	    call malloc (FP_DATA(fp), nc, FP_PIXTYPE(fp))
+	}
+	data = FP_DATA(fp)
+	call amovi (Memi[xt_fpvali(fp,im,line)], Memi[data], nc)
+	j = 1
+	for (c1=col1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+	    ;
+	while (c1 <= col2) {
+	    c1 = c1 - 1
+	    for (c2=c1+2; c2<=col2 && Mems[bp+c2]!=0; c2=c2+1)
+		;
+	    a = INDEFI
+	    do i = c1+1, c2-1 {
+		if (Mems[bp+i] == FP_LVAL(fp)) {
+		    if (IS_INDEFI(a)) {
+			if (c1 < col1 && c2 > col2) {
+			    c1 = c2 + 1
+			    next
+			}
+			if (c1 >= col1)
+			    a = Memi[data+c1-1]
+			else
+			    a = Memi[data+c2-1]
+			if (c2 <= col2)
+			    b = (Memi[data+c2-1] - a) / (c2 - c1)
+			else
+			    b = 0.
+		    }
+		    val = a + b * (i - c1)
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargi (Memi[data+i-1])
+			    call pargr (val)
+			if (c1 >= col1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c1)
+			    call pargi (line)
+			}
+			if (c2 <= col2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c2)
+			    call pargi (line)
+			}
+			call fprintf (fd, "\n")
+		    }
+		} else {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			l1 = FP_L1(fp,j)
+			l2 = FP_L2(fp,j)
+			if (l1 < line1 && l2 > line2)
+			    next
+			if (line > l1 && line < l2) {
+			    if (l1 >= line1)
+				c = Memi[FP_V1(fp,j)]
+			    else
+				c = Memi[FP_V2(fp,j)]
+			    if (l2 <= line2) {
+				d = (Memi[FP_V2(fp,j)] - c) / (l2 - l1)
+				val = c + d * (line - l1)
+			    } else
+				val = c
+			    l3 = l1
+			    l4 = l2
+			}
+		    }
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargi (Memi[data+i-1])
+			    call pargr (val)
+			if (l1 >= line1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l3)
+			}
+			if (l2 <= line2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l4)
+			}
+			call fprintf (fd, "\n")
+		    }
+		}
+		Memi[data+i-1] = nint (val)
+	    }
+	    for (c1=c2+1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+		;
+	}
+
+	call mfree (bp, TY_SHORT)
+	return (data)
+end
+
+
+# XT_FPVAL -- Get data for the specified line and set the values for
+# all column interpolation endpoints which occur at that line.
+
+pointer procedure xt_fpvali (fp, im, line)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+
+int	i
+pointer	data, imgl2i()
+
+begin
+	# Set out of bounds values to 0.  These are not used but we need
+	# to cancel the INDEF values.
+	if (line < 1 || line > IM_LEN(im,2)) {
+	    do i = 1, FP_NCOLS(fp) {
+		if (line == FP_L1(fp,i))
+		    Memi[FP_V1(fp,i)] = 0.
+		else if (line == FP_L2(fp,i))
+		    Memi[FP_V2(fp,i)] = 0.
+	    }
+	    return (NULL)
+	}
+
+	data = imgl2i (im, line)
+	do i = 1, FP_NCOLS(fp) {
+	    if (line == FP_L1(fp,i))
+		Memi[FP_V1(fp,i)] = Memi[data+FP_COL(fp,i)-1]
+	    else if (line == FP_L2(fp,i))
+		Memi[FP_V2(fp,i)] = Memi[data+FP_COL(fp,i)-1]
+	}
+
+	return (data)
+end
+
+
+
+# XT_FP -- Get the specified line of image data and replace bad pixels by
+# interpolation.
+
+pointer procedure xt_fpl (fp, im, line, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+pointer	imgl2l(), xt_fpsl()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2l (im, line))
+
+	col1 = 1
+	col2 = IM_LEN(im,1)
+	line1 = 1
+	line2 = IM_LEN(im,2)
+
+	return (xt_fpsl (fp, im, line, col1, col2, line1, line2, fd))
+end
+
+
+# XT_FXS -- Get the specified line of image data and replace bad pixels by
+# interpolation within a specified section.
+
+pointer procedure xt_fpsl (fp, im, line, col1, col2, line1, line2, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+int	i, j, nc, nl, ncols, c1, c2, l1, l2, l3, l4
+long	v[IM_MAXDIM]
+real	a, b, c, d, val
+long	indef
+pointer	pm, data, bp
+
+bool	pm_linenotempty()
+pointer	imgl2l(), xt_fpvall()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2l (im, line))
+
+	# Initialize
+	pm = FP_PM(fp)
+	nc = IM_LEN(im,1)
+	nl = IM_LEN(im,2)
+	ncols = FP_NCOLS(fp)
+	call amovkl (long(1), v, IM_MAXDIM)
+	v[2] = line
+
+	# If there might be column interpolation initialize value arrays.
+	if (ncols > 0 && FP_PV1(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_LONG
+	    call malloc (FP_PV1(fp), ncols, FP_PIXTYPE(fp))
+	    call malloc (FP_PV2(fp), ncols, FP_PIXTYPE(fp))
+	    indef = INDEFL
+	    call amovkl (indef, Meml[FP_V1(fp,1)], ncols)
+	    call amovkl (indef, Meml[FP_V2(fp,1)], ncols)
+	}
+
+	# If there are no bad pixels in the line and the line contains
+	# no column interpolation endpoints return the data directly.
+	# Otherwise get the line and fill in any endpoints that may
+	# be used later.
+
+	if (!pm_linenotempty (pm, v)) {
+	    if (line < FP_LMIN(fp) || line > FP_LMAX(fp))
+		return (imgl2l (im, line))
+	    else
+		return (xt_fpvall (fp, im, line))
+	}
+
+	# Get the pixel mask.
+	call malloc (bp, nc, TY_SHORT)
+	call pmglps (pm, v, Mems[bp], 0, nc, PIX_SRC)
+	bp = bp - 1
+
+	# Check if any column interpolation endpoints are needed and
+	# set them.  Set any other endpoints on the same lines at
+	# the same time.
+
+	if (line >= FP_LMIN(fp) && line < FP_LMAX(fp)) {
+	    j = 1
+	    do i = col1, col2 {
+		if (Mems[bp+i] == FP_CVAL(fp)) {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			if (line>FP_L1(fp,j) && line<FP_L2(fp,j)) {
+			    if (IS_INDEFL(Meml[FP_V1(fp,j)]))
+				data = xt_fpvall (fp, im, FP_L1(fp,j))
+			    if (IS_INDEFL(Meml[FP_V2(fp,j)]))
+				data = xt_fpvall (fp, im, FP_L2(fp,j))
+			}
+		    }
+		}
+	    }
+	}
+
+	# Fix pixels by column or line interpolation.
+	if (FP_DATA(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_LONG
+	    call malloc (FP_DATA(fp), nc, FP_PIXTYPE(fp))
+	}
+	data = FP_DATA(fp)
+	call amovl (Meml[xt_fpvall(fp,im,line)], Meml[data], nc)
+	j = 1
+	for (c1=col1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+	    ;
+	while (c1 <= col2) {
+	    c1 = c1 - 1
+	    for (c2=c1+2; c2<=col2 && Mems[bp+c2]!=0; c2=c2+1)
+		;
+	    a = INDEFL
+	    do i = c1+1, c2-1 {
+		if (Mems[bp+i] == FP_LVAL(fp)) {
+		    if (IS_INDEFL(a)) {
+			if (c1 < col1 && c2 > col2) {
+			    c1 = c2 + 1
+			    next
+			}
+			if (c1 >= col1)
+			    a = Meml[data+c1-1]
+			else
+			    a = Meml[data+c2-1]
+			if (c2 <= col2)
+			    b = (Meml[data+c2-1] - a) / (c2 - c1)
+			else
+			    b = 0.
+		    }
+		    val = a + b * (i - c1)
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargl (Meml[data+i-1])
+			    call pargr (val)
+			if (c1 >= col1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c1)
+			    call pargi (line)
+			}
+			if (c2 <= col2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c2)
+			    call pargi (line)
+			}
+			call fprintf (fd, "\n")
+		    }
+		} else {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			l1 = FP_L1(fp,j)
+			l2 = FP_L2(fp,j)
+			if (l1 < line1 && l2 > line2)
+			    next
+			if (line > l1 && line < l2) {
+			    if (l1 >= line1)
+				c = Meml[FP_V1(fp,j)]
+			    else
+				c = Meml[FP_V2(fp,j)]
+			    if (l2 <= line2) {
+				d = (Meml[FP_V2(fp,j)] - c) / (l2 - l1)
+				val = c + d * (line - l1)
+			    } else
+				val = c
+			    l3 = l1
+			    l4 = l2
+			}
+		    }
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargl (Meml[data+i-1])
+			    call pargr (val)
+			if (l1 >= line1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l3)
+			}
+			if (l2 <= line2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l4)
+			}
+			call fprintf (fd, "\n")
+		    }
+		}
+		Meml[data+i-1] = nint (val)
+	    }
+	    for (c1=c2+1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+		;
+	}
+
+	call mfree (bp, TY_SHORT)
+	return (data)
+end
+
+
+# XT_FPVAL -- Get data for the specified line and set the values for
+# all column interpolation endpoints which occur at that line.
+
+pointer procedure xt_fpvall (fp, im, line)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+
+int	i
+pointer	data, imgl2l()
+
+begin
+	# Set out of bounds values to 0.  These are not used but we need
+	# to cancel the INDEF values.
+	if (line < 1 || line > IM_LEN(im,2)) {
+	    do i = 1, FP_NCOLS(fp) {
+		if (line == FP_L1(fp,i))
+		    Meml[FP_V1(fp,i)] = 0.
+		else if (line == FP_L2(fp,i))
+		    Meml[FP_V2(fp,i)] = 0.
+	    }
+	    return (NULL)
+	}
+
+	data = imgl2l (im, line)
+	do i = 1, FP_NCOLS(fp) {
+	    if (line == FP_L1(fp,i))
+		Meml[FP_V1(fp,i)] = Meml[data+FP_COL(fp,i)-1]
+	    else if (line == FP_L2(fp,i))
+		Meml[FP_V2(fp,i)] = Meml[data+FP_COL(fp,i)-1]
+	}
+
+	return (data)
+end
+
+
+
+# XT_FP -- Get the specified line of image data and replace bad pixels by
+# interpolation.
+
+pointer procedure xt_fpr (fp, im, line, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+pointer	imgl2r(), xt_fpsr()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2r (im, line))
+
+	col1 = 1
+	col2 = IM_LEN(im,1)
+	line1 = 1
+	line2 = IM_LEN(im,2)
+
+	return (xt_fpsr (fp, im, line, col1, col2, line1, line2, fd))
+end
+
+
+# XT_FXS -- Get the specified line of image data and replace bad pixels by
+# interpolation within a specified section.
+
+pointer procedure xt_fpsr (fp, im, line, col1, col2, line1, line2, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+int	i, j, nc, nl, ncols, c1, c2, l1, l2, l3, l4
+long	v[IM_MAXDIM]
+real	a, b, c, d, val
+real	indef
+pointer	pm, data, bp
+
+bool	pm_linenotempty()
+pointer	imgl2r(), xt_fpvalr()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2r (im, line))
+
+	# Initialize
+	pm = FP_PM(fp)
+	nc = IM_LEN(im,1)
+	nl = IM_LEN(im,2)
+	ncols = FP_NCOLS(fp)
+	call amovkl (long(1), v, IM_MAXDIM)
+	v[2] = line
+
+	# If there might be column interpolation initialize value arrays.
+	if (ncols > 0 && FP_PV1(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_REAL
+	    call malloc (FP_PV1(fp), ncols, FP_PIXTYPE(fp))
+	    call malloc (FP_PV2(fp), ncols, FP_PIXTYPE(fp))
+	    indef = INDEFR
+	    call amovkr (indef, Memr[FP_V1(fp,1)], ncols)
+	    call amovkr (indef, Memr[FP_V2(fp,1)], ncols)
+	}
+
+	# If there are no bad pixels in the line and the line contains
+	# no column interpolation endpoints return the data directly.
+	# Otherwise get the line and fill in any endpoints that may
+	# be used later.
+
+	if (!pm_linenotempty (pm, v)) {
+	    if (line < FP_LMIN(fp) || line > FP_LMAX(fp))
+		return (imgl2r (im, line))
+	    else
+		return (xt_fpvalr (fp, im, line))
+	}
+
+	# Get the pixel mask.
+	call malloc (bp, nc, TY_SHORT)
+	call pmglps (pm, v, Mems[bp], 0, nc, PIX_SRC)
+	bp = bp - 1
+
+	# Check if any column interpolation endpoints are needed and
+	# set them.  Set any other endpoints on the same lines at
+	# the same time.
+
+	if (line >= FP_LMIN(fp) && line < FP_LMAX(fp)) {
+	    j = 1
+	    do i = col1, col2 {
+		if (Mems[bp+i] == FP_CVAL(fp)) {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			if (line>FP_L1(fp,j) && line<FP_L2(fp,j)) {
+			    if (IS_INDEFR(Memr[FP_V1(fp,j)]))
+				data = xt_fpvalr (fp, im, FP_L1(fp,j))
+			    if (IS_INDEFR(Memr[FP_V2(fp,j)]))
+				data = xt_fpvalr (fp, im, FP_L2(fp,j))
+			}
+		    }
+		}
+	    }
+	}
+
+	# Fix pixels by column or line interpolation.
+	if (FP_DATA(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_REAL
+	    call malloc (FP_DATA(fp), nc, FP_PIXTYPE(fp))
+	}
+	data = FP_DATA(fp)
+	call amovr (Memr[xt_fpvalr(fp,im,line)], Memr[data], nc)
+	j = 1
+	for (c1=col1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+	    ;
+	while (c1 <= col2) {
+	    c1 = c1 - 1
+	    for (c2=c1+2; c2<=col2 && Mems[bp+c2]!=0; c2=c2+1)
+		;
+	    a = INDEFR
+	    do i = c1+1, c2-1 {
+		if (Mems[bp+i] == FP_LVAL(fp)) {
+		    if (IS_INDEFR(a)) {
+			if (c1 < col1 && c2 > col2) {
+			    c1 = c2 + 1
+			    next
+			}
+			if (c1 >= col1)
+			    a = Memr[data+c1-1]
+			else
+			    a = Memr[data+c2-1]
+			if (c2 <= col2)
+			    b = (Memr[data+c2-1] - a) / (c2 - c1)
+			else
+			    b = 0.
+		    }
+		    val = a + b * (i - c1)
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargr (Memr[data+i-1])
+			    call pargr (val)
+			if (c1 >= col1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c1)
+			    call pargi (line)
+			}
+			if (c2 <= col2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c2)
+			    call pargi (line)
+			}
+			call fprintf (fd, "\n")
+		    }
+		} else {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			l1 = FP_L1(fp,j)
+			l2 = FP_L2(fp,j)
+			if (l1 < line1 && l2 > line2)
+			    next
+			if (line > l1 && line < l2) {
+			    if (l1 >= line1)
+				c = Memr[FP_V1(fp,j)]
+			    else
+				c = Memr[FP_V2(fp,j)]
+			    if (l2 <= line2) {
+				d = (Memr[FP_V2(fp,j)] - c) / (l2 - l1)
+				val = c + d * (line - l1)
+			    } else
+				val = c
+			    l3 = l1
+			    l4 = l2
+			}
+		    }
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargr (Memr[data+i-1])
+			    call pargr (val)
+			if (l1 >= line1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l3)
+			}
+			if (l2 <= line2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l4)
+			}
+			call fprintf (fd, "\n")
+		    }
+		}
+		Memr[data+i-1] = val
+	    }
+	    for (c1=c2+1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+		;
+	}
+
+	call mfree (bp, TY_SHORT)
+	return (data)
+end
+
+
+# XT_FPVAL -- Get data for the specified line and set the values for
+# all column interpolation endpoints which occur at that line.
+
+pointer procedure xt_fpvalr (fp, im, line)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+
+int	i
+pointer	data, imgl2r()
+
+begin
+	# Set out of bounds values to 0.  These are not used but we need
+	# to cancel the INDEF values.
+	if (line < 1 || line > IM_LEN(im,2)) {
+	    do i = 1, FP_NCOLS(fp) {
+		if (line == FP_L1(fp,i))
+		    Memr[FP_V1(fp,i)] = 0.
+		else if (line == FP_L2(fp,i))
+		    Memr[FP_V2(fp,i)] = 0.
+	    }
+	    return (NULL)
+	}
+
+	data = imgl2r (im, line)
+	do i = 1, FP_NCOLS(fp) {
+	    if (line == FP_L1(fp,i))
+		Memr[FP_V1(fp,i)] = Memr[data+FP_COL(fp,i)-1]
+	    else if (line == FP_L2(fp,i))
+		Memr[FP_V2(fp,i)] = Memr[data+FP_COL(fp,i)-1]
+	}
+
+	return (data)
+end
+
+
+
+# XT_FP -- Get the specified line of image data and replace bad pixels by
+# interpolation.
+
+pointer procedure xt_fpd (fp, im, line, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+pointer	imgl2d(), xt_fpsd()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2d (im, line))
+
+	col1 = 1
+	col2 = IM_LEN(im,1)
+	line1 = 1
+	line2 = IM_LEN(im,2)
+
+	return (xt_fpsd (fp, im, line, col1, col2, line1, line2, fd))
+end
+
+
+# XT_FXS -- Get the specified line of image data and replace bad pixels by
+# interpolation within a specified section.
+
+pointer procedure xt_fpsd (fp, im, line, col1, col2, line1, line2, fd)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+int	fd			#I File descriptor for pixel list
+
+int	col1, col2		#I Section of interest
+int	line1, line2		#I Section of interest
+
+int	i, j, nc, nl, ncols, c1, c2, l1, l2, l3, l4
+long	v[IM_MAXDIM]
+double	a, b, c, d, val
+double	indef
+pointer	pm, data, bp
+
+bool	pm_linenotempty()
+pointer	imgl2d(), xt_fpvald()
+
+begin
+	# If there are no bad pixels just get the image line and return.
+	if (fp == NULL)
+	    return (imgl2d (im, line))
+
+	# Initialize
+	pm = FP_PM(fp)
+	nc = IM_LEN(im,1)
+	nl = IM_LEN(im,2)
+	ncols = FP_NCOLS(fp)
+	call amovkl (long(1), v, IM_MAXDIM)
+	v[2] = line
+
+	# If there might be column interpolation initialize value arrays.
+	if (ncols > 0 && FP_PV1(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_DOUBLE
+	    call malloc (FP_PV1(fp), ncols, FP_PIXTYPE(fp))
+	    call malloc (FP_PV2(fp), ncols, FP_PIXTYPE(fp))
+	    indef = INDEFD
+	    call amovkd (indef, Memd[FP_V1(fp,1)], ncols)
+	    call amovkd (indef, Memd[FP_V2(fp,1)], ncols)
+	}
+
+	# If there are no bad pixels in the line and the line contains
+	# no column interpolation endpoints return the data directly.
+	# Otherwise get the line and fill in any endpoints that may
+	# be used later.
+
+	if (!pm_linenotempty (pm, v)) {
+	    if (line < FP_LMIN(fp) || line > FP_LMAX(fp))
+		return (imgl2d (im, line))
+	    else
+		return (xt_fpvald (fp, im, line))
+	}
+
+	# Get the pixel mask.
+	call malloc (bp, nc, TY_SHORT)
+	call pmglps (pm, v, Mems[bp], 0, nc, PIX_SRC)
+	bp = bp - 1
+
+	# Check if any column interpolation endpoints are needed and
+	# set them.  Set any other endpoints on the same lines at
+	# the same time.
+
+	if (line >= FP_LMIN(fp) && line < FP_LMAX(fp)) {
+	    j = 1
+	    do i = col1, col2 {
+		if (Mems[bp+i] == FP_CVAL(fp)) {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			if (line>FP_L1(fp,j) && line<FP_L2(fp,j)) {
+			    if (IS_INDEFD(Memd[FP_V1(fp,j)]))
+				data = xt_fpvald (fp, im, FP_L1(fp,j))
+			    if (IS_INDEFD(Memd[FP_V2(fp,j)]))
+				data = xt_fpvald (fp, im, FP_L2(fp,j))
+			}
+		    }
+		}
+	    }
+	}
+
+	# Fix pixels by column or line interpolation.
+	if (FP_DATA(fp) == NULL) {
+	    FP_PIXTYPE(fp) = TY_DOUBLE
+	    call malloc (FP_DATA(fp), nc, FP_PIXTYPE(fp))
+	}
+	data = FP_DATA(fp)
+	call amovd (Memd[xt_fpvald(fp,im,line)], Memd[data], nc)
+	j = 1
+	for (c1=col1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+	    ;
+	while (c1 <= col2) {
+	    c1 = c1 - 1
+	    for (c2=c1+2; c2<=col2 && Mems[bp+c2]!=0; c2=c2+1)
+		;
+	    a = INDEFD
+	    do i = c1+1, c2-1 {
+		if (Mems[bp+i] == FP_LVAL(fp)) {
+		    if (IS_INDEFD(a)) {
+			if (c1 < col1 && c2 > col2) {
+			    c1 = c2 + 1
+			    next
+			}
+			if (c1 >= col1)
+			    a = Memd[data+c1-1]
+			else
+			    a = Memd[data+c2-1]
+			if (c2 <= col2)
+			    b = (Memd[data+c2-1] - a) / (c2 - c1)
+			else
+			    b = 0.
+		    }
+		    val = a + b * (i - c1)
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargd (Memd[data+i-1])
+			    call pargd (val)
+			if (c1 >= col1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c1)
+			    call pargi (line)
+			}
+			if (c2 <= col2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (c2)
+			    call pargi (line)
+			}
+			call fprintf (fd, "\n")
+		    }
+		} else {
+		    for (; j<=ncols && FP_COL(fp,j)!=i; j=j+1)
+			;
+		    for (; j<=ncols && FP_COL(fp,j)==i; j=j+1) {
+			l1 = FP_L1(fp,j)
+			l2 = FP_L2(fp,j)
+			if (l1 < line1 && l2 > line2)
+			    next
+			if (line > l1 && line < l2) {
+			    if (l1 >= line1)
+				c = Memd[FP_V1(fp,j)]
+			    else
+				c = Memd[FP_V2(fp,j)]
+			    if (l2 <= line2) {
+				d = (Memd[FP_V2(fp,j)] - c) / (l2 - l1)
+				val = c + d * (line - l1)
+			    } else
+				val = c
+			    l3 = l1
+			    l4 = l2
+			}
+		    }
+		    if (fd != NULL) {
+			call fprintf (fd, "%4d %4d %8g %8g")
+			    call pargi (i)
+			    call pargi (line)
+			    call pargd (Memd[data+i-1])
+			    call pargd (val)
+			if (l1 >= line1) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l3)
+			}
+			if (l2 <= line2) {
+			    call fprintf (fd, " %4d %4d")
+			    call pargi (i)
+			    call pargi (l4)
+			}
+			call fprintf (fd, "\n")
+		    }
+		}
+		Memd[data+i-1] = val
+	    }
+	    for (c1=c2+1; c1<=col2 && Mems[bp+c1]==0; c1=c1+1)
+		;
+	}
+
+	call mfree (bp, TY_SHORT)
+	return (data)
+end
+
+
+# XT_FPVAL -- Get data for the specified line and set the values for
+# all column interpolation endpoints which occur at that line.
+
+pointer procedure xt_fpvald (fp, im, line)
+
+pointer	fp			#I FIXPIX pointer
+pointer	im			#I Image pointer
+int	line			#I Line
+
+int	i
+pointer	data, imgl2d()
+
+begin
+	# Set out of bounds values to 0.  These are not used but we need
+	# to cancel the INDEF values.
+	if (line < 1 || line > IM_LEN(im,2)) {
+	    do i = 1, FP_NCOLS(fp) {
+		if (line == FP_L1(fp,i))
+		    Memd[FP_V1(fp,i)] = 0.
+		else if (line == FP_L2(fp,i))
+		    Memd[FP_V2(fp,i)] = 0.
+	    }
+	    return (NULL)
+	}
+
+	data = imgl2d (im, line)
+	do i = 1, FP_NCOLS(fp) {
+	    if (line == FP_L1(fp,i))
+		Memd[FP_V1(fp,i)] = Memd[data+FP_COL(fp,i)-1]
+	    else if (line == FP_L2(fp,i))
+		Memd[FP_V2(fp,i)] = Memd[data+FP_COL(fp,i)-1]
+	}
+
+	return (data)
+end
+
+
diff --git a/pkg/xtools/fixpix/xtpmmap.x b/pkg/xtools/fixpix/xtpmmap.x
new file mode 100644
index 00000000..54bbf954
--- /dev/null
+++ b/pkg/xtools/fixpix/xtpmmap.x
@@ -0,0 +1,693 @@
+include	<mach.h>
+include	<ctype.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<pmset.h>
+include	<mwset.h>
+include	<syserr.h>
+
+
+# XT_PMMAP -- Open a pixel mask READ_ONLY.
+#
+# This routine maps multiple types of mask files and designations.
+# It matches the mask coordinates to the reference image based on the
+# physical coordinate system so the mask may be of a different size.
+# The mask name is returned so that the task has the name pointed to by "BPM".
+# A null filename is allowed and returns NULL.
+
+pointer procedure xt_pmmap (pmname, refim, mname, sz_mname)
+
+char	pmname[ARB]		#I Pixel mask name
+pointer	refim			#I Reference image pointer
+char	mname[ARB]		#O Expanded mask name
+int	sz_mname		#O Size of expanded mask name
+
+int	i, flag, nowhite()
+pointer	sp, fname, im, ref, xt_pmmap1()
+bool	streq()
+errchk	xt_pmmap1
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	im = NULL
+	i = nowhite (pmname, Memc[fname], SZ_FNAME)
+	if (Memc[fname] == '!') {
+	    iferr (call imgstr (refim, Memc[fname+1], Memc[fname], SZ_FNAME))
+		Memc[fname] = EOS
+	} else if (streq (Memc[fname], "BPM")) {
+	    iferr (call imgstr (refim, "BPM", Memc[fname], SZ_FNAME))
+		Memc[fname] = EOS
+	} else if (streq (Memc[fname], "^BPM")) {
+	    flag = INVERT_MASK
+	    iferr (call imgstr (refim, "BPM", Memc[fname+1], SZ_FNAME))
+		Memc[fname] = EOS
+	}
+
+	if (Memc[fname] == '^') {
+	    flag = INVERT_MASK
+	    call strcpy (Memc[fname+1], Memc[fname], SZ_FNAME)
+	} else
+	    flag = NO
+
+	if (streq (Memc[fname], "EMPTY"))
+	    ref = refim
+	else
+	    ref = NULL
+
+	if (Memc[fname] != EOS)
+	    im = xt_pmmap1 (Memc[fname], ref, refim, flag, YES)
+	call strcpy (Memc[fname], mname, sz_mname)
+
+	call sfree (sp)
+	return (im)
+end
+
+
+# XT_MAPPM -- Open a pixel mask READ_ONLY with/without matching.
+#
+# This routine maps multiple types of mask files and designations.
+# It may match the mask coordinates to the reference image based on the
+# physical coordinate system.  In either case the mask is matched to be
+# the same size.  The mask name is returned so that the task has the
+# name pointed to by "BPM".  A null filename is allowed and returns NULL.
+
+pointer procedure xt_mappm (pmname, refim, match, mname, sz_mname)
+
+char	pmname[ARB]		#I Pixel mask name
+pointer	refim			#I Reference image pointer
+int	match			#I Match by physical coordinates?
+char	mname[ARB]		#O Expanded mask name
+int	sz_mname		#O Size of expanded mask name
+
+int	i, flag, nowhite()
+pointer	sp, fname, im, ref, xt_pmmap1()
+bool	streq()
+errchk	xt_pmmap1
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	im = NULL
+	i = nowhite (pmname, Memc[fname], SZ_FNAME)
+	if (Memc[fname] == '!') {
+	    iferr (call imgstr (refim, Memc[fname+1], Memc[fname], SZ_FNAME))
+		Memc[fname] = EOS
+	} else if (streq (Memc[fname], "BPM")) {
+	    iferr (call imgstr (refim, "BPM", Memc[fname], SZ_FNAME))
+		Memc[fname] = EOS
+	} else if (streq (Memc[fname], "^BPM")) {
+	    flag = INVERT_MASK
+	    iferr (call imgstr (refim, "BPM", Memc[fname+1], SZ_FNAME))
+		Memc[fname] = EOS
+	}
+
+	if (Memc[fname] == '^') {
+	    flag = INVERT_MASK
+	    call strcpy (Memc[fname+1], Memc[fname], SZ_FNAME)
+	} else
+	    flag = NO
+
+	if (streq (Memc[fname], "EMPTY"))
+	    ref = refim
+	else
+	    ref = NULL
+
+	if (Memc[fname] != EOS)
+	    im = xt_pmmap1 (Memc[fname], ref, refim, flag, match)
+	call strcpy (Memc[fname], mname, sz_mname)
+
+	call sfree (sp)
+	return (im)
+end
+
+
+# XT_PMUNMAP -- Unmap a mask image.
+# Note that the imio pointer may be purely an internal pointer opened
+# with im_pmmapo so we need to free the pl pointer explicitly.
+
+procedure xt_pmunmap (im)
+
+pointer	im			#I IMIO pointer for mask
+
+pointer	pm
+int	imstati()
+
+begin
+	pm = imstati (im, IM_PMDES)
+	call pm_close (pm)
+	call imseti (im, IM_PMDES, NULL)
+	call imunmap (im)
+end
+
+
+# XT_PMMAP1 -- Open a pixel mask READ_ONLY.  The input mask may be
+# a pixel list image, a non-pixel list image, or a text file.
+# Return error if the pixel mask cannot be opened.  For pixel masks
+# or image masks match the WCS.
+
+pointer procedure xt_pmmap1 (pmname, ref, refim, flag, match)
+
+char	pmname[ARB]		#I Pixel mask name
+pointer	ref			#I Reference image for pixel mask
+pointer	refim			#I Reference image for image or text
+int	flag			#I Mask flag
+int	match			#I Match by physical coordinates?
+
+int	imstati(),  errcode()
+pointer	im, pm
+pointer	im_pmmap(), xt_pmimmap(), xt_pmtext(), xt_pmsection()
+bool	streq()
+errchk	xt_match
+
+begin
+	im = NULL
+
+	if (streq (pmname, "STDIN"))
+	    im = xt_pmtext (pmname, refim, flag)
+
+	else if (pmname[1] == '[')
+	    im = xt_pmsection (pmname, refim, flag)
+
+	else {
+	    ifnoerr (im = im_pmmap (pmname, READ_ONLY, ref)) {
+		call xt_match (im, refim, match)
+		if (flag == INVERT_MASK) {
+		    pm = imstati (im, IM_PMDES)
+		    call xt_pminvert (pm)
+		    call imseti (im, IM_PMDES, pm)
+		}
+	    } else {
+		switch (errcode()) {
+		case SYS_IKIOPEN, SYS_FOPNNEXFIL, SYS_PLBADSAVEF, SYS_FOPEN:
+		    ifnoerr (im = xt_pmimmap (pmname, refim, flag))
+			call xt_match (im, refim, match)
+		    else {
+			switch (errcode()) {
+			case SYS_IKIOPEN:
+			    im = xt_pmtext (pmname, refim, flag)
+			default:
+			    call erract (EA_ERROR)
+			}
+		    }
+		default:
+		    call erract (EA_ERROR)
+		}
+	    }
+	}
+
+	return (im)
+end
+
+
+# XT_PMIMMAP -- Open a pixel mask from a non-pixel list image.
+# Return error if the image cannot be opened.
+
+pointer procedure xt_pmimmap (pmname, refim, flag)
+
+char	pmname[ARB]		#I Image name
+pointer	refim			#I Reference image pointer
+int	flag			#I Mask flag
+
+int	i, ndim, npix, rop, val
+pointer	sp, v1, v2, im_in, im_out, pm, mw, data
+
+int	imstati(), imgnli()
+pointer immap(), pm_newmask(), im_pmmapo(), imgl1i(), mw_openim()
+errchk	immap, mw_openim, im_pmmapo
+
+begin
+	call smark (sp)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+
+	call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	call amovkl (long(1), Meml[v2], IM_MAXDIM)
+
+	im_in = immap (pmname, READ_ONLY, 0)
+	pm = imstati (im_in, IM_PMDES)
+	if (pm != NULL)
+	    return (im_in)
+	pm = pm_newmask (im_in, 16)
+
+	ndim = IM_NDIM(im_in)
+	npix = IM_LEN(im_in,1)
+
+	if (flag == INVERT_MASK)
+	    rop = PIX_NOT(PIX_SRC)
+	else
+	    rop = PIX_SRC
+
+	while (imgnli (im_in, data, Meml[v1]) != EOF) {
+	    if (flag == INVERT_MASK) {
+		do i = 0, npix-1 {
+		    val = Memi[data+i]
+		    if (val <= 0)
+		       Memi[data+i] = 1
+		    else
+		       Memi[data+i] = 0
+		}
+	    } else {
+		do i = 0, npix-1 {
+		    val = Memi[data+i]
+		    if (val < 0)
+		       Memi[data+i] = 0
+		}
+	    }
+	    call pmplpi (pm, Meml[v2], Memi[data], 0, npix, rop)
+	    call amovl (Meml[v1], Meml[v2], ndim)
+	}
+
+	im_out = im_pmmapo (pm, im_in)
+	data = imgl1i (im_out)		# Force I/O to set header
+	mw = mw_openim (im_in)		# Set WCS
+	call mw_saveim (mw, im_out)
+	call mw_close (mw)
+
+	#call imunmap (im_in)
+	call xt_pmunmap (im_in)
+	call sfree (sp)
+	return (im_out)
+end
+
+
+# XT_PMTEXT -- Create a pixel mask from a text file of rectangles.
+# Return error if the file cannot be opened.
+# This routine only applies to the first 2D plane.
+
+pointer procedure xt_pmtext (pmname, refim, flag)
+
+char	pmname[ARB]		#I Image name
+pointer	refim			#I Reference image pointer
+int	flag			#I Mask flag
+
+int	fd, nc, nl, c1, c2, l1, l2, nc1, nl1, rop
+pointer	pm, im, mw, dummy
+
+int	open(), fscan(), nscan()
+pointer	pm_newmask(), im_pmmapo(), imgl1i(), mw_openim()
+errchk	open, im_pmmapo
+
+begin
+	fd = open (pmname, READ_ONLY, TEXT_FILE)
+	pm = pm_newmask (refim, 16)
+
+	nc = IM_LEN(refim,1)
+	nl = IM_LEN(refim,2)
+
+	if (flag == INVERT_MASK)
+	    call pl_box (pm, 1, 1, nc, nl, PIX_SET+PIX_VALUE(1))
+
+	while (fscan (fd) != EOF) {
+	    call gargi (c1)
+	    call gargi (c2)
+	    call gargi (l1)
+	    call gargi (l2)
+	    if (nscan() != 4) {
+		if (nscan() == 2) {
+		    l1 = c2
+		    c2 = c1
+		    l2 = l1
+		} else
+		    next
+	    }
+
+	    c1 = max (1, c1)
+	    c2 = min (nc, c2)
+	    l1 = max (1, l1)
+	    l2 = min (nl, l2)
+	    nc1 = c2 - c1 + 1
+	    nl1 = l2 - l1 + 1
+	    if (nc1 < 1 || nl1 < 1)
+		next
+
+	    # Select mask value based on shape of rectangle.
+	    if (flag == INVERT_MASK)
+		rop = PIX_CLR
+	    else if (nc1 <= nl1)
+		rop = PIX_SET+PIX_VALUE(2)
+	    else
+		rop = PIX_SET+PIX_VALUE(3)
+
+	    # Set mask rectangle.
+	    call pm_box (pm, c1, l1, c2, l2, rop)
+	}
+
+	call close (fd)
+	im = im_pmmapo (pm, refim)
+	dummy = imgl1i (im)		# Force I/O to set header
+	mw = mw_openim (refim)		# Set WCS
+	call mw_saveim (mw, im)
+	call mw_close (mw)
+
+	return (im)
+end
+
+
+# XT_PMSECTION -- Create a pixel mask from an image section.
+# This only applies the mask to the first plane of the image.
+
+pointer procedure xt_pmsection (section, refim, flag)
+
+char	section[ARB]		#I Image section
+pointer	refim			#I Reference image pointer
+int	flag			#I Mask flag
+
+int	i, j, ip, temp, a[2], b[2], c[2], rop, ctoi()
+pointer	pm, im, mw, dummy, pm_newmask(), im_pmmapo(), imgl1i(), mw_openim()
+errchk	im_pmmapo
+define  error_  99
+
+begin
+	# This is currently only for 1D and 2D images.
+	if (IM_NDIM(refim) > 2)
+	    call error (1, "Image sections only allowed for 1D and 2D images")
+
+        # Decode the section string.
+	call amovki (1, a, 2)
+	call amovki (1, b, 2)
+	call amovki (1, c, 2)
+	do i = 1, IM_NDIM(refim)
+	    b[i] = IM_LEN(refim,i)
+
+        ip = 1
+        while (IS_WHITE(section[ip]))
+            ip = ip + 1
+        if (section[ip] == '[') {
+            ip = ip + 1
+
+	    do i = 1, IM_NDIM(refim) {
+		while (IS_WHITE(section[ip]))
+		    ip = ip + 1
+
+		# Get a:b:c.  Allow notation such as "-*:c"
+		# (or even "-:c") where the step is obviously negative.
+
+		if (ctoi (section, ip, temp) > 0) {                 # a
+		    a[i] = temp
+		    if (section[ip] == ':') {
+			ip = ip + 1
+			if (ctoi (section, ip, b[i]) == 0)             # a:b
+			    goto error_
+		    } else
+			b[i] = a[i]
+		} else if (section[ip] == '-') {                    # -*
+		    temp = a[i]
+		    a[i] = b[i]
+		    b[i] = temp
+		    ip = ip + 1
+		    if (section[ip] == '*')
+			ip = ip + 1
+		} else if (section[ip] == '*')                      # *
+		    ip = ip + 1
+		if (section[ip] == ':') {                           # ..:step
+		    ip = ip + 1
+		    if (ctoi (section, ip, c[i]) == 0)
+			goto error_
+		    else if (c[i] == 0)
+			goto error_
+		}
+		if (a[i] > b[i] && c[i] > 0)
+		    c[i] = -c[i]
+
+		while (IS_WHITE(section[ip]))
+		    ip = ip + 1
+		if (i < IM_NDIM(refim)) {
+		    if (section[ip] != ',')
+			goto error_
+		} else {
+		    if (section[ip] != ']')
+			goto error_
+		}
+		ip = ip + 1
+	    }
+	}
+
+	# In this case make the values be increasing only.
+	do i = 1, IM_NDIM(refim)
+	    if (c[i] < 0) {
+		temp = a[i]
+		a[i] = b[i]
+		b[i] = temp
+		c[i] = -c[i]
+	    }
+
+	# Make the mask.
+	pm = pm_newmask (refim, 16)
+
+	if (flag == INVERT_MASK) {
+	    rop = PIX_SET+PIX_VALUE(1)
+	    call pm_box (pm, 1, 1, IM_LEN(refim,1), IM_LEN(refim,2), rop)
+	    rop = PIX_CLR
+	} else
+	    rop = PIX_SET+PIX_VALUE(1)
+
+	if (c[1] == 1 && c[2] == 1)
+	    call pm_box (pm, a[1], a[2], b[1], b[2], rop)
+
+	else if (c[1] == 1)
+	    for (i=a[2]; i<=b[2]; i=i+c[2])
+		call pm_box (pm, a[1], i, b[1], i, rop)
+
+	else
+	    for (i=a[2]; i<=b[2]; i=i+c[2])
+		for (j=a[1]; j<=b[1]; j=j+c[1])
+		    call pm_point (pm, j, i, rop)
+
+	im = im_pmmapo (pm, refim)
+	dummy = imgl1i (im)		# Force I/O to set header
+	mw = mw_openim (refim)		# Set WCS
+	call mw_saveim (mw, im)
+	call mw_close (mw)
+
+	return (im)
+
+error_
+        call error (1, "Error in image section specification")
+end
+
+
+# XT_PMINVERT -- Invert a pixel mask by changing 0 to 1 and non-zero to zero.
+
+procedure xt_pminvert (pm)
+
+pointer	pm		#I Pixel mask to be inverted
+
+int	i, naxes, axlen[IM_MAXDIM], depth, npix, val
+pointer	sp, v, buf, one
+bool	pm_linenotempty()
+
+begin
+	call pm_gsize (pm, naxes, axlen, depth)
+
+	call smark (sp)
+	call salloc (v, IM_MAXDIM, TY_LONG)
+	call salloc (buf, axlen[1], TY_INT)
+	call salloc (one, 6, TY_INT)
+
+	npix = axlen[1]
+	RLI_LEN(one) = 2
+	RLI_AXLEN(one) = npix
+	Memi[one+3] = 1
+	Memi[one+4] = npix
+	Memi[one+5] = 1
+
+	call amovkl (long(1), Meml[v], IM_MAXDIM)
+	repeat {
+	    if (pm_linenotempty (pm, Meml[v])) {
+		call pmglpi (pm, Meml[v], Memi[buf], 0, npix, 0)
+		do i = 0, npix-1 {
+		    val = Memi[buf+i]
+		    if (val == 0)
+			Memi[buf+i] = 1
+		    else
+			Memi[buf+i] = 0
+		}
+		call pmplpi (pm, Meml[v], Memi[buf], 0, npix, PIX_SRC)
+	    } else
+		call pmplri (pm, Meml[v], Memi[one], 0, npix, PIX_SRC)
+	    
+	    do i = 2, naxes {
+		Meml[v+i-1] = Meml[v+i-1] + 1
+		if (Meml[v+i-1] <= axlen[i])
+		    break
+		else if (i < naxes)
+		    Meml[v+i-1] = 1
+	    }
+	} until (Meml[v+naxes-1] > axlen[naxes])
+
+	call sfree (sp)
+end
+
+
+# XT_MATCH -- Set the pixel mask to match the reference image.
+# This matches sizes and physical coordinates and allows the
+# original mask to be smaller or larger than the reference image.
+# Subsequent use of the pixel mask can then work in the logical
+# coordinates of the reference image.  The mask values are the maximum
+# of the mask values which overlap each reference image pixel.
+# A null input returns a null output.
+
+procedure xt_match (im, refim, match)
+
+pointer	im			#U Pixel mask image pointer
+pointer	refim			#I Reference image pointer
+int	match			#I Match by physical coordinates?
+
+int	i, j, k, l, i1, i2, j1, j2, nc, nl, ncpm, nlpm, nx, val
+double	x1, x2, y1, y2, lt[6], lt1[6], lt2[6]
+long	vold[IM_MAXDIM], vnew[IM_MAXDIM]
+pointer	pm, pmnew, imnew, mw, ctx, cty, bufref, bufpm
+
+int	imstati()
+pointer	pm_open(), mw_openim(), im_pmmapo(), imgl1i(), mw_sctran()
+bool	pm_empty(), pm_linenotempty()
+errchk	pm_open, mw_openim, im_pmmapo
+
+begin
+	if (im == NULL)
+	    return
+
+	# Set sizes.
+	nc = IM_LEN(refim,1)
+	nl = IM_LEN(refim,2)
+	ncpm = IM_LEN(im,1)
+	nlpm = IM_LEN(im,2)
+
+	# If the mask is empty and the sizes are the same then it does not
+	# matter if the two are actually matched in physical coordinates.
+	pm = imstati (im, IM_PMDES)
+	if (pm_empty(pm) && nc == ncpm && nl == nlpm)
+	    return
+
+	# Compute transformation between reference (logical) coordinates
+	# and mask (physical) coordinates if desired.
+
+	mw = mw_openim (im)
+	call mw_gltermd (mw, lt, lt[5], 2)
+	call mw_close (mw)
+
+	if (match == YES) {
+	    mw = mw_openim (refim)
+	    call mw_gltermd (mw, lt2, lt2[5], 2)
+	    call mw_close (mw)
+	} else
+	    call amovd (lt, lt2, 6)
+
+	# Combine lterms.
+	call mw_invertd (lt, lt1, 2)
+	call mw_mmuld (lt1, lt2, lt, 2)
+	call mw_vmuld (lt, lt[5], lt[5], 2)
+	lt[5] = lt2[5] - lt[5]
+	lt[6] = lt2[6] - lt[6]
+	do i = 1, 6
+	    lt[i] = nint (1D6 * (lt[i]-int(lt[i]))) / 1D6 + int(lt[i])
+
+	# Check for a rotation.  For now don't allow any rotation.
+	if (lt[2] != 0. || lt[3] != 0.)
+	    call error (1, "Image and mask have a relative rotation")
+	
+	# Check for an exact match.
+	if (lt[1] == 1D0 && lt[4] == 1D0 && lt[5] == 0D0 && lt[6] == 0D0 &&
+	    nc == ncpm && nl == nlpm)
+	    return
+
+	# Set reference to mask coordinates.
+	mw = mw_openim (im)
+	call mw_sltermd (mw, lt, lt[5], 2)
+	ctx = mw_sctran (mw, "logical", "physical", 1)
+	cty = mw_sctran (mw, "logical", "physical", 2)
+
+	# Create a new pixel mask of the required size and offset.
+	# Do dummy image I/O to set the header.
+	pmnew = pm_open (NULL)
+	call pm_ssize (pmnew, 2, IM_LEN(refim,1), 27)
+	imnew = im_pmmapo (pmnew, NULL)
+	bufref = imgl1i (imnew)
+
+	# Compute region of mask overlapping the reference image.
+	call mw_ctrand (ctx, 1-0.5D0, x1, 1)
+	call mw_ctrand (ctx, nc+0.5D0, x2, 1)
+	i1 = max (1, nint(min(x1,x2)+1D-5))
+	i2 = min (ncpm, nint(max(x1,x2)-1D-5))
+	call mw_ctrand (cty, 1-0.5D0, y1, 1)
+	call mw_ctrand (cty, nl+0.5D0, y2, 1)
+	j1 = max (1, nint(min(y1,y2)+1D-5))
+	j2 = min (nlpm, nint(max(y1,y2)-1D-5))
+
+	# Set the new mask values to the maximum of all mask values falling
+	# within each reference pixel in the overlap region.
+	if (i1 <= i2 && j1 <= j2) {
+	    nx = i2 - i1 + 1
+	    vold[1] = i1
+	    vnew[1] = 1
+
+	    # If the scales are the same then it is just a problem of
+	    # padding.  In this case use range lists for speed.
+	    if (lt[1] == 1D0 && lt[4] == 1D0) {
+		call malloc (bufpm, 3+3*nc, TY_INT)
+		k = nint (lt[5])
+		l = nint (lt[6])
+		do j = max(1-l,j1), min(nl-l,j2) {
+		    vold[2] = j
+		    call pmglri (pm, vold, Memi[bufpm], 0, nc, PIX_SRC)
+		    if (k != 0) {
+			bufref = bufpm
+			do i = 2, Memi[bufpm] {
+			    bufref = bufref + 3
+			    Memi[bufref] = Memi[bufref] + k
+			}
+		    }
+		    vnew[2] = j + l
+		    call pmplri (pmnew, vnew, Memi[bufpm], 0, nc, PIX_SRC)
+		}
+		bufref = NULL
+
+	    # Do all the geometry and pixel size matching.  This can
+	    # be slow.
+	    } else {
+		call malloc (bufpm, nx, TY_INT)
+		call malloc (bufref, nc, TY_INT)
+		do j = 1, nl {
+		    call mw_ctrand (cty, j-0.5D0, y1, 1)
+		    call mw_ctrand (cty, j+0.5D0, y2, 1)
+		    j1 = max (1, nint(min(y1,y2)+1D-5))
+		    j2 = min (nlpm, nint(max(y1,y2)-1D-5))
+		    if (j2 < j1)
+			next
+
+		    vnew[2] = j
+		    call aclri (Memi[bufref], nc)
+		    do l = j1, j2 {
+			vold[2] = l
+			if (!pm_linenotempty (pm, vold))
+			    next
+			call pmglpi (pm, vold, Memi[bufpm], 0, nx, 0)
+			do i = 1, nc {
+			    call mw_ctrand (ctx, i-0.5D0, x1, 1)
+			    call mw_ctrand (ctx, i+0.5D0, x2, 1)
+			    i1 = max (1, nint(min(x1,x2)+1D-5))
+			    i2 = min (ncpm, nint(max(x1,x2)-1D-5))
+			    if (i2 < i1)
+				next
+			    val = Memi[bufref+i-1]
+			    do k = i1-vold[1], i2-vold[1]
+				val = max (val, Memi[bufpm+k])
+			    Memi[bufref+i-1] = val
+			}
+		    }
+		    call pmplpi (pmnew, vnew, Memi[bufref], 0, nc, PIX_SRC)
+		}
+	    }
+	    call mfree (bufref, TY_INT)
+	    call mfree (bufpm, TY_INT)
+	}
+
+	call mw_close (mw)
+	call xt_pmunmap (im)
+	im = imnew
+	call imseti (im, IM_PMDES, pmnew)
+end
diff --git a/pkg/xtools/fixpix/ytfixpix.x b/pkg/xtools/fixpix/ytfixpix.x
new file mode 100644
index 00000000..e93b4c07
--- /dev/null
+++ b/pkg/xtools/fixpix/ytfixpix.x
@@ -0,0 +1,281 @@
+include	<imhdr.h>
+include	<imset.h>
+include	<pmset.h>
+include	"xtfixpix.h"
+
+# This version uses an internal copy of the input mask rather than modifying
+# the input mask.
+
+
+# XT_FPINIT -- Initialize FIXPIX data structure.
+# If the mask is null or empty a null pointer is returned.
+# If the mask is not empty the mask is examined for bad pixels requiring
+# column interpolation.  The columns and interpolation endpoints are
+# recorded.  Note that line interpolation does not need to be mapped since
+# this can be done efficiently as the reference image is accessed line by
+# line.
+
+pointer procedure yt_fpinit (pmin, lvalin, cvalin)
+
+pointer	pmin			#I Pixel mask
+int	lvalin			#I Input line interpolation code
+int	cvalin			#I Input column interpolation code
+
+int	i, j, k, l, n, nc, nl, l1, l2, lmin, lmax, ncols, lval, cval, ncompress
+short	val
+long	v[IM_MAXDIM]
+pointer	pm, fp, ptr, col, pl1, pl2
+pointer	sp, buf, cols
+
+bool	pm_empty()
+pointer	pm_newcopy()
+errchk	pmglrs, pmplrs
+
+begin
+	# Check for empty mask.
+	if (pmin == NULL)
+	    return (NULL)
+	if (pm_empty (pmin))
+	    return (NULL)
+
+	# Make an internal copy of the mask.
+	pm = pm_newcopy (pmin)
+
+	# Get mask size.
+	call pm_gsize (pm, i, v, j)
+	nc = v[1]
+	nl = v[2]
+
+	# Allocate memory and data structure.
+	call smark (sp)
+	call salloc (buf, 3*max(nc, nl), TY_SHORT) 
+	call salloc (cols, nc, TY_SHORT)
+	call calloc (fp, FP_LEN, TY_STRUCT)
+
+	# Set the mask codes.  Go through the mask and change any mask codes
+	# that match the input mask code to the output mask code (if they are
+	# different).  This is done to move the mask codes to a range that
+	# won't conflict with the length values.  For any other code replace
+	# the value by the length of the bad region along the line.  This
+	# value will be used in comparison to the length along the column for
+	# setting the interpolation for the narrower dimension.
+
+	if ((IS_INDEFI(lvalin)||lvalin<1) && (IS_INDEFI(cvalin)||cvalin<1)) {
+	    lval = FP_LDEF
+	    cval = FP_CDEF
+	} else if (IS_INDEFI(lvalin) || lvalin < 1) {
+	    lval = FP_LDEF
+	    cval = mod (cvalin - 1, nc) + 1
+	    if (lval == cval)
+		lval = FP_CDEF
+	} else if (IS_INDEFI(cvalin) || cvalin < 1) {
+	    lval = mod (lvalin - 1, nc) + 1
+	    cval = FP_CDEF
+	    if (cval == lval)
+		cval = FP_LDEF
+	} else if (lvalin != cvalin) {
+	    lval = mod (lvalin - 1, nc) + 1
+	    cval = mod (cvalin - 1, nc) + 1
+	} else {
+	    call mfree (fp, TY_STRUCT)
+	    call sfree (sp)
+	    call error (1, "Interpolation codes cannot be the same")
+	}
+	call yt_fpsinterp (pmin, pm, nc, nl, v, Mems[buf], lvalin, cvalin,
+	    lval, cval)
+
+	# Go through and check if there is any need for column interpolation;
+	# i.e. are there any mask values different from the line interpolation.
+
+	call aclrs (Mems[cols], nc)
+	call amovkl (long(1), v, IM_MAXDIM)
+	do l = 1, nl {
+	    v[2] = l
+	    call pmglrs (pm, v, Mems[buf], 0, nc, 0)
+	    ptr = buf + 3
+	    do i = 2, Mems[buf] {
+		val = Mems[ptr+2]
+		if (val != lval) {
+		    val = 1
+		    n = Mems[ptr+1] 
+		    call amovks (val, Mems[cols+Mems[ptr]-1], n)
+		}
+		ptr = ptr + 3
+	    }
+	}
+	n = 0
+	do i = 1, nc
+	    if (Mems[cols+i-1] != 0)
+		n = n + 1
+
+	# If there are mask codes for either column interpolation or
+	# interpolation lengths along lines to compare against column
+	# interpolation check the interpolation length against the
+	# column and set the line interpolation endpoints to use.
+	# compute the minimum and maximum lines that are endpoints
+	# to restrict the random access pass that will be needed to
+	# get the endpoint values.
+
+	if (n > 0) {
+	    n = n + 10
+	    call malloc (col, n, TY_INT)
+	    call malloc (pl1, n, TY_INT)
+	    call malloc (pl2, n, TY_INT)
+	    ncols = 0
+	    lmin = nl
+	    lmax = 0
+	    ncompress = 0
+	    do i = 1, nc {
+		if (Mems[cols+i-1] == 0)
+		    next
+		v[1] = i
+		do l = 1, nl {
+		    v[2] = l
+		    call pmglps (pm, v, Mems[buf+l-1], 0, 1, 0)
+		}
+		for (l1=1; l1<=nl && Mems[buf+l1-1]==0; l1=l1+1)
+		    ;
+		while (l1 <= nl) {
+		    l1 = l1 - 1
+		    for (l2=l1+1; l2<=nl && Mems[buf+l2-1]!=0; l2=l2+1)
+			;
+		    j = 0
+		    k = nc + l2 - l1 - 1
+		    do l = l1+1, l2-1 {
+			val = Mems[buf+l-1]
+			if (val == cval)
+			    j = j + 1
+			else if (val > nc) {
+			    if (val > k) {
+				j = j + 1
+				val = cval
+			    } else
+				val = lval
+			    v[2] = l
+			    call pmplps (pm, v, val, 0, 1, PIX_SRC)
+			    ncompress = ncompress + 1
+			}
+		    }
+		    if (ncompress > 100) {
+			call pm_compress (pm)
+			ncompress = 0
+		    }
+		    if (j > 0) {
+			if (ncols == n) {
+			    n = n + 10
+			    call realloc (col, n, TY_INT)
+			    call realloc (pl1, n, TY_INT)
+			    call realloc (pl2, n, TY_INT)
+			}
+			j = 1 + l1 - 1
+			k = 1 + l2 - 1
+			lmin = min (lmin, j, k)
+			lmax = max (lmax, j, k)
+			Memi[col+ncols] = i
+			Memi[pl1+ncols] = j
+			Memi[pl2+ncols] = k
+			ncols = ncols + 1
+		    }
+		    for (l1=l2+1; l1<=nl && Mems[buf+l1-1]==0; l1=l1+1)
+			;
+		}
+	    }
+
+	    FP_LMIN(fp) = lmin
+	    FP_LMAX(fp) = lmax
+	    FP_NCOLS(fp) = ncols
+	    FP_PCOL(fp) = col
+	    FP_PL1(fp) = pl1
+	    FP_PL2(fp) = pl2
+	}
+
+	FP_PM(fp) = pm
+	FP_LVAL(fp) = lval
+	FP_CVAL(fp) = cval
+
+	call sfree (sp)
+	return (fp)
+end
+
+
+# XT_SINTERP -- Set length of line interpolation regions.
+# The mask values are set to the length of any column interpolation
+# plus an offset leaving any line and column interpolation codes
+# unchanged.  These values will be used in a second pass to compare
+# to the lengths of line interpolation and then the mask values will
+# be reset to one of the line or column interpolation codes based on
+# the minimum distance.
+
+procedure yt_fpsinterp (pmin, pm, nc, nl, v, data, lvalin, cvalin,
+	lvalout, cvalout)
+
+pointer	pmin		#I Input pixel mask
+pointer	pm		#I Modified pixel mask
+int	nc, nl		#I Mask size
+long	v[ARB]		#I Coordinate vector
+short	data[ARB]	#I Data buffer
+int	lvalin		#I Input line interpolation code
+int	cvalin		#I Input column interpolation code
+int	lvalout		#I Output line interpolation code
+int	cvalout		#I Output column interpolation code
+
+int	c, l, c1, c2, val
+bool	pm_linenotempty()
+
+begin
+	call amovkl (long(1), v, IM_MAXDIM)
+	do l = 1, nl {
+	    v[2] = l
+	    if (!pm_linenotempty (pmin, v))
+		next
+	    
+	    call pmglps (pmin, v, data, 0, nc, 0)
+
+	    for (c1=1; c1<=nc && data[c1]==0; c1=c1+1)
+		;
+	    while (c1 <= nc) {
+		for (c2=c1+1; c2<=nc && data[c2]!=0; c2=c2+1)
+		    ;
+		c2 = c2 - 1
+		do c = c1, c2 {
+		    val = data[c]
+		    if (val == lvalin) {
+			if (lvalin != lvalout)
+			    data[c] = lvalout
+		    } else if (val == cvalin) {
+			if (cvalin != cvalout)
+			    data[c] = cvalout
+		    } else {
+			data[c] = nc + c2 - c1 + 1
+		    }
+		}
+		for (c1=c2+2; c1<=nc && data[c1]==0; c1=c1+1)
+		    ;
+	    }
+
+	    call pmplps (pm, v, data, 0, nc, PIX_SRC)
+	}
+end
+
+
+# XT_FPFREE -- Free FIXPIX data structures.
+
+procedure yt_fpfree (fp)
+
+pointer	fp		#U FIXPIX data structure
+
+begin
+	if (fp == NULL)
+	    return
+	call mfree (FP_PCOL(fp), TY_INT)
+	call mfree (FP_PL1(fp), TY_INT)
+	call mfree (FP_PL2(fp), TY_INT)
+	if (FP_PV1(fp) != NULL)
+	    call mfree (FP_PV1(fp), FP_PIXTYPE(fp))
+	if (FP_PV2(fp) != NULL)
+	    call mfree (FP_PV2(fp), FP_PIXTYPE(fp))
+	if (FP_DATA(fp) != NULL)
+	    call mfree (FP_DATA(fp), FP_PIXTYPE(fp))
+	call pm_close (FP_PM(fp))
+	call mfree (fp, TY_STRUCT)
+end
diff --git a/pkg/xtools/fixpix/ytpmmap.x b/pkg/xtools/fixpix/ytpmmap.x
new file mode 100644
index 00000000..e41fb4f8
--- /dev/null
+++ b/pkg/xtools/fixpix/ytpmmap.x
@@ -0,0 +1,961 @@
+include	<mach.h>
+include	<ctype.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<pmset.h>
+include	<mwset.h>
+include	<syserr.h>
+include	<math/iminterp.h>
+
+# Pixel mask matching options.
+define	PM_MATCH	"|logical|physical|world|offset|"
+define	PM_LOGICAL	1		# Match in logical coordinates
+define	PM_PHYSICAL	2		# Match in physical coordinates
+define	PM_WORLD	3		# Match in world coordinates
+define	PM_OFFSET	4		# Match in physical with WCS offset
+
+
+# XT_PMMAP/XT_MAPPM -- Open a pixel mask READ_ONLY.
+#
+# This routine maps multiple types of mask files and designations.
+# It may match the mask coordinates to the reference image based on the
+# physical coordinate system so the mask may be of a different size.
+# The mask name is returned so that the task has the name pointed to by "BPM".
+# A null filename is allowed and returns NULL.
+#
+# Modified to use xt_maskname with the reference image extension name.
+# Minor bug fixes in xt_match.
+
+pointer procedure yt_pmmap (pmname, refim, mname, sz_mname)
+
+char	pmname[ARB]		#I Pixel mask name
+pointer	refim			#I Reference image pointer
+char	mname[ARB]		#O Expanded mask name
+int	sz_mname		#O Size of expanded mask name
+
+pointer	yt_mappm()
+errchk	yt_mappm
+
+begin
+	return (yt_mappm (pmname, refim, "physical", mname, sz_mname))
+end
+
+pointer procedure yt_mappm (pmname, refim, match, mname, sz_mname)
+
+char	pmname[ARB]		#I Pixel mask name
+pointer	refim			#I Reference image pointer
+char	match[ARB]		#I Match by physical coordinates?
+char	mname[ARB]		#O Expanded mask name
+int	sz_mname		#O Size of expanded mask name
+
+int	i, j, flag, nowhite()
+pointer	sp, fname, extname, im, ref, yt_pmmap1()
+bool	streq()
+errchk	yt_pmmap1
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (extname, SZ_FNAME, TY_CHAR)
+
+	im = NULL
+	i = nowhite (pmname, Memc[fname], SZ_FNAME)
+
+	# Process invert flags.  These occur more than once.
+	j = 0; flag = 0
+	for (i=0; Memc[fname+i]!=EOS; i=i+1) {
+	    if (Memc[fname+i] == '^')
+	        flag = flag + 1
+	    else {
+	        Memc[fname+j] = Memc[fname+i]
+		j = j + 1
+	    }
+	}
+	Memc[fname+j] = EOS
+	if (mod (flag, 2) == 0)
+	    flag = 0
+	else
+	    flag = INVERT_MASK
+
+
+	# Resolve keyword references.
+	if (Memc[fname] == '!') {
+	    iferr (call imgstr (refim, Memc[fname+1], Memc[fname], SZ_FNAME))
+		Memc[fname] = EOS
+	} else if (streq (Memc[fname], "BPM")) {
+	    iferr (call imgstr (refim, "BPM", Memc[fname], SZ_FNAME))
+		Memc[fname] = EOS
+	}
+
+	# Resolve other special names.
+	if (streq (Memc[fname], "EMPTY"))
+	    ref = refim
+	else
+	    ref = NULL
+
+	# Create the mask.
+	if (Memc[fname] != EOS) {
+	    iferr (im = yt_pmmap1 (Memc[fname], ref, refim, flag, match)) {
+	        ifnoerr (call imgstr (refim, "extname", Memc[extname],
+		    SZ_FNAME)) {
+		    call xt_maskname (Memc[fname], Memc[extname], READ_ONLY,
+		        Memc[fname], SZ_FNAME)
+		    im = yt_pmmap1 (Memc[fname], ref, refim, flag, match)
+		} else
+		    im = yt_pmmap1 (Memc[fname], ref, refim, flag, match)
+	    }
+	}
+	call strcpy (Memc[fname], mname, sz_mname)
+
+	call sfree (sp)
+	return (im)
+end
+
+
+# XT_PMUNMAP -- Unmap a mask image.
+# Note that the imio pointer may be purely an internal pointer opened
+# with im_pmmapo so we need to free the pl pointer explicitly.
+
+procedure yt_pmunmap (im)
+
+pointer	im			#I IMIO pointer for mask
+
+pointer	pm
+int	imstati()
+
+begin
+	pm = imstati (im, IM_PMDES)
+	call pm_close (pm)
+	call imseti (im, IM_PMDES, NULL)
+	call imunmap (im)
+end
+
+
+# XT_PMMAP1 -- Open a pixel mask READ_ONLY.  The input mask may be
+# a pixel list image, a non-pixel list image, or a text file.
+# Return error if the pixel mask cannot be opened.  For pixel masks
+# or image masks possibly match the WCS.
+
+pointer procedure yt_pmmap1 (pmname, ref, refim, flag, match)
+
+char	pmname[ARB]		#I Pixel mask name
+pointer	ref			#I Reference image for pixel mask
+pointer	refim			#I Reference image for image or text
+int	flag			#I Mask flag
+char	match[ARB]		#I Match by physical coordinates?
+
+int	imstati(),  errcode()
+pointer	im, pm
+pointer	im_pmmap(), yt_pmimmap(), yt_pmtext(), yt_pmsection()
+bool	streq()
+errchk	yt_match
+
+begin
+	im = NULL
+
+	if (streq (pmname, "STDIN"))
+	    im = yt_pmtext (pmname, refim, flag)
+
+	else if (pmname[1] == '[')
+	    im = yt_pmsection (pmname, refim, flag)
+
+	else {
+	    ifnoerr (im = im_pmmap (pmname, READ_ONLY, ref)) {
+		call yt_match (im, refim, match)
+		if (flag == INVERT_MASK) {
+		    pm = imstati (im, IM_PMDES)
+		    call yt_pminvert (pm)
+		    call imseti (im, IM_PMDES, pm)
+		}
+	    } else {
+		switch (errcode()) {
+		case SYS_IKIOPEN, SYS_FOPNNEXFIL, SYS_PLBADSAVEF, SYS_FOPEN:
+		    ifnoerr (im = yt_pmimmap (pmname, refim, flag))
+			call yt_match (im, refim, match)
+		    else {
+			switch (errcode()) {
+			case SYS_IKIOPEN:
+			    im = yt_pmtext (pmname, refim, flag)
+			default:
+			    call erract (EA_ERROR)
+			}
+		    }
+		default:
+		    call erract (EA_ERROR)
+		}
+	    }
+	}
+
+	return (im)
+end
+
+
+# XT_PMIMMAP -- Open a pixel mask from a non-pixel list image.
+# Return error if the image cannot be opened.
+
+pointer procedure yt_pmimmap (pmname, refim, flag)
+
+char	pmname[ARB]		#I Image name
+pointer	refim			#I Reference image pointer
+int	flag			#I Mask flag
+
+int	i, ndim, npix, rop, val
+pointer	sp, v1, v2, im_in, im_out, pm, mw, data
+
+int	imstati(), imgnli()
+pointer immap(), pm_newmask(), im_pmmapo(), imgl1i(), mw_openim()
+errchk	immap, mw_openim, im_pmmapo
+
+begin
+	call smark (sp)
+	call salloc (v1, IM_MAXDIM, TY_LONG)
+	call salloc (v2, IM_MAXDIM, TY_LONG)
+
+	call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	call amovkl (long(1), Meml[v2], IM_MAXDIM)
+
+	im_in = immap (pmname, READ_ONLY, 0)
+	pm = imstati (im_in, IM_PMDES)
+	if (pm != NULL)
+	    return (im_in)
+	pm = pm_newmask (im_in, 16)
+
+	ndim = IM_NDIM(im_in)
+	npix = IM_LEN(im_in,1)
+
+	if (flag == INVERT_MASK)
+	    rop = PIX_NOT(PIX_SRC)
+	else
+	    rop = PIX_SRC
+
+	while (imgnli (im_in, data, Meml[v1]) != EOF) {
+	    if (flag == INVERT_MASK) {
+		do i = 0, npix-1 {
+		    val = Memi[data+i]
+		    if (val <= 0)
+		       Memi[data+i] = 1
+		    else
+		       Memi[data+i] = 0
+		}
+	    } else {
+		do i = 0, npix-1 {
+		    val = Memi[data+i]
+		    if (val < 0)
+		       Memi[data+i] = 0
+		}
+	    }
+	    call pmplpi (pm, Meml[v2], Memi[data], 0, npix, rop)
+	    call amovl (Meml[v1], Meml[v2], ndim)
+	}
+
+	im_out = im_pmmapo (pm, im_in)
+	data = imgl1i (im_out)		# Force I/O to set header
+	mw = mw_openim (im_in)		# Set WCS
+	call mw_saveim (mw, im_out)
+	call mw_close (mw)
+
+	#call imunmap (im_in)
+	call yt_pmunmap (im_in)
+	call sfree (sp)
+	return (im_out)
+end
+
+
+# XT_PMTEXT -- Create a pixel mask from a text file of rectangles.
+# Return error if the file cannot be opened.
+# This routine only applies to the first 2D plane.
+
+pointer procedure yt_pmtext (pmname, refim, flag)
+
+char	pmname[ARB]		#I Image name
+pointer	refim			#I Reference image pointer
+int	flag			#I Mask flag
+
+int	fd, nc, nl, c1, c2, l1, l2, nc1, nl1, rop
+pointer	pm, im, mw, dummy
+
+int	open(), fscan(), nscan()
+pointer	pm_newmask(), im_pmmapo(), imgl1i(), mw_openim()
+errchk	open,im_pmmapo
+
+begin
+	fd = open (pmname, READ_ONLY, TEXT_FILE)
+	pm = pm_newmask (refim, 16)
+
+	nc = IM_LEN(refim,1)
+	nl = IM_LEN(refim,2)
+
+	if (flag == INVERT_MASK)
+	    call pl_box (pm, 1, 1, nc, nl, PIX_SET+PIX_VALUE(1))
+
+	while (fscan (fd) != EOF) {
+	    call gargi (c1)
+	    call gargi (c2)
+	    call gargi (l1)
+	    call gargi (l2)
+	    if (nscan() != 4) {
+		if (nscan() == 2) {
+		    l1 = c2
+		    c2 = c1
+		    l2 = l1
+		} else
+		    next
+	    }
+
+	    c1 = max (1, c1)
+	    c2 = min (nc, c2)
+	    l1 = max (1, l1)
+	    l2 = min (nl, l2)
+	    nc1 = c2 - c1 + 1
+	    nl1 = l2 - l1 + 1
+	    if (nc1 < 1 || nl1 < 1)
+		next
+
+	    # Select mask value based on shape of rectangle.
+	    if (flag == INVERT_MASK)
+		rop = PIX_CLR
+	    else if (nc1 <= nl1)
+		rop = PIX_SET+PIX_VALUE(2)
+	    else
+		rop = PIX_SET+PIX_VALUE(3)
+
+	    # Set mask rectangle.
+	    call pm_box (pm, c1, l1, c2, l2, rop)
+	}
+
+	call close (fd)
+	im = im_pmmapo (pm, refim)
+	dummy = imgl1i (im)		# Force I/O to set header
+	mw = mw_openim (refim)		# Set WCS
+	call mw_saveim (mw, im)
+	call mw_close (mw)
+
+	return (im)
+end
+
+
+# XT_PMSECTION -- Create a pixel mask from an image section.
+# This only applies the mask to the first plane of the image.
+
+pointer procedure yt_pmsection (section, refim, flag)
+
+char	section[ARB]		#I Image section
+pointer	refim			#I Reference image pointer
+int	flag			#I Mask flag
+
+int	i, j, ip, temp, a[2], b[2], c[2], rop, ctoi()
+pointer	pm, im, mw, dummy, pm_newmask(), im_pmmapo(), imgl1i(), mw_openim()
+errchk	im_pmmapo
+define  error_  99
+
+begin
+	# This is currently only for 1D and 2D images.
+	if (IM_NDIM(refim) > 2)
+	    call error (1, "Image sections only allowed for 1D and 2D images")
+
+        # Decode the section string.
+	call amovki (1, a, 2)
+	call amovki (1, b, 2)
+	call amovki (1, c, 2)
+	do i = 1, IM_NDIM(refim)
+	    b[i] = IM_LEN(refim,i)
+
+        ip = 1
+        while (IS_WHITE(section[ip]))
+            ip = ip + 1
+        if (section[ip] == '[') {
+            ip = ip + 1
+
+	    do i = 1, IM_NDIM(refim) {
+		while (IS_WHITE(section[ip]))
+		    ip = ip + 1
+
+		# Get a:b:c.  Allow notation such as "-*:c"
+		# (or even "-:c") where the step is obviously negative.
+
+		if (ctoi (section, ip, temp) > 0) {                 # a
+		    a[i] = temp
+		    if (section[ip] == ':') {
+			ip = ip + 1
+			if (ctoi (section, ip, b[i]) == 0)             # a:b
+			    goto error_
+		    } else
+			b[i] = a[i]
+		} else if (section[ip] == '-') {                    # -*
+		    temp = a[i]
+		    a[i] = b[i]
+		    b[i] = temp
+		    ip = ip + 1
+		    if (section[ip] == '*')
+			ip = ip + 1
+		} else if (section[ip] == '*')                      # *
+		    ip = ip + 1
+		if (section[ip] == ':') {                           # ..:step
+		    ip = ip + 1
+		    if (ctoi (section, ip, c[i]) == 0)
+			goto error_
+		    else if (c[i] == 0)
+			goto error_
+		}
+		if (a[i] > b[i] && c[i] > 0)
+		    c[i] = -c[i]
+
+		while (IS_WHITE(section[ip]))
+		    ip = ip + 1
+		if (i < IM_NDIM(refim)) {
+		    if (section[ip] != ',')
+			goto error_
+		} else {
+		    if (section[ip] != ']')
+			goto error_
+		}
+		ip = ip + 1
+	    }
+	}
+
+	# In this case make the values be increasing only.
+	do i = 1, IM_NDIM(refim)
+	    if (c[i] < 0) {
+		temp = a[i]
+		a[i] = b[i]
+		b[i] = temp
+		c[i] = -c[i]
+	    }
+
+	# Make the mask.
+	pm = pm_newmask (refim, 16)
+
+	if (flag == INVERT_MASK) {
+	    rop = PIX_SET+PIX_VALUE(1)
+	    call pm_box (pm, 1, 1, IM_LEN(refim,1), IM_LEN(refim,2), rop)
+	    rop = PIX_CLR
+	} else
+	    rop = PIX_SET+PIX_VALUE(1)
+
+	if (c[1] == 1 && c[2] == 1)
+	    call pm_box (pm, a[1], a[2], b[1], b[2], rop)
+
+	else if (c[1] == 1)
+	    for (i=a[2]; i<=b[2]; i=i+c[2])
+		call pm_box (pm, a[1], i, b[1], i, rop)
+
+	else
+	    for (i=a[2]; i<=b[2]; i=i+c[2])
+		for (j=a[1]; j<=b[1]; j=j+c[1])
+		    call pm_point (pm, j, i, rop)
+
+	im = im_pmmapo (pm, refim)
+	dummy = imgl1i (im)		# Force I/O to set header
+	mw = mw_openim (refim)		# Set WCS
+	call mw_saveim (mw, im)
+	call mw_close (mw)
+
+	return (im)
+
+error_
+        call error (1, "Error in image section specification")
+end
+
+
+# XT_PMINVERT -- Invert a pixel mask by changing 0 to 1 and non-zero to zero.
+
+procedure yt_pminvert (pm)
+
+pointer	pm		#I Pixel mask to be inverted
+
+int	i, naxes, axlen[IM_MAXDIM], depth, npix, val
+pointer	sp, v, buf, one
+bool	pm_linenotempty()
+
+begin
+	call pm_gsize (pm, naxes, axlen, depth)
+
+	call smark (sp)
+	call salloc (v, IM_MAXDIM, TY_LONG)
+	call salloc (buf, axlen[1], TY_INT)
+	call salloc (one, 6, TY_INT)
+
+	npix = axlen[1]
+	RLI_LEN(one) = 2
+	RLI_AXLEN(one) = npix
+	Memi[one+3] = 1
+	Memi[one+4] = npix
+	Memi[one+5] = 1
+
+	call amovkl (long(1), Meml[v], IM_MAXDIM)
+	repeat {
+	    if (pm_linenotempty (pm, Meml[v])) {
+		call pmglpi (pm, Meml[v], Memi[buf], 0, npix, 0)
+		do i = 0, npix-1 {
+		    val = Memi[buf+i]
+		    if (val == 0)
+			Memi[buf+i] = 1
+		    else
+			Memi[buf+i] = 0
+		}
+		call pmplpi (pm, Meml[v], Memi[buf], 0, npix, PIX_SRC)
+	    } else
+		call pmplri (pm, Meml[v], Memi[one], 0, npix, PIX_SRC)
+	    
+	    do i = 2, naxes {
+		Meml[v+i-1] = Meml[v+i-1] + 1
+		if (Meml[v+i-1] <= axlen[i])
+		    break
+		else if (i < naxes)
+		    Meml[v+i-1] = 1
+	    }
+	} until (Meml[v+naxes-1] > axlen[naxes])
+
+	call sfree (sp)
+end
+
+
+# XT_MATCH -- Set the pixel mask to match the reference image.
+# This matches sizes and possibly the physical coordinates and allows the
+# original mask to be smaller or larger than the reference image.
+# Subsequent use of the pixel mask can then work in the logical
+# coordinates of the reference image.  The mask values are the maximum
+# of the mask values which overlap each reference image pixel.
+# A null input returns a null output.
+
+procedure yt_match (im, refim, match)
+
+pointer	im			#U Pixel mask image pointer
+pointer	refim			#I Reference image pointer
+char	match[ARB]		#I Match by physical coordinates?
+
+int	i, j, k, l, i1, i2, j1, j2, nc, nl, ncpm, nlpm, nx, val
+int	pmmatch, maxmaskval
+double	x1, x2, y1, y2, lt[6], lt1[6], lt2[6]
+long	vold[IM_MAXDIM], vnew[IM_MAXDIM]
+pointer	str, pm, pmnew, imnew, mw, ctx, cty, bufref, bufpm
+
+int	imstati(), strdic(), envfind(), nscan()
+pointer	pm_open(), mw_openim(), im_pmmapo(), imgl1i(), mw_sctran()
+bool	pm_empty(), pm_linenotempty()
+errchk	yt_match_world, pm_open, mw_openim, im_pmmapo
+
+begin
+	if (im == NULL)
+	    return
+
+	# Set sizes.
+	nc = IM_LEN(refim,1)
+	nl = IM_LEN(refim,2)
+	ncpm = IM_LEN(im,1)
+	nlpm = IM_LEN(im,2)
+
+	# If the mask is empty and the sizes are the same then it does not
+	# matter if the two are actually matched in physical coordinates.
+	pm = imstati (im, IM_PMDES)
+	if (pm_empty(pm) && nc == ncpm && nl == nlpm)
+	    return
+
+	# Set match type.
+	call malloc (str, SZ_FNAME, TY_CHAR)
+	call sscan (match)
+	call gargwrd (Memc[str], SZ_FNAME); call gargi (maxmaskval)
+	if (nscan() == 1)
+	    maxmaskval = 1
+	pmmatch = strdic (Memc[str], Memc[str], SZ_FNAME, PM_MATCH)
+	if (pmmatch == 0 && match[1] != EOS) {
+	    if (envfind (match, Memc[str], SZ_FNAME) > 0) {
+		call sscan (Memc[str])
+		call gargwrd (Memc[str], SZ_FNAME); call gargi (maxmaskval)
+		if (nscan() == 1)
+		    maxmaskval = 1
+		pmmatch = strdic (Memc[str], Memc[str], SZ_FNAME, PM_MATCH)
+	    } else
+	        pmmatch = PM_LOGICAL
+	} else {
+	    if (envfind ("pmmatch", Memc[str], SZ_FNAME) > 0) {
+		call sscan (Memc[str])
+		call gargwrd (Memc[str], SZ_FNAME); call gargi (maxmaskval)
+		if (nscan() == 1)
+		    maxmaskval = 1
+		pmmatch = strdic (Memc[str], Memc[str], SZ_FNAME, PM_MATCH)
+	    }
+	}
+	call mfree (str, TY_CHAR)
+	if (pmmatch == 0)
+	    call error (1, "Unknown or invalid pixel mask matching option")
+
+	if (pmmatch == PM_WORLD) {
+	    call yt_match_world (im, refim, maxmaskval)
+	    return
+	}
+
+	# Compute transformation between reference (logical) coordinates
+	# and mask (physical) coordinates.  Apply a world coordinate
+	# offset if desired.
+
+	mw = mw_openim (im)
+	if (pmmatch == PM_OFFSET) {
+	    call mw_gwtermd (mw, lt[5], lt1, lt, 2)
+	    ctx = mw_sctran (mw, "world", "physical", 0)
+	    call mw_ctrand (ctx, lt1, lt1[5], 2)
+	} else
+	    call aclrd (lt1[5], 2)
+	call mw_gltermd (mw, lt, lt[5], 2)
+	call mw_close (mw)
+
+	if (pmmatch == PM_LOGICAL)
+	    call amovd (lt, lt2, 6)
+	else {
+	    mw = mw_openim (refim)
+	    if (pmmatch == PM_OFFSET) {
+		ctx = mw_sctran (mw, "world", "physical", 0)
+		call mw_ctrand (ctx, lt1, lt1[3], 2)
+		lt1[5] = nint (lt1[5] - lt1[3])
+		lt1[6] = nint (lt1[6] - lt1[4])
+	    }
+	    call mw_gltermd (mw, lt2, lt2[5], 2)
+	    lt2[5] = lt2[5] - lt1[5]
+	    lt2[6] = lt2[6] - lt1[6]
+	    call mw_close (mw)
+	}
+
+	# Combine lterms.
+	call mw_invertd (lt, lt1, 2)
+	call mw_mmuld (lt1, lt2, lt, 2)
+	call mw_vmuld (lt, lt[5], lt[5], 2)
+	lt[5] = lt2[5] - lt[5]
+	lt[6] = lt2[6] - lt[6]
+	do i = 1, 6
+	    lt[i] = nint (1D6 * (lt[i]-int(lt[i]))) / 1D6 + int(lt[i])
+
+	# Check for a rotation.  For now don't allow any rotation.
+	if (lt[2] != 0. || lt[3] != 0.)
+	    call error (1, "Image and mask have a relative rotation")
+	
+	# Check for an exact match.
+	if (lt[1] == 1D0 && lt[4] == 1D0 && lt[5] == 0D0 && lt[6] == 0D0 &&
+	    nc == ncpm && nl == nlpm)
+	    return
+
+	# Set reference to mask coordinates.
+	mw = mw_openim (im)
+	call mw_sltermd (mw, lt, lt[5], 2)
+	ctx = mw_sctran (mw, "logical", "physical", 1)
+	cty = mw_sctran (mw, "logical", "physical", 2)
+
+	# Create a new pixel mask of the required size and offset.
+	# Do dummy image I/O to set the header.
+	pmnew = pm_open (NULL)
+	call pm_ssize (pmnew, 2, IM_LEN(refim,1), 27)
+	imnew = im_pmmapo (pmnew, NULL)
+	bufref = imgl1i (imnew)
+
+	# Compute region of mask overlapping the reference image.
+	call mw_ctrand (ctx, 1-0.5D0, x1, 1)
+	call mw_ctrand (ctx, nc+0.5D0, x2, 1)
+	i1 = max (1, nint(min(x1,x2)+1D-5))
+	i2 = min (ncpm, nint(max(x1,x2)-1D-5))
+	call mw_ctrand (cty, 1-0.5D0, y1, 1)
+	call mw_ctrand (cty, nl+0.5D0, y2, 1)
+	j1 = max (1, nint(min(y1,y2)+1D-5))
+	j2 = min (nlpm, nint(max(y1,y2)-1D-5))
+
+	# Set the new mask values to the maximum of all mask values falling
+	# within each reference pixel in the overlap region.
+	if (i1 <= i2 && j1 <= j2) {
+	    nx = i2 - i1 + 1
+	    vold[1] = i1
+	    vnew[1] = 1
+
+	    # If the scales are the same then it is just a problem of
+	    # padding.  In this case use range lists for speed.
+	    if (lt[1] == 1D0 && lt[4] == 1D0) {
+		call malloc (bufpm, 3+3*nc, TY_INT)
+		k = nint (lt[5])
+		l = nint (lt[6])
+		do j = max(1-l,j1), min(nl-l,j2) {
+		    vold[2] = j
+		    call plglri (pm, vold, Memi[bufpm], 0, nc, PIX_SRC)
+		    if (k != 0) {
+			bufref = bufpm
+			do i = 2, Memi[bufpm] {
+			    bufref = bufref + 3
+			    Memi[bufref] = Memi[bufref] + k
+			}
+		    }
+		    vnew[2] = j + l
+		    call pmplri (pmnew, vnew, Memi[bufpm], 0, nc, PIX_SRC)
+		}
+		bufref = NULL
+
+	    # Do all the geometry and pixel size matching.  This can
+	    # be slow.
+	    } else {
+		call malloc (bufpm, nx, TY_INT)
+		call malloc (bufref, nc, TY_INT)
+		do j = 1, nl {
+		    call mw_ctrand (cty, j-0.5D0, y1, 1)
+		    call mw_ctrand (cty, j+0.5D0, y2, 1)
+		    j1 = max (1, nint(min(y1,y2)+1D-5))
+		    j2 = min (nlpm, nint(max(y1,y2)-1D-5))
+		    if (j2 < j1)
+			next
+
+		    vnew[2] = j
+		    call aclri (Memi[bufref], nc)
+		    do l = j1, j2 {
+			vold[2] = l
+			if (!pm_linenotempty (pm, vold))
+			    next
+			call pmglpi (pm, vold, Memi[bufpm], 0, nx, 0)
+			do i = 1, nc {
+			    call mw_ctrand (ctx, i-0.5D0, x1, 1)
+			    call mw_ctrand (ctx, i+0.5D0, x2, 1)
+			    i1 = max (1, nint(min(x1,x2)+1D-5))
+			    i2 = min (ncpm, nint(max(x1,x2)-1D-5))
+			    if (i2 < i1)
+				next
+			    val = Memi[bufref+i-1]
+			    do k = i1-vold[1], i2-vold[1]
+				val = max (val, Memi[bufpm+k])
+			    Memi[bufref+i-1] = val
+			}
+		    }
+		    call pmplpi (pmnew, vnew, Memi[bufref], 0, nc, PIX_SRC)
+		}
+	    }
+	    call mfree (bufref, TY_INT)
+	    call mfree (bufpm, TY_INT)
+	}
+
+	call mw_close (mw)
+	call yt_pmunmap (im)
+	im = imnew
+	call imseti (im, IM_PMDES, pmnew)
+end
+
+
+# XT_MATCH_WORLD -- Set the pixel mask to match the reference image in
+# world coordinates.  The algorithm can fail in various ways, especially
+# when higher order WCS are used.  This ideally works with images and masks
+# that are not greatly skewed in RA/DEC space.
+
+procedure yt_match_world (im, refim, maxmaskval)
+
+pointer	im			#U Pixel mask image pointer
+pointer	refim			#I Reference image pointer
+int	maxmaskval		#I Maximum mask value
+
+int	i, j, k, l, nc, nl, ncpm, nlpm, cstep, lstep, buf, nxmsi, nymsi
+int	c_im, l_im, c_ref, l_ref, c1_ref, c2_ref, l1_ref, l2_ref
+int	xmin, xmax, ymin, ymax
+double	pix_im[2], pix_ref[2], pix_tmp[2], w1[2], w2[2]
+real	x, y, icstep, ilstep, d[2], der[2,2]
+long	v[2]
+pointer	sp, bits, rl
+pointer	ba, mw_im, mw_ref, ct1, ct2, pm, xmsi, ymsi, xvec, yvec, ptr
+
+int	imstati()
+real	msieval()
+pointer	xt_baopen(), pm_open(), im_pmmapo(), imgl1i()
+pointer	mw_openim(), mw_sctran()
+bool	pm_empty()
+errchk	xt_baopen, pm_open, mw_openim, im_pmmapo, msiinit, msifit
+
+begin
+	if (im == NULL)
+	    return
+
+	# Set sizes.
+	ncpm = IM_LEN(im,1)
+	nlpm = IM_LEN(im,2)
+	nc = IM_LEN(refim,1)
+	nl = IM_LEN(refim,2)
+
+	# If the mask is empty and the sizes are the same then it does not
+	# matter if the two are actually matched in world coordinates.
+	pm = imstati (im, IM_PMDES)
+	if (pm_empty(pm) && nc == ncpm && nl == nlpm)
+	    return
+
+	# Allocate working lines.
+	call smark (sp)
+	call salloc (bits, nc, TY_INT)
+	call salloc (rl, 3+3*ncpm, TY_INT)
+
+	# Use a bit array to hold the output in memory compactly.
+	ba = xt_baopen (nc, nl, maxmaskval)
+
+	# Set logical to logical transformation through the world coordinate
+	# systems.  Use a surface fit to speed up the WCS calculations.
+
+	mw_im = mw_openim (im)
+	mw_ref = mw_openim (refim)
+
+	# First bound the reference image in world coordinates.
+	# The image is sampled and a small amount of buffer is used.
+
+	ct1 = mw_sctran (mw_ref, "logical", "world", 3)
+	cstep = 20; lstep = 20
+	icstep = (nc - 1.) / (cstep - 1.); ilstep = (nl - 1.) / (lstep - 1.)
+	w1[1] = MAX_DOUBLE; w1[2] = -MAX_DOUBLE
+	w2[1] = MAX_DOUBLE; w2[2] = -MAX_DOUBLE
+	for (pix_im[2]=1-ilstep; pix_im[2]<=nl+1+ilstep;
+	    pix_im[2]=pix_im[2]+ilstep) {
+	    for (pix_im[1]=1-icstep; pix_im[1]<=nc+1+icstep;
+		pix_im[1]=pix_im[1]+icstep) {
+		call mw_ctrand (ct1, pix_im, pix_ref, 2)
+		w1[1] = min (w1[1], pix_ref[1])
+		w1[2] = max (w1[2], pix_ref[1])
+		w2[1] = min (w2[1], pix_ref[2])
+		w2[2] = max (w2[2], pix_ref[2])
+	    }
+	}
+	call mw_ctfree (ct1)
+
+	# Fit coordinate surfaces for the mapping from the mask to the
+	# the reference image.  This is done because the WCS evaluations
+	# can be slow.  This is done on a subsample and then linear
+	# interpolation will be done.  Provide a buffer to avoid edge
+	# effects from the subsampling.  Bound the mask to what overlaps
+	# the reference image.
+
+	cstep = 10; lstep = 10; buf = 1
+
+	ct1 = mw_sctran (mw_im, "logical", "world", 3)
+	ct2 = mw_sctran (mw_ref, "world", "logical", 3)
+
+	call msiinit (xmsi, II_BILINEAR)
+	call msiinit (ymsi, II_BILINEAR)
+	nxmsi = nint ((ncpm - 1.) / cstep + 2*buf + 1)
+	nymsi = nint ((nlpm - 1.) / lstep + 2*buf + 1)
+	icstep = (nxmsi - (2.*buf + 1)) / (ncpm - 1.)
+	ilstep = (nymsi - (2.*buf + 1)) / (nlpm - 1.)
+	call malloc (xvec, nxmsi*nymsi, TY_REAL)
+	call malloc (yvec, nxmsi*nymsi, TY_REAL)
+	xmin=ncpm+1; xmax=0; ymin=nlpm+1; ymax=0
+	k = -1
+	do j = 1, nymsi {
+	    pix_im[2] = (j - (2*buf))  / ilstep + 1
+	    do i = 1, nxmsi {
+		k = k + 1
+		pix_im[1] = (i - (2*buf)) / icstep + 1
+		call mw_ctrand (ct1, pix_im, pix_tmp, 2)
+		if (pix_tmp[1] < w1[1] || pix_tmp[1] > w1[2] ||
+		    pix_tmp[2] < w2[1] || pix_tmp[2] > w2[2]) {
+		    Memr[xvec+k] = 0
+		    Memr[yvec+k] = 0
+		    next
+		}
+
+		call mw_ctrand (ct2, pix_tmp, pix_ref, 2)
+		x = pix_ref[1]
+		y = pix_ref[2]
+		if (x > 0.5 && x < nc+0.5 && y > 0.5 && y < nl+0.5) {
+		    l = max (1, min (ncpm, nint (pix_im[1])))
+		    xmin = min (xmin, l)
+		    xmax = max (xmax, l)
+		    l = max (1, min (nlpm, nint (pix_im[2])))
+		    ymin = min (ymin, l)
+		    ymax = max (ymax, l)
+		}
+
+		Memr[xvec+k] = x
+		Memr[yvec+k] = y
+	    }
+	}
+	call msifit (xmsi, Memr[xvec], nxmsi, nymsi, nxmsi) 
+	call msifit (ymsi, Memr[yvec], nxmsi, nymsi, nxmsi) 
+	call mfree (xvec, TY_REAL)
+	call mfree (yvec, TY_REAL)
+	call mw_close (mw_im)
+	call mw_close (mw_ref)
+
+	# Expand the mask bound to avoid missing the edge.
+	i = (xmin - 1) * icstep + (2*buf) - 1
+	xmin = (i - (2*buf)) / icstep + 1
+	xmin = max (1, min (ncpm, nint(xmin)))
+	i = (xmax - 1) * icstep + (2*buf) + 1.99
+	xmax = (i - (2*buf)) / icstep + 1
+	xmax = max (1, min (ncpm, nint(xmax)))
+	j = (ymin - 1) * ilstep + (2*buf) - 1
+	ymin = (j - (2*buf)) / ilstep + 1
+	ymin = max (1, min (nlpm, nint(ymin)))
+	j = (ymax - 1) * ilstep + (2*buf) + 1.99
+	ymax = (j - (2*buf)) / ilstep + 1
+	ymax = max (1, min (nlpm, nint(ymax)))
+
+	# Determine size of mask pixel in reference system.
+	# This is approximate because we don't take into account the
+	# shape of the transformed square mask pixels.
+
+	x = (xmax+xmin)/2; y = (ymax+ymin)/2
+	x = (x - 1) * icstep + (2*buf); y = (y - 1) * ilstep + (2*buf)
+	call msider (xmsi, x, y, der, 2, 2, 2)
+	d[1] = max (abs(der[2,1]), abs(der[1,2])) * icstep
+	call msider (ymsi, x, y, der, 2, 2, 2)
+	d[2] = max (abs(der[2,1]), abs(der[1,2])) * ilstep
+
+	# Go through each mask pixel and add to the new mask.
+	# This uses range lists to quickly skip good pixels.
+
+	v[1] = 1
+	do l_im = ymin, ymax {
+	    v[2] = l_im
+	    call plglri (pm, v, Memi[rl], 0, ncpm, PIX_SRC)
+	    y = (l_im - 1) * ilstep + (2*buf)
+	    ptr = rl
+	    do k = RL_FIRST, RLI_LEN(rl) {
+		ptr = ptr + RL_LENELEM
+		c_im = Memi[ptr+RL_XOFF]
+		if (c_im > xmax)
+		    next
+		if (c_im+Memi[ptr+RL_NOFF]-1 < xmin)
+		    next
+		x = (c_im - 1) * icstep + (2*buf) - icstep
+		do c_im = 1, Memi[ptr+RL_NOFF] {
+		    x = x + icstep
+		    pix_ref[1] = msieval (xmsi, x, y)
+		    pix_ref[2] = msieval (ymsi, x, y)
+		    pix_tmp[1] = max (1D0, pix_ref[1] - 0.45 * d[1])
+		    pix_tmp[2] = min (double(nc), pix_ref[1] + 0.45 * d[1])
+		    if (pix_tmp[2] < 1 || pix_tmp[1] > nc)
+		        next
+		    c1_ref = nint (pix_tmp[1])
+		    c2_ref = nint (pix_tmp[2])
+		    pix_tmp[1] = max (1D0, pix_ref[2] - 0.45 * d[2])
+		    pix_tmp[2] = min (double(nl), pix_ref[2] + 0.45 * d[2])
+		    if (pix_tmp[2] < 1 || pix_tmp[1] > nl)
+		        next
+		    l1_ref = nint (pix_tmp[1])
+		    l2_ref = nint (pix_tmp[2])
+		    do l_ref = l1_ref, l2_ref {
+			do c_ref = c1_ref, c2_ref {
+			    call xt_bapi (ba, c_ref, l_ref,
+			        Memi[ptr+RL_VOFF], 1)
+			}
+		    }
+		}
+	    }
+	}
+
+	call msifree (xmsi)
+	call msifree (ymsi)
+	call yt_pmunmap (im)
+
+	# Create a new pixel mask of the required size and populate.
+	# Do dummy image I/O to set the header.
+
+	pm = pm_open (NULL)
+	call pm_ssize (pm, 2, IM_LEN(refim,1), 27)
+	im = im_pmmapo (pm, NULL)
+	ptr = imgl1i (im)
+
+	do j = 1, nl {
+	    call xt_bagi (ba, 1, j, Memi[bits], nc)
+	    v[2] = j
+	    call pmplpi (pm, v, Memi[bits], 0, nc, PIX_SRC)
+	}
+
+	call imseti (im, IM_PMDES, pm)
+
+	call xt_baclose (ba)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/getdatatype.x b/pkg/xtools/getdatatype.x
new file mode 100644
index 00000000..9502e82f
--- /dev/null
+++ b/pkg/xtools/getdatatype.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	NTYPES		9
+
+# GETDATATYPE -- Convert a character to an IRAF data type
+
+int procedure getdatatype (ch)
+
+char	ch
+int	i, type_code[NTYPES]
+int	stridx()
+
+string	types "bcusilrdx"		# Supported data types
+data	type_code /TY_UBYTE, TY_CHAR, TY_USHORT, TY_SHORT, TY_INT, TY_LONG,
+	TY_REAL, TY_DOUBLE, TY_COMPLEX/
+
+begin
+	i = stridx (ch, types)
+	if (i == 0)
+	   return (ERR)
+	else
+	    return (type_code[stridx(ch,types)])
+end
+
+
+# DTSTRING -- Convert a datatype to a string
+
+procedure dtstring (datatype, str, maxchar)
+
+int	datatype			# IRAF datatype
+char	str[maxchar]			# Output string
+int	maxchar				# Maximum characters in string
+
+begin
+	switch (datatype) {
+	case TY_UBYTE:
+	    call strcpy ("unsigned byte", str, maxchar)
+	case TY_CHAR:
+	    call strcpy ("character", str, maxchar)
+	case TY_USHORT:
+	    call strcpy ("unsigned short", str, maxchar)
+	case TY_SHORT:
+	    call strcpy ("short", str, maxchar)
+	case TY_INT:
+	    call strcpy ("integer", str, maxchar)
+	case TY_LONG:
+	    call strcpy ("long", str, maxchar)
+	case TY_REAL:
+	    call strcpy ("real", str, maxchar)
+	case TY_DOUBLE:
+	    call strcpy ("double", str, maxchar)
+	case TY_COMPLEX:
+	    call strcpy ("complex", str, maxchar)
+	default:
+	    call strcpy ("unknown", str, maxchar)
+	}
+end
diff --git a/pkg/xtools/gstrdetab.x b/pkg/xtools/gstrdetab.x
new file mode 100644
index 00000000..b51ac019
--- /dev/null
+++ b/pkg/xtools/gstrdetab.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSTRDETAB -- Procedure to remove tabs from a line of text.
+
+int procedure gstrdetab (line, outline, maxch, tabs)
+
+char   line[ARB], outline[ARB]
+int    maxch, tabs[ARB]
+
+int    ip, op
+
+begin
+	ip = 1
+	op = 1
+
+	while (line[ip] != EOS && op <= maxch) {
+	    if (line[ip] == '\t') {
+		repeat {
+		    outline[op] = ' '
+		    op = op + 1
+		} until (tabs[op] == YES || op > maxch)
+		ip = ip + 1
+	    } else {
+		outline[op] = line [ip]
+		ip = ip + 1
+		op = op + 1
+	    }
+	}
+
+	outline[op] = EOS
+	return (op-1)
+end
diff --git a/pkg/xtools/gstrentab.x b/pkg/xtools/gstrentab.x
new file mode 100644
index 00000000..2034c7fd
--- /dev/null
+++ b/pkg/xtools/gstrentab.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSTRENTAB -- Procedure to replace blanks with tabs and blanks.
+
+int procedure  gstrentab (line, outline, maxch, tabs)
+
+int   maxch, tabs[ARB]
+char  line[ARB], outline[ARB]
+
+int   ip, op, ltab
+
+begin
+	op = 1
+	ip = 1
+
+	repeat {
+	    ltab = ip
+	    while (line[ltab] == ' ' && op <= maxch) {
+		ltab = ltab + 1
+		if (tabs[ltab] == YES) {
+		    outline[op] = '\t'
+		    ip = ltab
+		    op = op + 1
+		}
+	    }
+	    for (; ip < ltab && op <= maxch; ip = ip + 1) {
+		outline[op] = ' '
+		op = op + 1
+	    }
+	    if (line[ip] == EOS || op >= maxch +1)
+		break
+	    outline[op] = line[ip]
+	    op = op + 1
+	    ip = ip + 1
+	} until (line[ip] == EOS || op >= maxch+1)
+
+	outline[op] = EOS
+	return (op-1)
+end
+
diff --git a/pkg/xtools/gstrsettab.x b/pkg/xtools/gstrsettab.x
new file mode 100644
index 00000000..ef7d5f68
--- /dev/null
+++ b/pkg/xtools/gstrsettab.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GSTRSETTAB -- Procedure to set tabs, using the integer array tabs.
+# The first tabstop is set at first_tabstop, with subsequent tabstops
+# at tabsize intervals.
+
+procedure gstrsettab (tabs, maxtabs, first_tabstop, tabsize)
+
+int   tabs[ARB], first_tabstop, tabsize
+int   i, maxtabs
+
+begin
+	for (i=1; i <= maxtabs; i = i + 1) {
+	    if (i < first_tabstop)
+		tabs[i] = NO
+	    else if (i == first_tabstop)
+		tabs[i] = YES
+	    else if (mod ((i - first_tabstop), tabsize) == 0)
+		tabs[i] = YES
+	    else
+		tabs[i] = NO
+	}
+end
diff --git a/pkg/xtools/gtools/Revisions b/pkg/xtools/gtools/Revisions
new file mode 100644
index 00000000..cca0335c
--- /dev/null
+++ b/pkg/xtools/gtools/Revisions
@@ -0,0 +1,172 @@
+.help revisions Jun88 pkg.xtools.gtools
+.nf
+=====
+V2.12
+=====
+
+pkg$xtools/gtools/gtlabax.x
+    Added workaround to avoid GUI message.  (2/1/99, Valdes)
+
+=======
+V2.11.2
+=======
+
+pkg$xtools/gtools/gtcolon.x
+    Corrected definition of btoi.  (8/11/99, Valdes)
+
+pkg$xtools/gtools/gtreset.x
+    This routine was declared as a function rather than a subroutine
+    as it should be.  (7/21/99, Valdes)
+
+pkg$xtools/gtools/gtlabax.x
+    Gmsg call is only made if there is a GUI.  (7/14/99, Valdes)
+
+*
+pkg$xtools/gtools/gthelp.x -
+pkg$xtools/gtools/gtpage.x -
+    New version with access to most of the GIO parameters and with
+    GUI messages.  (5/11/99, Valdes)
+
+=======
+V2.11.1
+=======
+
+=====
+V2.11
+=====
+lib$pkg/gtools.h
+pkg$xtools/gtools/gtools.h
+pkg$xtools/gtools/gtcolon.x
+pkg$xtools/gtools/gtset.x
+pkg$xtools/gtools/gtget.x
+pkg$xtools/gtools/gtlabax.x
+pkg$xtools/gtools/gtinit.x
+pkg$xtools/gtools/gtools.hlp
+    Added GTDRAWTITLE, GTDRAWXLABELS, and GTDRAWYLABELS to control the
+    three label components as blocks and independent of the user or
+    application settings of the title parameters and label parameters.
+    The help and key files were updated.
+    (4/26/96, Valdes)
+
+=========
+V2.10.4p2
+=========
+
+pkg$xtools/gtools/gtascale.x
+    The case with gt==NULL was not correct.  (8/16/95, Valdes)
+
+lib$pkg/gtools.h
+pkg$xtools/gtools/gtools.h
+pkg$xtools/gtools/gtget.x
+pkg$xtools/gtools/gtset.x
+pkg$xtools/gtools/gtwindow.x
+pkg$xtools/gtools/gtcopy.x
+pkg$xtools/gtools/gtinit.x
+pkg$xtools/gtools/gtswind.x
+pkg$xtools/gtools/gtcolon.x
+pkg$xtools/gtools/gtascale.x
+    Two new parameters, GTXFLIP and GTYFLIP, were added.  These boolean
+    parameters can be set to flip vectors plotted with the gtools
+    functions.  In the gt_window functions flips are now done using
+    these new parameters rather than explicitly setting the plot
+    limits.  Previously this meant that any use of the flip would
+    not allow autoscaling; that is a new graph with different limits
+    would only cover the fixed limits.  It also mean that the 'a'
+    window function would reset the flip.  (12/8/93, Valdes)
+
+pkg$xtools/gtools/gtplot.x
+    The gio color marks are drawn using the G_PLCOLOR rather than G_PMCOLOR
+    so the code was change to work appropriately. (11/11/93, Valdes)
+
+===========
+V2.10.3Beta
+===========
+
+pgk$xtools/gtools/gtools.hlp
+pgk$xtools/gtools/gtinit.x
+pgk$xtools/gtools/gtcolon.x
+pgk$xtools/gtools/Revisions
+pgk$xtools/gtools/gtvplot.x
+pgk$xtools/gtools/gtset.x
+pgk$xtools/gtools/gtplot.x
+pgk$xtools/gtools/gtget.x
+pgk$xtools/gtools/gtcopy.x
+pgk$xtools/gtools/gtools.h
+    Added color option.  (10/29/92, Valdes)
+
+pkg$xtools/gtools/gtcolon.x
+    The :/parameters case was resetting the subtitle string.
+    (12/28/90, Valdes, diagnosed by Jeff Munn)
+
+pkg$xtools/gtools/gtget.x
+    When the sysid option was added the gtgets routine was not modified
+    to return the setting.  This has been added.  (7/12/90, Valdes)
+
+pkg$xtools/gtools/gtget.x
+    When the histogram type was added the gtgets routine was not modified
+    to return this type.  This has been added.  (6/28/90, Valdes)
+
+====
+V2.9
+====
+
+pkg$xtools/gtools
+    1.  Added new colon command :/sysid to turn off system ID banner.
+    2.  Added new colon command :/type hist to plot histogram type lines.
+    (10/5/89, Valdes)
+
+pkg$xtools/gtools/gtascale.x
+    Made a trivial change, a temp variable is now used for switching two
+    variables, to work around an optimizer bug on Sun3/OS4/f68881.
+    (9/21/89, Valdes)
+
+====
+V2.8
+====
+
+pkg$xtools/gtools/gtascale.x +
+    Added a procedure to complement GSCALE to scale data only within
+    a GTOOLS window.  (11/30/87 Valdes)
+
+pkg$xtools/gtools/gtvplot.x +
+    Added a vector version of GT_PLOT.  (11/5/87 Valdes)
+
+====
+V2.5
+====
+
+pkg$xtools/gtools/*.x
+    Valdes, February 17, 1987
+    1.  Requires GIO changes.
+    2.  Eliminated GT_PAGE, GT_HELP, GT_WAITPAGE.
+    3.  Argument change to GT_COLON.
+
+pkg$xtools/gtools/gtset.x
+    Valdes, January 30, 1987
+    1.  In gtsets if the specified value string is not recognized an
+	error message is printed to STDERR.
+
+pkg$xtools/gtools/gthelp.x
+pkg$xtools/gtools/gtwindow.x
+pkg$xtools/gtools/gtcolon.x
+    Valdes, January 13, 1987
+    1.  GT_HELP now calls the system PAGEFILE procedure.  This procedure
+	should now be obsolete.
+    2.	Modified GT_WINDOW and GT_COLON to call PAGEFILE instead of GT_HELP.
+
+gtools$gtwindow.x:  Valdes, June 11, 1986
+    1.  Added new procedure gt_window.  It is a cursor driven procedure
+	for windowing graphs using the gtools pointer.  The help
+	page for gtools was also modified to show the windowing options.
+
+gtools$gtcur.x:  Valdes, May 10, 1986
+    1.  Took out "Confirm:" prompt so that cursor input from a file does
+	not cause anything to be printed.  Two EOF's (carriage return or
+	actual EOF) or a 'q' are required to exit thus protecting the user
+	from an inadvertent carriage return.
+
+From Valdes Oct 29, 1985:
+
+Added call to gmftitle in gtlabax.  This insures that graphics written to
+a metacode file can use the metacode tools locate graphics.
+.endhelp
diff --git a/pkg/xtools/gtools/gtascale.x b/pkg/xtools/gtools/gtascale.x
new file mode 100644
index 00000000..06f5c0ef
--- /dev/null
+++ b/pkg/xtools/gtools/gtascale.x
@@ -0,0 +1,100 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include	"gtools.h"
+	
+# GT_ASCALE -- Set graphics window to the range of the data.
+# Unlike GASCALE the data is limited to the GTOOLS window.
+# It also clips a fraction of the high and low points.
+
+procedure gt_ascale (gp, gt, x, y, npts)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+real	x[npts], y[npts]	# Data to scale
+int	npts			# Number of data points
+
+int	i, j, k, n
+real	xmin, xmax, ymin, ymax, x1, x2, y1, y2, temp
+pointer	buf
+
+begin
+	if (gt == NULL) {
+	    call gascale (gp, x, npts, 1)
+	    call gascale (gp, y, npts, 1)
+	    return
+	}
+
+	if (GT_TRANSPOSE(gt) == NO) {
+	    xmin = GT_XMIN(gt)
+	    xmax = GT_XMAX(gt)
+	    ymin = GT_YMIN(gt)
+	    ymax = GT_YMAX(gt)
+	} else {
+	    ymin = GT_XMIN(gt)
+	    ymax = GT_XMAX(gt)
+	    xmin = GT_YMIN(gt)
+	    xmax = GT_YMAX(gt)
+	}
+
+	if (IS_INDEF(xmin))
+	    xmin = -MAX_REAL
+	if (IS_INDEF(xmax))
+	    xmax = MAX_REAL
+	if (IS_INDEF(ymin))
+	    ymin = -MAX_REAL
+	if (IS_INDEF(ymax))
+	    ymax = MAX_REAL
+
+	temp = max (xmin, xmax)
+	xmin = min (xmin, xmax)
+	xmax = temp
+	temp = max (ymin, ymax)
+	ymin = min (ymin, ymax)
+	ymax = temp
+
+	x1 = xmax
+	x2 = xmin
+	y1 = ymax
+	y2 = ymin
+	n = 0
+	do i = 1, npts {
+	    if ((x[i]<xmin)||(x[i]>xmax)||(y[i]<ymin)||(y[i]>ymax))
+		next
+	    x1 = min (x1, x[i])
+	    x2 = max (x2, x[i])
+	    y1 = min (y1, y[i])
+	    y2 = max (y2, y[i])
+	    n = n + 1
+	}
+	if ((GT_LCLIP(gt) > 0. || GT_HCLIP(gt) > 0.) && n > 0) {
+	    call malloc (buf, n, TY_REAL)
+	    n = 0
+	    do i = 1, npts {
+		if ((x[i]<xmin)||(x[i]>xmax)||(y[i]<ymin)||(y[i]>ymax))
+		    next
+		Memr[buf+n] = y[i]
+		n = n + 1
+	    }
+	    call asrtr (Memr[buf], Memr[buf], n)
+	    if (GT_LCLIP(gt) > 1.)
+		j = GT_LCLIP(gt) / 100. * n
+	    else
+		j = max (0., GT_LCLIP(gt) * n)
+	    if (GT_HCLIP(gt) > 1.)
+		k = GT_HCLIP(gt) / 100. * n
+	    else
+		k = max (0., GT_HCLIP(gt) * n)
+	    k = n - 1 - k
+	    if (j > k) {
+		y1 = Memr[buf+j]
+		y2 = Memr[buf+k]
+	    }
+	    call mfree (buf, TY_REAL)
+	}
+
+	if (x1 <= x2)
+	    call gswind (gp, x1, x2, INDEF, INDEF)
+	if (y1 <= y2)
+	    call gswind (gp, INDEF, INDEF, y1, y2)
+end
diff --git a/pkg/xtools/gtools/gtcolon.x b/pkg/xtools/gtools/gtcolon.x
new file mode 100644
index 00000000..b2a918fb
--- /dev/null
+++ b/pkg/xtools/gtools/gtcolon.x
@@ -0,0 +1,754 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<gset.h>
+include	"gtools.h"
+
+define	KEY	"lib$scr/gtools.key"
+define	PROMPT	"graph format options"
+
+# Defined colon commands for the GTOOLS package
+define	CMDS "|help|xview|yview|xwindow|ywindow|sysid|parameters|title|subtitle\
+	|comments|xlabel|ylabel|xunits|yunits|drawtitle|drawxlabels|drawylabels\
+	|type|mark|line|xsize|ysize|color|xtransform|ytransform|xflip|yflip\
+	|transpose|xformat|yformat|xbuf|ybuf|clip|redraw|expand|shift|expand\
+	|uivalues|"
+
+define	HELP		1	# Get help
+define	XVIEW		2	# Set X viewport
+define	YVIEW		3	# Set Y viewport
+define	XWINDOW		4	# Set X window
+define	YWINDOW		5	# Set Y window
+define	SYSID		6	# Draw SYSID?
+define	PARAMETERS	7	# Set parameters string
+define	TITLE		8	# Set title
+define	SUBTITLE	9	# Set subtitle string
+define	COMMENTS	10	# Set comment string
+define	XLABEL		11	# Set X label
+define	YLABEL		12	# Set Y label
+define	XUNITS		13	# Set X unit label
+define	YUNITS		14	# Set Y unit label
+define	DRAWTITLE	15	# Draw title block?
+define	DRAWXLABELS	16	# Draw X label block?
+define	DRAWYLABELS	17	# Draw Y label block?
+define	TYPE		18	# Set graph type
+define	MARK		19	# Set symbol mark type
+define	LINE		20	# Set line type
+define	XSIZE		21	# Set X symbol size
+define	YSIZE		22	# Set Y symbol size
+define	COLOR		23	# Set color
+define	XTRANSFORM	24	# Set X transformation function
+define	YTRANSFORM	25	# Set Y transformation function
+define	XFLIP		26	# X flip
+define	YFLIP		27	# Y flip
+define	TRANSPOSE	28	# Transpose graph
+define	XFORMAT		29	# X format
+define	YFORMAT		30	# Y format
+define	XBUF		31	# X buffer distance
+define	YBUF		32	# X buffer distance
+define	CLIP		33	# Clipping factors
+define	REDRAW		34	# Redraw graph
+define	EXPAND		35	# Expand world coordinates
+define	SHIFT		36	# Shift world coordinates
+define	WINDOW		37	# Window command
+define	UIVALUES	38	# Send UI values
+
+
+# GT_COLON -- Process standard gtools colon commands.
+
+procedure gt_colon (cmdstr, gp, gt, newgraph)
+
+char	cmdstr[ARB]			# Command string
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+int	newgraph			# Update graph?
+
+char	cmd[SZ_LINE]
+int	ip, ncmd, ival
+real	x, y, rval[4]
+bool	bval
+
+int	nscan(), strdic(), gt_geti(), btoi()
+real	gt_getr()
+
+begin
+	# All GTOOLS commands start with '/'.
+	if (cmdstr[1] != '/')
+	    return
+
+	# Parse the command string matched against a dictionary.
+	call sscan (cmdstr[2])
+	call gargwrd (cmd, SZ_LINE)
+	ncmd = strdic (cmd, cmd, SZ_LINE, CMDS)
+
+	# Switch on the command and parse the arguments.
+	switch (ncmd) {
+	case HELP: # help: Print help
+	    call gpagefile (gp, KEY, PROMPT)
+
+	case XVIEW: # xview:  List or set x viewport.
+	    call gargr (rval[1])
+	    call gargr (rval[2])
+	    if (nscan() == 3) {
+		call gt_setr (gt, GTVXMIN, rval[1])
+		call gt_setr (gt, GTVXMAX, rval[2])
+	    } else {
+		call printf ("xview = %g %g\n")
+		    call pargr (gt_getr (gt, GTVXMIN))
+		    call pargr (gt_getr (gt, GTVXMAX))
+	    }
+
+	case YVIEW: # yview:  List or set y viewport.
+	    call gargr (rval[1])
+	    call gargr (rval[2])
+	    if (nscan() == 3) {
+		call gt_setr (gt, GTVYMIN, rval[1])
+		call gt_setr (gt, GTVYMAX, rval[2])
+	    } else {
+		call printf ("yview = %g %g\n")
+		    call pargr (gt_getr (gt, GTVYMIN))
+		    call pargr (gt_getr (gt, GTVYMAX))
+	    }
+
+	case XWINDOW: # xwindow:  List or set x window.
+	    call gargr (rval[1])
+	    call gargr (rval[2])
+	    if (nscan() == 3) {
+		call gt_setr (gt, GTXMIN, rval[1])
+		call gt_setr (gt, GTXMAX, rval[2])
+	    } else {
+		call printf ("xwindow = %g %g\n")
+		    call pargr (gt_getr (gt, GTXMIN))
+		    call pargr (gt_getr (gt, GTXMAX))
+	    }
+
+	case YWINDOW: # ywindow:  List or set y window.
+	    call gargr (rval[1])
+	    call gargr (rval[2])
+	    if (nscan() == 3) {
+		call gt_setr (gt, GTYMIN, rval[1])
+		call gt_setr (gt, GTYMAX, rval[2])
+	    } else {
+		call printf ("ywindow = %g %g\n")
+		    call pargr (gt_getr (gt, GTYMIN))
+		    call pargr (gt_getr (gt, GTYMAX))
+	    }
+
+	case SYSID: # sysid: Write SYSID string?
+	    call gargb (bval)
+	    if (nscan() == 2)
+		call gt_seti (gt, GTSYSID, btoi (bval))
+	    else {
+		call printf ("sysid = %b\n")
+		    call pargi (gt_geti (gt, GTSYSID))
+	    }
+
+	case PARAMETERS: # parameters: Set parameters string
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTPARAMS, cmd[ip])
+
+	case TITLE: # title: Set graph title
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTTITLE, cmd[ip])
+
+	case SUBTITLE: # subtitle: Set subtitle string
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTSUBTITLE, cmd[ip])
+
+	case COMMENTS: # comments: Set graph comments
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTCOMMENTS, cmd[ip])
+
+	case XLABEL: # xlabel: Set graph x label
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTXLABEL, cmd[ip])
+
+	case YLABEL: # ylabel: Set graph y label
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTYLABEL, cmd[ip])
+
+	case XUNITS: # xunits: Set graph x units
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTXUNITS, cmd[ip])
+
+	case YUNITS: # yunits: Set graph y units
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTYUNITS, cmd[ip])
+
+	case DRAWTITLE: # drawtitle: Draw title block?
+	    call gargb (bval)
+	    if (nscan() == 2)
+		call gt_seti (gt, GTDRAWTITLE, btoi (bval))
+	    else {
+		call printf ("drawtitle = %b\n")
+		    call pargi (gt_geti (gt, GTDRAWTITLE))
+	    }
+
+	case DRAWXLABELS: # drawxlabels: Draw x label block?
+	    call gargb (bval)
+	    if (nscan() == 2)
+		call gt_seti (gt, GTDRAWXLABELS, btoi (bval))
+	    else {
+		call printf ("drawxlabel = %b\n")
+		    call pargi (gt_geti (gt, GTDRAWXLABELS))
+	    }
+
+	case DRAWYLABELS: # drawylabels: Draw y label block?
+	    call gargb (bval)
+	    if (nscan() == 2)
+		call gt_seti (gt, GTDRAWYLABELS, btoi (bval))
+	    else {
+		call printf ("drawylabel = %b\n")
+		    call pargi (gt_geti (gt, GTDRAWYLABELS))
+	    }
+
+	case TYPE: # type: Graph type
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 2)
+		call gt_sets (gt, GTTYPE, cmd)
+	    else {
+		call gt_gets (gt, GTTYPE, cmd, SZ_LINE)
+	        call printf ("type = %s\n")
+		    call pargstr (cmd)
+	    }
+
+	case MARK: # mark: Mark type
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 2)
+		call gt_sets (gt, GTMARK, cmd)
+	    else {
+		call gt_gets (gt, GTMARK, cmd, SZ_LINE)
+	        call printf ("mark = %s\n")
+		    call pargstr (cmd)
+	    }
+
+	case LINE: # line: Line type
+	    call gargi (ival)
+	    if (nscan() == 2)
+		call gt_seti (gt, GTLINE, ival)
+	    else {
+	        call printf ("line = %s\n")
+		    call pargi (gt_geti (gt, GTLINE))
+	    }
+
+	case XSIZE: # xsize:  List or set x mark size.
+	    call gargr (rval[1])
+	    if (nscan() == 2) {
+		call gt_setr (gt, GTXSIZE, rval[1])
+	    } else {
+		call printf ("xsize = %g\n")
+		    call pargr (gt_getr (gt, GTXSIZE))
+	    }
+
+
+	case YSIZE: # ysize:  List or set y mark size.
+	    call gargr (rval[1])
+	    if (nscan() == 2) {
+		call gt_setr (gt, GTYSIZE, rval[1])
+	    } else {
+		call printf ("ysize = %g\n")
+		    call pargr (gt_getr (gt, GTYSIZE))
+	    }
+
+	case COLOR: # color: line/mark color
+	    call gargi (ival)
+	    if (nscan() == 2)
+		call gt_seti (gt, GTCOLOR, ival)
+	    else {
+	        call printf ("color = %s\n")
+		    call pargi (gt_geti (gt, GTCOLOR))
+	    }
+
+	case XTRANSFORM: # xtransform: List or set ytransform.
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 2)
+		call gt_sets (gt, GTXTRAN, cmd)
+	    else {
+		call gt_gets (gt, GTXTRAN, cmd, SZ_LINE)
+	        call printf ("xtransform = %s\n")
+		    call pargstr (cmd)
+	    }
+
+	case YTRANSFORM: # ytransform: List or set ytransform.
+	    call gargwrd (cmd, SZ_LINE)
+	    if (nscan() == 2)
+		call gt_sets (gt, GTYTRAN, cmd)
+	    else {
+		call gt_gets (gt, GTYTRAN, cmd, SZ_LINE)
+	        call printf ("ytransform = %s\n")
+		    call pargstr (cmd)
+	    }
+	
+	case XFLIP: # xflip: Toggle x flip flag
+	    call gargb (bval)
+	    if (nscan() == 2)
+		call gt_seti (gt, GTXFLIP, btoi (bval))
+	    else {
+		call printf ("xflip = %b\n")
+		    call pargi (gt_geti (gt, GTXFLIP))
+	    }
+
+	case YFLIP: # yflip: Toggle y flip flag
+	    call gargb (bval)
+	    if (nscan() == 2)
+		call gt_seti (gt, GTYFLIP, btoi (bval))
+	    else {
+		call printf ("yflip = %b\n")
+		    call pargi (gt_geti (gt, GTYFLIP))
+	    }
+
+	case TRANSPOSE: # transpose: Toggle transpose flag
+	    if (gt_geti (gt, GTTRANSPOSE) == NO)
+		call gt_seti (gt, GTTRANSPOSE, YES)
+	    else
+		call gt_seti (gt, GTTRANSPOSE, NO)
+
+	case XFORMAT: # xformat: Set graph x format
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTXFORMAT, cmd[ip])
+
+	case YFORMAT: # yformat: Set graph y format
+	    call gargstr (cmd, SZ_LINE)
+	    for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
+		;
+	    call gt_sets (gt, GTYFORMAT, cmd[ip])
+
+	case XBUF: # xbuf: List or set x buffer.
+	    call gargr (rval[1])
+	    if (nscan() == 2)
+		call gt_setr (gt, GTXBUF, rval[1])
+	    else {
+		call printf ("xbuf = %g\n")
+		   call pargr (gt_getr (gt, GTXBUF))
+	    }
+
+	case YBUF: # ybuf: List or set y buffer.
+	    call gargr (rval[1])
+	    if (nscan() == 2)
+		call gt_setr (gt, GTYBUF, rval[1])
+	    else {
+		call printf ("ybuf = %g\n")
+		   call pargr (gt_getr (gt, GTYBUF))
+	    }
+
+	case CLIP: # clip: autoscaling clipping
+	    call gargr (rval[1])
+	    call gargr (rval[2])
+	    if (nscan() == 3) {
+		call gt_setr (gt, GTLCLIP, rval[1])
+		call gt_setr (gt, GTHCLIP, rval[2])
+	    } else {
+		call printf ("clip = %g %g\n")
+		    call pargr (gt_getr (gt, GTLCLIP))
+		    call pargr (gt_getr (gt, GTHCLIP))
+	    }
+
+	case REDRAW: # redraw: Redraw the graph
+	    newgraph = 1
+
+	case EXPAND: # :expand x1 x2 y1 y2
+	    call gargr (rval[1])
+	    call gargr (rval[2])
+	    call gargr (rval[3])
+	    call gargr (rval[4])
+	    if (nscan() == 5) {
+		if (rval[1] !=  gt_getr (gt, GTXMIN)) {
+		    call gt_setr (gt, GTXMIN, rval[1])
+		    newgraph = 1
+		}
+		if (rval[2] !=  gt_getr (gt, GTXMAX)) {
+		    call gt_setr (gt, GTXMAX, rval[2])
+		    newgraph = 1
+		}
+		if (rval[3] !=  gt_getr (gt, GTYMIN)) {
+		    call gt_setr (gt, GTYMIN, rval[3])
+		    newgraph = 1
+		}
+		if (rval[4] !=  gt_getr (gt, GTYMAX)) {
+		    call gt_setr (gt, GTYMAX, rval[4])
+		    newgraph = 1
+		}
+	    }
+
+	case SHIFT: # :shift x y
+	    call gargr (x)
+	    call gargr (y)
+	    rval[1] = gt_getr (gt, GTXMIN)
+	    rval[2] = gt_getr (gt, GTXMAX)
+	    if (IS_INDEFR(x)) {
+		if (!IS_INDEFR(rval[1]) || !IS_INDEFR(rval[2])) {
+		    call gt_setr (gt, GTXMIN, INDEFR)
+		    call gt_setr (gt, GTXMAX, INDEFR)
+		    newgraph = 1
+		}
+	    } else {
+		if (!IS_INDEFR(rval[1]) && !IS_INDEFR(rval[2])) {
+		    rval[3] = rval[2] - rval[1]
+		    rval[4] = x - (rval[1] + rval[2]) / 2
+		    if (abs (rval[4] / rval[3]) > 0.001) {
+			call gt_setr (gt, GTXMIN, rval[1] + rval[4])
+			call gt_setr (gt, GTXMAX, rval[2] + rval[4])
+		    }
+		    newgraph = 1
+		}
+	    }
+
+	    rval[1] = gt_getr (gt, GTYMIN)
+	    rval[2] = gt_getr (gt, GTYMAX)
+	    if (IS_INDEFR(y)) {
+		if (!IS_INDEFR(rval[1]) || !IS_INDEFR(rval[2])) {
+		    call gt_setr (gt, GTYMIN, INDEFR)
+		    call gt_setr (gt, GTYMAX, INDEFR)
+		    newgraph = 1
+		}
+	    } else {
+		if (!IS_INDEFR(rval[1]) && !IS_INDEFR(rval[2])) {
+		    rval[3] = rval[2] - rval[1]
+		    rval[4] = y - (rval[1] + rval[2]) / 2
+		    if (abs (rval[4] / rval[3]) > 0.001) {
+			call gt_setr (gt, GTYMIN, rval[1] + rval[4])
+			call gt_setr (gt, GTYMAX, rval[2] + rval[4])
+		    }
+		    newgraph = 1
+		}
+	    }
+
+	case WINDOW: # window: window x y wcs key cmd
+	    call gargr (x)
+	    call gargr (y)
+	    call gargi (ip)
+	    call gargwrd (cmd, SZ_LINE)
+	    ival = cmd[1]
+	    if (nscan() < 5)
+		return
+	    if (ival == ':')
+		call gargwrd (cmd, SZ_LINE)
+	    call gt_window1 (gt, gp, x, y, ip, ival, cmd, newgraph)
+
+	case UIVALUES: # uivalues: send values to UI
+	    call gt_uivalues (gp, gt)
+
+	default: # Check for more colon command
+	    call gt_colon1 (cmdstr, gp, gt, newgraph)
+	}
+end
+
+
+# Defined colon commands
+define	CMDS1 "|txup|txsize|txpath|txspacing|txhjustify|txvjustify|txfont\
+	|txquality|txcolor|drawtitle|titlesize|titlejust|ntitlelines|aspect\
+	|charsize|titlecolor|framecolor|drawaxes|setaxispos|axispos1|axispos2\
+	|drawgrid|round|labelaxis|axislabelsize|drawticks|labelticks|nmajor\
+	|nminor|majorlength|minorlength|majorwidth|minorwidth|axiswidth\
+	|ticklabelsize|gridcolor|axislabelcolor|axiscolor|ticklabelcolor\
+	|tickcolor|axes|ticks|colors|"
+
+define	TXUP			1	# Text parameters
+define	TXSIZE			2
+define	TXPATH			3
+define	TXSPACING		4
+define	TXHJUSTIFY		5
+define	TXVJUSTIFY		6
+define	TXFONT			7
+define	TXQUALITY		8
+define	TXCOLOR			9
+
+define	DRAWTITLE		10	# GLABAX, general parameters
+define	TITLESIZE		11
+define	TITLEJUST		12
+define	NTITLELINES		13
+define	ASPECT			14
+define	CHARSIZE		15
+define	TITLECOLOR		16
+define	FRAMECOLOR		17
+
+define	DRAWAXES		18	# GLABAX, x/y axis parameters
+define	SETAXISPOS		19
+define	AXISPOS1		20
+define	AXISPOS2		21
+define	DRAWGRID		22
+define	ROUND			23
+define	LABELAXIS		24
+define	AXISLABELSIZE		25
+define	DRAWTICKS		26
+define	LABELTICKS		27
+define	NMAJOR			28
+define	NMINOR			29
+define	MAJORLENGTH		30
+define	MINORLENGTH		31
+define	MAJORWIDTH		32
+define	MINORWIDTH		33
+define	AXISWIDTH		34
+define	TICKLABELSIZE		35
+define	GRIDCOLOR		36
+define	AXISLABELCOLOR		37
+define	AXISCOLOR		38
+define	TICKLABELCOLOR		39
+define	TICKCOLOR		40
+
+define	AXES			41	# Grouped parameters
+define	TICKS			42
+define	COLORS			43
+
+
+# GT_COLON1 -- Interpret colon commands.
+
+procedure gt_colon1 (cmdstr, gp, gt, newgraph)
+
+char	cmdstr[ARB]			# Command string
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+int	newgraph			# Update graph?
+
+bool	bval
+real	rval[12]
+pointer	sp, cmd
+int	ncmd, btoi(), nscan(), strdic()
+
+begin
+	# All GTOOLS commands start with '/'.
+	if (cmdstr[1] != '/')
+	    return
+
+	# Parse the command string matched against a dictionary.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	call sscan (cmdstr[2])
+	call gargwrd (Memc[cmd], SZ_LINE)
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, CMDS1)
+
+	# Get arguments and return if there are insufficient arguments.
+	if (ncmd < DRAWAXES) {
+	    call gargr (rval[1])
+	    if (nscan() != 2) {
+		call sfree (sp)
+		return
+	    }
+	} else if (ncmd < AXES) {
+	    switch (ncmd) {
+	    case DRAWAXES:
+		call gargwrd (Memc[cmd], SZ_LINE)
+		rval[1] = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GT_XAXES)
+		call gargwrd (Memc[cmd], SZ_LINE)
+		rval[2] = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GT_YAXES)
+	    case DRAWGRID, ROUND, LABELAXIS, DRAWTICKS, LABELTICKS:
+		call gargb (bval)
+		rval[1] = btoi (bval)
+		call gargb (bval)
+		rval[2] = btoi (bval)
+	    default:
+		call gargr (rval[1])
+		call gargr (rval[2])
+	    }
+	    if (nscan() != 3) {
+		call sfree (sp)
+		return
+	    }
+	}
+
+	# Switch on the command and parse the arguments.
+	switch (ncmd) {
+	case TXUP:
+	    Memi[gt+GT_TXUP] = nint (rval[1])
+	case TXSIZE:
+	    Memr[P2R(gt+GT_TXSIZE)] = rval[1]
+	case TXPATH:
+	    Memi[gt+GT_TXPATH] = nint (rval[1])
+	case TXSPACING:
+	    Memr[P2R(gt+GT_TXSPACING)] = rval[1]
+	case TXHJUSTIFY:
+	    Memi[gt+GT_TXHJUSTIFY] = nint (rval[1])
+	case TXVJUSTIFY:
+	    Memi[gt+GT_TXVJUSTIFY] = nint (rval[1])
+	case TXFONT:
+	    Memi[gt+GT_TXFONT] = nint (rval[1])
+	case TXQUALITY:
+	    Memi[gt+GT_TXQUALITY] = nint (rval[1])
+	case TXCOLOR:
+	    Memi[gt+GT_TXCOLOR] = nint (rval[1])
+
+	case DRAWTITLE:
+	    Memi[gt+GT_DRAWTITLE] = nint (rval[1])
+	case TITLESIZE:
+	    Memr[P2R(gt+GT_TITLESIZE)] = rval[1]
+	case TITLEJUST:
+	    Memi[gt+GT_TITLEJUST] = nint (rval[1])
+	case NTITLELINES:
+	    Memi[gt+GT_NTITLELINES] = nint (rval[1])
+	case ASPECT:
+	    Memr[P2R(gt+GT_ASPECT)] = rval[1]
+	case CHARSIZE:
+	    Memr[P2R(gt+GT_CHARSIZE)] = rval[1]
+	case TITLECOLOR:
+	    Memi[gt+GT_TITLECOLOR] = nint (rval[1])
+	case FRAMECOLOR:
+	    Memi[gt+GT_FRAMECOLOR] = nint (rval[1])
+
+	case DRAWAXES:
+	    if (rval[1] > 0)
+		Memi[gt+GT_XDRAWAXES] = nint (rval[1]) - 1
+	    if (rval[2] > 0)
+		Memi[gt+GT_YDRAWAXES] = nint (rval[2]) - 1
+	case SETAXISPOS:
+	    Memi[gt+GT_XSETAXISPOS] = nint (rval[1])
+	    Memi[gt+GT_YSETAXISPOS] = nint (rval[2])
+	case AXISPOS1:
+	    Memr[P2R(gt+GT_XAXISPOS1)] = rval[1]
+	    Memr[P2R(gt+GT_YAXISPOS1)] = rval[2]
+	case AXISPOS2:
+	    Memr[P2R(gt+GT_XAXISPOS2)] = rval[1]
+	    Memr[P2R(gt+GT_YAXISPOS2)] = rval[2]
+	case DRAWGRID:
+	    Memi[gt+GT_XDRAWGRID] = nint (rval[1])
+	    Memi[gt+GT_YDRAWGRID] = nint (rval[2])
+	case ROUND:
+	    Memi[gt+GT_XROUND] = nint (rval[1])
+	    Memi[gt+GT_YROUND] = nint (rval[2])
+	case LABELAXIS:
+	    Memi[gt+GT_XLABELAXIS] = nint (rval[1])
+	    Memi[gt+GT_YLABELAXIS] = nint (rval[2])
+	case AXISLABELSIZE:
+	    Memr[P2R(gt+GT_XAXISLABELSIZE)] = rval[1]
+	    Memr[P2R(gt+GT_YAXISLABELSIZE)] = rval[2]
+	case DRAWTICKS:
+	    Memi[gt+GT_XDRAWTICKS] = nint (rval[1])
+	    Memi[gt+GT_YDRAWTICKS] = nint (rval[2])
+	case LABELTICKS:
+	    Memi[gt+GT_XLABELTICKS] = nint (rval[1])
+	    Memi[gt+GT_YLABELTICKS] = nint (rval[2])
+	case NMAJOR:
+	    Memi[gt+GT_XNMAJOR] = nint (rval[1])
+	    Memi[gt+GT_YNMAJOR] = nint (rval[2])
+	case NMINOR:
+	    Memi[gt+GT_XNMINOR] = nint (rval[1])
+	    Memi[gt+GT_YNMINOR] = nint (rval[2])
+	case MAJORLENGTH:
+	    Memr[P2R(gt+GT_XMAJORLENGTH)] = rval[1]
+	    Memr[P2R(gt+GT_YMAJORLENGTH)] = rval[2]
+	case MINORLENGTH:
+	    Memr[P2R(gt+GT_XMINORLENGTH)] = rval[1]
+	    Memr[P2R(gt+GT_YMINORLENGTH)] = rval[2]
+	case MAJORWIDTH:
+	    Memr[P2R(gt+GT_XMAJORWIDTH)] = rval[1]
+	    Memr[P2R(gt+GT_YMAJORWIDTH)] = rval[2]
+	case MINORWIDTH:
+	    Memr[P2R(gt+GT_XMINORWIDTH)] = rval[1]
+	    Memr[P2R(gt+GT_YMINORWIDTH)] = rval[2]
+	case AXISWIDTH:
+	    Memr[P2R(gt+GT_XAXISWIDTH)] = rval[1]
+	    Memr[P2R(gt+GT_YAXISWIDTH)] = rval[2]
+	case TICKLABELSIZE:
+	    Memr[P2R(gt+GT_XTICKLABELSIZE)] = rval[1]
+	    Memr[P2R(gt+GT_YTICKLABELSIZE)] = rval[2]
+	case GRIDCOLOR:
+	    Memi[gt+GT_XGRIDCOLOR] = nint (rval[1])
+	    Memi[gt+GT_YGRIDCOLOR] = nint (rval[2])
+	case AXISLABELCOLOR:
+	    Memi[gt+GT_XAXISLABELCOLOR] = nint (rval[1])
+	    Memi[gt+GT_YAXISLABELCOLOR] = nint (rval[2])
+	case AXISCOLOR:
+	    Memi[gt+GT_XAXISCOLOR] = nint (rval[1])
+	    Memi[gt+GT_YAXISCOLOR] = nint (rval[2])
+	case TICKLABELCOLOR:
+	    Memi[gt+GT_XTICKLABELCOLOR] = nint (rval[1])
+	    Memi[gt+GT_YTICKLABELCOLOR] = nint (rval[2])
+	case TICKCOLOR:
+	    Memi[gt+GT_XTICKCOLOR] = nint (rval[1])
+	    Memi[gt+GT_YTICKCOLOR] = nint (rval[2])
+
+	case AXES:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    rval[1] = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GT_XAXES)
+	    call gargr (rval[2])
+	    call gargb (bval)
+	    rval[3] = btoi (bval)
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    rval[4] = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GT_XAXES)
+	    call gargr (rval[5])
+	    call gargb (bval)
+	    rval[6] = btoi (bval)
+	    if (nscan() == 7) {
+		Memi[gt+GT_XDRAWAXES] = nint (rval[1])
+		Memr[P2R(gt+GT_XAXISWIDTH)] = rval[2]
+		Memr[P2R(gt+GT_XMAJORWIDTH)] = rval[2]
+		Memr[P2R(gt+GT_XMINORWIDTH)] = rval[2]
+		Memi[gt+GT_XDRAWGRID] = nint (rval[3])
+		Memi[gt+GT_YDRAWAXES] = nint (rval[4])
+		Memr[P2R(gt+GT_YAXISWIDTH)] = rval[5]
+		Memr[P2R(gt+GT_YMAJORWIDTH)] = rval[5]
+		Memr[P2R(gt+GT_YMINORWIDTH)] = rval[5]
+		Memi[gt+GT_YDRAWGRID] = nint (rval[6])
+	    }
+	case TICKS:
+	    call gargb (bval)
+	    rval[1] = btoi (bval)
+	    call gargb (bval)
+	    rval[2] = btoi (bval)
+	    call gargr (rval[3])
+	    call gargr (rval[4])
+	    call gargb (bval)
+	    rval[5] = btoi (bval)
+	    call gargb (bval)
+	    rval[6] = btoi (bval)
+	    call gargr (rval[7])
+	    call gargr (rval[8])
+	    if (nscan() == 9) {
+		Memi[gt+GT_XDRAWTICKS] = nint (rval[1])
+		Memi[gt+GT_XLABELTICKS] = nint (rval[2])
+		Memi[gt+GT_XNMAJOR] = nint (rval[3])
+		Memi[gt+GT_XNMINOR] = nint (rval[4])
+		Memi[gt+GT_YDRAWTICKS] = nint (rval[5])
+		Memi[gt+GT_YLABELTICKS] = nint (rval[6])
+		Memi[gt+GT_YNMAJOR] = nint (rval[7])
+		Memi[gt+GT_YNMINOR] = nint (rval[8])
+	    }
+	case COLORS:
+	    call gargr (rval[1])
+	    call gargr (rval[2])
+	    call gargr (rval[3])
+	    call gargr (rval[4])
+	    call gargr (rval[5])
+	    call gargr (rval[6])
+	    call gargr (rval[7])
+	    call gargr (rval[8])
+	    call gargr (rval[9])
+	    call gargr (rval[10])
+	    call gargr (rval[11])
+	    call gargr (rval[12])
+	    if (nscan() == 13) {
+		Memi[gt+GT_FRAMECOLOR] = nint (rval[1])
+		Memi[gt+GT_TITLECOLOR] = nint (rval[2])
+		Memi[gt+GT_XGRIDCOLOR] = nint (rval[3])
+		Memi[gt+GT_XAXISLABELCOLOR] = nint (rval[4])
+		Memi[gt+GT_XAXISCOLOR] = nint (rval[5])
+		Memi[gt+GT_XTICKLABELCOLOR] = nint (rval[6])
+		Memi[gt+GT_XTICKCOLOR] = nint (rval[7])
+		Memi[gt+GT_YGRIDCOLOR] = nint (rval[8])
+		Memi[gt+GT_YAXISLABELCOLOR] = nint (rval[9])
+		Memi[gt+GT_YAXISCOLOR] = nint (rval[10])
+		Memi[gt+GT_YTICKLABELCOLOR] = nint (rval[11])
+		Memi[gt+GT_YTICKCOLOR] = nint (rval[12])
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/gtools/gtcopy.x b/pkg/xtools/gtools/gtcopy.x
new file mode 100644
index 00000000..5c79da9e
--- /dev/null
+++ b/pkg/xtools/gtools/gtcopy.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gtools.h"
+
+# GT_COPY -- Copy values of one structure to another.
+
+procedure gt_copy (gt1, gt2)
+
+pointer	gt1, gt2
+
+int	len, strlen()
+pointer	gt_init()
+
+begin
+	if (gt1 == NULL)
+	    call error (0, "gt_copy: Undefined gtools structure")
+
+	if (gt2 == NULL)
+	    gt2 = gt_init ()
+	else {
+	    call mfree (GT_PARAMS(gt2), TY_CHAR)
+	    call mfree (GT_TITLE(gt2), TY_CHAR)
+	    call mfree (GT_SUBTITLE(gt2), TY_CHAR)
+	    call mfree (GT_COMMENTS(gt2), TY_CHAR)
+	    call mfree (GT_XLABEL(gt2), TY_CHAR)
+	    call mfree (GT_YLABEL(gt2), TY_CHAR)
+	    call mfree (GT_XUNITS(gt2), TY_CHAR)
+	    call mfree (GT_YUNITS(gt2), TY_CHAR)
+	    call mfree (GT_XFORMAT(gt2), TY_CHAR)
+	    call mfree (GT_YFORMAT(gt2), TY_CHAR)
+	}
+
+	call amovi (Memi[gt1], Memi[gt2], LEN_GT)
+
+	if (GT_PARAMS(gt1) != NULL) {
+	    len = strlen (Memc[GT_PARAMS(gt1)])
+	    call malloc (GT_PARAMS(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_PARAMS(gt1)], Memc[GT_PARAMS(gt2)], len)
+	}
+	if (GT_TITLE(gt1) != NULL) {
+	    len = strlen (Memc[GT_TITLE(gt1)])
+	    call malloc (GT_TITLE(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_TITLE(gt1)], Memc[GT_TITLE(gt2)], len)
+	}
+	if (GT_SUBTITLE(gt1) != NULL) {
+	    len = strlen (Memc[GT_SUBTITLE(gt1)])
+	    call malloc (GT_SUBTITLE(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_SUBTITLE(gt1)], Memc[GT_SUBTITLE(gt2)], len)
+	}
+	if (GT_COMMENTS(gt1) != NULL) {
+	    len = strlen (Memc[GT_COMMENTS(gt1)])
+	    call malloc (GT_COMMENTS(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_COMMENTS(gt1)], Memc[GT_COMMENTS(gt2)], len)
+	}
+	if (GT_XLABEL(gt1) != NULL) {
+	    len = strlen (Memc[GT_XLABEL(gt1)])
+	    call malloc (GT_XLABEL(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_XLABEL(gt1)], Memc[GT_XLABEL(gt2)], len)
+	}
+	if (GT_YLABEL(gt1) != NULL) {
+	    len = strlen (Memc[GT_YLABEL(gt1)])
+	    call malloc (GT_YLABEL(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_YLABEL(gt1)], Memc[GT_YLABEL(gt2)], len)
+	}
+	if (GT_XUNITS(gt1) != NULL) {
+	    len = strlen (Memc[GT_XUNITS(gt1)])
+	    call malloc (GT_XUNITS(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_XUNITS(gt1)], Memc[GT_XUNITS(gt2)], len)
+	}
+	if (GT_YUNITS(gt1) != NULL) {
+	    len = strlen (Memc[GT_YUNITS(gt1)])
+	    call malloc (GT_YUNITS(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_YUNITS(gt1)], Memc[GT_YUNITS(gt2)], len)
+	}
+	if (GT_XFORMAT(gt1) != NULL) {
+	    len = strlen (Memc[GT_XFORMAT(gt1)])
+	    call malloc (GT_XFORMAT(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_XFORMAT(gt1)], Memc[GT_XFORMAT(gt2)], len)
+	}
+	if (GT_YFORMAT(gt1) != NULL) {
+	    len = strlen (Memc[GT_YFORMAT(gt1)])
+	    call malloc (GT_YFORMAT(gt2), len, TY_CHAR)
+	    call strcpy (Memc[GT_YFORMAT(gt1)], Memc[GT_YFORMAT(gt2)], len)
+	}
+end
diff --git a/pkg/xtools/gtools/gtctran.x b/pkg/xtools/gtools/gtctran.x
new file mode 100644
index 00000000..1b62688f
--- /dev/null
+++ b/pkg/xtools/gtools/gtctran.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GT_XCTRAN -- Transform x between two WCS.  Return new value as a function.
+
+real procedure gt_xctran (gp, x1, wcs1, wcs2)
+
+pointer	gp			# GIO pointer
+real	x1			# X value to be transformed
+int	wcs1			# Input WCS
+int	wcs2			# Output WCS
+
+real	x2, y2
+
+begin
+	call gctran (gp, x1, 0., x2, y2, wcs1, wcs2)
+	return (x2)
+end
+
+
+# GT_YCTRAN -- Transform y between two WCS.  Return new value as a function.
+
+real procedure gt_yctran (gp, y1, wcs1, wcs2)
+
+pointer	gp			# GIO pointer
+real	y1			# Y value to be transformed
+int	wcs1			# Input WCS
+int	wcs2			# Output WCS
+
+real	x2, y2
+
+begin
+	call gctran (gp, 0., y1, x2, y2, wcs1, wcs2)
+	return (y2)
+end
diff --git a/pkg/xtools/gtools/gtcur.x b/pkg/xtools/gtools/gtcur.x
new file mode 100644
index 00000000..7103bf9c
--- /dev/null
+++ b/pkg/xtools/gtools/gtcur.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GT_GCUR -- Interface to clgcur to confirm EOF, map key 'q' to EOF.
+
+int procedure gt_gcur (cur, wx, wy, wcs, key, cmd, sz_cmd)
+
+char	cur[ARB]		# Cursor parameter
+real	wx, wy			# Cursor position
+int	wcs, key		# WCS and cursor key
+char	cmd[sz_cmd]		# Command string
+int	sz_cmd			# Size of command string
+
+int	curval, clgcur()
+
+begin
+	curval = clgcur (cur, wx, wy, wcs, key, cmd, sz_cmd)
+	if (key == 'q')
+	    curval = EOF
+
+	return (curval)
+end
diff --git a/pkg/xtools/gtools/gtcur1.x b/pkg/xtools/gtools/gtcur1.x
new file mode 100644
index 00000000..edb42299
--- /dev/null
+++ b/pkg/xtools/gtools/gtcur1.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gtools.h"
+
+# GT_GCUR1 -- Interface to clgcur to confirm EOF, map key 'q' to EOF.
+# Transposes X and Y if needed.
+
+int procedure gt_gcur1 (gt, cur, wx, wy, wcs, key, cmd, sz_cmd)
+
+pointer	gt			# GTOOLS pointer
+char	cur[ARB]		# Cursor parameter
+real	wx, wy			# Cursor position
+int	wcs, key		# WCS and cursor key
+char	cmd[sz_cmd]		# Command string
+int	sz_cmd			# Size of command string
+
+int	curval, clgcur()
+real	temp
+
+begin
+	curval = clgcur (cur, wx, wy, wcs, key, cmd, sz_cmd)
+
+	if (curval == EOF) {
+	    curval = clgcur (cur, wx, wy, wcs, key, cmd, sz_cmd)
+	    if (curval != EOF) {
+		if (key == 'q')
+		    curval = EOF
+	    }
+	} else if (key == 'q')
+	    curval = EOF
+
+	if (GT_TRANSPOSE(gt) == YES) {
+	    temp = wx
+	    wx = wy
+	    wy = temp
+	}
+	return (curval)
+end
diff --git a/pkg/xtools/gtools/gtfree.x b/pkg/xtools/gtools/gtfree.x
new file mode 100644
index 00000000..da4bec03
--- /dev/null
+++ b/pkg/xtools/gtools/gtfree.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gtools.h"
+
+# GT_FREE -- Free extended graphics tools structure.
+
+procedure gt_free (gt)
+
+pointer	gt			# Graphic tools pointer
+
+begin
+	if (gt == NULL)
+	    return
+
+	call mfree (GT_PARAMS(gt), TY_CHAR)
+	call mfree (GT_TITLE(gt), TY_CHAR)
+	call mfree (GT_SUBTITLE(gt), TY_CHAR)
+	call mfree (GT_COMMENTS(gt), TY_CHAR)
+	call mfree (GT_XLABEL(gt), TY_CHAR)
+	call mfree (GT_YLABEL(gt), TY_CHAR)
+	call mfree (GT_XUNITS(gt), TY_CHAR)
+	call mfree (GT_YUNITS(gt), TY_CHAR)
+	call mfree (GT_XFORMAT(gt), TY_CHAR)
+	call mfree (GT_YFORMAT(gt), TY_CHAR)
+	call mfree (gt, TY_STRUCT)
+end
diff --git a/pkg/xtools/gtools/gtget.x b/pkg/xtools/gtools/gtget.x
new file mode 100644
index 00000000..8274dab9
--- /dev/null
+++ b/pkg/xtools/gtools/gtget.x
@@ -0,0 +1,210 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gtools.h"
+
+# GT_GETI -- Set integer parameters.
+
+int procedure gt_geti (gt, param)
+
+pointer	gt			# GTOOLS pointer
+int	param			# Parameter to set
+
+begin
+	switch (param) {
+	case GTLINE:
+	    return (GT_LINE(gt))
+	case GTTRANSPOSE:
+	    return (GT_TRANSPOSE(gt))
+	case GTSYSID:
+	    return (GT_SYSID(gt))
+	case GTCOLOR:
+	    return (GT_COLOR(gt))
+	case GTXFLIP:
+	    return (GT_XFLIP(gt))
+	case GTYFLIP:
+	    return (GT_YFLIP(gt))
+	case GTDRAWTITLE:
+	    return (GT_DRWTITLE(gt))
+	case GTDRAWXLABELS:
+	    return (GT_DRWXLABELS(gt))
+	case GTDRAWYLABELS:
+	    return (GT_DRWYLABELS(gt))
+	}
+end
+
+
+# GT_GETR -- Set real parameters.
+
+real procedure gt_getr (gt, param)
+
+pointer	gt			# GTOOLS pointer
+int	param			# Parameter to set
+
+begin
+	switch (param) {
+	case GTVXMIN:
+	    return (GT_VXMIN(gt))
+	case GTVXMAX:
+	    return (GT_VXMAX(gt))
+	case GTVYMIN:
+	    return (GT_VYMIN(gt))
+	case GTVYMAX:
+	    return (GT_VYMAX(gt))
+	case GTXMIN:
+	    if (GT_XFLIP(gt) == NO)
+		return (GT_XMIN(gt))
+	    else
+		return (GT_XMAX(gt))
+	case GTXMAX:
+	    if (GT_XFLIP(gt) == NO)
+		return (GT_XMAX(gt))
+	    else
+		return (GT_XMIN(gt))
+	case GTYMIN:
+	    if (GT_YFLIP(gt) == NO)
+		return (GT_YMIN(gt))
+	    else
+		return (GT_YMAX(gt))
+	case GTYMAX:
+	    if (GT_YFLIP(gt) == NO)
+		return (GT_YMAX(gt))
+	    else
+		return (GT_YMIN(gt))
+	case GTXBUF:
+	    return (GT_XBUF(gt))
+	case GTYBUF:
+	    return (GT_YBUF(gt))
+	case GTLCLIP:
+	    return (GT_LCLIP(gt))
+	case GTHCLIP:
+	    return (GT_HCLIP(gt))
+	case GTXSIZE:
+	    return (GT_XSIZE(gt))
+	case GTYSIZE:
+	    return (GT_YSIZE(gt))
+	}
+end
+
+
+# GT_GETS -- Get string parameters.
+
+procedure gt_gets (gt, param, str, sz_str)
+
+pointer	gt			# GTOOLS pointer
+int	param			# Parameter to set
+char	str[sz_str]		# String
+int	sz_str			# Size of string
+
+begin
+	str[1] = EOS
+	switch (param) {
+	case GTPARAMS:
+	    if (GT_PARAMS(gt) != NULL)
+	        call strcpy (Memc[GT_PARAMS(gt)], str, sz_str)
+	case GTTITLE:
+	    if (GT_TITLE(gt) != NULL)
+	        call strcpy (Memc[GT_TITLE(gt)], str, sz_str)
+	case GTSUBTITLE:
+	    if (GT_SUBTITLE(gt) != NULL)
+	        call strcpy (Memc[GT_SUBTITLE(gt)], str, sz_str)
+	case GTCOMMENTS:
+	    if (GT_COMMENTS(gt) != NULL)
+	        call strcpy (Memc[GT_COMMENTS(gt)], str, sz_str)
+	case GTXLABEL:
+	    if (GT_XLABEL(gt) != NULL)
+	        call strcpy (Memc[GT_XLABEL(gt)], str, sz_str)
+	case GTYLABEL:
+	    if (GT_YLABEL(gt) != NULL)
+	        call strcpy (Memc[GT_YLABEL(gt)], str, sz_str)
+	case GTXUNITS:
+	    if (GT_XUNITS(gt) != NULL)
+	        call strcpy (Memc[GT_XUNITS(gt)], str, sz_str)
+	case GTYUNITS:
+	    if (GT_YUNITS(gt) != NULL)
+	        call strcpy (Memc[GT_YUNITS(gt)], str, sz_str)
+	case GTXFORMAT:
+	    if (GT_XFORMAT(gt) != NULL)
+	        call strcpy (Memc[GT_XFORMAT(gt)], str, sz_str)
+	case GTYFORMAT:
+	    if (GT_YFORMAT(gt) != NULL)
+	        call strcpy (Memc[GT_YFORMAT(gt)], str, sz_str)
+	case GTXTRAN:
+	    switch (GT_XTRAN(gt)) {
+	    case GW_LINEAR:
+	        call strcpy ("linear", str, sz_str)
+	    case GW_ELOG:
+	        call strcpy ("logarithmic", str, sz_str)
+	    }
+	case GTYTRAN:
+	    switch (GT_YTRAN(gt)) {
+	    case GW_LINEAR:
+	        call strcpy ("linear", str, sz_str)
+	    case GW_ELOG:
+	        call strcpy ("logarithmic", str, sz_str)
+	    }
+	case GTTYPE:
+	    #switch (GT_TYPE(gt)) {
+	    #case 1:
+	    #    call strcpy ("mark", str, sz_str)
+	    #case 2:
+	    #    call strcpy ("line", str, sz_str)
+	    #case 3:
+	    #    call strcpy ("histogram", str, sz_str)
+	    #}
+	    switch (GT_TYPE(gt)) {
+	    case 1:
+		switch (GT_MARK(gt)) {
+		case GM_POINT:
+		    call strcpy ("point", str, sz_str)
+		case GM_BOX:
+		    call strcpy ("box", str, sz_str)
+		case GM_PLUS:
+		    call strcpy ("plus", str, sz_str)
+		case GM_CROSS:
+		    call strcpy ("cross", str, sz_str)
+		case GM_DIAMOND:
+		    call strcpy ("diamond", str, sz_str)
+		case GM_HLINE:
+		    call strcpy ("hline", str, sz_str)
+		case GM_VLINE:
+		    call strcpy ("vline", str, sz_str)
+		case GM_HEBAR:
+		    call strcpy ("hebar", str, sz_str)
+		case GM_VEBAR:
+		    call strcpy ("vebar", str, sz_str)
+		case GM_CIRCLE:
+		    call strcpy ("circle", str, sz_str)
+		}
+	    case 2:
+		call sprintf (str, sz_str, "line%d")
+		    call pargi (GT_LINE(gt))
+	    case 3:
+		call sprintf (str, sz_str, "hist%d")
+		    call pargi (GT_LINE(gt))
+	    }
+	case GTMARK:
+	    switch (GT_MARK(gt)) {
+	    case GM_POINT:
+	        call strcpy ("point", str, sz_str)
+	    case GM_BOX:
+	        call strcpy ("box", str, sz_str)
+	    case GM_PLUS:
+	        call strcpy ("plus", str, sz_str)
+	    case GM_CROSS:
+	        call strcpy ("cross", str, sz_str)
+	    case GM_DIAMOND:
+	        call strcpy ("diamond", str, sz_str)
+	    case GM_HLINE:
+	        call strcpy ("hline", str, sz_str)
+	    case GM_VLINE:
+	        call strcpy ("vline", str, sz_str)
+	    case GM_HEBAR:
+	        call strcpy ("hebar", str, sz_str)
+	    case GM_VEBAR:
+	        call strcpy ("vebar", str, sz_str)
+	    case GM_CIRCLE:
+	        call strcpy ("circle", str, sz_str)
+	    }
+	}
+end
diff --git a/pkg/xtools/gtools/gtgui.x b/pkg/xtools/gtools/gtgui.x
new file mode 100644
index 00000000..16981ee3
--- /dev/null
+++ b/pkg/xtools/gtools/gtgui.x
@@ -0,0 +1,160 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gtools.h"
+
+# GT_UIVALUES -- Send UI parameters values.
+
+procedure gt_uivalues (gp, gt)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+
+int	fd, stropen()
+pointer	sp, msg, str1, str2
+
+begin
+	if (gt == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (msg, 20 * SZ_LINE, TY_CHAR)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+
+	fd = stropen (Memc[msg], 20 * SZ_LINE, WRITE_ONLY)
+
+	# SysID
+	call fprintf (fd, "%b ")
+	    call pargi (GT_SYSID(gt))
+
+	# Titles
+	call fprintf (fd, "\"%s\" \"%s\" \"%s\" \"%s\" \"%s\" \"%s\" ")
+	    if (GT_TITLE(gt) == NULL)
+		call pargstr ("")
+	    else
+		call pargstr (Memc[GT_TITLE(gt)])
+	    if (GT_SUBTITLE(gt) == NULL)
+		call pargstr ("")
+	    else
+		call pargstr (Memc[GT_SUBTITLE(gt)])
+	    if (GT_XLABEL(gt) == NULL)
+		call pargstr ("")
+	    else
+		call pargstr (Memc[GT_XLABEL(gt)])
+	    if (GT_XUNITS(gt) == NULL)
+		call pargstr ("")
+	    else
+		call pargstr (Memc[GT_XUNITS(gt)])
+	    if (GT_YLABEL(gt) == NULL)
+		call pargstr ("")
+	    else
+		call pargstr (Memc[GT_YLABEL(gt)])
+	    if (GT_YUNITS(gt) == NULL)
+		call pargstr ("")
+	    else
+		call pargstr (Memc[GT_YUNITS(gt)])
+
+	# Viewport
+	call fprintf (fd, "%4.2f %4.2f %4.2f %4.2f ")
+	    call pargr (GT_VXMIN(gt))
+	    call pargr (GT_VXMAX(gt))
+	    call pargr (GT_VYMIN(gt))
+	    call pargr (GT_VYMAX(gt))
+
+	# Window
+	call fprintf (fd, "%4.2f %4.2f %4.2f %4.2f ")
+	    call pargr (GT_XMIN(gt))
+	    call pargr (GT_XMAX(gt))
+	    call pargr (GT_YMIN(gt))
+	    call pargr (GT_YMAX(gt))
+
+	# Gtools
+	call fprintf (fd, "%b %b %b %4.2f %4.2f %g %g ")
+	    call pargi (GT_TRANSPOSE(gt))
+	    call pargi (GT_XFLIP(gt))
+	    call pargi (GT_YFLIP(gt))
+	    call pargr (GT_XBUF(gt))
+	    call pargr (GT_YBUF(gt))
+	    call pargr (GT_LCLIP(gt))
+	    call pargr (GT_HCLIP(gt))
+
+	# Plot types
+	call gt_gets (gt, GTTYPE, Memc[str1], SZ_LINE)
+	call fprintf (fd, "%s %g %g %d ")
+	    call pargstr (Memc[str1])
+	    call pargr (GT_XSIZE(gt))
+	    call pargr (GT_YSIZE(gt))
+	    call pargi (GT_COLOR(gt))
+
+	# Axes
+	call gt_gets (gt, GTXTRAN, Memc[str1], SZ_LINE)
+	call gt_gets (gt, GTYTRAN, Memc[str2], SZ_LINE)
+	call fprintf (fd, "%s %s %g %g %s %s %b %b ")
+	    switch (Memi[gt+GT_XDRAWAXES]) {
+	    case 0:
+		call pargstr ("none")
+	    case 1:
+		call pargstr ("bottom")
+	    case 2:
+		call pargstr ("top")
+	    case 3:
+		call pargstr ("both")
+	    }
+	    switch (Memi[gt+GT_YDRAWAXES]) {
+	    case 0:
+		call pargstr ("none")
+	    case 1:
+		call pargstr ("left")
+	    case 2:
+		call pargstr ("right")
+	    case 3:
+		call pargstr ("both")
+	    }
+	    call pargr (Memr[P2R(gt+GT_XAXISWIDTH)])
+	    call pargr (Memr[P2R(gt+GT_YAXISWIDTH)])
+	    call pargstr (Memc[str1])
+	    call pargstr (Memc[str2])
+	    call pargi (Memi[gt+GT_XDRAWGRID])
+	    call pargi (Memi[gt+GT_YDRAWGRID])
+
+	# Ticks
+	call fprintf (fd, "%b %b %d %d %d %d %b %b \"%s\" \"%s\" ")
+	    call pargi (Memi[gt+GT_XDRAWTICKS])
+	    call pargi (Memi[gt+GT_YDRAWTICKS])
+	    call pargi (Memi[gt+GT_XNMAJOR])
+	    call pargi (Memi[gt+GT_YNMAJOR])
+	    call pargi (Memi[gt+GT_XNMINOR])
+	    call pargi (Memi[gt+GT_YNMINOR])
+	    call pargi (Memi[gt+GT_XLABELTICKS])
+	    call pargi (Memi[gt+GT_YLABELTICKS])
+	    if (GT_XFORMAT(gt) == NULL)
+	       call pargstr ("")
+	    else
+	       call pargstr (Memc[GT_XFORMAT(gt)])
+	    if (GT_YFORMAT(gt) == NULL)
+	       call pargstr ("")
+	    else
+	       call pargstr (Memc[GT_YFORMAT(gt)])
+
+	# Colors
+	call fprintf (fd, "%d %d %d %d %d %d %d %d %d %d %d %d %d")
+	    call pargi (Memi[gt+GT_FRAMECOLOR])
+	    call pargi (Memi[gt+GT_TITLECOLOR])
+	    call pargi (Memi[gt+GT_XGRIDCOLOR])
+	    call pargi (Memi[gt+GT_YGRIDCOLOR])
+	    call pargi (Memi[gt+GT_XAXISLABELCOLOR])
+	    call pargi (Memi[gt+GT_YAXISLABELCOLOR])
+	    call pargi (Memi[gt+GT_XAXISCOLOR])
+	    call pargi (Memi[gt+GT_YAXISCOLOR])
+	    call pargi (Memi[gt+GT_XTICKLABELCOLOR])
+	    call pargi (Memi[gt+GT_YTICKLABELCOLOR])
+	    call pargi (Memi[gt+GT_XTICKCOLOR])
+	    call pargi (Memi[gt+GT_YTICKCOLOR])
+	    call pargi (Memi[gt+GT_TXCOLOR])
+
+	call strclose (fd)
+	call gmsg (gp, "gtvalues", Memc[msg])
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/gtools/gthelp.x b/pkg/xtools/gtools/gthelp.x
new file mode 100644
index 00000000..6267ced4
--- /dev/null
+++ b/pkg/xtools/gtools/gthelp.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GT_HELP -- Page graphics help from a file.
+# This routine should not be called anymore.
+
+procedure gt_help (file)
+
+char	file[ARB]			# File to be paged
+
+begin
+	call pagefile (file, "")
+end
diff --git a/pkg/xtools/gtools/gtinit.x b/pkg/xtools/gtools/gtinit.x
new file mode 100644
index 00000000..11e0c5bb
--- /dev/null
+++ b/pkg/xtools/gtools/gtinit.x
@@ -0,0 +1,164 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gtools.h"
+
+# GT_INIT1 -- Open the GTOOLS pointer.
+
+pointer procedure gt_init1 (gp)
+
+pointer	gp
+pointer	gt
+
+pointer	gt_init()
+errchk	gt_init, gt_ireset
+
+begin
+	# Initialize the graphics.
+
+	gt = gt_init()
+	call gt_ireset (gp, gt)
+
+	return (gt)
+end
+
+
+# GT_INIT -- Allocate and initialize GTOOLS pointer.
+#
+# This is an older version.  To properly set things either gt_ireset
+# should be called after gt_init or use the new gt_init1.
+
+pointer procedure gt_init ()
+
+pointer	gt
+
+begin
+	# Initialize the graphics.
+
+	call calloc (gt, LEN_GT, TY_STRUCT)
+	GT_VXMIN(gt) = INDEFR
+	GT_VXMAX(gt) = INDEFR
+	GT_VYMIN(gt) = INDEFR
+	GT_VYMAX(gt) = INDEFR
+	GT_XMIN(gt) = INDEFR
+	GT_XMAX(gt) = INDEFR
+	GT_YMIN(gt) = INDEFR
+	GT_YMAX(gt) = INDEFR
+	call gt_sets (gt, GTXTRAN, "linear")
+	call gt_sets (gt, GTYTRAN, "linear")
+	GT_XSIZE(gt) = 2.
+	GT_YSIZE(gt) = 2.
+	GT_SYSID(gt) = YES
+	GT_PARAMS(gt) = NULL
+	GT_TITLE(gt) = NULL
+	GT_SUBTITLE(gt) = NULL
+	GT_COMMENTS(gt) = NULL
+	GT_XLABEL(gt) = NULL
+	GT_YLABEL(gt) = NULL
+	GT_XUNITS(gt) = NULL
+	GT_YUNITS(gt) = NULL
+	GT_DRWTITLE(gt) = YES
+	GT_DRWXLABELS(gt) = YES
+	GT_DRWYLABELS(gt) = YES
+	GT_XFORMAT(gt) = NULL
+	GT_YFORMAT(gt) = NULL
+	GT_XBUF(gt) = .03
+	GT_YBUF(gt) = .03
+	GT_LCLIP(gt) = 0.
+	GT_HCLIP(gt) = 0.
+	GT_XFLIP(gt) = NO
+	GT_YFLIP(gt) = NO
+	GT_TRANSPOSE(gt) = NO
+	call gt_sets (gt, GTTYPE, "mark")
+	call gt_sets (gt, GTMARK, "plus")
+	call gt_seti (gt, GTLINE, 1)
+	call gt_seti (gt, GTCOLOR, 1)
+
+	GT_RESET(gt) = NO
+
+	return (gt)
+end
+
+
+# GT_IRESET -- Initialize GTOOLS values from GP pointer.
+
+procedure gt_ireset (gp, gt)
+
+pointer	gp			#I GIO pointer
+pointer	gt			#I GTOOLS pointer
+
+int	gstati()
+real	gstatr()
+
+begin
+	Memi[gt+GT_TXUP] = gstati (gp, G_TXUP)
+	Memr[P2R(gt+GT_TXSIZE)] = gstatr (gp, G_TXSIZE)
+	Memi[gt+GT_TXPATH] = gstati (gp, G_TXPATH)
+	Memr[P2R(gt+GT_TXSPACING)] = gstatr (gp, G_TXSPACING)
+	Memi[gt+GT_TXHJUSTIFY] = gstati (gp, G_TXHJUSTIFY)
+	Memi[gt+GT_TXVJUSTIFY] = gstati (gp, G_TXVJUSTIFY)
+	Memi[gt+GT_TXFONT] = gstati (gp, G_TXFONT)
+	Memi[gt+GT_TXQUALITY] = gstati (gp, G_TXQUALITY)
+	Memi[gt+GT_TXCOLOR] = gstati (gp, G_TXCOLOR)
+
+	Memi[gt+GT_DRAWTITLE] = gstati (gp, G_DRAWTITLE)
+	Memr[P2R(gt+GT_TITLESIZE)] = gstatr (gp, G_TITLESIZE)
+	#Memi[gt+GT_TITLEJUST] = gstati (gp, G_TITLEJUST)
+	Memi[gt+GT_NTITLELINES] = gstati (gp, G_NTITLELINES)
+	Memr[P2R(gt+GT_ASPECT)] = gstatr (gp, G_ASPECT)
+	#Memr[P2R(gt+GT_CHARSIZE)] = gstatr (gp, G_CHARSIZE)
+	Memi[gt+GT_TITLECOLOR] = gstati (gp, G_TITLECOLOR)
+	Memi[gt+GT_FRAMECOLOR] = gstati (gp, G_FRAMECOLOR)
+
+	Memi[gt+GT_XDRAWAXES] = gstati (gp, G_XDRAWAXES)
+	Memi[gt+GT_XSETAXISPOS] = gstati (gp, G_XSETAXISPOS)
+	Memr[P2R(gt+GT_XAXISPOS1)] = gstatr (gp, G_XAXISPOS1)
+	Memr[P2R(gt+GT_XAXISPOS2)] = gstatr (gp, G_XAXISPOS2)
+	Memi[gt+GT_XDRAWGRID] = gstati (gp, G_YDRAWGRID)
+	Memi[gt+GT_XROUND] = gstati (gp, G_XROUND)
+	Memi[gt+GT_XLABELAXIS] = gstati (gp, G_XLABELAXIS)
+	Memr[P2R(gt+GT_XAXISLABELSIZE)] = gstatr (gp, G_XAXISLABELSIZE)
+	Memi[gt+GT_XDRAWTICKS] = gstati (gp, G_XDRAWTICKS)
+	Memi[gt+GT_XLABELTICKS] = gstati (gp, G_XLABELTICKS)
+	Memi[gt+GT_XNMAJOR] = gstati (gp, G_XNMAJOR)
+	#Memi[gt+GT_XNMINOR] = gstati (gp, G_XNMINOR)
+	Memi[gt+GT_XNMINOR] = 0
+	Memr[P2R(gt+GT_XMAJORLENGTH)] = gstatr (gp, G_XMAJORLENGTH)
+	Memr[P2R(gt+GT_XMINORLENGTH)] = gstatr (gp, G_XMINORLENGTH)
+	Memr[P2R(gt+GT_XMAJORWIDTH)] = gstatr (gp, G_XMAJORWIDTH)
+	Memr[P2R(gt+GT_XMINORWIDTH)] = gstatr (gp, G_XMINORWIDTH)
+	Memr[P2R(gt+GT_XAXISWIDTH)] = gstatr (gp, G_XAXISWIDTH)
+	Memr[P2R(gt+GT_XTICKLABELSIZE)] = gstatr (gp, G_XTICKLABELSIZE)
+	Memi[gt+GT_XGRIDCOLOR] = gstati (gp, G_XGRIDCOLOR)
+	Memi[gt+GT_XAXISLABELCOLOR] = gstati (gp, G_XAXISLABELCOLOR)
+	Memi[gt+GT_XAXISCOLOR] = gstati (gp, G_XAXISCOLOR)
+	Memi[gt+GT_XTICKLABELCOLOR] = gstati (gp, G_XTICKLABELCOLOR)
+	Memi[gt+GT_XTICKCOLOR] = gstati (gp, G_XTICKCOLOR)
+
+	Memi[gt+GT_YDRAWAXES] = gstati (gp, G_YDRAWAXES)
+	Memi[gt+GT_YSETAXISPOS] = gstati (gp, G_YSETAXISPOS)
+	Memr[P2R(gt+GT_YAXISPOS1)] = gstatr (gp, G_YAXISPOS1)
+	Memr[P2R(gt+GT_YAXISPOS2)] = gstatr (gp, G_YAXISPOS2)
+	Memi[gt+GT_YDRAWGRID] = gstati (gp, G_XDRAWGRID)
+	Memi[gt+GT_YROUND] = gstati (gp, G_YROUND)
+	Memi[gt+GT_YLABELAXIS] = gstati (gp, G_YLABELAXIS)
+	Memr[P2R(gt+GT_YAXISLABELSIZE)] = gstatr (gp, G_YAXISLABELSIZE)
+	Memi[gt+GT_YDRAWTICKS] = gstati (gp, G_YDRAWTICKS)
+	Memi[gt+GT_YLABELTICKS] = gstati (gp, G_YLABELTICKS)
+	Memi[gt+GT_YNMAJOR] = gstati (gp, G_YNMAJOR)
+	#Memi[gt+GT_YNMINOR] = gstati (gp, G_YNMINOR)
+	Memi[gt+GT_YNMINOR] = 0
+	Memr[P2R(gt+GT_YMAJORLENGTH)] = gstatr (gp, G_YMAJORLENGTH)
+	Memr[P2R(gt+GT_YMINORLENGTH)] = gstatr (gp, G_YMINORLENGTH)
+	Memr[P2R(gt+GT_YMAJORWIDTH)] = gstatr (gp, G_YMAJORWIDTH)
+	Memr[P2R(gt+GT_YMINORWIDTH)] = gstatr (gp, G_YMINORWIDTH)
+	Memr[P2R(gt+GT_YAXISWIDTH)] = gstatr (gp, G_YAXISWIDTH)
+	Memr[P2R(gt+GT_YTICKLABELSIZE)] = gstatr (gp, G_YTICKLABELSIZE)
+	Memi[gt+GT_YGRIDCOLOR] = gstati (gp, G_YGRIDCOLOR)
+	Memi[gt+GT_YAXISLABELCOLOR] = gstati (gp, G_YAXISLABELCOLOR)
+	Memi[gt+GT_YAXISCOLOR] = gstati (gp, G_YAXISCOLOR)
+	Memi[gt+GT_YTICKLABELCOLOR] = gstati (gp, G_YTICKLABELCOLOR)
+	Memi[gt+GT_YTICKCOLOR] = gstati (gp, G_YTICKCOLOR)
+
+	GT_RESET(gt) = YES
+end
diff --git a/pkg/xtools/gtools/gtlabax.x b/pkg/xtools/gtools/gtlabax.x
new file mode 100644
index 00000000..28f80367
--- /dev/null
+++ b/pkg/xtools/gtools/gtlabax.x
@@ -0,0 +1,139 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<gset.h>
+include	<gio.h>
+include	"gtools.h"
+	
+# GT_LABAX -- Set graphics axis.
+
+procedure gt_labax (gp, gt)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+
+int	nl, len
+real	vx1, vx2, vy1, vy2, wx1, wx2, wy1, wy2
+pointer	title, xlabel, ylabel
+
+int	strlen()
+
+begin
+	if (gt != NULL) {
+	    call gt_reset (gp, gt)
+
+	    call ggview (gp, vx1, vx2, vy1, vy2)
+	    if (!IS_INDEF(GT_VXMIN(gt)))
+		vx1 = GT_VXMIN(gt)
+	    if (!IS_INDEF(GT_VXMAX(gt)))
+		vx2 = GT_VXMAX(gt)
+	    if (!IS_INDEF(GT_VYMIN(gt)))
+		vy1 = GT_VYMIN(gt)
+	    if (!IS_INDEF(GT_VYMAX(gt)))
+		vy2 = GT_VYMAX(gt)
+	    call gsview (gp, vx1, vx2, vy1, vy2)
+
+	    call malloc (title, SZ_LINE, TY_CHAR)
+	    len = SZ_LINE
+	    Memc[title] = EOS
+	    if (GT_DRWTITLE(gt) == YES) {
+		nl = NO
+		if (GT_SYSID(gt) == YES) {
+		    call sysid (Memc[title], len)
+		    len = len + strlen (Memc[title]) + 1
+		    call realloc (title, len, TY_CHAR)
+		    nl = YES 
+		}
+		if (GT_PARAMS(gt) != NULL) {
+		    len = len + strlen (Memc[GT_PARAMS(gt)]) + 1
+		    call realloc (title, len, TY_CHAR)
+		    if (nl == YES)
+			call strcat ("\n", Memc[title], len)
+		    call strcat (Memc[GT_PARAMS(gt)], Memc[title], len)
+		    nl = YES 
+		}
+		if (GT_TITLE(gt) != NULL) {
+		    len = len + strlen (Memc[GT_TITLE(gt)]) + 1
+		    call realloc (title, len, TY_CHAR)
+		    if (nl == YES)
+			call strcat ("\n", Memc[title], len)
+		    call strcat (Memc[GT_TITLE(gt)], Memc[title], len)
+		    nl = YES 
+		}
+		if (GT_SUBTITLE(gt) != NULL) {
+		    len = len + strlen (Memc[GT_SUBTITLE(gt)]) + 1
+		    call realloc (title, len, TY_CHAR)
+		    if (nl == YES)
+			call strcat ("\n", Memc[title], len)
+		    call strcat (Memc[GT_SUBTITLE(gt)], Memc[title], len)
+		    nl = YES 
+		}
+		if (GT_COMMENTS(gt) != NULL) {
+		    len = len + strlen (Memc[GT_COMMENTS(gt)]) + 1
+		    call realloc (title, len, TY_CHAR)
+		    if (nl == YES)
+			call strcat ("\n", Memc[title], len)
+		    call strcat (Memc[GT_COMMENTS(gt)], Memc[title], len)
+		    nl = YES 
+		}
+	    }
+
+	    call malloc (xlabel, SZ_LINE, TY_CHAR)
+	    Memc[xlabel] = EOS
+	    if (GT_DRWXLABELS(gt) == YES) {
+		if (GT_XLABEL(gt) != NULL)
+		    call strcat (Memc[GT_XLABEL(gt)], Memc[xlabel], SZ_LINE)
+		if (GT_XUNITS(gt) != NULL) {
+		    call strcat (" (", Memc[xlabel], SZ_LINE)
+		    call strcat (Memc[GT_XUNITS(gt)], Memc[xlabel], SZ_LINE)
+		    call strcat (")", Memc[xlabel], SZ_LINE)
+		}
+	    }
+	    if (GT_XFORMAT(gt) != NULL)
+		call gsets (gp, G_XTICKFORMAT, Memc[GT_XFORMAT(gt)])
+
+	    call malloc (ylabel, SZ_LINE, TY_CHAR)
+	    Memc[ylabel] = EOS
+	    if (GT_DRWYLABELS(gt) == YES) {
+		if (GT_YLABEL(gt) != NULL)
+		    call strcat (Memc[GT_YLABEL(gt)], Memc[ylabel], SZ_LINE)
+		if (GT_YUNITS(gt) != NULL) {
+		    call strcat (" (", Memc[ylabel], SZ_LINE)
+		    call strcat (Memc[GT_YUNITS(gt)], Memc[ylabel], SZ_LINE)
+		    call strcat (")", Memc[ylabel], SZ_LINE)
+		}
+	    }
+	    if (GT_YFORMAT(gt) != NULL)
+	    call gsets (gp, G_YTICKFORMAT, Memc[GT_YFORMAT(gt)])
+
+	    call gseti (gp, G_XNMINOR, Memi[gt+GT_XNMINOR])
+	    call gseti (gp, G_YNMINOR, Memi[gt+GT_YNMINOR])
+	    if (GT_TRANSPOSE(gt) == NO)
+	        call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel])
+	    else
+	        call glabax (gp, Memc[title], Memc[ylabel], Memc[xlabel])
+
+	    call ggview (gp, vx1, vx2, vy1, vy2)
+	    call ggwind (gp, wx1, wx2, wy1, wy2)
+	    call sprintf (Memc[title], SZ_LINE, "%g %g %g %g %g %g %g %g")
+		call pargr (vx1)
+		call pargr (vx2)
+		call pargr (vy1)
+		call pargr (vy2)
+		call pargr (wx1)
+		call pargr (wx2)
+		call pargr (wy1)
+		call pargr (wy2)
+	    if (GP_UIFNAME(gp) != EOS)
+		call gmsg (gp, "gtwcs", Memc[title])
+
+	    call mfree (title, TY_CHAR)
+	    call mfree (xlabel, TY_CHAR)
+	    call mfree (ylabel, TY_CHAR)
+	} else {
+	    call gmftitle (gp, "UNTITLED")
+	    call gseti (gp, G_XNMINOR, Memi[gt+GT_XNMINOR])
+	    call gseti (gp, G_YNMINOR, Memi[gt+GT_YNMINOR])
+	    call glabax (gp, "", "", "")
+	}
+end
diff --git a/pkg/xtools/gtools/gtools.h b/pkg/xtools/gtools/gtools.h
new file mode 100644
index 00000000..672510b5
--- /dev/null
+++ b/pkg/xtools/gtools/gtools.h
@@ -0,0 +1,168 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Public Definitions
+
+define	GTVXMIN			0	# Viewport X minimum
+define	GTVXMAX			1	# Viewport X maximum
+define	GTVYMIN			2	# Viewport Y minimum
+define	GTVYMAX			3	# Viewport Y maximum
+define	GTXMIN			4	# WCS X minimum
+define	GTXMAX			5	# WCS X maximum
+define	GTYMIN			6	# WCS Y minimum
+define	GTYMAX			7	# WCS Y maximum
+
+define	GTSYSID			8	# Add SYSID?
+define	GTPARAMS		9	# Graph parameters
+define	GTTITLE			10	# Graph title
+define	GTSUBTITLE		11	# Graph subtitle
+define	GTCOMMENTS		12	# Comments
+define	GTXLABEL		13	# X label
+define	GTYLABEL		14	# Y label
+define	GTXUNITS		15	# X units
+define	GTYUNITS		16	# Y units
+
+define	GTDRAWTITLE		17	# Draw title block?
+define	GTDRAWXLABELS		18	# Draw x axis label block?
+define	GTDRAWYLABELS		19	# Draw y axis label block?
+
+define	GTTYPE			20	# Graph type
+define	GTMARK			21	# Mark type
+define	GTLINE			22	# Line type
+define	GTXSIZE			23	# X Mark size
+define	GTYSIZE			24	# Y Mark size
+define	GTCOLOR			25	# Color
+
+define	GTXTRAN			26	# WCS X transform
+define	GTYTRAN			27	# WCS Y transform
+define	GTXFLIP			28	# Flip X axis
+define	GTYFLIP			29	# Flip Y axis
+define	GTTRANSPOSE		30	# Transpose X and Y axes?
+
+define	GTXFORMAT		31	# X format
+define	GTYFORMAT		32	# Y format
+
+define	GTXBUF			33	# Autoscaling buffer factor
+define	GTYBUF			34	# Autoscaling buffer factor
+define	GTLCLIP			35	# Low clipping factor
+define	GTHCLIP			36	# High clipping factor
+
+# Private Definitions
+
+define	GTRESET			37	# Initialized from GIO structure?
+
+define	GT_TXUP			51	# Text parameters
+define	GT_TXSIZE		52
+define	GT_TXPATH		53
+define	GT_TXSPACING		54
+define	GT_TXHJUSTIFY		55
+define	GT_TXVJUSTIFY		56
+define	GT_TXFONT		57
+define	GT_TXQUALITY		58
+define	GT_TXCOLOR		59
+
+define	GT_DRAWTITLE		60	# GLABAX, general parameters
+define	GT_TITLESIZE		61
+define	GT_TITLEJUST		62
+define	GT_NTITLELINES		63
+define	GT_ASPECT		64
+define	GT_CHARSIZE		65
+define	GT_TITLECOLOR		66
+define	GT_FRAMECOLOR		67
+define	GT_DRIDCOLOR		68
+
+define	GT_XDRAWAXES		71	# GLABAX, x axis parameters
+define	GT_XSETAXISPOS		72
+define	GT_XAXISPOS1		73
+define	GT_XAXISPOS2		74
+define	GT_XDRAWGRID		75
+define	GT_XROUND		76
+define	GT_XLABELAXIS		77
+define	GT_XAXISLABELSIZE	78
+define	GT_XDRAWTICKS		79
+define	GT_XLABELTICKS		80
+define	GT_XNMAJOR		81
+define	GT_XNMINOR		82
+define	GT_XMAJORLENGTH		83
+define	GT_XMINORLENGTH		84
+define	GT_XMAJORWIDTH		85
+define	GT_XMINORWIDTH		86
+define	GT_XAXISWIDTH		87
+define	GT_XTICKLABELSIZE	88
+define	GT_XTICKFORMAT		89
+define	GT_XGRIDCOLOR		90
+define	GT_XAXISLABELCOLOR	91
+define	GT_XAXISCOLOR		92
+define	GT_XTICKLABELCOLOR	93
+define	GT_XTICKCOLOR		94
+
+define	GT_YDRAWAXES		101	# GLABAX, y axis parameters
+define	GT_YSETAXISPOS		102
+define	GT_YAXISPOS1		103
+define	GT_YAXISPOS2		104
+define	GT_YDRAWGRID		105
+define	GT_YROUND		106
+define	GT_YLABELAXIS		107
+define	GT_YAXISLABELSIZE	108
+define	GT_YDRAWTICKS		109
+define	GT_YLABELTICKS		110
+define	GT_YNMAJOR		111
+define	GT_YNMINOR		112
+define	GT_YMAJORLENGTH		113
+define	GT_YMINORLENGTH		114
+define	GT_YMAJORWIDTH		115
+define	GT_YMINORWIDTH		116
+define	GT_YAXISWIDTH		117
+define	GT_YTICKLABELSIZE	118
+define	GT_YTICKFORMAT		119
+define	GT_YGRIDCOLOR		120
+define	GT_YAXISLABELCOLOR	121
+define	GT_YAXISCOLOR		122
+define	GT_YTICKLABELCOLOR	123
+define	GT_YTICKCOLOR		124
+
+define	LEN_GT		125	# Length of graphics tools extension
+
+define	GT_VXMIN	Memr[P2R($1+GTVXMIN)]
+define	GT_VXMAX	Memr[P2R($1+GTVXMAX)]	
+define	GT_VYMIN	Memr[P2R($1+GTVYMIN)]
+define	GT_VYMAX	Memr[P2R($1+GTVYMAX)]
+define	GT_XMIN		Memr[P2R($1+GTXMIN)]
+define	GT_XMAX		Memr[P2R($1+GTXMAX)]	
+define	GT_YMIN		Memr[P2R($1+GTYMIN)]
+define	GT_YMAX		Memr[P2R($1+GTYMAX)]
+define	GT_SYSID	Memi[$1+GTSYSID]
+define	GT_PARAMS	Memi[$1+GTPARAMS]
+define	GT_TITLE	Memi[$1+GTTITLE]
+define	GT_SUBTITLE	Memi[$1+GTSUBTITLE]
+define	GT_COMMENTS	Memi[$1+GTCOMMENTS]
+define	GT_XLABEL	Memi[$1+GTXLABEL]
+define	GT_YLABEL	Memi[$1+GTYLABEL]
+define	GT_XUNITS	Memi[$1+GTXUNITS]
+define	GT_YUNITS	Memi[$1+GTYUNITS]
+define	GT_DRWTITLE	Memi[$1+GTDRAWTITLE]
+define	GT_DRWXLABELS	Memi[$1+GTDRAWXLABELS]
+define	GT_DRWYLABELS	Memi[$1+GTDRAWYLABELS]
+define	GT_TYPE		Memi[$1+GTTYPE]
+define	GT_MARK		Memi[$1+GTMARK]
+define	GT_LINE		Memi[$1+GTLINE]
+define	GT_XSIZE	Memr[P2R($1+GTXSIZE)]
+define	GT_YSIZE	Memr[P2R($1+GTYSIZE)]
+define	GT_COLOR	Memi[$1+GTCOLOR]
+define	GT_XTRAN	Memi[$1+GTXTRAN]
+define	GT_YTRAN	Memi[$1+GTYTRAN]
+define	GT_XFLIP	Memi[$1+GTXFLIP]
+define	GT_YFLIP	Memi[$1+GTYFLIP]
+define	GT_TRANSPOSE	Memi[$1+GTTRANSPOSE]
+define	GT_XFORMAT	Memi[$1+GTXFORMAT]
+define	GT_YFORMAT	Memi[$1+GTYFORMAT]
+define	GT_XBUF		Memr[P2R($1+GTXBUF)]
+define	GT_YBUF		Memr[P2R($1+GTYBUF)]
+define	GT_LCLIP	Memr[P2R($1+GTLCLIP)]
+define	GT_HCLIP	Memr[P2R($1+GTHCLIP)]
+define	GT_RESET	Memi[$1+GTRESET]
+
+define	GTTYPES		"|mark|line|histogram|"
+define	GTMARKS	"|point|box|plus|cross|diamond|hline|vline|hebar|vebar|circle|"
+
+define	GT_XAXES	"|none|bottom|top|both|"
+define	GT_YAXES	"|none|left|right|both|"
diff --git a/pkg/xtools/gtools/gtools.hd b/pkg/xtools/gtools/gtools.hd
new file mode 100644
index 00000000..bc88b47b
--- /dev/null
+++ b/pkg/xtools/gtools/gtools.hd
@@ -0,0 +1,3 @@
+# Help directory for the GTOOLS (graphics tools) package.
+
+revisions	sys = Revisions
diff --git a/pkg/xtools/gtools/gtools.hlp b/pkg/xtools/gtools/gtools.hlp
new file mode 100644
index 00000000..43d5e3ab
--- /dev/null
+++ b/pkg/xtools/gtools/gtools.hlp
@@ -0,0 +1,91 @@
+.help gtools Apr96 xtools.gtools
+.ih
+NAME
+gtools -- Graphics tools
+.ih
+SYNOPSIS
+A number of application tasks use the graphics tools in the \fBgtools\fR
+package.  The graphics tools control labeling and titling of graphs and
+interactive formatting.  The user changes the defaults via colon commands
+and with cursor keys.  The windowing options are usually entered with the
+'w' key from an application program but other keys may be used instead.
+Not all of the formatting options may be available in a particular
+application; for example the graph type and mark type options.  Check the
+documentation for the application program.  Some applications set the
+values every time the graph is redraw so any user changes will be
+overridden.
+
+The title block consists of a system identification banner, a parameter
+string, a title string, a subtitle string, and a comment string in
+that order.  The \fIdrawtitle\fR parameter can be used to turn off all
+the title block.  There are parameters to control each of the
+parts of the title block.  The \fIsubtitle\fR and \fIcomments\fR
+parameters are rarely used by applications and so may be used to
+annotate graphs.  The x and y labels consist of label and units strings.
+The \fIdrawxlabels\fR and \fIdrawylabels\fR parameters can be used to
+turn off both parts of the axis labels.
+.ih
+WINDOW COMMANDS
+The following keystroke cursor commands may be available in an application.
+
+.nf
+a  Autoscale x and y axes
+b  Set bottom edge of window
+c  Center window at cursor position
+d  Shift window down
+e  Expand window (mark lower left and upper right of new window)
+f  Flip x axis
+g  Flip y axis
+j  Set left edge of window
+k  Set right edge of window
+l  Shift window left
+m  Autoscale x axis
+n  Autoscale y axis
+p  Pan x and y axes about cursor
+r  Shift window right
+t  Set top edge of window
+u  Shift window up
+x  Zoom x axis about cursor
+y  Zoom y axis about cursor
+z  Zoom x and y axes about cursor
+.fi
+.ih
+COLON COMMANDS
+.nf
+:/help			Print help menu
+:/redraw		Redraw the graph
+
+:/drawtitle [yes|no]	Draw title block?
+:/sysid [yes|no]	Include the standard IRAF user/date banner?
+:/parameters string	Parameter string (usual set by application)
+:/title string		Title
+:/subtitle string	Subtitle
+:/comments string	Comments
+
+:/type string		Type of graph (line, hist, or mark)
+:/mark string		Mark type (point, box, plus, cross, diamond,
+				   hline, vline, hebar, vebar, circle)
+:/line [0-9]		Line style
+:/color [0-9]		Line or mark color
+
+:/drawxlabels [yes|no]	Draw X axis label?
+:/xlabel string		Label for X axis
+:/xunits string		Units for X axis
+:/xsize size		Size of marks along the X axis
+:/xtransform type	X coordinate transform type (linear or logarithmic)
+:/xwindow x1 x2		X graph window (INDEF defaults to min or max)
+:/xflip [yes|no]	Flip X axis
+
+:/drawylabels [yes|no]	Draw Y axis label?
+:/ylabel string		Label for Y axis
+:/yunits string		Units for Y axis
+:/ysize size		Size of marks along the Y axis
+:/ytransform type	Y coordinate transform type (linear or logarithmic)
+:/ywindow y1 y2		Y graph window (INDEF defaults to min or max)
+:/yflip [yes|no]	Flip Y axis
+
+:/transpose		Transpose the graph axes
+
+Format changes do not take effect until the graph is redrawn.
+.fi
+.endhelp
diff --git a/pkg/xtools/gtools/gtplot.x b/pkg/xtools/gtools/gtplot.x
new file mode 100644
index 00000000..3591e6ab
--- /dev/null
+++ b/pkg/xtools/gtools/gtplot.x
@@ -0,0 +1,82 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gtools.h"
+
+# GT_GRAPH -- Plot polymarks or polypoints.
+
+procedure gt_plot (gp, gt, x, y, npts)
+
+pointer	gp		# GIO pointer
+pointer	gt		# GTOOLS pointer
+real	x[npts]		# Abscissas
+real	y[npts]		# Ordinates
+int	npts		# Number of points
+
+int	i, color, pltype, gstati()
+real	x1, x2
+
+begin
+	switch (GT_TYPE(gt)) {
+	case 1:
+	    #color = gstati (gp, G_PMCOLOR)
+	    #call gseti (gp, G_PMCOLOR, GT_COLOR(gt))
+	    color = gstati (gp, G_PLCOLOR)
+	    call gseti (gp, G_PLCOLOR, GT_COLOR(gt))
+	    if (GT_TRANSPOSE(gt) == NO)
+	        call gpmark (gp, x, y, npts, GT_MARK(gt), GT_XSIZE(gt),
+		    GT_YSIZE(gt))
+	    else
+	        call gpmark (gp, y, x, npts, GT_MARK(gt), GT_YSIZE(gt),
+		    GT_XSIZE(gt))
+	    #call gseti (gp, G_PMCOLOR, color)
+	    call gseti (gp, G_PLCOLOR, color)
+	case 2:
+	    color = gstati (gp, G_PLCOLOR)
+	    call gseti (gp, G_PLCOLOR, GT_COLOR(gt))
+	    pltype = gstati (gp, G_PLTYPE)
+	    call gseti (gp, G_PLTYPE, GT_LINE(gt))
+	    if (GT_TRANSPOSE(gt) == NO)
+	        call gpline (gp, x, y, npts)
+	    else
+	        call gpline (gp, y, x, npts)
+	    call gseti (gp, G_PLTYPE, pltype)
+	    call gseti (gp, G_PLCOLOR, color)
+	case 3:
+	    color = gstati (gp, G_PLCOLOR)
+	    call gseti (gp, G_PLCOLOR, GT_COLOR(gt))
+	    pltype = gstati (gp, G_PLTYPE)
+	    call gseti (gp, G_PLTYPE, GT_LINE(gt))
+	    if (GT_TRANSPOSE(gt) == NO) {
+		x1 = x[1]
+		x2 = (x[1] + x[2]) / 2
+		call gline (gp, x1, y[1], x2, y[1])
+		do i = 2, npts - 1 {
+		    x1 = x2
+		    x2 = (x[i] + x[i+1]) / 2
+		    call gline (gp, x1, y[i-1], x1, y[i]) 
+		    call gline (gp, x1, y[i], x2 , y[i])
+		}
+		x1 = x2
+		x2 = x[npts]
+		call gline (gp, x1, y[i-1], x1, y[i]) 
+		call gline (gp, x1, y[i], x2 , y[i])
+	    } else {
+		x1 = y[1]
+		x2 = (y[1] + y[2]) / 2
+		call gline (gp, x1, x[1], x2, x[1])
+		do i = 2, npts - 1 {
+		    x1 = x2
+		    x2 = (y[i] + y[i+1]) / 2
+		    call gline (gp, x1, x[i-1], x1, x[i]) 
+		    call gline (gp, x1, x[i], x2 , x[i])
+		}
+		x1 = x2
+		x2 = y[npts]
+		call gline (gp, x1, y[i-1], x1, y[i]) 
+		call gline (gp, x1, y[i], x2 , y[i])
+	    }
+	    call gseti (gp, G_PLTYPE, pltype)
+	    call gseti (gp, G_PLCOLOR, color)
+	}
+end
diff --git a/pkg/xtools/gtools/gtreset.x b/pkg/xtools/gtools/gtreset.x
new file mode 100644
index 00000000..696db0cd
--- /dev/null
+++ b/pkg/xtools/gtools/gtreset.x
@@ -0,0 +1,83 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gtools.h"
+
+# GT_RESET -- Reset parameters after a gclear, greset, or gcancel.
+
+procedure gt_reset (gp, gt)
+
+pointer	gp			#I GIO pointer
+pointer	gt			#I GTOOLS pointer
+
+begin
+	if (GT_RESET(gt) == NO)
+	    call gt_ireset (gp, gt)
+
+	call gseti (gp, G_TXUP, Memi[gt+GT_TXUP])
+	call gsetr (gp, G_TXSIZE, Memr[P2R(gt+GT_TXSIZE)])
+	call gseti (gp, G_TXPATH, Memi[gt+GT_TXPATH])
+	call gsetr (gp, G_TXSPACING, Memr[P2R(gt+GT_TXSPACING)])
+	call gseti (gp, G_TXHJUSTIFY, Memi[gt+GT_TXHJUSTIFY])
+	call gseti (gp, G_TXVJUSTIFY, Memi[gt+GT_TXVJUSTIFY])
+	call gseti (gp, G_TXFONT, Memi[gt+GT_TXFONT])
+	call gseti (gp, G_TXQUALITY, Memi[gt+GT_TXQUALITY])
+	call gseti (gp, G_TXCOLOR, Memi[gt+GT_TXCOLOR])
+
+	call gseti (gp, G_DRAWTITLE, Memi[gt+GT_DRAWTITLE])
+	call gsetr (gp, G_TITLESIZE, Memr[P2R(gt+GT_TITLESIZE)])
+	#call gseti (gp, G_TITLEJUST, Memi[gt+GT_TITLEJUST])
+	call gseti (gp, G_NTITLELINES, Memi[gt+GT_NTITLELINES])
+	call gsetr (gp, G_ASPECT, Memr[P2R(gt+GT_ASPECT)])
+	#call gsetr (gp, G_CHARSIZE, Memr[P2R(gt+GT_CHARSIZE)])
+	call gseti (gp, G_TITLECOLOR, Memi[gt+GT_TITLECOLOR])
+	call gseti (gp, G_FRAMECOLOR, Memi[gt+GT_FRAMECOLOR])
+
+	call gseti (gp, G_XDRAWAXES, Memi[gt+GT_XDRAWAXES])
+	call gseti (gp, G_XSETAXISPOS, Memi[gt+GT_XSETAXISPOS])
+	call gsetr (gp, G_XAXISPOS1, Memr[P2R(gt+GT_XAXISPOS1)])
+	call gsetr (gp, G_XAXISPOS2, Memr[P2R(gt+GT_XAXISPOS2)])
+	call gseti (gp, G_YDRAWGRID, Memi[gt+GT_XDRAWGRID])
+	call gseti (gp, G_XROUND, Memi[gt+GT_XROUND])
+	call gseti (gp, G_XLABELAXIS, Memi[gt+GT_XLABELAXIS])
+	call gsetr (gp, G_XAXISLABELSIZE, Memr[P2R(gt+GT_XAXISLABELSIZE)])
+	call gseti (gp, G_XDRAWTICKS, Memi[gt+GT_XDRAWTICKS])
+	call gseti (gp, G_XLABELTICKS, Memi[gt+GT_XLABELTICKS])
+	call gseti (gp, G_XNMAJOR, Memi[gt+GT_XNMAJOR])
+	call gseti (gp, G_XNMINOR, Memi[gt+GT_XNMINOR])
+	call gsetr (gp, G_XMAJORLENGTH, Memr[P2R(gt+GT_XMAJORLENGTH)])
+	call gsetr (gp, G_XMINORLENGTH, Memr[P2R(gt+GT_XMINORLENGTH)])
+	call gsetr (gp, G_XMAJORWIDTH, Memr[P2R(gt+GT_XMAJORWIDTH)])
+	call gsetr (gp, G_XMINORWIDTH, Memr[P2R(gt+GT_XMINORWIDTH)])
+	call gsetr (gp, G_XAXISWIDTH, Memr[P2R(gt+GT_XAXISWIDTH)])
+	call gsetr (gp, G_XTICKLABELSIZE, Memr[P2R(gt+GT_XTICKLABELSIZE)])
+	call gseti (gp, G_XGRIDCOLOR, Memi[gt+GT_XGRIDCOLOR])
+	call gseti (gp, G_XAXISLABELCOLOR, Memi[gt+GT_XAXISLABELCOLOR])
+	call gseti (gp, G_XAXISCOLOR, Memi[gt+GT_XAXISCOLOR])
+	call gseti (gp, G_XTICKLABELCOLOR, Memi[gt+GT_XTICKLABELCOLOR])
+	call gseti (gp, G_XTICKCOLOR, Memi[gt+GT_XTICKCOLOR])
+
+	call gseti (gp, G_YDRAWAXES, Memi[gt+GT_YDRAWAXES])
+	call gseti (gp, G_YSETAXISPOS, Memi[gt+GT_YSETAXISPOS])
+	call gsetr (gp, G_YAXISPOS1, Memr[P2R(gt+GT_YAXISPOS1)])
+	call gsetr (gp, G_YAXISPOS2, Memr[P2R(gt+GT_YAXISPOS2)])
+	call gseti (gp, G_XDRAWGRID, Memi[gt+GT_YDRAWGRID])
+	call gseti (gp, G_YROUND, Memi[gt+GT_YROUND])
+	call gseti (gp, G_YLABELAXIS, Memi[gt+GT_YLABELAXIS])
+	call gsetr (gp, G_YAXISLABELSIZE, Memr[P2R(gt+GT_YAXISLABELSIZE)])
+	call gseti (gp, G_YDRAWTICKS, Memi[gt+GT_YDRAWTICKS])
+	call gseti (gp, G_YLABELTICKS, Memi[gt+GT_YLABELTICKS])
+	call gseti (gp, G_YNMAJOR, Memi[gt+GT_YNMAJOR])
+	call gseti (gp, G_YNMINOR, Memi[gt+GT_YNMINOR])
+	call gsetr (gp, G_YMAJORLENGTH, Memr[P2R(gt+GT_YMAJORLENGTH)])
+	call gsetr (gp, G_YMINORLENGTH, Memr[P2R(gt+GT_YMINORLENGTH)])
+	call gsetr (gp, G_YMAJORWIDTH, Memr[P2R(gt+GT_YMAJORWIDTH)])
+	call gsetr (gp, G_YMINORWIDTH, Memr[P2R(gt+GT_YMINORWIDTH)])
+	call gsetr (gp, G_YAXISWIDTH, Memr[P2R(gt+GT_YAXISWIDTH)])
+	call gsetr (gp, G_YTICKLABELSIZE, Memr[P2R(gt+GT_YTICKLABELSIZE)])
+	call gseti (gp, G_YGRIDCOLOR, Memi[gt+GT_YGRIDCOLOR])
+	call gseti (gp, G_YAXISLABELCOLOR, Memi[gt+GT_YAXISLABELCOLOR])
+	call gseti (gp, G_YAXISCOLOR, Memi[gt+GT_YAXISCOLOR])
+	call gseti (gp, G_YTICKLABELCOLOR, Memi[gt+GT_YTICKLABELCOLOR])
+	call gseti (gp, G_YTICKCOLOR, Memi[gt+GT_YTICKCOLOR])
+end
diff --git a/pkg/xtools/gtools/gtset.x b/pkg/xtools/gtools/gtset.x
new file mode 100644
index 00000000..d5eb33cb
--- /dev/null
+++ b/pkg/xtools/gtools/gtset.x
@@ -0,0 +1,224 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<gset.h>
+include	"gtools.h"
+
+# GT_SETI -- Set integer parameters.
+
+procedure gt_seti (gt, param, ival)
+
+pointer	gt			# GTOOLS pointer
+int	param			# Parameter to set
+int	ival			# Integer value to set
+
+begin
+	if (gt == NULL)
+	    return
+
+	switch (param) {
+	case GTLINE:
+	    GT_LINE(gt) = ival
+	case GTTRANSPOSE:
+	    GT_TRANSPOSE(gt) = ival
+	case GTSYSID:
+	    GT_SYSID(gt) = ival
+	case GTCOLOR:
+	    GT_COLOR(gt) = ival
+	case GTXFLIP:
+	    GT_XFLIP(gt) = ival
+	case GTYFLIP:
+	    GT_YFLIP(gt) = ival
+	case GTDRAWTITLE:
+	    GT_DRWTITLE(gt) = ival
+	case GTDRAWXLABELS:
+	    GT_DRWXLABELS(gt) = ival
+	case GTDRAWYLABELS:
+	    GT_DRWYLABELS(gt) = ival
+	}
+end
+
+
+# GT_SETR -- Set real parameters.
+
+procedure gt_setr (gt, param, rval)
+
+pointer	gt			# GTOOLS pointer
+int	param			# Parameter to set
+real	rval			# Real value to set
+
+begin
+	if (gt == NULL)
+	    return
+
+	switch (param) {
+	case GTVXMIN:
+	    GT_VXMIN(gt) = rval
+	case GTVXMAX:
+	    GT_VXMAX(gt) = rval
+	case GTVYMIN:
+	    GT_VYMIN(gt) = rval
+	case GTVYMAX:
+	    GT_VYMAX(gt) = rval
+	case GTXMIN:
+	    if (GT_XFLIP(gt) == NO)
+		GT_XMIN(gt) = rval
+	    else
+		GT_XMAX(gt) = rval
+	case GTXMAX:
+	    if (GT_XFLIP(gt) == NO)
+		GT_XMAX(gt) = rval
+	    else
+		GT_XMIN(gt) = rval
+	case GTYMIN:
+	    if (GT_YFLIP(gt) == NO)
+		GT_YMIN(gt) = rval
+	    else
+		GT_YMAX(gt) = rval
+	case GTYMAX:
+	    if (GT_YFLIP(gt) == NO)
+		GT_YMAX(gt) = rval
+	    else
+		GT_YMIN(gt) = rval
+	case GTXBUF:
+	    GT_XBUF(gt) = rval
+	case GTYBUF:
+	    GT_YBUF(gt) = rval
+	case GTLCLIP:
+	    GT_LCLIP(gt) = rval
+	case GTHCLIP:
+	    GT_HCLIP(gt) = rval
+	case GTXSIZE:
+	    GT_XSIZE(gt) = rval
+	case GTYSIZE:
+	    GT_YSIZE(gt) = rval
+	}
+end
+
+
+# GT_SETS -- Set string parameters.
+
+procedure gt_sets (gt, param, str)
+
+pointer	gt			# GTOOLS pointer
+int	param			# Parameter to set
+char	str[ARB]		# String
+
+char	dummy[10]
+int	len
+
+int	marks[10]
+data	marks /GM_POINT,GM_BOX,GM_PLUS,GM_CROSS,GM_DIAMOND,GM_HLINE,GM_VLINE,
+		GM_HEBAR,GM_VEBAR,GM_CIRCLE/
+int	trans[2]
+data	trans /GW_LINEAR, GW_ELOG/
+
+int	strlen(), strdic()
+
+begin
+	if (gt == NULL)
+	    return
+
+	len = strlen (str)
+	switch (param) {
+	case GTPARAMS:
+	    call mfree (GT_PARAMS(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_PARAMS(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_PARAMS(gt)], len)
+	    }
+	case GTTITLE:
+	    call mfree (GT_TITLE(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_TITLE(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_TITLE(gt)], len)
+	    }
+	case GTSUBTITLE:
+	    call mfree (GT_SUBTITLE(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_SUBTITLE(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_SUBTITLE(gt)], len)
+	    }
+	case GTCOMMENTS:
+	    call mfree (GT_COMMENTS(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_COMMENTS(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_COMMENTS(gt)], len)
+	    }
+	case GTXLABEL:
+	    call mfree (GT_XLABEL(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_XLABEL(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_XLABEL(gt)], len)
+	    }
+	case GTYLABEL:
+	    call mfree (GT_YLABEL(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_YLABEL(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_YLABEL(gt)], len)
+	    }
+	case GTXUNITS:
+	    call mfree (GT_XUNITS(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_XUNITS(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_XUNITS(gt)], len)
+	    }
+	case GTYUNITS:
+	    call mfree (GT_YUNITS(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_YUNITS(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_YUNITS(gt)], len)
+	    }
+	case GTXFORMAT:
+	    call mfree (GT_XFORMAT(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_XFORMAT(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_XFORMAT(gt)], len)
+	    }
+	case GTYFORMAT:
+	    call mfree (GT_YFORMAT(gt), TY_CHAR)
+	    if (len > 0) {
+	        call malloc (GT_YFORMAT(gt), len, TY_CHAR)
+	        call strcpy (str, Memc[GT_YFORMAT(gt)], len)
+	    }
+	case GTXTRAN:
+	    len = strdic (str, dummy, 10, "|linear|logarithmic|")
+	    if (len == 0) {
+		call eprintf ("Unknown X transformation type `%s'\n")
+		    call pargstr (str)
+	    } else
+	        GT_XTRAN(gt) = trans[len]
+	case GTYTRAN:
+	    len = strdic (str, dummy, 10, "|linear|logarithmic|")
+	    if (len == 0) {
+		call eprintf ("Unknown Y transformation type `%s'\n")
+		    call pargstr (str)
+	    } else
+	        GT_YTRAN(gt) = trans[len]
+	case GTTYPE:
+	    len = strdic (str, dummy, 10, GTMARKS)
+	    if (len > 0) {
+		GT_TYPE(gt) = 1
+		GT_MARK(gt) = marks[len]
+		return
+	    }
+	    call strcpy (str, dummy, 10)
+	    if (IS_DIGIT(str[5])) {
+		GT_LINE(gt) = TO_INTEG(str[5])
+		dummy[5] = EOS
+	    }
+	    len = strdic (dummy, dummy, 10, GTTYPES)
+	    if (len == 0) {
+		call eprintf ("Unknown graph type `%s'\n")
+		    call pargstr (str)
+	    } else
+	        GT_TYPE(gt) = len
+	case GTMARK:
+	    len = strdic (str, dummy, 10, GTMARKS)
+	    if (len == 0) {
+		call eprintf ("Unknown mark type `%s'\n")
+		    call pargstr (str)
+	    } else
+	        GT_MARK(gt) = marks[len]
+	}
+end
diff --git a/pkg/xtools/gtools/gtswind.x b/pkg/xtools/gtools/gtswind.x
new file mode 100644
index 00000000..02766326
--- /dev/null
+++ b/pkg/xtools/gtools/gtswind.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include <mach.h>
+include	"gtools.h"
+	
+# GT_SWIND -- Set graphics window.
+
+procedure gt_swind (gp, gt)
+
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+
+real	xmin, xmax, dx, ymin, ymax, dy
+
+begin
+	if (gt != NULL) {
+	    if (GT_TRANSPOSE(gt) == NO) {
+	        call gseti (gp, G_XTRAN, GT_XTRAN(gt))
+	        call gseti (gp, G_YTRAN, GT_YTRAN(gt))
+	    } else {
+	        call gseti (gp, G_YTRAN, GT_XTRAN(gt))
+	        call gseti (gp, G_XTRAN, GT_YTRAN(gt))
+	    }
+	    call ggwind (gp, xmin, xmax, ymin, ymax)
+	    dx = xmax - xmin
+	    dy = ymax - ymin
+
+	    if (IS_INDEF (GT_XMIN(gt)))
+		xmin = xmin - GT_XBUF(gt) * dx
+	    else
+		xmin = GT_XMIN(gt)
+
+	    if (IS_INDEF (GT_XMAX(gt)))
+		xmax = xmax + GT_XBUF(gt) * dx
+	    else
+		xmax = GT_XMAX(gt)
+
+	    if (IS_INDEF (GT_YMIN(gt)))
+		ymin = ymin - GT_YBUF(gt) * dy
+	    else
+		ymin = GT_YMIN(gt)
+
+	    if (IS_INDEF (GT_YMAX(gt)))
+		ymax = ymax + GT_YBUF(gt) * dy
+	    else
+		ymax = GT_YMAX(gt)
+
+	    if (GT_XFLIP(gt) == YES) {
+		dx = xmin
+		xmin = xmax
+		xmax = dx
+	    }
+	    if (GT_YFLIP(gt) == YES) {
+		dy = ymin
+		ymin = ymax
+		ymax = dy
+	    }
+
+	    if (GT_TRANSPOSE(gt) == NO)
+		call gswind (gp, xmin, xmax, ymin, ymax)
+	    else
+	        call gswind (gp, ymin, ymax, xmin, xmax)
+	}
+end
diff --git a/pkg/xtools/gtools/gtvplot.x b/pkg/xtools/gtools/gtvplot.x
new file mode 100644
index 00000000..23550c3d
--- /dev/null
+++ b/pkg/xtools/gtools/gtvplot.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gtools.h"
+
+# GT_VPLOT -- Plot vector polymarks or polylines.
+
+procedure gt_vplot (gp, gt, v, npts, x1, x2)
+
+pointer	gp		# GIO pointer
+pointer	gt		# GTOOLS pointer
+real	v[npts]		# Abscissas
+int	npts		# Number of points
+real	x1, x2		# Vector range
+
+int	i, pltype, color, gstati()
+real	x, dx
+
+begin
+	switch (GT_TYPE(gt)) {
+	case 1:
+	    color = gstati (gp, G_PMCOLOR)
+	    call gseti (gp, G_PMCOLOR, GT_COLOR(gt))
+	    call gvmark (gp, v, npts, x1, x2, GT_MARK(gt), GT_XSIZE(gt),
+		GT_YSIZE(gt))
+	    call gseti (gp, G_PMCOLOR, color)
+	case 2:
+	    color = gstati (gp, G_PLCOLOR)
+	    call gseti (gp, G_PLCOLOR, GT_COLOR(gt))
+	    pltype = gstati (gp, G_PLTYPE)
+	    call gseti (gp, G_PLTYPE, GT_LINE(gt))
+	    call gvline (gp, v, npts, x1, x2)
+	    call gseti (gp, G_PLTYPE, pltype)
+	    call gseti (gp, G_PLCOLOR, color)
+	case 3:
+	    color = gstati (gp, G_PLCOLOR)
+	    call gseti (gp, G_PLCOLOR, GT_COLOR(gt))
+	    pltype = gstati (gp, G_PLTYPE)
+	    call gseti (gp, G_PLTYPE, GT_LINE(gt))
+	    dx = (x2 - x1) / (npts - 1)
+	    x = x1 - dx / 2
+	    do i = 1, npts-1 {
+		x = x + dx
+		call gline (gp, x-dx, v[i], x, v[i])
+		call gline (gp, x, v[i], x, v[i+1])
+	    }
+	    call gline (gp, x, v[npts], x+dx, v[npts])
+	    call gseti (gp, G_PLTYPE, pltype)
+	    call gseti (gp, G_PLCOLOR, color)
+	}
+end
diff --git a/pkg/xtools/gtools/gtwindow.x b/pkg/xtools/gtools/gtwindow.x
new file mode 100644
index 00000000..4a150d74
--- /dev/null
+++ b/pkg/xtools/gtools/gtwindow.x
@@ -0,0 +1,180 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gtools.h"
+
+define	HELP	"lib$scr/gtwindow.key"
+define	PROMPT	"window options"
+
+# GT_WINDOW -- Set graph window with the cursor.
+
+procedure gt_window (gt, gp, cursor, redraw)
+
+pointer	gt		# GTOOLS pointer
+pointer	gp		# GIO pointer
+char	cursor[ARB]	# Cursor
+int	redraw		# Redraw flag
+
+char	cmd[1]
+int	wcs1, key1, wcs2, key2, clgcur()
+real	wx1, wy1, wx2, wy2
+
+begin
+	call printf ( "window:")
+	if (clgcur (cursor, wx1, wy1, wcs1, key1, cmd, SZ_LINE) == EOF)
+	    return
+	switch (key1) {
+	case 'e':
+	    call printf ("again:")
+	    if (clgcur (cursor, wx2, wy2, wcs2, key2, cmd, SZ_LINE) == EOF)
+		return
+	    call gt_window2 (gt, gp, wx1, wy1, wcs1, key1, cmd,
+		wx2, wy2, wcs2, key2, cmd, redraw)
+	default:
+	    call gt_window1 (gt, gp, wx1, wy1, wcs1, key1, cmd, redraw)
+	}
+	call printf ("")
+end
+
+
+# GT_WINDOW1 -- Act on window command.
+
+procedure gt_window1 (gt, gp, wx, wy, wcs, key, cmd, redraw)
+
+pointer	gt			#I GTOOLS pointer
+pointer	gp			#I GIO pointer
+real	wx			#I X Coordinate
+real	wy			#I Y Coordinate
+int	wcs			#I WCS
+int	key			#I Key
+char	cmd[ARB]		#I Command
+int	redraw			#O Redraw flag
+
+int	gt_geti()
+real	x1, x2, y1, y2, dx, dy, wx1, wy1
+
+begin
+	redraw = YES
+	call ggwind (gp, x1, x2, y1, y2)
+	dx = x2 - x1
+	dy = y2 - y1
+
+	wx1 = wx
+	wy1 = wy
+	if (IS_INDEF(wx1))
+	    wx1 = (x1 + x2) / 2.
+	if (IS_INDEF(wy1))
+	    wy1 = (y1 + y2) / 2.
+	    
+
+	switch (key) {
+	case '?':	# Print help text
+	    call gpagefile (gp, HELP, PROMPT)
+	    redraw = NO
+	case 'a':	# Autoscale x and y axes
+	    call gt_setr (gt, GTXMIN, INDEF)
+	    call gt_setr (gt, GTXMAX, INDEF)
+	    call gt_setr (gt, GTYMIN, INDEF)
+	    call gt_setr (gt, GTYMAX, INDEF)
+	case 'b':	# Bottom edge
+	    call gt_setr (gt, GTYMIN, wy1)
+	case 'c':
+	    call gt_setr (gt, GTXMIN, wx1 - dx / 2)
+	    call gt_setr (gt, GTXMAX, wx1 + dx / 2)
+	    call gt_setr (gt, GTYMIN, wy1 - dy / 2)
+	    call gt_setr (gt, GTYMAX, wy1 + dy / 2)
+	case 'd':	# Shift down
+	    call gt_setr (gt, GTYMIN, y1 - 0.75 * dy)
+	    call gt_setr (gt, GTYMAX, y2 - 0.75 * dy)
+	case 'f':	# Flip x axis
+	    if (gt_geti (gt, GTXFLIP) == NO)
+		call gt_seti (gt, GTXFLIP, YES)
+	    else
+		call gt_seti (gt, GTXFLIP, NO)
+	case 'g':	# Flip y axis
+	    if (gt_geti (gt, GTYFLIP) == NO)
+		call gt_seti (gt, GTYFLIP, YES)
+	    else
+		call gt_seti (gt, GTYFLIP, NO)
+	case 'j':	# Left edge
+	    call gt_setr (gt, GTXMIN, wx1)
+	case 'k':	# Right edge
+	    call gt_setr (gt, GTXMAX, wx1)
+	case 'l':	# Shift left
+	    call gt_setr (gt, GTXMIN, x1 - 0.75 * dx)
+	    call gt_setr (gt, GTXMAX, x2 - 0.75 * dx)
+	case 'm':	# Autoscale x axis
+	    call gt_setr (gt, GTXMIN, INDEF)
+	    call gt_setr (gt, GTXMAX, INDEF)
+	case 'n':	# Autoscale y axis
+	    call gt_setr (gt, GTYMIN, INDEF)
+	    call gt_setr (gt, GTYMAX, INDEF)
+	case 'p':	# Pan
+	    call gt_setr (gt, GTXMIN, wx1 - dx)
+	    call gt_setr (gt, GTXMAX, wx1 + dx)
+	    call gt_setr (gt, GTYMIN, wy1 - dy)
+	    call gt_setr (gt, GTYMAX, wy1 + dy)
+	case 'r':	# Shift right
+	    call gt_setr (gt, GTXMIN, x1 + 0.75 * dx)
+	    call gt_setr (gt, GTXMAX, x2 + 0.75 * dx)
+	case 't':	# Top edge
+	    call gt_setr (gt, GTYMAX, wy1)
+	case 'u':	# Shift up
+	    call gt_setr (gt, GTYMIN, y1 + 0.75 * dy)
+	    call gt_setr (gt, GTYMAX, y2 + 0.75 * dy)
+	case 'x':	# Zoom x axis
+	    call gt_setr (gt, GTXMIN, wx1 - dx / 4)
+	    call gt_setr (gt, GTXMAX, wx1 + dx / 4)
+	case 'y':	# Zoom y axis
+	    call gt_setr (gt, GTYMIN, wy1 - dy / 4)
+	    call gt_setr (gt, GTYMAX, wy1 + dy / 4)
+	case 'z':	# Zoom x and y axis
+	    call gt_setr (gt, GTXMIN, wx1 - dx / 4)
+	    call gt_setr (gt, GTXMAX, wx1 + dx / 4)
+	    call gt_setr (gt, GTYMIN, wy1 - dy / 4)
+	    call gt_setr (gt, GTYMAX, wy1 + dy / 4)
+	case 'I':
+	    call fatal (0, "Interrupt")
+	default:
+	    call printf ("\07")
+	    redraw = NO
+	}
+end
+
+
+# GT_WINDOW2 -- Act on window command.
+
+procedure gt_window2 (gt, gp, wx1, wy1, wcs1, key1, cmd1,
+	wx2, wy2, wcs2, key2, cmd2, redraw)
+
+pointer	gt			#I GTOOLS pointer
+pointer	gp			#I GIO pointer
+real	wx1, wx2		#I X Coordinate
+real	wy1, wy2		#I Y Coordinate
+int	wcs1, wcs2		#I WCS
+int	key1, key2		#I Key
+char	cmd1[ARB], cmd2[ARB]	#I Command
+int	redraw			#O Redraw flag
+
+real	x1, x2, y1, y2, dx, dy
+
+begin
+	redraw = YES
+	call ggwind (gp, x1, x2, y1, y2)
+	dx = x2 - x1
+	dy = y2 - y1
+
+	switch (key1) {
+	case 'e':	# Expand window
+	    if (abs (wx2 - wx1) > 0.001 * abs (dx)) {
+	        call gt_setr (gt, GTXMIN, wx1)
+	        call gt_setr (gt, GTXMAX, wx2)
+	    }
+	    if (abs (wy2 - wy1) > 0.001 * abs (dy)) {
+	        call gt_setr (gt, GTYMIN, wy1)
+	        call gt_setr (gt, GTYMAX, wy2)
+	    }
+	default:
+	    call printf ("\07\n")
+	    redraw = NO
+	}
+end
diff --git a/pkg/xtools/gtools/mkpkg b/pkg/xtools/gtools/mkpkg
new file mode 100644
index 00000000..bbad01aa
--- /dev/null
+++ b/pkg/xtools/gtools/mkpkg
@@ -0,0 +1,27 @@
+# GTOOLS
+
+update:
+	$checkout	libxtools.a lib$
+	$update		libxtools.a
+	$checkin	libxtools.a lib$
+	;
+
+libxtools.a:
+	gtascale.x	gtools.h <mach.h>
+	gtcolon.x	gtools.h <ctype.h> <gset.h>
+	gtcopy.x	gtools.h
+	gtctran.x	
+	gtcur.x	
+	gtcur1.x	gtools.h
+	gtfree.x	gtools.h
+	gtget.x		gtools.h <gset.h>
+	gtgui.x		gtools.h <gset.h>
+	gtinit.x	gtools.h <gset.h>
+	gtlabax.x	gtools.h <ctype.h> <gset.h> <gio.h>
+	gtplot.x	gtools.h <gset.h>
+	gtreset.x	gtools.h <gset.h>
+	gtset.x		gtools.h <ctype.h> <gset.h>
+	gtswind.x	gtools.h <gset.h> <mach.h>
+	gtvplot.x	gtools.h <gset.h>
+	gtwindow.x	gtools.h
+	;
diff --git a/pkg/xtools/icfit/Revisions b/pkg/xtools/icfit/Revisions
new file mode 100644
index 00000000..0117042e
--- /dev/null
+++ b/pkg/xtools/icfit/Revisions
@@ -0,0 +1,405 @@
+.help revisions Jun88 pkg.xtools.icfit
+.nf
+icdeviant.gx
+    There were two bugs related to growing.  First, the logic was wrong.
+    Second, in one place the grow parameter was treated as being in pixels
+    and in another as being in user coordinate units.
+    (6/28/10, Valdes)
+
+icdosetup.gx
+    When there is only one sample range that is binned to a single point
+    this would result in the fitting limits (introduced 8/11/00) being
+    equal.  This causes cvinit to return an error and the cv pointer
+    is invald.   The change is if the number of binned fitting points
+    is 1 then the full range of the unbinned data is used.  Note that
+    a change was also made on this date to have cvinit return a null
+    pointer rather than a partially initialized pointer.  (11/18/02, Valdes)
+
+=======
+V2.12.1
+=======
+
+=====
+V2.12
+=====
+
+icdosetup.gx
+    The change made previously is now restricted to the polynomial functions
+    which make sense to extrapolate.  The spline functions define the
+    fitting region to be the region set by the calling program.
+    (11/21/00, Valdes)
+
+icfshow.gx
+    Will now work if the GT pointer is NULL.  (8/19/00, Valdes)
+
+icdosetup.gx
+    When using sample ranges the fitting region is now limited to the
+    minimum and maximum of the fitted region.  (8/11/00, Valdes)
+
+=========
+V2.11.3p1
+=========
+=======
+V2.11.3
+=======
+
+icgui.x
+    Eliminated gmsg calls when there is no GUI.  (2/1/99, Valdes)
+
+icshow.x
+icvshow.gx
+    The gt pointer was not being used when called by CURFIT noninteractively.
+    The IC_GT structure is now set in these routines.  (9/14/99, Valdes)
+
+=======
+V2.11.2
+=======
+
+icggraph.gx
+    Moved smark to after an initial return.  (7/11/99, Valdes)
+
+icgfit.x
+    This routine is called with a graphics descriptor for interactive
+    fitting.  The descriptor is set in an internal structure.  Other
+    procedures, which may be called both for interactive and
+    non-interactive fitting, check if the descriptor is not NULL
+    before sending GUI messages.  The problem occurs if this procedure is
+    first called interactively and then the non-interactive fitting
+    routine is called later (maybe after a deactivate workstation or
+    closing the descriptor) resulting in GUI messages being sent
+    when not in interactive mode.  The solution is to return the
+    internal descriptor value to NULL after finishing the interactive
+    fitting and returning from this procedure. (7/22/99, Valdes)
+
+icgui.x
+    Fixed bug in behavior when there is no gui.  (4/2/99, Valdes)
+
+icfit.h
+names.h
+icgfit.gx
+icparams.x
+icggraph.gx
+icgcolon.gx
+icgui.x
+icferrors.gx
+icshow.x
+icerrors.gx
+icvshow.gx
+icguishow.gx
+icfvshow.gx
+mkpkg
+    Added support for GUIs.  (12/7/98, Valdes)
+
+=======
+V2.11.1
+=======
+
+=======
+V2.11.0
+=======
+
+pkg$xtools/icfit/icfit.hlp
+    Changed the order of the task name and version number in the revisions
+    section.  (4/22/97, Valdes)
+
+pkg$xtools/icgcolon.gx
+pkg$xtools/icfit/icfit.hlp
+    Changed the "fitvalue" colon command to "evaluate" to avoid abbreviation
+    conflict with "function".  (4/16/97, Valdes)
+
+pkg$xtools/icfit/icshow.x
+    The commenting of the title string needed to be modified since the
+    title string could include new lines and we want each line to be
+    commented.  (3/27/97, Valdes)
+
+pkg$xtools/icfit/icgcolon.gx
+pkg$xtools/icfit/icfit.hlp
+    Added a "fitvalue" colon command to evaluate the fit at an arbitrary value.
+    (1/28/97, Valdes)
+
+pkg$xtools/icfit/icvshow.gx
+pkg$xtools/icfit/icshow.x
+pkg$xtools/icfit/icerrors.gx
+    All output except the tabular part of :xyshow now begins with
+    the comment character.  Comment column labels were added back.
+    (2/29/96, Valdes)
+
+pkg$xtools/icfit/icvshow.gx
+pkg$xtools/icfit/icgcolon.gx
+pkg$xtools/icfit/icfit.help
+    Enhanced the :xyshow command to include the weights and not print
+    column labels.  (11/20/95, Valdes)
+
+pkg$xtools/icfit/icparams.x
+    Added an ic_geti paramter "nmin" to return the minimum number of
+    points that can be fit.  (9/8/95, Valdes)
+
+pkg$xtools/icfit/icgfit.h
+    The prototype capability of adding points was supposed to return to
+    the calling program as if only the original data was used however
+    the structure element giving the number of points fit was the number
+    after adding the points.  This causes other routines to think the
+    data was sampled in some way which then leads to attempting to
+    reference a NULL array.  The routine now sets the number of points
+    fit back to the input value upon completion.  (7/12/95, Valdes)
+
+pkg$xtools/icfit/icfit.h
+pkg$xtools/icfit/icparams.x
+pkg$xtools/icfit/icggraph.gx
+pkg$xtools/icfit/icgcolon.gx
+pkg$xtools/icfit/icfit.hlp
+    Added a color option for the fit.  Users may set it with :color and
+    applications with ic_puti.  (6/30/95, Valdes)
+
+=======
+V2.10.4
+=======
+
+pkg$xtools/icfit/icdosetup.gx
+    Fixed two type mismatches in min/max calls.  (12/30/94, Valdes)
+
+pkg$xtools/icfit/icgfit.gx
+pkg$xtools/icfit/icfit.hlp
+    Added 'v' key to change fitting weight.  (12/29/94, Valdes)
+
+pkg$xtools/icparams.gx
+    Make it legal to call ic_closed with a null pointer.  (8/11/93, Valdes)
+
+============
+V2.10.3 beta
+============
+
+pkg$xtools/icfit.gx
+    This procedure now sets the IC_FITERROR structure element so that
+    a program using only the noninteractive ic_fit will have this element
+    defined.  The procedure will still return with an error condition
+    if an error occurs as was true previously.  (6/29/93, Valdes)
+
+pkg$xtools/icdosetup.gx
+    The fitting min and max given to cvinit is now calculated from the data
+    avoiding errors in setting it by calling programs.  This was especially
+    dangerous because fitting data outside this range can cause memory
+    corruption errors by the CURFIT routines.  (7/29/92, Valdes)
+
+=======
+V2.10.1
+=======
+
+pkg$xtools/icfit/icgcolon.gx
+pkg$xtools/icfit/icggraph.gx
+pkg$xtools/icfit/icparams.x
+pkg$xtools/icfit/icfit.h
+pkg$xtools/icfit/icfit.hlp
+noao$lib/src/icgfit.key
+noao$lib/src/idicgfit.key
+    Added a new user parameter called "markrej" to toggle whether to mark
+    rejected points or not.  (1/21/92, Valdes)
+
+pkg$xtools/icfit/icfit.hlp
+pkg$xtools/icfit/icgsample.gx
+pkg$xtools/icfit/icgfit.gx
+pkg$xtools/icfit/icgcolon.gx
+pkg$xtools/icfit/icparams.x
+pkg$xtools/icfit/icfit.h
+pkg$xtools/icfit/icfit.hlp
+    1.  Added 'z' key to delete individual sample regions.
+    2.  Increased the internal sample string to 1024 characters.
+    (9/4/91, Valdes)
+
+pkg$xtools/icfit/icfit.hlp
+pkg$xtools/icfit/icgfit.gx
+pkg$xtools/icfit/icgadd.gx
+pkg$xtools/icfit/ mkpkg
+    Added 'a' key to allow adding points for constraining the fit.
+    (9/3/91, Valdes)
+
+pkg$xtools/icfit/icfit.hlp
+    Fixed typo for :errors description.  (11/20/90, Valdes)
+
+pkg$xtools/icfit/icgcolon.gx
+    1. Unrecognized or ambiguous colon commands are now noted.
+    (10/2/90, Valdes)
+
+pkg$xtools/icfit/icvshow.gx
+pkg$xtools/icfit/icgcolon.gx
+pkg$xtools/icfit/icfit.hlp
+noaolib$scr/icgfit.key
+    1. The :vshow command now does not print the (x, y fit, y) values.
+    2. A new user command, :xyshow, prints the (x, y fit, y) values.
+    (5/16/90, Valdes)
+
+====
+V2.9
+====
+
+pkg$xtools/icfit/icparams.x
+pkg$xtools/icfit/icgcolon.x
+    1. ic_puti uses max (1, order) for setting the order.
+    2. icg_colon prints error if attempting to set order < 1.
+    (3/6/90, Valdes)
+
+pkg$xtools/icfit/icparams.x
+    Added ability to get information about the number of fit points and the
+    rejected points to the ic_geti procedure.  (5/4/89, Valdes)
+
+pkg$xtools/icfit/icggraph.gx
+    Scaled the symbol used for marking average points to the appropriate
+    coordinate system.  This is still only approximately correct.
+    Based on a report by Ivo Busko.  (3/1/89, Valdes)
+ 
+pkg$xtools/icfit/icvshow.gx
+
+    Changed output format of 3 values so 7 digits of precision are printed.
+    This was in response to a user request for the utilities.curfit task,
+    but all programs calling icvshow will be affected.  (ShJ 3-NOV-88)
+
+< 	call fprintf (fd, "RMS = %10.7g\n")
+> 	call fprintf (fd, "RMS = %7.4g\n")
+
+< 	call fprintf (fd, "square root of reduced chi square = %10.7g\n")
+> 	call fprintf (fd, "square root of reduced chi square = %7.4g\n")
+
+<       call fprintf (fd, "\t%14.7e\t%14.7e\n")
+>       call fprintf (fd, "\t%10.4e\t%10.4e\n")
+
+pkg$xtools/icfit/icgfit.gx
+pkg$xtools/icfit/icgaddfit.gx
+noao$lib/scr/icgfit.key
+    Added 'I' interrupt key.  (4/20/88 Valdes)
+
+pkg$xtools/icfit/icgfit.gx
+pkg$xtools/icfit/icgparams.gx
+    Valdes, Jan. 5, 1988
+    Added checks for an error in fitting the curve.
+
+pkg$xtools/icfit/icgfit.gx
+    Valdes, Oct. 2, 1987
+    1.  When doing sample regions there was a round off problem with
+    negative numbers.  Replaced int(x+.5) with nint(x).
+
+pkg$xtools/icfit/icfit.h
+pkg$xtools/icfit/icparams.x
+pkg$xtools/icfit/icguaxes.gx
+    Valdes, February 20,1987
+    1.  Made the cursor help file a setable parameter since the graph
+	keys are definable by the application.
+    2.  Added the radial velocity axis type explicitly to the package
+	to remove the need for onedspec.identify to have it's own copy
+	of the package.
+
+pkg$xtools/icfit/*x
+    Valdes, February 17, 1987
+    1.  Required GIO changes.
+
+pkg$xtools/icfit/icgcolon.gx
+    Valdes, January 16, 1987
+    1.  Colon command dictionary and switch modified to use macro definitions.
+
+pkg$xtools/icfit/icgfit.gx
+noao$lib/scr/icgfit.key
+noao$lib/scr/icgaxes.key	-
+    Valdes, January 13, 1987
+    1.  When setting sample ranges with the cursor the range limits are now
+	rounded to the nearest integer only if the x values are integers.
+	Previously it always rounded even if the data were not integers.
+    2.  Modified to use system page procedure for printing help.
+    3.  Revised the help file and included the graph axes help in the same
+	file since it is now paged.  The separate axes help file was deleted.
+
+pkg$xtools/icfit/icgcolon.gx
+    Valdes, October 7, 1986
+    1.  It is no longer possible to set naverage to 0 which causes ICFIT
+	to crash.  A message is now printed telling the user that 0 is
+	not a legal value.  This error is present in V2.3 and earlier.
+
+pkg$xtools/icfit/icgdelete.gx
+pkg$xtools/icfit/icgundelete.gx
+    Valdes, September 8, 1986
+    1.  Procedures were defined as function but used as subroutines.  The
+	function declarations were removed.  Found during the Alliant port.
+
+pkg$xtools/icfit/icgfit.gx
+noao$onedspec/identify/icfit/icgfit.gx
+    Valdes, August 21, 1986
+    1.  When defining sample ranges interactively with the cursor the
+	new sample string was appended to the previous string without
+	a leading space and with a trailing space.  This was fine if
+	the sample was defined only interactively or only explicitly
+	as a string.  However, appending an interactive sample to one
+	the user types in (without a trailing blank) is an error.
+	Changed the interactive appending to put a leading blank and
+	no trailing blank.
+
+noao$lib/src/icgfit.key
+    Valdes, August 20, 1986
+    1.  The key file listed :lowreject and :highreject instead of the
+	correct :low_reject and :high_reject.  The key file was fixed.
+
+====================================
+Version 2.3 Release, August 18, 1986
+====================================
+
+icfit$:  Valdes, August 11, 1986
+    1.  Reorganized package to have separate objects for each procedure.
+	This allows loading only the procedures of the desired datatype.
+
+icfit$icgfit.gx:  Valdes, August 7, 1986
+    1.  The 'c' key was using a fixed format inappropriate for some types
+	of data.  The formats where changed to general %g format.
+
+icfit$icgfit.gx:  Valdes, August 7, 1986
+    1.  A bug in the generic code was causing a double to be
+	passed to gt_setr which caused the windowing to be wrong.
+	This bug appeared only in the SUN.
+    2.  A bug in writing the current key definition with the 'g' key was
+	fixed.  This bug appeared only in the SUN.
+
+icfit:  Valdes, July 3, 1986
+    1.  New ICFIT package.
+
+icfit$icggraph.gx:  Valdes, April 28, 1986
+    1.  Fixed bug in icggraph.gx:
+	    real $tcveval  --->  PIXEL $tcveval
+
+icfit$icgfit.gx,icgfit2.x,icgcolon.x:  Valdes, April 7, 1986
+    1.  Fixed use of STRIDX with a character constant to STRIDXS.
+    2.  Fixed problem with colon usage for ":sample" and ":function"
+
+icfit: Valdes, Mar 13, 1986:
+    1.  ICFIT package converted to generic form.  The package now has entries
+	for both single precision and double precision data.  It uses the new
+	curfit math library which now has double precision entries as well.
+	The external names of the single precision procedures are unchanged.
+======
+Release 2.2
+======
+From Valdes Dec 30 , 1985
+
+1.  Setting of sample ranges by cursor was integer truncating giving the
+funny result that if the cursor was set at 4.99 the sample limit was 4.
+This has been changed so that the sample limit is rounded to the nearest
+integer.
+------
+From Valdes Nov 20 , 1985
+
+1.  New procedure ICG_FIT2 added.  This procedure does all graphics
+open and closes and has cl parameters "graphics", "plots", and "cursor".
+This will eventually phase out ICG_FIT.
+
+2.  Procedures modified to use an array of GTOOLS pointers instead of
+keeping them in separate variables.  This allows easy expansion to add
+additional graph formats.
+------
+From Valdes Oct 17 , 1985
+
+1.  Graphing the zero line was removed from icggraph.x because the line
+interfered with fitting data near zero.
+------
+From Valdes Oct 4, 1985
+
+1.  The package was modified to add high and low rejection and to iterate
+the rejection algorithm.
+
+2.  Procedure icg_params was add to label the graphs with the fitting
+parameters.
+.endhelp
diff --git a/pkg/xtools/icfit/icclean.gx b/pkg/xtools/icfit/icclean.gx
new file mode 100644
index 00000000..0d5dd08a
--- /dev/null
+++ b/pkg/xtools/icfit/icclean.gx
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pkg/rg.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_CLEAN -- Replace rejected points by the fitted values.
+
+procedure ic_clean$t (ic, cv, x, y, w, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	cv				# Curfit pointer
+PIXEL	x[npts]				# Ordinates
+PIXEL	y[npts]				# Abscissas
+PIXEL	w[npts]				# Weights
+int	npts				# Number of points
+
+int	i, nclean, newreject
+pointer	sp, xclean, yclean, wclean
+
+PIXEL	$tcveval()
+
+begin
+	if ((IC_LOW(ic) == 0.) && (IC_HIGH(ic) == 0.))
+	    return
+
+	# If there has been no subsampling and no sample averaging then the
+	# IC_REJPTS(ic) array already contains the rejected points.
+
+	if (npts == IC_NFIT(ic)) {
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+		        y[i] = $tcveval (cv, x[i])
+	        }
+	    }
+
+	# If there has been no sample averaging then the rejpts array already
+	# contains indices into the subsampled array.
+
+	} else if (abs(IC_NAVERAGE(ic)) < 2) {
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Mem$t[IC_YFIT(ic)+i-1] =
+			    $tcveval (cv, Mem$t[IC_XFIT(ic)+i-1])
+		}
+	    }
+	    call rg_unpack$t (IC_RG(ic), Mem$t[IC_YFIT(ic)], y)
+
+	# Because ic_fit rejects points from the fitting data which
+	# has been sample averaged the rejpts array refers to the wrong data.
+	# Do the cleaning using ic_deviant to find the points to reject.
+
+	} else if (RG_NPTS(IC_RG(ic)) == npts) {
+	    call amovki (NO, Memi[IC_REJPTS(ic)], npts)
+	    call ic_deviant$t (cv, x, y, w, Memi[IC_REJPTS(ic)], npts,
+		IC_LOW(ic), IC_HIGH(ic), IC_GROW(ic), NO, IC_NREJECT(ic),
+		newreject)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			y[i] = $tcveval (cv, x[i])
+		}
+	    }
+
+	# If there is subsampling then allocate temporary arrays for the
+	# subsample points.
+
+	} else {
+	    call smark (sp)
+	    nclean = RG_NPTS(IC_RG(ic))
+	    call salloc (xclean, nclean, TY_PIXEL)
+	    call salloc (yclean, nclean, TY_PIXEL)
+	    call salloc (wclean, nclean, TY_PIXEL)
+	    call rg_pack$t (IC_RG(ic), x, Mem$t[xclean])
+	    call rg_pack$t (IC_RG(ic), y, Mem$t[yclean])
+	    call rg_pack$t (IC_RG(ic), w, Mem$t[wclean])
+	    call amovki (NO, Memi[IC_REJPTS(ic)], npts)
+	    call ic_deviant$t (cv, Mem$t[xclean], Mem$t[yclean],
+		Mem$t[wclean], Memi[IC_REJPTS(ic)], nclean, IC_LOW(ic),
+		IC_HIGH(ic), IC_GROW(ic), NO, IC_NREJECT(ic), newreject)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Mem$t[yclean+i-1] = $tcveval (cv, Mem$t[xclean+i-1])
+		}
+	    }
+	    call rg_unpack$t (IC_RG(ic), Mem$t[yclean], y)
+	    call sfree (sp)
+	}
+end
diff --git a/pkg/xtools/icfit/iccleand.x b/pkg/xtools/icfit/iccleand.x
new file mode 100644
index 00000000..97c88a19
--- /dev/null
+++ b/pkg/xtools/icfit/iccleand.x
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pkg/rg.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_CLEAN -- Replace rejected points by the fitted values.
+
+procedure ic_cleand (ic, cv, x, y, w, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	cv				# Curfit pointer
+double	x[npts]				# Ordinates
+double	y[npts]				# Abscissas
+double	w[npts]				# Weights
+int	npts				# Number of points
+
+int	i, nclean, newreject
+pointer	sp, xclean, yclean, wclean
+
+double	dcveval()
+
+begin
+	if ((IC_LOW(ic) == 0.) && (IC_HIGH(ic) == 0.))
+	    return
+
+	# If there has been no subsampling and no sample averaging then the
+	# IC_REJPTS(ic) array already contains the rejected points.
+
+	if (npts == IC_NFIT(ic)) {
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+		        y[i] = dcveval (cv, x[i])
+	        }
+	    }
+
+	# If there has been no sample averaging then the rejpts array already
+	# contains indices into the subsampled array.
+
+	} else if (abs(IC_NAVERAGE(ic)) < 2) {
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memd[IC_YFIT(ic)+i-1] =
+			    dcveval (cv, Memd[IC_XFIT(ic)+i-1])
+		}
+	    }
+	    call rg_unpackd (IC_RG(ic), Memd[IC_YFIT(ic)], y)
+
+	# Because ic_fit rejects points from the fitting data which
+	# has been sample averaged the rejpts array refers to the wrong data.
+	# Do the cleaning using ic_deviant to find the points to reject.
+
+	} else if (RG_NPTS(IC_RG(ic)) == npts) {
+	    call amovki (NO, Memi[IC_REJPTS(ic)], npts)
+	    call ic_deviantd (cv, x, y, w, Memi[IC_REJPTS(ic)], npts,
+		IC_LOW(ic), IC_HIGH(ic), IC_GROW(ic), NO, IC_NREJECT(ic),
+		newreject)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			y[i] = dcveval (cv, x[i])
+		}
+	    }
+
+	# If there is subsampling then allocate temporary arrays for the
+	# subsample points.
+
+	} else {
+	    call smark (sp)
+	    nclean = RG_NPTS(IC_RG(ic))
+	    call salloc (xclean, nclean, TY_DOUBLE)
+	    call salloc (yclean, nclean, TY_DOUBLE)
+	    call salloc (wclean, nclean, TY_DOUBLE)
+	    call rg_packd (IC_RG(ic), x, Memd[xclean])
+	    call rg_packd (IC_RG(ic), y, Memd[yclean])
+	    call rg_packd (IC_RG(ic), w, Memd[wclean])
+	    call amovki (NO, Memi[IC_REJPTS(ic)], npts)
+	    call ic_deviantd (cv, Memd[xclean], Memd[yclean],
+		Memd[wclean], Memi[IC_REJPTS(ic)], nclean, IC_LOW(ic),
+		IC_HIGH(ic), IC_GROW(ic), NO, IC_NREJECT(ic), newreject)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memd[yclean+i-1] = dcveval (cv, Memd[xclean+i-1])
+		}
+	    }
+	    call rg_unpackd (IC_RG(ic), Memd[yclean], y)
+	    call sfree (sp)
+	}
+end
diff --git a/pkg/xtools/icfit/iccleanr.x b/pkg/xtools/icfit/iccleanr.x
new file mode 100644
index 00000000..cbcff319
--- /dev/null
+++ b/pkg/xtools/icfit/iccleanr.x
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pkg/rg.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_CLEAN -- Replace rejected points by the fitted values.
+
+procedure ic_cleanr (ic, cv, x, y, w, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	cv				# Curfit pointer
+real	x[npts]				# Ordinates
+real	y[npts]				# Abscissas
+real	w[npts]				# Weights
+int	npts				# Number of points
+
+int	i, nclean, newreject
+pointer	sp, xclean, yclean, wclean
+
+real	rcveval()
+
+begin
+	if ((IC_LOW(ic) == 0.) && (IC_HIGH(ic) == 0.))
+	    return
+
+	# If there has been no subsampling and no sample averaging then the
+	# IC_REJPTS(ic) array already contains the rejected points.
+
+	if (npts == IC_NFIT(ic)) {
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+		        y[i] = rcveval (cv, x[i])
+	        }
+	    }
+
+	# If there has been no sample averaging then the rejpts array already
+	# contains indices into the subsampled array.
+
+	} else if (abs(IC_NAVERAGE(ic)) < 2) {
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memr[IC_YFIT(ic)+i-1] =
+			    rcveval (cv, Memr[IC_XFIT(ic)+i-1])
+		}
+	    }
+	    call rg_unpackr (IC_RG(ic), Memr[IC_YFIT(ic)], y)
+
+	# Because ic_fit rejects points from the fitting data which
+	# has been sample averaged the rejpts array refers to the wrong data.
+	# Do the cleaning using ic_deviant to find the points to reject.
+
+	} else if (RG_NPTS(IC_RG(ic)) == npts) {
+	    call amovki (NO, Memi[IC_REJPTS(ic)], npts)
+	    call ic_deviantr (cv, x, y, w, Memi[IC_REJPTS(ic)], npts,
+		IC_LOW(ic), IC_HIGH(ic), IC_GROW(ic), NO, IC_NREJECT(ic),
+		newreject)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			y[i] = rcveval (cv, x[i])
+		}
+	    }
+
+	# If there is subsampling then allocate temporary arrays for the
+	# subsample points.
+
+	} else {
+	    call smark (sp)
+	    nclean = RG_NPTS(IC_RG(ic))
+	    call salloc (xclean, nclean, TY_REAL)
+	    call salloc (yclean, nclean, TY_REAL)
+	    call salloc (wclean, nclean, TY_REAL)
+	    call rg_packr (IC_RG(ic), x, Memr[xclean])
+	    call rg_packr (IC_RG(ic), y, Memr[yclean])
+	    call rg_packr (IC_RG(ic), w, Memr[wclean])
+	    call amovki (NO, Memi[IC_REJPTS(ic)], npts)
+	    call ic_deviantr (cv, Memr[xclean], Memr[yclean],
+		Memr[wclean], Memi[IC_REJPTS(ic)], nclean, IC_LOW(ic),
+		IC_HIGH(ic), IC_GROW(ic), NO, IC_NREJECT(ic), newreject)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memr[yclean+i-1] = rcveval (cv, Memr[xclean+i-1])
+		}
+	    }
+	    call rg_unpackr (IC_RG(ic), Memr[yclean], y)
+	    call sfree (sp)
+	}
+end
diff --git a/pkg/xtools/icfit/icdeviant.gx b/pkg/xtools/icfit/icdeviant.gx
new file mode 100644
index 00000000..e4e2cff3
--- /dev/null
+++ b/pkg/xtools/icfit/icdeviant.gx
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<math/curfit.h>
+include	"names.h"
+
+# IC_DEVIANT -- Find deviant points with large residuals from the fit
+# and reject from the fit.
+#
+# The sigma of the fit residuals is calculated.  The rejection thresholds
+# are set at +-reject*sigma.  Points outside the rejection threshold are
+# recorded in the reject array.
+
+procedure ic_deviant$t (cv, x, y, w, rejpts, npts, low_reject, high_reject,
+    grow, refit, nreject, newreject)
+
+pointer	cv				# Curve descriptor
+PIXEL	x[npts]				# Input ordinates
+PIXEL	y[npts]				# Input data values
+PIXEL	w[npts]				# Weights
+int	rejpts[npts]			# Points rejected
+int	npts				# Number of input points
+real	low_reject, high_reject		# Rejection thresholds
+real	grow				# Rejection radius
+int	refit				# Refit the curve?
+int	nreject				# Number of points rejected
+int	newreject			# Number of new points rejected
+
+int	i, j, i_min, i_max, pixgrow
+PIXEL	sigma, low_cut, high_cut, residual
+pointer	sp, residuals
+
+begin
+	# If low_reject and high_reject are zero then simply return.
+
+	if ((low_reject == 0.) && (high_reject == 0.))
+	    return
+
+	# Allocate memory for the residuals.
+
+	call smark (sp)
+	call salloc (residuals, npts, TY_PIXEL)
+
+	# Compute the residuals.
+
+	call $tcvvector (cv, x, Mem$t[residuals], npts)
+	call asub$t (y, Mem$t[residuals], Mem$t[residuals], npts)
+
+	# Compute the sigma of the residuals.  If there are less than
+	# 5 points return.
+
+	j = 0
+	nreject = 0
+	sigma = 0.
+
+	do i = 1, npts {
+	    if ((w[i] != 0.) && (rejpts[i] == NO)) {
+		sigma = sigma + Mem$t[residuals+i-1] ** 2
+		j = j + 1
+	    } else if (rejpts[i] == YES)
+		nreject = nreject + 1
+	}
+
+	if (j < 5) {
+	    call sfree (sp)
+	    return
+	} else
+	    sigma = sqrt (sigma / j)
+
+	if (low_reject > 0.)
+	    low_cut = -low_reject * sigma
+	else
+	    low_cut = -MAX_REAL
+	if (high_reject > 0.)
+	    high_cut = high_reject * sigma
+	else
+	    high_cut = MAX_REAL
+
+	# Reject the residuals exceeding the rejection limits.
+	# A for loop is used instead of do because with region growing we
+	# want to modify the loop index.
+
+	pixgrow = 0
+        if (grow > 0.) {
+	    do i = 1, npts-1 {
+		if (abs (x[i+1] - x[i]) < 0.0001)
+		    next
+		if (i == 1)
+		    pixgrow = grow / abs (x[i+1] - x[i])
+		else
+		    pixgrow = max (grow / abs (x[i+1] - x[i]), pixgrow)
+	    }
+	}
+
+	newreject = 0
+	for (i = 1; i <= npts; i = i + 1) {
+	    if (w[i] == 0. || rejpts[i] == YES)
+		next
+
+	    residual = Mem$t[residuals + i - 1]
+	    if (residual < high_cut && residual > low_cut)
+		next
+
+	    i_min = max (1, i - pixgrow)
+	    i_max = min (npts, i + pixgrow)
+
+	    # Reject points from the fit and flag them.
+	    do j = i_min, i_max {
+		if ((abs (x[i] - x[j]) <= grow) && (w[j] != 0.) &&
+		    (rejpts[j] == NO)) {
+		    if (refit == YES)
+			call $tcvrject (cv, x[j], y[j], w[j])
+		    rejpts[j] = 2
+		    newreject = newreject + 1
+		}
+	    }
+	}
+	do i = 1, npts
+	    if (rejpts[i] != NO)
+		rejpts[i] = YES
+
+	nreject = nreject + newreject
+	call sfree (sp)
+
+	if ((refit == YES) && (newreject > 0)) {
+	    call $tcvsolve (cv, i)
+	    switch (i) {
+	    case SINGULAR:
+		call error (1, "ic_reject: Singular solution")
+	    case NO_DEG_FREEDOM:
+		call error (2, "ic_reject: No degrees of freedom")
+	    }
+	}
+end
diff --git a/pkg/xtools/icfit/icdeviantd.x b/pkg/xtools/icfit/icdeviantd.x
new file mode 100644
index 00000000..ab16b3d5
--- /dev/null
+++ b/pkg/xtools/icfit/icdeviantd.x
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<math/curfit.h>
+include	"names.h"
+
+# IC_DEVIANT -- Find deviant points with large residuals from the fit
+# and reject from the fit.
+#
+# The sigma of the fit residuals is calculated.  The rejection thresholds
+# are set at +-reject*sigma.  Points outside the rejection threshold are
+# recorded in the reject array.
+
+procedure ic_deviantd (cv, x, y, w, rejpts, npts, low_reject, high_reject,
+    grow, refit, nreject, newreject)
+
+pointer	cv				# Curve descriptor
+double	x[npts]				# Input ordinates
+double	y[npts]				# Input data values
+double	w[npts]				# Weights
+int	rejpts[npts]			# Points rejected
+int	npts				# Number of input points
+real	low_reject, high_reject		# Rejection thresholds
+real	grow				# Rejection radius
+int	refit				# Refit the curve?
+int	nreject				# Number of points rejected
+int	newreject			# Number of new points rejected
+
+int	i, j, i_min, i_max, pixgrow
+double	sigma, low_cut, high_cut, residual
+pointer	sp, residuals
+
+begin
+	# If low_reject and high_reject are zero then simply return.
+
+	if ((low_reject == 0.) && (high_reject == 0.))
+	    return
+
+	# Allocate memory for the residuals.
+
+	call smark (sp)
+	call salloc (residuals, npts, TY_DOUBLE)
+
+	# Compute the residuals.
+
+	call dcvvector (cv, x, Memd[residuals], npts)
+	call asubd (y, Memd[residuals], Memd[residuals], npts)
+
+	# Compute the sigma of the residuals.  If there are less than
+	# 5 points return.
+
+	j = 0
+	nreject = 0
+	sigma = 0.
+
+	do i = 1, npts {
+	    if ((w[i] != 0.) && (rejpts[i] == NO)) {
+		sigma = sigma + Memd[residuals+i-1] ** 2
+		j = j + 1
+	    } else if (rejpts[i] == YES)
+		nreject = nreject + 1
+	}
+
+	if (j < 5) {
+	    call sfree (sp)
+	    return
+	} else
+	    sigma = sqrt (sigma / j)
+
+	if (low_reject > 0.)
+	    low_cut = -low_reject * sigma
+	else
+	    low_cut = -MAX_REAL
+	if (high_reject > 0.)
+	    high_cut = high_reject * sigma
+	else
+	    high_cut = MAX_REAL
+
+	# Reject the residuals exceeding the rejection limits.
+	# A for loop is used instead of do because with region growing we
+	# want to modify the loop index.
+
+	pixgrow = 0
+        if (grow > 0.) {
+	    do i = 1, npts-1 {
+		if (abs (x[i+1] - x[i]) < 0.0001)
+		    next
+		if (i == 1)
+		    pixgrow = grow / abs (x[i+1] - x[i])
+		else
+		    pixgrow = max (grow / abs (x[i+1] - x[i]), pixgrow)
+	    }
+	}
+
+	newreject = 0
+	for (i = 1; i <= npts; i = i + 1) {
+	    if (w[i] == 0. || rejpts[i] == YES)
+		next
+
+	    residual = Memd[residuals + i - 1]
+	    if (residual < high_cut && residual > low_cut)
+		next
+
+	    i_min = max (1, i - pixgrow)
+	    i_max = min (npts, i + pixgrow)
+
+	    # Reject points from the fit and flag them.
+	    do j = i_min, i_max {
+		if ((abs (x[i] - x[j]) <= grow) && (w[j] != 0.) &&
+		    (rejpts[j] == NO)) {
+		    if (refit == YES)
+			call dcvrject (cv, x[j], y[j], w[j])
+		    rejpts[j] = 2
+		    newreject = newreject + 1
+		}
+	    }
+	}
+	do i = 1, npts
+	    if (rejpts[i] != NO)
+		rejpts[i] = YES
+
+	nreject = nreject + newreject
+	call sfree (sp)
+
+	if ((refit == YES) && (newreject > 0)) {
+	    call dcvsolve (cv, i)
+	    switch (i) {
+	    case SINGULAR:
+		call error (1, "ic_reject: Singular solution")
+	    case NO_DEG_FREEDOM:
+		call error (2, "ic_reject: No degrees of freedom")
+	    }
+	}
+end
diff --git a/pkg/xtools/icfit/icdeviantr.x b/pkg/xtools/icfit/icdeviantr.x
new file mode 100644
index 00000000..5d584377
--- /dev/null
+++ b/pkg/xtools/icfit/icdeviantr.x
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<math/curfit.h>
+include	"names.h"
+
+# IC_DEVIANT -- Find deviant points with large residuals from the fit
+# and reject from the fit.
+#
+# The sigma of the fit residuals is calculated.  The rejection thresholds
+# are set at +-reject*sigma.  Points outside the rejection threshold are
+# recorded in the reject array.
+
+procedure ic_deviantr (cv, x, y, w, rejpts, npts, low_reject, high_reject,
+    grow, refit, nreject, newreject)
+
+pointer	cv				# Curve descriptor
+real	x[npts]				# Input ordinates
+real	y[npts]				# Input data values
+real	w[npts]				# Weights
+int	rejpts[npts]			# Points rejected
+int	npts				# Number of input points
+real	low_reject, high_reject		# Rejection thresholds
+real	grow				# Rejection radius
+int	refit				# Refit the curve?
+int	nreject				# Number of points rejected
+int	newreject			# Number of new points rejected
+
+int	i, j, i_min, i_max, pixgrow
+real	sigma, low_cut, high_cut, residual
+pointer	sp, residuals
+
+begin
+	# If low_reject and high_reject are zero then simply return.
+
+	if ((low_reject == 0.) && (high_reject == 0.))
+	    return
+
+	# Allocate memory for the residuals.
+
+	call smark (sp)
+	call salloc (residuals, npts, TY_REAL)
+
+	# Compute the residuals.
+
+	call rcvvector (cv, x, Memr[residuals], npts)
+	call asubr (y, Memr[residuals], Memr[residuals], npts)
+
+	# Compute the sigma of the residuals.  If there are less than
+	# 5 points return.
+
+	j = 0
+	nreject = 0
+	sigma = 0.
+
+	do i = 1, npts {
+	    if ((w[i] != 0.) && (rejpts[i] == NO)) {
+		sigma = sigma + Memr[residuals+i-1] ** 2
+		j = j + 1
+	    } else if (rejpts[i] == YES)
+		nreject = nreject + 1
+	}
+
+	if (j < 5) {
+	    call sfree (sp)
+	    return
+	} else
+	    sigma = sqrt (sigma / j)
+
+	if (low_reject > 0.)
+	    low_cut = -low_reject * sigma
+	else
+	    low_cut = -MAX_REAL
+	if (high_reject > 0.)
+	    high_cut = high_reject * sigma
+	else
+	    high_cut = MAX_REAL
+
+	# Reject the residuals exceeding the rejection limits.
+	# A for loop is used instead of do because with region growing we
+	# want to modify the loop index.
+
+	pixgrow = 0
+        if (grow > 0.) {
+	    do i = 1, npts-1 {
+		if (abs (x[i+1] - x[i]) < 0.0001)
+		    next
+		if (i == 1)
+		    pixgrow = grow / abs (x[i+1] - x[i])
+		else
+		    pixgrow = max (grow / abs (x[i+1] - x[i]), pixgrow)
+	    }
+	}
+
+	newreject = 0
+	for (i = 1; i <= npts; i = i + 1) {
+	    if (w[i] == 0. || rejpts[i] == YES)
+		next
+
+	    residual = Memr[residuals + i - 1]
+	    if (residual < high_cut && residual > low_cut)
+		next
+
+	    i_min = max (1, i - pixgrow)
+	    i_max = min (npts, i + pixgrow)
+
+	    # Reject points from the fit and flag them.
+	    do j = i_min, i_max {
+		if ((abs (x[i] - x[j]) <= grow) && (w[j] != 0.) &&
+		    (rejpts[j] == NO)) {
+		    if (refit == YES)
+			call rcvrject (cv, x[j], y[j], w[j])
+		    rejpts[j] = 2
+		    newreject = newreject + 1
+		}
+	    }
+	}
+	do i = 1, npts
+	    if (rejpts[i] != NO)
+		rejpts[i] = YES
+
+	nreject = nreject + newreject
+	call sfree (sp)
+
+	if ((refit == YES) && (newreject > 0)) {
+	    call rcvsolve (cv, i)
+	    switch (i) {
+	    case SINGULAR:
+		call error (1, "ic_reject: Singular solution")
+	    case NO_DEG_FREEDOM:
+		call error (2, "ic_reject: No degrees of freedom")
+	    }
+	}
+end
diff --git a/pkg/xtools/icfit/icdosetup.gx b/pkg/xtools/icfit/icdosetup.gx
new file mode 100644
index 00000000..b4ec4c55
--- /dev/null
+++ b/pkg/xtools/icfit/icdosetup.gx
@@ -0,0 +1,121 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_DOSETUP -- Setup the fit.  This is called at the start of each call
+# to ic_fit to update the fitting parameters if necessary.
+
+procedure ic_dosetup$t (ic, cv, x, wts, npts, newx, newwts, newfunction, refit)
+
+pointer	ic				# ICFIT pointer
+pointer	cv				# Curfit pointer
+PIXEL	x[npts]				# Ordinates of data
+PIXEL	wts[npts]			# Weights
+int	npts				# Number of points in data
+int	newx				# New x points?
+int	newwts				# New weights?
+int	newfunction			# New function?
+int	refit				# Use cvrefit?
+
+int	ord
+PIXEL	xmin, xmax
+
+pointer	rg_xranges$t()
+#extern	hd_power$t()
+errchk	rg_xranges$t
+
+begin
+	# Set sample points.
+	if ((newx == YES) || (newwts == YES)) {
+	    if (npts == 0)
+		call error (0, "No data points for fit")
+
+	    call mfree (IC_XFIT(ic), TY_PIXEL)
+	    call mfree (IC_YFIT(ic), TY_PIXEL)
+	    call malloc (IC_XFIT(ic), npts, TY_PIXEL)
+
+	    call mfree (IC_WTSFIT(ic), TY_PIXEL)
+	    call malloc (IC_WTSFIT(ic), npts, TY_PIXEL)
+
+	    call mfree (IC_REJPTS(ic), TY_INT)
+	    call malloc (IC_REJPTS(ic), npts, TY_INT)
+	    call amovki (NO, Memi[IC_REJPTS(ic)], npts)
+	    IC_NREJECT(ic) = 0
+
+	    # Set sample points.
+
+	    call rg_free (IC_RG(ic))
+	    IC_RG(ic) = rg_xranges$t (Memc[IC_SAMPLE(ic)], x, npts)
+	    call rg_order (IC_RG(ic))
+	    call rg_merge (IC_RG(ic))
+	    call rg_wtbin$t (IC_RG(ic), max (1, abs (IC_NAVERAGE(ic))), x, wts,
+		npts, Mem$t[IC_XFIT(ic)], Mem$t[IC_WTSFIT(ic)], IC_NFIT(ic))
+
+	    if (IC_NFIT(ic) == 0)
+		call error (0, "No sample points for fit")
+
+	    if (IC_NFIT(ic) == npts) {
+	        call rg_free (IC_RG(ic))
+	        call mfree (IC_XFIT(ic), TY_PIXEL)
+	        call mfree (IC_WTSFIT(ic), TY_PIXEL)
+	        IC_YFIT(ic) = NULL
+		IC_WTSFIT(ic) = NULL
+		call alim$t (x, npts, xmin, xmax)
+	    } else {
+	        call malloc (IC_YFIT(ic), IC_NFIT(ic), TY_PIXEL)
+		if (IC_NFIT(ic) == 1)
+		    call alim$t (x, npts, xmin, xmax)
+		else
+		    call alim$t (Mem$t[IC_XFIT(ic)], IC_NFIT(ic), xmin, xmax)
+	    }
+
+	    IC_XMIN(ic) = min (IC_XMIN(ic), real(xmin))
+	    IC_XMAX(ic) = max (IC_XMAX(ic), real(xmax))
+	    refit = NO
+	}
+
+	# Set curve fitting parameters.
+	# For polynomials define fitting range over range of data in fit
+	# and assume extrpolation is ok.  For spline functions define
+	# fitting range to be range of evaluation set by the caller
+	# since extrapolation will not make sense.
+
+	if ((newx == YES) || (newfunction == YES)) {
+	    if (cv != NULL)
+	        call $tcvfree (cv)
+
+	    switch (IC_FUNCTION(ic)) {
+	    case LEGENDRE, CHEBYSHEV:
+		ord = min (IC_ORDER(ic), IC_NFIT(ic))
+	        call $tcvinit (cv, IC_FUNCTION(ic), ord, PIXEL (xmin),
+		    PIXEL (xmax))
+	    case SPLINE1:
+		ord = min (IC_ORDER(ic), IC_NFIT(ic) - 1)
+		if (ord > 0)
+	            call $tcvinit (cv, SPLINE1, ord, PIXEL (IC_XMIN(ic)),
+			PIXEL (IC_XMAX(ic)))
+		else
+	            call $tcvinit (cv, LEGENDRE, IC_NFIT(ic),
+			PIXEL (IC_XMIN(ic)), PIXEL (IC_XMAX(ic)))
+	    case SPLINE3:
+		ord = min (IC_ORDER(ic), IC_NFIT(ic) - 3)
+		if (ord > 0)
+	            call $tcvinit (cv, SPLINE3, ord, PIXEL (IC_XMIN(ic)),
+			PIXEL (IC_XMAX(ic)))
+		else
+	            call $tcvinit (cv, LEGENDRE, IC_NFIT(ic),
+			PIXEL (IC_XMIN(ic)), PIXEL (IC_XMAX(ic)))
+#	    case USERFNC:
+#		ord = min (IC_ORDER(ic), IC_NFIT(ic))
+#		call $tcvinit (cv, USERFNC, ord, PIXEL (IC_XMIN(ic)),
+#		    PIXEL (IC_XMAX(ic)))
+#		call $tcvuserfnc (cv, hd_power$t)
+	    default:
+		call error (0, "Unknown fitting function")
+	    }
+
+	    refit = NO
+	}
+end
diff --git a/pkg/xtools/icfit/icdosetupd.x b/pkg/xtools/icfit/icdosetupd.x
new file mode 100644
index 00000000..98b64939
--- /dev/null
+++ b/pkg/xtools/icfit/icdosetupd.x
@@ -0,0 +1,121 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_DOSETUP -- Setup the fit.  This is called at the start of each call
+# to ic_fit to update the fitting parameters if necessary.
+
+procedure ic_dosetupd (ic, cv, x, wts, npts, newx, newwts, newfunction, refit)
+
+pointer	ic				# ICFIT pointer
+pointer	cv				# Curfit pointer
+double	x[npts]				# Ordinates of data
+double	wts[npts]			# Weights
+int	npts				# Number of points in data
+int	newx				# New x points?
+int	newwts				# New weights?
+int	newfunction			# New function?
+int	refit				# Use cvrefit?
+
+int	ord
+double	xmin, xmax
+
+pointer	rg_xrangesd()
+#extern	hd_power$t()
+errchk	rg_xrangesd
+
+begin
+	# Set sample points.
+	if ((newx == YES) || (newwts == YES)) {
+	    if (npts == 0)
+		call error (0, "No data points for fit")
+
+	    call mfree (IC_XFIT(ic), TY_DOUBLE)
+	    call mfree (IC_YFIT(ic), TY_DOUBLE)
+	    call malloc (IC_XFIT(ic), npts, TY_DOUBLE)
+
+	    call mfree (IC_WTSFIT(ic), TY_DOUBLE)
+	    call malloc (IC_WTSFIT(ic), npts, TY_DOUBLE)
+
+	    call mfree (IC_REJPTS(ic), TY_INT)
+	    call malloc (IC_REJPTS(ic), npts, TY_INT)
+	    call amovki (NO, Memi[IC_REJPTS(ic)], npts)
+	    IC_NREJECT(ic) = 0
+
+	    # Set sample points.
+
+	    call rg_free (IC_RG(ic))
+	    IC_RG(ic) = rg_xrangesd (Memc[IC_SAMPLE(ic)], x, npts)
+	    call rg_order (IC_RG(ic))
+	    call rg_merge (IC_RG(ic))
+	    call rg_wtbind (IC_RG(ic), max (1, abs (IC_NAVERAGE(ic))), x, wts,
+		npts, Memd[IC_XFIT(ic)], Memd[IC_WTSFIT(ic)], IC_NFIT(ic))
+
+	    if (IC_NFIT(ic) == 0)
+		call error (0, "No sample points for fit")
+
+	    if (IC_NFIT(ic) == npts) {
+	        call rg_free (IC_RG(ic))
+	        call mfree (IC_XFIT(ic), TY_DOUBLE)
+	        call mfree (IC_WTSFIT(ic), TY_DOUBLE)
+	        IC_YFIT(ic) = NULL
+		IC_WTSFIT(ic) = NULL
+		call alimd (x, npts, xmin, xmax)
+	    } else {
+	        call malloc (IC_YFIT(ic), IC_NFIT(ic), TY_DOUBLE)
+		if (IC_NFIT(ic) == 1)
+		    call alimd (x, npts, xmin, xmax)
+		else
+		    call alimd (Memd[IC_XFIT(ic)], IC_NFIT(ic), xmin, xmax)
+	    }
+
+	    IC_XMIN(ic) = min (IC_XMIN(ic), real(xmin))
+	    IC_XMAX(ic) = max (IC_XMAX(ic), real(xmax))
+	    refit = NO
+	}
+
+	# Set curve fitting parameters.
+	# For polynomials define fitting range over range of data in fit
+	# and assume extrpolation is ok.  For spline functions define
+	# fitting range to be range of evaluation set by the caller
+	# since extrapolation will not make sense.
+
+	if ((newx == YES) || (newfunction == YES)) {
+	    if (cv != NULL)
+	        call dcvfree (cv)
+
+	    switch (IC_FUNCTION(ic)) {
+	    case LEGENDRE, CHEBYSHEV:
+		ord = min (IC_ORDER(ic), IC_NFIT(ic))
+	        call dcvinit (cv, IC_FUNCTION(ic), ord, double (xmin),
+		    double (xmax))
+	    case SPLINE1:
+		ord = min (IC_ORDER(ic), IC_NFIT(ic) - 1)
+		if (ord > 0)
+	            call dcvinit (cv, SPLINE1, ord, double (IC_XMIN(ic)),
+			double (IC_XMAX(ic)))
+		else
+	            call dcvinit (cv, LEGENDRE, IC_NFIT(ic),
+			double (IC_XMIN(ic)), double (IC_XMAX(ic)))
+	    case SPLINE3:
+		ord = min (IC_ORDER(ic), IC_NFIT(ic) - 3)
+		if (ord > 0)
+	            call dcvinit (cv, SPLINE3, ord, double (IC_XMIN(ic)),
+			double (IC_XMAX(ic)))
+		else
+	            call dcvinit (cv, LEGENDRE, IC_NFIT(ic),
+			double (IC_XMIN(ic)), double (IC_XMAX(ic)))
+#	    case USERFNC:
+#		ord = min (IC_ORDER(ic), IC_NFIT(ic))
+#		call $tcvinit (cv, USERFNC, ord, PIXEL (IC_XMIN(ic)),
+#		    PIXEL (IC_XMAX(ic)))
+#		call $tcvuserfnc (cv, hd_power$t)
+	    default:
+		call error (0, "Unknown fitting function")
+	    }
+
+	    refit = NO
+	}
+end
diff --git a/pkg/xtools/icfit/icdosetupr.x b/pkg/xtools/icfit/icdosetupr.x
new file mode 100644
index 00000000..2039560d
--- /dev/null
+++ b/pkg/xtools/icfit/icdosetupr.x
@@ -0,0 +1,121 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_DOSETUP -- Setup the fit.  This is called at the start of each call
+# to ic_fit to update the fitting parameters if necessary.
+
+procedure ic_dosetupr (ic, cv, x, wts, npts, newx, newwts, newfunction, refit)
+
+pointer	ic				# ICFIT pointer
+pointer	cv				# Curfit pointer
+real	x[npts]				# Ordinates of data
+real	wts[npts]			# Weights
+int	npts				# Number of points in data
+int	newx				# New x points?
+int	newwts				# New weights?
+int	newfunction			# New function?
+int	refit				# Use cvrefit?
+
+int	ord
+real	xmin, xmax
+
+pointer	rg_xrangesr()
+#extern	hd_power$t()
+errchk	rg_xrangesr
+
+begin
+	# Set sample points.
+	if ((newx == YES) || (newwts == YES)) {
+	    if (npts == 0)
+		call error (0, "No data points for fit")
+
+	    call mfree (IC_XFIT(ic), TY_REAL)
+	    call mfree (IC_YFIT(ic), TY_REAL)
+	    call malloc (IC_XFIT(ic), npts, TY_REAL)
+
+	    call mfree (IC_WTSFIT(ic), TY_REAL)
+	    call malloc (IC_WTSFIT(ic), npts, TY_REAL)
+
+	    call mfree (IC_REJPTS(ic), TY_INT)
+	    call malloc (IC_REJPTS(ic), npts, TY_INT)
+	    call amovki (NO, Memi[IC_REJPTS(ic)], npts)
+	    IC_NREJECT(ic) = 0
+
+	    # Set sample points.
+
+	    call rg_free (IC_RG(ic))
+	    IC_RG(ic) = rg_xrangesr (Memc[IC_SAMPLE(ic)], x, npts)
+	    call rg_order (IC_RG(ic))
+	    call rg_merge (IC_RG(ic))
+	    call rg_wtbinr (IC_RG(ic), max (1, abs (IC_NAVERAGE(ic))), x, wts,
+		npts, Memr[IC_XFIT(ic)], Memr[IC_WTSFIT(ic)], IC_NFIT(ic))
+
+	    if (IC_NFIT(ic) == 0)
+		call error (0, "No sample points for fit")
+
+	    if (IC_NFIT(ic) == npts) {
+	        call rg_free (IC_RG(ic))
+	        call mfree (IC_XFIT(ic), TY_REAL)
+	        call mfree (IC_WTSFIT(ic), TY_REAL)
+	        IC_YFIT(ic) = NULL
+		IC_WTSFIT(ic) = NULL
+		call alimr (x, npts, xmin, xmax)
+	    } else {
+	        call malloc (IC_YFIT(ic), IC_NFIT(ic), TY_REAL)
+		if (IC_NFIT(ic) == 1)
+		    call alimr (x, npts, xmin, xmax)
+		else
+		    call alimr (Memr[IC_XFIT(ic)], IC_NFIT(ic), xmin, xmax)
+	    }
+
+	    IC_XMIN(ic) = min (IC_XMIN(ic), real(xmin))
+	    IC_XMAX(ic) = max (IC_XMAX(ic), real(xmax))
+	    refit = NO
+	}
+
+	# Set curve fitting parameters.
+	# For polynomials define fitting range over range of data in fit
+	# and assume extrpolation is ok.  For spline functions define
+	# fitting range to be range of evaluation set by the caller
+	# since extrapolation will not make sense.
+
+	if ((newx == YES) || (newfunction == YES)) {
+	    if (cv != NULL)
+	        call rcvfree (cv)
+
+	    switch (IC_FUNCTION(ic)) {
+	    case LEGENDRE, CHEBYSHEV:
+		ord = min (IC_ORDER(ic), IC_NFIT(ic))
+	        call rcvinit (cv, IC_FUNCTION(ic), ord, real (xmin),
+		    real (xmax))
+	    case SPLINE1:
+		ord = min (IC_ORDER(ic), IC_NFIT(ic) - 1)
+		if (ord > 0)
+	            call rcvinit (cv, SPLINE1, ord, real (IC_XMIN(ic)),
+			real (IC_XMAX(ic)))
+		else
+	            call rcvinit (cv, LEGENDRE, IC_NFIT(ic),
+			real (IC_XMIN(ic)), real (IC_XMAX(ic)))
+	    case SPLINE3:
+		ord = min (IC_ORDER(ic), IC_NFIT(ic) - 3)
+		if (ord > 0)
+	            call rcvinit (cv, SPLINE3, ord, real (IC_XMIN(ic)),
+			real (IC_XMAX(ic)))
+		else
+	            call rcvinit (cv, LEGENDRE, IC_NFIT(ic),
+			real (IC_XMIN(ic)), real (IC_XMAX(ic)))
+#	    case USERFNC:
+#		ord = min (IC_ORDER(ic), IC_NFIT(ic))
+#		call $tcvinit (cv, USERFNC, ord, PIXEL (IC_XMIN(ic)),
+#		    PIXEL (IC_XMAX(ic)))
+#		call $tcvuserfnc (cv, hd_power$t)
+	    default:
+		call error (0, "Unknown fitting function")
+	    }
+
+	    refit = NO
+	}
+end
diff --git a/pkg/xtools/icfit/icerrors.gx b/pkg/xtools/icfit/icerrors.gx
new file mode 100644
index 00000000..114349e3
--- /dev/null
+++ b/pkg/xtools/icfit/icerrors.gx
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"names.h"
+
+# IC_ERRORS -- Compute and error diagnositic information.
+
+procedure ic_errors$t (ic, file, cv, x, y, wts, npts)
+
+pointer	ic		# ICFIT pointer
+char	file[ARB]	# Output file
+pointer	cv		# Curfit pointer
+PIXEL	x[ARB]		# Ordinates
+PIXEL	y[ARB]		# Abscissas
+PIXEL	wts[ARB]	# Weights
+int	npts		# Number of data points
+
+int	fd, open()
+errchk	open, ic_ferrors$t
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	call ic_ferrors$t (ic, cv, x, y, wts, npts, fd)
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/icerrorsd.x b/pkg/xtools/icfit/icerrorsd.x
new file mode 100644
index 00000000..763c7c4d
--- /dev/null
+++ b/pkg/xtools/icfit/icerrorsd.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"names.h"
+
+# IC_ERRORS -- Compute and error diagnositic information.
+
+procedure ic_errorsd (ic, file, cv, x, y, wts, npts)
+
+pointer	ic		# ICFIT pointer
+char	file[ARB]	# Output file
+pointer	cv		# Curfit pointer
+double	x[ARB]		# Ordinates
+double	y[ARB]		# Abscissas
+double	wts[ARB]	# Weights
+int	npts		# Number of data points
+
+int	fd, open()
+errchk	open, ic_ferrorsd
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	call ic_ferrorsd (ic, cv, x, y, wts, npts, fd)
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/icerrorsr.x b/pkg/xtools/icfit/icerrorsr.x
new file mode 100644
index 00000000..def6f603
--- /dev/null
+++ b/pkg/xtools/icfit/icerrorsr.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"names.h"
+
+# IC_ERRORS -- Compute and error diagnositic information.
+
+procedure ic_errorsr (ic, file, cv, x, y, wts, npts)
+
+pointer	ic		# ICFIT pointer
+char	file[ARB]	# Output file
+pointer	cv		# Curfit pointer
+real	x[ARB]		# Ordinates
+real	y[ARB]		# Abscissas
+real	wts[ARB]	# Weights
+int	npts		# Number of data points
+
+int	fd, open()
+errchk	open, ic_ferrorsr
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	call ic_ferrorsr (ic, cv, x, y, wts, npts, fd)
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/icferrors.gx b/pkg/xtools/icfit/icferrors.gx
new file mode 100644
index 00000000..4c7ef109
--- /dev/null
+++ b/pkg/xtools/icfit/icferrors.gx
@@ -0,0 +1,141 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_FERRORS -- Compute error diagnositic information.
+
+procedure ic_ferrors$t (ic, cv, x, y, wts, npts, fd)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+PIXEL	x[ARB]		# Ordinates
+PIXEL	y[ARB]		# Abscissas
+PIXEL	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	fd		# Output file descriptor
+
+int	i, n, deleted, ncoeffs
+PIXEL	chisqr, rms
+pointer	sp, fit, wts1, coeffs, errors
+
+int	$tcvstati()
+PIXEL	ic_rms$t()
+
+begin
+	# Determine the number of coefficients and allocate memory.
+
+	ncoeffs = $tcvstati (cv, CVNCOEFF)
+	call smark (sp)
+	call salloc (coeffs, ncoeffs, TY_PIXEL)
+	call salloc (errors, ncoeffs, TY_PIXEL)
+
+	if (npts == IC_NFIT(ic)) {
+	    # Allocate memory for the fit.
+
+	    n = npts
+	    call salloc (fit, n, TY_PIXEL)
+	    call salloc (wts1, n, TY_PIXEL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amov$t (wts, Mem$t[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+		do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Mem$t[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call $tcvvector (cv, x, Mem$t[fit], n)
+	    call $tcvcoeff (cv, Mem$t[coeffs], ncoeffs)
+	    call $tcverrors (cv, y, Mem$t[wts1], Mem$t[fit], n, chisqr,
+		Mem$t[errors])
+	    rms = ic_rms$t (x, y, Mem$t[fit], Mem$t[wts1], n)
+	} else {
+	    # Allocate memory for the fit.
+
+	    n = IC_NFIT(ic)
+	    call salloc (fit, n, TY_PIXEL)
+	    call salloc (wts1, n, TY_PIXEL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amov$t (Mem$t[IC_WTSFIT(ic)], Mem$t[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Mem$t[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call $tcvvector (cv, Mem$t[IC_XFIT(ic)], Mem$t[fit], n)
+	    rms = ic_rms$t (Mem$t[IC_XFIT(ic)], Mem$t[IC_YFIT(ic)],
+		Mem$t[fit], Mem$t[wts1], n)
+	    call $tcvcoeff (cv, Mem$t[coeffs], ncoeffs)
+	    call $tcverrors (cv, Mem$t[IC_YFIT(ic)], Mem$t[wts1], Mem$t[fit],
+		n, chisqr, Mem$t[errors])
+	}
+
+	# Print the error analysis.
+
+	call fprintf (fd, "# total points = %d\nsample points = %d\n")
+	    call pargi (npts)
+	    call pargi (n)
+	call fprintf (fd, "# nrejected = %d\ndeleted = %d\n")
+	    call pargi (IC_NREJECT(ic))
+	    call pargi (deleted)
+	call fprintf (fd, "# RMS = %7.4g\n")
+	    call parg$t (rms)
+	call fprintf (fd, "# square root of reduced chi square = %7.4g\n")
+	    call parg$t (sqrt (chisqr))
+
+	# Free allocated memory.
+
+	call sfree (sp)
+end
+
+# IC_RMS -- Compute RMS of points which have not been deleted.
+
+PIXEL procedure ic_rms$t (x, y, fit, wts, npts)
+
+PIXEL	x[ARB]		# Ordinates
+PIXEL	y[ARB]		# Abscissas
+PIXEL	fit[ARB]	# Fit
+PIXEL	wts[ARB]	# Weights
+int	npts		# Number of data points
+
+int	i, n
+PIXEL	resid, rms
+
+begin
+	rms = 0.
+	n = 0
+	do i = 1, npts {
+	    if (wts[i] == 0.)
+		next
+	    resid = y[i] - fit[i]
+	    rms = rms + resid * resid
+	    n = n + 1
+	}
+
+	if (n > 0)
+	    rms = sqrt (rms / n)
+
+	return (rms)
+end
diff --git a/pkg/xtools/icfit/icferrorsd.x b/pkg/xtools/icfit/icferrorsd.x
new file mode 100644
index 00000000..03a5523c
--- /dev/null
+++ b/pkg/xtools/icfit/icferrorsd.x
@@ -0,0 +1,141 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_FERRORS -- Compute error diagnositic information.
+
+procedure ic_ferrorsd (ic, cv, x, y, wts, npts, fd)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+double	x[ARB]		# Ordinates
+double	y[ARB]		# Abscissas
+double	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	fd		# Output file descriptor
+
+int	i, n, deleted, ncoeffs
+double	chisqr, rms
+pointer	sp, fit, wts1, coeffs, errors
+
+int	dcvstati()
+double	ic_rmsd()
+
+begin
+	# Determine the number of coefficients and allocate memory.
+
+	ncoeffs = dcvstati (cv, CVNCOEFF)
+	call smark (sp)
+	call salloc (coeffs, ncoeffs, TY_DOUBLE)
+	call salloc (errors, ncoeffs, TY_DOUBLE)
+
+	if (npts == IC_NFIT(ic)) {
+	    # Allocate memory for the fit.
+
+	    n = npts
+	    call salloc (fit, n, TY_DOUBLE)
+	    call salloc (wts1, n, TY_DOUBLE)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovd (wts, Memd[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+		do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memd[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call dcvvector (cv, x, Memd[fit], n)
+	    call dcvcoeff (cv, Memd[coeffs], ncoeffs)
+	    call dcverrors (cv, y, Memd[wts1], Memd[fit], n, chisqr,
+		Memd[errors])
+	    rms = ic_rmsd (x, y, Memd[fit], Memd[wts1], n)
+	} else {
+	    # Allocate memory for the fit.
+
+	    n = IC_NFIT(ic)
+	    call salloc (fit, n, TY_DOUBLE)
+	    call salloc (wts1, n, TY_DOUBLE)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovd (Memd[IC_WTSFIT(ic)], Memd[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memd[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call dcvvector (cv, Memd[IC_XFIT(ic)], Memd[fit], n)
+	    rms = ic_rmsd (Memd[IC_XFIT(ic)], Memd[IC_YFIT(ic)],
+		Memd[fit], Memd[wts1], n)
+	    call dcvcoeff (cv, Memd[coeffs], ncoeffs)
+	    call dcverrors (cv, Memd[IC_YFIT(ic)], Memd[wts1], Memd[fit],
+		n, chisqr, Memd[errors])
+	}
+
+	# Print the error analysis.
+
+	call fprintf (fd, "# total points = %d\nsample points = %d\n")
+	    call pargi (npts)
+	    call pargi (n)
+	call fprintf (fd, "# nrejected = %d\ndeleted = %d\n")
+	    call pargi (IC_NREJECT(ic))
+	    call pargi (deleted)
+	call fprintf (fd, "# RMS = %7.4g\n")
+	    call pargd (rms)
+	call fprintf (fd, "# square root of reduced chi square = %7.4g\n")
+	    call pargd (sqrt (chisqr))
+
+	# Free allocated memory.
+
+	call sfree (sp)
+end
+
+# IC_RMS -- Compute RMS of points which have not been deleted.
+
+double procedure ic_rmsd (x, y, fit, wts, npts)
+
+double	x[ARB]		# Ordinates
+double	y[ARB]		# Abscissas
+double	fit[ARB]	# Fit
+double	wts[ARB]	# Weights
+int	npts		# Number of data points
+
+int	i, n
+double	resid, rms
+
+begin
+	rms = 0.
+	n = 0
+	do i = 1, npts {
+	    if (wts[i] == 0.)
+		next
+	    resid = y[i] - fit[i]
+	    rms = rms + resid * resid
+	    n = n + 1
+	}
+
+	if (n > 0)
+	    rms = sqrt (rms / n)
+
+	return (rms)
+end
diff --git a/pkg/xtools/icfit/icferrorsr.x b/pkg/xtools/icfit/icferrorsr.x
new file mode 100644
index 00000000..61cf0d52
--- /dev/null
+++ b/pkg/xtools/icfit/icferrorsr.x
@@ -0,0 +1,141 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_FERRORS -- Compute error diagnositic information.
+
+procedure ic_ferrorsr (ic, cv, x, y, wts, npts, fd)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+real	x[ARB]		# Ordinates
+real	y[ARB]		# Abscissas
+real	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	fd		# Output file descriptor
+
+int	i, n, deleted, ncoeffs
+real	chisqr, rms
+pointer	sp, fit, wts1, coeffs, errors
+
+int	rcvstati()
+real	ic_rmsr()
+
+begin
+	# Determine the number of coefficients and allocate memory.
+
+	ncoeffs = rcvstati (cv, CVNCOEFF)
+	call smark (sp)
+	call salloc (coeffs, ncoeffs, TY_REAL)
+	call salloc (errors, ncoeffs, TY_REAL)
+
+	if (npts == IC_NFIT(ic)) {
+	    # Allocate memory for the fit.
+
+	    n = npts
+	    call salloc (fit, n, TY_REAL)
+	    call salloc (wts1, n, TY_REAL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovr (wts, Memr[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+		do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memr[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call rcvvector (cv, x, Memr[fit], n)
+	    call rcvcoeff (cv, Memr[coeffs], ncoeffs)
+	    call rcverrors (cv, y, Memr[wts1], Memr[fit], n, chisqr,
+		Memr[errors])
+	    rms = ic_rmsr (x, y, Memr[fit], Memr[wts1], n)
+	} else {
+	    # Allocate memory for the fit.
+
+	    n = IC_NFIT(ic)
+	    call salloc (fit, n, TY_REAL)
+	    call salloc (wts1, n, TY_REAL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovr (Memr[IC_WTSFIT(ic)], Memr[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memr[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call rcvvector (cv, Memr[IC_XFIT(ic)], Memr[fit], n)
+	    rms = ic_rmsr (Memr[IC_XFIT(ic)], Memr[IC_YFIT(ic)],
+		Memr[fit], Memr[wts1], n)
+	    call rcvcoeff (cv, Memr[coeffs], ncoeffs)
+	    call rcverrors (cv, Memr[IC_YFIT(ic)], Memr[wts1], Memr[fit],
+		n, chisqr, Memr[errors])
+	}
+
+	# Print the error analysis.
+
+	call fprintf (fd, "# total points = %d\nsample points = %d\n")
+	    call pargi (npts)
+	    call pargi (n)
+	call fprintf (fd, "# nrejected = %d\ndeleted = %d\n")
+	    call pargi (IC_NREJECT(ic))
+	    call pargi (deleted)
+	call fprintf (fd, "# RMS = %7.4g\n")
+	    call pargr (rms)
+	call fprintf (fd, "# square root of reduced chi square = %7.4g\n")
+	    call pargr (sqrt (chisqr))
+
+	# Free allocated memory.
+
+	call sfree (sp)
+end
+
+# IC_RMS -- Compute RMS of points which have not been deleted.
+
+real procedure ic_rmsr (x, y, fit, wts, npts)
+
+real	x[ARB]		# Ordinates
+real	y[ARB]		# Abscissas
+real	fit[ARB]	# Fit
+real	wts[ARB]	# Weights
+int	npts		# Number of data points
+
+int	i, n
+real	resid, rms
+
+begin
+	rms = 0.
+	n = 0
+	do i = 1, npts {
+	    if (wts[i] == 0.)
+		next
+	    resid = y[i] - fit[i]
+	    rms = rms + resid * resid
+	    n = n + 1
+	}
+
+	if (n > 0)
+	    rms = sqrt (rms / n)
+
+	return (rms)
+end
diff --git a/pkg/xtools/icfit/icfit.gx b/pkg/xtools/icfit/icfit.gx
new file mode 100644
index 00000000..2c301360
--- /dev/null
+++ b/pkg/xtools/icfit/icfit.gx
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+
+include	<error.h>
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_FIT -- Fit a function.  This is the main fitting task.  It uses
+# flags to define changes since the last fit.  This allows the most
+# efficient use of the curfit and ranges packages.
+
+procedure ic_fit$t (ic, cv, x, y, wts, npts, newx, newy, newwts, newfunction)
+
+pointer	ic				# ICFIT pointer
+pointer	cv				# Curfit pointer
+PIXEL	x[npts]				# Ordinates
+PIXEL	y[npts]				# Data to be fit
+PIXEL	wts[npts]			# Weights
+int	npts				# Number of points
+int	newx				# New x points?
+int	newy				# New y points?
+int	newwts				# New weights?
+int	newfunction			# New function?
+
+int	ier, refit
+
+errchk	ic_dosetup$t, $tcvfit, $tcvrefit, rg_wtbin$t, ic_reject$t
+
+begin
+	IC_FITERROR(ic) = NO
+
+	iferr {
+	    # Setup the new parameters.
+
+	    call ic_dosetup$t (ic, cv, x, wts, npts, newx, newwts, newfunction,
+		refit)
+
+	    # If not sampling use the data array directly.
+
+	    if (npts == IC_NFIT(ic)) {
+		if (refit == NO) {
+		    call $tcvfit (cv, x, y, wts, npts, WTS_USER, ier)
+		} else if (newy == YES)
+		    call $tcvrefit (cv, x, y, wts, ier)
+
+	    # If sampling first form the sample y values.
+
+	    } else {
+		if ((newx == YES) || (newy == YES) || (newwts == YES))
+		    call rg_wtbin$t (IC_RG(ic), IC_NAVERAGE(ic), y, wts, npts,
+			Mem$t[IC_YFIT(ic)], Mem$t[IC_WTSFIT(ic)], IC_NFIT(ic))
+		if (refit == NO) {
+		    call $tcvfit (cv, Mem$t[IC_XFIT(ic)], Mem$t[IC_YFIT(ic)],
+			Mem$t[IC_WTSFIT(ic)], IC_NFIT(ic), WTS_USER, ier)
+		} else if (newy == YES)
+		    call $tcvrefit (cv, Mem$t[IC_XFIT(ic)], Mem$t[IC_YFIT(ic)],
+			Mem$t[IC_WTSFIT(ic)], ier)
+	    }
+
+	    # Check for an error in the fit.
+
+	    switch (ier) {
+	    case SINGULAR:
+		call printf ("Singular solution\n")
+		call flush (STDOUT)
+	    case NO_DEG_FREEDOM:
+		call printf ("No degrees of freedom\n")
+		call flush (STDOUT)
+		IC_FITERROR(ic) = YES
+	    }
+
+	    if (IC_FITERROR(ic) == NO) {
+		refit = YES
+
+		# Do pixel rejection if desired.
+
+		if ((IC_LOW(ic) > 0.) || (IC_HIGH(ic) > 0.)) {
+		    if (npts == IC_NFIT(ic))
+			call ic_reject$t (cv, x, y, wts, Memi[IC_REJPTS(ic)],
+			    IC_NFIT(ic), IC_LOW(ic), IC_HIGH(ic),
+			    IC_NITERATE(ic), IC_GROW(ic), IC_NREJECT(ic))
+		    else
+			call ic_reject$t (cv, Mem$t[IC_XFIT(ic)],
+			    Mem$t[IC_YFIT(ic)], Mem$t[IC_WTSFIT(ic)],
+			    Memi[IC_REJPTS(ic)], IC_NFIT(ic), IC_LOW(ic),
+			    IC_HIGH(ic), IC_NITERATE(ic), IC_GROW(ic),
+			    IC_NREJECT(ic))
+
+		    if (IC_NREJECT(ic) > 0)
+			refit = NO
+		} else
+		    IC_NREJECT(ic) = 0
+	    }
+	} then {
+	    IC_FITERROR(ic) = YES
+	    call erract (EA_ERROR)
+	}
+end
diff --git a/pkg/xtools/icfit/icfit.h b/pkg/xtools/icfit/icfit.h
new file mode 100644
index 00000000..3ea9023c
--- /dev/null
+++ b/pkg/xtools/icfit/icfit.h
@@ -0,0 +1,50 @@
+# The ICFIT data structure
+
+define	IC_NGKEYS	5		# Number of graph keys
+define	IC_LENSTRUCT	44		# Length of ICFIT structure
+define	IC_SZSAMPLE	1024		# Size of sample string
+
+# User fitting parameters
+define	IC_FUNCTION	Memi[$1]	# Function type
+define	IC_ORDER	Memi[$1+1]	# Order of function
+define	IC_SAMPLE	Memi[$1+2]	# Pointer to sample string
+define	IC_NAVERAGE	Memi[$1+3]	# Sampling averaging bin
+define	IC_NITERATE	Memi[$1+4]	# Number of rejection interation
+define	IC_XMIN		Memr[P2R($1+5)]	# Minimum value for curve
+define	IC_XMAX		Memr[P2R($1+6)]	# Maximum value for curve
+define	IC_LOW		Memr[P2R($1+7)]	# Low rejection value
+define	IC_HIGH		Memr[P2R($1+8)]	# Low rejection value
+define	IC_GROW		Memr[P2R($1+9)]	# Rejection growing radius
+
+# ICFIT parameters used for fitting
+define	IC_NFIT		Memi[$1+10]	# Number of fit points
+define	IC_NREJECT	Memi[$1+11]	# Number of rejected points
+define	IC_RG		Memi[$1+12]	# Pointer for ranges
+define	IC_XFIT		Memi[$1+13]	# Pointer to ordinates of fit points
+define	IC_YFIT		Memi[$1+14]	# Pointer to abscissas of fit points
+define	IC_WTSFIT	Memi[$1+15]	# Pointer to weights of fit points
+define	IC_REJPTS	Memi[$1+16]	# Pointer to rejected points
+
+# ICFIT parameters used for interactive graphics
+define	IC_NEWX		Memi[$1+17]	# New x fit points?
+define	IC_NEWY		Memi[$1+18]	# New y points?
+define	IC_NEWWTS	Memi[$1+19]	# New weights?
+define	IC_NEWFUNCTION	Memi[$1+20]	# New fitting function?
+define	IC_COLOR	Memi[$1+21]	# Fit color
+define	IC_OVERPLOT	Memi[$1+22]	# Overplot next plot?
+define	IC_FITERROR	Memi[$1+23]	# Error in fit
+define	IC_MARKREJ	Memi[$1+24]	# Mark rejected points?
+define	IC_LABELS	Memi[$1+25+$2-1]# Graph axis labels
+define	IC_UNITS	Memi[$1+27+$2-1]# Graph axis units
+define	IC_HELP		Memi[$1+29]	# Pointer to help file name
+define	IC_GP		Memi[$1+30]	# GIO pointer
+define	IC_GT		Memi[$1+31]	# GTOOLS pointer
+
+# ICFIT key definitions
+define	IC_GKEY		Memi[$1+32]			# Graph key
+define	IC_AXES		Memi[$1+33+($2-1)*2+$3-1]	# Graph axis codes
+
+# Default help file and prompt
+define	IC_DEFHELP	"noao$lib/scr/icgfit.key"
+define	IC_DEFHTML	"noao$lib/scr/icgfit.html"
+define	IC_PROMPT	"icfit cursor options"
diff --git a/pkg/xtools/icfit/icfit.hlp b/pkg/xtools/icfit/icfit.hlp
new file mode 100644
index 00000000..3461c9ff
--- /dev/null
+++ b/pkg/xtools/icfit/icfit.hlp
@@ -0,0 +1,229 @@
+.help icfit Sep91 xtools.icfit
+.ih
+NAME
+icfit -- Interactive curve fitting
+.ih
+SYNOPSIS
+A number of application tasks use the interactive curve fitting tools based
+on the \fBcurfit\fR package for fitting curves to data.  Interactive graphical
+curve fitting begins by graphing the data points and the current fit in one of
+five formats.  When the cursor appears the user may modify the graphs and the
+fit in a number of ways with cursor mode keystrokes and colon commands.
+These are described below.
+.ih
+CURSOR MODE
+.ls ?
+The terminal is cleared and a menu of cursor keys and colon commands is printed.
+.le
+.ls a
+Add points to contrain the fit.  When adding points a query is made to set
+the weights.  A large weight will force the fit to go near the added point.
+The added points are  internal to the fitting routine and are not returned
+or otherwise available to the particular task using the ICFIT capability.
+.le
+.ls c
+The coordinates of the data point nearest the cursor and the fitted value
+are printed on the status line.
+.le
+.ls d
+The data point nearest the cursor and not previously deleted is marked with an
+X.  It will not be used in futher fits unless it is undeleted.
+.le
+.ls f
+A curve is fit to the data and the fit is graphed in the current format.
+.le
+.ls g
+Redefine the graph keys "h-l" from their defaults.  A prompt is given for the
+graph key which is to be redefined and then for the graph desired.
+A '?' to either prompt prints help information.  A graph
+is given by a pair of comma separated data types.  The first data type defines
+the horizontal axis and the second defines the vertical axis.  Any of the
+data types may be graphed along either axis.  The data types are
+.nf
+    x  Independent variable		y  Dependent variable
+    f  Fitted value			r  Residual (y - f)
+    d  Ratio (y / f)			n  Nonlinear part of y
+.fi
+.le
+.ls h, i, j, k, l
+Each key produces a different graph.  The graphs are described by the data
+which is graphed along each axis as defined above.  The default graph keys
+(which may be redefined with the 'g' key) are h=(x,y), i=(y,x), j=(x,r),
+k=(x,d), l=(x,n).
+.le
+.ls o
+Overplot the next fit provided the graph format is not changed.
+.le
+.ls q
+Exit from the interactive curve fitting.  Two consecutive carriage returns
+(cursor end-of-file) may also be used.
+.le
+.ls r
+Redraw the current graph.
+.le
+.ls s
+Select a sample range.  Set the cursor at one end point of the sample before
+typing 's' and then set the cursor to the other endpoint and type any key
+in response to the prompt "again:".  Sample ranges are intersected unless
+the sample ranges have been initialized to all the points with the key 't'.
+.le
+.ls t
+Initialize the sample to include all data points.
+.le
+.ls u
+Undelete the data point nearest the cursor which was previously deleted.
+.le
+.ls v
+Change the fitting weight of the point nearest the cursor.
+.le
+.ls w
+Set the graph window (range along each axis to be graphed).  This is a
+\fBgtools\fR option which prints the prompt "window:".  The set of cursor
+keys is printed with '?' and help is available under the keyword \fBgtools\fR.
+.le
+.ls x
+Change the x value of the point nearest the cursor.
+.le
+.ls y
+Change the y value of the point nearest the cursor.
+.le
+.ls z
+Delete the nearest sample region to the cursor.
+.le
+.ih
+COLON COMMANDS
+Colon commands are show or set the values of parameters.  The parameter names
+may be abbreviated as may the function type.
+
+.ls :show [file]
+Show the current values of all the fitting parameters.  The default output
+is the terminal (STDOUT) and the screen is cleared before the information
+is output.  If a file is specified then the information is appended to the
+named file.
+.le
+.ls :vshow [file]
+A verbose version of "show" which includes the fitted coefficients and their
+errors.
+.le
+.ls :evaluate <value>
+Evaluate the fit at the specified value and print the result on the status
+line.
+.le
+.ls :xyshow [file]
+List the independent (X), dependent (y), fitted (Y fit), and weight values.
+The output may be listed on the screen or to a file.  Note that if the
+original input is combined into composit points (\fInaverage\fR not 1)
+then the values are for the composite points.  Deleted points will have
+a weight of zero.
+.le
+.ls :errors [file]
+Show the fitted function and square root of the chi square of the fit.
+The default output
+is the terminal (STDOUT) and the screen is cleared before the information
+is output.  If a file is specified then the information is appended to the
+named file.
+.le
+.ls :function [value]
+Show the current value or set the function type.  The functions types are
+"chebyshev", "legendre", "spline1", or "spline3" for chebyshev or legendre
+polynomial or linear or cubic spline.
+.le
+.ls :grow [value]
+Show the current value or set the rejection growing radius.  Any points within
+this distance of rejected points are also rejected.
+.le
+.ls :color [value=0-9]
+Color of fit where 0=background (invisible), 1=foreground, and higher
+numbers depend on the graphics device.  Note that this applies to the
+fit and to change the color of the data use ":/color".
+.le
+.ls :markrej [value]
+Mark rejected points?  If there are many rejected points then it might be
+desired not to mark the points.
+.le
+.ls :naverage [value]
+Show the current value or set the number of points to average or median to form
+fitting points.  A positive value select an mean and negative values select
+a median.  The averaged points are also shown in the graphs.
+.le
+.ls :order [value]
+Show the current value or set the order of the function.  For legendre or
+chebyshev polynomials the order is the number of terms (i.e. an order of 2
+has two terms and is a linear function).  For the splines the order is the
+number of spline pieces.
+.le
+.ls :low_reject [value], :high_reject [value]
+Show the current values or set the rejection limits.  When a fit is made
+if the rejection threshold is greater than zero then the sigma of the
+residuals about the fit is computed.  Points with residuals more than
+this number of times the sigma are removed from the final fit.  These
+points are marked on the graphs with diamonds.
+.le
+.ls :niterate [value]
+Show the current value or set a new value for the number of rejection
+iterations.
+.le
+.ls :sample [value]
+Show the current value or set the sample points to use in the fits.  This
+parameter is a string consisting of single points, colon separated ranges,
+or "*" to indicate all points.  A file containing sample strings may also
+be specified by prefixing the file name with the character '@'.
+Note that sample ranges may also be set with the cursor mode key 's'.
+.le
+.ih
+DESCRIPTION
+A one dimensional function is fit to a set of x and y data points.
+The function may be a legendre polynomial, chebyshev polynomial,
+linear spline, or cubic spline of a given order or number of spline pieces.
+
+The points fit are determined by selecting a sample of data specified by
+the parameter \fIsample\fR and taking either the average or median of
+the number of points specified by the parameter \fInaverage\fR.
+The type of averaging is selected by the sign of the parameter and the number
+of points is selected by the absolute value of the parameter.
+
+If \fIniterate\fR is greater than zero the sigma
+of the residuals between the fitted points and the fitted function is computed
+and those points whose residuals are less than \fI-low_reject\fR * sigma
+or \fIhigh_reject\fR * sigma value are excluded from the fit.  Points within
+a distance of \fIgrow\fR pixels of a rejected pixel are also excluded from
+the fit.  The function is then refit without the rejected points.
+The rejection can be iterated the number of times specified by the parameter
+\fIniterate\fR.  Note a rejection value of zero is the same as no rejection.
+The rejected points may be marked with diamonds.  The marking of rejected
+points is controlled by the :markrej command.
+
+There are five types or formats of graphs selected by the keys 'h', 'i', 'j',
+'k', and 'l'.  The graphs are defined by what is plotted on each axis of the
+graph.  There are six data types, any of which may be plotted on either axis.
+These data types are the independent data points (x), the dependent data
+points (y), the fitted values (f), the residuals (r=y-f), the
+ratio of the data to the fit (d=y/f), and the data with the linear term
+of the fit (determined by the endpoints of the fit) subtracted.  The
+default graph keys are shown in the cursor key section though the definitions
+may be modified by the application.  The user may also redefine the graph
+keys using the 'g' key.  This gives a choice of 36 different graph types.
+
+It is important to remember that changing the value of a fitting
+parameter does not change the fit until 'f' is typed.
+.ih
+NOTES
+The sample region is stored internally as a string of length 1024 characters.
+This is greatly increased over versions prior to V2.10.  However, due
+to the fixed default size of string parameters in parameter files (160
+characters), initial sample regions input with a CL parameter are limited
+to this smaller length string.  The limitation may be escaped by using
+the new capability of specifying a file containing ranges.  Also sample
+regions initialize by a task parameter may be extended interactively.
+.ih
+REVISIONS
+.ls ICFIT V2.11
+The :xyshow output was modified to 1) not include colon labels,
+2) print (X, Y, Y fit, Weight) instead of (X, Y fit, Y), and 3)
+the printed values are those actually used in the fit when using
+composite points (naverage not 1).
+.le
+.ih
+SEE ALSO
+gtools
+.endhelp
diff --git a/pkg/xtools/icfit/icfitd.x b/pkg/xtools/icfit/icfitd.x
new file mode 100644
index 00000000..88a0e66f
--- /dev/null
+++ b/pkg/xtools/icfit/icfitd.x
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+
+include	<error.h>
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_FIT -- Fit a function.  This is the main fitting task.  It uses
+# flags to define changes since the last fit.  This allows the most
+# efficient use of the curfit and ranges packages.
+
+procedure ic_fitd (ic, cv, x, y, wts, npts, newx, newy, newwts, newfunction)
+
+pointer	ic				# ICFIT pointer
+pointer	cv				# Curfit pointer
+double	x[npts]				# Ordinates
+double	y[npts]				# Data to be fit
+double	wts[npts]			# Weights
+int	npts				# Number of points
+int	newx				# New x points?
+int	newy				# New y points?
+int	newwts				# New weights?
+int	newfunction			# New function?
+
+int	ier, refit
+
+errchk	ic_dosetupd, dcvfit, dcvrefit, rg_wtbind, ic_rejectd
+
+begin
+	IC_FITERROR(ic) = NO
+
+	iferr {
+	    # Setup the new parameters.
+
+	    call ic_dosetupd (ic, cv, x, wts, npts, newx, newwts, newfunction,
+		refit)
+
+	    # If not sampling use the data array directly.
+
+	    if (npts == IC_NFIT(ic)) {
+		if (refit == NO) {
+		    call dcvfit (cv, x, y, wts, npts, WTS_USER, ier)
+		} else if (newy == YES)
+		    call dcvrefit (cv, x, y, wts, ier)
+
+	    # If sampling first form the sample y values.
+
+	    } else {
+		if ((newx == YES) || (newy == YES) || (newwts == YES))
+		    call rg_wtbind (IC_RG(ic), IC_NAVERAGE(ic), y, wts, npts,
+			Memd[IC_YFIT(ic)], Memd[IC_WTSFIT(ic)], IC_NFIT(ic))
+		if (refit == NO) {
+		    call dcvfit (cv, Memd[IC_XFIT(ic)], Memd[IC_YFIT(ic)],
+			Memd[IC_WTSFIT(ic)], IC_NFIT(ic), WTS_USER, ier)
+		} else if (newy == YES)
+		    call dcvrefit (cv, Memd[IC_XFIT(ic)], Memd[IC_YFIT(ic)],
+			Memd[IC_WTSFIT(ic)], ier)
+	    }
+
+	    # Check for an error in the fit.
+
+	    switch (ier) {
+	    case SINGULAR:
+		call printf ("Singular solution\n")
+		call flush (STDOUT)
+	    case NO_DEG_FREEDOM:
+		call printf ("No degrees of freedom\n")
+		call flush (STDOUT)
+		IC_FITERROR(ic) = YES
+	    }
+
+	    if (IC_FITERROR(ic) == NO) {
+		refit = YES
+
+		# Do pixel rejection if desired.
+
+		if ((IC_LOW(ic) > 0.) || (IC_HIGH(ic) > 0.)) {
+		    if (npts == IC_NFIT(ic))
+			call ic_rejectd (cv, x, y, wts, Memi[IC_REJPTS(ic)],
+			    IC_NFIT(ic), IC_LOW(ic), IC_HIGH(ic),
+			    IC_NITERATE(ic), IC_GROW(ic), IC_NREJECT(ic))
+		    else
+			call ic_rejectd (cv, Memd[IC_XFIT(ic)],
+			    Memd[IC_YFIT(ic)], Memd[IC_WTSFIT(ic)],
+			    Memi[IC_REJPTS(ic)], IC_NFIT(ic), IC_LOW(ic),
+			    IC_HIGH(ic), IC_NITERATE(ic), IC_GROW(ic),
+			    IC_NREJECT(ic))
+
+		    if (IC_NREJECT(ic) > 0)
+			refit = NO
+		} else
+		    IC_NREJECT(ic) = 0
+	    }
+	} then {
+	    IC_FITERROR(ic) = YES
+	    call erract (EA_ERROR)
+	}
+end
diff --git a/pkg/xtools/icfit/icfitr.x b/pkg/xtools/icfit/icfitr.x
new file mode 100644
index 00000000..96344ffd
--- /dev/null
+++ b/pkg/xtools/icfit/icfitr.x
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+
+include	<error.h>
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_FIT -- Fit a function.  This is the main fitting task.  It uses
+# flags to define changes since the last fit.  This allows the most
+# efficient use of the curfit and ranges packages.
+
+procedure ic_fitr (ic, cv, x, y, wts, npts, newx, newy, newwts, newfunction)
+
+pointer	ic				# ICFIT pointer
+pointer	cv				# Curfit pointer
+real	x[npts]				# Ordinates
+real	y[npts]				# Data to be fit
+real	wts[npts]			# Weights
+int	npts				# Number of points
+int	newx				# New x points?
+int	newy				# New y points?
+int	newwts				# New weights?
+int	newfunction			# New function?
+
+int	ier, refit
+
+errchk	ic_dosetupr, rcvfit, rcvrefit, rg_wtbinr, ic_rejectr
+
+begin
+	IC_FITERROR(ic) = NO
+
+	iferr {
+	    # Setup the new parameters.
+
+	    call ic_dosetupr (ic, cv, x, wts, npts, newx, newwts, newfunction,
+		refit)
+
+	    # If not sampling use the data array directly.
+
+	    if (npts == IC_NFIT(ic)) {
+		if (refit == NO) {
+		    call rcvfit (cv, x, y, wts, npts, WTS_USER, ier)
+		} else if (newy == YES)
+		    call rcvrefit (cv, x, y, wts, ier)
+
+	    # If sampling first form the sample y values.
+
+	    } else {
+		if ((newx == YES) || (newy == YES) || (newwts == YES))
+		    call rg_wtbinr (IC_RG(ic), IC_NAVERAGE(ic), y, wts, npts,
+			Memr[IC_YFIT(ic)], Memr[IC_WTSFIT(ic)], IC_NFIT(ic))
+		if (refit == NO) {
+		    call rcvfit (cv, Memr[IC_XFIT(ic)], Memr[IC_YFIT(ic)],
+			Memr[IC_WTSFIT(ic)], IC_NFIT(ic), WTS_USER, ier)
+		} else if (newy == YES)
+		    call rcvrefit (cv, Memr[IC_XFIT(ic)], Memr[IC_YFIT(ic)],
+			Memr[IC_WTSFIT(ic)], ier)
+	    }
+
+	    # Check for an error in the fit.
+
+	    switch (ier) {
+	    case SINGULAR:
+		call printf ("Singular solution\n")
+		call flush (STDOUT)
+	    case NO_DEG_FREEDOM:
+		call printf ("No degrees of freedom\n")
+		call flush (STDOUT)
+		IC_FITERROR(ic) = YES
+	    }
+
+	    if (IC_FITERROR(ic) == NO) {
+		refit = YES
+
+		# Do pixel rejection if desired.
+
+		if ((IC_LOW(ic) > 0.) || (IC_HIGH(ic) > 0.)) {
+		    if (npts == IC_NFIT(ic))
+			call ic_rejectr (cv, x, y, wts, Memi[IC_REJPTS(ic)],
+			    IC_NFIT(ic), IC_LOW(ic), IC_HIGH(ic),
+			    IC_NITERATE(ic), IC_GROW(ic), IC_NREJECT(ic))
+		    else
+			call ic_rejectr (cv, Memr[IC_XFIT(ic)],
+			    Memr[IC_YFIT(ic)], Memr[IC_WTSFIT(ic)],
+			    Memi[IC_REJPTS(ic)], IC_NFIT(ic), IC_LOW(ic),
+			    IC_HIGH(ic), IC_NITERATE(ic), IC_GROW(ic),
+			    IC_NREJECT(ic))
+
+		    if (IC_NREJECT(ic) > 0)
+			refit = NO
+		} else
+		    IC_NREJECT(ic) = 0
+	    }
+	} then {
+	    IC_FITERROR(ic) = YES
+	    call erract (EA_ERROR)
+	}
+end
diff --git a/pkg/xtools/icfit/icfshow.x b/pkg/xtools/icfit/icfshow.x
new file mode 100644
index 00000000..ced7bdaf
--- /dev/null
+++ b/pkg/xtools/icfit/icfshow.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+# IC_FSHOW -- Show the values of the parameters.
+
+procedure ic_fshow (ic, fd)
+
+pointer	ic			# ICFIT pointer
+int	fd			# Output file
+
+pointer	str, ptr
+long	clktime()
+
+begin
+	call malloc (str, SZ_LINE, TY_CHAR)
+
+	call cnvtime (clktime(0), Memc[str], SZ_LINE)
+	call fprintf (fd, "\n# %s\n")
+	    call pargstr (Memc[str])
+
+	if (IC_GT(ic) != NULL) {
+	    # The title may contain new lines so we have to put comments
+	    # in front of each line.
+	    call gt_gets (IC_GT(ic), GTTITLE, Memc[str], SZ_LINE)
+	    call putline (fd, "# ")
+	    for (ptr=str; Memc[ptr]!=EOS; ptr=ptr+1) {
+		call putc (fd, Memc[ptr])
+		if (Memc[ptr] == '\n') {
+		    call putline (fd, "# ")
+		}
+	    }
+	    call putline (fd, "\n")
+
+	    call gt_gets (IC_GT(ic), GTYUNITS, Memc[str], SZ_LINE)
+	    if (Memc[str] != EOS) {
+		call fprintf (fd, "# fit units = %s\n")
+		    call pargstr (Memc[str])
+	    }
+	}
+
+	call ic_gstr (ic, "function", Memc[str], SZ_LINE)
+	call fprintf (fd, "# function = %s\n")
+	    call pargstr (Memc[str])
+	call fprintf (fd, "# grow = %g\n")
+	    call pargr (IC_GROW(ic))
+	call fprintf (fd, "# naverage = %d\n")
+	    call pargi (IC_NAVERAGE(ic))
+	call fprintf (fd, "# order = %d\n")
+	    call pargi (IC_ORDER(ic))
+	call fprintf (fd, "# low_reject = %g\n")
+	    call pargr (IC_LOW(ic))
+	call fprintf (fd, "# high_reject = %g\n")
+	    call pargr (IC_HIGH(ic))
+	call fprintf (fd, "# niterate = %d\n")
+	    call pargi (IC_NITERATE(ic))
+	call fprintf (fd, "# sample = %s\n")
+	    call pargstr (Memc[IC_SAMPLE(ic)])
+
+	call mfree (str, TY_CHAR)
+end
diff --git a/pkg/xtools/icfit/icfvshow.gx b/pkg/xtools/icfit/icfvshow.gx
new file mode 100644
index 00000000..458c0664
--- /dev/null
+++ b/pkg/xtools/icfit/icfvshow.gx
@@ -0,0 +1,164 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_FVSHOW -- Show fit parameters in verbose mode.
+
+procedure ic_fvshow$t (ic, cv, x, y, wts, npts, fd)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+PIXEL	x[ARB]		# Ordinates
+PIXEL	y[ARB]		# Abscissas
+PIXEL	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	fd		# Output descriptor
+
+int	i, n, deleted, ncoeffs
+PIXEL	chisqr, rms
+pointer	sp, fit, wts1, coeffs, errors
+
+int	$tcvstati()
+PIXEL	ic_rms$t()
+
+begin
+	# Do the standard ic_show option, then add on the verbose part.
+	call ic_fshow (ic, fd)
+
+	if (npts == 0) {
+	    call eprintf ("# Incomplete output - no data points for fit\n")
+	    return
+	}
+
+	# Determine the number of coefficients and allocate memory.
+
+	ncoeffs = $tcvstati (cv, CVNCOEFF)
+	call smark (sp)
+	call salloc (coeffs, ncoeffs, TY_PIXEL)
+	call salloc (errors, ncoeffs, TY_PIXEL)
+
+	if (npts == IC_NFIT(ic)) {
+	    # Allocate memory for the fit.
+
+	    n = npts
+	    call salloc (fit, n, TY_PIXEL)
+	    call salloc (wts1, n, TY_PIXEL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amov$t (wts, Mem$t[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+		do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Mem$t[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call $tcvvector (cv, x, Mem$t[fit], n)
+	    call $tcvcoeff (cv, Mem$t[coeffs], ncoeffs)
+	    call $tcverrors (cv, y, Mem$t[wts1], Mem$t[fit], n, chisqr,
+		Mem$t[errors])
+	    rms = ic_rms$t (x, y, Mem$t[fit], Mem$t[wts1], n)
+	} else {
+	    # Allocate memory for the fit.
+
+	    n = IC_NFIT(ic)
+	    call salloc (fit, n, TY_PIXEL)
+	    call salloc (wts1, n, TY_PIXEL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amov$t (Mem$t[IC_WTSFIT(ic)], Mem$t[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Mem$t[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call $tcvvector (cv, Mem$t[IC_XFIT(ic)], Mem$t[fit], n)
+	    rms = ic_rms$t (Mem$t[IC_XFIT(ic)], Mem$t[IC_YFIT(ic)],
+		Mem$t[fit], Mem$t[wts1], n)
+	    call $tcvcoeff (cv, Mem$t[coeffs], ncoeffs)
+	    call $tcverrors (cv, Mem$t[IC_YFIT(ic)], Mem$t[wts1], Mem$t[fit],
+		n, chisqr, Mem$t[errors])
+	}
+
+	# Print the error analysis.
+
+	call fprintf (fd, "# total points = %d\n# sample points = %d\n")
+	    call pargi (npts)
+	    call pargi (n)
+	call fprintf (fd, "# nrejected = %d\n# deleted = %d\n")
+	    call pargi (IC_NREJECT(ic))
+	    call pargi (deleted)
+	call fprintf (fd, "# RMS = %10.7g\n")
+	    call parg$t (rms)
+	call fprintf (fd, "# square root of reduced chi square = %10.7g\n")
+	    call parg$t (sqrt (chisqr))
+
+	call fprintf (fd, "# \t  coefficent\t  error\n")
+	do i = 1, ncoeffs {
+	    call fprintf (fd, "# \t%14.7e\t%14.7e\n")
+		call parg$t (Mem$t[coeffs+i-1])
+	 	call parg$t (Mem$t[errors+i-1])
+	}
+
+	# Free allocated memory.
+
+	call sfree (sp)
+end
+
+
+# IC_FXYSHOW -- List data as x, y, fit, weight lines on output.
+
+procedure ic_fxyshow$t (ic, cv, x, y, w, npts, fd)
+
+pointer	ic			# ICFIT pointer
+pointer	cv			# Pointer to curfit structure
+PIXEL	x[npts]			# Array of x data values
+PIXEL	y[npts]			# Array of y data values
+PIXEL	w[npts]			# Array of weight data values
+int	npts			# Number of data values
+int	fd			# Output file descriptor
+
+int	i
+PIXEL	$tcveval()
+
+begin
+	# List the data being fit (not necessarily the input data).
+	call fprintf (fd, "#      X        Y    Y FIT   WEIGHT\n")
+	if (npts == IC_NFIT(ic)) {
+	    do i = 1, npts {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call parg$t (x[i])
+		    call parg$t (y[i])
+		    call parg$t ($tcveval (cv, x[i]))
+		    call parg$t (w[i])
+	    }
+	} else {
+	    do i = 1, IC_NFIT(ic) {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call parg$t (Mem$t[IC_XFIT(ic)+i-1])
+		    call parg$t (Mem$t[IC_YFIT(ic)+i-1])
+		    call parg$t ($tcveval (cv, Mem$t[IC_XFIT(ic)+i-1]))
+		    call parg$t (Mem$t[IC_WTSFIT(ic)+i-1])
+	    }
+	}
+end
diff --git a/pkg/xtools/icfit/icfvshowd.x b/pkg/xtools/icfit/icfvshowd.x
new file mode 100644
index 00000000..a26e0530
--- /dev/null
+++ b/pkg/xtools/icfit/icfvshowd.x
@@ -0,0 +1,164 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_FVSHOW -- Show fit parameters in verbose mode.
+
+procedure ic_fvshowd (ic, cv, x, y, wts, npts, fd)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+double	x[ARB]		# Ordinates
+double	y[ARB]		# Abscissas
+double	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	fd		# Output descriptor
+
+int	i, n, deleted, ncoeffs
+double	chisqr, rms
+pointer	sp, fit, wts1, coeffs, errors
+
+int	dcvstati()
+double	ic_rmsd()
+
+begin
+	# Do the standard ic_show option, then add on the verbose part.
+	call ic_fshow (ic, fd)
+
+	if (npts == 0) {
+	    call eprintf ("# Incomplete output - no data points for fit\n")
+	    return
+	}
+
+	# Determine the number of coefficients and allocate memory.
+
+	ncoeffs = dcvstati (cv, CVNCOEFF)
+	call smark (sp)
+	call salloc (coeffs, ncoeffs, TY_DOUBLE)
+	call salloc (errors, ncoeffs, TY_DOUBLE)
+
+	if (npts == IC_NFIT(ic)) {
+	    # Allocate memory for the fit.
+
+	    n = npts
+	    call salloc (fit, n, TY_DOUBLE)
+	    call salloc (wts1, n, TY_DOUBLE)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovd (wts, Memd[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+		do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memd[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call dcvvector (cv, x, Memd[fit], n)
+	    call dcvcoeff (cv, Memd[coeffs], ncoeffs)
+	    call dcverrors (cv, y, Memd[wts1], Memd[fit], n, chisqr,
+		Memd[errors])
+	    rms = ic_rmsd (x, y, Memd[fit], Memd[wts1], n)
+	} else {
+	    # Allocate memory for the fit.
+
+	    n = IC_NFIT(ic)
+	    call salloc (fit, n, TY_DOUBLE)
+	    call salloc (wts1, n, TY_DOUBLE)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovd (Memd[IC_WTSFIT(ic)], Memd[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memd[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call dcvvector (cv, Memd[IC_XFIT(ic)], Memd[fit], n)
+	    rms = ic_rmsd (Memd[IC_XFIT(ic)], Memd[IC_YFIT(ic)],
+		Memd[fit], Memd[wts1], n)
+	    call dcvcoeff (cv, Memd[coeffs], ncoeffs)
+	    call dcverrors (cv, Memd[IC_YFIT(ic)], Memd[wts1], Memd[fit],
+		n, chisqr, Memd[errors])
+	}
+
+	# Print the error analysis.
+
+	call fprintf (fd, "# total points = %d\n# sample points = %d\n")
+	    call pargi (npts)
+	    call pargi (n)
+	call fprintf (fd, "# nrejected = %d\n# deleted = %d\n")
+	    call pargi (IC_NREJECT(ic))
+	    call pargi (deleted)
+	call fprintf (fd, "# RMS = %10.7g\n")
+	    call pargd (rms)
+	call fprintf (fd, "# square root of reduced chi square = %10.7g\n")
+	    call pargd (sqrt (chisqr))
+
+	call fprintf (fd, "# \t  coefficent\t  error\n")
+	do i = 1, ncoeffs {
+	    call fprintf (fd, "# \t%14.7e\t%14.7e\n")
+		call pargd (Memd[coeffs+i-1])
+	 	call pargd (Memd[errors+i-1])
+	}
+
+	# Free allocated memory.
+
+	call sfree (sp)
+end
+
+
+# IC_FXYSHOW -- List data as x, y, fit, weight lines on output.
+
+procedure ic_fxyshowd (ic, cv, x, y, w, npts, fd)
+
+pointer	ic			# ICFIT pointer
+pointer	cv			# Pointer to curfit structure
+double	x[npts]			# Array of x data values
+double	y[npts]			# Array of y data values
+double	w[npts]			# Array of weight data values
+int	npts			# Number of data values
+int	fd			# Output file descriptor
+
+int	i
+double	dcveval()
+
+begin
+	# List the data being fit (not necessarily the input data).
+	call fprintf (fd, "#      X        Y    Y FIT   WEIGHT\n")
+	if (npts == IC_NFIT(ic)) {
+	    do i = 1, npts {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call pargd (x[i])
+		    call pargd (y[i])
+		    call pargd (dcveval (cv, x[i]))
+		    call pargd (w[i])
+	    }
+	} else {
+	    do i = 1, IC_NFIT(ic) {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call pargd (Memd[IC_XFIT(ic)+i-1])
+		    call pargd (Memd[IC_YFIT(ic)+i-1])
+		    call pargd (dcveval (cv, Memd[IC_XFIT(ic)+i-1]))
+		    call pargd (Memd[IC_WTSFIT(ic)+i-1])
+	    }
+	}
+end
diff --git a/pkg/xtools/icfit/icfvshowr.x b/pkg/xtools/icfit/icfvshowr.x
new file mode 100644
index 00000000..2d50020f
--- /dev/null
+++ b/pkg/xtools/icfit/icfvshowr.x
@@ -0,0 +1,164 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"icfit.h"
+include	"names.h"
+
+# IC_FVSHOW -- Show fit parameters in verbose mode.
+
+procedure ic_fvshowr (ic, cv, x, y, wts, npts, fd)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+real	x[ARB]		# Ordinates
+real	y[ARB]		# Abscissas
+real	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	fd		# Output descriptor
+
+int	i, n, deleted, ncoeffs
+real	chisqr, rms
+pointer	sp, fit, wts1, coeffs, errors
+
+int	rcvstati()
+real	ic_rmsr()
+
+begin
+	# Do the standard ic_show option, then add on the verbose part.
+	call ic_fshow (ic, fd)
+
+	if (npts == 0) {
+	    call eprintf ("# Incomplete output - no data points for fit\n")
+	    return
+	}
+
+	# Determine the number of coefficients and allocate memory.
+
+	ncoeffs = rcvstati (cv, CVNCOEFF)
+	call smark (sp)
+	call salloc (coeffs, ncoeffs, TY_REAL)
+	call salloc (errors, ncoeffs, TY_REAL)
+
+	if (npts == IC_NFIT(ic)) {
+	    # Allocate memory for the fit.
+
+	    n = npts
+	    call salloc (fit, n, TY_REAL)
+	    call salloc (wts1, n, TY_REAL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovr (wts, Memr[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+		do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memr[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call rcvvector (cv, x, Memr[fit], n)
+	    call rcvcoeff (cv, Memr[coeffs], ncoeffs)
+	    call rcverrors (cv, y, Memr[wts1], Memr[fit], n, chisqr,
+		Memr[errors])
+	    rms = ic_rmsr (x, y, Memr[fit], Memr[wts1], n)
+	} else {
+	    # Allocate memory for the fit.
+
+	    n = IC_NFIT(ic)
+	    call salloc (fit, n, TY_REAL)
+	    call salloc (wts1, n, TY_REAL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovr (Memr[IC_WTSFIT(ic)], Memr[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memr[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Get the coefficients and compute the errors.
+
+	    call rcvvector (cv, Memr[IC_XFIT(ic)], Memr[fit], n)
+	    rms = ic_rmsr (Memr[IC_XFIT(ic)], Memr[IC_YFIT(ic)],
+		Memr[fit], Memr[wts1], n)
+	    call rcvcoeff (cv, Memr[coeffs], ncoeffs)
+	    call rcverrors (cv, Memr[IC_YFIT(ic)], Memr[wts1], Memr[fit],
+		n, chisqr, Memr[errors])
+	}
+
+	# Print the error analysis.
+
+	call fprintf (fd, "# total points = %d\n# sample points = %d\n")
+	    call pargi (npts)
+	    call pargi (n)
+	call fprintf (fd, "# nrejected = %d\n# deleted = %d\n")
+	    call pargi (IC_NREJECT(ic))
+	    call pargi (deleted)
+	call fprintf (fd, "# RMS = %10.7g\n")
+	    call pargr (rms)
+	call fprintf (fd, "# square root of reduced chi square = %10.7g\n")
+	    call pargr (sqrt (chisqr))
+
+	call fprintf (fd, "# \t  coefficent\t  error\n")
+	do i = 1, ncoeffs {
+	    call fprintf (fd, "# \t%14.7e\t%14.7e\n")
+		call pargr (Memr[coeffs+i-1])
+	 	call pargr (Memr[errors+i-1])
+	}
+
+	# Free allocated memory.
+
+	call sfree (sp)
+end
+
+
+# IC_FXYSHOW -- List data as x, y, fit, weight lines on output.
+
+procedure ic_fxyshowr (ic, cv, x, y, w, npts, fd)
+
+pointer	ic			# ICFIT pointer
+pointer	cv			# Pointer to curfit structure
+real	x[npts]			# Array of x data values
+real	y[npts]			# Array of y data values
+real	w[npts]			# Array of weight data values
+int	npts			# Number of data values
+int	fd			# Output file descriptor
+
+int	i
+real	rcveval()
+
+begin
+	# List the data being fit (not necessarily the input data).
+	call fprintf (fd, "#      X        Y    Y FIT   WEIGHT\n")
+	if (npts == IC_NFIT(ic)) {
+	    do i = 1, npts {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call pargr (x[i])
+		    call pargr (y[i])
+		    call pargr (rcveval (cv, x[i]))
+		    call pargr (w[i])
+	    }
+	} else {
+	    do i = 1, IC_NFIT(ic) {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call pargr (Memr[IC_XFIT(ic)+i-1])
+		    call pargr (Memr[IC_YFIT(ic)+i-1])
+		    call pargr (rcveval (cv, Memr[IC_XFIT(ic)+i-1]))
+		    call pargr (Memr[IC_WTSFIT(ic)+i-1])
+	    }
+	}
+end
diff --git a/pkg/xtools/icfit/icgadd.gx b/pkg/xtools/icfit/icgadd.gx
new file mode 100644
index 00000000..aa0b45d5
--- /dev/null
+++ b/pkg/xtools/icfit/icgadd.gx
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+define	MSIZE		2.		# Mark size
+
+# ICG_ADD -- Add a point.
+
+procedure icg_add$t (gp, wx, wy, wt, x, y, w1, w2, npts)
+
+pointer	gp				# GIO pointer
+real	wx				# X point to insert	
+real	wy				# Y point to insert	
+real	wt				# Weight of point to add
+PIXEL	x[npts]				# Independent variable
+PIXEL	y[npts]				# Dependent variable
+PIXEL	w1[npts]			# Current weights
+PIXEL	w2[npts]			# Initial weights
+int	npts				# Number of points
+
+int	i, j
+
+begin
+	# Find the place to insert the new point.
+	if (x[1] < x[npts])
+	    for (i = npts; (i > 0) && (wx < x[i]); i = i - 1)
+		;
+	else
+	    for (i = npts; (i > 0) && (wx > x[i]); i = i - 1)
+		;
+
+	# Shift the data to insert the new point.
+	for (j = npts; j > i; j = j - 1) {
+	    x[j+1] = x[j]
+	    y[j+1] = y[j]
+	    w1[j+1] = w1[j]
+	    w2[j+1] = w2[j]
+	}
+
+	# Add the new point and increment the number of points.
+	i = i + 1
+	x[i] = wx
+	y[i] = wy
+	w1[i] = wt
+	w2[i] = wt
+	npts = npts + 1
+
+	# Mark the point
+	call gmark (gp, real (x[i]), real (y[i]), GM_PLUS, MSIZE, MSIZE)
+end
diff --git a/pkg/xtools/icfit/icgaddd.x b/pkg/xtools/icfit/icgaddd.x
new file mode 100644
index 00000000..b32c6b5a
--- /dev/null
+++ b/pkg/xtools/icfit/icgaddd.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+define	MSIZE		2.		# Mark size
+
+# ICG_ADD -- Add a point.
+
+procedure icg_addd (gp, wx, wy, wt, x, y, w1, w2, npts)
+
+pointer	gp				# GIO pointer
+real	wx				# X point to insert	
+real	wy				# Y point to insert	
+real	wt				# Weight of point to add
+double	x[npts]				# Independent variable
+double	y[npts]				# Dependent variable
+double	w1[npts]			# Current weights
+double	w2[npts]			# Initial weights
+int	npts				# Number of points
+
+int	i, j
+
+begin
+	# Find the place to insert the new point.
+	if (x[1] < x[npts])
+	    for (i = npts; (i > 0) && (wx < x[i]); i = i - 1)
+		;
+	else
+	    for (i = npts; (i > 0) && (wx > x[i]); i = i - 1)
+		;
+
+	# Shift the data to insert the new point.
+	for (j = npts; j > i; j = j - 1) {
+	    x[j+1] = x[j]
+	    y[j+1] = y[j]
+	    w1[j+1] = w1[j]
+	    w2[j+1] = w2[j]
+	}
+
+	# Add the new point and increment the number of points.
+	i = i + 1
+	x[i] = wx
+	y[i] = wy
+	w1[i] = wt
+	w2[i] = wt
+	npts = npts + 1
+
+	# Mark the point
+	call gmark (gp, real (x[i]), real (y[i]), GM_PLUS, MSIZE, MSIZE)
+end
diff --git a/pkg/xtools/icfit/icgaddr.x b/pkg/xtools/icfit/icgaddr.x
new file mode 100644
index 00000000..4e09be1b
--- /dev/null
+++ b/pkg/xtools/icfit/icgaddr.x
@@ -0,0 +1,50 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+define	MSIZE		2.		# Mark size
+
+# ICG_ADD -- Add a point.
+
+procedure icg_addr (gp, wx, wy, wt, x, y, w1, w2, npts)
+
+pointer	gp				# GIO pointer
+real	wx				# X point to insert	
+real	wy				# Y point to insert	
+real	wt				# Weight of point to add
+real	x[npts]				# Independent variable
+real	y[npts]				# Dependent variable
+real	w1[npts]			# Current weights
+real	w2[npts]			# Initial weights
+int	npts				# Number of points
+
+int	i, j
+
+begin
+	# Find the place to insert the new point.
+	if (x[1] < x[npts])
+	    for (i = npts; (i > 0) && (wx < x[i]); i = i - 1)
+		;
+	else
+	    for (i = npts; (i > 0) && (wx > x[i]); i = i - 1)
+		;
+
+	# Shift the data to insert the new point.
+	for (j = npts; j > i; j = j - 1) {
+	    x[j+1] = x[j]
+	    y[j+1] = y[j]
+	    w1[j+1] = w1[j]
+	    w2[j+1] = w2[j]
+	}
+
+	# Add the new point and increment the number of points.
+	i = i + 1
+	x[i] = wx
+	y[i] = wy
+	w1[i] = wt
+	w2[i] = wt
+	npts = npts + 1
+
+	# Mark the point
+	call gmark (gp, real (x[i]), real (y[i]), GM_PLUS, MSIZE, MSIZE)
+end
diff --git a/pkg/xtools/icfit/icgaxes.gx b/pkg/xtools/icfit/icgaxes.gx
new file mode 100644
index 00000000..0e3f6a55
--- /dev/null
+++ b/pkg/xtools/icfit/icgaxes.gx
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/gtools.h>
+include	"icfit.h"
+include	"names.h"
+
+# ICG_AXES -- Set axes data.
+# The applications program may set additional axes types.
+
+procedure icg_axes$t (ic, gt, cv, axis, x, y, z, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	gt				# GTOOLS pointer
+pointer	cv				# CURFIT pointer
+int	axis				# Output axis
+PIXEL	x[npts]				# Independent variable
+PIXEL	y[npts]				# Dependent variable
+PIXEL	z[npts]				# Output values
+int	npts				# Number of points
+
+int	i, axistype, gtlabel[2], gtunits[2]
+PIXEL 	a, b, xmin, xmax
+pointer	label, units
+
+PIXEL	$tcveval(), icg_dvz$t()
+errchk	adiv$t()
+extern	icg_dvz$t()
+
+data	gtlabel/GTXLABEL, GTYLABEL/
+data	gtunits/GTXUNITS, GTYUNITS/
+
+begin
+	axistype = IC_AXES(ic, IC_GKEY(ic), axis)
+	switch (axistype) {
+	case 'x':	# Independent variable
+	    call gt_sets (gt, gtlabel[axis], Memc[IC_LABELS(ic,1)])
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,1)])
+	    call amov$t (x, z, npts)
+	case 'y':	# Dependent variable
+	    call gt_sets (gt, gtlabel[axis], Memc[IC_LABELS(ic,2)])
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    call amov$t (y, z, npts)
+	case 'f':	# Fitted values
+	    call gt_sets (gt, gtlabel[axis], "fit")
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    call $tcvvector (cv, x, z, npts)
+	case 'r':	# Residuals
+	    call gt_sets (gt, gtlabel[axis], "residuals")
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    call $tcvvector (cv, x, z, npts)
+	    call asub$t (y, z, z, npts)
+	case 'd':	# Ratio
+	    call gt_sets (gt, gtlabel[axis], "ratio")
+	    call gt_sets (gt, gtunits[axis], "")
+	    call $tcvvector (cv, x, z, npts)
+#	    iferr (call adiv$t (y, z, z, npts))
+		call advz$t (y, z, z, npts, icg_dvz$t)
+	case 'n':	# Linear component removed
+	    call gt_sets (gt, gtlabel[axis], "non-linear component")
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    xmin = IC_XMIN(ic)
+	    xmax = IC_XMAX(ic)
+	    a = $tcveval (cv, PIXEL (xmin))
+	    b = ($tcveval (cv, PIXEL (xmax)) - a) / (xmax - xmin)
+	    do i = 1, npts
+	        z[i] = y[i] - a - b * (x[i] - xmin)
+	case 'v':
+	    call gt_sets (gt, gtlabel[axis], "Velocity")
+	    call gt_sets (gt, gtunits[axis], "km/s")
+	    call $tcvvector (cv, x, z, npts)
+	    do i = 1, npts
+	        z[i] = (z[i] - y[i]) / y[i] * 300000.
+	default:	# User axes types.
+	    call malloc (label, SZ_LINE, TY_CHAR)
+	    call malloc (units, SZ_LINE, TY_CHAR)
+	    if (axis == 1) {
+		call strcpy (Memc[IC_LABELS(ic,1)], Memc[label], SZ_LINE)
+		call strcpy (Memc[IC_UNITS(ic,1)], Memc[units], SZ_LINE)
+	        call amov$t (x, z, npts)
+	    } else {
+		call strcpy (Memc[IC_LABELS(ic,2)], Memc[label], SZ_LINE)
+		call strcpy (Memc[IC_UNITS(ic,2)], Memc[units], SZ_LINE)
+	        call amov$t (y, z, npts)
+	    }
+	    call icg_uaxes$t (axistype, cv, x, y, z, npts, Memc[label],
+		Memc[units], SZ_LINE)
+	    call gt_sets (gt, gtlabel[axis], Memc[label])
+	    call gt_sets (gt, gtunits[axis], Memc[units])
+	    call mfree (label, TY_CHAR)
+	    call mfree (units, TY_CHAR)
+	}
+end
+
+
+# ICG_DVZ -- Error action to take on zero division.
+
+PIXEL procedure icg_dvz$t (x)
+
+PIXEL	x			# Numerator
+
+begin
+	return (1.)
+end
diff --git a/pkg/xtools/icfit/icgaxesd.x b/pkg/xtools/icfit/icgaxesd.x
new file mode 100644
index 00000000..9505c4c8
--- /dev/null
+++ b/pkg/xtools/icfit/icgaxesd.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/gtools.h>
+include	"icfit.h"
+include	"names.h"
+
+# ICG_AXES -- Set axes data.
+# The applications program may set additional axes types.
+
+procedure icg_axesd (ic, gt, cv, axis, x, y, z, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	gt				# GTOOLS pointer
+pointer	cv				# CURFIT pointer
+int	axis				# Output axis
+double	x[npts]				# Independent variable
+double	y[npts]				# Dependent variable
+double	z[npts]				# Output values
+int	npts				# Number of points
+
+int	i, axistype, gtlabel[2], gtunits[2]
+double 	a, b, xmin, xmax
+pointer	label, units
+
+double	dcveval(), icg_dvzd()
+errchk	adivd()
+extern	icg_dvzd()
+
+data	gtlabel/GTXLABEL, GTYLABEL/
+data	gtunits/GTXUNITS, GTYUNITS/
+
+begin
+	axistype = IC_AXES(ic, IC_GKEY(ic), axis)
+	switch (axistype) {
+	case 'x':	# Independent variable
+	    call gt_sets (gt, gtlabel[axis], Memc[IC_LABELS(ic,1)])
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,1)])
+	    call amovd (x, z, npts)
+	case 'y':	# Dependent variable
+	    call gt_sets (gt, gtlabel[axis], Memc[IC_LABELS(ic,2)])
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    call amovd (y, z, npts)
+	case 'f':	# Fitted values
+	    call gt_sets (gt, gtlabel[axis], "fit")
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    call dcvvector (cv, x, z, npts)
+	case 'r':	# Residuals
+	    call gt_sets (gt, gtlabel[axis], "residuals")
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    call dcvvector (cv, x, z, npts)
+	    call asubd (y, z, z, npts)
+	case 'd':	# Ratio
+	    call gt_sets (gt, gtlabel[axis], "ratio")
+	    call gt_sets (gt, gtunits[axis], "")
+	    call dcvvector (cv, x, z, npts)
+#	    iferr (call adiv$t (y, z, z, npts))
+		call advzd (y, z, z, npts, icg_dvzd)
+	case 'n':	# Linear component removed
+	    call gt_sets (gt, gtlabel[axis], "non-linear component")
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    xmin = IC_XMIN(ic)
+	    xmax = IC_XMAX(ic)
+	    a = dcveval (cv, double (xmin))
+	    b = (dcveval (cv, double (xmax)) - a) / (xmax - xmin)
+	    do i = 1, npts
+	        z[i] = y[i] - a - b * (x[i] - xmin)
+	case 'v':
+	    call gt_sets (gt, gtlabel[axis], "Velocity")
+	    call gt_sets (gt, gtunits[axis], "km/s")
+	    call dcvvector (cv, x, z, npts)
+	    do i = 1, npts
+	        z[i] = (z[i] - y[i]) / y[i] * 300000.
+	default:	# User axes types.
+	    call malloc (label, SZ_LINE, TY_CHAR)
+	    call malloc (units, SZ_LINE, TY_CHAR)
+	    if (axis == 1) {
+		call strcpy (Memc[IC_LABELS(ic,1)], Memc[label], SZ_LINE)
+		call strcpy (Memc[IC_UNITS(ic,1)], Memc[units], SZ_LINE)
+	        call amovd (x, z, npts)
+	    } else {
+		call strcpy (Memc[IC_LABELS(ic,2)], Memc[label], SZ_LINE)
+		call strcpy (Memc[IC_UNITS(ic,2)], Memc[units], SZ_LINE)
+	        call amovd (y, z, npts)
+	    }
+	    call icg_uaxesd (axistype, cv, x, y, z, npts, Memc[label],
+		Memc[units], SZ_LINE)
+	    call gt_sets (gt, gtlabel[axis], Memc[label])
+	    call gt_sets (gt, gtunits[axis], Memc[units])
+	    call mfree (label, TY_CHAR)
+	    call mfree (units, TY_CHAR)
+	}
+end
+
+
+# ICG_DVZ -- Error action to take on zero division.
+
+double procedure icg_dvzd (x)
+
+double	x			# Numerator
+
+begin
+	return (1.)
+end
diff --git a/pkg/xtools/icfit/icgaxesr.x b/pkg/xtools/icfit/icgaxesr.x
new file mode 100644
index 00000000..dcd4d686
--- /dev/null
+++ b/pkg/xtools/icfit/icgaxesr.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/gtools.h>
+include	"icfit.h"
+include	"names.h"
+
+# ICG_AXES -- Set axes data.
+# The applications program may set additional axes types.
+
+procedure icg_axesr (ic, gt, cv, axis, x, y, z, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	gt				# GTOOLS pointer
+pointer	cv				# CURFIT pointer
+int	axis				# Output axis
+real	x[npts]				# Independent variable
+real	y[npts]				# Dependent variable
+real	z[npts]				# Output values
+int	npts				# Number of points
+
+int	i, axistype, gtlabel[2], gtunits[2]
+real 	a, b, xmin, xmax
+pointer	label, units
+
+real	rcveval(), icg_dvzr()
+errchk	adivr()
+extern	icg_dvzr()
+
+data	gtlabel/GTXLABEL, GTYLABEL/
+data	gtunits/GTXUNITS, GTYUNITS/
+
+begin
+	axistype = IC_AXES(ic, IC_GKEY(ic), axis)
+	switch (axistype) {
+	case 'x':	# Independent variable
+	    call gt_sets (gt, gtlabel[axis], Memc[IC_LABELS(ic,1)])
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,1)])
+	    call amovr (x, z, npts)
+	case 'y':	# Dependent variable
+	    call gt_sets (gt, gtlabel[axis], Memc[IC_LABELS(ic,2)])
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    call amovr (y, z, npts)
+	case 'f':	# Fitted values
+	    call gt_sets (gt, gtlabel[axis], "fit")
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    call rcvvector (cv, x, z, npts)
+	case 'r':	# Residuals
+	    call gt_sets (gt, gtlabel[axis], "residuals")
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    call rcvvector (cv, x, z, npts)
+	    call asubr (y, z, z, npts)
+	case 'd':	# Ratio
+	    call gt_sets (gt, gtlabel[axis], "ratio")
+	    call gt_sets (gt, gtunits[axis], "")
+	    call rcvvector (cv, x, z, npts)
+#	    iferr (call adiv$t (y, z, z, npts))
+		call advzr (y, z, z, npts, icg_dvzr)
+	case 'n':	# Linear component removed
+	    call gt_sets (gt, gtlabel[axis], "non-linear component")
+	    call gt_sets (gt, gtunits[axis], Memc[IC_UNITS(ic,2)])
+	    xmin = IC_XMIN(ic)
+	    xmax = IC_XMAX(ic)
+	    a = rcveval (cv, real (xmin))
+	    b = (rcveval (cv, real (xmax)) - a) / (xmax - xmin)
+	    do i = 1, npts
+	        z[i] = y[i] - a - b * (x[i] - xmin)
+	case 'v':
+	    call gt_sets (gt, gtlabel[axis], "Velocity")
+	    call gt_sets (gt, gtunits[axis], "km/s")
+	    call rcvvector (cv, x, z, npts)
+	    do i = 1, npts
+	        z[i] = (z[i] - y[i]) / y[i] * 300000.
+	default:	# User axes types.
+	    call malloc (label, SZ_LINE, TY_CHAR)
+	    call malloc (units, SZ_LINE, TY_CHAR)
+	    if (axis == 1) {
+		call strcpy (Memc[IC_LABELS(ic,1)], Memc[label], SZ_LINE)
+		call strcpy (Memc[IC_UNITS(ic,1)], Memc[units], SZ_LINE)
+	        call amovr (x, z, npts)
+	    } else {
+		call strcpy (Memc[IC_LABELS(ic,2)], Memc[label], SZ_LINE)
+		call strcpy (Memc[IC_UNITS(ic,2)], Memc[units], SZ_LINE)
+	        call amovr (y, z, npts)
+	    }
+	    call icg_uaxesr (axistype, cv, x, y, z, npts, Memc[label],
+		Memc[units], SZ_LINE)
+	    call gt_sets (gt, gtlabel[axis], Memc[label])
+	    call gt_sets (gt, gtunits[axis], Memc[units])
+	    call mfree (label, TY_CHAR)
+	    call mfree (units, TY_CHAR)
+	}
+end
+
+
+# ICG_DVZ -- Error action to take on zero division.
+
+real procedure icg_dvzr (x)
+
+real	x			# Numerator
+
+begin
+	return (1.)
+end
diff --git a/pkg/xtools/icfit/icgcolon.gx b/pkg/xtools/icfit/icgcolon.gx
new file mode 100644
index 00000000..14329164
--- /dev/null
+++ b/pkg/xtools/icfit/icgcolon.gx
@@ -0,0 +1,218 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+include	"names.h"
+
+# List of colon commands.
+define	CMDS "|function|order|sample|naverage|niterate|low_reject|high_reject\
+	|grow|markrej|color|show|vshow|xyshow|errors|evaluate\
+	|graph|help|gui|"
+
+define	FUNCTION	1	# Set or show function type
+define	ORDER		2	# Set or show function order
+define	SAMPLE		3	# Set or show sample ranges
+define	NAVERAGE	4	# Set or show sample averaging or medianing
+define	NITERATE	5	# Set or show rejection iterations
+define	LOW_REJECT	6	# Set or show lower rejection factor
+define	HIGH_REJECT	7	# Set or show upper rejection factor
+define	GROW		8	# Set or show rejection growing radius
+define	MARKREJ		9	# Mark rejected points
+define	COLOR		10	# Fit color
+define	SHOW		11	# Show values of parameters
+define	VSHOW		12	# Show verbose information
+define	XYSHOW		13	# Show x-y-fit-wts values
+define	ERRORS		14	# Show errors of fit
+define	EVALUATE	15	# Evaluate fit at specified value
+define	GRAPH		16	# Define graph
+define	HELP		17	# Set help file
+define	GUI		18	# Send GUI command
+
+# ICG_COLON -- Processes colon commands.  The common flags and newgraph
+# signal changes in fitting parameters or the need to redraw the graph.
+
+procedure icg_colon$t (ic, cmdstr, newgraph, gp, gt, cv, x, y, wts, npts)
+
+pointer	ic				# ICFIT pointer
+char	cmdstr[ARB]			# Command string
+int	newgraph			# New graph?
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	cv				# CURFIT pointer for error listing
+PIXEL	x[npts], y[npts], wts[npts]	# Data arrays for error listing
+int	npts				# Number of data points
+
+PIXEL	val, $tcveval()
+char	key, xtype, ytype
+bool	bval
+int	ncmd, ival
+real	rval
+pointer	sp, cmd
+
+int	nscan(), strdic(), btoi()
+
+string	funcs "|chebyshev|legendre|spline1|spline3|power|"
+
+begin
+	# Check for GTOOLS command.
+	if (cmdstr[1] == '/') {
+	    call gt_colon (cmdstr, gp, gt, newgraph)
+	    return
+	}
+
+	# Use formated scan to parse the command string.
+	# The first word is the command and it may be minimum match
+	# abbreviated with the list of commands.
+
+	call smark (sp)
+	call salloc (cmd, IC_SZSAMPLE, TY_CHAR)
+
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], IC_SZSAMPLE)
+	ncmd = strdic (Memc[cmd], Memc[cmd], IC_SZSAMPLE, CMDS)
+
+	switch (ncmd) {
+	case FUNCTION: # :function - List or set the fitting function.
+	    call gargwrd (Memc[cmd], IC_SZSAMPLE)
+	    if (nscan() == 1) {
+		call printf ("function = %s\n")
+		    call ic_gstr (ic, "function", Memc[cmd], IC_SZSAMPLE)
+		    call pargstr (Memc[cmd])
+	    } else {
+		if (strdic (Memc[cmd], Memc[cmd], IC_SZSAMPLE, funcs) > 0) {
+		    call ic_pstr (ic, "function", Memc[cmd])
+		    IC_NEWFUNCTION(ic) = YES
+		} else
+		    call printf ("Unknown or ambiguous function\n")
+	    }
+
+	case ORDER: # :order - List or set the function order.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("order = %d\n")
+		    call pargi (IC_ORDER(ic))
+	    } else if (ival < 1) {
+		call printf ("Order must be greater than zero\n")
+	    } else {
+		call ic_puti (ic, "order", ival)
+		IC_NEWFUNCTION(ic) = YES
+	    }
+
+	case SAMPLE: # :sample - List or set the sample points.
+	    call gargstr (Memc[cmd], IC_SZSAMPLE)
+	    if (Memc[cmd] == EOS) {
+	        call printf ("sample = %s\n")
+		    call pargstr (Memc[IC_SAMPLE(ic)])
+	    } else {
+		call ic_pstr (ic, "sample", Memc[cmd])
+		IC_NEWX(ic) = YES
+	    }
+
+	case NAVERAGE: # :naverage - List or set the sample averging.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("naverage = %d\n")
+		    call pargi (IC_NAVERAGE(ic))
+	    } else {
+		call ic_puti (ic, "naverage", ival)
+		IC_NEWX(ic) = YES
+	    }
+
+	case NITERATE: # :niterate - List or set the rejection iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("niterate = %d\n")
+		    call pargi (IC_NITERATE(ic))
+	    } else
+		call ic_puti (ic, "niterate", ival)
+
+
+	case LOW_REJECT: # :low_reject - List or set lower rejection factor.
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("low_reject = %g\n")
+		    call pargr (IC_LOW(ic))
+	    } else
+		call ic_putr (ic, "low", rval)
+
+	case HIGH_REJECT: # :high_reject - List or set high rejection factor.
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("high_reject = %g\n")
+		    call pargr (IC_HIGH(ic))
+	    } else
+		call ic_putr (ic, "high", rval)
+
+	case GROW: # :grow - List or set the rejection growing.
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("grow = %g\n")
+		    call pargr (IC_GROW(ic))
+	    } else
+		call ic_putr (ic, "grow", rval)
+
+	case MARKREJ: # :markrej - Mark rejected points
+	    call gargb (bval)
+	    if (nscan() == 1) {
+		call printf ("markrej = %b\n")
+		    call pargi (IC_MARKREJ(ic))
+	    } else
+		call ic_puti (ic, "markrej", btoi (bval))
+
+	case COLOR: # :color - List or set the fit color.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("color = %d\n")
+		    call pargi (IC_COLOR(ic))
+	    } else
+		call ic_puti (ic, "color", ival)
+
+	case SHOW, VSHOW, XYSHOW, ERRORS:
+	    call ic_guishow$t (ic, cmdstr, cv, x, y, wts, npts)
+
+	case EVALUATE: # :evaluate x - evaluate fit at x.
+	    call garg$t (val)
+	    if (nscan() == 1)
+		call printf ("evaluate requires a value to evaluate\n")
+	    else {
+		call printf ("fit(%g) = %g\n")
+		    call parg$t (val)
+		    call parg$t ($tcveval (cv, val))
+	    }
+
+	case GRAPH: # :graph key xtype ytpe
+	    call gargc (key)
+	    call gargc (xtype)
+	    call gargc (ytype)
+	    if (nscan() != 4) {
+		ival = IC_GKEY(ic)
+		call printf ("graph %c %c %c\n")
+		    call pargi ('h'+ival-1)
+		    call pargi (IC_AXES(ic,ival,1))
+		    call pargi (IC_AXES(ic,ival,2))
+	    } else {
+		ival = key - 'h' + 1
+		IC_GKEY(ic) = ival
+		call ic_pkey (ic, ival, int(xtype), int(ytype))
+		newgraph = YES
+	    }
+
+	case HELP: # :help file
+	    call gargwrd (Memc[cmd], IC_SZSAMPLE)
+	    if (Memc[cmd] == EOS) {
+	        call printf ("help = %s\n")
+		    call pargstr (Memc[IC_HELP(ic)])
+	    } else
+		call ic_pstr (ic, "help", Memc[cmd])
+
+        case GUI: # :gui command - Update, unlearn or set the options.
+	    call gargstr (Memc[cmd], IC_SZSAMPLE)
+	    call ic_gui (ic, Memc[cmd])
+
+	default: # Unrecognized command.
+	    call printf ("Unrecognized command or ambiguous abbreviation\007")
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgcolond.x b/pkg/xtools/icfit/icgcolond.x
new file mode 100644
index 00000000..00c92a0d
--- /dev/null
+++ b/pkg/xtools/icfit/icgcolond.x
@@ -0,0 +1,218 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+include	"names.h"
+
+# List of colon commands.
+define	CMDS "|function|order|sample|naverage|niterate|low_reject|high_reject\
+	|grow|markrej|color|show|vshow|xyshow|errors|evaluate\
+	|graph|help|gui|"
+
+define	FUNCTION	1	# Set or show function type
+define	ORDER		2	# Set or show function order
+define	SAMPLE		3	# Set or show sample ranges
+define	NAVERAGE	4	# Set or show sample averaging or medianing
+define	NITERATE	5	# Set or show rejection iterations
+define	LOW_REJECT	6	# Set or show lower rejection factor
+define	HIGH_REJECT	7	# Set or show upper rejection factor
+define	GROW		8	# Set or show rejection growing radius
+define	MARKREJ		9	# Mark rejected points
+define	COLOR		10	# Fit color
+define	SHOW		11	# Show values of parameters
+define	VSHOW		12	# Show verbose information
+define	XYSHOW		13	# Show x-y-fit-wts values
+define	ERRORS		14	# Show errors of fit
+define	EVALUATE	15	# Evaluate fit at specified value
+define	GRAPH		16	# Define graph
+define	HELP		17	# Set help file
+define	GUI		18	# Send GUI command
+
+# ICG_COLON -- Processes colon commands.  The common flags and newgraph
+# signal changes in fitting parameters or the need to redraw the graph.
+
+procedure icg_colond (ic, cmdstr, newgraph, gp, gt, cv, x, y, wts, npts)
+
+pointer	ic				# ICFIT pointer
+char	cmdstr[ARB]			# Command string
+int	newgraph			# New graph?
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	cv				# CURFIT pointer for error listing
+double	x[npts], y[npts], wts[npts]	# Data arrays for error listing
+int	npts				# Number of data points
+
+double	val, dcveval()
+char	key, xtype, ytype
+bool	bval
+int	ncmd, ival
+real	rval
+pointer	sp, cmd
+
+int	nscan(), strdic(), btoi()
+
+string	funcs "|chebyshev|legendre|spline1|spline3|power|"
+
+begin
+	# Check for GTOOLS command.
+	if (cmdstr[1] == '/') {
+	    call gt_colon (cmdstr, gp, gt, newgraph)
+	    return
+	}
+
+	# Use formated scan to parse the command string.
+	# The first word is the command and it may be minimum match
+	# abbreviated with the list of commands.
+
+	call smark (sp)
+	call salloc (cmd, IC_SZSAMPLE, TY_CHAR)
+
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], IC_SZSAMPLE)
+	ncmd = strdic (Memc[cmd], Memc[cmd], IC_SZSAMPLE, CMDS)
+
+	switch (ncmd) {
+	case FUNCTION: # :function - List or set the fitting function.
+	    call gargwrd (Memc[cmd], IC_SZSAMPLE)
+	    if (nscan() == 1) {
+		call printf ("function = %s\n")
+		    call ic_gstr (ic, "function", Memc[cmd], IC_SZSAMPLE)
+		    call pargstr (Memc[cmd])
+	    } else {
+		if (strdic (Memc[cmd], Memc[cmd], IC_SZSAMPLE, funcs) > 0) {
+		    call ic_pstr (ic, "function", Memc[cmd])
+		    IC_NEWFUNCTION(ic) = YES
+		} else
+		    call printf ("Unknown or ambiguous function\n")
+	    }
+
+	case ORDER: # :order - List or set the function order.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("order = %d\n")
+		    call pargi (IC_ORDER(ic))
+	    } else if (ival < 1) {
+		call printf ("Order must be greater than zero\n")
+	    } else {
+		call ic_puti (ic, "order", ival)
+		IC_NEWFUNCTION(ic) = YES
+	    }
+
+	case SAMPLE: # :sample - List or set the sample points.
+	    call gargstr (Memc[cmd], IC_SZSAMPLE)
+	    if (Memc[cmd] == EOS) {
+	        call printf ("sample = %s\n")
+		    call pargstr (Memc[IC_SAMPLE(ic)])
+	    } else {
+		call ic_pstr (ic, "sample", Memc[cmd])
+		IC_NEWX(ic) = YES
+	    }
+
+	case NAVERAGE: # :naverage - List or set the sample averging.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("naverage = %d\n")
+		    call pargi (IC_NAVERAGE(ic))
+	    } else {
+		call ic_puti (ic, "naverage", ival)
+		IC_NEWX(ic) = YES
+	    }
+
+	case NITERATE: # :niterate - List or set the rejection iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("niterate = %d\n")
+		    call pargi (IC_NITERATE(ic))
+	    } else
+		call ic_puti (ic, "niterate", ival)
+
+
+	case LOW_REJECT: # :low_reject - List or set lower rejection factor.
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("low_reject = %g\n")
+		    call pargr (IC_LOW(ic))
+	    } else
+		call ic_putr (ic, "low", rval)
+
+	case HIGH_REJECT: # :high_reject - List or set high rejection factor.
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("high_reject = %g\n")
+		    call pargr (IC_HIGH(ic))
+	    } else
+		call ic_putr (ic, "high", rval)
+
+	case GROW: # :grow - List or set the rejection growing.
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("grow = %g\n")
+		    call pargr (IC_GROW(ic))
+	    } else
+		call ic_putr (ic, "grow", rval)
+
+	case MARKREJ: # :markrej - Mark rejected points
+	    call gargb (bval)
+	    if (nscan() == 1) {
+		call printf ("markrej = %b\n")
+		    call pargi (IC_MARKREJ(ic))
+	    } else
+		call ic_puti (ic, "markrej", btoi (bval))
+
+	case COLOR: # :color - List or set the fit color.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("color = %d\n")
+		    call pargi (IC_COLOR(ic))
+	    } else
+		call ic_puti (ic, "color", ival)
+
+	case SHOW, VSHOW, XYSHOW, ERRORS:
+	    call ic_guishowd (ic, cmdstr, cv, x, y, wts, npts)
+
+	case EVALUATE: # :evaluate x - evaluate fit at x.
+	    call gargd (val)
+	    if (nscan() == 1)
+		call printf ("evaluate requires a value to evaluate\n")
+	    else {
+		call printf ("fit(%g) = %g\n")
+		    call pargd (val)
+		    call pargd (dcveval (cv, val))
+	    }
+
+	case GRAPH: # :graph key xtype ytpe
+	    call gargc (key)
+	    call gargc (xtype)
+	    call gargc (ytype)
+	    if (nscan() != 4) {
+		ival = IC_GKEY(ic)
+		call printf ("graph %c %c %c\n")
+		    call pargi ('h'+ival-1)
+		    call pargi (IC_AXES(ic,ival,1))
+		    call pargi (IC_AXES(ic,ival,2))
+	    } else {
+		ival = key - 'h' + 1
+		IC_GKEY(ic) = ival
+		call ic_pkey (ic, ival, int(xtype), int(ytype))
+		newgraph = YES
+	    }
+
+	case HELP: # :help file
+	    call gargwrd (Memc[cmd], IC_SZSAMPLE)
+	    if (Memc[cmd] == EOS) {
+	        call printf ("help = %s\n")
+		    call pargstr (Memc[IC_HELP(ic)])
+	    } else
+		call ic_pstr (ic, "help", Memc[cmd])
+
+        case GUI: # :gui command - Update, unlearn or set the options.
+	    call gargstr (Memc[cmd], IC_SZSAMPLE)
+	    call ic_gui (ic, Memc[cmd])
+
+	default: # Unrecognized command.
+	    call printf ("Unrecognized command or ambiguous abbreviation\007")
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgcolonr.x b/pkg/xtools/icfit/icgcolonr.x
new file mode 100644
index 00000000..dc320c2b
--- /dev/null
+++ b/pkg/xtools/icfit/icgcolonr.x
@@ -0,0 +1,218 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+include	"names.h"
+
+# List of colon commands.
+define	CMDS "|function|order|sample|naverage|niterate|low_reject|high_reject\
+	|grow|markrej|color|show|vshow|xyshow|errors|evaluate\
+	|graph|help|gui|"
+
+define	FUNCTION	1	# Set or show function type
+define	ORDER		2	# Set or show function order
+define	SAMPLE		3	# Set or show sample ranges
+define	NAVERAGE	4	# Set or show sample averaging or medianing
+define	NITERATE	5	# Set or show rejection iterations
+define	LOW_REJECT	6	# Set or show lower rejection factor
+define	HIGH_REJECT	7	# Set or show upper rejection factor
+define	GROW		8	# Set or show rejection growing radius
+define	MARKREJ		9	# Mark rejected points
+define	COLOR		10	# Fit color
+define	SHOW		11	# Show values of parameters
+define	VSHOW		12	# Show verbose information
+define	XYSHOW		13	# Show x-y-fit-wts values
+define	ERRORS		14	# Show errors of fit
+define	EVALUATE	15	# Evaluate fit at specified value
+define	GRAPH		16	# Define graph
+define	HELP		17	# Set help file
+define	GUI		18	# Send GUI command
+
+# ICG_COLON -- Processes colon commands.  The common flags and newgraph
+# signal changes in fitting parameters or the need to redraw the graph.
+
+procedure icg_colonr (ic, cmdstr, newgraph, gp, gt, cv, x, y, wts, npts)
+
+pointer	ic				# ICFIT pointer
+char	cmdstr[ARB]			# Command string
+int	newgraph			# New graph?
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	cv				# CURFIT pointer for error listing
+real	x[npts], y[npts], wts[npts]	# Data arrays for error listing
+int	npts				# Number of data points
+
+real	val, rcveval()
+char	key, xtype, ytype
+bool	bval
+int	ncmd, ival
+real	rval
+pointer	sp, cmd
+
+int	nscan(), strdic(), btoi()
+
+string	funcs "|chebyshev|legendre|spline1|spline3|power|"
+
+begin
+	# Check for GTOOLS command.
+	if (cmdstr[1] == '/') {
+	    call gt_colon (cmdstr, gp, gt, newgraph)
+	    return
+	}
+
+	# Use formated scan to parse the command string.
+	# The first word is the command and it may be minimum match
+	# abbreviated with the list of commands.
+
+	call smark (sp)
+	call salloc (cmd, IC_SZSAMPLE, TY_CHAR)
+
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], IC_SZSAMPLE)
+	ncmd = strdic (Memc[cmd], Memc[cmd], IC_SZSAMPLE, CMDS)
+
+	switch (ncmd) {
+	case FUNCTION: # :function - List or set the fitting function.
+	    call gargwrd (Memc[cmd], IC_SZSAMPLE)
+	    if (nscan() == 1) {
+		call printf ("function = %s\n")
+		    call ic_gstr (ic, "function", Memc[cmd], IC_SZSAMPLE)
+		    call pargstr (Memc[cmd])
+	    } else {
+		if (strdic (Memc[cmd], Memc[cmd], IC_SZSAMPLE, funcs) > 0) {
+		    call ic_pstr (ic, "function", Memc[cmd])
+		    IC_NEWFUNCTION(ic) = YES
+		} else
+		    call printf ("Unknown or ambiguous function\n")
+	    }
+
+	case ORDER: # :order - List or set the function order.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("order = %d\n")
+		    call pargi (IC_ORDER(ic))
+	    } else if (ival < 1) {
+		call printf ("Order must be greater than zero\n")
+	    } else {
+		call ic_puti (ic, "order", ival)
+		IC_NEWFUNCTION(ic) = YES
+	    }
+
+	case SAMPLE: # :sample - List or set the sample points.
+	    call gargstr (Memc[cmd], IC_SZSAMPLE)
+	    if (Memc[cmd] == EOS) {
+	        call printf ("sample = %s\n")
+		    call pargstr (Memc[IC_SAMPLE(ic)])
+	    } else {
+		call ic_pstr (ic, "sample", Memc[cmd])
+		IC_NEWX(ic) = YES
+	    }
+
+	case NAVERAGE: # :naverage - List or set the sample averging.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("naverage = %d\n")
+		    call pargi (IC_NAVERAGE(ic))
+	    } else {
+		call ic_puti (ic, "naverage", ival)
+		IC_NEWX(ic) = YES
+	    }
+
+	case NITERATE: # :niterate - List or set the rejection iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("niterate = %d\n")
+		    call pargi (IC_NITERATE(ic))
+	    } else
+		call ic_puti (ic, "niterate", ival)
+
+
+	case LOW_REJECT: # :low_reject - List or set lower rejection factor.
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("low_reject = %g\n")
+		    call pargr (IC_LOW(ic))
+	    } else
+		call ic_putr (ic, "low", rval)
+
+	case HIGH_REJECT: # :high_reject - List or set high rejection factor.
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("high_reject = %g\n")
+		    call pargr (IC_HIGH(ic))
+	    } else
+		call ic_putr (ic, "high", rval)
+
+	case GROW: # :grow - List or set the rejection growing.
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("grow = %g\n")
+		    call pargr (IC_GROW(ic))
+	    } else
+		call ic_putr (ic, "grow", rval)
+
+	case MARKREJ: # :markrej - Mark rejected points
+	    call gargb (bval)
+	    if (nscan() == 1) {
+		call printf ("markrej = %b\n")
+		    call pargi (IC_MARKREJ(ic))
+	    } else
+		call ic_puti (ic, "markrej", btoi (bval))
+
+	case COLOR: # :color - List or set the fit color.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("color = %d\n")
+		    call pargi (IC_COLOR(ic))
+	    } else
+		call ic_puti (ic, "color", ival)
+
+	case SHOW, VSHOW, XYSHOW, ERRORS:
+	    call ic_guishowr (ic, cmdstr, cv, x, y, wts, npts)
+
+	case EVALUATE: # :evaluate x - evaluate fit at x.
+	    call gargr (val)
+	    if (nscan() == 1)
+		call printf ("evaluate requires a value to evaluate\n")
+	    else {
+		call printf ("fit(%g) = %g\n")
+		    call pargr (val)
+		    call pargr (rcveval (cv, val))
+	    }
+
+	case GRAPH: # :graph key xtype ytpe
+	    call gargc (key)
+	    call gargc (xtype)
+	    call gargc (ytype)
+	    if (nscan() != 4) {
+		ival = IC_GKEY(ic)
+		call printf ("graph %c %c %c\n")
+		    call pargi ('h'+ival-1)
+		    call pargi (IC_AXES(ic,ival,1))
+		    call pargi (IC_AXES(ic,ival,2))
+	    } else {
+		ival = key - 'h' + 1
+		IC_GKEY(ic) = ival
+		call ic_pkey (ic, ival, int(xtype), int(ytype))
+		newgraph = YES
+	    }
+
+	case HELP: # :help file
+	    call gargwrd (Memc[cmd], IC_SZSAMPLE)
+	    if (Memc[cmd] == EOS) {
+	        call printf ("help = %s\n")
+		    call pargstr (Memc[IC_HELP(ic)])
+	    } else
+		call ic_pstr (ic, "help", Memc[cmd])
+
+        case GUI: # :gui command - Update, unlearn or set the options.
+	    call gargstr (Memc[cmd], IC_SZSAMPLE)
+	    call ic_gui (ic, Memc[cmd])
+
+	default: # Unrecognized command.
+	    call printf ("Unrecognized command or ambiguous abbreviation\007")
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgdelete.gx b/pkg/xtools/icfit/icgdelete.gx
new file mode 100644
index 00000000..1c2a6fd6
--- /dev/null
+++ b/pkg/xtools/icfit/icgdelete.gx
@@ -0,0 +1,89 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+define	MSIZE		2.		# Mark size
+
+# ICG_DELETE -- Delete data point nearest the cursor.
+# The nearest point to the cursor in NDC coordinates is determined.
+
+procedure icg_delete$t (ic, gp, gt, cv, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+pointer	gt					# GTOOLS pointer
+pointer	cv					# CURFIT pointer
+PIXEL	x[npts], y[npts]			# Data points
+PIXEL	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	gt_geti()
+pointer	sp, xout, yout
+
+begin
+	call smark (sp)
+	call salloc (xout, npts, TY_PIXEL)
+	call salloc (yout, npts, TY_PIXEL)
+
+	call icg_axes$t (ic, gt, cv, 1, x, y, Mem$t[xout], npts)
+	call icg_axes$t (ic, gt, cv, 2, x, y, Mem$t[yout], npts)
+
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call icg_d1$t (ic, gp, Mem$t[xout], Mem$t[yout], wts, userwts,
+		npts, wx, wy)
+	else
+	    call icg_d1$t (ic, gp, Mem$t[yout], Mem$t[xout], wts, userwts,
+		npts, wy, wx)
+
+	call sfree (sp)
+end
+
+
+# ICG_D1 -- Do the actual delete.
+
+procedure icg_d1$t (ic, gp, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+PIXEL	x[npts], y[npts]			# Data points
+PIXEL	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with non-zero weight.
+
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] == 0.)
+		next
+
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+		
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Mark the deleted point with a cross and set the weight to zero.
+
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    wts[j] = 0.
+	    IC_NEWWTS(ic) = YES
+	}
+end
diff --git a/pkg/xtools/icfit/icgdeleted.x b/pkg/xtools/icfit/icgdeleted.x
new file mode 100644
index 00000000..60027998
--- /dev/null
+++ b/pkg/xtools/icfit/icgdeleted.x
@@ -0,0 +1,89 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+define	MSIZE		2.		# Mark size
+
+# ICG_DELETE -- Delete data point nearest the cursor.
+# The nearest point to the cursor in NDC coordinates is determined.
+
+procedure icg_deleted (ic, gp, gt, cv, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+pointer	gt					# GTOOLS pointer
+pointer	cv					# CURFIT pointer
+double	x[npts], y[npts]			# Data points
+double	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	gt_geti()
+pointer	sp, xout, yout
+
+begin
+	call smark (sp)
+	call salloc (xout, npts, TY_DOUBLE)
+	call salloc (yout, npts, TY_DOUBLE)
+
+	call icg_axesd (ic, gt, cv, 1, x, y, Memd[xout], npts)
+	call icg_axesd (ic, gt, cv, 2, x, y, Memd[yout], npts)
+
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call icg_d1d (ic, gp, Memd[xout], Memd[yout], wts, userwts,
+		npts, wx, wy)
+	else
+	    call icg_d1d (ic, gp, Memd[yout], Memd[xout], wts, userwts,
+		npts, wy, wx)
+
+	call sfree (sp)
+end
+
+
+# ICG_D1 -- Do the actual delete.
+
+procedure icg_d1d (ic, gp, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+double	x[npts], y[npts]			# Data points
+double	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with non-zero weight.
+
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] == 0.)
+		next
+
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+		
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Mark the deleted point with a cross and set the weight to zero.
+
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    wts[j] = 0.
+	    IC_NEWWTS(ic) = YES
+	}
+end
diff --git a/pkg/xtools/icfit/icgdeleter.x b/pkg/xtools/icfit/icgdeleter.x
new file mode 100644
index 00000000..86edd93b
--- /dev/null
+++ b/pkg/xtools/icfit/icgdeleter.x
@@ -0,0 +1,89 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+define	MSIZE		2.		# Mark size
+
+# ICG_DELETE -- Delete data point nearest the cursor.
+# The nearest point to the cursor in NDC coordinates is determined.
+
+procedure icg_deleter (ic, gp, gt, cv, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+pointer	gt					# GTOOLS pointer
+pointer	cv					# CURFIT pointer
+real	x[npts], y[npts]			# Data points
+real	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	gt_geti()
+pointer	sp, xout, yout
+
+begin
+	call smark (sp)
+	call salloc (xout, npts, TY_REAL)
+	call salloc (yout, npts, TY_REAL)
+
+	call icg_axesr (ic, gt, cv, 1, x, y, Memr[xout], npts)
+	call icg_axesr (ic, gt, cv, 2, x, y, Memr[yout], npts)
+
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call icg_d1r (ic, gp, Memr[xout], Memr[yout], wts, userwts,
+		npts, wx, wy)
+	else
+	    call icg_d1r (ic, gp, Memr[yout], Memr[xout], wts, userwts,
+		npts, wy, wx)
+
+	call sfree (sp)
+end
+
+
+# ICG_D1 -- Do the actual delete.
+
+procedure icg_d1r (ic, gp, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+real	x[npts], y[npts]			# Data points
+real	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with non-zero weight.
+
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] == 0.)
+		next
+
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+		
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Mark the deleted point with a cross and set the weight to zero.
+
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    wts[j] = 0.
+	    IC_NEWWTS(ic) = YES
+	}
+end
diff --git a/pkg/xtools/icfit/icgfit.gx b/pkg/xtools/icfit/icgfit.gx
new file mode 100644
index 00000000..767daa3e
--- /dev/null
+++ b/pkg/xtools/icfit/icgfit.gx
@@ -0,0 +1,544 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<pkg/gtools.h>
+include	"names.h"
+include	"icfit.h"
+
+# ICG_FIT -- Interactive curve fitting with graphics.  This is the main
+# entry point for the interactive graphics part of the icfit package.
+
+procedure icg_fit$t (ic, gp, cursor, gt, cv, x, y, wts, npts)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+char	cursor[ARB]		# GIO cursor input
+pointer	gt			# GTOOLS pointer
+pointer	cv			# CURFIT pointer
+PIXEL	x[npts]			# Ordinates
+PIXEL	y[npts]			# Abscissas
+PIXEL	wts[npts]		# Weights
+int	npts			# Number of points
+
+real	wx, wy
+int	wcs, key
+
+int	i, j, newgraph, axes[2], xtype
+PIXEL	px1
+real	rx1, rx2, ry1, ry2
+pointer	sp, cmd, userwts, x1, y1, w1, n
+
+int	gt_gcur1(), stridxs(), scan(), nscan()
+int	icg_nearest$t()
+PIXEL	$tcveval()
+errchk	ic_fit$t()
+
+begin
+	call smark (sp)
+	call salloc (cmd, IC_SZSAMPLE, TY_CHAR)
+
+	# Allocate memory for the fit and a copy of the weights.
+	# The weights are copied because they are changed when points are
+	# deleted.
+
+	n = npts
+	x1 = NULL
+	y1 = NULL
+	w1 = NULL
+	call malloc (userwts, n, TY_PIXEL)
+	call amov$t (wts, Mem$t[userwts], n)
+
+	# Initialize
+	IC_GP(ic) = gp
+	IC_GT(ic) = gt
+	IC_OVERPLOT(ic) = NO
+	IC_NEWX(ic) = YES
+	IC_NEWY(ic) = YES
+	IC_NEWWTS(ic) = YES
+	IC_NEWFUNCTION(ic) = YES
+
+	# Send the GUI the current task values.
+	call ic_gui (ic, "open")
+	call ic_gui (ic, "graph")
+
+	# Read cursor commands.
+
+	key = 'f'
+	newgraph = YES
+	axes[1] = IC_AXES(ic, IC_GKEY(ic), 1)
+	axes[2] = IC_AXES(ic, IC_GKEY(ic), 2)
+	xtype = 0
+
+	repeat {
+	    switch (key) {
+	    case '?': # Print help text.
+		call ic_gui (ic, "help")
+
+	    case ':': # List or set parameters
+		if (Memc[cmd] == '/')
+	            call gt_colon (Memc[cmd], gp, gt, newgraph)
+		else
+		    call icg_colon$t (ic, Memc[cmd], newgraph, gp, gt, cv,
+			x, y, wts, n)
+
+	    case 'a': # Add points
+		if ((IC_AXES(ic,IC_GKEY(ic),1) == 'x') &&
+		    (IC_AXES(ic,IC_GKEY(ic),2) == 'y'))
+		    ;
+		else if ((IC_AXES(ic,IC_GKEY(ic),1) == 'y') &&
+		    (IC_AXES(ic,IC_GKEY(ic),2) == 'x')) {
+		    rx1 = wx
+		    wx = wy
+		    wy = rx1
+		} else {
+		    call printf ("Graph must be x vs. y or y vs. x\07\n")
+		    next
+		}
+
+		rx1 = 1.
+		call printf ("weight = (%g) ")
+		    call pargr (rx1)
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargr (rx2)
+		    if (nscan() == 1)
+			if (!IS_INDEFR (rx2))
+			    rx1 = rx2
+		}
+
+		if (x1 == NULL) {
+		    call malloc (x1, n+1, TY_PIXEL)
+		    call malloc (y1, n+1, TY_PIXEL)
+		    call malloc (w1, n+1, TY_PIXEL)
+		    call amov$t (x, Mem$t[x1], n)
+		    call amov$t (y, Mem$t[y1], n)
+		    call amov$t (wts, Mem$t[w1], n)
+		} else {
+		    call realloc (x1, n+1, TY_PIXEL)
+		    call realloc (y1, n+1, TY_PIXEL)
+		    call realloc (w1, n+1, TY_PIXEL)
+		}
+		call realloc (userwts, n+1, TY_PIXEL)
+
+		call icg_add$t (gp, wx, wy, rx1, Mem$t[x1], Mem$t[y1],
+		    Mem$t[w1], Mem$t[userwts], n)
+
+		IC_NEWX(ic) = YES
+		IC_NEWY(ic) = YES
+		IC_NEWWTS(ic) = YES
+
+	    case 'c': # Print the positions of data points.
+		if (x1 == NULL) {
+		    i = icg_nearest$t (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = %g  y = %g  fit = %g\n")
+			    call parg$t (x[i])
+			    call parg$t (y[i])
+			    call parg$t ($tcveval (cv, x[i]))
+		    }
+		} else {
+		    i = icg_nearest$t (ic, gp, gt, cv, Mem$t[x1], Mem$t[y1],
+			n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = %g  y = %g  fit = %g\n")
+			    call parg$t (Mem$t[x1+i-1])
+			    call parg$t (Mem$t[y1+i-1])
+			    call parg$t ($tcveval (cv, Mem$t[x1+i-1]))
+		    }
+		}
+
+	    case 'd': # Delete data points.
+		if (x1 == NULL)
+		    call icg_delete$t (ic, gp, gt, cv, x, y, wts,
+			Mem$t[userwts], n, wx, wy)
+		else
+		    call icg_delete$t (ic, gp, gt, cv, Mem$t[x1], Mem$t[y1],
+			Mem$t[w1], Mem$t[userwts], n, wx, wy)
+		call ic_gui (ic, "refit YES")
+
+	    case 'f': # Fit the function and reset the flags.
+		iferr {
+		    if (x1 == NULL)
+			call ic_fit$t (ic, cv, x, y, wts, n, IC_NEWX(ic),
+			    IC_NEWY(ic), IC_NEWWTS(ic), IC_NEWFUNCTION(ic))
+		    else
+			call ic_fit$t (ic, cv, Mem$t[x1], Mem$t[y1], Mem$t[w1],
+			    n, IC_NEWX(ic), IC_NEWY(ic), IC_NEWWTS(ic),
+			    IC_NEWFUNCTION(ic))
+
+		    IC_NEWX(ic) = NO
+		    IC_NEWY(ic) = NO
+		    IC_NEWWTS(ic) = NO
+		    IC_NEWFUNCTION(ic) = NO
+		    IC_FITERROR(ic) = NO
+		    newgraph = YES
+
+		    call  ic_gui (ic, "refit NO")
+		} then {
+		    IC_FITERROR(ic) = YES
+		    call erract (EA_WARN)
+		}
+
+	    case 'g':	# Set graph axes types.
+		call printf ("Graph key to be defined: ")
+		call flush (STDOUT)
+		if (scan() == EOF)
+		    goto 10
+		call gargc (Memc[cmd])
+
+		switch (Memc[cmd]) {
+		case '\n':
+		case 'h', 'i', 'j', 'k', 'l':
+		    switch (Memc[cmd]) {
+		    case 'h':
+		        key = 1
+		    case 'i':
+		        key = 2
+		    case 'j':
+		        key = 3
+		    case 'k':
+		        key = 4
+		    case 'l':
+		        key = 5
+		    }
+
+		    call printf ("Set graph axes types (%c, %c): ")
+		        call pargi (IC_AXES(ic, key, 1))
+		        call pargi (IC_AXES(ic, key, 2))
+		    call flush (STDOUT)
+		    if (scan() == EOF)
+		        goto 10
+		    call gargc (Memc[cmd])
+
+		    switch (Memc[cmd]) {
+		    case '\n':
+		    default:
+		        call gargc (Memc[cmd+1])
+		        call gargc (Memc[cmd+1])
+		        if (Memc[cmd+1] != '\n') {
+			    IC_AXES(ic, key, 1) = Memc[cmd]
+			    IC_AXES(ic, key, 2) = Memc[cmd+1]
+			    if (IC_GKEY(ic) == key)
+				newgraph = YES
+		        }
+		    }
+		default:
+		    call printf ("Not a graph key\n")
+		}
+
+	    case 'h':
+		if (IC_GKEY(ic) != 1) {
+		    IC_GKEY(ic) = 1
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'i':
+		if (IC_GKEY(ic) != 2) {
+		    IC_GKEY(ic) = 2
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'j':
+		if (IC_GKEY(ic) != 3) {
+		    IC_GKEY(ic) = 3
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'k':
+		if (IC_GKEY(ic) != 4) {
+		    IC_GKEY(ic) = 4
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'l':
+		if (IC_GKEY(ic) != 5) {
+		    IC_GKEY(ic) = 5
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 't': # Initialize the sample string and erase from the graph.
+		if (x1 == NULL)
+		    call icg_sample$t (ic, gp, gt, x, n, 0)
+		else
+		    call icg_sample$t (ic, gp, gt, Mem$t[x1], n, 0)
+		call ic_pstr (ic, "sample", "*")
+		IC_NEWX(ic) = YES
+
+	    case 'o': # Set overplot flag
+		IC_OVERPLOT(ic) = YES
+
+	    case 'r': # Redraw the graph
+		newgraph = YES
+
+	    case 's': # Set sample regions with the cursor.
+		if ((IC_AXES(ic,IC_GKEY(ic),1) == 'x') ||
+		    (IC_AXES(ic,IC_GKEY(ic),2) == 'x')) {
+		    if (stridxs ("*", Memc[IC_SAMPLE(ic)]) > 0)
+		        Memc[IC_SAMPLE(ic)] = EOS
+
+		    rx1 = wx
+		    ry1 = wy
+		    call printf ("again:\n")
+		    if (gt_gcur1(gt, cursor, wx, wy, wcs, key, Memc[cmd],
+			IC_SZSAMPLE) == EOF)
+		        break
+		    call printf ("\n")
+		    rx2 = wx
+		    ry2 = wy
+
+		    # Determine if the x vector is integer.
+		    if (xtype == 0) {
+			xtype = TY_INT
+			if (x1 == NULL) {
+			    do i = 1, n
+				if (x[i] != int (x[i])) {
+				    xtype = TY_REAL
+				    break
+				}
+			} else {
+			    do i = 1, n
+				if (Mem$t[x1+i-1] != int (Mem$t[x1+i-1])) {
+				    xtype = TY_REAL
+				    break
+				}
+			}
+		    }
+
+		    if (IC_AXES(ic,IC_GKEY(ic),1) == 'x') {
+		        if (xtype == TY_INT) {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %d:%d")
+		                call pargi (nint (rx1))
+		                call pargi (nint (rx2))
+			} else {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %g:%g")
+		                call pargr (rx1)
+		                call pargr (rx2)
+			}
+		    } else {
+		        if (xtype == TY_INT) {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %d:%d")
+		                call pargi (nint (ry1))
+		                call pargi (nint (ry2))
+			} else {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %g:%g")
+		                call pargr (ry1)
+		                call pargr (ry2)
+			}
+		    }
+		    call strcat (Memc[cmd], Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+		    if (x1 == NULL)
+			call icg_sample$t (ic, gp, gt, x, n, 1)
+		    else
+			call icg_sample$t (ic, gp, gt, Mem$t[x1], n, 1)
+		    call ic_pstr (ic, "sample",  Memc[IC_SAMPLE(ic)])
+		    IC_NEWX(ic) = YES
+		}
+
+	    case 'u': # Undelete data points.
+		if (x1 == NULL)
+		    call icg_undelete$t (ic, gp, gt, cv, x, y, wts,
+			Mem$t[userwts], n, wx, wy)
+		else
+		    call icg_undelete$t (ic, gp, gt, cv, Mem$t[x1], Mem$t[y1],
+			Mem$t[w1], Mem$t[userwts], n, wx, wy)
+		call ic_gui (ic, "refit YES")
+
+	    case 'w':  # Window graph
+		call gt_window (gt, gp, cursor, newgraph)
+
+	    case 'v': # Reset the value of the weight.
+		if (x1 == NULL) {
+		    i = icg_nearest$t (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("weight = (%g) ")
+			    call parg$t (wts[i])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call garg$t (px1)
+			    if (nscan() == 1) {
+				if (!IS_$INDEF (px1)) {
+				    wts[i] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWWTS(ic) = YES
+				}
+			    }
+			}
+		    }
+		} else {
+		    i = icg_nearest$t (ic, gp, gt, cv, Mem$t[x1], Mem$t[y1], n,
+			wx, wy)
+
+		    if (i != 0) {
+			call printf ("weight = (%g) ")
+			    call parg$t (Mem$t[w1+i-1])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call garg$t (px1)
+			    if (nscan() == 1) {
+				if (!IS_$INDEF (px1)) {
+				    j = icg_nearest$t (ic, gp, gt, cv, x, y, n,
+					wx, wy)
+				    if (j != 0)
+					if (x[j] == Mem$t[x1+i-1] &&
+					    y[j] == Mem$t[y1+i-1])
+					    wts[j] = px1
+				    Mem$t[w1+i-1] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWWTS(ic) = YES
+				}
+			    }
+			}
+		    }
+		}
+
+	    case 'x': # Reset the value of the x point.
+		if (x1 == NULL) {
+		    i = icg_nearest$t (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = (%g) ")
+			    call parg$t (x[i])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call garg$t (px1)
+			    if (nscan() == 1) {
+				if (!IS_$INDEF (px1)) {
+				    x[i] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWX(ic) = YES
+				}
+			    }
+			}
+		    }
+		} else {
+		    i = icg_nearest$t (ic, gp, gt, cv, Mem$t[x1], Mem$t[y1], n,
+			wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = (%g) ")
+			    call parg$t (Mem$t[x1+i-1])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call garg$t (px1)
+			    if (nscan() == 1) {
+				if (!IS_$INDEF (px1)) {
+				    j = icg_nearest$t (ic, gp, gt, cv, x, y, n,
+					wx, wy)
+				    if (j != 0)
+					if (x[j] == Mem$t[x1+i-1] &&
+					    y[j] == Mem$t[y1+i-1])
+					    x[j] = px1
+				    Mem$t[x1+i-1] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWX(ic) = YES
+				}
+			    }
+			}
+		    }
+		}
+
+	    case 'y': # Reset the value of the y point.
+		if (x1 == NULL) {
+		    i = icg_nearest$t (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("y = (%g) ")
+			    call parg$t (y[i])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call garg$t (px1)
+			    if (nscan() == 1) {
+				if (!IS_$INDEF (px1)) {
+				    y[i] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWY(ic) = YES
+				}
+			    }
+			}
+		    }
+		} else {
+		    i = icg_nearest$t (ic, gp, gt, cv, Mem$t[x1], Mem$t[y1], n,
+			wx, wy)
+
+		    if (i != 0) {
+			call printf ("y = (%g) ")
+			    call parg$t (Mem$t[y1+i-1])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call garg$t (px1)
+			    if (nscan() == 1) {
+				if (!IS_$INDEF (px1)) {
+				    j = icg_nearest$t (ic, gp, gt, cv, x, y, n,
+					wx, wy)
+				    if (j != 0)
+					if (x[j] == Mem$t[x1+i-1] &&
+					    y[j] == Mem$t[y1+i-1])
+					    y[j] = px1
+				    Mem$t[y1+i-1] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWY(ic) = YES
+				}
+			    }
+			}
+		    }
+		}
+
+	    case 'z': # Delete sample region
+		if (x1 == NULL)
+		    call icg_dsample$t (wx, wy, ic, gp, gt, x, n)
+		else
+		    call icg_dsample$t (wx, wy, ic, gp, gt, Mem$t[x1], n)
+		call ic_pstr (ic, "sample", Memc[IC_SAMPLE(ic)])
+
+	    case 'I': # Interrupt
+		call fatal (0, "Interrupt")
+
+	    default: # Let the user decide on any other keys.
+		call icg_user (ic, gp, gt, cv, wx, wy, wcs, key, Memc[cmd])
+	    }
+
+	    # Redraw the graph if necessary.
+10	    if (newgraph == YES) {
+		if (IC_AXES(ic, IC_GKEY(ic), 1) != axes[1]) {
+		    axes[1] = IC_AXES(ic, IC_GKEY(ic), 1)
+		    call gt_setr (gt, GTXMIN, INDEFR)
+		    call gt_setr (gt, GTXMAX, INDEFR)
+		}
+		if (IC_AXES(ic, IC_GKEY(ic), 2) != axes[2]) {
+		    axes[2] = IC_AXES(ic, IC_GKEY(ic), 2)
+		    call gt_setr (gt, GTYMIN, INDEFR)
+		    call gt_setr (gt, GTYMAX, INDEFR)
+		}
+		if (x1 == NULL)
+		    call icg_graph$t (ic, gp, gt, cv, x, y, wts, n)
+		else
+		    call icg_graph$t (ic, gp, gt, cv, Mem$t[x1], Mem$t[y1],
+			Mem$t[w1], n)
+		newgraph = NO
+	    }
+	    if (cursor[1] == EOS)
+		break
+	} until (gt_gcur1 (gt, cursor, wx, wy, wcs, key, Memc[cmd],
+	    IC_SZSAMPLE) == EOF)
+
+	call ic_gui (ic, "close")
+	IC_GP(ic) = NULL
+
+	if (x1 != NULL) {
+	    call mfree (x1, TY_PIXEL)
+	    call mfree (y1, TY_PIXEL)
+	    call mfree (w1, TY_PIXEL)
+	    if (IC_WTSFIT(ic) == NULL)
+		IC_NFIT(ic) = npts
+	}
+	call mfree (userwts, TY_PIXEL)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgfitd.x b/pkg/xtools/icfit/icgfitd.x
new file mode 100644
index 00000000..ee66e9b3
--- /dev/null
+++ b/pkg/xtools/icfit/icgfitd.x
@@ -0,0 +1,544 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<pkg/gtools.h>
+include	"names.h"
+include	"icfit.h"
+
+# ICG_FIT -- Interactive curve fitting with graphics.  This is the main
+# entry point for the interactive graphics part of the icfit package.
+
+procedure icg_fitd (ic, gp, cursor, gt, cv, x, y, wts, npts)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+char	cursor[ARB]		# GIO cursor input
+pointer	gt			# GTOOLS pointer
+pointer	cv			# CURFIT pointer
+double	x[npts]			# Ordinates
+double	y[npts]			# Abscissas
+double	wts[npts]		# Weights
+int	npts			# Number of points
+
+real	wx, wy
+int	wcs, key
+
+int	i, j, newgraph, axes[2], xtype
+double	px1
+real	rx1, rx2, ry1, ry2
+pointer	sp, cmd, userwts, x1, y1, w1, n
+
+int	gt_gcur1(), stridxs(), scan(), nscan()
+int	icg_nearestd()
+double	dcveval()
+errchk	ic_fitd()
+
+begin
+	call smark (sp)
+	call salloc (cmd, IC_SZSAMPLE, TY_CHAR)
+
+	# Allocate memory for the fit and a copy of the weights.
+	# The weights are copied because they are changed when points are
+	# deleted.
+
+	n = npts
+	x1 = NULL
+	y1 = NULL
+	w1 = NULL
+	call malloc (userwts, n, TY_DOUBLE)
+	call amovd (wts, Memd[userwts], n)
+
+	# Initialize
+	IC_GP(ic) = gp
+	IC_GT(ic) = gt
+	IC_OVERPLOT(ic) = NO
+	IC_NEWX(ic) = YES
+	IC_NEWY(ic) = YES
+	IC_NEWWTS(ic) = YES
+	IC_NEWFUNCTION(ic) = YES
+
+	# Send the GUI the current task values.
+	call ic_gui (ic, "open")
+	call ic_gui (ic, "graph")
+
+	# Read cursor commands.
+
+	key = 'f'
+	newgraph = YES
+	axes[1] = IC_AXES(ic, IC_GKEY(ic), 1)
+	axes[2] = IC_AXES(ic, IC_GKEY(ic), 2)
+	xtype = 0
+
+	repeat {
+	    switch (key) {
+	    case '?': # Print help text.
+		call ic_gui (ic, "help")
+
+	    case ':': # List or set parameters
+		if (Memc[cmd] == '/')
+	            call gt_colon (Memc[cmd], gp, gt, newgraph)
+		else
+		    call icg_colond (ic, Memc[cmd], newgraph, gp, gt, cv,
+			x, y, wts, n)
+
+	    case 'a': # Add points
+		if ((IC_AXES(ic,IC_GKEY(ic),1) == 'x') &&
+		    (IC_AXES(ic,IC_GKEY(ic),2) == 'y'))
+		    ;
+		else if ((IC_AXES(ic,IC_GKEY(ic),1) == 'y') &&
+		    (IC_AXES(ic,IC_GKEY(ic),2) == 'x')) {
+		    rx1 = wx
+		    wx = wy
+		    wy = rx1
+		} else {
+		    call printf ("Graph must be x vs. y or y vs. x\07\n")
+		    next
+		}
+
+		rx1 = 1.
+		call printf ("weight = (%g) ")
+		    call pargr (rx1)
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargr (rx2)
+		    if (nscan() == 1)
+			if (!IS_INDEFR (rx2))
+			    rx1 = rx2
+		}
+
+		if (x1 == NULL) {
+		    call malloc (x1, n+1, TY_DOUBLE)
+		    call malloc (y1, n+1, TY_DOUBLE)
+		    call malloc (w1, n+1, TY_DOUBLE)
+		    call amovd (x, Memd[x1], n)
+		    call amovd (y, Memd[y1], n)
+		    call amovd (wts, Memd[w1], n)
+		} else {
+		    call realloc (x1, n+1, TY_DOUBLE)
+		    call realloc (y1, n+1, TY_DOUBLE)
+		    call realloc (w1, n+1, TY_DOUBLE)
+		}
+		call realloc (userwts, n+1, TY_DOUBLE)
+
+		call icg_addd (gp, wx, wy, rx1, Memd[x1], Memd[y1],
+		    Memd[w1], Memd[userwts], n)
+
+		IC_NEWX(ic) = YES
+		IC_NEWY(ic) = YES
+		IC_NEWWTS(ic) = YES
+
+	    case 'c': # Print the positions of data points.
+		if (x1 == NULL) {
+		    i = icg_nearestd (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = %g  y = %g  fit = %g\n")
+			    call pargd (x[i])
+			    call pargd (y[i])
+			    call pargd (dcveval (cv, x[i]))
+		    }
+		} else {
+		    i = icg_nearestd (ic, gp, gt, cv, Memd[x1], Memd[y1],
+			n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = %g  y = %g  fit = %g\n")
+			    call pargd (Memd[x1+i-1])
+			    call pargd (Memd[y1+i-1])
+			    call pargd (dcveval (cv, Memd[x1+i-1]))
+		    }
+		}
+
+	    case 'd': # Delete data points.
+		if (x1 == NULL)
+		    call icg_deleted (ic, gp, gt, cv, x, y, wts,
+			Memd[userwts], n, wx, wy)
+		else
+		    call icg_deleted (ic, gp, gt, cv, Memd[x1], Memd[y1],
+			Memd[w1], Memd[userwts], n, wx, wy)
+		call ic_gui (ic, "refit YES")
+
+	    case 'f': # Fit the function and reset the flags.
+		iferr {
+		    if (x1 == NULL)
+			call ic_fitd (ic, cv, x, y, wts, n, IC_NEWX(ic),
+			    IC_NEWY(ic), IC_NEWWTS(ic), IC_NEWFUNCTION(ic))
+		    else
+			call ic_fitd (ic, cv, Memd[x1], Memd[y1], Memd[w1],
+			    n, IC_NEWX(ic), IC_NEWY(ic), IC_NEWWTS(ic),
+			    IC_NEWFUNCTION(ic))
+
+		    IC_NEWX(ic) = NO
+		    IC_NEWY(ic) = NO
+		    IC_NEWWTS(ic) = NO
+		    IC_NEWFUNCTION(ic) = NO
+		    IC_FITERROR(ic) = NO
+		    newgraph = YES
+
+		    call  ic_gui (ic, "refit NO")
+		} then {
+		    IC_FITERROR(ic) = YES
+		    call erract (EA_WARN)
+		}
+
+	    case 'g':	# Set graph axes types.
+		call printf ("Graph key to be defined: ")
+		call flush (STDOUT)
+		if (scan() == EOF)
+		    goto 10
+		call gargc (Memc[cmd])
+
+		switch (Memc[cmd]) {
+		case '\n':
+		case 'h', 'i', 'j', 'k', 'l':
+		    switch (Memc[cmd]) {
+		    case 'h':
+		        key = 1
+		    case 'i':
+		        key = 2
+		    case 'j':
+		        key = 3
+		    case 'k':
+		        key = 4
+		    case 'l':
+		        key = 5
+		    }
+
+		    call printf ("Set graph axes types (%c, %c): ")
+		        call pargi (IC_AXES(ic, key, 1))
+		        call pargi (IC_AXES(ic, key, 2))
+		    call flush (STDOUT)
+		    if (scan() == EOF)
+		        goto 10
+		    call gargc (Memc[cmd])
+
+		    switch (Memc[cmd]) {
+		    case '\n':
+		    default:
+		        call gargc (Memc[cmd+1])
+		        call gargc (Memc[cmd+1])
+		        if (Memc[cmd+1] != '\n') {
+			    IC_AXES(ic, key, 1) = Memc[cmd]
+			    IC_AXES(ic, key, 2) = Memc[cmd+1]
+			    if (IC_GKEY(ic) == key)
+				newgraph = YES
+		        }
+		    }
+		default:
+		    call printf ("Not a graph key\n")
+		}
+
+	    case 'h':
+		if (IC_GKEY(ic) != 1) {
+		    IC_GKEY(ic) = 1
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'i':
+		if (IC_GKEY(ic) != 2) {
+		    IC_GKEY(ic) = 2
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'j':
+		if (IC_GKEY(ic) != 3) {
+		    IC_GKEY(ic) = 3
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'k':
+		if (IC_GKEY(ic) != 4) {
+		    IC_GKEY(ic) = 4
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'l':
+		if (IC_GKEY(ic) != 5) {
+		    IC_GKEY(ic) = 5
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 't': # Initialize the sample string and erase from the graph.
+		if (x1 == NULL)
+		    call icg_sampled (ic, gp, gt, x, n, 0)
+		else
+		    call icg_sampled (ic, gp, gt, Memd[x1], n, 0)
+		call ic_pstr (ic, "sample", "*")
+		IC_NEWX(ic) = YES
+
+	    case 'o': # Set overplot flag
+		IC_OVERPLOT(ic) = YES
+
+	    case 'r': # Redraw the graph
+		newgraph = YES
+
+	    case 's': # Set sample regions with the cursor.
+		if ((IC_AXES(ic,IC_GKEY(ic),1) == 'x') ||
+		    (IC_AXES(ic,IC_GKEY(ic),2) == 'x')) {
+		    if (stridxs ("*", Memc[IC_SAMPLE(ic)]) > 0)
+		        Memc[IC_SAMPLE(ic)] = EOS
+
+		    rx1 = wx
+		    ry1 = wy
+		    call printf ("again:\n")
+		    if (gt_gcur1(gt, cursor, wx, wy, wcs, key, Memc[cmd],
+			IC_SZSAMPLE) == EOF)
+		        break
+		    call printf ("\n")
+		    rx2 = wx
+		    ry2 = wy
+
+		    # Determine if the x vector is integer.
+		    if (xtype == 0) {
+			xtype = TY_INT
+			if (x1 == NULL) {
+			    do i = 1, n
+				if (x[i] != int (x[i])) {
+				    xtype = TY_REAL
+				    break
+				}
+			} else {
+			    do i = 1, n
+				if (Memd[x1+i-1] != int (Memd[x1+i-1])) {
+				    xtype = TY_REAL
+				    break
+				}
+			}
+		    }
+
+		    if (IC_AXES(ic,IC_GKEY(ic),1) == 'x') {
+		        if (xtype == TY_INT) {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %d:%d")
+		                call pargi (nint (rx1))
+		                call pargi (nint (rx2))
+			} else {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %g:%g")
+		                call pargr (rx1)
+		                call pargr (rx2)
+			}
+		    } else {
+		        if (xtype == TY_INT) {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %d:%d")
+		                call pargi (nint (ry1))
+		                call pargi (nint (ry2))
+			} else {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %g:%g")
+		                call pargr (ry1)
+		                call pargr (ry2)
+			}
+		    }
+		    call strcat (Memc[cmd], Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+		    if (x1 == NULL)
+			call icg_sampled (ic, gp, gt, x, n, 1)
+		    else
+			call icg_sampled (ic, gp, gt, Memd[x1], n, 1)
+		    call ic_pstr (ic, "sample",  Memc[IC_SAMPLE(ic)])
+		    IC_NEWX(ic) = YES
+		}
+
+	    case 'u': # Undelete data points.
+		if (x1 == NULL)
+		    call icg_undeleted (ic, gp, gt, cv, x, y, wts,
+			Memd[userwts], n, wx, wy)
+		else
+		    call icg_undeleted (ic, gp, gt, cv, Memd[x1], Memd[y1],
+			Memd[w1], Memd[userwts], n, wx, wy)
+		call ic_gui (ic, "refit YES")
+
+	    case 'w':  # Window graph
+		call gt_window (gt, gp, cursor, newgraph)
+
+	    case 'v': # Reset the value of the weight.
+		if (x1 == NULL) {
+		    i = icg_nearestd (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("weight = (%g) ")
+			    call pargd (wts[i])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargd (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    wts[i] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWWTS(ic) = YES
+				}
+			    }
+			}
+		    }
+		} else {
+		    i = icg_nearestd (ic, gp, gt, cv, Memd[x1], Memd[y1], n,
+			wx, wy)
+
+		    if (i != 0) {
+			call printf ("weight = (%g) ")
+			    call pargd (Memd[w1+i-1])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargd (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    j = icg_nearestd (ic, gp, gt, cv, x, y, n,
+					wx, wy)
+				    if (j != 0)
+					if (x[j] == Memd[x1+i-1] &&
+					    y[j] == Memd[y1+i-1])
+					    wts[j] = px1
+				    Memd[w1+i-1] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWWTS(ic) = YES
+				}
+			    }
+			}
+		    }
+		}
+
+	    case 'x': # Reset the value of the x point.
+		if (x1 == NULL) {
+		    i = icg_nearestd (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = (%g) ")
+			    call pargd (x[i])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargd (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    x[i] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWX(ic) = YES
+				}
+			    }
+			}
+		    }
+		} else {
+		    i = icg_nearestd (ic, gp, gt, cv, Memd[x1], Memd[y1], n,
+			wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = (%g) ")
+			    call pargd (Memd[x1+i-1])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargd (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    j = icg_nearestd (ic, gp, gt, cv, x, y, n,
+					wx, wy)
+				    if (j != 0)
+					if (x[j] == Memd[x1+i-1] &&
+					    y[j] == Memd[y1+i-1])
+					    x[j] = px1
+				    Memd[x1+i-1] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWX(ic) = YES
+				}
+			    }
+			}
+		    }
+		}
+
+	    case 'y': # Reset the value of the y point.
+		if (x1 == NULL) {
+		    i = icg_nearestd (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("y = (%g) ")
+			    call pargd (y[i])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargd (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    y[i] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWY(ic) = YES
+				}
+			    }
+			}
+		    }
+		} else {
+		    i = icg_nearestd (ic, gp, gt, cv, Memd[x1], Memd[y1], n,
+			wx, wy)
+
+		    if (i != 0) {
+			call printf ("y = (%g) ")
+			    call pargd (Memd[y1+i-1])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargd (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    j = icg_nearestd (ic, gp, gt, cv, x, y, n,
+					wx, wy)
+				    if (j != 0)
+					if (x[j] == Memd[x1+i-1] &&
+					    y[j] == Memd[y1+i-1])
+					    y[j] = px1
+				    Memd[y1+i-1] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWY(ic) = YES
+				}
+			    }
+			}
+		    }
+		}
+
+	    case 'z': # Delete sample region
+		if (x1 == NULL)
+		    call icg_dsampled (wx, wy, ic, gp, gt, x, n)
+		else
+		    call icg_dsampled (wx, wy, ic, gp, gt, Memd[x1], n)
+		call ic_pstr (ic, "sample", Memc[IC_SAMPLE(ic)])
+
+	    case 'I': # Interrupt
+		call fatal (0, "Interrupt")
+
+	    default: # Let the user decide on any other keys.
+		call icg_user (ic, gp, gt, cv, wx, wy, wcs, key, Memc[cmd])
+	    }
+
+	    # Redraw the graph if necessary.
+10	    if (newgraph == YES) {
+		if (IC_AXES(ic, IC_GKEY(ic), 1) != axes[1]) {
+		    axes[1] = IC_AXES(ic, IC_GKEY(ic), 1)
+		    call gt_setr (gt, GTXMIN, INDEFR)
+		    call gt_setr (gt, GTXMAX, INDEFR)
+		}
+		if (IC_AXES(ic, IC_GKEY(ic), 2) != axes[2]) {
+		    axes[2] = IC_AXES(ic, IC_GKEY(ic), 2)
+		    call gt_setr (gt, GTYMIN, INDEFR)
+		    call gt_setr (gt, GTYMAX, INDEFR)
+		}
+		if (x1 == NULL)
+		    call icg_graphd (ic, gp, gt, cv, x, y, wts, n)
+		else
+		    call icg_graphd (ic, gp, gt, cv, Memd[x1], Memd[y1],
+			Memd[w1], n)
+		newgraph = NO
+	    }
+	    if (cursor[1] == EOS)
+		break
+	} until (gt_gcur1 (gt, cursor, wx, wy, wcs, key, Memc[cmd],
+	    IC_SZSAMPLE) == EOF)
+
+	call ic_gui (ic, "close")
+	IC_GP(ic) = NULL
+
+	if (x1 != NULL) {
+	    call mfree (x1, TY_DOUBLE)
+	    call mfree (y1, TY_DOUBLE)
+	    call mfree (w1, TY_DOUBLE)
+	    if (IC_WTSFIT(ic) == NULL)
+		IC_NFIT(ic) = npts
+	}
+	call mfree (userwts, TY_DOUBLE)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgfitr.x b/pkg/xtools/icfit/icgfitr.x
new file mode 100644
index 00000000..d10c1607
--- /dev/null
+++ b/pkg/xtools/icfit/icgfitr.x
@@ -0,0 +1,544 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<pkg/gtools.h>
+include	"names.h"
+include	"icfit.h"
+
+# ICG_FIT -- Interactive curve fitting with graphics.  This is the main
+# entry point for the interactive graphics part of the icfit package.
+
+procedure icg_fitr (ic, gp, cursor, gt, cv, x, y, wts, npts)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+char	cursor[ARB]		# GIO cursor input
+pointer	gt			# GTOOLS pointer
+pointer	cv			# CURFIT pointer
+real	x[npts]			# Ordinates
+real	y[npts]			# Abscissas
+real	wts[npts]		# Weights
+int	npts			# Number of points
+
+real	wx, wy
+int	wcs, key
+
+int	i, j, newgraph, axes[2], xtype
+real	px1
+real	rx1, rx2, ry1, ry2
+pointer	sp, cmd, userwts, x1, y1, w1, n
+
+int	gt_gcur1(), stridxs(), scan(), nscan()
+int	icg_nearestr()
+real	rcveval()
+errchk	ic_fitr()
+
+begin
+	call smark (sp)
+	call salloc (cmd, IC_SZSAMPLE, TY_CHAR)
+
+	# Allocate memory for the fit and a copy of the weights.
+	# The weights are copied because they are changed when points are
+	# deleted.
+
+	n = npts
+	x1 = NULL
+	y1 = NULL
+	w1 = NULL
+	call malloc (userwts, n, TY_REAL)
+	call amovr (wts, Memr[userwts], n)
+
+	# Initialize
+	IC_GP(ic) = gp
+	IC_GT(ic) = gt
+	IC_OVERPLOT(ic) = NO
+	IC_NEWX(ic) = YES
+	IC_NEWY(ic) = YES
+	IC_NEWWTS(ic) = YES
+	IC_NEWFUNCTION(ic) = YES
+
+	# Send the GUI the current task values.
+	call ic_gui (ic, "open")
+	call ic_gui (ic, "graph")
+
+	# Read cursor commands.
+
+	key = 'f'
+	newgraph = YES
+	axes[1] = IC_AXES(ic, IC_GKEY(ic), 1)
+	axes[2] = IC_AXES(ic, IC_GKEY(ic), 2)
+	xtype = 0
+
+	repeat {
+	    switch (key) {
+	    case '?': # Print help text.
+		call ic_gui (ic, "help")
+
+	    case ':': # List or set parameters
+		if (Memc[cmd] == '/')
+	            call gt_colon (Memc[cmd], gp, gt, newgraph)
+		else
+		    call icg_colonr (ic, Memc[cmd], newgraph, gp, gt, cv,
+			x, y, wts, n)
+
+	    case 'a': # Add points
+		if ((IC_AXES(ic,IC_GKEY(ic),1) == 'x') &&
+		    (IC_AXES(ic,IC_GKEY(ic),2) == 'y'))
+		    ;
+		else if ((IC_AXES(ic,IC_GKEY(ic),1) == 'y') &&
+		    (IC_AXES(ic,IC_GKEY(ic),2) == 'x')) {
+		    rx1 = wx
+		    wx = wy
+		    wy = rx1
+		} else {
+		    call printf ("Graph must be x vs. y or y vs. x\07\n")
+		    next
+		}
+
+		rx1 = 1.
+		call printf ("weight = (%g) ")
+		    call pargr (rx1)
+		call flush (STDOUT)
+		if (scan() != EOF) {
+		    call gargr (rx2)
+		    if (nscan() == 1)
+			if (!IS_INDEFR (rx2))
+			    rx1 = rx2
+		}
+
+		if (x1 == NULL) {
+		    call malloc (x1, n+1, TY_REAL)
+		    call malloc (y1, n+1, TY_REAL)
+		    call malloc (w1, n+1, TY_REAL)
+		    call amovr (x, Memr[x1], n)
+		    call amovr (y, Memr[y1], n)
+		    call amovr (wts, Memr[w1], n)
+		} else {
+		    call realloc (x1, n+1, TY_REAL)
+		    call realloc (y1, n+1, TY_REAL)
+		    call realloc (w1, n+1, TY_REAL)
+		}
+		call realloc (userwts, n+1, TY_REAL)
+
+		call icg_addr (gp, wx, wy, rx1, Memr[x1], Memr[y1],
+		    Memr[w1], Memr[userwts], n)
+
+		IC_NEWX(ic) = YES
+		IC_NEWY(ic) = YES
+		IC_NEWWTS(ic) = YES
+
+	    case 'c': # Print the positions of data points.
+		if (x1 == NULL) {
+		    i = icg_nearestr (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = %g  y = %g  fit = %g\n")
+			    call pargr (x[i])
+			    call pargr (y[i])
+			    call pargr (rcveval (cv, x[i]))
+		    }
+		} else {
+		    i = icg_nearestr (ic, gp, gt, cv, Memr[x1], Memr[y1],
+			n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = %g  y = %g  fit = %g\n")
+			    call pargr (Memr[x1+i-1])
+			    call pargr (Memr[y1+i-1])
+			    call pargr (rcveval (cv, Memr[x1+i-1]))
+		    }
+		}
+
+	    case 'd': # Delete data points.
+		if (x1 == NULL)
+		    call icg_deleter (ic, gp, gt, cv, x, y, wts,
+			Memr[userwts], n, wx, wy)
+		else
+		    call icg_deleter (ic, gp, gt, cv, Memr[x1], Memr[y1],
+			Memr[w1], Memr[userwts], n, wx, wy)
+		call ic_gui (ic, "refit YES")
+
+	    case 'f': # Fit the function and reset the flags.
+		iferr {
+		    if (x1 == NULL)
+			call ic_fitr (ic, cv, x, y, wts, n, IC_NEWX(ic),
+			    IC_NEWY(ic), IC_NEWWTS(ic), IC_NEWFUNCTION(ic))
+		    else
+			call ic_fitr (ic, cv, Memr[x1], Memr[y1], Memr[w1],
+			    n, IC_NEWX(ic), IC_NEWY(ic), IC_NEWWTS(ic),
+			    IC_NEWFUNCTION(ic))
+
+		    IC_NEWX(ic) = NO
+		    IC_NEWY(ic) = NO
+		    IC_NEWWTS(ic) = NO
+		    IC_NEWFUNCTION(ic) = NO
+		    IC_FITERROR(ic) = NO
+		    newgraph = YES
+
+		    call  ic_gui (ic, "refit NO")
+		} then {
+		    IC_FITERROR(ic) = YES
+		    call erract (EA_WARN)
+		}
+
+	    case 'g':	# Set graph axes types.
+		call printf ("Graph key to be defined: ")
+		call flush (STDOUT)
+		if (scan() == EOF)
+		    goto 10
+		call gargc (Memc[cmd])
+
+		switch (Memc[cmd]) {
+		case '\n':
+		case 'h', 'i', 'j', 'k', 'l':
+		    switch (Memc[cmd]) {
+		    case 'h':
+		        key = 1
+		    case 'i':
+		        key = 2
+		    case 'j':
+		        key = 3
+		    case 'k':
+		        key = 4
+		    case 'l':
+		        key = 5
+		    }
+
+		    call printf ("Set graph axes types (%c, %c): ")
+		        call pargi (IC_AXES(ic, key, 1))
+		        call pargi (IC_AXES(ic, key, 2))
+		    call flush (STDOUT)
+		    if (scan() == EOF)
+		        goto 10
+		    call gargc (Memc[cmd])
+
+		    switch (Memc[cmd]) {
+		    case '\n':
+		    default:
+		        call gargc (Memc[cmd+1])
+		        call gargc (Memc[cmd+1])
+		        if (Memc[cmd+1] != '\n') {
+			    IC_AXES(ic, key, 1) = Memc[cmd]
+			    IC_AXES(ic, key, 2) = Memc[cmd+1]
+			    if (IC_GKEY(ic) == key)
+				newgraph = YES
+		        }
+		    }
+		default:
+		    call printf ("Not a graph key\n")
+		}
+
+	    case 'h':
+		if (IC_GKEY(ic) != 1) {
+		    IC_GKEY(ic) = 1
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'i':
+		if (IC_GKEY(ic) != 2) {
+		    IC_GKEY(ic) = 2
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'j':
+		if (IC_GKEY(ic) != 3) {
+		    IC_GKEY(ic) = 3
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'k':
+		if (IC_GKEY(ic) != 4) {
+		    IC_GKEY(ic) = 4
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 'l':
+		if (IC_GKEY(ic) != 5) {
+		    IC_GKEY(ic) = 5
+		    newgraph = YES
+		    call ic_gui (ic, "graph")
+		}
+
+	    case 't': # Initialize the sample string and erase from the graph.
+		if (x1 == NULL)
+		    call icg_sampler (ic, gp, gt, x, n, 0)
+		else
+		    call icg_sampler (ic, gp, gt, Memr[x1], n, 0)
+		call ic_pstr (ic, "sample", "*")
+		IC_NEWX(ic) = YES
+
+	    case 'o': # Set overplot flag
+		IC_OVERPLOT(ic) = YES
+
+	    case 'r': # Redraw the graph
+		newgraph = YES
+
+	    case 's': # Set sample regions with the cursor.
+		if ((IC_AXES(ic,IC_GKEY(ic),1) == 'x') ||
+		    (IC_AXES(ic,IC_GKEY(ic),2) == 'x')) {
+		    if (stridxs ("*", Memc[IC_SAMPLE(ic)]) > 0)
+		        Memc[IC_SAMPLE(ic)] = EOS
+
+		    rx1 = wx
+		    ry1 = wy
+		    call printf ("again:\n")
+		    if (gt_gcur1(gt, cursor, wx, wy, wcs, key, Memc[cmd],
+			IC_SZSAMPLE) == EOF)
+		        break
+		    call printf ("\n")
+		    rx2 = wx
+		    ry2 = wy
+
+		    # Determine if the x vector is integer.
+		    if (xtype == 0) {
+			xtype = TY_INT
+			if (x1 == NULL) {
+			    do i = 1, n
+				if (x[i] != int (x[i])) {
+				    xtype = TY_REAL
+				    break
+				}
+			} else {
+			    do i = 1, n
+				if (Memr[x1+i-1] != int (Memr[x1+i-1])) {
+				    xtype = TY_REAL
+				    break
+				}
+			}
+		    }
+
+		    if (IC_AXES(ic,IC_GKEY(ic),1) == 'x') {
+		        if (xtype == TY_INT) {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %d:%d")
+		                call pargi (nint (rx1))
+		                call pargi (nint (rx2))
+			} else {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %g:%g")
+		                call pargr (rx1)
+		                call pargr (rx2)
+			}
+		    } else {
+		        if (xtype == TY_INT) {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %d:%d")
+		                call pargi (nint (ry1))
+		                call pargi (nint (ry2))
+			} else {
+		            call sprintf (Memc[cmd], IC_SZSAMPLE, " %g:%g")
+		                call pargr (ry1)
+		                call pargr (ry2)
+			}
+		    }
+		    call strcat (Memc[cmd], Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+		    if (x1 == NULL)
+			call icg_sampler (ic, gp, gt, x, n, 1)
+		    else
+			call icg_sampler (ic, gp, gt, Memr[x1], n, 1)
+		    call ic_pstr (ic, "sample",  Memc[IC_SAMPLE(ic)])
+		    IC_NEWX(ic) = YES
+		}
+
+	    case 'u': # Undelete data points.
+		if (x1 == NULL)
+		    call icg_undeleter (ic, gp, gt, cv, x, y, wts,
+			Memr[userwts], n, wx, wy)
+		else
+		    call icg_undeleter (ic, gp, gt, cv, Memr[x1], Memr[y1],
+			Memr[w1], Memr[userwts], n, wx, wy)
+		call ic_gui (ic, "refit YES")
+
+	    case 'w':  # Window graph
+		call gt_window (gt, gp, cursor, newgraph)
+
+	    case 'v': # Reset the value of the weight.
+		if (x1 == NULL) {
+		    i = icg_nearestr (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("weight = (%g) ")
+			    call pargr (wts[i])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargr (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    wts[i] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWWTS(ic) = YES
+				}
+			    }
+			}
+		    }
+		} else {
+		    i = icg_nearestr (ic, gp, gt, cv, Memr[x1], Memr[y1], n,
+			wx, wy)
+
+		    if (i != 0) {
+			call printf ("weight = (%g) ")
+			    call pargr (Memr[w1+i-1])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargr (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    j = icg_nearestr (ic, gp, gt, cv, x, y, n,
+					wx, wy)
+				    if (j != 0)
+					if (x[j] == Memr[x1+i-1] &&
+					    y[j] == Memr[y1+i-1])
+					    wts[j] = px1
+				    Memr[w1+i-1] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWWTS(ic) = YES
+				}
+			    }
+			}
+		    }
+		}
+
+	    case 'x': # Reset the value of the x point.
+		if (x1 == NULL) {
+		    i = icg_nearestr (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = (%g) ")
+			    call pargr (x[i])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargr (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    x[i] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWX(ic) = YES
+				}
+			    }
+			}
+		    }
+		} else {
+		    i = icg_nearestr (ic, gp, gt, cv, Memr[x1], Memr[y1], n,
+			wx, wy)
+
+		    if (i != 0) {
+			call printf ("x = (%g) ")
+			    call pargr (Memr[x1+i-1])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargr (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    j = icg_nearestr (ic, gp, gt, cv, x, y, n,
+					wx, wy)
+				    if (j != 0)
+					if (x[j] == Memr[x1+i-1] &&
+					    y[j] == Memr[y1+i-1])
+					    x[j] = px1
+				    Memr[x1+i-1] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWX(ic) = YES
+				}
+			    }
+			}
+		    }
+		}
+
+	    case 'y': # Reset the value of the y point.
+		if (x1 == NULL) {
+		    i = icg_nearestr (ic, gp, gt, cv, x, y, n, wx, wy)
+
+		    if (i != 0) {
+			call printf ("y = (%g) ")
+			    call pargr (y[i])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargr (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    y[i] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWY(ic) = YES
+				}
+			    }
+			}
+		    }
+		} else {
+		    i = icg_nearestr (ic, gp, gt, cv, Memr[x1], Memr[y1], n,
+			wx, wy)
+
+		    if (i != 0) {
+			call printf ("y = (%g) ")
+			    call pargr (Memr[y1+i-1])
+			call flush (STDOUT)
+			if (scan() != EOF) {
+			    call gargr (px1)
+			    if (nscan() == 1) {
+				if (!IS_INDEF (px1)) {
+				    j = icg_nearestr (ic, gp, gt, cv, x, y, n,
+					wx, wy)
+				    if (j != 0)
+					if (x[j] == Memr[x1+i-1] &&
+					    y[j] == Memr[y1+i-1])
+					    y[j] = px1
+				    Memr[y1+i-1] = px1
+				    call ic_gui (ic, "refit YES")
+				    IC_NEWY(ic) = YES
+				}
+			    }
+			}
+		    }
+		}
+
+	    case 'z': # Delete sample region
+		if (x1 == NULL)
+		    call icg_dsampler (wx, wy, ic, gp, gt, x, n)
+		else
+		    call icg_dsampler (wx, wy, ic, gp, gt, Memr[x1], n)
+		call ic_pstr (ic, "sample", Memc[IC_SAMPLE(ic)])
+
+	    case 'I': # Interrupt
+		call fatal (0, "Interrupt")
+
+	    default: # Let the user decide on any other keys.
+		call icg_user (ic, gp, gt, cv, wx, wy, wcs, key, Memc[cmd])
+	    }
+
+	    # Redraw the graph if necessary.
+10	    if (newgraph == YES) {
+		if (IC_AXES(ic, IC_GKEY(ic), 1) != axes[1]) {
+		    axes[1] = IC_AXES(ic, IC_GKEY(ic), 1)
+		    call gt_setr (gt, GTXMIN, INDEFR)
+		    call gt_setr (gt, GTXMAX, INDEFR)
+		}
+		if (IC_AXES(ic, IC_GKEY(ic), 2) != axes[2]) {
+		    axes[2] = IC_AXES(ic, IC_GKEY(ic), 2)
+		    call gt_setr (gt, GTYMIN, INDEFR)
+		    call gt_setr (gt, GTYMAX, INDEFR)
+		}
+		if (x1 == NULL)
+		    call icg_graphr (ic, gp, gt, cv, x, y, wts, n)
+		else
+		    call icg_graphr (ic, gp, gt, cv, Memr[x1], Memr[y1],
+			Memr[w1], n)
+		newgraph = NO
+	    }
+	    if (cursor[1] == EOS)
+		break
+	} until (gt_gcur1 (gt, cursor, wx, wy, wcs, key, Memc[cmd],
+	    IC_SZSAMPLE) == EOF)
+
+	call ic_gui (ic, "close")
+	IC_GP(ic) = NULL
+
+	if (x1 != NULL) {
+	    call mfree (x1, TY_REAL)
+	    call mfree (y1, TY_REAL)
+	    call mfree (w1, TY_REAL)
+	    if (IC_WTSFIT(ic) == NULL)
+		IC_NFIT(ic) = npts
+	}
+	call mfree (userwts, TY_REAL)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icggraph.gx b/pkg/xtools/icfit/icggraph.gx
new file mode 100644
index 00000000..393582db
--- /dev/null
+++ b/pkg/xtools/icfit/icggraph.gx
@@ -0,0 +1,226 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<pkg/gtools.h>
+include	"names.h"
+include	"icfit.h"
+
+define	NGRAPH		100		# Number of fit points to graph
+define	MSIZE		2.		# Mark size
+
+# ICG_GRAPH -- Graph data and fit.
+
+procedure icg_graph$t (ic, gp, gt, cv, x, y, wts, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointers
+pointer	cv				# Curfit pointer
+PIXEL	x[npts]				# Independent variable
+PIXEL	y[npts]				# Dependent variable
+PIXEL	wts[npts]			# Weights
+int	npts				# Number of points
+
+pointer	xout, yout
+real	size
+
+begin
+	call malloc (xout, npts, TY_PIXEL)
+	call malloc (yout, npts, TY_PIXEL)
+	call icg_axes$t (ic, gt, cv, 1, x, y, Mem$t[xout], npts)
+	call icg_axes$t (ic, gt, cv, 2, x, y, Mem$t[yout], npts)
+	call icg_params$t (ic, cv, x, y, wts, npts, gt)
+
+	call icg_g1$t (ic, gp, gt, Mem$t[xout], Mem$t[yout], wts, npts)
+
+ 	# Symbol size for averaged ranges.
+ 	size = abs(IC_NAVERAGE(ic) * (Mem$t[xout+npts-1] - Mem$t[xout]) / 
+ 	       float(npts))
+ 
+	if (npts != IC_NFIT(ic)) {
+	    if ((abs (IC_NAVERAGE(ic)) > 1) || (IC_NREJECT(ic) > 0)) {
+	        call realloc (xout, IC_NFIT(ic), TY_PIXEL)
+		call realloc (yout, IC_NFIT(ic), TY_PIXEL)
+		call icg_axes$t (ic, gt, cv, 1, Mem$t[IC_XFIT(ic)],
+		    Mem$t[IC_YFIT(ic)], Mem$t[xout], IC_NFIT(ic))
+		call icg_axes$t (ic, gt, cv, 2, Mem$t[IC_XFIT(ic)],
+		    Mem$t[IC_YFIT(ic)], Mem$t[yout], IC_NFIT(ic))
+		call icg_g2$t (ic, gp, gt, Mem$t[xout], Mem$t[yout],
+		    IC_NFIT(ic), size)
+	    }
+
+	} else if (IC_NREJECT(ic) > 0)
+	    call icg_g2$t (ic, gp, gt, Mem$t[xout], Mem$t[yout], npts, size)
+
+	call icg_gf$t (ic, gp, gt, cv, max (npts, NGRAPH))
+
+	# Mark the the sample regions.
+
+	call icg_sample$t (ic, gp, gt, x, npts, 1)
+
+	# Send the wcs to the gui.
+	call ic_gui (ic, "wcs")
+
+	call mfree (xout, TY_PIXEL)
+	call mfree (yout, TY_PIXEL)
+end
+
+procedure icg_g1$t (ic, gp, gt, x, y, wts, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+PIXEL	x[npts]				# Ordinates
+PIXEL	y[npts]				# Abscissas
+PIXEL	wts[npts]			# Weights
+int	npts				# Number of points
+
+int	i
+pointer	sp, xr, yr, xr1, yr1, gt1
+
+begin
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (xr1, 2, TY_REAL)
+	call salloc (yr1, 2, TY_REAL)
+	call acht$tr (x, Memr[xr], npts)
+	call acht$tr (y, Memr[yr], npts)
+
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "cross")
+
+	if (IC_OVERPLOT(ic) == NO) {
+	    # Start a new plot.
+
+	    call gclear (gp)
+
+	    # Set the graph scale and axes.
+
+	    call gascale (gp, Memr[xr], npts, 1)
+	    call gascale (gp, Memr[yr], npts, 2)
+	    call gt_swind (gp, gt)
+	    call gt_labax (gp, gt)
+	}
+
+	if (IC_OVERPLOT(ic) == NO) {
+	    Memr[xr1] = Memr[xr]
+	    Memr[yr1] = Memr[yr]
+	    do i = 1, npts {
+		if (wts[i] == 0.) {
+		    call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1) 
+		} else {
+		    Memr[xr1+1] = Memr[xr+i-1]
+		    Memr[yr1+1] = Memr[yr+i-1]
+		    call gt_plot (gp, gt, Memr[xr1], Memr[yr1], 2)
+		    Memr[xr1] = Memr[xr1+1]
+		    Memr[yr1] = Memr[yr1+1]
+		}
+	    }
+	}
+
+	# Reset status flags.
+
+	IC_OVERPLOT(ic) = NO
+
+	call sfree (sp)
+	call gt_free (gt1)
+end
+
+procedure icg_g2$t (ic, gp, gt, x, y, npts, size)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+PIXEL	x[npts], y[npts]	# Data points
+int	npts			# Number of data points
+real	size			# Symbol size
+
+int	i
+pointer	sp, xr, yr, gt1
+
+begin
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call acht$tr (x, Memr[xr], npts)
+	call acht$tr (y, Memr[yr], npts)
+
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+
+	# Mark the sample points.
+
+	if (abs (IC_NAVERAGE(ic)) > 1) {
+	    call gt_sets (gt1, GTMARK, "plus")
+ 	    call gt_setr (gt1, GTXSIZE, -size)
+	    call gt_setr (gt1, GTYSIZE, 1.)
+	    call gt_plot (gp, gt1, Memr[xr], Memr[yr], npts)
+	}
+
+	# Mark the rejected points.
+
+	if (IC_NREJECT(ic) > 0 && IC_MARKREJ(ic) == YES) {
+	    call gt_sets (gt1, GTMARK, "diamond")
+	    call gt_setr (gt1, GTXSIZE, MSIZE)
+	    call gt_setr (gt1, GTYSIZE, MSIZE)
+	    do i = 1, npts {
+		if (Memi[IC_REJPTS(ic)+i-1] == YES)
+	            call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1)
+	    }
+	}
+
+	call gt_free (gt1)
+	call sfree (sp)
+end
+
+procedure icg_gf$t (ic, gp, gt, cv, npts)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOL pointer
+pointer	cv			# CURFIT pointer
+int	npts			# Number of points to plot
+
+pointer	sp, xr, yr, x, y, xo, yo, gt1
+int	i
+PIXEL	dx
+
+begin
+	if (IC_FITERROR(ic) == YES)
+	    return
+
+	call smark (sp)
+
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (x,  npts, TY_PIXEL)
+	call salloc (y,  npts, TY_PIXEL)
+	call salloc (xo, npts, TY_PIXEL)
+	call salloc (yo, npts, TY_PIXEL)
+
+	# Generate vector of independent variable values
+	dx = (IC_XMAX(ic) - IC_XMIN(ic)) / (npts - 1)
+	do i = 1, npts
+	    Mem$t[x+i-1] = IC_XMIN(ic) + (i-1) * dx
+
+	# Calculate vector of fit values. 
+	call $tcvvector (cv, Mem$t[x], Mem$t[y], npts)
+
+	# Convert to user function or transpose axes.  Change type to reals
+	# for plotting.
+	call icg_axes$t (ic, gt, cv, 1, Mem$t[x], Mem$t[y], Mem$t[xo], npts)
+	call icg_axes$t (ic, gt, cv, 2, Mem$t[x], Mem$t[y], Mem$t[yo], npts)
+	call acht$tr (Mem$t[xo], Memr[xr], npts)
+	call acht$tr (Mem$t[yo], Memr[yr], npts)
+
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "line")
+	call gt_seti (gt1, GTLINE, GL_DASHED)
+	call gt_seti (gt1, GTCOLOR, max (0, min (9, IC_COLOR(ic))))
+	call gt_plot (gp, gt1, Memr[xr], Memr[yr], npts)
+	call gt_free (gt1)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icggraphd.x b/pkg/xtools/icfit/icggraphd.x
new file mode 100644
index 00000000..03994a14
--- /dev/null
+++ b/pkg/xtools/icfit/icggraphd.x
@@ -0,0 +1,226 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<pkg/gtools.h>
+include	"names.h"
+include	"icfit.h"
+
+define	NGRAPH		100		# Number of fit points to graph
+define	MSIZE		2.		# Mark size
+
+# ICG_GRAPH -- Graph data and fit.
+
+procedure icg_graphd (ic, gp, gt, cv, x, y, wts, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointers
+pointer	cv				# Curfit pointer
+double	x[npts]				# Independent variable
+double	y[npts]				# Dependent variable
+double	wts[npts]			# Weights
+int	npts				# Number of points
+
+pointer	xout, yout
+real	size
+
+begin
+	call malloc (xout, npts, TY_DOUBLE)
+	call malloc (yout, npts, TY_DOUBLE)
+	call icg_axesd (ic, gt, cv, 1, x, y, Memd[xout], npts)
+	call icg_axesd (ic, gt, cv, 2, x, y, Memd[yout], npts)
+	call icg_paramsd (ic, cv, x, y, wts, npts, gt)
+
+	call icg_g1d (ic, gp, gt, Memd[xout], Memd[yout], wts, npts)
+
+ 	# Symbol size for averaged ranges.
+ 	size = abs(IC_NAVERAGE(ic) * (Memd[xout+npts-1] - Memd[xout]) / 
+ 	       float(npts))
+ 
+	if (npts != IC_NFIT(ic)) {
+	    if ((abs (IC_NAVERAGE(ic)) > 1) || (IC_NREJECT(ic) > 0)) {
+	        call realloc (xout, IC_NFIT(ic), TY_DOUBLE)
+		call realloc (yout, IC_NFIT(ic), TY_DOUBLE)
+		call icg_axesd (ic, gt, cv, 1, Memd[IC_XFIT(ic)],
+		    Memd[IC_YFIT(ic)], Memd[xout], IC_NFIT(ic))
+		call icg_axesd (ic, gt, cv, 2, Memd[IC_XFIT(ic)],
+		    Memd[IC_YFIT(ic)], Memd[yout], IC_NFIT(ic))
+		call icg_g2d (ic, gp, gt, Memd[xout], Memd[yout],
+		    IC_NFIT(ic), size)
+	    }
+
+	} else if (IC_NREJECT(ic) > 0)
+	    call icg_g2d (ic, gp, gt, Memd[xout], Memd[yout], npts, size)
+
+	call icg_gfd (ic, gp, gt, cv, max (npts, NGRAPH))
+
+	# Mark the the sample regions.
+
+	call icg_sampled (ic, gp, gt, x, npts, 1)
+
+	# Send the wcs to the gui.
+	call ic_gui (ic, "wcs")
+
+	call mfree (xout, TY_DOUBLE)
+	call mfree (yout, TY_DOUBLE)
+end
+
+procedure icg_g1d (ic, gp, gt, x, y, wts, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+double	x[npts]				# Ordinates
+double	y[npts]				# Abscissas
+double	wts[npts]			# Weights
+int	npts				# Number of points
+
+int	i
+pointer	sp, xr, yr, xr1, yr1, gt1
+
+begin
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (xr1, 2, TY_REAL)
+	call salloc (yr1, 2, TY_REAL)
+	call achtdr (x, Memr[xr], npts)
+	call achtdr (y, Memr[yr], npts)
+
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "cross")
+
+	if (IC_OVERPLOT(ic) == NO) {
+	    # Start a new plot.
+
+	    call gclear (gp)
+
+	    # Set the graph scale and axes.
+
+	    call gascale (gp, Memr[xr], npts, 1)
+	    call gascale (gp, Memr[yr], npts, 2)
+	    call gt_swind (gp, gt)
+	    call gt_labax (gp, gt)
+	}
+
+	if (IC_OVERPLOT(ic) == NO) {
+	    Memr[xr1] = Memr[xr]
+	    Memr[yr1] = Memr[yr]
+	    do i = 1, npts {
+		if (wts[i] == 0.) {
+		    call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1) 
+		} else {
+		    Memr[xr1+1] = Memr[xr+i-1]
+		    Memr[yr1+1] = Memr[yr+i-1]
+		    call gt_plot (gp, gt, Memr[xr1], Memr[yr1], 2)
+		    Memr[xr1] = Memr[xr1+1]
+		    Memr[yr1] = Memr[yr1+1]
+		}
+	    }
+	}
+
+	# Reset status flags.
+
+	IC_OVERPLOT(ic) = NO
+
+	call sfree (sp)
+	call gt_free (gt1)
+end
+
+procedure icg_g2d (ic, gp, gt, x, y, npts, size)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+double	x[npts], y[npts]	# Data points
+int	npts			# Number of data points
+real	size			# Symbol size
+
+int	i
+pointer	sp, xr, yr, gt1
+
+begin
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call achtdr (x, Memr[xr], npts)
+	call achtdr (y, Memr[yr], npts)
+
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+
+	# Mark the sample points.
+
+	if (abs (IC_NAVERAGE(ic)) > 1) {
+	    call gt_sets (gt1, GTMARK, "plus")
+ 	    call gt_setr (gt1, GTXSIZE, -size)
+	    call gt_setr (gt1, GTYSIZE, 1.)
+	    call gt_plot (gp, gt1, Memr[xr], Memr[yr], npts)
+	}
+
+	# Mark the rejected points.
+
+	if (IC_NREJECT(ic) > 0 && IC_MARKREJ(ic) == YES) {
+	    call gt_sets (gt1, GTMARK, "diamond")
+	    call gt_setr (gt1, GTXSIZE, MSIZE)
+	    call gt_setr (gt1, GTYSIZE, MSIZE)
+	    do i = 1, npts {
+		if (Memi[IC_REJPTS(ic)+i-1] == YES)
+	            call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1)
+	    }
+	}
+
+	call gt_free (gt1)
+	call sfree (sp)
+end
+
+procedure icg_gfd (ic, gp, gt, cv, npts)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOL pointer
+pointer	cv			# CURFIT pointer
+int	npts			# Number of points to plot
+
+pointer	sp, xr, yr, x, y, xo, yo, gt1
+int	i
+double	dx
+
+begin
+	if (IC_FITERROR(ic) == YES)
+	    return
+
+	call smark (sp)
+
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (x,  npts, TY_DOUBLE)
+	call salloc (y,  npts, TY_DOUBLE)
+	call salloc (xo, npts, TY_DOUBLE)
+	call salloc (yo, npts, TY_DOUBLE)
+
+	# Generate vector of independent variable values
+	dx = (IC_XMAX(ic) - IC_XMIN(ic)) / (npts - 1)
+	do i = 1, npts
+	    Memd[x+i-1] = IC_XMIN(ic) + (i-1) * dx
+
+	# Calculate vector of fit values. 
+	call dcvvector (cv, Memd[x], Memd[y], npts)
+
+	# Convert to user function or transpose axes.  Change type to reals
+	# for plotting.
+	call icg_axesd (ic, gt, cv, 1, Memd[x], Memd[y], Memd[xo], npts)
+	call icg_axesd (ic, gt, cv, 2, Memd[x], Memd[y], Memd[yo], npts)
+	call achtdr (Memd[xo], Memr[xr], npts)
+	call achtdr (Memd[yo], Memr[yr], npts)
+
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "line")
+	call gt_seti (gt1, GTLINE, GL_DASHED)
+	call gt_seti (gt1, GTCOLOR, max (0, min (9, IC_COLOR(ic))))
+	call gt_plot (gp, gt1, Memr[xr], Memr[yr], npts)
+	call gt_free (gt1)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icggraphr.x b/pkg/xtools/icfit/icggraphr.x
new file mode 100644
index 00000000..ac2a3f2c
--- /dev/null
+++ b/pkg/xtools/icfit/icggraphr.x
@@ -0,0 +1,226 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<pkg/gtools.h>
+include	"names.h"
+include	"icfit.h"
+
+define	NGRAPH		100		# Number of fit points to graph
+define	MSIZE		2.		# Mark size
+
+# ICG_GRAPH -- Graph data and fit.
+
+procedure icg_graphr (ic, gp, gt, cv, x, y, wts, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointers
+pointer	cv				# Curfit pointer
+real	x[npts]				# Independent variable
+real	y[npts]				# Dependent variable
+real	wts[npts]			# Weights
+int	npts				# Number of points
+
+pointer	xout, yout
+real	size
+
+begin
+	call malloc (xout, npts, TY_REAL)
+	call malloc (yout, npts, TY_REAL)
+	call icg_axesr (ic, gt, cv, 1, x, y, Memr[xout], npts)
+	call icg_axesr (ic, gt, cv, 2, x, y, Memr[yout], npts)
+	call icg_paramsr (ic, cv, x, y, wts, npts, gt)
+
+	call icg_g1r (ic, gp, gt, Memr[xout], Memr[yout], wts, npts)
+
+ 	# Symbol size for averaged ranges.
+ 	size = abs(IC_NAVERAGE(ic) * (Memr[xout+npts-1] - Memr[xout]) / 
+ 	       float(npts))
+ 
+	if (npts != IC_NFIT(ic)) {
+	    if ((abs (IC_NAVERAGE(ic)) > 1) || (IC_NREJECT(ic) > 0)) {
+	        call realloc (xout, IC_NFIT(ic), TY_REAL)
+		call realloc (yout, IC_NFIT(ic), TY_REAL)
+		call icg_axesr (ic, gt, cv, 1, Memr[IC_XFIT(ic)],
+		    Memr[IC_YFIT(ic)], Memr[xout], IC_NFIT(ic))
+		call icg_axesr (ic, gt, cv, 2, Memr[IC_XFIT(ic)],
+		    Memr[IC_YFIT(ic)], Memr[yout], IC_NFIT(ic))
+		call icg_g2r (ic, gp, gt, Memr[xout], Memr[yout],
+		    IC_NFIT(ic), size)
+	    }
+
+	} else if (IC_NREJECT(ic) > 0)
+	    call icg_g2r (ic, gp, gt, Memr[xout], Memr[yout], npts, size)
+
+	call icg_gfr (ic, gp, gt, cv, max (npts, NGRAPH))
+
+	# Mark the the sample regions.
+
+	call icg_sampler (ic, gp, gt, x, npts, 1)
+
+	# Send the wcs to the gui.
+	call ic_gui (ic, "wcs")
+
+	call mfree (xout, TY_REAL)
+	call mfree (yout, TY_REAL)
+end
+
+procedure icg_g1r (ic, gp, gt, x, y, wts, npts)
+
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+real	x[npts]				# Ordinates
+real	y[npts]				# Abscissas
+real	wts[npts]			# Weights
+int	npts				# Number of points
+
+int	i
+pointer	sp, xr, yr, xr1, yr1, gt1
+
+begin
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (xr1, 2, TY_REAL)
+	call salloc (yr1, 2, TY_REAL)
+	call achtrr (x, Memr[xr], npts)
+	call achtrr (y, Memr[yr], npts)
+
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "cross")
+
+	if (IC_OVERPLOT(ic) == NO) {
+	    # Start a new plot.
+
+	    call gclear (gp)
+
+	    # Set the graph scale and axes.
+
+	    call gascale (gp, Memr[xr], npts, 1)
+	    call gascale (gp, Memr[yr], npts, 2)
+	    call gt_swind (gp, gt)
+	    call gt_labax (gp, gt)
+	}
+
+	if (IC_OVERPLOT(ic) == NO) {
+	    Memr[xr1] = Memr[xr]
+	    Memr[yr1] = Memr[yr]
+	    do i = 1, npts {
+		if (wts[i] == 0.) {
+		    call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1) 
+		} else {
+		    Memr[xr1+1] = Memr[xr+i-1]
+		    Memr[yr1+1] = Memr[yr+i-1]
+		    call gt_plot (gp, gt, Memr[xr1], Memr[yr1], 2)
+		    Memr[xr1] = Memr[xr1+1]
+		    Memr[yr1] = Memr[yr1+1]
+		}
+	    }
+	}
+
+	# Reset status flags.
+
+	IC_OVERPLOT(ic) = NO
+
+	call sfree (sp)
+	call gt_free (gt1)
+end
+
+procedure icg_g2r (ic, gp, gt, x, y, npts, size)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+real	x[npts], y[npts]	# Data points
+int	npts			# Number of data points
+real	size			# Symbol size
+
+int	i
+pointer	sp, xr, yr, gt1
+
+begin
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call achtrr (x, Memr[xr], npts)
+	call achtrr (y, Memr[yr], npts)
+
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+
+	# Mark the sample points.
+
+	if (abs (IC_NAVERAGE(ic)) > 1) {
+	    call gt_sets (gt1, GTMARK, "plus")
+ 	    call gt_setr (gt1, GTXSIZE, -size)
+	    call gt_setr (gt1, GTYSIZE, 1.)
+	    call gt_plot (gp, gt1, Memr[xr], Memr[yr], npts)
+	}
+
+	# Mark the rejected points.
+
+	if (IC_NREJECT(ic) > 0 && IC_MARKREJ(ic) == YES) {
+	    call gt_sets (gt1, GTMARK, "diamond")
+	    call gt_setr (gt1, GTXSIZE, MSIZE)
+	    call gt_setr (gt1, GTYSIZE, MSIZE)
+	    do i = 1, npts {
+		if (Memi[IC_REJPTS(ic)+i-1] == YES)
+	            call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1)
+	    }
+	}
+
+	call gt_free (gt1)
+	call sfree (sp)
+end
+
+procedure icg_gfr (ic, gp, gt, cv, npts)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOL pointer
+pointer	cv			# CURFIT pointer
+int	npts			# Number of points to plot
+
+pointer	sp, xr, yr, x, y, xo, yo, gt1
+int	i
+real	dx
+
+begin
+	if (IC_FITERROR(ic) == YES)
+	    return
+
+	call smark (sp)
+
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (x,  npts, TY_REAL)
+	call salloc (y,  npts, TY_REAL)
+	call salloc (xo, npts, TY_REAL)
+	call salloc (yo, npts, TY_REAL)
+
+	# Generate vector of independent variable values
+	dx = (IC_XMAX(ic) - IC_XMIN(ic)) / (npts - 1)
+	do i = 1, npts
+	    Memr[x+i-1] = IC_XMIN(ic) + (i-1) * dx
+
+	# Calculate vector of fit values. 
+	call rcvvector (cv, Memr[x], Memr[y], npts)
+
+	# Convert to user function or transpose axes.  Change type to reals
+	# for plotting.
+	call icg_axesr (ic, gt, cv, 1, Memr[x], Memr[y], Memr[xo], npts)
+	call icg_axesr (ic, gt, cv, 2, Memr[x], Memr[y], Memr[yo], npts)
+	call achtrr (Memr[xo], Memr[xr], npts)
+	call achtrr (Memr[yo], Memr[yr], npts)
+
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "line")
+	call gt_seti (gt1, GTLINE, GL_DASHED)
+	call gt_seti (gt1, GTCOLOR, max (0, min (9, IC_COLOR(ic))))
+	call gt_plot (gp, gt1, Memr[xr], Memr[yr], npts)
+	call gt_free (gt1)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgnearest.gx b/pkg/xtools/icfit/icgnearest.gx
new file mode 100644
index 00000000..d3165940
--- /dev/null
+++ b/pkg/xtools/icfit/icgnearest.gx
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<pkg/gtools.h>
+include "icfit.h"
+
+# ICG_NEAREST -- Find the nearest point to the cursor and return the index.
+# The nearest point to the cursor in NDC coordinates is determined.
+# The cursor is moved to the nearest point selected.
+
+int procedure icg_nearest$t (ic, gp, gt, cv, x, y, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+pointer	gt					# GTOOLS pointer
+pointer	cv					# CURFIT pointer
+PIXEL	x[npts], y[npts]			# Data points
+int	npts					# Number of points
+real	wx, wy					# Cursor position
+
+int	pt
+pointer	sp, xout, yout
+
+int	icg_n$t(), gt_geti()
+
+begin
+	call smark (sp)
+	call salloc (xout, npts, TY_PIXEL)
+	call salloc (yout, npts, TY_PIXEL)
+	call icg_axes$t (ic, gt, cv, 1, x, y, Mem$t[xout], npts)
+	call icg_axes$t (ic, gt, cv, 2, x, y, Mem$t[yout], npts)
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    pt = icg_n$t (gp, Mem$t[xout], Mem$t[yout], npts, wx, wy)
+	else
+	    pt = icg_n$t (gp, Mem$t[yout], Mem$t[xout], npts, wy, wx)
+	call sfree (sp)
+	
+	return (pt)
+end
+
+int procedure icg_n$t (gp, x, y, npts, wx, wy)
+
+pointer	gp					# GIO pointer
+PIXEL	x[npts], y[npts]			# Data points
+int	npts					# Number of points
+real	wx, wy					# Cursor position
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point.
+
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Move the cursor to the selected point and return the index.
+
+	if (j != 0)
+	    call gscur (gp, real (x[j]), real (y[j]))
+
+	return (j)
+end
diff --git a/pkg/xtools/icfit/icgnearestd.x b/pkg/xtools/icfit/icgnearestd.x
new file mode 100644
index 00000000..4011f95c
--- /dev/null
+++ b/pkg/xtools/icfit/icgnearestd.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<pkg/gtools.h>
+include "icfit.h"
+
+# ICG_NEAREST -- Find the nearest point to the cursor and return the index.
+# The nearest point to the cursor in NDC coordinates is determined.
+# The cursor is moved to the nearest point selected.
+
+int procedure icg_nearestd (ic, gp, gt, cv, x, y, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+pointer	gt					# GTOOLS pointer
+pointer	cv					# CURFIT pointer
+double	x[npts], y[npts]			# Data points
+int	npts					# Number of points
+real	wx, wy					# Cursor position
+
+int	pt
+pointer	sp, xout, yout
+
+int	icg_nd(), gt_geti()
+
+begin
+	call smark (sp)
+	call salloc (xout, npts, TY_DOUBLE)
+	call salloc (yout, npts, TY_DOUBLE)
+	call icg_axesd (ic, gt, cv, 1, x, y, Memd[xout], npts)
+	call icg_axesd (ic, gt, cv, 2, x, y, Memd[yout], npts)
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    pt = icg_nd (gp, Memd[xout], Memd[yout], npts, wx, wy)
+	else
+	    pt = icg_nd (gp, Memd[yout], Memd[xout], npts, wy, wx)
+	call sfree (sp)
+	
+	return (pt)
+end
+
+int procedure icg_nd (gp, x, y, npts, wx, wy)
+
+pointer	gp					# GIO pointer
+double	x[npts], y[npts]			# Data points
+int	npts					# Number of points
+real	wx, wy					# Cursor position
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point.
+
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Move the cursor to the selected point and return the index.
+
+	if (j != 0)
+	    call gscur (gp, real (x[j]), real (y[j]))
+
+	return (j)
+end
diff --git a/pkg/xtools/icfit/icgnearestr.x b/pkg/xtools/icfit/icgnearestr.x
new file mode 100644
index 00000000..41363103
--- /dev/null
+++ b/pkg/xtools/icfit/icgnearestr.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<pkg/gtools.h>
+include "icfit.h"
+
+# ICG_NEAREST -- Find the nearest point to the cursor and return the index.
+# The nearest point to the cursor in NDC coordinates is determined.
+# The cursor is moved to the nearest point selected.
+
+int procedure icg_nearestr (ic, gp, gt, cv, x, y, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+pointer	gt					# GTOOLS pointer
+pointer	cv					# CURFIT pointer
+real	x[npts], y[npts]			# Data points
+int	npts					# Number of points
+real	wx, wy					# Cursor position
+
+int	pt
+pointer	sp, xout, yout
+
+int	icg_nr(), gt_geti()
+
+begin
+	call smark (sp)
+	call salloc (xout, npts, TY_REAL)
+	call salloc (yout, npts, TY_REAL)
+	call icg_axesr (ic, gt, cv, 1, x, y, Memr[xout], npts)
+	call icg_axesr (ic, gt, cv, 2, x, y, Memr[yout], npts)
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    pt = icg_nr (gp, Memr[xout], Memr[yout], npts, wx, wy)
+	else
+	    pt = icg_nr (gp, Memr[yout], Memr[xout], npts, wy, wx)
+	call sfree (sp)
+	
+	return (pt)
+end
+
+int procedure icg_nr (gp, x, y, npts, wx, wy)
+
+pointer	gp					# GIO pointer
+real	x[npts], y[npts]			# Data points
+int	npts					# Number of points
+real	wx, wy					# Cursor position
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point.
+
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Move the cursor to the selected point and return the index.
+
+	if (j != 0)
+	    call gscur (gp, real (x[j]), real (y[j]))
+
+	return (j)
+end
diff --git a/pkg/xtools/icfit/icgparams.gx b/pkg/xtools/icfit/icgparams.gx
new file mode 100644
index 00000000..c63657e3
--- /dev/null
+++ b/pkg/xtools/icfit/icgparams.gx
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/gtools.h>
+include	"icfit.h"
+include	"names.h"
+
+# ICG_PARAMS -- Set parameter string.
+
+procedure icg_params$t (ic, cv, x, y, wts, npts, gt)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+PIXEL	x[ARB]		# Ordinates
+PIXEL	y[ARB]		# Abscissas
+PIXEL	wts[ARB]	# Weights
+int	npts		# Number of data points
+pointer	gt		# GTOOLS pointer
+
+int	i, n, deleted
+PIXEL	rms
+pointer	sp, fit, wts1, str, params
+
+PIXEL	ic_rms$t()
+
+begin
+	call smark (sp)
+
+	n = IC_NFIT(ic)
+	deleted = 0
+	rms = INDEF
+
+	if (n == npts) {
+	    # Allocate memory for the fit.
+
+	    call salloc (fit, n, TY_PIXEL)
+	    call salloc (wts1, n, TY_PIXEL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amov$t (wts, Mem$t[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+		do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Mem$t[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Set the fit and compute the RMS error.
+
+	    if (IC_FITERROR(ic) == NO) {
+	        call $tcvvector (cv, x, Mem$t[fit], n)
+	        rms = ic_rms$t (x, y, Mem$t[fit], Mem$t[wts1], n)
+	    } else
+		rms = INDEF
+	} else if (n > 0) {
+	    # Allocate memory for the fit.
+
+	    call salloc (fit, n, TY_PIXEL)
+	    call salloc (wts1, n, TY_PIXEL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amov$t (Mem$t[IC_WTSFIT(ic)], Mem$t[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Mem$t[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Set the fit and compute the rms error.
+
+	    if (IC_FITERROR(ic) == NO) {
+	        call $tcvvector (cv, Mem$t[IC_XFIT(ic)], Mem$t[fit], n)
+	        rms = ic_rms$t (Mem$t[IC_XFIT(ic)], Mem$t[IC_YFIT(ic)],
+		    Mem$t[fit], Mem$t[wts1], n)
+	    } else
+		rms = INDEF
+	}
+
+	# Print the parameters and errors.
+
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (params, 2*SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[str], SZ_LINE,
+	    "func=%s, order=%d, low_rej=%r, high_rej=%r, niterate=%d, grow=%r")
+	    call ic_gstr (ic, "function", Memc[params], 2*SZ_LINE)
+	    call pargstr (Memc[params])
+	    call pargi (IC_ORDER(ic))
+	    call pargr (IC_LOW(ic))
+	    call pargr (IC_HIGH(ic))
+	    call pargi (IC_NITERATE(ic))
+	    call pargr (IC_GROW(ic))
+	call sprintf (Memc[params], 2*SZ_LINE,
+	    "%s\ntotal=%d, sample=%d, rejected=%d, deleted=%d, RMS=%7.4g")
+	    call pargstr (Memc[str])
+	    call pargi (npts)
+	    call pargi (n)
+	    call pargi (IC_NREJECT(ic))
+	    call pargi (deleted)
+	    call parg$t (rms)
+	call gt_sets (gt, GTPARAMS, Memc[params])
+
+	# Free allocated memory.
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgparamsd.x b/pkg/xtools/icfit/icgparamsd.x
new file mode 100644
index 00000000..de9397ab
--- /dev/null
+++ b/pkg/xtools/icfit/icgparamsd.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/gtools.h>
+include	"icfit.h"
+include	"names.h"
+
+# ICG_PARAMS -- Set parameter string.
+
+procedure icg_paramsd (ic, cv, x, y, wts, npts, gt)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+double	x[ARB]		# Ordinates
+double	y[ARB]		# Abscissas
+double	wts[ARB]	# Weights
+int	npts		# Number of data points
+pointer	gt		# GTOOLS pointer
+
+int	i, n, deleted
+double	rms
+pointer	sp, fit, wts1, str, params
+
+double	ic_rmsd()
+
+begin
+	call smark (sp)
+
+	n = IC_NFIT(ic)
+	deleted = 0
+	rms = INDEFD
+
+	if (n == npts) {
+	    # Allocate memory for the fit.
+
+	    call salloc (fit, n, TY_DOUBLE)
+	    call salloc (wts1, n, TY_DOUBLE)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovd (wts, Memd[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+		do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memd[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Set the fit and compute the RMS error.
+
+	    if (IC_FITERROR(ic) == NO) {
+	        call dcvvector (cv, x, Memd[fit], n)
+	        rms = ic_rmsd (x, y, Memd[fit], Memd[wts1], n)
+	    } else
+		rms = INDEFD
+	} else if (n > 0) {
+	    # Allocate memory for the fit.
+
+	    call salloc (fit, n, TY_DOUBLE)
+	    call salloc (wts1, n, TY_DOUBLE)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovd (Memd[IC_WTSFIT(ic)], Memd[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memd[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Set the fit and compute the rms error.
+
+	    if (IC_FITERROR(ic) == NO) {
+	        call dcvvector (cv, Memd[IC_XFIT(ic)], Memd[fit], n)
+	        rms = ic_rmsd (Memd[IC_XFIT(ic)], Memd[IC_YFIT(ic)],
+		    Memd[fit], Memd[wts1], n)
+	    } else
+		rms = INDEFD
+	}
+
+	# Print the parameters and errors.
+
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (params, 2*SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[str], SZ_LINE,
+	    "func=%s, order=%d, low_rej=%r, high_rej=%r, niterate=%d, grow=%r")
+	    call ic_gstr (ic, "function", Memc[params], 2*SZ_LINE)
+	    call pargstr (Memc[params])
+	    call pargi (IC_ORDER(ic))
+	    call pargr (IC_LOW(ic))
+	    call pargr (IC_HIGH(ic))
+	    call pargi (IC_NITERATE(ic))
+	    call pargr (IC_GROW(ic))
+	call sprintf (Memc[params], 2*SZ_LINE,
+	    "%s\ntotal=%d, sample=%d, rejected=%d, deleted=%d, RMS=%7.4g")
+	    call pargstr (Memc[str])
+	    call pargi (npts)
+	    call pargi (n)
+	    call pargi (IC_NREJECT(ic))
+	    call pargi (deleted)
+	    call pargd (rms)
+	call gt_sets (gt, GTPARAMS, Memc[params])
+
+	# Free allocated memory.
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgparamsr.x b/pkg/xtools/icfit/icgparamsr.x
new file mode 100644
index 00000000..a1c898de
--- /dev/null
+++ b/pkg/xtools/icfit/icgparamsr.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/gtools.h>
+include	"icfit.h"
+include	"names.h"
+
+# ICG_PARAMS -- Set parameter string.
+
+procedure icg_paramsr (ic, cv, x, y, wts, npts, gt)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+real	x[ARB]		# Ordinates
+real	y[ARB]		# Abscissas
+real	wts[ARB]	# Weights
+int	npts		# Number of data points
+pointer	gt		# GTOOLS pointer
+
+int	i, n, deleted
+real	rms
+pointer	sp, fit, wts1, str, params
+
+real	ic_rmsr()
+
+begin
+	call smark (sp)
+
+	n = IC_NFIT(ic)
+	deleted = 0
+	rms = INDEFR
+
+	if (n == npts) {
+	    # Allocate memory for the fit.
+
+	    call salloc (fit, n, TY_REAL)
+	    call salloc (wts1, n, TY_REAL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovr (wts, Memr[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+		do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memr[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Set the fit and compute the RMS error.
+
+	    if (IC_FITERROR(ic) == NO) {
+	        call rcvvector (cv, x, Memr[fit], n)
+	        rms = ic_rmsr (x, y, Memr[fit], Memr[wts1], n)
+	    } else
+		rms = INDEFR
+	} else if (n > 0) {
+	    # Allocate memory for the fit.
+
+	    call salloc (fit, n, TY_REAL)
+	    call salloc (wts1, n, TY_REAL)
+
+	    # Eliminate rejected points and count deleted points.
+
+	    call amovr (Memr[IC_WTSFIT(ic)], Memr[wts1], n)
+	    if (IC_NREJECT(ic) > 0) {
+	        do i = 1, npts {
+		    if (Memi[IC_REJPTS(ic)+i-1] == YES)
+			Memr[wts1+i-1] = 0.
+		}
+	    }
+	    deleted = 0
+	    do i = 1, n {
+		if (wts[i] == 0.)
+		    deleted = deleted + 1
+	    }
+
+	    # Set the fit and compute the rms error.
+
+	    if (IC_FITERROR(ic) == NO) {
+	        call rcvvector (cv, Memr[IC_XFIT(ic)], Memr[fit], n)
+	        rms = ic_rmsr (Memr[IC_XFIT(ic)], Memr[IC_YFIT(ic)],
+		    Memr[fit], Memr[wts1], n)
+	    } else
+		rms = INDEFR
+	}
+
+	# Print the parameters and errors.
+
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (params, 2*SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[str], SZ_LINE,
+	    "func=%s, order=%d, low_rej=%r, high_rej=%r, niterate=%d, grow=%r")
+	    call ic_gstr (ic, "function", Memc[params], 2*SZ_LINE)
+	    call pargstr (Memc[params])
+	    call pargi (IC_ORDER(ic))
+	    call pargr (IC_LOW(ic))
+	    call pargr (IC_HIGH(ic))
+	    call pargi (IC_NITERATE(ic))
+	    call pargr (IC_GROW(ic))
+	call sprintf (Memc[params], 2*SZ_LINE,
+	    "%s\ntotal=%d, sample=%d, rejected=%d, deleted=%d, RMS=%7.4g")
+	    call pargstr (Memc[str])
+	    call pargi (npts)
+	    call pargi (n)
+	    call pargi (IC_NREJECT(ic))
+	    call pargi (deleted)
+	    call pargr (rms)
+	call gt_sets (gt, GTPARAMS, Memc[params])
+
+	# Free allocated memory.
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgsample.gx b/pkg/xtools/icfit/icgsample.gx
new file mode 100644
index 00000000..84d5216a
--- /dev/null
+++ b/pkg/xtools/icfit/icgsample.gx
@@ -0,0 +1,226 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<mach.h>
+include	<pkg/rg.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+# ICG_SAMPLE -- Mark sample.
+
+procedure icg_sample$t (ic, gp, gt, x, npts, pltype)
+
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+PIXEL	x[npts]				# Ordinates of graph
+int	npts				# Number of data points
+int	pltype				# Plot line type
+
+pointer	rg
+int	i, axis, pltype1
+real	xl, xr, yb, yt, dy
+real	x1, x2, y1, y2, y3
+
+int	gstati(), stridxs(), gt_geti()
+pointer	rg_xranges$t()
+
+begin
+	if (stridxs ("*", Memc[IC_SAMPLE(ic)]) > 0)
+	    return
+
+	# Find axis along which the independent data is plotted.
+	if (IC_AXES(ic,IC_GKEY(ic),1) == 'x')
+	    axis = 1
+	else if (IC_AXES(ic,IC_GKEY(ic),2) == 'x')
+	    axis = 2
+	else
+	    return
+
+	if (gt_geti (gt, GTTRANSPOSE) == YES)
+	    axis = mod (axis, 2) + 1
+
+	pltype1 = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_PLTYPE, pltype)
+	rg = rg_xranges$t (Memc[IC_SAMPLE(ic)], x, npts)
+
+	switch (axis) {
+	case 1:
+	    call ggwind (gp, xl, xr, yb, yt)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+	        if ((x1 > xl) && (x1 < xr))
+	            call gline (gp, x1, y1, x1, y2)
+	        if ((x2 > xl) && (x2 < xr))
+	            call gline (gp, x2, y1, x2, y2)
+	        call gline (gp, x1, y3, x2, y3)
+	    }
+	case 2:
+	    call ggwind (gp, yb, yt, xl, xr)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+	        if ((x1 > xl) && (x1 < xr))
+	            call gline (gp, y1, x1, y2, x1)
+	        if ((x2 > xl) && (x2 < xr))
+	            call gline (gp, y1, x2, y2, x2)
+	        call gline (gp, y3, x1, y3, x2)
+	    }
+	}
+
+	call gseti (gp, G_PLTYPE, pltype1)
+	call rg_free (rg)
+end
+
+
+# ICG_DSAMPLE -- Delete sample region.
+
+procedure icg_dsample$t (wx, wy, ic, gp, gt, x, npts)
+
+real	wx, wy				# Region to be deleted
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+PIXEL	x[npts]				# Ordinates of graph
+int	npts				# Number of data points
+
+pointer	sp, str, rg
+int	i,  j, axis, pltype1
+real	w, diff
+real	xl, xr, yb, yt, dy
+real	x1, x2, y1, y2, y3
+
+int	gstati(), stridxs(), gt_geti()
+pointer	rg_xranges$t()
+
+begin
+	if (stridxs ("*", Memc[IC_SAMPLE(ic)]) > 0)
+	    return
+
+	# Find axis along which the independent data is plotted.
+	if (IC_AXES(ic,IC_GKEY(ic),1) == 'x')
+	    axis = 1
+	else if (IC_AXES(ic,IC_GKEY(ic),2) == 'x')
+	    axis = 2
+	else
+	    return
+
+	if (gt_geti (gt, GTTRANSPOSE) == YES)
+	    axis = mod (axis, 2) + 1
+
+	# Initialize
+	pltype1 = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_PLTYPE, 0)
+	rg = rg_xranges$t (Memc[IC_SAMPLE(ic)], x, npts)
+
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	Memc[IC_SAMPLE(ic)] = EOS
+
+	# Find nearest sample region
+	if (axis == 1)
+	    w = wx
+	else
+	    w = wy
+
+	j = 1
+	diff = MAX_REAL
+	do i = 1, RG_NRGS(rg) {
+	    x1 = x[RG_X1(rg, i)]
+	    x2 = x[RG_X2(rg, i)]
+	    if (w < x1) {
+		if (x1 - w < diff) {
+		    diff = x1 - wx
+		    j = i
+		}
+	    } else if (wx > x2) {
+		if (wx - x2 < diff) {
+		    diff = x1 - wx
+		    j = i
+		}
+	    } else {
+		diff = 0.
+		j = i
+	    }
+	}
+
+	# Erase sample region and reset sample string
+	switch (axis) {
+	case 1:
+	    call ggwind (gp, xl, xr, yb, yt)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+		if (i != j) {
+		    if (x1 == int(x1) && x2 == int(x2))
+			call sprintf (Memc[str], SZ_FNAME, " %d:%d")
+		    else
+			call sprintf (Memc[str], SZ_FNAME, " %g:%g")
+			call pargr (x1)
+			call pargr (x2)
+		    call strcat (Memc[str], Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+		} else {
+		    if ((x1 > xl) && (x1 < xr))
+			call gline (gp, x1, y1, x1, y2)
+		    if ((x2 > xl) && (x2 < xr))
+			call gline (gp, x2, y1, x2, y2)
+		    call gline (gp, x1, y3, x2, y3)
+		    IC_NEWX(ic) = YES
+		}
+	    }
+	case 2:
+	    call ggwind (gp, yb, yt, xl, xr)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+		if (i != j) {
+		    if (x1 == int(x1) && x2 == int(x2))
+			call sprintf (Memc[str], SZ_FNAME, " %d:%d")
+		    else
+			call sprintf (Memc[str], SZ_FNAME, " %g:%g")
+			call pargr (x1)
+			call pargr (x2)
+		    call strcat (Memc[str], Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+		} else {
+		    if ((x1 > xl) && (x1 < xr))
+			call gline (gp, y1, x1, y2, x1)
+		    if ((x2 > xl) && (x2 < xr))
+			call gline (gp, y1, x2, y2, x2)
+		    call gline (gp, y3, x1, y3, x2)
+		    IC_NEWX(ic) = YES
+		}
+	    }
+	}
+
+	if (Memc[IC_SAMPLE(ic)] == EOS)
+	    call strcat ("*", Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+
+	call gseti (gp, G_PLTYPE, pltype1)
+	call rg_free (rg)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgsampled.x b/pkg/xtools/icfit/icgsampled.x
new file mode 100644
index 00000000..314dfc33
--- /dev/null
+++ b/pkg/xtools/icfit/icgsampled.x
@@ -0,0 +1,226 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<mach.h>
+include	<pkg/rg.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+# ICG_SAMPLE -- Mark sample.
+
+procedure icg_sampled (ic, gp, gt, x, npts, pltype)
+
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+double	x[npts]				# Ordinates of graph
+int	npts				# Number of data points
+int	pltype				# Plot line type
+
+pointer	rg
+int	i, axis, pltype1
+real	xl, xr, yb, yt, dy
+real	x1, x2, y1, y2, y3
+
+int	gstati(), stridxs(), gt_geti()
+pointer	rg_xrangesd()
+
+begin
+	if (stridxs ("*", Memc[IC_SAMPLE(ic)]) > 0)
+	    return
+
+	# Find axis along which the independent data is plotted.
+	if (IC_AXES(ic,IC_GKEY(ic),1) == 'x')
+	    axis = 1
+	else if (IC_AXES(ic,IC_GKEY(ic),2) == 'x')
+	    axis = 2
+	else
+	    return
+
+	if (gt_geti (gt, GTTRANSPOSE) == YES)
+	    axis = mod (axis, 2) + 1
+
+	pltype1 = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_PLTYPE, pltype)
+	rg = rg_xrangesd (Memc[IC_SAMPLE(ic)], x, npts)
+
+	switch (axis) {
+	case 1:
+	    call ggwind (gp, xl, xr, yb, yt)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+	        if ((x1 > xl) && (x1 < xr))
+	            call gline (gp, x1, y1, x1, y2)
+	        if ((x2 > xl) && (x2 < xr))
+	            call gline (gp, x2, y1, x2, y2)
+	        call gline (gp, x1, y3, x2, y3)
+	    }
+	case 2:
+	    call ggwind (gp, yb, yt, xl, xr)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+	        if ((x1 > xl) && (x1 < xr))
+	            call gline (gp, y1, x1, y2, x1)
+	        if ((x2 > xl) && (x2 < xr))
+	            call gline (gp, y1, x2, y2, x2)
+	        call gline (gp, y3, x1, y3, x2)
+	    }
+	}
+
+	call gseti (gp, G_PLTYPE, pltype1)
+	call rg_free (rg)
+end
+
+
+# ICG_DSAMPLE -- Delete sample region.
+
+procedure icg_dsampled (wx, wy, ic, gp, gt, x, npts)
+
+real	wx, wy				# Region to be deleted
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+double	x[npts]				# Ordinates of graph
+int	npts				# Number of data points
+
+pointer	sp, str, rg
+int	i,  j, axis, pltype1
+real	w, diff
+real	xl, xr, yb, yt, dy
+real	x1, x2, y1, y2, y3
+
+int	gstati(), stridxs(), gt_geti()
+pointer	rg_xrangesd()
+
+begin
+	if (stridxs ("*", Memc[IC_SAMPLE(ic)]) > 0)
+	    return
+
+	# Find axis along which the independent data is plotted.
+	if (IC_AXES(ic,IC_GKEY(ic),1) == 'x')
+	    axis = 1
+	else if (IC_AXES(ic,IC_GKEY(ic),2) == 'x')
+	    axis = 2
+	else
+	    return
+
+	if (gt_geti (gt, GTTRANSPOSE) == YES)
+	    axis = mod (axis, 2) + 1
+
+	# Initialize
+	pltype1 = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_PLTYPE, 0)
+	rg = rg_xrangesd (Memc[IC_SAMPLE(ic)], x, npts)
+
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	Memc[IC_SAMPLE(ic)] = EOS
+
+	# Find nearest sample region
+	if (axis == 1)
+	    w = wx
+	else
+	    w = wy
+
+	j = 1
+	diff = MAX_REAL
+	do i = 1, RG_NRGS(rg) {
+	    x1 = x[RG_X1(rg, i)]
+	    x2 = x[RG_X2(rg, i)]
+	    if (w < x1) {
+		if (x1 - w < diff) {
+		    diff = x1 - wx
+		    j = i
+		}
+	    } else if (wx > x2) {
+		if (wx - x2 < diff) {
+		    diff = x1 - wx
+		    j = i
+		}
+	    } else {
+		diff = 0.
+		j = i
+	    }
+	}
+
+	# Erase sample region and reset sample string
+	switch (axis) {
+	case 1:
+	    call ggwind (gp, xl, xr, yb, yt)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+		if (i != j) {
+		    if (x1 == int(x1) && x2 == int(x2))
+			call sprintf (Memc[str], SZ_FNAME, " %d:%d")
+		    else
+			call sprintf (Memc[str], SZ_FNAME, " %g:%g")
+			call pargr (x1)
+			call pargr (x2)
+		    call strcat (Memc[str], Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+		} else {
+		    if ((x1 > xl) && (x1 < xr))
+			call gline (gp, x1, y1, x1, y2)
+		    if ((x2 > xl) && (x2 < xr))
+			call gline (gp, x2, y1, x2, y2)
+		    call gline (gp, x1, y3, x2, y3)
+		    IC_NEWX(ic) = YES
+		}
+	    }
+	case 2:
+	    call ggwind (gp, yb, yt, xl, xr)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+		if (i != j) {
+		    if (x1 == int(x1) && x2 == int(x2))
+			call sprintf (Memc[str], SZ_FNAME, " %d:%d")
+		    else
+			call sprintf (Memc[str], SZ_FNAME, " %g:%g")
+			call pargr (x1)
+			call pargr (x2)
+		    call strcat (Memc[str], Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+		} else {
+		    if ((x1 > xl) && (x1 < xr))
+			call gline (gp, y1, x1, y2, x1)
+		    if ((x2 > xl) && (x2 < xr))
+			call gline (gp, y1, x2, y2, x2)
+		    call gline (gp, y3, x1, y3, x2)
+		    IC_NEWX(ic) = YES
+		}
+	    }
+	}
+
+	if (Memc[IC_SAMPLE(ic)] == EOS)
+	    call strcat ("*", Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+
+	call gseti (gp, G_PLTYPE, pltype1)
+	call rg_free (rg)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgsampler.x b/pkg/xtools/icfit/icgsampler.x
new file mode 100644
index 00000000..2310cbb8
--- /dev/null
+++ b/pkg/xtools/icfit/icgsampler.x
@@ -0,0 +1,226 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<mach.h>
+include	<pkg/rg.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+# ICG_SAMPLE -- Mark sample.
+
+procedure icg_sampler (ic, gp, gt, x, npts, pltype)
+
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+real	x[npts]				# Ordinates of graph
+int	npts				# Number of data points
+int	pltype				# Plot line type
+
+pointer	rg
+int	i, axis, pltype1
+real	xl, xr, yb, yt, dy
+real	x1, x2, y1, y2, y3
+
+int	gstati(), stridxs(), gt_geti()
+pointer	rg_xrangesr()
+
+begin
+	if (stridxs ("*", Memc[IC_SAMPLE(ic)]) > 0)
+	    return
+
+	# Find axis along which the independent data is plotted.
+	if (IC_AXES(ic,IC_GKEY(ic),1) == 'x')
+	    axis = 1
+	else if (IC_AXES(ic,IC_GKEY(ic),2) == 'x')
+	    axis = 2
+	else
+	    return
+
+	if (gt_geti (gt, GTTRANSPOSE) == YES)
+	    axis = mod (axis, 2) + 1
+
+	pltype1 = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_PLTYPE, pltype)
+	rg = rg_xrangesr (Memc[IC_SAMPLE(ic)], x, npts)
+
+	switch (axis) {
+	case 1:
+	    call ggwind (gp, xl, xr, yb, yt)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+	        if ((x1 > xl) && (x1 < xr))
+	            call gline (gp, x1, y1, x1, y2)
+	        if ((x2 > xl) && (x2 < xr))
+	            call gline (gp, x2, y1, x2, y2)
+	        call gline (gp, x1, y3, x2, y3)
+	    }
+	case 2:
+	    call ggwind (gp, yb, yt, xl, xr)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+	        if ((x1 > xl) && (x1 < xr))
+	            call gline (gp, y1, x1, y2, x1)
+	        if ((x2 > xl) && (x2 < xr))
+	            call gline (gp, y1, x2, y2, x2)
+	        call gline (gp, y3, x1, y3, x2)
+	    }
+	}
+
+	call gseti (gp, G_PLTYPE, pltype1)
+	call rg_free (rg)
+end
+
+
+# ICG_DSAMPLE -- Delete sample region.
+
+procedure icg_dsampler (wx, wy, ic, gp, gt, x, npts)
+
+real	wx, wy				# Region to be deleted
+pointer	ic				# ICFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+real	x[npts]				# Ordinates of graph
+int	npts				# Number of data points
+
+pointer	sp, str, rg
+int	i,  j, axis, pltype1
+real	w, diff
+real	xl, xr, yb, yt, dy
+real	x1, x2, y1, y2, y3
+
+int	gstati(), stridxs(), gt_geti()
+pointer	rg_xrangesr()
+
+begin
+	if (stridxs ("*", Memc[IC_SAMPLE(ic)]) > 0)
+	    return
+
+	# Find axis along which the independent data is plotted.
+	if (IC_AXES(ic,IC_GKEY(ic),1) == 'x')
+	    axis = 1
+	else if (IC_AXES(ic,IC_GKEY(ic),2) == 'x')
+	    axis = 2
+	else
+	    return
+
+	if (gt_geti (gt, GTTRANSPOSE) == YES)
+	    axis = mod (axis, 2) + 1
+
+	# Initialize
+	pltype1 = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_PLTYPE, 0)
+	rg = rg_xrangesr (Memc[IC_SAMPLE(ic)], x, npts)
+
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	Memc[IC_SAMPLE(ic)] = EOS
+
+	# Find nearest sample region
+	if (axis == 1)
+	    w = wx
+	else
+	    w = wy
+
+	j = 1
+	diff = MAX_REAL
+	do i = 1, RG_NRGS(rg) {
+	    x1 = x[RG_X1(rg, i)]
+	    x2 = x[RG_X2(rg, i)]
+	    if (w < x1) {
+		if (x1 - w < diff) {
+		    diff = x1 - wx
+		    j = i
+		}
+	    } else if (wx > x2) {
+		if (wx - x2 < diff) {
+		    diff = x1 - wx
+		    j = i
+		}
+	    } else {
+		diff = 0.
+		j = i
+	    }
+	}
+
+	# Erase sample region and reset sample string
+	switch (axis) {
+	case 1:
+	    call ggwind (gp, xl, xr, yb, yt)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+		if (i != j) {
+		    if (x1 == int(x1) && x2 == int(x2))
+			call sprintf (Memc[str], SZ_FNAME, " %d:%d")
+		    else
+			call sprintf (Memc[str], SZ_FNAME, " %g:%g")
+			call pargr (x1)
+			call pargr (x2)
+		    call strcat (Memc[str], Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+		} else {
+		    if ((x1 > xl) && (x1 < xr))
+			call gline (gp, x1, y1, x1, y2)
+		    if ((x2 > xl) && (x2 < xr))
+			call gline (gp, x2, y1, x2, y2)
+		    call gline (gp, x1, y3, x2, y3)
+		    IC_NEWX(ic) = YES
+		}
+	    }
+	case 2:
+	    call ggwind (gp, yb, yt, xl, xr)
+
+	    dy = yt - yb
+	    y1 = yb + dy / 100
+	    y2 = y1 + dy / 20
+	    y3 = (y1 + y2) / 2
+
+	    do i = 1, RG_NRGS(rg) {
+	        x1 = x[RG_X1(rg, i)]
+	        x2 = x[RG_X2(rg, i)]
+		if (i != j) {
+		    if (x1 == int(x1) && x2 == int(x2))
+			call sprintf (Memc[str], SZ_FNAME, " %d:%d")
+		    else
+			call sprintf (Memc[str], SZ_FNAME, " %g:%g")
+			call pargr (x1)
+			call pargr (x2)
+		    call strcat (Memc[str], Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+		} else {
+		    if ((x1 > xl) && (x1 < xr))
+			call gline (gp, y1, x1, y2, x1)
+		    if ((x2 > xl) && (x2 < xr))
+			call gline (gp, y1, x2, y2, x2)
+		    call gline (gp, y3, x1, y3, x2)
+		    IC_NEWX(ic) = YES
+		}
+	    }
+	}
+
+	if (Memc[IC_SAMPLE(ic)] == EOS)
+	    call strcat ("*", Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+
+	call gseti (gp, G_PLTYPE, pltype1)
+	call rg_free (rg)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icguaxes.gx b/pkg/xtools/icfit/icguaxes.gx
new file mode 100644
index 00000000..1527a10e
--- /dev/null
+++ b/pkg/xtools/icfit/icguaxes.gx
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ICG_UAXES -- Set user axis
+
+procedure icg_uaxes$t (key, cv, x, y, z, npts, label, units, maxchars)
+
+int	key				# Key for axes
+pointer	cv				# CURFIT pointer
+PIXEL	x[npts]				# Independent variable
+PIXEL	y[npts]				# Dependent variable
+PIXEL	z[npts]				# Output values
+int	npts				# Number of points
+char	label[maxchars]			# Axis label
+char	units[maxchars]			# Axis units
+int	maxchars			# Maximum chars in label
+
+begin
+end
diff --git a/pkg/xtools/icfit/icguaxesd.x b/pkg/xtools/icfit/icguaxesd.x
new file mode 100644
index 00000000..b787d211
--- /dev/null
+++ b/pkg/xtools/icfit/icguaxesd.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ICG_UAXES -- Set user axis
+
+procedure icg_uaxesd (key, cv, x, y, z, npts, label, units, maxchars)
+
+int	key				# Key for axes
+pointer	cv				# CURFIT pointer
+double	x[npts]				# Independent variable
+double	y[npts]				# Dependent variable
+double	z[npts]				# Output values
+int	npts				# Number of points
+char	label[maxchars]			# Axis label
+char	units[maxchars]			# Axis units
+int	maxchars			# Maximum chars in label
+
+begin
+end
diff --git a/pkg/xtools/icfit/icguaxesr.x b/pkg/xtools/icfit/icguaxesr.x
new file mode 100644
index 00000000..deeac3c7
--- /dev/null
+++ b/pkg/xtools/icfit/icguaxesr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ICG_UAXES -- Set user axis
+
+procedure icg_uaxesr (key, cv, x, y, z, npts, label, units, maxchars)
+
+int	key				# Key for axes
+pointer	cv				# CURFIT pointer
+real	x[npts]				# Independent variable
+real	y[npts]				# Dependent variable
+real	z[npts]				# Output values
+int	npts				# Number of points
+char	label[maxchars]			# Axis label
+char	units[maxchars]			# Axis units
+int	maxchars			# Maximum chars in label
+
+begin
+end
diff --git a/pkg/xtools/icfit/icgui.x b/pkg/xtools/icfit/icgui.x
new file mode 100644
index 00000000..9e0fd6e0
--- /dev/null
+++ b/pkg/xtools/icfit/icgui.x
@@ -0,0 +1,138 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<gio.h>
+include "icfit.h"
+
+define	CMDS "|open|close|params|graph|wcs|refit|help|"
+
+define	OPEN		1	# Open GUI and send initial parameters
+define	CLOSE		2	# Close GUI and send final parameters
+define	PARAMS		3	# Send new parameters
+define	GRAPH		4	# Send graph type parameters
+define	WCS		5	# Send graph wcs parameters
+define	REFIT		6	# Send refit flag
+define	HELP		7	# Send help
+
+# IC_GUI -- GUI interaction.
+#
+# Note there is currently an interface violation to determine if the graphics
+# stream is connected to a GUI.
+
+procedure ic_gui (ic, cmd)
+
+pointer	ic		#I ICFIT pointer
+char	cmd[ARB]	#I Command
+
+int	ncmd, strdic()
+real	vx1, vx2, vy1, vy2, wx1, wx2, wy1, wy2
+pointer	sp, str, msg
+bool	streq()
+errchk	ic_help
+
+begin
+	if (IC_GP(ic) == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Scan the command and switch on the first word.
+	call sscan (cmd)
+	call gargwrd (Memc[str], SZ_LINE)
+	ncmd = strdic (Memc[str], Memc[str], SZ_LINE, CMDS)
+	switch (ncmd) {
+	case OPEN, CLOSE, PARAMS:
+	    call salloc (msg, SZ_LINE+IC_SZSAMPLE, TY_CHAR)
+	    call ic_gstr (ic, "function", Memc[str], SZ_LINE)
+	    call sprintf (Memc[msg], SZ_LINE+IC_SZSAMPLE,
+		"%s %s %d \"%s\" %d %d %g %g %g %b")
+		call pargstr (cmd)
+		call pargstr (Memc[str])
+		call pargi (IC_ORDER(ic))
+		call pargstr (Memc[IC_SAMPLE(ic)])
+		call pargi (IC_NAVERAGE(ic))
+		call pargi (IC_NITERATE(ic))
+		call pargr (IC_LOW(ic))
+		call pargr (IC_HIGH(ic))
+		call pargr (IC_GROW(ic))
+		call pargi (IC_MARKREJ(ic))
+	    if (GP_UIFNAME(IC_GP(ic)) != EOS)
+		call gmsg (IC_GP(ic), "icfit", Memc[msg])
+
+	    if (GP_UIFNAME(IC_GP(ic)) != EOS) {
+		if (streq (Memc[IC_HELP(ic)], IC_DEFHELP))
+		    call strcpy (IC_DEFHTML, Memc[IC_HELP(ic)], SZ_LINE)
+	    }
+
+	case GRAPH:
+	    call sprintf (Memc[str], SZ_LINE, "graph %c %c %c")
+		call pargi ('h'+IC_GKEY(ic)-1)
+		call pargi (IC_AXES(ic,IC_GKEY(ic),1))
+		call pargi (IC_AXES(ic,IC_GKEY(ic),2))
+	    if (GP_UIFNAME(IC_GP(ic)) != EOS)
+		call gmsg (IC_GP(ic), "icfit", Memc[str])
+
+	case WCS:
+	    call ggview (IC_GP(ic), vx1, vx2, vy1, vy2)
+	    call ggwind (IC_GP(ic), wx1, wx2, wy1, wy2)
+	    call sprintf (Memc[str], SZ_LINE, "wcs %g %g %g %g %g %g %g %g")
+		call pargr (vx1)
+		call pargr (vx2)
+		call pargr (vy1)
+		call pargr (vy2)
+		call pargr (wx1)
+		call pargr (wx2)
+		call pargr (wy1)
+		call pargr (wy2)
+	    if (GP_UIFNAME(IC_GP(ic)) != EOS)
+		call gmsg (IC_GP(ic), "icfit", Memc[str])
+
+	case REFIT:
+	    if (GP_UIFNAME(IC_GP(ic)) != EOS)
+		call gmsg (IC_GP(ic), "icrefit", cmd)
+
+	case HELP:
+	    if (GP_UIFNAME(IC_GP(ic)) != EOS)
+		call ic_help (ic)
+	    else
+		call gpagefile (IC_GP(ic), Memc[IC_HELP(ic)], IC_PROMPT)
+	}
+
+	call sfree (sp)
+end
+
+
+# IC_HELP - Send help to GUI
+
+procedure ic_help (ic)
+
+pointer	ic		#I ICFIT pointer
+
+int	i, fd, len_str, open(), getline()
+pointer	line, help
+errchk	open()
+
+begin
+	len_str = 10 * SZ_LINE
+	call calloc (help, len_str, TY_CHAR)
+	line = help
+
+	fd = open (Memc[IC_HELP(ic)], READ_ONLY, TEXT_FILE)
+	while (getline (fd, Memc[line]) != EOF) {
+	    for (; Memc[line]!=EOS; line=line+1)
+		;
+	    i = line - help
+	    if (i + SZ_LINE > len_str) {
+		len_str = len_str + 10 * SZ_LINE
+		call realloc (help, len_str, TY_CHAR)
+		line = help + i
+	    }
+	}
+	call close (fd)
+
+	# Send results to GUI.
+	call gmsg (IC_GP(ic), "ichelp", Memc[help])
+
+	call mfree (help, TY_CHAR)
+end
diff --git a/pkg/xtools/icfit/icguishow.gx b/pkg/xtools/icfit/icguishow.gx
new file mode 100644
index 00000000..30df5f4d
--- /dev/null
+++ b/pkg/xtools/icfit/icguishow.gx
@@ -0,0 +1,86 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gset.h>
+include	<gio.h>
+include "icfit.h"
+include	"names.h"
+
+define	CMDS "|show|vshow|xyshow|errors|"
+
+define	SHOW		1	# Show information
+define	VSHOW		2	# Show verbose information
+define	XYSHOW		3	# Show points 
+define	ERRORS		4	# Show errors
+
+# IC_GUISHOW -- GUI show.
+#
+# Note there is currently an interface violation to determine if the graphics
+# stream is connected to a GUI.
+
+procedure ic_guishow$t (ic, cmd, cv, x, y, wts, npts)
+
+pointer	ic				#I ICFIT pointer
+char	cmd[ARB]			#I Command
+pointer cv                              #I CURFIT pointer for error listing
+PIXEL   x[npts], y[npts], wts[npts]     #I Data arrays
+int     npts                            #I Number of data points
+
+int	ncmd, deact, fd
+pointer	sp, str, msg
+int	strdic(), nscan(), stropen(), open()
+errchk	stropen, open, ic_fshow, ic_fvshow$t, ic_fxyshow$t, ic_ferrors$t
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Scan the command.
+	call sscan (cmd)
+	call gargwrd (Memc[str], SZ_LINE)
+	ncmd = strdic (Memc[str], Memc[str], SZ_LINE, CMDS)
+	call gargwrd (Memc[str], SZ_LINE)
+
+	iferr {
+	    # Setup the output.
+	    deact = NO
+	    msg = NULL
+
+	    if (nscan() == 1) {
+		if (GP_UIFNAME(IC_GP(ic)) != EOS) {
+		    call malloc (msg, 100000, TY_CHAR)
+		    fd = stropen (Memc[msg], 100000, WRITE_ONLY)
+		} else {
+		    fd = open ("STDOUT", APPEND, TEXT_FILE)
+		    call gdeactivate (IC_GP(ic), AW_CLEAR)
+		    deact = YES
+		}
+	    } else
+		fd = open (Memc[str], APPEND, TEXT_FILE)
+
+	    # Write the results to the output.
+	    switch (ncmd) {
+	    case SHOW:
+		call ic_fshow (ic, fd)
+	    case VSHOW:
+		call ic_fvshow$t (ic, cv, x, y, wts, npts, fd)
+	    case XYSHOW:
+		call ic_fxyshow$t (ic, cv, x, y, wts, npts, fd)
+	    case ERRORS:
+		call ic_fshow (ic, fd)
+		call ic_ferrors$t (ic, cv, x, y, wts, npts, fd)
+	    }
+
+	    # Flush the output.
+	    call close (fd)
+	    if (msg != NULL)
+		call gmsg (IC_GP(ic), "icshow", Memc[msg])
+	} then
+	    call erract (EA_WARN)
+
+	if (msg != NULL)
+	    call mfree (msg, TY_CHAR)
+	if (deact == YES)
+	    call greactivate (IC_GP(ic), AW_PAUSE)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icguishowd.x b/pkg/xtools/icfit/icguishowd.x
new file mode 100644
index 00000000..dee7401d
--- /dev/null
+++ b/pkg/xtools/icfit/icguishowd.x
@@ -0,0 +1,86 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gset.h>
+include	<gio.h>
+include "icfit.h"
+include	"names.h"
+
+define	CMDS "|show|vshow|xyshow|errors|"
+
+define	SHOW		1	# Show information
+define	VSHOW		2	# Show verbose information
+define	XYSHOW		3	# Show points 
+define	ERRORS		4	# Show errors
+
+# IC_GUISHOW -- GUI show.
+#
+# Note there is currently an interface violation to determine if the graphics
+# stream is connected to a GUI.
+
+procedure ic_guishowd (ic, cmd, cv, x, y, wts, npts)
+
+pointer	ic				#I ICFIT pointer
+char	cmd[ARB]			#I Command
+pointer cv                              #I CURFIT pointer for error listing
+double   x[npts], y[npts], wts[npts]     #I Data arrays
+int     npts                            #I Number of data points
+
+int	ncmd, deact, fd
+pointer	sp, str, msg
+int	strdic(), nscan(), stropen(), open()
+errchk	stropen, open, ic_fshow, ic_fvshowd, ic_fxyshowd, ic_ferrorsd
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Scan the command.
+	call sscan (cmd)
+	call gargwrd (Memc[str], SZ_LINE)
+	ncmd = strdic (Memc[str], Memc[str], SZ_LINE, CMDS)
+	call gargwrd (Memc[str], SZ_LINE)
+
+	iferr {
+	    # Setup the output.
+	    deact = NO
+	    msg = NULL
+
+	    if (nscan() == 1) {
+		if (GP_UIFNAME(IC_GP(ic)) != EOS) {
+		    call malloc (msg, 100000, TY_CHAR)
+		    fd = stropen (Memc[msg], 100000, WRITE_ONLY)
+		} else {
+		    fd = open ("STDOUT", APPEND, TEXT_FILE)
+		    call gdeactivate (IC_GP(ic), AW_CLEAR)
+		    deact = YES
+		}
+	    } else
+		fd = open (Memc[str], APPEND, TEXT_FILE)
+
+	    # Write the results to the output.
+	    switch (ncmd) {
+	    case SHOW:
+		call ic_fshow (ic, fd)
+	    case VSHOW:
+		call ic_fvshowd (ic, cv, x, y, wts, npts, fd)
+	    case XYSHOW:
+		call ic_fxyshowd (ic, cv, x, y, wts, npts, fd)
+	    case ERRORS:
+		call ic_fshow (ic, fd)
+		call ic_ferrorsd (ic, cv, x, y, wts, npts, fd)
+	    }
+
+	    # Flush the output.
+	    call close (fd)
+	    if (msg != NULL)
+		call gmsg (IC_GP(ic), "icshow", Memc[msg])
+	} then
+	    call erract (EA_WARN)
+
+	if (msg != NULL)
+	    call mfree (msg, TY_CHAR)
+	if (deact == YES)
+	    call greactivate (IC_GP(ic), AW_PAUSE)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icguishowr.x b/pkg/xtools/icfit/icguishowr.x
new file mode 100644
index 00000000..f16a957e
--- /dev/null
+++ b/pkg/xtools/icfit/icguishowr.x
@@ -0,0 +1,86 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<gset.h>
+include	<gio.h>
+include "icfit.h"
+include	"names.h"
+
+define	CMDS "|show|vshow|xyshow|errors|"
+
+define	SHOW		1	# Show information
+define	VSHOW		2	# Show verbose information
+define	XYSHOW		3	# Show points 
+define	ERRORS		4	# Show errors
+
+# IC_GUISHOW -- GUI show.
+#
+# Note there is currently an interface violation to determine if the graphics
+# stream is connected to a GUI.
+
+procedure ic_guishowr (ic, cmd, cv, x, y, wts, npts)
+
+pointer	ic				#I ICFIT pointer
+char	cmd[ARB]			#I Command
+pointer cv                              #I CURFIT pointer for error listing
+real   x[npts], y[npts], wts[npts]     #I Data arrays
+int     npts                            #I Number of data points
+
+int	ncmd, deact, fd
+pointer	sp, str, msg
+int	strdic(), nscan(), stropen(), open()
+errchk	stropen, open, ic_fshow, ic_fvshowr, ic_fxyshowr, ic_ferrorsr
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Scan the command.
+	call sscan (cmd)
+	call gargwrd (Memc[str], SZ_LINE)
+	ncmd = strdic (Memc[str], Memc[str], SZ_LINE, CMDS)
+	call gargwrd (Memc[str], SZ_LINE)
+
+	iferr {
+	    # Setup the output.
+	    deact = NO
+	    msg = NULL
+
+	    if (nscan() == 1) {
+		if (GP_UIFNAME(IC_GP(ic)) != EOS) {
+		    call malloc (msg, 100000, TY_CHAR)
+		    fd = stropen (Memc[msg], 100000, WRITE_ONLY)
+		} else {
+		    fd = open ("STDOUT", APPEND, TEXT_FILE)
+		    call gdeactivate (IC_GP(ic), AW_CLEAR)
+		    deact = YES
+		}
+	    } else
+		fd = open (Memc[str], APPEND, TEXT_FILE)
+
+	    # Write the results to the output.
+	    switch (ncmd) {
+	    case SHOW:
+		call ic_fshow (ic, fd)
+	    case VSHOW:
+		call ic_fvshowr (ic, cv, x, y, wts, npts, fd)
+	    case XYSHOW:
+		call ic_fxyshowr (ic, cv, x, y, wts, npts, fd)
+	    case ERRORS:
+		call ic_fshow (ic, fd)
+		call ic_ferrorsr (ic, cv, x, y, wts, npts, fd)
+	    }
+
+	    # Flush the output.
+	    call close (fd)
+	    if (msg != NULL)
+		call gmsg (IC_GP(ic), "icshow", Memc[msg])
+	} then
+	    call erract (EA_WARN)
+
+	if (msg != NULL)
+	    call mfree (msg, TY_CHAR)
+	if (deact == YES)
+	    call greactivate (IC_GP(ic), AW_PAUSE)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/icfit/icgundelete.gx b/pkg/xtools/icfit/icgundelete.gx
new file mode 100644
index 00000000..c997ccd0
--- /dev/null
+++ b/pkg/xtools/icfit/icgundelete.gx
@@ -0,0 +1,93 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+define	MSIZE		2.		# Mark size
+
+# ICG_UNDELETE -- Undelete data point nearest the cursor.
+# The nearest point to the cursor in NDC coordinates is determined.
+
+procedure icg_undelete$t (ic, gp, gt, cv, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+pointer	gt					# GTOOLS pointer
+pointer	cv					# CURFIT pointer
+PIXEL	x[npts], y[npts]			# Data points
+PIXEL	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+pointer	sp, xout, yout
+
+int	gt_geti()
+
+begin
+	call smark (sp)
+	call salloc (xout, npts, TY_PIXEL)
+	call salloc (yout, npts, TY_PIXEL)
+
+	call icg_axes$t (ic, gt, cv, 1, x, y, Mem$t[xout], npts)
+	call icg_axes$t (ic, gt, cv, 2, x, y, Mem$t[yout], npts)
+
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call icg_u1$t (ic, gp, Mem$t[xout], Mem$t[yout], wts, userwts,
+		npts, wx, wy)
+	else
+	    call icg_u1$t (ic, gp, Mem$t[yout], Mem$t[xout], wts, userwts,
+		npts, wy, wx)
+
+	call sfree (sp)
+end
+
+
+# ICG_U1 -- Do the actual undelete.
+
+procedure icg_u1$t (ic, gp, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+PIXEL	x[npts], y[npts]			# Data points
+PIXEL	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with zero weight.
+
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] != 0.)
+		next
+
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Unmark the deleted point and reset the weight.
+
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gseti (gp, G_PMLTYPE, GL_CLEAR)
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    call gseti (gp, G_PMLTYPE, GL_SOLID)
+	    call gline (gp, real (x[j]), real (y[j]), real (x[j]), real (y[j]))
+	    wts[j] = userwts[j]
+	    IC_NEWWTS(ic) = YES
+	}
+end
diff --git a/pkg/xtools/icfit/icgundeleted.x b/pkg/xtools/icfit/icgundeleted.x
new file mode 100644
index 00000000..df295a92
--- /dev/null
+++ b/pkg/xtools/icfit/icgundeleted.x
@@ -0,0 +1,93 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+define	MSIZE		2.		# Mark size
+
+# ICG_UNDELETE -- Undelete data point nearest the cursor.
+# The nearest point to the cursor in NDC coordinates is determined.
+
+procedure icg_undeleted (ic, gp, gt, cv, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+pointer	gt					# GTOOLS pointer
+pointer	cv					# CURFIT pointer
+double	x[npts], y[npts]			# Data points
+double	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+pointer	sp, xout, yout
+
+int	gt_geti()
+
+begin
+	call smark (sp)
+	call salloc (xout, npts, TY_DOUBLE)
+	call salloc (yout, npts, TY_DOUBLE)
+
+	call icg_axesd (ic, gt, cv, 1, x, y, Memd[xout], npts)
+	call icg_axesd (ic, gt, cv, 2, x, y, Memd[yout], npts)
+
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call icg_u1d (ic, gp, Memd[xout], Memd[yout], wts, userwts,
+		npts, wx, wy)
+	else
+	    call icg_u1d (ic, gp, Memd[yout], Memd[xout], wts, userwts,
+		npts, wy, wx)
+
+	call sfree (sp)
+end
+
+
+# ICG_U1 -- Do the actual undelete.
+
+procedure icg_u1d (ic, gp, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+double	x[npts], y[npts]			# Data points
+double	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with zero weight.
+
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] != 0.)
+		next
+
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Unmark the deleted point and reset the weight.
+
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gseti (gp, G_PMLTYPE, GL_CLEAR)
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    call gseti (gp, G_PMLTYPE, GL_SOLID)
+	    call gline (gp, real (x[j]), real (y[j]), real (x[j]), real (y[j]))
+	    wts[j] = userwts[j]
+	    IC_NEWWTS(ic) = YES
+	}
+end
diff --git a/pkg/xtools/icfit/icgundeleter.x b/pkg/xtools/icfit/icgundeleter.x
new file mode 100644
index 00000000..a1db4dca
--- /dev/null
+++ b/pkg/xtools/icfit/icgundeleter.x
@@ -0,0 +1,93 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include	"icfit.h"
+
+define	MSIZE		2.		# Mark size
+
+# ICG_UNDELETE -- Undelete data point nearest the cursor.
+# The nearest point to the cursor in NDC coordinates is determined.
+
+procedure icg_undeleter (ic, gp, gt, cv, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+pointer	gt					# GTOOLS pointer
+pointer	cv					# CURFIT pointer
+real	x[npts], y[npts]			# Data points
+real	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+pointer	sp, xout, yout
+
+int	gt_geti()
+
+begin
+	call smark (sp)
+	call salloc (xout, npts, TY_REAL)
+	call salloc (yout, npts, TY_REAL)
+
+	call icg_axesr (ic, gt, cv, 1, x, y, Memr[xout], npts)
+	call icg_axesr (ic, gt, cv, 2, x, y, Memr[yout], npts)
+
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call icg_u1r (ic, gp, Memr[xout], Memr[yout], wts, userwts,
+		npts, wx, wy)
+	else
+	    call icg_u1r (ic, gp, Memr[yout], Memr[xout], wts, userwts,
+		npts, wy, wx)
+
+	call sfree (sp)
+end
+
+
+# ICG_U1 -- Do the actual undelete.
+
+procedure icg_u1r (ic, gp, x, y, wts, userwts, npts, wx, wy)
+
+pointer	ic					# ICFIT pointer
+pointer	gp					# GIO pointer
+real	x[npts], y[npts]			# Data points
+real	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with zero weight.
+
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] != 0.)
+		next
+
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Unmark the deleted point and reset the weight.
+
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gseti (gp, G_PMLTYPE, GL_CLEAR)
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    call gseti (gp, G_PMLTYPE, GL_SOLID)
+	    call gline (gp, real (x[j]), real (y[j]), real (x[j]), real (y[j]))
+	    wts[j] = userwts[j]
+	    IC_NEWWTS(ic) = YES
+	}
+end
diff --git a/pkg/xtools/icfit/icguser.x b/pkg/xtools/icfit/icguser.x
new file mode 100644
index 00000000..58727343
--- /dev/null
+++ b/pkg/xtools/icfit/icguser.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# ICG_USER -- User default action
+
+procedure icg_user (ic, gp, gt, cv, wx, wy, wcs, key, cmd)
+
+pointer	ic			# ICFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+pointer	cv			# CURFIT pointer
+real	wx, wy			# Cursor positions
+int	wcs			# GIO WCS
+int	key			# Cursor key
+char	cmd[ARB]		# Cursor command
+
+begin
+	# Ring bell
+	call printf ("\07\n")
+end
diff --git a/pkg/xtools/icfit/iclist.gx b/pkg/xtools/icfit/iclist.gx
new file mode 100644
index 00000000..73af2f4e
--- /dev/null
+++ b/pkg/xtools/icfit/iclist.gx
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"icfit.h"
+include	"names.h"
+
+# IC_LIST -- List X, Y, FIT, W.
+
+procedure ic_list$t (ic, cv, x, y, wts, npts, file)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+PIXEL	x[ARB]		# Ordinates
+PIXEL	y[ARB]		# Abscissas
+PIXEL	wts[ARB]	# Weights
+int	npts		# Number of data points
+char	file[ARB]	# Output file
+
+int	i, fd, open()
+PIXEL	$tcveval()
+errchk	open()
+
+begin
+	# Open the output file.
+	fd = open (file, APPEND, TEXT_FILE)
+
+	if (npts == IC_NFIT(ic)) {
+	    do i = 1, npts {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call parg$t (x[i])
+		    call parg$t (y[i])
+		    call parg$t ($tcveval (cv, x[i]))
+		    call parg$t (wts[i])
+	    }
+	} else {
+	    do i = 1, IC_NFIT(ic) {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call parg$t (Mem$t[IC_XFIT(ic)+i-1])
+		    call parg$t (Mem$t[IC_YFIT(ic)+i-1])
+		    call parg$t ($tcveval (cv, Mem$t[IC_XFIT(ic)+i-1]))
+		    call parg$t (Mem$t[IC_WTSFIT(ic)+i-1])
+	    }
+	}
+
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/iclistd.x b/pkg/xtools/icfit/iclistd.x
new file mode 100644
index 00000000..78eb6058
--- /dev/null
+++ b/pkg/xtools/icfit/iclistd.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"icfit.h"
+include	"names.h"
+
+# IC_LIST -- List X, Y, FIT, W.
+
+procedure ic_listd (ic, cv, x, y, wts, npts, file)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+double	x[ARB]		# Ordinates
+double	y[ARB]		# Abscissas
+double	wts[ARB]	# Weights
+int	npts		# Number of data points
+char	file[ARB]	# Output file
+
+int	i, fd, open()
+double	dcveval()
+errchk	open()
+
+begin
+	# Open the output file.
+	fd = open (file, APPEND, TEXT_FILE)
+
+	if (npts == IC_NFIT(ic)) {
+	    do i = 1, npts {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call pargd (x[i])
+		    call pargd (y[i])
+		    call pargd (dcveval (cv, x[i]))
+		    call pargd (wts[i])
+	    }
+	} else {
+	    do i = 1, IC_NFIT(ic) {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call pargd (Memd[IC_XFIT(ic)+i-1])
+		    call pargd (Memd[IC_YFIT(ic)+i-1])
+		    call pargd (dcveval (cv, Memd[IC_XFIT(ic)+i-1]))
+		    call pargd (Memd[IC_WTSFIT(ic)+i-1])
+	    }
+	}
+
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/iclistr.x b/pkg/xtools/icfit/iclistr.x
new file mode 100644
index 00000000..4e2b2c14
--- /dev/null
+++ b/pkg/xtools/icfit/iclistr.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"icfit.h"
+include	"names.h"
+
+# IC_LIST -- List X, Y, FIT, W.
+
+procedure ic_listr (ic, cv, x, y, wts, npts, file)
+
+pointer	ic		# ICFIT pointer
+pointer	cv		# Curfit pointer
+real	x[ARB]		# Ordinates
+real	y[ARB]		# Abscissas
+real	wts[ARB]	# Weights
+int	npts		# Number of data points
+char	file[ARB]	# Output file
+
+int	i, fd, open()
+real	rcveval()
+errchk	open()
+
+begin
+	# Open the output file.
+	fd = open (file, APPEND, TEXT_FILE)
+
+	if (npts == IC_NFIT(ic)) {
+	    do i = 1, npts {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call pargr (x[i])
+		    call pargr (y[i])
+		    call pargr (rcveval (cv, x[i]))
+		    call pargr (wts[i])
+	    }
+	} else {
+	    do i = 1, IC_NFIT(ic) {
+		call fprintf (fd, "%8g %8g %8g %8g\n")
+		    call pargr (Memr[IC_XFIT(ic)+i-1])
+		    call pargr (Memr[IC_YFIT(ic)+i-1])
+		    call pargr (rcveval (cv, Memr[IC_XFIT(ic)+i-1]))
+		    call pargr (Memr[IC_WTSFIT(ic)+i-1])
+	    }
+	}
+
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/icparams.x b/pkg/xtools/icfit/icparams.x
new file mode 100644
index 00000000..da829ce0
--- /dev/null
+++ b/pkg/xtools/icfit/icparams.x
@@ -0,0 +1,388 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "icfit.h"
+
+define	FUNCTIONS	"|chebyshev|legendre|spline3|spline1|user|"
+
+# IC_OPEN -- Open ICFIT parameter structure.
+
+procedure ic_open (ic)
+
+pointer	ic		# ICFIT pointer
+
+begin
+	# Allocate memory for the package parameter structure.
+	call malloc (ic, IC_LENSTRUCT, TY_STRUCT)
+	call malloc (IC_SAMPLE(ic), IC_SZSAMPLE, TY_CHAR)
+	call malloc (IC_LABELS(ic,1), SZ_LINE, TY_CHAR)
+	call malloc (IC_LABELS(ic,2), SZ_LINE, TY_CHAR)
+	call malloc (IC_UNITS(ic,1), SZ_LINE, TY_CHAR)
+	call malloc (IC_UNITS(ic,2), SZ_LINE, TY_CHAR)
+	call malloc (IC_HELP(ic), SZ_FNAME, TY_CHAR)
+
+	# Initialize parameters
+	IC_OVERPLOT(ic) = NO
+	IC_RG(ic) = NULL
+	IC_XFIT(ic) = NULL
+	IC_YFIT(ic) = NULL
+	IC_WTSFIT(ic) = NULL
+	IC_REJPTS(ic) = NULL
+	IC_GP(ic) = NULL
+	IC_GT(ic) = NULL
+
+	# Set defaults
+	call ic_pstr (ic, "function", "spline3")
+	call ic_puti (ic, "order", 1)
+	call ic_pstr (ic, "sample", "*")
+	call ic_puti (ic, "naverage", 1)
+	call ic_puti (ic, "niterate", 0)
+	call ic_putr (ic, "low", 3.)
+	call ic_putr (ic, "high", 3.)
+	call ic_putr (ic, "grow", 0.)
+	call ic_puti (ic, "markrej", YES)
+	call ic_pstr (ic, "xlabel", "X")
+	call ic_pstr (ic, "ylabel", "Y")
+	call ic_pstr (ic, "xunits", "")
+	call ic_pstr (ic, "yunits", "")
+	call ic_puti (ic, "color", 1)
+	call ic_pstr (ic, "help", IC_DEFHELP)
+	call ic_puti (ic, "key", 1)
+	call ic_pkey (ic, 1, 'x', 'y')
+	call ic_pkey (ic, 2, 'y', 'x')
+	call ic_pkey (ic, 3, 'x', 'r')
+	call ic_pkey (ic, 4, 'x', 'd')
+	call ic_pkey (ic, 5, 'x', 'n')
+end
+
+
+# IC_COPY -- Copy an ICFIT structure.
+# The output pointer must be allocated already.
+
+procedure ic_copy (icin, icout)
+
+pointer	icin		# Input ICFIT pointer to copy
+pointer	icout		# Ouput ICFIT pointer
+
+begin
+	IC_FUNCTION(icout) = IC_FUNCTION(icin)
+	IC_ORDER(icout) = IC_ORDER(icin)
+	IC_NAVERAGE(icout) = IC_NAVERAGE(icin)
+	IC_NITERATE(icout) = IC_NITERATE(icin)
+	IC_XMIN(icout) = IC_XMIN(icin)
+	IC_XMAX(icout) = IC_XMAX(icin)
+	IC_LOW(icout) = IC_LOW(icin)
+	IC_HIGH(icout) = IC_HIGH(icin)
+	IC_GROW(icout) = IC_GROW(icin)
+	IC_COLOR(icout) = IC_COLOR(icin)
+	IC_MARKREJ(icout) = IC_MARKREJ(icin)
+	IC_GKEY(icout) = IC_GKEY(icin)
+
+	call strcpy (Memc[IC_SAMPLE(icin)], Memc[IC_SAMPLE(icout)], IC_SZSAMPLE)
+	call strcpy (Memc[IC_LABELS(icin,1)], Memc[IC_LABELS(icout,1)], SZ_LINE)
+	call strcpy (Memc[IC_LABELS(icin,2)], Memc[IC_LABELS(icout,2)], SZ_LINE)
+	call strcpy (Memc[IC_UNITS(icin,1)], Memc[IC_UNITS(icout,1)], SZ_LINE)
+	call strcpy (Memc[IC_UNITS(icin,2)], Memc[IC_UNITS(icout,2)], SZ_LINE)
+	call strcpy (Memc[IC_HELP(icin)], Memc[IC_HELP(icout)], SZ_LINE)
+
+	call amovi (IC_AXES(icin,1,1), IC_AXES(icout,1,1), 10)
+
+	IC_RG(icout) = NULL
+	IC_XFIT(icout) = NULL
+	IC_YFIT(icout) = NULL
+	IC_WTSFIT(icout) = NULL
+	IC_REJPTS(icout) = NULL
+end
+
+
+# IC_CLOSER -- Close ICFIT parameter structure.
+
+procedure ic_closer (ic)
+
+pointer	ic		# ICFIT pointer
+
+begin
+	if (ic != NULL) {
+	    # Free memory for the package parameter structure.
+	    call rg_free (IC_RG(ic))
+	    call mfree (IC_XFIT(ic), TY_REAL)
+	    call mfree (IC_YFIT(ic), TY_REAL)
+	    call mfree (IC_WTSFIT(ic), TY_REAL)
+	    call mfree (IC_REJPTS(ic), TY_INT)
+	    call mfree (IC_SAMPLE(ic), TY_CHAR)
+	    call mfree (IC_LABELS(ic,1), TY_CHAR)
+	    call mfree (IC_LABELS(ic,2), TY_CHAR)
+	    call mfree (IC_UNITS(ic,1), TY_CHAR)
+	    call mfree (IC_UNITS(ic,2), TY_CHAR)
+	    call mfree (IC_HELP(ic), TY_CHAR)
+	    call mfree (ic, TY_STRUCT)
+	}
+end
+
+
+# IC_CLOSED -- Close ICFIT parameter structure.
+
+procedure ic_closed (ic)
+
+pointer	ic		# ICFIT pointer
+
+begin
+	if (ic != NULL) {
+	    # Free memory for the package parameter structure.
+	    call rg_free (IC_RG(ic))
+	    call mfree (IC_XFIT(ic), TY_DOUBLE)
+	    call mfree (IC_YFIT(ic), TY_DOUBLE)
+	    call mfree (IC_WTSFIT(ic), TY_DOUBLE)
+	    call mfree (IC_REJPTS(ic), TY_INT)
+	    call mfree (IC_SAMPLE(ic), TY_CHAR)
+	    call mfree (IC_LABELS(ic,1), TY_CHAR)
+	    call mfree (IC_LABELS(ic,2), TY_CHAR)
+	    call mfree (IC_UNITS(ic,1), TY_CHAR)
+	    call mfree (IC_UNITS(ic,2), TY_CHAR)
+	    call mfree (IC_HELP(ic), TY_CHAR)
+	    call mfree (ic, TY_STRUCT)
+	}
+end
+
+
+# IC_PSTR -- Put string valued parameters.
+
+procedure ic_pstr (ic, param, str)
+
+pointer	ic			# ICFIT pointer
+char	param[ARB]		# Parameter to be put
+char	str[ARB]		# String value
+
+int	i
+pointer	ptr
+
+int	strdic()
+bool	streq()
+
+begin
+	if (streq (param, "sample"))
+	    call strcpy (str, Memc[IC_SAMPLE(ic)], IC_SZSAMPLE)
+	else if (streq (param, "function")) {
+	    call malloc (ptr, SZ_LINE, TY_CHAR)
+	    i = strdic (str, Memc[ptr], SZ_LINE, FUNCTIONS)
+	    if (i > 0)
+		IC_FUNCTION(ic) = i
+	    call mfree (ptr, TY_CHAR)
+	} else if (streq (param, "xlabel"))
+	    call strcpy (str, Memc[IC_LABELS(ic,1)], SZ_LINE)
+	else if (streq (param, "ylabel"))
+	    call strcpy (str, Memc[IC_LABELS(ic,2)], SZ_LINE)
+	else if (streq (param, "xunits"))
+	    call strcpy (str, Memc[IC_UNITS(ic,1)], SZ_LINE)
+	else if (streq (param, "yunits"))
+	    call strcpy (str, Memc[IC_UNITS(ic,2)], SZ_LINE)
+	else if (streq (param, "help"))
+	    call strcpy (str, Memc[IC_HELP(ic)], SZ_LINE)
+	else
+	    call error (0, "ICFIT: Unknown parameter")
+
+	call ic_gui (ic, "params")
+end
+
+
+# IC_PUTI -- Put integer valued parameters.
+
+procedure ic_puti (ic, param, ival)
+
+pointer	ic			# ICFIT pointer
+char	param[ARB]		# Parameter to be put
+int	ival			# Integer value
+
+bool	streq()
+
+begin
+	if (streq (param, "naverage"))
+	    IC_NAVERAGE(ic) = ival
+	else if (streq (param, "order"))
+	    IC_ORDER(ic) = max (1, ival)
+	else if (streq (param, "niterate"))
+	    IC_NITERATE(ic) = ival
+	else if (streq (param, "key"))
+	    IC_GKEY(ic) = ival
+	else if (streq (param, "color"))
+	    IC_COLOR(ic) = ival
+	else if (streq (param, "markrej"))
+	    IC_MARKREJ(ic) = ival
+	else
+	    call error (0, "ICFIT: Unknown parameter")
+
+	call ic_gui (ic, "params")
+end
+
+
+# IC_PKEY -- Put key parameters.
+# Note the key types must be integers not characters.
+
+procedure ic_pkey (ic, key, xaxis, yaxis)
+
+pointer	ic			# ICFIT pointer
+int	key			# Key to be defined
+int	xaxis			# X axis type
+int	yaxis			# Y axis type
+
+begin
+	if (key >= 1 && key <= 5) {
+	    IC_AXES(ic, key, 1) = xaxis
+	    IC_AXES(ic, key, 2) = yaxis
+
+	    if (key == IC_GKEY(ic))
+		call ic_gui (ic, "graph")
+	}
+end
+
+
+# IC_GKEY -- Get key parameters.
+
+procedure ic_gkey (ic, key, xaxis, yaxis)
+
+pointer	ic			# ICFIT pointer
+int	key			# Key to be gotten
+int	xaxis			# X axis type
+int	yaxis			# Y axis type
+
+begin
+	xaxis = IC_AXES(ic, key, 1)
+	yaxis = IC_AXES(ic, key, 2)
+end
+
+
+# IC_PUTR -- Put real valued parameters.
+
+procedure ic_putr (ic, param, rval)
+
+pointer	ic			# ICFIT pointer
+char	param[ARB]		# Parameter to be put
+real	rval			# Real value
+
+bool	streq()
+
+begin
+	if (streq (param, "xmin"))
+	    IC_XMIN(ic) = rval
+	else if (streq (param, "xmax"))
+	    IC_XMAX(ic) = rval
+	else if (streq (param, "low"))
+	    IC_LOW(ic) = rval
+	else if (streq (param, "high"))
+	    IC_HIGH(ic) = rval
+	else if (streq (param, "grow"))
+	    IC_GROW(ic) = rval
+	else
+	    call error (0, "ICFIT: Unknown parameter")
+
+	call ic_gui (ic, "params")
+end
+
+
+# IC_GSTR -- Get string valued parameters.
+
+procedure ic_gstr (ic, param, str, maxchars)
+
+pointer	ic			# ICFIT pointer
+char	param[ARB]		# Parameter to be put
+char	str[maxchars]		# String value
+int	maxchars		# Maximum number of characters
+
+bool	streq()
+
+begin
+	if (streq (param, "sample"))
+	    call strcpy (Memc[IC_SAMPLE(ic)], str, maxchars)
+	else if (streq (param, "xlabel"))
+	    call strcpy (Memc[IC_LABELS(ic,1)], str, maxchars)
+	else if (streq (param, "ylabel"))
+	    call strcpy (Memc[IC_LABELS(ic,2)], str, maxchars)
+	else if (streq (param, "xunits"))
+	    call strcpy (Memc[IC_UNITS(ic,1)], str, maxchars)
+	else if (streq (param, "yunits"))
+	    call strcpy (Memc[IC_UNITS(ic,2)], str, maxchars)
+	else if (streq (param, "help"))
+	    call strcpy (Memc[IC_HELP(ic)], str, maxchars)
+	else if (streq (param, "function")) {
+	    switch (IC_FUNCTION(ic)) {
+	    case 1:
+		call strcpy ("chebyshev", str, maxchars)
+	    case 2:
+		call strcpy ("legendre", str, maxchars)
+	    case 3:
+		call strcpy ("spline3", str, maxchars)
+	    case 4:
+		call strcpy ("spline1", str, maxchars)
+	    case 5:
+		call strcpy ("user", str, maxchars)
+	    }
+	} else
+	    call error (0, "ICFIT: Unknown parameter")
+end
+
+
+# IC_GETI -- Get integer valued parameters.
+
+int procedure ic_geti (ic, param)
+
+pointer	ic			# ICFIT pointer
+char	param[ARB]		# Parameter to be gotten
+
+bool	streq()
+
+begin
+	if (streq (param, "naverage"))
+	    return (IC_NAVERAGE(ic))
+	else if (streq (param, "order"))
+	    return (IC_ORDER(ic))
+	else if (streq (param, "niterate"))
+	    return (IC_NITERATE(ic))
+	else if (streq (param, "key"))
+	    return (IC_GKEY(ic))
+	else if (streq (param, "nfit"))
+	    return (IC_NFIT(ic))
+	else if (streq (param, "nreject"))
+	    return (IC_NREJECT(ic))
+	else if (streq (param, "rejpts"))
+	    return (IC_REJPTS(ic))
+	else if (streq (param, "color"))
+	    return (IC_COLOR(ic))
+	else if (streq (param, "markrej"))
+	    return (IC_MARKREJ(ic))
+	else if (streq (param, "nmin")) {
+	    switch (IC_FUNCTION(ic)) {
+	    case 3:
+		return (IC_ORDER(ic) + 3)
+	    case 4:
+		return (IC_ORDER(ic) + 1)
+	    default:
+		return (IC_ORDER(ic))
+	    }
+	}
+
+	call error (0, "ICFIT: Unknown parameter")
+end
+
+
+# IC_GETR -- Get real valued parameters.
+
+real procedure ic_getr (ic, param)
+
+pointer	ic			# ICFIT pointer
+char	param[ARB]		# Parameter to be put
+
+bool	streq()
+
+begin
+	if (streq (param, "xmin"))
+	    return (IC_XMIN(ic))
+	else if (streq (param, "xmax"))
+	    return (IC_XMAX(ic))
+	else if (streq (param, "low"))
+	    return (IC_LOW(ic))
+	else if (streq (param, "high"))
+	    return (IC_HIGH(ic))
+	else if (streq (param, "grow"))
+	    return (IC_GROW(ic))
+
+	call error (0, "ICFIT: Unknown parameter")
+end
diff --git a/pkg/xtools/icfit/icreject.gx b/pkg/xtools/icfit/icreject.gx
new file mode 100644
index 00000000..79965384
--- /dev/null
+++ b/pkg/xtools/icfit/icreject.gx
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"names.h"
+
+# IC_REJECT -- Reject points with large residuals from the fit.
+#
+# The sigma of the fit residuals is calculated.  The rejection thresholds
+# are set at low_reject*sigma and high_reject*sigma.  Points outside the
+# rejection threshold are rejected from the fit and flagged in the rejpts
+# array.  Finally, the remaining points are refit.
+
+procedure ic_reject$t (cv, x, y, w, rejpts, npts, low_reject, high_reject,
+    niterate, grow, nreject)
+
+pointer	cv				# Curve descriptor
+PIXEL	x[npts]				# Input ordinates
+PIXEL	y[npts]				# Input data values
+PIXEL	w[npts]				# Weights
+int	rejpts[npts]			# Points rejected
+int	npts				# Number of input points
+real	low_reject, high_reject		# Rejection threshold
+int	niterate			# Number of rejection iterations
+real	grow				# Rejection radius
+int	nreject				# Number of points rejected
+
+int	i, ierr, nit, newreject
+errchk	ic_deviant$t
+
+begin
+	# Initialize rejection.
+	nreject = 0
+	call amovki (NO, rejpts, npts)
+
+	if (niterate <= 0)
+	    return
+
+	# Find deviant points.  If an error occurs reduce the number of
+	# iterations and start again.
+	iferr {
+	    nit = 0
+	    do i = 1, niterate {
+		call ic_deviant$t (cv, x, y, w, rejpts, npts, low_reject,
+		    high_reject, grow, YES, nreject, newreject)
+		nit = nit + 1
+		if (newreject == 0)
+		    break
+	    }
+	} then {
+	    call $tcvfit (cv, x, y, w, npts, WTS_USER, ierr)
+	    nreject = 0
+	    call amovki (NO, rejpts, npts)
+	    do i = 1, nit
+		call ic_deviant$t (cv, x, y, w, rejpts, npts, low_reject,
+		    high_reject, grow, YES, nreject, newreject)
+	}
+end
diff --git a/pkg/xtools/icfit/icrejectd.x b/pkg/xtools/icfit/icrejectd.x
new file mode 100644
index 00000000..36985923
--- /dev/null
+++ b/pkg/xtools/icfit/icrejectd.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"names.h"
+
+# IC_REJECT -- Reject points with large residuals from the fit.
+#
+# The sigma of the fit residuals is calculated.  The rejection thresholds
+# are set at low_reject*sigma and high_reject*sigma.  Points outside the
+# rejection threshold are rejected from the fit and flagged in the rejpts
+# array.  Finally, the remaining points are refit.
+
+procedure ic_rejectd (cv, x, y, w, rejpts, npts, low_reject, high_reject,
+    niterate, grow, nreject)
+
+pointer	cv				# Curve descriptor
+double	x[npts]				# Input ordinates
+double	y[npts]				# Input data values
+double	w[npts]				# Weights
+int	rejpts[npts]			# Points rejected
+int	npts				# Number of input points
+real	low_reject, high_reject		# Rejection threshold
+int	niterate			# Number of rejection iterations
+real	grow				# Rejection radius
+int	nreject				# Number of points rejected
+
+int	i, ierr, nit, newreject
+errchk	ic_deviantd
+
+begin
+	# Initialize rejection.
+	nreject = 0
+	call amovki (NO, rejpts, npts)
+
+	if (niterate <= 0)
+	    return
+
+	# Find deviant points.  If an error occurs reduce the number of
+	# iterations and start again.
+	iferr {
+	    nit = 0
+	    do i = 1, niterate {
+		call ic_deviantd (cv, x, y, w, rejpts, npts, low_reject,
+		    high_reject, grow, YES, nreject, newreject)
+		nit = nit + 1
+		if (newreject == 0)
+		    break
+	    }
+	} then {
+	    call dcvfit (cv, x, y, w, npts, WTS_USER, ierr)
+	    nreject = 0
+	    call amovki (NO, rejpts, npts)
+	    do i = 1, nit
+		call ic_deviantd (cv, x, y, w, rejpts, npts, low_reject,
+		    high_reject, grow, YES, nreject, newreject)
+	}
+end
diff --git a/pkg/xtools/icfit/icrejectr.x b/pkg/xtools/icfit/icrejectr.x
new file mode 100644
index 00000000..2e344279
--- /dev/null
+++ b/pkg/xtools/icfit/icrejectr.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math/curfit.h>
+include	"names.h"
+
+# IC_REJECT -- Reject points with large residuals from the fit.
+#
+# The sigma of the fit residuals is calculated.  The rejection thresholds
+# are set at low_reject*sigma and high_reject*sigma.  Points outside the
+# rejection threshold are rejected from the fit and flagged in the rejpts
+# array.  Finally, the remaining points are refit.
+
+procedure ic_rejectr (cv, x, y, w, rejpts, npts, low_reject, high_reject,
+    niterate, grow, nreject)
+
+pointer	cv				# Curve descriptor
+real	x[npts]				# Input ordinates
+real	y[npts]				# Input data values
+real	w[npts]				# Weights
+int	rejpts[npts]			# Points rejected
+int	npts				# Number of input points
+real	low_reject, high_reject		# Rejection threshold
+int	niterate			# Number of rejection iterations
+real	grow				# Rejection radius
+int	nreject				# Number of points rejected
+
+int	i, ierr, nit, newreject
+errchk	ic_deviantr
+
+begin
+	# Initialize rejection.
+	nreject = 0
+	call amovki (NO, rejpts, npts)
+
+	if (niterate <= 0)
+	    return
+
+	# Find deviant points.  If an error occurs reduce the number of
+	# iterations and start again.
+	iferr {
+	    nit = 0
+	    do i = 1, niterate {
+		call ic_deviantr (cv, x, y, w, rejpts, npts, low_reject,
+		    high_reject, grow, YES, nreject, newreject)
+		nit = nit + 1
+		if (newreject == 0)
+		    break
+	    }
+	} then {
+	    call rcvfit (cv, x, y, w, npts, WTS_USER, ierr)
+	    nreject = 0
+	    call amovki (NO, rejpts, npts)
+	    do i = 1, nit
+		call ic_deviantr (cv, x, y, w, rejpts, npts, low_reject,
+		    high_reject, grow, YES, nreject, newreject)
+	}
+end
diff --git a/pkg/xtools/icfit/icshow.x b/pkg/xtools/icfit/icshow.x
new file mode 100644
index 00000000..d39e85d5
--- /dev/null
+++ b/pkg/xtools/icfit/icshow.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"icfit.h"
+
+# IC_SHOW -- Show the values of the parameters.
+
+procedure ic_show (ic, file, gt)
+
+pointer	ic			# ICFIT pointer
+char	file[ARB]		# Output file
+pointer	gt			# GTOOLS pointer
+
+int	fd, open()
+errchk	open, ic_fshow
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	IC_GT(ic) = gt
+	call ic_fshow (ic, fd)
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/icvshow.gx b/pkg/xtools/icfit/icvshow.gx
new file mode 100644
index 00000000..f356cb14
--- /dev/null
+++ b/pkg/xtools/icfit/icvshow.gx
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"icfit.h"
+
+# IC_VSHOW -- Show fit parameters in verbose mode.
+
+procedure ic_vshow$t (ic, file, cv, x, y, wts, npts, gt)
+
+pointer	ic		# ICFIT pointer
+char	file[ARB]	# Output file
+pointer	cv		# Curfit pointer
+PIXEL	x[ARB]		# Ordinates
+PIXEL	y[ARB]		# Abscissas
+PIXEL	wts[ARB]	# Weights
+int	npts		# Number of data points
+pointer	gt		# Graphics tools pointer
+
+int	fd, open()
+errchk	open, ic_fvshow$t
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	IC_GT(ic) = gt
+	call ic_fvshow$t (ic, cv, x, y, wts, npts, fd)
+	call close (fd)
+end
+
+
+# IC_XYSHOW -- List data as x, y, fit, weight lines on output.
+
+procedure ic_xyshow$t (ic, file, cv, x, y, w, npts)
+
+pointer	ic		# ICFIT pointer
+char	file[ARB]		# Output file
+pointer	cv			# Pointer to curfit structure
+PIXEL	x[npts]			# Array of x data values
+PIXEL	y[npts]			# Array of y data values
+PIXEL	w[npts]			# Array of weight data values
+int	npts			# Number of data values
+
+int	fd, open()
+errchk	open, ic_fxyshow$t
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	call ic_fxyshow$t (ic, cv, x, y, w, npts, fd)
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/icvshowd.x b/pkg/xtools/icfit/icvshowd.x
new file mode 100644
index 00000000..45b7ae85
--- /dev/null
+++ b/pkg/xtools/icfit/icvshowd.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"icfit.h"
+
+# IC_VSHOW -- Show fit parameters in verbose mode.
+
+procedure ic_vshowd (ic, file, cv, x, y, wts, npts, gt)
+
+pointer	ic		# ICFIT pointer
+char	file[ARB]	# Output file
+pointer	cv		# Curfit pointer
+double	x[ARB]		# Ordinates
+double	y[ARB]		# Abscissas
+double	wts[ARB]	# Weights
+int	npts		# Number of data points
+pointer	gt		# Graphics tools pointer
+
+int	fd, open()
+errchk	open, ic_fvshowd
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	IC_GT(ic) = gt
+	call ic_fvshowd (ic, cv, x, y, wts, npts, fd)
+	call close (fd)
+end
+
+
+# IC_XYSHOW -- List data as x, y, fit, weight lines on output.
+
+procedure ic_xyshowd (ic, file, cv, x, y, w, npts)
+
+pointer	ic		# ICFIT pointer
+char	file[ARB]		# Output file
+pointer	cv			# Pointer to curfit structure
+double	x[npts]			# Array of x data values
+double	y[npts]			# Array of y data values
+double	w[npts]			# Array of weight data values
+int	npts			# Number of data values
+
+int	fd, open()
+errchk	open, ic_fxyshowd
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	call ic_fxyshowd (ic, cv, x, y, w, npts, fd)
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/icvshowr.x b/pkg/xtools/icfit/icvshowr.x
new file mode 100644
index 00000000..6f846ec8
--- /dev/null
+++ b/pkg/xtools/icfit/icvshowr.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"icfit.h"
+
+# IC_VSHOW -- Show fit parameters in verbose mode.
+
+procedure ic_vshowr (ic, file, cv, x, y, wts, npts, gt)
+
+pointer	ic		# ICFIT pointer
+char	file[ARB]	# Output file
+pointer	cv		# Curfit pointer
+real	x[ARB]		# Ordinates
+real	y[ARB]		# Abscissas
+real	wts[ARB]	# Weights
+int	npts		# Number of data points
+pointer	gt		# Graphics tools pointer
+
+int	fd, open()
+errchk	open, ic_fvshowr
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	IC_GT(ic) = gt
+	call ic_fvshowr (ic, cv, x, y, wts, npts, fd)
+	call close (fd)
+end
+
+
+# IC_XYSHOW -- List data as x, y, fit, weight lines on output.
+
+procedure ic_xyshowr (ic, file, cv, x, y, w, npts)
+
+pointer	ic		# ICFIT pointer
+char	file[ARB]		# Output file
+pointer	cv			# Pointer to curfit structure
+real	x[npts]			# Array of x data values
+real	y[npts]			# Array of y data values
+real	w[npts]			# Array of weight data values
+int	npts			# Number of data values
+
+int	fd, open()
+errchk	open, ic_fxyshowr
+
+begin
+	fd = open (file, APPEND, TEXT_FILE)
+	call ic_fxyshowr (ic, cv, x, y, w, npts, fd)
+	call close (fd)
+end
diff --git a/pkg/xtools/icfit/mkpkg b/pkg/xtools/icfit/mkpkg
new file mode 100644
index 00000000..9ad67b9e
--- /dev/null
+++ b/pkg/xtools/icfit/mkpkg
@@ -0,0 +1,85 @@
+# ICFIT package.
+
+$checkout libxtools.a lib$
+$update	  libxtools.a
+$checkin  libxtools.a lib$
+$exit
+
+generic:
+	$set	GEN = "$$generic -k -t rd"
+	$ifolder (iccleanr.x, icclean.gx)	$(GEN) icclean.gx $endif
+	$ifolder (icdeviantr.x, icdeviant.gx)	$(GEN) icdeviant.gx $endif
+	$ifolder (icerrorsr.x, icerrors.gx)	$(GEN) icerrors.gx $endif
+	$ifolder (icferrorsr.x, icferrors.gx)	$(GEN) icferrors.gx $endif
+	$ifolder (icfitr.x, icfit.gx)		$(GEN) icfit.gx $endif
+	$ifolder (icgaddr.x, icgadd.gx)		$(GEN) icgadd.gx $endif
+	$ifolder (icgcolonr.x, icgcolon.gx)	$(GEN) icgcolon.gx $endif
+	$ifolder (icgdeleter.x, icgdelete.gx)	$(GEN) icgdelete.gx $endif
+	$ifolder (icgfitr.x, icgfit.gx)		$(GEN) icgfit.gx $endif
+	$ifolder (icgaxesr.x, icgaxes.gx)	$(GEN) icgaxes.gx $endif
+	$ifolder (icggraphr.x, icggraph.gx)	$(GEN) icggraph.gx $endif
+	$ifolder (icgnearestr.x, icgnearest.gx)	$(GEN) icgnearest.gx $endif
+	$ifolder (icgparamsr.x, icgparams.gx)	$(GEN) icgparams.gx $endif
+	$ifolder (icgsampler.x, icgsample.gx)	$(GEN) icgsample.gx $endif
+	$ifolder (icgundeleter.x, icgundelete.gx) $(GEN) icgundelete.gx $endif
+	$ifolder (icguaxesr.x, icguaxes.gx)	$(GEN) icguaxes.gx $endif
+	$ifolder (icguishowr.x, icguishow.gx)	$(GEN) icguishow.gx $endif
+	$ifolder (icrejectr.x, icreject.gx)	$(GEN) icreject.gx $endif
+	$ifolder (icdosetupr.x, icdosetup.gx)	$(GEN) icdosetup.gx $endif
+	$ifolder (icvshowr.x, icvshow.gx)	$(GEN) icvshow.gx $endif
+	$ifolder (icfvshowr.x, icfvshow.gx)	$(GEN) icfvshow.gx $endif
+	;
+
+libxtools.a:
+	$ifeq (USE_GENERIC, yes) $call generic $endif
+
+	iccleand.x	icfit.h names.h <pkg/rg.h>
+	iccleanr.x	icfit.h names.h <pkg/rg.h>
+	icdeviantd.x	names.h <mach.h> <math/curfit.h>
+	icdeviantr.x	names.h <mach.h> <math/curfit.h>
+	icdosetupd.x	icfit.h names.h <math/curfit.h>
+	icdosetupr.x	icfit.h names.h <math/curfit.h>
+	icerrorsd.x	names.h
+	icerrorsr.x	names.h
+	icferrorsd.x	icfit.h names.h <math/curfit.h>
+	icferrorsr.x	icfit.h names.h <math/curfit.h>
+	icfitd.x	icfit.h names.h <error.h> <math/curfit.h>
+	icfitr.x	icfit.h names.h <error.h> <math/curfit.h>
+	icfshow.x	icfit.h <pkg/gtools.h>
+	icfvshowd.x	icfit.h names.h <math/curfit.h>
+	icfvshowr.x	icfit.h names.h <math/curfit.h>
+	icgaddd.x	<gset.h>
+	icgaddr.x	<gset.h>
+	icgaxesd.x	icfit.h names.h <pkg/gtools.h>
+	icgaxesr.x	icfit.h names.h <pkg/gtools.h>
+	icgcolond.x	icfit.h names.h <error.h> <pkg/gtools.h>
+	icgcolonr.x	icfit.h names.h <error.h> <pkg/gtools.h>
+	icgdeleted.x	icfit.h <gset.h> <mach.h> <pkg/gtools.h>
+	icgdeleter.x	icfit.h <gset.h> <mach.h> <pkg/gtools.h>
+	icgfitd.x	icfit.h names.h <error.h> <pkg/gtools.h>
+	icgfitr.x	icfit.h names.h <error.h> <pkg/gtools.h>
+	icggraphd.x	icfit.h names.h <gset.h> <pkg/gtools.h>
+	icggraphr.x	icfit.h names.h <gset.h> <pkg/gtools.h>
+	icgnearestd.x	icfit.h <mach.h> <pkg/gtools.h>
+	icgnearestr.x	icfit.h <mach.h> <pkg/gtools.h>
+	icgparamsd.x	icfit.h names.h <pkg/gtools.h>
+	icgparamsr.x	icfit.h names.h <pkg/gtools.h>
+	icgsampled.x	icfit.h <gset.h> <mach.h> <pkg/gtools.h> <pkg/rg.h>
+	icgsampler.x	icfit.h <gset.h> <mach.h> <pkg/gtools.h> <pkg/rg.h>
+	icguaxesd.x	
+	icguaxesr.x	
+	icgui.x		icfit.h <gio.h> <gset.h>
+	icguishowd.x	icfit.h names.h <error.h> <gio.h> <gset.h>
+	icguishowr.x	icfit.h names.h <error.h> <gio.h> <gset.h>
+	icgundeleted.x	icfit.h <gset.h> <mach.h> <pkg/gtools.h>
+	icgundeleter.x	icfit.h <gset.h> <mach.h> <pkg/gtools.h>
+	icguser.x	
+	iclistd.x	icfit.h names.h
+	iclistr.x	icfit.h names.h
+	icparams.x	icfit.h
+	icrejectd.x	names.h <math/curfit.h>
+	icrejectr.x	names.h <math/curfit.h>
+	icshow.x	icfit.h
+	icvshowd.x	icfit.h
+	icvshowr.x	icfit.h
+	;
diff --git a/pkg/xtools/icfit/names.h b/pkg/xtools/icfit/names.h
new file mode 100644
index 00000000..6fce9473
--- /dev/null
+++ b/pkg/xtools/icfit/names.h
@@ -0,0 +1,21 @@
+# NAMES -- Map generic names to external names.
+
+define	ic_cleanr	ic_clean
+define	ic_fitr		ic_fit
+define	icg_fitr	icg_fit
+define	ic_freer	ic_free
+define	ic_errorsr	ic_errors
+
+define	rcvcoeff	cvcoeff
+define	rcverrors	cverrors
+define	rcveval		cveval
+define	rcvfit		cvfit
+define	rcvfree		cvfree
+define	rcvinit		cvinit
+define	rcvrefit	cvrefit
+define	rcvrject	cvrject
+define	rcvsolve	cvsolve
+define	rcvstati	cvstati
+define	rcvvector	cvvector
+define	rcvsave		cvsave
+define	rcvuserfnc	cvuserfnc
diff --git a/pkg/xtools/imtools.x b/pkg/xtools/imtools.x
new file mode 100644
index 00000000..e4ca8bd3
--- /dev/null
+++ b/pkg/xtools/imtools.x
@@ -0,0 +1,147 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<imhdr.h>
+
+# NEW_TITLE -- Get a new image title.
+# The null string defaults to the original title.
+
+procedure new_title (param, im)
+
+char	param[ARB]			# Parameter
+pointer	im				# Image descriptor
+char	title[SZ_LINE]
+int	strlen()
+
+begin
+	call clgstr (param, title, SZ_LINE)
+	if (strlen (title) > 0)
+	    call strcpy (title, IM_TITLE(im), SZ_IMTITLE) 
+end
+
+
+# NEW_PIXTYPE -- Get a new pixel datatype.
+# The null string defaults to the original pixel datatype.
+
+procedure new_pixtype (param, im)
+
+char	param[ARB]			# Parameter
+pointer	im				# Image descriptor
+
+char	pixtype[7]
+int	type_codes[6], i
+data	type_codes /TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE, TY_COMPLEX/
+int	strdic()
+
+begin
+	call clgstr ("pixtype", pixtype, 7)
+	i = strdic (pixtype, pixtype, 7, "|short|int|long|real|double|complex|")
+	if (i > 0)
+	    IM_PIXTYPE(im) = type_codes[i]
+end
+
+
+# GET_ROOT -- Get the root name from an image.
+
+procedure get_root (image, root, maxch)
+
+char	image[ARB]			# Image name with possible section
+char	root[ARB]			# Root image name
+int	maxch				# Maximum length of root image name
+
+begin
+	call imgimage (image, root, maxch)
+end
+
+
+# GET_SECTION -- Get the image section from an image.
+
+procedure get_section (image, section, maxch)
+
+char	image[ARB]			# Image name with possible section
+char	section[ARB]			# Section
+int	maxch				# Maximum length of section
+
+begin
+	call imgsection (image, section, maxch)
+end
+
+
+# XT_MKIMTEMP -- Return the temporary output image name to be used.
+# XT_DELIMTEMP -- Delete the temporary image.
+#
+# In order to have an output image be the same as the input
+# image a temporary image is used.  When the temporary image has been
+# created it replaces the desired output image name.  Only root names
+# are considered.
+
+procedure xt_mkimtemp (input, output, original, sz_fname)
+
+char	input[ARB]			#I Input image
+char	output[ARB]			#U Output image to use
+char	original[ARB]			#O Root of original output image
+int	sz_fname			#I Maximum size of image names
+
+pointer	sp, inname, outname, extn
+int	i, j, k, gstrmatch(), strncmp(), fnextn()
+bool	xt_imnameeq()
+
+begin
+	call smark (sp)
+	call salloc (inname, SZ_FNAME, TY_CHAR)
+	call salloc (outname, SZ_FNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	# Strip image sections leaving only the path and root image name
+	# (with group and image kernel parameters).  To change to
+	# remove group and image kernel stuff use imgcluster instead of
+	# imgimage.
+
+	call imgimage (input, Memc[inname], SZ_FNAME)
+	if (gstrmatch (input, Memc[inname], i, k) > 0)
+	    call strcpy (input, Memc[inname], k)
+
+	call imgimage (output, Memc[outname], SZ_FNAME)
+	if (gstrmatch (output, Memc[outname], j, k) > 0)
+	    call strcpy (output, Memc[outname], k)
+
+	call strcpy (Memc[outname], output, sz_fname)
+	call strcpy (Memc[outname], original, sz_fname)
+
+	# Check if the input and output images are the same.
+	# First check if the path names are the same and then if
+	# the image names are the same.  If they are return a temporary
+	# image name with the same extension as the output image.
+
+	if (i == j && strncmp (Memc[inname], Memc[outname], i-1) == 0) {
+	    if (xt_imnameeq (Memc[inname], Memc[outname])) {
+		call mktemp ("tmp", output, sz_fname)
+		if (fnextn (original, Memc[extn], SZ_FNAME) > 0) {
+		    call strcat (".", output, sz_fname)
+		    call strcat (Memc[extn], output, sz_fname)
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+procedure xt_delimtemp (output, original)
+
+char	output[ARB]		# Output image
+char	original[ARB]		# Temporary output image name
+
+bool	strne()
+errchk	imdelete
+
+begin
+	# If the output image is not the same as the original output image name
+	# replace the original output image with the new image.
+
+	if (strne (output, original)) {
+	    iferr (call imdelete (original))
+		;
+	    call imrename (output, original)
+	}
+end
diff --git a/pkg/xtools/inlfit/README b/pkg/xtools/inlfit/README
new file mode 100644
index 00000000..56d72836
--- /dev/null
+++ b/pkg/xtools/inlfit/README
@@ -0,0 +1,165 @@
+                      THE INLFIT PACKAGE
+
+This subdirectory contains the routines of the interactive non-linear
+least squares fitting package INLFIT. This package is layered on the NLFIT
+package in MATH. NLFIT uses the Levenberg-Marquardt method to solve for
+the parameters of a user specified non-linear equation. The user must supply
+two routines. The first routine evaluates the function in terms of its
+parameters. The second routine evaluates the function and its derivatives
+in terms of its parameters. The user must also supply initial guesses for
+the parameters and parameter increments, the list of parameters to be
+varied during the fitting process, a fitting tolerance, and the maximum
+number of iterations.
+
+The entry points into the INLFIT package are listed below.
+
+	  ininit - Initialize the fitting routines
+	   inget - Get the value of an INLFIT parameter
+	   input - Store the value of an INLFIT parameter
+	  ingkey - Get the value of an INLFIT graphics/axis parameter
+	  inpkey - Store the value of an INLFIT graphics/axis parameter
+	   infit - Fit the function non-interactively
+	  ingfit - Fit the function interactively
+	inerrors - Compute the errors of the fit
+	  infree - Free memory allocated by ininit
+
+The calling sequences for the above routines are listed below. The [iprd]
+stand for integer, pointer, real and double precision versions of each
+routine respectively. [str] stands for string.
+
+               in_init[rd] (in, address(func), address(dfunc), param, dparam,
+	               nparams, plist, nfparams)
+  [irdp]val = in_get[irdp] (in, param)
+                   in_gstr (in, params, str, maxch)
+              in_put[irdp] (in, param, val)
+                   in_pstr (in, param, str)
+                   in_gkey (in, key, axis, type, varnum)
+                   in_pkey (in, key, axis, type, varnum)
+               in_fit[rd]  (in, nl, x, y, wts, npts, nvars, wtflag, stat)
+               ing_fit[rd] (in, gp, cursor, gt, nl, x, y, wts, names, npts,
+	                     nvars, len_names, wtflag, stat)
+             in_errors[rd] (in, nl, x, y, wts, npts, nvars, variance,
+	                    chisqr, scatter, rms, errors)
+               in_free[rd] (in)
+
+
+The user supplied functions fnc and dfnc have the following calling
+sequences.
+
+	fnc (x, nvars, nparams, nparams, zfit)
+       dfnc (x, nvars, params, dparams, nparams, zfit, derivs)
+
+The addresses of the user supplied functions can be obtained with a call
+to locpr as follows.
+
+        address = locpr (fnc)
+
+The user definition for the INLFIT package can be found in the file 
+lib$pkg/inlfit.h and can be made available to user applications programs
+with the statement "include <pkg/inlfit.h>".
+
+The permitted values for the param argument are the following.
+
+# Integer valued parameters (in_geti, in_puti)
+
+define	INLFUNCTION		# Fitting function
+define	INLDERIVATIVE		# Fitting function derivatives
+define	INLNPARAMS		# Total number of parameters
+define	INLNFPARAMS		# Number of fitting parameters
+define	INLNVARS		# Number of variables
+define	INLNPTS			# Number of variables
+define	INLMAXITER		# Max. number of iterations
+define	INLNREJECT		# Number of rejection iterations
+define	INLNREJPTS		# Number of rejected points
+define	INLUAXES		# User plot function
+define	INLUCOLON		# User colon function
+define	INLUFIT			# User fit function
+define	INLOVERPLOT		# Overplot next plot ?
+define	INLPLOTFIT		# Overplot fit ?
+define	INLFITERROR		# Error fit code
+define	INLGKEY			# Graph key
+
+
+# Real/double valued parameters (in_get[rd], in_put[rd])
+
+define	INLTOLERANCE		# Tolerance of convergence
+define	INLLOW			# Low rejection value
+define	INLHIGH			# High rejection value
+define	INLGROW			# Rejection growing radius
+
+
+# Pointer valued parameters (in_getp, in_getp)
+
+define	INLNL			# NLFIT descriptor
+define	INLPARAM		# Parameter vector
+define	INLDPARAM		# Parameter change vector
+define	INLPLIST		# Parameter list
+define	INLREJPTS		# Rejected points
+define	INLXMIN			# Minimum value for curve
+define	INLXMAX			# Maximum value for curve
+define	INLSFLOAT		# Floating point substructure
+define	INLSGAXES		# Graphics substructure
+
+
+# String valued parameters (in_gstr, in_pstr)
+
+define	INLLABELS		# standard axis labels
+define	INLUNITS		# standard axis units
+define	INLFLABELS		# Function labels
+define	INLFUNITS		# Function units
+define	INLPLABELS		# Parameter labels
+define	INLPUNITS		# Parameter units
+define	INLVLABELS		# Variable labels
+define	INLVUNITS		# Variable units
+define	INLUSERLABELS		# User plot labels
+define	INLUSERUNITS		# User plot units
+define	INLHELP			# Help file name
+define	INLPROMPT		# Help prompt
+
+
+The permitted values for the key argument are the following.
+
+# in_gkey, in_pkey
+
+define	KEY_FUNCTION		# Function
+define	KEY_FIT			# Fit
+define	KEY_RESIDUALS		# Residuals
+define	KEY_RATIO		# Ratio
+define	KEY_NONLINEAR		# Non-linear part
+define	KEY_VARIABLE		# Variable (user or default)
+define	KEY_UAXIS		# User plot function
+define	KEY_MIN			# Min. key type
+define	KEY_MAX			# Max. key type
+
+The permitted values for the axis argument are the following.
+
+# in_gkey, in_pkey
+
+define	INLXAXIS		# X axis
+define	INLYAXIS		# Y axis
+
+
+The permitted values of the weights flag argument wtflag input to
+in_fit[rd] or in_gfit[rd], and the stat argument returned by in_fit[rd]
+or in_gfit[rd] are defined in lib$math/nlfit.h. They can be included in
+the user's application with the statement "include <math/nlfit.h>".
+The values are listed below.
+
+# Permitted values for wtflag
+
+define	WTS_USER		# User supplied weights
+define	WTS_UNIFORM		# Uniform weighting
+define	WTS_CHISQ		# Chi-squared weighting
+define	WTS_SCATTER		# Weights include computed scatter term
+
+# Permitted values for stat
+
+define	DONE			# Solution converged
+define	SINGULAR		# Singular solution
+define	NO_DEG_FREEDOM		# Too few points
+define	NOT_DONE		# Solution did not converge.
+
+Note the pointer to the NLFIT structure nl is returned by the in_fit[rd]
+and in_gfit[rd] routines and input to the in_errors[rd] routine. This
+pointer must be freed separately with a call to nl_free when the fitting
+process terminates.
diff --git a/pkg/xtools/inlfit/incopy.gx b/pkg/xtools/inlfit/incopy.gx
new file mode 100644
index 00000000..8165cf6d
--- /dev/null
+++ b/pkg/xtools/inlfit/incopy.gx
@@ -0,0 +1,126 @@
+include	<pkg/inlfit.h>
+include	"inlfitdef.h"
+
+# IN_COPY -- Copy INLFIT parameter structure, into another. The destination
+# structure is allocated if the pointer is NULL.
+
+procedure in_copy$t (insrc, indst)
+
+pointer	insrc			# source INLFIT pointer
+pointer	indst			# destination INLFIT pointer
+
+int	in_geti()
+PIXEL	in_get$t()
+pointer	in_getp()
+
+begin
+#	# Debug.
+#	call eprintf (
+#	    "in_copy: insrc=%d, indst=%d\n")
+#	    call pargi (insrc)
+#	    call pargi (indst)
+
+	# Allocate destination.
+	if (indst == NULL) {
+
+	    # Allocate structure memory.
+	    call malloc (indst, LEN_INLSTRUCT, TY_STRUCT)
+
+	    # Allocate memory for parameter values, changes, and list.
+	    call malloc (IN_PARAM  (indst), in_geti (insrc, INLNPARAMS),
+			 TY_PIXEL)
+	    call malloc (IN_DPARAM (indst), in_geti (insrc, INLNPARAMS),
+			 TY_PIXEL)
+	    call malloc (IN_PLIST  (indst), in_geti (insrc, INLNPARAMS),
+			 TY_INT)
+
+	    # Allocate space for strings. All strings are limited
+	    # to SZ_LINE or SZ_FNAME.
+	    call malloc (IN_LABELS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_UNITS      (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_FLABELS    (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_FUNITS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_PLABELS    (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_PUNITS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_VLABELS    (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_VUNITS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_USERLABELS (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_USERUNITS  (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_HELP       (indst), SZ_FNAME, TY_CHAR)
+	    call malloc (IN_PROMPT     (indst), SZ_FNAME, TY_CHAR)
+
+	    # Allocate space for floating point and graph substructures.
+	    call malloc (IN_SFLOAT (indst), LEN_INLFLOAT, TY_PIXEL)
+	    call malloc (IN_SGAXES (indst), INLNGKEYS * LEN_INLGRAPH, TY_INT)
+	}
+
+	# Copy integer parameters.
+	call in_puti (indst, INLFUNCTION,   in_geti (insrc, INLFUNCTION))
+	call in_puti (indst, INLDERIVATIVE, in_geti (insrc, INLDERIVATIVE))
+	call in_puti (indst, INLNPARAMS,    in_geti (insrc, INLNPARAMS))
+	call in_puti (indst, INLNFPARAMS,   in_geti (insrc, INLNFPARAMS))
+
+	# Copy parameter values, changes, and list.
+	call amov$t  (Mem$t[in_getp (insrc, INLPARAM)],
+		      Mem$t[in_getp (indst, INLPARAM)],
+		      in_geti (insrc, INLNPARAMS))
+	call amov$t  (Mem$t[in_getp (insrc, INLDPARAM)],
+		      Mem$t[in_getp (indst, INLDPARAM)],
+		      in_geti (insrc, INLNPARAMS))
+	call amovi   (Memi[in_getp (insrc, INLPLIST)],
+		      Memi[in_getp (indst, INLPLIST)],
+		      in_geti (insrc, INLNPARAMS))
+
+	# Copy defaults.
+	call in_put$t (indst, INLTOLERANCE, in_get$t (insrc, INLTOLERANCE))
+	call in_puti  (indst, INLMAXITER,   in_geti  (insrc, INLMAXITER))
+	call in_puti  (indst, INLNREJECT,   in_geti  (insrc, INLNREJECT))
+	call in_put$t (indst, INLLOW,       in_get$t (insrc, INLLOW))
+	call in_put$t (indst, INLHIGH,      in_get$t (insrc, INLHIGH))
+	call in_put$t (indst, INLGROW,      in_get$t (insrc, INLGROW))
+
+	# Copy character strings.
+	call in_pstr (indst, INLLABELS,     Memc[IN_LABELS     (insrc)])
+	call in_pstr (indst, INLUNITS,      Memc[IN_UNITS      (insrc)])
+	call in_pstr (indst, INLFLABELS,    Memc[IN_FLABELS    (insrc)])
+	call in_pstr (indst, INLFUNITS,     Memc[IN_FUNITS     (insrc)])
+	call in_pstr (indst, INLPLABELS,    Memc[IN_PLABELS    (insrc)])
+	call in_pstr (indst, INLPUNITS,     Memc[IN_PUNITS     (insrc)])
+	call in_pstr (indst, INLVLABELS,    Memc[IN_VLABELS    (insrc)])
+	call in_pstr (indst, INLVUNITS,     Memc[IN_VUNITS     (insrc)])
+	call in_pstr (indst, INLUSERLABELS, Memc[IN_USERLABELS (insrc)])
+	call in_pstr (indst, INLUSERUNITS,  Memc[IN_USERUNITS  (insrc)])
+	call in_pstr (indst, INLHELP,       Memc[IN_HELP       (insrc)])
+	call in_pstr (indst, INLPROMPT,     Memc[IN_PROMPT     (insrc)])
+
+	# Copy user defined functions.
+	call in_puti (indst, INLUAXES,  in_geti (insrc, INLUAXES))
+	call in_puti (indst, INLUCOLON, in_geti (insrc, INLUCOLON))
+	call in_puti (indst, INLUFIT,   in_geti (insrc, INLUFIT))
+
+	# Copy graph key, and axes.
+	call in_puti (indst, INLGKEY, in_geti (insrc, INLGKEY))
+	call amovi (IN_SGAXES (insrc), IN_SGAXES (indst),
+	    INLNGKEYS * LEN_INLGRAPH)
+
+	# Copy flags and counters.
+	call in_puti (indst, INLOVERPLOT, in_geti (insrc, INLOVERPLOT))
+	call in_puti (indst, INLPLOTFIT,  in_geti (insrc, INLPLOTFIT))
+	call in_puti (indst, INLNREJPTS,  in_geti (insrc, INLNREJPTS))
+
+	# Initialize number of points and variables.
+	call in_puti (indst, INLNVARS, 0)
+	call in_puti (indst, INLNPTS,  0)
+
+	# Reallocate rejected point list and limit values.
+	call in_bfinit (indst, in_geti (insrc, INLNPTS),
+	    in_geti (insrc, INLNVARS))
+
+	# Copy rejected point list and limit values.
+	call amovi  (MEMP[in_getp (insrc, INLREJPTS)],
+	    MEMP[in_getp (indst, INLREJPTS)], in_geti (indst, INLNPTS))
+	call amov$t (Mem$t[in_getp (insrc, INLXMIN)],
+	    Mem$t[in_getp (indst, INLXMIN)], in_geti (indst, INLNVARS))
+	call amov$t (Mem$t[in_getp (insrc, INLXMAX)],
+	    Mem$t[in_getp (indst, INLXMAX)], in_geti (indst, INLNVARS))
+end
diff --git a/pkg/xtools/inlfit/incopyd.x b/pkg/xtools/inlfit/incopyd.x
new file mode 100644
index 00000000..01ae6793
--- /dev/null
+++ b/pkg/xtools/inlfit/incopyd.x
@@ -0,0 +1,126 @@
+include	<pkg/inlfit.h>
+include	"inlfitdef.h"
+
+# IN_COPY -- Copy INLFIT parameter structure, into another. The destination
+# structure is allocated if the pointer is NULL.
+
+procedure in_copyd (insrc, indst)
+
+pointer	insrc			# source INLFIT pointer
+pointer	indst			# destination INLFIT pointer
+
+int	in_geti()
+double	in_getd()
+pointer	in_getp()
+
+begin
+#	# Debug.
+#	call eprintf (
+#	    "in_copy: insrc=%d, indst=%d\n")
+#	    call pargi (insrc)
+#	    call pargi (indst)
+
+	# Allocate destination.
+	if (indst == NULL) {
+
+	    # Allocate structure memory.
+	    call malloc (indst, LEN_INLSTRUCT, TY_STRUCT)
+
+	    # Allocate memory for parameter values, changes, and list.
+	    call malloc (IN_PARAM  (indst), in_geti (insrc, INLNPARAMS),
+			 TY_DOUBLE)
+	    call malloc (IN_DPARAM (indst), in_geti (insrc, INLNPARAMS),
+			 TY_DOUBLE)
+	    call malloc (IN_PLIST  (indst), in_geti (insrc, INLNPARAMS),
+			 TY_INT)
+
+	    # Allocate space for strings. All strings are limited
+	    # to SZ_LINE or SZ_FNAME.
+	    call malloc (IN_LABELS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_UNITS      (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_FLABELS    (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_FUNITS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_PLABELS    (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_PUNITS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_VLABELS    (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_VUNITS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_USERLABELS (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_USERUNITS  (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_HELP       (indst), SZ_FNAME, TY_CHAR)
+	    call malloc (IN_PROMPT     (indst), SZ_FNAME, TY_CHAR)
+
+	    # Allocate space for floating point and graph substructures.
+	    call malloc (IN_SFLOAT (indst), LEN_INLFLOAT, TY_DOUBLE)
+	    call malloc (IN_SGAXES (indst), INLNGKEYS * LEN_INLGRAPH, TY_INT)
+	}
+
+	# Copy integer parameters.
+	call in_puti (indst, INLFUNCTION,   in_geti (insrc, INLFUNCTION))
+	call in_puti (indst, INLDERIVATIVE, in_geti (insrc, INLDERIVATIVE))
+	call in_puti (indst, INLNPARAMS,    in_geti (insrc, INLNPARAMS))
+	call in_puti (indst, INLNFPARAMS,   in_geti (insrc, INLNFPARAMS))
+
+	# Copy parameter values, changes, and list.
+	call amovd  (Memd[in_getp (insrc, INLPARAM)],
+		      Memd[in_getp (indst, INLPARAM)],
+		      in_geti (insrc, INLNPARAMS))
+	call amovd  (Memd[in_getp (insrc, INLDPARAM)],
+		      Memd[in_getp (indst, INLDPARAM)],
+		      in_geti (insrc, INLNPARAMS))
+	call amovi   (Memi[in_getp (insrc, INLPLIST)],
+		      Memi[in_getp (indst, INLPLIST)],
+		      in_geti (insrc, INLNPARAMS))
+
+	# Copy defaults.
+	call in_putd (indst, INLTOLERANCE, in_getd (insrc, INLTOLERANCE))
+	call in_puti  (indst, INLMAXITER,   in_geti  (insrc, INLMAXITER))
+	call in_puti  (indst, INLNREJECT,   in_geti  (insrc, INLNREJECT))
+	call in_putd (indst, INLLOW,       in_getd (insrc, INLLOW))
+	call in_putd (indst, INLHIGH,      in_getd (insrc, INLHIGH))
+	call in_putd (indst, INLGROW,      in_getd (insrc, INLGROW))
+
+	# Copy character strings.
+	call in_pstr (indst, INLLABELS,     Memc[IN_LABELS     (insrc)])
+	call in_pstr (indst, INLUNITS,      Memc[IN_UNITS      (insrc)])
+	call in_pstr (indst, INLFLABELS,    Memc[IN_FLABELS    (insrc)])
+	call in_pstr (indst, INLFUNITS,     Memc[IN_FUNITS     (insrc)])
+	call in_pstr (indst, INLPLABELS,    Memc[IN_PLABELS    (insrc)])
+	call in_pstr (indst, INLPUNITS,     Memc[IN_PUNITS     (insrc)])
+	call in_pstr (indst, INLVLABELS,    Memc[IN_VLABELS    (insrc)])
+	call in_pstr (indst, INLVUNITS,     Memc[IN_VUNITS     (insrc)])
+	call in_pstr (indst, INLUSERLABELS, Memc[IN_USERLABELS (insrc)])
+	call in_pstr (indst, INLUSERUNITS,  Memc[IN_USERUNITS  (insrc)])
+	call in_pstr (indst, INLHELP,       Memc[IN_HELP       (insrc)])
+	call in_pstr (indst, INLPROMPT,     Memc[IN_PROMPT     (insrc)])
+
+	# Copy user defined functions.
+	call in_puti (indst, INLUAXES,  in_geti (insrc, INLUAXES))
+	call in_puti (indst, INLUCOLON, in_geti (insrc, INLUCOLON))
+	call in_puti (indst, INLUFIT,   in_geti (insrc, INLUFIT))
+
+	# Copy graph key, and axes.
+	call in_puti (indst, INLGKEY, in_geti (insrc, INLGKEY))
+	call amovi (IN_SGAXES (insrc), IN_SGAXES (indst),
+	    INLNGKEYS * LEN_INLGRAPH)
+
+	# Copy flags and counters.
+	call in_puti (indst, INLOVERPLOT, in_geti (insrc, INLOVERPLOT))
+	call in_puti (indst, INLPLOTFIT,  in_geti (insrc, INLPLOTFIT))
+	call in_puti (indst, INLNREJPTS,  in_geti (insrc, INLNREJPTS))
+
+	# Initialize number of points and variables.
+	call in_puti (indst, INLNVARS, 0)
+	call in_puti (indst, INLNPTS,  0)
+
+	# Reallocate rejected point list and limit values.
+	call in_bfinit (indst, in_geti (insrc, INLNPTS),
+	    in_geti (insrc, INLNVARS))
+
+	# Copy rejected point list and limit values.
+	call amovi  (MEMP[in_getp (insrc, INLREJPTS)],
+	    MEMP[in_getp (indst, INLREJPTS)], in_geti (indst, INLNPTS))
+	call amovd (Memd[in_getp (insrc, INLXMIN)],
+	    Memd[in_getp (indst, INLXMIN)], in_geti (indst, INLNVARS))
+	call amovd (Memd[in_getp (insrc, INLXMAX)],
+	    Memd[in_getp (indst, INLXMAX)], in_geti (indst, INLNVARS))
+end
diff --git a/pkg/xtools/inlfit/incopyr.x b/pkg/xtools/inlfit/incopyr.x
new file mode 100644
index 00000000..1e698374
--- /dev/null
+++ b/pkg/xtools/inlfit/incopyr.x
@@ -0,0 +1,126 @@
+include	<pkg/inlfit.h>
+include	"inlfitdef.h"
+
+# IN_COPY -- Copy INLFIT parameter structure, into another. The destination
+# structure is allocated if the pointer is NULL.
+
+procedure in_copyr (insrc, indst)
+
+pointer	insrc			# source INLFIT pointer
+pointer	indst			# destination INLFIT pointer
+
+int	in_geti()
+real	in_getr()
+pointer	in_getp()
+
+begin
+#	# Debug.
+#	call eprintf (
+#	    "in_copy: insrc=%d, indst=%d\n")
+#	    call pargi (insrc)
+#	    call pargi (indst)
+
+	# Allocate destination.
+	if (indst == NULL) {
+
+	    # Allocate structure memory.
+	    call malloc (indst, LEN_INLSTRUCT, TY_STRUCT)
+
+	    # Allocate memory for parameter values, changes, and list.
+	    call malloc (IN_PARAM  (indst), in_geti (insrc, INLNPARAMS),
+			 TY_REAL)
+	    call malloc (IN_DPARAM (indst), in_geti (insrc, INLNPARAMS),
+			 TY_REAL)
+	    call malloc (IN_PLIST  (indst), in_geti (insrc, INLNPARAMS),
+			 TY_INT)
+
+	    # Allocate space for strings. All strings are limited
+	    # to SZ_LINE or SZ_FNAME.
+	    call malloc (IN_LABELS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_UNITS      (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_FLABELS    (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_FUNITS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_PLABELS    (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_PUNITS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_VLABELS    (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_VUNITS     (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_USERLABELS (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_USERUNITS  (indst), SZ_LINE,  TY_CHAR)
+	    call malloc (IN_HELP       (indst), SZ_FNAME, TY_CHAR)
+	    call malloc (IN_PROMPT     (indst), SZ_FNAME, TY_CHAR)
+
+	    # Allocate space for floating point and graph substructures.
+	    call malloc (IN_SFLOAT (indst), LEN_INLFLOAT, TY_REAL)
+	    call malloc (IN_SGAXES (indst), INLNGKEYS * LEN_INLGRAPH, TY_INT)
+	}
+
+	# Copy integer parameters.
+	call in_puti (indst, INLFUNCTION,   in_geti (insrc, INLFUNCTION))
+	call in_puti (indst, INLDERIVATIVE, in_geti (insrc, INLDERIVATIVE))
+	call in_puti (indst, INLNPARAMS,    in_geti (insrc, INLNPARAMS))
+	call in_puti (indst, INLNFPARAMS,   in_geti (insrc, INLNFPARAMS))
+
+	# Copy parameter values, changes, and list.
+	call amovr  (Memr[in_getp (insrc, INLPARAM)],
+		      Memr[in_getp (indst, INLPARAM)],
+		      in_geti (insrc, INLNPARAMS))
+	call amovr  (Memr[in_getp (insrc, INLDPARAM)],
+		      Memr[in_getp (indst, INLDPARAM)],
+		      in_geti (insrc, INLNPARAMS))
+	call amovi   (Memi[in_getp (insrc, INLPLIST)],
+		      Memi[in_getp (indst, INLPLIST)],
+		      in_geti (insrc, INLNPARAMS))
+
+	# Copy defaults.
+	call in_putr (indst, INLTOLERANCE, in_getr (insrc, INLTOLERANCE))
+	call in_puti  (indst, INLMAXITER,   in_geti  (insrc, INLMAXITER))
+	call in_puti  (indst, INLNREJECT,   in_geti  (insrc, INLNREJECT))
+	call in_putr (indst, INLLOW,       in_getr (insrc, INLLOW))
+	call in_putr (indst, INLHIGH,      in_getr (insrc, INLHIGH))
+	call in_putr (indst, INLGROW,      in_getr (insrc, INLGROW))
+
+	# Copy character strings.
+	call in_pstr (indst, INLLABELS,     Memc[IN_LABELS     (insrc)])
+	call in_pstr (indst, INLUNITS,      Memc[IN_UNITS      (insrc)])
+	call in_pstr (indst, INLFLABELS,    Memc[IN_FLABELS    (insrc)])
+	call in_pstr (indst, INLFUNITS,     Memc[IN_FUNITS     (insrc)])
+	call in_pstr (indst, INLPLABELS,    Memc[IN_PLABELS    (insrc)])
+	call in_pstr (indst, INLPUNITS,     Memc[IN_PUNITS     (insrc)])
+	call in_pstr (indst, INLVLABELS,    Memc[IN_VLABELS    (insrc)])
+	call in_pstr (indst, INLVUNITS,     Memc[IN_VUNITS     (insrc)])
+	call in_pstr (indst, INLUSERLABELS, Memc[IN_USERLABELS (insrc)])
+	call in_pstr (indst, INLUSERUNITS,  Memc[IN_USERUNITS  (insrc)])
+	call in_pstr (indst, INLHELP,       Memc[IN_HELP       (insrc)])
+	call in_pstr (indst, INLPROMPT,     Memc[IN_PROMPT     (insrc)])
+
+	# Copy user defined functions.
+	call in_puti (indst, INLUAXES,  in_geti (insrc, INLUAXES))
+	call in_puti (indst, INLUCOLON, in_geti (insrc, INLUCOLON))
+	call in_puti (indst, INLUFIT,   in_geti (insrc, INLUFIT))
+
+	# Copy graph key, and axes.
+	call in_puti (indst, INLGKEY, in_geti (insrc, INLGKEY))
+	call amovi (IN_SGAXES (insrc), IN_SGAXES (indst),
+	    INLNGKEYS * LEN_INLGRAPH)
+
+	# Copy flags and counters.
+	call in_puti (indst, INLOVERPLOT, in_geti (insrc, INLOVERPLOT))
+	call in_puti (indst, INLPLOTFIT,  in_geti (insrc, INLPLOTFIT))
+	call in_puti (indst, INLNREJPTS,  in_geti (insrc, INLNREJPTS))
+
+	# Initialize number of points and variables.
+	call in_puti (indst, INLNVARS, 0)
+	call in_puti (indst, INLNPTS,  0)
+
+	# Reallocate rejected point list and limit values.
+	call in_bfinit (indst, in_geti (insrc, INLNPTS),
+	    in_geti (insrc, INLNVARS))
+
+	# Copy rejected point list and limit values.
+	call amovi  (MEMP[in_getp (insrc, INLREJPTS)],
+	    MEMP[in_getp (indst, INLREJPTS)], in_geti (indst, INLNPTS))
+	call amovr (Memr[in_getp (insrc, INLXMIN)],
+	    Memr[in_getp (indst, INLXMIN)], in_geti (indst, INLNVARS))
+	call amovr (Memr[in_getp (insrc, INLXMAX)],
+	    Memr[in_getp (indst, INLXMAX)], in_geti (indst, INLNVARS))
+end
diff --git a/pkg/xtools/inlfit/indeviant.gx b/pkg/xtools/inlfit/indeviant.gx
new file mode 100644
index 00000000..4ee2f372
--- /dev/null
+++ b/pkg/xtools/inlfit/indeviant.gx
@@ -0,0 +1,121 @@
+include	<mach.h>
+
+
+# IN_DEVIANT -- Find deviant points with large residuals from the fit
+# and reject them from the fit.  The sigma of the fit residuals is calculated.
+# The rejection thresholds are set at (+/-)reject*sigma.  Points outside the
+# rejection threshold are recorded in the reject array.
+
+procedure in_deviant$t (nl, x, y, w, rejpts, npts, nvars, low_reject,
+	high_reject, grow, nreject, newreject)
+
+pointer	nl				# NLFIT descriptor
+PIXEL	x[ARB]				# Input ordinates (npts * nvars)
+PIXEL	y[npts]				# Input data values
+PIXEL	w[npts]				# Weights
+int	rejpts[npts]			# Points rejected
+int	npts				# Number of input points
+int	nvars				# Number of input variables
+PIXEL	low_reject, high_reject		# Rejection thresholds
+PIXEL	grow				# Rejection radius
+int	nreject				# Number of points rejected (output)
+int	newreject			# Number of new points rej. (output)
+
+int	i, j, i_min, i_max, ilast
+PIXEL	sigma, low_cut, high_cut, residual
+pointer	sp, residuals
+
+begin
+#	# Debug.
+#	call eprintf (
+#	    "in_deviant: nl=%d, npts=%d, nvars=%d, low=%g, high=%g, grow=%g\n")
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+#	    call parg$t (low_reject)
+#	    call parg$t (high_reject)
+#	    call parg$t (grow)
+
+	# Initialize.
+	nreject = 0
+	newreject = 0
+
+	# If low_reject and high_reject are zero then just return.
+	if ((low_reject == PIXEL (0.0)) && (high_reject == PIXEL (0.0)))
+	    return
+
+	# Allocate memory for the residuals.
+	call smark (sp)
+	call salloc (residuals, npts, TY_PIXEL)
+
+	# Compute the residuals.
+	call nlvector$t (nl, x, Mem$t[residuals], npts, nvars)
+	call asub$t (y, Mem$t[residuals], Mem$t[residuals], npts)
+
+	# Compute the sigma of the residuals.
+	j = 0
+	sigma = PIXEL (0.0)
+	do i = 1, npts {
+	    if ((w[i] != PIXEL (0.0)) && (rejpts[i] == NO)) {
+		sigma = sigma + Mem$t[residuals+i-1] ** 2
+		j = j + 1
+	    } else if (rejpts[i] == YES)
+		nreject = nreject + 1
+	}
+
+	# If there are less than five points for the sigma calculation,
+	# just return.
+
+	if (j < 5) {
+	    call sfree (sp)
+	    return
+	} else
+	    sigma = sqrt (sigma / j)
+
+	# Set the lower and upper cut limits according the the sigma value.
+
+	if (low_reject > PIXEL (0.0))
+	    low_cut = -low_reject * sigma
+	else
+	    low_cut = -MAX_REAL
+	if (high_reject > PIXEL (0.0))
+	    high_cut = high_reject * sigma
+	else
+	    high_cut = MAX_REAL
+
+	# Reject the residuals exceeding the rejection limits.
+	# A for loop is used instead of do because with region
+	# growing we want to modify the loop index.
+
+	for (i = 1; i <= npts; i = i + 1) {
+
+	    # Do not process points with zero weigth or already rejected.
+	    if ((w[i] == PIXEL (0.0)) || (rejpts[i] == YES))
+		next
+
+	    # Reject point, and all other points closer than the growing
+	    # factor.
+
+	    residual = Mem$t[residuals + i - 1]
+	    if ((residual > high_cut) || (residual < low_cut)) {
+
+		# Determine region to reject.
+		i_min = max (1, int (i - grow))
+		i_max = min (npts, int (i + grow))
+
+		# Reject points from the fit and flag them.
+		do j = i_min, i_max {
+		    if ((abs (x[i] - x[j]) <= grow) && (w[j] != PIXEL (0.0)) &&
+		        (rejpts[j] == NO)) {
+			rejpts[j] = YES
+		        newreject = newreject + 1
+			ilast = j
+		    }
+		}
+		i = ilast
+	    }
+	}
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/indeviantd.x b/pkg/xtools/inlfit/indeviantd.x
new file mode 100644
index 00000000..ec32e637
--- /dev/null
+++ b/pkg/xtools/inlfit/indeviantd.x
@@ -0,0 +1,121 @@
+include	<mach.h>
+
+
+# IN_DEVIANT -- Find deviant points with large residuals from the fit
+# and reject them from the fit.  The sigma of the fit residuals is calculated.
+# The rejection thresholds are set at (+/-)reject*sigma.  Points outside the
+# rejection threshold are recorded in the reject array.
+
+procedure in_deviantd (nl, x, y, w, rejpts, npts, nvars, low_reject,
+	high_reject, grow, nreject, newreject)
+
+pointer	nl				# NLFIT descriptor
+double	x[ARB]				# Input ordinates (npts * nvars)
+double	y[npts]				# Input data values
+double	w[npts]				# Weights
+int	rejpts[npts]			# Points rejected
+int	npts				# Number of input points
+int	nvars				# Number of input variables
+double	low_reject, high_reject		# Rejection thresholds
+double	grow				# Rejection radius
+int	nreject				# Number of points rejected (output)
+int	newreject			# Number of new points rej. (output)
+
+int	i, j, i_min, i_max, ilast
+double	sigma, low_cut, high_cut, residual
+pointer	sp, residuals
+
+begin
+#	# Debug.
+#	call eprintf (
+#	    "in_deviant: nl=%d, npts=%d, nvars=%d, low=%g, high=%g, grow=%g\n")
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+#	    call parg$t (low_reject)
+#	    call parg$t (high_reject)
+#	    call parg$t (grow)
+
+	# Initialize.
+	nreject = 0
+	newreject = 0
+
+	# If low_reject and high_reject are zero then just return.
+	if ((low_reject == double (0.0)) && (high_reject == double (0.0)))
+	    return
+
+	# Allocate memory for the residuals.
+	call smark (sp)
+	call salloc (residuals, npts, TY_DOUBLE)
+
+	# Compute the residuals.
+	call nlvectord (nl, x, Memd[residuals], npts, nvars)
+	call asubd (y, Memd[residuals], Memd[residuals], npts)
+
+	# Compute the sigma of the residuals.
+	j = 0
+	sigma = double (0.0)
+	do i = 1, npts {
+	    if ((w[i] != double (0.0)) && (rejpts[i] == NO)) {
+		sigma = sigma + Memd[residuals+i-1] ** 2
+		j = j + 1
+	    } else if (rejpts[i] == YES)
+		nreject = nreject + 1
+	}
+
+	# If there are less than five points for the sigma calculation,
+	# just return.
+
+	if (j < 5) {
+	    call sfree (sp)
+	    return
+	} else
+	    sigma = sqrt (sigma / j)
+
+	# Set the lower and upper cut limits according the the sigma value.
+
+	if (low_reject > double (0.0))
+	    low_cut = -low_reject * sigma
+	else
+	    low_cut = -MAX_REAL
+	if (high_reject > double (0.0))
+	    high_cut = high_reject * sigma
+	else
+	    high_cut = MAX_REAL
+
+	# Reject the residuals exceeding the rejection limits.
+	# A for loop is used instead of do because with region
+	# growing we want to modify the loop index.
+
+	for (i = 1; i <= npts; i = i + 1) {
+
+	    # Do not process points with zero weigth or already rejected.
+	    if ((w[i] == double (0.0)) || (rejpts[i] == YES))
+		next
+
+	    # Reject point, and all other points closer than the growing
+	    # factor.
+
+	    residual = Memd[residuals + i - 1]
+	    if ((residual > high_cut) || (residual < low_cut)) {
+
+		# Determine region to reject.
+		i_min = max (1, int (i - grow))
+		i_max = min (npts, int (i + grow))
+
+		# Reject points from the fit and flag them.
+		do j = i_min, i_max {
+		    if ((abs (x[i] - x[j]) <= grow) && (w[j] != double (0.0)) &&
+		        (rejpts[j] == NO)) {
+			rejpts[j] = YES
+		        newreject = newreject + 1
+			ilast = j
+		    }
+		}
+		i = ilast
+	    }
+	}
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/indeviantr.x b/pkg/xtools/inlfit/indeviantr.x
new file mode 100644
index 00000000..334d7ef8
--- /dev/null
+++ b/pkg/xtools/inlfit/indeviantr.x
@@ -0,0 +1,121 @@
+include	<mach.h>
+
+
+# IN_DEVIANT -- Find deviant points with large residuals from the fit
+# and reject them from the fit.  The sigma of the fit residuals is calculated.
+# The rejection thresholds are set at (+/-)reject*sigma.  Points outside the
+# rejection threshold are recorded in the reject array.
+
+procedure in_deviantr (nl, x, y, w, rejpts, npts, nvars, low_reject,
+	high_reject, grow, nreject, newreject)
+
+pointer	nl				# NLFIT descriptor
+real	x[ARB]				# Input ordinates (npts * nvars)
+real	y[npts]				# Input data values
+real	w[npts]				# Weights
+int	rejpts[npts]			# Points rejected
+int	npts				# Number of input points
+int	nvars				# Number of input variables
+real	low_reject, high_reject		# Rejection thresholds
+real	grow				# Rejection radius
+int	nreject				# Number of points rejected (output)
+int	newreject			# Number of new points rej. (output)
+
+int	i, j, i_min, i_max, ilast
+real	sigma, low_cut, high_cut, residual
+pointer	sp, residuals
+
+begin
+#	# Debug.
+#	call eprintf (
+#	    "in_deviant: nl=%d, npts=%d, nvars=%d, low=%g, high=%g, grow=%g\n")
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+#	    call parg$t (low_reject)
+#	    call parg$t (high_reject)
+#	    call parg$t (grow)
+
+	# Initialize.
+	nreject = 0
+	newreject = 0
+
+	# If low_reject and high_reject are zero then just return.
+	if ((low_reject == real (0.0)) && (high_reject == real (0.0)))
+	    return
+
+	# Allocate memory for the residuals.
+	call smark (sp)
+	call salloc (residuals, npts, TY_REAL)
+
+	# Compute the residuals.
+	call nlvectorr (nl, x, Memr[residuals], npts, nvars)
+	call asubr (y, Memr[residuals], Memr[residuals], npts)
+
+	# Compute the sigma of the residuals.
+	j = 0
+	sigma = real (0.0)
+	do i = 1, npts {
+	    if ((w[i] != real (0.0)) && (rejpts[i] == NO)) {
+		sigma = sigma + Memr[residuals+i-1] ** 2
+		j = j + 1
+	    } else if (rejpts[i] == YES)
+		nreject = nreject + 1
+	}
+
+	# If there are less than five points for the sigma calculation,
+	# just return.
+
+	if (j < 5) {
+	    call sfree (sp)
+	    return
+	} else
+	    sigma = sqrt (sigma / j)
+
+	# Set the lower and upper cut limits according the the sigma value.
+
+	if (low_reject > real (0.0))
+	    low_cut = -low_reject * sigma
+	else
+	    low_cut = -MAX_REAL
+	if (high_reject > real (0.0))
+	    high_cut = high_reject * sigma
+	else
+	    high_cut = MAX_REAL
+
+	# Reject the residuals exceeding the rejection limits.
+	# A for loop is used instead of do because with region
+	# growing we want to modify the loop index.
+
+	for (i = 1; i <= npts; i = i + 1) {
+
+	    # Do not process points with zero weigth or already rejected.
+	    if ((w[i] == real (0.0)) || (rejpts[i] == YES))
+		next
+
+	    # Reject point, and all other points closer than the growing
+	    # factor.
+
+	    residual = Memr[residuals + i - 1]
+	    if ((residual > high_cut) || (residual < low_cut)) {
+
+		# Determine region to reject.
+		i_min = max (1, int (i - grow))
+		i_max = min (npts, int (i + grow))
+
+		# Reject points from the fit and flag them.
+		do j = i_min, i_max {
+		    if ((abs (x[i] - x[j]) <= grow) && (w[j] != real (0.0)) &&
+		        (rejpts[j] == NO)) {
+			rejpts[j] = YES
+		        newreject = newreject + 1
+			ilast = j
+		    }
+		}
+		i = ilast
+	    }
+	}
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/indump.gx b/pkg/xtools/inlfit/indump.gx
new file mode 100644
index 00000000..ee624a4e
--- /dev/null
+++ b/pkg/xtools/inlfit/indump.gx
@@ -0,0 +1,233 @@
+include	<pkg/inlfit.h>
+include	"inlfitdef.h"
+
+# IN_DUMP -- INLFIT debugging routine.
+
+procedure in_dump$t (fd, in)
+
+int	fd		# file descriptor
+pointer	in		# INLFIT descriptor
+
+int	i, npars, nfpars, nvars
+
+begin
+	# Test INLFIT pointer.
+	if (in == NULL) {
+	    call fprintf (fd, "\n****** in_dump: Null INLFIT pointer\n")
+	    call flush (fd)
+	    return
+	}
+
+	# File and INLFIT descriptors.
+	call fprintf (fd, "\n****** in_dump: (fd=%d), (in=%d)\n")
+	    call pargi (fd)
+	    call pargi (in)
+	call flush (fd)
+
+	# Function and derivative pointers.
+	call fprintf (fd, "Fitting function pointer    = %d\n")
+	    call pargi (IN_FUNC (in))
+	call fprintf (fd, "Derivative function pointer = %d\n")
+	    call pargi (IN_DFUNC (in))
+	call flush (fd)
+
+	# Number of parameters, fitting parameters, and variables.
+	npars  = IN_NPARAMS (in)
+	nfpars = IN_NFPARAMS (in)
+	nvars  = IN_NVARS (in)
+	call fprintf (fd, "Number of parameters        = %d\n")
+	    call pargi (npars)
+	call fprintf (fd, "Number of fitted parameters = %d\n")
+	    call pargi (nfpars)
+	call fprintf (fd, "Number of variables         = %d\n")
+	    call pargi (nvars)
+	call fprintf (fd, "Number of points            = %d\n")
+	    call pargi (IN_NPTS (in))
+	call flush (fd)
+
+	# Parameter values.
+	    call fprintf (fd, "Parameter values (%d):\n")
+		call pargi (npars)
+	if (IN_PARAM (in) != NULL) {
+	    do i = 1, npars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call parg$t (Mem$t [IN_PARAM (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null parameter value pointer\n")
+	call flush (fd)
+
+	# Parameter changes.
+	if (IN_PARAM (in) != NULL) {
+	    call fprintf (fd, "Parameter changes (%d):\n")
+		call pargi (npars)
+	    do i = 1, npars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call parg$t (Mem$t [IN_DPARAM (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null parameter change pointer\n")
+	call flush (fd)
+
+	# Parameter list.
+	if (IN_PARAM (in) != NULL) {
+	    call fprintf (fd, "Parameter list (%d):\n")
+		call pargi (npars)
+	    do i = 1, npars {
+		call fprintf (fd, "%d -> %d\n")
+		    call pargi (i)
+		    call pargi (Memi[IN_PLIST (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null parameter list pointer\n")
+	call flush (fd)
+
+	# Floating point parameters.
+	if (IN_SFLOAT (in) != NULL) {
+	    call fprintf (fd, "Fit tolerance  = %g\n")
+		call parg$t (IN_TOL$T (in))
+	    call fprintf (fd, "Low reject     = %g\n")
+		call parg$t (IN_LOW$T (in))
+	    call fprintf (fd, "High reject    = %g\n")
+		call parg$t (IN_HIGH$T (in))
+	    call fprintf (fd, "Growing radius = %g\n")
+		call parg$t (IN_GROW$T (in))
+	} else
+	    call fprintf (fd, "Null floating point pointer\n")
+	call flush (fd)
+
+	# Max number of iterations, and rejection iterations.
+	call fprintf (fd, "Maximum number of iterations   = %d\n")
+	    call pargi (IN_MAXITER (in))
+	call fprintf (fd, "Number of rejection iterations = %d\n")
+	    call pargi (IN_MAXITER (in))
+
+	# Rejected points.
+	call fprintf (fd, "Number of rejected points   = %d\n")
+	    call pargi (IN_NREJPTS (in))
+	call fprintf (fd, "Rejected point list pointer = %d\n")
+	    call pargi (IN_REJPTS (in))
+
+	# User procedures.
+	call fprintf (fd, "User axis procedure pointer  = %d\n")
+	    call pargi (IN_UAXES (in))
+	call fprintf (fd, "User colon procedure pointer = %d\n")
+	    call pargi (IN_UCOLON (in))
+	call fprintf (fd, "User fit procedure pointer   = %d\n")
+	    call pargi (IN_UFIT (in))
+
+	# Minimum variable values.
+	if (IN_XMIN (in) != NULL) {
+	    call fprintf (fd, "Minimum variable values (%d):\n")
+		call pargi (nvars)
+	    do i = 1, nvars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call parg$t (Mem$t[IN_XMIN (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null minimum value pointer\n")
+	call flush (fd)
+
+	# Maximum variable values.
+	if (IN_XMAX (in) != NULL) {
+	    call fprintf (fd, "Maximum variable values (%d):\n")
+		call pargi (nvars)
+	    do i = 1, nvars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call parg$t (Mem$t[IN_XMAX (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null maximum value pointer\n")
+	call flush (fd)
+
+	# Flags.
+	call fprintf (fd, "Overplot next flag = %d\n")
+	    call pargi (IN_OVERPLOT (in))
+	call fprintf (fd, "Overplot fit flag  = %d\n")
+	    call pargi (IN_PLOTFIT (in))
+	call fprintf (fd, "Fit error code     = %d\n")
+	    call pargi (IN_FITERROR (in))
+
+	# Strings.
+	if (IN_LABELS (in) != NULL) {
+	    call fprintf (fd, "Axis labels         = [%s]\n")
+		call pargstr (Memc[IN_LABELS (in)])
+	} else
+	    call fprintf (fd, "Null axis label pointer\n")
+	if (IN_UNITS (in) != NULL) {
+	    call fprintf (fd, "Axis units          = [%s]\n")
+		call pargstr (Memc[IN_UNITS (in)])
+	} else
+	    call fprintf (fd, "Null axis unit pointer\n")
+	if (IN_FLABELS (in) != NULL) {
+	    call fprintf (fd, "Function/fit labels = [%s]\n")
+		call pargstr (Memc[IN_FLABELS (in)])
+	} else
+	    call fprintf (fd, "Null function/fit label pointer\n")
+	if (IN_FUNITS (in) != NULL) {
+	    call fprintf (fd, "Function/fit units  = [%s]\n")
+		call pargstr (Memc[IN_FUNITS (in)])
+	} else
+	    call fprintf (fd, "Null function/fit unit pointer\n")
+	if (IN_PLABELS (in) != NULL) {
+	    call fprintf (fd, "Parameter labels    = [%s]\n")
+		call pargstr (Memc[IN_PLABELS (in)])
+	} else
+	    call fprintf (fd, "Null parameter label pointer\n")
+	if (IN_PUNITS (in) != NULL) {
+	    call fprintf (fd, "Parameter units     = [%s]\n")
+		call pargstr (Memc[IN_PUNITS (in)])
+	} else
+	    call fprintf (fd, "Null parameter unit pointer\n")
+	if (IN_VLABELS (in) != NULL) {
+	    call fprintf (fd, "Variable labels     = [%s]\n")
+		call pargstr (Memc[IN_VLABELS (in)])
+	} else
+	    call fprintf (fd, "Null variable label pointer\n")
+	if (IN_VUNITS (in) != NULL) {
+	    call fprintf (fd, "Variable units      = [%s]\n")
+		call pargstr (Memc[IN_VUNITS (in)])
+	} else
+	    call fprintf (fd, "Null variable unit pointer\n")
+	if (IN_USERLABELS (in) != NULL) {
+	    call fprintf (fd, "User plot labels    = [%s]\n")
+		call pargstr (Memc[IN_USERLABELS (in)])
+	} else
+	    call fprintf (fd, "Null user plot label pointer\n")
+	if (IN_USERUNITS (in) != NULL) {
+	    call fprintf (fd, "User plot units     = [%s]\n")
+		call pargstr (Memc[IN_USERUNITS (in)])
+	} else
+	    call fprintf (fd, "Null user plot unit pointer\n")
+	if (IN_HELP (in) != NULL) {
+	    call fprintf (fd, "Help page          = [%s]\n")
+		call pargstr (Memc[IN_HELP (in)])
+	} else
+	    call fprintf (fd, "Null help page pointer\n")
+	if (IN_PROMPT (in) != NULL) {
+	    call fprintf (fd, "Help prompt        = [%s]\n")
+		call pargstr (Memc[IN_PROMPT (in)])
+	} else
+	    call fprintf (fd, "Null help prompt\n")
+	call flush (fd)
+
+	# Graph keys.
+	if (IN_SGAXES (in) != NULL) {
+	    call fprintf (fd, "Current graph key = %d\n")
+		call pargi (IN_GKEY (in))
+	    do i = 1, INLNGKEYS {
+		call fprintf (fd, "%d, xtype=%d, xnum=%d, ytype=%d, ynum=%d\n")
+		    call pargi (i)
+		    call pargi (IN_GXTYPE   (in, i))
+		    call pargi (IN_GXNUMBER (in, i))
+		    call pargi (IN_GYTYPE   (in, i))
+		    call pargi (IN_GYNUMBER (in, i))
+	    }
+	} else
+	    call fprintf (fd, "Null key pointer\n")
+	call flush (fd)
+end
diff --git a/pkg/xtools/inlfit/indumpd.x b/pkg/xtools/inlfit/indumpd.x
new file mode 100644
index 00000000..8e388f4a
--- /dev/null
+++ b/pkg/xtools/inlfit/indumpd.x
@@ -0,0 +1,233 @@
+include	<pkg/inlfit.h>
+include	"inlfitdef.h"
+
+# IN_DUMP -- INLFIT debugging routine.
+
+procedure in_dumpd (fd, in)
+
+int	fd		# file descriptor
+pointer	in		# INLFIT descriptor
+
+int	i, npars, nfpars, nvars
+
+begin
+	# Test INLFIT pointer.
+	if (in == NULL) {
+	    call fprintf (fd, "\n****** in_dump: Null INLFIT pointer\n")
+	    call flush (fd)
+	    return
+	}
+
+	# File and INLFIT descriptors.
+	call fprintf (fd, "\n****** in_dump: (fd=%d), (in=%d)\n")
+	    call pargi (fd)
+	    call pargi (in)
+	call flush (fd)
+
+	# Function and derivative pointers.
+	call fprintf (fd, "Fitting function pointer    = %d\n")
+	    call pargi (IN_FUNC (in))
+	call fprintf (fd, "Derivative function pointer = %d\n")
+	    call pargi (IN_DFUNC (in))
+	call flush (fd)
+
+	# Number of parameters, fitting parameters, and variables.
+	npars  = IN_NPARAMS (in)
+	nfpars = IN_NFPARAMS (in)
+	nvars  = IN_NVARS (in)
+	call fprintf (fd, "Number of parameters        = %d\n")
+	    call pargi (npars)
+	call fprintf (fd, "Number of fitted parameters = %d\n")
+	    call pargi (nfpars)
+	call fprintf (fd, "Number of variables         = %d\n")
+	    call pargi (nvars)
+	call fprintf (fd, "Number of points            = %d\n")
+	    call pargi (IN_NPTS (in))
+	call flush (fd)
+
+	# Parameter values.
+	    call fprintf (fd, "Parameter values (%d):\n")
+		call pargi (npars)
+	if (IN_PARAM (in) != NULL) {
+	    do i = 1, npars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call pargd (Memd [IN_PARAM (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null parameter value pointer\n")
+	call flush (fd)
+
+	# Parameter changes.
+	if (IN_PARAM (in) != NULL) {
+	    call fprintf (fd, "Parameter changes (%d):\n")
+		call pargi (npars)
+	    do i = 1, npars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call pargd (Memd [IN_DPARAM (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null parameter change pointer\n")
+	call flush (fd)
+
+	# Parameter list.
+	if (IN_PARAM (in) != NULL) {
+	    call fprintf (fd, "Parameter list (%d):\n")
+		call pargi (npars)
+	    do i = 1, npars {
+		call fprintf (fd, "%d -> %d\n")
+		    call pargi (i)
+		    call pargi (Memi[IN_PLIST (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null parameter list pointer\n")
+	call flush (fd)
+
+	# Floating point parameters.
+	if (IN_SFLOAT (in) != NULL) {
+	    call fprintf (fd, "Fit tolerance  = %g\n")
+		call pargd (IN_TOLD (in))
+	    call fprintf (fd, "Low reject     = %g\n")
+		call pargd (IN_LOWD (in))
+	    call fprintf (fd, "High reject    = %g\n")
+		call pargd (IN_HIGHD (in))
+	    call fprintf (fd, "Growing radius = %g\n")
+		call pargd (IN_GROWD (in))
+	} else
+	    call fprintf (fd, "Null floating point pointer\n")
+	call flush (fd)
+
+	# Max number of iterations, and rejection iterations.
+	call fprintf (fd, "Maximum number of iterations   = %d\n")
+	    call pargi (IN_MAXITER (in))
+	call fprintf (fd, "Number of rejection iterations = %d\n")
+	    call pargi (IN_MAXITER (in))
+
+	# Rejected points.
+	call fprintf (fd, "Number of rejected points   = %d\n")
+	    call pargi (IN_NREJPTS (in))
+	call fprintf (fd, "Rejected point list pointer = %d\n")
+	    call pargi (IN_REJPTS (in))
+
+	# User procedures.
+	call fprintf (fd, "User axis procedure pointer  = %d\n")
+	    call pargi (IN_UAXES (in))
+	call fprintf (fd, "User colon procedure pointer = %d\n")
+	    call pargi (IN_UCOLON (in))
+	call fprintf (fd, "User fit procedure pointer   = %d\n")
+	    call pargi (IN_UFIT (in))
+
+	# Minimum variable values.
+	if (IN_XMIN (in) != NULL) {
+	    call fprintf (fd, "Minimum variable values (%d):\n")
+		call pargi (nvars)
+	    do i = 1, nvars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call pargd (Memd[IN_XMIN (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null minimum value pointer\n")
+	call flush (fd)
+
+	# Maximum variable values.
+	if (IN_XMAX (in) != NULL) {
+	    call fprintf (fd, "Maximum variable values (%d):\n")
+		call pargi (nvars)
+	    do i = 1, nvars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call pargd (Memd[IN_XMAX (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null maximum value pointer\n")
+	call flush (fd)
+
+	# Flags.
+	call fprintf (fd, "Overplot next flag = %d\n")
+	    call pargi (IN_OVERPLOT (in))
+	call fprintf (fd, "Overplot fit flag  = %d\n")
+	    call pargi (IN_PLOTFIT (in))
+	call fprintf (fd, "Fit error code     = %d\n")
+	    call pargi (IN_FITERROR (in))
+
+	# Strings.
+	if (IN_LABELS (in) != NULL) {
+	    call fprintf (fd, "Axis labels         = [%s]\n")
+		call pargstr (Memc[IN_LABELS (in)])
+	} else
+	    call fprintf (fd, "Null axis label pointer\n")
+	if (IN_UNITS (in) != NULL) {
+	    call fprintf (fd, "Axis units          = [%s]\n")
+		call pargstr (Memc[IN_UNITS (in)])
+	} else
+	    call fprintf (fd, "Null axis unit pointer\n")
+	if (IN_FLABELS (in) != NULL) {
+	    call fprintf (fd, "Function/fit labels = [%s]\n")
+		call pargstr (Memc[IN_FLABELS (in)])
+	} else
+	    call fprintf (fd, "Null function/fit label pointer\n")
+	if (IN_FUNITS (in) != NULL) {
+	    call fprintf (fd, "Function/fit units  = [%s]\n")
+		call pargstr (Memc[IN_FUNITS (in)])
+	} else
+	    call fprintf (fd, "Null function/fit unit pointer\n")
+	if (IN_PLABELS (in) != NULL) {
+	    call fprintf (fd, "Parameter labels    = [%s]\n")
+		call pargstr (Memc[IN_PLABELS (in)])
+	} else
+	    call fprintf (fd, "Null parameter label pointer\n")
+	if (IN_PUNITS (in) != NULL) {
+	    call fprintf (fd, "Parameter units     = [%s]\n")
+		call pargstr (Memc[IN_PUNITS (in)])
+	} else
+	    call fprintf (fd, "Null parameter unit pointer\n")
+	if (IN_VLABELS (in) != NULL) {
+	    call fprintf (fd, "Variable labels     = [%s]\n")
+		call pargstr (Memc[IN_VLABELS (in)])
+	} else
+	    call fprintf (fd, "Null variable label pointer\n")
+	if (IN_VUNITS (in) != NULL) {
+	    call fprintf (fd, "Variable units      = [%s]\n")
+		call pargstr (Memc[IN_VUNITS (in)])
+	} else
+	    call fprintf (fd, "Null variable unit pointer\n")
+	if (IN_USERLABELS (in) != NULL) {
+	    call fprintf (fd, "User plot labels    = [%s]\n")
+		call pargstr (Memc[IN_USERLABELS (in)])
+	} else
+	    call fprintf (fd, "Null user plot label pointer\n")
+	if (IN_USERUNITS (in) != NULL) {
+	    call fprintf (fd, "User plot units     = [%s]\n")
+		call pargstr (Memc[IN_USERUNITS (in)])
+	} else
+	    call fprintf (fd, "Null user plot unit pointer\n")
+	if (IN_HELP (in) != NULL) {
+	    call fprintf (fd, "Help page          = [%s]\n")
+		call pargstr (Memc[IN_HELP (in)])
+	} else
+	    call fprintf (fd, "Null help page pointer\n")
+	if (IN_PROMPT (in) != NULL) {
+	    call fprintf (fd, "Help prompt        = [%s]\n")
+		call pargstr (Memc[IN_PROMPT (in)])
+	} else
+	    call fprintf (fd, "Null help prompt\n")
+	call flush (fd)
+
+	# Graph keys.
+	if (IN_SGAXES (in) != NULL) {
+	    call fprintf (fd, "Current graph key = %d\n")
+		call pargi (IN_GKEY (in))
+	    do i = 1, INLNGKEYS {
+		call fprintf (fd, "%d, xtype=%d, xnum=%d, ytype=%d, ynum=%d\n")
+		    call pargi (i)
+		    call pargi (IN_GXTYPE   (in, i))
+		    call pargi (IN_GXNUMBER (in, i))
+		    call pargi (IN_GYTYPE   (in, i))
+		    call pargi (IN_GYNUMBER (in, i))
+	    }
+	} else
+	    call fprintf (fd, "Null key pointer\n")
+	call flush (fd)
+end
diff --git a/pkg/xtools/inlfit/indumpr.x b/pkg/xtools/inlfit/indumpr.x
new file mode 100644
index 00000000..bdcc6be7
--- /dev/null
+++ b/pkg/xtools/inlfit/indumpr.x
@@ -0,0 +1,233 @@
+include	<pkg/inlfit.h>
+include	"inlfitdef.h"
+
+# IN_DUMP -- INLFIT debugging routine.
+
+procedure in_dumpr (fd, in)
+
+int	fd		# file descriptor
+pointer	in		# INLFIT descriptor
+
+int	i, npars, nfpars, nvars
+
+begin
+	# Test INLFIT pointer.
+	if (in == NULL) {
+	    call fprintf (fd, "\n****** in_dump: Null INLFIT pointer\n")
+	    call flush (fd)
+	    return
+	}
+
+	# File and INLFIT descriptors.
+	call fprintf (fd, "\n****** in_dump: (fd=%d), (in=%d)\n")
+	    call pargi (fd)
+	    call pargi (in)
+	call flush (fd)
+
+	# Function and derivative pointers.
+	call fprintf (fd, "Fitting function pointer    = %d\n")
+	    call pargi (IN_FUNC (in))
+	call fprintf (fd, "Derivative function pointer = %d\n")
+	    call pargi (IN_DFUNC (in))
+	call flush (fd)
+
+	# Number of parameters, fitting parameters, and variables.
+	npars  = IN_NPARAMS (in)
+	nfpars = IN_NFPARAMS (in)
+	nvars  = IN_NVARS (in)
+	call fprintf (fd, "Number of parameters        = %d\n")
+	    call pargi (npars)
+	call fprintf (fd, "Number of fitted parameters = %d\n")
+	    call pargi (nfpars)
+	call fprintf (fd, "Number of variables         = %d\n")
+	    call pargi (nvars)
+	call fprintf (fd, "Number of points            = %d\n")
+	    call pargi (IN_NPTS (in))
+	call flush (fd)
+
+	# Parameter values.
+	    call fprintf (fd, "Parameter values (%d):\n")
+		call pargi (npars)
+	if (IN_PARAM (in) != NULL) {
+	    do i = 1, npars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call pargr (Memr [IN_PARAM (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null parameter value pointer\n")
+	call flush (fd)
+
+	# Parameter changes.
+	if (IN_PARAM (in) != NULL) {
+	    call fprintf (fd, "Parameter changes (%d):\n")
+		call pargi (npars)
+	    do i = 1, npars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call pargr (Memr [IN_DPARAM (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null parameter change pointer\n")
+	call flush (fd)
+
+	# Parameter list.
+	if (IN_PARAM (in) != NULL) {
+	    call fprintf (fd, "Parameter list (%d):\n")
+		call pargi (npars)
+	    do i = 1, npars {
+		call fprintf (fd, "%d -> %d\n")
+		    call pargi (i)
+		    call pargi (Memi[IN_PLIST (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null parameter list pointer\n")
+	call flush (fd)
+
+	# Floating point parameters.
+	if (IN_SFLOAT (in) != NULL) {
+	    call fprintf (fd, "Fit tolerance  = %g\n")
+		call pargr (IN_TOLR (in))
+	    call fprintf (fd, "Low reject     = %g\n")
+		call pargr (IN_LOWR (in))
+	    call fprintf (fd, "High reject    = %g\n")
+		call pargr (IN_HIGHR (in))
+	    call fprintf (fd, "Growing radius = %g\n")
+		call pargr (IN_GROWR (in))
+	} else
+	    call fprintf (fd, "Null floating point pointer\n")
+	call flush (fd)
+
+	# Max number of iterations, and rejection iterations.
+	call fprintf (fd, "Maximum number of iterations   = %d\n")
+	    call pargi (IN_MAXITER (in))
+	call fprintf (fd, "Number of rejection iterations = %d\n")
+	    call pargi (IN_MAXITER (in))
+
+	# Rejected points.
+	call fprintf (fd, "Number of rejected points   = %d\n")
+	    call pargi (IN_NREJPTS (in))
+	call fprintf (fd, "Rejected point list pointer = %d\n")
+	    call pargi (IN_REJPTS (in))
+
+	# User procedures.
+	call fprintf (fd, "User axis procedure pointer  = %d\n")
+	    call pargi (IN_UAXES (in))
+	call fprintf (fd, "User colon procedure pointer = %d\n")
+	    call pargi (IN_UCOLON (in))
+	call fprintf (fd, "User fit procedure pointer   = %d\n")
+	    call pargi (IN_UFIT (in))
+
+	# Minimum variable values.
+	if (IN_XMIN (in) != NULL) {
+	    call fprintf (fd, "Minimum variable values (%d):\n")
+		call pargi (nvars)
+	    do i = 1, nvars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call pargr (Memr[IN_XMIN (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null minimum value pointer\n")
+	call flush (fd)
+
+	# Maximum variable values.
+	if (IN_XMAX (in) != NULL) {
+	    call fprintf (fd, "Maximum variable values (%d):\n")
+		call pargi (nvars)
+	    do i = 1, nvars {
+		call fprintf (fd, "%d -> %g\n")
+		    call pargi (i)
+		    call pargr (Memr[IN_XMAX (in) + i - 1])
+	    }
+	} else
+	    call fprintf (fd, "Null maximum value pointer\n")
+	call flush (fd)
+
+	# Flags.
+	call fprintf (fd, "Overplot next flag = %d\n")
+	    call pargi (IN_OVERPLOT (in))
+	call fprintf (fd, "Overplot fit flag  = %d\n")
+	    call pargi (IN_PLOTFIT (in))
+	call fprintf (fd, "Fit error code     = %d\n")
+	    call pargi (IN_FITERROR (in))
+
+	# Strings.
+	if (IN_LABELS (in) != NULL) {
+	    call fprintf (fd, "Axis labels         = [%s]\n")
+		call pargstr (Memc[IN_LABELS (in)])
+	} else
+	    call fprintf (fd, "Null axis label pointer\n")
+	if (IN_UNITS (in) != NULL) {
+	    call fprintf (fd, "Axis units          = [%s]\n")
+		call pargstr (Memc[IN_UNITS (in)])
+	} else
+	    call fprintf (fd, "Null axis unit pointer\n")
+	if (IN_FLABELS (in) != NULL) {
+	    call fprintf (fd, "Function/fit labels = [%s]\n")
+		call pargstr (Memc[IN_FLABELS (in)])
+	} else
+	    call fprintf (fd, "Null function/fit label pointer\n")
+	if (IN_FUNITS (in) != NULL) {
+	    call fprintf (fd, "Function/fit units  = [%s]\n")
+		call pargstr (Memc[IN_FUNITS (in)])
+	} else
+	    call fprintf (fd, "Null function/fit unit pointer\n")
+	if (IN_PLABELS (in) != NULL) {
+	    call fprintf (fd, "Parameter labels    = [%s]\n")
+		call pargstr (Memc[IN_PLABELS (in)])
+	} else
+	    call fprintf (fd, "Null parameter label pointer\n")
+	if (IN_PUNITS (in) != NULL) {
+	    call fprintf (fd, "Parameter units     = [%s]\n")
+		call pargstr (Memc[IN_PUNITS (in)])
+	} else
+	    call fprintf (fd, "Null parameter unit pointer\n")
+	if (IN_VLABELS (in) != NULL) {
+	    call fprintf (fd, "Variable labels     = [%s]\n")
+		call pargstr (Memc[IN_VLABELS (in)])
+	} else
+	    call fprintf (fd, "Null variable label pointer\n")
+	if (IN_VUNITS (in) != NULL) {
+	    call fprintf (fd, "Variable units      = [%s]\n")
+		call pargstr (Memc[IN_VUNITS (in)])
+	} else
+	    call fprintf (fd, "Null variable unit pointer\n")
+	if (IN_USERLABELS (in) != NULL) {
+	    call fprintf (fd, "User plot labels    = [%s]\n")
+		call pargstr (Memc[IN_USERLABELS (in)])
+	} else
+	    call fprintf (fd, "Null user plot label pointer\n")
+	if (IN_USERUNITS (in) != NULL) {
+	    call fprintf (fd, "User plot units     = [%s]\n")
+		call pargstr (Memc[IN_USERUNITS (in)])
+	} else
+	    call fprintf (fd, "Null user plot unit pointer\n")
+	if (IN_HELP (in) != NULL) {
+	    call fprintf (fd, "Help page          = [%s]\n")
+		call pargstr (Memc[IN_HELP (in)])
+	} else
+	    call fprintf (fd, "Null help page pointer\n")
+	if (IN_PROMPT (in) != NULL) {
+	    call fprintf (fd, "Help prompt        = [%s]\n")
+		call pargstr (Memc[IN_PROMPT (in)])
+	} else
+	    call fprintf (fd, "Null help prompt\n")
+	call flush (fd)
+
+	# Graph keys.
+	if (IN_SGAXES (in) != NULL) {
+	    call fprintf (fd, "Current graph key = %d\n")
+		call pargi (IN_GKEY (in))
+	    do i = 1, INLNGKEYS {
+		call fprintf (fd, "%d, xtype=%d, xnum=%d, ytype=%d, ynum=%d\n")
+		    call pargi (i)
+		    call pargi (IN_GXTYPE   (in, i))
+		    call pargi (IN_GXNUMBER (in, i))
+		    call pargi (IN_GYTYPE   (in, i))
+		    call pargi (IN_GYNUMBER (in, i))
+	    }
+	} else
+	    call fprintf (fd, "Null key pointer\n")
+	call flush (fd)
+end
diff --git a/pkg/xtools/inlfit/inerrors.gx b/pkg/xtools/inlfit/inerrors.gx
new file mode 100644
index 00000000..f21f805f
--- /dev/null
+++ b/pkg/xtools/inlfit/inerrors.gx
@@ -0,0 +1,66 @@
+include <math/nlfit.h>
+include	<pkg/inlfit.h>
+
+# IN_ERRORS -- Compute the reduced chi-square of the fit and the
+# parameter errors. This procedure must be used instead of nlerrors()
+# because the weigths are changed during the data rejection process.
+# If no data rejection is used, then both procedures are equivalent.
+
+procedure in_errors$t (in, nl, x, y, wts, npts, nvars, variance, chisqr,
+	scatter, rms, errors)
+
+pointer	in			# INLFIT pointer
+pointer	nl			# NLFIT pointer
+PIXEL	x[ARB]			# Ordinates (npts * nvars)
+PIXEL	y[npts]			# Data to be fit
+PIXEL	wts[npts]		# Weights
+int	npts			# Number of points
+int	nvars			# Number of variables
+PIXEL	variance		# variance of the fit (output)
+PIXEL	chisqr			# reduced chi-squared of fit (output)
+PIXEL	scatter			# additional scatter in equation
+PIXEL	rms			# RMS of the fit (output)
+PIXEL	errors[ARB]		# errors in coefficients (output)
+
+int	i
+PIXEL	in_rms$t(), nlstat$t
+pointer	sp, fit, wts1, rejpts
+
+int	in_geti()
+pointer	in_getp()
+
+begin
+#	# Debug.
+#	call eprintf ("in_errors: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Allocate memory for fit and weights.
+	call smark (sp)
+	call salloc (fit, npts, TY_PIXEL)
+	call salloc (wts1, npts, TY_PIXEL)
+
+	# Set zero weight for rejeceted points.
+	call amov$t (wts, Mem$t[wts1], npts)
+	if (in_geti (in, INLNREJPTS) > 0) {
+	    rejpts = in_getp (in, INLREJPTS)
+	    do i = 1, npts {
+		if (Memi[rejpts+i-1] == YES)
+		    Mem$t[wts1+i-1] = PIXEL (0.0)
+	    }
+	}
+
+	# Evaluate the fit, and compute the rms, reduced chi
+	# squared and errors.
+
+	call nlvector$t (nl, x, Mem$t[fit], npts, nvars)
+	call nlerrors$t (nl, y, Mem$t[fit], Mem$t[wts1], npts,
+	    variance, chisqr, errors)
+	rms = in_rms$t (y, Mem$t[fit], Mem$t[wts1], npts)
+	scatter = nlstat$t (nl, NLSCATTER)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/inerrorsd.x b/pkg/xtools/inlfit/inerrorsd.x
new file mode 100644
index 00000000..deae56d2
--- /dev/null
+++ b/pkg/xtools/inlfit/inerrorsd.x
@@ -0,0 +1,66 @@
+include <math/nlfit.h>
+include	<pkg/inlfit.h>
+
+# IN_ERRORS -- Compute the reduced chi-square of the fit and the
+# parameter errors. This procedure must be used instead of nlerrors()
+# because the weigths are changed during the data rejection process.
+# If no data rejection is used, then both procedures are equivalent.
+
+procedure in_errorsd (in, nl, x, y, wts, npts, nvars, variance, chisqr,
+	scatter, rms, errors)
+
+pointer	in			# INLFIT pointer
+pointer	nl			# NLFIT pointer
+double	x[ARB]			# Ordinates (npts * nvars)
+double	y[npts]			# Data to be fit
+double	wts[npts]		# Weights
+int	npts			# Number of points
+int	nvars			# Number of variables
+double	variance		# variance of the fit (output)
+double	chisqr			# reduced chi-squared of fit (output)
+double	scatter			# additional scatter in equation
+double	rms			# RMS of the fit (output)
+double	errors[ARB]		# errors in coefficients (output)
+
+int	i
+double	in_rmsd(), nlstatd
+pointer	sp, fit, wts1, rejpts
+
+int	in_geti()
+pointer	in_getp()
+
+begin
+#	# Debug.
+#	call eprintf ("in_errors: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Allocate memory for fit and weights.
+	call smark (sp)
+	call salloc (fit, npts, TY_DOUBLE)
+	call salloc (wts1, npts, TY_DOUBLE)
+
+	# Set zero weight for rejeceted points.
+	call amovd (wts, Memd[wts1], npts)
+	if (in_geti (in, INLNREJPTS) > 0) {
+	    rejpts = in_getp (in, INLREJPTS)
+	    do i = 1, npts {
+		if (Memi[rejpts+i-1] == YES)
+		    Memd[wts1+i-1] = double (0.0)
+	    }
+	}
+
+	# Evaluate the fit, and compute the rms, reduced chi
+	# squared and errors.
+
+	call nlvectord (nl, x, Memd[fit], npts, nvars)
+	call nlerrorsd (nl, y, Memd[fit], Memd[wts1], npts,
+	    variance, chisqr, errors)
+	rms = in_rmsd (y, Memd[fit], Memd[wts1], npts)
+	scatter = nlstatd (nl, NLSCATTER)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/inerrorsr.x b/pkg/xtools/inlfit/inerrorsr.x
new file mode 100644
index 00000000..c481f565
--- /dev/null
+++ b/pkg/xtools/inlfit/inerrorsr.x
@@ -0,0 +1,66 @@
+include <math/nlfit.h>
+include	<pkg/inlfit.h>
+
+# IN_ERRORS -- Compute the reduced chi-square of the fit and the
+# parameter errors. This procedure must be used instead of nlerrors()
+# because the weigths are changed during the data rejection process.
+# If no data rejection is used, then both procedures are equivalent.
+
+procedure in_errorsr (in, nl, x, y, wts, npts, nvars, variance, chisqr,
+	scatter, rms, errors)
+
+pointer	in			# INLFIT pointer
+pointer	nl			# NLFIT pointer
+real	x[ARB]			# Ordinates (npts * nvars)
+real	y[npts]			# Data to be fit
+real	wts[npts]		# Weights
+int	npts			# Number of points
+int	nvars			# Number of variables
+real	variance		# variance of the fit (output)
+real	chisqr			# reduced chi-squared of fit (output)
+real	scatter			# additional scatter in equation
+real	rms			# RMS of the fit (output)
+real	errors[ARB]		# errors in coefficients (output)
+
+int	i
+real	in_rmsr(), nlstatr
+pointer	sp, fit, wts1, rejpts
+
+int	in_geti()
+pointer	in_getp()
+
+begin
+#	# Debug.
+#	call eprintf ("in_errors: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Allocate memory for fit and weights.
+	call smark (sp)
+	call salloc (fit, npts, TY_REAL)
+	call salloc (wts1, npts, TY_REAL)
+
+	# Set zero weight for rejeceted points.
+	call amovr (wts, Memr[wts1], npts)
+	if (in_geti (in, INLNREJPTS) > 0) {
+	    rejpts = in_getp (in, INLREJPTS)
+	    do i = 1, npts {
+		if (Memi[rejpts+i-1] == YES)
+		    Memr[wts1+i-1] = real (0.0)
+	    }
+	}
+
+	# Evaluate the fit, and compute the rms, reduced chi
+	# squared and errors.
+
+	call nlvectorr (nl, x, Memr[fit], npts, nvars)
+	call nlerrorsr (nl, y, Memr[fit], Memr[wts1], npts,
+	    variance, chisqr, errors)
+	rms = in_rmsr (y, Memr[fit], Memr[wts1], npts)
+	scatter = nlstatr (nl, NLSCATTER)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/infit.gx b/pkg/xtools/inlfit/infit.gx
new file mode 100644
index 00000000..069bf584
--- /dev/null
+++ b/pkg/xtools/inlfit/infit.gx
@@ -0,0 +1,99 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+# IN_FIT -- Fit a function using non-linear least squares. The function
+# can have an arbitrary number of independent variables. This is the main
+# entry point for the non-interactive part of the INLFIT package.
+
+procedure in_fit$t (in, nl, x, y, wts, npts, nvars, wtflag, stat)
+
+pointer	in				# INLFIT pointer
+pointer	nl				# NLFIT pointer
+PIXEL	x[ARB]				# Ordinates (npts * nvars)
+PIXEL	y[npts]				# Data to be fit
+PIXEL	wts[npts]			# Weights
+int	npts				# Number of points
+int	nvars				# Number of variables
+int	wtflag				# Type of weighting
+int	stat				# Error code (output)
+
+int	i, ndeleted
+pointer	sp, wts1, str
+int	in_geti()
+PIXEL	in_get$t
+
+begin
+
+#	# Debug.
+#	call eprintf ("in_fit: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Allocate string, and rejection weight space. The latter are
+	# are used to mark rejected points with a zero weight before
+	# calling NLFIT.
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (wts1, npts, TY_PIXEL)
+	call amov$t (wts, Mem$t[wts1], npts)
+
+	# Initialize rejected point list, and the buffer containing
+	# the minimum and maximum variable values.
+	call in_bfinit$t (in, npts, nvars)
+
+	# Set independent variable limits.
+	call in_limit$t (in, x, npts, nvars)
+
+	# Reinitialize.
+	call in_nlinit$t (in, nl)
+
+	# Check number of data points. If no points are present
+	# set the error flag to the appropiate value, and return.
+	if (npts == 0) {
+	    stat = NO_DEG_FREEDOM
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    call sfree (sp)
+	    return
+	}
+
+	# Check the number of deleted points.
+	ndeleted = 0
+	do i = 1, npts {
+	    if (wts[i] <= PIXEL(0.0))
+		ndeleted = ndeleted + 1
+	}
+	if ((npts - ndeleted) < in_geti (in, INLNFPARAMS)) {
+	    stat = NO_DEG_FREEDOM
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    call sfree (sp)
+	    return
+	}
+
+	# Call NLFIT.
+	call nlfit$t (nl, x, y, wts, npts, nvars, wtflag, stat)
+
+	# Update fit status into the INLFIT structure.
+	call in_puti (in, INLFITERROR, stat)
+
+	# Do pixel rejection and refit, if at least one of the rejection
+	# limits is positive. Otherwise clear number of rejected points.
+
+	if (in_get$t (in, INLLOW)  > PIXEL (0.0) ||
+	    in_get$t (in, INLHIGH) > PIXEL (0.0)) {
+	    call in_reject$t (in, nl, x, y, Mem$t[wts1], npts, nvars, wtflag)
+	    if (in_geti (in, INLNREJPTS) > 0) {
+		do i = 1, npts {
+		    if (Mem$t[wts1+i-1] > PIXEL(0.0))
+			wts[i] = Mem$t[wts1+i-1]
+		}
+	    }
+	    stat = in_geti (in, INLFITERROR)
+	} else
+	    call in_puti (in, INLNREJPTS, 0)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/infitd.x b/pkg/xtools/inlfit/infitd.x
new file mode 100644
index 00000000..f57bbb6c
--- /dev/null
+++ b/pkg/xtools/inlfit/infitd.x
@@ -0,0 +1,99 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+# IN_FIT -- Fit a function using non-linear least squares. The function
+# can have an arbitrary number of independent variables. This is the main
+# entry point for the non-interactive part of the INLFIT package.
+
+procedure in_fitd (in, nl, x, y, wts, npts, nvars, wtflag, stat)
+
+pointer	in				# INLFIT pointer
+pointer	nl				# NLFIT pointer
+double	x[ARB]				# Ordinates (npts * nvars)
+double	y[npts]				# Data to be fit
+double	wts[npts]			# Weights
+int	npts				# Number of points
+int	nvars				# Number of variables
+int	wtflag				# Type of weighting
+int	stat				# Error code (output)
+
+int	i, ndeleted
+pointer	sp, wts1, str
+int	in_geti()
+double	in_getd
+
+begin
+
+#	# Debug.
+#	call eprintf ("in_fit: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Allocate string, and rejection weight space. The latter are
+	# are used to mark rejected points with a zero weight before
+	# calling NLFIT.
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (wts1, npts, TY_DOUBLE)
+	call amovd (wts, Memd[wts1], npts)
+
+	# Initialize rejected point list, and the buffer containing
+	# the minimum and maximum variable values.
+	call in_bfinitd (in, npts, nvars)
+
+	# Set independent variable limits.
+	call in_limitd (in, x, npts, nvars)
+
+	# Reinitialize.
+	call in_nlinitd (in, nl)
+
+	# Check number of data points. If no points are present
+	# set the error flag to the appropiate value, and return.
+	if (npts == 0) {
+	    stat = NO_DEG_FREEDOM
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    call sfree (sp)
+	    return
+	}
+
+	# Check the number of deleted points.
+	ndeleted = 0
+	do i = 1, npts {
+	    if (wts[i] <= double(0.0))
+		ndeleted = ndeleted + 1
+	}
+	if ((npts - ndeleted) < in_geti (in, INLNFPARAMS)) {
+	    stat = NO_DEG_FREEDOM
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    call sfree (sp)
+	    return
+	}
+
+	# Call NLFIT.
+	call nlfitd (nl, x, y, wts, npts, nvars, wtflag, stat)
+
+	# Update fit status into the INLFIT structure.
+	call in_puti (in, INLFITERROR, stat)
+
+	# Do pixel rejection and refit, if at least one of the rejection
+	# limits is positive. Otherwise clear number of rejected points.
+
+	if (in_getd (in, INLLOW)  > double (0.0) ||
+	    in_getd (in, INLHIGH) > double (0.0)) {
+	    call in_rejectd (in, nl, x, y, Memd[wts1], npts, nvars, wtflag)
+	    if (in_geti (in, INLNREJPTS) > 0) {
+		do i = 1, npts {
+		    if (Memd[wts1+i-1] > double(0.0))
+			wts[i] = Memd[wts1+i-1]
+		}
+	    }
+	    stat = in_geti (in, INLFITERROR)
+	} else
+	    call in_puti (in, INLNREJPTS, 0)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/infitr.x b/pkg/xtools/inlfit/infitr.x
new file mode 100644
index 00000000..1a46a09c
--- /dev/null
+++ b/pkg/xtools/inlfit/infitr.x
@@ -0,0 +1,99 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+# IN_FIT -- Fit a function using non-linear least squares. The function
+# can have an arbitrary number of independent variables. This is the main
+# entry point for the non-interactive part of the INLFIT package.
+
+procedure in_fitr (in, nl, x, y, wts, npts, nvars, wtflag, stat)
+
+pointer	in				# INLFIT pointer
+pointer	nl				# NLFIT pointer
+real	x[ARB]				# Ordinates (npts * nvars)
+real	y[npts]				# Data to be fit
+real	wts[npts]			# Weights
+int	npts				# Number of points
+int	nvars				# Number of variables
+int	wtflag				# Type of weighting
+int	stat				# Error code (output)
+
+int	i, ndeleted
+pointer	sp, wts1, str
+int	in_geti()
+real	in_getr
+
+begin
+
+#	# Debug.
+#	call eprintf ("in_fit: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Allocate string, and rejection weight space. The latter are
+	# are used to mark rejected points with a zero weight before
+	# calling NLFIT.
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (wts1, npts, TY_REAL)
+	call amovr (wts, Memr[wts1], npts)
+
+	# Initialize rejected point list, and the buffer containing
+	# the minimum and maximum variable values.
+	call in_bfinitr (in, npts, nvars)
+
+	# Set independent variable limits.
+	call in_limitr (in, x, npts, nvars)
+
+	# Reinitialize.
+	call in_nlinitr (in, nl)
+
+	# Check number of data points. If no points are present
+	# set the error flag to the appropiate value, and return.
+	if (npts == 0) {
+	    stat = NO_DEG_FREEDOM
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    call sfree (sp)
+	    return
+	}
+
+	# Check the number of deleted points.
+	ndeleted = 0
+	do i = 1, npts {
+	    if (wts[i] <= real(0.0))
+		ndeleted = ndeleted + 1
+	}
+	if ((npts - ndeleted) < in_geti (in, INLNFPARAMS)) {
+	    stat = NO_DEG_FREEDOM
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    call sfree (sp)
+	    return
+	}
+
+	# Call NLFIT.
+	call nlfitr (nl, x, y, wts, npts, nvars, wtflag, stat)
+
+	# Update fit status into the INLFIT structure.
+	call in_puti (in, INLFITERROR, stat)
+
+	# Do pixel rejection and refit, if at least one of the rejection
+	# limits is positive. Otherwise clear number of rejected points.
+
+	if (in_getr (in, INLLOW)  > real (0.0) ||
+	    in_getr (in, INLHIGH) > real (0.0)) {
+	    call in_rejectr (in, nl, x, y, Memr[wts1], npts, nvars, wtflag)
+	    if (in_geti (in, INLNREJPTS) > 0) {
+		do i = 1, npts {
+		    if (Memr[wts1+i-1] > real(0.0))
+			wts[i] = Memr[wts1+i-1]
+		}
+	    }
+	    stat = in_geti (in, INLFITERROR)
+	} else
+	    call in_puti (in, INLNREJPTS, 0)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/infree.gx b/pkg/xtools/inlfit/infree.gx
new file mode 100644
index 00000000..80fed996
--- /dev/null
+++ b/pkg/xtools/inlfit/infree.gx
@@ -0,0 +1,52 @@
+include "inlfitdef.h"
+
+
+# IN_FREE -- Free INLFIT parameter structure, substructures, and auxiliary
+# buffers.
+
+procedure in_free$t (in)
+
+pointer	in		# INLFIT pointer
+
+begin
+
+#	# Debug.
+#	call eprintf ("in_free: in=%d\n")
+#	    call pargi (in)
+
+	# Free only if it's not NULL.
+	if (in != NULL) {
+
+	    # Free parameter values, changes, and list.
+	    call mfree (IN_PARAM  (in), TY_PIXEL)
+	    call mfree (IN_DPARAM (in), TY_PIXEL)
+	    call mfree (IN_PLIST  (in), TY_INT)
+
+	    # Free string space.
+	    call mfree (IN_LABELS     (in), TY_CHAR)
+	    call mfree (IN_UNITS      (in), TY_CHAR)
+	    call mfree (IN_PLABELS    (in), TY_CHAR)
+	    call mfree (IN_PUNITS     (in), TY_CHAR)
+	    call mfree (IN_VLABELS    (in), TY_CHAR)
+	    call mfree (IN_VUNITS     (in), TY_CHAR)
+	    call mfree (IN_USERLABELS (in), TY_CHAR)
+	    call mfree (IN_USERUNITS  (in), TY_CHAR)
+	    call mfree (IN_HELP       (in), TY_CHAR)
+	    call mfree (IN_PROMPT     (in), TY_CHAR)
+
+	    # Free rejected point list, and limit values for variables.
+	    if (IN_REJPTS (in) != NULL)
+	        call mfree (IN_REJPTS (in), TY_INT)
+	    if (IN_XMIN (in) != NULL)
+	        call mfree (IN_XMIN (in), TY_PIXEL)
+	    if (IN_XMAX (in) != NULL)
+	        call mfree (IN_XMAX (in), TY_PIXEL)
+
+	    # Free substructures.
+	    call mfree (IN_SFLOAT (in), TY_PIXEL)
+	    call mfree (IN_SGAXES (in), TY_INT)
+
+	    # Free structure.
+	    call mfree (in, TY_STRUCT)
+	}
+end
diff --git a/pkg/xtools/inlfit/infreed.x b/pkg/xtools/inlfit/infreed.x
new file mode 100644
index 00000000..09f2c8ea
--- /dev/null
+++ b/pkg/xtools/inlfit/infreed.x
@@ -0,0 +1,52 @@
+include "inlfitdef.h"
+
+
+# IN_FREE -- Free INLFIT parameter structure, substructures, and auxiliary
+# buffers.
+
+procedure in_freed (in)
+
+pointer	in		# INLFIT pointer
+
+begin
+
+#	# Debug.
+#	call eprintf ("in_free: in=%d\n")
+#	    call pargi (in)
+
+	# Free only if it's not NULL.
+	if (in != NULL) {
+
+	    # Free parameter values, changes, and list.
+	    call mfree (IN_PARAM  (in), TY_DOUBLE)
+	    call mfree (IN_DPARAM (in), TY_DOUBLE)
+	    call mfree (IN_PLIST  (in), TY_INT)
+
+	    # Free string space.
+	    call mfree (IN_LABELS     (in), TY_CHAR)
+	    call mfree (IN_UNITS      (in), TY_CHAR)
+	    call mfree (IN_PLABELS    (in), TY_CHAR)
+	    call mfree (IN_PUNITS     (in), TY_CHAR)
+	    call mfree (IN_VLABELS    (in), TY_CHAR)
+	    call mfree (IN_VUNITS     (in), TY_CHAR)
+	    call mfree (IN_USERLABELS (in), TY_CHAR)
+	    call mfree (IN_USERUNITS  (in), TY_CHAR)
+	    call mfree (IN_HELP       (in), TY_CHAR)
+	    call mfree (IN_PROMPT     (in), TY_CHAR)
+
+	    # Free rejected point list, and limit values for variables.
+	    if (IN_REJPTS (in) != NULL)
+	        call mfree (IN_REJPTS (in), TY_INT)
+	    if (IN_XMIN (in) != NULL)
+	        call mfree (IN_XMIN (in), TY_DOUBLE)
+	    if (IN_XMAX (in) != NULL)
+	        call mfree (IN_XMAX (in), TY_DOUBLE)
+
+	    # Free substructures.
+	    call mfree (IN_SFLOAT (in), TY_DOUBLE)
+	    call mfree (IN_SGAXES (in), TY_INT)
+
+	    # Free structure.
+	    call mfree (in, TY_STRUCT)
+	}
+end
diff --git a/pkg/xtools/inlfit/infreer.x b/pkg/xtools/inlfit/infreer.x
new file mode 100644
index 00000000..55136dfd
--- /dev/null
+++ b/pkg/xtools/inlfit/infreer.x
@@ -0,0 +1,52 @@
+include "inlfitdef.h"
+
+
+# IN_FREE -- Free INLFIT parameter structure, substructures, and auxiliary
+# buffers.
+
+procedure in_freer (in)
+
+pointer	in		# INLFIT pointer
+
+begin
+
+#	# Debug.
+#	call eprintf ("in_free: in=%d\n")
+#	    call pargi (in)
+
+	# Free only if it's not NULL.
+	if (in != NULL) {
+
+	    # Free parameter values, changes, and list.
+	    call mfree (IN_PARAM  (in), TY_REAL)
+	    call mfree (IN_DPARAM (in), TY_REAL)
+	    call mfree (IN_PLIST  (in), TY_INT)
+
+	    # Free string space.
+	    call mfree (IN_LABELS     (in), TY_CHAR)
+	    call mfree (IN_UNITS      (in), TY_CHAR)
+	    call mfree (IN_PLABELS    (in), TY_CHAR)
+	    call mfree (IN_PUNITS     (in), TY_CHAR)
+	    call mfree (IN_VLABELS    (in), TY_CHAR)
+	    call mfree (IN_VUNITS     (in), TY_CHAR)
+	    call mfree (IN_USERLABELS (in), TY_CHAR)
+	    call mfree (IN_USERUNITS  (in), TY_CHAR)
+	    call mfree (IN_HELP       (in), TY_CHAR)
+	    call mfree (IN_PROMPT     (in), TY_CHAR)
+
+	    # Free rejected point list, and limit values for variables.
+	    if (IN_REJPTS (in) != NULL)
+	        call mfree (IN_REJPTS (in), TY_INT)
+	    if (IN_XMIN (in) != NULL)
+	        call mfree (IN_XMIN (in), TY_REAL)
+	    if (IN_XMAX (in) != NULL)
+	        call mfree (IN_XMAX (in), TY_REAL)
+
+	    # Free substructures.
+	    call mfree (IN_SFLOAT (in), TY_REAL)
+	    call mfree (IN_SGAXES (in), TY_INT)
+
+	    # Free structure.
+	    call mfree (in, TY_STRUCT)
+	}
+end
diff --git a/pkg/xtools/inlfit/ingaxes.gx b/pkg/xtools/inlfit/ingaxes.gx
new file mode 100644
index 00000000..d836e074
--- /dev/null
+++ b/pkg/xtools/inlfit/ingaxes.gx
@@ -0,0 +1,105 @@
+include	<pkg/gtools.h>
+include	<pkg/inlfit.h>
+
+# ING_AXES -- Set axes data. The applications program may set additional
+# axes types.
+
+procedure ing_axes$t (in, gt, nl, axis, x, y, z, npts, nvars)
+
+pointer	in				# INLFIT pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+int	axis				# Output axis
+PIXEL	x[ARB]				# Independent variables (npts * nvars)
+PIXEL	y[npts]				# Dependent variable
+PIXEL	z[npts]				# Output values
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+int	i, j
+int	axistype, axisnum
+int	gtlabel[2], gtunits[2]
+PIXEL 	a, b, xmin, xmax
+pointer	sp, label, units, minptr, maxptr
+
+PIXEL	nleval$t()
+PIXEL	ing_dvz$t()
+errchk	adiv$t()
+extern	ing_dvz$t()
+
+data	gtlabel/GTXLABEL, GTYLABEL/
+data	gtunits/GTXUNITS, GTYUNITS/
+
+int	in_geti()
+pointer	in_getp()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+
+	# Get the appropiate axis type and variable number.
+	call in_gkey (in, in_geti (in, INLGKEY), axis, axistype, axisnum)
+
+	# Get and set axes labels and units.
+	call ing_getlabel (in, axistype, axisnum, Memc[label], Memc[units],
+	    SZ_LINE)
+	call gt_sets (gt, gtlabel[axis], Memc[label])
+	call gt_sets (gt, gtunits[axis], Memc[units])
+
+	# Branch on axis type.
+	switch (axistype) {
+	case KEY_VARIABLE:	# Independent variable
+	    do i = 1, npts
+		z[i] = x[(i-1)*nvars+axisnum]
+	case KEY_FUNCTION:	# Function variable
+	    call amov$t (y, z, npts)
+	case KEY_FIT:		# Fitted values
+	    call nlvector$t (nl, x, z, npts, nvars)
+	case KEY_RESIDUALS:	# Residuals
+	    call nlvector$t (nl, x, z, npts, nvars)
+	    call asub$t (y, z, z, npts)
+	case KEY_RATIO:		# Ratio
+	    call nlvector$t (nl, x, z, npts, nvars)
+	    call advz$t (y, z, z, npts, ing_dvz$t)
+	case KEY_NONLINEAR:	# Linear component removed
+	    call aclr$t (z, npts)
+	    minptr = in_getp (in, INLXMIN)
+	    maxptr = in_getp (in, INLXMAX)
+	    a = nleval$t (nl, Mem$t[minptr], nvars)
+	    do i = 1, nvars {
+		xmin = Mem$t[minptr+i-1]
+		xmax = Mem$t[maxptr+i-1]
+		Mem$t[minptr+i-1] = xmax
+		b = (nleval$t (nl, Mem$t[minptr], nvars) - a) /
+		    (xmax - xmin)
+		Mem$t[minptr+i-1] = xmin
+		do j = 1, npts
+		    z[j] = z[j] + y[j] - a - b * (x[(j-1)*nvars+i] - xmin)
+	    }
+	case KEY_UAXIS:	# User axes plots.
+	    if (axis == 1) {
+	        do i = 1, npts
+		    z[i] = x[(i-1)*nvars+axisnum]
+	    } else
+	        call amov$t (y, z, npts)
+	    call ing_uaxes$t (axisnum, in, nl, x, y, z, npts, nvars)
+	default:
+	    call error (0, "ing_axes: Unknown axis type")
+	}
+
+	# Free memory.
+	call sfree (sp)
+end
+
+
+# ING_DVZ -- Error action to take on zero division.
+
+PIXEL procedure ing_dvz$t (x)
+
+PIXEL	x			# Numerator
+
+begin
+	return (PIXEL (1.0))
+end
diff --git a/pkg/xtools/inlfit/ingaxesd.x b/pkg/xtools/inlfit/ingaxesd.x
new file mode 100644
index 00000000..9a9816a6
--- /dev/null
+++ b/pkg/xtools/inlfit/ingaxesd.x
@@ -0,0 +1,105 @@
+include	<pkg/gtools.h>
+include	<pkg/inlfit.h>
+
+# ING_AXES -- Set axes data. The applications program may set additional
+# axes types.
+
+procedure ing_axesd (in, gt, nl, axis, x, y, z, npts, nvars)
+
+pointer	in				# INLFIT pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+int	axis				# Output axis
+double	x[ARB]				# Independent variables (npts * nvars)
+double	y[npts]				# Dependent variable
+double	z[npts]				# Output values
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+int	i, j
+int	axistype, axisnum
+int	gtlabel[2], gtunits[2]
+double 	a, b, xmin, xmax
+pointer	sp, label, units, minptr, maxptr
+
+double	nlevald()
+double	ing_dvzd()
+errchk	adivd()
+extern	ing_dvzd()
+
+data	gtlabel/GTXLABEL, GTYLABEL/
+data	gtunits/GTXUNITS, GTYUNITS/
+
+int	in_geti()
+pointer	in_getp()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+
+	# Get the appropiate axis type and variable number.
+	call in_gkey (in, in_geti (in, INLGKEY), axis, axistype, axisnum)
+
+	# Get and set axes labels and units.
+	call ing_getlabel (in, axistype, axisnum, Memc[label], Memc[units],
+	    SZ_LINE)
+	call gt_sets (gt, gtlabel[axis], Memc[label])
+	call gt_sets (gt, gtunits[axis], Memc[units])
+
+	# Branch on axis type.
+	switch (axistype) {
+	case KEY_VARIABLE:	# Independent variable
+	    do i = 1, npts
+		z[i] = x[(i-1)*nvars+axisnum]
+	case KEY_FUNCTION:	# Function variable
+	    call amovd (y, z, npts)
+	case KEY_FIT:		# Fitted values
+	    call nlvectord (nl, x, z, npts, nvars)
+	case KEY_RESIDUALS:	# Residuals
+	    call nlvectord (nl, x, z, npts, nvars)
+	    call asubd (y, z, z, npts)
+	case KEY_RATIO:		# Ratio
+	    call nlvectord (nl, x, z, npts, nvars)
+	    call advzd (y, z, z, npts, ing_dvzd)
+	case KEY_NONLINEAR:	# Linear component removed
+	    call aclrd (z, npts)
+	    minptr = in_getp (in, INLXMIN)
+	    maxptr = in_getp (in, INLXMAX)
+	    a = nlevald (nl, Memd[minptr], nvars)
+	    do i = 1, nvars {
+		xmin = Memd[minptr+i-1]
+		xmax = Memd[maxptr+i-1]
+		Memd[minptr+i-1] = xmax
+		b = (nlevald (nl, Memd[minptr], nvars) - a) /
+		    (xmax - xmin)
+		Memd[minptr+i-1] = xmin
+		do j = 1, npts
+		    z[j] = z[j] + y[j] - a - b * (x[(j-1)*nvars+i] - xmin)
+	    }
+	case KEY_UAXIS:	# User axes plots.
+	    if (axis == 1) {
+	        do i = 1, npts
+		    z[i] = x[(i-1)*nvars+axisnum]
+	    } else
+	        call amovd (y, z, npts)
+	    call ing_uaxesd (axisnum, in, nl, x, y, z, npts, nvars)
+	default:
+	    call error (0, "ing_axes: Unknown axis type")
+	}
+
+	# Free memory.
+	call sfree (sp)
+end
+
+
+# ING_DVZ -- Error action to take on zero division.
+
+double procedure ing_dvzd (x)
+
+double	x			# Numerator
+
+begin
+	return (double (1.0))
+end
diff --git a/pkg/xtools/inlfit/ingaxesr.x b/pkg/xtools/inlfit/ingaxesr.x
new file mode 100644
index 00000000..5af7f3d8
--- /dev/null
+++ b/pkg/xtools/inlfit/ingaxesr.x
@@ -0,0 +1,105 @@
+include	<pkg/gtools.h>
+include	<pkg/inlfit.h>
+
+# ING_AXES -- Set axes data. The applications program may set additional
+# axes types.
+
+procedure ing_axesr (in, gt, nl, axis, x, y, z, npts, nvars)
+
+pointer	in				# INLFIT pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+int	axis				# Output axis
+real	x[ARB]				# Independent variables (npts * nvars)
+real	y[npts]				# Dependent variable
+real	z[npts]				# Output values
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+int	i, j
+int	axistype, axisnum
+int	gtlabel[2], gtunits[2]
+real 	a, b, xmin, xmax
+pointer	sp, label, units, minptr, maxptr
+
+real	nlevalr()
+real	ing_dvzr()
+errchk	adivr()
+extern	ing_dvzr()
+
+data	gtlabel/GTXLABEL, GTYLABEL/
+data	gtunits/GTXUNITS, GTYUNITS/
+
+int	in_geti()
+pointer	in_getp()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	call salloc (units, SZ_LINE, TY_CHAR)
+
+	# Get the appropiate axis type and variable number.
+	call in_gkey (in, in_geti (in, INLGKEY), axis, axistype, axisnum)
+
+	# Get and set axes labels and units.
+	call ing_getlabel (in, axistype, axisnum, Memc[label], Memc[units],
+	    SZ_LINE)
+	call gt_sets (gt, gtlabel[axis], Memc[label])
+	call gt_sets (gt, gtunits[axis], Memc[units])
+
+	# Branch on axis type.
+	switch (axistype) {
+	case KEY_VARIABLE:	# Independent variable
+	    do i = 1, npts
+		z[i] = x[(i-1)*nvars+axisnum]
+	case KEY_FUNCTION:	# Function variable
+	    call amovr (y, z, npts)
+	case KEY_FIT:		# Fitted values
+	    call nlvectorr (nl, x, z, npts, nvars)
+	case KEY_RESIDUALS:	# Residuals
+	    call nlvectorr (nl, x, z, npts, nvars)
+	    call asubr (y, z, z, npts)
+	case KEY_RATIO:		# Ratio
+	    call nlvectorr (nl, x, z, npts, nvars)
+	    call advzr (y, z, z, npts, ing_dvzr)
+	case KEY_NONLINEAR:	# Linear component removed
+	    call aclrr (z, npts)
+	    minptr = in_getp (in, INLXMIN)
+	    maxptr = in_getp (in, INLXMAX)
+	    a = nlevalr (nl, Memr[minptr], nvars)
+	    do i = 1, nvars {
+		xmin = Memr[minptr+i-1]
+		xmax = Memr[maxptr+i-1]
+		Memr[minptr+i-1] = xmax
+		b = (nlevalr (nl, Memr[minptr], nvars) - a) /
+		    (xmax - xmin)
+		Memr[minptr+i-1] = xmin
+		do j = 1, npts
+		    z[j] = z[j] + y[j] - a - b * (x[(j-1)*nvars+i] - xmin)
+	    }
+	case KEY_UAXIS:	# User axes plots.
+	    if (axis == 1) {
+	        do i = 1, npts
+		    z[i] = x[(i-1)*nvars+axisnum]
+	    } else
+	        call amovr (y, z, npts)
+	    call ing_uaxesr (axisnum, in, nl, x, y, z, npts, nvars)
+	default:
+	    call error (0, "ing_axes: Unknown axis type")
+	}
+
+	# Free memory.
+	call sfree (sp)
+end
+
+
+# ING_DVZ -- Error action to take on zero division.
+
+real procedure ing_dvzr (x)
+
+real	x			# Numerator
+
+begin
+	return (real (1.0))
+end
diff --git a/pkg/xtools/inlfit/ingcolon.gx b/pkg/xtools/inlfit/ingcolon.gx
new file mode 100644
index 00000000..5b9f7bfb
--- /dev/null
+++ b/pkg/xtools/inlfit/ingcolon.gx
@@ -0,0 +1,362 @@
+include	<gset.h>
+include	<error.h>
+include	<pkg/inlfit.h>
+
+# List of colon commands.
+define	CMDS "|show|low_reject|high_reject|nreject|grow|errors|vshow|constant|\
+fit|tolerance|maxiter|variables|data|page|results|"
+
+define	SHOW		1	# Show fit information
+define	LOW_REJECT	2	# Set or show lower rejection factor
+define	HIGH_REJECT	3	# Set or show upper rejection factor
+define	NREJECT		4	# Set or show rejection iterations
+define	GROW		5	# Set or show rejection growing radius
+define	ERRORS		6	# Show fit errors
+define	VSHOW		7	# Show verbose information
+define	CONSTANT	8	# Set constant parameter
+define	FIT		9 	# Set fitting parameter
+define	TOL		10	# Set or show fitting tolerance
+define	MAXITER		11	# Set or show max number of iterations
+define	VARIABLES	12	# List the variables
+define	DATA		13	# List of data
+define	PAGE		14	# Page through a file
+define	RESULTS		15	# List the results of the fit
+
+
+# ING_COLON -- Processes colon commands.  The common flags and newgraph
+# signal changes in fitting parameters or the need to redraw the graph.
+
+procedure ing_colon$t (in, cmdstr, gp, gt, nl, x, y, wts, names, npts, nvars,
+	len_name, newgraph)
+
+pointer	in				# INLFIT pointer
+char	cmdstr[ARB]			# Command string
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer for error listing
+PIXEL	x[ARB]				# Independent variabels (npts * nvars)
+PIXEL	y[npts]				# dependent variables
+PIXEL	wts[npts]			# Weights
+char	names[ARB]			# Object names
+int	npts				# Number of data points
+int	nvars				# Number of variables
+int	len_name			# Length of object name
+int	newgraph			# New graph ?
+
+int	ncmd, ival
+PIXEL	fval
+pointer	sp, cmd
+
+int	nscan(), strdic()
+int	in_geti()
+PIXEL	in_get$t()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Use formated scan to parse the command string.
+	# The first word is the command and it may be minimum match
+	# abbreviated with the list of commands.
+
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], SZ_LINE)
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, CMDS)
+
+	# Branch on command code.
+	switch (ncmd) {
+	case SHOW: # :show - Show the values of the fitting parameters.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_show$t (in, "STDOUT")
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_show$t (in, Memc[cmd])
+		} then
+		    call erract (EA_WARN)
+	    }
+
+	case LOW_REJECT: # :low_reject - List or set lower rejection factor.
+	    call garg$t (fval)
+	    if (nscan() == 1) {
+		call printf ("low_reject = %g\n")
+		    call parg$t (in_get$t (in, INLLOW))
+	    } else
+		call in_put$t (in, INLLOW, fval)
+
+	case HIGH_REJECT: # :high_reject - List or set high rejection factor.
+	    call garg$t (fval)
+	    if (nscan() == 1) {
+		call printf ("high_reject = %g\n")
+		    call parg$t (in_get$t (in, INLHIGH))
+	    } else
+		call in_put$t (in, INLHIGH, fval)
+
+	case NREJECT: # :nreject - List or set the rejection iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("nreject = %d\n")
+		    call pargi (in_geti (in, INLNREJECT))
+	    } else
+		call in_puti (in, INLNREJECT, ival)
+
+	case GROW: # :grow - List or set the rejection growing.
+	    call garg$t (fval)
+	    if (nscan() == 1) {
+		call printf ("grow = %g\n")
+		    call parg$t (in_get$t (in, INLGROW))
+	    } else
+		call in_put$t (in, INLGROW, fval)
+
+	case ERRORS: # :errors - print errors analysis of fit
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_show$t (in, "STDOUT")
+		call ing_errors$t (in, "STDOUT", nl, x, y, wts, npts, nvars)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_show$t (in, Memc[cmd])
+		    call ing_errors$t (in, Memc[cmd], nl, x, y, wts, npts,
+		        nvars)
+		} then
+		    call erract (EA_WARN)
+	    }
+
+	case VSHOW: #  Verbose list of the fitting parameters and results. 
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_vshow$t (in, "STDOUT", nl, x, y, wts, names, npts,
+		    nvars, len_name, gt)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_vshow$t (in, Memc[cmd], nl, x, y, wts, names,
+		        npts, nvars, len_name, gt)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	case CONSTANT:	# Set constant parameter.
+	    call ing_change$t (in, CONSTANT)
+
+	case FIT:	# Set fitting parameter.
+	    call ing_change$t (in, FIT)
+
+	case TOL:	# Set or show tolerance.
+	    call garg$t (fval)
+	    if (nscan() == 1) {
+		call printf ("tol = %g\n")
+		    call parg$t (in_get$t (in, INLTOLERANCE))
+	    } else
+		call in_put$t (in, INLTOLERANCE, fval)
+
+	case MAXITER:	# Set or show max number of iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("maxiter = %d\n")
+		    call pargi (in_geti (in, INLMAXITER))
+	    } else
+		call in_puti (in, INLMAXITER, ival)
+
+	case VARIABLES: # Show the list of variables.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_variables$t (in, "STDOUT", nvars)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_variables$t (in, Memc[cmd], nvars)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	case DATA: # List the raw data.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_data$t (in, "STDOUT", x, names, npts, nvars, len_name)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_data$t (in, Memc[cmd], x, names, npts, nvars,
+		        len_name)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	case PAGE: # Page through a file.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1)
+		call printf ("File to be paged is undefined\n")
+	    else
+		call gpagefile (gp, Memc[cmd], "")
+
+	case RESULTS: # List the results of the fit.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_results$t (in, "STDOUT", nl, x, y, wts, names, npts,
+		    nvars, len_name)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_results$t (in, Memc[cmd], nl, x, y, wts, names,
+		        npts, nvars, len_name)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	default:	# User definable action.
+	    call ing_ucolon$t (in, gp, gt, nl, x, y, wts, npts, nvars, newgraph)
+	}
+
+	# Free memory
+	call sfree (sp)
+end
+
+
+# ING_CHANGE -- Change fitting parameter into constant parameter, and
+# viceversa. Parameters can be specified either by a name, supplied in
+# the parameter labels, or just by a sequence number.
+
+procedure ing_change$t (in, type)
+
+pointer	in			# INLFIT descriptor
+int	type			# parameter type (fit, constant)
+
+bool	isfit
+int	ip, pos, number, npars
+PIXEL	$tval
+pointer	param, value, pname
+pointer	pvalues, plist, plabels
+pointer	sp
+
+bool	streq()
+int	ctoi(), cto$t()
+int	strdic()
+int	in_geti()
+pointer	in_getp()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (param,   SZ_LINE, TY_CHAR)
+	call salloc (value,   SZ_LINE, TY_CHAR)
+	call salloc (pname,   SZ_LINE, TY_CHAR)
+	call salloc (plabels, SZ_LINE, TY_CHAR)
+
+	# Get parameter name.
+	Memc[param] = EOS
+	call gargwrd (Memc[param], SZ_LINE)
+	if (streq (Memc[param], "")) {
+	    call eprintf ("Parameter not specified\n")
+	    call sfree (sp)
+	    return
+	}
+
+	# Try to find the parameter name in the parameter labels.
+	call in_gstr (in, INLPLABELS, Memc[plabels], SZ_LINE)
+	number = strdic (Memc[param], Memc[pname], SZ_LINE, Memc[plabels])
+
+	# Try to find the parameter by number if it was not found
+	# by name in the dictionary.
+	if (number == 0) {
+	    ip = 1
+	    if (ctoi (Memc[param], ip, number) == 0) {
+		call eprintf ("Parameter not found (%s)\n")
+		    call pargstr (Memc[param])
+	        call sfree (sp)
+		return
+	    }
+	}
+
+	# Test parameter number.
+	npars = in_geti (in, INLNPARAMS)
+	if (number < 1 || number > npars) {
+	    call eprintf ("Parameter out of range (%d)\n")
+		call pargi (number)
+	    call sfree (sp)
+	    return
+	}
+
+	# Get pointers to parameter values and list.
+	pvalues = in_getp (in, INLPARAM)
+	plist   = in_getp (in, INLPLIST)
+
+	# Get new value if specified. Otherwise assume
+	# old parameter value.
+	Memc[value] = EOS
+	call gargwrd (Memc[value], SZ_LINE)
+	if (streq (Memc[value], ""))
+	    $tval = Mem$t[pvalues + number - 1]
+	else {
+	    ip = 1
+	    if (cto$t (Memc[value], ip, $tval) == 0) {
+	        call eprintf ("Bad parameter value (%s)\n")
+		    call pargstr (Memc[value])
+	        call sfree (sp)
+	        return
+	    }
+	}
+
+	# Update parameter value.
+	Mem$t[pvalues + number - 1] = $tval
+
+	# Find the parameter position in the parameter list.
+	do pos = 1, npars {
+	    if (Memi[plist + pos - 1] >= number ||
+		Memi[plist + pos - 1] == 0)
+	        break
+	}
+
+	# Insert or remove parameter from the parameter list
+	# according with its type, i.e., with the type of change.
+	# The list is not changed if it's not necesary to do so.
+
+	if (type == FIT) {
+	    if (Memi[plist + pos - 1] != number) {
+		do ip = npars, pos + 1, -1
+		    Memi[plist + ip - 1] = Memi[plist + ip - 2]
+		Memi[plist + pos - 1] = number
+		call in_puti (in, INLNFPARAMS, in_geti (in, INLNFPARAMS) + 1)
+	    }
+	    isfit = true
+	} else {
+	    if (Memi[plist + pos - 1] == number) {
+		do ip = pos, npars - 1
+		    Memi[plist + ip - 1] = Memi[plist + ip]
+		Memi[plist + npars - 1] = 0
+		call in_puti (in, INLNFPARAMS, in_geti (in, INLNFPARAMS) - 1)
+	    }
+	    isfit = false
+	}
+
+	# Print setting.
+	call printf ("(%s) changed to %s parameter, with value=%g\n")
+	    call pargstr (Memc[pname])
+	if (isfit)
+	    call pargstr ("fitting")
+	else
+	    call pargstr ("constant")
+	    call parg$t ($tval)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingcolond.x b/pkg/xtools/inlfit/ingcolond.x
new file mode 100644
index 00000000..453895e3
--- /dev/null
+++ b/pkg/xtools/inlfit/ingcolond.x
@@ -0,0 +1,362 @@
+include	<gset.h>
+include	<error.h>
+include	<pkg/inlfit.h>
+
+# List of colon commands.
+define	CMDS "|show|low_reject|high_reject|nreject|grow|errors|vshow|constant|\
+fit|tolerance|maxiter|variables|data|page|results|"
+
+define	SHOW		1	# Show fit information
+define	LOW_REJECT	2	# Set or show lower rejection factor
+define	HIGH_REJECT	3	# Set or show upper rejection factor
+define	NREJECT		4	# Set or show rejection iterations
+define	GROW		5	# Set or show rejection growing radius
+define	ERRORS		6	# Show fit errors
+define	VSHOW		7	# Show verbose information
+define	CONSTANT	8	# Set constant parameter
+define	FIT		9 	# Set fitting parameter
+define	TOL		10	# Set or show fitting tolerance
+define	MAXITER		11	# Set or show max number of iterations
+define	VARIABLES	12	# List the variables
+define	DATA		13	# List of data
+define	PAGE		14	# Page through a file
+define	RESULTS		15	# List the results of the fit
+
+
+# ING_COLON -- Processes colon commands.  The common flags and newgraph
+# signal changes in fitting parameters or the need to redraw the graph.
+
+procedure ing_colond (in, cmdstr, gp, gt, nl, x, y, wts, names, npts, nvars,
+	len_name, newgraph)
+
+pointer	in				# INLFIT pointer
+char	cmdstr[ARB]			# Command string
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer for error listing
+double	x[ARB]				# Independent variabels (npts * nvars)
+double	y[npts]				# dependent variables
+double	wts[npts]			# Weights
+char	names[ARB]			# Object names
+int	npts				# Number of data points
+int	nvars				# Number of variables
+int	len_name			# Length of object name
+int	newgraph			# New graph ?
+
+int	ncmd, ival
+double	fval
+pointer	sp, cmd
+
+int	nscan(), strdic()
+int	in_geti()
+double	in_getd()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Use formated scan to parse the command string.
+	# The first word is the command and it may be minimum match
+	# abbreviated with the list of commands.
+
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], SZ_LINE)
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, CMDS)
+
+	# Branch on command code.
+	switch (ncmd) {
+	case SHOW: # :show - Show the values of the fitting parameters.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_showd (in, "STDOUT")
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_showd (in, Memc[cmd])
+		} then
+		    call erract (EA_WARN)
+	    }
+
+	case LOW_REJECT: # :low_reject - List or set lower rejection factor.
+	    call gargd (fval)
+	    if (nscan() == 1) {
+		call printf ("low_reject = %g\n")
+		    call pargd (in_getd (in, INLLOW))
+	    } else
+		call in_putd (in, INLLOW, fval)
+
+	case HIGH_REJECT: # :high_reject - List or set high rejection factor.
+	    call gargd (fval)
+	    if (nscan() == 1) {
+		call printf ("high_reject = %g\n")
+		    call pargd (in_getd (in, INLHIGH))
+	    } else
+		call in_putd (in, INLHIGH, fval)
+
+	case NREJECT: # :nreject - List or set the rejection iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("nreject = %d\n")
+		    call pargi (in_geti (in, INLNREJECT))
+	    } else
+		call in_puti (in, INLNREJECT, ival)
+
+	case GROW: # :grow - List or set the rejection growing.
+	    call gargd (fval)
+	    if (nscan() == 1) {
+		call printf ("grow = %g\n")
+		    call pargd (in_getd (in, INLGROW))
+	    } else
+		call in_putd (in, INLGROW, fval)
+
+	case ERRORS: # :errors - print errors analysis of fit
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_showd (in, "STDOUT")
+		call ing_errorsd (in, "STDOUT", nl, x, y, wts, npts, nvars)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_showd (in, Memc[cmd])
+		    call ing_errorsd (in, Memc[cmd], nl, x, y, wts, npts,
+		        nvars)
+		} then
+		    call erract (EA_WARN)
+	    }
+
+	case VSHOW: #  Verbose list of the fitting parameters and results. 
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_vshowd (in, "STDOUT", nl, x, y, wts, names, npts,
+		    nvars, len_name, gt)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_vshowd (in, Memc[cmd], nl, x, y, wts, names,
+		        npts, nvars, len_name, gt)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	case CONSTANT:	# Set constant parameter.
+	    call ing_changed (in, CONSTANT)
+
+	case FIT:	# Set fitting parameter.
+	    call ing_changed (in, FIT)
+
+	case TOL:	# Set or show tolerance.
+	    call gargd (fval)
+	    if (nscan() == 1) {
+		call printf ("tol = %g\n")
+		    call pargd (in_getd (in, INLTOLERANCE))
+	    } else
+		call in_putd (in, INLTOLERANCE, fval)
+
+	case MAXITER:	# Set or show max number of iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("maxiter = %d\n")
+		    call pargi (in_geti (in, INLMAXITER))
+	    } else
+		call in_puti (in, INLMAXITER, ival)
+
+	case VARIABLES: # Show the list of variables.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_variablesd (in, "STDOUT", nvars)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_variablesd (in, Memc[cmd], nvars)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	case DATA: # List the raw data.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_datad (in, "STDOUT", x, names, npts, nvars, len_name)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_datad (in, Memc[cmd], x, names, npts, nvars,
+		        len_name)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	case PAGE: # Page through a file.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1)
+		call printf ("File to be paged is undefined\n")
+	    else
+		call gpagefile (gp, Memc[cmd], "")
+
+	case RESULTS: # List the results of the fit.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_resultsd (in, "STDOUT", nl, x, y, wts, names, npts,
+		    nvars, len_name)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_resultsd (in, Memc[cmd], nl, x, y, wts, names,
+		        npts, nvars, len_name)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	default:	# User definable action.
+	    call ing_ucolond (in, gp, gt, nl, x, y, wts, npts, nvars, newgraph)
+	}
+
+	# Free memory
+	call sfree (sp)
+end
+
+
+# ING_CHANGE -- Change fitting parameter into constant parameter, and
+# viceversa. Parameters can be specified either by a name, supplied in
+# the parameter labels, or just by a sequence number.
+
+procedure ing_changed (in, type)
+
+pointer	in			# INLFIT descriptor
+int	type			# parameter type (fit, constant)
+
+bool	isfit
+int	ip, pos, number, npars
+double	dval
+pointer	param, value, pname
+pointer	pvalues, plist, plabels
+pointer	sp
+
+bool	streq()
+int	ctoi(), ctod()
+int	strdic()
+int	in_geti()
+pointer	in_getp()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (param,   SZ_LINE, TY_CHAR)
+	call salloc (value,   SZ_LINE, TY_CHAR)
+	call salloc (pname,   SZ_LINE, TY_CHAR)
+	call salloc (plabels, SZ_LINE, TY_CHAR)
+
+	# Get parameter name.
+	Memc[param] = EOS
+	call gargwrd (Memc[param], SZ_LINE)
+	if (streq (Memc[param], "")) {
+	    call eprintf ("Parameter not specified\n")
+	    call sfree (sp)
+	    return
+	}
+
+	# Try to find the parameter name in the parameter labels.
+	call in_gstr (in, INLPLABELS, Memc[plabels], SZ_LINE)
+	number = strdic (Memc[param], Memc[pname], SZ_LINE, Memc[plabels])
+
+	# Try to find the parameter by number if it was not found
+	# by name in the dictionary.
+	if (number == 0) {
+	    ip = 1
+	    if (ctoi (Memc[param], ip, number) == 0) {
+		call eprintf ("Parameter not found (%s)\n")
+		    call pargstr (Memc[param])
+	        call sfree (sp)
+		return
+	    }
+	}
+
+	# Test parameter number.
+	npars = in_geti (in, INLNPARAMS)
+	if (number < 1 || number > npars) {
+	    call eprintf ("Parameter out of range (%d)\n")
+		call pargi (number)
+	    call sfree (sp)
+	    return
+	}
+
+	# Get pointers to parameter values and list.
+	pvalues = in_getp (in, INLPARAM)
+	plist   = in_getp (in, INLPLIST)
+
+	# Get new value if specified. Otherwise assume
+	# old parameter value.
+	Memc[value] = EOS
+	call gargwrd (Memc[value], SZ_LINE)
+	if (streq (Memc[value], ""))
+	    dval = Memd[pvalues + number - 1]
+	else {
+	    ip = 1
+	    if (ctod (Memc[value], ip, dval) == 0) {
+	        call eprintf ("Bad parameter value (%s)\n")
+		    call pargstr (Memc[value])
+	        call sfree (sp)
+	        return
+	    }
+	}
+
+	# Update parameter value.
+	Memd[pvalues + number - 1] = dval
+
+	# Find the parameter position in the parameter list.
+	do pos = 1, npars {
+	    if (Memi[plist + pos - 1] >= number ||
+		Memi[plist + pos - 1] == 0)
+	        break
+	}
+
+	# Insert or remove parameter from the parameter list
+	# according with its type, i.e., with the type of change.
+	# The list is not changed if it's not necesary to do so.
+
+	if (type == FIT) {
+	    if (Memi[plist + pos - 1] != number) {
+		do ip = npars, pos + 1, -1
+		    Memi[plist + ip - 1] = Memi[plist + ip - 2]
+		Memi[plist + pos - 1] = number
+		call in_puti (in, INLNFPARAMS, in_geti (in, INLNFPARAMS) + 1)
+	    }
+	    isfit = true
+	} else {
+	    if (Memi[plist + pos - 1] == number) {
+		do ip = pos, npars - 1
+		    Memi[plist + ip - 1] = Memi[plist + ip]
+		Memi[plist + npars - 1] = 0
+		call in_puti (in, INLNFPARAMS, in_geti (in, INLNFPARAMS) - 1)
+	    }
+	    isfit = false
+	}
+
+	# Print setting.
+	call printf ("(%s) changed to %s parameter, with value=%g\n")
+	    call pargstr (Memc[pname])
+	if (isfit)
+	    call pargstr ("fitting")
+	else
+	    call pargstr ("constant")
+	    call pargd (dval)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingcolonr.x b/pkg/xtools/inlfit/ingcolonr.x
new file mode 100644
index 00000000..b9179fc6
--- /dev/null
+++ b/pkg/xtools/inlfit/ingcolonr.x
@@ -0,0 +1,362 @@
+include	<gset.h>
+include	<error.h>
+include	<pkg/inlfit.h>
+
+# List of colon commands.
+define	CMDS "|show|low_reject|high_reject|nreject|grow|errors|vshow|constant|\
+fit|tolerance|maxiter|variables|data|page|results|"
+
+define	SHOW		1	# Show fit information
+define	LOW_REJECT	2	# Set or show lower rejection factor
+define	HIGH_REJECT	3	# Set or show upper rejection factor
+define	NREJECT		4	# Set or show rejection iterations
+define	GROW		5	# Set or show rejection growing radius
+define	ERRORS		6	# Show fit errors
+define	VSHOW		7	# Show verbose information
+define	CONSTANT	8	# Set constant parameter
+define	FIT		9 	# Set fitting parameter
+define	TOL		10	# Set or show fitting tolerance
+define	MAXITER		11	# Set or show max number of iterations
+define	VARIABLES	12	# List the variables
+define	DATA		13	# List of data
+define	PAGE		14	# Page through a file
+define	RESULTS		15	# List the results of the fit
+
+
+# ING_COLON -- Processes colon commands.  The common flags and newgraph
+# signal changes in fitting parameters or the need to redraw the graph.
+
+procedure ing_colonr (in, cmdstr, gp, gt, nl, x, y, wts, names, npts, nvars,
+	len_name, newgraph)
+
+pointer	in				# INLFIT pointer
+char	cmdstr[ARB]			# Command string
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer for error listing
+real	x[ARB]				# Independent variabels (npts * nvars)
+real	y[npts]				# dependent variables
+real	wts[npts]			# Weights
+char	names[ARB]			# Object names
+int	npts				# Number of data points
+int	nvars				# Number of variables
+int	len_name			# Length of object name
+int	newgraph			# New graph ?
+
+int	ncmd, ival
+real	fval
+pointer	sp, cmd
+
+int	nscan(), strdic()
+int	in_geti()
+real	in_getr()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Use formated scan to parse the command string.
+	# The first word is the command and it may be minimum match
+	# abbreviated with the list of commands.
+
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], SZ_LINE)
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, CMDS)
+
+	# Branch on command code.
+	switch (ncmd) {
+	case SHOW: # :show - Show the values of the fitting parameters.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_showr (in, "STDOUT")
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_showr (in, Memc[cmd])
+		} then
+		    call erract (EA_WARN)
+	    }
+
+	case LOW_REJECT: # :low_reject - List or set lower rejection factor.
+	    call gargr (fval)
+	    if (nscan() == 1) {
+		call printf ("low_reject = %g\n")
+		    call pargr (in_getr (in, INLLOW))
+	    } else
+		call in_putr (in, INLLOW, fval)
+
+	case HIGH_REJECT: # :high_reject - List or set high rejection factor.
+	    call gargr (fval)
+	    if (nscan() == 1) {
+		call printf ("high_reject = %g\n")
+		    call pargr (in_getr (in, INLHIGH))
+	    } else
+		call in_putr (in, INLHIGH, fval)
+
+	case NREJECT: # :nreject - List or set the rejection iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("nreject = %d\n")
+		    call pargi (in_geti (in, INLNREJECT))
+	    } else
+		call in_puti (in, INLNREJECT, ival)
+
+	case GROW: # :grow - List or set the rejection growing.
+	    call gargr (fval)
+	    if (nscan() == 1) {
+		call printf ("grow = %g\n")
+		    call pargr (in_getr (in, INLGROW))
+	    } else
+		call in_putr (in, INLGROW, fval)
+
+	case ERRORS: # :errors - print errors analysis of fit
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_showr (in, "STDOUT")
+		call ing_errorsr (in, "STDOUT", nl, x, y, wts, npts, nvars)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_showr (in, Memc[cmd])
+		    call ing_errorsr (in, Memc[cmd], nl, x, y, wts, npts,
+		        nvars)
+		} then
+		    call erract (EA_WARN)
+	    }
+
+	case VSHOW: #  Verbose list of the fitting parameters and results. 
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_vshowr (in, "STDOUT", nl, x, y, wts, names, npts,
+		    nvars, len_name, gt)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_vshowr (in, Memc[cmd], nl, x, y, wts, names,
+		        npts, nvars, len_name, gt)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	case CONSTANT:	# Set constant parameter.
+	    call ing_changer (in, CONSTANT)
+
+	case FIT:	# Set fitting parameter.
+	    call ing_changer (in, FIT)
+
+	case TOL:	# Set or show tolerance.
+	    call gargr (fval)
+	    if (nscan() == 1) {
+		call printf ("tol = %g\n")
+		    call pargr (in_getr (in, INLTOLERANCE))
+	    } else
+		call in_putr (in, INLTOLERANCE, fval)
+
+	case MAXITER:	# Set or show max number of iterations.
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("maxiter = %d\n")
+		    call pargi (in_geti (in, INLMAXITER))
+	    } else
+		call in_puti (in, INLMAXITER, ival)
+
+	case VARIABLES: # Show the list of variables.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_variablesr (in, "STDOUT", nvars)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_variablesr (in, Memc[cmd], nvars)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	case DATA: # List the raw data.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_datar (in, "STDOUT", x, names, npts, nvars, len_name)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_datar (in, Memc[cmd], x, names, npts, nvars,
+		        len_name)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	case PAGE: # Page through a file.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1)
+		call printf ("File to be paged is undefined\n")
+	    else
+		call gpagefile (gp, Memc[cmd], "")
+
+	case RESULTS: # List the results of the fit.
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan() == 1) {
+		call gdeactivate (gp, AW_CLEAR)
+		call ing_title (in, "STDOUT", gt)
+		call ing_resultsr (in, "STDOUT", nl, x, y, wts, names, npts,
+		    nvars, len_name)
+		call greactivate (gp, AW_PAUSE)
+	    } else {
+		iferr {
+		    call ing_title (in, Memc[cmd], gt)
+		    call ing_resultsr (in, Memc[cmd], nl, x, y, wts, names,
+		        npts, nvars, len_name)
+		} then 
+		    call erract (EA_WARN)
+	    }
+
+	default:	# User definable action.
+	    call ing_ucolonr (in, gp, gt, nl, x, y, wts, npts, nvars, newgraph)
+	}
+
+	# Free memory
+	call sfree (sp)
+end
+
+
+# ING_CHANGE -- Change fitting parameter into constant parameter, and
+# viceversa. Parameters can be specified either by a name, supplied in
+# the parameter labels, or just by a sequence number.
+
+procedure ing_changer (in, type)
+
+pointer	in			# INLFIT descriptor
+int	type			# parameter type (fit, constant)
+
+bool	isfit
+int	ip, pos, number, npars
+real	rval
+pointer	param, value, pname
+pointer	pvalues, plist, plabels
+pointer	sp
+
+bool	streq()
+int	ctoi(), ctor()
+int	strdic()
+int	in_geti()
+pointer	in_getp()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (param,   SZ_LINE, TY_CHAR)
+	call salloc (value,   SZ_LINE, TY_CHAR)
+	call salloc (pname,   SZ_LINE, TY_CHAR)
+	call salloc (plabels, SZ_LINE, TY_CHAR)
+
+	# Get parameter name.
+	Memc[param] = EOS
+	call gargwrd (Memc[param], SZ_LINE)
+	if (streq (Memc[param], "")) {
+	    call eprintf ("Parameter not specified\n")
+	    call sfree (sp)
+	    return
+	}
+
+	# Try to find the parameter name in the parameter labels.
+	call in_gstr (in, INLPLABELS, Memc[plabels], SZ_LINE)
+	number = strdic (Memc[param], Memc[pname], SZ_LINE, Memc[plabels])
+
+	# Try to find the parameter by number if it was not found
+	# by name in the dictionary.
+	if (number == 0) {
+	    ip = 1
+	    if (ctoi (Memc[param], ip, number) == 0) {
+		call eprintf ("Parameter not found (%s)\n")
+		    call pargstr (Memc[param])
+	        call sfree (sp)
+		return
+	    }
+	}
+
+	# Test parameter number.
+	npars = in_geti (in, INLNPARAMS)
+	if (number < 1 || number > npars) {
+	    call eprintf ("Parameter out of range (%d)\n")
+		call pargi (number)
+	    call sfree (sp)
+	    return
+	}
+
+	# Get pointers to parameter values and list.
+	pvalues = in_getp (in, INLPARAM)
+	plist   = in_getp (in, INLPLIST)
+
+	# Get new value if specified. Otherwise assume
+	# old parameter value.
+	Memc[value] = EOS
+	call gargwrd (Memc[value], SZ_LINE)
+	if (streq (Memc[value], ""))
+	    rval = Memr[pvalues + number - 1]
+	else {
+	    ip = 1
+	    if (ctor (Memc[value], ip, rval) == 0) {
+	        call eprintf ("Bad parameter value (%s)\n")
+		    call pargstr (Memc[value])
+	        call sfree (sp)
+	        return
+	    }
+	}
+
+	# Update parameter value.
+	Memr[pvalues + number - 1] = rval
+
+	# Find the parameter position in the parameter list.
+	do pos = 1, npars {
+	    if (Memi[plist + pos - 1] >= number ||
+		Memi[plist + pos - 1] == 0)
+	        break
+	}
+
+	# Insert or remove parameter from the parameter list
+	# according with its type, i.e., with the type of change.
+	# The list is not changed if it's not necesary to do so.
+
+	if (type == FIT) {
+	    if (Memi[plist + pos - 1] != number) {
+		do ip = npars, pos + 1, -1
+		    Memi[plist + ip - 1] = Memi[plist + ip - 2]
+		Memi[plist + pos - 1] = number
+		call in_puti (in, INLNFPARAMS, in_geti (in, INLNFPARAMS) + 1)
+	    }
+	    isfit = true
+	} else {
+	    if (Memi[plist + pos - 1] == number) {
+		do ip = pos, npars - 1
+		    Memi[plist + ip - 1] = Memi[plist + ip]
+		Memi[plist + npars - 1] = 0
+		call in_puti (in, INLNFPARAMS, in_geti (in, INLNFPARAMS) - 1)
+	    }
+	    isfit = false
+	}
+
+	# Print setting.
+	call printf ("(%s) changed to %s parameter, with value=%g\n")
+	    call pargstr (Memc[pname])
+	if (isfit)
+	    call pargstr ("fitting")
+	else
+	    call pargstr ("constant")
+	    call pargr (rval)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingdata.gx b/pkg/xtools/inlfit/ingdata.gx
new file mode 100644
index 00000000..80637be1
--- /dev/null
+++ b/pkg/xtools/inlfit/ingdata.gx
@@ -0,0 +1,86 @@
+include	<pkg/inlfit.h>
+
+define	NPERLINE	5
+
+# ING_DATA -- List the raw data on the screen.
+
+procedure ing_data$t (in, file, x, names, npts, nvars, len_name)
+
+pointer	in			# INLFIT pointer
+char	file[ARB]		# Output file name
+PIXEL	x[ARB]			# Ordinates (npts * nvars)
+char	names[ARB]		# Object names
+int	npts			# Number of data points
+int	nvars			# Number of variables
+int	len_name		# Length of the name
+
+int	i, j, fd
+pointer	sp, vnames, name
+int	open()
+int	inlstrwrd()
+errchk	open()
+
+begin
+	# Open the output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Test the number of data points.
+	if (npts == 0) {
+	    call eprintf ("Incomplete output - no data points for fit\n")
+	    return
+	}
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (vnames, SZ_LINE, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+
+	# Get the variable names.
+	call in_gstr (in, INLVLABELS, Memc[vnames], SZ_LINE)
+
+	# Print title.
+	do j = 1, nvars + 1 {
+	    if (mod (j, NPERLINE) == 1) {
+		call fprintf (fd, "\n")
+		call fprintf (fd, "#")
+	    }
+	    if (j == 1) {
+		call fprintf (fd, "%14.14s ")
+		    call pargstr ("objectid")
+	    } else if (inlstrwrd (j-1, Memc[name], SZ_LINE, Memc[vnames]) !=
+	        0) {
+		call fprintf (fd, "%14.14s ")
+		    call pargstr (Memc[name])
+	    } else {
+		call fprintf (fd, "%12.12s%02.2d ")
+		    call pargstr ("var")
+		    call pargi (j-1)
+	    }
+	}
+	call fprintf (fd, "\n")
+	
+	# List the  variables values.
+	do i = 1, npts {
+	    do j = 1, nvars + 1 {
+		if (j == 1) {
+		    call fprintf (fd, "\n")
+	            call fprintf (fd, "%15.15s")
+			call pargstr (names[(i-1)*len_name+1])
+	        } else if (mod (j, NPERLINE) == 1) {
+		    call fprintf (fd, "\n")
+	            call fprintf (fd, "*%14.7g")
+		        call parg$t (x[(i-1)*nvars+j-1])
+		} else {
+	            call fprintf (fd, " %14.7g")
+		        call parg$t (x[(i-1)*nvars+j-1])
+		}
+	    }
+	}
+	call fprintf (fd, "\n\n")
+
+	# Free allocated memory and close output file.
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingdatad.x b/pkg/xtools/inlfit/ingdatad.x
new file mode 100644
index 00000000..c1a82797
--- /dev/null
+++ b/pkg/xtools/inlfit/ingdatad.x
@@ -0,0 +1,86 @@
+include	<pkg/inlfit.h>
+
+define	NPERLINE	5
+
+# ING_DATA -- List the raw data on the screen.
+
+procedure ing_datad (in, file, x, names, npts, nvars, len_name)
+
+pointer	in			# INLFIT pointer
+char	file[ARB]		# Output file name
+double	x[ARB]			# Ordinates (npts * nvars)
+char	names[ARB]		# Object names
+int	npts			# Number of data points
+int	nvars			# Number of variables
+int	len_name		# Length of the name
+
+int	i, j, fd
+pointer	sp, vnames, name
+int	open()
+int	inlstrwrd()
+errchk	open()
+
+begin
+	# Open the output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Test the number of data points.
+	if (npts == 0) {
+	    call eprintf ("Incomplete output - no data points for fit\n")
+	    return
+	}
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (vnames, SZ_LINE, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+
+	# Get the variable names.
+	call in_gstr (in, INLVLABELS, Memc[vnames], SZ_LINE)
+
+	# Print title.
+	do j = 1, nvars + 1 {
+	    if (mod (j, NPERLINE) == 1) {
+		call fprintf (fd, "\n")
+		call fprintf (fd, "#")
+	    }
+	    if (j == 1) {
+		call fprintf (fd, "%14.14s ")
+		    call pargstr ("objectid")
+	    } else if (inlstrwrd (j-1, Memc[name], SZ_LINE, Memc[vnames]) !=
+	        0) {
+		call fprintf (fd, "%14.14s ")
+		    call pargstr (Memc[name])
+	    } else {
+		call fprintf (fd, "%12.12s%02.2d ")
+		    call pargstr ("var")
+		    call pargi (j-1)
+	    }
+	}
+	call fprintf (fd, "\n")
+	
+	# List the  variables values.
+	do i = 1, npts {
+	    do j = 1, nvars + 1 {
+		if (j == 1) {
+		    call fprintf (fd, "\n")
+	            call fprintf (fd, "%15.15s")
+			call pargstr (names[(i-1)*len_name+1])
+	        } else if (mod (j, NPERLINE) == 1) {
+		    call fprintf (fd, "\n")
+	            call fprintf (fd, "*%14.7g")
+		        call pargd (x[(i-1)*nvars+j-1])
+		} else {
+	            call fprintf (fd, " %14.7g")
+		        call pargd (x[(i-1)*nvars+j-1])
+		}
+	    }
+	}
+	call fprintf (fd, "\n\n")
+
+	# Free allocated memory and close output file.
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingdatar.x b/pkg/xtools/inlfit/ingdatar.x
new file mode 100644
index 00000000..21674540
--- /dev/null
+++ b/pkg/xtools/inlfit/ingdatar.x
@@ -0,0 +1,86 @@
+include	<pkg/inlfit.h>
+
+define	NPERLINE	5
+
+# ING_DATA -- List the raw data on the screen.
+
+procedure ing_datar (in, file, x, names, npts, nvars, len_name)
+
+pointer	in			# INLFIT pointer
+char	file[ARB]		# Output file name
+real	x[ARB]			# Ordinates (npts * nvars)
+char	names[ARB]		# Object names
+int	npts			# Number of data points
+int	nvars			# Number of variables
+int	len_name		# Length of the name
+
+int	i, j, fd
+pointer	sp, vnames, name
+int	open()
+int	inlstrwrd()
+errchk	open()
+
+begin
+	# Open the output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Test the number of data points.
+	if (npts == 0) {
+	    call eprintf ("Incomplete output - no data points for fit\n")
+	    return
+	}
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (vnames, SZ_LINE, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+
+	# Get the variable names.
+	call in_gstr (in, INLVLABELS, Memc[vnames], SZ_LINE)
+
+	# Print title.
+	do j = 1, nvars + 1 {
+	    if (mod (j, NPERLINE) == 1) {
+		call fprintf (fd, "\n")
+		call fprintf (fd, "#")
+	    }
+	    if (j == 1) {
+		call fprintf (fd, "%14.14s ")
+		    call pargstr ("objectid")
+	    } else if (inlstrwrd (j-1, Memc[name], SZ_LINE, Memc[vnames]) !=
+	        0) {
+		call fprintf (fd, "%14.14s ")
+		    call pargstr (Memc[name])
+	    } else {
+		call fprintf (fd, "%12.12s%02.2d ")
+		    call pargstr ("var")
+		    call pargi (j-1)
+	    }
+	}
+	call fprintf (fd, "\n")
+	
+	# List the  variables values.
+	do i = 1, npts {
+	    do j = 1, nvars + 1 {
+		if (j == 1) {
+		    call fprintf (fd, "\n")
+	            call fprintf (fd, "%15.15s")
+			call pargstr (names[(i-1)*len_name+1])
+	        } else if (mod (j, NPERLINE) == 1) {
+		    call fprintf (fd, "\n")
+	            call fprintf (fd, "*%14.7g")
+		        call pargr (x[(i-1)*nvars+j-1])
+		} else {
+	            call fprintf (fd, " %14.7g")
+		        call pargr (x[(i-1)*nvars+j-1])
+		}
+	    }
+	}
+	call fprintf (fd, "\n\n")
+
+	# Free allocated memory and close output file.
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingdefkey.x b/pkg/xtools/inlfit/ingdefkey.x
new file mode 100644
index 00000000..2154389d
--- /dev/null
+++ b/pkg/xtools/inlfit/ingdefkey.x
@@ -0,0 +1,182 @@
+include	"inlfitdef.h"
+include	<pkg/inlfit.h>
+
+# Abort label
+define	abort		9999
+
+
+# ING_DEFKEY - Define graph keys
+
+procedure ing_defkey (in, nvars, newgraph)
+
+pointer	in			# INLFIT descriptor
+int	nvars			# number of variables
+int	newgraph		# update graph ?
+
+char	ch
+int	key			# graph key
+int	axis			# axis number
+int	type[2], num[2]		# key types and numbers
+int	n, ip
+pointer	line, word, vlabels, str, sp
+
+int	scan()
+int	ctoi()
+int	strdic(), strlen()
+int	inlstrext(), inlstrwrd()
+int	in_geti()
+
+begin
+	# Allocate string space.
+	call smark  (sp)
+	call salloc (line,    SZ_LINE + 1, TY_CHAR)
+	call salloc (word,    SZ_LINE + 1, TY_CHAR)
+	call salloc (vlabels, SZ_LINE + 1, TY_CHAR)
+	call salloc (str,     SZ_LINE + 1, TY_CHAR)
+
+	# Get graph key to define.
+	call printf ("Graph key to be defined: ")
+	call flush (STDOUT)
+	if (scan() == EOF)
+	    goto abort
+        call gargc (ch)
+
+	# Convert key type into key number.
+	switch (ch) {
+	case '\n':
+	    goto abort
+	case 'h', 'i', 'j', 'k', 'l':
+	    switch (ch) {
+	    case 'h':
+		key = 1
+	    case 'i':
+		key = 2
+	    case 'j':
+		key = 3
+	    case 'k':
+		key = 4
+	    case 'l':
+		key = 5
+	    }
+	default:
+	    call eprintf ("Not a graph key, choose: [h, i, j, k, l]\n")
+	    goto abort
+	}
+
+	# Get variable label pointer.
+	call in_gstr (in, INLVLABELS, Memc[vlabels], SZ_LINE)
+
+	# Print current settings for the axis types.
+	call printf ("Set graph axis types (")
+	do axis = 1, 2 {
+	    call in_gkey (in, key, axis, type[axis], num[axis])
+	    switch (type[axis]) {
+	    case KEY_FUNCTION:
+		call printf ("function")
+	    case KEY_FIT:
+		call printf ("fit")
+	    case KEY_RESIDUALS:
+		call printf ("residuals")
+	    case KEY_RATIO:
+		call printf ("ratio")
+	    case KEY_NONLINEAR:
+		call printf ("nonlinear")
+	    case KEY_UAXIS:
+		call sprintf (Memc[str], SZ_LINE, "user%d")
+		    call pargi (num[axis])
+		call printf (Memc[str])
+	    case KEY_VARIABLE:
+		if (inlstrwrd (num[axis], Memc[str], SZ_LINE,
+		    Memc[vlabels]) != 0)
+		    call printf (Memc[str])
+		else {
+		    call sprintf (Memc[str], SZ_LINE, "var%d")
+		        call pargi (num[axis])
+		    call printf (Memc[str])
+		}
+	    default:
+		call error (0, "ing_defkey: Illegal key type")
+	    }
+	    if (axis == 1)
+	        call printf (", ")
+	}
+	call printf (") : ")
+	call flush (STDOUT)
+
+	# Get line from the input stream.
+	if (scan() == EOF)
+	    goto abort
+	call gargstr (Memc[line], SZ_LINE)
+
+	# Get new axis types from input line.
+	ip = 1
+	axis = 1
+	call sscan (Memc[line])
+	while (axis <= 2) {
+
+	    # Get word from line.
+	    if (inlstrext (Memc[line], ip, ", ", YES, Memc[word],
+	        SZ_LINE) == 0) {
+		if (axis == 2)
+		    call eprintf ("Incomplete definition, usage: X,Y\n")
+		goto abort
+	    }
+
+	    # Search for word in the type dictionary. Keywords can
+	    # be abreviated up to three characters to avoid conflicts
+	    # with user variables.
+	    if (strlen (Memc[word]) >= 3)
+	        type[axis] = strdic (Memc[word], Memc[str], SZ_LINE, KEY_TYPES)
+	    else
+		type[axis] = 0
+
+	    # Check type.
+	    if (type[axis] == 0) {
+		type[axis] = KEY_VARIABLE
+	        num[axis]  = strdic (Memc[word], Memc[str], SZ_LINE,
+		    Memc[vlabels])
+	        if (num[axis] == 0) {
+		    call eprintf ("Not a defined key type (%s), choose: [%s]\n")
+			call pargstr (Memc[word])
+			call pargstr (Memc[vlabels])
+		    goto abort
+	        }
+	    } else if (type[axis] == KEY_VARIABLE || type[axis] ==
+	        KEY_UAXIS) {
+	        if (inlstrext (Memc[line], ip, ", ", YES, Memc[word],
+		    SZ_LINE) == 0) {
+		    call eprintf ("Incomplete definition, usage: X,Y\n")
+		    goto abort
+	        }
+		n = 1
+		if (ctoi (Memc[word], n, num[axis]) == 0) {
+		    call eprintf ( "Not a valid var/user number (%s)\n")
+			call pargstr (Memc[word])
+		    goto abort
+		}
+		if (type[axis] == KEY_VARIABLE && num[axis] > nvars) {
+		    call eprintf ( "Variable number does not exist (%s)\n")
+			call pargstr (Memc[word])
+		    goto abort
+		}
+	    } else
+		num[axis] = INDEFI
+
+	    # Count axis
+	    axis = axis + 1
+	}
+
+	# Update axis types.
+	call in_pkey (in, key, 1, type[1], num[1])
+	call in_pkey (in, key, 2, type[2], num[2])
+
+	# Test if screen needs to be refreshed.
+	if (in_geti (in, INLGKEY) == key)
+	    newgraph = YES
+	else
+	    newgraph = NO
+
+abort
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingdelete.gx b/pkg/xtools/inlfit/ingdelete.gx
new file mode 100644
index 00000000..c4cac6d7
--- /dev/null
+++ b/pkg/xtools/inlfit/ingdelete.gx
@@ -0,0 +1,87 @@
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+
+define	MSIZE		2.0		# Mark size (real)
+
+
+# ING_DELETE -- Delete data point nearest the cursor.
+# The nearest point to the cursor in NDC coordinates is determined.
+
+procedure ing_delete$t (in, gp, gt, nl, x, y, wts, npts, nvars, wx, wy)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+PIXEL	x[ARB]				# Independent variables (npts * nvars)
+PIXEL	y[npts]				# Dependent variables
+PIXEL	wts[npts]			# Weight array
+int	npts				# Number of points
+int	nvars				# Number of variables
+real	wx, wy				# Position to be nearest
+
+int	gt_geti()
+pointer	sp, xout, yout
+
+begin
+	# Allocate memory for axes data
+	call smark (sp)
+	call salloc (xout, npts, TY_PIXEL)
+	call salloc (yout, npts, TY_PIXEL)
+
+	# Get axes data
+	call ing_axes$t (in, gt, nl, 1, x, y, Mem$t[xout], npts, nvars)
+	call ing_axes$t (in, gt, nl, 2, x, y, Mem$t[yout], npts, nvars)
+
+	# Transpose axes if necessary
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call ing_d1$t (in, gp, Mem$t[xout], Mem$t[yout], wts, npts, wx, wy)
+	else
+	    call ing_d1$t (in, gp, Mem$t[yout], Mem$t[xout], wts, npts, wy, wx)
+
+	# Free memory
+	call sfree (sp)
+end
+
+
+# ING_D1 -- Do the actual delete. Mark deleted point with zero weigth.
+
+procedure ing_d1$t (in, gp, x, y, wts, npts, wx, wy)
+
+pointer	in					# ICFIT pointer
+pointer	gp					# GIO pointer
+PIXEL	x[npts], y[npts]			# Data points
+PIXEL	wts[npts]				# Weight array
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with non-zero weight.
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] == PIXEL (0.0))
+		next
+
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+		
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Mark the deleted point with a cross and set the weight to zero.
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    wts[j] = PIXEL (0.0)
+	}
+end
diff --git a/pkg/xtools/inlfit/ingdeleted.x b/pkg/xtools/inlfit/ingdeleted.x
new file mode 100644
index 00000000..47f66b06
--- /dev/null
+++ b/pkg/xtools/inlfit/ingdeleted.x
@@ -0,0 +1,87 @@
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+
+define	MSIZE		2.0		# Mark size (real)
+
+
+# ING_DELETE -- Delete data point nearest the cursor.
+# The nearest point to the cursor in NDC coordinates is determined.
+
+procedure ing_deleted (in, gp, gt, nl, x, y, wts, npts, nvars, wx, wy)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+double	x[ARB]				# Independent variables (npts * nvars)
+double	y[npts]				# Dependent variables
+double	wts[npts]			# Weight array
+int	npts				# Number of points
+int	nvars				# Number of variables
+real	wx, wy				# Position to be nearest
+
+int	gt_geti()
+pointer	sp, xout, yout
+
+begin
+	# Allocate memory for axes data
+	call smark (sp)
+	call salloc (xout, npts, TY_DOUBLE)
+	call salloc (yout, npts, TY_DOUBLE)
+
+	# Get axes data
+	call ing_axesd (in, gt, nl, 1, x, y, Memd[xout], npts, nvars)
+	call ing_axesd (in, gt, nl, 2, x, y, Memd[yout], npts, nvars)
+
+	# Transpose axes if necessary
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call ing_d1d (in, gp, Memd[xout], Memd[yout], wts, npts, wx, wy)
+	else
+	    call ing_d1d (in, gp, Memd[yout], Memd[xout], wts, npts, wy, wx)
+
+	# Free memory
+	call sfree (sp)
+end
+
+
+# ING_D1 -- Do the actual delete. Mark deleted point with zero weigth.
+
+procedure ing_d1d (in, gp, x, y, wts, npts, wx, wy)
+
+pointer	in					# ICFIT pointer
+pointer	gp					# GIO pointer
+double	x[npts], y[npts]			# Data points
+double	wts[npts]				# Weight array
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with non-zero weight.
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] == double (0.0))
+		next
+
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+		
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Mark the deleted point with a cross and set the weight to zero.
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    wts[j] = double (0.0)
+	}
+end
diff --git a/pkg/xtools/inlfit/ingdeleter.x b/pkg/xtools/inlfit/ingdeleter.x
new file mode 100644
index 00000000..27fbd16c
--- /dev/null
+++ b/pkg/xtools/inlfit/ingdeleter.x
@@ -0,0 +1,87 @@
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+
+define	MSIZE		2.0		# Mark size (real)
+
+
+# ING_DELETE -- Delete data point nearest the cursor.
+# The nearest point to the cursor in NDC coordinates is determined.
+
+procedure ing_deleter (in, gp, gt, nl, x, y, wts, npts, nvars, wx, wy)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+real	x[ARB]				# Independent variables (npts * nvars)
+real	y[npts]				# Dependent variables
+real	wts[npts]			# Weight array
+int	npts				# Number of points
+int	nvars				# Number of variables
+real	wx, wy				# Position to be nearest
+
+int	gt_geti()
+pointer	sp, xout, yout
+
+begin
+	# Allocate memory for axes data
+	call smark (sp)
+	call salloc (xout, npts, TY_REAL)
+	call salloc (yout, npts, TY_REAL)
+
+	# Get axes data
+	call ing_axesr (in, gt, nl, 1, x, y, Memr[xout], npts, nvars)
+	call ing_axesr (in, gt, nl, 2, x, y, Memr[yout], npts, nvars)
+
+	# Transpose axes if necessary
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call ing_d1r (in, gp, Memr[xout], Memr[yout], wts, npts, wx, wy)
+	else
+	    call ing_d1r (in, gp, Memr[yout], Memr[xout], wts, npts, wy, wx)
+
+	# Free memory
+	call sfree (sp)
+end
+
+
+# ING_D1 -- Do the actual delete. Mark deleted point with zero weigth.
+
+procedure ing_d1r (in, gp, x, y, wts, npts, wx, wy)
+
+pointer	in					# ICFIT pointer
+pointer	gp					# GIO pointer
+real	x[npts], y[npts]			# Data points
+real	wts[npts]				# Weight array
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with non-zero weight.
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] == real (0.0))
+		next
+
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+		
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Mark the deleted point with a cross and set the weight to zero.
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    wts[j] = real (0.0)
+	}
+end
diff --git a/pkg/xtools/inlfit/ingerrors.gx b/pkg/xtools/inlfit/ingerrors.gx
new file mode 100644
index 00000000..1125a39a
--- /dev/null
+++ b/pkg/xtools/inlfit/ingerrors.gx
@@ -0,0 +1,139 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# ING_ERRORS -- Compute error diagnostic information and print it on the
+# screen.
+
+procedure ing_errors$t (in, file, nl, x, y, wts, npts, nvars)
+
+pointer	in		# INLFIT pointer
+char	file[ARB]	# Output file name
+pointer	nl		# NLFIT pointer
+PIXEL	x[ARB]		# Ordinates (npts * nvars)
+PIXEL	y[ARB]		# Abscissas
+PIXEL	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	nvars		# Number of variables
+
+bool	isfit
+int	i, j, deleted, rejected, nparams, fd
+PIXEL	chisqr, variance, rms
+pointer	sp, fit, wts1, params, errors, rejpts, plist
+pointer	name, pvnames, labels
+
+int	open(), nlstati(), inlstrwrd(), in_geti()
+pointer	in_getp()
+PIXEL	in_rms$t(), nlstat$t()
+errchk	open()
+
+begin
+	# Open the output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Determine the number of coefficients.
+	nparams = nlstati (nl, NLNPARAMS)
+
+	# Allocate memory for parameters, errors, and parameter list.
+	call smark (sp)
+	call salloc (params, nparams, TY_PIXEL)
+	call salloc (errors, nparams, TY_PIXEL)
+	call salloc (labels, SZ_LINE + 1, TY_CHAR)
+
+	# Allocate memory for the fit and strings.
+	call salloc (fit, npts, TY_PIXEL)
+	call salloc (wts1, npts, TY_PIXEL)
+	call salloc (name, SZ_LINE + 1, TY_CHAR)
+	call salloc (pvnames, SZ_LINE + 1, TY_CHAR)
+
+	# Get number of rejected points and rejected point list.
+	rejected = in_geti (in, INLNREJPTS)
+	rejpts   = in_getp (in, INLREJPTS)
+
+	# Count deleted points.
+	deleted = 0
+	do i = 1, npts {
+	    if (wts[i] == PIXEL (0.0))
+		deleted = deleted + 1
+	}
+
+	# Assign a zero weight to rejected points.
+	call amov$t (wts, Mem$t[wts1], npts)
+	if (rejected > 0) {
+	    do i = 1, npts {
+		if (Memi[rejpts+i-1] == YES)
+		    Mem$t[wts1+i-1] = PIXEL (0.0)
+	    }
+	}
+
+	# Get the parameter values and errors.
+	call nlvector$t (nl, x, Mem$t[fit], npts, nvars)
+	call nlpget$t (nl, Mem$t[params], nparams)
+	call nlerrors$t (nl, y, Mem$t[fit], Mem$t[wts1], npts, variance,
+	    chisqr, Mem$t[errors])
+
+	# Compute the RMS.
+	rms = in_rms$t (y, Mem$t[fit], Mem$t[wts1], npts)
+
+	# Print the error analysis.
+	call fprintf (fd, "\nniterations        %d\n")
+	    call pargi (nlstati (nl, NLITER))
+	call fprintf (fd, "total_points       %d\n")
+	    call pargi (npts)
+	call fprintf (fd, "rejected           %d\n")
+	    call pargi (in_geti (in, INLNREJPTS))
+	call fprintf (fd, "deleted            %d\n")
+	    call pargi (deleted)
+	call fprintf (fd, "standard deviation %10.7g\n")
+	    call parg$t (sqrt (variance))
+	call fprintf (fd, "reduced chi        %10.7g\n")
+	    call parg$t (sqrt (chisqr))
+	call fprintf (fd, "average error      %10.7g\n")
+	if (chisqr <= 0)
+	    call parg$t (PIXEL(0.0))
+	else
+	    call parg$t (sqrt (max (variance, PIXEL (0.0)) / chisqr))
+	call fprintf (fd, "average scatter    %10.7g\n")
+	    call parg$t (sqrt (nlstat$t (nl, NLSCATTER)))
+	call fprintf (fd, "RMS                %10.7g\n")
+	    call parg$t (rms)
+
+	# Print parameter values and errors.
+	call in_gstr (in, INLPLABELS, Memc[labels], SZ_LINE)
+	call strcpy (Memc[labels], Memc[pvnames], SZ_LINE)
+	call fprintf (fd, "\n%-10.10s  %14.14s  %14.14s\n")
+	    call pargstr ("parameter")
+	    call pargstr ("value")
+	    call pargstr ("error")
+	plist = in_getp (in, INLPLIST)
+	do i = 1, nparams {
+	    if (inlstrwrd (i, Memc[name], SZ_LINE, Memc[pvnames]) != 0) {
+	        call fprintf (fd, "%-10.10s  ")
+		    call pargstr (Memc[name])
+	    } else {
+	        call fprintf (fd, "%-10.2d  ")
+		    call pargi (i)
+	    }
+	    call fprintf (fd, "%14.7f  %14.7f    (%s)\n")
+		call parg$t (Mem$t[params+i-1])
+		call parg$t (Mem$t[errors+i-1])
+	    isfit = false
+	    do j = 1, nparams {
+		if (Memi[plist+j-1] == i) {
+		    isfit = true
+		    break
+		}
+	    }
+	    if (isfit)
+		call pargstr ("fit")
+	    else
+		call pargstr ("constant")
+	}
+	call fprintf (fd, "\n")
+
+	# Free allocated memory.
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingerrorsd.x b/pkg/xtools/inlfit/ingerrorsd.x
new file mode 100644
index 00000000..44302b68
--- /dev/null
+++ b/pkg/xtools/inlfit/ingerrorsd.x
@@ -0,0 +1,139 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# ING_ERRORS -- Compute error diagnostic information and print it on the
+# screen.
+
+procedure ing_errorsd (in, file, nl, x, y, wts, npts, nvars)
+
+pointer	in		# INLFIT pointer
+char	file[ARB]	# Output file name
+pointer	nl		# NLFIT pointer
+double	x[ARB]		# Ordinates (npts * nvars)
+double	y[ARB]		# Abscissas
+double	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	nvars		# Number of variables
+
+bool	isfit
+int	i, j, deleted, rejected, nparams, fd
+double	chisqr, variance, rms
+pointer	sp, fit, wts1, params, errors, rejpts, plist
+pointer	name, pvnames, labels
+
+int	open(), nlstati(), inlstrwrd(), in_geti()
+pointer	in_getp()
+double	in_rmsd(), nlstatd()
+errchk	open()
+
+begin
+	# Open the output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Determine the number of coefficients.
+	nparams = nlstati (nl, NLNPARAMS)
+
+	# Allocate memory for parameters, errors, and parameter list.
+	call smark (sp)
+	call salloc (params, nparams, TY_DOUBLE)
+	call salloc (errors, nparams, TY_DOUBLE)
+	call salloc (labels, SZ_LINE + 1, TY_CHAR)
+
+	# Allocate memory for the fit and strings.
+	call salloc (fit, npts, TY_DOUBLE)
+	call salloc (wts1, npts, TY_DOUBLE)
+	call salloc (name, SZ_LINE + 1, TY_CHAR)
+	call salloc (pvnames, SZ_LINE + 1, TY_CHAR)
+
+	# Get number of rejected points and rejected point list.
+	rejected = in_geti (in, INLNREJPTS)
+	rejpts   = in_getp (in, INLREJPTS)
+
+	# Count deleted points.
+	deleted = 0
+	do i = 1, npts {
+	    if (wts[i] == double (0.0))
+		deleted = deleted + 1
+	}
+
+	# Assign a zero weight to rejected points.
+	call amovd (wts, Memd[wts1], npts)
+	if (rejected > 0) {
+	    do i = 1, npts {
+		if (Memi[rejpts+i-1] == YES)
+		    Memd[wts1+i-1] = double (0.0)
+	    }
+	}
+
+	# Get the parameter values and errors.
+	call nlvectord (nl, x, Memd[fit], npts, nvars)
+	call nlpgetd (nl, Memd[params], nparams)
+	call nlerrorsd (nl, y, Memd[fit], Memd[wts1], npts, variance,
+	    chisqr, Memd[errors])
+
+	# Compute the RMS.
+	rms = in_rmsd (y, Memd[fit], Memd[wts1], npts)
+
+	# Print the error analysis.
+	call fprintf (fd, "\nniterations        %d\n")
+	    call pargi (nlstati (nl, NLITER))
+	call fprintf (fd, "total_points       %d\n")
+	    call pargi (npts)
+	call fprintf (fd, "rejected           %d\n")
+	    call pargi (in_geti (in, INLNREJPTS))
+	call fprintf (fd, "deleted            %d\n")
+	    call pargi (deleted)
+	call fprintf (fd, "standard deviation %10.7g\n")
+	    call pargd (sqrt (variance))
+	call fprintf (fd, "reduced chi        %10.7g\n")
+	    call pargd (sqrt (chisqr))
+	call fprintf (fd, "average error      %10.7g\n")
+	if (chisqr <= 0)
+	    call pargd (double(0.0))
+	else
+	    call pargd (sqrt (max (variance, double (0.0)) / chisqr))
+	call fprintf (fd, "average scatter    %10.7g\n")
+	    call pargd (sqrt (nlstatd (nl, NLSCATTER)))
+	call fprintf (fd, "RMS                %10.7g\n")
+	    call pargd (rms)
+
+	# Print parameter values and errors.
+	call in_gstr (in, INLPLABELS, Memc[labels], SZ_LINE)
+	call strcpy (Memc[labels], Memc[pvnames], SZ_LINE)
+	call fprintf (fd, "\n%-10.10s  %14.14s  %14.14s\n")
+	    call pargstr ("parameter")
+	    call pargstr ("value")
+	    call pargstr ("error")
+	plist = in_getp (in, INLPLIST)
+	do i = 1, nparams {
+	    if (inlstrwrd (i, Memc[name], SZ_LINE, Memc[pvnames]) != 0) {
+	        call fprintf (fd, "%-10.10s  ")
+		    call pargstr (Memc[name])
+	    } else {
+	        call fprintf (fd, "%-10.2d  ")
+		    call pargi (i)
+	    }
+	    call fprintf (fd, "%14.7f  %14.7f    (%s)\n")
+		call pargd (Memd[params+i-1])
+		call pargd (Memd[errors+i-1])
+	    isfit = false
+	    do j = 1, nparams {
+		if (Memi[plist+j-1] == i) {
+		    isfit = true
+		    break
+		}
+	    }
+	    if (isfit)
+		call pargstr ("fit")
+	    else
+		call pargstr ("constant")
+	}
+	call fprintf (fd, "\n")
+
+	# Free allocated memory.
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingerrorsr.x b/pkg/xtools/inlfit/ingerrorsr.x
new file mode 100644
index 00000000..7d1b86d4
--- /dev/null
+++ b/pkg/xtools/inlfit/ingerrorsr.x
@@ -0,0 +1,139 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# ING_ERRORS -- Compute error diagnostic information and print it on the
+# screen.
+
+procedure ing_errorsr (in, file, nl, x, y, wts, npts, nvars)
+
+pointer	in		# INLFIT pointer
+char	file[ARB]	# Output file name
+pointer	nl		# NLFIT pointer
+real	x[ARB]		# Ordinates (npts * nvars)
+real	y[ARB]		# Abscissas
+real	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	nvars		# Number of variables
+
+bool	isfit
+int	i, j, deleted, rejected, nparams, fd
+real	chisqr, variance, rms
+pointer	sp, fit, wts1, params, errors, rejpts, plist
+pointer	name, pvnames, labels
+
+int	open(), nlstati(), inlstrwrd(), in_geti()
+pointer	in_getp()
+real	in_rmsr(), nlstatr()
+errchk	open()
+
+begin
+	# Open the output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Determine the number of coefficients.
+	nparams = nlstati (nl, NLNPARAMS)
+
+	# Allocate memory for parameters, errors, and parameter list.
+	call smark (sp)
+	call salloc (params, nparams, TY_REAL)
+	call salloc (errors, nparams, TY_REAL)
+	call salloc (labels, SZ_LINE + 1, TY_CHAR)
+
+	# Allocate memory for the fit and strings.
+	call salloc (fit, npts, TY_REAL)
+	call salloc (wts1, npts, TY_REAL)
+	call salloc (name, SZ_LINE + 1, TY_CHAR)
+	call salloc (pvnames, SZ_LINE + 1, TY_CHAR)
+
+	# Get number of rejected points and rejected point list.
+	rejected = in_geti (in, INLNREJPTS)
+	rejpts   = in_getp (in, INLREJPTS)
+
+	# Count deleted points.
+	deleted = 0
+	do i = 1, npts {
+	    if (wts[i] == real (0.0))
+		deleted = deleted + 1
+	}
+
+	# Assign a zero weight to rejected points.
+	call amovr (wts, Memr[wts1], npts)
+	if (rejected > 0) {
+	    do i = 1, npts {
+		if (Memi[rejpts+i-1] == YES)
+		    Memr[wts1+i-1] = real (0.0)
+	    }
+	}
+
+	# Get the parameter values and errors.
+	call nlvectorr (nl, x, Memr[fit], npts, nvars)
+	call nlpgetr (nl, Memr[params], nparams)
+	call nlerrorsr (nl, y, Memr[fit], Memr[wts1], npts, variance,
+	    chisqr, Memr[errors])
+
+	# Compute the RMS.
+	rms = in_rmsr (y, Memr[fit], Memr[wts1], npts)
+
+	# Print the error analysis.
+	call fprintf (fd, "\nniterations        %d\n")
+	    call pargi (nlstati (nl, NLITER))
+	call fprintf (fd, "total_points       %d\n")
+	    call pargi (npts)
+	call fprintf (fd, "rejected           %d\n")
+	    call pargi (in_geti (in, INLNREJPTS))
+	call fprintf (fd, "deleted            %d\n")
+	    call pargi (deleted)
+	call fprintf (fd, "standard deviation %10.7g\n")
+	    call pargr (sqrt (variance))
+	call fprintf (fd, "reduced chi        %10.7g\n")
+	    call pargr (sqrt (chisqr))
+	call fprintf (fd, "average error      %10.7g\n")
+	if (chisqr <= 0)
+	    call pargr (real(0.0))
+	else
+	    call pargr (sqrt (max (variance, real (0.0)) / chisqr))
+	call fprintf (fd, "average scatter    %10.7g\n")
+	    call pargr (sqrt (nlstatr (nl, NLSCATTER)))
+	call fprintf (fd, "RMS                %10.7g\n")
+	    call pargr (rms)
+
+	# Print parameter values and errors.
+	call in_gstr (in, INLPLABELS, Memc[labels], SZ_LINE)
+	call strcpy (Memc[labels], Memc[pvnames], SZ_LINE)
+	call fprintf (fd, "\n%-10.10s  %14.14s  %14.14s\n")
+	    call pargstr ("parameter")
+	    call pargstr ("value")
+	    call pargstr ("error")
+	plist = in_getp (in, INLPLIST)
+	do i = 1, nparams {
+	    if (inlstrwrd (i, Memc[name], SZ_LINE, Memc[pvnames]) != 0) {
+	        call fprintf (fd, "%-10.10s  ")
+		    call pargstr (Memc[name])
+	    } else {
+	        call fprintf (fd, "%-10.2d  ")
+		    call pargi (i)
+	    }
+	    call fprintf (fd, "%14.7f  %14.7f    (%s)\n")
+		call pargr (Memr[params+i-1])
+		call pargr (Memr[errors+i-1])
+	    isfit = false
+	    do j = 1, nparams {
+		if (Memi[plist+j-1] == i) {
+		    isfit = true
+		    break
+		}
+	    }
+	    if (isfit)
+		call pargstr ("fit")
+	    else
+		call pargstr ("constant")
+	}
+	call fprintf (fd, "\n")
+
+	# Free allocated memory.
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/inget.gx b/pkg/xtools/inlfit/inget.gx
new file mode 100644
index 00000000..907a0331
--- /dev/null
+++ b/pkg/xtools/inlfit/inget.gx
@@ -0,0 +1,220 @@
+.help inget
+	int    = in_geti (in, param)
+	pointer= in_getp (in, param)
+	real   = in_getr (in, param)
+	double = in_getd (in, param)
+	         in_gstr (in, param, str, maxch)
+	         in_gkey (in, key, axis, type, varnum)
+.endhelp
+
+include	<pkg/inlfit.h>
+include "inlfitdef.h"
+
+# IN_GETI -- Get integer valued parameters.
+
+int procedure in_geti (in, param)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+
+begin
+	switch (param) {
+	case INLFUNCTION:
+	    return (IN_FUNC (in))
+	case INLDERIVATIVE:
+	    return (IN_DFUNC (in))
+	case INLNPARAMS:
+	    return (IN_NPARAMS (in))
+	case INLNFPARAMS:
+	    return (IN_NFPARAMS (in))
+	case INLNVARS:
+	    return (IN_NVARS (in))
+	case INLNPTS:
+	    return (IN_NPTS (in))
+	case INLMAXITER:
+	    return (IN_MAXITER (in))
+	case INLNREJECT:
+	    return (IN_NREJECT(in))
+	case INLNREJPTS:
+	    return (IN_NREJPTS (in))
+	case INLUAXES:
+	    return (IN_UAXES (in))
+	case INLUCOLON:
+	    return (IN_UCOLON (in))
+	case INLUFIT:
+	    return (IN_UFIT (in))
+	case INLOVERPLOT:
+	    return (IN_OVERPLOT (in))
+	case INLPLOTFIT:
+	    return (IN_PLOTFIT (in))
+	case INLFITERROR:
+	    return (IN_FITERROR (in))
+	case INLGKEY:
+	    return (IN_GKEY (in))
+	default:
+	    call error (0, "INLFIT, in_geti: Unknown parameter")
+	}
+end
+
+
+$for (rd)
+# IN_GET[RD] -- Get real/double valued parameters.
+
+PIXEL procedure in_get$t (in, param)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+
+begin
+	switch (param) {
+	case INLTOLERANCE:
+	    return (IN_TOL$T (in))
+	case INLLOW:
+	    return (IN_LOW$T (in))
+	case INLHIGH:
+	    return (IN_HIGH$T (in))
+	case INLGROW:
+	    return (IN_GROW$T (in))
+	default:
+	    call error (0, "INLFIT, in_get[rd]: Unknown parameter")
+	}
+end
+$endfor
+
+
+# IN_GETP -- Get pointer valued parameters.
+
+pointer procedure in_getp (in, param)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+
+begin
+	switch (param) {
+	case INLPARAM:
+	    return (IN_PARAM (in))
+	case INLDPARAM:
+	    return (IN_DPARAM (in))
+	case INLPLIST:
+	    return (IN_PLIST (in))
+	case INLSFLOAT:
+	    return (IN_SFLOAT (in))
+	case INLREJPTS:
+	    return (IN_REJPTS (in))
+	case INLXMIN:
+	    return (IN_XMIN (in))
+	case INLXMAX:
+	    return (IN_XMAX (in))
+	case INLSGAXES:
+	    return (IN_SGAXES (in))
+	default:
+	    call error (0, "INLFIT, in_getp: Unknown parameter")
+	}
+end
+
+
+# IN_GETC -- Get character pointer valued parameters.
+
+pointer procedure in_getc (in, param)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+
+begin
+	switch (param) {
+	case INLLABELS:
+	    return (IN_LABELS (in))
+	case INLUNITS:
+	    return (IN_UNITS (in))
+	case INLFLABELS:
+	    return (IN_FLABELS (in))
+	case INLFUNITS:
+	    return (IN_FUNITS (in))
+	case INLPLABELS:
+	    return (IN_PLABELS (in))
+	case INLPUNITS:
+	    return (IN_PUNITS (in))
+	case INLVLABELS:
+	    return (IN_VLABELS (in))
+	case INLVUNITS:
+	    return (IN_VUNITS (in))
+	case INLUSERLABELS:
+	    return (IN_USERLABELS (in))
+	case INLUSERUNITS:
+	    return (IN_USERUNITS (in))
+	case INLHELP:
+	    return (IN_HELP (in))
+	case INLPROMPT:
+	    return (IN_PROMPT (in))
+	default:
+	    call error (0, "INLFIT, in_getc: Unknown parameter")
+	}
+end
+
+
+# IN_GSTR -- Get string valued parameters.
+
+procedure in_gstr (in, param, str, maxch)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+char	str[maxch]		# string value
+int	maxch			# maximum number of characters
+
+begin
+	switch (param) {
+	case INLLABELS:
+	    call strcpy (Memc[IN_LABELS (in)], str, maxch)
+	case INLUNITS:
+	    call strcpy (Memc[IN_UNITS (in)], str, maxch)
+	case INLFLABELS:
+	    call strcpy (Memc[IN_FLABELS (in)], str, maxch)
+	case INLFUNITS:
+	    call strcpy (Memc[IN_FUNITS (in)], str, maxch)
+	case INLPLABELS:
+	    call strcpy (Memc[IN_PLABELS (in)], str, maxch)
+	case INLPUNITS:
+	    call strcpy (Memc[IN_PUNITS (in)], str, maxch)
+	case INLVLABELS:
+	    call strcpy (Memc[IN_VLABELS (in)], str, maxch)
+	case INLVUNITS:
+	    call strcpy (Memc[IN_VUNITS (in)], str, maxch)
+	case INLUSERLABELS:
+	    call strcpy (Memc[IN_USERLABELS (in)], str, maxch)
+	case INLUSERUNITS:
+	    call strcpy (Memc[IN_USERUNITS (in)], str, maxch)
+	case INLHELP:
+	    call strcpy (Memc[IN_HELP (in)], str, maxch)
+	case INLPROMPT:
+	    call strcpy (Memc[IN_PROMPT (in)], str, maxch)
+	default:
+	    call error (0, "INLFIT, in_gstr: Unknown parameter")
+	}
+end
+
+
+# IN_GKEY -- Get key parameters.
+
+procedure in_gkey (in, key, axis, type, varnum)
+
+pointer	in			# INLFIT pointer
+int	key			# key to get
+int	axis			# axis number
+int	type			# axis type (output)
+int	varnum			# axis variable number (output)
+
+begin
+	# Check ranges
+	if (key < 1 || key > INLNGKEYS)
+	    call error (0, "INLFIT, in_pkey: Illegal key")
+
+	# Get data
+	if (axis == INLXAXIS) {
+	    type   = IN_GXTYPE   (in, key)
+	    varnum = IN_GXNUMBER (in, key)
+	} else if (axis == INLYAXIS) {
+	    type   = IN_GYTYPE   (in, key)
+	    varnum = IN_GYNUMBER (in, key)
+	} else
+	    call error (0, "INLFIT, in_gkey: Illegal axis")
+end
diff --git a/pkg/xtools/inlfit/inget.x b/pkg/xtools/inlfit/inget.x
new file mode 100644
index 00000000..aa31a8cb
--- /dev/null
+++ b/pkg/xtools/inlfit/inget.x
@@ -0,0 +1,242 @@
+.help inget
+	int    = in_geti (in, param)
+	pointer= in_getp (in, param)
+	real   = in_getr (in, param)
+	double = in_getd (in, param)
+	         in_gstr (in, param, str, maxch)
+	         in_gkey (in, key, axis, type, varnum)
+.endhelp
+
+include	<pkg/inlfit.h>
+include "inlfitdef.h"
+
+# IN_GETI -- Get integer valued parameters.
+
+int procedure in_geti (in, param)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+
+begin
+	switch (param) {
+	case INLFUNCTION:
+	    return (IN_FUNC (in))
+	case INLDERIVATIVE:
+	    return (IN_DFUNC (in))
+	case INLNPARAMS:
+	    return (IN_NPARAMS (in))
+	case INLNFPARAMS:
+	    return (IN_NFPARAMS (in))
+	case INLNVARS:
+	    return (IN_NVARS (in))
+	case INLNPTS:
+	    return (IN_NPTS (in))
+	case INLMAXITER:
+	    return (IN_MAXITER (in))
+	case INLNREJECT:
+	    return (IN_NREJECT(in))
+	case INLNREJPTS:
+	    return (IN_NREJPTS (in))
+	case INLUAXES:
+	    return (IN_UAXES (in))
+	case INLUCOLON:
+	    return (IN_UCOLON (in))
+	case INLUFIT:
+	    return (IN_UFIT (in))
+	case INLOVERPLOT:
+	    return (IN_OVERPLOT (in))
+	case INLPLOTFIT:
+	    return (IN_PLOTFIT (in))
+	case INLFITERROR:
+	    return (IN_FITERROR (in))
+	case INLGKEY:
+	    return (IN_GKEY (in))
+	default:
+	    call error (0, "INLFIT, in_geti: Unknown parameter")
+	}
+end
+
+
+
+# IN_GET[RD] -- Get real/double valued parameters.
+
+real procedure in_getr (in, param)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+
+begin
+	switch (param) {
+	case INLTOLERANCE:
+	    return (IN_TOLR (in))
+	case INLLOW:
+	    return (IN_LOWR (in))
+	case INLHIGH:
+	    return (IN_HIGHR (in))
+	case INLGROW:
+	    return (IN_GROWR (in))
+	default:
+	    call error (0, "INLFIT, in_get[rd]: Unknown parameter")
+	}
+end
+
+# IN_GET[RD] -- Get real/double valued parameters.
+
+double procedure in_getd (in, param)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+
+begin
+	switch (param) {
+	case INLTOLERANCE:
+	    return (IN_TOLD (in))
+	case INLLOW:
+	    return (IN_LOWD (in))
+	case INLHIGH:
+	    return (IN_HIGHD (in))
+	case INLGROW:
+	    return (IN_GROWD (in))
+	default:
+	    call error (0, "INLFIT, in_get[rd]: Unknown parameter")
+	}
+end
+
+
+
+# IN_GETP -- Get pointer valued parameters.
+
+pointer procedure in_getp (in, param)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+
+begin
+	switch (param) {
+	case INLPARAM:
+	    return (IN_PARAM (in))
+	case INLDPARAM:
+	    return (IN_DPARAM (in))
+	case INLPLIST:
+	    return (IN_PLIST (in))
+	case INLSFLOAT:
+	    return (IN_SFLOAT (in))
+	case INLREJPTS:
+	    return (IN_REJPTS (in))
+	case INLXMIN:
+	    return (IN_XMIN (in))
+	case INLXMAX:
+	    return (IN_XMAX (in))
+	case INLSGAXES:
+	    return (IN_SGAXES (in))
+	default:
+	    call error (0, "INLFIT, in_getp: Unknown parameter")
+	}
+end
+
+
+# IN_GETC -- Get character pointer valued parameters.
+
+pointer procedure in_getc (in, param)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+
+begin
+	switch (param) {
+	case INLLABELS:
+	    return (IN_LABELS (in))
+	case INLUNITS:
+	    return (IN_UNITS (in))
+	case INLFLABELS:
+	    return (IN_FLABELS (in))
+	case INLFUNITS:
+	    return (IN_FUNITS (in))
+	case INLPLABELS:
+	    return (IN_PLABELS (in))
+	case INLPUNITS:
+	    return (IN_PUNITS (in))
+	case INLVLABELS:
+	    return (IN_VLABELS (in))
+	case INLVUNITS:
+	    return (IN_VUNITS (in))
+	case INLUSERLABELS:
+	    return (IN_USERLABELS (in))
+	case INLUSERUNITS:
+	    return (IN_USERUNITS (in))
+	case INLHELP:
+	    return (IN_HELP (in))
+	case INLPROMPT:
+	    return (IN_PROMPT (in))
+	default:
+	    call error (0, "INLFIT, in_getc: Unknown parameter")
+	}
+end
+
+
+# IN_GSTR -- Get string valued parameters.
+
+procedure in_gstr (in, param, str, maxch)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to get
+char	str[maxch]		# string value
+int	maxch			# maximum number of characters
+
+begin
+	switch (param) {
+	case INLLABELS:
+	    call strcpy (Memc[IN_LABELS (in)], str, maxch)
+	case INLUNITS:
+	    call strcpy (Memc[IN_UNITS (in)], str, maxch)
+	case INLFLABELS:
+	    call strcpy (Memc[IN_FLABELS (in)], str, maxch)
+	case INLFUNITS:
+	    call strcpy (Memc[IN_FUNITS (in)], str, maxch)
+	case INLPLABELS:
+	    call strcpy (Memc[IN_PLABELS (in)], str, maxch)
+	case INLPUNITS:
+	    call strcpy (Memc[IN_PUNITS (in)], str, maxch)
+	case INLVLABELS:
+	    call strcpy (Memc[IN_VLABELS (in)], str, maxch)
+	case INLVUNITS:
+	    call strcpy (Memc[IN_VUNITS (in)], str, maxch)
+	case INLUSERLABELS:
+	    call strcpy (Memc[IN_USERLABELS (in)], str, maxch)
+	case INLUSERUNITS:
+	    call strcpy (Memc[IN_USERUNITS (in)], str, maxch)
+	case INLHELP:
+	    call strcpy (Memc[IN_HELP (in)], str, maxch)
+	case INLPROMPT:
+	    call strcpy (Memc[IN_PROMPT (in)], str, maxch)
+	default:
+	    call error (0, "INLFIT, in_gstr: Unknown parameter")
+	}
+end
+
+
+# IN_GKEY -- Get key parameters.
+
+procedure in_gkey (in, key, axis, type, varnum)
+
+pointer	in			# INLFIT pointer
+int	key			# key to get
+int	axis			# axis number
+int	type			# axis type (output)
+int	varnum			# axis variable number (output)
+
+begin
+	# Check ranges
+	if (key < 1 || key > INLNGKEYS)
+	    call error (0, "INLFIT, in_pkey: Illegal key")
+
+	# Get data
+	if (axis == INLXAXIS) {
+	    type   = IN_GXTYPE   (in, key)
+	    varnum = IN_GXNUMBER (in, key)
+	} else if (axis == INLYAXIS) {
+	    type   = IN_GYTYPE   (in, key)
+	    varnum = IN_GYNUMBER (in, key)
+	} else
+	    call error (0, "INLFIT, in_gkey: Illegal axis")
+end
diff --git a/pkg/xtools/inlfit/ingfit.gx b/pkg/xtools/inlfit/ingfit.gx
new file mode 100644
index 00000000..4dc5b330
--- /dev/null
+++ b/pkg/xtools/inlfit/ingfit.gx
@@ -0,0 +1,204 @@
+include	<error.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include <math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# IN_GFIT -- Fit a function using non-linear least squares. The function
+# can have an arbitrary number of independent variables. This is the main
+# entry point for the interactive part of the INLFIT package.
+
+
+procedure ing_fit$t (in, gp, cursor, gt, nl, x, y, wts, names, npts, nvars,
+	len_name, wtflag, stat)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+char	cursor[ARB]		# GIO cursor input
+pointer	gt			# GTOOLS pointer
+pointer	nl			# NLFIT pointer
+PIXEL	x[ARB]			# independent variables (npts * nvars)
+PIXEL	y[ARB]			# dependent variables
+PIXEL	wts[ARB]		# weigths
+char	names[ARB]		# star ids
+int	npts			# number of points
+int	nvars			# number of variables
+int	len_name		# length of an object name
+int	wtflag			# type of weighting
+int	stat			# Error code (output)
+
+int	i, wcs, key, gkey, newgraph
+int	xtype, xvar, ytype, yvar, xt, xv, yt, yv
+PIXEL	fit
+pointer	sp, cmd, oldwts, help, prompt
+real	wx, wy
+
+int	gt_gcur1(), ing_nearest$t(), in_geti()
+PIXEL	nleval$t()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Allocate and initialize a copy of the weights. A new copy
+	# of the weights is used because it is necessary to have the
+	# original values to restore them back when the user deletes
+	# and undeletes points.
+
+	call salloc (oldwts, npts, TY_PIXEL)
+	call amov$t (wts, Mem$t[oldwts], npts)
+
+	# Allocate space for help page and prompt, and get them.
+	call salloc (help, SZ_LINE, TY_CHAR)
+	call salloc (prompt, SZ_LINE, TY_CHAR)
+	call in_gstr (in, INLHELP, Memc[help], SZ_LINE)
+	call in_gstr (in, INLPROMPT, Memc[prompt], SZ_LINE)
+
+	# Initialize INLFIT flags.
+	call in_puti (in, INLOVERPLOT, NO)
+
+	# Initialize loop control variables. The first action
+	# is to fit the data, in order to have all the fit
+	# parameters set.
+	key = 'f'
+	newgraph = YES
+
+	# Get initial setup for axes.
+	gkey = in_geti (in, INLGKEY)
+	call in_gkey (in, gkey, INLXAXIS, xtype, xvar)
+	call in_gkey (in, gkey, INLYAXIS, xtype, xvar)
+
+	# Loop reading cursor commands.
+	repeat {
+	    switch (key) {
+	    case '?': # Print help text.
+		call gpagefile (gp, Memc[help], Memc[prompt])
+
+	    case ':': # List or set parameters.
+		if (Memc[cmd] == '/')
+	            call gt_colon (Memc[cmd], gp, gt, newgraph)
+		else
+		    call ing_colon$t (in, Memc[cmd], gp, gt, nl, x, y, wts,
+		        names, npts, nvars, len_name, newgraph)
+
+	    case 'c': # Print the positions and useful info on data points.
+
+		i = ing_nearest$t (in, gp, gt, nl, x, y, npts, nvars, wx, wy)
+	    	if (i != 0) {
+		    fit = nleval$t (nl, x[(i-1)*nvars+1], nvars)
+		    call printf (
+		        "%d %s x=%g y=%g func=%g fit=%g, resid=%g\n")
+			call pargi (i)
+			call pargstr (names[(i-1)*len_name+1])
+			call pargr (wx)
+			call pargr (wy)
+			call parg$t (y[i])
+			call parg$t (fit)
+			call parg$t (y[i] - fit)
+		}
+
+	    case 'd': # Delete data points.
+		call ing_delete$t (in, gp, gt, nl, x, y, wts, npts, nvars,
+		    wx, wy)
+
+	    case 'f': # Fit the function.
+
+		# Fit.
+		do i = 1, npts {
+		    if (wts[i] > PIXEL(0.0))
+		        wts[i] = Mem$t[oldwts+i-1]
+		}
+		call in_fit$t (in, nl, x, y, wts, npts, nvars, wtflag, stat)
+
+		newgraph = YES
+
+	    case 'g':	# Set graph axistype types.
+		call ing_defkey (in, nvars, newgraph)
+
+	    case 'h':
+		if (in_geti (in, INLGKEY) != 1) {
+		    call in_puti (in, INLGKEY, 1)
+		    newgraph = YES
+		}
+
+	    case 'i':
+		if (in_geti (in, INLGKEY) != 2) {
+		    call in_puti (in, INLGKEY, 2)
+		    newgraph = YES
+		}
+
+	    case 'j':
+		if (in_geti (in, INLGKEY) != 3) {
+		    call in_puti (in, INLGKEY, 3)
+		    newgraph = YES
+		}
+
+	    case 'k':
+		if (in_geti (in, INLGKEY) != 4) {
+		    call in_puti (in, INLGKEY, 4)
+		    newgraph = YES
+		}
+
+	    case 'l':
+		if (in_geti (in, INLGKEY) != 5) {
+		    call in_puti (in, INLGKEY, 5)
+		    newgraph = YES
+		}
+
+	    case 'o': # Set the overplot flag.
+		call in_puti (in, INLOVERPLOT, YES)
+
+	    case 'r': # Redraw the graph.
+		newgraph = YES
+
+	    case 't': # Toggle overplot fit flag.
+		if (in_geti (in, INLPLOTFIT) == YES)
+		    call in_puti (in, INLPLOTFIT, NO)
+		else
+		    call in_puti (in, INLPLOTFIT, YES)
+		newgraph = YES
+
+	    case 'u': # Undelete data points.
+		call ing_undelete$t (in, gp, gt, nl, x, y, wts, Mem$t[oldwts],
+	     	    npts, nvars, wx, wy)
+
+	    case 'w':  # Window graph.
+		call gt_window (gt, gp, cursor, newgraph)
+
+	    case 'I': # Interrupt.
+		call fatal (0, "Interrupt")
+
+	    default: # Let the user decide on any other keys.
+		call ing_ufit (in, gp, gt, nl, wx, wy, wcs, key, Memc[cmd])
+	    }
+
+	    # Redraw the graph if necessary.
+	    if (newgraph == YES) {
+		gkey = in_geti (in, INLGKEY)
+		call in_gkey (in, gkey, INLXAXIS, xt, xv)
+		if (xt != xtype || xv != xvar) {
+		    call in_gkey (in, gkey, INLXAXIS, xtype, xvar)
+		    call gt_setr (gt, GTXMIN, INDEFR)
+		    call gt_setr (gt, GTXMAX, INDEFR)
+		}
+		call in_gkey (in, gkey, INLYAXIS, yt, yv)
+		if (xt != xtype || xv != xvar) {
+		    call in_gkey (in, gkey, INLYAXIS, ytype, yvar)
+		    call gt_setr (gt, GTYMIN, INDEFR)
+		    call gt_setr (gt, GTYMAX, INDEFR)
+		}
+	    	call ing_graph$t (in, gp, gt, nl, x, y, wts, npts, nvars)
+		newgraph = NO
+	    }
+
+	    if (cursor[1] == EOS)
+		break
+
+	} until (gt_gcur1 (gt, cursor, wx, wy, wcs, key, Memc[cmd],
+	    SZ_LINE) == EOF)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingfitd.x b/pkg/xtools/inlfit/ingfitd.x
new file mode 100644
index 00000000..b31364e0
--- /dev/null
+++ b/pkg/xtools/inlfit/ingfitd.x
@@ -0,0 +1,204 @@
+include	<error.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include <math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# IN_GFIT -- Fit a function using non-linear least squares. The function
+# can have an arbitrary number of independent variables. This is the main
+# entry point for the interactive part of the INLFIT package.
+
+
+procedure ing_fitd (in, gp, cursor, gt, nl, x, y, wts, names, npts, nvars,
+	len_name, wtflag, stat)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+char	cursor[ARB]		# GIO cursor input
+pointer	gt			# GTOOLS pointer
+pointer	nl			# NLFIT pointer
+double	x[ARB]			# independent variables (npts * nvars)
+double	y[ARB]			# dependent variables
+double	wts[ARB]		# weigths
+char	names[ARB]		# star ids
+int	npts			# number of points
+int	nvars			# number of variables
+int	len_name		# length of an object name
+int	wtflag			# type of weighting
+int	stat			# Error code (output)
+
+int	i, wcs, key, gkey, newgraph
+int	xtype, xvar, ytype, yvar, xt, xv, yt, yv
+double	fit
+pointer	sp, cmd, oldwts, help, prompt
+real	wx, wy
+
+int	gt_gcur1(), ing_nearestd(), in_geti()
+double	nlevald()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Allocate and initialize a copy of the weights. A new copy
+	# of the weights is used because it is necessary to have the
+	# original values to restore them back when the user deletes
+	# and undeletes points.
+
+	call salloc (oldwts, npts, TY_DOUBLE)
+	call amovd (wts, Memd[oldwts], npts)
+
+	# Allocate space for help page and prompt, and get them.
+	call salloc (help, SZ_LINE, TY_CHAR)
+	call salloc (prompt, SZ_LINE, TY_CHAR)
+	call in_gstr (in, INLHELP, Memc[help], SZ_LINE)
+	call in_gstr (in, INLPROMPT, Memc[prompt], SZ_LINE)
+
+	# Initialize INLFIT flags.
+	call in_puti (in, INLOVERPLOT, NO)
+
+	# Initialize loop control variables. The first action
+	# is to fit the data, in order to have all the fit
+	# parameters set.
+	key = 'f'
+	newgraph = YES
+
+	# Get initial setup for axes.
+	gkey = in_geti (in, INLGKEY)
+	call in_gkey (in, gkey, INLXAXIS, xtype, xvar)
+	call in_gkey (in, gkey, INLYAXIS, xtype, xvar)
+
+	# Loop reading cursor commands.
+	repeat {
+	    switch (key) {
+	    case '?': # Print help text.
+		call gpagefile (gp, Memc[help], Memc[prompt])
+
+	    case ':': # List or set parameters.
+		if (Memc[cmd] == '/')
+	            call gt_colon (Memc[cmd], gp, gt, newgraph)
+		else
+		    call ing_colond (in, Memc[cmd], gp, gt, nl, x, y, wts,
+		        names, npts, nvars, len_name, newgraph)
+
+	    case 'c': # Print the positions and useful info on data points.
+
+		i = ing_nearestd (in, gp, gt, nl, x, y, npts, nvars, wx, wy)
+	    	if (i != 0) {
+		    fit = nlevald (nl, x[(i-1)*nvars+1], nvars)
+		    call printf (
+		        "%d %s x=%g y=%g func=%g fit=%g, resid=%g\n")
+			call pargi (i)
+			call pargstr (names[(i-1)*len_name+1])
+			call pargr (wx)
+			call pargr (wy)
+			call pargd (y[i])
+			call pargd (fit)
+			call pargd (y[i] - fit)
+		}
+
+	    case 'd': # Delete data points.
+		call ing_deleted (in, gp, gt, nl, x, y, wts, npts, nvars,
+		    wx, wy)
+
+	    case 'f': # Fit the function.
+
+		# Fit.
+		do i = 1, npts {
+		    if (wts[i] > double(0.0))
+		        wts[i] = Memd[oldwts+i-1]
+		}
+		call in_fitd (in, nl, x, y, wts, npts, nvars, wtflag, stat)
+
+		newgraph = YES
+
+	    case 'g':	# Set graph axistype types.
+		call ing_defkey (in, nvars, newgraph)
+
+	    case 'h':
+		if (in_geti (in, INLGKEY) != 1) {
+		    call in_puti (in, INLGKEY, 1)
+		    newgraph = YES
+		}
+
+	    case 'i':
+		if (in_geti (in, INLGKEY) != 2) {
+		    call in_puti (in, INLGKEY, 2)
+		    newgraph = YES
+		}
+
+	    case 'j':
+		if (in_geti (in, INLGKEY) != 3) {
+		    call in_puti (in, INLGKEY, 3)
+		    newgraph = YES
+		}
+
+	    case 'k':
+		if (in_geti (in, INLGKEY) != 4) {
+		    call in_puti (in, INLGKEY, 4)
+		    newgraph = YES
+		}
+
+	    case 'l':
+		if (in_geti (in, INLGKEY) != 5) {
+		    call in_puti (in, INLGKEY, 5)
+		    newgraph = YES
+		}
+
+	    case 'o': # Set the overplot flag.
+		call in_puti (in, INLOVERPLOT, YES)
+
+	    case 'r': # Redraw the graph.
+		newgraph = YES
+
+	    case 't': # Toggle overplot fit flag.
+		if (in_geti (in, INLPLOTFIT) == YES)
+		    call in_puti (in, INLPLOTFIT, NO)
+		else
+		    call in_puti (in, INLPLOTFIT, YES)
+		newgraph = YES
+
+	    case 'u': # Undelete data points.
+		call ing_undeleted (in, gp, gt, nl, x, y, wts, Memd[oldwts],
+	     	    npts, nvars, wx, wy)
+
+	    case 'w':  # Window graph.
+		call gt_window (gt, gp, cursor, newgraph)
+
+	    case 'I': # Interrupt.
+		call fatal (0, "Interrupt")
+
+	    default: # Let the user decide on any other keys.
+		call ing_ufit (in, gp, gt, nl, wx, wy, wcs, key, Memc[cmd])
+	    }
+
+	    # Redraw the graph if necessary.
+	    if (newgraph == YES) {
+		gkey = in_geti (in, INLGKEY)
+		call in_gkey (in, gkey, INLXAXIS, xt, xv)
+		if (xt != xtype || xv != xvar) {
+		    call in_gkey (in, gkey, INLXAXIS, xtype, xvar)
+		    call gt_setr (gt, GTXMIN, INDEFR)
+		    call gt_setr (gt, GTXMAX, INDEFR)
+		}
+		call in_gkey (in, gkey, INLYAXIS, yt, yv)
+		if (xt != xtype || xv != xvar) {
+		    call in_gkey (in, gkey, INLYAXIS, ytype, yvar)
+		    call gt_setr (gt, GTYMIN, INDEFR)
+		    call gt_setr (gt, GTYMAX, INDEFR)
+		}
+	    	call ing_graphd (in, gp, gt, nl, x, y, wts, npts, nvars)
+		newgraph = NO
+	    }
+
+	    if (cursor[1] == EOS)
+		break
+
+	} until (gt_gcur1 (gt, cursor, wx, wy, wcs, key, Memc[cmd],
+	    SZ_LINE) == EOF)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingfitr.x b/pkg/xtools/inlfit/ingfitr.x
new file mode 100644
index 00000000..9e685506
--- /dev/null
+++ b/pkg/xtools/inlfit/ingfitr.x
@@ -0,0 +1,204 @@
+include	<error.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+include <math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# IN_GFIT -- Fit a function using non-linear least squares. The function
+# can have an arbitrary number of independent variables. This is the main
+# entry point for the interactive part of the INLFIT package.
+
+
+procedure ing_fitr (in, gp, cursor, gt, nl, x, y, wts, names, npts, nvars,
+	len_name, wtflag, stat)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+char	cursor[ARB]		# GIO cursor input
+pointer	gt			# GTOOLS pointer
+pointer	nl			# NLFIT pointer
+real	x[ARB]			# independent variables (npts * nvars)
+real	y[ARB]			# dependent variables
+real	wts[ARB]		# weigths
+char	names[ARB]		# star ids
+int	npts			# number of points
+int	nvars			# number of variables
+int	len_name		# length of an object name
+int	wtflag			# type of weighting
+int	stat			# Error code (output)
+
+int	i, wcs, key, gkey, newgraph
+int	xtype, xvar, ytype, yvar, xt, xv, yt, yv
+real	fit
+pointer	sp, cmd, oldwts, help, prompt
+real	wx, wy
+
+int	gt_gcur1(), ing_nearestr(), in_geti()
+real	nlevalr()
+
+begin
+	# Allocate string space.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Allocate and initialize a copy of the weights. A new copy
+	# of the weights is used because it is necessary to have the
+	# original values to restore them back when the user deletes
+	# and undeletes points.
+
+	call salloc (oldwts, npts, TY_REAL)
+	call amovr (wts, Memr[oldwts], npts)
+
+	# Allocate space for help page and prompt, and get them.
+	call salloc (help, SZ_LINE, TY_CHAR)
+	call salloc (prompt, SZ_LINE, TY_CHAR)
+	call in_gstr (in, INLHELP, Memc[help], SZ_LINE)
+	call in_gstr (in, INLPROMPT, Memc[prompt], SZ_LINE)
+
+	# Initialize INLFIT flags.
+	call in_puti (in, INLOVERPLOT, NO)
+
+	# Initialize loop control variables. The first action
+	# is to fit the data, in order to have all the fit
+	# parameters set.
+	key = 'f'
+	newgraph = YES
+
+	# Get initial setup for axes.
+	gkey = in_geti (in, INLGKEY)
+	call in_gkey (in, gkey, INLXAXIS, xtype, xvar)
+	call in_gkey (in, gkey, INLYAXIS, xtype, xvar)
+
+	# Loop reading cursor commands.
+	repeat {
+	    switch (key) {
+	    case '?': # Print help text.
+		call gpagefile (gp, Memc[help], Memc[prompt])
+
+	    case ':': # List or set parameters.
+		if (Memc[cmd] == '/')
+	            call gt_colon (Memc[cmd], gp, gt, newgraph)
+		else
+		    call ing_colonr (in, Memc[cmd], gp, gt, nl, x, y, wts,
+		        names, npts, nvars, len_name, newgraph)
+
+	    case 'c': # Print the positions and useful info on data points.
+
+		i = ing_nearestr (in, gp, gt, nl, x, y, npts, nvars, wx, wy)
+	    	if (i != 0) {
+		    fit = nlevalr (nl, x[(i-1)*nvars+1], nvars)
+		    call printf (
+		        "%d %s x=%g y=%g func=%g fit=%g, resid=%g\n")
+			call pargi (i)
+			call pargstr (names[(i-1)*len_name+1])
+			call pargr (wx)
+			call pargr (wy)
+			call pargr (y[i])
+			call pargr (fit)
+			call pargr (y[i] - fit)
+		}
+
+	    case 'd': # Delete data points.
+		call ing_deleter (in, gp, gt, nl, x, y, wts, npts, nvars,
+		    wx, wy)
+
+	    case 'f': # Fit the function.
+
+		# Fit.
+		do i = 1, npts {
+		    if (wts[i] > real(0.0))
+		        wts[i] = Memr[oldwts+i-1]
+		}
+		call in_fitr (in, nl, x, y, wts, npts, nvars, wtflag, stat)
+
+		newgraph = YES
+
+	    case 'g':	# Set graph axistype types.
+		call ing_defkey (in, nvars, newgraph)
+
+	    case 'h':
+		if (in_geti (in, INLGKEY) != 1) {
+		    call in_puti (in, INLGKEY, 1)
+		    newgraph = YES
+		}
+
+	    case 'i':
+		if (in_geti (in, INLGKEY) != 2) {
+		    call in_puti (in, INLGKEY, 2)
+		    newgraph = YES
+		}
+
+	    case 'j':
+		if (in_geti (in, INLGKEY) != 3) {
+		    call in_puti (in, INLGKEY, 3)
+		    newgraph = YES
+		}
+
+	    case 'k':
+		if (in_geti (in, INLGKEY) != 4) {
+		    call in_puti (in, INLGKEY, 4)
+		    newgraph = YES
+		}
+
+	    case 'l':
+		if (in_geti (in, INLGKEY) != 5) {
+		    call in_puti (in, INLGKEY, 5)
+		    newgraph = YES
+		}
+
+	    case 'o': # Set the overplot flag.
+		call in_puti (in, INLOVERPLOT, YES)
+
+	    case 'r': # Redraw the graph.
+		newgraph = YES
+
+	    case 't': # Toggle overplot fit flag.
+		if (in_geti (in, INLPLOTFIT) == YES)
+		    call in_puti (in, INLPLOTFIT, NO)
+		else
+		    call in_puti (in, INLPLOTFIT, YES)
+		newgraph = YES
+
+	    case 'u': # Undelete data points.
+		call ing_undeleter (in, gp, gt, nl, x, y, wts, Memr[oldwts],
+	     	    npts, nvars, wx, wy)
+
+	    case 'w':  # Window graph.
+		call gt_window (gt, gp, cursor, newgraph)
+
+	    case 'I': # Interrupt.
+		call fatal (0, "Interrupt")
+
+	    default: # Let the user decide on any other keys.
+		call ing_ufit (in, gp, gt, nl, wx, wy, wcs, key, Memc[cmd])
+	    }
+
+	    # Redraw the graph if necessary.
+	    if (newgraph == YES) {
+		gkey = in_geti (in, INLGKEY)
+		call in_gkey (in, gkey, INLXAXIS, xt, xv)
+		if (xt != xtype || xv != xvar) {
+		    call in_gkey (in, gkey, INLXAXIS, xtype, xvar)
+		    call gt_setr (gt, GTXMIN, INDEFR)
+		    call gt_setr (gt, GTXMAX, INDEFR)
+		}
+		call in_gkey (in, gkey, INLYAXIS, yt, yv)
+		if (xt != xtype || xv != xvar) {
+		    call in_gkey (in, gkey, INLYAXIS, ytype, yvar)
+		    call gt_setr (gt, GTYMIN, INDEFR)
+		    call gt_setr (gt, GTYMAX, INDEFR)
+		}
+	    	call ing_graphr (in, gp, gt, nl, x, y, wts, npts, nvars)
+		newgraph = NO
+	    }
+
+	    if (cursor[1] == EOS)
+		break
+
+	} until (gt_gcur1 (gt, cursor, wx, wy, wcs, key, Memc[cmd],
+	    SZ_LINE) == EOF)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/inggetlabel.x b/pkg/xtools/inlfit/inggetlabel.x
new file mode 100644
index 00000000..7693b2a9
--- /dev/null
+++ b/pkg/xtools/inlfit/inggetlabel.x
@@ -0,0 +1,78 @@
+include	<pkg/inlfit.h>
+
+
+# ING_GETLABEL -- Get label and units for a given axis
+
+procedure ing_getlabel (in, xtype, xnum, label, units, maxch)
+
+pointer	in			# INLFIT descriptor
+int	xtype			# axis type
+int	xnum			# axis number
+char	label[ARB]		# label
+char	units[ARB]		# units
+int	maxch			# max chars. in label and units
+
+int	dummy
+pointer	sp, str
+pointer	labels, lunits, vlabels, vunits
+pointer	userlabels, userunits
+
+int	inlstrwrd()
+
+begin
+	# Begin allocation of string space.
+	call smark (sp)
+	call salloc (str, SZ_LINE + 1, TY_CHAR)
+
+	# Branch on axis type.
+	switch (xtype) {
+	case KEY_VARIABLE:
+	    call salloc (labels,  SZ_LINE, TY_CHAR)
+	    call salloc (vlabels, SZ_LINE, TY_CHAR)
+	    call salloc (vunits,  SZ_LINE, TY_CHAR)
+	    call in_gstr (in, INLLABELS,  Memc[labels],  SZ_LINE)
+	    call in_gstr (in, INLVLABELS, Memc[vlabels], SZ_LINE)
+	    call in_gstr (in, INLVUNITS,  Memc[vunits],  SZ_LINE)
+
+	    if (inlstrwrd (xnum, label, maxch, Memc[vlabels]) == 0) {
+		if (inlstrwrd (xtype, Memc[str], SZ_LINE, Memc[labels]) != 0) {
+		    call sprintf (label, maxch, "%s%d")
+		        call pargstr (Memc[str])
+		        call pargi (xnum)
+		}
+	    }
+	    dummy = inlstrwrd (xnum, units, maxch, Memc[vunits])
+
+	case KEY_FUNCTION, KEY_FIT, KEY_RESIDUALS, KEY_RATIO, KEY_NONLINEAR:
+	    call salloc (labels, SZ_LINE, TY_CHAR)
+	    call salloc (lunits, SZ_LINE, TY_CHAR)
+	    call in_gstr (in, INLLABELS, Memc[labels], SZ_LINE)
+	    call in_gstr (in, INLUNITS,  Memc[lunits], SZ_LINE)
+
+	    dummy = inlstrwrd (xtype, label, maxch, Memc[labels])
+	    dummy = inlstrwrd (xtype, units, maxch, Memc[lunits])
+
+	case KEY_UAXIS:
+	    call salloc (labels,     SZ_LINE, TY_CHAR)
+	    call salloc (userlabels, SZ_LINE, TY_CHAR)
+	    call salloc (userunits,  SZ_LINE, TY_CHAR)
+	    call in_gstr (in, INLLABELS, Memc[labels], SZ_LINE)
+	    call in_gstr (in, INLUSERLABELS, Memc[userlabels], SZ_LINE)
+	    call in_gstr (in, INLUSERUNITS,  Memc[userunits],  SZ_LINE)
+
+	    if (inlstrwrd (xnum, label, maxch, Memc[userlabels]) == 0) {
+		if (inlstrwrd (xtype, Memc[str], SZ_LINE, Memc[labels]) != 0) {
+		    call sprintf (label, maxch, "%s%d")
+		        call pargstr (Memc[str])
+		        call pargi (xnum)
+		}
+	    }
+	    dummy = inlstrwrd (xnum, units, maxch, Memc[userunits])
+
+	default:
+	    call error (0, "INLFIT, ing_getlabel: Unknown axis type")
+	}
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/inggraph.gx b/pkg/xtools/inlfit/inggraph.gx
new file mode 100644
index 00000000..0eeb48d8
--- /dev/null
+++ b/pkg/xtools/inlfit/inggraph.gx
@@ -0,0 +1,240 @@
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+define	NGRAPH		100		# Number of fit points to graph
+define	MSIZE		3.0		# mark size for rejected points (real)
+
+
+# ING_GRAPH -- Graph data and fit. First plot the data marking deleted
+# points, then overplot rejected points, and finally overplot the fit.
+
+procedure ing_graph$t (in, gp, gt, nl, x, y, wts, npts, nvars)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointers
+pointer	nl				# NLFIT pointer
+PIXEL	x[ARB]				# Independent variables (npts * nvars)
+PIXEL	y[npts]				# Dependent variables
+PIXEL	wts[npts]			# Weights
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+pointer	xout, yout
+pointer	sp
+
+begin
+	# Alloacate axes data memory.
+	call smark (sp)
+	call salloc (xout, npts, TY_PIXEL)
+	call salloc (yout, npts, TY_PIXEL)
+
+	# Set axes data.
+	call ing_axes$t (in, gt, nl, 1, x, y, Mem$t[xout], npts, nvars)
+	call ing_axes$t (in, gt, nl, 2, x, y, Mem$t[yout], npts, nvars)
+
+	# Set graphic parameters.
+	call ing_params$t (in, nl, x, y, wts, npts, nvars, gt)
+
+	# Plot data and deleted points.
+	call ing_g1$t (in, gp, gt, Mem$t[xout], Mem$t[yout], wts, npts)
+
+	# Overplot rejected points.
+	call ing_g2$t (in, gp, gt, Mem$t[xout], Mem$t[yout], npts)
+
+	# Overplot the fit.
+	call ing_gf$t (in, gp, gt, nl, x, wts, npts, nvars)
+
+	# Free memory
+	call sfree (sp)
+end
+
+
+# ING_G1 - Plot data and deleted points (weight = 0.0).
+
+procedure ing_g1$t (in, gp, gt, x, y, wts, npts)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+PIXEL	x[npts]				# Ordinates
+PIXEL	y[npts]				# Abscissas
+PIXEL	wts[npts]			# Weights
+int	npts				# Number of points
+
+int	i
+pointer	sp, xr, yr, xr1, yr1, gt1
+
+int	in_geti()
+
+begin
+	# Allocate memory.
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (xr1, 2, TY_REAL)
+	call salloc (yr1, 2, TY_REAL)
+
+	# Change type to real for plotting.
+	call acht$tr (x, Memr[xr], npts)
+	call acht$tr (y, Memr[yr], npts)
+
+	# Start new graph if not overplotting.
+	if (in_geti (in, INLOVERPLOT) == NO) {
+	    call gclear (gp)
+	    call gascale (gp, Memr[xr], npts, 1)
+	    call gascale (gp, Memr[yr], npts, 2)
+	    call gt_swind (gp, gt)
+	    call gt_labax (gp, gt)
+	}
+
+	# Initialize auxiliaray GTOOLS descriptor for deleted points.
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "cross")
+
+	# Plot data points marking deleted points with other symbol.
+	Memr[xr1] = Memr[xr]
+	Memr[yr1] = Memr[yr]
+	do i = 1, npts {
+	    if (wts[i] == PIXEL (0.0)) {
+		call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1) 
+	    } else {
+#		Memr[xr1+1] = Memr[xr+i-1]
+#		Memr[yr1+1] = Memr[yr+i-1]
+#		call gt_plot (gp, gt, Memr[xr1], Memr[yr1], 2)
+#		Memr[xr1] = Memr[xr1+1]
+#		Memr[yr1] = Memr[yr1+1]
+
+		call gt_plot (gp, gt, Memr[xr+i-1], Memr[yr+i-1], 1)
+	    }
+	}
+
+	# Reset overplot flag.
+	call in_puti (in, INLOVERPLOT, NO)
+
+	# Free memory and auxiliary GTOOLS descriptor.
+	call sfree (sp)
+	call gt_free (gt1)
+end
+
+
+# ING_G2 - Overplot rejected points.
+
+procedure ing_g2$t (in, gp, gt, x, y, npts)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+PIXEL	x[npts], y[npts]	# Data points
+int	npts			# Number of data points
+
+int	i
+pointer	sp, xr, yr, gt1
+pointer	rejpts
+
+int	in_geti()
+int	in_getp()
+
+begin
+	# Don't plot if there are no rejected points
+	if (in_geti (in, INLNREJPTS) == 0)
+	    return
+
+	# Allocate axes memory.
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+
+	# Change type to real for plotting.
+	call acht$tr (x, Memr[xr], npts)
+	call acht$tr (y, Memr[yr], npts)
+
+	# Initialize auxiliary GTOOLS descriptor
+	# for rejected points.
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "diamond")
+	call gt_setr (gt1, GTXSIZE, MSIZE)
+	call gt_setr (gt1, GTYSIZE, MSIZE)
+
+	# Plot rejected points if there are any.
+	rejpts = in_getp (in, INLREJPTS)
+	do i = 1, npts {
+	    if (Memi[rejpts + i - 1] == YES)
+		call gt_plot (gp, gt1, Memr[xr + i - 1], Memr[yr + i - 1], 1)
+	}
+
+	# Free memory and auxiliary GTOOLS descriptor.
+	call gt_free (gt1)
+	call sfree (sp)
+end
+
+
+# ING_GF - Overplot the fit using dashed lines.
+
+procedure ing_gf$t (in, gp, gt, nl, xin, wts, npts, nvars)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOL pointer
+pointer	nl			# NLFIT pointer
+PIXEL	xin[ARB]		# Independent variables
+PIXEL	wts[npts]		# weights
+int	npts			# Number of points to plot
+int	nvars			# Number of variables
+
+int	i
+pointer	sp, xr, yr, x, y, xo, yo, gt1
+
+int	in_geti()
+
+begin
+	# Don't plot if there is a fit error.
+	if (in_geti (in, INLFITERROR) != DONE ||
+	    in_geti (in, INLPLOTFIT) == NO)
+	    return
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (x,  npts * nvars, TY_PIXEL)
+	call salloc (y,  npts, TY_PIXEL)
+	call salloc (xo, npts, TY_PIXEL)
+	call salloc (yo, npts, TY_PIXEL)
+
+	# Move input data into vector.
+	call amov$t (xin, Mem$t[x], npts * nvars)
+
+	# Calculate vector of fit values.
+	call nlvector$t (nl, Mem$t[x], Mem$t[y], npts, nvars)
+
+	# Set axes data.
+	call ing_axes$t (in, gt, nl, 1, Mem$t[x], Mem$t[y], Mem$t[xo],
+			 npts, nvars)
+	call ing_axes$t (in, gt, nl, 2, Mem$t[x], Mem$t[y], Mem$t[yo],
+			 npts, nvars)
+
+	# Convert to real for plotting.
+	call acht$tr (Mem$t[xo], Memr[xr], npts)
+	call acht$tr (Mem$t[yo], Memr[yr], npts)
+
+	# Initialize auxiliary GTOOLS descriptor, plot the
+	# fit and free the auxiliary descriptor.
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "box")
+	call gt_setr (gt1, GTXSIZE, MSIZE)
+	call gt_setr (gt1, GTXSIZE, MSIZE)
+	do i = 1, npts {
+	    if (wts[i] != PIXEL (0.0))
+		call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1) 
+	}
+	call gt_free (gt1)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/inggraphd.x b/pkg/xtools/inlfit/inggraphd.x
new file mode 100644
index 00000000..245afa63
--- /dev/null
+++ b/pkg/xtools/inlfit/inggraphd.x
@@ -0,0 +1,240 @@
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+define	NGRAPH		100		# Number of fit points to graph
+define	MSIZE		3.0		# mark size for rejected points (real)
+
+
+# ING_GRAPH -- Graph data and fit. First plot the data marking deleted
+# points, then overplot rejected points, and finally overplot the fit.
+
+procedure ing_graphd (in, gp, gt, nl, x, y, wts, npts, nvars)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointers
+pointer	nl				# NLFIT pointer
+double	x[ARB]				# Independent variables (npts * nvars)
+double	y[npts]				# Dependent variables
+double	wts[npts]			# Weights
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+pointer	xout, yout
+pointer	sp
+
+begin
+	# Alloacate axes data memory.
+	call smark (sp)
+	call salloc (xout, npts, TY_DOUBLE)
+	call salloc (yout, npts, TY_DOUBLE)
+
+	# Set axes data.
+	call ing_axesd (in, gt, nl, 1, x, y, Memd[xout], npts, nvars)
+	call ing_axesd (in, gt, nl, 2, x, y, Memd[yout], npts, nvars)
+
+	# Set graphic parameters.
+	call ing_paramsd (in, nl, x, y, wts, npts, nvars, gt)
+
+	# Plot data and deleted points.
+	call ing_g1d (in, gp, gt, Memd[xout], Memd[yout], wts, npts)
+
+	# Overplot rejected points.
+	call ing_g2d (in, gp, gt, Memd[xout], Memd[yout], npts)
+
+	# Overplot the fit.
+	call ing_gfd (in, gp, gt, nl, x, wts, npts, nvars)
+
+	# Free memory
+	call sfree (sp)
+end
+
+
+# ING_G1 - Plot data and deleted points (weight = 0.0).
+
+procedure ing_g1d (in, gp, gt, x, y, wts, npts)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+double	x[npts]				# Ordinates
+double	y[npts]				# Abscissas
+double	wts[npts]			# Weights
+int	npts				# Number of points
+
+int	i
+pointer	sp, xr, yr, xr1, yr1, gt1
+
+int	in_geti()
+
+begin
+	# Allocate memory.
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (xr1, 2, TY_REAL)
+	call salloc (yr1, 2, TY_REAL)
+
+	# Change type to real for plotting.
+	call achtdr (x, Memr[xr], npts)
+	call achtdr (y, Memr[yr], npts)
+
+	# Start new graph if not overplotting.
+	if (in_geti (in, INLOVERPLOT) == NO) {
+	    call gclear (gp)
+	    call gascale (gp, Memr[xr], npts, 1)
+	    call gascale (gp, Memr[yr], npts, 2)
+	    call gt_swind (gp, gt)
+	    call gt_labax (gp, gt)
+	}
+
+	# Initialize auxiliaray GTOOLS descriptor for deleted points.
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "cross")
+
+	# Plot data points marking deleted points with other symbol.
+	Memr[xr1] = Memr[xr]
+	Memr[yr1] = Memr[yr]
+	do i = 1, npts {
+	    if (wts[i] == double (0.0)) {
+		call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1) 
+	    } else {
+#		Memr[xr1+1] = Memr[xr+i-1]
+#		Memr[yr1+1] = Memr[yr+i-1]
+#		call gt_plot (gp, gt, Memr[xr1], Memr[yr1], 2)
+#		Memr[xr1] = Memr[xr1+1]
+#		Memr[yr1] = Memr[yr1+1]
+
+		call gt_plot (gp, gt, Memr[xr+i-1], Memr[yr+i-1], 1)
+	    }
+	}
+
+	# Reset overplot flag.
+	call in_puti (in, INLOVERPLOT, NO)
+
+	# Free memory and auxiliary GTOOLS descriptor.
+	call sfree (sp)
+	call gt_free (gt1)
+end
+
+
+# ING_G2 - Overplot rejected points.
+
+procedure ing_g2d (in, gp, gt, x, y, npts)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+double	x[npts], y[npts]	# Data points
+int	npts			# Number of data points
+
+int	i
+pointer	sp, xr, yr, gt1
+pointer	rejpts
+
+int	in_geti()
+int	in_getp()
+
+begin
+	# Don't plot if there are no rejected points
+	if (in_geti (in, INLNREJPTS) == 0)
+	    return
+
+	# Allocate axes memory.
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+
+	# Change type to real for plotting.
+	call achtdr (x, Memr[xr], npts)
+	call achtdr (y, Memr[yr], npts)
+
+	# Initialize auxiliary GTOOLS descriptor
+	# for rejected points.
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "diamond")
+	call gt_setr (gt1, GTXSIZE, MSIZE)
+	call gt_setr (gt1, GTYSIZE, MSIZE)
+
+	# Plot rejected points if there are any.
+	rejpts = in_getp (in, INLREJPTS)
+	do i = 1, npts {
+	    if (Memi[rejpts + i - 1] == YES)
+		call gt_plot (gp, gt1, Memr[xr + i - 1], Memr[yr + i - 1], 1)
+	}
+
+	# Free memory and auxiliary GTOOLS descriptor.
+	call gt_free (gt1)
+	call sfree (sp)
+end
+
+
+# ING_GF - Overplot the fit using dashed lines.
+
+procedure ing_gfd (in, gp, gt, nl, xin, wts, npts, nvars)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOL pointer
+pointer	nl			# NLFIT pointer
+double	xin[ARB]		# Independent variables
+double	wts[npts]		# weights
+int	npts			# Number of points to plot
+int	nvars			# Number of variables
+
+int	i
+pointer	sp, xr, yr, x, y, xo, yo, gt1
+
+int	in_geti()
+
+begin
+	# Don't plot if there is a fit error.
+	if (in_geti (in, INLFITERROR) != DONE ||
+	    in_geti (in, INLPLOTFIT) == NO)
+	    return
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (x,  npts * nvars, TY_DOUBLE)
+	call salloc (y,  npts, TY_DOUBLE)
+	call salloc (xo, npts, TY_DOUBLE)
+	call salloc (yo, npts, TY_DOUBLE)
+
+	# Move input data into vector.
+	call amovd (xin, Memd[x], npts * nvars)
+
+	# Calculate vector of fit values.
+	call nlvectord (nl, Memd[x], Memd[y], npts, nvars)
+
+	# Set axes data.
+	call ing_axesd (in, gt, nl, 1, Memd[x], Memd[y], Memd[xo],
+			 npts, nvars)
+	call ing_axesd (in, gt, nl, 2, Memd[x], Memd[y], Memd[yo],
+			 npts, nvars)
+
+	# Convert to real for plotting.
+	call achtdr (Memd[xo], Memr[xr], npts)
+	call achtdr (Memd[yo], Memr[yr], npts)
+
+	# Initialize auxiliary GTOOLS descriptor, plot the
+	# fit and free the auxiliary descriptor.
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "box")
+	call gt_setr (gt1, GTXSIZE, MSIZE)
+	call gt_setr (gt1, GTXSIZE, MSIZE)
+	do i = 1, npts {
+	    if (wts[i] != double (0.0))
+		call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1) 
+	}
+	call gt_free (gt1)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/inggraphr.x b/pkg/xtools/inlfit/inggraphr.x
new file mode 100644
index 00000000..6ddac343
--- /dev/null
+++ b/pkg/xtools/inlfit/inggraphr.x
@@ -0,0 +1,240 @@
+include	<gset.h>
+include	<pkg/gtools.h>
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+define	NGRAPH		100		# Number of fit points to graph
+define	MSIZE		3.0		# mark size for rejected points (real)
+
+
+# ING_GRAPH -- Graph data and fit. First plot the data marking deleted
+# points, then overplot rejected points, and finally overplot the fit.
+
+procedure ing_graphr (in, gp, gt, nl, x, y, wts, npts, nvars)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointers
+pointer	nl				# NLFIT pointer
+real	x[ARB]				# Independent variables (npts * nvars)
+real	y[npts]				# Dependent variables
+real	wts[npts]			# Weights
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+pointer	xout, yout
+pointer	sp
+
+begin
+	# Alloacate axes data memory.
+	call smark (sp)
+	call salloc (xout, npts, TY_REAL)
+	call salloc (yout, npts, TY_REAL)
+
+	# Set axes data.
+	call ing_axesr (in, gt, nl, 1, x, y, Memr[xout], npts, nvars)
+	call ing_axesr (in, gt, nl, 2, x, y, Memr[yout], npts, nvars)
+
+	# Set graphic parameters.
+	call ing_paramsr (in, nl, x, y, wts, npts, nvars, gt)
+
+	# Plot data and deleted points.
+	call ing_g1r (in, gp, gt, Memr[xout], Memr[yout], wts, npts)
+
+	# Overplot rejected points.
+	call ing_g2r (in, gp, gt, Memr[xout], Memr[yout], npts)
+
+	# Overplot the fit.
+	call ing_gfr (in, gp, gt, nl, x, wts, npts, nvars)
+
+	# Free memory
+	call sfree (sp)
+end
+
+
+# ING_G1 - Plot data and deleted points (weight = 0.0).
+
+procedure ing_g1r (in, gp, gt, x, y, wts, npts)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+real	x[npts]				# Ordinates
+real	y[npts]				# Abscissas
+real	wts[npts]			# Weights
+int	npts				# Number of points
+
+int	i
+pointer	sp, xr, yr, xr1, yr1, gt1
+
+int	in_geti()
+
+begin
+	# Allocate memory.
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (xr1, 2, TY_REAL)
+	call salloc (yr1, 2, TY_REAL)
+
+	# Change type to real for plotting.
+	call achtrr (x, Memr[xr], npts)
+	call achtrr (y, Memr[yr], npts)
+
+	# Start new graph if not overplotting.
+	if (in_geti (in, INLOVERPLOT) == NO) {
+	    call gclear (gp)
+	    call gascale (gp, Memr[xr], npts, 1)
+	    call gascale (gp, Memr[yr], npts, 2)
+	    call gt_swind (gp, gt)
+	    call gt_labax (gp, gt)
+	}
+
+	# Initialize auxiliaray GTOOLS descriptor for deleted points.
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "cross")
+
+	# Plot data points marking deleted points with other symbol.
+	Memr[xr1] = Memr[xr]
+	Memr[yr1] = Memr[yr]
+	do i = 1, npts {
+	    if (wts[i] == real (0.0)) {
+		call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1) 
+	    } else {
+#		Memr[xr1+1] = Memr[xr+i-1]
+#		Memr[yr1+1] = Memr[yr+i-1]
+#		call gt_plot (gp, gt, Memr[xr1], Memr[yr1], 2)
+#		Memr[xr1] = Memr[xr1+1]
+#		Memr[yr1] = Memr[yr1+1]
+
+		call gt_plot (gp, gt, Memr[xr+i-1], Memr[yr+i-1], 1)
+	    }
+	}
+
+	# Reset overplot flag.
+	call in_puti (in, INLOVERPLOT, NO)
+
+	# Free memory and auxiliary GTOOLS descriptor.
+	call sfree (sp)
+	call gt_free (gt1)
+end
+
+
+# ING_G2 - Overplot rejected points.
+
+procedure ing_g2r (in, gp, gt, x, y, npts)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+real	x[npts], y[npts]	# Data points
+int	npts			# Number of data points
+
+int	i
+pointer	sp, xr, yr, gt1
+pointer	rejpts
+
+int	in_geti()
+int	in_getp()
+
+begin
+	# Don't plot if there are no rejected points
+	if (in_geti (in, INLNREJPTS) == 0)
+	    return
+
+	# Allocate axes memory.
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+
+	# Change type to real for plotting.
+	call achtrr (x, Memr[xr], npts)
+	call achtrr (y, Memr[yr], npts)
+
+	# Initialize auxiliary GTOOLS descriptor
+	# for rejected points.
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "diamond")
+	call gt_setr (gt1, GTXSIZE, MSIZE)
+	call gt_setr (gt1, GTYSIZE, MSIZE)
+
+	# Plot rejected points if there are any.
+	rejpts = in_getp (in, INLREJPTS)
+	do i = 1, npts {
+	    if (Memi[rejpts + i - 1] == YES)
+		call gt_plot (gp, gt1, Memr[xr + i - 1], Memr[yr + i - 1], 1)
+	}
+
+	# Free memory and auxiliary GTOOLS descriptor.
+	call gt_free (gt1)
+	call sfree (sp)
+end
+
+
+# ING_GF - Overplot the fit using dashed lines.
+
+procedure ing_gfr (in, gp, gt, nl, xin, wts, npts, nvars)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOL pointer
+pointer	nl			# NLFIT pointer
+real	xin[ARB]		# Independent variables
+real	wts[npts]		# weights
+int	npts			# Number of points to plot
+int	nvars			# Number of variables
+
+int	i
+pointer	sp, xr, yr, x, y, xo, yo, gt1
+
+int	in_geti()
+
+begin
+	# Don't plot if there is a fit error.
+	if (in_geti (in, INLFITERROR) != DONE ||
+	    in_geti (in, INLPLOTFIT) == NO)
+	    return
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (xr, npts, TY_REAL)
+	call salloc (yr, npts, TY_REAL)
+	call salloc (x,  npts * nvars, TY_REAL)
+	call salloc (y,  npts, TY_REAL)
+	call salloc (xo, npts, TY_REAL)
+	call salloc (yo, npts, TY_REAL)
+
+	# Move input data into vector.
+	call amovr (xin, Memr[x], npts * nvars)
+
+	# Calculate vector of fit values.
+	call nlvectorr (nl, Memr[x], Memr[y], npts, nvars)
+
+	# Set axes data.
+	call ing_axesr (in, gt, nl, 1, Memr[x], Memr[y], Memr[xo],
+			 npts, nvars)
+	call ing_axesr (in, gt, nl, 2, Memr[x], Memr[y], Memr[yo],
+			 npts, nvars)
+
+	# Convert to real for plotting.
+	call achtrr (Memr[xo], Memr[xr], npts)
+	call achtrr (Memr[yo], Memr[yr], npts)
+
+	# Initialize auxiliary GTOOLS descriptor, plot the
+	# fit and free the auxiliary descriptor.
+	call gt_copy (gt, gt1)
+	call gt_sets (gt1, GTTYPE, "mark")
+	call gt_sets (gt1, GTMARK, "box")
+	call gt_setr (gt1, GTXSIZE, MSIZE)
+	call gt_setr (gt1, GTXSIZE, MSIZE)
+	do i = 1, npts {
+	    if (wts[i] != real (0.0))
+		call gt_plot (gp, gt1, Memr[xr+i-1], Memr[yr+i-1], 1) 
+	}
+	call gt_free (gt1)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingnearest.gx b/pkg/xtools/inlfit/ingnearest.gx
new file mode 100644
index 00000000..1d208678
--- /dev/null
+++ b/pkg/xtools/inlfit/ingnearest.gx
@@ -0,0 +1,81 @@
+include	<mach.h>
+include	<pkg/gtools.h>
+
+
+# ING_NEAREST -- Find the nearest point to the cursor and return the index.
+# The cursor is moved to the nearest point selected.
+
+int procedure ing_nearest$t (in, gp, gt, nl, x, y, npts, nvars, wx, wy)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+PIXEL	x[ARB]				# Independent variables (npts * nvars)
+PIXEL	y[npts]				# Dependent variables
+int	npts				# Number of points
+int	nvars				# Number of variables
+real	wx, wy				# Cursor position
+
+int	pt
+pointer	sp, xout, yout
+
+int	ing_n$t(), gt_geti()
+
+begin
+	# Allocate memory for axes data
+	call smark (sp)
+	call salloc (xout, npts, TY_PIXEL)
+	call salloc (yout, npts, TY_PIXEL)
+
+	# Set axes data
+	call ing_axes$t (in, gt, nl, 1, x, y, Mem$t[xout], npts, nvars)
+	call ing_axes$t (in, gt, nl, 2, x, y, Mem$t[yout], npts, nvars)
+
+	# Check for transposed axes
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    pt = ing_n$t (gp, Mem$t[xout], Mem$t[yout], npts, wx, wy)
+	else
+	    pt = ing_n$t (gp, Mem$t[yout], Mem$t[xout], npts, wy, wx)
+	call sfree (sp)
+	
+	# Return index
+	return (pt)
+end
+
+
+# ING_N -- Find position and move the cursor.
+
+int procedure ing_n$t (gp, x, y, npts, wx, wy)
+
+pointer	gp					# GIO pointer
+PIXEL	x[npts], y[npts]			# Data points
+int	npts					# Number of points
+real	wx, wy					# Cursor position
+
+int	i, j
+real	xc, yc, x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx, wy, xc, yc, 1, 0)
+
+	# Search for nearest point.
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+	    r2 = (x0 - xc) ** 2 + (y0 - yc) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Move the cursor to the selected point and return the index.
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    wx = x[j]
+	    wy = y[j]
+	}
+	return (j)
+end
diff --git a/pkg/xtools/inlfit/ingnearestd.x b/pkg/xtools/inlfit/ingnearestd.x
new file mode 100644
index 00000000..d27f7a6b
--- /dev/null
+++ b/pkg/xtools/inlfit/ingnearestd.x
@@ -0,0 +1,81 @@
+include	<mach.h>
+include	<pkg/gtools.h>
+
+
+# ING_NEAREST -- Find the nearest point to the cursor and return the index.
+# The cursor is moved to the nearest point selected.
+
+int procedure ing_nearestd (in, gp, gt, nl, x, y, npts, nvars, wx, wy)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+double	x[ARB]				# Independent variables (npts * nvars)
+double	y[npts]				# Dependent variables
+int	npts				# Number of points
+int	nvars				# Number of variables
+real	wx, wy				# Cursor position
+
+int	pt
+pointer	sp, xout, yout
+
+int	ing_nd(), gt_geti()
+
+begin
+	# Allocate memory for axes data
+	call smark (sp)
+	call salloc (xout, npts, TY_DOUBLE)
+	call salloc (yout, npts, TY_DOUBLE)
+
+	# Set axes data
+	call ing_axesd (in, gt, nl, 1, x, y, Memd[xout], npts, nvars)
+	call ing_axesd (in, gt, nl, 2, x, y, Memd[yout], npts, nvars)
+
+	# Check for transposed axes
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    pt = ing_nd (gp, Memd[xout], Memd[yout], npts, wx, wy)
+	else
+	    pt = ing_nd (gp, Memd[yout], Memd[xout], npts, wy, wx)
+	call sfree (sp)
+	
+	# Return index
+	return (pt)
+end
+
+
+# ING_N -- Find position and move the cursor.
+
+int procedure ing_nd (gp, x, y, npts, wx, wy)
+
+pointer	gp					# GIO pointer
+double	x[npts], y[npts]			# Data points
+int	npts					# Number of points
+real	wx, wy					# Cursor position
+
+int	i, j
+real	xc, yc, x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx, wy, xc, yc, 1, 0)
+
+	# Search for nearest point.
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+	    r2 = (x0 - xc) ** 2 + (y0 - yc) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Move the cursor to the selected point and return the index.
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    wx = x[j]
+	    wy = y[j]
+	}
+	return (j)
+end
diff --git a/pkg/xtools/inlfit/ingnearestr.x b/pkg/xtools/inlfit/ingnearestr.x
new file mode 100644
index 00000000..2ac7de51
--- /dev/null
+++ b/pkg/xtools/inlfit/ingnearestr.x
@@ -0,0 +1,81 @@
+include	<mach.h>
+include	<pkg/gtools.h>
+
+
+# ING_NEAREST -- Find the nearest point to the cursor and return the index.
+# The cursor is moved to the nearest point selected.
+
+int procedure ing_nearestr (in, gp, gt, nl, x, y, npts, nvars, wx, wy)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+real	x[ARB]				# Independent variables (npts * nvars)
+real	y[npts]				# Dependent variables
+int	npts				# Number of points
+int	nvars				# Number of variables
+real	wx, wy				# Cursor position
+
+int	pt
+pointer	sp, xout, yout
+
+int	ing_nr(), gt_geti()
+
+begin
+	# Allocate memory for axes data
+	call smark (sp)
+	call salloc (xout, npts, TY_REAL)
+	call salloc (yout, npts, TY_REAL)
+
+	# Set axes data
+	call ing_axesr (in, gt, nl, 1, x, y, Memr[xout], npts, nvars)
+	call ing_axesr (in, gt, nl, 2, x, y, Memr[yout], npts, nvars)
+
+	# Check for transposed axes
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    pt = ing_nr (gp, Memr[xout], Memr[yout], npts, wx, wy)
+	else
+	    pt = ing_nr (gp, Memr[yout], Memr[xout], npts, wy, wx)
+	call sfree (sp)
+	
+	# Return index
+	return (pt)
+end
+
+
+# ING_N -- Find position and move the cursor.
+
+int procedure ing_nr (gp, x, y, npts, wx, wy)
+
+pointer	gp					# GIO pointer
+real	x[npts], y[npts]			# Data points
+int	npts					# Number of points
+real	wx, wy					# Cursor position
+
+int	i, j
+real	xc, yc, x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx, wy, xc, yc, 1, 0)
+
+	# Search for nearest point.
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+	    r2 = (x0 - xc) ** 2 + (y0 - yc) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Move the cursor to the selected point and return the index.
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    wx = x[j]
+	    wy = y[j]
+	}
+	return (j)
+end
diff --git a/pkg/xtools/inlfit/ingparams.gx b/pkg/xtools/inlfit/ingparams.gx
new file mode 100644
index 00000000..e250d681
--- /dev/null
+++ b/pkg/xtools/inlfit/ingparams.gx
@@ -0,0 +1,120 @@
+include	<pkg/gtools.h>
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# ING_PARAMS -- Set parameter string.
+
+procedure ing_params$t (in, nl, x, y, wts, npts, nvars, gt)
+
+pointer	in		# INLFIT pointer
+pointer	nl		# NLFIT pointer
+PIXEL	x[ARB]		# Ordinates (npts * nvars)
+PIXEL	y[ARB]		# Abscissas
+PIXEL	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	nvars		# Number of variables
+pointer	gt		# GTOOLS pointer
+
+int	i, rejected, deleted, length
+int	len3, len4
+PIXEL	rms
+pointer	sp, fit, wts1, rejpts
+pointer	str1, str2, str3, str4, line
+
+int	strlen()
+int	nlstati()
+int	inlstrwrd()
+int	in_geti()
+PIXEL	nlstat$t()
+PIXEL	in_rms$t()
+PIXEL	in_get$t()
+pointer	in_getp()
+
+begin
+	# Allocate memory
+	call smark (sp)
+	call salloc (fit, npts, TY_PIXEL)
+	call salloc (wts1, npts, TY_PIXEL)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+	call salloc (str3, SZ_LINE, TY_CHAR)
+	call salloc (str4, SZ_LINE, TY_CHAR)
+
+	# Mark rejected points as deleted for rms comnputation,
+	# and count number of deleted points.
+	call amov$t (wts, Mem$t[wts1], npts)
+	rejected = in_geti (in, INLNREJPTS)
+	rejpts   = in_getp (in, INLREJPTS)
+	if (rejected > 0) {
+	    do i = 1, npts {
+	        if (Memi[rejpts+i-1] == YES)
+		    Mem$t[wts1+i-1] = PIXEL (0.0)
+	    }
+	}
+	deleted = 0
+	do i = 1, npts {
+	    if (wts[i] == PIXEL (0.0))
+	        deleted = deleted + 1
+	}
+
+	# Set the fit and compute the RMS error.
+	if (in_geti (in, INLFITERROR) == DONE) {
+	    call nlvector$t (nl, x, Mem$t[fit], npts, nvars)
+	    rms = in_rms$t (y, Mem$t[fit], Mem$t[wts1], npts)
+	} else
+	    rms = INDEF
+
+	# Build interactive graphics and NLFIT parameter strings
+	call sprintf (Memc[str1], SZ_LINE,
+	    #"low_rej=%7.4g, high_rej=%7.4g, nreject=%d, grow=%7.4g")
+	    "low_rej=%.4g, high_rej=%.4g, nreject=%d, grow=%.4g")
+	    call parg$t (in_get$t (in, INLLOW))
+	    call parg$t (in_get$t (in, INLHIGH))
+	    call pargi  (in_geti  (in, INLNREJECT))
+	    call parg$t (in_get$t (in, INLGROW))
+	call sprintf (Memc[str2], SZ_LINE,
+	    #"total=%d, rejected=%d, deleted=%d, RMS=%7.4g")
+	    "total=%d, rejected=%d, deleted=%d, RMS=%.4g")
+	    call pargi (npts)
+	    call pargi (rejected)
+	    call pargi (deleted)
+	    call parg$t (rms)
+	call sprintf (Memc[str3], SZ_LINE,
+	    #"tolerance=%7.4g, maxiter=%d, iterations=%d")
+	    "tolerance=%.4g, maxiter=%d, iterations=%d")
+	    call parg$t (nlstat$t (nl, NLTOL))
+	    call pargi (nlstati (nl, NLITMAX))
+	    call pargi (nlstati (nl, NLITER))
+
+	# Set the output parameter line.
+	length = strlen (Memc[str1]) + strlen (Memc[str2]) +
+	    strlen (Memc[str3]) + 3
+	call salloc (line, length + 1, TY_CHAR)
+	call sprintf (Memc[line], length, "%s\n%s\n%s")
+	    call pargstr (Memc[str1])
+	    call pargstr (Memc[str2])
+	    call pargstr (Memc[str3])
+	call gt_sets (gt, GTPARAMS, Memc[line])
+
+	# Get the error and function label strings.
+	call nlerrmsg (in_geti (in, INLFITERROR), Memc[str1], SZ_LINE)
+	call in_gstr (in, INLFLABELS, Memc[str2], SZ_LINE)
+
+	# Set the output title line.
+	len3 = inlstrwrd (1, Memc[str3], SZ_LINE, Memc[str2])
+	len4 = inlstrwrd (2, Memc[str4], SZ_LINE, Memc[str2])
+	if (len3 != 0 && len4 != 0) {
+	    call sprintf (Memc[line], length, "%s = %s\n%s")
+		call pargstr (Memc[str3])
+		call pargstr (Memc[str4])
+		call pargstr (Memc[str1])
+	} else {
+	    call sprintf (Memc[line], length, "%s")
+		call pargstr (Memc[str2])
+	}
+	call gt_sets (gt, GTTITLE, Memc[line])
+
+	# Free allocated memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingparamsd.x b/pkg/xtools/inlfit/ingparamsd.x
new file mode 100644
index 00000000..eceea41c
--- /dev/null
+++ b/pkg/xtools/inlfit/ingparamsd.x
@@ -0,0 +1,120 @@
+include	<pkg/gtools.h>
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# ING_PARAMS -- Set parameter string.
+
+procedure ing_paramsd (in, nl, x, y, wts, npts, nvars, gt)
+
+pointer	in		# INLFIT pointer
+pointer	nl		# NLFIT pointer
+double	x[ARB]		# Ordinates (npts * nvars)
+double	y[ARB]		# Abscissas
+double	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	nvars		# Number of variables
+pointer	gt		# GTOOLS pointer
+
+int	i, rejected, deleted, length
+int	len3, len4
+double	rms
+pointer	sp, fit, wts1, rejpts
+pointer	str1, str2, str3, str4, line
+
+int	strlen()
+int	nlstati()
+int	inlstrwrd()
+int	in_geti()
+double	nlstatd()
+double	in_rmsd()
+double	in_getd()
+pointer	in_getp()
+
+begin
+	# Allocate memory
+	call smark (sp)
+	call salloc (fit, npts, TY_DOUBLE)
+	call salloc (wts1, npts, TY_DOUBLE)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+	call salloc (str3, SZ_LINE, TY_CHAR)
+	call salloc (str4, SZ_LINE, TY_CHAR)
+
+	# Mark rejected points as deleted for rms comnputation,
+	# and count number of deleted points.
+	call amovd (wts, Memd[wts1], npts)
+	rejected = in_geti (in, INLNREJPTS)
+	rejpts   = in_getp (in, INLREJPTS)
+	if (rejected > 0) {
+	    do i = 1, npts {
+	        if (Memi[rejpts+i-1] == YES)
+		    Memd[wts1+i-1] = double (0.0)
+	    }
+	}
+	deleted = 0
+	do i = 1, npts {
+	    if (wts[i] == double (0.0))
+	        deleted = deleted + 1
+	}
+
+	# Set the fit and compute the RMS error.
+	if (in_geti (in, INLFITERROR) == DONE) {
+	    call nlvectord (nl, x, Memd[fit], npts, nvars)
+	    rms = in_rmsd (y, Memd[fit], Memd[wts1], npts)
+	} else
+	    rms = INDEFD
+
+	# Build interactive graphics and NLFIT parameter strings
+	call sprintf (Memc[str1], SZ_LINE,
+	    #"low_rej=%7.4g, high_rej=%7.4g, nreject=%d, grow=%7.4g")
+	    "low_rej=%.4g, high_rej=%.4g, nreject=%d, grow=%.4g")
+	    call pargd (in_getd (in, INLLOW))
+	    call pargd (in_getd (in, INLHIGH))
+	    call pargi  (in_geti  (in, INLNREJECT))
+	    call pargd (in_getd (in, INLGROW))
+	call sprintf (Memc[str2], SZ_LINE,
+	    #"total=%d, rejected=%d, deleted=%d, RMS=%7.4g")
+	    "total=%d, rejected=%d, deleted=%d, RMS=%.4g")
+	    call pargi (npts)
+	    call pargi (rejected)
+	    call pargi (deleted)
+	    call pargd (rms)
+	call sprintf (Memc[str3], SZ_LINE,
+	    #"tolerance=%7.4g, maxiter=%d, iterations=%d")
+	    "tolerance=%.4g, maxiter=%d, iterations=%d")
+	    call pargd (nlstatd (nl, NLTOL))
+	    call pargi (nlstati (nl, NLITMAX))
+	    call pargi (nlstati (nl, NLITER))
+
+	# Set the output parameter line.
+	length = strlen (Memc[str1]) + strlen (Memc[str2]) +
+	    strlen (Memc[str3]) + 3
+	call salloc (line, length + 1, TY_CHAR)
+	call sprintf (Memc[line], length, "%s\n%s\n%s")
+	    call pargstr (Memc[str1])
+	    call pargstr (Memc[str2])
+	    call pargstr (Memc[str3])
+	call gt_sets (gt, GTPARAMS, Memc[line])
+
+	# Get the error and function label strings.
+	call nlerrmsg (in_geti (in, INLFITERROR), Memc[str1], SZ_LINE)
+	call in_gstr (in, INLFLABELS, Memc[str2], SZ_LINE)
+
+	# Set the output title line.
+	len3 = inlstrwrd (1, Memc[str3], SZ_LINE, Memc[str2])
+	len4 = inlstrwrd (2, Memc[str4], SZ_LINE, Memc[str2])
+	if (len3 != 0 && len4 != 0) {
+	    call sprintf (Memc[line], length, "%s = %s\n%s")
+		call pargstr (Memc[str3])
+		call pargstr (Memc[str4])
+		call pargstr (Memc[str1])
+	} else {
+	    call sprintf (Memc[line], length, "%s")
+		call pargstr (Memc[str2])
+	}
+	call gt_sets (gt, GTTITLE, Memc[line])
+
+	# Free allocated memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingparamsr.x b/pkg/xtools/inlfit/ingparamsr.x
new file mode 100644
index 00000000..53f9ffc9
--- /dev/null
+++ b/pkg/xtools/inlfit/ingparamsr.x
@@ -0,0 +1,120 @@
+include	<pkg/gtools.h>
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# ING_PARAMS -- Set parameter string.
+
+procedure ing_paramsr (in, nl, x, y, wts, npts, nvars, gt)
+
+pointer	in		# INLFIT pointer
+pointer	nl		# NLFIT pointer
+real	x[ARB]		# Ordinates (npts * nvars)
+real	y[ARB]		# Abscissas
+real	wts[ARB]	# Weights
+int	npts		# Number of data points
+int	nvars		# Number of variables
+pointer	gt		# GTOOLS pointer
+
+int	i, rejected, deleted, length
+int	len3, len4
+real	rms
+pointer	sp, fit, wts1, rejpts
+pointer	str1, str2, str3, str4, line
+
+int	strlen()
+int	nlstati()
+int	inlstrwrd()
+int	in_geti()
+real	nlstatr()
+real	in_rmsr()
+real	in_getr()
+pointer	in_getp()
+
+begin
+	# Allocate memory
+	call smark (sp)
+	call salloc (fit, npts, TY_REAL)
+	call salloc (wts1, npts, TY_REAL)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+	call salloc (str3, SZ_LINE, TY_CHAR)
+	call salloc (str4, SZ_LINE, TY_CHAR)
+
+	# Mark rejected points as deleted for rms comnputation,
+	# and count number of deleted points.
+	call amovr (wts, Memr[wts1], npts)
+	rejected = in_geti (in, INLNREJPTS)
+	rejpts   = in_getp (in, INLREJPTS)
+	if (rejected > 0) {
+	    do i = 1, npts {
+	        if (Memi[rejpts+i-1] == YES)
+		    Memr[wts1+i-1] = real (0.0)
+	    }
+	}
+	deleted = 0
+	do i = 1, npts {
+	    if (wts[i] == real (0.0))
+	        deleted = deleted + 1
+	}
+
+	# Set the fit and compute the RMS error.
+	if (in_geti (in, INLFITERROR) == DONE) {
+	    call nlvectorr (nl, x, Memr[fit], npts, nvars)
+	    rms = in_rmsr (y, Memr[fit], Memr[wts1], npts)
+	} else
+	    rms = INDEFR
+
+	# Build interactive graphics and NLFIT parameter strings
+	call sprintf (Memc[str1], SZ_LINE,
+	    #"low_rej=%7.4g, high_rej=%7.4g, nreject=%d, grow=%7.4g")
+	    "low_rej=%.4g, high_rej=%.4g, nreject=%d, grow=%.4g")
+	    call pargr (in_getr (in, INLLOW))
+	    call pargr (in_getr (in, INLHIGH))
+	    call pargi  (in_geti  (in, INLNREJECT))
+	    call pargr (in_getr (in, INLGROW))
+	call sprintf (Memc[str2], SZ_LINE,
+	    #"total=%d, rejected=%d, deleted=%d, RMS=%7.4g")
+	    "total=%d, rejected=%d, deleted=%d, RMS=%.4g")
+	    call pargi (npts)
+	    call pargi (rejected)
+	    call pargi (deleted)
+	    call pargr (rms)
+	call sprintf (Memc[str3], SZ_LINE,
+	    #"tolerance=%7.4g, maxiter=%d, iterations=%d")
+	    "tolerance=%.4g, maxiter=%d, iterations=%d")
+	    call pargr (nlstatr (nl, NLTOL))
+	    call pargi (nlstati (nl, NLITMAX))
+	    call pargi (nlstati (nl, NLITER))
+
+	# Set the output parameter line.
+	length = strlen (Memc[str1]) + strlen (Memc[str2]) +
+	    strlen (Memc[str3]) + 3
+	call salloc (line, length + 1, TY_CHAR)
+	call sprintf (Memc[line], length, "%s\n%s\n%s")
+	    call pargstr (Memc[str1])
+	    call pargstr (Memc[str2])
+	    call pargstr (Memc[str3])
+	call gt_sets (gt, GTPARAMS, Memc[line])
+
+	# Get the error and function label strings.
+	call nlerrmsg (in_geti (in, INLFITERROR), Memc[str1], SZ_LINE)
+	call in_gstr (in, INLFLABELS, Memc[str2], SZ_LINE)
+
+	# Set the output title line.
+	len3 = inlstrwrd (1, Memc[str3], SZ_LINE, Memc[str2])
+	len4 = inlstrwrd (2, Memc[str4], SZ_LINE, Memc[str2])
+	if (len3 != 0 && len4 != 0) {
+	    call sprintf (Memc[line], length, "%s = %s\n%s")
+		call pargstr (Memc[str3])
+		call pargstr (Memc[str4])
+		call pargstr (Memc[str1])
+	} else {
+	    call sprintf (Memc[line], length, "%s")
+		call pargstr (Memc[str2])
+	}
+	call gt_sets (gt, GTTITLE, Memc[line])
+
+	# Free allocated memory.
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingresults.gx b/pkg/xtools/inlfit/ingresults.gx
new file mode 100644
index 00000000..6582bd35
--- /dev/null
+++ b/pkg/xtools/inlfit/ingresults.gx
@@ -0,0 +1,85 @@
+include <pkg/inlfit.h>
+
+# ING_RESULTS -- Print the results of the fit.
+
+procedure ing_results$t (in, file, nl, x, y, wts, names, npts, nvars, len_name)
+
+pointer	in			# INLFIT pointer
+char	file[ARB]		# Output file name
+pointer	nl			# NLFIT pointer
+PIXEL	x[ARB]			# Ordinates (npts * nvars)
+PIXEL	y[ARB]			# Abscissas
+PIXEL	wts[ARB]		# Weights
+char	names[ARB]		# Object names
+int	npts		        # Number of data points
+int	nvars		        # Number of variables
+int	len_name		# Length of a name
+
+int	i, fd, rejected
+pointer	sp, fit, wts1, rejpts
+int	open(), in_geti()
+pointer	in_getp()
+errchk	open
+
+begin
+	# Open the output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Test the number of points.
+	if (npts == 0) {
+	    call eprintf ("Incomplete output - no data points for fit\n")
+	    return
+	}
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (fit, npts, TY_PIXEL)
+	call salloc (wts1, npts, TY_PIXEL)
+
+	# Evaluate the fit.
+	call nlvector$t (nl, x, Mem$t[fit], npts, nvars)
+
+	# Assign a zero weight to the rejected points.
+	rejected = in_geti (in, INLNREJPTS)
+	rejpts = in_getp (in, INLREJPTS)
+	call amov$t (wts, Mem$t[wts1], npts)
+	if (rejected > 0) {
+	    do i = 1, npts {
+		if (Memi[rejpts+i-1] == YES)
+		    Mem$t[wts1+i-1] = PIXEL (0.0)
+	    }
+	}
+
+	# Print the title.
+	call fprintf (fd, "\n#%14.14s %14.14s %14.14s")
+	    call pargstr ("objectid")
+	    call pargstr ("function")
+	    call pargstr ("fit")
+	call fprintf (fd, " %14.14s %14.14s\n")
+	    call pargstr ("residuals")
+	    call pargstr ("sigma")
+	
+	# List function value, fit value, residual and error values.
+	do i = 1, npts {
+	    call fprintf (fd, " %14.14s %14.7g %14.7g %14.7g %14.7g\n")
+	    call pargstr (names[(i-1)*len_name+1])
+	    if (Mem$t[wts1+i-1] <= 0.0) {
+		call parg$t (INDEF)
+		call parg$t (INDEF)
+		call parg$t (INDEF)
+		call parg$t (INDEF)
+	    } else {
+		call parg$t (y[i])
+		call parg$t (Mem$t[fit+i-1])
+		call parg$t (y[i] - Mem$t[fit+i-1])
+		call parg$t (sqrt (PIXEL (1.0) / Mem$t[wts1+i-1]))
+	    }
+	}
+	call fprintf (fd, "\n")
+
+	# Free allocated memory, and close output file.
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingresultsd.x b/pkg/xtools/inlfit/ingresultsd.x
new file mode 100644
index 00000000..c19d8166
--- /dev/null
+++ b/pkg/xtools/inlfit/ingresultsd.x
@@ -0,0 +1,85 @@
+include <pkg/inlfit.h>
+
+# ING_RESULTS -- Print the results of the fit.
+
+procedure ing_resultsd (in, file, nl, x, y, wts, names, npts, nvars, len_name)
+
+pointer	in			# INLFIT pointer
+char	file[ARB]		# Output file name
+pointer	nl			# NLFIT pointer
+double	x[ARB]			# Ordinates (npts * nvars)
+double	y[ARB]			# Abscissas
+double	wts[ARB]		# Weights
+char	names[ARB]		# Object names
+int	npts		        # Number of data points
+int	nvars		        # Number of variables
+int	len_name		# Length of a name
+
+int	i, fd, rejected
+pointer	sp, fit, wts1, rejpts
+int	open(), in_geti()
+pointer	in_getp()
+errchk	open
+
+begin
+	# Open the output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Test the number of points.
+	if (npts == 0) {
+	    call eprintf ("Incomplete output - no data points for fit\n")
+	    return
+	}
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (fit, npts, TY_DOUBLE)
+	call salloc (wts1, npts, TY_DOUBLE)
+
+	# Evaluate the fit.
+	call nlvectord (nl, x, Memd[fit], npts, nvars)
+
+	# Assign a zero weight to the rejected points.
+	rejected = in_geti (in, INLNREJPTS)
+	rejpts = in_getp (in, INLREJPTS)
+	call amovd (wts, Memd[wts1], npts)
+	if (rejected > 0) {
+	    do i = 1, npts {
+		if (Memi[rejpts+i-1] == YES)
+		    Memd[wts1+i-1] = double (0.0)
+	    }
+	}
+
+	# Print the title.
+	call fprintf (fd, "\n#%14.14s %14.14s %14.14s")
+	    call pargstr ("objectid")
+	    call pargstr ("function")
+	    call pargstr ("fit")
+	call fprintf (fd, " %14.14s %14.14s\n")
+	    call pargstr ("residuals")
+	    call pargstr ("sigma")
+	
+	# List function value, fit value, residual and error values.
+	do i = 1, npts {
+	    call fprintf (fd, " %14.14s %14.7g %14.7g %14.7g %14.7g\n")
+	    call pargstr (names[(i-1)*len_name+1])
+	    if (Memd[wts1+i-1] <= 0.0) {
+		call pargd (INDEFD)
+		call pargd (INDEFD)
+		call pargd (INDEFD)
+		call pargd (INDEFD)
+	    } else {
+		call pargd (y[i])
+		call pargd (Memd[fit+i-1])
+		call pargd (y[i] - Memd[fit+i-1])
+		call pargd (sqrt (double (1.0) / Memd[wts1+i-1]))
+	    }
+	}
+	call fprintf (fd, "\n")
+
+	# Free allocated memory, and close output file.
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingresultsr.x b/pkg/xtools/inlfit/ingresultsr.x
new file mode 100644
index 00000000..d6e6f43c
--- /dev/null
+++ b/pkg/xtools/inlfit/ingresultsr.x
@@ -0,0 +1,85 @@
+include <pkg/inlfit.h>
+
+# ING_RESULTS -- Print the results of the fit.
+
+procedure ing_resultsr (in, file, nl, x, y, wts, names, npts, nvars, len_name)
+
+pointer	in			# INLFIT pointer
+char	file[ARB]		# Output file name
+pointer	nl			# NLFIT pointer
+real	x[ARB]			# Ordinates (npts * nvars)
+real	y[ARB]			# Abscissas
+real	wts[ARB]		# Weights
+char	names[ARB]		# Object names
+int	npts		        # Number of data points
+int	nvars		        # Number of variables
+int	len_name		# Length of a name
+
+int	i, fd, rejected
+pointer	sp, fit, wts1, rejpts
+int	open(), in_geti()
+pointer	in_getp()
+errchk	open
+
+begin
+	# Open the output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Test the number of points.
+	if (npts == 0) {
+	    call eprintf ("Incomplete output - no data points for fit\n")
+	    return
+	}
+
+	# Allocate memory.
+	call smark (sp)
+	call salloc (fit, npts, TY_REAL)
+	call salloc (wts1, npts, TY_REAL)
+
+	# Evaluate the fit.
+	call nlvectorr (nl, x, Memr[fit], npts, nvars)
+
+	# Assign a zero weight to the rejected points.
+	rejected = in_geti (in, INLNREJPTS)
+	rejpts = in_getp (in, INLREJPTS)
+	call amovr (wts, Memr[wts1], npts)
+	if (rejected > 0) {
+	    do i = 1, npts {
+		if (Memi[rejpts+i-1] == YES)
+		    Memr[wts1+i-1] = real (0.0)
+	    }
+	}
+
+	# Print the title.
+	call fprintf (fd, "\n#%14.14s %14.14s %14.14s")
+	    call pargstr ("objectid")
+	    call pargstr ("function")
+	    call pargstr ("fit")
+	call fprintf (fd, " %14.14s %14.14s\n")
+	    call pargstr ("residuals")
+	    call pargstr ("sigma")
+	
+	# List function value, fit value, residual and error values.
+	do i = 1, npts {
+	    call fprintf (fd, " %14.14s %14.7g %14.7g %14.7g %14.7g\n")
+	    call pargstr (names[(i-1)*len_name+1])
+	    if (Memr[wts1+i-1] <= 0.0) {
+		call pargr (INDEFR)
+		call pargr (INDEFR)
+		call pargr (INDEFR)
+		call pargr (INDEFR)
+	    } else {
+		call pargr (y[i])
+		call pargr (Memr[fit+i-1])
+		call pargr (y[i] - Memr[fit+i-1])
+		call pargr (sqrt (real (1.0) / Memr[wts1+i-1]))
+	    }
+	}
+	call fprintf (fd, "\n")
+
+	# Free allocated memory, and close output file.
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingshow.gx b/pkg/xtools/inlfit/ingshow.gx
new file mode 100644
index 00000000..28efcc6e
--- /dev/null
+++ b/pkg/xtools/inlfit/ingshow.gx
@@ -0,0 +1,40 @@
+include	<pkg/inlfit.h>
+
+
+# ING_SHOW -- Show the values of all the user defined parameters that
+# can be changed with colon commands. The output can be any file.
+
+procedure ing_show$t (in, file)
+
+pointer	in			# INLFIT pointer
+char	file[ARB]		# Output file
+
+int	fd
+int	open(), in_geti()
+PIXEL	in_get$t
+errchk	open()
+
+begin
+	# Open output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Print parameters.
+	call fprintf (fd, "low_reject    %g\n")
+	    call parg$t (in_get$t (in, INLLOW))
+	call fprintf (fd, "high_reject   %g\n")
+	    call parg$t (in_get$t (in, INLHIGH))
+	call fprintf (fd, "nreject       %d\n")
+	    call pargi (in_geti (in, INLNREJECT))
+	call fprintf (fd, "grow          %g\n")
+	    call parg$t (in_get$t (in, INLGROW))
+	call fprintf (fd, "tol           %g\n")
+	    call parg$t (in_get$t (in, INLTOLERANCE))
+	call fprintf (fd, "maxiter       %d\n")
+	    call pargi (in_geti (in, INLMAXITER))
+	call fprintf (fd, "\n")
+
+	# Free memory and close file.
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingshowd.x b/pkg/xtools/inlfit/ingshowd.x
new file mode 100644
index 00000000..031ae3f3
--- /dev/null
+++ b/pkg/xtools/inlfit/ingshowd.x
@@ -0,0 +1,40 @@
+include	<pkg/inlfit.h>
+
+
+# ING_SHOW -- Show the values of all the user defined parameters that
+# can be changed with colon commands. The output can be any file.
+
+procedure ing_showd (in, file)
+
+pointer	in			# INLFIT pointer
+char	file[ARB]		# Output file
+
+int	fd
+int	open(), in_geti()
+double	in_getd
+errchk	open()
+
+begin
+	# Open output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Print parameters.
+	call fprintf (fd, "low_reject    %g\n")
+	    call pargd (in_getd (in, INLLOW))
+	call fprintf (fd, "high_reject   %g\n")
+	    call pargd (in_getd (in, INLHIGH))
+	call fprintf (fd, "nreject       %d\n")
+	    call pargi (in_geti (in, INLNREJECT))
+	call fprintf (fd, "grow          %g\n")
+	    call pargd (in_getd (in, INLGROW))
+	call fprintf (fd, "tol           %g\n")
+	    call pargd (in_getd (in, INLTOLERANCE))
+	call fprintf (fd, "maxiter       %d\n")
+	    call pargi (in_geti (in, INLMAXITER))
+	call fprintf (fd, "\n")
+
+	# Free memory and close file.
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingshowr.x b/pkg/xtools/inlfit/ingshowr.x
new file mode 100644
index 00000000..237c90df
--- /dev/null
+++ b/pkg/xtools/inlfit/ingshowr.x
@@ -0,0 +1,40 @@
+include	<pkg/inlfit.h>
+
+
+# ING_SHOW -- Show the values of all the user defined parameters that
+# can be changed with colon commands. The output can be any file.
+
+procedure ing_showr (in, file)
+
+pointer	in			# INLFIT pointer
+char	file[ARB]		# Output file
+
+int	fd
+int	open(), in_geti()
+real	in_getr
+errchk	open()
+
+begin
+	# Open output file.
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	# Print parameters.
+	call fprintf (fd, "low_reject    %g\n")
+	    call pargr (in_getr (in, INLLOW))
+	call fprintf (fd, "high_reject   %g\n")
+	    call pargr (in_getr (in, INLHIGH))
+	call fprintf (fd, "nreject       %d\n")
+	    call pargi (in_geti (in, INLNREJECT))
+	call fprintf (fd, "grow          %g\n")
+	    call pargr (in_getr (in, INLGROW))
+	call fprintf (fd, "tol           %g\n")
+	    call pargr (in_getr (in, INLTOLERANCE))
+	call fprintf (fd, "maxiter       %d\n")
+	    call pargi (in_geti (in, INLMAXITER))
+	call fprintf (fd, "\n")
+
+	# Free memory and close file.
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/ingtitle.x b/pkg/xtools/inlfit/ingtitle.x
new file mode 100644
index 00000000..8b9fd877
--- /dev/null
+++ b/pkg/xtools/inlfit/ingtitle.x
@@ -0,0 +1,49 @@
+include <pkg/gtools.h>
+
+# ING_TITLE -- Write out the time stamp and the title of the current fit.
+
+procedure ing_title (in, file, gt)
+
+pointer	in		# pointer to the inlfit structure (not used yet)
+char	file[ARB]	# arbitrary file name
+pointer	gt		# pointer to the gtools structure
+
+int	fd, sfd
+pointer	sp, str
+int	open(), stropen(), fscan()
+long	clktime()
+
+begin
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Put time stamp in.
+	call cnvtime (clktime(0), Memc[str], SZ_LINE)
+	call fprintf (fd, "\n#%s\n")
+	    call pargstr (Memc[str])
+
+	# Print plot title.
+	call gt_gets (gt, GTTITLE, Memc[str], SZ_LINE)
+	sfd = stropen (Memc[str], SZ_LINE, READ_ONLY)
+	while (fscan (sfd) != EOF) {
+	    call gargstr (Memc[str], SZ_LINE)
+	    call fprintf (fd, "#%s\n")
+	        call pargstr (Memc[str])
+	} 
+	call fprintf (fd, "\n")
+	call strclose (sfd)
+
+	# Print fit units.
+	#call gt_gets (gt, GTYUNITS, Memc[str], SZ_LINE)
+	#if (Memc[str] != EOS) {
+	    #call fprintf (fd, "fit_units    %s\n")
+	        #call pargstr (Memc[str])
+	#}
+
+	call sfree (sp)
+	call close (fd)
+end
diff --git a/pkg/xtools/inlfit/inguaxes.gx b/pkg/xtools/inlfit/inguaxes.gx
new file mode 100644
index 00000000..58942f52
--- /dev/null
+++ b/pkg/xtools/inlfit/inguaxes.gx
@@ -0,0 +1,47 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# ING_UAXES -- Set user axis
+
+procedure ing_uaxes$t (keynum, in, nl, x, y, z, npts, nvars)
+
+int	keynum				# Key number for axes
+pointer	in				# INLFIT pointer
+pointer	nl				# NLFIT pointer
+PIXEL	x[ARB]				# Independent variable
+PIXEL	y[npts]				# Dependent variable
+PIXEL	z[npts]				# Output values
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+int	npars				# number of parameters
+int	uaxes				# user defined procedure
+pointer	params				# parameter values
+pointer	sp
+
+int	nlstati()
+int	in_geti()
+
+begin
+	# Check if equation is defined
+	uaxes = in_geti (in, INLUAXES)
+	if (!IS_INDEFI (uaxes)) {
+
+	    # Get number of parameters, allocate space
+	    # for parameter values, and get parameter values
+	    npars = nlstati (nl, NLNPARAMS)
+	    call smark (sp)
+	    call salloc (params, npars, TY_PIXEL)
+	    call nlpget$t (nl, Mem$t[params], npars)
+
+	    # Call user plot functions
+	    call zcall8 (uaxes, keynum, Mem$t[params], npars,
+			 x, y, z, npts, nvars)
+
+	    # Free memory
+	    call sfree (sp)
+
+	} else
+	    call eprintf ("Warning: User plot function not defined\n")
+end
diff --git a/pkg/xtools/inlfit/inguaxesd.x b/pkg/xtools/inlfit/inguaxesd.x
new file mode 100644
index 00000000..48759bc0
--- /dev/null
+++ b/pkg/xtools/inlfit/inguaxesd.x
@@ -0,0 +1,47 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# ING_UAXES -- Set user axis
+
+procedure ing_uaxesd (keynum, in, nl, x, y, z, npts, nvars)
+
+int	keynum				# Key number for axes
+pointer	in				# INLFIT pointer
+pointer	nl				# NLFIT pointer
+double	x[ARB]				# Independent variable
+double	y[npts]				# Dependent variable
+double	z[npts]				# Output values
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+int	npars				# number of parameters
+int	uaxes				# user defined procedure
+pointer	params				# parameter values
+pointer	sp
+
+int	nlstati()
+int	in_geti()
+
+begin
+	# Check if equation is defined
+	uaxes = in_geti (in, INLUAXES)
+	if (!IS_INDEFI (uaxes)) {
+
+	    # Get number of parameters, allocate space
+	    # for parameter values, and get parameter values
+	    npars = nlstati (nl, NLNPARAMS)
+	    call smark (sp)
+	    call salloc (params, npars, TY_DOUBLE)
+	    call nlpgetd (nl, Memd[params], npars)
+
+	    # Call user plot functions
+	    call zcall8 (uaxes, keynum, Memd[params], npars,
+			 x, y, z, npts, nvars)
+
+	    # Free memory
+	    call sfree (sp)
+
+	} else
+	    call eprintf ("Warning: User plot function not defined\n")
+end
diff --git a/pkg/xtools/inlfit/inguaxesr.x b/pkg/xtools/inlfit/inguaxesr.x
new file mode 100644
index 00000000..53905563
--- /dev/null
+++ b/pkg/xtools/inlfit/inguaxesr.x
@@ -0,0 +1,47 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# ING_UAXES -- Set user axis
+
+procedure ing_uaxesr (keynum, in, nl, x, y, z, npts, nvars)
+
+int	keynum				# Key number for axes
+pointer	in				# INLFIT pointer
+pointer	nl				# NLFIT pointer
+real	x[ARB]				# Independent variable
+real	y[npts]				# Dependent variable
+real	z[npts]				# Output values
+int	npts				# Number of points
+int	nvars				# Number of variables
+
+int	npars				# number of parameters
+int	uaxes				# user defined procedure
+pointer	params				# parameter values
+pointer	sp
+
+int	nlstati()
+int	in_geti()
+
+begin
+	# Check if equation is defined
+	uaxes = in_geti (in, INLUAXES)
+	if (!IS_INDEFI (uaxes)) {
+
+	    # Get number of parameters, allocate space
+	    # for parameter values, and get parameter values
+	    npars = nlstati (nl, NLNPARAMS)
+	    call smark (sp)
+	    call salloc (params, npars, TY_REAL)
+	    call nlpgetr (nl, Memr[params], npars)
+
+	    # Call user plot functions
+	    call zcall8 (uaxes, keynum, Memr[params], npars,
+			 x, y, z, npts, nvars)
+
+	    # Free memory
+	    call sfree (sp)
+
+	} else
+	    call eprintf ("Warning: User plot function not defined\n")
+end
diff --git a/pkg/xtools/inlfit/ingucolon.gx b/pkg/xtools/inlfit/ingucolon.gx
new file mode 100644
index 00000000..3e858789
--- /dev/null
+++ b/pkg/xtools/inlfit/ingucolon.gx
@@ -0,0 +1,19 @@
+# ING_UCOLON -- User default colon commands
+
+procedure ing_ucolon$t (in, gp, gt, nl, x, y, wts, npts, nvars, newgraph)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+pointer	nl			# NLFIT pointer
+PIXEL	x[ARB]			# Independent variables
+PIXEL	y[npts]			# Dependent variables
+PIXEL	wts[npts]		# Weights
+int	npts			# Number of points
+int	nvars			# Number of variables
+int	newgraph		# New graph ? (output)
+
+begin
+	# Ring bell
+	call printf ("\07\n")
+end
diff --git a/pkg/xtools/inlfit/ingucolond.x b/pkg/xtools/inlfit/ingucolond.x
new file mode 100644
index 00000000..db3ab047
--- /dev/null
+++ b/pkg/xtools/inlfit/ingucolond.x
@@ -0,0 +1,19 @@
+# ING_UCOLON -- User default colon commands
+
+procedure ing_ucolond (in, gp, gt, nl, x, y, wts, npts, nvars, newgraph)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+pointer	nl			# NLFIT pointer
+double	x[ARB]			# Independent variables
+double	y[npts]			# Dependent variables
+double	wts[npts]		# Weights
+int	npts			# Number of points
+int	nvars			# Number of variables
+int	newgraph		# New graph ? (output)
+
+begin
+	# Ring bell
+	call printf ("\07\n")
+end
diff --git a/pkg/xtools/inlfit/ingucolonr.x b/pkg/xtools/inlfit/ingucolonr.x
new file mode 100644
index 00000000..1a7de7a5
--- /dev/null
+++ b/pkg/xtools/inlfit/ingucolonr.x
@@ -0,0 +1,19 @@
+# ING_UCOLON -- User default colon commands
+
+procedure ing_ucolonr (in, gp, gt, nl, x, y, wts, npts, nvars, newgraph)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+pointer	nl			# NLFIT pointer
+real	x[ARB]			# Independent variables
+real	y[npts]			# Dependent variables
+real	wts[npts]		# Weights
+int	npts			# Number of points
+int	nvars			# Number of variables
+int	newgraph		# New graph ? (output)
+
+begin
+	# Ring bell
+	call printf ("\07\n")
+end
diff --git a/pkg/xtools/inlfit/ingufit.x b/pkg/xtools/inlfit/ingufit.x
new file mode 100644
index 00000000..5780d755
--- /dev/null
+++ b/pkg/xtools/inlfit/ingufit.x
@@ -0,0 +1,17 @@
+# ING_UFIT -- User default action for interactive fitting commands
+
+procedure ing_ufit (in, gp, gt, nl, wx, wy, wcs, key, cmd)
+
+pointer	in			# INLFIT pointer
+pointer	gp			# GIO pointer
+pointer	gt			# GTOOLS pointer
+pointer	nl			# NLFIT pointer
+real	wx, wy			# Cursor positions
+int	wcs			# GIO WCS
+int	key			# Cursor key
+char	cmd[ARB]		# Cursor command
+
+begin
+	# Ring bell
+	call printf ("\07\n")
+end
diff --git a/pkg/xtools/inlfit/ingundelete.gx b/pkg/xtools/inlfit/ingundelete.gx
new file mode 100644
index 00000000..4b59156f
--- /dev/null
+++ b/pkg/xtools/inlfit/ingundelete.gx
@@ -0,0 +1,92 @@
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+
+define	MSIZE		2.0		# Mark size (real)
+
+
+# ING_UNDELETE -- Undelete data point nearest the cursor. The nearest point to
+# the cursor in NDC coordinates is determined.
+
+procedure ing_undelete$t (in, gp, gt, nl, x, y, wts, userwts, npts, nvars,
+	wx, wy)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+PIXEL	x[ARB]				# Independent variables (npts * nvars)
+PIXEL	y[npts]				# Dependent variables
+PIXEL	wts[npts], userwts[npts]	# Weight arrays
+int	npts				# Number of points
+int	nvars				# Number of variables
+real	wx, wy				# Position to be nearest
+
+pointer	sp, xout, yout
+int	gt_geti()
+
+begin
+	# Allocate memory for the axes data.
+	call smark (sp)
+	call salloc (xout, npts, TY_PIXEL)
+	call salloc (yout, npts, TY_PIXEL)
+
+	# Get the axes data.
+	call ing_axes$t (in, gt, nl, 1, x, y, Mem$t[xout], npts, nvars)
+	call ing_axes$t (in, gt, nl, 2, x, y, Mem$t[yout], npts, nvars)
+
+	# Transpose axes if necessary.
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call ing_u1$t (in, gp, Mem$t[xout], Mem$t[yout], wts, userwts,
+		npts, wx, wy)
+	else
+	    call ing_u1$t (in, gp, Mem$t[yout], Mem$t[xout], wts, userwts,
+		npts, wy, wx)
+
+	# Free memory.
+	call sfree (sp)
+end
+
+
+# ING_U1 -- Do the actual undelete.
+
+procedure ing_u1$t (in, gp, x, y, wts, userwts, npts, wx, wy)
+
+pointer	in					# ICFIT pointer
+pointer	gp					# GIO pointer
+PIXEL	x[npts], y[npts]			# Data points
+PIXEL	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with zero weight.
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] != PIXEL (0.0))
+		next
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Unmark the deleted point and reset the weight.
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gseti (gp, G_PMLTYPE, GL_CLEAR)
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    call gseti (gp, G_PMLTYPE, GL_SOLID)
+	    #call gline (gp, real (x[j]), real (y[j]), real (x[j]), real (y[j]))
+	    call gmark (gp, real (x[j]), real (y[j]), GM_PLUS, MSIZE, MSIZE)
+	    wts[j] = userwts[j]
+	}
+end
diff --git a/pkg/xtools/inlfit/ingundeleted.x b/pkg/xtools/inlfit/ingundeleted.x
new file mode 100644
index 00000000..5b7717d9
--- /dev/null
+++ b/pkg/xtools/inlfit/ingundeleted.x
@@ -0,0 +1,92 @@
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+
+define	MSIZE		2.0		# Mark size (real)
+
+
+# ING_UNDELETE -- Undelete data point nearest the cursor. The nearest point to
+# the cursor in NDC coordinates is determined.
+
+procedure ing_undeleted (in, gp, gt, nl, x, y, wts, userwts, npts, nvars,
+	wx, wy)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+double	x[ARB]				# Independent variables (npts * nvars)
+double	y[npts]				# Dependent variables
+double	wts[npts], userwts[npts]	# Weight arrays
+int	npts				# Number of points
+int	nvars				# Number of variables
+real	wx, wy				# Position to be nearest
+
+pointer	sp, xout, yout
+int	gt_geti()
+
+begin
+	# Allocate memory for the axes data.
+	call smark (sp)
+	call salloc (xout, npts, TY_DOUBLE)
+	call salloc (yout, npts, TY_DOUBLE)
+
+	# Get the axes data.
+	call ing_axesd (in, gt, nl, 1, x, y, Memd[xout], npts, nvars)
+	call ing_axesd (in, gt, nl, 2, x, y, Memd[yout], npts, nvars)
+
+	# Transpose axes if necessary.
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call ing_u1d (in, gp, Memd[xout], Memd[yout], wts, userwts,
+		npts, wx, wy)
+	else
+	    call ing_u1d (in, gp, Memd[yout], Memd[xout], wts, userwts,
+		npts, wy, wx)
+
+	# Free memory.
+	call sfree (sp)
+end
+
+
+# ING_U1 -- Do the actual undelete.
+
+procedure ing_u1d (in, gp, x, y, wts, userwts, npts, wx, wy)
+
+pointer	in					# ICFIT pointer
+pointer	gp					# GIO pointer
+double	x[npts], y[npts]			# Data points
+double	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with zero weight.
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] != double (0.0))
+		next
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Unmark the deleted point and reset the weight.
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gseti (gp, G_PMLTYPE, GL_CLEAR)
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    call gseti (gp, G_PMLTYPE, GL_SOLID)
+	    #call gline (gp, real (x[j]), real (y[j]), real (x[j]), real (y[j]))
+	    call gmark (gp, real (x[j]), real (y[j]), GM_PLUS, MSIZE, MSIZE)
+	    wts[j] = userwts[j]
+	}
+end
diff --git a/pkg/xtools/inlfit/ingundeleter.x b/pkg/xtools/inlfit/ingundeleter.x
new file mode 100644
index 00000000..149003e5
--- /dev/null
+++ b/pkg/xtools/inlfit/ingundeleter.x
@@ -0,0 +1,92 @@
+include	<gset.h>
+include	<mach.h>
+include	<pkg/gtools.h>
+
+define	MSIZE		2.0		# Mark size (real)
+
+
+# ING_UNDELETE -- Undelete data point nearest the cursor. The nearest point to
+# the cursor in NDC coordinates is determined.
+
+procedure ing_undeleter (in, gp, gt, nl, x, y, wts, userwts, npts, nvars,
+	wx, wy)
+
+pointer	in				# INLFIT pointer
+pointer	gp				# GIO pointer
+pointer	gt				# GTOOLS pointer
+pointer	nl				# NLFIT pointer
+real	x[ARB]				# Independent variables (npts * nvars)
+real	y[npts]				# Dependent variables
+real	wts[npts], userwts[npts]	# Weight arrays
+int	npts				# Number of points
+int	nvars				# Number of variables
+real	wx, wy				# Position to be nearest
+
+pointer	sp, xout, yout
+int	gt_geti()
+
+begin
+	# Allocate memory for the axes data.
+	call smark (sp)
+	call salloc (xout, npts, TY_REAL)
+	call salloc (yout, npts, TY_REAL)
+
+	# Get the axes data.
+	call ing_axesr (in, gt, nl, 1, x, y, Memr[xout], npts, nvars)
+	call ing_axesr (in, gt, nl, 2, x, y, Memr[yout], npts, nvars)
+
+	# Transpose axes if necessary.
+	if (gt_geti (gt, GTTRANSPOSE) == NO)
+	    call ing_u1r (in, gp, Memr[xout], Memr[yout], wts, userwts,
+		npts, wx, wy)
+	else
+	    call ing_u1r (in, gp, Memr[yout], Memr[xout], wts, userwts,
+		npts, wy, wx)
+
+	# Free memory.
+	call sfree (sp)
+end
+
+
+# ING_U1 -- Do the actual undelete.
+
+procedure ing_u1r (in, gp, x, y, wts, userwts, npts, wx, wy)
+
+pointer	in					# ICFIT pointer
+pointer	gp					# GIO pointer
+real	x[npts], y[npts]			# Data points
+real	wts[npts], userwts[npts]		# Weight arrays
+int	npts					# Number of points
+real	wx, wy					# Position to be nearest
+
+int	i, j
+real	x0, y0, r2, r2min
+
+begin
+	# Transform world cursor coordinates to NDC.
+	call gctran (gp, wx, wy, wx, wy, 1, 0)
+
+	# Search for nearest point to a point with zero weight.
+	r2min = MAX_REAL
+	do i = 1, npts {
+	    if (wts[i] != real (0.0))
+		next
+	    call gctran (gp, real (x[i]), real (y[i]), x0, y0, 1, 0)
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+		r2min = r2
+		j = i
+	    }
+	}
+
+	# Unmark the deleted point and reset the weight.
+	if (j != 0) {
+	    call gscur (gp, real (x[j]), real (y[j]))
+	    call gseti (gp, G_PMLTYPE, GL_CLEAR)
+	    call gmark (gp, real (x[j]), real (y[j]), GM_CROSS, MSIZE, MSIZE)
+	    call gseti (gp, G_PMLTYPE, GL_SOLID)
+	    #call gline (gp, real (x[j]), real (y[j]), real (x[j]), real (y[j]))
+	    call gmark (gp, real (x[j]), real (y[j]), GM_PLUS, MSIZE, MSIZE)
+	    wts[j] = userwts[j]
+	}
+end
diff --git a/pkg/xtools/inlfit/ingvars.gx b/pkg/xtools/inlfit/ingvars.gx
new file mode 100644
index 00000000..291284a0
--- /dev/null
+++ b/pkg/xtools/inlfit/ingvars.gx
@@ -0,0 +1,55 @@
+include <pkg/inlfit.h>
+
+# ING_VARIABLES -- Write the variable numbers, names and minimum and maximum
+# values to a file.
+
+procedure ing_variables$t (in, file, nvars)
+
+pointer	in			# pointer to the inlfit structure
+char	file[ARB]		# output file name
+int	nvars			# number of variables
+
+int	i, fd
+pointer	sp, labels, pvnames, name, minptr, maxptr
+int	open(), inlstrwrd()
+pointer	in_getp()
+
+begin
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	call smark (sp)
+	call salloc (labels, SZ_LINE, TY_CHAR)
+	call salloc (pvnames, SZ_LINE, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call in_gstr (in, INLVLABELS, Memc[labels], SZ_LINE)
+	call strcpy (Memc[labels], Memc[pvnames], SZ_LINE)
+
+	# Print the title string.
+	call fprintf (fd, "\n%-10.10s  %-10.10s  %14.14s  %14.14s\n")
+	    call pargstr ("number")
+	    call pargstr ("variable")
+	    call pargstr ("minimum")
+	    call pargstr ("maximum")
+
+	# Print the variables.
+	minptr = in_getp (in, INLXMIN)
+	maxptr = in_getp (in, INLXMAX)
+	do i = 1, nvars {
+	    if (inlstrwrd (i, Memc[name], SZ_LINE, Memc[pvnames]) == 0) {
+		call sprintf (Memc[name], SZ_LINE, "var %d")
+		    call pargi (i)
+	    }
+	    call fprintf (fd, "%-10.2d  %-10.10s  ")
+		call pargi (i)
+		call pargstr (Memc[name])
+	    call fprintf (fd, "%14.7f  %14.7f\n")
+		call parg$t (Mem$t[minptr+i-1])
+		call parg$t (Mem$t[maxptr+i-1])
+	}
+	call fprintf (fd, "\n")
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingvarsd.x b/pkg/xtools/inlfit/ingvarsd.x
new file mode 100644
index 00000000..257b51fb
--- /dev/null
+++ b/pkg/xtools/inlfit/ingvarsd.x
@@ -0,0 +1,55 @@
+include <pkg/inlfit.h>
+
+# ING_VARIABLES -- Write the variable numbers, names and minimum and maximum
+# values to a file.
+
+procedure ing_variablesd (in, file, nvars)
+
+pointer	in			# pointer to the inlfit structure
+char	file[ARB]		# output file name
+int	nvars			# number of variables
+
+int	i, fd
+pointer	sp, labels, pvnames, name, minptr, maxptr
+int	open(), inlstrwrd()
+pointer	in_getp()
+
+begin
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	call smark (sp)
+	call salloc (labels, SZ_LINE, TY_CHAR)
+	call salloc (pvnames, SZ_LINE, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call in_gstr (in, INLVLABELS, Memc[labels], SZ_LINE)
+	call strcpy (Memc[labels], Memc[pvnames], SZ_LINE)
+
+	# Print the title string.
+	call fprintf (fd, "\n%-10.10s  %-10.10s  %14.14s  %14.14s\n")
+	    call pargstr ("number")
+	    call pargstr ("variable")
+	    call pargstr ("minimum")
+	    call pargstr ("maximum")
+
+	# Print the variables.
+	minptr = in_getp (in, INLXMIN)
+	maxptr = in_getp (in, INLXMAX)
+	do i = 1, nvars {
+	    if (inlstrwrd (i, Memc[name], SZ_LINE, Memc[pvnames]) == 0) {
+		call sprintf (Memc[name], SZ_LINE, "var %d")
+		    call pargi (i)
+	    }
+	    call fprintf (fd, "%-10.2d  %-10.10s  ")
+		call pargi (i)
+		call pargstr (Memc[name])
+	    call fprintf (fd, "%14.7f  %14.7f\n")
+		call pargd (Memd[minptr+i-1])
+		call pargd (Memd[maxptr+i-1])
+	}
+	call fprintf (fd, "\n")
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingvarsr.x b/pkg/xtools/inlfit/ingvarsr.x
new file mode 100644
index 00000000..b0855805
--- /dev/null
+++ b/pkg/xtools/inlfit/ingvarsr.x
@@ -0,0 +1,55 @@
+include <pkg/inlfit.h>
+
+# ING_VARIABLES -- Write the variable numbers, names and minimum and maximum
+# values to a file.
+
+procedure ing_variablesr (in, file, nvars)
+
+pointer	in			# pointer to the inlfit structure
+char	file[ARB]		# output file name
+int	nvars			# number of variables
+
+int	i, fd
+pointer	sp, labels, pvnames, name, minptr, maxptr
+int	open(), inlstrwrd()
+pointer	in_getp()
+
+begin
+	if (file[1] == EOS)
+	    return
+	fd = open (file, APPEND, TEXT_FILE)
+
+	call smark (sp)
+	call salloc (labels, SZ_LINE, TY_CHAR)
+	call salloc (pvnames, SZ_LINE, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call in_gstr (in, INLVLABELS, Memc[labels], SZ_LINE)
+	call strcpy (Memc[labels], Memc[pvnames], SZ_LINE)
+
+	# Print the title string.
+	call fprintf (fd, "\n%-10.10s  %-10.10s  %14.14s  %14.14s\n")
+	    call pargstr ("number")
+	    call pargstr ("variable")
+	    call pargstr ("minimum")
+	    call pargstr ("maximum")
+
+	# Print the variables.
+	minptr = in_getp (in, INLXMIN)
+	maxptr = in_getp (in, INLXMAX)
+	do i = 1, nvars {
+	    if (inlstrwrd (i, Memc[name], SZ_LINE, Memc[pvnames]) == 0) {
+		call sprintf (Memc[name], SZ_LINE, "var %d")
+		    call pargi (i)
+	    }
+	    call fprintf (fd, "%-10.2d  %-10.10s  ")
+		call pargi (i)
+		call pargstr (Memc[name])
+	    call fprintf (fd, "%14.7f  %14.7f\n")
+		call pargr (Memr[minptr+i-1])
+		call pargr (Memr[maxptr+i-1])
+	}
+	call fprintf (fd, "\n")
+
+	call close (fd)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/ingvshow.gx b/pkg/xtools/inlfit/ingvshow.gx
new file mode 100644
index 00000000..129e6b4c
--- /dev/null
+++ b/pkg/xtools/inlfit/ingvshow.gx
@@ -0,0 +1,34 @@
+include <pkg/inlfit.h>
+
+
+# ING_VSHOW -- Show fit parameters in verbose mode on the screen.
+
+procedure ing_vshow$t (in, file, nl, x, y, wts, names, npts, nvars, len_name,
+	gt)
+
+pointer	in		        # INLFIT pointer
+char	file[ARB]		# Output file name
+pointer	nl			# NLFIT pointer
+PIXEL	x[ARB]			# Ordinates (npts * nvars)
+PIXEL	y[ARB]			# Abscissas
+PIXEL	wts[ARB]		# Weights
+char	names[ARB]		# Object ids
+int	npts			# Number of data points
+int	nvars			# Number of variables
+int	len_name		# Length of id name
+pointer	gt			# Graphics tools pointer
+
+begin
+	# Print the title.
+	call ing_title (in, file, gt)
+
+	# Do the standard ing_show option.
+	call ing_show$t (in, file)
+
+	# Print the error analysis information.
+	call ing_errors$t (in, file, nl, x, y, wts, npts, nvars)
+
+	# Print the results.
+	call ing_results$t (in, file, nl, x, y, wts, names, npts, nvars,
+	    len_name)
+end
diff --git a/pkg/xtools/inlfit/ingvshowd.x b/pkg/xtools/inlfit/ingvshowd.x
new file mode 100644
index 00000000..e7a2af30
--- /dev/null
+++ b/pkg/xtools/inlfit/ingvshowd.x
@@ -0,0 +1,34 @@
+include <pkg/inlfit.h>
+
+
+# ING_VSHOW -- Show fit parameters in verbose mode on the screen.
+
+procedure ing_vshowd (in, file, nl, x, y, wts, names, npts, nvars, len_name,
+	gt)
+
+pointer	in		        # INLFIT pointer
+char	file[ARB]		# Output file name
+pointer	nl			# NLFIT pointer
+double	x[ARB]			# Ordinates (npts * nvars)
+double	y[ARB]			# Abscissas
+double	wts[ARB]		# Weights
+char	names[ARB]		# Object ids
+int	npts			# Number of data points
+int	nvars			# Number of variables
+int	len_name		# Length of id name
+pointer	gt			# Graphics tools pointer
+
+begin
+	# Print the title.
+	call ing_title (in, file, gt)
+
+	# Do the standard ing_show option.
+	call ing_showd (in, file)
+
+	# Print the error analysis information.
+	call ing_errorsd (in, file, nl, x, y, wts, npts, nvars)
+
+	# Print the results.
+	call ing_resultsd (in, file, nl, x, y, wts, names, npts, nvars,
+	    len_name)
+end
diff --git a/pkg/xtools/inlfit/ingvshowr.x b/pkg/xtools/inlfit/ingvshowr.x
new file mode 100644
index 00000000..aed987ce
--- /dev/null
+++ b/pkg/xtools/inlfit/ingvshowr.x
@@ -0,0 +1,34 @@
+include <pkg/inlfit.h>
+
+
+# ING_VSHOW -- Show fit parameters in verbose mode on the screen.
+
+procedure ing_vshowr (in, file, nl, x, y, wts, names, npts, nvars, len_name,
+	gt)
+
+pointer	in		        # INLFIT pointer
+char	file[ARB]		# Output file name
+pointer	nl			# NLFIT pointer
+real	x[ARB]			# Ordinates (npts * nvars)
+real	y[ARB]			# Abscissas
+real	wts[ARB]		# Weights
+char	names[ARB]		# Object ids
+int	npts			# Number of data points
+int	nvars			# Number of variables
+int	len_name		# Length of id name
+pointer	gt			# Graphics tools pointer
+
+begin
+	# Print the title.
+	call ing_title (in, file, gt)
+
+	# Do the standard ing_show option.
+	call ing_showr (in, file)
+
+	# Print the error analysis information.
+	call ing_errorsr (in, file, nl, x, y, wts, npts, nvars)
+
+	# Print the results.
+	call ing_resultsr (in, file, nl, x, y, wts, names, npts, nvars,
+	    len_name)
+end
diff --git a/pkg/xtools/inlfit/ininit.gx b/pkg/xtools/inlfit/ininit.gx
new file mode 100644
index 00000000..a0df0ffe
--- /dev/null
+++ b/pkg/xtools/inlfit/ininit.gx
@@ -0,0 +1,172 @@
+.help ininit
+INLFIT memory allocation procedures. All the calls to malloc() and realloc()
+are grouped in this file. Acces to the INLFIT structure is restricted to
+the in_get() and in_put() procedures, except for buffer allocation and
+initialization.
+.nf
+
+User entry points:
+
+    in_init$t (in, func, dfunc, param, dparam, nparams, plist, nfparams)
+
+Low level entry point:
+
+    in_bfinit$t (in, npts, nvars)
+.fi
+.endhelp
+
+include	<pkg/inlfit.h>
+include "inlfitdef.h"
+
+
+# IN_INIT -- Initialize INLFIT parameter structure.
+
+procedure in_init$t (in, func, dfunc, param, dparam, nparams, plist, nfparams)
+
+pointer	in			# INLFIT pointer
+int	func			# fitting function address
+int	dfunc			# derivative function address
+PIXEL	param[nparams]		# parameter values
+PIXEL	dparam[nparams]		# initial guess at uncertenties in parameters
+int	nparams			# number of parameters
+int	plist[nparams]		# list of active parameters
+int	nfparams		# number of fitting paramters
+
+begin
+#	# Debug.
+#	call eprintf (
+#	    "in_init: in=%d, func=%d, dfunc=%d, npars=%d, nfpars=%d\n")
+#	    call pargi (in)
+#	    call pargi (func)
+#	    call pargi (dfunc)
+#	    call pargi (nparams)
+#	    call pargi (nfparams)
+
+	# Allocate the structure memory.
+	call malloc (in, LEN_INLSTRUCT, TY_STRUCT)
+
+	# Allocate memory for parameter values, changes, and list.
+	call malloc (IN_PARAM  (in), nparams, TY_PIXEL)
+	call malloc (IN_DPARAM (in), nparams, TY_PIXEL)
+	call malloc (IN_PLIST  (in), nparams, TY_INT)
+
+	# Allocate space for strings. All strings are limited
+	# to SZ_LINE or SZ_FNAME.
+	call malloc (IN_LABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_UNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_FLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_FUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_PLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_PUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_VLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_VUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_USERLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_USERUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_HELP(in), SZ_FNAME, TY_CHAR)
+	call malloc (IN_PROMPT(in), SZ_FNAME, TY_CHAR)
+
+	# Allocate space for floating point and graph substructures.
+	call malloc (IN_SFLOAT (in), LEN_INLFLOAT, TY_PIXEL)
+	call malloc (IN_SGAXES (in), INLNGKEYS * LEN_INLGRAPH, TY_INT)
+
+	# Enter procedure parameters into the structure.
+	call in_puti (in, INLFUNCTION, func)
+	call in_puti (in, INLDERIVATIVE, dfunc)
+	call in_puti (in, INLNPARAMS, nparams)
+	call in_puti (in, INLNFPARAMS, nfparams)
+	call amov$t  (param, Mem$t[IN_PARAM(in)], nparams)
+	call amov$t  (dparam, Mem$t[IN_DPARAM(in)], nparams)
+	call amovi   (plist, Memi[IN_PLIST(in)], nparams)
+
+	# Set defaults, just in case.
+	call in_put$t (in, INLTOLERANCE, PIXEL (0.01))
+	call in_puti  (in, INLMAXITER, 3)
+	call in_puti  (in, INLNREJECT, 0)
+	call in_put$t (in, INLLOW, PIXEL (3.0))
+	call in_put$t (in, INLHIGH, PIXEL (3.0))
+	call in_put$t (in, INLGROW, PIXEL (0.0))
+
+	# Initialize the character strings.
+	call in_pstr (in, INLLABELS, KEY_TYPES)
+	call in_pstr (in, INLUNITS, "")
+	call in_pstr (in, INLFLABELS, "")
+	call in_pstr (in, INLFUNITS, "")
+	call in_pstr (in, INLPLABELS, "")
+	call in_pstr (in, INLPUNITS, "")
+	call in_pstr (in, INLVLABELS, "")
+	call in_pstr (in, INLVUNITS, "")
+	call in_pstr (in, INLUSERLABELS, "")
+	call in_pstr (in, INLUSERUNITS,  "")
+	call in_pstr (in, INLHELP, IN_DEFHELP)
+	call in_pstr (in, INLPROMPT, IN_DEFPROMPT)
+
+	# Initialize user defined functions.
+	call in_puti (in, INLUAXES,  INDEFI)
+	call in_puti (in, INLUCOLON, INDEFI)
+	call in_puti (in, INLUFIT,   INDEFI)
+
+	# Initialize graph key, and axes.
+	call in_puti (in, INLGKEY, 2)
+	call in_pkey (in, 1, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 1, INLYAXIS, KEY_FIT, INDEFI)
+	call in_pkey (in, 2, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 2, INLYAXIS, KEY_RESIDUALS, INDEFI)
+	call in_pkey (in, 3, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 3, INLYAXIS, KEY_RATIO, INDEFI)
+	call in_pkey (in, 4, INLXAXIS, KEY_VARIABLE, 1)
+	call in_pkey (in, 4, INLYAXIS, KEY_RESIDUALS, INDEFI)
+	call in_pkey (in, 5, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 5, INLYAXIS, KEY_RESIDUALS, INDEFI)
+
+	# Initialize flags and counters.
+	call in_puti (in, INLOVERPLOT, NO)
+	call in_puti (in, INLPLOTFIT, NO)
+	call in_puti (in, INLNREJPTS, 0)
+	call in_puti (in, INLNVARS, 0)
+	call in_puti (in, INLNPTS, 0)
+
+	# Initialize pointers.
+	call in_putp (in, INLREJPTS, NULL)
+	call in_putp (in, INLXMIN,   NULL)
+	call in_putp (in, INLXMAX,   NULL)
+end
+
+
+# IN_BFINIT -- Initialize the rejected point counter, number of variables,
+# rejected point list, and the buffers containing the minimum and maximum
+# variable values. The rejected point list and limit value buffers are
+# reallocated, if necessary.
+
+procedure in_bfinit$t (in, npts, nvars)
+
+pointer	in			# INLFIT descriptor
+int	npts			# number of points
+int	nvars			# number of variables
+
+int	in_geti()
+
+begin
+#	# Debug.
+#	call eprintf ("in_bfinit: in=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Clear rejected point counter, and initialize number of variables.
+	call in_puti (in, INLNREJPTS, 0)
+
+	# Reallocate space for rejected point list and initialize it.
+	if (in_geti (in, INLNPTS) != npts) {
+	    call in_puti (in, INLNPTS, npts)
+	    call realloc (IN_REJPTS (in), npts, TY_INT)
+	}
+	call amovki  (NO, Memi[IN_REJPTS(in)], npts)
+
+	# Reallocate space for minimum and maximum variable values.
+	# Initialization is made afterwards.
+	if (in_geti (in, INLNVARS) != nvars) {
+	    call in_puti (in, INLNVARS, nvars)
+	    call realloc (IN_XMIN (in), nvars, TY_PIXEL)
+	    call realloc (IN_XMAX (in), nvars, TY_PIXEL)
+	}
+end
diff --git a/pkg/xtools/inlfit/ininitd.x b/pkg/xtools/inlfit/ininitd.x
new file mode 100644
index 00000000..147f2886
--- /dev/null
+++ b/pkg/xtools/inlfit/ininitd.x
@@ -0,0 +1,172 @@
+.help ininit
+INLFIT memory allocation procedures. All the calls to malloc() and realloc()
+are grouped in this file. Acces to the INLFIT structure is restricted to
+the in_get() and in_put() procedures, except for buffer allocation and
+initialization.
+.nf
+
+User entry points:
+
+    in_initd (in, func, dfunc, param, dparam, nparams, plist, nfparams)
+
+Low level entry point:
+
+    in_bfinitd (in, npts, nvars)
+.fi
+.endhelp
+
+include	<pkg/inlfit.h>
+include "inlfitdef.h"
+
+
+# IN_INIT -- Initialize INLFIT parameter structure.
+
+procedure in_initd (in, func, dfunc, param, dparam, nparams, plist, nfparams)
+
+pointer	in			# INLFIT pointer
+int	func			# fitting function address
+int	dfunc			# derivative function address
+double	param[nparams]		# parameter values
+double	dparam[nparams]		# initial guess at uncertenties in parameters
+int	nparams			# number of parameters
+int	plist[nparams]		# list of active parameters
+int	nfparams		# number of fitting paramters
+
+begin
+#	# Debug.
+#	call eprintf (
+#	    "in_init: in=%d, func=%d, dfunc=%d, npars=%d, nfpars=%d\n")
+#	    call pargi (in)
+#	    call pargi (func)
+#	    call pargi (dfunc)
+#	    call pargi (nparams)
+#	    call pargi (nfparams)
+
+	# Allocate the structure memory.
+	call malloc (in, LEN_INLSTRUCT, TY_STRUCT)
+
+	# Allocate memory for parameter values, changes, and list.
+	call malloc (IN_PARAM  (in), nparams, TY_DOUBLE)
+	call malloc (IN_DPARAM (in), nparams, TY_DOUBLE)
+	call malloc (IN_PLIST  (in), nparams, TY_INT)
+
+	# Allocate space for strings. All strings are limited
+	# to SZ_LINE or SZ_FNAME.
+	call malloc (IN_LABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_UNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_FLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_FUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_PLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_PUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_VLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_VUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_USERLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_USERUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_HELP(in), SZ_FNAME, TY_CHAR)
+	call malloc (IN_PROMPT(in), SZ_FNAME, TY_CHAR)
+
+	# Allocate space for floating point and graph substructures.
+	call malloc (IN_SFLOAT (in), LEN_INLFLOAT, TY_DOUBLE)
+	call malloc (IN_SGAXES (in), INLNGKEYS * LEN_INLGRAPH, TY_INT)
+
+	# Enter procedure parameters into the structure.
+	call in_puti (in, INLFUNCTION, func)
+	call in_puti (in, INLDERIVATIVE, dfunc)
+	call in_puti (in, INLNPARAMS, nparams)
+	call in_puti (in, INLNFPARAMS, nfparams)
+	call amovd  (param, Memd[IN_PARAM(in)], nparams)
+	call amovd  (dparam, Memd[IN_DPARAM(in)], nparams)
+	call amovi   (plist, Memi[IN_PLIST(in)], nparams)
+
+	# Set defaults, just in case.
+	call in_putd (in, INLTOLERANCE, double (0.01))
+	call in_puti  (in, INLMAXITER, 3)
+	call in_puti  (in, INLNREJECT, 0)
+	call in_putd (in, INLLOW, double (3.0))
+	call in_putd (in, INLHIGH, double (3.0))
+	call in_putd (in, INLGROW, double (0.0))
+
+	# Initialize the character strings.
+	call in_pstr (in, INLLABELS, KEY_TYPES)
+	call in_pstr (in, INLUNITS, "")
+	call in_pstr (in, INLFLABELS, "")
+	call in_pstr (in, INLFUNITS, "")
+	call in_pstr (in, INLPLABELS, "")
+	call in_pstr (in, INLPUNITS, "")
+	call in_pstr (in, INLVLABELS, "")
+	call in_pstr (in, INLVUNITS, "")
+	call in_pstr (in, INLUSERLABELS, "")
+	call in_pstr (in, INLUSERUNITS,  "")
+	call in_pstr (in, INLHELP, IN_DEFHELP)
+	call in_pstr (in, INLPROMPT, IN_DEFPROMPT)
+
+	# Initialize user defined functions.
+	call in_puti (in, INLUAXES,  INDEFI)
+	call in_puti (in, INLUCOLON, INDEFI)
+	call in_puti (in, INLUFIT,   INDEFI)
+
+	# Initialize graph key, and axes.
+	call in_puti (in, INLGKEY, 2)
+	call in_pkey (in, 1, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 1, INLYAXIS, KEY_FIT, INDEFI)
+	call in_pkey (in, 2, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 2, INLYAXIS, KEY_RESIDUALS, INDEFI)
+	call in_pkey (in, 3, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 3, INLYAXIS, KEY_RATIO, INDEFI)
+	call in_pkey (in, 4, INLXAXIS, KEY_VARIABLE, 1)
+	call in_pkey (in, 4, INLYAXIS, KEY_RESIDUALS, INDEFI)
+	call in_pkey (in, 5, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 5, INLYAXIS, KEY_RESIDUALS, INDEFI)
+
+	# Initialize flags and counters.
+	call in_puti (in, INLOVERPLOT, NO)
+	call in_puti (in, INLPLOTFIT, NO)
+	call in_puti (in, INLNREJPTS, 0)
+	call in_puti (in, INLNVARS, 0)
+	call in_puti (in, INLNPTS, 0)
+
+	# Initialize pointers.
+	call in_putp (in, INLREJPTS, NULL)
+	call in_putp (in, INLXMIN,   NULL)
+	call in_putp (in, INLXMAX,   NULL)
+end
+
+
+# IN_BFINIT -- Initialize the rejected point counter, number of variables,
+# rejected point list, and the buffers containing the minimum and maximum
+# variable values. The rejected point list and limit value buffers are
+# reallocated, if necessary.
+
+procedure in_bfinitd (in, npts, nvars)
+
+pointer	in			# INLFIT descriptor
+int	npts			# number of points
+int	nvars			# number of variables
+
+int	in_geti()
+
+begin
+#	# Debug.
+#	call eprintf ("in_bfinit: in=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Clear rejected point counter, and initialize number of variables.
+	call in_puti (in, INLNREJPTS, 0)
+
+	# Reallocate space for rejected point list and initialize it.
+	if (in_geti (in, INLNPTS) != npts) {
+	    call in_puti (in, INLNPTS, npts)
+	    call realloc (IN_REJPTS (in), npts, TY_INT)
+	}
+	call amovki  (NO, Memi[IN_REJPTS(in)], npts)
+
+	# Reallocate space for minimum and maximum variable values.
+	# Initialization is made afterwards.
+	if (in_geti (in, INLNVARS) != nvars) {
+	    call in_puti (in, INLNVARS, nvars)
+	    call realloc (IN_XMIN (in), nvars, TY_DOUBLE)
+	    call realloc (IN_XMAX (in), nvars, TY_DOUBLE)
+	}
+end
diff --git a/pkg/xtools/inlfit/ininitr.x b/pkg/xtools/inlfit/ininitr.x
new file mode 100644
index 00000000..8c0f3469
--- /dev/null
+++ b/pkg/xtools/inlfit/ininitr.x
@@ -0,0 +1,172 @@
+.help ininit
+INLFIT memory allocation procedures. All the calls to malloc() and realloc()
+are grouped in this file. Acces to the INLFIT structure is restricted to
+the in_get() and in_put() procedures, except for buffer allocation and
+initialization.
+.nf
+
+User entry points:
+
+    in_initr (in, func, dfunc, param, dparam, nparams, plist, nfparams)
+
+Low level entry point:
+
+    in_bfinitr (in, npts, nvars)
+.fi
+.endhelp
+
+include	<pkg/inlfit.h>
+include "inlfitdef.h"
+
+
+# IN_INIT -- Initialize INLFIT parameter structure.
+
+procedure in_initr (in, func, dfunc, param, dparam, nparams, plist, nfparams)
+
+pointer	in			# INLFIT pointer
+int	func			# fitting function address
+int	dfunc			# derivative function address
+real	param[nparams]		# parameter values
+real	dparam[nparams]		# initial guess at uncertenties in parameters
+int	nparams			# number of parameters
+int	plist[nparams]		# list of active parameters
+int	nfparams		# number of fitting paramters
+
+begin
+#	# Debug.
+#	call eprintf (
+#	    "in_init: in=%d, func=%d, dfunc=%d, npars=%d, nfpars=%d\n")
+#	    call pargi (in)
+#	    call pargi (func)
+#	    call pargi (dfunc)
+#	    call pargi (nparams)
+#	    call pargi (nfparams)
+
+	# Allocate the structure memory.
+	call malloc (in, LEN_INLSTRUCT, TY_STRUCT)
+
+	# Allocate memory for parameter values, changes, and list.
+	call malloc (IN_PARAM  (in), nparams, TY_REAL)
+	call malloc (IN_DPARAM (in), nparams, TY_REAL)
+	call malloc (IN_PLIST  (in), nparams, TY_INT)
+
+	# Allocate space for strings. All strings are limited
+	# to SZ_LINE or SZ_FNAME.
+	call malloc (IN_LABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_UNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_FLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_FUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_PLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_PUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_VLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_VUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_USERLABELS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_USERUNITS(in), SZ_LINE, TY_CHAR)
+	call malloc (IN_HELP(in), SZ_FNAME, TY_CHAR)
+	call malloc (IN_PROMPT(in), SZ_FNAME, TY_CHAR)
+
+	# Allocate space for floating point and graph substructures.
+	call malloc (IN_SFLOAT (in), LEN_INLFLOAT, TY_REAL)
+	call malloc (IN_SGAXES (in), INLNGKEYS * LEN_INLGRAPH, TY_INT)
+
+	# Enter procedure parameters into the structure.
+	call in_puti (in, INLFUNCTION, func)
+	call in_puti (in, INLDERIVATIVE, dfunc)
+	call in_puti (in, INLNPARAMS, nparams)
+	call in_puti (in, INLNFPARAMS, nfparams)
+	call amovr  (param, Memr[IN_PARAM(in)], nparams)
+	call amovr  (dparam, Memr[IN_DPARAM(in)], nparams)
+	call amovi   (plist, Memi[IN_PLIST(in)], nparams)
+
+	# Set defaults, just in case.
+	call in_putr (in, INLTOLERANCE, real (0.01))
+	call in_puti  (in, INLMAXITER, 3)
+	call in_puti  (in, INLNREJECT, 0)
+	call in_putr (in, INLLOW, real (3.0))
+	call in_putr (in, INLHIGH, real (3.0))
+	call in_putr (in, INLGROW, real (0.0))
+
+	# Initialize the character strings.
+	call in_pstr (in, INLLABELS, KEY_TYPES)
+	call in_pstr (in, INLUNITS, "")
+	call in_pstr (in, INLFLABELS, "")
+	call in_pstr (in, INLFUNITS, "")
+	call in_pstr (in, INLPLABELS, "")
+	call in_pstr (in, INLPUNITS, "")
+	call in_pstr (in, INLVLABELS, "")
+	call in_pstr (in, INLVUNITS, "")
+	call in_pstr (in, INLUSERLABELS, "")
+	call in_pstr (in, INLUSERUNITS,  "")
+	call in_pstr (in, INLHELP, IN_DEFHELP)
+	call in_pstr (in, INLPROMPT, IN_DEFPROMPT)
+
+	# Initialize user defined functions.
+	call in_puti (in, INLUAXES,  INDEFI)
+	call in_puti (in, INLUCOLON, INDEFI)
+	call in_puti (in, INLUFIT,   INDEFI)
+
+	# Initialize graph key, and axes.
+	call in_puti (in, INLGKEY, 2)
+	call in_pkey (in, 1, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 1, INLYAXIS, KEY_FIT, INDEFI)
+	call in_pkey (in, 2, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 2, INLYAXIS, KEY_RESIDUALS, INDEFI)
+	call in_pkey (in, 3, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 3, INLYAXIS, KEY_RATIO, INDEFI)
+	call in_pkey (in, 4, INLXAXIS, KEY_VARIABLE, 1)
+	call in_pkey (in, 4, INLYAXIS, KEY_RESIDUALS, INDEFI)
+	call in_pkey (in, 5, INLXAXIS, KEY_FUNCTION, INDEFI)
+	call in_pkey (in, 5, INLYAXIS, KEY_RESIDUALS, INDEFI)
+
+	# Initialize flags and counters.
+	call in_puti (in, INLOVERPLOT, NO)
+	call in_puti (in, INLPLOTFIT, NO)
+	call in_puti (in, INLNREJPTS, 0)
+	call in_puti (in, INLNVARS, 0)
+	call in_puti (in, INLNPTS, 0)
+
+	# Initialize pointers.
+	call in_putp (in, INLREJPTS, NULL)
+	call in_putp (in, INLXMIN,   NULL)
+	call in_putp (in, INLXMAX,   NULL)
+end
+
+
+# IN_BFINIT -- Initialize the rejected point counter, number of variables,
+# rejected point list, and the buffers containing the minimum and maximum
+# variable values. The rejected point list and limit value buffers are
+# reallocated, if necessary.
+
+procedure in_bfinitr (in, npts, nvars)
+
+pointer	in			# INLFIT descriptor
+int	npts			# number of points
+int	nvars			# number of variables
+
+int	in_geti()
+
+begin
+#	# Debug.
+#	call eprintf ("in_bfinit: in=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Clear rejected point counter, and initialize number of variables.
+	call in_puti (in, INLNREJPTS, 0)
+
+	# Reallocate space for rejected point list and initialize it.
+	if (in_geti (in, INLNPTS) != npts) {
+	    call in_puti (in, INLNPTS, npts)
+	    call realloc (IN_REJPTS (in), npts, TY_INT)
+	}
+	call amovki  (NO, Memi[IN_REJPTS(in)], npts)
+
+	# Reallocate space for minimum and maximum variable values.
+	# Initialization is made afterwards.
+	if (in_geti (in, INLNVARS) != nvars) {
+	    call in_puti (in, INLNVARS, nvars)
+	    call realloc (IN_XMIN (in), nvars, TY_REAL)
+	    call realloc (IN_XMAX (in), nvars, TY_REAL)
+	}
+end
diff --git a/pkg/xtools/inlfit/inlfitdef.h b/pkg/xtools/inlfit/inlfitdef.h
new file mode 100644
index 00000000..0153f20f
--- /dev/null
+++ b/pkg/xtools/inlfit/inlfitdef.h
@@ -0,0 +1,148 @@
+# The INLFIT data structure and private definitions.
+
+# Pointer Mem
+
+define	MEMP		Memi
+
+
+# Default help file and prompt
+
+define	IN_DEFHELP	"lib$scr/inlgfit.key"
+define	IN_DEFPROMPT	"inlfit cursor options"
+
+
+# Graphic key/axis types
+define	KEY_TYPES	"|function|fit|residuals|ratio|nonlinear|var|user|"
+
+
+# ---------------------------------------------------------------------- 
+# INLFIT structure definition.
+
+# Structure length.
+define	LEN_INLSTRUCT	37
+
+# NLFIT parameters. These parameters are stored in the INLFIT structure,
+# and passed without change to the NLFIT package. The NLFIT descriptor
+# is stored here as well.
+
+#define	IN_TYPE		Memi[$1+0]	# calculation type (TY_REAL, TY_DOUBLE)
+define	IN_FUNC		Memi[$1+1]	# fitting function
+define	IN_DFUNC	Memi[$1+2]	# derivative function
+define	IN_NPARAMS	Memi[$1+3]	# number of parameters
+define	IN_NFPARAMS	Memi[$1+4]	# number of fitted parameters
+define	IN_PARAM	MEMP[$1+5]	# pointer to parameter vector
+define	IN_DPARAM	MEMP[$1+6]	# pointer to par. change vector
+define	IN_PLIST	MEMP[$1+7]	# parameter list
+define	IN_MAXITER	Memi[$1+8]	# max number of iterations
+
+# INLFIT parameters used to keep track of the number of variables and
+# number of points in the fit. These numbers are used to decide buffer
+# reallocation.
+
+define	IN_NVARS	Memi[$1+9]	# number of variables
+define	IN_NPTS		Memi[$1+10]	# number of points
+
+# INLFIT floating point substructure. This substructure is used to
+# store a pointer to a separate buffer, containing floating point
+# numbers.
+
+define	IN_SFLOAT	MEMP[$1+11]	# pointer to subs. with reals/doubles
+
+# INLFIT parameters used for automatic data rejection. The rejection
+# limits and the grow radius are stored in the floating point substructure.
+
+define	IN_NREJECT	Memi[$1+12]	# number of rejection iteration
+
+# INLFIT parameters used to store the rejected point counter, and a
+# pointer to the rejected point list.
+
+define	IN_NREJPTS	Memi[$1+13]	# number of rejected points
+define	IN_REJPTS	MEMP[$1+14]	# pointer to buffer with rejected pts.
+
+# INLFIT parameters used to store user defined procedures addresses.
+# These parameters are used by the zcall*() procedures.
+
+define	IN_UAXES	Memi[$1+15]	# plot function
+define	IN_UCOLON	Memi[$1+16]	# default colon command
+define	IN_UFIT		Memi[$1+17]	# default interactive fit command
+
+# INLFIT parameters used to store pointers to separate buffers, containing
+# the minimum and maximum values of all the input variables. The number
+# of variables is kept as well.
+
+define	IN_XMIN		MEMP[$1+18]	# pointer to buffer with min. values
+define	IN_XMAX		MEMP[$1+19]	# pointer to buffer with max. values
+
+# INLFIT flags.
+
+define	IN_OVERPLOT	Memi[$1+20]	# overplot next plot ?
+define	IN_PLOTFIT	Memi[$1+21]	# overplot fit ?
+define	IN_FITERROR	Memi[$1+22]	# error fit code
+
+# INLFIT string parameters used for interactive graphics. These are
+# pointers to the actual strings.
+
+define	IN_LABELS	MEMP[$1+23]	# standard axis labels
+define	IN_UNITS	MEMP[$1+24]	# standard axis units
+define	IN_FLABELS	MEMP[$1+25]	# function and fit labels
+define	IN_FUNITS	MEMP[$1+26]	# function and fit units
+define	IN_PLABELS	MEMP[$1+27]	# parameter labels
+define	IN_PUNITS	MEMP[$1+28]	# parameter units
+define	IN_VLABELS	MEMP[$1+29]	# variable labels
+define	IN_VUNITS	MEMP[$1+30]	# variable units
+define	IN_USERLABELS	MEMP[$1+31]	# user plot labels
+define	IN_USERUNITS	MEMP[$1+32]	# user plot units
+define	IN_HELP		MEMP[$1+33]	# help file name
+define	IN_PROMPT	MEMP[$1+34]	# help prompt
+
+# INLFIT graph key definitions.
+
+define	IN_GKEY		Memi[$1+35]	# current graph key
+define	IN_SGAXES	MEMP[$1+36]	# pointer to subs. with graph keys 
+
+# next free location	($1 + 37) == LEN_INLSTRUCT
+
+
+# ---------------------------------------------------------------------- 
+# Floating point number substructures (real, double). This is an easy way
+# to avoid having to deal with mixed floating point types in the main
+# structure. The macro parameter is the main structure pointer. The
+# substructure used depends on the calculation type.
+
+# Substructure length
+
+define	LEN_INLFLOAT	4
+
+# Real version
+
+define	IN_TOLR		Memr[IN_SFLOAT($1)+0]	# tolerance of convergence
+define	IN_LOWR		Memr[IN_SFLOAT($1)+1]	# low rejection value
+define	IN_HIGHR	Memr[IN_SFLOAT($1)+2]	# high rejection value
+define	IN_GROWR	Memr[IN_SFLOAT($1)+3]	# rejection growing radius
+
+# Double precission version
+
+define	IN_TOLD		Memd[IN_SFLOAT($1)+0]	# tolerance of convergence
+define	IN_LOWD		Memd[IN_SFLOAT($1)+1]	# low rejection value
+define	IN_HIGHD	Memd[IN_SFLOAT($1)+2]	# high rejection value
+define	IN_GROWD	Memd[IN_SFLOAT($1)+3]	# rejection growing radius
+
+
+# ---------------------------------------------------------------------- 
+# Graph axes substructure. The macro parameters are the pointer to the
+# main structure, and the key number. The actual size of the graph axes
+# buffer will be equal to the maximum number of keys (IN_GKEYS) times
+# the substructure length (LEN_INLGRAPH). The type is one of the possible
+# codes for KEY_TYPES, and the number is used to keep track of the variable
+# or user supplied function numbers.
+
+# Substructure length
+
+define	LEN_INLGRAPH	4
+
+# Substructure definition
+
+define	IN_GXTYPE	Memi[IN_SGAXES($1)+($2-1)*LEN_INLGRAPH+0] # x axis type
+define	IN_GXNUMBER	Memi[IN_SGAXES($1)+($2-1)*LEN_INLGRAPH+1] # x axis num.
+define	IN_GYTYPE	Memi[IN_SGAXES($1)+($2-1)*LEN_INLGRAPH+2] # y axis type
+define	IN_GYNUMBER	Memi[IN_SGAXES($1)+($2-1)*LEN_INLGRAPH+3] # y axis num.
diff --git a/pkg/xtools/inlfit/inlgfit.key b/pkg/xtools/inlfit/inlgfit.key
new file mode 100644
index 00000000..c01f9a9d
--- /dev/null
+++ b/pkg/xtools/inlfit/inlgfit.key
@@ -0,0 +1,77 @@
+1. INTERACTIVE NONLINEAR LEAST SQUARES FITTING CURSOR OPTIONS
+
+?       Print options
+c       Print coordinates and fit of point nearest the cursor
+d       Delete point nearest the cursor
+f       Do the fit and redraw or overplot the graph
+g       Redefine graph keys.  The following data types may be along
+        either axis.
+            function    Dependent variable, or function
+            fit         Fitted value
+            residuals   Residuals (function - fit)
+            ratio       Ratio (function / fit)
+            nonlinear   Nonlinear component of function
+            var n       Independent variable number "n"
+            identifier  Independent variable "identifier" (if defined)
+            user n      User defined plot function (if defined)
+h-l     Graph keys.  The defaults are the following.
+	    h=(function, fit)
+	    i=(function, residual)
+            j=(function, ratio)
+	    k=(var 1, residual)
+	    l=(user 1, user 2)
+o       Overplot the next graph
+q       Exit interactive curve fitting
+r       Redraw graph
+t	Overplot fit
+u       Undelete the deleted point nearest the cursor
+w       Set graph window.
+	    For help type 'w' followed by '?' after the prompt.
+I       Interrupt task immediately
+
+
+2. INTERACTIVE NONLINEAR LEAST SQUARES FITTING COLON COMMANDS
+
+The parameters are listed or set with the following commands which may be
+abbreviated.  To list the value of a parameter type the command alone.
+
+:show [file]               Print the values of the task fitting parameters
+:variables [file]	   Print the variable names, min and max values
+:data [file]		   Print the values of all the variables
+:errors [file]             Print an error analysis of the fit
+:results [file]		   Print the results of the fit
+:vshow [file]              Print an error analysis and results of the fit
+:page file		   Page through a file
+:const [param] [value]     Change parameter to constant parameter
+:fit [param] [value]       Change parameter to fitting parameter
+:tolerance [value]	   Show/set the convergence criteria
+:maxiter [value]	   Show/set the maximum number of fitting iterations
+:nreject [value]           Show/set the maximum number of rejection iterations
+:low_reject [value]        Show/set the low rejection threshold
+:high_reject [value]       Show/set the high rejection threshold
+:grow [value]              Show/set the rejection growing radius
+
+Additional commands are available for setting graph formats and manipulating
+the graphics.  Use the following commands for help.
+
+:/help       Print help for graph formatting option
+:.help       Print help for general graphics options
+
+
+3. INTERACTIVE NONLINEAR LEAST SQUARES FITTING GRAPH KEYS
+
+The graph keys are h, i, j, k, and l.  The graph keys may be redefined to
+put any combination of axes types along either graph axis with the 'g' key.
+To define a graph key select the desired key to redefine and then specify
+the axes types for the horizontal and vertical axes by a pair of comma
+separated types from the following (they may be abreviated up to three
+characters, except for 'identifier'):
+
+function    Dependent variable
+fit         Fitted value
+ratio       Ratio (function / fit)
+residuuals  Residuals of fit (function - fit)
+nonlinear   Nonlinear part of data (linear component of fit subtracted)
+var [n]     Indepedent variable number "n"
+user [n]    User defined plot equation "n" (if defined)
+identifier  Independent variable named "identifier" (if defined)
diff --git a/pkg/xtools/inlfit/inlimit.gx b/pkg/xtools/inlfit/inlimit.gx
new file mode 100644
index 00000000..ed4c2b43
--- /dev/null
+++ b/pkg/xtools/inlfit/inlimit.gx
@@ -0,0 +1,51 @@
+include	<pkg/inlfit.h>
+
+
+# IN_LIMIT -- Compute the independent variable limits for all variables,
+# and store them in the INLFIT structure.
+
+procedure in_limit$t (in, x, npts, nvars)
+
+pointer	in			# INLFIT descriptor
+PIXEL	x[ARB]			# Independent values (npts * nvars)
+int	npts			# number of points
+int	nvars			# number of variables
+
+int	i, j
+PIXEL	aux, xmin, xmax
+pointer	minptr, maxptr
+
+pointer	in_getp()
+
+begin
+#	# Debug
+#	call eprintf ("in_limit: in=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Get minimum and maximum buffer pointers
+	minptr = in_getp (in, INLXMIN)
+	maxptr = in_getp (in, INLXMAX)
+
+	# Loop over variables
+	do i = 1, nvars {
+
+	    # Set initial values
+	    xmin = x[i]
+	    xmax = x[i]
+
+	    # Search for maximum and minimum values
+	    do j = 1, npts {
+		aux = x[(j - 1) * nvars + i]
+		if (xmin > aux)
+		    xmin = aux
+		else if (xmax < aux)
+		    xmax = aux
+	    }
+
+	    # Enter values into the structure
+	    Mem$t[minptr + i - 1] = xmin
+	    Mem$t[maxptr + i - 1] = xmax
+	}
+end
diff --git a/pkg/xtools/inlfit/inlimitd.x b/pkg/xtools/inlfit/inlimitd.x
new file mode 100644
index 00000000..cc0ba12e
--- /dev/null
+++ b/pkg/xtools/inlfit/inlimitd.x
@@ -0,0 +1,51 @@
+include	<pkg/inlfit.h>
+
+
+# IN_LIMIT -- Compute the independent variable limits for all variables,
+# and store them in the INLFIT structure.
+
+procedure in_limitd (in, x, npts, nvars)
+
+pointer	in			# INLFIT descriptor
+double	x[ARB]			# Independent values (npts * nvars)
+int	npts			# number of points
+int	nvars			# number of variables
+
+int	i, j
+double	aux, xmin, xmax
+pointer	minptr, maxptr
+
+pointer	in_getp()
+
+begin
+#	# Debug
+#	call eprintf ("in_limit: in=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Get minimum and maximum buffer pointers
+	minptr = in_getp (in, INLXMIN)
+	maxptr = in_getp (in, INLXMAX)
+
+	# Loop over variables
+	do i = 1, nvars {
+
+	    # Set initial values
+	    xmin = x[i]
+	    xmax = x[i]
+
+	    # Search for maximum and minimum values
+	    do j = 1, npts {
+		aux = x[(j - 1) * nvars + i]
+		if (xmin > aux)
+		    xmin = aux
+		else if (xmax < aux)
+		    xmax = aux
+	    }
+
+	    # Enter values into the structure
+	    Memd[minptr + i - 1] = xmin
+	    Memd[maxptr + i - 1] = xmax
+	}
+end
diff --git a/pkg/xtools/inlfit/inlimitr.x b/pkg/xtools/inlfit/inlimitr.x
new file mode 100644
index 00000000..e85b6c62
--- /dev/null
+++ b/pkg/xtools/inlfit/inlimitr.x
@@ -0,0 +1,51 @@
+include	<pkg/inlfit.h>
+
+
+# IN_LIMIT -- Compute the independent variable limits for all variables,
+# and store them in the INLFIT structure.
+
+procedure in_limitr (in, x, npts, nvars)
+
+pointer	in			# INLFIT descriptor
+real	x[ARB]			# Independent values (npts * nvars)
+int	npts			# number of points
+int	nvars			# number of variables
+
+int	i, j
+real	aux, xmin, xmax
+pointer	minptr, maxptr
+
+pointer	in_getp()
+
+begin
+#	# Debug
+#	call eprintf ("in_limit: in=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Get minimum and maximum buffer pointers
+	minptr = in_getp (in, INLXMIN)
+	maxptr = in_getp (in, INLXMAX)
+
+	# Loop over variables
+	do i = 1, nvars {
+
+	    # Set initial values
+	    xmin = x[i]
+	    xmax = x[i]
+
+	    # Search for maximum and minimum values
+	    do j = 1, npts {
+		aux = x[(j - 1) * nvars + i]
+		if (xmin > aux)
+		    xmin = aux
+		else if (xmax < aux)
+		    xmax = aux
+	    }
+
+	    # Enter values into the structure
+	    Memr[minptr + i - 1] = xmin
+	    Memr[maxptr + i - 1] = xmax
+	}
+end
diff --git a/pkg/xtools/inlfit/inlstrext.x b/pkg/xtools/inlfit/inlstrext.x
new file mode 100644
index 00000000..b2b071d9
--- /dev/null
+++ b/pkg/xtools/inlfit/inlstrext.x
@@ -0,0 +1,47 @@
+include	<ctype.h>
+
+# INLSTREXT - Extract a word (delimited substring) from a string.
+# The input string is scanned from the given initial value until one
+# of the delimiters is found. The delimiters are not included in the
+# output word.
+# Leading white spaces in a word may be optionally skipped. White 
+# spaces are skipped before looking at the delimiters string, so it's
+# possible to remove leading white spaces and use them as delimiters
+# at the same time.
+# The value returned is the number of characters in the output string.
+# Upon return, the pointer is located at the begining of the next word.
+
+int procedure inlstrext (str, ip, dict, skip, outstr, maxch)
+
+char	str[ARB]			# input string
+int	ip				# pointer into input string
+char	dict[ARB]			# dictionary of delimiters
+int	skip				# skip leading white spaces ?
+char	outstr[ARB]			# extracted word
+int	maxch				# max number of chars
+
+int	op
+int	stridx()
+
+begin
+	# Skip leading white spaces
+	if (skip == YES) {
+	    while (IS_WHITE (str[ip]))
+		ip = ip + 1
+    	}
+
+	# Process input string
+	for (op=1;  str[ip] != EOS && op <= maxch;  op=op+1)
+	    if (stridx (str[ip], dict) == 0) {
+		outstr[op] = str[ip]
+		ip = ip + 1
+	    } else {
+		repeat {
+		    ip = ip + 1
+		} until (stridx (str[ip], dict) == 0 || str[ip] == EOS)
+		break
+	    }
+
+	outstr[op] = EOS
+	return (op - 1)
+end
diff --git a/pkg/xtools/inlfit/inlstrwrd.x b/pkg/xtools/inlfit/inlstrwrd.x
new file mode 100644
index 00000000..23aa8bdf
--- /dev/null
+++ b/pkg/xtools/inlfit/inlstrwrd.x
@@ -0,0 +1,51 @@
+# INLSTRWRD -- Search a dictionary string for a given string index number.
+# This is the opposite function of strdic(), that returns the index for
+# given string.  The entries in the dictionary string are separated by
+# a delimiter character which is the first character of the dictionary
+# string.  The index of the string found is returned as the function value.
+# Otherwise, if there is no string for that index, a zero is returned.
+
+int procedure inlstrwrd (index, outstr, maxch, dict)
+
+int	index			# String index
+char	outstr[ARB]		# Output string as found in dictionary
+int	maxch			# Maximum length of output string
+char	dict[ARB]		# Dictionary string
+
+int	i, len, start, count
+
+int	strlen()
+
+begin
+	# Clear output string
+	outstr[1] = EOS
+
+	# Return if the dictionary is not long enough
+	if (dict[1] == EOS)
+	    return (0)
+
+	# Initialize counters
+	count = 1
+	len   = strlen (dict)
+
+	# Search the dictionary string. This loop only terminates
+	# successfully if the index is found. Otherwise the procedure
+	# returns with and error condition.
+	for (start = 2; count < index; start = start + 1) {
+	    if (dict[start] == dict[1])
+		count = count + 1
+	    if (start == len)
+		return (0)
+	}
+
+	# Extract the output string from the dictionary
+	for (i = start; dict[i] != EOS && dict[i] != dict[1]; i = i + 1) {
+	    if (i - start + 1 > maxch)
+		break
+	    outstr[i - start + 1] = dict[i]
+	}
+	outstr[i - start + 1] = EOS
+
+	# Return index for output string
+	return (count)
+end
diff --git a/pkg/xtools/inlfit/innlinit.gx b/pkg/xtools/inlfit/innlinit.gx
new file mode 100644
index 00000000..87c2aab1
--- /dev/null
+++ b/pkg/xtools/inlfit/innlinit.gx
@@ -0,0 +1,28 @@
+include	"inlfitdef.h"
+
+
+# IN_NLINIT -- Initialize (reinitialize) NLFIT descriptor. The new
+# NLFIT descriptor is returned as a procedure argument.
+
+procedure in_nlinit$t (in, nl)
+
+pointer	in			# INLFIT descriptor
+pointer	nl			# NLFIT descriptor
+
+errchk	nlinit(), nlfree()
+
+begin
+#	# Debug.
+#	call eprintf ("in_nlinit: in=%d, nl=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+
+	# Free old NLFIT structure if any.
+	if (nl != NULL)
+	    call nlfree$t (nl)
+
+	# Initialize new NLFIT structure.
+	call nlinit$t (nl, IN_FUNC (in), IN_DFUNC (in), Mem$t[IN_PARAM (in)],
+	    Mem$t[IN_DPARAM (in)], IN_NPARAMS (in), Memi[IN_PLIST (in)],
+	    IN_NFPARAMS (in), IN_TOL$T (in), IN_MAXITER (in))
+end
diff --git a/pkg/xtools/inlfit/innlinitd.x b/pkg/xtools/inlfit/innlinitd.x
new file mode 100644
index 00000000..87a82c91
--- /dev/null
+++ b/pkg/xtools/inlfit/innlinitd.x
@@ -0,0 +1,28 @@
+include	"inlfitdef.h"
+
+
+# IN_NLINIT -- Initialize (reinitialize) NLFIT descriptor. The new
+# NLFIT descriptor is returned as a procedure argument.
+
+procedure in_nlinitd (in, nl)
+
+pointer	in			# INLFIT descriptor
+pointer	nl			# NLFIT descriptor
+
+errchk	nlinit(), nlfree()
+
+begin
+#	# Debug.
+#	call eprintf ("in_nlinit: in=%d, nl=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+
+	# Free old NLFIT structure if any.
+	if (nl != NULL)
+	    call nlfreed (nl)
+
+	# Initialize new NLFIT structure.
+	call nlinitd (nl, IN_FUNC (in), IN_DFUNC (in), Memd[IN_PARAM (in)],
+	    Memd[IN_DPARAM (in)], IN_NPARAMS (in), Memi[IN_PLIST (in)],
+	    IN_NFPARAMS (in), IN_TOLD (in), IN_MAXITER (in))
+end
diff --git a/pkg/xtools/inlfit/innlinitr.x b/pkg/xtools/inlfit/innlinitr.x
new file mode 100644
index 00000000..21e7b932
--- /dev/null
+++ b/pkg/xtools/inlfit/innlinitr.x
@@ -0,0 +1,28 @@
+include	"inlfitdef.h"
+
+
+# IN_NLINIT -- Initialize (reinitialize) NLFIT descriptor. The new
+# NLFIT descriptor is returned as a procedure argument.
+
+procedure in_nlinitr (in, nl)
+
+pointer	in			# INLFIT descriptor
+pointer	nl			# NLFIT descriptor
+
+errchk	nlinit(), nlfree()
+
+begin
+#	# Debug.
+#	call eprintf ("in_nlinit: in=%d, nl=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+
+	# Free old NLFIT structure if any.
+	if (nl != NULL)
+	    call nlfreer (nl)
+
+	# Initialize new NLFIT structure.
+	call nlinitr (nl, IN_FUNC (in), IN_DFUNC (in), Memr[IN_PARAM (in)],
+	    Memr[IN_DPARAM (in)], IN_NPARAMS (in), Memi[IN_PLIST (in)],
+	    IN_NFPARAMS (in), IN_TOLR (in), IN_MAXITER (in))
+end
diff --git a/pkg/xtools/inlfit/input.gx b/pkg/xtools/inlfit/input.gx
new file mode 100644
index 00000000..4fac25a5
--- /dev/null
+++ b/pkg/xtools/inlfit/input.gx
@@ -0,0 +1,188 @@
+.help input
+	in_puti (in, param, ival)
+	in_putr (in, param, rval)
+	in_putd (in, param, dval)
+	in_putp (in, param, pval)
+	in_pstr (in, param, str)
+	in_pkey (in, key, axis, type, varnum)
+.endhelp
+
+include	<pkg/inlfit.h>
+include "inlfitdef.h"
+
+
+# IN_PUTI -- Put integer valued parameters.
+
+procedure in_puti (in, param, ival)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to put
+int	ival			# integer value
+
+begin
+	switch (param) {
+	case INLFUNCTION:
+	    IN_FUNC (in) = ival
+	case INLDERIVATIVE:
+	    IN_DFUNC (in) = ival
+	case INLNPARAMS:
+	    IN_NPARAMS (in) = ival
+	case INLNFPARAMS:
+	    IN_NFPARAMS (in) = ival
+	case INLNVARS:
+	    IN_NVARS (in) = ival
+	case INLNPTS:
+	    IN_NPTS (in) = ival
+	case INLMAXITER:
+	    IN_MAXITER (in) = ival
+	case INLNREJECT:
+	    IN_NREJECT (in) = ival
+	case INLNREJPTS:
+	    IN_NREJPTS (in) = ival
+	case INLUAXES:
+	    IN_UAXES (in) = ival
+	case INLUCOLON:
+	    IN_UCOLON (in) = ival
+	case INLUFIT:
+	    IN_UFIT (in) = ival
+	case INLOVERPLOT:
+	    IN_OVERPLOT (in) = ival
+	case INLPLOTFIT:
+	    IN_PLOTFIT (in) = ival
+	case INLFITERROR:
+	    IN_FITERROR (in) = ival
+	case INLGKEY:
+	    if (ival < 1 || ival > INLNGKEYS)
+		call error (0, "INLFIT, in_puti: Bad key number (INLGKEY)")
+	    IN_GKEY (in) = ival
+	default:
+	    call error (0, "INLFIT, in_puti: Unknown parameter")
+	}
+end
+
+
+$for (rd)
+# IN_PUT[RD] -- Put real/double valued parameters.
+
+procedure in_put$t (in, param, $tval)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to put
+PIXEL	$tval			# value
+
+begin
+	switch (param) {
+	case INLTOLERANCE:
+	    IN_TOL$T (in) = $tval
+	case INLLOW:
+	    IN_LOW$T (in) = $tval
+	case INLHIGH:
+	    IN_HIGH$T (in) = $tval
+	case INLGROW:
+	    IN_GROW$T (in) = $tval
+	default:
+	    call error (0, "INLFIT, in_put[rd]: Unknown parameter")
+	}
+end
+$endfor
+
+
+# IN_PUTP -- Put pointer valued parameters.
+
+procedure in_putp (in, param, pval)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to put
+pointer	pval			# pointer value
+
+begin
+	switch (param) {
+	case INLPARAM:
+	    IN_PARAM (in) = pval
+	case INLDPARAM:
+	    IN_DPARAM (in) = pval
+	case INLPLIST:
+	    IN_PLIST (in) = pval
+	case INLSFLOAT:
+	    IN_SFLOAT (in) = pval
+	case INLREJPTS:
+	    IN_REJPTS (in) = pval
+	case INLXMIN:
+	    IN_XMIN (in) = pval
+	case INLXMAX:
+	    IN_XMAX (in) = pval
+	case INLSGAXES:
+	    IN_SGAXES (in) = pval
+	default:
+	    call error (0, "INLFIT, in_putp: Unknown parameter")
+	}
+end
+
+
+# IN_PSTR -- Put string valued parameters.
+
+procedure in_pstr (in, param, str)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to put
+char	str[ARB]		# string value
+
+begin
+	switch (param) {
+	case INLLABELS:
+	    call strcpy (str, Memc[IN_LABELS (in)], SZ_LINE)
+	case INLUNITS:
+	    call strcpy (str, Memc[IN_UNITS (in)], SZ_LINE)
+	case INLFLABELS:
+	    call strcpy (str, Memc[IN_FLABELS (in)], SZ_LINE)
+	case INLFUNITS:
+	    call strcpy (str, Memc[IN_FUNITS (in)], SZ_LINE)
+	case INLPLABELS:
+	    call strcpy (str, Memc[IN_PLABELS (in)], SZ_LINE)
+	case INLPUNITS:
+	    call strcpy (str, Memc[IN_PUNITS (in)], SZ_LINE)
+	case INLVLABELS:
+	    call strcpy (str, Memc[IN_VLABELS (in)], SZ_LINE)
+	case INLVUNITS:
+	    call strcpy (str, Memc[IN_VUNITS (in)], SZ_LINE)
+	case INLUSERLABELS:
+	    call strcpy (str, Memc[IN_USERLABELS (in)], SZ_LINE)
+	case INLUSERUNITS:
+	    call strcpy (str, Memc[IN_USERUNITS (in)], SZ_LINE)
+	case INLHELP:
+	    call strcpy (str, Memc[IN_HELP (in)], SZ_FNAME)
+	case INLPROMPT:
+	    call strcpy (str, Memc[IN_PROMPT (in)], SZ_FNAME)
+	default:
+	    call error (0, "INLFIT, in_pstr: Unknown parameter")
+	}
+end
+
+
+# IN_PKEY -- Put key parameters.
+
+procedure in_pkey (in, key, axis, type, varnum)
+
+pointer	in			# INLFIT pointer
+int	key			# key to put
+int	axis			# axis number
+int	type			# axis type
+int	varnum			# axis variable number
+
+begin
+	# Check ranges
+	if (key < 1 || key > INLNGKEYS)
+	    call error (0, "INLFIT, in_pkey: Illegal key")
+	if (type < KEY_MIN || type > KEY_MAX)
+	    call error (0, "INLFIT, in_pkey: Illegal key type")
+	
+	# Enter data
+	if (axis == INLXAXIS) {
+	    IN_GXTYPE   (in, key) = type
+	    IN_GXNUMBER (in, key) = varnum
+	} else if (axis == INLYAXIS) {
+	    IN_GYTYPE   (in, key) = type
+	    IN_GYNUMBER (in, key) = varnum
+	} else
+	    call error (0,"INLFIT, in_pkey: Illegal axis number")
+end
diff --git a/pkg/xtools/inlfit/input.x b/pkg/xtools/inlfit/input.x
new file mode 100644
index 00000000..db1613cb
--- /dev/null
+++ b/pkg/xtools/inlfit/input.x
@@ -0,0 +1,211 @@
+.help input
+	in_puti (in, param, ival)
+	in_putr (in, param, rval)
+	in_putd (in, param, dval)
+	in_putp (in, param, pval)
+	in_pstr (in, param, str)
+	in_pkey (in, key, axis, type, varnum)
+.endhelp
+
+include	<pkg/inlfit.h>
+include "inlfitdef.h"
+
+
+# IN_PUTI -- Put integer valued parameters.
+
+procedure in_puti (in, param, ival)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to put
+int	ival			# integer value
+
+begin
+	switch (param) {
+	case INLFUNCTION:
+	    IN_FUNC (in) = ival
+	case INLDERIVATIVE:
+	    IN_DFUNC (in) = ival
+	case INLNPARAMS:
+	    IN_NPARAMS (in) = ival
+	case INLNFPARAMS:
+	    IN_NFPARAMS (in) = ival
+	case INLNVARS:
+	    IN_NVARS (in) = ival
+	case INLNPTS:
+	    IN_NPTS (in) = ival
+	case INLMAXITER:
+	    IN_MAXITER (in) = ival
+	case INLNREJECT:
+	    IN_NREJECT (in) = ival
+	case INLNREJPTS:
+	    IN_NREJPTS (in) = ival
+	case INLUAXES:
+	    IN_UAXES (in) = ival
+	case INLUCOLON:
+	    IN_UCOLON (in) = ival
+	case INLUFIT:
+	    IN_UFIT (in) = ival
+	case INLOVERPLOT:
+	    IN_OVERPLOT (in) = ival
+	case INLPLOTFIT:
+	    IN_PLOTFIT (in) = ival
+	case INLFITERROR:
+	    IN_FITERROR (in) = ival
+	case INLGKEY:
+	    if (ival < 1 || ival > INLNGKEYS)
+		call error (0, "INLFIT, in_puti: Bad key number (INLGKEY)")
+	    IN_GKEY (in) = ival
+	default:
+	    call error (0, "INLFIT, in_puti: Unknown parameter")
+	}
+end
+
+
+
+# IN_PUT[RD] -- Put real/double valued parameters.
+
+procedure in_putr (in, param, rval)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to put
+real	rval			# value
+
+begin
+	switch (param) {
+	case INLTOLERANCE:
+	    IN_TOLR (in) = rval
+	case INLLOW:
+	    IN_LOWR (in) = rval
+	case INLHIGH:
+	    IN_HIGHR (in) = rval
+	case INLGROW:
+	    IN_GROWR (in) = rval
+	default:
+	    call error (0, "INLFIT, in_put[rd]: Unknown parameter")
+	}
+end
+
+# IN_PUT[RD] -- Put real/double valued parameters.
+
+procedure in_putd (in, param, dval)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to put
+double	dval			# value
+
+begin
+	switch (param) {
+	case INLTOLERANCE:
+	    IN_TOLD (in) = dval
+	case INLLOW:
+	    IN_LOWD (in) = dval
+	case INLHIGH:
+	    IN_HIGHD (in) = dval
+	case INLGROW:
+	    IN_GROWD (in) = dval
+	default:
+	    call error (0, "INLFIT, in_put[rd]: Unknown parameter")
+	}
+end
+
+
+
+# IN_PUTP -- Put pointer valued parameters.
+
+procedure in_putp (in, param, pval)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to put
+pointer	pval			# pointer value
+
+begin
+	switch (param) {
+	case INLPARAM:
+	    IN_PARAM (in) = pval
+	case INLDPARAM:
+	    IN_DPARAM (in) = pval
+	case INLPLIST:
+	    IN_PLIST (in) = pval
+	case INLSFLOAT:
+	    IN_SFLOAT (in) = pval
+	case INLREJPTS:
+	    IN_REJPTS (in) = pval
+	case INLXMIN:
+	    IN_XMIN (in) = pval
+	case INLXMAX:
+	    IN_XMAX (in) = pval
+	case INLSGAXES:
+	    IN_SGAXES (in) = pval
+	default:
+	    call error (0, "INLFIT, in_putp: Unknown parameter")
+	}
+end
+
+
+# IN_PSTR -- Put string valued parameters.
+
+procedure in_pstr (in, param, str)
+
+pointer	in			# INLFIT pointer
+int	param			# parameter to put
+char	str[ARB]		# string value
+
+begin
+	switch (param) {
+	case INLLABELS:
+	    call strcpy (str, Memc[IN_LABELS (in)], SZ_LINE)
+	case INLUNITS:
+	    call strcpy (str, Memc[IN_UNITS (in)], SZ_LINE)
+	case INLFLABELS:
+	    call strcpy (str, Memc[IN_FLABELS (in)], SZ_LINE)
+	case INLFUNITS:
+	    call strcpy (str, Memc[IN_FUNITS (in)], SZ_LINE)
+	case INLPLABELS:
+	    call strcpy (str, Memc[IN_PLABELS (in)], SZ_LINE)
+	case INLPUNITS:
+	    call strcpy (str, Memc[IN_PUNITS (in)], SZ_LINE)
+	case INLVLABELS:
+	    call strcpy (str, Memc[IN_VLABELS (in)], SZ_LINE)
+	case INLVUNITS:
+	    call strcpy (str, Memc[IN_VUNITS (in)], SZ_LINE)
+	case INLUSERLABELS:
+	    call strcpy (str, Memc[IN_USERLABELS (in)], SZ_LINE)
+	case INLUSERUNITS:
+	    call strcpy (str, Memc[IN_USERUNITS (in)], SZ_LINE)
+	case INLHELP:
+	    call strcpy (str, Memc[IN_HELP (in)], SZ_FNAME)
+	case INLPROMPT:
+	    call strcpy (str, Memc[IN_PROMPT (in)], SZ_FNAME)
+	default:
+	    call error (0, "INLFIT, in_pstr: Unknown parameter")
+	}
+end
+
+
+# IN_PKEY -- Put key parameters.
+
+procedure in_pkey (in, key, axis, type, varnum)
+
+pointer	in			# INLFIT pointer
+int	key			# key to put
+int	axis			# axis number
+int	type			# axis type
+int	varnum			# axis variable number
+
+begin
+	# Check ranges
+	if (key < 1 || key > INLNGKEYS)
+	    call error (0, "INLFIT, in_pkey: Illegal key")
+	if (type < KEY_MIN || type > KEY_MAX)
+	    call error (0, "INLFIT, in_pkey: Illegal key type")
+	
+	# Enter data
+	if (axis == INLXAXIS) {
+	    IN_GXTYPE   (in, key) = type
+	    IN_GXNUMBER (in, key) = varnum
+	} else if (axis == INLYAXIS) {
+	    IN_GYTYPE   (in, key) = type
+	    IN_GYNUMBER (in, key) = varnum
+	} else
+	    call error (0,"INLFIT, in_pkey: Illegal axis number")
+end
diff --git a/pkg/xtools/inlfit/inrefit.gx b/pkg/xtools/inlfit/inrefit.gx
new file mode 100644
index 00000000..2effe21e
--- /dev/null
+++ b/pkg/xtools/inlfit/inrefit.gx
@@ -0,0 +1,67 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# IN_REFIT -- Refit a function. This procedure is analogous to in_fit(),
+# except that this one does not initialize the weigths and the rejected
+# point list, and it does not reject points after the fit, because it is
+# intended to be called from the data rejection procedure.
+
+procedure in_refit$t (in, nl, x, y, wts, npts, nvars, wtflag)
+
+pointer	in				# INLFIT pointer
+pointer	nl				# NLFIT pointer
+PIXEL	x[ARB]				# Ordinates
+PIXEL	y[npts]				# Data to be fit
+PIXEL	wts[npts]			# Weights
+int	npts				# Number of points
+int	nvars				# Number of variables
+int	wtflag				# Type of weighting
+
+int	i, ndeleted, ier
+pointer	rejpts
+pointer	in_getp()
+int	in_geti()
+
+begin
+#	# Debug
+#	call eprintf ("in_refit: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+
+	# Assign a zero weight to each rejected point.
+	rejpts = in_getp (in, INLREJPTS)
+	do i = 1, npts {
+	    if (Memi[rejpts+i-1] == YES)
+		wts[i] = PIXEL (0.0)
+	}
+
+	# Reinitialize NLFIT.
+	call in_nlinit$t (in, nl)
+
+	# Check number of data points.
+	if (npts == 0) {
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    return
+	}
+
+	# Check number of deleted points.
+	ndeleted = 0
+	do i = 1, npts {
+	    if (wts[i] <= PIXEL(0.0))
+		ndeleted = ndeleted + 1
+	}
+	if ((npts - ndeleted) < in_geti(in, INLNFPARAMS)) {
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    return
+	}
+
+	# Refit.
+	call nlfit$t (nl, x, y, wts, npts, nvars, wtflag, ier)
+
+	# Store fit status in the INLFIT structure.
+	call in_puti (in, INLFITERROR, ier)
+end
diff --git a/pkg/xtools/inlfit/inrefitd.x b/pkg/xtools/inlfit/inrefitd.x
new file mode 100644
index 00000000..956e125e
--- /dev/null
+++ b/pkg/xtools/inlfit/inrefitd.x
@@ -0,0 +1,67 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# IN_REFIT -- Refit a function. This procedure is analogous to in_fit(),
+# except that this one does not initialize the weigths and the rejected
+# point list, and it does not reject points after the fit, because it is
+# intended to be called from the data rejection procedure.
+
+procedure in_refitd (in, nl, x, y, wts, npts, nvars, wtflag)
+
+pointer	in				# INLFIT pointer
+pointer	nl				# NLFIT pointer
+double	x[ARB]				# Ordinates
+double	y[npts]				# Data to be fit
+double	wts[npts]			# Weights
+int	npts				# Number of points
+int	nvars				# Number of variables
+int	wtflag				# Type of weighting
+
+int	i, ndeleted, ier
+pointer	rejpts
+pointer	in_getp()
+int	in_geti()
+
+begin
+#	# Debug
+#	call eprintf ("in_refit: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+
+	# Assign a zero weight to each rejected point.
+	rejpts = in_getp (in, INLREJPTS)
+	do i = 1, npts {
+	    if (Memi[rejpts+i-1] == YES)
+		wts[i] = double (0.0)
+	}
+
+	# Reinitialize NLFIT.
+	call in_nlinitd (in, nl)
+
+	# Check number of data points.
+	if (npts == 0) {
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    return
+	}
+
+	# Check number of deleted points.
+	ndeleted = 0
+	do i = 1, npts {
+	    if (wts[i] <= double(0.0))
+		ndeleted = ndeleted + 1
+	}
+	if ((npts - ndeleted) < in_geti(in, INLNFPARAMS)) {
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    return
+	}
+
+	# Refit.
+	call nlfitd (nl, x, y, wts, npts, nvars, wtflag, ier)
+
+	# Store fit status in the INLFIT structure.
+	call in_puti (in, INLFITERROR, ier)
+end
diff --git a/pkg/xtools/inlfit/inrefitr.x b/pkg/xtools/inlfit/inrefitr.x
new file mode 100644
index 00000000..3dea7f9f
--- /dev/null
+++ b/pkg/xtools/inlfit/inrefitr.x
@@ -0,0 +1,67 @@
+include	<math/nlfit.h>
+include	<pkg/inlfit.h>
+
+
+# IN_REFIT -- Refit a function. This procedure is analogous to in_fit(),
+# except that this one does not initialize the weigths and the rejected
+# point list, and it does not reject points after the fit, because it is
+# intended to be called from the data rejection procedure.
+
+procedure in_refitr (in, nl, x, y, wts, npts, nvars, wtflag)
+
+pointer	in				# INLFIT pointer
+pointer	nl				# NLFIT pointer
+real	x[ARB]				# Ordinates
+real	y[npts]				# Data to be fit
+real	wts[npts]			# Weights
+int	npts				# Number of points
+int	nvars				# Number of variables
+int	wtflag				# Type of weighting
+
+int	i, ndeleted, ier
+pointer	rejpts
+pointer	in_getp()
+int	in_geti()
+
+begin
+#	# Debug
+#	call eprintf ("in_refit: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+
+	# Assign a zero weight to each rejected point.
+	rejpts = in_getp (in, INLREJPTS)
+	do i = 1, npts {
+	    if (Memi[rejpts+i-1] == YES)
+		wts[i] = real (0.0)
+	}
+
+	# Reinitialize NLFIT.
+	call in_nlinitr (in, nl)
+
+	# Check number of data points.
+	if (npts == 0) {
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    return
+	}
+
+	# Check number of deleted points.
+	ndeleted = 0
+	do i = 1, npts {
+	    if (wts[i] <= real(0.0))
+		ndeleted = ndeleted + 1
+	}
+	if ((npts - ndeleted) < in_geti(in, INLNFPARAMS)) {
+	    call in_puti (in, INLFITERROR, NO_DEG_FREEDOM)
+	    return
+	}
+
+	# Refit.
+	call nlfitr (nl, x, y, wts, npts, nvars, wtflag, ier)
+
+	# Store fit status in the INLFIT structure.
+	call in_puti (in, INLFITERROR, ier)
+end
diff --git a/pkg/xtools/inlfit/inreject.gx b/pkg/xtools/inlfit/inreject.gx
new file mode 100644
index 00000000..5aad8596
--- /dev/null
+++ b/pkg/xtools/inlfit/inreject.gx
@@ -0,0 +1,72 @@
+include	<pkg/inlfit.h>
+
+
+# IN_REJECT -- Reject points with large residuals from the fit.
+# The sigma of the fit residuals is calculated.  The rejection thresholds
+# are set at low_reject*sigma and high_reject*sigma.  Points outside the
+# rejection threshold are rejected from the fit and flagged in the rejpts
+# array.  Finally, the remaining points are refit.
+
+procedure in_reject$t (in, nl, x, y, w, npts, nvars, wtflag)
+
+pointer	in				# INLFIT decriptor
+pointer	nl				# NLFIT decriptor
+PIXEL	x[ARB]				# Input ordinates (npts * nvars)
+PIXEL	y[npts]				# Input data values
+PIXEL	w[npts]				# Weights
+int	npts				# Number of input points
+int	nvars				# Number of variables
+int	wtflag				# Type of weighting
+
+int	i, nreject, newreject, niter
+PIXEL	low, high, grow
+pointer	sp, wts1, rejpts
+
+int	in_geti()
+PIXEL	in_get$t()
+pointer	in_getp()
+
+begin
+#	# Debug.
+#	call eprintf ("in_reject: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Get number of reject iterations, and return if they
+	# are less than one.
+	niter = in_geti (in, INLNREJECT)
+	if (niter < 1)
+	    return
+
+	call smark (sp)
+	call salloc (wts1, npts, TY_PIXEL)
+	call amov$t (w, Mem$t[wts1], npts)
+
+	# Get rejection parameters, and rejected point list.
+	low    = in_get$t (in, INLLOW)
+	high   = in_get$t (in, INLHIGH)
+	grow   = in_get$t (in, INLGROW)
+	rejpts = in_getp  (in, INLREJPTS)
+
+	# Loop looking for deviant points, and refitting.
+	do i = 1, niter {
+
+	    # Look for new deviant points.
+	    call in_deviant$t (nl, x, y, w, Memi[rejpts], npts, nvars, low,
+	        high, grow, nreject, newreject)
+
+	    # Refit if there are new rejected points.
+	    if (newreject != 0) {
+	        call amov$t (Mem$t[wts1], w, npts)
+		call in_refit$t (in, nl, x, y, w, npts, nvars, wtflag)
+	    } else
+		break
+	}
+
+	# Update number of rejected points.
+	call in_puti (in, INLNREJPTS, nreject + newreject)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/inrejectd.x b/pkg/xtools/inlfit/inrejectd.x
new file mode 100644
index 00000000..670cbce6
--- /dev/null
+++ b/pkg/xtools/inlfit/inrejectd.x
@@ -0,0 +1,72 @@
+include	<pkg/inlfit.h>
+
+
+# IN_REJECT -- Reject points with large residuals from the fit.
+# The sigma of the fit residuals is calculated.  The rejection thresholds
+# are set at low_reject*sigma and high_reject*sigma.  Points outside the
+# rejection threshold are rejected from the fit and flagged in the rejpts
+# array.  Finally, the remaining points are refit.
+
+procedure in_rejectd (in, nl, x, y, w, npts, nvars, wtflag)
+
+pointer	in				# INLFIT decriptor
+pointer	nl				# NLFIT decriptor
+double	x[ARB]				# Input ordinates (npts * nvars)
+double	y[npts]				# Input data values
+double	w[npts]				# Weights
+int	npts				# Number of input points
+int	nvars				# Number of variables
+int	wtflag				# Type of weighting
+
+int	i, nreject, newreject, niter
+double	low, high, grow
+pointer	sp, wts1, rejpts
+
+int	in_geti()
+double	in_getd()
+pointer	in_getp()
+
+begin
+#	# Debug.
+#	call eprintf ("in_reject: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Get number of reject iterations, and return if they
+	# are less than one.
+	niter = in_geti (in, INLNREJECT)
+	if (niter < 1)
+	    return
+
+	call smark (sp)
+	call salloc (wts1, npts, TY_DOUBLE)
+	call amovd (w, Memd[wts1], npts)
+
+	# Get rejection parameters, and rejected point list.
+	low    = in_getd (in, INLLOW)
+	high   = in_getd (in, INLHIGH)
+	grow   = in_getd (in, INLGROW)
+	rejpts = in_getp  (in, INLREJPTS)
+
+	# Loop looking for deviant points, and refitting.
+	do i = 1, niter {
+
+	    # Look for new deviant points.
+	    call in_deviantd (nl, x, y, w, Memi[rejpts], npts, nvars, low,
+	        high, grow, nreject, newreject)
+
+	    # Refit if there are new rejected points.
+	    if (newreject != 0) {
+	        call amovd (Memd[wts1], w, npts)
+		call in_refitd (in, nl, x, y, w, npts, nvars, wtflag)
+	    } else
+		break
+	}
+
+	# Update number of rejected points.
+	call in_puti (in, INLNREJPTS, nreject + newreject)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/inrejectr.x b/pkg/xtools/inlfit/inrejectr.x
new file mode 100644
index 00000000..98116fe9
--- /dev/null
+++ b/pkg/xtools/inlfit/inrejectr.x
@@ -0,0 +1,72 @@
+include	<pkg/inlfit.h>
+
+
+# IN_REJECT -- Reject points with large residuals from the fit.
+# The sigma of the fit residuals is calculated.  The rejection thresholds
+# are set at low_reject*sigma and high_reject*sigma.  Points outside the
+# rejection threshold are rejected from the fit and flagged in the rejpts
+# array.  Finally, the remaining points are refit.
+
+procedure in_rejectr (in, nl, x, y, w, npts, nvars, wtflag)
+
+pointer	in				# INLFIT decriptor
+pointer	nl				# NLFIT decriptor
+real	x[ARB]				# Input ordinates (npts * nvars)
+real	y[npts]				# Input data values
+real	w[npts]				# Weights
+int	npts				# Number of input points
+int	nvars				# Number of variables
+int	wtflag				# Type of weighting
+
+int	i, nreject, newreject, niter
+real	low, high, grow
+pointer	sp, wts1, rejpts
+
+int	in_geti()
+real	in_getr()
+pointer	in_getp()
+
+begin
+#	# Debug.
+#	call eprintf ("in_reject: in=%d, nl=%d, npts=%d, nvars=%d\n")
+#	    call pargi (in)
+#	    call pargi (nl)
+#	    call pargi (npts)
+#	    call pargi (nvars)
+
+	# Get number of reject iterations, and return if they
+	# are less than one.
+	niter = in_geti (in, INLNREJECT)
+	if (niter < 1)
+	    return
+
+	call smark (sp)
+	call salloc (wts1, npts, TY_REAL)
+	call amovr (w, Memr[wts1], npts)
+
+	# Get rejection parameters, and rejected point list.
+	low    = in_getr (in, INLLOW)
+	high   = in_getr (in, INLHIGH)
+	grow   = in_getr (in, INLGROW)
+	rejpts = in_getp  (in, INLREJPTS)
+
+	# Loop looking for deviant points, and refitting.
+	do i = 1, niter {
+
+	    # Look for new deviant points.
+	    call in_deviantr (nl, x, y, w, Memi[rejpts], npts, nvars, low,
+	        high, grow, nreject, newreject)
+
+	    # Refit if there are new rejected points.
+	    if (newreject != 0) {
+	        call amovr (Memr[wts1], w, npts)
+		call in_refitr (in, nl, x, y, w, npts, nvars, wtflag)
+	    } else
+		break
+	}
+
+	# Update number of rejected points.
+	call in_puti (in, INLNREJPTS, nreject + newreject)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/inlfit/inrms.gx b/pkg/xtools/inlfit/inrms.gx
new file mode 100644
index 00000000..a2c5015b
--- /dev/null
+++ b/pkg/xtools/inlfit/inrms.gx
@@ -0,0 +1,31 @@
+# IN_RMS -- Compute rms of points which have a non-zero weight.
+
+PIXEL procedure in_rms$t (y, fit, wts, npts)
+
+PIXEL	y[npts]		# function
+PIXEL	fit[npts]	# fit
+PIXEL	wts[npts]	# weights
+int	npts		# number of points
+
+int	i, ndata
+PIXEL	resid, rms
+
+begin
+	rms = PIXEL (0.0)
+	ndata = 0
+
+	do i = 1, npts {
+	    if (wts[i] == PIXEL (0.0))
+		next
+	    resid = y[i] - fit[i]
+	    rms = rms + resid * resid
+	    ndata = ndata + 1
+	}
+
+	if (ndata > 0)
+	    rms = sqrt (rms / ndata)
+	else
+	    rms = PIXEL (0.0)
+
+	return (rms)
+end
diff --git a/pkg/xtools/inlfit/inrmsd.x b/pkg/xtools/inlfit/inrmsd.x
new file mode 100644
index 00000000..26800de7
--- /dev/null
+++ b/pkg/xtools/inlfit/inrmsd.x
@@ -0,0 +1,31 @@
+# IN_RMS -- Compute rms of points which have a non-zero weight.
+
+double procedure in_rmsd (y, fit, wts, npts)
+
+double	y[npts]		# function
+double	fit[npts]	# fit
+double	wts[npts]	# weights
+int	npts		# number of points
+
+int	i, ndata
+double	resid, rms
+
+begin
+	rms = double (0.0)
+	ndata = 0
+
+	do i = 1, npts {
+	    if (wts[i] == double (0.0))
+		next
+	    resid = y[i] - fit[i]
+	    rms = rms + resid * resid
+	    ndata = ndata + 1
+	}
+
+	if (ndata > 0)
+	    rms = sqrt (rms / ndata)
+	else
+	    rms = double (0.0)
+
+	return (rms)
+end
diff --git a/pkg/xtools/inlfit/inrmsr.x b/pkg/xtools/inlfit/inrmsr.x
new file mode 100644
index 00000000..e28696a1
--- /dev/null
+++ b/pkg/xtools/inlfit/inrmsr.x
@@ -0,0 +1,31 @@
+# IN_RMS -- Compute rms of points which have a non-zero weight.
+
+real procedure in_rmsr (y, fit, wts, npts)
+
+real	y[npts]		# function
+real	fit[npts]	# fit
+real	wts[npts]	# weights
+int	npts		# number of points
+
+int	i, ndata
+real	resid, rms
+
+begin
+	rms = real (0.0)
+	ndata = 0
+
+	do i = 1, npts {
+	    if (wts[i] == real (0.0))
+		next
+	    resid = y[i] - fit[i]
+	    rms = rms + resid * resid
+	    ndata = ndata + 1
+	}
+
+	if (ndata > 0)
+	    rms = sqrt (rms / ndata)
+	else
+	    rms = real (0.0)
+
+	return (rms)
+end
diff --git a/pkg/xtools/inlfit/mkpkg b/pkg/xtools/inlfit/mkpkg
new file mode 100644
index 00000000..4dd38bfb
--- /dev/null
+++ b/pkg/xtools/inlfit/mkpkg
@@ -0,0 +1,122 @@
+# INLFIT mkpkg file
+
+$checkout	libxtools.a lib$
+$update		libxtools.a
+$checkin	libxtools.a lib$
+$exit
+
+generic:
+	$set	GEN = "$$generic -k -t rd"
+	$ifnewer (inget.gx, inget.x)
+	    $generic -k -o inget.x inget.gx
+	$endif
+	$ifnewer (input.gx, input.x)
+	    $generic -k -o input.x input.gx
+	$endif
+
+	$ifnewer (indump.gx,      indumpr.x)	$(GEN) indump.gx $endif
+
+	$ifnewer (incopy.gx,      incopyr.x)	$(GEN) incopy.gx $endif
+	$ifnewer (infree.gx,      infreer.x)	$(GEN) infree.gx $endif
+	$ifnewer (ininit.gx,      ininitr.x)	$(GEN) ininit.gx $endif
+	$ifnewer (innlinit.gx,    innlinitr.x)	$(GEN) innlinit.gx $endif
+
+	$ifnewer (indeviant.gx,   indeviantr.x)	$(GEN) indeviant.gx $endif
+	$ifnewer (inerrors.gx,    inerrorsr.x)	$(GEN) inerrors.gx $endif
+	$ifnewer (infit.gx,       infitr.x)	$(GEN) infit.gx $endif
+	$ifnewer (inlimit.gx,     inlimitr.x)	$(GEN) inlimit.gx $endif
+	$ifnewer (inrefit.gx,     inrefitr.x)	$(GEN) inrefit.gx $endif
+	$ifnewer (inreject.gx,    inrejectr.x)	$(GEN) inreject.gx $endif
+	$ifnewer (inrms.gx,       inrmsr.x)	$(GEN) inrms.gx $endif
+
+	$ifnewer (ingaxes.gx,     ingaxesr.x)	$(GEN) ingaxes.gx $endif
+	$ifnewer (ingcolon.gx,    ingcolonr.x)	$(GEN) ingcolon.gx $endif
+	$ifnewer (ingdata.gx,     ingdatar.x)	$(GEN) ingdata.gx $endif
+	$ifnewer (ingdelete.gx,   ingdeleter.x)	$(GEN) ingdelete.gx $endif
+	$ifnewer (ingerrors.gx,   ingerrorsr.x)	$(GEN) ingerrors.gx $endif
+	$ifnewer (ingfit.gx,      ingfitr.x)	$(GEN) ingfit.gx $endif
+	$ifnewer (inggraph.gx,    inggraphr.x)	$(GEN) inggraph.gx $endif
+	$ifnewer (ingnearest.gx,  ingnearestr.x) $(GEN) ingnearest.gx $endif
+	$ifnewer (ingparams.gx,   ingparamsr.x)	$(GEN) ingparams.gx $endif
+	$ifnewer (ingresults.gx,  ingresultsr.x) $(GEN) ingresults.gx $endif
+	$ifnewer (ingshow.gx,     ingshowr.x)	$(GEN) ingshow.gx $endif
+	$ifnewer (inguaxes.gx,    inguaxesr.x)	$(GEN) inguaxes.gx $endif
+	$ifnewer (ingucolon.gx,   ingucolonr.x)	$(GEN) ingucolon.gx $endif
+	$ifnewer (ingundelete.gx, ingundeleter.x) $(GEN) ingundelete.gx $endif
+	$ifnewer (ingvars.gx,     ingvarsr.x) $(GEN) ingvars.gx $endif
+	$ifnewer (ingvshow.gx,    ingvshowr.x)	$(GEN) ingvshow.gx $endif
+	;
+
+libxtools.a:
+
+	$ifeq (USE_GENERIC, yes) $call generic $endif
+
+	incopyd.x	<pkg/inlfit.h>   "inlfitdef.h"
+	incopyr.x	<pkg/inlfit.h>   "inlfitdef.h"
+	indeviantd.x	<mach.h>
+	indeviantr.x	<mach.h>
+	indumpd.x	<pkg/inlfit.h>    "inlfitdef.h"
+	indumpr.x	<pkg/inlfit.h>	  "inlfitdef.h"
+	inerrorsd.x	<pkg/inlfit.h>    <math/nlfit.h>
+	inerrorsr.x	<pkg/inlfit.h>    <math/nlfit.h>
+	infitd.x	<pkg/inlfit.h>    <math/nlfit.h>
+	infitr.x	<pkg/inlfit.h>    <math/nlfit.h>
+	infreed.x	"inlfitdef.h"
+	infreer.x	"inlfitdef.h"
+	ingaxesd.x	<pkg/inlfit.h> <pkg/gtools.h>
+	ingaxesr.x	<pkg/inlfit.h> <pkg/gtools.h>
+	ingcolond.x	<pkg/inlfit.h> <error.h> <gset.h>
+	ingcolonr.x	<pkg/inlfit.h> <error.h> <gset.h>
+	ingdatar.x	<pkg/inlfit.h>
+	ingdatad.x	<pkg/inlfit.h>
+	ingdefkey.x	<pkg/inlfit.h> "inlfitdef.h"
+	ingdeleted.x	<gset.h> <mach.h> <pkg/gtools.h>
+	ingdeleter.x	<gset.h> <mach.h> <pkg/gtools.h>
+	ingerrorsd.x	<pkg/inlfit.h> <math/nlfit.h>
+	ingerrorsr.x	<pkg/inlfit.h> <math/nlfit.h>
+	inget.x	        <pkg/inlfit.h> "inlfitdef.h"
+	ingfitd.x	<pkg/inlfit.h> <math/nlfit.h> <error.h> <mach.h>\
+			<pkg/gtools.h>
+	ingfitr.x	<pkg/inlfit.h> <math/nlfit.h> <error.h> <mach.h>\
+			<pkg/gtools.h>
+	inggetlabel.x	<pkg/inlfit.h>
+	inggraphd.x	<pkg/inlfit.h> <math/nlfit.h> <gset.h>\
+			<pkg/gtools.h>
+	inggraphr.x	<pkg/inlfit.h> <math/nlfit.h> <gset.h>\
+			<pkg/gtools.h>
+	ingnearestd.x	<mach.h> <pkg/gtools.h>
+	ingnearestr.x	<mach.h> <pkg/gtools.h>
+	ingparamsd.x	<pkg/inlfit.h> <math/nlfit.h> <pkg/gtools.h>
+	ingparamsr.x	<pkg/inlfit.h> <math/nlfit.h> <pkg/gtools.h>
+	ingresultsr.x	<pkg/inlfit.h>
+	ingresultsd.x	<pkg/inlfit.h>
+	ingshowd.x	<pkg/inlfit.h>
+	ingshowr.x	<pkg/inlfit.h>
+	inguaxesd.x	<pkg/inlfit.h> <math/nlfit.h>
+	inguaxesr.x	<pkg/inlfit.h> <math/nlfit.h>
+	ingucolond.x	
+	ingucolonr.x	
+	ingufit.x	
+	ingundeleted.x	<gset.h> <mach.h> <pkg/gtools.h>
+	ingundeleter.x	<gset.h> <mach.h> <pkg/gtools.h>
+	ingvarsr.x	<pkg/inlfit.h>
+	ingvarsd.x	<pkg/inlfit.h>
+	ingvshowd.x	<pkg/inlfit.h>
+	ingvshowr.x	<pkg/inlfit.h>
+	ininitd.x	<pkg/inlfit.h> "inlfitdef.h"
+	ininitr.x	<pkg/inlfit.h> "inlfitdef.h"
+	inlimitd.x	<pkg/inlfit.h>
+	inlimitr.x	<pkg/inlfit.h>
+	inlstrext.x	<ctype.h>
+	inlstrwrd.x	
+	innlinitd.x	"inlfitdef.h"
+	innlinitr.x	"inlfitdef.h"
+	input.x	        <pkg/inlfit.h> "inlfitdef.h"
+	inrefitd.x	<pkg/inlfit.h> <math/nlfit.h>
+	inrefitr.x	<pkg/inlfit.h> <math/nlfit.h>
+	inrejectd.x	<pkg/inlfit.h>
+	inrejectr.x	<pkg/inlfit.h>
+	inrmsd.x	
+	inrmsr.x	
+	ingtitle.x	<pkg/gtools.h>
+	;
diff --git a/pkg/xtools/intrp.f b/pkg/xtools/intrp.f
new file mode 100644
index 00000000..3ebb23bb
--- /dev/null
+++ b/pkg/xtools/intrp.f
@@ -0,0 +1,292 @@
+	subroutine intrp (itab, xtab, ytab, ntab, x, y, ierr)
+c
+c Interpolator using CODIM1 algorithm which is admittedly
+c obscure  but works well.
+c
+c	itab - a label between 1 and 20 to identify the table and its
+c              most recent search index
+c	xtab - array of length ntab containing the x-values
+c	ytab -                                     y-values
+c	ntab - number of x,y pairs in the table
+c	   x - independent for which a y-value is desired
+c	   y - returned interpolated (or extrapolated) value
+c	ierr - =0 for ok, -1 for extrapolation
+c
+	real xtab(ntab), ytab(ntab), x, y
+	integer itab, ierr
+	real t(4), u(4)
+c	integer savind
+c	data savind/-1/
+c
+c----- Only 1 pt in table
+	if (ntab .eq. 1) then
+		y = ytab(1)
+		ierr = 0
+		return
+	endif
+c
+c-----
+c Locate search index
+	call srch (itab, x, xtab, ntab, index, ierr)
+c	if (index .eq. savind) go to 2000
+c	savind = index
+c
+c-----
+c Set interpolator index flags
+	i1 = 2
+	i2 = 3
+	iload = max0 (index-2, 1)
+c
+	if (ntab .gt. 2) then
+		if (index.eq.   2) i2 = 4
+c
+		if (index.eq.ntab) i1 = 1
+	endif
+c
+	if (index.gt.2 .and. index.lt.ntab) then
+		i1 = 1
+		i2 = 4
+	endif
+c-----
+c Load interpolation arrays
+	do 1000 i = i1, i2
+		j = iload + (i-i1)
+		t(i) = xtab (j)
+		u(i) = ytab (j)
+1000	continue
+c
+c-----
+c Get interpolated value
+2000	call codim1 (x, t, u, i1, i2, y)
+	return
+	end
+c
+c--------------------------------------------------------------
+c
+	subroutine srch (itab, x, xtab, ntab, index, ierr)
+c
+c Search table of x-values to bracket the desired interpolant, x
+c
+c The returned search index will be:
+c	2 - if extrapolation below the table is required
+c    ntab -                  above
+c   index - points to value just above x in the table if bounded.
+c
+c The index is saved as a starting point for subsequent entries
+c in an array indexed through 'itab' which serves to label the
+c set of saved search indices. Itab may be between 1 and 20.
+c
+c	itab - The table identifier (1-20)
+c	   x - The value for which an index is desired
+c	xtab - The table containing the x-values (array of length ntab)
+c	ntab - number of elements in the table
+c      index - returned index into the table (points just above x)
+c	ierr - 0 for ok, -1 for extrapolation
+c
+	integer insave(20), ntab, index, ind
+	real xtab(ntab), x
+c
+c intialize insaved indices
+	data insave/20*0/
+c
+c-----
+c Determine direction of table, ascending or descending
+	idir = sign (1.0, xtab(ntab) - xtab(1))
+c
+c-----
+c Reset error flag
+	ierr = 0
+c
+c-----
+c Check for previous insaved index
+	last = insave(itab)
+	if (last .eq. 0 .or. last .gt. ntab) then
+c
+c-----
+c no previous entry
+		isrch = 1
+c check for extrapolation
+		if ((x-xtab(   1)) * idir .lt. 0.0) go to 2000
+		if ((x-xtab(ntab)) * idir .gt. 0.0) go to 2100
+	else
+c
+c-----
+c previous entry left a valid index
+		isrch = last
+c
+c check for still wihin bounds - difference from above should be opposite
+c                                sign of difference from below
+c
+		if ((xtab(last)-x) * (xtab(last-1)-x) .lt. 0.0) then
+			index = last
+			return
+		endif
+	endif
+c
+c -----
+c Begin searching - first determine direction
+c
+	if ((x - xtab(isrch)) * idir .gt. 0.0) then
+c forward
+		do 1100 i = isrch+1, ntab
+			if ((x-xtab(i)) * idir .gt. 0.0) go to 1100
+			go to 1500
+1100		continue
+c fall thru implies extrapolation required at high end
+		go to 2100
+	else
+c
+c-----
+c negative direction search
+		do 1200 i = isrch-1,1,-1
+			if ((x-xtab(i)) * idir .lt. 0.0) go to 1200
+			go to 1400
+1200		continue
+c fall through implies extrapolation at low end
+		go to 2000
+	endif
+c
+c-----
+c point has been bounded
+1400	index = i + 1
+	go to 3000
+1500	index = i
+	go to 3000
+c
+c-----
+c extrapolations
+2000	index = 2
+	ierr = -1
+	go to 3000
+2100	index = ntab
+	ierr = -1
+	go to 3000
+c
+c-----
+c insave index
+3000	insave(itab) = index
+	return
+c
+c------
+c Entry to reset saved index
+	entry intrp0 (itab)
+c
+	insave(itab) = 0
+	return
+c
+c-----
+c Entry to return current index
+	entry intrpi (itab, ind)
+c
+	ind = insave(itab)
+	return
+	end 
+c
+c-------------------------------------------------------------------
+c
+	subroutine codim1 (x, t, u, i1, i2, y)
+c
+c this subroutine performs an interposlation in a fashion
+c not really understandable, but it works well.
+c
+c	x - input independent variable
+c	t - array of 4 table independents surrounding x if possible
+c	u - array of 4 table dependents corresponding to the t array
+c
+c  i1, i2 - indicators as follows:
+c
+c	    i1 = 1, i2 = 4  :  4 pts available in t and u arrays
+c           i1 = 1, i2 = 3  :  3 pts available (x near right edge of table)
+c	    i1 = 2, i2 = 4  :                  (x near left  edge of table)
+c	    i1 = 2, i2 = 3  :  2 pts available
+c           i1 = 3, i3 = 3  :  1 pt  available
+c
+c	y - output interpolated (or extrapolated) dependent value
+c
+	real t(4), u(4), x, y
+	integer i1, i2
+c
+c variable xk affects the extrapolation procedure. a value of -1.0
+c appears to be a reliable value.
+c
+	data xk/-1.0/
+c
+	v = x
+c the following code is extracted from an original source
+c
+      a2=v-t(2)
+      al=a2/(t(3)-t(2))
+      s=al*u(3)+(1.-al)*u(2)
+      if(i1.gt.1.and.i2.lt.4)goto1530
+      a3=v-t(3)
+      if(i1.gt.1)goto1185
+1180  a1=v-t(1)
+      c1=a2/(t(1)-t(2))*a3/(t(1)-t(3))
+      c2=a1/(t(2)-t(1))*a3/(t(2)-t(3))
+      c3=a1/(t(3)-t(1))*a2/(t(3)-t(2))
+      p1=c1*u(1)+c2*u(2)+c3*u(3)
+      if(i2.lt.4)goto1400
+1185  a4=v-t(4)
+      c4=a3/(t(2)-t(3))*a4/(t(2)-t(4))
+      c5=a2/(t(3)-t(2))*a4/(t(3)-t(4))
+      c6=a2/(t(4)-t(2))*a3/(t(4)-t(3))
+      p2=c4*u(2)+c5*u(3)+c6*u(4)
+      if(i1.eq.1)goto1500
+1200  if(xk.lt.0.)goto1230
+      xe=xk
+      goto1260
+1230  slope1=abs((u(4)-u(3))/(t(4)-t(3)))
+      slope2=abs((u(3)-u(2))/(t(3)-t(2)))
+      xe=1.0
+      if(slope1+slope2.ne.0.)xe=1.-abs(slope1-slope2)/(slope1+slope2)
+1260  p1=s+xe*(p2-s)
+      goto1500
+1400  if(xk.lt.0.)goto1430
+      xe=xk
+      goto1460
+1430  slope1=abs((u(2)-u(1))/(t(2)-t(1)))
+      slope2=abs((u(3)-u(2))/(t(3)-t(2)))
+      xe=1.0
+      if(slope1+slope2.ne.0.)xe=1.-abs(slope1-slope2)/(slope1+slope2)
+1460  p2=s+xe*(p1-s)
+1500  e1=abs(p1-s)
+      e2=abs(p2-s)
+      if(e1+e2.gt.0.)goto1560
+1530  z=s
+      goto1700
+1560  bt=(e1*al)/(e1*al+(1.-al)*e2)
+      z=bt*p2+(1.-bt)*p1
+c
+1700	y = z
+	return
+	end
+c
+c----------------------------------------------------------------------
+c
+	subroutine lintrp (itab, xtab, ytab, ntab, x, y, ierr)
+c
+c Linear interpolator with last index save
+c
+c Arguments are identical to INTRP, and uses the same index search
+c scheme so that values for ITAB should not clash with calls
+c to INTRP and LINTRP.
+c
+	real xtab(ntab), ytab(ntab), x , y
+	integer itab, ierr
+c
+c----- Only 1 pt in table
+	if (ntab .eq. 1) then
+		y = ytab (1)
+		ierr = 0
+		return
+	endif
+c
+c-----locate search index
+	call srch (itab, x, xtab, ntab, index, ierr)
+c
+c----- index points just above x
+	y = ytab(index-1) + (x - xtab(index-1)) * 
+     1   (ytab(index) - ytab(index-1)) / (xtab(index) - xtab(index-1))
+c
+	return
+	end
diff --git a/pkg/xtools/isdir.x b/pkg/xtools/isdir.x
new file mode 100644
index 00000000..297c5cb8
--- /dev/null
+++ b/pkg/xtools/isdir.x
@@ -0,0 +1,69 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<finfo.h>
+
+# ISDIRECTORY -- Test whether the named file is a directory.  Check first to
+# see if it is a subdirectory of the current directory; otherwise look in
+# the environment to see if it is a logical directory.  If VFN is a directory,
+# return the OS pathname of the directory in pathname, and the number of
+# chars in the pathname as the function value.  Otherwise return 0.
+
+int procedure isdirectory (vfn, pathname, maxch)
+
+char	vfn[ARB]		# name to be tested
+char	pathname[ARB]		# receives path of directory
+int	maxch			# max chars out
+
+bool	isdir
+pointer	sp, fname, op
+int	ip, fd, nchars, ch
+long	file_info[LEN_FINFO]
+int	finfo(), diropen(), gstrcpy(), strlen()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Copy the VFN string, minus any whitespace on either end.
+	op = fname
+	for (ip=1;  vfn[ip] != EOS;  ip=ip+1) {
+	    ch = vfn[ip]
+	    if (!IS_WHITE (ch)) {
+		Memc[op] = ch
+		op = op + 1
+	    }
+	}
+	Memc[op] = EOS
+
+	isdir = false
+	if (finfo (Memc[fname], file_info) != ERR) {
+	    isdir = (FI_TYPE(file_info) == FI_DIRECTORY)
+
+	    if (isdir) {
+		call fdirname (Memc[fname], pathname, maxch)
+		nchars = strlen (pathname)
+	    }
+
+	} else {
+	    # If we get here, either VFN is a logical directory (with the
+	    # $ omitted), or it is the name of a new file.
+
+	    Memc[op] = '$'
+	    Memc[op+1] = EOS
+	    ifnoerr (fd = diropen (Memc[fname], 0)) {
+		call close (fd)
+		isdir = true
+	    }
+
+	    nchars = gstrcpy (Memc[fname], pathname, maxch)
+	}
+
+	call sfree (sp)
+	if (isdir)
+	    return (nchars)
+	else {
+	    pathname[1] = EOS
+	    return (0)
+	}
+end
diff --git a/pkg/xtools/mef/Notes b/pkg/xtools/mef/Notes
new file mode 100644
index 00000000..7f781840
--- /dev/null
+++ b/pkg/xtools/mef/Notes
@@ -0,0 +1,26 @@
+
+mefwrhdr.x
+	Previuolsy we changed the value of INHERIT to NO. Now we pass
+	the card to the output file unchanged with the exception when
+	the output file is new, then we do not pass it along. 3/4/98
+
+mefrdhdr.x
+	When a kernel section is given in the input file, it is
+	necessary to read the entire header in memory rather
+	than the 1st block. An error was found trying to get EXTNAME
+	value when the keyword was not located in the 1st block.
+	nz 10/2/03
+mefldhdr.x
+	New routine to read the entire header in memory. 10.02.03
+
+==================================================
+
+mefrdhdr.x
+	Change mef_rdhdr...() to be a function now rather than a
+	procedure. This way we can return and EOF value to the
+	calling routine.
+	revised. Used mef_ldhdr() now and discard rd1st and rd2end.
+	Took out any eprintf statement and made the code much simpler.
+	Jan.7.04
+
+
diff --git a/pkg/xtools/mef/mefappfile.x b/pkg/xtools/mef/mefappfile.x
new file mode 100644
index 00000000..eae4536b
--- /dev/null
+++ b/pkg/xtools/mef/mefappfile.x
@@ -0,0 +1,109 @@
+include <pkg/mef.h>
+
+# MEFFAPPFILE.X --  Set of routines to append a FITS units to an FITS file.
+#	meff_app_file(mefi, mefo)
+#	mef_pakwr (out, card)
+#	mef_wrpgcount (out)
+#	mef_wrblank (out, nlines)
+
+
+# MEF_APP_FILE -- Append a FITS file to an existant file. This means the
+# first input unit needs to be changed from a Primary to an Extension Unit.
+
+procedure mef_app_file (mefi, mefo)
+
+pointer	mefi	#I input mef descriptor	
+pointer	mefo	#O output mef descriptor	
+
+char    dname[1]
+int	off, status
+bool	in_phdu
+int	access(), mef_rdhdr_gn()
+
+errchk mef_rdhdr_gn
+
+begin
+
+	# If output file does not exist create a dummy extension
+	if (access(MEF_FNAME(mefo), 0,0) == NO) {
+	   dname[1] = EOS
+	   call mef_dummyhdr (MEF_FD(mefo),dname)
+	   MEF_ACMODE(mefo) = APPEND
+	}
+
+	in_phdu = true      # The input file has a PHDU
+
+	# Read the first input header unit (PHDU) and change to extension
+	# unit while writing to output file.
+	status = mef_rdhdr_gn (mefi,0)
+	if (status == EOF)
+	    call error (13, "EOF encountered on input file")
+	call mef_wrhdr (mefi, mefo, in_phdu)
+
+	# Check for dataless unit; if so the data pointer is at the
+	# end of the last header block.
+
+	if (MEF_POFF(mefi) == INDEFI)
+	    off = MEF_HOFF(mefi) + ((MEF_HSIZE(mefi)+2879)/2880)*1440
+	else
+	    off = MEF_POFF(mefi)
+
+	# Now copy the data
+	call seek (MEF_FD(mefi), off)
+	call fcopyo (MEF_FD(mefi), MEF_FD(mefo))
+end
+
+
+# MEF_PAKWR -- Pack a character buffer and write to the output buffer.
+
+procedure mef_pakwr (out, card)
+
+int 	out		#I Output file descriptor	
+char 	card[ARB]	#I Input FITS card
+
+begin
+	call achtcb (card, card, 80)
+	call write(out, card, 40)
+end
+
+
+# MEF_WRPGCOUNT -- Write PCOUNT and GCOUNT to the output buffer.
+
+procedure mef_wrpgcount (out)
+
+int	out		#I file descriptor
+
+char	line[80]
+
+begin
+	call mef_encodei ("PCOUNT", 0, line, "No 'random' parameters")
+	call mef_pakwr (out, line)
+	call mef_encodei ("GCOUNT", 1, line, "Only one group")
+	call mef_pakwr (out, line)
+end
+
+
+# MEF_WRBLANK --  Write a number of blank lines into the output buffer.
+# we reach the END card in the 1st block but we run out
+# to the 2nd block in the output file. Now fill it up
+# with blank.
+
+procedure mef_wrblank (out, olines)
+
+int	out		#I output file descriptor
+int	olines		#I number of blank lines
+
+int	nlines, i, nbk
+char    card[80]
+
+begin
+	   nlines = 36 - mod(olines,36) 
+
+	   do i =1, 80
+	      card[i] = ' '
+
+	   call achtcb (card, card, 80)
+	   for(i=1; i<=nlines; i=i+1) 
+	      call write(out, card, 40)
+	   return
+end
diff --git a/pkg/xtools/mef/mefclose.x b/pkg/xtools/mef/mefclose.x
new file mode 100644
index 00000000..cbae6d54
--- /dev/null
+++ b/pkg/xtools/mef/mefclose.x
@@ -0,0 +1,17 @@
+include <pkg/mef.h>
+
+# MEF_CLOSE -- Closes mef file descriptor and free up mef memory
+# descriptor.
+
+procedure mef_close(mef)
+
+pointer mef  	#I Mef descriptor
+
+begin
+	call close(MEF_FD(mef))
+
+	if (MEF_HDRP(mef) != NULL)
+	   call mfree(MEF_HDRP(mef), TY_CHAR)
+
+	call mfree (mef, TY_STRUCT)
+end
diff --git a/pkg/xtools/mef/mefcpextn.x b/pkg/xtools/mef/mefcpextn.x
new file mode 100644
index 00000000..b1d00af2
--- /dev/null
+++ b/pkg/xtools/mef/mefcpextn.x
@@ -0,0 +1,46 @@
+include <mach.h>
+include <pkg/mef.h>
+
+# MEF_COPY_EXTN -- Append a FITS unit to the output file.
+
+procedure mef_copy_extn (mefi, mefo, gn)
+
+pointer	mefi	#I input mef descriptor
+pointer	mefo	#I output mef descriptor
+int	gn      #I input group number
+
+char    ibuf[FITS_BLKSZ_CHAR]
+int	ndim, totpix, i, k, in, out, status
+int	read(), mef_rdhdr_gn(), mef_totpix()
+bool    iphdu
+
+errchk  mef_rdhdr_gn
+
+begin
+	iphdu = (gn == 0)
+
+	status = mef_rdhdr_gn (mefi, gn)
+	if (status == EOF)
+	   call error (13, " EOF encountered on input file")
+
+	call mef_wrhdr (mefi, mefo, iphdu)
+	MEF_ACMODE(mefo) = APPEND
+
+	# Count the pixels and write data. 
+	ndim = MEF_NDIM(mefi)
+        if (ndim > 0 || MEF_PCOUNT(mefi) > 0) {
+	    # Set in multiple of FITS_BLKSZ_CHAR
+	    totpix = mef_totpix(mefi)
+	    totpix = (totpix + 1439)/1440
+
+	    in = MEF_FD(mefi)
+	    out = MEF_FD(mefo)
+
+	    # Position the input file to the beginning of the pixel area.
+	    call seek (in, MEF_POFF(mefi))
+	    do i = 1, totpix {
+	        k = read (in, ibuf, 1440)
+	        call write (out, ibuf, 1440)
+	    }
+	}
+end
diff --git a/pkg/xtools/mef/mefdummyh.x b/pkg/xtools/mef/mefdummyh.x
new file mode 100644
index 00000000..ba0d38dd
--- /dev/null
+++ b/pkg/xtools/mef/mefdummyh.x
@@ -0,0 +1,84 @@
+include <pkg/mef.h>
+
+# MEF_DUMMYHDR -- Write a dummy Primary header Unit with no data to a new file.
+# Optionaly a header file with user keywords can be used.
+
+procedure mef_dummyhdr (out, hdrfname)
+
+int	out		#I File descriptor
+char	hdrfname[ARB]	#I Header filename
+
+char    card[LEN_CARD]
+pointer sp, path, op
+int	n, nlines, i, nchars, FD
+int	strlen(), open(), getline(), strncmp()
+
+begin
+	call smark(sp)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+
+	n = 0
+	call mef_encodeb ("SIMPLE", YES, card, "FITS STANDARD")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+	call mef_encodei ("BITPIX", 8, card, "Character information")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+	call mef_encodei ("NAXIS", 0, card, "No image data array present")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+	call mef_encodeb ("EXTEND", YES, card,
+	                         "There maybe standard extensions")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+        call mef_encodec ("ORIGIN", FITS_ORIGIN, strlen(FITS_ORIGIN),
+		           card, "FITS file originator")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+        call mef_encode_date (Memc[path], SZ_PATHNAME)
+	call mef_encodec ("DATE", Memc[path], strlen(Memc[path]), 
+			card, "Date FITS file was generated")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+	# Write a header file if one is given
+	if (hdrfname[1] != EOS) {
+	   fd = open (hdrfname, READ_ONLY, TEXT_FILE)
+	   nchars = getline(fd, Memc[path])
+	   repeat {
+	       if ((strncmp (Memc[path], "SIMPLE", 6) == 0) ||
+	           (strncmp (Memc[path], "BITPIX", 6) == 0) ||
+	           (strncmp (Memc[path], "NAXIS",  5) == 0) )
+	            nchars = getline(fd, Memc[path])
+	       for (op=nchars-1; op <= LEN_CARD; op=op+1)
+		   Memc[path+op] = ' '
+	       Memc[path+LEN_CARD] = EOS
+	       call mef_pakwr (out, Memc[path])
+	       n = n + 1
+	       if (n == 36)
+	           n = 0
+	       nchars = getline(fd, Memc[path])
+	   } until (nchars == EOF)
+	   call close (fd)
+	}
+
+        Memc[path] = ' '
+	call amovkc (Memc[path], card, 80)
+	call strcpy ("END", card, 3)
+	card[4] = ' '                           # Clear EOS mark
+	call mef_pakwr (out, card)
+
+	n = n + 1
+
+	call amovkc (" ", card, 80)
+	nlines = 36 - n
+	for (i=1; i<= nlines; i=i+1)
+	   call mef_pakwr (out, card)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/mef/mefencode.x b/pkg/xtools/mef/mefencode.x
new file mode 100644
index 00000000..57b5637d
--- /dev/null
+++ b/pkg/xtools/mef/mefencode.x
@@ -0,0 +1,530 @@
+include <time.h>
+include <pkg/mef.h>
+
+# MEFENCODE -- Routines to encode keyword, value and comment into a FITS card
+
+define  LEN_OBJECT  63
+define  CENTURY     1900
+
+# MEF_ENCODEB -- Procedure to encode a boolean parameter into a FITS card.
+
+procedure mef_encodeb (keyword, param, card, comment)
+
+char	keyword[ARB]	#I FITS keyword
+int	param		#I integer parameter equal to YES/NO
+char	card[ARB]	#O FITS card image
+char	comment[ARB]	#I FITS comment string
+
+char	truth
+
+begin
+	if (param == YES)
+	    truth = 'T'
+	else
+	    truth = 'F'
+
+	call sprintf (card, LEN_CARD, "%-8.8s= %20c / %-47.47s")
+	    call pargstr (keyword)
+	    call pargc (truth)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODEI -- Procedure to encode an integer parameter into a FITS card.
+
+procedure mef_encodei (keyword, param, card, comment)
+
+char	keyword[ARB]	#I FITS keyword
+int	param		#I integer parameter
+char	card[ARB]	#O FITS card image
+char	comment[ARB]	#I FITS comment string
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20d / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (param)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODEL -- Procedure to encode a long parameter into a FITS card.
+
+procedure mef_encodel (keyword, param, card, comment)
+
+char	keyword[ARB]		#I FITS keyword
+long	param			#I long integer parameter
+char	card[ARB]		#O FITS card image
+char	comment[ARB]		#I FITS comment string
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20d / %-47.47s")
+	    call pargstr (keyword)
+	    call pargl (param)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODER -- Procedure to encode a real parameter into a FITS card.
+
+procedure mef_encoder (keyword, param, card, comment, precision)
+
+char	keyword[ARB]		#I FITS keyword
+real	param			#I real parameter
+char	card[ARB]		#O FITS card image
+char	comment[ARB]		#I FITS comment card
+int	precision		#I precision of real
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20.*e / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargr (param)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODED -- Procedure to encode a double parameter into a FITS card.
+
+procedure mef_encoded (keyword, param, card, comment, precision)
+
+char	keyword[ARB]		#I FITS keyword
+double	param			#I double parameter
+char	card[ARB]		#O FITS card image
+char	comment[ARB]		#I FITS comment string
+int	precision		#I FITS precision
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20.*e / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargd (param)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODE_AXIS -- Procedure to add the axis number to axis dependent
+# keywords.
+
+procedure mef_encode_axis (root, keyword, axisno)
+
+char	root[ARB]		#I FITS root keyword
+char	keyword[ARB]		#O FITS keyword
+int	axisno			#I FITS axis number
+
+begin
+	call strcpy (root, keyword, SZ_KEYWORD)
+	call sprintf (keyword, SZ_KEYWORD, "%-5.5s%-3.3s")
+	    call pargstr (root)
+	    call pargi (axisno)
+end
+
+
+# MEF_ENCODEC -- Procedure to encode an IRAF string parameter into a FITS card.
+
+procedure mef_encodec (keyword, param, maxch, card, comment)
+
+char	keyword[LEN_CARD]	#I FITS keyword
+char	param[LEN_CARD]		#I FITS string parameter
+int	maxch			#I maximum number of characters in param
+char	card[LEN_CARD+1]	#O FITS card image
+char	comment[LEN_CARD]	#I comment string
+
+int	nblanks, maxchar, slashp
+
+begin
+	maxchar = max(8, min (maxch, LEN_OBJECT))
+	slashp = 32 
+	nblanks = LEN_CARD - (slashp + 1)
+	if (maxchar >= 19) {
+	   slashp = 1
+	   nblanks = max (LEN_OBJECT - maxchar - slashp+3, 1)
+	}
+        call sprintf (card, LEN_CARD, "%-8.8s= '%*.*s' %*t/ %*.*s")
+	    call pargstr (keyword)
+	    call pargi (-maxchar)
+	    call pargi (maxchar)
+	    call pargstr (param)
+	    call pargi (slashp)
+	    call pargi (-nblanks)
+	    call pargi (nblanks)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODE_DATE -- Procedure to encode the date in the form dd/mm/yy.
+
+procedure mef_encode_date (datestr, szdate)
+
+char	datestr[ARB]	# string containing the date
+int	szdate		# number of chars in the date string
+
+long	ctime
+int	time[LEN_TMSTRUCT]
+long	clktime()
+
+begin
+	ctime = clktime (long (0))
+	call brktime (ctime, time)
+
+	call sprintf (datestr, szdate, "%02s/%02s/%02s")
+	    call pargi (TM_MDAY(time))
+	    call pargi (TM_MONTH(time))
+	    call pargi (mod (TM_YEAR(time), CENTURY))
+end
+
+
+# MEF_AKWC -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwc (keyword, value, len, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# keyword name
+char	value[ARB]		# Keyword value
+int	len			# Lenght of value
+char	comment[ARB]		# Comment
+pointer	pn			# Pointer to a char area
+char	card[LEN_CARD]
+
+begin
+	call mef_encodec (keyword, value, len, card, comment)
+	call amovc (card, Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+end
+
+
+# MEF_AKWB -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwb (keyword, value, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+int	value			# I Keyword value (YES, NO)
+char	comment[ARB]		# I Comment
+pointer	pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+        call smark(sp)
+        call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call mef_encodeb (keyword, value, Memc[pc], comment)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree(sp)
+end
+
+
+# MEF_AKWI -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwi (keyword, value, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+int	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+pointer	pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+        call smark(sp)
+        call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call mef_encodei (keyword, value, Memc[pc], comment)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree(sp)
+end
+
+
+# MEF_AKWR -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwr (keyword, value, comment, precision,  pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+real	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+int	precision
+pointer	pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+        call smark(sp)
+        call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call mef_encoder (keyword, value, Memc[pc], comment, precision)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree(sp)
+end
+
+
+# MEF_AKWD -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwd (keyword, value, comment, precision, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+double	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+int	precision
+pointer	pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+        call smark(sp)
+        call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call mef_encoded (keyword, value, Memc[pc], comment, precision)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree(sp)
+end
+
+
+# NOTE: This local version of the xtools routine call handle starting
+# index of zero (0). Taken from dataio/lib and modified. NZ March, 98
+#
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+
+define	FIRST	1		# Default starting range
+define	LAST	MAX_INT		# Default ending range
+define	STEP	1		# Default step
+define	NULL	-1		# Ranges delimiter
+
+# DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas.  Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers.  ERR is returned as
+# the function value if a conversion error occurs.  The list of ranges is
+# delimited by a single NULL.
+
+int procedure ldecode_ranges (range_string, ranges, max_ranges, nvalues)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	nvalues			# The number of values in the ranges
+
+int	ip, nrange, first, last, step, ctoi()
+
+begin
+	ip = 1
+	nvalues = 0
+
+	do nrange = 1, max_ranges - 1 {
+	    # Defaults to all positive integers
+	    first = FIRST
+	    last = LAST
+	    step = STEP
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get first limit.
+	    # Must be a number, '-', 'x', or EOS.  If not return ERR.
+	    if (range_string[ip] == EOS) {			# end of list
+		if (nrange == 1) {
+		    # Null string defaults
+		    ranges[1, 1] = first
+		    ranges[2, 1] = last
+		    ranges[3, 1] = step
+		    ranges[1, 2] = NULL
+	    	    nvalues = nvalues + abs (last-first) / step + 1
+		    return (OK)
+		} else {
+		    ranges[1, nrange] = NULL
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, first) == 0)
+		    return (ERR)
+	    } else
+		return (ERR)
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get last limit
+	    # Must be '-', or 'x' otherwise last = first.
+	    if (range_string[ip] == 'x')
+		;
+	    else if (range_string[ip] == '-') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, last) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		last = first
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get step.
+	    # Must be 'x' or assume default step.
+	    if (range_string[ip] == 'x') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, step) == 0)
+		        ;
+		} else if (range_string[ip] == '-')
+		    ;
+		else
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    ranges[1, nrange] = first
+	    ranges[2, nrange] = last
+	    ranges[3, nrange] = step
+	    nvalues = nvalues + abs (last-first) / step + 1
+	}
+
+	return (ERR)					# ran out of space
+end
+
+
+# GET_NEXT_NUMBER -- Given a list of ranges and the current file number,
+# find and return the next file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically increasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure lget_next_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number+1 is anywhere in the list, that is the next number,
+	# otherwise the next number is the smallest number in the list which
+	# is greater than number+1.
+
+	number = number + 1
+	next_number = MAX_INT
+
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder + step <= last)
+		    next_number = number - remainder + step
+	    } else if (first > number)
+		next_number = min (next_number, first)
+	}
+
+	if (next_number == MAX_INT)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# GET_PREVIOUS_NUMBER -- Given a list of ranges and the current file number,
+# find and return the previous file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically decreasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure lget_previous_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number-1 is anywhere in the list, that is the previous number,
+	# otherwise the previous number is the largest number in the list which
+	# is less than number-1.
+
+	number = number - 1
+	next_number = 0
+
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder >= first)
+		    next_number = number - remainder
+	    } else if (last < number) {
+		remainder = mod (last - first, step)
+		if (remainder == 0)
+		    next_number = max (next_number, last)
+		else if (last - remainder >= first)
+		    next_number = max (next_number, last - remainder)
+	    }
+	}
+
+	if (next_number == 0)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# IS_IN_RANGE -- Test number to see if it is in range.
+
+bool procedure lis_in_range (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Number to be tested against ranges
+
+int	ip, first, last, step
+
+begin
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last)
+		if (mod (number - first, step) == 0)
+		    return (true)
+	}
+
+	return (false)
+end
diff --git a/pkg/xtools/mef/mefget.x b/pkg/xtools/mef/mefget.x
new file mode 100644
index 00000000..4860c99e
--- /dev/null
+++ b/pkg/xtools/mef/mefget.x
@@ -0,0 +1,183 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<pkg/mef.h>
+
+# MEFGETB -- Get an image header parameter of type boolean.  False is returned
+# if the parameter cannot be found or if the value is not true.
+
+bool procedure mefgetb (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+pointer	sp, kv, line
+int	strlen()
+bool    bval
+
+errchk mef_findkw
+
+begin
+	call smark (sp)
+	call salloc (kv, LEN_CARD, TY_CHAR)
+	call salloc (line, LEN_CARD, TY_CHAR)
+	
+	call mef_findkw (MEF_HDRP(mef), key, Memc[kv])
+	if (strlen(Memc[kv]) != 1) {
+	    call sprintf(Memc[line], LEN_CARD, "Invalid boolean value: '%s'")
+		 call pargstr (Memc[kv])
+	    call error (0,Memc[line]) 
+	}else
+	    bval = Memc[kv] == 'T'
+
+	call sfree (sp)
+	return (bval)
+end
+
+
+# MEFGETC -- Get an image header parameter of type char.
+
+char procedure mefgetc (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+long	mefgetl()
+
+begin
+	return (mefgetl (mef, key))
+end
+
+
+# MEFGETD -- Get an image header parameter of type double floating.  If the
+# named parameter is a standard parameter return the value directly,
+# else scan the user area for the named parameter and decode the value.
+
+double procedure mefgetd (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+int	ip
+double	dval
+pointer	sp, sval
+int	ctod()
+errchk	syserrs, mefgstr
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_LINE, TY_CHAR)
+
+	ip = 1
+	call mefgstr (mef, key, Memc[sval], SZ_LINE)
+	if(Memc[sval]==EOS)
+	    call syserrs (SYS_IDBKEYNF, key)
+	if (ctod (Memc[sval], ip, dval) == 0)
+	    call syserrs (SYS_IDBTYPE, key)
+
+	call sfree (sp)
+	return (dval)
+end
+
+
+# MEFGETI -- Get an image header parameter of type integer.
+
+int procedure mefgeti (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+long	lval, mefgetl()
+errchk	mefgetl
+
+begin
+	lval = mefgetl (mef, key)
+	if (IS_INDEFL(lval))
+	    return (INDEFI)
+	else
+	    return (lval)
+end
+
+
+# MEFGETL -- Get an image header parameter of type long integer.
+
+long procedure mefgetl (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+double	dval, mefgetd()
+errchk	mefgetd
+
+begin
+	dval = mefgetd (mef, key)
+	if (IS_INDEFD(dval))
+	    return (INDEFL)
+	else
+	    return (nint (dval))
+end
+
+
+# MEFGETR -- Get an image header parameter of type real.
+
+real procedure mefgetr (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+double	dval, mefgetd()
+errchk	mefgetd
+
+begin
+	dval = mefgetd (mef, key)
+	if (IS_INDEFD(dval))
+	    return (INDEFR)
+	else
+	    return (dval)
+end
+
+
+# MEFGETS -- Get an image header parameter of type short integer.
+
+short procedure mefgets (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+long	lval, mefgetl()
+errchk	mefgetl
+
+begin
+	lval = mefgetl (mef, key)
+	if (IS_INDEFL(lval))
+	    return (INDEFS)
+	else
+	    return (lval)
+end
+
+
+# MEFGSTR -- Get an image header parameter of type string.  If the named
+# parameter is a standard parameter return the value directly, else scan
+# the user area for the named parameter and decode the value.
+
+procedure mefgstr (mef, key, outstr, maxch)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+pointer	sp, kv
+
+begin
+	call smark (sp)
+	call salloc (kv, LEN_CARD, TY_CHAR)
+
+	# Find the record.
+	iferr (call mef_findkw (MEF_HDRP(mef), key, Memc[kv]))
+	    Memc[kv] = EOS
+
+	call strcpy (Memc[kv], outstr, min (maxch, LEN_CARD))
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/mef/mefgnbc.x b/pkg/xtools/mef/mefgnbc.x
new file mode 100644
index 00000000..2d370893
--- /dev/null
+++ b/pkg/xtools/mef/mefgnbc.x
@@ -0,0 +1,55 @@
+include <pkg/mef.h>
+
+# MEF_GNBC -- Get the Number of Blank Cards in a FITS header pointed by
+# mef. This is the number of cards available to insert before an expantion by
+# one block is required. If the header has not being read and EOF (-2) is
+# returned.
+
+int procedure mef_gnbc (mef)
+
+pointer mef
+
+int	len, hd, ip, nbc, hsize, k, ncards
+int	strlen(), strncmp()
+
+begin
+	if (MEF_HDRP(mef) == NULL)
+	    return (EOF)
+	    
+	hd = MEF_HDRP(mef)
+	len = strlen(Memc[hd])
+
+	# Go to the end of buffer and get last line
+
+	ip = hd + MEF_HSIZE(mef) - LEN_CARDNL
+	
+	# See if line is blank
+
+	nbc = 0
+	while (ip > 0) {
+	    do k = 0, LEN_CARD-1 
+		if (Memc[ip+k] != ' ')
+		    break
+
+	    if (k != LEN_CARD && k != 0)   # blank keyw card
+		break
+	    else if (k == 0) {
+		if (strncmp ("END     ", Memc[ip], 8) == 0) {
+	    	    ip = ip - LEN_CARDNL
+		    next
+		} else
+		    break
+	    } else
+		nbc = nbc + 1
+	    ip = ip - LEN_CARDNL
+	}
+
+	hsize = MEF_HSIZE(mef)
+	ncards = (hsize + 80)/81
+	
+	ncards = ((ncards + 35)/36)*36 - ncards
+	nbc = nbc + ncards
+
+	return (nbc)
+end
+
diff --git a/pkg/xtools/mef/mefgval.x b/pkg/xtools/mef/mefgval.x
new file mode 100644
index 00000000..aa481a2a
--- /dev/null
+++ b/pkg/xtools/mef/mefgval.x
@@ -0,0 +1,182 @@
+include	<ctype.h>
+include <pkg/mef.h>
+
+
+# MEFGVAL.X -- Set of routines to decode the value  of a FITS keyword given
+# the whole card.
+
+
+# MEF_GVALI -- Return the integer value of a FITS encoded card.
+
+procedure mef_gvali (card, ival)
+
+char	card[ARB]		#I card to be decoded
+int	ival			#O receives integer value
+
+int	ip, ctoi()
+char	sval[MEF_SZVALSTR]
+
+begin
+	call mef_gvalt (card, sval, MEF_SZVALSTR)
+	ip = 1
+	if (ctoi (sval, ip, ival) <= 0)
+	    ival = 0
+end
+
+
+# MEF_GVALR -- Return the real value of a FITS encoded card.
+
+procedure mef_gvalr (card, rval)
+
+char	card[ARB]		#I card to be decoded
+real	rval			#O receives integer value
+
+int	ip, ctor()
+char	sval[MEF_SZVALSTR]
+
+begin
+	call mef_gvalt (card, sval, MEF_SZVALSTR)
+	ip = 1
+	if (ctor (sval, ip, rval) <= 0)
+	    rval = 0.0
+end
+
+
+# MEF_GVALD -- Return the double value of a FITS encoded card.
+
+procedure mef_gvald (card, dval)
+
+char	card[ARB]		#I card to be decoded
+double	dval			#O receives integer value
+
+int	ip, ctod()
+char	sval[MEF_SZVALSTR]
+
+begin
+	call mef_gvalt (card, sval, MEF_SZVALSTR)
+	ip = 1
+	if (ctod (sval, ip, dval) <= 0)
+	    dval = 0.0
+end
+
+
+# MEF_GVALB -- Return the boolean/integer value of a FITS encoded card.
+
+procedure mef_gvalb (card, bval)
+
+char	card[ARB]		#I card to be decoded
+int	bval			#O receives YES/NO
+
+char	sval[MEF_SZVALSTR]
+
+begin
+	call mef_gvalt (card, sval, MEF_SZVALSTR)
+	if (sval[1] == 'T')
+	    bval = YES
+	else
+	    bval = NO
+end
+
+
+# MEF_GVALT -- Get the string value of a FITS encoded card.  Strip leading
+# and trailing whitespace and any quotes.
+
+procedure mef_gvalt (card, outstr, maxch)
+
+char	card[ARB]		#I FITS card to be decoded
+char	outstr[ARB]		#O output string to receive parameter value
+int	maxch			#I length of outstr
+
+int	ip, op
+int	ctowrd(), strlen()
+
+begin
+	ip = FITS_STARTVALUE
+	if (ctowrd (card, ip, outstr, maxch) > 0) {
+	    # Strip trailing whitespace.
+	    op = strlen (outstr)
+	    while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n'))
+		op = op - 1
+	    outstr[op+1] = EOS
+	} else
+	    outstr[1] = EOS
+end
+
+
+# MEF_GETCMT -- Get the comment field of a FITS encoded card.
+
+procedure mef_getcmt (card, comment, maxch)
+
+char	card[ARB]		#I FITS card to be decoded
+char	comment[ARB]		#O output string to receive comment
+int	maxch			#I max chars out
+
+int	ip, op
+int	lastch
+
+begin
+	# Find the slash which marks the beginning of the comment field.
+	ip = FITS_ENDVALUE + 1
+	while (card[ip] != EOS && card[ip] != '\n' && card[ip] != '/')
+	    ip = ip + 1
+
+	# Copy the comment to the output string, omitting the /, any
+	# trailing blanks, and the newline.
+
+	lastch = 0
+	do op = 1, maxch {
+	    if (card[ip] == EOS)
+		break
+	    ip = ip + 1
+	    comment[op] = card[ip]
+	    if (card[ip] > ' ')
+		lastch = op
+	}
+	comment[lastch+1] = EOS
+end
+
+
+# MEF_GLTM -- Procedure to convert an input time stream with hh:mm:ss
+#	     and date stream dd/mm/yy into seconds from jan 1st 1980.
+
+procedure mef_gltm (time, date, limtime)
+
+char    time[ARB]	#I time
+char	date[ARB]	#I date
+int	limtime		#O seconds
+
+int     hr,mn,sec,days,month,year, ip, iy, days_per_year, ctoi(),i
+int	month_to_days[12], adays
+
+data    month_to_days / 0,31,59,90,120,151,181,212,243,273,304,334/
+
+begin
+	ip = 1
+	ip = ctoi (time, ip, hr)
+	ip = 1 
+	ip = ctoi (time[4], ip, mn)
+	ip = 1 
+	ip = ctoi (time[7], ip, sec)
+
+	sec = sec + mn * 60 + hr * 3600
+
+	ip = 1
+	ip = ctoi (date, ip, days)
+	ip = 1 
+	ip = ctoi (date[4], ip, month)
+	ip = 1 
+	ip = ctoi (date[7], ip, year)
+
+	days_per_year = 0
+
+	iy = year + 1900
+	do i = 1, iy - 1980
+	    days_per_year = days_per_year + 365
+
+	adays= (year-80)/4
+	if (month > 2) adays=adays+1
+
+	days = adays + days-1 + days_per_year + month_to_days[month]
+
+	limtime = sec + days * 86400
+end
diff --git a/pkg/xtools/mef/mefkfind.x b/pkg/xtools/mef/mefkfind.x
new file mode 100644
index 00000000..bfcf393b
--- /dev/null
+++ b/pkg/xtools/mef/mefkfind.x
@@ -0,0 +1,75 @@
+include <syserr.h>
+include <pkg/mef.h>
+
+# MEF_FINDKW -- Search the header database for a particular keyword
+# and get its value. An error is returned if the keyword is not found.
+
+procedure mef_findkw (hdrp, key, keywval)
+
+pointer	hdrp			#I pointer to header buffer 
+char	key[ARB]		#I Keyword name
+char	keywval[ARB]		#O string value
+
+pointer	sp, ukey, lkey, ip
+int	nchars, lch, uch, ch, i
+int	gstrcpy()
+
+errchk  syserrs
+
+begin
+	call smark (sp)
+	call salloc (ukey, SZ_KEYWORD, TY_CHAR)
+	call salloc (lkey, SZ_KEYWORD, TY_CHAR)
+
+	# Prepare U/L FITS keywords, truncated to 8 chars.
+	nchars = gstrcpy (key, Memc[lkey], SZ_KEYWORD)
+	call strlwr (Memc[lkey])
+	nchars = gstrcpy (key, Memc[ukey], SZ_KEYWORD)
+	call strupr (Memc[ukey])
+
+	# Search for the FIRST occurrence of a record with the given key.
+
+	# Fixed length (80 character), newline terminated records, EOS
+	# terminated record group.
+
+	# Simple fast search, fixed length records.  Case insensitive
+	# keyword match.
+
+	lch = Memc[lkey]
+	uch = Memc[ukey]
+
+	for (ip=hdrp;  Memc[ip] != EOS;  ip=ip+LEN_CARDNL) {
+	    ch = Memc[ip]
+	    if (ch == EOS)
+		break
+	    else if (ch != lch && ch != uch)
+		next
+	    else {
+		# Abbreviations are not permitted.
+		ch = Memc[ip+nchars]
+		if (ch != ' ' && ch != '=')
+		  next
+	    }
+
+	    # First char matches; check rest of string.
+	    do i = 1, nchars-1 {
+		ch = Memc[ip+i]
+		if (ch != Memc[lkey+i] && ch != Memc[ukey+i]) {
+		    ch = 0
+		    break
+		}
+	    }
+
+	    if (ch != 0) {
+		#Copy card starting at ip
+		call mef_gvalt (Memc[ip], keywval, MEF_SZVALSTR)
+		call sfree (sp)
+		return
+	    }
+	}
+
+	# Keyword not found
+	call syserrs (SYS_IDBKEYNF, key)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/mef/mefksection.x b/pkg/xtools/mef/mefksection.x
new file mode 100644
index 00000000..e6a44b7b
--- /dev/null
+++ b/pkg/xtools/mef/mefksection.x
@@ -0,0 +1,174 @@
+include <ctotok.h>
+include <lexnum.h>
+include <pkg/mef.h>
+
+define	KS_EXTNAME	1
+define	KS_EXTVER	2
+
+# MEF_KSECTION -- Procedure to parse and analyze a string of the form
+#
+#  "(extname=)name,(extver=)23"
+#
+#   The numeric field is position depend if it does not have 'extver'.
+
+procedure mef_ksection (ksection, extname, extver)
+
+char 	ksection[ARB]	#I String with kernel section
+char	extname[ARB]	#O Extname
+int	extver		#O Extver
+
+int     ctotok(),ip, jp, nident, nexpr
+int	junk, nch, lexnum(), ty, token, ival
+char    outstr[LEN_CARD]
+char 	identif[LEN_CARD]
+int	lex_type, mef_klex(), ctoi()
+ 
+begin
+	
+        extname[1] = EOS
+        extver = INDEFL
+	ip = 1
+	nident = 0
+	nexpr = 0
+	identif[1] = EOS
+
+	repeat {
+	    # Advance to the next keyword.
+	    token = ctotok (ksection, ip, outstr, LEN_CARD)
+
+	    switch (token) {
+	    case TOK_EOS:
+		break
+	    case TOK_NEWLINE:
+		break
+	    case TOK_NUMBER:
+	       if (nexpr != 1)
+		  call error(13,
+		  "Numeric value only allow as second term in ksection")
+	       jp = 1
+	       ty = lexnum (outstr, jp, nch)
+	       if (ty != LEX_DECIMAL)
+		  call error(13, "Number is not decimal")
+	       jp = 1
+	       junk = ctoi(outstr, jp, ival)
+	       extver = ival
+	       nexpr = nexpr + 1
+	    case TOK_PUNCTUATION:
+		if (outstr[1] == ',' && identif[1] == EOS)
+		   call error(13,"syntax error in kernel section")
+	    case TOK_STRING:
+	       if (nexpr != 0)
+		  call error(13,
+		   "String value only allow as first term in ksection")
+
+		call strcpy (outstr, extname, LEN_CARD)
+	       nexpr = nexpr + 1
+	    case TOK_IDENTIFIER:
+		nident = nident + 1
+		call strcpy(outstr, identif, LEN_CARD] 
+		call strlwr(outstr)
+		lex_type = mef_klex (outstr)
+		# See if it is a reserved keyword.
+		jp = ip
+		# look for =, + or -
+	        if (lex_type > 0) {
+	            # Now see if of the type lex=<value> or lex+/-
+		    if (ctotok (ksection, ip, outstr, LEN_CARD) == 
+						TOK_OPERATOR) {
+		        if (outstr[1] == '=' ) {
+		            token = ctotok (ksection, ip, outstr, LEN_CARD)
+		            if (token != TOK_IDENTIFIER &&
+				token != TOK_STRING &&
+			        token != TOK_NUMBER)
+			           call error(13,
+				   "syntax error in kernel section")
+		             else
+		                 call mef_kvalue(outstr, lex_type, 
+					   extname, extver)
+	                } else
+		            ip = jp
+	            }
+	        } else {
+	            if (nexpr == 0)
+		        call strcpy (identif, extname, LEN_CARD)
+	            else {
+		        call error(13,
+		           "String value only allow as first term in ksection")
+	            }
+	        }
+		nexpr = nexpr + 1
+	    default:
+	        call error (13, "Syntax error in ksection")
+	    }
+	}	   
+end
+
+
+# MEF_KLEX -- Returns the lexival value of a parameter in string.
+
+int procedure mef_klex (outstr)
+
+char    outstr[ARB]	#I string
+
+int	len, strlen(), strncmp()
+char	tmp[LEN_CARD]
+
+begin
+	len = strlen(outstr)
+	# See if it is extname or extversion
+	if (strncmp (outstr, "ext", 3) == 0 && len < 8 ) {
+	   if (len == 3)
+	      call error(13, "'ext' is ambiguous in ksection")
+	   call strcpy ("name", tmp, 4)
+	   if (strncmp(outstr[4], tmp, len-3) == 0)
+	      return (KS_EXTNAME)
+	   else {
+	      call strcpy ("ver", tmp, 3)
+	      if (strncmp(outstr[4], tmp, len-3) == 0)
+		 return (KS_EXTVER)
+	   }
+	}
+
+	return (0)	# Is a value
+
+end
+
+
+define	ERROR   -2
+# MEF_KVALUE -- Get the value from a string of extname and extver.
+
+procedure mef_kvalue(outstr, lex_type, extname, extver)
+
+char	outstr[ARB]	#I Input string
+int	lex_type	#I Type of value
+char    extname[ARB]	#O Extname
+int	extver		#O Extver
+
+int	ty, lexnum(), ip, ival, ctoi(), nch, junk
+int	strcmp()
+
+begin
+	call strlwr(outstr)
+	if (strcmp (outstr, "yes") == 0)
+	   ival = YES
+	else if (strcmp (outstr, "no") == 0)
+	   ival = NO
+	else
+	   ival = ERROR
+
+	switch (lex_type) {
+	case  KS_EXTNAME:
+	   call strcpy (outstr, extname, LEN_CARD)
+	case  KS_EXTVER:
+	   ip = 1
+	   ty = lexnum (outstr, ip, nch)
+	   if (ty != LEX_DECIMAL)
+	      call error(13, "Number is not a decimal")
+	   ip = 1
+	   junk = ctoi(outstr, ip, ival)
+	   extver = ival
+	default:
+	     call error(13, "Syntax error in ksection")
+
+	}
+end
diff --git a/pkg/xtools/mef/mefldhdr.x b/pkg/xtools/mef/mefldhdr.x
new file mode 100644
index 00000000..c13d7802
--- /dev/null
+++ b/pkg/xtools/mef/mefldhdr.x
@@ -0,0 +1,118 @@
+include <error.h>
+include <mach.h>
+include <ctype.h>
+include <mii.h>
+include <pkg/mef.h>
+
+# MEF_LOAD_HEADER -- Load a FITS header from a file descriptor into a
+# spool file.
+
+int procedure mef_load_header (mef, spool, group)
+
+pointer mef			#I FITS descriptor
+int	spool			#I spool output file descriptor
+int	group			#I Currrent group
+
+pointer lbuf, sp, fb
+int	nchars, index, ncards, pcount, in
+int	mef_read_card(), mef_kctype()
+int	note()
+
+errchk  mef_read_card
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (fb, FITS_BLOCK_BYTES, TY_CHAR)
+
+	MEF_EXTNAME(mef) = EOS
+	MEF_EXTVER(mef) = INDEFL
+
+	in = MEF_FD(mef)
+	MEF_HOFF(mef) = note(in)
+
+	# Read successive lines of the FITS header. 
+	pcount = 0
+	ncards = 0
+	repeat {
+	    # Get the next input line.
+	    nchars = mef_read_card (in, Memc[fb], Memc[lbuf], ncards)
+	    if (nchars == EOF) {
+		call close (spool)
+		return (EOF)
+            }
+	    ncards = ncards + 1
+	    # A FITS header card already has 80 chars, just add the newline.
+	    Memc[lbuf+LEN_CARD] = '\n'
+	    Memc[lbuf+LEN_CARD+1] = EOS
+	    call putline (spool, Memc[lbuf])
+
+	    # Process the header card.
+	    switch (mef_kctype (Memc[lbuf], index)) {
+	    case END:
+		MEF_HSIZE(mef) = ncards*LEN_CARDNL
+		break
+	    case SIMPLE:
+		call strcpy ("SIMPLE", MEF_EXTTYPE(mef), SZ_EXTTYPE)
+	    case XTENSION:
+		call mef_gvalt (Memc[lbuf], MEF_EXTTYPE(mef), SZ_EXTTYPE)
+	    case EXTNAME:
+		call mef_gvalt (Memc[lbuf], MEF_EXTNAME(mef), LEN_CARD)
+	    case EXTVER:
+		call mef_gvali (Memc[lbuf], MEF_EXTVER(mef))
+	    case PCOUNT:
+		call mef_gvali (Memc[lbuf], pcount)
+		MEF_PCOUNT(mef) = pcount
+	    case BITPIX:
+		call mef_gvali (Memc[lbuf], MEF_BITPIX(mef))
+	    case NAXIS:
+		call mef_gvali (Memc[lbuf], MEF_NDIM(mef))
+	    case NAXISN:
+		 call mef_gvali (Memc[lbuf], MEF_NAXIS(mef,index))
+	    case OBJECT:
+		call mef_gvalt (Memc[lbuf], MEF_OBJECT(mef), MEF_SZVALSTR)
+	    default:
+		if (ncards == 1) {
+		    call sprintf(Memc[lbuf], SZ_LINE,
+		    "Header does not start with SIMPLE nor XTENSION: %s[%d]")
+		       call pargstr(MEF_FNAME(mef))
+		       call pargi(group)
+		    call error (13, Memc[lbuf])	
+		}
+	    }
+	}
+
+	call sfree (sp)
+	return (OK)
+end
+
+
+# MEF_GET_CARD -- Read a FITS header card.
+
+int procedure mef_read_card (fd, ibuf, obuf, ncards)
+
+int	fd			#I Input file descriptor
+char	ibuf[ARB]		#I input buffer
+char    obuf[ARB]		#O Output buffer
+int	ncards			#I ncards read so far
+
+int	ip, nchars_read
+int	read()
+errchk	read
+
+begin
+	# We read one FITS block first, read card from it until 36
+	# cards have been processed, where we read again.
+
+	if (mod (ncards, 36) == 0) {
+	    nchars_read = read (fd, ibuf, FITS_BLKSZ_CHAR)
+	    if (nchars_read ==  EOF)
+	        return (EOF)
+	    call miiupk (ibuf, ibuf, FITS_BLOCK_BYTES, MII_BYTE, TY_CHAR)
+	    ip = 1
+	}
+	
+	call amovc (ibuf[ip], obuf, LEN_CARD)
+	ip = ip + LEN_CARD
+
+	return (LEN_CARD)
+end
diff --git a/pkg/xtools/mef/mefopen.x b/pkg/xtools/mef/mefopen.x
new file mode 100644
index 00000000..a7a6529d
--- /dev/null
+++ b/pkg/xtools/mef/mefopen.x
@@ -0,0 +1,93 @@
+include <pkg/mef.h>
+
+# MEFOPEN --- Open a FITS extension, it can be the Primary or extension
+#	      unit, file.fits[0] for the PU or file.fits[extn] for the
+#	      Extension Unit.
+#
+#	filename.ext[abs#][extname,extver]
+#
+#	The absolute extension number (abs#) convention is zero for
+#	the Primary Unit.
+#
+
+
+# MEF_OPEN -- Open a FITS Unit from a file and returns its characteristics.
+
+pointer procedure mef_open (fitsfile, acmode, oldp)
+
+char	fitsfile[ARB]	#I Input FITS filename
+int	acmode		#I access mode
+pointer	oldp		#I Old Fits pointer or header size
+
+pointer	sp, ksec, section, mef
+int	group, clsize, open()
+
+begin
+        call smark (sp)
+	call salloc (ksec, LEN_CARD, TY_CHAR)
+	call salloc (section, LEN_CARD, TY_CHAR)
+
+	call calloc (mef, LEN_MEF, TY_STRUCT)
+
+	MEF_ACMODE(mef) = acmode
+
+	# Get filename components
+	call imparse (fitsfile, MEF_FNAME(mef), SZ_FNAME, Memc[ksec],
+		     LEN_CARD, Memc[section], LEN_CARD, group, clsize)
+
+	# Check if file has an extension and exists.
+	call mef_file_access (MEF_FNAME(mef), acmode)
+
+	if (Memc[section] != EOS) 
+	   call error(13, "mefopen: Image sections not allowed")
+
+	MEF_FD(mef) = open (MEF_FNAME(mef), acmode, BINARY_FILE)
+	MEF_ENUMBER(mef) = group
+	MEF_CGROUP(mef) = -1
+	MEF_KEEPXT(mef) = NO
+
+	call sfree (sp)
+	return(mef)
+end
+
+
+# MEF_FILE_ACCESS -- Check that file exists if READ* mode is given. Mainly we
+# want to check if there is an extension 'fits'. If file was given with no
+# extension, append .fits and see if exists.
+
+procedure mef_file_access (fname, acmode)
+
+char	fname[ARB]
+int	acmode
+
+pointer sp, fext, fn
+int	len, fnextn(), access(), strncmp()
+begin
+	if (acmode == NEW_FILE || acmode == NEW_COPY)
+	    return
+
+	call smark (sp)
+	call salloc (fext, SZ_FNAME, TY_CHAR)
+	call salloc (fn, SZ_FNAME, TY_CHAR)
+
+	call strcpy (fname, Memc[fn], SZ_FNAME)
+
+	len = fnextn (Memc[fn], Memc[fext], SZ_FNAME)
+
+	if (strncmp("fits", Memc[fext], 4) == 0)
+	    return
+
+	# See if file exists with no extension
+	if (access(fname, 0, 0) == YES)
+	    return
+	else {
+	    call strcat( ".fits", Memc[fn], SZ_FNAME)
+	    if (access(Memc[fn], 0, 0) == YES) {
+		call strcpy (Memc[fn], fname, SZ_FNAME)
+		return
+	    }
+	}
+
+	call sfree(sp)
+
+end
diff --git a/pkg/xtools/mef/mefrdhdr.x b/pkg/xtools/mef/mefrdhdr.x
new file mode 100644
index 00000000..a8ac45e8
--- /dev/null
+++ b/pkg/xtools/mef/mefrdhdr.x
@@ -0,0 +1,397 @@
+include <error.h>
+include <mach.h>
+include <ctype.h> 
+include <fset.h>
+include <pkg/mef.h>
+
+# MEFRDHR.X -- Routines to read FITS header units.
+#
+#     eof|stat = mef_rdhdr (mef, group, extname, extver)
+# 	         mef_skip_data_unit (mef)
+#	totpix = mef_totpix (mef)
+#     eof|stat = mef_rdhdr_gn (mef,gn)
+#     eof|stat = mef_rdhdr_exnv (mef,extname, extver)
+
+
+# MEF_RDHR -- Read FITS header on a mef file that matches EXTNAME/EXTVER or 
+# GROUP number. If both are specified, the former takes procedence.
+
+int procedure mef_rdhdr (mef, group, extname, extver)
+
+pointer	mef		#I Mef descriptor
+int	group 		#I Group number to read
+char    extname[ARB]    #I Extname to read		
+int	extver		#I Extver to read
+
+int	open(),in, cur_extn, note(), gnum
+int	spool
+bool	extnv, read_next_group
+int	mef_load_header(), mef_pixtype()
+bool    mef_cmp_extnv
+errchk	open, read, mef_load_header
+
+begin
+	if (group == MEF_CGROUP(mef))
+	    return (group)
+
+	gnum = group
+	if (MEF_FD(mef) == NULL) {
+	    MEF_FD(mef) = open (MEF_FNAME(mef), READ_ONLY, BINARY_FILE)
+	    MEF_ENUMBER(mef) = -1 
+	    MEF_CGROUP(mef) = -1 
+	} 
+	MEF_SKDATA(mef) = NO  
+
+	in = MEF_FD(mef)
+
+	extnv = extname[1] != EOS || extver != INDEFL
+	spool = open ("spool", NEW_FILE, SPOOL_FILE)
+
+	if (gnum == -1 || extnv)
+	    gnum = 0
+	   
+	cur_extn = MEF_CGROUP(mef)
+	read_next_group = true
+
+	repeat {
+	   # If we need to read the next group
+	   if (read_next_group) {
+
+	       cur_extn = cur_extn+1
+
+	       # See if this extension contains the correct 
+	       # extname/extver values.
+
+	       call fseti (spool, F_CANCEL, YES)
+	       if (mef_load_header (mef, spool, cur_extn) == EOF) {
+		   call close (spool)
+		   return (EOF)
+	       }			
+
+	       # We read the header already, marked the spot.
+	       MEF_POFF(mef) = note(in)
+
+	       if (extnv) {
+		   read_next_group = mef_cmp_extnv (mef, extname, extver)
+	       } else {
+		   if (gnum == cur_extn) 
+		       read_next_group = false
+	       }
+	       call mef_skip_data_unit (mef)
+	       next
+
+	   } else {			# This is the group we want
+	       if (MEF_HDRP(mef) != NULL)
+		   call mfree (MEF_HDRP(mef), TY_CHAR)
+
+	       call mef_cp_spool (spool, mef)
+	       MEF_CGROUP(mef) = cur_extn
+
+	       # To indicate that data has been skipped.
+	       MEF_SKDATA(mef) = YES  
+	       break
+	   }
+	}
+	call close (spool)
+	MEF_DATATYPE(mef) = mef_pixtype(mef)
+	return (cur_extn)
+end
+
+int procedure mef_pixtype (mef)
+pointer mef, hdrp
+bool    bfloat, lscale, lzero
+bool    fxf_fpl_equald()
+int	i, impixtype, ctod(), ip
+double  bscale, bzero
+char    sval[LEN_CARD]
+
+begin
+        hdrp= MEF_HDRP(mef)
+	bscale = 1.0d0
+	ip=1
+	ifnoerr (call mef_findkw (hdrp, "BSCALE", sval))
+	     i = ctod(sval,ip,bscale)
+	bzero = 0.0d0
+	ip=1
+	ifnoerr (call mef_findkw (hdrp, "BZERO", sval))
+	     i = ctod(sval,ip,bzero)
+
+	lscale = fxf_fpl_equald (1.0d0, bscale, 1)
+	lzero =  fxf_fpl_equald (0.0d0, bzero, 1)
+
+	# Determine if scaling is necessary.
+	bfloat = (!lscale || !lzero)
+
+	switch (MEF_BITPIX(mef)) {
+	case  8:
+	    if (bfloat)
+		impixtype = TY_REAL
+	    else
+		impixtype = TY_SHORT              # convert from byte to short
+	case 16:
+	    if (bfloat) {
+		impixtype = TY_REAL
+	    } else
+		impixtype = TY_SHORT
+
+	    if (lscale && fxf_fpl_equald (32768.0d0, bzero, 4)) {
+		impixtype = TY_USHORT
+	    }
+	case 32:
+	    if (bfloat)
+		impixtype = TY_REAL
+	    else
+		impixtype = TY_INT
+	case -32:
+	    impixtype = TY_REAL
+	case -64:
+	    impixtype = TY_DOUBLE
+	default:
+	    impixtype = ERR
+	}
+
+	return(impixtype)
+
+end
+
+# MEF_CMP_EXTNV -- Compare the EXTNAME and EXTVER header values with the
+#		  ones passed as arguments. Return false if matched.
+
+bool procedure mef_cmp_extnv (mef, extname, extver)
+pointer	mef
+char	extname[ARB] 	#I extname value
+int	extver		#I extver value
+
+int	mef_strcmp_lwr()
+bool	bxtn, bxtv, bval, bxtn_eq, bxtv_eq
+
+begin
+	bxtn = extname[1] != EOS
+	bxtv = extver != INDEFL
+
+	if (bxtn)
+	    bxtn_eq = (mef_strcmp_lwr(MEF_EXTNAME(mef), extname) == 0)
+	if (bxtv)
+	    bxtv_eq = (MEF_EXTVER(mef) == extver)
+	
+	if (bxtn && bxtv)
+	    # Both EXTNAME and EXTVER are defined.
+	    bval = bxtn_eq && bxtv_eq
+	else if (bxtn && !bxtv)
+	    # Only EXTNAME is defined.
+	    bval = bxtn_eq
+	else if (!bxtn && bxtv)
+	    # Only EXTVER is defined.
+	    bval = bxtv_eq 
+	else
+	    bval = false
+
+	return (!bval)
+end
+
+# MEF_SKIP_DATA_UNIT -- Skip data unit. The file is already position at the
+# end of the last header block.
+
+procedure mef_skip_data_unit (mef)
+
+pointer	mef	#I Input mef descriptor
+
+int	in, ndim, off, note(), mef_totpix()
+errchk  seek
+
+begin
+	# See if data portion has already been skipped.
+	if (MEF_SKDATA(mef) == YES)
+	    return
+
+	in = MEF_FD(mef)
+	ndim = MEF_NDIM (mef)
+        if (ndim > 0 || MEF_PCOUNT(mef) > 0) {
+	   # Skip to the beginning of next extension
+	   off = note(in)
+	   if (off == EOF)
+	      return
+	   off = off + mef_totpix(mef)
+	   call seek (in, off)
+	}
+end
+
+
+# MEF_TOTPIX -- Returns the number of pixels in the data area in units
+#		of chars.
+
+int procedure mef_totpix (mef)
+
+pointer	mef		#I Mef descriptor
+
+int	ndim, totpix, i, bitpix
+
+begin
+	ndim = MEF_NDIM (mef)
+	if (ndim == 0 && MEF_PCOUNT(mef) <= 0)
+	    return (0)
+
+	if (ndim == 0)
+	    totpix = 0
+	else {
+	    totpix = MEF_NAXIS(mef,1) 
+	    do i = 2, ndim
+		  totpix = totpix *  MEF_NAXIS(mef,i)
+	}
+	bitpix = abs(MEF_BITPIX(mef))
+
+	# If PCOUNT is not zero, add it to totpix
+	totpix = MEF_PCOUNT(mef) + totpix
+
+	if (bitpix <= NBITS_BYTE)
+	    totpix = (totpix + 1) / SZB_CHAR
+	else
+	    totpix = totpix * (bitpix / (SZB_CHAR * NBITS_BYTE))
+
+	# Set the number of characters in multiple of 1440.
+	totpix = ((totpix + 1439)/1440) * 1440
+	return (totpix)
+end
+
+
+# MEF_STRCMP_LWR -- Compare 2 strings in lower case
+
+int procedure mef_strcmp_lwr (s1, s2)
+
+char s1[ARB], s2[ARB]
+
+pointer sp, l1, l2
+int	strcmp(), istat
+
+begin
+	call smark(sp)
+	call salloc (l1, SZ_FNAME, TY_CHAR)
+	call salloc (l2, SZ_FNAME, TY_CHAR)
+
+	call strcpy (s1, Memc[l1], SZ_FNAME)
+	call strcpy (s2, Memc[l2], SZ_FNAME)
+	call strlwr(Memc[l1])
+	call strlwr(Memc[l2])
+	istat = strcmp (Memc[l1], Memc[l2])
+
+	call sfree(sp)
+	return (istat)
+end
+
+
+# MEF_KCTYPE -- Find the type of card that is based on the keyword name.
+
+int procedure mef_kctype (card, index)
+
+char	card[ARB]	#I FITS card
+int	index		#O index value
+
+int	strncmp()
+
+begin
+	if (strncmp (card, "SIMPLE  ", 8) == 0)
+	   return (SIMPLE)
+	if (strncmp (card, "NAXIS", 5) == 0) {
+	   if (card[6] == ' ') {
+	      call mef_gvali (card, index)
+	      return (NAXIS)
+    	   } else  if (IS_DIGIT(card[6])) {
+	       index = TO_INTEG(card[6])
+	       return (NAXISN)                      # NAXISn
+     	   }
+	}
+	if (strncmp (card, "BITPIX  ", 8) == 0)
+	   return (BITPIX)
+	if (strncmp (card, "EXTNAME ", 8) == 0)
+	   return (EXTNAME)
+	if (strncmp (card, "EXTVER  ", 8) == 0)
+	   return (EXTVER)
+	if (strncmp (card, "EXTEND  ", 8) == 0)
+	   return (EXTEND)
+	if (strncmp (card, "PCOUNT  ", 8) == 0)
+	   return (PCOUNT)
+	if (strncmp (card, "FILENAME", 8) == 0)
+	   return (FILENAME)
+	if (strncmp (card, "INHERIT ", 8) == 0)
+	   return (INHERIT)
+	if (strncmp (card, "GCOUNT  ", 8) == 0)
+	   return (GCOUNT)
+	if (strncmp (card, "OBJECT  ", 8) == 0)
+	   return (OBJECT)
+	if (strncmp (card, "XTENSION", 8) == 0)
+	   return (XTENSION)
+	if (strncmp (card, "END     ", 8) == 0)
+	   return (END)
+
+        return(ERR)
+end
+
+
+# MEF_RDHDR_GN -- Read group based on group number
+
+int procedure mef_rdhdr_gn (mef,gn)
+
+pointer	mef 		#I mef descriptor
+int	gn		#I group number to read
+
+char	extname[MEF_SZVALSTR]
+int	extver
+int	mef_rdhdr()
+
+errchk  mef_rdhdr
+
+begin
+	extname[1] =EOS
+	extver=INDEFL
+	return (mef_rdhdr (mef, gn, extname, extver))
+end
+
+
+# MEF_RDHDR_EXNV -- Read group based on the Extname and Extver values
+
+int procedure mef_rdhdr_exnv (mef,extname, extver)
+
+pointer	mef		#I, mef descriptor
+char	extname[ARB]	#I, extname value
+int	extver		#I, extver value
+int     mef_rdhdr()
+
+errchk  mef_rdhdr
+
+begin
+	return (mef_rdhdr (mef, 0, extname, extver))
+end
+
+
+# MEF_CP_SPOOL -- 
+
+procedure mef_cp_spool (spool, mef)
+
+int	spool 		#I spool file descriptor
+pointer mef		#
+
+pointer	hdr, lbuf, sp
+int	fitslen, fstatl, user
+int	stropen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	call seek (spool, BOFL)
+	fitslen = fstatl (spool, F_FILESIZE)
+	fitslen = max (fitslen, MEF_HSIZE(mef))
+	call malloc (hdr, fitslen, TY_CHAR)
+	user = stropen (Memc[hdr], fitslen, NEW_FILE)
+
+	# Append the saved FITS cards to saved cache.
+	while (getline (spool, Memc[lbuf]) != EOF)
+	    call putline (user, Memc[lbuf])
+
+	call close (user)
+	call close (spool)
+
+	MEF_HDRP(mef) = hdr
+
+	call sfree(sp)
+end
diff --git a/pkg/xtools/mef/mefrdhdr.x_save b/pkg/xtools/mef/mefrdhdr.x_save
new file mode 100644
index 00000000..a46d5d04
--- /dev/null
+++ b/pkg/xtools/mef/mefrdhdr.x_save
@@ -0,0 +1,529 @@
+include <error.h>
+include <mach.h>
+include <ctype.h> 
+include <fset.h>
+include <mef.h>
+
+# MEFRDHR.X -- Routines to read FITS header units.
+#
+# 	         mef_rdhdr (mef, group, extname, extver)
+# 	         mef_rdblk (in, spp_buf)
+# 	         mef_skip_data_unit (mef)
+#	totpix = mef_totpix (mef)
+# 	         mef_rd2end (mef, read_next_group)
+# 	         mef_rdhdr_gn (mef,gn)
+# 	         mef_rdhdr_exnv (mef,extname, extver)
+
+
+# MEF_RDHR -- Read FITS header on a mef file that matches EXTNAME/EXTVER or 
+# GROUP number. If both are specified, the former takes procedence.
+
+procedure mef_rdhdr (mef, group, extname, extver)
+
+pointer	mef		#I Mef descriptor
+int	group 		#I Group number to read
+char    extname[ARB]    #I Extname to read		
+int	extver		#I Extver to read
+
+int	open(),in, cur_extn, note(), gnum
+int	spool
+char	spp_buf[FITS_BLKSZ_NL]
+bool	extnv, end_card, read_next_group, mef_rd1st()
+bool    mef_cmp_extnv
+errchk	open, read, mef_rd1st, mef_load_header
+
+begin
+	if (group == MEF_CGROUP(mef))
+	    return
+
+	gnum = group
+	if (MEF_FD(mef) == NULL) {
+	    MEF_FD(mef) = open (MEF_FNAME(mef), READ_ONLY, BINARY_FILE)
+	    MEF_ENUMBER(mef) = -1 
+	    MEF_CGROUP(mef) = -1 
+	} 
+	MEF_SKDATA(mef) = NO  
+
+	in = MEF_FD(mef)
+
+	extnv = extname[1] != EOS || extver != INDEFL
+	if (extnv)
+	   spool = open ("spool", NEW_FILE, SPOOL_FILE)
+
+	if (gnum == -1 || extnv)
+	    gnum = 0
+#	else if (gnum != -1 && extnv)
+#	    gnum = -1			# EXTNAME/EXTVER takes precedence
+	   
+	cur_extn = MEF_CGROUP(mef)
+#	if (cur_extn < 0) 
+#	    cur_extn = -1	        # Ready to read PHU
+	read_next_group = true
+
+	repeat {
+	   # If we need to read the next group
+	   if (read_next_group) {
+	       # Read 1st block 
+	       cur_extn = cur_extn+1
+
+	       # See if this extension contains the correct 
+	       # extname/extver values.
+
+	       if (extnv) {
+		   end_card = true
+		   # We are not sure if extname or extver are in the
+		   # 1st block.
+	           call fseti (spool, F_CANCEL, YES)
+		   call mef_load_header (mef, spool)
+#		   iferr (call mef_load_header (mef, spool)) {
+#		       call erract(EA_WARN)
+#		   }
+
+		   read_next_group = mef_cmp_extnv (mef, extname, extver)
+		   MEF_POFF(mef) = note(in)
+		   call mef_skip_data_unit (mef)
+		   next
+	       } else {
+	           end_card = mef_rd1st (mef, spp_buf) 
+		   if (gnum == cur_extn) 
+		       read_next_group = false
+	       }
+
+	       if (read_next_group) {
+		   if (!end_card)
+		       call mef_rd2end (mef, read_next_group)
+		   call mef_skip_data_unit (mef)
+	       }
+	   } else {			# This is the group we want
+	       if (MEF_HDRP(mef) != NULL)
+		   call mfree (MEF_HDRP(mef), TY_CHAR)
+	       if (end_card) {
+		   if (extnv) {
+		       call mef_cp_spool (spool, mef)
+                       cur_extn = cur_extn + 1
+		   } else {
+		       call malloc (MEF_HDRP(mef), MEF_HSIZE(mef)+1, TY_CHAR)
+		       call amovc (spp_buf, Memc[MEF_HDRP(mef)], MEF_HSIZE(mef))
+		       Memc[MEF_HDRP(mef)+MEF_HSIZE(mef)] = EOS
+		   }
+	       } else {
+		   call malloc (MEF_HDRP(mef), FITS_BLKSZ_NL, TY_CHAR)
+		   call amovc (spp_buf, Memc[MEF_HDRP(mef)], FITS_BLKSZ_NL)
+		   call mef_rd2end (mef, read_next_group)
+	       }
+	       if (!extnv) {
+		   if (MEF_NDIM(mef) != 0 || MEF_PCOUNT(mef) > 0) 
+		       MEF_POFF(mef) = note(in)
+		   else
+		       MEF_POFF(mef) = INDEFL
+	           call mef_skip_data_unit (mef)
+	       }
+	       MEF_CGROUP(mef) = cur_extn
+
+	       # To indicate that data has been skipped.
+	       MEF_SKDATA(mef) = YES  
+
+	       return
+	   }
+	}
+end
+
+
+# MEF_RD1ST -- Handle the 1st FITS header block.
+# Return true if the END card is in this 1st block.
+
+bool procedure	mef_rd1st (mef, hbuf)
+
+pointer mef		#I Mef descriptor
+char	hbuf[ARB]	#O Buffer containing the first block of a unit
+
+int	in, k, i, index, mef_kctype()
+int	strncmp(), note()
+pointer	sp, errmsg
+
+errchk  mef_rdblk
+
+begin
+	in = MEF_FD(mef)
+
+	# Read 1st block.
+ 	MEF_HOFF(mef) = note(in)
+	call mef_rdblk (in, hbuf)
+
+	MEF_EXTNAME(mef) = EOS
+	MEF_EXTVER(mef) = INDEFL
+	k = 1
+        # Verify FITS header
+	if (strncmp (hbuf[k], "SIMPLE  ", 8) != 0 &&
+	    strncmp (hbuf[k], "XTENSION", 8) != 0 ) {
+            call smark (sp)
+            call salloc (errmsg, SZ_LINE, TY_CHAR)
+            call sprintf (Memc[errmsg], SZ_LINE, "Extension %s[%d] is not FITS.")
+                call pargstr(MEF_FNAME(mef))
+                call pargi(MEF_CGROUP(mef))
+            call error (13, Memc[errmsg])
+#            iferr (call error (13, Memc[errmsg])) {
+#                call sfree (sp)
+#                call erract (EA_ERROR)
+#            }
+	} else {
+	    call mef_gvalt (hbuf[k], MEF_EXTTYPE(mef), MEF_SZVALSTR)
+	    if (strncmp (hbuf[k], "SIMPLE  ", 8) == 0)
+	        call strcpy (MEF_FNAME(mef), MEF_EXTTYPE(mef), MEF_SZVALSTR)
+	}
+	k = k + LEN_CARDNL
+
+	MEF_PCOUNT(mef) = 0
+
+	for (i=2; i< 37; i=i+1) {
+           switch (mef_kctype(hbuf[k], index)) {
+	   case NAXIS:
+	      MEF_NDIM(mef) = index
+	   case NAXISN:
+	      call mef_gvali (hbuf[k], MEF_NAXIS(mef,index))
+	   case BITPIX:
+	      call mef_gvali (hbuf[k], MEF_BITPIX(mef))
+	   case EXTNAME:
+	      call mef_gvalt (hbuf[k], MEF_EXTNAME(mef), MEF_SZVALSTR)
+	   case EXTVER:
+	      call mef_gvali (hbuf[k], MEF_EXTVER(mef))
+	   case PCOUNT:
+	      call mef_gvali (hbuf[k], MEF_PCOUNT(mef))
+	   case OBJECT:
+	      call mef_gvalt (hbuf[k], MEF_OBJECT(mef), MEF_SZVALSTR)
+	   case END:
+	      MEF_HSIZE(mef) = i*LEN_CARDNL
+              return(true)	
+	      break
+	   default:
+	      ;
+	   }
+	   k = k + LEN_CARDNL
+	}
+	return(false)
+	    
+end
+
+
+# MEF_RDBLK -- Read one header FITS block from disk and add a newline 
+# after each fits record (80 chars).
+
+procedure mef_rdblk (in, spp_buf)
+
+int	in		#I File descriptor
+char    spp_buf[ARB]	#O Buffer with header
+
+char    ibuf[FITS_BLKSZ_CHAR]
+int     nchar, i, read(), k, j
+char    line[LEN_CARD]
+
+begin
+	nchar = read (in, ibuf, FITS_BLKSZ_CHAR)
+	if (nchar == EOF) 
+	   call error(13, "EOF encountered")
+
+	# Unpack the input buffer to spp char with new_line delimited records.
+	line[LEN_CARDNL] = '\n'
+	k = 1
+	j = 1
+	for (i=1; i<37; i=i+1) {
+   	   call achtbc(ibuf[k], line, LEN_CARD)
+	   call amovc (line, spp_buf[j], LEN_CARDNL)
+	   k = k + 40		
+	   j = j + LEN_CARDNL
+	}
+end	 
+
+
+# MEF_CMP_EXTNV -- Compare the EXTNAME and EXTVER header values with the
+#		  ones passed as arguments. Return false if matched.
+
+bool procedure mef_cmp_extnv (mef, extname, extver)
+pointer	mef
+char	extname[ARB] 	#I extname value
+int	extver		#I extver value
+
+int	mef_strcmp_lwr()
+bool	bxtn, bxtv, bval, bxtn_eq, bxtv_eq
+
+begin
+	bxtn = extname[1] != EOS
+	bxtv = extver != INDEFL
+
+	if (bxtn)
+	    bxtn_eq = (mef_strcmp_lwr(MEF_EXTNAME(mef), extname) == 0)
+	if (bxtv)
+	    bxtv_eq = (MEF_EXTVER(mef) == extver)
+	
+	if (bxtn && bxtv)
+	    # Both EXTNAME and EXTVER are defined.
+	    bval = bxtn_eq && bxtv_eq
+	else if (bxtn && !bxtv)
+	    # Only EXTNAME is defined.
+	    bval = bxtn_eq
+	else if (!bxtn && bxtv)
+	    # Only EXTVER is defined.
+	    bval = bxtv_eq 
+	else
+	    bval = false
+
+	return (!bval)
+end
+
+# MEF_SKIP_DATA_UNIT -- Skip data unit. The file is already position at the
+# end of the last header block.
+
+procedure mef_skip_data_unit (mef)
+
+pointer	mef	#I Input mef descriptor
+
+int	in, ndim, off, note(), mef_totpix()
+errchk  seek
+
+begin
+	# See if data portion has already been skipped.
+	if (MEF_SKDATA(mef) == YES)
+	    return
+
+	in = MEF_FD(mef)
+	ndim = MEF_NDIM (mef)
+        if (ndim > 0 || MEF_PCOUNT(mef) > 0) {
+	   # Skip to the beginning of next extension
+	   off = note(in)
+	   if (off == EOF)
+	      return
+	   off = off + mef_totpix(mef)
+	   call seek (in, off)
+	}
+end
+
+
+# MEF_TOTPIX -- Returns the number of pixels in the data area in units
+#		of chars.
+
+int procedure mef_totpix (mef)
+
+pointer	mef		#I Mef descriptor
+
+int	ndim, totpix, i, bitpix
+
+begin
+	ndim = MEF_NDIM (mef)
+	if (ndim == 0 && MEF_PCOUNT(mef) <= 0)
+	    return (0)
+
+	if (ndim == 0)
+	    totpix = 0
+	else {
+	    totpix = MEF_NAXIS(mef,1) 
+	    do i = 2, ndim
+		  totpix = totpix *  MEF_NAXIS(mef,i)
+	}
+	bitpix = abs(MEF_BITPIX(mef))
+
+	# If PCOUNT is not zero, add it to totpix
+	totpix = MEF_PCOUNT(mef) + totpix
+
+	if (bitpix <= NBITS_BYTE)
+	    totpix = (totpix + 1) / SZB_CHAR
+	else
+	    totpix = totpix * (bitpix / (SZB_CHAR * NBITS_BYTE))
+
+	# Set the number of characters in multiple of 1440.
+	totpix = ((totpix + 1439)/1440) * 1440
+	return (totpix)
+end
+
+
+# MEF_RD2END --  Read from block 2 to the end.
+
+procedure mef_rd2end (mef, read_next_group)
+
+pointer	mef			#I mef descriptor	
+bool	read_next_group		#I if true, read current header to END
+
+char	hbuf[FITS_BLKSZ_NL] 
+int	in, k,i, nblks, strncmp(), size_last_block, hoffset
+errchk  mef_rdblk
+
+begin
+	in = MEF_FD(mef)
+	# We need to read the header only.
+        if (read_next_group)
+	   repeat {
+	      k = 1
+	      call mef_rdblk (in, hbuf)
+	      for (i=1; i<37; i=i+1) {
+	          if (strncmp (hbuf[k], "END     " , 8) == 0)
+		     return
+	          else
+		     k = k + LEN_CARDNL
+	      }
+	   }
+	   
+
+	# This is the requested header, copy to user area.
+	nblks = 2
+	repeat {
+	   k = 1
+	   call mef_rdblk (in, hbuf)
+	   # Copy the buffer into the user area.
+	   for (i=1; i<37; i=i+1) {
+	       if (strncmp (hbuf[k], "END     " , 8) == 0) {
+                  size_last_block = i*LEN_CARDNL
+	          call realloc (MEF_HDRP(mef), FITS_BLKSZ_NL*nblks+1, TY_CHAR)
+	          hoffset = MEF_HDRP(mef)+FITS_BLKSZ_NL*(nblks-1)
+		  call amovc (hbuf, Memc[hoffset], size_last_block)
+		  Memc[hoffset+size_last_block] = EOS
+		  MEF_HSIZE(mef) = (nblks-1)*FITS_BLKSZ_NL + size_last_block
+		  return
+	       } else
+		  k = k + LEN_CARDNL
+	   }
+	   call realloc (MEF_HDRP(mef), FITS_BLKSZ_NL*nblks, TY_CHAR)
+	   hoffset = MEF_HDRP(mef)+FITS_BLKSZ_NL*(nblks-1)
+	   call amovc (hbuf, Memc[hoffset], FITS_BLKSZ_NL)
+	   nblks = nblks + 1
+	}
+end
+
+
+# MEF_STRCMP_LWR -- Compare 2 strings in lower case
+
+int procedure mef_strcmp_lwr (s1, s2)
+
+char s1[ARB], s2[ARB]
+
+pointer sp, l1, l2
+int	strcmp(), istat
+
+begin
+	call smark(sp)
+	call salloc (l1, SZ_FNAME, TY_CHAR)
+	call salloc (l2, SZ_FNAME, TY_CHAR)
+
+	call strcpy (s1, Memc[l1], SZ_FNAME)
+	call strcpy (s2, Memc[l2], SZ_FNAME)
+	call strlwr(Memc[l1])
+	call strlwr(Memc[l2])
+	istat = strcmp (Memc[l1], Memc[l2])
+
+	call sfree(sp)
+	return (istat)
+end
+
+
+# MEF_KCTYPE -- Find the type of card that is based on the keyword name.
+
+int procedure mef_kctype (card, index)
+
+char	card[ARB]	#I FITS card
+int	index		#O index value
+
+int	strncmp()
+
+begin
+	if (strncmp (card, "SIMPLE  ", 8) == 0)
+	   return (SIMPLE)
+	if (strncmp (card, "NAXIS", 5) == 0) {
+	   if (card[6] == ' ') {
+	      call mef_gvali (card, index)
+	      return (NAXIS)
+    	   } else  if (IS_DIGIT(card[6])) {
+	       index = TO_INTEG(card[6])
+	       return (NAXISN)                      # NAXISn
+     	   }
+	}
+	if (strncmp (card, "BITPIX  ", 8) == 0)
+	   return (BITPIX)
+	if (strncmp (card, "EXTNAME ", 8) == 0)
+	   return (EXTNAME)
+	if (strncmp (card, "EXTVER  ", 8) == 0)
+	   return (EXTVER)
+	if (strncmp (card, "EXTEND  ", 8) == 0)
+	   return (EXTEND)
+	if (strncmp (card, "PCOUNT  ", 8) == 0)
+	   return (PCOUNT)
+	if (strncmp (card, "FILENAME", 8) == 0)
+	   return (FILENAME)
+	if (strncmp (card, "INHERIT ", 8) == 0)
+	   return (INHERIT)
+	if (strncmp (card, "GCOUNT  ", 8) == 0)
+	   return (GCOUNT)
+	if (strncmp (card, "OBJECT  ", 8) == 0)
+	   return (OBJECT)
+	if (strncmp (card, "XTENSION", 8) == 0)
+	   return (XTENSION)
+	if (strncmp (card, "END     ", 8) == 0)
+	   return (END)
+
+        return(ERR)
+end
+
+
+# MEF_RDHDR_GN -- Read group based on group number
+
+procedure mef_rdhdr_gn (mef,gn)
+
+pointer	mef 		#I mef descriptor
+int	gn		#I group number to read
+
+char	extname[MEF_SZVALSTR]
+int	extver
+
+errchk  mef_rdhdr
+
+begin
+	extname[1] =EOS
+	extver=INDEFL
+	call mef_rdhdr (mef, gn, extname, extver)
+end
+
+
+# MEF_RDHDR_EXNV -- Read group based on the Extname and Extver values
+
+procedure mef_rdhdr_exnv (mef,extname, extver)
+
+pointer	mef		#I, mef descriptor
+char	extname[ARB]	#I, extname value
+int	extver		#I, extver value
+
+errchk  mef_rdhdr
+
+begin
+	call mef_rdhdr (mef, 0, extname, extver)
+end
+
+
+# MEF_CP_SPOOL -- 
+
+procedure mef_cp_spool (spool, mef)
+
+int	spool 		#I spool file descriptor
+pointer mef		#
+
+pointer	hdr, lbuf, sp
+int	fitslen, fstatl, user
+int	stropen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	call seek (spool, BOFL)
+	fitslen = fstatl (spool, F_FILESIZE)
+	fitslen = max (fitslen, MEF_HSIZE(mef))
+	call malloc (hdr, fitslen, TY_CHAR)
+	user = stropen (Memc[hdr], fitslen, NEW_FILE)
+
+	# Append the saved FITS cards to saved cache.
+	while (getline (spool, Memc[lbuf]) != EOF)
+	    call putline (user, Memc[lbuf])
+
+	call close (user)
+	call close (spool)
+
+	MEF_HDRP(mef) = hdr
+
+	call sfree(sp)
+end
diff --git a/pkg/xtools/mef/mefsetpl.x b/pkg/xtools/mef/mefsetpl.x
new file mode 100644
index 00000000..0df45a4a
--- /dev/null
+++ b/pkg/xtools/mef/mefsetpl.x
@@ -0,0 +1,203 @@
+include <pkg/mef.h>
+
+define  MEF_PLVERSION  MEF_HFLAG
+define  MEF_PLSIZE     MEF_CGROUP
+
+define  DEF_SZBUF       32768
+define  INC_SZBUF       16384
+define  INC_HDRMEM      8100
+define  IDB_RECLEN      80
+
+define  KW_TITLE        "$TITLE = "
+define  LEN_KWTITLE     9
+define  KW_CTIME        "$CTIME = "
+define  LEN_KWCTIME     9
+define  KW_MTIME        "$MTIME = "
+define  LEN_KWMTIME     9
+define  KW_LIMTIME      "$LIMTIME = "
+define  LEN_KWLIMTIME   11
+define  KW_MINPIXVAL    "$MINPIXVAL = "
+define  LEN_KWMINPIXVAL 13
+define  KW_MAXPIXVAL    "$MAXPIXVAL = "
+define  LEN_KWMAXPIXVAL 13
+
+define SZ_IMTITLE      383    # image title string
+
+procedure mef_setpl (version, plsize, imhdr, title, ctime, mtime, limtime,
+		minval, maxval, mef)
+
+int     version		#I PL version number
+char    imhdr[ARB]      #I Mask title
+char    title[ARB]
+int     plsize		#I Mask size of TY_SHORT
+int	ctime
+int	mtime
+int	limtime
+real	minval
+real	maxval
+pointer mef		#I Mef descriptor
+
+int	tlen, i, ch, hdrlen, nchars
+pointer	sp, tbuf, ip, op, rp, bp, hd
+int	strncmp(), ctol(), ctor(), strlen()
+errchk	realloc
+
+begin
+	MEF_PLVERSION(mef) = version
+	MEF_PLSIZE(mef) = plsize
+	tlen= strlen(imhdr)
+
+	call smark (sp)
+	call salloc (tbuf, SZ_IMTITLE, TY_CHAR)
+	call salloc (bp, tlen, TY_CHAR)
+
+	call strcpy (imhdr, Memc[bp], tlen)
+
+
+	# Get the image title string.
+	for (ip = bp;  Memc[ip] != EOS;) {
+	    if (Memc[ip] == '$') {
+		if (strncmp (Memc[ip], KW_TITLE, LEN_KWTITLE) == 0) {
+		    # Advance to first character of quoted string.
+		    ip = ip + LEN_KWTITLE
+		    while (Memc[ip] != EOS && Memc[ip] != '"')
+			ip = ip + 1
+		    if (Memc[ip] == '"')
+			ip = ip + 1
+
+		    # Extract the string.
+		    op = tbuf
+		    while (Memc[ip] != EOS && Memc[ip] != '"') {
+			if (Memc[ip] == '\\' && Memc[ip+1] == '"')
+			    ip = ip + 1
+			Memc[op] = Memc[ip]
+			op = min (tbuf + SZ_IMTITLE, op + 1)
+			ip = ip + 1
+		    }
+
+		    # Store in image descriptor.
+		    Memc[op] = EOS
+		    call strcpy (Memc[tbuf], title, SZ_IMTITLE)
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp (Memc[ip], KW_CTIME, LEN_KWCTIME) == 0) {
+		    # Decode the create time.
+		    ip = ip + LEN_KWCTIME
+		    rp = 1
+		    if (ctol (Memc[ip], rp, ctime) <= 0)
+			ctime = 0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp (Memc[ip], KW_MTIME, LEN_KWMTIME) == 0) {
+		    # Decode the modify time.
+		    ip = ip + LEN_KWMTIME
+		    rp = 1
+		    if (ctol (Memc[ip], rp, mtime) <= 0)
+			mtime = 0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp (Memc[ip], KW_LIMTIME, LEN_KWLIMTIME) == 0) {
+		    # Decode the limits time.
+		    ip = ip + LEN_KWLIMTIME
+		    rp = 1
+		    if (ctol (Memc[ip], rp, limtime) <= 0)
+			limtime = 0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp(Memc[ip],KW_MINPIXVAL,LEN_KWMINPIXVAL)==0) {
+		    # Decode the minimum pixel value.
+		    ip = ip + LEN_KWMINPIXVAL
+		    rp = 1
+		    if (ctor (Memc[ip], rp, minval) <= 0)
+			minval = 0.0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp(Memc[ip],KW_MAXPIXVAL,LEN_KWMAXPIXVAL)==0) {
+		    # Decode the maximum pixel value.
+		    ip = ip + LEN_KWMAXPIXVAL
+		    rp = 1
+		    if (ctor (Memc[ip], rp, maxval) <= 0)
+			maxval = 0.0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+		}
+	    } else
+		break
+	}
+	
+	hdrlen = tlen*2
+	call malloc (hd, hdrlen, TY_CHAR)
+	op = hd
+
+	while (Memc[ip] != EOS) {
+	    rp = op
+
+	    nchars = rp - hd
+	    if (nchars + IDB_RECLEN + 2 > hdrlen) {
+		hdrlen = hdrlen + INC_HDRMEM
+		call realloc (hd, hdrlen, TY_CHAR)
+		op = hd + nchars
+	    }
+	    # Copy the saved card, leave IP positioned to past newline.
+	    do i = 1, IDB_RECLEN {
+		ch = Memc[ip]
+		if (ch != EOS)
+		    ip = ip + 1
+		if (ch == '\n')
+		    break
+		Memc[op] = ch
+		op = op + 1
+	    }
+
+	    # Blank fill the card.
+	    while (op - rp < IDB_RECLEN) {
+		Memc[op] = ' '
+		op = op + 1
+	    }
+
+	    # Add newline termination.
+	    Memc[op] = '\n';  op = op + 1
+	}
+
+	Memc[op] = EOS
+
+	MEF_HDRP(mef) = hd
+	MEF_HSIZE(mef) = strlen(Memc[hd])
+
+	call sfree (sp)
+end
+
diff --git a/pkg/xtools/mef/mefwrhdr.x b/pkg/xtools/mef/mefwrhdr.x
new file mode 100644
index 00000000..90ec337e
--- /dev/null
+++ b/pkg/xtools/mef/mefwrhdr.x
@@ -0,0 +1,212 @@
+include <error.h>
+include <pkg/mef.h>
+
+# MEF_WRHDR -- Append the header from an input PHU or extension to output file.
+
+procedure mef_wrhdr (mefi, mefo, in_phdu)
+
+pointer	mefi		#I input mef descriptor
+pointer	mefo		#I output mef descriptor
+bool	in_phdu		#I true if input header is Primary Header Unit.
+
+pointer hb, sp, ln
+int	output_lines, out, offset
+int	i, index, naxis, mef_kctype(), strncmp(), note()
+bool    endk, new_outf
+errchk  open, fcopyo
+
+define	nextb_ 99
+
+begin
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	# At this point the input first header has been read
+
+	hb = MEF_HDRP(mefi)
+	if (Memc[hb] == NULL)
+	   call error(13,"mef_wrhdr: input header buffer is empty")
+
+	out = MEF_FD(mefo)
+
+	new_outf = false
+	if (MEF_ACMODE(mefo) == NEW_IMAGE)
+	   new_outf = true
+
+	output_lines = 0
+	endk = false
+
+	# If we want to copy the header with no modification
+	if (MEF_KEEPXT(mefo) == YES) {
+	    for (i=1; i<37; i=i+1) {
+	       switch (mef_kctype(Memc[hb], index)) {
+	       case END:
+		   call mef_pakwr (out, Memc[hb])
+		   endk = true
+		   output_lines = i
+		   break
+	       default:
+		   call mef_pakwr (out, Memc[hb])
+		   hb = hb + LEN_CARDNL
+	       }
+	    }
+	    goto nextb_
+	} 
+
+	# Check for 1st card
+	if (strncmp (Memc[hb], "SIMPLE  ", 8) == 0) {
+	    # Append extension to existing file
+	    if (!new_outf) {            
+	        call mef_encodec ("XTENSION", "IMAGE", 5, Memc[ln],
+		    "Image extension")
+	        call mef_pakwr (out, Memc[ln])
+	    } else
+	        call mef_pakwr (out, Memc[hb])
+	} else if (strncmp (Memc[hb], "XTENSION", 8) == 0 ) {
+	    if (new_outf) {
+	        # Create a PHU
+	        # Must create a dummy header if input extension is not image
+		if (strncmp (MEF_EXTTYPE(mefi), "IMAGE", 5) != 0) {
+		    Memc[ln] = EOS
+		    call mef_dummyhdr (out, Memc[ln])
+		    new_outf = false
+	            call mef_pakwr (out, Memc[hb])
+	        } else {
+	            call mef_encodeb ("SIMPLE", YES, Memc[ln],
+		        "Standard FITS format")
+	            call mef_pakwr (out, Memc[ln])
+		}
+	    } else
+	        call mef_pakwr (out, Memc[hb])
+	} else {
+	    # Is the wrong kind of header
+#	    call eprintf ("File %s is not FITS\n")
+#		call erract (EA_FATAL)
+	    call sprintf (Memc[ln],LEN_CARD, "File %s is not FITS")
+	        call pargstr(MEF_FNAME(mefi))
+            call error(13, Memc[ln])			
+	}
+	hb = hb + LEN_CARDNL
+
+	for (i=2; i<37; i=i+1) {
+	   switch (mef_kctype(Memc[hb], index)) {
+	   case BITPIX:
+	      # Get to calculate totpix value
+	      call mef_gvali (Memc[hb], MEF_BITPIX(mefi))
+	   case NAXIS:
+	      naxis = index
+	      MEF_NDIM(mefi) = index
+	      if (in_phdu && !new_outf && naxis == 0) {
+	         call mef_pakwr (out, Memc[hb])
+		 call mef_wrpgcount (out)
+	         output_lines = output_lines + 2
+		 hb = hb + LEN_CARDNL
+		 next
+	      }
+	   case NAXISN:
+	      call mef_gvali (Memc[hb], MEF_NAXIS(mefi,index))
+	      call mef_pakwr (out, Memc[hb])
+	      if (index == naxis) {
+	          if (in_phdu && !new_outf ) {
+		      # We are writing from a phu to ehu.
+		      # 2 new cards PCOUNT and GCOUNT
+
+		      call mef_wrpgcount (out)
+		      output_lines = output_lines + 2
+	          }			
+	          if (!in_phdu && new_outf) {
+		      # We are writing from a ehu to a phu
+		      call mef_encodeb ("EXTEND", YES, Memc[ln],
+			  "There may be extensions")
+		      call mef_pakwr (out, Memc[ln])
+		      output_lines = output_lines + 1
+		  }   
+	      }
+	      hb = hb + LEN_CARDNL
+	      next
+	   case EXTEND, FILENAME:
+	      if (!new_outf) {
+		  # Do not put these cards  when going to an ehu
+	          output_lines = output_lines - 1
+	          hb = hb + LEN_CARDNL
+		  next
+	      }
+	   case INHERIT:
+	      # Eliminate INHERIT keyword from an input IMAGE extension
+	      # when creating a new output file. If file already exists
+	      # then pass the card along.
+
+	      if (new_outf) {
+	          output_lines = output_lines - 1
+	          hb = hb + LEN_CARDNL
+		  next
+	      } 
+	   case PCOUNT,GCOUNT,EXTNAME,EXTVER:   
+	      # Do not put these cards into PHU
+	      if (new_outf) {
+	         output_lines = output_lines - 1
+	         hb = hb + LEN_CARDNL
+		 next
+	      } 
+	   case END:
+	      call mef_pakwr (out, Memc[hb])
+	      endk = true
+	      output_lines = i + output_lines
+	      break
+	   default:
+	      ;
+	   }
+	   call mef_pakwr (out, Memc[hb])
+	   hb = hb + LEN_CARDNL
+
+	} # end for loop
+
+nextb_
+	# See if we need to keep reading header
+	#
+	if (!endk) 
+	   repeat {
+	      for (i=1; i<37; i=i+1) {
+	        if (strncmp (Memc[hb], "END     ", 8) == 0) {
+	           call mef_pakwr (out, Memc[hb])
+		   endk = true
+		   output_lines = i + output_lines
+		   break
+	        }
+	        call mef_pakwr (out, Memc[hb])
+		hb = hb + LEN_CARDNL
+	      }
+              if (endk) break
+	      
+	   } #end repeat
+           
+	   offset = note(out)-1     # to base zero
+	   call mef_padfile (out, offset)
+	   call flush(out)
+
+	call sfree(sp)
+end
+
+procedure mef_padfile (fd, offset)
+
+int	fd	  # file descriptor
+int	offset    # file position in chars
+
+int     pad, nlines,i
+char	card[LEN_CARDNL]
+
+begin
+        i = mod(offset, 1440)
+	if (i == 0) return
+
+	pad = 1440 - i
+	nlines = pad/40
+
+        do i =1, 80
+              card[i] = ' '
+        call achtcb (card, card, 80)
+
+        for(i=1; i<=nlines; i=i+1)
+           call write(fd, card, 40)
+
+end
diff --git a/pkg/xtools/mef/mefwrhdr.x_save b/pkg/xtools/mef/mefwrhdr.x_save
new file mode 100644
index 00000000..ef1c332b
--- /dev/null
+++ b/pkg/xtools/mef/mefwrhdr.x_save
@@ -0,0 +1,185 @@
+include <error.h>
+include <mef.h>
+
+# MEF_WRHDR -- Append the header from an input PHU or extension to output file.
+
+procedure mef_wrhdr (mefi, mefo, in_phdu)
+
+pointer	mefi		#I input mef descriptor
+pointer	mefo		#I output mef descriptor
+bool	in_phdu		#I true if input header is Primary Header Unit.
+
+pointer hb, sp, ln
+int	output_lines, out
+int	i, index, naxis, mef_kctype(), strncmp()
+bool    endk, new_outf
+errchk  open, fcopyo
+
+define	nextb_ 99
+
+begin
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	# At this point the input first header has been read
+
+	hb = MEF_HDRP(mefi)
+	if (Memc[hb] == NULL)
+	   call error(13,"mef_wrhdr: input header buffer is empty")
+
+	out = MEF_FD(mefo)
+
+	new_outf = false
+	if (MEF_ACMODE(mefo) == NEW_IMAGE)
+	   new_outf = true
+
+	output_lines = 0
+	endk = false
+
+	# If we want to copy the header with no modification
+	if (MEF_KEEPXT(mefo) == YES) {
+	    for (i=1; i<37; i=i+1) {
+	       switch (mef_kctype(Memc[hb], index)) {
+	       case END:
+		   call mef_pakwr (out, Memc[hb])
+		   endk = true
+		   output_lines = i
+		   break
+	       default:
+		   call mef_pakwr (out, Memc[hb])
+		   hb = hb + LEN_CARDNL
+	       }
+	    }
+	    goto nextb_
+	} 
+
+	# Check for 1st card
+	if (strncmp (Memc[hb], "SIMPLE  ", 8) == 0) {
+	    # Append extension to existing file
+	    if (!new_outf) {            
+	        call mef_encodec ("XTENSION", "IMAGE", 5, Memc[ln],
+		    "Image extension")
+	        call mef_pakwr (out, Memc[ln])
+	    } else
+	        call mef_pakwr (out, Memc[hb])
+	} else if (strncmp (Memc[hb], "XTENSION", 8) == 0 ) {
+	    if (new_outf) {
+	        # Create a PHU
+	        # Must create a dummy header if input extension is not image
+		if (strncmp (MEF_EXTTYPE(mefi), "IMAGE", 5) != 0) {
+		    Memc[ln] = EOS
+		    call mef_dummyhdr (out, Memc[ln])
+		    new_outf = false
+	            call mef_pakwr (out, Memc[hb])
+	        } else {
+	            call mef_encodeb ("SIMPLE", YES, Memc[ln],
+		        "Standard FITS format")
+	            call mef_pakwr (out, Memc[ln])
+		}
+	    } else
+	        call mef_pakwr (out, Memc[hb])
+	} else {
+	    # Is the wrong kind of header
+#	    call eprintf ("File %s is not FITS\n")
+#		call erract (EA_FATAL)
+	    call sprintf (Memc[ln],LEN_CARD, "File %s is not FITS")
+	        call pargstr(MEF_FNAME(mefi))
+            call error(13, Memc[ln])			
+	}
+	hb = hb + LEN_CARDNL
+
+	for (i=2; i<37; i=i+1) {
+	   switch (mef_kctype(Memc[hb], index)) {
+	   case BITPIX:
+	      # Get to calculate totpix value
+	      call mef_gvali (Memc[hb], MEF_BITPIX(mefi))
+	   case NAXIS:
+	      naxis = index
+	      MEF_NDIM(mefi) = index
+	      if (in_phdu && !new_outf && naxis == 0) {
+	         call mef_pakwr (out, Memc[hb])
+		 call mef_wrpgcount (out)
+	         output_lines = output_lines + 2
+		 hb = hb + LEN_CARDNL
+		 next
+	      }
+	   case NAXISN:
+	      call mef_gvali (Memc[hb], MEF_NAXIS(mefi,index))
+	      call mef_pakwr (out, Memc[hb])
+	      if (index == naxis) {
+	          if (in_phdu && !new_outf ) {
+		      # We are writing from a phu to ehu.
+		      # 2 new cards PCOUNT and GCOUNT
+
+		      call mef_wrpgcount (out)
+		      output_lines = output_lines + 2
+	          }			
+	          if (!in_phdu && new_outf) {
+		      # We are writing from a ehu to a phu
+		      call mef_encodeb ("EXTEND", YES, Memc[ln],
+			  "There may be extensions")
+		      call mef_pakwr (out, Memc[ln])
+		      output_lines = output_lines + 1
+		  }   
+	      }
+	      hb = hb + LEN_CARDNL
+	      next
+	   case EXTEND, FILENAME:
+	      if (!new_outf) {
+		  # Do not put these cards  when going to an ehu
+	          output_lines = output_lines - 1
+	          hb = hb + LEN_CARDNL
+		  next
+	      }
+	   case INHERIT:
+	      # Eliminate INHERIT keyword from an input IMAGE extension
+	      # when creating a new output file. If file already exists
+	      # then pass the card along.
+
+	      if (new_outf) {
+	          output_lines = output_lines - 1
+	          hb = hb + LEN_CARDNL
+		  next
+	      } 
+	   case PCOUNT,GCOUNT,EXTNAME,EXTVER:   
+	      # Do not put these cards into PHU
+	      if (new_outf) {
+	         output_lines = output_lines - 1
+	         hb = hb + LEN_CARDNL
+		 next
+	      } 
+	   case END:
+	      call mef_pakwr (out, Memc[hb])
+	      endk = true
+	      output_lines = i + output_lines
+	      break
+	   default:
+	      ;
+	   }
+	   call mef_pakwr (out, Memc[hb])
+	   hb = hb + LEN_CARDNL
+
+	} # end for loop
+
+nextb_
+	# See if we need to keep reading header
+	#
+	if (!endk) 
+	   repeat {
+	      for (i=1; i<37; i=i+1) {
+	        if (strncmp (Memc[hb], "END     ", 8) == 0) {
+	           call mef_pakwr (out, Memc[hb])
+		   endk = true
+		   output_lines = i + output_lines
+		   break
+	        }
+	        call mef_pakwr (out, Memc[hb])
+		hb = hb + LEN_CARDNL
+	      }
+              if (endk) break
+	      
+	   } #end repeat
+	call mef_wrblank (out, output_lines)
+
+	call sfree(sp)
+end
diff --git a/pkg/xtools/mef/mefwrpl.x b/pkg/xtools/mef/mefwrpl.x
new file mode 100644
index 00000000..1eef1cc2
--- /dev/null
+++ b/pkg/xtools/mef/mefwrpl.x
@@ -0,0 +1,213 @@
+include <error.h>
+include <pkg/mef.h>
+
+define MEF_PLSIZE  MEF_CGROUP
+# MEF_WRPL -- 
+
+procedure mef_wrpl (mef, title, ctime,mtime, limtime, minval, 
+   	      maxval,plbuf, naxis, axlen)
+
+char    title[ARB]
+int	ctime, mtime, limtime
+real	minval, maxval
+pointer	mef		#I input mef descriptor
+short   plbuf		#I Pixel list buffer
+int	naxis, axlen[ARB]
+
+pointer sp, ln, mii, hb
+char    blank[1]
+int	output_lines, npad, i 
+int	pcount, fd, nlines
+bool    endk, new_outf
+errchk  open, fcopyo
+
+begin
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	# Output file descriptor
+	fd  = MEF_FD(mef)
+
+	new_outf = false
+	if (MEF_ACMODE(mef) == NEW_IMAGE)
+	   new_outf = true
+
+	output_lines = 0
+	endk = false
+
+	# Create a PHU
+	if (new_outf) {
+	    # Must create a dummy header if input extension is not image
+	    Memc[ln] = EOS
+	    call mef_dummyhdr (fd, Memc[ln])
+	    new_outf = false
+	} 
+
+	call mef_wcardc ("XTENSION", "BINTABLE", "Extension type", fd)
+	call mef_wcardi ("BITPIX", 8, "Default value", fd)
+	call mef_wcardi ("NAXIS", 2, "Lines and cols", fd)
+	call mef_wcardi ("NAXIS1", 8, "Nbytes per line", fd)
+	call mef_wcardi ("NAXIS2", 1, "Nlines", fd)
+	
+	# Calculate the number of 2880 bytes block the heap will
+	# occupy.
+
+	pcount = ((MEF_PLSIZE(mef)+1439)/1440)*2880
+	call mef_wcardi ("PCOUNT", pcount, "Heap size in bytes", fd)
+	call mef_wcardi ("GCOUNT", 1, "1 Group", fd)
+	call mef_wcardi ("TFIELDS", 1, "1 Column field", fd)
+	call sprintf (Memc[ln], LEN_CARD, "PI(%d)")
+	    call pargi(MEF_PLSIZE(mef))
+	call mef_wcardc ("TFORM1", Memc[ln], "Variable word array", fd)
+	call mef_wcardb ("INHERIT", NO, "No Inherit", fd)
+        call mef_wcardc ("ORIGIN", FITS_ORIGIN, "FITS file originator", fd)
+	call mef_wcardc ("EXTNAME", MEF_EXTNAME(mef), "", fd)
+	call mef_wcardi ("EXTVER", MEF_EXTVER(mef), "", fd)
+	call mef_wcardi ("CTIME", ctime, "", fd)
+	call mef_wcardi ("MTIME", mtime, "", fd)
+	call mef_wcardi ("LIMTIME", limtime, "", fd)
+	call mef_wcardr ("DATAMIN", minval, "", fd)
+	call mef_wcardr ("DATAMAX", maxval, "", fd)
+	call mef_wcardc ("OBJECT", title, "", fd)
+
+	call mef_wcardb ("CMPIMAGE", YES, "Is a compressed image", fd)
+	call mef_wcardc ("CMPTYPE", "PLIO_1", "IRAF image masks", fd)
+	call mef_wcardi ("CBITPIX", 32, "BITPIX for uncompressed image", fd)
+	call mef_wcardi ("CNAXIS", naxis, "NAXIS for uncompressed image", fd)
+	do i = 1, naxis {
+	    call sprintf (Memc[ln], LEN_CARD, "NAXIS%d")
+		call pargi(i)
+	    call mef_wcardi ("CNAXIS", axlen[i], "axis length", fd)
+	}
+	
+	hb = MEF_HDRP(mef)	
+	output_lines = 23
+	nlines = MEF_HSIZE(mef) / LEN_CARDNL
+
+	for (i=1; i<= nlines; i=i+1) {
+	    call mef_pakwr (fd, Memc[hb])
+	    hb = hb + LEN_CARDNL
+	}
+
+        blank[1] = ' '
+	call amovkc (blank, Memc[ln], 80)
+	call strcpy ("END", Memc[ln], 3)
+	Memc[ln+3] = ' '                           # Clear EOS mark
+	call mef_pakwr (fd, Memc[ln])
+
+	output_lines = output_lines + nlines + 1 + naxis
+	call mef_wrblank (fd, output_lines)
+
+	call salloc (mii, 1400, TY_INT)
+
+	# Now write 2 integers as table data (nelem,offset)
+	Memi[mii] = MEF_PLSIZE(mef)	 # Number of words in pl buff (2bytes)
+	Memi[mii+1] = 0			 # Offset from start of heap
+
+	npad = 1438
+	call amovki (0, Memi[mii+2], npad)
+	call write (fd, Memi[mii], 1440)
+
+	# Write mask in heap area
+	call write (fd, plbuf, MEF_PLSIZE(mef)*SZ_SHORT)
+
+	# Pad to 1440 characters block in case we want to append another
+	# extension
+
+	npad = 1440 - mod (MEF_PLSIZE(mef), 1440)
+
+	call amovki (0, Memi[mii], npad)
+	call write (fd, Memi[mii], npad)
+							 
+
+	call sfree(sp)
+end
+
+procedure mef_wcardi (kname, kvalue, kcomm, fd)
+
+char	kname[ARB]	#I Keyword name
+int	kvalue	        #I Keyword value
+char 	kcomm[ARB]	#I Card comment
+int	fd	        #I file descriptor
+
+pointer sp, ln
+
+begin
+
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	call mef_encodei (kname, kvalue, Memc[ln], kcomm)
+	call mef_pakwr (fd, Memc[ln])
+
+	call sfree (sp)
+
+end
+
+
+procedure mef_wcardc (kname, kvalue, kcomm, fd)
+
+char	kname[ARB]	#I Keyword name
+char	kvalue[ARB]	#I Keyword value
+char 	kcomm[ARB]	#I Card comment
+int	fd   	        #I file descriptor
+
+pointer sp, ln
+int     slen, strlen()
+
+begin
+
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	slen = strlen(kvalue)
+	call mef_encodec (kname, kvalue, slen, Memc[ln], kcomm)
+	call mef_pakwr (fd, Memc[ln])
+
+	call sfree(sp)
+
+end
+
+
+procedure mef_wcardb (kname, kvalue, kcomm, fd)
+
+char	kname[ARB]	#I Keyword name
+int	kvalue	        #I Keyword value
+char 	kcomm[ARB]	#I Card comment
+int	fd	        #I file descriptor
+
+pointer sp, ln
+
+begin
+
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	call mef_encodeb (kname, kvalue, Memc[ln], kcomm)
+	call mef_pakwr (fd, Memc[ln])
+
+	call sfree(sp)
+
+end
+
+procedure mef_wcardr (kname, kvalue, kcomm, fd)
+
+char	kname[ARB]	#I Keyword name
+real	kvalue		#I Keyword value
+char 	kcomm[ARB]	#I Card comment
+int	fd	        #I file descriptor
+
+pointer sp, ln
+
+begin
+
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	call mef_encoder (kname, kvalue, Memc[ln], kcomm, 6)
+	call mef_pakwr (fd, Memc[ln])
+
+	call sfree(sp)
+
+end
+
diff --git a/pkg/xtools/mef/mkpkg b/pkg/xtools/mef/mkpkg
new file mode 100644
index 00000000..5a3f358c
--- /dev/null
+++ b/pkg/xtools/mef/mkpkg
@@ -0,0 +1,26 @@
+# MEFLIB
+
+update:
+        $checkout       libxtools.a lib$
+        $update         libxtools.a
+        $checkin        libxtools.a lib$
+        ;
+
+libxtools.a:
+        mefappfile.x    <pkg/mef.h>
+        mefclose.x      <pkg/mef.h>
+        mefcpextn.x     <mach.h> <pkg/mef.h>
+        mefdummyh.x     <pkg/mef.h>
+        mefencode.x     <ctype.h> <mach.h> <pkg/mef.h> <time.h>
+        mefget.x        <ctype.h> <pkg/mef.h>
+        mefgnbc.x       <pkg/mef.h>
+        mefgval.x       <ctype.h> <pkg/mef.h>
+        mefkfind.x      <pkg/mef.h>
+        mefksection.x   <ctotok.h> <lexnum.h> <pkg/mef.h>
+        mefldhdr.x      <ctype.h> <error.h> <mach.h> <pkg/mef.h> <mii.h>
+        mefopen.x       <pkg/mef.h>
+        mefrdhdr.x      <ctype.h> <error.h> <fset.h> <mach.h> <pkg/mef.h>
+        mefsetpl.x      <pkg/mef.h>
+        mefwrhdr.x      <error.h> <pkg/mef.h>
+        mefwrpl.x       <error.h> <pkg/mef.h>
+	;
diff --git a/pkg/xtools/mkpkg b/pkg/xtools/mkpkg
new file mode 100644
index 00000000..57eedf4e
--- /dev/null
+++ b/pkg/xtools/mkpkg
@@ -0,0 +1,80 @@
+# XTOOLS Programming tools library.
+
+update:
+	$checkout libxtools.a lib$
+	$update	  libxtools.a
+	$checkin  libxtools.a lib$
+	$purge    lib$
+	;
+
+txtcompile:
+	$omake	t_txtcompile.x
+	$link	t_txtcompile.o -lxtools -o xx_txtcompile.e
+	$move	xx_txtcompile.o bin$x_txtcompile.e
+	;
+
+generic:
+	$set GEN = "$$generic -k"
+	$ifolder (xtsample.x, xtsample.gx)
+	    $(GEN) xtsample.gx -o xtsample.x $endif
+	$ifolder (xtstat.x, xtstat.gx)
+	    $(GEN) xtstat.gx -o xtstat.x $endif
+	;
+
+libxtools.a:
+	$ifeq (USE_GENERIC, yes) $call generic $endif
+
+	@ranges		# Range tools "1:10,5:20,30"
+	@gtools		# Graphics tools
+	@icfit		# Interactive curfit package
+	@inlfit		# Interactive non-linear least-squares package
+	@fixpix		# Mask and pixel fixing routines
+	@skywcs		# Sky coordinates transformation routines
+	@catquery	# Catalog and survey access routines
+	@mef		# MEF handling routines
+
+	center1d.x	<math/iminterp.h> <pkg/center1d.h>
+	clgcurfit.x	<math/curfit.h>
+	clginterp.x	<math/iminterp.h>
+	clgsec.x	<ctype.h> <imhdr.h> <mach.h>
+	cogetr.x	cogetr.h <imhdr.h>
+	dttext.x	<ctotok.h> <ctype.h> <error.h> <finfo.h> <fset.h>\
+			<pkg/dttext.h> <time.h>
+	extrema.x	
+	getdatatype.x	
+	gstrdetab.x	
+	gstrentab.x	
+	gstrsettab.x	
+	imtools.x	<ctype.h> <imhdr.h>
+	intrp.f
+	isdir.x		<ctype.h> <finfo.h>
+	peaks.x	
+	ranges.x	<ctype.h> <mach.h>
+	rmmed.x		<pkg/rmsorted.h> <mach.h>
+	rmsorted.x	<pkg/rmsorted.h>
+	rmturlach.x	<mach.h>
+	rngranges.x	<ctype.h> <mach.h>
+	obsdb.x		<error.h> <imset.h>
+	strdetab.x	
+	strentab.x	
+	syshost.x	<clset.h> <ctotok.h>
+	xt21imsum.x	<imhdr.h>
+	xtanswer.x	<pkg/xtanswer.h>
+	xtargs.x	<ctotok.h>
+	xtbitarray.x	<mach.h>
+	xtextns.x       <ctype.h> <error.h> <mach.h> <pkg/mef.h>
+	xtgids.x	<ctotok.h>
+	xtimleneq.x	<imhdr.h>
+	xtimnames.x
+	xtimtgetim.x	
+	xtlogfiles.x
+	xtmaskname.x	
+	xtmksection.x	<imhdr.h>
+	xtphistory.x	<imhdr.h>
+	xtsample.x	<imhdr.h>
+	xtsort.x	
+	xtstat.x
+	xtstripwhite.x	<ctype.h>
+	xtsums.x	
+	xttxtfio.x
+	;
diff --git a/pkg/xtools/numrecipes.x b/pkg/xtools/numrecipes.x
new file mode 100644
index 00000000..ae437b6d
--- /dev/null
+++ b/pkg/xtools/numrecipes.x
@@ -0,0 +1,689 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	<mach.h>
+
+# GAMMLN -- Return natural log of gamma function.
+# POIDEV -- Returns Poisson deviates for a given mean.
+# GASDEV -- Return a normally distributed deviate of zero mean and unit var.
+# MR_SOLVE -- Levenberg-Marquardt nonlinear chi square minimization.
+#     MR_EVAL -- Evaluate curvature matrix.
+#     MR_INVERT -- Solve a set of linear equations using Householder transforms.
+# TWOFFT -- Returns the complex FFTs of two input real arrays.
+# REALFT -- Calculates the FFT of a set of 2N real valued data points.
+#     FOUR1 -- Computes the forward or inverse FFT of the input array.
+
+
+# GAMMLN -- Return natural log of gamma function.
+# Argument must greater than 0.  Full accuracy is obtained for values
+# greater than 1.  For 0<xx<1, the reflection formula can be used first.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+real procedure gammln (xx)
+
+real	xx		# Value to be evaluated
+
+int	j
+double	cof[6], stp, x, tmp, ser
+data	cof, stp / 76.18009173D0, -86.50532033D0, 24.01409822D0,
+		-1.231739516D0,.120858003D-2,-.536382D-5,2.50662827465D0/
+
+begin
+	x = xx - 1.0D0
+	tmp = x + 5.5D0
+	tmp = (x + 0.5D0) * log (tmp) - tmp
+	ser = 1.0D0
+	do j = 1, 6 {
+	    x = x + 1.0D0
+	    ser = ser + cof[j] / x
+	}
+	return (tmp + log (stp * ser))
+end
+
+
+# POIDEV -- Returns Poisson deviates for a given mean.
+# The real value returned is an integer.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+#
+# Modified to return zero for input values less than or equal to zero.
+
+real procedure poidev (xm, seed)
+
+real	xm		# Poisson mean
+long	seed		# Random number seed
+
+real	oldm, g, em, t, y, ymin, ymax, sq, alxm, gammln(), urand(), gasdev()
+data	oldm /-1./
+
+begin
+	if (xm <= 0)
+	    em = 0
+	else if (xm < 12) {
+	    if (xm != oldm) {
+		oldm = xm
+		g = exp (-xm)
+	    }
+	    em = 0
+	    for (t = urand (seed); t > g; t = t * urand (seed))
+		em = em + 1
+	} else if (xm < 100) {
+	    if (xm != oldm) {
+		oldm = xm
+		sq = sqrt (2. * xm)
+		ymin = -xm / sq
+		ymax = (1000 - xm) / sq
+		alxm = log (xm)
+		g = xm * alxm - gammln (xm+1.)
+	    }
+	    repeat {
+		repeat {
+	            y = tan (PI * urand(seed))
+		} until (y >= ymin)
+	        em = int (sq * min (y, ymax) + xm)
+	        t = 0.9 * (1 + y**2) * exp (em * alxm - gammln (em+1) - g)
+	    } until (urand(seed) <= t)
+	} else
+	    em = xm + sqrt (xm) * gasdev (seed)
+	return (em)
+end
+
+
+# GASDEV -- Return a normally distributed deviate with zero mean and unit
+# variance.  The method computes two deviates simultaneously.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+real procedure gasdev (seed)
+
+long	seed		# Seed for random numbers
+
+real	v1, v2, r, fac, urand()
+int	iset
+data	iset/0/
+
+begin
+	if (iset == 0) {
+	    repeat {
+	        v1 = 2 * urand (seed) - 1.
+	        v2 = 2 * urand (seed) - 1.
+	        r = v1 ** 2 + v2 ** 2
+	    } until ((r > 0) && (r < 1))
+	    fac = sqrt (-2. * log (r) / r)
+
+	    iset = 1
+	    return (v1 * fac)
+	} else {
+	    iset = 0
+	    return (v2 * fac)
+	}
+end
+
+
+# MR_SOLVE -- Levenberg-Marquardt nonlinear chi square minimization.
+#
+# Use the Levenberg-Marquardt method to minimize the chi squared of a set
+# of paraemters.  The parameters being fit are indexed by the flag array.
+# To initialize the Marquardt parameter, MR, is less than zero.  After that
+# the parameter is adjusted as needed.  To finish set the parameter to zero
+# to free memory.  This procedure requires a subroutine, DERIVS, which
+# takes the derivatives of the function being fit with respect to the
+# parameters.  There is no limitation on the number of parameters or
+# data points.  For a description of the method see NUMERICAL RECIPES
+# by Press, Flannery, Teukolsky, and Vetterling, p523.
+#
+# These routines have their origin in Numerical Recipes, MRQMIN, MRQCOF,
+# but have been completely redesigned.
+
+procedure mr_solve (x, y, npts, params, flags, np, nfit, mr, chisq)
+
+real	x[npts]			# X data array
+real	y[npts]			# Y data array
+int	npts			# Number of data points
+real	params[np]		# Parameter array
+int	flags[np]		# Flag array indexing parameters to fit
+int	np			# Number of parameters
+int	nfit			# Number of parameters to fit
+real	mr			# MR parameter
+real	chisq			# Chi square of fit
+
+int	i
+real	chisq1
+pointer	new, a1, a2, delta1, delta2
+
+errchk	mr_invert
+
+begin
+	# Allocate memory and initialize.
+	if (mr < 0.) {
+	    call mfree (new, TY_REAL)
+	    call mfree (a1, TY_REAL)
+	    call mfree (a2, TY_REAL)
+	    call mfree (delta1, TY_REAL)
+	    call mfree (delta2, TY_REAL)
+
+	    call malloc (new, np, TY_REAL)
+	    call malloc (a1, nfit*nfit, TY_REAL)
+	    call malloc (a2, nfit*nfit, TY_REAL)
+	    call malloc (delta1, nfit, TY_REAL)
+	    call malloc (delta2, nfit, TY_REAL)
+
+	    call amovr (params, Memr[new], np)
+	    call mr_eval (x, y, npts, Memr[new], flags, np, Memr[a2],
+	        Memr[delta2], nfit, chisq)
+	    mr = 0.001
+	}
+
+	# Restore last good fit and apply the Marquardt parameter.
+	call amovr (Memr[a2], Memr[a1], nfit * nfit)
+	call amovr (Memr[delta2], Memr[delta1], nfit)
+	do i = 1, nfit
+	    Memr[a1+(i-1)*(nfit+1)] = Memr[a2+(i-1)*(nfit+1)] * (1. + mr)
+
+	# Matrix solution.
+	call mr_invert (Memr[a1], Memr[delta1], nfit)
+
+	# Compute the new values and curvature matrix.
+	do i = 1, nfit
+	    Memr[new+flags[i]-1] = params[flags[i]] + Memr[delta1+i-1]
+	call mr_eval (x, y, npts, Memr[new], flags, np, Memr[a1],
+	    Memr[delta1], nfit, chisq1)
+
+	# Check if chisq has improved.
+	if (chisq1 < chisq) {
+	    mr = 0.1 * mr
+	    chisq = chisq1
+	    call amovr (Memr[a1], Memr[a2], nfit * nfit)
+	    call amovr (Memr[delta1], Memr[delta2], nfit)
+	    call amovr (Memr[new], params, np)
+	} else
+	    mr = 10. * mr
+
+	if (mr == 0.) {
+	    call mfree (new, TY_REAL)
+	    call mfree (a1,  TY_REAL)
+	    call mfree (a2,  TY_REAL)
+	    call mfree (delta1, TY_REAL)
+	    call mfree (delta2, TY_REAL)
+	}
+end
+
+
+# MR_EVAL -- Evaluate curvature matrix.  This calls procedure DERIVS.
+
+procedure mr_eval (x, y, npts, params, flags, np, a, delta, nfit, chisq)
+
+real	x[npts]			# X data array
+real	y[npts]			# Y data array
+int	npts			# Number of data points
+real	params[np]		# Parameter array
+int	flags[np]		# Flag array indexing parameters to fit
+int	np			# Number of parameters
+real	a[nfit,nfit]		# Curvature matrix
+real	delta[nfit]		# Delta array
+int	nfit			# Number of parameters to fit
+real	chisq			# Chi square of fit
+
+int	i, j, k
+real	ymod, dy, dydpj, dydpk
+pointer	sp, dydp
+
+begin
+	call smark (sp)
+	call salloc (dydp, np, TY_REAL)
+
+	do j = 1, nfit {
+	   do k = 1, j
+	       a[j,k] = 0.
+	    delta[j] = 0.
+	}
+
+	chisq = 0.
+	do i = 1, npts {
+	    call derivs (x[i], params, ymod, Memr[dydp], np)
+	    dy = y[i] - ymod
+	    do j = 1, nfit {
+		dydpj = Memr[dydp+flags[j]-1]
+		delta[j] = delta[j] + dy * dydpj
+		do k = 1, j {
+		    dydpk = Memr[dydp+flags[k]-1]
+		    a[j,k] = a[j,k] + dydpj * dydpk
+		}
+	    }
+	    chisq = chisq + dy * dy
+	}
+
+	do j = 2, nfit
+	    do k = 1, j-1
+		a[k,j] = a[j,k]
+
+	call sfree (sp)
+end
+	    
+
+# MR_INVERT -- Solve a set of linear equations using Householder transforms.
+# This calls a routine published in in "Solving Least Squares Problems",
+# by Charles L. Lawson and Richard J. Hanson, Prentice Hall, 1974.
+
+procedure mr_invert (a, b, n)
+
+real	a[n,n]		# Input matrix and returned inverse
+real	b[n]		# Input RHS vector and returned solution
+int	n		# Dimension of input matrices
+
+int	krank
+real	rnorm
+pointer	sp, h, g, ip
+
+begin
+	call smark (sp)
+	call salloc (h, n, TY_REAL)
+	call salloc (g, n, TY_REAL)
+	call salloc (ip, n, TY_INT)
+
+	call hfti (a, n, n, n, b, n, 1, 0.001, krank, rnorm,
+	    Memr[h], Memr[g], Memi[ip])
+
+	call sfree (sp)
+end
+
+
+# TWOFFT - Given two real input arrays DATA1 and DATA2, each of length
+# N, this routine calls cc_four1() and returns two complex output arrays,
+# FFT1 and FFT2, each of complex length N (i.e. real length 2*N), which
+# contain the discrete Fourier transforms of the respective DATAs.  As
+# always, N must be an integer power of 2.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+procedure twofft (data1, data2, fft1, fft2, N)
+
+real	data1[ARB], data2[ARB]	# Input data arrays
+real	fft1[ARB], fft2[ARB]	# Output FFT arrays
+int	N			# No. of points
+
+int	nn3, nn2, jj, j
+real	rep, rem, aip, aim
+
+begin
+	nn2 = 2  +  N  +  N
+	nn3 = nn2  +  1
+
+	jj = 2
+	for (j=1; j <= N; j = j  +  1) {
+	    fft1[jj-1] = data1[j]	# Pack 'em into one complex array
+	    fft1[jj] = data2[j]
+	    jj = jj  +  2
+	}
+
+	call four1 (fft1, N, 1)		# Transform the complex array
+	fft2[1] = fft1[2]
+	fft2[2] = 0.0
+	fft1[2] = 0.0
+	for (j=3; j <= N + 1; j = j  +  2) {
+	    rep = 0.5 * (fft1[j]  +  fft1[nn2-j])
+	    rem = 0.5 * (fft1[j] - fft1[nn2-j])
+	    aip = 0.5 * (fft1[j + 1]  +  fft1[nn3-j])
+	    aim = 0.5 * (fft1[j + 1] - fft1[nn3-j])
+	    fft1[j] = rep
+	    fft1[j+1] = aim
+	    fft1[nn2-j] = rep
+	    fft1[nn3-j] = -aim
+	    fft2[j] = aip
+	    fft2[j+1] = -rem
+	    fft2[nn2-j] = aip
+	    fft2[nn3-j] = rem
+	}
+
+end
+
+
+# REALFT - Calculates the Fourier Transform of a set of 2N real valued
+# data points.  Replaces this data (which is stored in the array DATA) by
+# the positive frequency half of it's complex Fourier Transform.  The real
+# valued first and last components of the complex transform are returned
+# as elements DATA(1) and DATA(2) respectively.  N must be an integer power
+# of 2.  This routine also calculates the inverse transform of a complex
+# array if it is the transform of real data.  (Result in this case must be
+# multiplied by 1/N). A forward transform is perform for isign == 1, other-
+# wise the inverse transform is computed.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+procedure realft (data, N, isign)
+
+real 	data[ARB]	# Input data array & output FFT
+int	N		# No. of points
+int 	isign		# Direction of transfer
+
+double	wr, wi, wpr, wpi, wtemp, theta	# Local variables
+real	c1, c2, h1r, h1i, h2r, h2i
+real	wrs, wis
+int	i, i1, i2, i3, i4 
+int	N2P3
+
+begin
+					# Initialize
+	theta = PI/double(N)
+	c1 = 0.5
+	
+	if (isign == 1) {
+	  c2 = -0.5
+	  call four1 (data,n,1)		# Forward transform is here
+	} else {
+	  c2 = 0.5
+	  theta = -theta
+	} 
+
+	wtemp = sin (0.5 * theta)
+	wpr = -2.0d0 * wtemp * wtemp
+	wpi = dsin (theta)
+	wr = 1.0D0  +  wpr
+	wi = wpi
+	n2p3 = 2*n + 3
+
+	for (i=2; i<=n/2; i = i  +  1) {
+	  i1 = 2 * i - 1
+	  i2 = i1 + 1
+	  i3 = n2p3 - i2
+	  i4 = i3 + 1
+	  wrs = sngl (wr)
+	  wis = sngl (wi)
+	  			# The 2 transforms are separated out of Z
+	  h1r = c1 * (data[i1] + data[i3])	
+	  h1i = c1 * (data[i2] - data[i4])
+	  h2r = -c2 * (data[i2] + data[i4])
+	  h2i = c2 * (data[i1] - data[i3])
+				# Here they are recombined to form the true
+				# transform of the original real data.
+	  data[i1] = h1r + wr*h2r - wi*h2i
+	  data[i2] = h1i + wr*h2i + wi*h2r
+	  data[i3] = h1r - wr*h2r + wi*h2i
+	  data[i4] = -h1i + wr*h2i + wi*h2r
+
+	  wtemp = wr		# The reccurrence
+	  wr = wr * wpr - wi * wpi + wr
+	  wi = wi * wpr + wtemp * wpi + wi
+	}
+
+	if (isign == 1) {
+	  h1r = data[1]
+	  data[1] = h1r + data[2]
+	  data[2] = h1r - data[2]
+	} else {
+	  h1r = data[1]
+	  data[1] = c1 * (h1r + data[2])
+	  data[2] = c1 * (h1r - data[2])
+	  call four1 (data,n,-1)
+	}
+
+end
+
+
+# FOUR1 -  Replaces DATA by it's discrete transform, if ISIGN is input
+# as 1; or replaces DATA by NN times it's inverse discrete Fourier transform
+# if ISIGN is input as -1.  Data is a complex array of length NN or, equiv-
+# alently, a real array of length 2*NN.  NN *must* be an integer power of
+# two.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+procedure four1 (data, nn, isign)
+
+real	data[ARB]	# Data array (returned as FFT)
+int	nn		# No. of points in data array
+int	isign		# Direction of transform
+
+double 	wr, wi, wpr, wpi		# Local variables
+double	wtemp, theta
+real 	tempr, tempi
+int	i, j, istep
+int	n, mmax, m
+
+begin
+	n = 2 * nn
+	j = 1
+	for (i=1; i<n; i = i  +  2) {
+	  if (j > i) {				# Swap 'em
+	    tempr = data[j]
+	    tempi = data[j+1]
+	    data[j] = data[i]
+	    data[j+1] = data[i+1]
+	    data[i] = tempr
+	    data[i+1] = tempi
+	  }
+	  m = n / 2
+	  while (m >= 2 && j > m) {
+	    j = j - m
+	    m = m / 2
+	  }
+	  j = j + m
+	}
+	mmax = 2
+	while (n > mmax) {
+	  istep = 2 * mmax
+	  theta = TWOPI / double (isign*mmax)
+	  wtemp = dsin (0.5*theta)
+	  wpr = -2.d0 * wtemp * wtemp
+	  wpi = dsin (theta)
+	  wr = 1.d0
+	  wi = 0.d0
+	  for (m=1; m < mmax; m = m  +  2) {
+	    for (i=m; i<=n; i = i  +  istep) {
+		j = i + mmax
+		tempr = real (wr) * data[j] - real (wi) * data[j+1]
+		tempi = real (wr) * data[j + 1] + real (wi) * data[j]
+		data[j] = data[i] - tempr
+		data[j+1] = data[i+1] - tempi
+		data[i] = data[i] + tempr
+		data[i+1] = data[i+1] + tempi
+	    }
+	    wtemp = wr
+	    wr = wr * wpr - wi * wpi + wr
+	    wi = wi * wpr + wtemp * wpi + wi
+	  } 
+	  mmax = istep
+	}
+end
+
+
+################################################################################
+# LU Decomosition
+################################################################################
+define	TINY	(1E-20)		# Number of numerical limit
+
+# Given an N x N matrix A, with physical dimension N, this routine
+# replaces it by the LU decomposition of a rowwise permutation of
+# itself.  A and N are input.  A is output, arranged as in equation
+# (2.3.14) above; INDX is an output vector which records the row
+# permutation effected by the partial pivioting; D is output as +/-1
+# depending on whether the number of row interchanges was even or odd,
+# respectively.  This routine is used in combination with LUBKSB to
+# solve linear equations or invert a matrix.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+procedure ludcmp (a, n, np, indx, d)
+
+real	a[np,np]
+int	n
+int	np
+int	indx[n]
+real	d
+
+int	i, j, k, imax
+real	aamax, sum, dum
+pointer	vv
+
+begin
+	# Allocate memory.
+	call malloc (vv, n, TY_REAL)
+	
+	# Loop over rows to get the implict scaling information.
+	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 mfree (vv, TY_REAL)
+	        call error (1, "Singular matrix")
+	    }
+	    Memr[vv+i-1] = 1. / aamax
+	}
+
+	# This is the loop over columns of Crout's method.
+	do j = 1, n {
+	    do i = 1, j-1 {
+	        sum = a[i,j]
+		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]
+		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
+
+	    # Now, finally, divide by the pivot element.
+	    # If the pivot element is zero the matrix is signular (at
+	    # least to the precission of the algorithm.  For some
+	    # applications on singular matrices, it is desirable to
+	    # substitute TINY for zero.
+
+	    if (a[j,j] == 0.)
+	        a[j,j] = TINY
+	    if (j != n) {
+	        dum = 1. / a[j,j]
+		do i = j+1, n
+		    a[i,j] = a[i,j] * dum
+	    }
+	}
+
+	call mfree (vv, TY_REAL)
+end
+
+
+# Solves the set of N linear equations AX = B.  Here A is input, not
+# as the matrix of A but rather as its LU decomposition, determined by
+# the routine LUDCMP.  INDX is input as the permuation vector returned
+# by LUDCMP.  B is input as the right-hand side vector B, and returns
+# with the solution vector X.  A, N, NP and INDX are not modified by
+# this routine and can be left in place for successive calls with
+# different right-hand sides B.  This routine takes into account the
+# possiblity that B will begin with many zero elements, so it is
+# efficient for use in matrix inversion.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+procedure lubksb (a, n, np, indx, b)
+
+real	a[np,np]
+int	n
+int	np
+int	indx[n]
+real	b[n]
+
+int	i, j, ii, ll
+real	sum
+
+begin
+	ii = 0
+	do i = 1, n {
+	    ll = indx[i]
+	    sum = b[ll]
+	    b[ll] = b[i]
+	    if (ii != 0) {
+	        do j = ii, i-1
+		    sum = sum - a[i,j] * b[j]
+	    } else if (sum != 0.)
+	        ii = i
+	    b[i] = sum
+	}
+
+	do i = n, 1, -1 {
+	    sum = b[i]
+	    if (i < n) {
+	        do j = i+1, n
+		    sum = sum - a[i,j] * b[j]
+	    }
+	    b[i] = sum / a[i,i]
+	}
+end
+
+
+# Invert a matrix using LU decomposition using A as both input and output.
+
+procedure luminv (a, n, np)
+
+real	a[np,np]
+int	n
+int	np
+
+int	i, j
+real	d
+pointer	y, indx
+
+begin
+	# Allocate working memory.
+	call calloc (y, n*n, TY_REAL)
+	call malloc (indx, n, TY_INT)
+
+	# Setup identify matrix.
+	do i = 0, n-1
+	    Memr[y+(n+1)*i] = 1.
+
+	# Do LU decomposition.
+	call ludcmp (a, n, np, Memi[indx], d)
+
+	# Find inverse by columns.
+	do j = 0, n-1
+	    call lubksb (a, n, np, Memi[indx], Memr[y+n*j])
+
+	# Return inverse in a.
+	do i = 1, n
+	    do j = 1, n
+	        a[i,j] = Memr[y+n*(j-1)+(i-1)]
+
+	call mfree (y, TY_REAL)
+end
+################################################################################
diff --git a/pkg/xtools/obsdb.x b/pkg/xtools/obsdb.x
new file mode 100644
index 00000000..1bb2ea7d
--- /dev/null
+++ b/pkg/xtools/obsdb.x
@@ -0,0 +1,568 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<imset.h>
+
+.help obsdb Nov90 "Observatory Database Interface"
+.ih
+DESCRIPTION
+
+These procedures provide a simple interface to a simple observatory database.
+It uses environment variables if possible to allow users and sites to
+set or reset the observatory information.  The observatory database is
+specified by the environment parameter "obsdb" which defaults to
+"noao$lib/obsdb.dat".  The observatory may be specified as "observatory"
+to look first for the environment parameter "observatory" and then
+for the task parameter "observatory.observatory".   The observatory
+may also be specified as "obspars" to ignore the database and use the
+parameters set in observatory task parameter set.  This allows setting
+arbitrary values without requiring the user modify or create a database
+file.  The case of the observatory identification is ignored.
+
+PROCEDURES
+
+.nf
+	obs = obsopen (observatory)
+	obs = obsvopen (observatory, verbose)
+	      obsimopen (obs, im, observatory, verbose, newobs, obshead)
+	      obsclose (obs)
+	      obslog (obs, task, params, fd)
+	val = obsget[ird] (obs, param)
+	      obsgstr (obs, param, str, maxchar)
+	      obsinfo (obs, fd)
+.fi
+
+DATABASE
+
+The database file is that defined by the environment variable "obsdb".
+If absent the file is "noao$lib/obsdb.dat".  The observatory name
+used in the obsopen procedure is the observatory ID as defined
+in the database, the special string "observatory" which uses
+to the environment variable of the same name or the task parameter
+"observatory.observatory", or the special string "obspars" which
+uses the observatory task parameters and does not require an entry
+in the database.
+
+The database format is simply a list of keyword/value definitions with
+arbitrary whitespace allowed for visual formatting.  Also comments
+beginning with '#' may be used.  Parameters for a particular
+observatory begin with the "observatory" parameter and end with the
+next observatory definitions (or end-of-file).  For example:
+
+.nf
+observatory = "kpno"
+	name = "Kitt Peak National Observatory"
+	longitude = 111:36.0
+	latitude = 31:58.8
+	altitude = 2120.
+	timezone = 7
+
+observatory = "ctio"
+	<etc.>
+.fi
+
+String parameters must be quoted if they contain whitespace.
+.ih
+SEE ALSO
+Source code
+.endhelp
+
+
+# Symbol table definitions.
+define	LEN_INDEX	10		# Length of symtab index
+define	LEN_STAB	512		# Length of symtab
+define	SZ_SBUF		512		# Size of symtab string buffer
+define	SYMLEN		40		# Length of symbol structure
+define	SZ_OBSVAL	79		# Size of observatory value string
+
+# Symbol table structure
+define	OBSVAL		Memc[P2C($1)]	# Observatory value string
+
+
+# OBSOPEN -- Open observatory database and store the requested observatory
+# information in symbol table.
+
+pointer procedure obsopen (observatory)
+
+char	observatory[ARB]		# Observatory name
+pointer	obsvopen()
+errchk	obsvopen
+
+begin
+	return (obsvopen (observatory, NO))
+end
+
+
+# OBSVOPEN -- Open observatory database and store the requested observatory
+# information in symbol table.
+
+pointer procedure obsvopen (observatory, verbose)
+
+char	observatory[ARB]		# Observatory name
+int	verbose				# Verbose?
+pointer	obs				# Observatory symbol table pointer
+
+int	fd, envfind(), envgets(), open(), fscan(), nscan(), nowhite()
+pointer	sp, fname, obsname, key, str, temp, sym
+pointer	stopen(), stenter()
+bool	found, streq(), strne()
+errchk	open, stopen, stenter, envfind, envgets, fscan
+
+string	obskey	"observatory"
+define	getobs_	99
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (obsname, SZ_FNAME, TY_CHAR)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (temp, SZ_LINE, TY_CHAR)
+
+	# Open observatory database.
+	if (envfind ("obsdb", Memc[fname], SZ_FNAME) <= 0) {
+	    call strcpy ("noao$lib/obsdb.dat", Memc[fname], SZ_FNAME)
+	    if (verbose == YES) {
+		call eprintf ("Using default observatory database: %s\n")
+		    call pargstr ("noao$lib/obsdb.dat")
+	    }
+	} else if (verbose == YES) {
+	    call eprintf (
+		"Using database defined by '%s' environment variable: %s\n")
+		call pargstr ("obsdb")
+		call pargstr (Memc[fname])
+	}
+	fd = open (Memc[fname], READ_ONLY, TEXT_FILE)
+
+	# Set observatory from the environment or task parameter if needed.
+	# Convert to lower case but save original name for documentation.
+
+	if (streq (observatory, obskey)) {
+	    if (envgets (obskey, Memc[obsname], SZ_FNAME) <= 0) {
+		call clgstr ("observatory.observatory", Memc[obsname], SZ_FNAME)
+		if (verbose == YES) {
+		    call eprintf (
+			"Using observatory defined by observatory task: %s\n") 
+			call pargstr (Memc[obsname])
+		}
+	    } else if (verbose == YES) {
+		call eprintf (
+    		"Using observatory defined by '%s' environment variable: %s\n")
+		    call pargstr (observatory)
+		    call pargstr (Memc[obsname])
+	    }
+	} else
+	    call strcpy (observatory, Memc[obsname], SZ_LINE)
+
+getobs_ 
+	# Strip whitespace and convert to lower case.
+	call strcpy (Memc[obsname], Memc[temp], SZ_LINE)
+	if (nowhite (Memc[obsname], Memc[obsname], SZ_LINE) > 0)
+	    call strlwr (Memc[obsname])
+
+	if (streq (Memc[obsname], "obspars")) {
+	    if (verbose == YES) {
+		call eprintf (
+		    "Using observatory parameters from observatory task\n")
+	    }
+
+	    # Create symbol table.
+	    obs = stopen (Memc[obsname], LEN_INDEX, LEN_STAB, SZ_SBUF)
+	    sym = stenter (obs, obskey, SYMLEN)
+	    call strcpy (Memc[obsname], OBSVAL(sym), SZ_OBSVAL)
+#	    sym = obspars (obs, "name")
+#	    sym = obspars (obs, "longitude")
+#	    sym = obspars (obs, "latitude")
+#	    sym = obspars (obs, "altitude")
+#	    sym = obspars (obs, "timezone")
+	} else {
+	    if (verbose == YES) {
+		call eprintf (
+		    "Using observatory parameters for database entry: %s\n")
+		    call pargstr (Memc[temp])
+	    }
+
+	    # Find observatory entry.
+	    found = false
+	    while (fscan (fd) != EOF) {
+		call gargwrd (Memc[key], SZ_FNAME)
+		call gargwrd (Memc[str], SZ_LINE)
+		call gargwrd (Memc[str], SZ_LINE)
+		if (nscan()<3 || Memc[key]=='#' || strne (Memc[key], obskey))
+		    next
+		call strlwr (Memc[str])
+		if (streq (Memc[str], Memc[obsname])) {
+		    found = true
+		    break
+		}
+	    }
+
+	    # Check if entry was found.
+	    if (!found) {
+		if (Memc[obsname] != EOS && Memc[obsname] != '?') {
+		    call eprintf (
+		    "WARNING: Observatory entry %s not found in database %s")
+			call pargstr (Memc[temp])
+			call pargstr (Memc[fname])
+		}
+
+		# List database contents and try again
+		call seek (fd, BOF)
+		while (fscan (fd) != EOF) {
+		    call gargwrd (Memc[key], SZ_FNAME)
+		    call gargwrd (Memc[str], SZ_LINE)
+		    call gargwrd (Memc[str], SZ_LINE)
+		    if (nscan() < 3 || Memc[key] == '#')
+			next
+		    if (streq (Memc[key], obskey)) {
+			call eprintf ("\n  %s: ")
+			    call pargstr (Memc[str])
+		    } else if (streq (Memc[key], "name"))
+			call eprintf (Memc[str])
+		}
+		call seek (fd, BOF)
+		call eprintf (
+		   "\n  obspars:  Use parameters from OBSERVATORY task\n\n")
+		call flush (STDERR)
+		call clgstr ("observatory.override", Memc[obsname], SZ_LINE)
+		goto getobs_
+	    }
+
+	    # Create symbol table.
+	    obs = stopen (Memc[obsname], LEN_INDEX, LEN_STAB, SZ_SBUF)
+
+	    # Read the file and enter the parameters in the symbol table.
+	    sym = stenter (obs, Memc[key], SYMLEN)
+	    call strcpy (Memc[obsname], OBSVAL(sym), SZ_OBSVAL)
+	    while (fscan(fd) != EOF) {
+		call gargwrd (Memc[key], SZ_FNAME)
+		call gargwrd (Memc[str], SZ_LINE)
+		call gargwrd (Memc[str], SZ_LINE)
+		if (nscan() < 3 || Memc[key] == '#')
+		    next
+		if (streq (Memc[key], obskey))
+		    break
+		sym = stenter (obs, Memc[key], SYMLEN)
+		call strcpy (Memc[str], OBSVAL(sym), SZ_OBSVAL)
+	    }
+	}
+
+	call close (fd)
+	call sfree (sp)
+
+	return (obs)
+end
+
+
+# OBSCLOSE -- Close the observatory symbol table pointer.
+
+procedure obsclose (obs)
+
+pointer	obs			# Observatory symbol table pointer
+
+begin
+	if (obs != NULL)
+	    call stclose (obs)
+end
+
+
+# OBSPARS -- Get parameter and if not found possibly get it from the
+# observatory task
+
+pointer procedure obspars (obs, param)
+
+pointer	obs		# Observatory pointer
+char	param[ARB]	# Parameter
+pointer	sym		# Symbol table pointer
+
+bool	streq()
+pointer	sp, str, stfind(), stenter()
+double	clgetd()
+
+begin
+	sym = stfind (obs, param)
+	if (sym != NULL)
+	    return (sym)
+
+	sym = stfind (obs, "observatory")
+	if (!streq (OBSVAL(sym), "obspars")) {
+	    return (NULL)
+	}
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call sprintf (Memc[str], SZ_LINE, "observatory.%s")
+	    call pargstr (param)
+
+	if (streq (param, "name")) {
+	    sym = stenter (obs, param, SYMLEN)
+	    call clgstr (Memc[str], OBSVAL(sym), SZ_OBSVAL)
+	} else if (streq (param, "longitude")) {
+	    sym = stenter (obs, param, SYMLEN)
+	    call sprintf (OBSVAL(sym), SZ_OBSVAL, "%g")
+		call pargd (clgetd (Memc[str]))
+	} else if (streq (param, "latitude")) {
+	    sym = stenter (obs, param, SYMLEN)
+	    call sprintf (OBSVAL(sym), SZ_OBSVAL, "%g")
+		call pargd (clgetd (Memc[str]))
+	} else if (streq (param, "altitude")) {
+	    sym = stenter (obs, param, SYMLEN)
+	    call sprintf (OBSVAL(sym), SZ_OBSVAL, "%g")
+		call pargd (clgetd (Memc[str]))
+	} else if (streq (param, "timezone")) {
+	    sym = stenter (obs, param, SYMLEN)
+	    call sprintf (OBSVAL(sym), SZ_OBSVAL, "%g")
+		call pargd (clgetd (Memc[str]))
+	}
+
+	call sfree (sp)
+	return (sym)
+end
+	
+
+
+# OBSLOG -- Log current observatory
+
+procedure obslog (obs, task, params, fd)
+
+pointer	obs			# Observatory symbol table pointer
+char	task[ARB]		# Task name, image name, or other string
+char	params[ARB]		# Parameters to log
+int	fd			# File descriptor
+
+int	ip, ctowrd()
+pointer	sym, obspars()
+pointer	sp, param
+
+begin
+	call smark (sp)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+
+	# Log task string and observatory name
+	sym = obspars (obs, "name")
+	if (sym == NULL)
+	    sym = obspars (obs, "observatory")
+
+	call fprintf (fd, "# ")
+	if (task[1] != EOS) {
+	    call fprintf (fd, "%s: ")
+		call pargstr (task)
+	}
+	call fprintf (fd,  "Observatory parameters for %s\n")
+	    call pargstr (OBSVAL(sym))
+
+	for (ip=1; ctowrd (params, ip, Memc[param], SZ_FNAME) > 0;) {
+	    sym = obspars (obs, Memc[param])
+	    if (sym == NULL)
+		next
+	    call fprintf (fd, "#\t%s = %s\n")
+		call pargstr (Memc[param])
+		call pargstr (OBSVAL(sym))
+	}
+	call flush (fd)
+
+	call sfree (sp)
+end
+
+
+# OBSGETI -- Get integer observatory parameter.
+
+int procedure obsgeti (obs, param)
+
+pointer	obs			# Observatory symbol table pointer
+char	param[ARB]		# Observatory parameter
+
+int	ip, ival, ctoi()
+pointer	sym, obspars()
+errchk	obspars
+
+begin
+	sym = obspars (obs, param)
+	if (sym == NULL)
+	    call error (1, "OBSGETI: Observatory parameter not found")
+	ip = 1
+	if (ctoi (OBSVAL(sym), ip, ival) <= 0)
+	    call error (1, "OBSGETI: Observatory parameter not integer")
+	return (ival)
+end
+
+
+# OBSGETR -- Get real observatory parameter.
+
+real procedure obsgetr (obs, param)
+
+pointer	obs			# Observatory symbol table pointer
+char	param[ARB]		# Observatory parameter
+
+int	ip, ctor()
+real	rval
+pointer	sym, obspars()
+errchk	obspars
+
+begin
+	sym = obspars (obs, param)
+	if (sym == NULL)
+	    call error (1, "OBSGETR: Observatory parameter not found")
+	ip = 1
+	if (ctor (OBSVAL(sym), ip, rval) <= 0)
+	    call error (1, "OBSGETR: Observatory parameter not real")
+	return (rval)
+end
+
+
+# OBSGETD -- Get double observatory parameter.
+
+double procedure obsgetd (obs, param)
+
+pointer	obs			# Observatory symbol table pointer
+char	param[ARB]		# Observatory parameter
+
+int	ip, ctod()
+double	dval
+pointer	sym, obspars()
+errchk	obspars
+
+begin
+	sym = obspars (obs, param)
+	if (sym == NULL)
+	    call error (1, "OBSGETD: Observatory parameter not found")
+	ip = 1
+	if (ctod (OBSVAL(sym), ip, dval) <= 0)
+	    call error (1, "OBSGETD: Observatory parameter not double")
+	return (dval)
+end
+
+
+# OBSGSTR -- Get string valued observatory parameter.
+
+procedure obsgstr (obs, param, str, maxchar)
+
+pointer	obs			# Observatory symbol table pointer
+char	param[ARB]		# Observatory parameter
+char	str[maxchar]		# Observatory parameter value
+int	maxchar			# Maximum characters for string
+
+pointer	sym, obspars()
+errchk	obspars
+
+begin
+	sym = obspars (obs, param)
+	if (sym == NULL)
+	    call error (1, "OBSGSTR: Observatory parameter not found")
+	call strcpy (OBSVAL(sym), str, maxchar)
+end
+
+
+# OBSIMOPEN - Open/reopen observatory for an image.
+# Check if the OBSERVAT keyword is found.  If found open/reopen the
+# observatory.  If not found open/reopen the default observatory.
+# Return flags indicating a change in observatory and whether the
+# observatory was defined in the image.
+
+procedure obsimopen (obs, im, observatory, verbose, newobs, obshead)
+
+pointer	obs			#U Observatory symbol table pointer
+pointer	im			#I Image pointer
+char	observatory[ARB]	#I Default observatory
+int	verbose			#I Verbose?
+bool	newobs			#O New observatory?
+bool	obshead			#O Observatory found in header?	
+
+bool	strne()
+pointer	sp, observat, sym, obsvopen(), obspars()
+errchk	obsvopen
+
+begin
+	call smark (sp)
+	call salloc (observat, SZ_FNAME, TY_CHAR)
+
+	if (verbose == YES) {
+	    call imstats (im, IM_IMAGENAME, Memc[observat], SZ_FNAME)
+	    call eprintf ("%s: ")
+		call pargstr (Memc[observat])
+	}
+
+	newobs = false
+	ifnoerr (call imgstr (im, "observat", Memc[observat], SZ_FNAME)) {
+	    if (verbose == YES) {
+		call eprintf ("OBSERVAT = %s\n")
+		    call pargstr (Memc[observat])
+	    }
+
+	    call strlwr (Memc[observat])
+	    if (obs == NULL) {
+		obs = obsvopen (Memc[observat], verbose)
+		newobs = true
+	    } else {
+		sym = obspars (obs, "observatory")
+		if (strne (Memc[observat], OBSVAL(sym))) {
+		    call obsclose (obs)
+		    obs = obsvopen (Memc[observat], verbose)
+		    newobs = true
+		}
+	    }
+	    obshead = true
+	} else {
+	    if (verbose == YES) {
+		call eprintf ("No OBSERVAT keyword - using %s\n")
+		    call pargstr (observatory)
+	    }
+
+	    if (obs == NULL) {
+		obs = obsvopen (observatory, verbose)
+		newobs = true
+	    } else {
+		sym = obspars (obs, "observatory")
+		if (strne (observatory, OBSVAL(sym))) {
+		    call obsclose (obs)
+		    obs = obsvopen (observatory, verbose)
+		    newobs = true
+		}
+	    }
+	    obshead = false
+	}
+
+	call sfree (sp)
+end
+
+
+# OBSINFO -- List observatory parameters
+
+procedure obsinfo (obs, fd)
+
+pointer	obs			# Observatory symbol table pointer
+int	fd			# Output file descriptor
+
+pointer	sym, name, obspars(), sthead(), stnext(), stname()
+int	stridxs()
+bool	streq()
+errchk	obspars
+string	obskey	"observatory"
+
+begin
+	sym = obspars (obs, obskey)
+	call fprintf (fd, "\t%s = %s\n")
+	    call pargstr (obskey)
+	    call pargstr (OBSVAL(sym))
+
+	if (streq (OBSVAL(sym), "obspars")) {
+	    sym = obspars (obs, "name")
+	    sym = obspars (obs, "longitude")
+	    sym = obspars (obs, "latitude")
+	    sym = obspars (obs, "altitude")
+	    sym = obspars (obs, "timezone")
+	}
+
+	for (sym = sthead (obs); sym != NULL; sym = stnext (obs, sym)) {
+	    name = stname (obs, sym)
+	    if (streq (Memc[name], obskey))
+		next
+	    if (stridxs (" 	", OBSVAL(sym)) > 0)
+		call fprintf (fd, "\t%s = '%s'\n")
+	    else
+		call fprintf (fd, "\t%s = %s\n")
+		call pargstr (Memc[name])
+		call pargstr (OBSVAL(sym))
+	}
+end
diff --git a/pkg/xtools/peaks.x b/pkg/xtools/peaks.x
new file mode 100644
index 00000000..dfad9abb
--- /dev/null
+++ b/pkg/xtools/peaks.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PEAKS -- find the peaks in an array of x and y points.
+# The extrema in the input data points are found using extrema(xtools).
+# The extrema are located to a precision of dx.
+# The extrema with negative curvature (peaks) are selected and returned
+# in the x array.  The spline value is returned in the y array.  The
+# background is estimated by linear interpolation of the neighboring
+# minima (extrema of positive curvature) to the position of the peak.
+# The background is returned in the background array.  The number of
+# peaks found is returned as the function value.
+
+int procedure peaks (x, y, background, npts, dx)
+
+real	x[npts], y[npts]	# Input data points and output peaks
+real	background[npts]	# Background estimate
+int	npts			# Number of input data points
+real	dx			# Precision of peak positions
+
+int	i, j, k, npeaks, nextrema
+pointer	sp, a, b, c
+
+int	extrema()
+errchk	salloc
+
+begin
+	nextrema = extrema (x, y, background, npts, dx)
+
+	if (nextrema == 0)
+	    return (0)
+
+	# Allocate working storage
+	call smark (sp)
+	call salloc (a, nextrema, TY_REAL)
+	call salloc (b, nextrema, TY_REAL)
+	call salloc (c, nextrema, TY_REAL)
+
+	npeaks = 0
+	do i = 1, nextrema {
+	    if (background[i] < 0.) {
+		Memr[a + npeaks] = x[i]
+		Memr[b + npeaks] = y[i]
+		for (j = i - 1; j > 0; j = j - 1)
+		    if (background[j] > 0.)
+			break;
+		for (k = i + 1; k <= npts; k = k + 1)
+		    if (background[k] > 0.)
+			break;
+		if ((j >= 1) && (k <= npts))
+		    Memr[c + npeaks] =
+			(y[k] - y[j]) / (x[k] - x[j]) * (x[i] - x[j]) + y[j]
+		else if (j >= 1)
+		    Memr[c + npeaks] = y[j]
+		else if (k <= npts)
+		    Memr[c + npeaks] = y[k]
+		else {
+		    call sfree (sp)
+		    call error (1, "No background points")
+		}
+		npeaks = npeaks + 1
+	    }
+	}
+
+	call amovr (Memr[a], x, npeaks)
+	call amovr (Memr[b], y, npeaks)
+	call amovr (Memr[c], background, npeaks)
+
+	call sfree (sp)
+	return (npeaks)
+end
diff --git a/pkg/xtools/ranges.par b/pkg/xtools/ranges.par
new file mode 100644
index 00000000..57126d91
--- /dev/null
+++ b/pkg/xtools/ranges.par
@@ -0,0 +1,4 @@
+# Parameters for ranges task
+
+range_string,s,a,,,,Range string
+test,*i,a,,,,Test value
diff --git a/pkg/xtools/ranges.x b/pkg/xtools/ranges.x
new file mode 100644
index 00000000..ce008b12
--- /dev/null
+++ b/pkg/xtools/ranges.x
@@ -0,0 +1,245 @@
+include	<mach.h>
+include	<ctype.h>
+
+define	FIRST	1		# Default starting range
+define	LAST	MAX_INT		# Default ending range
+define	STEP	1		# Default step
+define	EOLIST	0		# End of list
+
+# DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas.  Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers.  ERR is returned as
+# the function value if a conversion error occurs.  The list of ranges is
+# delimited by EOLIST.
+
+int procedure decode_ranges (range_string, ranges, max_ranges, nvalues)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	nvalues			# The number of values in the ranges
+
+int	ip, nrange, first, last, step, ctoi()
+
+begin
+	ip = 1
+	nvalues = 0
+
+	do nrange = 1, max_ranges - 1 {
+	    # Defaults to all nonnegative integers
+	    first = FIRST
+	    last = LAST
+	    step = STEP
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get first limit.
+	    # Must be a number, '-', 'x', or EOS.  If not return ERR.
+	    if (range_string[ip] == EOS) {			# end of list
+		if (nrange == 1) {
+		    # Null string defaults
+		    ranges[1, 1] = first
+		    ranges[2, 1] = last
+		    ranges[3, 1] = step
+		    ranges[1, 2] = EOLIST
+	    	    nvalues = MAX_INT
+		    return (OK)
+		} else {
+		    ranges[1, nrange] = EOLIST
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, first) == 0)
+		    return (ERR)
+	    } else
+		return (ERR)
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get last limit
+	    # Must be '-', or 'x' otherwise last = first.
+	    if (range_string[ip] == 'x')
+		;
+	    else if (range_string[ip] == '-') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, last) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		last = first
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get step.
+	    # Must be 'x' or assume default step.
+	    if (range_string[ip] == 'x') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, step) == 0)
+		        ;
+		    if (step == 0)
+			return (ERR)
+		} else if (range_string[ip] == '-')
+		    ;
+		else
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    ranges[1, nrange] = first
+	    ranges[2, nrange] = last
+	    ranges[3, nrange] = step
+	    nvalues = nvalues + abs (last-first) / step + 1
+	}
+
+	return (ERR)					# ran out of space
+end
+
+
+# GET_NEXT_NUMBER -- Given a list of ranges and the current file number,
+# find and return the next file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically increasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure get_next_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number+1 is anywhere in the list, that is the next number,
+	# otherwise the next number is the smallest number in the list which
+	# is greater than number+1.
+
+	number = number + 1
+	next_number = MAX_INT
+
+	for (ip=1;  ranges[ip] != EOLIST;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (step == 0)
+		call error (1, "Step size of zero in range list")
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder + step <= last)
+		    next_number = number - remainder + step
+	    } else if (first > number)
+		next_number = min (next_number, first)
+	}
+
+	if (next_number == MAX_INT)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# GET_PREVIOUS_NUMBER -- Given a list of ranges and the current file number,
+# find and return the previous file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically decreasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure get_previous_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number-1 is anywhere in the list, that is the previous number,
+	# otherwise the previous number is the largest number in the list which
+	# is less than number-1.
+
+	number = number - 1
+	next_number = 0
+
+	for (ip=1;  ranges[ip] != EOLIST;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (step == 0)
+		call error (1, "Step size of zero in range list")
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder >= first)
+		    next_number = number - remainder
+	    } else if (last < number) {
+		remainder = mod (last - first, step)
+		if (remainder == 0)
+		    next_number = max (next_number, last)
+		else if (last - remainder >= first)
+		    next_number = max (next_number, last - remainder)
+	    }
+	}
+
+	if (next_number == 0)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# IS_IN_RANGE -- Test number to see if it is in range.
+# If the number is INDEFI then it is mapped to the maximum integer.
+
+bool procedure is_in_range (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Number to be tested against ranges
+
+int	ip, first, last, step, num
+
+begin
+	if (IS_INDEFI (number))
+	    num = MAX_INT
+	else
+	    num = number
+
+	for (ip=1;  ranges[ip] != EOLIST;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (num >= first && num <= last)
+		if (mod (num - first, step) == 0)
+		    return (true)
+	}
+
+	return (false)
+end
diff --git a/pkg/xtools/ranges/Revisions b/pkg/xtools/ranges/Revisions
new file mode 100644
index 00000000..a249d529
--- /dev/null
+++ b/pkg/xtools/ranges/Revisions
@@ -0,0 +1,59 @@
+.help revisions Jun88 pkg.xtools.ranges
+.nf
+xtools$ranges/rgranges.x
+    The range parsing would fail for single numbers.  (4/29/94, Valdes)
+
+xtools$ranges/rgranges.x
+xtools$ranges/rgxranges.gx
+    Added @file capability.  Rewrote the parsing logic.  (10/9/91, Valdes)
+
+xtools$ranges/rgwtbin.gx
+    At least one point from each sample region must be included regardless
+    of the size of average.  (6/14/89, Valdes)
+
+xtools$ranges/rgwtbin.gx
+    The remainder bin in a sample region must be at least
+    max (min (N, 3), (N+1)/2) except that a single bin may be any size. 
+    (6/7/89, Valdes)
+ 
+xtools$ranges/rgencode.x, rginverse.x, rgnext.x, rgunion.x
+    Added some missing functionality to convert a range into a string,
+    to invert a range, to get the next higher member of a range (ala
+    xtools$ranges.x) and to take the union of two ranges.
+    (6/2/89, Seaman)
+
+xtools$ranges/rgintersect.x, rgmerge.x
+    Fixed bugs in handling overlapping ranges.  (6/2/89, Seaman)
+
+xtools$ranges/rgxranges.gx
+    Numbers in scientific notation are now recognized.  Based on report
+    from Ivo Busko.  (3/1/89)
+ 
+xtools$ranges/rgwtbin.gx
+    The remainder bin in a sample region must be at least max (3, (N+1)/2)
+    except that a single bin may be any size.  (1/23/89, Valdes)
+ 
+xtools$ranges/rgdump.x +
+xtools$ranges/rgmerge.x
+    Valdes, May 4, 1987
+    1.  Added a debugging procedure for dumping the ranges descriptor.
+    2.  Fixed a bug when merging overlapping ranges.
+
+xtools$ranges/rgbin.gx
+xtools$ranges/rgwtbin.gx
+    Valdes, August 11, 1986
+    1.  Since AMED$T no longer modifies the input array the temporary arrays
+	used to preserve the input array are no longer needed.
+
+xtools$ranges: Valdes, August 11, 1986
+    1.  Reorganized package to have separate modules for each datatype.
+	This allows loading only the required procedures.
+
+xtools$ranges/rgwtbin.gx: Valdes, August 8, 1986
+    1.  If all the weights were zero in a given range then a divide by zero
+	would result.  A check against this was added.
+
+xtools$ranges: Valdes, March 13, 1986
+    1.  The RANGES package has been converted to generic form.  It is compiled
+	into both single and double precision procedures.
+.endhelp
diff --git a/pkg/xtools/ranges/mkpkg b/pkg/xtools/ranges/mkpkg
new file mode 100644
index 00000000..9ec1673f
--- /dev/null
+++ b/pkg/xtools/ranges/mkpkg
@@ -0,0 +1,49 @@
+# Library for the RANGES procedures.
+
+$checkout libxtools.a lib$
+$update	  libxtools.a
+$checkin  libxtools.a lib$
+$exit
+
+generic:
+	$set	GEN = "$$generic -k -t rd"
+	$ifolder (rgbinr.x, rgbin.gx)		$(GEN) rgbin.gx $endif
+	$ifolder (rgexcluder.x, rgexclude.gx)	$(GEN) rgexclude.gx $endif
+	$ifolder (rggxmarkr.x, rggxmark.gx)	$(GEN) rggxmark.gx $endif
+	$ifolder (rgpackr.x, rgpack.gx)		$(GEN) rgpack.gx $endif
+	$ifolder (rgunpackr.x, rgunpack.gx)	$(GEN) rgunpack.gx $endif
+	$ifolder (rgwtbinr.x, rgwtbin.gx)	$(GEN) rgwtbin.gx $endif
+	$ifolder (rgxrangesr.x, rgxranges.gx)	$(GEN) rgxranges.gx $endif
+	;
+
+libxtools.a:
+	$ifeq (USE_GENERIC, yes) $call generic $endif
+
+	rgbind.x	<pkg/rg.h>
+	rgbinr.x	<pkg/rg.h>
+	rgdump.x	<pkg/rg.h>
+	rgencode.x	<pkg/rg.h>
+	rgexcluded.x	<pkg/rg.h>
+	rgexcluder.x	<pkg/rg.h>
+	rgfree.x	
+	rggxmarkd.x	<gset.h> <pkg/rg.h>
+	rggxmarkr.x	<gset.h> <pkg/rg.h>
+	rgindices.x	<pkg/rg.h>
+	rginrange.x	<pkg/rg.h>
+	rgintersect.x	<pkg/rg.h>
+	rginverse.x	<pkg/rg.h>
+	rgmerge.x	<pkg/rg.h>
+	rgnext.x	<mach.h> <pkg/rg.h>
+	rgorder.x	<pkg/rg.h>
+	rgpackd.x	<pkg/rg.h>
+	rgpackr.x	<pkg/rg.h>
+	rgranges.x	<ctype.h> <error.h> <pkg/rg.h>
+	rgunion.x	<pkg/rg.h>
+	rgunpackd.x	<pkg/rg.h>
+	rgunpackr.x	<pkg/rg.h>
+	rgwindow.x	<pkg/rg.h>
+	rgwtbind.x	<pkg/rg.h>
+	rgwtbinr.x	<pkg/rg.h>
+	rgxrangesd.x	<ctype.h> <error.h> <pkg/rg.h>
+	rgxrangesr.x	<ctype.h> <error.h> <pkg/rg.h>
+	;
diff --git a/pkg/xtools/ranges/rgbin.gx b/pkg/xtools/ranges/rgbin.gx
new file mode 100644
index 00000000..f1133a1c
--- /dev/null
+++ b/pkg/xtools/ranges/rgbin.gx
@@ -0,0 +1,75 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_BIN -- Average or median of data.
+#
+# The ranges are broken up into subranges of at most abs (nbin) points.  The
+# subranges are averaged if nbin > 1 and medianed if nbin < 1.
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_bin$t (rg, nbin, in, nin, out, nout)
+
+pointer	rg				# Ranges
+int	nbin				# Maximum points in average or median
+PIXEL	in[nin]				# Input array
+int	nin				# Number of input points
+PIXEL	out[ARB]			# Output array
+int	nout				# Number of output points
+
+int	i, j, k, n, npts, ntemp
+
+PIXEL	asum$t(), amed$t()
+
+errchk	rg_pack$t
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	# If the bin size is exactly one then move the selected input points
+	# to the output array.
+
+	if (abs (nbin) == 1) {
+	    call rg_pack$t (rg, in, out)
+	    return
+	}
+
+	# Determine the subranges and take the median or average.
+
+	npts = abs (nbin)
+	ntemp = 0
+
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		j = min (nin, RG_X1(rg, i))
+		k = max (1, RG_X2(rg, i))
+		while (j >= k) {
+		    n = max (0, min (npts, j - k + 1))
+		    k = k - n
+		    ntemp = ntemp + 1
+		    if (nbin > 0)
+		        out[ntemp] = asum$t (in[k + 1], n) / n
+		    else
+			out[ntemp] = amed$t (in[k+1], n)
+		}
+	    } else {
+		j = max (1, RG_X1(rg, i))
+		k = min (nin, RG_X2(rg, i))
+	        while (j <= k) {
+		    n = max (0, min (npts, k - j + 1))
+		    ntemp = ntemp + 1
+		    if (nbin > 0)
+		        out[ntemp] = asum$t (in[j], n) / n
+		    else
+			out[ntemp] = amed$t (in[j], n)
+		    j = j + n
+		}
+	    }
+	}
+
+	nout = ntemp
+end
diff --git a/pkg/xtools/ranges/rgbind.x b/pkg/xtools/ranges/rgbind.x
new file mode 100644
index 00000000..16c66760
--- /dev/null
+++ b/pkg/xtools/ranges/rgbind.x
@@ -0,0 +1,75 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_BIN -- Average or median of data.
+#
+# The ranges are broken up into subranges of at most abs (nbin) points.  The
+# subranges are averaged if nbin > 1 and medianed if nbin < 1.
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_bind (rg, nbin, in, nin, out, nout)
+
+pointer	rg				# Ranges
+int	nbin				# Maximum points in average or median
+double	in[nin]				# Input array
+int	nin				# Number of input points
+double	out[ARB]			# Output array
+int	nout				# Number of output points
+
+int	i, j, k, n, npts, ntemp
+
+double	asumd(), amedd()
+
+errchk	rg_packd
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	# If the bin size is exactly one then move the selected input points
+	# to the output array.
+
+	if (abs (nbin) == 1) {
+	    call rg_packd (rg, in, out)
+	    return
+	}
+
+	# Determine the subranges and take the median or average.
+
+	npts = abs (nbin)
+	ntemp = 0
+
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		j = min (nin, RG_X1(rg, i))
+		k = max (1, RG_X2(rg, i))
+		while (j >= k) {
+		    n = max (0, min (npts, j - k + 1))
+		    k = k - n
+		    ntemp = ntemp + 1
+		    if (nbin > 0)
+		        out[ntemp] = asumd (in[k + 1], n) / n
+		    else
+			out[ntemp] = amedd (in[k+1], n)
+		}
+	    } else {
+		j = max (1, RG_X1(rg, i))
+		k = min (nin, RG_X2(rg, i))
+	        while (j <= k) {
+		    n = max (0, min (npts, k - j + 1))
+		    ntemp = ntemp + 1
+		    if (nbin > 0)
+		        out[ntemp] = asumd (in[j], n) / n
+		    else
+			out[ntemp] = amedd (in[j], n)
+		    j = j + n
+		}
+	    }
+	}
+
+	nout = ntemp
+end
diff --git a/pkg/xtools/ranges/rgbinr.x b/pkg/xtools/ranges/rgbinr.x
new file mode 100644
index 00000000..81fb9f70
--- /dev/null
+++ b/pkg/xtools/ranges/rgbinr.x
@@ -0,0 +1,75 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_BIN -- Average or median of data.
+#
+# The ranges are broken up into subranges of at most abs (nbin) points.  The
+# subranges are averaged if nbin > 1 and medianed if nbin < 1.
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_binr (rg, nbin, in, nin, out, nout)
+
+pointer	rg				# Ranges
+int	nbin				# Maximum points in average or median
+real	in[nin]				# Input array
+int	nin				# Number of input points
+real	out[ARB]			# Output array
+int	nout				# Number of output points
+
+int	i, j, k, n, npts, ntemp
+
+real	asumr(), amedr()
+
+errchk	rg_packr
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	# If the bin size is exactly one then move the selected input points
+	# to the output array.
+
+	if (abs (nbin) == 1) {
+	    call rg_packr (rg, in, out)
+	    return
+	}
+
+	# Determine the subranges and take the median or average.
+
+	npts = abs (nbin)
+	ntemp = 0
+
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		j = min (nin, RG_X1(rg, i))
+		k = max (1, RG_X2(rg, i))
+		while (j >= k) {
+		    n = max (0, min (npts, j - k + 1))
+		    k = k - n
+		    ntemp = ntemp + 1
+		    if (nbin > 0)
+		        out[ntemp] = asumr (in[k + 1], n) / n
+		    else
+			out[ntemp] = amedr (in[k+1], n)
+		}
+	    } else {
+		j = max (1, RG_X1(rg, i))
+		k = min (nin, RG_X2(rg, i))
+	        while (j <= k) {
+		    n = max (0, min (npts, k - j + 1))
+		    ntemp = ntemp + 1
+		    if (nbin > 0)
+		        out[ntemp] = asumr (in[j], n) / n
+		    else
+			out[ntemp] = amedr (in[j], n)
+		    j = j + n
+		}
+	    }
+	}
+
+	nout = ntemp
+end
diff --git a/pkg/xtools/ranges/rgdump.x b/pkg/xtools/ranges/rgdump.x
new file mode 100644
index 00000000..97c3a89b
--- /dev/null
+++ b/pkg/xtools/ranges/rgdump.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+
+include	<pkg/rg.h>
+
+# RG_DUMP -- Dump the contents of a range structure.
+
+procedure rg_dump (rg)
+
+pointer	rg		# Ranges
+
+int	i
+
+begin
+	if (rg == NULL)
+	    call printf ("RG_DUMP: The range pointer is NULL\n")
+	else {
+	    call printf ("RG_DUMP: NPTS = %d, NRGS = %d\n")
+		call pargi (RG_NPTS(rg))
+		call pargi (RG_NRGS(rg))
+	    do i = 1, RG_NRGS(rg) {
+		call printf ("  %4d - %4d\n")
+		    call pargi (RG_X1(rg, i))
+		    call pargi (RG_X2(rg, i))
+	    }
+	}
+	call flush (STDOUT)
+end
diff --git a/pkg/xtools/ranges/rgencode.x b/pkg/xtools/ranges/rgencode.x
new file mode 100644
index 00000000..ff0a0343
--- /dev/null
+++ b/pkg/xtools/ranges/rgencode.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_ENCODE -- Encode a range structure into a string, return the
+# number of characters that were written or ERR for string overflow.
+
+int procedure rg_encode (rg, outstr, maxch)
+
+pointer	rg				# First set of ranges
+char	outstr[maxch]			# String to receive the ranges
+int	maxch				# Maximum length of the string
+
+char	tmpstr[SZ_LINE]
+int	i, outlen
+
+int	strlen()
+
+begin
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	outlen = 0
+	outstr[1] = EOS
+
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) != RG_X2(rg, i)) {
+		call sprintf (tmpstr, maxch, "%d:%d,")
+		    call pargi (RG_X1(rg, i))
+		    call pargi (RG_X2(rg, i))
+	    } else {
+		call sprintf (tmpstr, maxch, "%d,")
+		    call pargi (RG_X1(rg, i))
+	    }
+
+	    outlen = outlen + strlen (tmpstr)
+
+	    if (outlen <= maxch)
+		call strcat (tmpstr, outstr, maxch)
+	    else {
+		outstr[1] = EOS
+		return (ERR)
+	    }
+	}
+
+	# remove the last comma
+
+	outstr[outlen] = EOS
+	outlen = outlen - 1
+
+	return (outlen)
+end
diff --git a/pkg/xtools/ranges/rgexclude.gx b/pkg/xtools/ranges/rgexclude.gx
new file mode 100644
index 00000000..876e4ef7
--- /dev/null
+++ b/pkg/xtools/ranges/rgexclude.gx
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_EXCLUDE -- Exclude points given by ranges.
+#
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_exclude$t (rg, a, nin, b, nout)
+
+pointer	rg					# Ranges
+PIXEL	a[nin]					# Input array
+int	nin					# Number of input points
+PIXEL	b[ARB]					# Output array
+int	nout					# Number of output points
+
+int	i, j, k, n, ntemp
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	if (RG_NRGS(rg) == 0) {
+	    call amov$t (a[1], b[1], nin)
+	    nout = nin
+	} else {
+	    ntemp = 0
+
+	    i = 1
+	    j = 1
+	    k = min (nin, min (RG_X1(rg, i), RG_X2(rg, i)) - 1)
+	    n = max (0, k - j + 1)
+	    call amov$t (a[j], b[ntemp+1], n)
+	    ntemp = ntemp + n
+
+	    do i = 2, RG_NRGS(rg) {
+	        j = max (1, max (RG_X1(rg, i-1), RG_X2(rg, i-1)) + 1)
+	        k = min (nin, min (RG_X1(rg, i), RG_X2(rg, i)) - 1)
+	        n = max (0, k - j + 1)
+	        call amov$t (a[j], b[ntemp+1], n)
+	        ntemp = ntemp + n
+	    }
+
+	    i = RG_NRGS (rg)
+	    j = max (1, max (RG_X1(rg, i), RG_X2(rg, i)) + 1)
+	    k = nin
+	    n = max (0, k - j + 1)
+	    call amov$t (a[j], b[ntemp+1], n)
+	    ntemp = ntemp + n
+	}
+
+	nout = ntemp
+end
diff --git a/pkg/xtools/ranges/rgexcluded.x b/pkg/xtools/ranges/rgexcluded.x
new file mode 100644
index 00000000..2d9ef823
--- /dev/null
+++ b/pkg/xtools/ranges/rgexcluded.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_EXCLUDE -- Exclude points given by ranges.
+#
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_excluded (rg, a, nin, b, nout)
+
+pointer	rg					# Ranges
+double	a[nin]					# Input array
+int	nin					# Number of input points
+double	b[ARB]					# Output array
+int	nout					# Number of output points
+
+int	i, j, k, n, ntemp
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	if (RG_NRGS(rg) == 0) {
+	    call amovd (a[1], b[1], nin)
+	    nout = nin
+	} else {
+	    ntemp = 0
+
+	    i = 1
+	    j = 1
+	    k = min (nin, min (RG_X1(rg, i), RG_X2(rg, i)) - 1)
+	    n = max (0, k - j + 1)
+	    call amovd (a[j], b[ntemp+1], n)
+	    ntemp = ntemp + n
+
+	    do i = 2, RG_NRGS(rg) {
+	        j = max (1, max (RG_X1(rg, i-1), RG_X2(rg, i-1)) + 1)
+	        k = min (nin, min (RG_X1(rg, i), RG_X2(rg, i)) - 1)
+	        n = max (0, k - j + 1)
+	        call amovd (a[j], b[ntemp+1], n)
+	        ntemp = ntemp + n
+	    }
+
+	    i = RG_NRGS (rg)
+	    j = max (1, max (RG_X1(rg, i), RG_X2(rg, i)) + 1)
+	    k = nin
+	    n = max (0, k - j + 1)
+	    call amovd (a[j], b[ntemp+1], n)
+	    ntemp = ntemp + n
+	}
+
+	nout = ntemp
+end
diff --git a/pkg/xtools/ranges/rgexcluder.x b/pkg/xtools/ranges/rgexcluder.x
new file mode 100644
index 00000000..44cb90fe
--- /dev/null
+++ b/pkg/xtools/ranges/rgexcluder.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_EXCLUDE -- Exclude points given by ranges.
+#
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_excluder (rg, a, nin, b, nout)
+
+pointer	rg					# Ranges
+real	a[nin]					# Input array
+int	nin					# Number of input points
+real	b[ARB]					# Output array
+int	nout					# Number of output points
+
+int	i, j, k, n, ntemp
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	if (RG_NRGS(rg) == 0) {
+	    call amovr (a[1], b[1], nin)
+	    nout = nin
+	} else {
+	    ntemp = 0
+
+	    i = 1
+	    j = 1
+	    k = min (nin, min (RG_X1(rg, i), RG_X2(rg, i)) - 1)
+	    n = max (0, k - j + 1)
+	    call amovr (a[j], b[ntemp+1], n)
+	    ntemp = ntemp + n
+
+	    do i = 2, RG_NRGS(rg) {
+	        j = max (1, max (RG_X1(rg, i-1), RG_X2(rg, i-1)) + 1)
+	        k = min (nin, min (RG_X1(rg, i), RG_X2(rg, i)) - 1)
+	        n = max (0, k - j + 1)
+	        call amovr (a[j], b[ntemp+1], n)
+	        ntemp = ntemp + n
+	    }
+
+	    i = RG_NRGS (rg)
+	    j = max (1, max (RG_X1(rg, i), RG_X2(rg, i)) + 1)
+	    k = nin
+	    n = max (0, k - j + 1)
+	    call amovr (a[j], b[ntemp+1], n)
+	    ntemp = ntemp + n
+	}
+
+	nout = ntemp
+end
diff --git a/pkg/xtools/ranges/rgfree.x b/pkg/xtools/ranges/rgfree.x
new file mode 100644
index 00000000..8b2ab344
--- /dev/null
+++ b/pkg/xtools/ranges/rgfree.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# RG_FREE -- Free ranges memory.
+
+procedure rg_free (rg)
+
+pointer	rg				# Ranges
+
+begin
+	if (rg != NULL) {
+	    call mfree (rg, TY_STRUCT)
+	    rg = NULL
+	}
+end
diff --git a/pkg/xtools/ranges/rggxmark.gx b/pkg/xtools/ranges/rggxmark.gx
new file mode 100644
index 00000000..26108c98
--- /dev/null
+++ b/pkg/xtools/ranges/rggxmark.gx
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<pkg/rg.h>
+
+# RG_GXMARK -- Mark x ranges.
+
+procedure rg_gxmark$t (gp, rstr, x, npts, pltype)
+
+pointer	gp				# GIO pointer
+char	rstr[ARB]			# Range string
+PIXEL	x[npts]				# Ordinates of graph
+int	npts				# Number of data points
+int	pltype				# Plot line type
+
+pointer	rg
+int	i, pltype1
+real	xl, xr, yb, yt, dy
+real	x1, x2, y1, y2, y3
+
+int	gstati(), stridxs()
+pointer	rg_xranges$t()
+
+begin
+	if (stridxs ("*", rstr) > 0)
+	    return
+
+	rg = rg_xranges$t (rstr, x, npts)
+
+	pltype1 = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_PLTYPE, pltype)
+
+	call ggwind (gp, xl, xr, yb, yt)
+
+	dy = yt - yb
+	y1 = yb + dy / 100
+	y2 = y1 + dy / 20
+	y3 = (y1 + y2) / 2
+
+	do i = 1, RG_NRGS(rg) {
+	    x1 = x[RG_X1(rg, i)]
+	    x2 = x[RG_X2(rg, i)]
+	    if ((x1 > xl) && (x1 < xr))
+	        call gline (gp, x1, y1, x1, y2)
+	    if ((x2 > xl) && (x2 < xr))
+	        call gline (gp, x2, y1, x2, y2)
+	    call gline (gp, x1, y3, x2, y3)
+	}
+
+	call gseti (gp, G_PLTYPE, pltype1)
+	call rg_free (rg)
+end
diff --git a/pkg/xtools/ranges/rggxmarkd.x b/pkg/xtools/ranges/rggxmarkd.x
new file mode 100644
index 00000000..82eb49db
--- /dev/null
+++ b/pkg/xtools/ranges/rggxmarkd.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<pkg/rg.h>
+
+# RG_GXMARK -- Mark x ranges.
+
+procedure rg_gxmarkd (gp, rstr, x, npts, pltype)
+
+pointer	gp				# GIO pointer
+char	rstr[ARB]			# Range string
+double	x[npts]				# Ordinates of graph
+int	npts				# Number of data points
+int	pltype				# Plot line type
+
+pointer	rg
+int	i, pltype1
+real	xl, xr, yb, yt, dy
+real	x1, x2, y1, y2, y3
+
+int	gstati(), stridxs()
+pointer	rg_xrangesd()
+
+begin
+	if (stridxs ("*", rstr) > 0)
+	    return
+
+	rg = rg_xrangesd (rstr, x, npts)
+
+	pltype1 = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_PLTYPE, pltype)
+
+	call ggwind (gp, xl, xr, yb, yt)
+
+	dy = yt - yb
+	y1 = yb + dy / 100
+	y2 = y1 + dy / 20
+	y3 = (y1 + y2) / 2
+
+	do i = 1, RG_NRGS(rg) {
+	    x1 = x[RG_X1(rg, i)]
+	    x2 = x[RG_X2(rg, i)]
+	    if ((x1 > xl) && (x1 < xr))
+	        call gline (gp, x1, y1, x1, y2)
+	    if ((x2 > xl) && (x2 < xr))
+	        call gline (gp, x2, y1, x2, y2)
+	    call gline (gp, x1, y3, x2, y3)
+	}
+
+	call gseti (gp, G_PLTYPE, pltype1)
+	call rg_free (rg)
+end
diff --git a/pkg/xtools/ranges/rggxmarkr.x b/pkg/xtools/ranges/rggxmarkr.x
new file mode 100644
index 00000000..ec0f63b8
--- /dev/null
+++ b/pkg/xtools/ranges/rggxmarkr.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	<pkg/rg.h>
+
+# RG_GXMARK -- Mark x ranges.
+
+procedure rg_gxmarkr (gp, rstr, x, npts, pltype)
+
+pointer	gp				# GIO pointer
+char	rstr[ARB]			# Range string
+real	x[npts]				# Ordinates of graph
+int	npts				# Number of data points
+int	pltype				# Plot line type
+
+pointer	rg
+int	i, pltype1
+real	xl, xr, yb, yt, dy
+real	x1, x2, y1, y2, y3
+
+int	gstati(), stridxs()
+pointer	rg_xrangesr()
+
+begin
+	if (stridxs ("*", rstr) > 0)
+	    return
+
+	rg = rg_xrangesr (rstr, x, npts)
+
+	pltype1 = gstati (gp, G_PLTYPE)
+	call gseti (gp, G_PLTYPE, pltype)
+
+	call ggwind (gp, xl, xr, yb, yt)
+
+	dy = yt - yb
+	y1 = yb + dy / 100
+	y2 = y1 + dy / 20
+	y3 = (y1 + y2) / 2
+
+	do i = 1, RG_NRGS(rg) {
+	    x1 = x[RG_X1(rg, i)]
+	    x2 = x[RG_X2(rg, i)]
+	    if ((x1 > xl) && (x1 < xr))
+	        call gline (gp, x1, y1, x1, y2)
+	    if ((x2 > xl) && (x2 < xr))
+	        call gline (gp, x2, y1, x2, y2)
+	    call gline (gp, x1, y3, x2, y3)
+	}
+
+	call gseti (gp, G_PLTYPE, pltype1)
+	call rg_free (rg)
+end
diff --git a/pkg/xtools/ranges/rgindices.x b/pkg/xtools/ranges/rgindices.x
new file mode 100644
index 00000000..48f1ec8f
--- /dev/null
+++ b/pkg/xtools/ranges/rgindices.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_INDICES -- Return the indices in the ranges.
+
+procedure rg_indices (rg, indices, npts, type)
+
+pointer	rg				# Ranges
+pointer	indices				# Indices
+int	npts				# Number of indices
+int	type				# Data type of points
+
+int	i, j, k, step
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	# Determine the number of range points.
+
+	indices = NULL
+	npts = 0
+	if (RG_NRGS (rg) == 0)
+	    return
+
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) > RG_X2(rg, i))
+		npts = npts + RG_X1(rg, i) - RG_X2(rg, i) + 1
+	    else
+		npts = npts + RG_X2(rg, i) - RG_X1(rg, i) + 1
+	}
+
+	# Allocate the range points array.
+
+	call malloc (indices, npts, type)
+
+	# Set the range points.
+
+	k = indices
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) > RG_X2(rg, i))
+		step = -1
+	    else
+		step = 1
+
+	    switch (type) {
+	    case TY_SHORT:
+	    	do j = RG_X1(rg, i), RG_X2(rg, i), step {
+		    Mems[k] = j
+		    k = k + 1
+		}
+	    case TY_INT:
+	    	do j = RG_X1(rg, i), RG_X2(rg, i), step {
+		    Memi[k] = j
+		    k = k + 1
+		}
+	    case TY_LONG:
+	    	do j = RG_X1(rg, i), RG_X2(rg, i), step {
+		    Meml[k] = j
+		    k = k + 1
+		}
+	    case TY_REAL:
+	    	do j = RG_X1(rg, i), RG_X2(rg, i), step {
+		    Memr[k] = j
+		    k = k + 1
+		}
+	    case TY_DOUBLE:
+	    	do j = RG_X1(rg, i), RG_X2(rg, i), step {
+		    Memd[k] = j
+		    k = k + 1
+		}
+	    default:
+		call error (0, "rg_indices:  Datatype not available")
+	    }
+	}
+
+	return
+end
diff --git a/pkg/xtools/ranges/rginrange.x b/pkg/xtools/ranges/rginrange.x
new file mode 100644
index 00000000..7dd946ae
--- /dev/null
+++ b/pkg/xtools/ranges/rginrange.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_INRANGE -- Is value in the ranges?
+
+int procedure rg_inrange (rg, rval)
+
+pointer	rg				# Ranges
+int	rval				# Range value to test
+
+int	i
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	do i = 1, RG_NRGS(rg) {
+	    if ((RG_X1(rg, i) <= RG_X2(rg, i)) && (rval >= RG_X1(rg, i)) &&
+		    (rval <= RG_X2(rg, i)))
+		return (YES)
+	    else if ((rval >= RG_X2(rg, i)) && (rval <= RG_X1(rg, i)))
+		return (YES)
+	}
+
+	return (NO)
+end
diff --git a/pkg/xtools/ranges/rgintersect.x b/pkg/xtools/ranges/rgintersect.x
new file mode 100644
index 00000000..5e4e4390
--- /dev/null
+++ b/pkg/xtools/ranges/rgintersect.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_INTERSECT -- Intersect two sets of ordered and merged ranges.
+
+pointer procedure rg_intersect (rg1, rg2)
+
+pointer	rg1				# First set of ranges
+pointer	rg2				# Second set of ranges
+
+pointer	rg3				# Pointer to intersection
+
+int	i, j, k
+
+begin
+	# Error check the range pointers.
+
+	if ((rg1 == NULL) || (rg2 == NULL))
+	    call error (0, "Range descriptor(s) undefined")
+
+	# Allocate the range points array.
+
+	k = RG_NRGS(rg1) + RG_NRGS(rg2) - 1
+	call malloc (rg3, LEN_RG + 2 * max (1, k), TY_STRUCT)
+
+	# Set the ranges.
+
+	i = 1
+	j = 1
+	k = 0
+
+	while (i <= RG_NRGS(rg1) && j <= RG_NRGS(rg2)) {
+	    if (RG_X2(rg1, i) < RG_X1(rg2, j))
+		i = i + 1
+	    else if (RG_X2(rg2, j) < RG_X1(rg1, i))
+		j = j + 1
+	    else {
+		k = k + 1
+		RG_X1(rg3, k) = max (RG_X1(rg1, i), RG_X1(rg2, j))
+		RG_X2(rg3, k) = min (RG_X2(rg1, i), RG_X2(rg2, j))
+
+	        if (RG_X2(rg1, i) < RG_X2(rg2, j))
+		    i = i + 1
+	        else
+		    j = j + 1
+	    }
+	}
+
+	call realloc (rg3, LEN_RG + 2 * max (1, k), TY_STRUCT)
+
+	RG_NRGS(rg3) = k
+	RG_NPTS(rg3) = 0
+	do i = 1, RG_NRGS(rg3)
+	    RG_NPTS(rg3) = RG_NPTS(rg3) + RG_X2(rg3, i) - RG_X1(rg3, i) + 1
+
+	return (rg3)
+end
diff --git a/pkg/xtools/ranges/rginverse.x b/pkg/xtools/ranges/rginverse.x
new file mode 100644
index 00000000..869fde19
--- /dev/null
+++ b/pkg/xtools/ranges/rginverse.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_INVERSE -- Invert a set of ordered and merged ranges.
+
+procedure rg_inverse (rg, rmin, rmax)
+
+pointer	rg			# RANGES pointer
+int	rmin			# Minimum value of window
+int	rmax			# Maximum value of window
+
+int	i
+pointer rgtmp
+
+pointer	rg_window()
+
+begin
+	call malloc (rgtmp, LEN_RG + 2 * (RG_NRGS(rg) + 1), TY_STRUCT)
+	RG_NRGS(rgtmp) = RG_NRGS(rg) + 1
+
+	RG_X1(rgtmp, 1) = rmin
+
+	do i = 1, RG_NRGS(rg) {
+	    RG_X2(rgtmp, i) = RG_X1(rg, i) - 1
+	    RG_X1(rgtmp, i+1) = RG_X2(rg, i) + 1
+	}
+
+	RG_X2(rgtmp, RG_NRGS(rgtmp)) = rmax
+
+	call rg_free (rg)
+	rg = rg_window (rgtmp, rmin, rmax)
+	call rg_free (rgtmp)
+end
diff --git a/pkg/xtools/ranges/rgmerge.x b/pkg/xtools/ranges/rgmerge.x
new file mode 100644
index 00000000..2cb5034a
--- /dev/null
+++ b/pkg/xtools/ranges/rgmerge.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_MERGE -- Merge overlapping ranges in set of ordered ranges.
+
+procedure rg_merge (rg)
+
+pointer	rg				# Ranges
+
+int	new, old
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+	if (RG_NRGS(rg) == 0)
+	    return
+
+	# Eliminate overlapping ranges and count the number of new ranges.
+
+	new = 1
+	do old = 2, RG_NRGS(rg)
+	    if (RG_X1(rg, old) > RG_X2(rg, new) + 1) {
+		new = new + 1
+		RG_X1(rg, new) = RG_X1(rg, old)
+		RG_X2(rg, new) = RG_X2(rg, old)
+	    } else
+		RG_X2(rg, new) = max (RG_X2(rg, old), RG_X2(rg, new))
+
+	call realloc (rg, LEN_RG + 2 * new, TY_STRUCT)
+
+	RG_NPTS(rg) = 0
+	RG_NRGS(rg) = new
+	do new = 1, RG_NRGS(rg)
+	    RG_NPTS(rg) = RG_NPTS(rg) + RG_X2(rg, new) - RG_X1(rg, new) + 1
+end
diff --git a/pkg/xtools/ranges/rgnext.x b/pkg/xtools/ranges/rgnext.x
new file mode 100644
index 00000000..354ef813
--- /dev/null
+++ b/pkg/xtools/ranges/rgnext.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<pkg/rg.h>
+
+# RG_NEXT -- Return the next value in a set of ordered and merged ranges.
+# Number is set to the next value in the set of ranges or is unchanged
+# (and EOF is returned) if there are no more values.
+
+int procedure rg_next (rg, number)
+
+pointer	rg			# RANGES pointer
+int	number			# Both input and output parameter
+
+int	next_number, i
+
+begin
+	next_number = number + 1
+
+	do i = 1, RG_NRGS(rg)
+	    if (next_number > RG_X2(rg, i)) {
+		next
+	    } else if (next_number < RG_X1(rg, i)) {
+		number = RG_X1(rg, i)
+	    	return (number)
+	    } else {
+		number = next_number
+		return (number)
+	    }
+
+	return (EOF)
+end
diff --git a/pkg/xtools/ranges/rgorder.x b/pkg/xtools/ranges/rgorder.x
new file mode 100644
index 00000000..7864ecb2
--- /dev/null
+++ b/pkg/xtools/ranges/rgorder.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <pkg/rg.h>
+
+# RG_ORDER -- Make all ranges increasing and order by the starting point.
+
+procedure rg_order (rg)
+
+pointer	rg				# Ranges
+
+int	i, j, temp
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	# Make all ranges increasing.
+
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		temp = RG_X1(rg, i)
+		RG_X1(rg, i) = RG_X2(rg, i)
+		RG_X2(rg, i) = temp
+	    }
+	}
+
+	# Sort the ranges in increasing order.
+
+	do i = 1, RG_NRGS(rg) - 1 {
+	    do j = i + 1, RG_NRGS(rg) {
+		if (RG_X1(rg, i) > RG_X1(rg, j)) {
+		    temp = RG_X1(rg, i)
+		    RG_X1(rg, i) = RG_X1(rg, j)
+		    RG_X1(rg, j) = temp
+		    temp = RG_X2(rg, i)
+		    RG_X2(rg, i) = RG_X2(rg, j)
+		    RG_X2(rg, j) = temp
+		}
+	    }
+	}
+end
diff --git a/pkg/xtools/ranges/rgpack.gx b/pkg/xtools/ranges/rgpack.gx
new file mode 100644
index 00000000..d77a3a09
--- /dev/null
+++ b/pkg/xtools/ranges/rgpack.gx
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_PACK -- Pack input data to include only points in the ranges.
+#
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_pack$t (rg, a, b)
+
+pointer	rg					# Ranges
+PIXEL	a[ARB]					# Input array
+PIXEL	b[ARB]					# Output array
+
+int	i, j, k, n
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range pointer undefined")
+
+	j = 0
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		do k = RG_X1(rg, i), RG_X2(rg, i), -1 {
+		    j = j + 1
+		    b[j] = a[k]
+		}
+	    } else {
+		n = RG_X2(rg, i) - RG_X1(rg, i) + 1
+	        call amov$t (a[RG_X1(rg, i)], b[j + 1], n)
+	        j = j + n
+	    }
+	}
+end
diff --git a/pkg/xtools/ranges/rgpackd.x b/pkg/xtools/ranges/rgpackd.x
new file mode 100644
index 00000000..a0889ec6
--- /dev/null
+++ b/pkg/xtools/ranges/rgpackd.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_PACK -- Pack input data to include only points in the ranges.
+#
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_packd (rg, a, b)
+
+pointer	rg					# Ranges
+double	a[ARB]					# Input array
+double	b[ARB]					# Output array
+
+int	i, j, k, n
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range pointer undefined")
+
+	j = 0
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		do k = RG_X1(rg, i), RG_X2(rg, i), -1 {
+		    j = j + 1
+		    b[j] = a[k]
+		}
+	    } else {
+		n = RG_X2(rg, i) - RG_X1(rg, i) + 1
+	        call amovd (a[RG_X1(rg, i)], b[j + 1], n)
+	        j = j + n
+	    }
+	}
+end
diff --git a/pkg/xtools/ranges/rgpackr.x b/pkg/xtools/ranges/rgpackr.x
new file mode 100644
index 00000000..e01307a3
--- /dev/null
+++ b/pkg/xtools/ranges/rgpackr.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_PACK -- Pack input data to include only points in the ranges.
+#
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_packr (rg, a, b)
+
+pointer	rg					# Ranges
+real	a[ARB]					# Input array
+real	b[ARB]					# Output array
+
+int	i, j, k, n
+
+begin
+	# Error check the range pointer.
+
+	if (rg == NULL)
+	    call error (0, "Range pointer undefined")
+
+	j = 0
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		do k = RG_X1(rg, i), RG_X2(rg, i), -1 {
+		    j = j + 1
+		    b[j] = a[k]
+		}
+	    } else {
+		n = RG_X2(rg, i) - RG_X1(rg, i) + 1
+	        call amovr (a[RG_X1(rg, i)], b[j + 1], n)
+	        j = j + n
+	    }
+	}
+end
diff --git a/pkg/xtools/ranges/rgranges.x b/pkg/xtools/ranges/rgranges.x
new file mode 100644
index 00000000..913fc2b9
--- /dev/null
+++ b/pkg/xtools/ranges/rgranges.x
@@ -0,0 +1,136 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<ctype.h>
+include	<pkg/rg.h>
+
+define	NRGS	10		# Allocation size
+
+# RG_RANGES -- Parse a range string.  Return a pointer to the ranges.
+
+pointer procedure rg_ranges (rstr, rmin, rmax)
+
+char	rstr[ARB]		# Range string
+int	rmin			# Minimum value
+int	rmax			# Maximum value
+pointer	rg			# Range pointer
+
+int	i, fd, strlen(), open(), getline()
+pointer	sp, str, ptr
+errchk	open, rg_add
+
+begin
+	call smark (sp)
+	call salloc (str, max (strlen (rstr), SZ_LINE), TY_CHAR)
+	call calloc (rg, LEN_RG, TY_STRUCT)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Add range(s)
+	    iferr {
+		if (Memc[str] == '@') {
+		    fd = open (Memc[str+1], READ_ONLY, TEXT_FILE)
+		    while (getline (fd, Memc[str]) != EOF) {
+			iferr (call rg_add (rg, Memc[str], rmin, rmax))
+			    call erract (EA_WARN)
+		    }
+		    call close (fd)
+		} else
+		    call rg_add (rg, Memc[str], rmin, rmax)
+	    } then
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+	return (rg)
+end
+
+
+# RG_ADD -- Add a range
+
+procedure rg_add (rg, rstr, rmin, rmax)
+
+pointer	rg			# Range descriptor
+char	rstr[ARB]		# Range string
+int	rmin			# Minimum value
+int	rmax			# Maximum value
+
+int	i, j, nrgs, strlen(), ctoi()
+int	rval1, rval2
+pointer	sp, str, ptr
+
+begin
+	call smark (sp)
+	call salloc (str, strlen (rstr), TY_CHAR)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		if (rstr[i] == ':')
+		    Memc[ptr] = ' '
+		else
+		    Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Parse range
+	    if (Memc[str] == '@')
+		call error (1, "Cannot nest @files")
+	    else if (Memc[str] == '*') {
+		rval1 = rmin
+		rval2 = rmax
+	    } else {
+		# Get range
+		j = 1
+		if (ctoi (Memc[str], j, rval1) == 0)
+		    call error (1, "Range syntax error")
+		if (ctoi (Memc[str], j, rval2) == 0)
+		    rval2 = rval1
+	    }
+
+	    # Check limits.
+	    j = rval1
+	    rval1 = min (j, rval2)
+	    rval2 = max (j, rval2)
+	    if (rval2 >= rmin && rval1 <= rmax) {
+		nrgs = RG_NRGS(rg)
+		if (mod (nrgs, NRGS) == 0)
+		    call realloc (rg, LEN_RG+2*(nrgs+NRGS), TY_STRUCT)
+		nrgs = nrgs + 1
+		RG_NRGS(rg) = nrgs
+		RG_X1(rg, nrgs) = max (rmin, rval1)
+		RG_X2(rg, nrgs) = min (rmax, rval2)
+		RG_NPTS(rg) = RG_NPTS(rg) +
+		    abs (RG_X1(rg, nrgs) - RG_X2(rg, nrgs)) + 1
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/ranges/rgunion.x b/pkg/xtools/ranges/rgunion.x
new file mode 100644
index 00000000..5b9dfa6f
--- /dev/null
+++ b/pkg/xtools/ranges/rgunion.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_UNION -- Find the union of two sets of ranges.
+
+pointer procedure rg_union (rg1, rg2)
+
+pointer	rg1				# First set of ranges
+pointer	rg2				# Second set of ranges
+
+pointer	rg3				# Pointer to union
+
+int	i, j
+
+begin
+	# Error check the range pointers.
+
+	if ((rg1 == NULL) || (rg2 == NULL))
+	    call error (0, "Range descriptor(s) undefined")
+
+	# Allocate the range points array.
+
+	i = RG_NRGS(rg1) + RG_NRGS(rg2)
+	call malloc (rg3, LEN_RG + 2 * max (1, i), TY_STRUCT)
+
+	# Set the ranges.
+
+	RG_NRGS(rg3) = i
+	RG_NPTS(rg3) = RG_NPTS(rg1) + RG_NPTS(rg2)
+
+	j = 1
+	do i = 1, RG_NRGS(rg1) {
+	    RG_X1(rg3, j) = RG_X1(rg1, i)
+	    RG_X2(rg3, j) = RG_X2(rg1, i)
+	    j = j + 1
+	}
+	do i = 1, RG_NRGS(rg2) {
+	    RG_X1(rg3, j) = RG_X1(rg2, i)
+	    RG_X2(rg3, j) = RG_X2(rg2, i)
+	    j = j + 1
+	}
+
+	call rgorder (rg3)
+	call rgmerge (rg3)
+
+	return (rg3)
+end
diff --git a/pkg/xtools/ranges/rgunpack.gx b/pkg/xtools/ranges/rgunpack.gx
new file mode 100644
index 00000000..2b357ebb
--- /dev/null
+++ b/pkg/xtools/ranges/rgunpack.gx
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_UNPACK -- Unpack a packed array.
+#
+# There is no checking on the size of the arrays.  The points in the
+# unpacked array which are not covered by the packed array are left unchanged.
+# The packed and unpacked arrays should not be the same.
+
+procedure rg_unpack$t (rg, packed, unpacked)
+
+pointer	rg					# Ranges
+PIXEL	packed[ARB]				# Packed array
+PIXEL	unpacked[ARB]				# Unpacked array
+
+int	i, j, x1, x2, nx
+
+begin
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	j = 1
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) < RG_X2(rg, i)) {
+		x1 = RG_X1(rg, i)
+		x2 = RG_X2(rg, i)
+	    } else {
+		x1 = RG_X2(rg, i)
+		x2 = RG_X1(rg, i)
+	    }
+
+	    nx = x2 - x1 + 1
+	    call amov$t (packed[j], unpacked[x1], nx)
+	    j = j + nx
+	}
+end
diff --git a/pkg/xtools/ranges/rgunpackd.x b/pkg/xtools/ranges/rgunpackd.x
new file mode 100644
index 00000000..2ce32fa2
--- /dev/null
+++ b/pkg/xtools/ranges/rgunpackd.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_UNPACK -- Unpack a packed array.
+#
+# There is no checking on the size of the arrays.  The points in the
+# unpacked array which are not covered by the packed array are left unchanged.
+# The packed and unpacked arrays should not be the same.
+
+procedure rg_unpackd (rg, packed, unpacked)
+
+pointer	rg					# Ranges
+double	packed[ARB]				# Packed array
+double	unpacked[ARB]				# Unpacked array
+
+int	i, j, x1, x2, nx
+
+begin
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	j = 1
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) < RG_X2(rg, i)) {
+		x1 = RG_X1(rg, i)
+		x2 = RG_X2(rg, i)
+	    } else {
+		x1 = RG_X2(rg, i)
+		x2 = RG_X1(rg, i)
+	    }
+
+	    nx = x2 - x1 + 1
+	    call amovd (packed[j], unpacked[x1], nx)
+	    j = j + nx
+	}
+end
diff --git a/pkg/xtools/ranges/rgunpackr.x b/pkg/xtools/ranges/rgunpackr.x
new file mode 100644
index 00000000..6c96f5f8
--- /dev/null
+++ b/pkg/xtools/ranges/rgunpackr.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_UNPACK -- Unpack a packed array.
+#
+# There is no checking on the size of the arrays.  The points in the
+# unpacked array which are not covered by the packed array are left unchanged.
+# The packed and unpacked arrays should not be the same.
+
+procedure rg_unpackr (rg, packed, unpacked)
+
+pointer	rg					# Ranges
+real	packed[ARB]				# Packed array
+real	unpacked[ARB]				# Unpacked array
+
+int	i, j, x1, x2, nx
+
+begin
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	j = 1
+	do i = 1, RG_NRGS(rg) {
+	    if (RG_X1(rg, i) < RG_X2(rg, i)) {
+		x1 = RG_X1(rg, i)
+		x2 = RG_X2(rg, i)
+	    } else {
+		x1 = RG_X2(rg, i)
+		x2 = RG_X1(rg, i)
+	    }
+
+	    nx = x2 - x1 + 1
+	    call amovr (packed[j], unpacked[x1], nx)
+	    j = j + nx
+	}
+end
diff --git a/pkg/xtools/ranges/rgwindow.x b/pkg/xtools/ranges/rgwindow.x
new file mode 100644
index 00000000..fe495362
--- /dev/null
+++ b/pkg/xtools/ranges/rgwindow.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_WINDOW -- Intersect a set of ordered and merged ranges with a window.
+
+pointer procedure rg_window (rg, rmin, rmax)
+
+pointer	rg				# Ranges
+int	rmin, rmax			# Window
+
+pointer	rgout				# Pointer to windowed ranges
+
+int	i, j
+
+begin
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	# Allocate the range points array.
+
+	call malloc (rgout, LEN_RG + 2 * max (1, RG_NRGS(rg)), TY_STRUCT)
+
+	# Set the windowed ranges.
+
+	j = 0
+	do i = 1, RG_NRGS(rg) {
+	    if ((rmin <= RG_X2(rg, i)) && (rmax >= RG_X1(rg, i))) {
+		j = j + 1
+		RG_X1(rgout, j) = max (rmin, RG_X1(rg, i))
+		RG_X2(rgout, j) = min (rmax, RG_X2(rg, i))
+	    }
+	}
+
+	call realloc (rgout, LEN_RG + 2 * max (1, j), TY_STRUCT)
+	RG_NRGS(rgout) = j
+	RG_NPTS(rgout) = 0
+	do i = 1, RG_NRGS(rgout)
+	    RG_NPTS(rgout) = RG_NPTS(rgout) +
+		abs (RG_X1(rgout, i) - RG_X2(rgout, i)) + 1
+
+	return (rgout)
+end
diff --git a/pkg/xtools/ranges/rgwtbin.gx b/pkg/xtools/ranges/rgwtbin.gx
new file mode 100644
index 00000000..711dbf1e
--- /dev/null
+++ b/pkg/xtools/ranges/rgwtbin.gx
@@ -0,0 +1,112 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_WTBIN -- Weighted average or median of data.
+#
+# The ranges are broken up into subranges of at most abs (nbin) points and a
+# minimum of max (3, (abs(nbin)+1)/2) (though always at least one bin).  The
+# subranges are weighted averaged if nbin > 1 and medianed if nbin < 1.
+# The output weights are the sum of the weights for each subrange.
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_wtbin$t (rg, nbin, in, wtin, nin, out, wtout, nout)
+
+pointer	rg				# Ranges
+int	nbin				# Maximum points in average or median
+PIXEL	in[nin]				# Input array
+PIXEL	wtin[nin]			# Input weights
+int	nin				# Number of input points
+PIXEL	out[ARB]			# Output array
+PIXEL	wtout[ARB]			# Output weights
+int	nout				# Number of output points
+
+int	i, j, k, l, n, npts, ntemp, nsample
+
+PIXEL	asum$t(), amed$t()
+
+errchk	rg_pack$t
+
+begin
+	# Check for a null set of ranges.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	# If the bin size is exactly one then move the selected input points
+	# to the output array.
+
+	if (abs (nbin) < 2) {
+	    call rg_pack$t (rg, in, out)
+	    call rg_pack$t (rg, wtin, wtout)
+	    nout = RG_NPTS(rg)
+	    return
+	}
+
+	# Determine the subranges and take the median or average.
+
+	npts = abs (nbin)
+	ntemp = 0
+
+	do i = 1, RG_NRGS(rg) {
+	    nsample = 0
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		j = min (nin, RG_X1(rg, i))
+		k = max (1, RG_X2(rg, i))
+		while (j >= k) {
+		    n = max (0, min (npts, j - k + 1))
+		    if (nsample > 0 && n < max (min (npts, 3), (npts+1)/2))
+			break
+		    k = k - n
+		    nsample = nsample + 1
+		    ntemp = ntemp + 1
+		    wtout[ntemp] = asum$t (wtin[k + 1], n)
+		    if (nbin > 0) {
+		        if (wtout[ntemp] != 0.) {
+			    out[ntemp] = 0.
+			    do l = k + 1, k + n
+			        out[ntemp] = out[ntemp] + in[l] * wtin[l]
+		            out[ntemp] = out[ntemp] / wtout[ntemp]
+			} else {
+			    out[ntemp] = 0.
+			    do l = k + 1, k + n
+			        out[ntemp] = out[ntemp] + in[l]
+		            out[ntemp] = out[ntemp] / n
+			}
+		    } else {
+			out[ntemp] = amed$t (in[k+1], n)
+		    }
+		}
+	    } else {
+		j = max (1, RG_X1(rg, i))
+		k = min (nin, RG_X2(rg, i))
+	        while (j <= k) {
+		    n = max (0, min (npts, k - j + 1))
+		    if (nsample > 0 && n < max (min (npts, 3), (npts+1)/2))
+			break
+		    nsample = nsample + 1
+		    ntemp = ntemp + 1
+		    wtout[ntemp] = asum$t (wtin[j], n)
+		    if (nbin > 0) {
+			if (wtout[ntemp] != 0.) {
+			    out[ntemp] = 0.
+			    do l = j, j + n - 1
+		                out[ntemp] = out[ntemp] + in[l] * wtin[l]
+			    out[ntemp] = out[ntemp] / wtout[ntemp]
+			} else {
+			    out[ntemp] = 0.
+			    do l = j, j + n - 1
+		                out[ntemp] = out[ntemp] + in[l]
+			    out[ntemp] = out[ntemp] / n
+			}
+		    } else {
+			out[ntemp] = amed$t (in[j], n)
+		    }
+		    j = j + n
+		}
+	    }
+	}
+
+	nout = ntemp
+end
diff --git a/pkg/xtools/ranges/rgwtbind.x b/pkg/xtools/ranges/rgwtbind.x
new file mode 100644
index 00000000..82adeba5
--- /dev/null
+++ b/pkg/xtools/ranges/rgwtbind.x
@@ -0,0 +1,112 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_WTBIN -- Weighted average or median of data.
+#
+# The ranges are broken up into subranges of at most abs (nbin) points and a
+# minimum of max (3, (abs(nbin)+1)/2) (though always at least one bin).  The
+# subranges are weighted averaged if nbin > 1 and medianed if nbin < 1.
+# The output weights are the sum of the weights for each subrange.
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_wtbind (rg, nbin, in, wtin, nin, out, wtout, nout)
+
+pointer	rg				# Ranges
+int	nbin				# Maximum points in average or median
+double	in[nin]				# Input array
+double	wtin[nin]			# Input weights
+int	nin				# Number of input points
+double	out[ARB]			# Output array
+double	wtout[ARB]			# Output weights
+int	nout				# Number of output points
+
+int	i, j, k, l, n, npts, ntemp, nsample
+
+double	asumd(), amedd()
+
+errchk	rg_packd
+
+begin
+	# Check for a null set of ranges.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	# If the bin size is exactly one then move the selected input points
+	# to the output array.
+
+	if (abs (nbin) < 2) {
+	    call rg_packd (rg, in, out)
+	    call rg_packd (rg, wtin, wtout)
+	    nout = RG_NPTS(rg)
+	    return
+	}
+
+	# Determine the subranges and take the median or average.
+
+	npts = abs (nbin)
+	ntemp = 0
+
+	do i = 1, RG_NRGS(rg) {
+	    nsample = 0
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		j = min (nin, RG_X1(rg, i))
+		k = max (1, RG_X2(rg, i))
+		while (j >= k) {
+		    n = max (0, min (npts, j - k + 1))
+		    if (nsample > 0 && n < max (min (npts, 3), (npts+1)/2))
+			break
+		    k = k - n
+		    nsample = nsample + 1
+		    ntemp = ntemp + 1
+		    wtout[ntemp] = asumd (wtin[k + 1], n)
+		    if (nbin > 0) {
+		        if (wtout[ntemp] != 0.) {
+			    out[ntemp] = 0.
+			    do l = k + 1, k + n
+			        out[ntemp] = out[ntemp] + in[l] * wtin[l]
+		            out[ntemp] = out[ntemp] / wtout[ntemp]
+			} else {
+			    out[ntemp] = 0.
+			    do l = k + 1, k + n
+			        out[ntemp] = out[ntemp] + in[l]
+		            out[ntemp] = out[ntemp] / n
+			}
+		    } else {
+			out[ntemp] = amedd (in[k+1], n)
+		    }
+		}
+	    } else {
+		j = max (1, RG_X1(rg, i))
+		k = min (nin, RG_X2(rg, i))
+	        while (j <= k) {
+		    n = max (0, min (npts, k - j + 1))
+		    if (nsample > 0 && n < max (min (npts, 3), (npts+1)/2))
+			break
+		    nsample = nsample + 1
+		    ntemp = ntemp + 1
+		    wtout[ntemp] = asumd (wtin[j], n)
+		    if (nbin > 0) {
+			if (wtout[ntemp] != 0.) {
+			    out[ntemp] = 0.
+			    do l = j, j + n - 1
+		                out[ntemp] = out[ntemp] + in[l] * wtin[l]
+			    out[ntemp] = out[ntemp] / wtout[ntemp]
+			} else {
+			    out[ntemp] = 0.
+			    do l = j, j + n - 1
+		                out[ntemp] = out[ntemp] + in[l]
+			    out[ntemp] = out[ntemp] / n
+			}
+		    } else {
+			out[ntemp] = amedd (in[j], n)
+		    }
+		    j = j + n
+		}
+	    }
+	}
+
+	nout = ntemp
+end
diff --git a/pkg/xtools/ranges/rgwtbinr.x b/pkg/xtools/ranges/rgwtbinr.x
new file mode 100644
index 00000000..a4be8485
--- /dev/null
+++ b/pkg/xtools/ranges/rgwtbinr.x
@@ -0,0 +1,112 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/rg.h>
+
+# RG_WTBIN -- Weighted average or median of data.
+#
+# The ranges are broken up into subranges of at most abs (nbin) points and a
+# minimum of max (3, (abs(nbin)+1)/2) (though always at least one bin).  The
+# subranges are weighted averaged if nbin > 1 and medianed if nbin < 1.
+# The output weights are the sum of the weights for each subrange.
+# The output array must be large enough to contain the desired points.
+# If the ranges are merged then the input and output arrays may be the same.
+
+procedure rg_wtbinr (rg, nbin, in, wtin, nin, out, wtout, nout)
+
+pointer	rg				# Ranges
+int	nbin				# Maximum points in average or median
+real	in[nin]				# Input array
+real	wtin[nin]			# Input weights
+int	nin				# Number of input points
+real	out[ARB]			# Output array
+real	wtout[ARB]			# Output weights
+int	nout				# Number of output points
+
+int	i, j, k, l, n, npts, ntemp, nsample
+
+real	asumr(), amedr()
+
+errchk	rg_packr
+
+begin
+	# Check for a null set of ranges.
+
+	if (rg == NULL)
+	    call error (0, "Range descriptor undefined")
+
+	# If the bin size is exactly one then move the selected input points
+	# to the output array.
+
+	if (abs (nbin) < 2) {
+	    call rg_packr (rg, in, out)
+	    call rg_packr (rg, wtin, wtout)
+	    nout = RG_NPTS(rg)
+	    return
+	}
+
+	# Determine the subranges and take the median or average.
+
+	npts = abs (nbin)
+	ntemp = 0
+
+	do i = 1, RG_NRGS(rg) {
+	    nsample = 0
+	    if (RG_X1(rg, i) > RG_X2(rg, i)) {
+		j = min (nin, RG_X1(rg, i))
+		k = max (1, RG_X2(rg, i))
+		while (j >= k) {
+		    n = max (0, min (npts, j - k + 1))
+		    if (nsample > 0 && n < max (min (npts, 3), (npts+1)/2))
+			break
+		    k = k - n
+		    nsample = nsample + 1
+		    ntemp = ntemp + 1
+		    wtout[ntemp] = asumr (wtin[k + 1], n)
+		    if (nbin > 0) {
+		        if (wtout[ntemp] != 0.) {
+			    out[ntemp] = 0.
+			    do l = k + 1, k + n
+			        out[ntemp] = out[ntemp] + in[l] * wtin[l]
+		            out[ntemp] = out[ntemp] / wtout[ntemp]
+			} else {
+			    out[ntemp] = 0.
+			    do l = k + 1, k + n
+			        out[ntemp] = out[ntemp] + in[l]
+		            out[ntemp] = out[ntemp] / n
+			}
+		    } else {
+			out[ntemp] = amedr (in[k+1], n)
+		    }
+		}
+	    } else {
+		j = max (1, RG_X1(rg, i))
+		k = min (nin, RG_X2(rg, i))
+	        while (j <= k) {
+		    n = max (0, min (npts, k - j + 1))
+		    if (nsample > 0 && n < max (min (npts, 3), (npts+1)/2))
+			break
+		    nsample = nsample + 1
+		    ntemp = ntemp + 1
+		    wtout[ntemp] = asumr (wtin[j], n)
+		    if (nbin > 0) {
+			if (wtout[ntemp] != 0.) {
+			    out[ntemp] = 0.
+			    do l = j, j + n - 1
+		                out[ntemp] = out[ntemp] + in[l] * wtin[l]
+			    out[ntemp] = out[ntemp] / wtout[ntemp]
+			} else {
+			    out[ntemp] = 0.
+			    do l = j, j + n - 1
+		                out[ntemp] = out[ntemp] + in[l]
+			    out[ntemp] = out[ntemp] / n
+			}
+		    } else {
+			out[ntemp] = amedr (in[j], n)
+		    }
+		    j = j + n
+		}
+	    }
+	}
+
+	nout = ntemp
+end
diff --git a/pkg/xtools/ranges/rgxranges.gx b/pkg/xtools/ranges/rgxranges.gx
new file mode 100644
index 00000000..7a779925
--- /dev/null
+++ b/pkg/xtools/ranges/rgxranges.gx
@@ -0,0 +1,162 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<ctype.h>
+include	<pkg/rg.h>
+
+define	NRGS	10		# Allocation size
+
+# RG_XRANGES -- Parse a range string corrsponding to a real set of values.
+# Return a pointer to the ranges.
+
+pointer procedure rg_xranges$t (rstr, rvals, npts)
+
+char	rstr[ARB]		# Range string
+PIXEL	rvals[npts]		# Range values (sorted)
+int	npts			# Number of range values
+pointer	rg			# Range pointer
+
+int	i, fd, strlen(), open(), getline()
+pointer	sp, str, ptr
+errchk	open, rg_xadd$t
+
+begin
+	# Check for valid arguments
+	if (npts < 1)
+	    call error (0, "No data points for range determination")
+
+	call smark (sp)
+	call salloc (str, max (strlen (rstr), SZ_LINE), TY_CHAR)
+	call calloc (rg, LEN_RG, TY_STRUCT)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Add range(s)
+	    iferr {
+		if (Memc[str] == '@') {
+		    fd = open (Memc[str+1], READ_ONLY, TEXT_FILE)
+		    while (getline (fd, Memc[str]) != EOF) {
+			iferr (call rg_xadd$t (rg, Memc[str], rvals, npts))
+			    call erract (EA_WARN)
+		    }
+		    call close (fd)
+		} else
+		    call rg_xadd$t (rg, Memc[str], rvals, npts)
+	    } then
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+	return (rg)
+end
+
+
+# RG_XADD -- Add a range
+
+procedure rg_xadd$t (rg, rstr, rvals, npts)
+
+pointer	rg			# Range descriptor
+char	rstr[ARB]		# Range string
+PIXEL	rvals[npts]		# Range values (sorted)
+int	npts			# Number of range values
+
+int	i, j, k, nrgs, strlen(), cto$t()
+PIXEL	rval1, rval2, a1, b1, a2, b2
+pointer	sp, str, ptr
+
+begin
+	call smark (sp)
+	call salloc (str, strlen (rstr), TY_CHAR)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		if (rstr[i] == ':')
+		    Memc[ptr] = ' '
+		else
+		    Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Parse range
+	    if (Memc[str] == '@')
+		call error (1, "Cannot nest @files")
+	    else if (Memc[str] == '*') {
+		rval1 = rvals[1]
+		rval2 = rvals[npts]
+	    } else {
+		# Get range
+		j = 1
+		if (cto$t (Memc[str], j, rval1) == 0)
+		    call error (1, "Range syntax error")
+		rval2 = rval1
+		if (cto$t (Memc[str], j, rval2) == 0)
+		    ;
+	    }
+
+	    # Check limits and find indices into rval array
+	    a1 = min (rval1, rval2)
+	    b1 = max (rval1, rval2)
+	    a2 = min (rvals[1], rvals[npts])
+	    b2 = max (rvals[1], rvals[npts])
+	    if ((b1 >= a2) && (a1 <= b2)) {
+		a1 = max (a2, min (b2, a1))
+		b1 = max (a2, min (b2, b1))
+		if (rvals[1] <= rvals[npts]) {
+		    for (k = 1; (k <= npts) && (rvals[k] < a1); k = k + 1)
+			;
+		    for (j = k; (j <= npts) && (rvals[j] <= b1); j = j + 1)
+			;
+		    j = j - 1
+		} else {
+		    for (k = 1; (k <= npts) && (rvals[k] > b1); k = k + 1)
+			;
+		    for (j = k; (j <= npts) && (rvals[j] >= a1); j = j + 1)
+			;
+		    j = j - 1
+		}
+
+		# Add range
+		if (k <= j) {
+		    nrgs = RG_NRGS(rg)
+		    if (mod (nrgs, NRGS) == 0)
+			call realloc (rg, LEN_RG+2*(nrgs+NRGS), TY_STRUCT)
+		    nrgs = nrgs + 1
+		    RG_NRGS(rg) = nrgs
+		    RG_X1(rg, nrgs) = k
+		    RG_X2(rg, nrgs) = j
+		    RG_NPTS(rg) = RG_NPTS(rg) +
+			RG_X1(rg, nrgs) - RG_X2(rg, nrgs) + 1
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/ranges/rgxranges1.gx b/pkg/xtools/ranges/rgxranges1.gx
new file mode 100644
index 00000000..b019e47c
--- /dev/null
+++ b/pkg/xtools/ranges/rgxranges1.gx
@@ -0,0 +1,146 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<pkg/rg.h>
+
+# RG_XRANGES -- Parse a range string corrsponding to a real set of values.
+# Return a pointer to the ranges.
+
+pointer procedure rg_xranges$t (rstr, rvals, npts)
+
+char	rstr[ARB]		# Range string
+PIXEL	rvals[npts]		# Range values (sorted)
+int	npts			# Number of range values
+
+pointer	rg
+int	i, j, k, nrgs
+PIXEL	rval1, rval2, a, b
+
+int	cto$t()
+
+begin
+	# Check for valid arguments.
+
+	if (npts < 1)
+	    call error (0, "No data points for range determination")
+
+	# Check for a valid string and determine the number of ranges.
+
+	i = 1
+	nrgs = 0
+
+	while (rstr[i] != EOS) {
+
+	    # Skip delimiters
+	    while (IS_WHITE(rstr[i]) || (rstr[i] == ',') || (rstr[i]=='\n'))
+	        i = i + 1
+
+	    # Check for EOS.
+
+	    if (rstr[i] == EOS)
+		break
+
+	    # First character must be a *, -, ., or digit.
+
+	    if ((rstr[i] == '*') || (rstr[i] == '-') || (rstr[i] == '.') ||
+		    IS_DIGIT(rstr[i])) {
+		i = i + 1
+	        nrgs = nrgs + 1
+
+ 		# Remaining characters must be :, -, ., E, D, e, d, or digits.
+		# Replace : with ! to avoid sexigesimal interpretation.
+
+	        while ((rstr[i]==':') || (rstr[i]=='-') || (rstr[i]=='.') ||
+ 		       (rstr[i]=='E') || (rstr[i]=='D') ||
+ 		       (rstr[i]=='e') || (rstr[i]=='d') ||
+			IS_DIGIT(rstr[i])) {
+		    if (rstr[i] == ':')
+			rstr[i] = '!'
+		    i = i + 1
+		}
+	    } else
+		call error (0, "Syntax error in range string")
+	}
+
+	# Allocate memory for the ranges.
+
+	call malloc (rg, LEN_RG + 2 * max (1, nrgs), TY_STRUCT)
+
+	# Rescan the string and set the ranges.
+
+	i = 1
+	nrgs = 0
+
+	while (rstr[i] != EOS) {
+
+	    # Skip delimiters.
+	    while (IS_WHITE(rstr[i]) || (rstr[i]==',') || (rstr[i]=='\n'))
+	        i = i + 1
+
+	    # Check for EOS.
+
+	    if (rstr[i] == EOS)
+		break
+
+	    # If first character is * then set range to full range.
+	    # Otherwise parse the range.
+
+	    if (rstr[i] == '*') {
+		i = i + 1
+		rval1 = rvals[1]
+		rval2 = rvals[npts]
+
+	    } else {
+		# First digit is starting value.
+		if (cto$t (rstr, i, rval1) == 0) {
+		    nrgs = 0
+		    break
+		}
+		rval2 = rval1
+
+		# Check for an ending value for the range and restore ':'.
+		if (rstr[i] == '!') {
+		    rstr[i] = ':'
+		    i = i + 1
+		    if (cto$t (rstr, i, rval2) == 0) {
+			nrgs = 0
+			break
+		    }
+		}
+	    }
+
+	    # Check limits.
+
+	    a = min (rval1, rval2)
+	    b = max (rval1, rval2)
+	    if ((b >= rvals[1]) && (a <= rvals[npts])) {
+		rval1 = max (rvals[1], min (rvals[npts], rval1))
+		rval2 = max (rvals[1], min (rvals[npts], rval2))
+	    	a = min (rval1, rval2)
+	    	b = max (rval1, rval2)
+		for (k = 1; (k <= npts) && (rvals[k] < a); k = k + 1)
+		    ;
+		for (j = k; (j <= npts) && (rvals[j] <= b); j = j + 1)
+		    ;
+		j = j - 1
+		if (k <= j) {
+		    nrgs = nrgs + 1
+		    if (rval1 <= rval2) {
+		    	RG_X1(rg, nrgs) = k
+		    	RG_X2(rg, nrgs) = j
+		    } else {
+		    	RG_X1(rg, nrgs) = j
+		    	RG_X2(rg, nrgs) = k
+		    }
+		}
+	    }
+	}
+
+	RG_NRGS(rg) = nrgs
+	RG_NPTS(rg) = 0
+	do i = 1, RG_NRGS(rg)
+	    RG_NPTS(rg) = RG_NPTS(rg) +
+		abs (RG_X1(rg, i) - RG_X2(rg, i)) + 1
+
+	return (rg)
+end
diff --git a/pkg/xtools/ranges/rgxrangesd.x b/pkg/xtools/ranges/rgxrangesd.x
new file mode 100644
index 00000000..f9de6c32
--- /dev/null
+++ b/pkg/xtools/ranges/rgxrangesd.x
@@ -0,0 +1,162 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<ctype.h>
+include	<pkg/rg.h>
+
+define	NRGS	10		# Allocation size
+
+# RG_XRANGES -- Parse a range string corrsponding to a real set of values.
+# Return a pointer to the ranges.
+
+pointer procedure rg_xrangesd (rstr, rvals, npts)
+
+char	rstr[ARB]		# Range string
+double	rvals[npts]		# Range values (sorted)
+int	npts			# Number of range values
+pointer	rg			# Range pointer
+
+int	i, fd, strlen(), open(), getline()
+pointer	sp, str, ptr
+errchk	open, rg_xaddd
+
+begin
+	# Check for valid arguments
+	if (npts < 1)
+	    call error (0, "No data points for range determination")
+
+	call smark (sp)
+	call salloc (str, max (strlen (rstr), SZ_LINE), TY_CHAR)
+	call calloc (rg, LEN_RG, TY_STRUCT)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Add range(s)
+	    iferr {
+		if (Memc[str] == '@') {
+		    fd = open (Memc[str+1], READ_ONLY, TEXT_FILE)
+		    while (getline (fd, Memc[str]) != EOF) {
+			iferr (call rg_xaddd (rg, Memc[str], rvals, npts))
+			    call erract (EA_WARN)
+		    }
+		    call close (fd)
+		} else
+		    call rg_xaddd (rg, Memc[str], rvals, npts)
+	    } then
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+	return (rg)
+end
+
+
+# RG_XADD -- Add a range
+
+procedure rg_xaddd (rg, rstr, rvals, npts)
+
+pointer	rg			# Range descriptor
+char	rstr[ARB]		# Range string
+double	rvals[npts]		# Range values (sorted)
+int	npts			# Number of range values
+
+int	i, j, k, nrgs, strlen(), ctod()
+double	rval1, rval2, a1, b1, a2, b2
+pointer	sp, str, ptr
+
+begin
+	call smark (sp)
+	call salloc (str, strlen (rstr), TY_CHAR)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		if (rstr[i] == ':')
+		    Memc[ptr] = ' '
+		else
+		    Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Parse range
+	    if (Memc[str] == '@')
+		call error (1, "Cannot nest @files")
+	    else if (Memc[str] == '*') {
+		rval1 = rvals[1]
+		rval2 = rvals[npts]
+	    } else {
+		# Get range
+		j = 1
+		if (ctod (Memc[str], j, rval1) == 0)
+		    call error (1, "Range syntax error")
+		rval2 = rval1
+		if (ctod (Memc[str], j, rval2) == 0)
+		    ;
+	    }
+
+	    # Check limits and find indices into rval array
+	    a1 = min (rval1, rval2)
+	    b1 = max (rval1, rval2)
+	    a2 = min (rvals[1], rvals[npts])
+	    b2 = max (rvals[1], rvals[npts])
+	    if ((b1 >= a2) && (a1 <= b2)) {
+		a1 = max (a2, min (b2, a1))
+		b1 = max (a2, min (b2, b1))
+		if (rvals[1] <= rvals[npts]) {
+		    for (k = 1; (k <= npts) && (rvals[k] < a1); k = k + 1)
+			;
+		    for (j = k; (j <= npts) && (rvals[j] <= b1); j = j + 1)
+			;
+		    j = j - 1
+		} else {
+		    for (k = 1; (k <= npts) && (rvals[k] > b1); k = k + 1)
+			;
+		    for (j = k; (j <= npts) && (rvals[j] >= a1); j = j + 1)
+			;
+		    j = j - 1
+		}
+
+		# Add range
+		if (k <= j) {
+		    nrgs = RG_NRGS(rg)
+		    if (mod (nrgs, NRGS) == 0)
+			call realloc (rg, LEN_RG+2*(nrgs+NRGS), TY_STRUCT)
+		    nrgs = nrgs + 1
+		    RG_NRGS(rg) = nrgs
+		    RG_X1(rg, nrgs) = k
+		    RG_X2(rg, nrgs) = j
+		    RG_NPTS(rg) = RG_NPTS(rg) +
+			RG_X1(rg, nrgs) - RG_X2(rg, nrgs) + 1
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/ranges/rgxrangesr.x b/pkg/xtools/ranges/rgxrangesr.x
new file mode 100644
index 00000000..425abf04
--- /dev/null
+++ b/pkg/xtools/ranges/rgxrangesr.x
@@ -0,0 +1,162 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<ctype.h>
+include	<pkg/rg.h>
+
+define	NRGS	10		# Allocation size
+
+# RG_XRANGES -- Parse a range string corrsponding to a real set of values.
+# Return a pointer to the ranges.
+
+pointer procedure rg_xrangesr (rstr, rvals, npts)
+
+char	rstr[ARB]		# Range string
+real	rvals[npts]		# Range values (sorted)
+int	npts			# Number of range values
+pointer	rg			# Range pointer
+
+int	i, fd, strlen(), open(), getline()
+pointer	sp, str, ptr
+errchk	open, rg_xaddr
+
+begin
+	# Check for valid arguments
+	if (npts < 1)
+	    call error (0, "No data points for range determination")
+
+	call smark (sp)
+	call salloc (str, max (strlen (rstr), SZ_LINE), TY_CHAR)
+	call calloc (rg, LEN_RG, TY_STRUCT)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Add range(s)
+	    iferr {
+		if (Memc[str] == '@') {
+		    fd = open (Memc[str+1], READ_ONLY, TEXT_FILE)
+		    while (getline (fd, Memc[str]) != EOF) {
+			iferr (call rg_xaddr (rg, Memc[str], rvals, npts))
+			    call erract (EA_WARN)
+		    }
+		    call close (fd)
+		} else
+		    call rg_xaddr (rg, Memc[str], rvals, npts)
+	    } then
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+	return (rg)
+end
+
+
+# RG_XADD -- Add a range
+
+procedure rg_xaddr (rg, rstr, rvals, npts)
+
+pointer	rg			# Range descriptor
+char	rstr[ARB]		# Range string
+real	rvals[npts]		# Range values (sorted)
+int	npts			# Number of range values
+
+int	i, j, k, nrgs, strlen(), ctor()
+real	rval1, rval2, a1, b1, a2, b2
+pointer	sp, str, ptr
+
+begin
+	call smark (sp)
+	call salloc (str, strlen (rstr), TY_CHAR)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		if (rstr[i] == ':')
+		    Memc[ptr] = ' '
+		else
+		    Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Parse range
+	    if (Memc[str] == '@')
+		call error (1, "Cannot nest @files")
+	    else if (Memc[str] == '*') {
+		rval1 = rvals[1]
+		rval2 = rvals[npts]
+	    } else {
+		# Get range
+		j = 1
+		if (ctor (Memc[str], j, rval1) == 0)
+		    call error (1, "Range syntax error")
+		rval2 = rval1
+		if (ctor (Memc[str], j, rval2) == 0)
+		    ;
+	    }
+
+	    # Check limits and find indices into rval array
+	    a1 = min (rval1, rval2)
+	    b1 = max (rval1, rval2)
+	    a2 = min (rvals[1], rvals[npts])
+	    b2 = max (rvals[1], rvals[npts])
+	    if ((b1 >= a2) && (a1 <= b2)) {
+		a1 = max (a2, min (b2, a1))
+		b1 = max (a2, min (b2, b1))
+		if (rvals[1] <= rvals[npts]) {
+		    for (k = 1; (k <= npts) && (rvals[k] < a1); k = k + 1)
+			;
+		    for (j = k; (j <= npts) && (rvals[j] <= b1); j = j + 1)
+			;
+		    j = j - 1
+		} else {
+		    for (k = 1; (k <= npts) && (rvals[k] > b1); k = k + 1)
+			;
+		    for (j = k; (j <= npts) && (rvals[j] >= a1); j = j + 1)
+			;
+		    j = j - 1
+		}
+
+		# Add range
+		if (k <= j) {
+		    nrgs = RG_NRGS(rg)
+		    if (mod (nrgs, NRGS) == 0)
+			call realloc (rg, LEN_RG+2*(nrgs+NRGS), TY_STRUCT)
+		    nrgs = nrgs + 1
+		    RG_NRGS(rg) = nrgs
+		    RG_X1(rg, nrgs) = k
+		    RG_X2(rg, nrgs) = j
+		    RG_NPTS(rg) = RG_NPTS(rg) +
+			RG_X1(rg, nrgs) - RG_X2(rg, nrgs) + 1
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/rmmed.x b/pkg/xtools/rmmed.x
new file mode 100644
index 00000000..940fda9f
--- /dev/null
+++ b/pkg/xtools/rmmed.x
@@ -0,0 +1,446 @@
+include	<mach.h>
+include	<pkg/rmsorted.h>
+
+# RM_MED -- Running median/maximum/minimum library.
+#
+# This is a layer over the sorted running routines.
+# This layer provides:
+#
+#    1. Support for multiple datasets (e.g. pixels in running image)
+#    2. Support for an interior average
+#    3. Support for masks
+#    4. Support for excluded index (e.g. image)
+
+
+# Method object structure.
+define	RM_LEN		26		# Structure size
+define	RM_RMS		Memi[$1]	# Pointer to RMEDSRT method
+define	RM_BOX		Memi[$1+1]	# Box size
+define	RM_TYPE		Memi[$1+2]	# Type of output
+define	RM_NDATA	Memi[$1+3]	# Number of datasets
+define	RM_PIXTYPE	Memi[$1+4]	# Internal storage type
+define	RM_GOOD		Memi[$1+5]	# Ptr to good array (box)
+define	RM_MASK		Memi[$1+6]	# Ptr to mask array
+define	RM_PWIN		Memi[$1+7]	# Ptr to packed window data (n*box)
+define	RM_POUT		Memi[$1+8]	# Ptr to packed outlist data (n*box)
+define	RM_PMASK	Memi[$1+9]	# Ptr to mask data (n*(box+15)/16)
+define	RM_SETMASK	P2S($1+10)	# Ptr to set mask array (16)
+define	RM_UNSETMASK	P2S($1+18)	# Ptr to unset mask array (16)
+
+define	GOOD		Memr[RM_GOOD($1)+$2]
+define	MASK		Mems[RM_MASK($1)+$2/16]
+define	SETMASK		Mems[RM_SETMASK($1)+mod($2,16)]
+define	UNSETMASK	Mems[RM_UNSETMASK($1)+mod($2,16)]
+
+define	PWINR		Memr[RM_PWIN($1)+RM_BOX($1)*($2-1)]
+define	PWINS		Mems[RM_PWIN($1)+RM_BOX($1)*($2-1)]
+define	POUT		Mems[RM_POUT($1)+(RM_BOX($1)+1)/2*($2-1)]
+
+define	RM_TYPES	"|median|maximum|minimum|"
+define	RM_TYMED	1		# Medain
+define	RM_TYMAX	2		# Maximum
+define	RM_TYMIN	3		# Maximum
+
+
+# RM_MED -- Compute next running value.
+
+real procedure rm_med (rm, nclip, navg, blank, exclude, index, in, mask, nused)
+
+pointer	rm			#I RM pointer
+real	nclip			#I Clipping factor
+int	navg			#I Number of central values to average
+real	blank			#I Blank value
+int	exclude			#I Index of excluded data (one indexed)
+int	index			#I Index of new data (one indexed)
+real	in			#I Input data value
+short	mask			#I Input mask value	
+short	nused			#O Number of values in calculated result
+real	val			#R Return value
+
+int	i, j, iexclude
+short	s1, s2, ors(), ands()
+pointer	rms
+real	clip, rmsorted()
+
+begin
+	# Call sorted running routine.
+	rms = RM_RMS(rm)
+	val = rmsorted (rms, nclip, index, in)
+
+	# Set mask if needed.
+	s2 = mod (index-1, RM_BOX(rm))
+	s1 = MASK(rm,s2)
+	if (mask != 0 || s1 != 0) {
+	    if (mask != 0)
+		MASK(rm,s2) = ors (s1, SETMASK(rm,s2))
+	    else
+		MASK(rm,s2) = ands (s1, UNSETMASK(rm,s2))
+	    s1 = MASK(rm,s2)
+	}
+
+	# Recompute value if there are masks or an excluded value.
+	iexclude = mod (exclude-1, RM_BOX(rm))
+	if (s1 == 0 && iexclude < 0) {
+	    do s2 = 0, RM_BOX(rm)-1, 16 {
+		s1 = MASK(rm,s2)
+		if (s1 != 0)
+		    break
+	    }
+	}
+	if (s1 != 0 || iexclude >= 0) {
+	    nused = 0
+	    do i = 0, RM_BOX(rm)-1 {
+	        s2 = IN(rms,i)
+		if (s2 != iexclude) {
+		    s1 = MASK(rm,s2)
+		    if (s1 == 0) {
+			GOOD(rm,nused) = DATA(rms,i)
+			nused = nused + 1
+		    } else if (ands (s1, SETMASK(rm,s2)) == 0) {
+			GOOD(rm,nused) = DATA(rms,i)
+			nused = nused + 1
+		    }
+		}
+	    }
+
+	    if (nused > 2 && nclip > 0.) {
+	        i = nused / 2
+		if (mod (nused, 2) == 0)
+		    val = (GOOD(rm,i) + GOOD(rm,i-1)) / 2
+		else
+		    val = GOOD(rm,i)
+		clip = val + nclip * (val - GOOD(rm,0))
+		do i = nused, 1, -1 {
+		    if (GOOD(rm,i-1) < clip)
+		        break
+		}
+		nused = i
+	    }
+
+	    switch (RM_TYPE(rm)) {
+	    case RM_TYMED:
+		switch (nused) {
+		case 0:
+		    val = blank
+		case 1:
+		    val = GOOD(rm,0)
+		case 2:
+		    val = (GOOD(rm,0) + GOOD(rm,1)) / 2.
+		default:
+		    for (i = 0; nused-2*i>max(2,navg); i=i+1)
+			;
+		    val = GOOD(rm,i)
+		    do j = i+1, nused-i-1 {
+			val = val + GOOD(rm,j)
+		    }
+		    nused = nused - 2 * i
+		    val = val / nused
+		}
+	    case RM_TYMAX:
+		switch (nused) {
+		case 0:
+		    val = blank
+		default:
+		    val = GOOD(rm,nused-1)
+		}
+	    case RM_TYMIN:
+		switch (nused) {
+		case 0:
+		    val = blank
+		default:
+		    val = GOOD(rm,0)
+		}
+	    }
+	} else
+	    nused = min (navg, RM_BOX(rm))
+
+	return (val)
+end
+
+
+# RM_GMED -- Running sorted value.
+
+real procedure rm_gmed (rm, nclip, navg, blank, exclude, nused)
+
+pointer	rm			#I RM pointer
+real	nclip			#I Clipping factor
+int	navg			#I Number of central values to average
+real	blank			#I Blank value
+int	exclude			#I Index of excluded data (one indexed)
+short	nused			#O Number of values in calculated result
+real	val			#R Return value
+
+int	i, j, iexclude
+short	mask, ands()
+real	clip
+pointer	rms
+
+begin
+	rms = RM_RMS(rm)
+	iexclude = mod (exclude-1, RM_BOX(rm))
+
+	# Extract good values to use.
+	nused = 0
+	do i = 0, RM_BOX(rm)-1 {
+	    j = IN(rms,i)
+	    mask = MASK(rm,j)
+	    if (j != iexclude) {
+		if (mask == 0) {
+		    GOOD(rm,nused) = DATA(rms,i)
+		    nused = nused + 1
+		} else if (ands (mask, SETMASK(rm,j)) == 0) {
+		    GOOD(rm,nused) = DATA(rms,i)
+		    nused = nused + 1
+		}
+	    }
+	}
+
+	if (nused > 2 && nclip > 0.) {
+	    i = nused / 2
+	    if (mod (nused, 2) == 0)
+		val = (GOOD(rm,i) + GOOD(rm,i-1)) / 2
+	    else
+		val = GOOD(rm,i)
+	    clip = val + nclip * (val - GOOD(rm,0))
+	    do i = nused, 1, -1 {
+		if (GOOD(rm,i-1) < clip)
+		    break
+	    }
+	    nused = i
+	}
+
+	switch (RM_TYPE(rm)) {
+	case RM_TYMED:
+	    switch (nused) {
+	    case 0:
+		val = blank
+	    case 1:
+		val = GOOD(rm,0)
+	    case 2:
+		val = (GOOD(rm,0) + GOOD(rm,1)) / 2.
+	    default:
+		for (i = 0; nused-2*i>max(2,navg); i=i+1)
+		    ;
+		val = GOOD(rm,i)
+		do j = i+1, nused-i-1 {
+		    val = val + GOOD(rm,j)
+		}
+		nused = nused - 2 * i
+		val = val / nused
+	    }
+	case RM_TYMAX:
+	    switch (nused) {
+	    case 0:
+		val = blank
+	    default:
+		val = GOOD(rm,nused-1)
+	    }
+	case RM_TYMIN:
+	    switch (nused) {
+	    case 0:
+		val = blank
+	    default:
+		val = GOOD(rm,0)
+	    }
+	}
+
+	return (val)
+end
+
+
+# RM_GDATA -- Get data value for specified index
+
+real procedure rm_gdata (rm, index)
+
+pointer	rm			#I RM pointer
+int	index			#I Index of new data (one indexed)
+
+int	i, j
+pointer	rms
+
+begin
+	rms = RM_RMS(rm)
+	i = mod (index-1, RM_BOX(rm))
+	do j = 0, RM_BOX(rm)-1 {
+	    if (IN(rms,j) == i)
+	        return (DATA(rms,j))
+	}
+end
+
+
+
+# RM_OPEN -- Open running sorted package.
+#
+# This is called once to allocate memory and initialize the algorithms.
+
+pointer procedure rm_open (box, type, ndatasets, pixtype)
+
+int	box			#I Median box size (<= 128)
+char	type[ARB]		#I Output type
+int	ndatasets		#I Number of datasets
+int	pixtype			#I Internal storage type
+pointer	rm			#O RM pointer
+
+char	str[8]
+int	i, j, strdic()
+short	s, nots(), shifts()
+real	val
+pointer	rms, rms_open()
+
+begin
+	# Set internal storage type.
+	if (pixtype == TY_SHORT)
+	    i = TY_SHORT
+	else
+	    i = TY_REAL
+
+	# Set the output type.
+	j = strdic (type, str, 8, RM_TYPES)
+	switch (j) {
+	case RM_TYMED:
+	    val = 0.
+	    rms = rms_open (box, RMS_TYMED, val)
+	case RM_TYMAX:
+	    switch (i) {
+	    case TY_SHORT:
+		val = -MAX_SHORT
+		rms = rms_open (box, RMS_TYMAX, val)
+	    case TY_REAL:
+		val = -MAX_REAL
+		rms = rms_open (box, RMS_TYMAX, val)
+	    }
+	case RM_TYMIN:
+	    switch (i) {
+	    case TY_SHORT:
+		val = MAX_SHORT
+		rms = rms_open (box, RMS_TYMIN, val)
+	    case TY_REAL:
+		val = MAX_REAL
+		rms = rms_open (box, RMS_TYMIN, val)
+	    }
+	default:
+	    call error (1, "Unknown running type")
+	}
+
+	call calloc (rm, RM_LEN, TY_STRUCT)
+	call calloc (RM_GOOD(rm), box, TY_REAL)
+	call calloc (RM_PWIN(rm), box*ndatasets, i)
+	call calloc (RM_POUT(rm), ndatasets*(box+1)/2, TY_SHORT)
+	call calloc (RM_PMASK(rm), ndatasets*(box+15)/16, TY_SHORT)
+	
+	RM_RMS(rm) = rms
+	RM_BOX(rm) = box
+	RM_TYPE(rm) = j
+	RM_NDATA(rm) = ndatasets
+	RM_PIXTYPE(rm) = i
+	RM_MASK(rm) = RM_PMASK(rm)
+
+	# Set mask flags.
+	s = 1
+	do i = 0, 15 {
+	    SETMASK(rm,i) = s
+	    UNSETMASK(rm,i) = nots (s)
+	    s = shifts (s, short(1))
+	}
+
+	do i = 1, ndatasets
+	    call rm_pack (rm, i)
+
+	return (rm)
+end
+
+
+# RM_CLOSE -- Close running sorted package.
+
+procedure rm_close (rm)
+
+pointer	rm			#I RM pointer
+
+begin
+	call rms_close (RM_RMS(rm))
+
+	call mfree (RM_GOOD(rm), TY_REAL)
+	call mfree (RM_PWIN(rm), RM_PIXTYPE(rm))
+	call mfree (RM_POUT(rm), TY_SHORT)
+	call mfree (RM_PMASK(rm), TY_SHORT)
+	call mfree (rm, TY_STRUCT)
+end
+
+
+# RM_PACK -- Pack data.
+
+procedure rm_pack (rm, dataset)
+
+pointer	rm			#I RM pointer
+int	dataset			#I Data set
+
+pointer	rms
+
+begin
+	rms = RM_RMS(rm)
+	if (RM_PIXTYPE(rm) == TY_SHORT)
+	    call anirs (DATA(rms,0), PWINS(rm,dataset), RM_BOX(rm))
+#	else
+#	    call amovr (DATA(rms,0), PWINR(rm,dataset), RM_BOX(rm))
+	call achtsb (OUT(rms,0), POUT(rm,dataset), RM_BOX(rm))
+end
+
+
+# RM_UNPACK -- Unpack data.
+
+procedure rm_unpack (rm, dataset)
+
+pointer	rm			#I RM pointer
+int	dataset			#I Data set
+
+int	i, j, box
+pointer	rms
+
+begin
+	rms = RM_RMS(rm)
+	box = RM_BOX(rm)
+
+	if (RM_PIXTYPE(rm) == TY_SHORT)
+	    call achtsr (PWINS(rm,dataset), DATA(rms,0), box)
+	else
+	    RMS_DATA(rms) = RM_PWIN(rm) + box * (dataset - 1)
+#	    call amovr (PWINR(rm,dataset), DATA(rms,0), box)
+	call achtbs (POUT(rm,dataset), OUT(rms,0), box)
+	RM_MASK(rm) = RM_PMASK(rm) + (box + 15) / 16 * (dataset - 1)
+
+	do i = 0, box-1 {
+	    j = OUT(rms,i)
+	    IN(rms,j) = i
+	}
+end
+
+
+# ANIRS -- Convert real to short using nearest integer.
+
+procedure anirs (a, b, n)
+
+real	a[n]			#I Input real array
+short	b[n]			#O Output short array
+int	n			#I Number of array values
+
+int	i
+
+begin
+	do i = 1, n
+	    b[i] = a[i] + 0.5
+end
+
+
+# RM_DUMP -- Dump data.
+
+procedure rm_dump (rm, unsorted, sorted, in, out)
+
+pointer	rm			#I Method pointer
+bool	unsorted		#I Dump data in unsorted order?
+bool	sorted			#I Dump data in sorted order?
+bool	in			#I Dump in list?
+bool	out			#I Dump out list?
+
+begin
+	call rms_dump (RM_RMS(rm), unsorted, sorted, in, out)
+end
diff --git a/pkg/xtools/rmsorted.x b/pkg/xtools/rmsorted.x
new file mode 100644
index 00000000..54d0c2fb
--- /dev/null
+++ b/pkg/xtools/rmsorted.x
@@ -0,0 +1,183 @@
+include	<pkg/rmsorted.h>
+
+
+# RMSORTED -- Compute running sorted value.
+
+real procedure rmsorted (rm, nclip, index, data)
+
+pointer	rm			#I Method pointer
+real	nclip			#I Clipping factor
+int	index			#I Index of new data
+real	data			#I Input data  value
+real	val			#R Return value
+
+int	i, i1, box, outnext, out, nused
+real	clip
+
+begin
+	# Extract from structure.
+	box = RMS_BOX(rm)
+	outnext = mod (index-1, box)
+	out = OUT(rm,outnext)
+
+	# Find value to replace.
+	if (out == 0) {
+	    do i = out, box-2 {
+	        i1 = i + 1
+	        if (data <= DATA(rm,i1))
+		    break
+		DATA(rm,i) = DATA(rm,i1)
+		IN(rm,i) = IN(rm,i1)
+		OUT(rm,IN(rm,i)) = i
+	    }
+	} else if (out == box-1) {
+	    do i = out, 1, -1 {
+	        i1 = i - 1
+	        if (data >= DATA(rm,i1))
+		    break
+		DATA(rm,i) = DATA(rm,i1)
+		IN(rm,i) = IN(rm,i1)
+		OUT(rm,IN(rm,i)) = i
+	    }
+	} else if (data > DATA(rm,out+1)) {
+	    do i = out, box-2 {
+	        i1 = i + 1
+	        if (data <= DATA(rm,i1))
+		    break
+		DATA(rm,i) = DATA(rm,i1)
+		IN(rm,i) = IN(rm,i1)
+		OUT(rm,IN(rm,i)) = i
+	    }
+	} else {
+	    do i = out, 1, -1 {
+	        i1 = i - 1
+	        if (data >= DATA(rm,i1))
+		    break
+		DATA(rm,i) = DATA(rm,i1)
+		IN(rm,i) = IN(rm,i1)
+		OUT(rm,IN(rm,i)) = i
+	    }
+	}
+
+	# Set new value.
+	DATA(rm,i) = data
+	IN(rm,i) = outnext
+	OUT(rm,outnext) = i
+
+	# Apply clipping if needed.
+	nused = box
+	if (nused > 2 && nclip > 0.) {
+	    i = nused / 2
+	    if (mod (nused, 2) == 0)
+		val = (DATA(rm,i) + DATA(rm,i-1)) / 2
+	    else
+		val = DATA(rm,i)
+	    clip = val + nclip * (val - DATA(rm,0))
+	    do i = nused, 1, -1 {
+		if (DATA(rm,i-1) < clip)
+		    break
+	    }
+	    nused = i
+	}
+
+	# Compute output value.
+	switch (RMS_TYPE(rm)) {
+	case RMS_TYMED:
+	    i = nused / 2
+	    if (mod (nused, 2) == 0)
+		val = (DATA(rm,i) + DATA(rm,i-1)) / 2
+	    else
+		val = DATA(rm,i)
+	case RMS_TYMAX:
+	    val = DATA(rm,nused-1)
+	case RMS_TYMIN:
+	    val = DATA(rm,0)
+	}
+
+	return (val)
+end
+
+
+# RMS_OPEN -- Open running sorted algorithm.
+
+pointer procedure rms_open (box, type, data)
+
+int	box			#I Running box
+int	type			#I Output type
+real	data			#I Initial data value
+pointer	rm			#R Method pointer
+
+int	i
+
+begin
+	call malloc (rm, RMS_LEN(box), TY_STRUCT)
+	RMS_BOX(rm) = box
+	RMS_TYPE(rm) = type
+	RMS_DATA(rm) = rm + RMS_OFFSET
+	RMS_IN(rm) = P2S(RMS_DATA(rm) + box)
+	RMS_OUT(rm) = RMS_IN(rm) + box
+	RMS_DATA(rm) = P2R(RMS_DATA(rm))
+
+	do i = 0, box-1 {
+	    DATA(rm,i) = data
+	    IN(rm,i) = i
+	    OUT(rm,i) = i
+	}
+
+	return (rm)
+end
+
+
+# RMS_CLOSE -- Close running sorted algorithm.
+
+procedure rms_close (rm)
+
+pointer	rm			#I Method pointer
+
+begin
+	call mfree (rm, TY_STRUCT)
+end
+
+
+# RMS_DUMP -- Dump data structure.
+
+procedure rms_dump (rm, unsorted, sorted, in, out)
+
+pointer	rm			#I RM pointer
+bool	unsorted		#I Dump data in input order?
+bool	sorted			#I Dump data in sorted order?
+bool	in			#I Dump in list?
+bool	out			#I Dump out list?
+
+int	i
+
+begin
+	if (unsorted) {
+	    do i = 0, RMS_BOX(rm)-1 {
+		call printf (" %7.3f")
+		    call pargr (DATA(rm,OUT(rm,i)))
+	    }
+	    call printf ("\n")
+	}
+	if (sorted) {
+	    do i = 0, RMS_BOX(rm)-1 {
+		call printf (" %7.3f")
+		    call pargr (DATA(rm,i))
+	    }
+	    call printf ("\n")
+	}
+	if (in) {
+	    do i = 0, RMS_BOX(rm)-1 {
+		call printf (" %3d")
+		    call pargs (IN(rm,i))
+	    }
+	    call printf ("\n")
+	}
+	if (out) {
+	    do i = 0, RMS_BOX(rm)-1 {
+		call printf (" %3d")
+		    call pargs (OUT(rm,i))
+	    }
+	    call printf ("\n")
+	}
+end
diff --git a/pkg/xtools/rmturlach.x b/pkg/xtools/rmturlach.x
new file mode 100644
index 00000000..bb23511e
--- /dev/null
+++ b/pkg/xtools/rmturlach.x
@@ -0,0 +1,417 @@
+# Turlach -- Running median library.
+#
+# The algorithm is that described by Haerdle und Steiger (1995) and the
+# implementation is after Turlach.  The starting point was the GNU General
+# Pubic Licensed code from the R Foundation (see copyright heritage below).
+# Besides the language recoding the structure has been significantly changed.
+#
+# Copyright (C) 1995   Berwin A. Turlach <berwin@alphasun.anu.edu.au>
+# Copyright (C) 2000-2 Martin Maechler <maechler@stat.math.ethz.ch>
+# Copyright (C) 2003   The R Foundation
+
+include	<mach.h>
+
+define	RMT_OFFSET	4			# Offset to data
+define	RMT_LEN		(RMT_OFFSET+5*$1+3)	# Structure length
+define	RMT_BOX		Memi[$1]		# Running box size
+define	RMT_DATA	Memi[$1+1]		# Sorted data (ptr)
+define	RMT_IN		Memi[$1+2]		# Mapping to input (ptr)
+define	RMT_OUT		Memi[$1+3]		# Mapping to output (ptr)
+
+define	DATA		Memr[RMT_DATA($1)+$2]
+define	IN		Mems[RMT_IN($1)+$2]
+define	OUT		Mems[RMT_OUT($1)+$2]
+
+
+# RMTURLACH -- Compute running median value using the Turlach algorithm.
+
+real procedure rmturlach (rm, index, data)
+
+pointer	rm			#I Method pointer
+int	index			#I Index of new data
+real	data			#I Input data value
+
+short	nrnew, box, outnext, out, leaf, one
+data	one/1/
+
+begin
+	nrnew = index - 1
+	box = RMT_BOX(rm)
+	outnext = mod (nrnew, box)
+	out = OUT(rm,outnext)
+	DATA(rm,out) = data
+
+	leaf = out - box
+	if (out > box) {
+	    if (data >= DATA(rm,box))
+		call rm_uoui (leaf, box, DATA(rm,1), OUT(rm,1), IN(rm,1))
+	    else
+		call rm_uodi (leaf, box, nrnew, outnext, data,
+		    DATA(rm,1), OUT(rm,1), IN(rm,1))
+	} else if (out < box) {
+	    if (data < DATA(rm,box))
+		call rm_dodi (leaf, box, DATA(rm,1), OUT(rm,1), IN(rm,1))
+	    else
+		call rm_doui (leaf, box, nrnew, outnext, data,
+		    DATA(rm,1), OUT(rm,1), IN(rm,1))
+	} else if (DATA(rm,box) > DATA(rm,box+1)) {
+	    call rm_swap (box, box+one, DATA(rm,1), OUT(rm,1), IN(rm,1));
+	    call rm_uptoleaf (one, box, DATA(rm,1), OUT(rm,1), IN(rm,1));
+	} else if (DATA(rm,box) < DATA(rm,box-1)) {
+	    call rm_swap (box, box-one, DATA(rm,1), OUT(rm,1), IN(rm,1));
+	    call rm_downtoleaf (-one, box, DATA(rm,1), OUT(rm,1), IN(rm,1));
+	}
+
+	return (DATA(rm,box))
+end
+
+
+# RMT_OPEN -- Open Turlach running median algorithm.
+
+pointer procedure rmt_open (box, data)
+
+int	box			#I Running median box
+real	data			#I Initial data value
+pointer	rm			#R Method pointer
+
+short	i, halfbox
+#short	i, j, k, halfbox, one
+#data	one/1/
+
+begin
+	call malloc (rm, RMT_LEN(box), TY_STRUCT)
+
+	RMT_BOX(rm) = box
+	RMT_DATA(rm) = rm + RMT_OFFSET
+	RMT_IN(rm) = P2S(RMT_DATA(rm) + 2 * box + 1)
+	RMT_OUT(rm) = RMT_IN(rm) + 2 * box + 1
+
+	halfbox = (box - 1) / 2
+
+	do i = 1+halfbox, box+halfbox {
+	    DATA(rm,i) = data
+	    IN(rm,i) = i-halfbox-1
+	    OUT(rm,i-halfbox-1) = i
+	}
+
+	do i = 0, halfbox {
+	    DATA(rm,i) = -MAX_REAL
+	    DATA(rm,i+box+halfbox+1) = MAX_REAL
+	}
+
+	return (rm)
+end
+
+
+# RMT_CLOSE -- Close Turlach running median algorithm.
+
+procedure rmt_close (rm)
+
+pointer	rm			#I Method pointer
+
+begin
+	call mfree (rm, TY_STRUCT)
+end
+
+
+# RMT_DUMP -- Dump data structure.
+
+procedure rmt_dump (rm, unsorted, sorted, in, out)
+
+pointer	rm			#I Method pointer
+bool	unsorted		#I Dump data in unsorted order?
+bool	sorted			#I Dump data in sorted order?
+bool	in			#I Dump in list?
+bool	out			#I Dump out list?
+
+int	i, box, halfbox
+
+begin
+	box = RMT_BOX(rm)
+	halfbox = box / 2
+	if (unsorted) {
+	    do i = 1+halfbox, halfbox+box {
+		call eprintf (" %3.0f")
+		    call pargr (DATA(rm,OUT(rm,i-halfbox-1)))
+	    }
+	    call eprintf ("\n")
+	}
+	if (sorted) {
+	    #do i = 0, 2*box {
+	    do i = 1+halfbox, halfbox+box {
+		call eprintf (" %3.0f")
+		    call pargr (DATA(rm,i))
+	    }
+	    call eprintf ("\n")
+	}
+	if (in) {
+	    #do i = 0, 2*box {
+	    do i = 1+halfbox, halfbox+box {
+		call eprintf (" %3d")
+		    call pargs (IN(rm,i))
+	    }
+	    call eprintf ("\n")
+	}
+	if (out) {
+	    do i = 0, box-1 {
+		call eprintf (" %3d")
+		    call pargs (OUT(rm,i))
+	    }
+	    call eprintf ("\n")
+	}
+end
+
+
+# RM_SWAP -- Swap positions `l' and `r'.
+
+procedure rm_swap (l, r, window, outlist, nrlist)
+
+short	l			#I Index to swap
+short	r			#I Index to swap
+real	window[ARB]		#U Work array
+short	outlist[ARB]		#U Work array
+short	nrlist[ARB]		#U Work array
+
+short	nl, nr
+real	w
+
+begin
+	w = window[l]; window[l] = window[r]; window[r] = w
+	nl = nrlist[l]; nr = nrlist[r]; nrlist[l] = nr; nrlist[r] = nl
+	outlist[nl] = r; outlist[nr] = l
+end
+
+
+# RM_SIFTUP -- Used only in the initial sorting.
+
+procedure rm_siftup (l, r, window, outlist, nrlist)
+
+short	l			#I Left index
+short	r			#I Right index
+real	window[ARB]		#U Work array
+short	outlist[ARB]		#U Work array
+short	nrlist[ARB]		#U Work array
+
+short	i, j, nrold
+real	w
+
+begin
+	i = l
+	j = 2 * i
+	w = window[i]
+	nrold = nrlist[i]
+	while (j <= r) {
+	    if (j < r) {
+	        if (window[j] < window[j+1])
+		    j = j + 1
+	    }
+	    if (w >= window[j])
+	        break
+
+	    window[i] = window[j]
+	    outlist[nrlist[j]] = i
+	    nrlist[i] = nrlist[j]
+	    i = j
+	    j = 2 * i
+	}
+
+	window[i] = w
+	outlist[nrold] = i
+	nrlist[i] = nrold
+end
+
+
+# RM_UOUI - Upper Out Upper In
+
+procedure rm_uoui (leaf, box, window, outlist, nrlist)
+
+short	leaf			#I Leaf
+short	box			#I Box size
+real	window[ARB]		#U Work array
+short	outlist[ARB]		#U Work array
+short	nrlist[ARB]		#U Work array
+
+short	i, j, k
+
+begin
+	call rm_uptoleaf (leaf, box, window, outlist, nrlist)
+
+	i = leaf
+	j = i + box
+	k = i / 2 + box
+	while (window[j] < window[k]) {
+	    call rm_swap (j, k, window, outlist, nrlist)
+	    i = (k - box)
+	    j = i + box
+	    k = i / 2 + box
+	}
+end
+
+
+# RM_DODI - Down Out Down In
+
+procedure rm_dodi (leaf, box, window, outlist, nrlist)
+
+short	leaf			#I Leaf
+short	box			#I Box size
+real	window[ARB]		#U Work array
+short	outlist[ARB]		#U Work array
+short	nrlist[ARB]		#U Work array
+
+short	i, j, k
+
+begin
+	call rm_downtoleaf (leaf, box, window, outlist, nrlist)
+
+	i = leaf
+	j = i + box
+	k = i / 2 + box
+	while (window[j] > window[k]) {
+	    call rm_swap (j, k, window, outlist, nrlist)
+	    i = (k - box)
+	    j = i + box
+	    k = i / 2 + box
+	}
+end
+
+
+# RM_UODI -- Upper Out Down In
+
+procedure rm_uodi (leaf, box, nrnew, outnext, in, window, outlist, nrlist)
+
+short	leaf			#I Leaf
+short	box			#I Box size
+short	nrnew			#I nrnew
+short	outnext			#I outnext
+real	in			#I Input value
+real	window[ARB]		#U Work array
+short	outlist[ARB]		#U Work array
+short	nrlist[ARB]		#U Work array
+
+short	one
+data	one/1/
+
+begin
+	call rm_toroot (leaf, box, nrnew, outnext, in, window, outlist,
+	    nrlist)
+
+	if (window[box] < window[box-1]) {
+	    call rm_swap (box, box-one, window, outlist, nrlist)
+	    call rm_downtoleaf (-one, box, window, outlist, nrlist)
+	}
+end
+
+
+# RM_DOUI -- Down Out Upper In
+
+procedure rm_doui (leaf, box, nrnew, outnext, in, window, outlist, nrlist)
+
+short	leaf			#I Leaf
+short	box			#I Box size
+short	nrnew			#I nrnew
+short	outnext			#I outnext
+real	in			#I Input value
+real	window[ARB]		#U Work array
+short	outlist[ARB]		#U Work array
+short	nrlist[ARB]		#U Work array
+
+short	one
+data	one/1/
+
+begin
+	call rm_toroot (leaf, box, nrnew, outnext, in, window, outlist,
+	    nrlist)
+
+	if (window[box] > window[box+1]) {
+	    call rm_swap (box, box+one, window, outlist, nrlist)
+	    call rm_uptoleaf (one, box, window, outlist, nrlist)
+	}
+end
+
+# RM_TOROOT
+
+procedure rm_toroot (leaf, box, nrnew, outnext, in, window, outlist, nrlist)
+
+short	leaf			#I Leaf
+short	box			#I Box size
+short	nrnew			#I nrnew
+short	outnext			#I outnext
+real	in			#I Input value
+real	window[ARB]		#U Work array
+short	outlist[ARB]		#U Work array
+short	nrlist[ARB]		#U Work array
+
+short	i, j, k
+
+begin
+	i = leaf
+	repeat {
+	    j = i + box
+	    k = i / 2 + box
+	    window[j] = window[k]
+	    outlist[nrlist[k]] = j
+	    nrlist[j] = nrlist[k]
+	    i = k - box
+	} until (i == 0)
+
+	window[box] = in
+	outlist[outnext] = box
+	nrlist[box] = outnext
+end
+
+
+# RM_DOWNTOLEAF
+
+procedure rm_downtoleaf (leaf, box, window, outlist, nrlist)
+
+short	leaf			#I Leaf
+short	box			#I Box size
+real	window[ARB]		#U Work array
+short	outlist[ARB]		#U Work array
+short	nrlist[ARB]		#U Work array
+
+short	i, j, childl, childr
+
+begin
+	i = leaf
+	repeat {
+	    j = i + box
+	    childl = 2 * i + box
+	    childr = childl - 1
+	    if (window[childl] < window[childr])
+	        childl = childr
+	    if (window[j] >= window[childl])
+	        break
+	    call rm_swap (j, childl, window, outlist, nrlist)
+	    i = childl - box
+	}
+end
+
+
+# RM_UPTOLEAF
+
+procedure rm_uptoleaf (leaf, box, window, outlist, nrlist)
+
+short	leaf			#I Leaf
+short	box			#I Box size
+real	window[ARB]		#U Work array
+short	outlist[ARB]		#U Work array
+short	nrlist[ARB]		#U Work array
+
+short	i, j, childl, childr
+
+begin
+	i = leaf
+	repeat {
+	    j = i + box
+	    childl = 2 * i + box
+	    childr = childl + 1
+	    if (window[childl] > window[childr])
+	        childl = childr
+	    if (window[j] <= window[childl])
+	        break
+	    call rm_swap (j, childl, window, outlist, nrlist)
+	    i = childl - box
+	}
+end
+
diff --git a/pkg/xtools/rngranges.x b/pkg/xtools/rngranges.x
new file mode 100644
index 00000000..accfc88d
--- /dev/null
+++ b/pkg/xtools/rngranges.x
@@ -0,0 +1,384 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+include	<ctype.h>
+include	<mach.h>
+
+# RNGRANGES -- Yet another ranges package.
+# This ranges package allows real number ranges (including negative values)
+# and @ lists.  It is an object oriented package using a pointer.
+#
+# RNG_OPEN     -- Open a range string.  Return a pointer to the ranges.
+# RNG_CLOSE    -- Close range structure.
+# RNG_INDEX    -- Get ith range element.  Return EOF if index is out of range.
+# RNG_NEAREST  -- Get nearest range index and value to input value.
+# 		 Return the difference.
+# RNG_INRANGER  -- Check if real value is within a range.
+# RNG_INRANGEI -- Check if integer value is within a range.
+# RNG_ELEMENTR -- Check if real value is an element.
+# RNG_ELEMENTI -- Check if integer value is an element.
+# RNG_ADD      -- Add a range.
+# RNG_ERROR    -- Set error flag and free memory.
+
+
+# Definitions for the RANGES structure.
+
+define	LEN_RNG		2			# Length of main structure
+define	RNG_ALLOC	10			# Allocation size
+define	RNG_MAXINT	(MAX_INT/2)		# Maximum range integer
+
+define	RNG_NPTS	Memi[$1]		# Number of points in ranges
+define	RNG_NRNGS	Memi[$1+1]		# Number of range intervals
+define	RNG_X1		Memr[P2R($1+4*($2)-2)]	# Start of range
+define	RNG_X2		Memr[P2R($1+4*($2)-1)]	# End of range
+define	RNG_DX		Memr[P2R($1+4*($2))]	# Interval step
+define	RNG_NX		Memi[$1+4*($2)+1]	# Number of intervals step
+
+
+# RNG_OPEN -- Open a range string.  Return a pointer to the ranges.
+
+pointer procedure rng_open (rstr, r1, r2, dr)
+
+char	rstr[ARB]		# Range string
+real	r1, r2, dr		# Default range and range limits
+pointer	rg			# Range pointer
+
+int	i, fd, strlen(), open(), getline()
+real	a, b, c
+pointer	sp, str, ptr
+errchk	open, rng_add
+
+begin
+	call smark (sp)
+	call salloc (str, max (strlen (rstr), SZ_LINE), TY_CHAR)
+	call calloc (rg, LEN_RNG, TY_STRUCT)
+
+	a = r1
+	b = r2
+	c = dr
+	if (IS_INDEF(a))
+	    a = 0
+	if (IS_INDEF(b))
+	    b = RNG_MAXINT
+	if (IS_INDEF(c))
+	    c = 1
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Add range(s)
+	    if (Memc[str] == '@') {
+		fd = open (Memc[str+1], READ_ONLY, TEXT_FILE)
+		while (getline (fd, Memc[str]) != EOF)
+		    call rng_add (rg, Memc[str], a, b, c)
+		call close (fd)
+	    } else
+		call rng_add (rg, Memc[str], a, b, c)
+	}
+
+	if (RNG_NRNGS(rg) == 0)
+	    call rng_add (rg, "*", a, b, c)
+
+	call sfree (sp)
+	return (rg)
+end
+
+
+# RNG_CLOSE -- Close range structure
+
+procedure rng_close (rg)
+
+pointer	rg			#I Range descriptor
+
+begin
+	call mfree (rg, TY_STRUCT)
+end
+
+
+# RNG_INDEX -- Get ith range element.  Return EOF if index is out of range.
+
+int procedure rng_index (rg, ival, rval)
+
+pointer	rg			#I Range descriptor
+int	ival			#I Range index
+real	rval			#O Range value
+
+int	i, j
+
+begin
+	if (ival < 1 || ival > RNG_NPTS(rg))
+	    return (EOF)
+
+	j = 1 + RNG_NPTS(rg)
+	do i = RNG_NRNGS(rg), 1, -1 {
+	    j = j - RNG_NX(rg,i)
+	    if (ival >= j) {
+		rval = RNG_X1(rg,i) + (ival - j) * RNG_DX(rg,i)
+		return (ival)
+	    }
+	}
+end
+
+
+# RNG_NEAREST -- Get nearest range index and value to input value.
+# Return the difference.
+
+real procedure rng_nearest (rg, x, ival, rval)
+
+pointer	rg			#I Range descriptor
+real	x			#I Value to be matched
+int	ival			#O Index to range values
+real	rval			#O Range value
+
+int	i, j, k
+real	drmin, dx
+
+begin
+	ival = 1
+	rval = RNG_X1(rg,1)
+	drmin = abs (x - rval)
+
+	k = 1
+	do i = 1, RNG_NRNGS(rg) {
+	    dx = x - RNG_X1(rg,i)
+	    j = max (0, min (RNG_NX(rg,i)-1, nint (dx / RNG_DX(rg,i))))
+	    dx = abs (dx - j * RNG_DX(rg,i))
+	    if (dx < drmin) {
+		drmin = dx
+		ival = j + k
+		rval = RNG_X1(rg,i) + j * RNG_DX(rg,i)
+	    }
+	    k = k + RNG_NX(rg,i)
+	}
+	return (x - rval)
+end
+
+
+# RNG_INRANGER -- Check if real value is within a range.
+
+bool procedure rng_inranger (rg, x)
+
+pointer	rg			#I Range descriptor
+real	x			#I Value to check
+
+int	i
+real	x1, x2
+
+begin
+	do i = 1, RNG_NRNGS(rg) {
+	    x1 = RNG_X1(rg,i)
+	    x2 = RNG_X2(rg,i)
+	    if (x >= min (x1, x2) && x <= max (x1, x2))
+		return (true)
+	}
+	return (false)
+end
+
+
+# RNG_INRANGEI -- Check if integer value is within an integer range.
+
+bool procedure rng_inrangei (rg, x)
+
+pointer	rg			#I Range descriptor
+int	x			#I Value to check
+
+bool	rng_inranger()
+
+begin
+	return (rng_inranger (rg, real(x)))
+end
+
+
+# RNG_ELEMENTR -- Check if real value is an element.
+
+bool procedure rng_elementr (rg, x, delta)
+
+pointer	rg			#I Range descriptor
+real	x			#I Value to check
+real	delta			#I Maximum distance from element
+
+int	ival
+real	rval, rng_nearest()
+
+begin
+	return (abs (rng_nearest (rg, x, ival, rval)) < delta)
+end
+
+
+# RNG_ELEMENTI -- Check if integer value is an element.
+
+bool procedure rng_elementi (rg, x)
+
+pointer	rg			#I Range descriptor
+int	x			#I Value to check
+
+int	ival
+real	rval, rng_nearest()
+
+begin
+	return (abs (rng_nearest (rg, real(x), ival, rval)) < 0.49)
+end
+
+
+# RNG_ADD -- Add a range
+
+procedure rng_add (rg, rstr, r1, r2, dr)
+
+pointer	rg			# Range descriptor
+char	rstr[ARB]		# Range string
+real	r1, r2, dr		# Default range and range limits
+
+int	i, j, nrgs, strlen(), ctor()
+real	x1, x2, dx, nx
+pointer	sp, str, ptr
+errchk	rng_error
+
+begin
+	call smark (sp)
+	call salloc (str, strlen (rstr), TY_CHAR)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    # Convert colon syntax to hyphen/x syntax.
+	    j=0
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		if (rstr[i] == ':') {
+		    if (j == 0)
+			Memc[ptr] = '-'
+		    else if (j == 1)
+			Memc[ptr] = 'x'
+		    else
+			call rng_error (1, rstr, r1, r2, dr, rg)
+		    j = j + 1
+		} else
+		    Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Parse range
+	    if (Memc[str] == '@')
+		call rng_error (2, rstr, r1, r2, dr, rg)
+	    else if (Memc[str] == '*') {
+		x1 = r1
+		x2 = r2
+		dx = dr
+		if ((x2 - x1) / dx + 1 > RNG_MAXINT)
+		    x2 = x1 + (RNG_MAXINT - 1) * dx
+	    } else {
+		j = 1
+		if (ctor (Memc[str], j, x1) == 0)
+		    call rng_error (3, rstr, r1, r2, dr, rg)
+		if (Memc[str+j-1] == '-') {
+		    j = j + 1
+		    if (ctor (Memc[str], j, x2) == 0)
+			call rng_error (3, rstr, r1, r2, dr, rg)
+		    if (Memc[str+j-1] == 'x') {
+			j = j + 1
+			if (ctor (Memc[str], j, dx) == 0)
+			    call rng_error (3, rstr, r1, r2, dr, rg)
+		    } else
+			dx = dr
+		} else if (Memc[str+j-1] == 'x') {
+		    j = j + 1
+		    if (ctor (Memc[str], j, dx) == 0)
+			call rng_error (3, rstr, r1, r2, dr, rg)
+		    if (dx < 0)
+			x2 = min (r1, r2)
+		    else
+			x2 = max (r1, r2)
+		    if ((x2 - x1) / dx + 1 > RNG_MAXINT)
+			x2 = x1 + (RNG_MAXINT - 1) * dx
+		} else {
+		    x2 = x1
+		    dx = dr
+		}
+	    }
+
+	    if (x1 < min (r1, r2) || x1 > max (r1, r2) ||
+	        x2 < min (r1, r2) || x2 > max (r1, r2))
+		call rng_error (4, rstr, r1, r2, dr, rg)
+
+	    nrgs = RNG_NRNGS(rg)
+	    if (mod (nrgs, RNG_ALLOC) == 0)
+		call realloc (rg, LEN_RNG+4*(nrgs+RNG_ALLOC), TY_STRUCT)
+	    nrgs = nrgs + 1
+	    RNG_NRNGS(rg) = nrgs
+	    RNG_X1(rg, nrgs) = x1
+	    RNG_X2(rg, nrgs) = x2
+	    RNG_DX(rg, nrgs) = dx
+	    nx = (x2 - x1) / dx + 1
+	    RNG_NX(rg, nrgs) = min (nx, real (RNG_MAXINT))
+	    RNG_NPTS(rg) = min (nx + RNG_NPTS(rg), real (RNG_MAXINT))
+	}
+
+	call sfree (sp)
+end
+
+
+# RNG_ERROR -- Set error flag and free memory.
+# Note that the pointer is freed at this point.
+
+procedure rng_error (errnum, rstr, r1, r2, dr, rg)
+
+int	errnum			# Error number
+char	rstr[ARB]		# Range string
+real	r1, r2, dr		# Default range and range limits
+pointer	rg			# Range pointer to be freed.
+
+pointer	errstr
+
+begin
+	call salloc (errstr, SZ_LINE, TY_CHAR)
+
+	switch (errnum) {
+	case 1:
+	    call sprintf (Memc[errstr], SZ_LINE,
+	        "Range syntax error: Too many colons (%s)")
+		call pargstr (rstr)
+	case 2:
+	    call sprintf (Memc[errstr], SZ_LINE,
+	        "Range syntax error: Cannot nest @files (%s)")
+		call pargstr (rstr)
+	case 3:
+	    call sprintf (Memc[errstr], SZ_LINE,
+	        "Range syntax error: (%s)")
+		call pargstr (rstr)
+	case 4:
+	    call sprintf (Memc[errstr], SZ_LINE,
+		"Range syntax error: Range out of bounds %g to %g (%s)")
+		call pargr (min (r1, r2))
+		call pargr (max (r1, r2))
+		call pargstr (rstr)
+	case 5:
+	    call sprintf (Memc[errstr], SZ_LINE,
+		"Range syntax error: Too many range elements (%s)")
+		call pargstr (rstr)
+	}
+
+	call rng_close (rg)
+	call error (errnum, Memc[errstr])
+end
diff --git a/pkg/xtools/rngranges.xBAK b/pkg/xtools/rngranges.xBAK
new file mode 100644
index 00000000..3d24e524
--- /dev/null
+++ b/pkg/xtools/rngranges.xBAK
@@ -0,0 +1,384 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+include	<ctype.h>
+include	<mach.h>
+
+# RNGRANGES -- Yet another ranges package.
+# This ranges package allows real number ranges (including negative values)
+# and @ lists.  It is an object oriented package using a pointer.
+#
+# RNG_OPEN     -- Open a range string.  Return a pointer to the ranges.
+# RNG_CLOSE    -- Close range structure.
+# RNG_INDEX    -- Get ith range element.  Return EOF if index is out of range.
+# RNG_NEAREST  -- Get nearest range index and value to input value.
+# 		 Return the difference.
+# RNG_INRANGER  -- Check if real value is within a range.
+# RNG_INRANGEI -- Check if integer value is within a range.
+# RNG_ELEMENTR -- Check if real value is an element.
+# RNG_ELEMENTI -- Check if integer value is an element.
+# RNG_ADD      -- Add a range.
+# RNG_ERROR    -- Set error flag and free memory.
+
+
+# Definitions for the RANGES structure.
+
+define	LEN_RNG		2			# Length of main structure
+define	RNG_ALLOC	10			# Allocation size
+
+define	RNG_NPTS	Memi[$1]		# Number of points in ranges
+define	RNG_NRNGS	Memi[$1+1]		# Number of range intervals
+define	RNG_X1		Memr[$1+4*($2)-2]	# Start of range
+define	RNG_X2		Memr[$1+4*($2)-1]	# End of range
+define	RNG_DX		Memr[$1+4*($2)]		# Interval step
+define	RNG_NX		Memi[$1+4*($2)+1]	# Number of intervals step
+
+
+# RNG_OPEN -- Open a range string.  Return a pointer to the ranges.
+
+pointer procedure rng_open (rstr, r1, r2, dr)
+
+char	rstr[ARB]		# Range string
+real	r1, r2, dr		# Default range and range limits
+pointer	rg			# Range pointer
+
+int	i, fd, strlen(), open(), getline()
+real	a, b, c
+pointer	sp, str, ptr
+errchk	open, rng_add
+
+begin
+	call smark (sp)
+	call salloc (str, max (strlen (rstr), SZ_LINE), TY_CHAR)
+	call calloc (rg, LEN_RNG, TY_STRUCT)
+
+	a = r1
+	b = r2
+	c = dr
+	if (IS_INDEF(a))
+	    a = 0
+	if (IS_INDEF(b))
+	    b = MAX_INT / 2
+	if (IS_INDEF(c))
+	    c = 1
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Add range(s)
+	    if (Memc[str] == '@') {
+		fd = open (Memc[str+1], READ_ONLY, TEXT_FILE)
+		while (getline (fd, Memc[str]) != EOF)
+		    call rng_add (rg, Memc[str], a, b, c)
+		call close (fd)
+	    } else
+		call rng_add (rg, Memc[str], a, b, c)
+	}
+
+	if (RNG_NRNGS(rg) == 0)
+	    call rng_add (rg, "*", a, b, c)
+
+	call sfree (sp)
+	return (rg)
+end
+
+
+# RNG_CLOSE -- Close range structure
+
+procedure rng_close (rg)
+
+pointer	rg			#I Range descriptor
+
+begin
+	call mfree (rg, TY_STRUCT)
+end
+
+
+# RNG_INDEX -- Get ith range element.  Return EOF if index is out of range.
+
+int procedure rng_index (rg, ival, rval)
+
+pointer	rg			#I Range descriptor
+int	ival			#I Range index
+real	rval			#O Range value
+
+int	i, j
+
+begin
+	if (ival < 1 || ival > RNG_NPTS(rg))
+	    return (EOF)
+
+	j = 1 + RNG_NPTS(rg)
+	do i = RNG_NRNGS(rg), 1, -1 {
+	    j = j - RNG_NX(rg,i)
+	    if (ival >= j) {
+		rval = RNG_X1(rg,i) + (ival - j) * RNG_DX(rg,i)
+		return (ival)
+	    }
+	}
+end
+
+
+# RNG_NEAREST -- Get nearest range index and value to input value.
+# Return the difference.
+
+real procedure rng_nearest (rg, x, ival, rval)
+
+pointer	rg			#I Range descriptor
+real	x			#I Value to be matched
+int	ival			#O Index to range values
+real	rval			#O Range value
+
+int	i, j, k
+real	drmin, dx
+
+begin
+	ival = 1
+	rval = RNG_X1(rg,1)
+	drmin = abs (x - rval)
+
+	k = 1
+	do i = 1, RNG_NRNGS(rg) {
+	    dx = x - RNG_X1(rg,i)
+	    j = max (0, min (RNG_NX(rg,i)-1, nint (dx / RNG_DX(rg,i))))
+	    dx = abs (dx - j * RNG_DX(rg,i))
+	    if (dx < drmin) {
+		drmin = dx
+		ival = j + k
+		rval = RNG_X1(rg,i) + j * RNG_DX(rg,i)
+	    }
+	    k = k + RNG_NX(rg,i)
+	}
+	return (x - rval)
+end
+
+
+# RNG_INRANGER -- Check if real value is within a range.
+
+bool procedure rng_inranger (rg, x)
+
+pointer	rg			#I Range descriptor
+real	x			#I Value to check
+
+int	i
+real	x1, x2
+
+begin
+	do i = 1, RNG_NRNGS(rg) {
+	    x1 = RNG_X1(rg,i)
+	    x2 = RNG_X2(rg,i)
+	    if (x >= min (x1, x2) && x <= max (x1, x2))
+		return (true)
+	}
+	return (false)
+end
+
+
+# RNG_INRANGEI -- Check if integer value is within an integer range.
+
+bool procedure rng_inrangei (rg, x)
+
+pointer	rg			#I Range descriptor
+int	x			#I Value to check
+
+bool	rng_inranger()
+
+begin
+	return (rng_inranger (rg, real(x)))
+end
+
+
+# RNG_ELEMENTR -- Check if real value is an element.
+
+bool procedure rng_elementr (rg, x, delta)
+
+pointer	rg			#I Range descriptor
+real	x			#I Value to check
+real	delta			#I Maximum distance from element
+
+int	ival
+real	rval, rng_nearest()
+
+begin
+	return (abs (rng_nearest (rg, x, ival, rval)) < delta)
+end
+
+
+# RNG_ELEMENTI -- Check if integer value is an element.
+
+bool procedure rng_elementi (rg, x)
+
+pointer	rg			#I Range descriptor
+int	x			#I Value to check
+
+int	ival
+real	rval, rng_nearest()
+
+begin
+	return (abs (rng_nearest (rg, real(x), ival, rval)) < 0.49)
+end
+
+
+# RNG_ADD -- Add a range.
+
+procedure rng_add (rg, rstr, r1, r2, dr)
+
+pointer	rg			# Range descriptor
+char	rstr[ARB]		# Range string
+real	r1, r2, dr		# Default range and range limits
+
+int	i, j, nx, nrgs, strlen(), ctor()
+real	x1, x2, dx
+pointer	sp, str, ptr
+errchk	rng_error
+
+begin
+	call smark (sp)
+	call salloc (str, strlen (rstr), TY_CHAR)
+
+	i = 1
+	while (rstr[i] != EOS) {
+
+	    # Find beginning and end of a range and copy it to the work string
+	    while (IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n')
+	        i = i + 1
+	    if (rstr[i] == EOS)
+		break
+
+	    # Convert colon syntax to hyphen/x syntax.
+	    j=0
+	    ptr = str
+	    while (!(IS_WHITE(rstr[i]) || rstr[i]==',' || rstr[i]=='\n' ||
+		rstr[i]==EOS)) {
+		if (rstr[i] == ':') {
+		    if (j == 0)
+			Memc[ptr] = '-'
+		    else if (j == 1)
+			Memc[ptr] = 'x'
+		    else
+			call rng_error (1, rstr, r1, r2, dr, rg)
+		    j = j + 1
+		} else
+		    Memc[ptr] = rstr[i]
+	        i = i + 1
+		ptr = ptr + 1
+	    }
+	    Memc[ptr] = EOS
+
+	    # Parse range
+	    if (Memc[str] == '@')
+		call rng_error (2, rstr, r1, r2, dr, rg)
+	    else if (Memc[str] == '*') {
+		x1 = r1
+		x2 = r2
+		dx = dr
+	    } else {
+		j = 1
+		if (ctor (Memc[str], j, x1) == 0)
+		    call rng_error (3, rstr, r1, r2, dr, rg)
+		if (Memc[str+j-1] == '-') {
+		    j = j + 1
+		    if (ctor (Memc[str], j, x2) == 0)
+			call rng_error (3, rstr, r1, r2, dr, rg)
+		    if (Memc[str+j-1] == 'x') {
+			j = j + 1
+			if (ctor (Memc[str], j, dx) == 0)
+			    call rng_error (3, rstr, r1, r2, dr, rg)
+		    } else
+			dx = dr
+		} else if (Memc[str+j-1] == 'x') {
+		    j = j + 1
+		    if (ctor (Memc[str], j, dx) == 0)
+			call rng_error (3, rstr, r1, r2, dr, rg)
+		    if (dx < 0)
+			x2 = min (r1, r2)
+		    else
+			x2 = max (r1, r2)
+		} else {
+		    x2 = x1
+		    dx = dr
+		}
+	    }
+
+	    if (x1 < min (r1, r2) || x1 > max (r1, r2) ||
+	        x2 < min (r1, r2) || x2 > max (r1, r2))
+		call rng_error (4, rstr, r1, r2, dr, rg)
+
+	    nrgs = RNG_NRNGS(rg)
+	    if (mod (nrgs, RNG_ALLOC) == 0)
+		call realloc (rg, LEN_RNG+4*(nrgs+RNG_ALLOC), TY_STRUCT)
+	    nrgs = nrgs + 1
+	    nx = (x2 - x1) / dx + 1
+	    if (nx > MAX_INT)
+		call rng_error (5, rstr, r1, r2, dr, rg)
+	    RNG_NRNGS(rg) = nrgs
+	    RNG_X1(rg, nrgs) = x1
+	    RNG_X2(rg, nrgs) = x2
+	    RNG_DX(rg, nrgs) = dx
+	    RNG_NX(rg, nrgs) = nx
+	    nx = nx + RNG_NPTS(rg)
+	    if (nx > MAX_INT)
+		call rng_error (5, rstr, r1, r2, dr, rg)
+	    RNG_NPTS(rg) = nx
+	}
+
+	call sfree (sp)
+end
+
+
+# RNG_ERROR -- Set error flag and free memory.
+# Note that the pointer is freed at this point.
+
+procedure rng_error (errnum, rstr, r1, r2, dr, rg)
+
+int	errnum			# Error number
+char	rstr[ARB]		# Range string
+real	r1, r2, dr		# Default range and range limits
+pointer	rg			# Range pointer to be freed.
+
+pointer	errstr
+
+begin
+	call salloc (errstr, SZ_LINE, TY_CHAR)
+
+	switch (errnum) {
+	case 1:
+	    call sprintf (Memc[errstr], SZ_LINE,
+	        "Range syntax error: Too many colons (%s)")
+		call pargstr (rstr)
+	case 2:
+	    call sprintf (Memc[errstr], SZ_LINE,
+	        "Range syntax error: Cannot nest @files (%s)")
+		call pargstr (rstr)
+	case 3:
+	    call sprintf (Memc[errstr], SZ_LINE,
+	        "Range syntax error: (%s)")
+		call pargstr (rstr)
+	case 4:
+	    call sprintf (Memc[errstr], SZ_LINE,
+		"Range syntax error: Range out of bounds %g to %g (%s)")
+		call pargr (min (r1, r2))
+		call pargr (max (r1, r2))
+		call pargstr (rstr)
+	case 5:
+	    call sprintf (Memc[errstr], SZ_LINE,
+		"Range syntax error: Too many range elements (%s)")
+		call pargstr (rstr)
+	}
+
+	call rng_close (rg)
+	call error (errnum, Memc[errstr])
+end
diff --git a/pkg/xtools/skywcs/doc/README b/pkg/xtools/skywcs/doc/README
new file mode 100644
index 00000000..b0998629
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/README
@@ -0,0 +1,301 @@
+                SKYWCS: The Sky Coordinates Package
+
+1. Introduction
+
+    The skywcs package contains a simple set of routines for managing sky
+coordinate information and for transforming from one sky coordinate system to
+another. The sky coordinate system is defined either by a system name, e.g.
+"J2000", "galactic", etc., or by an image system name, e.g. "dev$ypix" or
+"dev$ypix world".
+
+    The skywcs routine are layered on the Starlink Positional Astronomy library
+SLALIB which is installed in the IRAF MATH package. Type "help slalib option=
+sys" for more information about SLALIB.
+
+
+2. The Interface Routines
+
+The package prefix is sk. The interface routines are listed below.
+
+   stat = sk_decwcs (ccsystem, mw, coo, imcoo)
+   stat = sk_decwstr (ccsystem, coo, imcoo)
+   stat = sk_decim (im, wcs, mw, coo)
+	  sk_enwcs (coo, ccsystem, maxch)
+ newcoo = sk_copy (coo)
+          sk_iiprint (label, imagesys, mw, coo) 
+          sk_iiwrite (fd, label, imagesys, mw, coo) 
+[id]val = sk_stat[id] (coo, param)
+          sk_stats (coo, param, str, maxch)
+	  sk_set[id] (coo, param, [id]val)
+          sk_sets (coo, param, str)
+	  sk_ultran (incoo, outcoo, ilng, ilat, olng, olat, npts)
+	  sk_lltran (incoo, outoo, ilng, ilat, ipmlng, ipmlat, px, rv,
+             olng, olat)
+	  sk_equatorial (incoo, outcoo, ilng, ilat, ipmlng, ipmlat, px,
+	     rv, olng, olat)
+	  sk_saveim (coo, mw, im)
+	  sk_close (coo)
+
+
+3. Notes
+
+    An "include <pkg/skywcs.h>" statement must appear in the calling program
+to make the skywcs package parameter definitions visible to the calling
+program.
+
+    A "-lxtools -lslalib" must be included in the calling program link line
+to link in the skywcs and the slalib routines.
+
+    The sky coordinate descriptor is created with a call to one of the
+sk_decwcs, sk_decwstr, or sk_imwcs routines. If the source of the sky
+coordinate descriptor is an image then an IRAF MWCS descriptor will be returned
+with the sky oordinate descriptor. The sky coordinate descriptor is freed with a
+call to sk_close. A separate call to mw_close must be made to free the MWCS
+descriptor if one was allocated.
+
+    By default the main skywcs coordinate transformation routine sk_ultran
+assumes that the input and output sky coordinates are in hours and degrees
+if the input and output coordinate systems are equatorial, otherwise the
+coordinates are assumed to be in degrees and degrees. The default input and
+output sky coordinate units can be reset with calls to sk_seti. Two lower level
+coordinate transformations for handling proper motions sk_lltran and
+sk_equatorial are also available. These routines assume that the input and
+output coordinates and proper motions are in radians.
+
+    Calling programs working with both sky coordinate and MWCS descriptors
+need to be aware that the MWCS routines assume that all sky coordinates
+will be input and output in degrees and adjust their code accordingly.
+
+    The skywcs routine sk_saveim can be used to update an image header.
+
+
+3. Examples
+
+Example 1: Convert from B1950 coordinates to J2000 coordinates.
+
+    include <skywcs.h>
+
+    ....
+
+    # Open input coordinate system.
+    instat = sk_decwstr ("B1950", incoo, NULL)
+    if (instat == ERR) {
+	call sk_close (incoo)
+	return
+    }
+
+    # Open output coordinate system.
+    outstat = sk_decwstr ("J2000", outcoo, NULL)
+    if (outstat == ERR) {
+	call sk_close (outcoo)
+	return
+    }
+
+    # Do the transformation assuming the input coordinates are in hours
+    # and degrees. The output coordinates will be in hours and degrees
+    # as well.
+    call sk_ultran (incoo, outcoo, rain, decin, raout, decout, npts) 
+
+    # Close the coordinate descriptors.
+    call sk_close (incoo)
+    call sk_close (outcoo)
+
+    ...
+
+
+Example 2: Repeat example 1 but convert to galactic coordinates.
+
+    include <skywcs.h>
+
+    ....
+
+    # Open the input coordinate system.
+    instat = sk_decwstr ("B1950", incoo, NULL)
+    if (instat == ERR) {
+	call sk_close (incoo)
+	return
+    }
+
+    # Open the output coordinate system.
+    outstat = sk_decwstr ("galactic", outcoo, NULL)
+    if (outstat == ERR) {
+	call sk_close (outcoo)
+	return
+    }
+
+    # Dd the transformation assuming the input coordinates are in hours and
+    # degrees. The output coordinates will be in degrees and degrees.
+    call sk_ultran (incoo, outcoo, rain, decin, raout, decout, npts) 
+
+    # Close the coordinate descriptors.
+    call sk_close (incoo)
+    call sk_close (outcoo)
+
+    ...
+
+Example 3: Convert a grid of pixel coordinates in the input image to the
+equivalent pixel coordinate in the output image using the image world
+coordinate systems to connect the two.
+
+    include <skywcs.h>
+
+    ....
+
+    # Mwref will be defined because the input system is an image.
+    refstat = sk_decwcs ("refimage logical", mwref, refcoo, NULL)
+    if (refstat == ERR || mwref == NULL) {
+	if (mwref != NULL)
+	    call mw_close (mwref)
+	call sk_close (refcoo)
+	return
+    }
+
+    # Set the reference coordinate descriptor so it expects input in degrees
+    # and degrees.
+    call sk_seti (refcoo, S_NLNGUNUTS, SKY_DEGREES)
+    call sk_seti (refcoo, S_NLATUNUTS, SKY_DEGREES)
+
+    # Mwout will be defined because the output system is an image.
+    outstat = sk_decwcs ("image logical", mwout, outcoo, NULL)
+    if (outstat == ERR || mwout == NULL) {
+	if (mwout != NULL)
+	    call mw_close (mwout)
+	call sk_close (outcoo)
+	call mw_close (mwref)
+	call sk_close (refcoo)
+	return
+    }
+
+    # Set the output coordinate descriptor so it will output coordinates
+    # in degrees and degrees.
+    call sk_seti (outcoo, S_NLNGUNUTS, SKY_DEGREES)
+    call sk_seti (outcoo, S_NLATUNUTS, SKY_DEGREES)
+
+    # Compute pixel grid in refimage and store coordinate in the arrays
+    # xref and yref.
+    npts = 0
+    do j = 1, IM_LEN(im,2), 100 {
+        do i = 1, IM_LEN(im,1), 100 {
+	    npts = npts + 1
+	    xref[npts] = i
+	    yref[npts] = j
+	}
+    }
+
+    # Convert xref and yref to celestial coordinates raref and decref using
+    # mwref. The output coordinates will be in degrees and degrees.
+    ctref = mw_sctran (mwref, "logical", "world", 03B)
+    do i = 1, npts
+	call mw_c2trand (ctref, xref[i], yref[i], raref[i], decref[i])
+    call ct_free (ctref)
+
+    # Convert the reference celestial coordinates to the output celestial
+    # coordinate system using the coordinate descriptors.
+    call sk_ultran (refcoo, outcoo, raref, decref, raout, decout, npts)
+
+    # Convert the output celestial coordinates to  pixel coordinates in
+    # the other image using mwout.
+    ctout = mw_sctran (mwout, "world", "logical", 03B)
+    do i = 1, npts
+	call mw_c2trand (ctout, raout[i], decout[i], xout[i], yout[i])
+    call ct_free (ctout)
+
+    # Print the input and output pixel coordinates.
+    do i = 1, npts {
+	call printf ("%10.3f %10.3f  %10.3f %10.3f\n")
+	    call pargd (xref[i])
+	    call pargd (yref[i])
+	    call pargd (xout[i])
+	    call pargd (yout[i])
+    }
+
+    # Tidy up.
+    call mw_close (mwref)
+    call mw_close (mwout)
+    call sk_close (refcoo)
+    call sk_close (outcoo)
+
+
+Example 4: Convert a 2D image with an J2000 tangent plane projection wcs to the
+equivalent galactic wcs. The transformation requires a shift in origin and a
+rotation. Assume that the ra axis is 1 and the dec axis is 2. The details of
+how to compute the rotation are not shown here. See the imcctran task for
+details.
+
+    include <mwset.h> 
+    include <skywcs.h>
+
+    ...
+
+    # Open image.
+    im = immap (image, READ_WRITE, 0)
+
+    # Open the image coordinate system.
+    instat = sk_decim (im, "logical", mwin, cooin)
+    if (instat == ERR || mwin == NULL) {
+	...
+	call sk_close (cooin)
+	...
+    }
+
+    # Get the dimensions of the mwcs descriptor. This should be 2.
+    ndim = mw_ndim (mwin, MW_NPHYSDIM)
+
+    # Get the default coordinates to degrees and degreees.
+    call sk_seti (cooin, S_NLNGUNITS, SKY_DEGREES)
+    call sk_seti (cooin, S_NATGUNITS, SKY_DEGREES)
+
+    # Open the output coordinate system. Mwout is NULL because this system
+    # is not an image.
+    outstat = sk_decwstr ("galactic", mwout, cooout, cooin)
+    if (outstat == ERR) {
+        ...
+	call sk_close (outstat)
+	...
+    }
+
+    # Make a copy of the mwcs descriptor.
+    mwout = mw_newcopy (mwin)
+
+    # Allocate space for the r and w vectors and cd matrix.
+    call malloc (r, ndim, TY_DOUBLE)
+    call malloc (w, ndim, TY_DOUBLE)
+    call malloc (cd, ndim * ndim, TY_DOUBLE)
+    call malloc (newcd, ndim * ndim, TY_DOUBLE)
+
+    # Assume for simplicty that the MWCS LTERM is the identify transform.
+    # so we don't have to worry about it. Get the WTERM which consists
+    # of r the reference point in pixels, w the reference point in degrees,
+    # and the cd matrix in degrees per pixel.
+    call mw_gwtermd (mwin, Memd[r], Memd[w], Memd[cd], ndim)
+
+    # Convert the world coordinates zero point. The pixel zero point
+    # remains the same.
+    tilng = Memd[w]
+    tilat = Memd[w+1]
+    call sk_ultran (incoo, outcoo, tilng, tilat, tolng, tolat, 1)
+    Memd[w] = tolng
+    Memd[w+1] = tolat
+
+    # Figure out how much to rotate the coordinate system and edit the
+    # compute a new CD matrix. Call it newcd.
+    ...
+
+    # Enter the new CD matrix and zero point.
+    call mw_swterm (mwout, Memd[r], Memd[w], Memd[newcd], ndim)
+
+    # Update the header. 
+    call sk_saveim (cooout, mwout, im)
+    call mw_saveim (mwout, im)
+    ...
+
+    # Tidy up.
+    call mfree (r, TY_DOUBLE)
+    call mfree (w, TY_DOUBLE)
+    call mfree (cd, TY_DOUBLE)
+    call mfree (newcd, TY_DOUBLE)
+    call mw_close (mwin)
+    call mw_close (mwout)
+    call sk_close (cooin)
+    call sk_close (cooout)
+    call imunmap (im)
diff --git a/pkg/xtools/skywcs/doc/ccsystems.hlp b/pkg/xtools/skywcs/doc/ccsystems.hlp
new file mode 100644
index 00000000..63a2fde6
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/ccsystems.hlp
@@ -0,0 +1,134 @@
+.help ccsystems Mar00 Skywcs
+.ih
+NAME
+ccsystems -- list and describe the supported sky coordinate systems
+.ih
+USAGE
+help ccsystems
+
+.ih
+SKY COORDINATE SYSTEMS
+
+The sky package supports the equatorial ("fk4", "fk4-noe", "fk5", "icrs"),
+ecliptic, galactic, and supergalactic celestial coordinate systems. In most
+cases and unless otherwise noted users can input their coordinates in
+any one of these systems as long as they specify the coordinate system
+correctly.
+
+Considerable flexibility is permitted in how the coordinate systems are
+specified, e.g. J2000.0, j2000.0, 2000.0, fk5, fk5 J2000, and fk5 2000.0
+all specify the mean place post-IAU 1976 or FK5 system. Missing equinox and
+epoch fields assume reasonable defaults. In most cases the
+systems of most interest to users are "icrs", "j2000", and "b1950"
+which stand for the ICRS J2000.0, FK5 J2000.0 and FK4 B1950.0 celestial
+coordinate systems respectively. The full set of options are listed below:
+
+.ls equinox [epoch]
+The equatorial mean place post-IAU 1976 (FK5) system if equinox is a
+Julian epoch, e.g. J2000.0 or 2000.0, or the equatorial mean place
+pre-IAU 1976 system (FK4) if equinox is a Besselian epoch, e.g. B1950.0
+or 1950.0. Julian equinoxes are prefixed by a J or j, Besselian equinoxes
+by a B or b. Equinoxes without the J / j or B / b prefix are treated as
+Besselian epochs if they are < 1984.0, Julian epochs if they are >= 1984.0.
+Epoch is the epoch of the observation and may be a Julian
+epoch, a Besselian epoch, or a Julian date. Julian epochs
+are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to the epoch type of
+equinox if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.  If undefined epoch defaults to equinox.
+.le
+.ls icrs [equinox] [epoch]
+The International Celestial Reference System where equinox is
+a Julian or Besselian epoch e.g. J2000.0  or B1980.0.
+Equinoxes without the J / j or B / b prefix are treated as Julian epochs.
+The default value of equinox is J2000.0.
+Epoch is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.  If undefined epoch defaults to equinox.
+.le
+.ls fk5 [equinox] [epoch]
+The equatorial mean place post-IAU 1976 (FK5) system where equinox is
+a Julian or Besselian epoch e.g. J2000.0  or B1980.0.
+Equinoxes without the J / j or B / b prefix are treated as Julian epochs.
+The default value of equinox is J2000.0.
+Epoch is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.  If undefined epoch defaults to equinox.
+.le
+.ls fk4 [equinox] [epoch]
+The equatorial mean place pre-IAU 1976 (FK4) system where equinox is a
+Besselian or Julian epoch e.g. B1950.0  or J2000.0,
+and epoch is the Besselian epoch, the Julian epoch, or the Julian date of the
+observation.
+Equinoxes without the J / j or B / b prefix are treated
+as Besselian epochs. The default value of equinox is B1950.0. Epoch
+is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.  If undefined epoch defaults to equinox.
+.le
+.ls noefk4 [equinox] [epoch]
+The equatorial mean place pre-IAU 1976 (FK4) system but without the E-terms
+where equinox is a Besselian or Julian epoch e.g. B1950.0 or J2000.0,
+and epoch is the Besselian epoch, the Julian epoch, or the Julian date of the
+observation.
+Equinoxes without the J / j or B / b prefix are treated
+as Besselian epochs. The default value of equinox is B1950.0.
+Epoch is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian day.  If undefined epoch defaults to equinox.
+.le
+.ls apparent epoch
+The equatorial geocentric apparent place post-IAU 1976 system where
+epoch is the epoch of observation.
+Epoch is a Besselian epoch, a Julian epoch or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian
+epochs if the epoch value < 1984.0, Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date.
+.le
+.ls ecliptic epoch
+The ecliptic coordinate system where epoch is the epoch of observation.
+Epoch is a Besselian epoch, a Julian epoch, or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian epochs
+if the epoch values < 1984.0, Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian day.
+.le
+.ls galactic [epoch]
+The IAU 1958 galactic coordinate system.
+Epoch is a Besselian epoch, a Julian epoch or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian
+epochs if the epoch value < 1984.0, Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date. The default value of epoch is B1950.0.
+.le
+.ls supergalactic [epoch]
+The deVaucouleurs supergalactic coordinate system.
+Epoch is a Besselian epoch, a Julian epoch or a Julian date.
+Julian epochs are prefixed by a J or j, Besselian epochs by a B or b.
+Epochs without the J / j or B / b prefix default to Besselian
+epochs if the epoch value < 1984.0, Julian epochs
+if the epoch value <= 3000.0, otherwise epoch is interpreted as
+a Julian date. The default value of epoch is B1950.0.
+.le
+
+Fields enclosed in [] are optional with the defaults as described. The epoch
+field for the "icrs" , "fk5", "galactic", and "supergalactic" coordinate
+systems is only used if the input coordinates are in the equatorial fk4,
+noefk4, fk5, or icrs systems and proper motions are used to transform from
+coordinate system to another.
+
+.ih
+SEE ALSO
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skclose.hlp b/pkg/xtools/skywcs/doc/skclose.hlp
new file mode 100644
index 00000000..191b08b5
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skclose.hlp
@@ -0,0 +1,23 @@
+.help skclose Mar00 Skywcs
+.ih
+NAME
+skclose -- free the sky coordinate descriptor
+.ih
+SYNOPSIS
+call sk_close (coo)
+
+.nf
+pointer	coo		# the sky coordinate descriptor
+.fi
+.ih
+ARGUMENTS
+.ls  coo    
+The sky coordinate descriptor to be freed.
+.le
+.ih
+DESCRIPTION
+Sk_close frees a previously allocated sky coordinate descriptor.
+.ih
+SEE ALSO
+skdecwcs, skdecwstr, skdecim, skcopy
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skcopy.hlp b/pkg/xtools/skywcs/doc/skcopy.hlp
new file mode 100644
index 00000000..68219c0d
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skcopy.hlp
@@ -0,0 +1,24 @@
+.help skcopy Mar00 Skywcs
+.ih
+NAME
+skcopy -- copy a sky coordinate descriptor
+.ih
+SYNOPSIS
+newcoo = sk_copy (coo)
+
+.nf
+pointer	coo		# the sky coordinate descriptor
+.fi
+.ih
+ARGUMENTS
+.ls  coo    
+The sky coordinate descriptor to be copied.
+.le
+.ih
+DESCRIPTION
+Sk_copy is a pointer function which returns a copy of the input sky coordinate
+descriptor as its function value.
+.ih
+SEE ALSO
+skdecwcs, skdecwstr, skdecim, skclose
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skdecim.hlp b/pkg/xtools/skywcs/doc/skdecim.hlp
new file mode 100644
index 00000000..6e570e47
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skdecim.hlp
@@ -0,0 +1,56 @@
+.help skdecim Mar00 Skywcs
+.ih
+NAME
+skdecim -- open a sky coordinate descriptor using an image descriptor
+.ih
+SYNOPSIS
+stat = sk_decim (im, mw, coo, imcoo)
+
+.nf
+pointer	im		# the input image descriptor
+pointer	mw		# the output mwcs descriptor
+pointer	coo		# the output sky coordinate descriptor
+pointer	imcoo		# the input image sky coordinate descriptor 
+.fi
+.ih
+ARGUMENTS
+.ls  im
+The input image descriptor.
+.le
+.ls mw
+The output mwcs descriptor.  A NULL value for mw is returned if the image
+world coordinate system cannot be read.
+.le
+.ls coo
+The output sky coordinate descriptor.
+.le
+.ls imcoo
+The parent image sky coordinate descriptor. Imcoo is set to NULL
+except in cases where the sky coordinate descriptor for an image is
+transformed and written back to the same image.
+.le
+.ih
+DESCRIPTION
+Sk_decim is an integer function which returns OK or ERR as its function
+value. ERR is returned if a valid sky coordinate system cannot be opened,
+OK otherwise.
+
+Sk_decim returns the image MWCS descriptor mw. The MWCS descriptor is used
+to convert from pixel coordinates to world coordinates and vice versa.
+The MWCS descriptor must be freed with a call to the MWCS routine
+mw_close before task termination.
+
+Sk_decim returns the sky descriptor coo. The sky coordinate descriptor 
+is defined even if an error is detected in reading the image celestial 
+coordinate system, and must be freed with a call to sk_close before
+task termination.
+
+.ih
+NOTES
+Type "help ccsystems" to see the list of the supported sky coordinate systems.
+
+Type "help mwcs$MWCS.hlp fi+" to find out more about the IRAF image world
+coordinate system library MWCS.
+SEE ALSO
+skdecwcs, skdecwstr, skcopy, skclose
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skdecwcs.hlp b/pkg/xtools/skywcs/doc/skdecwcs.hlp
new file mode 100644
index 00000000..2081fd50
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skdecwcs.hlp
@@ -0,0 +1,62 @@
+.help skdecwcs Mar00 Skywcs 
+.ih
+NAME
+skdecwcs -- open a sky coordinate descriptor using an image or system name
+.ih
+SYNOPSIS
+stat = sk_decwcs (ccsystem, mw, coo, imcoo)
+
+.nf
+char	ccsystem	# the input celestial coordinate system name
+pointer	mw		# the output mwcs descriptor
+pointer	coo		# the output sky coordinate descriptor
+pointer	imcoo		# the input image sky coordinate descriptor 
+.fi
+.ih
+ARGUMENTS
+.ls  ccsystem.   
+The celestial coordinate system name. Ccsystem is a either an image system
+name, e.g.  "dev$ypix logical" or "dev$ypix world" or a system name, e.g.
+"J2000" or "galactic".
+.le
+.ls mw
+The output mwcs descriptor. A NULL value for mw is returned if the
+image world coordinate system cannot be read or ccsystem is not an image
+system name. 
+.le
+.ls coo
+The output sky coordinate descriptor.
+.le
+.ls imcoo
+The parent image coordinate descriptor. Imcoo is set to NULL
+except in cases where the sky coordinate descriptor for an image is
+transformed and written back to the same image.
+.le
+.ih
+DESCRIPTION
+Sk_decwcs is an integer function which returns OK or ERR as its function
+value. ERR is returned if a valid sky coordinate system cannot be opened,
+OK otherwise.
+
+Sk_decwcs returns the image MWCS descriptor mw if ccsystem is an image
+system, otherwise it returns NULL. The MWCS descriptor is used
+to convert from pixel coordinates to world coordinates and vice versa.
+The MWCS descriptor must be freed with a call to the MWCS routine
+mw_close before task termination.
+
+Sk_decwcs returns the sky descriptor coo. The sky coordinate descriptor
+is defined even if an error is detected in reading the image celestial
+coordinate system, and must be freed with a call to sk_close before
+task termination.
+
+.ih
+NOTES
+Type "help ccsystems" to see the list of the supported sky coordinate systems.
+
+Type "help mwcs$MWCS.hlp fi+" to find out more about the IRAF image world
+coordinate system library MWCS.
+
+
+SEE ALSO
+skdecwstr, skdecim
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skdecwstr.hlp b/pkg/xtools/skywcs/doc/skdecwstr.hlp
new file mode 100644
index 00000000..0edf7fa0
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skdecwstr.hlp
@@ -0,0 +1,46 @@
+.help skdecwstr Mar00 Skywcs
+.ih
+NAME
+skdecwstr -- open a sky coordinate descriptor using a system name
+.ih
+SYNOPSIS
+stat = sk_decwstr (csystem, coo, imcoo)
+
+.nf
+char	csystem		# the input celestial coordinate system name
+pointer	coo		# the output sky coordinate descriptor
+pointer	imcoo		# the input image sky coordinate descriptor 
+.fi
+.ih
+ARGUMENTS
+.ls  csystem 
+The sky coordinates definition. Ccsystem is a system name,  e.g. "J2000"
+or "galactic".
+.le
+.ls coo
+The output sky coordinate descriptor.
+.le
+.ls imcoo
+The parent image coordinate descriptor. Imcoo is set to NULL
+except in cases where the sky coordinate descriptor for an image is
+transformed and written back to the same image.
+.le
+.ih
+DESCRIPTION
+Sk_decwstr is an integer function which returns OK or ERR as its function
+value. ERR is returned if a valid sky coordinate system cannot be opened,
+OK otherwise.
+
+Sk_decwstr returns the sky descriptor coo. The sky coordinate descriptor
+is defined even if an error is detected in reading the image celestial
+coordinate system, and must be freed with a call to sk_close before
+task termination.
+
+.ih
+NOTES
+
+Type "help ccsystems" to get a list of the supported sky coordinate systems.
+
+SEE ALSO
+skdecwcs, skdecim, skcopy, skclose
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skenwcs.hlp b/pkg/xtools/skywcs/doc/skenwcs.hlp
new file mode 100644
index 00000000..cc388108
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skenwcs.hlp
@@ -0,0 +1,32 @@
+.help skenwcs Mar00 Skywcs
+.ih
+NAME
+skenwcs -- encode a system name using a sky coordinate descriptor
+.ih
+SYNOPSIS
+
+call sk_enwcs (coo, csystem, maxch)
+
+.nf
+pointer	coo		# the input sky coordinate descriptor
+char	csystem		# the output system name
+int	maxch		# the maximum size of the output system name
+.fi
+.ih
+ARGUMENTS
+.ls  coo    
+The input sky coordinate descriptor
+.le
+.ls csystem
+The output system name, e.g. "galactic".
+.le
+.ls maxch
+The maximum size of the output system name.
+.le
+.ih
+DESCRIPTION
+Sk_enwcs returns the sky coordinate system name.
+.ih
+SEE ALSO
+skdecwcs, skdecwstr
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skequatorial.hlp b/pkg/xtools/skywcs/doc/skequatorial.hlp
new file mode 100644
index 00000000..4500b881
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skequatorial.hlp
@@ -0,0 +1,58 @@
+.help skequatorial Mar00 Skywcs
+.ih
+NAME
+skequatorial -- apply pm and transform between equatorial coordinate systems
+.ih
+SYNOPSIS
+call sk_equatorial (incoo, outcoo, ilng, ilat, ipmlng, ipmlat, px, rv,
+	            olng, olat)
+
+.nf
+pointer	incoo		# the input sky coordinate descriptor
+pointer	outcoo		# the output sky coordinate descriptor
+double ilng, ilat	# the input sky coordinates in radians
+double ipmlng, ipmlat	# the input proper motions in radians  / year
+double	px		# the input parallax in arcsec
+double	rv		# the input radial velocity in km / sec (+ve receding)
+double olng, olat	# the output sky coordinates in radians
+.fi
+.ih
+ARGUMENTS
+.ls  incoo    
+The input sky coordinate descriptor.
+.le
+.ls  outcoo    
+The output sky coordinate descriptor.
+.le
+.ls ilng, ilat
+The input sky coordinates in radians.
+.le
+.ls ipmlng, ipmlat
+The input proper motions. If proper motions are unknown do not set ipmlng
+and ipmlat to 0.0, use sk_ultran instead. Note that the ra proper motion
+is in dra  not cos (dec) * dra units.
+.le
+.ls px
+The parallax in arcseconds. Use 0.0 if the proper motion is unknown unknown. 
+The parallax value is used only if proper motions are defined.
+.le
+.ls rv
+The radial velocity in km / sec. Use 0.0 if the radial velocity is unknown.
+The radial velocity value is used only if proper motions are defined.
+.le
+.ls olng, olat
+The output sky coordinates in radians.
+.le
+.ih
+DESCRIPTION
+The coordinates in the input sky coordinate system are converted to 
+coordinates in the output sky coordinate system.
+.ih
+NOTES
+If the proper motions are undefined use the routine sk_ultran. Zero valued
+proper motions are not the same as undefined proper motions.
+
+.ih
+SEE ALSO
+sk_lltran, sk_ultran
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skiiprint.hlp b/pkg/xtools/skywcs/doc/skiiprint.hlp
new file mode 100644
index 00000000..217819c2
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skiiprint.hlp
@@ -0,0 +1,39 @@
+.help skiiprint Mar00 Skywcs
+.ih
+NAME
+skiiprint -- print the sky coordinate system summary
+.ih
+SYNOPSIS
+
+call sk_iprint (label, imagesys, mw, coo)
+
+.nf
+char	label		# the input user label
+char	imagesys	# the input image system
+pointer	mw		# the input mwcs descriptor 
+pointer	coo		# the sky coordinate descriptor
+.fi
+.ih
+ARGUMENTS
+.ls label
+The input user supplied label, e.g. "Input System", "Ref System",
+"Output System" etc.
+.le
+.ls imagesys
+The input image system, e.g. "dev$ypix logical", "dev$ypix world", etc.
+.le
+.ls mwcs
+The input image mwcs descriptor if defined. If mwcs is defined then 
+information about which sky coordinate  corresponds to which image
+axis etc is read from the mwcs descriptor.
+.le
+.ls  coo    
+The input sky coordinate descriptor.
+.le
+.ih
+DESCRIPTION
+A summary of the sky coordinate system is printed on the standard output.
+.ih
+SEE ALSO
+skiiwrite
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skiiwrite.hlp b/pkg/xtools/skywcs/doc/skiiwrite.hlp
new file mode 100644
index 00000000..c82472f4
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skiiwrite.hlp
@@ -0,0 +1,43 @@
+.help skiiwrite Mar00 Skywcs
+.ih
+NAME
+skiiwrite -- write the sky coordinate system summary to a file
+.ih
+SYNOPSIS
+
+call sk_iiwrite (outfd, label, imagesys, mw, coo)
+
+.nf
+int	outfd		# the input file descriptor
+char	label		# the input user label
+char	imagesys	# the input image system
+pointer	mw		# the input mwcs descriptor
+pointer	coo		# the sky coordinate descriptor
+.fi
+.ih
+ARGUMENTS
+.ls outfd
+The input file descriptor.
+.le
+.ls label
+The input user supplied label, e.g. "Input System", "Ref System",
+"Output System" etc.
+.le
+.ls imagesys
+The input image system, e.g. "dev$ypix logical", "dev$ypix world", etc.
+.le
+.ls mwcs
+The input image mwcs descriptor if defined. If mwcs is defined then
+information about which sky coordinate  corresponds to which image
+axis etc is read from the mwcs descriptor.
+.le
+.ls  coo    
+The input sky coordinate descriptor.
+.le
+.ih
+DESCRIPTION
+A summary of the sky coordinate system is written to a file.
+.ih
+SEE ALSO
+skiiprint
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/sklltran.hlp b/pkg/xtools/skywcs/doc/sklltran.hlp
new file mode 100644
index 00000000..b45f3ea4
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/sklltran.hlp
@@ -0,0 +1,59 @@
+.help sklltran Mar00 Skywcs
+.ih
+NAME
+sklltran -- apply pm and transform between coordinate systems
+.ih
+SYNOPSIS
+call sk_lltran (incoo, outcoo, ilng, ilat, ipmlng, ipmlat, px, rv, olng, olat)
+
+.nf
+pointer	incoo		# the input sky coordinate descriptor
+pointer	outcoo		# the output sky coordinate descriptor
+double ilng, ilat	# the input sky coordinates in radians
+double ipmlng, ipmlat	# the input proper motions in radians  / year
+double	px		# the input parallax in arcsec
+double	rv		# the input radial velocity in km / sec (+ve receding)
+double olng, olat	# the output sky coordinates in radians
+.fi
+.ih
+ARGUMENTS
+.ls  incoo    
+The input sky coordinate descriptor.
+.le
+.ls  outcoo    
+The output sky coordinate descriptor.
+.le
+.ls ilng, ilat
+The input sky coordinates in radians.
+.le
+.ls ipmlng, ipmlat
+The input proper motions. For these to be applied the input coordinate
+system must be an equatorial coordinate system. If proper motions are
+unknown do not set ipmlng and ipmlat to 0.0, use sk_ultran instead. Note that
+the ra proper motion is in dra  not cos (dec) * dra units.
+.le
+.ls px
+The parallax in arcseconds. Use 0.0 if the proper motion is unknown unknown.
+The parallax value is used only if proper motions are defined.
+.le
+.ls rv
+The radial velocity in km / sec. Use 0.0 if the radial velocity is unknown.
+The radial velocity value is used only if proper motions are defined.
+.le
+.ls olng, olat
+The onput sky coordinates in radians.
+.le
+
+.ih
+DESCRIPTION
+The coordinates in the input sky coordinate system are converted to
+coordinates in the output sky coordinate system.
+.ih
+NOTES
+If the proper motions are undefined use the routine sk_ultran. Zero valued
+proper motions are not the same as undefined proper motions.
+
+.ih
+SEE ALSO
+sk_ultran, sk_equatorial
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/sksaveim.hlp b/pkg/xtools/skywcs/doc/sksaveim.hlp
new file mode 100644
index 00000000..82c16f3f
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/sksaveim.hlp
@@ -0,0 +1,39 @@
+.help sksaveim Mar00 Skywcs
+.ih
+NAME
+sksaveim -- update the image header using a sky coordinate descriptor
+.ih
+SYNOPSIS
+call sk_saveim (coo, mw, im)
+
+.nf
+pointer	coo		# the input sky coordinate descriptor
+pointer	mw		# the input mwcs descriptor
+pointer	im		# the input image descriptor
+.fi
+.ih
+ARGUMENTS
+.ls coo
+The input sky coordinate descriptor.
+.le
+.ls mw
+The IRAF mwcs descriptor.
+.le
+.ls  im
+The input image descriptor.
+.le
+.ih
+DESCRIPTION
+The image world coordinate system is updated using information in
+the sky coordinate descriptor and the mwcs descriptor.
+
+.ih
+NOTES
+Note that the sk_saveim call does not include a call to the MWCS mw_saveim
+routine. This call must be made separately.
+
+Type "help mwcs$MWCS.hlp fi+" to find out more about the IRAF image world
+coordinate system code.
+SEE ALSO
+skdecwcs, skdecim
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/sksetd.hlp b/pkg/xtools/skywcs/doc/sksetd.hlp
new file mode 100644
index 00000000..f518d71c
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/sksetd.hlp
@@ -0,0 +1,53 @@
+.help sksetd Mar00 Skywcs
+.ih
+NAME
+sksetd -- set a double sky coordinate descriptor parameter
+.ih
+SYNOPSIS
+include <skywcs.h>
+
+call sk_setd (coo, parameter, dval)
+
+.nf
+pointer	coo		# the input sky coordinate descriptor
+int	parameter	# the double parameter to be set
+double	dval		# the value of the parameter to be set
+.fi
+.ih
+ARGUMENTS
+.ls  coo    
+The sky coordinate descriptor.
+.le
+.ls parameter
+The parameter to be set. The double parameter definitions in skywcs.h are:
+.nf
+	S_VXOFF		# the logical ra / longitude offset in pixels
+	S_VYOFF		# the logical dec / latitude offset in pixels
+	S_VXSTEP	# the logical ra / longitude step size in pixels
+	S_VYSTEP	# the logical dec / latitude step size in pixels
+	S_EQUINOX	# the equinox in years
+	S_EPOCH		# the MJD of the observation 
+.fi
+.le
+.ls dval
+The value of the parameter to be set.
+.le
+.ih
+DESCRIPTION
+Sk_setd sets the values of double sky coordinate descriptor parameters.
+.ih
+NOTES
+The offsets and step sizes default to 0 and 1 for both axes. However
+if the sky coordinate descriptor was derived from an input image section, e.g.
+"dev$ypix[100:300,100:300]" these numbers may assume other values in some
+circumstances.
+
+The equinox and epoch of observation are normally set by the calling program
+when the sky coordinate descriptor is initialized, e.g. they default
+to 2000.0 and  51544.50000 if the input coordinate system was "fk5".
+
+In most cases these parameters should not be set by the user.
+.ih
+SEE ALSO
+skseti, sksets
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skseti.hlp b/pkg/xtools/skywcs/doc/skseti.hlp
new file mode 100644
index 00000000..b08be476
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skseti.hlp
@@ -0,0 +1,93 @@
+.help skseti Mar00 Skywcs
+.ih
+NAME
+skseti -- set an integer sky coordinate descriptor parameter
+.ih
+SYNOPSIS
+include <skywcs.h>
+
+call sk_seti (coo, parameter, ival)
+
+.nf
+pointer	coo		# the input sky coordinate descriptor
+int	parameter	# the integer parameter to be set
+int	ival		# the value of the parameter to be set
+.fi
+.ih
+ARGUMENTS
+.ls  coo    
+The sky coordinate descriptor.
+.le
+.ls parameter
+The parameter to be set. The double parameter definitions in skywcs.h are:
+.nf
+	S_CTYPE		# the celestial coordinate system type
+	S_RADECSYS	# the equatorial system type
+	S_NLNGUNITS	# the ra / longitude units
+	S_NLATUNITS	# the dec/ latitude units
+	S_WTYPE		# the projection type
+	S_PLNGAX	# the physical ra / longitude axis
+	S_PLATAX	# the physical dec / latitude axis
+	S_XLAX		# the logical ra / longitude axis
+	S_YLAX		# the logical dec / latitude axis
+	S_PIXTYPE	# the IRAF pixel coordinate system type
+	S_NLNGAX	# the length of ra / longitude axis
+	S_NLATAX	# the length of dec / latitude axis
+	S_STATUS	# the coordinate system status 
+.fi
+.le
+.ls ival
+The value of the parameter to be set.
+.le
+.ih
+DESCRIPTION
+Sk_seti sets the values of integer sky coordinate descriptor parameters.
+.ih
+NOTES
+Permitted values of S_CTYPE are CTYPE_EQUATORIAL, CTYPE_ECLIPTIC, 
+CTYPE_GALACTIC, and CTYPE_SUPERGALACTIC. The corresponding string dictionary
+is CTYPE_LIST.
+
+Permitted types of S_RADECSYS are EQTYPE_FK4, EQTYPE_FK4NOE,
+EQTYPE_FK5, EQTYPE, ICRS, and EQTYPE_GAPPT. The corresponding string
+dictionary is EQTYPE_LIST.
+
+Permitted values of S_WTYPE are WTYPE_LIN, WTYPE_AZP, WTYPE_TAN,  WTYPE_SIN,
+WTYPE_STG, WTYPE_ARC, WTYPE_ZPN, WTYPE_ZEA, WTYPE_AIR, WTYPE_CYP, WTYPE_CAR,
+WTYPE_MER, WTYPE_CEA, WTYPE_COP, WTYPE_COD, WTYPE_COE, WTYPE_COO, WTYPE_BON,
+WTYPE_PCO, WTYPE_GLS, WTYPE_PAR, WTYPE_AIT, WTYPE_MOL, WTYPE_CSC, WTYPE_QSC,
+WTYPE_TSC, WTYPE_TNX, WTYPE_ZPX. The corresponding string dictionary is
+WTYPE_LIST.
+
+Permitted values of S_PIXTYPE are  PIXTYPE_LOGICAL, PIXTYPE_TV,
+PIXTYPE_PHYSICAL.  and PIXTPE_WORLD. The corresponding string dictionary
+is PIXTYPE_LIST.
+
+Permitted values of S_NLNGUNITS are SKY_HOURS, SKY_DEGREES, and SKY_RADIANS.
+The corresponding string dictionary is SKY_LNG_UNITLIST.
+Permitted values of S_NLATUNITS are SKY_DEGREES, and SKY_RADIANS.
+The corresponding string dictionary is SKY_LAT_UNITLIST.
+
+The parameters S_CTYPE, S_RADECSYS, S_NLNGUNITS, and S_NLATUNITS are
+important for all sky coordinate descriptors regardless of the source.
+The parameters S_WTYPE, S_PLNGAX, S_PLATAX, S_XLAX, S_YLAX, S_PIXTYPE,
+S_NLNGAX, and S_NLATAX are only important for sky coordinate descriptors
+derived from an image sky coordinate systems. S_STATUS is OK if the sky
+coordinate descriptor describes a valid celestial coordinate system, ERR
+otherwise.
+
+In most cases these parameters should not be modified by the user. The
+major exceptions are the units parameters S_NLNGUNITS and N_LATUNITS
+which assumes default values fo hours and degrees for equatorial sky
+coordinate systems and degrees and degrees for other sky coordinate systems.
+If the user input and output units are different from the normal defaults
+then the units parameters should be set appropriately.
+
+Parameters that occasionally need to be reset when a coordinate system
+is created, edited, or saved to an image are S_WTYPE, S_PIXTYPE, S_PLNGAX,
+and S_PLATAX.
+
+.ih
+SEE ALSO
+sksetd, sksets
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/sksets.hlp b/pkg/xtools/skywcs/doc/sksets.hlp
new file mode 100644
index 00000000..8e4179b4
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/sksets.hlp
@@ -0,0 +1,36 @@
+.help sksets Mar00 Skywcs
+.ih
+NAME
+sksets -- set a string sky coordinate descriptor parameter
+.ih
+SYNOPSIS
+include <skywcs.h>
+
+call sk_sets (coo, parameter, str)
+
+.nf
+pointer	coo		# the input sky coordinate descriptor
+int	parameter	# the string parameter to be set
+char	str		# the value of the string parameter to be set
+.fi
+.ih
+ARGUMENTS
+.ls  coo    
+The sky coordinate descriptor.
+.le
+.ls parameter
+The parameter to be set. The string parameter definitions in skywcs.h are:
+.nf
+	S_COOSYSTEM	# the celestial coordinate system name
+.fi
+.le
+.ls str
+The value of the parameter to be set.
+.le
+.ih
+DESCRIPTION
+Sk_sets sets the values of string sky coordinate descriptor parameters. 
+.ih
+SEE ALSO
+sksetd, skseti
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skstatd.hlp b/pkg/xtools/skywcs/doc/skstatd.hlp
new file mode 100644
index 00000000..52dc0c70
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skstatd.hlp
@@ -0,0 +1,49 @@
+.help skstatd Mar00 Skywcs
+.ih
+NAME
+skstatd -- get a double sky coordinate descriptor parameter
+.ih
+SYNOPSIS
+include <skywcs.h>
+
+dval = sk_statd (coo, parameter)
+
+.nf
+pointer	coo		# the input sky coordinate descriptor
+int	parameter	# the double parameter to be returned
+.fi
+.ih
+ARGUMENTS
+.ls  coo    
+The sky coordinate descriptor.
+.le
+.ls parameter
+The oarameter to be returned. The double parameter definitions in skywcs.h are:
+.nf
+	S_VXOFF		# the logical ra / longitude offset in pixels
+	S_VYOFF		# the logical dec / latitude offset in pixels
+	S_VXSTEP	# the logical ra / longitude step size in pixels
+	S_VYSTEP	# the logical dec / latitude step size in pixels
+	S_EQUINOX	# the equinox in years
+	S_EPOCH		# the MJD of the observation
+.fi
+.le
+.ih
+DESCRIPTION
+Sk_statd returns the values of double sky coordinate descriptor parameters.
+
+.ih
+NOTES
+The offsets and step sizes default to 0 and 1 for both axes. However
+if the sky coordinate descriptor was derived from an input image section, e.g.
+"dev$ypix[100:300,100:300]" these numbers may assume other values in some
+circumstances.
+
+The equinox and epoch of observation are normally set by the calling program
+when the sky coordinate descriptor is initialized, e.g. they default
+to 2000.0 and  51544.50000 if the input coordinate system was "fk5".
+
+.ih
+SEE ALSO
+skstati, skstats
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skstati.hlp b/pkg/xtools/skywcs/doc/skstati.hlp
new file mode 100644
index 00000000..90d33eb1
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skstati.hlp
@@ -0,0 +1,79 @@
+.help skstati Mar00 Skywcs
+.ih
+NAME
+skstati -- get an integer sky coordinate descriptor parameter
+.ih
+SYNOPSIS
+include <skywcs.h>
+
+ival = sk_stati (coo, parameter)
+
+.nf
+pointer	coo		# the input sky coordinate descriptor
+int	parameter	# the integer parameter to be returned
+.fi
+.ih
+ARGUMENTS
+.ls  coo    
+The sky coordinate descriptor.
+.le
+.ls parameter
+Parameter to be returned. The integer parameter definitions in skywcs.h are:
+.nf
+	S_CTYPE		# the celestial coordinate system type
+	S_RADECSYS	# the equatorial system type
+	S_NLNGUNITS	# the ra / longitude units
+	S_NLATUNITS	# the dec/ latitude units
+	S_WTYPE		# the projection type
+	S_PLNGAX	# the physical ra / longitude axis
+	S_PLATAX	# the physical dec / latitude axis
+	S_XLAX		# the logical ra / longitude axis
+	S_YLAX		# the logical dec / latitude axis
+	S_PIXTYPE	# the IRAF pixel coordinate system type
+	S_NLNGAX	# the length of the ra / longitude axis
+	S_NLATAX	# the length of the dec / latitude axis
+	S_STATUS	# the coordinate system status 
+.fi
+.le
+.ih
+DESCRIPTION
+Sk_stati returns the values of integer sky coordinate descriptor parameters.
+
+.ih
+NOTES
+Permitted values of S_CTYPE are CTYPE_EQUATORIAL, CTYPE_ECLIPTIC, 
+CTYPE_GALACTIC, and CTYPE_SUPERGALACTIC. The corresponding string dictionary
+is CTYPE_LIST.
+
+Permitted types of S_RADECSYS are EQTYPE_FK4, EQTYPE_FK4NOE,
+EQTYPE_FK5, EQTYPE, ICRS, and EQTYPE_GAPPT. The corresponding string
+dictionary is EQTYPE_LIST.
+
+Permitted values of S_WTYPE are WTYPE_LIN, WTYPE_AZP, WTYPE_TAN,  WTYPE_SIN,
+WTYPE_STG, WTYPE_ARC, WTYPE_ZPN, WTYPE_ZEA, WTYPE_AIR, WTYPE_CYP, WTYPE_CAR,
+WTYPE_MER, WTYPE_CEA, WTYPE_COP, WTYPE_COD, WTYPE_COE, WTYPE_COO, WTYPE_BON,
+WTYPE_PCO, WTYPE_GLS, WTYPE_PAR, WTYPE_AIT, WTYPE_MOL, WTYPE_CSC, WTYPE_QSC,
+WTYPE_TSC, WTYPE_TNX, WTYPE_ZPX. The corresponding string dictionary is
+WTYPE_LIST.
+
+Permitted values of S_PIXTYPE are  PIXTYPE_LOGICAL, PIXTYPE_TV,
+PIXTYPE_PHYSICAL.  and PIXTPE_WORLD. The corresponding string dictionary
+is PIXTYPE_LIST.
+
+Permitted values of S_NLNGUNITS are SKY_HOURS, SKY_DEGREES, and SKY_RADIANS.
+The corresponding string dictionary is SKY_LNG_UNITLIST.
+Permitted values of S_NLATUNITS are SKY_DEGREES, and SKY_RADIANS.
+The corresponding string dictionary is SKY_LAT_UNITLIST.
+
+The parameters S_CTYPE, S_RADECSYS, S_NLNGUNITS, and S_NLATUNITS are
+important for all sky coordinate descriptors regardless of the source.
+The parameters S_WTYPE, S_PLNGAX, S_PLATAX, S_XLAX, S_YLAX, S_PIXTYPE,
+S_NLNGAX, and S_NLATAX are only important for sky coordinate descriptors
+derived from an image sky coordinate systems. S_STATUS is OK if the sky
+coordinate descriptor describes a valid celestial coordinate system, ERR
+otherwise.
+
+.ih
+SEE ALSO
+skstatd, skstats
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skstats.hlp b/pkg/xtools/skywcs/doc/skstats.hlp
new file mode 100644
index 00000000..483ed3e5
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skstats.hlp
@@ -0,0 +1,40 @@
+.help skstats Mar00 Skywcs
+.ih
+NAME
+skstats -- get a string sky coordinate descriptor parameter
+.ih
+SYNOPSIS
+include <skywcs.h>
+
+call sk_stats (coo, parameter, str, maxch)
+
+.nf
+pointer	coo		# the input sky coordinate descriptor
+int	parameter	# the string parameter to be returned
+char	str		# the returned string parameter value
+int	maxch		# the maximum size of the returned string parameter
+.fi
+.ih
+ARGUMENTS
+.ls  coo    
+The sky coordinate descriptor.
+.le
+.ls parameter
+The parameter to be returned. The string parameter definitions in skywcs.h are:
+.nf
+	S_COOSYSTEM	# the celestial coordinate system name
+.fi
+.le
+.ls str
+The value of the returned string.
+.le
+.ls maxch
+The maximum size of the returned string.
+.le
+.ih
+DESCRIPTION
+Sk_stats returns the values of string sky coordinate descriptor parameters.
+.ih
+SEE ALSO
+skstati, skstatd
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skultran.hlp b/pkg/xtools/skywcs/doc/skultran.hlp
new file mode 100644
index 00000000..ca02385e
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skultran.hlp
@@ -0,0 +1,50 @@
+.help skultran Mar00 Skywcs
+.ih
+NAME
+skultran -- transform between coordinate systems
+.ih
+SYNOPSIS
+call sk_ultran (incoo, outcoo, ilng, ilat, olng, olat, npts)
+
+.nf
+pointer	incoo		# the input sky coordinate descriptor
+pointer	outcoo		# the output sky coordinate descriptor
+double ilng, ilat	# the input celestial coordinates in expected units
+double olng, olat	# the output celestial coordinates in expected units
+int	npts		# the number of input and output coordinate pairs
+.fi
+.ih
+ARGUMENTS
+.ls  incoo    
+The input sky coordinate descriptor.
+.le
+.ls  outcoo    
+The output sky coordinate descriptor.
+.le
+.ls ilng, ilat
+The input sky coordinates in the units defined by the integer parameters
+S_NLNGUNITS and S_NLATUNITS.
+.le
+.ls olng, olat
+The output sky coordinates in the units defined by the integer parameters
+S_NLNGUNITS and S_NLATUNITS.
+.le
+.ls npts
+The number of input and output coordinate pairs.
+.le
+.ih
+DESCRIPTION
+The coordinates in the input coordinate system are converted to 
+coordinates in the output coordinates system.
+
+If the calling program has not set the S_NLNGUNITS and S_NLATUNITS parameters
+in either system the expected coordinates are hours and degrees for
+equatorial sky coordinate systems and degrees and degrees for other sky
+coordinate systems. The calling program must either perform the necessary
+coordinate conversions or set the units parameters in the input and output
+sky coordinate descriptors appropriately.
+
+.ih
+SEE ALSO
+sk_lltran, sk_equatorial
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skywcs.hd b/pkg/xtools/skywcs/doc/skywcs.hd
new file mode 100644
index 00000000..74bac140
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skywcs.hd
@@ -0,0 +1,25 @@
+# Help directory for the SKYWCS library
+
+$doc		= "./"
+$source		= "../"
+
+skdecwcs	hlp=doc$skdecwcs.hlp,		src=source$skdecode.x
+skdecwstr	hlp=doc$skdecwstr.hlp,		src=source$skdecode.x
+skdecim		hlp=doc$skdecim.hlp,		src=source$skdecode.x
+skenwcs		hlp=doc$skenwcs.hlp,		src=source$skdecode.x
+skcopy		hlp=doc$skcopy.hlp,		src=source$skdecode.x
+skiiprint	hlp=doc$skiiprint.hlp,		src=source$skwrite.x
+skiiwrite	hlp=doc$skiiwrite.hlp,		src=source$skwrite.x
+skstati		hlp=doc$skstati.hlp,		src=source$skstat.x
+skstatd		hlp=doc$skstatd.hlp,		src=source$skstat.x
+skstats		hlp=doc$skstats.hlp,		src=source$skstat.x
+skseti		hlp=doc$skseti.hlp,		src=source$skset.x
+sksetd		hlp=doc$sksetd.hlp,		src=source$skset.x
+sksets		hlp=doc$sksets.hlp,		src=source$skset.x
+skultran	hlp=doc$skultran.hlp,		src=source$skytransform.x
+sklltran	hlp=doc$sklltran.hlp,		src=source$skytransform.x
+skequatorial	hlp=doc$skequatorial.hlp,	src=source$skytransform.x
+sksaveim	hlp=doc$sksaveim.hlp,		src=source$sksaveim.x
+skclose		hlp=doc$skclose.hlp,		src=source$skdecode.x
+
+ccsystems	hlp=doc$ccsystems.hlp
diff --git a/pkg/xtools/skywcs/doc/skywcs.hlp b/pkg/xtools/skywcs/doc/skywcs.hlp
new file mode 100644
index 00000000..d02f4d2f
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skywcs.hlp
@@ -0,0 +1,306 @@
+.help skywcs Oct00 xtools
+.ih
+NAME
+skywcs -- sky coordinates package
+.ih
+SYNOPSIS
+
+.nf
+   stat = sk_decwcs (ccsystem, mw, coo, imcoo)
+   stat = sk_decwstr (ccsystem, coo, imcoo)
+   stat = sk_decim (im, wcs, mw, coo)
+	  sk_enwcs (coo, ccsystem, maxch)
+ newcoo = sk_copy (coo)
+          sk_iiprint (label, imagesys, mw, coo) 
+          sk_iiwrite (fd, label, imagesys, mw, coo) 
+[id]val = sk_stat[id] (coo, param)
+          sk_stats (coo, param, str, maxch)
+	  sk_set[id] (coo, param, [id]val)
+          sk_sets (coo, param, str)
+	  sk_ultran (incoo, outcoo, ilng, ilat, olng, olat, npts)
+	  sk_lltran (incoo, outoo, ilng, ilat, ipmlng, ipmlat, px, rv,
+             olng, olat)
+	  sk_equatorial (incoo, outcoo, ilng, ilat, ipmlng, ipmlat, px,
+	     rv, olng, olat)
+	  sk_saveim (coo, mw, im)
+	  sk_close (coo)
+
+.fi
+.ih
+DESCRIPTION
+
+The skywcs package contains a simple set of routines for managing
+sky coordinate information and for transforming from one sky coordinate
+system to another. The sky coordinate system is defined either by a system
+name, e.g. "J2000", "galactic", etc. or by an image system name, e.g.
+"dev$ypix" or "dev$ypix world".
+
+The skywcs routine are layered on the Starlink Positional Astronomy library
+SLALIB which is installed in the IRAF MATH package.  Type "help slalib
+option=sys" for more information about SLALIB.
+
+
+.ih
+NOTES
+
+An "include <skywcs.h>" statement must be included in the calling program
+to make the skywcs package parameter definitions visible to the calling
+program.
+
+The sky coordinate descriptor is created with a call to one of the sk_decwcs
+sk_decwstr or sk_imwcs routines. If the source of sky coordinate descriptor
+is an image then an IRAF MWCS descriptor will be returned with the sky 
+oordinate descriptor. The sky coordinate descriptor is freed with a
+call to sk_close. A separate call to mw_close must be made to free the
+MWCS descriptor if one was allocated.
+
+By default the main skywcs coordinate transformation routine sk_ultran
+assumes that the input and output sky coordinates are in hours and degrees
+if the input and output coordinate systems are equatorial, otherwise the
+coordinates are assumed to be in degrees and degrees. The default input and
+output sky coordinate units can be reset with calls to sk_seti. Two lower level
+coordinate transformations for handling proper motions sk_lltran and
+sk_equatorial are also available. These routines expect the input and output
+coordinates and proper motions to be in radians.
+
+Calling programs working with both sky coordinate and MWCS descriptors
+need to be aware that the MWCS routines assume that all sky coordinates
+must be input in degrees and will be output in degrees and adjust their
+code accordingly.
+
+The skywcs routine sk_saveim can be used to update an image header.
+
+
+.ih
+EXAMPLES
+.nf
+Example 1: Convert from B1950 coordinates to J2000 coordinates.
+
+    include <skywcs.h>
+
+    ....
+
+    # Open input coordinate system.
+    instat = sk_decwstr ("B1950", incoo, NULL)
+    if (instat == ERR) {
+	call sk_close (incoo)
+	return
+    }
+
+    # Open output coordinate system.
+    outstat = sk_decwstr ("J2000", outcoo, NULL)
+    if (outstat == ERR) {
+	call sk_close (outcoo)
+	return
+    }
+
+    # Do the transformation assuming the input coordinates are in hours
+    # and degrees. The output coordinates will be in hours and degrees
+    # as well.
+    call sk_ultran (incoo, outcoo, rain, decin, raout, decout, npts) 
+
+    # Close the coordinate descriptors.
+    call sk_close (incoo)
+    call sk_close (outcoo)
+
+    ...
+
+
+Example 2: Repeat example 1 but convert to galactic coordinates.
+
+    include <skywcs.h>
+
+    ....
+
+    # Open the input coordinate system.
+    instat = sk_decwstr ("B1950", incoo, NULL)
+    if (instat == ERR) {
+	call sk_close (incoo)
+	return
+    }
+
+    # Open the output coordinate system.
+    outstat = sk_decwstr ("galactic", outcoo, NULL)
+    if (outstat == ERR) {
+	call sk_close (outcoo)
+	return
+    }
+
+    # Do the transformation assuming the input coordinates are in hours and
+    # degrees. The output coordinates will be in degrees and degrees.
+    call sk_ultran (incoo, outcoo, rain, decin, raout, decout, npts) 
+
+    # Close the coordinate descriptors.
+    call sk_close (incoo)
+    call sk_close (outcoo)
+
+    ...
+
+Example 3: Convert a grid of pixel coordinates in the input image to the
+	   equivalent pixel coordinate in the output image using the
+	   image world coordinate systems to connect the two.
+
+    include <skywcs.h>
+
+    ....
+
+    # Mwref will be defined because the input system is an image.
+    refstat = sk_decwcs ("refimage logical", mwref, refcoo, NULL)
+    if (refstat == ERR || mwref == NULL) {
+	if (mwref != NULL)
+	    call mw_close (mwref)
+	call sk_close (refcoo)
+	return
+    }
+
+    # Set the reference coordinate descriptor so it expects input in degrees
+    # and degrees.
+    call sk_seti (refcoo, S_NLNGUNUTS, SKY_DEGREES)
+    call sk_seti (refcoo, S_NLATUNUTS, SKY_DEGREES)
+
+    # Mwout will be defined because the output system is an image.
+    outstat = sk_decwcs ("image logical", mwout, outcoo, NULL)
+    if (outstat == ERR || mwout == NULL) {
+	if (mwout != NULL)
+	    call mw_close (mwout)
+	call sk_close (outcoo)
+	call mw_close (mwref)
+	call sk_close (refcoo)
+	return
+    }
+
+    # Set the output coordinate descriptor so it will output coordinates
+    # in degrees and degrees.
+    call sk_seti (outcoo, S_NLNGUNUTS, SKY_DEGREES)
+    call sk_seti (outcoo, S_NLATUNUTS, SKY_DEGREES)
+
+    # Compute pixel grid in refimage and store coordinate in the arrays
+    # xref and yref.
+    npts = 0
+    do j = 1, IM_LEN(im,2), 100 {
+        do i = 1, IM_LEN(im,1), 100 {
+	    npts = npts + 1
+	    xref[npts] = i
+	    yref[npts] = j
+	}
+    }
+
+    # Convert xref and yref to celestial coordinates raref and decref using
+    # mwref. The output coordinates will be in degrees and degrees.
+    ctref = mw_sctran (mwref, "logical", "world", 03B)
+    do i = 1, npts
+	call mw_c2trand (ctref, xref[i], yref[i], raref[i], decref[i])
+    call ct_free (ctref)
+
+    # Convert the reference celestial coordinates to the output celestial
+    # coordinate system using the coordinate descriptors.
+    call sk_ultran (refcoo, outcoo, raref, decref, raout, decout, npts)
+
+    # Convert the output celestial coordinates to  pixel coordinates in
+    # the other image using mwout.
+    ctout = mw_sctran (mwout, "world", "logical", 03B)
+    do i = 1, npts
+	call mw_c2trand (ctout, raout[i], decout[i], xout[i], yout[i])
+    call ct_free (ctout)
+
+    # Print the input and output pixel coordinates.
+    do i = 1, npts {
+	call printf ("%10.3f %10.3f  %10.3f %10.3f\n")
+	    call pargd (xref[i])
+	    call pargd (yref[i])
+	    call pargd (xout[i])
+	    call pargd (yout[i])
+    }
+
+    # Tidy up.
+    call mw_close (mwref)
+    call mw_close (mwout)
+    call sk_close (refcoo)
+    call sk_close (outcoo)
+
+
+Example 4: Convert a 2D image with an J2000 tangent plane projection
+	   wcs to the equivalent galactic wcs. The transformation
+	   requires a shift in origin and a rotation. Assume that the ra
+	   axis is 1 and the dec axis is 2. The details of how to compute
+	   the rotation are not shown here. See the imcctran task for details.
+
+    include <mwset.h> 
+    include <skywcs.h>
+
+    ...
+
+    # Open image.
+    im = immap (image, READ_WRITE, 0)
+
+    # Open the image coordinate system.
+    instat = sk_decim (im, "logical", mwin, cooin)
+    if (instat == ERR || mwin == NULL) {
+	...
+	call sk_close (cooin)
+	...
+    }
+
+    # Get the dimensions of the mwcs descriptor. This should be 2.
+    ndim = mw_ndim (mwin, MW_NPHYSDIM)
+
+    # Get the default coordinates to degrees and degreees.
+    call sk_seti (cooin, S_NLNGUNITS, SKY_DEGREES)
+    call sk_seti (cooin, S_NATGUNITS, SKY_DEGREES)
+
+    # Open the output coordinate system. Mwout is NULL because this system
+    # is not an image.
+    outstat = sk_decwstr ("galactic", mwout, cooout, cooin)
+    if (outstat == ERR) {
+        ...
+	call sk_close (outstat)
+	...
+    }
+
+    # Make a copy of the mwcs descriptor.
+    mwout = mw_newcopy (mwin)
+
+    # Allocate space for the r and w vectors and cd matrix.
+    call malloc (r, ndim, TY_DOUBLE)
+    call malloc (w, ndim, TY_DOUBLE)
+    call malloc (cd, ndim * ndim, TY_DOUBLE)
+    call malloc (newcd, ndim * ndim, TY_DOUBLE)
+
+    # Assume for simplicty that the MWCS LTERM is the identify transform.
+    # so we don't have to worry about it. Get the WTERM which consists
+    # of r the reference point in pixels, w the reference point in degrees,
+    # and the cd matrix in degrees per pixel.
+    call mw_gwtermd (mwin, Memd[r], Memd[w], Memd[cd], ndim)
+
+    # Convert the world coordinates zero point. The pixel zero point
+    # remains the same.
+    tilng = Memd[w]
+    tilat = Memd[w+1]
+    call sk_ultran (incoo, outcoo, tilng, tilat, tolng, tolat, 1)
+    Memd[w] = tolng
+    Memd[w+1] = tolat
+
+    # Figure out how much to rotate the coordinate system and edit the
+    # compute a new CD matrix. Call it newcd.
+    ...
+
+    # Enter the new CD matrix and zero point.
+    call mw_swterm (mwout, Memd[r], Memd[w], Memd[newcd], ndim)
+
+    # Update the header. 
+    call sk_saveim (cooout, mwout, im)
+    call mw_saveim (mwout, im)
+    ...
+
+    # Tidy up.
+    call mfree (r, TY_DOUBLE)
+    call mfree (w, TY_DOUBLE)
+    call mfree (cd, TY_DOUBLE)
+    call mfree (newcd, TY_DOUBLE)
+    call mw_close (mwin)
+    call mw_close (mwout)
+    call sk_close (cooin)
+    call sk_close (cooout)
+    call imunmap (im)
+.fi
+.endhelp
diff --git a/pkg/xtools/skywcs/doc/skywcs.men b/pkg/xtools/skywcs/doc/skywcs.men
new file mode 100644
index 00000000..7502bcd0
--- /dev/null
+++ b/pkg/xtools/skywcs/doc/skywcs.men
@@ -0,0 +1,15 @@
+    skdecwcs - Open a sky coordinate descriptor using an image or system name
+   skdecwstr - Open a sky coordinate descriptor using a system name
+     skdecim - Open a sky coordinate descriptor using an image descriptor
+     skenwcs - Encode a system name using a sky coordinate descriptor
+      skcopy - Copy a sky coordinate descriptor
+ skstat[ids] - Get a sky coordinate descriptor parameter value
+  skset[ids] - Set a sky coordinate descriptor parameter value
+   skiiprint - Print a sky coordinate descriptor summary
+   skiiwrite - Write a sky coordinate descriptor summary
+    skultran - Transform between coordinate systems
+    sklltran - Apply pm and transform between coordinates systems 
+skequatorial - Apply pm and transform between equatorial coordinate systems
+    sksaveim - Update image header using sky coordinate descriptor
+     skclose - Close the sky coordinate descriptor
+   ccsystems - Describe the supported celestial coordinate systems
diff --git a/pkg/xtools/skywcs/mkpkg b/pkg/xtools/skywcs/mkpkg
new file mode 100644
index 00000000..9a46ce5a
--- /dev/null
+++ b/pkg/xtools/skywcs/mkpkg
@@ -0,0 +1,16 @@
+# Libary for the celestial coordinate sytem pacakge
+
+$checkout libxtools.a lib$
+$update   libxtools.a
+$checkin  libxtools.a lib$
+$exit
+
+libxtools.a:
+	skdecode.x	<imio.h> <imhdr.h> <mwset.h> "skywcsdef.h" "skywcs.h"
+	skwrite.x	"skywcsdef.h" "skywcs.h"
+	skstat.x	"skywcsdef.h" "skywcs.h"
+	skset.x		"skywcsdef.h" "skywcs.h"
+	sktransform.x	<math.h> "skywcsdef.h" "skywcs.h"
+	sksaveim.x	"skywcsdef.h" "skywcs.h"
+	skwrdstr.x
+	;
diff --git a/pkg/xtools/skywcs/skdecode.x b/pkg/xtools/skywcs/skdecode.x
new file mode 100644
index 00000000..5fa88f3b
--- /dev/null
+++ b/pkg/xtools/skywcs/skdecode.x
@@ -0,0 +1,999 @@
+include <imio.h>
+include <imhdr.h>
+include <mwset.h>
+include "skywcs.h"
+include "skywcsdef.h"
+
+# SK_DECWCS -- Decode the wcs string which may be either an image name
+# plus wcs, e.g. "dev$pix logical" or a string describing the celestial
+# coordinate system, e.g. "J2000" or "galactic" into a celestial coordinate
+# structure. If the input wcs is an image wcs then a non-NULL pointer to
+# the image wcs structure is also returned. ERR is returned if a valid
+# celestial coordinate structure cannot be created.
+
+int procedure sk_decwcs (instr, mw, coo, imcoo)
+
+char	instr[ARB]		#I the input wcs string
+pointer	mw			#O the pointer to the image wcs structure
+pointer	coo			#O the pointer to the coordinate structure
+pointer	imcoo			#I pointer to an existing coordinate structure 
+
+int	stat
+pointer	sp, str1, str2, laxno, paxval, im
+int	sk_strwcs(), sk_decim()
+pointer	immap()
+errchk	immap()
+
+begin
+	call calloc (coo, LEN_SKYCOOSTRUCT, TY_STRUCT)
+	call strcpy (instr, SKY_COOSYSTEM(coo), SZ_FNAME)
+
+	# Allocate some working space.
+	call smark (sp)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+	call salloc (laxno, IM_MAXDIM, TY_INT)
+	call salloc (paxval, IM_MAXDIM, TY_INT)
+
+	# Decode the wcs.
+	call sscan (instr)
+	    call gargwrd (Memc[str1], SZ_LINE)
+	    call gargwrd (Memc[str2], SZ_LINE)
+
+	# First try to open an image wcs.
+	iferr {
+	    im = immap (Memc[str1], READ_ONLY, 0)
+
+	# Decode the user wcs.
+	} then {
+
+	    # Initialize.
+	    mw = NULL
+	    if (imcoo == NULL) {
+	        SKY_NLNGAX(coo) = 2048
+	        SKY_NLATAX(coo) = 2048
+	        SKY_PLNGAX(coo) = 1
+	        SKY_PLATAX(coo) = 2
+	        SKY_XLAX(coo) = 1
+	        SKY_YLAX(coo) = 2
+	        SKY_VXOFF(coo) = 0.0d0
+	        SKY_VYOFF(coo) = 0.0d0
+	        SKY_VXSTEP(coo) = 1.0d0
+	        SKY_VYSTEP(coo) = 1.0d0
+	        SKY_WTYPE(coo) = 0
+	    } else {
+	        SKY_NLNGAX(coo) = SKY_NLNGAX(imcoo)
+	        SKY_NLATAX(coo) = SKY_NLATAX(imcoo)
+	        SKY_PLNGAX(coo) = SKY_PLNGAX(imcoo)
+	        SKY_PLATAX(coo) = SKY_PLATAX(imcoo)
+	        SKY_XLAX(coo) = SKY_XLAX(imcoo)
+	        SKY_YLAX(coo) = SKY_YLAX(imcoo)
+	        SKY_VXOFF(coo) = SKY_VXOFF(imcoo)
+	        SKY_VYOFF(coo) = SKY_VYOFF(imcoo)
+	        SKY_VXSTEP(coo) = SKY_VXSTEP(imcoo)
+	        SKY_VYSTEP(coo) = SKY_VYSTEP(imcoo)
+	        SKY_WTYPE(coo) = SKY_WTYPE(imcoo)
+	    }
+	    SKY_PIXTYPE(coo) = PIXTYPE_WORLD
+
+	    # Decode the actual wcs.
+	    stat = sk_strwcs (instr, SKY_CTYPE(coo), SKY_RADECSYS(coo),
+	        SKY_EQUINOX(coo), SKY_EPOCH(coo))
+	    switch (SKY_CTYPE(coo)) {
+	    case CTYPE_EQUATORIAL:
+		SKY_NLNGUNITS(coo) = SKY_HOURS
+		SKY_NLATUNITS(coo) = SKY_DEGREES
+	    default:
+		SKY_NLNGUNITS(coo) = SKY_DEGREES
+		SKY_NLATUNITS(coo) = SKY_DEGREES
+	    }
+
+	# Decode the image wcs.
+	} else {
+	    stat = sk_decim (im, Memc[str2], mw, coo)
+	    call imunmap (im)
+	}
+
+	call sfree (sp)
+
+	SKY_STATUS(coo) = stat
+	return (stat)
+end
+
+
+# SK_DECWSTR -- Decode the wcs string coordinate system, e.g. "J2000" or
+# "galactic" into a celestial coordinate structure. ERR is returned if a
+# valid celestial coordinate structure cannot be created.
+
+int procedure sk_decwstr (instr, coo, imcoo)
+
+char	instr[ARB]		#I the input wcs string
+pointer	coo			#O the pointer to the coordinate structure
+pointer	imcoo			#I pointer to an existing coordinate structure 
+
+int	stat
+int	sk_strwcs()
+
+begin
+	call calloc (coo, LEN_SKYCOOSTRUCT, TY_STRUCT)
+	call strcpy (instr, SKY_COOSYSTEM(coo), SZ_FNAME)
+
+	# Initialize.
+	if (imcoo == NULL) {
+	    SKY_NLNGAX(coo) = 2048
+	    SKY_NLATAX(coo) = 2048
+	    SKY_PLNGAX(coo) = 1
+	    SKY_PLATAX(coo) = 2
+	    SKY_XLAX(coo) = 1
+	    SKY_YLAX(coo) = 2
+	    SKY_VXOFF(coo) = 0.0d0
+	    SKY_VYOFF(coo) = 0.0d0
+	    SKY_VXSTEP(coo) = 1.0d0
+	    SKY_VYSTEP(coo) = 1.0d0
+	    SKY_WTYPE(coo) = 0
+	} else {
+	    SKY_NLNGAX(coo) = SKY_NLNGAX(imcoo)
+	    SKY_NLATAX(coo) = SKY_NLATAX(imcoo)
+	    SKY_PLNGAX(coo) = SKY_PLNGAX(imcoo)
+	    SKY_PLATAX(coo) = SKY_PLATAX(imcoo)
+	    SKY_XLAX(coo) = SKY_XLAX(imcoo)
+	    SKY_YLAX(coo) = SKY_YLAX(imcoo)
+	    SKY_VXOFF(coo) = SKY_VXOFF(imcoo)
+	    SKY_VYOFF(coo) = SKY_VYOFF(imcoo)
+	    SKY_VXSTEP(coo) = SKY_VXSTEP(imcoo)
+	    SKY_VYSTEP(coo) = SKY_VYSTEP(imcoo)
+	    SKY_WTYPE(coo) = SKY_WTYPE(imcoo)
+	}
+	SKY_PIXTYPE(coo) = PIXTYPE_WORLD
+
+	# Decode the actual wcs.
+	stat = sk_strwcs (instr, SKY_CTYPE(coo), SKY_RADECSYS(coo),
+            SKY_EQUINOX(coo), SKY_EPOCH(coo))
+	switch (SKY_CTYPE(coo)) {
+	case CTYPE_EQUATORIAL:
+	    SKY_NLNGUNITS(coo) = SKY_HOURS
+	    SKY_NLATUNITS(coo) = SKY_DEGREES
+	default:
+	    SKY_NLNGUNITS(coo) = SKY_DEGREES
+	    SKY_NLATUNITS(coo) = SKY_DEGREES
+	}
+
+	SKY_STATUS(coo) = stat
+
+	return (stat)
+end
+
+
+# SK_DECIM -- Given an image descriptor and an image wcs string create a
+# celstial coordinate structure. A non-NULL pointer to the image wcs structure
+# is also returned. ERR is returned if a valid  celestial coordinate descriptor
+# cannot be created.
+
+
+int procedure sk_decim (im, wcs, mw, coo)
+
+pointer	im			#I the pointer to the input image
+char	wcs[ARB]		#I the wcs string [logical|tv|physical|world]
+pointer	mw			#O the pointer to the image wcs structure
+pointer	coo			#O the pointer to the coordinate structure
+
+int	stat
+pointer	sp, str1, laxno, paxval
+int	sk_imwcs(), strdic(), mw_stati()
+pointer	mw_openim()
+errchk	mw_openim()
+
+begin
+	call malloc (coo, LEN_SKYCOOSTRUCT, TY_STRUCT)
+	call sprintf (SKY_COOSYSTEM(coo), SZ_FNAME, "%s %s")
+	    call pargstr (IM_HDRFILE(im))
+	    call pargstr (wcs)
+
+	call smark (sp)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (laxno, IM_MAXDIM, TY_INT)
+	call salloc (paxval, IM_MAXDIM, TY_INT)
+
+	# Try to open the image wcs.
+	iferr {
+	    mw = mw_openim (im)
+
+	# Set up a dummy wcs.
+	} then {
+
+	    #Initialize.
+	    SKY_CTYPE(coo) = 0
+	    SKY_RADECSYS(coo) = 0
+	    SKY_EQUINOX(coo) = INDEFD
+	    SKY_EPOCH(coo) = INDEFD
+	    mw = NULL
+	    SKY_PLNGAX(coo) = 1
+	    SKY_PLATAX(coo) = 2
+	    SKY_XLAX(coo) = 1
+	    SKY_YLAX(coo) = 2
+	    SKY_NLNGAX(coo) = 2048
+	    SKY_NLATAX(coo) = 2048
+	    SKY_VXOFF(coo) = 0.0d0
+	    SKY_VYOFF(coo) = 0.0d0
+	    SKY_VXSTEP(coo) = 1.0d0
+	    SKY_VYSTEP(coo) = 1.0d0
+	    SKY_WTYPE(coo) = 0
+	    SKY_PIXTYPE(coo) = PIXTYPE_LOGICAL
+	    SKY_NLNGUNITS(coo) = SKY_DEGREES
+	    SKY_NLATUNITS(coo) = SKY_DEGREES
+	    stat = ERR
+
+	# Decode the wcs.
+	} else {
+	    SKY_PIXTYPE(coo) = strdic (wcs, Memc[str1], SZ_LINE, PIXTYPE_LIST)
+	    if (SKY_PIXTYPE(coo) <= 0)
+	        SKY_PIXTYPE(coo) = PIXTYPE_LOGICAL
+	    if (sk_imwcs (im, mw, SKY_CTYPE(coo), SKY_PLNGAX(coo),
+		    SKY_PLATAX(coo), SKY_WTYPE(coo), SKY_RADECSYS(coo),
+		    SKY_EQUINOX(coo), SKY_EPOCH(coo)) == OK) {
+	    	switch (SKY_CTYPE(coo)) {
+	    	case CTYPE_EQUATORIAL:
+	    	    SKY_NLNGUNITS(coo) = SKY_HOURS
+	    	    SKY_NLATUNITS(coo) = SKY_DEGREES
+	    	default:
+	    	    SKY_NLNGUNITS(coo) = SKY_DEGREES
+	    	    SKY_NLATUNITS(coo) = SKY_DEGREES
+	    	}
+		call mw_gaxmap (mw, Memi[laxno], Memi[paxval], mw_stati(mw,
+		    MW_NPHYSDIM))
+		if (Memi[laxno+SKY_PLNGAX(coo)-1] <
+		    Memi[laxno+SKY_PLATAX(coo)-1]) {
+		    SKY_XLAX(coo) = Memi[laxno+SKY_PLNGAX(coo)-1] 
+		    SKY_YLAX(coo) = Memi[laxno+SKY_PLATAX(coo)-1] 
+		} else {
+		    SKY_XLAX(coo) = Memi[laxno+SKY_PLATAX(coo)-1] 
+		    SKY_YLAX(coo) = Memi[laxno+SKY_PLNGAX(coo)-1] 
+		}
+		if (SKY_XLAX(coo) <= 0 || SKY_YLAX(coo) <= 0) {
+		    SKY_VXOFF(coo) = 0.0d0
+		    SKY_VYOFF(coo) = 0.0d0
+		    SKY_VXSTEP(coo) = 1.0d0
+		    SKY_VYSTEP(coo) = 1.0d0
+	            SKY_NLNGAX(coo) = 2048
+	            SKY_NLATAX(coo) = 2048
+		    stat = ERR
+		} else {
+		    SKY_VXOFF(coo) = IM_VOFF(im,IM_VMAP(im,SKY_XLAX(coo)))
+		    SKY_VYOFF(coo) = IM_VOFF(im,IM_VMAP(im,SKY_YLAX(coo)))
+		    SKY_VXSTEP(coo) = IM_VSTEP(im,SKY_XLAX(coo))
+		    SKY_VYSTEP(coo) = IM_VSTEP(im,SKY_YLAX(coo))
+	            SKY_NLNGAX(coo) = IM_LEN(im,SKY_XLAX(coo))
+	            SKY_NLATAX(coo) = IM_LEN(im,SKY_YLAX(coo))
+		    stat = OK
+		}
+	    } else {
+		call mw_close (mw)
+		mw = NULL
+	        SKY_XLAX(coo) = 1
+	        SKY_YLAX(coo) = 2
+	        SKY_NLNGAX(coo) = 2048
+	        SKY_NLATAX(coo) = 2048
+	        SKY_VXOFF(coo) = 0.0d0
+	        SKY_VYOFF(coo) = 0.0d0
+	        SKY_VXSTEP(coo) = 1.0d0
+	        SKY_VYSTEP(coo) = 1.0d0
+	    	SKY_NLNGUNITS(coo) = SKY_DEGREES
+	    	SKY_NLATUNITS(coo) = SKY_DEGREES
+		stat = ERR
+	    }
+	}
+
+	call sfree (sp)
+
+	SKY_STATUS(coo) = stat
+	return (stat)
+end
+
+
+# SK_STRWCS -- Decode the sky coordinate system from an input string.
+# The string syntax is [ctype] equinox [epoch]. The various options
+# have been placed case statements. Although there is considerable
+# duplication of code in the case statements, there are minor differences
+# and I found it clearer to write it out rather than trying to be
+# concise. I might want to clean this up a bit later.
+
+int procedure sk_strwcs (instr, ctype, radecsys, equinox, epoch)
+
+char	instr[ARB]		#I the input wcs string
+int	ctype			#O the output coordinate type
+int	radecsys		#O the output equatorial reference system
+double	equinox			#O the output equinox
+double	epoch			#O the output epoch of the observation
+
+int	ip, nitems, sctype, sradecsys, stat
+pointer	sp, str1, str2
+int	strdic(), nscan(), ctod()
+double	sl_ej2d(), sl_epb(), sl_eb2d(), sl_epj()
+
+begin
+	# Initialize.
+	ctype = 0
+	radecsys = 0
+	equinox = INDEFD
+	epoch = INDEFD
+
+	# Allocate working space.
+	call smark (sp)
+	call salloc (str1, SZ_LINE, TY_CHAR)
+	call salloc (str2, SZ_LINE, TY_CHAR)
+
+	# Determine the coordinate string.
+	call sscan (instr)
+	    call gargwrd (Memc[str1], SZ_LINE)
+
+	# Return with an error if the string is blank.
+	if (Memc[str1] == EOS || nscan() < 1) {
+	    call sfree (sp)
+	    return (ERR)
+	} else
+	    nitems = 1
+	    
+	# If the coordinate type is undefined temporarily default it to
+	# equatorial.
+	sctype = strdic (Memc[str1], Memc[str2], SZ_LINE, FTYPE_LIST) 
+	if (sctype <= 0) {
+	    ctype = CTYPE_EQUATORIAL
+	} else {
+	    switch (sctype) {
+	    case FTYPE_FK4:
+	        ctype = CTYPE_EQUATORIAL
+		radecsys = EQTYPE_FK4
+	    case FTYPE_FK4NOE:
+	        ctype = CTYPE_EQUATORIAL
+		radecsys = EQTYPE_FK4NOE
+	    case FTYPE_FK5:
+	        ctype = CTYPE_EQUATORIAL
+		radecsys = EQTYPE_FK5
+	    case FTYPE_ICRS:
+	        ctype = CTYPE_EQUATORIAL
+		radecsys = EQTYPE_ICRS
+	    case FTYPE_GAPPT:
+	        ctype = CTYPE_EQUATORIAL
+		radecsys = EQTYPE_GAPPT
+	    case FTYPE_ECLIPTIC:
+	        ctype = CTYPE_ECLIPTIC
+	    case FTYPE_GALACTIC:
+	        ctype = CTYPE_GALACTIC
+	    case FTYPE_SUPERGALACTIC:
+	        ctype = CTYPE_SUPERGALACTIC
+	    }
+	    call gargwrd (Memc[str1], SZ_LINE)
+	    if (nscan() > nitems)
+		nitems = nitems + 1
+	}
+	sctype = ctype
+	sradecsys = radecsys
+
+	# Decode the coordinate system.
+	switch (sctype) {
+
+	# Decode the equatorial system, equinox, and epoch.
+	case CTYPE_EQUATORIAL:
+
+	    switch (sradecsys) {
+	    case EQTYPE_FK4, EQTYPE_FK4NOE:
+		if (Memc[str1] == 'J' || Memc[str1] == 'j' ||
+		    Memc[str1] == 'B' || Memc[str1] == 'b')
+		    ip = 2
+		else 
+		    ip = 1
+	        if (ctod (Memc[str1], ip, equinox) <= 0)
+		    equinox = 1950.0d0
+		if (Memc[str1] == 'J' || Memc[str1] == 'j')
+		    equinox = sl_epb (sl_ej2d (equinox))
+
+	        call gargwrd (Memc[str2], SZ_LINE)
+	        if (nscan() <= nitems)
+		    epoch = sl_eb2d (equinox)
+		else {
+		    if (Memc[str2] == 'J' || Memc[str2] == 'j' ||
+		        Memc[str2] == 'B' || Memc[str2] == 'b')
+		        ip = 2
+		    else
+		        ip = 1
+		    if (ctod (Memc[str2], ip, epoch) <= 0)
+		        epoch = sl_eb2d (equinox)
+		    else if (epoch <= 3000.0d0 && (Memc[str2] == 'J' ||
+		        Memc[str2] == 'j'))
+		        epoch = sl_ej2d (epoch)
+		    else if (epoch > 3000.0d0)
+		        epoch = epoch - 2400000.5d0
+		    else
+			epoch = sl_eb2d (epoch)
+		}
+
+	    case EQTYPE_FK5, EQTYPE_ICRS:
+		if (Memc[str1] == 'J' || Memc[str1] == 'j' ||
+		    Memc[str1] == 'B' || Memc[str1] == 'b')
+		    ip = 2
+		else 
+		    ip = 1
+	        if (ctod (Memc[str1], ip, equinox) <= 0)
+		    equinox = 2000.0d0
+		if (Memc[str1] == 'B' || Memc[str1] == 'b')
+		    equinox = sl_epj(sl_eb2d (equinox))
+
+	        call gargwrd (Memc[str2], SZ_LINE)
+	        if (nscan() <= nitems)
+		    epoch = sl_ej2d (equinox)
+		else {
+		    if (Memc[str2] == 'J' || Memc[str2] == 'j' ||
+		        Memc[str2] == 'B' || Memc[str2] == 'b')
+		        ip = 2
+		    else
+		        ip = 1
+		    if (ctod (Memc[str2], ip, epoch) <= 0)
+		        epoch = sl_ej2d (equinox)
+		    else if (epoch <= 3000.0d0 && (Memc[str2] == 'B' ||
+		        Memc[str2] == 'b'))
+		        epoch = sl_eb2d (epoch)
+		    else if (epoch > 3000.0d0)
+		        epoch = epoch - 2400000.5d0
+		    else
+			epoch = sl_ej2d (epoch)
+		}
+
+	    case EQTYPE_GAPPT:
+		equinox = 2000.0d0
+		if (Memc[str1] == 'J' || Memc[str1] == 'j' ||
+		    Memc[str1] == 'B' || Memc[str1] == 'b')
+		    ip = 2
+		else
+		    ip = 1
+	        if (ctod (Memc[str1], ip, epoch) <= 0) {
+		    epoch = INDEFD
+		} else if (epoch <= 3000.0d0) {
+		    if (Memc[str1] == 'B' || Memc[str1] == 'b')
+		        epoch = sl_eb2d (epoch)
+		    else if (Memc[str1] == 'J' || Memc[str1] == 'j')
+		        epoch = sl_ej2d (epoch)
+		    else if (epoch < 1984.0d0)
+		        epoch = sl_eb2d (epoch)
+		    else
+		        epoch = sl_ej2d (epoch)
+		} else {
+		    epoch = epoch - 2400000.5d0
+		} 
+
+	    default:
+		ip = 1
+		if (Memc[str1] == 'B' || Memc[str1] == 'b') {
+		    radecsys = EQTYPE_FK4
+		    ip = ip + 1
+	            if (ctod (Memc[str1], ip, equinox) <= 0)
+			equinox = 1950.0d0
+
+	            call gargwrd (Memc[str2], SZ_LINE)
+	            if (nscan() <= nitems)
+		        epoch = sl_eb2d (equinox)
+		    else {
+		        if (Memc[str2] == 'J' || Memc[str2] == 'j')
+		            ip = 2
+		        else if (Memc[str2] == 'B' || Memc[str2] == 'b')
+		            ip = 2
+		        else
+		            ip = 1
+		        if (ctod (Memc[str2], ip, epoch) <= 0)
+		            epoch = sl_eb2d (equinox)
+		        else if (epoch <= 3000.0d0 && (Memc[str2] == 'J' ||
+			    Memc[str2] == 'j'))
+		            epoch = sl_ej2d (epoch)
+		        else if (epoch > 3000.0d0)
+		            epoch = epoch - 2400000.5d0
+			else
+			    epoch = sl_eb2d (epoch)
+		    }
+
+		} else if (Memc[str1] == 'J' || Memc[str1] == 'j') {
+		    radecsys = EQTYPE_FK5
+		    ip = ip + 1
+	            if (ctod (Memc[str1], ip, equinox) <= 0)
+			equinox = 2000.0d0
+
+	            call gargwrd (Memc[str2], SZ_LINE)
+	            if (nscan() <= nitems)
+		        epoch = sl_ej2d (equinox)
+		    else {
+		        if (Memc[str2] == 'J' || Memc[str2] == 'j' ||
+		            Memc[str2] == 'B' || Memc[str2] == 'b')
+		            ip = 2
+		        else
+		            ip = 1
+		        if (ctod (Memc[str2], ip, epoch) <= 0)
+		            epoch = sl_ej2d (equinox)
+		        else if (epoch <= 3000.0d0 && (Memc[str2] == 'B' ||
+			    Memc[str2] == 'b'))
+		            epoch = sl_eb2d (epoch)
+		        else if (epoch > 3000.0d0)
+		            epoch = epoch - 2400000.5d0
+			else
+			    epoch = sl_ej2d (epoch)
+		    }
+
+		} else if (ctod (Memc[str1], ip, equinox) <= 0) {
+		    ctype = 0
+		    radecsys = 0
+		    equinox = INDEFD
+		    epoch = INDEFD
+
+		} else if (equinox < 1984.0d0) {
+		    radecsys = EQTYPE_FK4
+	            call gargwrd (Memc[str2], SZ_LINE)
+	            if (nscan() <= nitems)
+		        epoch = sl_eb2d (equinox)
+		    else {
+		        if (Memc[str2] == 'J' || Memc[str2] == 'j' ||
+		            Memc[str2] == 'B' || Memc[str2] == 'b')
+		            ip = 2
+		        else
+		            ip = 1
+		        if (ctod (Memc[str2], ip, epoch) <= 0)
+		            epoch = sl_eb2d (equinox)
+		        else if (epoch <= 3000.0d0 && (Memc[str2] == 'J' ||
+			    Memc[str2] == 'j'))
+		            epoch = sl_ej2d (epoch)
+		        else if (epoch > 3000.0d0)
+		            epoch = epoch - 2400000.5d0
+			else
+			    epoch = sl_eb2d (epoch)
+		    }
+
+		} else {
+		    radecsys = EQTYPE_FK5
+	            call gargwrd (Memc[str2], SZ_LINE)
+	            if (nscan() <= nitems)
+		        epoch = sl_ej2d (equinox)
+		    else {
+		        if (Memc[str2] == 'J' || Memc[str2] == 'j' ||
+		            Memc[str2] == 'B' || Memc[str2] == 'b')
+		            ip = 2
+		        else
+		            ip = 1
+		        if (ctod (Memc[str2], ip, epoch) <= 0)
+		            epoch = sl_ej2d (equinox)
+		        else if (epoch <= 3000.0d0 && (Memc[str2] == 'B' ||
+			    Memc[str2] == 'b'))
+		            epoch = sl_eb2d (epoch)
+		        else if (epoch > 3000.0d0)
+		            epoch = epoch - 2400000.5d0
+			else
+			    epoch = sl_ej2d (epoch)
+		    }
+		}
+	    }
+
+	# Decode the ecliptic coordinate system.
+	case CTYPE_ECLIPTIC:
+	    if (Memc[str1] == 'J' || Memc[str1] == 'j' ||
+	        Memc[str1] == 'B' || Memc[str1] == 'b')
+		ip = 2
+	    else
+		ip = 1
+	    if (ctod (Memc[str1], ip, epoch) <= 0) {
+		epoch = INDEFD
+	    } else if (epoch <= 3000.0d0) {
+	        if (Memc[str1] == 'B' || Memc[str1] == 'b')
+		    epoch = sl_eb2d (epoch)
+	        else if (Memc[str1] == 'J' || Memc[str1] == 'j')
+		    epoch = sl_ej2d (epoch)
+		else if (epoch < 1984.0d0)
+		    epoch = sl_eb2d (epoch)
+		else
+		    epoch = sl_ej2d (epoch)
+	    } else {
+		epoch = epoch - 2400000.5d0
+	    }
+
+	# Decode the galactic and supergalactic coordinate system.
+	case CTYPE_GALACTIC, CTYPE_SUPERGALACTIC:
+	    if (Memc[str1] == 'J' || Memc[str1] == 'j' ||
+		Memc[str1] == 'B' || Memc[str1] == 'b')
+		ip = 2
+	    else
+		ip = 1
+	    if (ctod (Memc[str1], ip, epoch) <= 0) {
+		epoch = sl_eb2d (1950.0d0)
+	    } else if (epoch <= 3000.0d0) {
+	        if (Memc[str1] == 'J' || Memc[str1] == 'j')
+		    epoch = sl_ej2d (epoch)
+	        else if (Memc[str1] == 'B' || Memc[str1] == 'b')
+		    epoch = sl_eb2d (epoch)
+	        else if (epoch < 1984.0d0) 
+		    epoch = sl_eb2d (epoch)
+		else
+		    epoch = sl_ej2d (epoch)
+	    } else {
+		epoch = epoch - 2400000.5d0
+	    }
+	}
+
+	# Return the appropriate error status.
+	if (ctype == 0)
+	    stat = ERR
+	else if (ctype == CTYPE_EQUATORIAL && (radecsys == 0 ||
+	    IS_INDEFD(equinox) || IS_INDEFD(epoch)))
+	    stat = ERR
+	else if (ctype == CTYPE_ECLIPTIC && IS_INDEFD(epoch))
+	    stat = ERR
+	else
+	    stat = OK
+
+	call sfree (sp)
+
+	return (stat)
+end
+
+
+# SK_IMWCS -- Decode the sky coordinate system of the image. Return
+# an error if the sky coordinate system is not one of the supported types
+# or required information is missing from the image header.
+
+int procedure sk_imwcs (im, mw, ctype, lngax, latax, wtype, radecsys,
+	equinox, epoch)
+
+pointer	im			#I the image pointer
+pointer	mw			#I pointer to the world coordinate system
+int	ctype			#O the output coordinate type
+int	lngax			#O the output ra/glon/elon axis
+int	latax			#O the output dec/glat/elat axis
+int	wtype			#O the output projection type
+int	radecsys		#O the output equatorial reference system
+double	equinox			#O the output equinox
+double	epoch			#O the output epoch of the observation
+
+int	i, ndim, axtype, day, month, year, ier, oldfits
+pointer	sp, atval
+double	hours
+double	imgetd(), sl_eb2d(), sl_ej2d()
+int	mw_stati(), strdic(), dtm_decode()
+errchk	mw_gwattrs(), imgstr(), imgetd()
+
+begin
+	call smark (sp)
+	call salloc (atval, SZ_LINE, TY_CHAR)
+
+	# Initialize
+	ctype = 0
+	lngax = 0
+	latax = 0
+	wtype = 0
+	radecsys = 0
+	equinox = INDEFD
+	epoch = INDEFD
+
+	# Determine the sky coordinate system of the image.
+	ndim = mw_stati (mw, MW_NPHYSDIM)
+	do i = 1, ndim {
+	    iferr (call mw_gwattrs (mw, i, "axtype", Memc[atval], SZ_LINE))
+		call strcpy ("INDEF", Memc[atval], SZ_LINE)
+	    axtype = strdic (Memc[atval], Memc[atval], SZ_LINE, AXTYPE_LIST)
+	    switch (axtype) {
+	    case AXTYPE_RA, AXTYPE_DEC: 
+		ctype = CTYPE_EQUATORIAL
+	    case AXTYPE_ELON, AXTYPE_ELAT: 
+		ctype = CTYPE_ECLIPTIC
+	    case AXTYPE_GLON, AXTYPE_GLAT: 
+		ctype = CTYPE_GALACTIC
+	    case AXTYPE_SLON, AXTYPE_SLAT: 
+		ctype = CTYPE_SUPERGALACTIC
+	    default:
+		;
+	    }
+	    switch (axtype) {
+	    case AXTYPE_RA, AXTYPE_ELON, AXTYPE_GLON, AXTYPE_SLON:
+		lngax = i
+	    case AXTYPE_DEC, AXTYPE_ELAT, AXTYPE_GLAT, AXTYPE_SLAT:
+		latax = i
+	    default:
+		;
+	    }
+	}
+
+	# Return if the sky coordinate system cannot be decoded.
+	if (ctype == 0 || lngax == 0 || latax == 0) {
+	    call sfree (sp)
+	    return (ERR)
+	}
+
+	# Decode the sky projection.
+	iferr {
+	    call mw_gwattrs (mw, lngax, "wtype", Memc[atval], SZ_LINE)
+	} then {
+	    iferr (call mw_gwattrs(mw, latax, "wtype", Memc[atval], SZ_LINE))
+		call strcpy ("linear", Memc[atval], SZ_LINE)
+	}
+	wtype = strdic (Memc[atval], Memc[atval], SZ_LINE, WTYPE_LIST)
+
+	# Return if the sky projection system is not supported.
+	if (wtype == 0) {
+	    call sfree (sp)
+	    return (ERR)
+	}
+
+	# Determine the RA/DEC system and equinox.
+	if (ctype == CTYPE_EQUATORIAL) {
+
+	    # Get the equinox of the coordinate system. The EQUINOX keyword
+	    # takes precedence over EPOCH.
+	    iferr {
+	        equinox = imgetd (im, "EQUINOX")
+	    } then {
+		iferr {
+	            equinox = imgetd (im, "EPOCH")
+		} then {
+		    equinox = INDEFD
+		}
+	    }
+
+	    # Determine which equatorial system will be used. The default
+	    # is FK4 if equinox < 1984.0, FK5 if equinox is >= 1984.
+	    iferr {
+	        call imgstr (im, "RADECSYS", Memc[atval], SZ_LINE)
+	    } then {
+	        radecsys = 0
+	    } else {
+		call strlwr (Memc[atval])
+	        radecsys = strdic (Memc[atval], Memc[atval], SZ_LINE,
+		    EQTYPE_LIST)
+	    }
+	    if (radecsys == 0) {
+		if (IS_INDEFD(equinox))
+		    radecsys = EQTYPE_FK5
+		else if (equinox < 1984.0d0)
+		    radecsys = EQTYPE_FK4
+		else
+		    radecsys = EQTYPE_FK5
+	    }
+
+	    # Get the MJD of the observation. If there is no MJD in the
+	    # header use the DATE_OBS keyword value and transform it to
+	    # an MJD.
+	    iferr {
+	        epoch = imgetd (im, "MJD-WCS")
+	    } then {
+	        iferr {
+	            epoch = imgetd (im, "MJD-OBS")
+	        } then {
+		    iferr {
+	                call imgstr (im, "DATE-OBS", Memc[atval], SZ_LINE)
+		    } then {
+		        epoch = INDEFD
+		    } else if (dtm_decode (Memc[atval], year, month, day,
+			hours, oldfits) == OK) {
+		        call sl_cadj (year, month, day, epoch, ier)
+		        if (ier != 0)
+			    epoch = INDEFD
+			else if (! IS_INDEFD(hours) && hours >= 0.0d0 &&
+			    hours <= 24.0d0)
+			    epoch = epoch + hours / 24.0d0
+		    } else
+		        epoch = INDEFD
+	        }
+	    }
+
+	    # Set the default equinox and epoch appropriate for each
+	    # equatorial system if these are undefined.
+	    switch (radecsys) {
+	    case EQTYPE_FK4, EQTYPE_FK4NOE:
+		if (IS_INDEFD(equinox))
+		    equinox = 1950.0d0
+		if (IS_INDEFD(epoch))
+		    epoch = sl_eb2d (1950.0d0)
+	    case EQTYPE_FK5, EQTYPE_ICRS:
+		if (IS_INDEFD(equinox))
+		    equinox = 2000.0d0
+		if (IS_INDEFD(epoch))
+		    epoch = sl_ej2d (2000.0d0)
+	    case EQTYPE_GAPPT:
+		equinox = 2000.0d0
+		;
+	    }
+
+	    # Return if the epoch is undefined. This can only occur if
+	    # the equatorial coordinate system is GAPPT and there is NO
+	    # epoch of observation in the image header.
+	    if (IS_INDEFD(epoch)) {
+		call sfree (sp)
+		return (ERR)
+	    }
+	} 
+
+	# Get the MJD of the observation. If there is no MJD in the
+	# header use the DATE_OBS keyword value and transform it to
+	# an MJD.
+	if (ctype == CTYPE_ECLIPTIC) {
+
+	    iferr {
+	        epoch = imgetd (im, "MJD-WCS")
+	    } then {
+	        iferr {
+	            epoch = imgetd (im, "MJD-OBS")
+	        } then {
+		    iferr {
+	                call imgstr (im, "DATE-OBS", Memc[atval], SZ_LINE)
+		    } then {
+		        epoch = INDEFD
+		    } else if (dtm_decode (Memc[atval], year, month, day,
+			hours, oldfits) == OK) {
+		        call sl_cadj (year, month, day, epoch, ier)
+		        if (ier != 0)
+			    epoch = INDEFD
+			else if (! IS_INDEFD(hours) && hours >= 0.0d0 &&
+			    hours <= 24.0d0)
+			    epoch = epoch + hours / 24.0d0
+		    } else
+		        epoch = INDEFD
+	        }
+	    }
+
+	    # Return if the epoch is undefined.
+	    if (IS_INDEFD(epoch)) {
+		call sfree (sp)
+		return (ERR)
+	    }
+	}
+
+	if (ctype == CTYPE_GALACTIC || ctype == CTYPE_SUPERGALACTIC) {
+
+	    # Get the MJD of the observation. If there is no MJD in the
+	    # header use the DATE_OBS keyword value and transform it to
+	    # an MJD.
+	    iferr {
+	        epoch = imgetd (im, "MJD-WCS")
+	    } then {
+	        iferr {
+	            epoch = imgetd (im, "MJD-OBS")
+	        } then {
+		    iferr {
+	                call imgstr (im, "DATE-OBS", Memc[atval], SZ_LINE)
+		    } then {
+		        epoch = sl_eb2d (1950.0d0)
+		    } else if (dtm_decode (Memc[atval], year, month, day,
+		        hours, oldfits) == OK) {
+		        call sl_cadj (year, month, day, epoch, ier)
+		        if (ier != 0)
+			    epoch = sl_eb2d (1950.0d0)
+			else {
+			    if (! IS_INDEFD(hours) && hours >= 0.0d0 &&
+				hours <= 24.0d0)
+			        epoch = epoch + hours / 24.0d0
+			    #if (epoch < 1984.0d0)
+		    	        #epoch = sl_eb2d (epoch)
+			    #else
+		    	        #epoch = sl_ej2d (epoch)
+			}
+		    } else
+		        epoch = sl_eb2d (1950.0d0)
+	        }
+	    }
+	}
+
+	call sfree (sp)
+
+	return (OK)
+end
+
+
+# SK_ENWCS -- Encode the celestial wcs system.
+
+procedure sk_enwcs (coo, wcsstr, maxch)
+
+pointer	coo			#I the celestial coordinate system descriptor
+char	wcsstr[ARB]		#O the output wcs string
+int	maxch			#I the size of the output string
+
+double	sk_statd(), sl_epj(), sl_epb()
+int	sk_stati()
+
+begin
+	switch (sk_stati (coo, S_CTYPE)) {
+
+	case CTYPE_EQUATORIAL:
+
+	    switch (sk_stati(coo, S_RADECSYS)) {
+
+	    case EQTYPE_GAPPT:
+		if (IS_INDEFD(sk_statd(coo, S_EPOCH))) {
+	            call sprintf (wcsstr, maxch, "apparent")
+		} else {
+	            call sprintf (wcsstr, maxch, "apparent J%0.8f")
+		        call pargd (sl_epj(sk_statd(coo, S_EPOCH)))
+		}
+
+	    case EQTYPE_FK5:
+	        call sprintf (wcsstr, maxch, "fk5 J%0.3f J%0.8f")
+		    call pargd (sk_statd(coo, S_EQUINOX))
+		    call pargd (sl_epj(sk_statd(coo, S_EPOCH)))
+
+	    case EQTYPE_ICRS:
+	        call sprintf (wcsstr, maxch, "icrs J%0.3f J%0.8f")
+		    call pargd (sk_statd(coo, S_EQUINOX))
+		    call pargd (sl_epj(sk_statd(coo, S_EPOCH)))
+
+	    case EQTYPE_FK4:
+	        call sprintf (wcsstr, maxch, "fk4 B%0.3f B%0.8f")
+		    call pargd (sk_statd(coo, S_EQUINOX))
+		    call pargd (sl_epb(sk_statd(coo, S_EPOCH)))
+
+	    case EQTYPE_FK4NOE:
+	        call sprintf (wcsstr, maxch, "fk4noe B%0.3f B%0.8f")
+		    call pargd (sk_statd(coo, S_EQUINOX))
+		    call pargd (sl_epb(sk_statd(coo, S_EPOCH)))
+
+	    default:
+		wcsstr[1] = EOS
+	    }
+
+	case CTYPE_ECLIPTIC:
+	    if (IS_INDEFD(sk_statd(coo, S_EPOCH))) {
+	        call sprintf (wcsstr, maxch, "ecliptic")
+	    } else {
+	        call sprintf (wcsstr, maxch, "ecliptic J%0.8f")
+		    call pargd (sl_epj(sk_statd(coo, S_EPOCH)))
+	    }
+
+	case CTYPE_GALACTIC:
+	    call sprintf (wcsstr, maxch, "galactic J%0.8f")
+		call pargd (sl_epj(sk_statd(coo, S_EPOCH)))
+
+	case CTYPE_SUPERGALACTIC:
+	    call sprintf (wcsstr, maxch, "supergalactic j%0.8f")
+		call pargd (sl_epj(sk_statd(coo, S_EPOCH)))
+	}
+end
+
+
+# SK_COPY -- Copy the coodinate structure.
+
+pointer procedure sk_copy (cooin)
+
+pointer	cooin			#I the pointer to the input structure
+
+pointer	cooout
+
+begin
+	if (cooin == NULL)
+	    cooout = NULL
+	else {
+	    call calloc (cooout, LEN_SKYCOOSTRUCT, TY_STRUCT)
+            SKY_VXOFF(cooout) = SKY_VXOFF(cooin)
+            SKY_VYOFF(cooout) = SKY_VYOFF(cooin)
+            SKY_VXSTEP(cooout) = SKY_VXSTEP(cooin)
+            SKY_VYSTEP(cooout) = SKY_VYSTEP(cooin)
+	    SKY_EQUINOX(cooout) = SKY_EQUINOX(cooin)
+	    SKY_EPOCH(cooout) = SKY_EPOCH(cooin)
+	    SKY_CTYPE(cooout) = SKY_CTYPE(cooin)
+	    SKY_RADECSYS(cooout) = SKY_RADECSYS(cooin)
+            SKY_WTYPE(cooout) = SKY_WTYPE(cooin)
+            SKY_PLNGAX(cooout) = SKY_PLNGAX(cooin)
+            SKY_PLATAX(cooout) = SKY_PLATAX(cooin)
+            SKY_XLAX(cooout) = SKY_XLAX(cooin)
+            SKY_YLAX(cooout) = SKY_YLAX(cooin)
+            SKY_PIXTYPE(cooout) = SKY_PIXTYPE(cooin)
+    	    SKY_NLNGAX(cooout) = SKY_NLNGAX(cooin)
+            SKY_NLATAX(cooout) = SKY_NLATAX(cooin)
+    	    SKY_NLNGUNITS(cooout) = SKY_NLNGUNITS(cooin)
+            SKY_NLATUNITS(cooout) = SKY_NLATUNITS(cooin)
+	    call strcpy (SKY_COOSYSTEM(cooin), SKY_COOSYSTEM(cooout),
+		SZ_FNAME)
+	}
+
+	return (cooout)
+end
+
+
+# SK_CLOSE -- Free the coordinate structure.
+
+procedure sk_close (coo)
+
+pointer	coo			#U the input coordinate structure
+
+begin
+	if (coo != NULL)
+	    call mfree (coo, TY_STRUCT)
+end
diff --git a/pkg/xtools/skywcs/sksaveim.x b/pkg/xtools/skywcs/sksaveim.x
new file mode 100644
index 00000000..77b5a1d9
--- /dev/null
+++ b/pkg/xtools/skywcs/sksaveim.x
@@ -0,0 +1,157 @@
+include "skywcsdef.h"
+include "skywcs.h"
+
+# SK_SAVEIM -- Update the image header keywords that describe the
+# fundamental coordinate system, CTYPE, RADECSYS, EQUINOX (EPOCH), and
+# MJD-WCS.
+
+procedure sk_saveim (coo, mw, im)
+
+pointer	coo			#I pointer to the coordinate structure
+pointer	mw			#I pointer to the mwcs structure
+pointer	im			#I image descriptor
+
+errchk	imdelf()
+
+begin
+	# Move all this to a separate routine
+	switch (SKY_CTYPE(coo)) {
+
+	case CTYPE_EQUATORIAL:
+	    call mw_swattrs (mw, SKY_PLNGAX(coo), "axtype", "ra")
+	    call mw_swattrs (mw, SKY_PLATAX(coo), "axtype", "dec")
+	    switch (SKY_RADECSYS(coo)) {
+	    case EQTYPE_FK4:
+		call imastr (im, "radecsys", "FK4")
+		call imaddd (im, "equinox", SKY_EQUINOX(coo))
+		call imaddd (im, "mjd-wcs", SKY_EPOCH(coo))
+	    case EQTYPE_FK4NOE:
+		call imastr (im, "radecsys", "FK4NOE")
+		call imaddd (im, "equinox", SKY_EQUINOX(coo))
+		call imaddd (im, "mjd-wcs", SKY_EPOCH(coo))
+	    case EQTYPE_FK5:
+		call imastr (im, "radecsys", "FK5")
+		call imaddd (im, "equinox", SKY_EQUINOX(coo))
+	        iferr (call imdelf (im, "mjd-wcs"))
+		    ;
+	    case EQTYPE_ICRS:
+		call imastr (im, "radecsys", "ICRS")
+		call imaddd (im, "equinox", SKY_EQUINOX(coo))
+	        iferr (call imdelf (im, "mjd-wcs"))
+		    ;
+	    case EQTYPE_GAPPT:
+		call imastr (im, "radecsys", "GAPPT")
+		iferr (call imdelf (im, "equinox"))
+		    ;
+		call imaddd (im, "mjd-wcs", SKY_EPOCH(coo))
+	    }
+
+	case CTYPE_ECLIPTIC:
+	    call mw_swattrs (mw, SKY_PLNGAX(coo), "axtype", "elon")
+	    call mw_swattrs (mw, SKY_PLATAX(coo), "axtype", "elat")
+	    iferr (call imdelf (im, "radecsys"))
+		;
+	    iferr (call imdelf (im, "equinox"))
+		;
+	    call imaddd (im, "mjd-wcs", SKY_EPOCH(coo))
+
+	case CTYPE_GALACTIC:
+	    call mw_swattrs (mw, SKY_PLNGAX(coo), "axtype", "glon")
+	    call mw_swattrs (mw, SKY_PLATAX(coo), "axtype", "glat")
+	    iferr (call imdelf (im, "radecsys"))
+		;
+	    iferr (call imdelf (im, "equinox"))
+		;
+	    iferr (call imdelf (im, "mjd-wcs"))
+		;
+
+	case CTYPE_SUPERGALACTIC:
+	    call mw_swattrs (mw, SKY_PLNGAX(coo), "axtype", "slon")
+	    call mw_swattrs (mw, SKY_PLATAX(coo), "axtype", "slat")
+	    iferr (call imdelf (im, "radecsys"))
+		;
+	    iferr (call imdelf (im, "equinox"))
+		;
+	    iferr (call imdelf (im, "mjd-wcs"))
+		;
+	}
+end
+
+
+# SK_CTYPEIM -- Modify the CTYPE keywords appropriately. This step will
+# become unnecessary when MWCS is updated to deal with non-equatorial celestial
+# coordinate systems.
+
+procedure sk_ctypeim (coo, im)
+
+pointer	coo			#I pointer to the coordinate structure
+pointer	im			#I image descriptor
+
+pointer	sp, wtype, key1, key2, attr
+int	sk_wrdstr()
+
+begin
+	call smark (sp)
+	call salloc (key1, 8, TY_CHAR)
+	call salloc (key2, 8, TY_CHAR)
+	call salloc (wtype, 3, TY_CHAR)
+	call salloc (attr, 8, TY_CHAR)
+
+	call sprintf (Memc[key1], 8, "CTYPE%d")
+	    call pargi (SKY_PLNGAX(coo))
+	call sprintf (Memc[key2], 8, "CTYPE%d")
+	    call pargi (SKY_PLATAX(coo))
+
+	if (SKY_WTYPE(coo) <= 0 || SKY_WTYPE(coo) == WTYPE_LIN) {
+	    call imastr (im, Memc[key1], "LINEAR")
+	    call imastr (im, Memc[key2], "LINEAR")
+	    call sfree (sp)
+	    return
+	}
+
+	if (sk_wrdstr (SKY_WTYPE(coo), Memc[wtype], 3, WTYPE_LIST) <= 0)
+	    call strcpy ("tan", Memc[wtype], 3)
+	call strupr (Memc[wtype])
+
+	# Move all this to a separate routine
+	switch (SKY_CTYPE(coo)) {
+
+	case CTYPE_EQUATORIAL:
+	    call sprintf (Memc[attr], 8, "RA---%3s") 
+		call pargstr (Memc[wtype])
+	    call imastr (im, Memc[key1], Memc[attr])
+	    call sprintf (Memc[attr], 8, "DEC--%3s") 
+		call pargstr (Memc[wtype])
+	    call imastr (im, Memc[key2], Memc[attr])
+
+	case CTYPE_ECLIPTIC:
+	    call sprintf (Memc[attr], 8, "ELON-%3s") 
+		call pargstr (Memc[wtype])
+	    call imastr (im, Memc[key1], Memc[attr])
+	    call sprintf (Memc[attr], 8, "ELAT-%3s") 
+		call pargstr (Memc[wtype])
+	    call imastr (im, Memc[key2], Memc[attr])
+
+	case CTYPE_GALACTIC:
+	    call sprintf (Memc[attr], 8, "GLON-%3s") 
+		call pargstr (Memc[wtype])
+	    call imastr (im, Memc[key1], Memc[attr])
+	    call sprintf (Memc[attr], 8, "GLAT-%3s") 
+		call pargstr (Memc[wtype])
+	    call imastr (im, Memc[key2], Memc[attr])
+
+	case CTYPE_SUPERGALACTIC:
+	    call sprintf (Memc[attr], 8, "SLON-%3s") 
+		call pargstr (Memc[wtype])
+	    call imastr (im, Memc[key1], Memc[attr])
+	    call sprintf (Memc[attr], 8, "SLAT-%3s") 
+		call pargstr (Memc[wtype])
+	    call imastr (im, Memc[key2], Memc[attr])
+
+	default:
+	    call imastr (im, Memc[key1], "LINEAR")
+	    call imastr (im, Memc[key2], "LINEAR")
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/skywcs/skset.x b/pkg/xtools/skywcs/skset.x
new file mode 100644
index 00000000..9e7191c3
--- /dev/null
+++ b/pkg/xtools/skywcs/skset.x
@@ -0,0 +1,90 @@
+include "skywcsdef.h"
+include "skywcs.h"
+
+
+# SK_SETD -- Set a double precision coordinate parameter.
+
+procedure sk_setd (coo, param, value)
+
+pointer	coo			#I pointer to the coordinate structure
+int	param			#I the input parameter
+double	value			#I the parameter value
+
+begin
+	switch (param) {
+	case S_VXOFF:
+	    SKY_VXOFF(coo) = value
+	case S_VYOFF:
+	    SKY_VYOFF(coo) = value
+	case S_VXSTEP:
+	    SKY_VXSTEP(coo) = value
+	case S_VYSTEP:
+	    SKY_VYSTEP(coo) = value
+	case S_EQUINOX:
+	    SKY_EQUINOX(coo) = value
+	case S_EPOCH:
+	    SKY_EPOCH(coo) = value
+	default:
+	    call error (0, "SKY_SETD: Unknown coordinate system parameter")
+	}
+end
+
+
+# SK_SETI -- Set an integer coordinate parameter.
+
+procedure sk_seti (coo, param, value)
+
+pointer	coo			#I pointer to the coordinate structure
+int	param			#I the input parameter
+int	value			#I the parameter value
+
+begin
+	switch (param) {
+	case S_CTYPE:
+	    SKY_CTYPE(coo) = value
+	case S_RADECSYS:
+	    SKY_RADECSYS(coo) = value
+	case S_WTYPE:
+	    SKY_WTYPE(coo) = value
+	case S_PLNGAX:
+	    SKY_PLNGAX(coo) = value
+	case S_PLATAX:
+	    SKY_PLATAX(coo) = value
+	case S_XLAX:
+	    SKY_XLAX(coo) = value
+	case S_YLAX:
+	    SKY_YLAX(coo) = value
+	case S_PIXTYPE:
+	    SKY_PIXTYPE(coo) = value
+	case S_NLNGAX:
+	    SKY_NLNGAX(coo) = value
+	case S_NLATAX:
+	    SKY_NLATAX(coo) = value
+	case S_NLNGUNITS:
+	    SKY_NLNGUNITS(coo) = value
+	case S_NLATUNITS:
+	    SKY_NLATUNITS(coo) = value
+	case S_STATUS:
+	    SKY_STATUS(coo) = value
+	default:
+	    call error (0, "SKY_SETI: Unknown coordinate system parameter")
+	}
+end
+
+
+# SK_SETS -- Set a character string coordinate parameter.
+
+procedure sk_sets (coo, param, value)
+
+pointer	coo			#I pointer to the coordinate structure
+int	param			#I the input parameter
+char	value[ARB]		#I the parameter value
+
+begin
+	switch (param) {
+	case S_COOSYSTEM:
+	    call strcpy (value, SKY_COOSYSTEM(coo), SZ_FNAME)
+	default:
+	    call error (0, "SKY_SETSTR: Unknown coordinate system parameter")
+	}
+end
diff --git a/pkg/xtools/skywcs/skstat.x b/pkg/xtools/skywcs/skstat.x
new file mode 100644
index 00000000..82d2f1c2
--- /dev/null
+++ b/pkg/xtools/skywcs/skstat.x
@@ -0,0 +1,90 @@
+include "skywcsdef.h"
+include "skywcs.h"
+
+
+# SK_STATD -- Get a double precision coordinate parameter.
+
+double procedure sk_statd (coo, param)
+
+pointer	coo			#I pointer to the coordinate structure
+int	param			#I the input parameter
+
+begin
+	switch (param) {
+	case S_VXOFF:
+	    return (SKY_VXOFF(coo))
+	case S_VYOFF:
+	    return (SKY_VYOFF(coo))
+	case S_VXSTEP:
+	    return (SKY_VXSTEP(coo))
+	case S_VYSTEP:
+	    return (SKY_VYSTEP(coo))
+	case S_EQUINOX:
+	    return (SKY_EQUINOX(coo))
+	case S_EPOCH:
+	    return (SKY_EPOCH(coo))
+	default:
+	    call error (0, "SKY_STATD: Unknown coordinate system parameter")
+	}
+end
+
+
+# SK_STATI -- Get an integer coordinate parameter.
+
+int procedure sk_stati (coo, param)
+
+pointer	coo			#I pointer to the coordinate structure
+int	param			#I the input parameter
+
+begin
+	switch (param) {
+	case S_CTYPE:
+	    return (SKY_CTYPE(coo))
+	case S_RADECSYS:
+	    return (SKY_RADECSYS(coo))
+	case S_WTYPE:
+	    return (SKY_WTYPE(coo))
+	case S_PLNGAX:
+	    return (SKY_PLNGAX(coo))
+	case S_PLATAX:
+	    return (SKY_PLATAX(coo))
+	case S_XLAX:
+	    return (SKY_XLAX(coo))
+	case S_YLAX:
+	    return (SKY_YLAX(coo))
+	case S_PIXTYPE:
+	    return (SKY_PIXTYPE(coo))
+	case S_NLNGAX:
+	    return (SKY_NLNGAX(coo))
+	case S_NLATAX:
+	    return (SKY_NLATAX(coo))
+	case S_NLNGUNITS:
+	    return (SKY_NLNGUNITS(coo))
+	case S_NLATUNITS:
+	    return (SKY_NLATUNITS(coo))
+	case S_STATUS:
+	    return (SKY_STATUS(coo))
+	default:
+	    call error (0, "SKY_STATI: Unknown coordinate system parameter")
+	}
+end
+
+
+
+# SK_STATS -- Get a character string coordinate parameter.
+
+procedure sk_stats (coo, param, value, maxch)
+
+pointer	coo			#I pointer to the coordinate structure
+int	param			#I the input parameter
+char	value			#O the output string
+int	maxch			#I the maximum size of the string
+
+begin
+	switch (param) {
+	case S_COOSYSTEM:
+	    call strcpy (SKY_COOSYSTEM(coo), value, maxch)
+	default:
+	    call error (0, "SKY_GETSTR: Unknown coordinate system parameter")
+	}
+end
diff --git a/pkg/xtools/skywcs/sktransform.x b/pkg/xtools/skywcs/sktransform.x
new file mode 100644
index 00000000..a8cf87c3
--- /dev/null
+++ b/pkg/xtools/skywcs/sktransform.x
@@ -0,0 +1,577 @@
+include <math.h>
+include "skywcsdef.h"
+include "skywcs.h"
+
+# SK_ULTRAN -- Transform the sky coordinates from the input coordinate
+# system to the output coordinate system using the units conversions as
+# appropriate.
+
+procedure sk_ultran (cooin, cooout, ilng, ilat, olng, olat, npts) 
+
+pointer	cooin		#I pointer to the input coordinate system structure
+pointer	cooout		#I pointer to the output coordinate system structure
+double	ilng[ARB]	#I the input ra/longitude in radians
+double	ilat[ARB]	#I the input dec/latitude in radians
+double	olng[ARB]	#O the output ra/longitude in radians
+double	olat[ARB]	#O the output dec/latitude in radians
+int	npts		#I the number of points to be converted
+
+double	tilng, tilat, tolng, tolat
+int	i
+
+begin
+	do i = 1, npts {
+
+	    switch (SKY_NLNGUNITS(cooin)) {
+	    case SKY_HOURS:
+		tilng = DEGTORAD(15.0d0 * ilng[i])
+	    case SKY_DEGREES:
+		tilng = DEGTORAD(ilng[i])
+	    case SKY_RADIANS:
+		tilng = ilng[i]
+	    default:
+		tilng = ilng[i]
+	    }
+	    switch (SKY_NLATUNITS(cooin)) {
+	    case SKY_HOURS:
+		tilat = DEGTORAD(15.0d0 * ilat[i])
+	    case SKY_DEGREES:
+		tilat = DEGTORAD(ilat[i])
+	    case SKY_RADIANS:
+		tilat = ilat[i]
+	    default:
+		tilat = ilat[i]
+	    }
+
+	    call sk_lltran (cooin, cooout, tilng, tilat, INDEFD, INDEFD,
+		0.0d0, 0.0d0, tolng, tolat)
+
+	    switch (SKY_NLNGUNITS(cooout)) {
+	    case SKY_HOURS:
+		olng[i] = RADTODEG(tolng) / 15.0d0
+	    case SKY_DEGREES:
+		olng[i] = RADTODEG(tolng)
+	    case SKY_RADIANS:
+		olng[i] = tolng
+	    default:
+		olng[i] = tolng
+	    }
+	    switch (SKY_NLATUNITS(cooout)) {
+	    case SKY_HOURS:
+		olat[i] = RADTODEG(tolat) / 15.0d0
+	    case SKY_DEGREES:
+		olat[i] = RADTODEG(tolat)
+	    case SKY_RADIANS:
+		olat[i] = tolat
+	    default:
+		olat[i] = tolat
+	    }
+	}
+end
+
+
+# SK_LLTRAN -- Transform the sky coordinate from the input coordinate
+# system to the output coordinate system assuming that all the coordinate
+# are in radians.
+
+procedure sk_lltran (cooin, cooout, ilng, ilat, ipmlng, ipmlat, px, rv,
+	olng, olat)
+
+pointer	cooin		#I pointer to the input coordinate system structure
+pointer	cooout		#I pointer to the output coordinate system structure
+double	ilng		#I the input ra/longitude in radians
+double	ilat		#I the input dec/latitude in radians
+double	ipmlng		#I the input proper motion in ra in radians
+double	ipmlat		#I the input proper motion in dec in radians
+double	px		#I the input parallax in arcseconds
+double	rv		#I the input radial velocity in km / second
+double	olng		#O the output ra/longitude in radians
+double	olat		#O the output dec/latitude in radians
+
+int	pmflag
+double	pmr, pmd
+double	sl_epj(), sl_epb()
+
+begin
+	# Test for the case where the input coordinate system is the
+	# same as the output coordinate system.
+	if (SKY_CTYPE(cooin) == SKY_CTYPE(cooout)) {
+
+	    switch (SKY_CTYPE(cooin)) {
+
+	    case CTYPE_EQUATORIAL:
+		call sk_equatorial (cooin, cooout, ilng, ilat, ipmlng,
+		    ipmlat, px, rv, olng, olat)
+
+	    case CTYPE_ECLIPTIC:
+		if (SKY_EPOCH(cooin) == SKY_EPOCH(cooout)) {
+		    olng = ilng
+		    olat = ilat
+		} else {
+		    call sl_eceq (ilng, ilat, SKY_EPOCH(cooin), olng, olat)
+		    call sl_eqec (olng, olat, SKY_EPOCH(cooout), olng, olat)
+		}
+
+	    default:
+		olng = ilng
+		olat = ilat
+	    }
+
+	    return
+	}
+
+	# Compute proper motions ?
+	if (! IS_INDEFD(ipmlng) && ! IS_INDEFD(ipmlat))
+	    pmflag = YES
+	else
+	    pmflag = NO
+
+	# Cover the remaining cases.
+	switch (SKY_CTYPE(cooin)) {
+
+	# The input system is equatorial.
+	case CTYPE_EQUATORIAL:
+
+	    switch (SKY_RADECSYS(cooin)) {
+
+	    case EQTYPE_FK4, EQTYPE_FK4NOE:
+	        if (pmflag == YES) {
+		    call sl_pm (ilng, ilat, ipmlng, ipmlat, px, rv,
+		        sl_epb (SKY_EPOCH(cooin)), sl_epb (SKY_EPOCH(cooout)),
+			olng, olat)
+	        } else {
+		    olng = ilng
+		    olat = ilat
+	        }
+		if (SKY_RADECSYS(cooin) == EQTYPE_FK4)
+		    call sl_suet (olng, olat, SKY_EQUINOX(cooin), olng, olat)
+		if (SKY_EQUINOX(cooin) != 1950.0d0)
+		    call sl_prcs (1, SKY_EQUINOX(cooin), 1950.0d0, olng, olat) 
+		call sl_adet (olng, olat, 1950.0d0, olng, olat)
+		if (pmflag == YES)
+		    call sl_f45z (olng, olat, sl_epb(SKY_EPOCH(cooout)),
+		        olng, olat)
+		else
+		    call sl_f45z (olng, olat, sl_epb (SKY_EPOCH(cooin)),
+		        olng, olat)
+
+	    case EQTYPE_FK5:
+	        if (pmflag == YES) {
+		    call sl_pm (ilng, ilat, ipmlng, ipmlat, px, rv,
+		        sl_epj (SKY_EPOCH(cooin)), sl_epj(SKY_EPOCH(cooout)),
+			olng, olat)
+	        } else {
+	            olng = ilng
+	            olat = ilat
+		}
+		if (SKY_EQUINOX(cooin) != 2000.0d0)
+		    call sl_prcs (2, SKY_EQUINOX(cooin), 2000.0d0, olng, olat) 
+
+	    case EQTYPE_ICRS:
+	        if (pmflag == YES) {
+		    call sl_pm (ilng, ilat, ipmlng, ipmlat, px, rv,
+		        sl_epj (SKY_EPOCH(cooin)), sl_epj(SKY_EPOCH(cooout)),
+			olng, olat)
+	        } else {
+	            olng = ilng
+	            olat = ilat
+		}
+		if (SKY_EQUINOX(cooin) != 2000.0d0)
+		    call sl_prcs (2, SKY_EQUINOX(cooin), 2000.0d0, olng, olat) 
+		call sl_hf5z (olng, olat, 2000.0d0, olng, olat, pmr, pmd)
+
+	    case EQTYPE_GAPPT:
+		call sl_amp (ilng, ilat, SKY_EPOCH(cooin), 2000.0d0, olng, olat)
+
+	    }
+
+	    switch (SKY_CTYPE(cooout)) {
+
+	    # The output coordinate system is ecliptic.
+	    case CTYPE_ECLIPTIC:
+		call sl_eqec (olng, olat, SKY_EPOCH(cooout), olng, olat)
+
+	    # The output coordinate system is galactic.
+	    case CTYPE_GALACTIC:
+		call sl_eqga (olng, olat, olng, olat)
+
+	    # The output coordinate system is supergalactic.
+	    case CTYPE_SUPERGALACTIC:
+		call sl_eqga (olng, olat, olng, olat)
+		call sl_gasu (olng, olat, olng, olat)
+
+	    default:
+	        olng = ilng
+	        olat = ilat
+	    }
+
+	# The input coordinate system is ecliptic.
+	case CTYPE_ECLIPTIC:
+
+	    call sl_eceq (ilng, ilat, SKY_EPOCH(cooin), olng, olat)
+	    switch (SKY_CTYPE(cooout)) {
+
+	    # The output coordinate system is equatorial.
+	    case CTYPE_EQUATORIAL:
+
+		switch (SKY_RADECSYS(cooout)) {
+		case EQTYPE_FK4, EQTYPE_FK4NOE:
+		    call sl_f54z (olng, olat, sl_epb(SKY_EPOCH(cooout)),
+		        olng, olat, pmr, pmd)
+		    call sl_suet (olng, olat, 1950.0d0, olng, olat)
+		    if (SKY_EQUINOX(cooout) != 1950.0d0)
+			call sl_prcs (1, 1950.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+		    if (SKY_RADECSYS(cooout) == EQTYPE_FK4)
+		        call sl_adet (olng, olat, SKY_EQUINOX(cooout),
+			    olng, olat)
+
+		case EQTYPE_FK5:
+		    if (SKY_EQUINOX(cooout) != 2000.0d0)
+			call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+
+		case EQTYPE_ICRS:
+		    #call sl_f5hz (olng, olat, sl_epj(SKY_EPOCH(cooin)),
+		        #olng, olat)
+		    call sl_f5hz (olng, olat, 2000.0d0, olng, olat)
+		    if (SKY_EQUINOX(cooout) != 2000.0d0)
+			call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+
+		case EQTYPE_GAPPT:
+		    call sl_map (olng, olat, 0.0d0, 0.0d0, px, 0.0d0,
+			2000.0d0, SKY_EPOCH(cooout), olng, olat)
+		}
+
+	    # The output coordinate system is galactic.
+	    case CTYPE_GALACTIC:
+		call sl_eqga (olng, olat, olng, olat)
+
+	    # The output system is supergalactic.
+	    case CTYPE_SUPERGALACTIC:
+		call sl_eqga (olng, olat, olng, olat)
+		call sl_gasu (olng, olat, olng, olat)
+
+	    default:
+	        olng = ilng
+	        olat = ilat
+	    }
+
+	# The input coordinate system is galactic.
+	case CTYPE_GALACTIC:
+
+	    switch (SKY_CTYPE(cooout)) {
+
+	    # The output coordinate system is equatorial.
+	    case CTYPE_EQUATORIAL:
+	        call sl_gaeq (ilng, ilat, olng, olat)
+
+		switch (SKY_RADECSYS(cooout)) {
+		case EQTYPE_FK4, EQTYPE_FK4NOE:
+		    call sl_f54z (olng, olat, sl_epb(SKY_EPOCH(cooout)),
+		        olng, olat, pmr, pmd)
+		    call sl_suet (olng, olat, 1950.0d0, olng, olat)
+		    if (SKY_EQUINOX(cooout) != 1950.0d0)
+			call sl_prcs (1, 1950.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+		    if (SKY_RADECSYS(cooout) == EQTYPE_FK4)
+		        call sl_adet (olng, olat, SKY_EQUINOX(cooout),
+			    olng, olat)
+
+		case EQTYPE_FK5:
+		    if (SKY_EQUINOX(cooout) != 2000.0d0)
+			call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+
+		case EQTYPE_ICRS:
+		    call sl_f5hz (olng, olat, 2000.0d0, olng, olat)
+		    if (SKY_EQUINOX(cooout) != 2000.0d0)
+			call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+
+		case EQTYPE_GAPPT:
+		    call sl_map (olng, olat, 0.0d0, 0.0d0, px, 0.0d0,
+			2000.0d0, SKY_EPOCH(cooout), olng, olat)
+		}
+
+	    # The output coordinate system is ecliptic.
+	    case CTYPE_ECLIPTIC:
+		call sl_gaeq (ilng, ilat, olng, olat)
+		call sl_eqec (olng, olat, SKY_EPOCH(cooout), olng, olat)
+
+	    # The output coordinate system is supergalactic.
+	    case CTYPE_SUPERGALACTIC:
+		call sl_gasu (ilng, ilat, olng, olat)
+
+	    default:
+	        olng = ilng
+	        olat = ilat
+	    }
+
+	# The input coordinates are supergalactic.
+	case CTYPE_SUPERGALACTIC:
+
+	    switch (SKY_CTYPE(cooout)) {
+
+	    case CTYPE_EQUATORIAL:
+		call sl_suga (ilng, ilat, olng, olat)
+
+		switch (SKY_RADECSYS(cooout)) {
+
+		case EQTYPE_FK4:
+		    call sl_gaeq (olng, olat, olng, olat)
+		    call sl_f54z (olng, olat, sl_epb (SKY_EPOCH(cooout)),
+		        olng, olat, pmr, pmd)
+		    call sl_suet (olng, olat, 1950.0d0, olng, olat)
+		    if (SKY_EQUINOX(cooout) != 1950.0d0)
+			call sl_prcs (1, 1950.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+		    call sl_adet (olng, olat, SKY_EQUINOX(cooout), olng, olat)
+
+		case EQTYPE_FK4NOE:
+		    call sl_gaeq (olng, olat, olng, olat)
+		    call sl_f54z (olng, olat, sl_epb (SKY_EPOCH(cooout)),
+		        olng, olat, pmr, pmd)
+		    call sl_suet (olng, olat, 1950.0d0, olng, olat)
+		    if (SKY_EQUINOX(cooout) != 1950.0d0)
+			call sl_prcs (1, 1950.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+
+		case EQTYPE_FK5:
+		    call sl_gaeq (olng, olat, olng, olat)
+		    if (SKY_EQUINOX(cooout) != 2000.0d0)
+			call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+
+		case EQTYPE_ICRS:
+		    call sl_gaeq (olng, olat, olng, olat)
+		    call sl_f5hz (olng, olat, 2000.0d0, olng, olat)
+		    if (SKY_EQUINOX(cooout) != 2000.0d0)
+			call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout),
+			    olng, olat) 
+
+		case EQTYPE_GAPPT:
+		    call sl_gaeq (olng, olat, olng, olat)
+		    call sl_map (olng, olat, 0.0d0, 0.0d0, px, 0.0d0,
+			2000.0d0, SKY_EPOCH(cooout), olng, olat)
+		}
+
+	    case CTYPE_ECLIPTIC:
+		call sl_suga (ilng, ilat, olng, olat)
+		call sl_gaeq (olng, olat, olng, olat)
+		call sl_eqec (olng, olat, SKY_EPOCH(cooout), olng, olat)
+
+	    case CTYPE_GALACTIC:
+		call sl_suga (ilng, ilat, olng, olat)
+
+	    default:
+	        olng = ilng
+	        olat = ilat
+	    }
+
+	default:
+	    olng = ilng
+	    olat = ilat
+	}
+end
+
+
+# SK_EQUATORIAL -- Convert / precess equatorial coordinates.
+
+procedure sk_equatorial (cooin, cooout, ilng, ilat, ipmlng, ipmlat,
+	px, rv, olng, olat)
+
+pointer	cooin		#I the input coordinate system structure
+pointer	cooout		#I the output coordinate system structure
+double	ilng		#I the input ra in radians
+double	ilat		#I the input dec in radians
+double	ipmlng		#I the input proper motion in ra in radians
+double	ipmlat		#I the input proper motion in dec in radians
+double	px		#I the input parallax in arcseconds
+double	rv		#I the input radial valocity in km / second
+double	olng		#O the output ra in radians
+double	olat		#O the output dec in radians
+
+int	pmflag
+double	pmr, pmd
+double	sl_epb(), sl_epj()
+
+begin
+	# Check to see whether or not conversion / precession is necessary.
+	if ((SKY_RADECSYS(cooin) == SKY_RADECSYS(cooout)) &&
+	    (SKY_EQUINOX(cooin) == SKY_EQUINOX(cooout)) &&
+	    (SKY_EPOCH(cooin) == SKY_EPOCH(cooout))) {
+	    olng = ilng
+	    olat = ilat
+	    return
+	}
+
+	# Compute proper motions ?
+	if (! IS_INDEFD(ipmlng) && ! IS_INDEFD(ipmlat))
+	    pmflag = YES
+	else
+	    pmflag = NO
+
+	switch (SKY_RADECSYS(cooin)) {
+
+	# The input coordinate system is FK4 with or without the E terms.
+	case EQTYPE_FK4, EQTYPE_FK4NOE:
+
+	    if (pmflag == YES) {
+		call sl_pm (ilng, ilat, ipmlng, ipmlat, px, rv,
+		    sl_epb (SKY_EPOCH(cooin)), sl_epb (SKY_EPOCH(cooout)),
+		    olng, olat)
+	    } else {
+		olng = ilng
+		olat = ilat
+	    }
+	    if (SKY_RADECSYS(cooin) == EQTYPE_FK4)
+		call sl_suet (olng, olat, SKY_EQUINOX(cooin), olng, olat)
+	    if (SKY_EQUINOX(cooin) != 1950.0d0)
+	        call sl_prcs (1, SKY_EQUINOX(cooin), 1950.0d0, olng, olat) 
+	    call sl_adet (olng, olat, 1950.0d0, olng, olat)
+	    if (pmflag == YES)
+	        call sl_f45z (olng, olat, sl_epb (SKY_EPOCH(cooout)),
+		    olng, olat)
+	    else
+	        call sl_f45z (olng, olat, sl_epb (SKY_EPOCH(cooin)),
+		    olng, olat)
+
+	    switch (SKY_RADECSYS(cooout)) {
+
+	    # The output coordinate system is FK4 with and without the E terms.
+	    case EQTYPE_FK4, EQTYPE_FK4NOE:
+		call sl_f54z (olng, olat, sl_epb (SKY_EPOCH(cooout)),
+		    olng, olat, pmr, pmd)
+	        call sl_suet (olng, olat, 1950.0d0, olng, olat)
+		if (SKY_EQUINOX(cooout) != 1950.0d0)
+	            call sl_prcs (1, 1950.0d0, SKY_EQUINOX(cooout),
+		        olng, olat) 
+		if (SKY_RADECSYS(cooout) == EQTYPE_FK4)
+	            call sl_adet (olng, olat, SKY_EQUINOX(cooout), olng, olat)
+
+	    # The output coordinate system is FK5.
+	    case EQTYPE_FK5:
+		if (SKY_EQUINOX(cooout) != 2000.0d0)
+		    call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout), olng, olat) 
+
+	    # The output coordinate system is ICRS (Hipparcos).
+	    case EQTYPE_ICRS:
+		call sl_f5hz (olng, olat, 2000.0d0, olng, olat)
+		if (SKY_EQUINOX(cooout) != 2000.0d0)
+		    call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout), olng, olat) 
+
+	    # The output coordinate system is geocentric apparent.
+	    case EQTYPE_GAPPT:
+		call sl_map (olng, olat, 0.0d0, 0.0d0, px, 0.0d0, 2000.0d0,
+		    SKY_EPOCH(cooout), olng, olat)
+	    }
+
+	# The input coordinate system is FK5 or geocentric apparent.
+	case EQTYPE_FK5, EQTYPE_GAPPT:
+
+	    if (SKY_RADECSYS(cooin) == EQTYPE_FK5) {
+	        if (pmflag == YES) {
+		    call sl_pm (ilng, ilat, ipmlng, ipmlat, px, rv,
+		        sl_epj (SKY_EPOCH(cooin)), sl_epj (SKY_EPOCH(cooout)),
+			    olng, olat)
+	        } else {
+	            olng = ilng
+	            olat = ilat
+		}
+	    } else
+	        call sl_amp (ilng, ilat, SKY_EPOCH(cooin), 2000.0d0, olng, olat)
+
+	    switch (SKY_RADECSYS(cooout)) {
+
+	    # The output coordinate system is FK4 with or without the E terms.
+	    case EQTYPE_FK4, EQTYPE_FK4NOE:
+	        if (SKY_EQUINOX(cooin) != 2000.0d0)
+		    call sl_prcs (2, SKY_EQUINOX(cooin), 2000.0d0, olng, olat) 
+		call sl_f54z (olng, olat, sl_epb(SKY_EPOCH(cooout)),
+		    olng, olat, pmr, pmd)
+		call sl_suet (olng, olat, 1950.0d0, olng, olat)
+		if (SKY_EQUINOX(cooout) != 1950.0d0)
+		    call sl_prcs (1, 1950.0d0, SKY_EQUINOX(cooout), olng, olat) 
+		if (SKY_RADECSYS(cooout) == EQTYPE_FK4)
+	            call sl_adet (olng, olat, SKY_EQUINOX(cooout), olng, olat)
+
+	    # The output coordinate system is FK5.
+	    case EQTYPE_FK5:
+		if (SKY_EQUINOX(cooin) != SKY_EQUINOX(cooout))
+		    call sl_prcs (2, SKY_EQUINOX(cooin), SKY_EQUINOX(cooout),
+		        olng, olat) 
+
+	    # The output coordinate system is ICRS.
+	    case EQTYPE_ICRS:
+	        if (SKY_EQUINOX(cooin) != 2000.0d0)
+		    call sl_prcs (2, SKY_EQUINOX(cooin), 2000.0d0, olng, olat) 
+		call sl_f5hz (olng, olat, sl_epj(SKY_EPOCH(cooin)), olng, olat)
+	        if (SKY_EQUINOX(cooout) != 2000.0d0)
+		    call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout), olng, olat) 
+
+	    # The output coordinate system is geocentric apparent.
+	    case EQTYPE_GAPPT:
+	        if (SKY_EQUINOX(cooin) != 2000.0d0)
+		    call sl_prcs (2, SKY_EQUINOX(cooin), 2000.0d0, olng, olat) 
+		call sl_map (olng, olat, 0.0d0, 0.0d0, px, 0.0d0, 2000.0d0,
+		    SKY_EPOCH(cooout), olng, olat)
+	    }
+
+	# The input coordinate system is ICRS.
+	case EQTYPE_ICRS:
+
+	    if (pmflag == YES) {
+		call sl_pm (ilng, ilat, ipmlng, ipmlat, px, rv,
+		    sl_epj (SKY_EPOCH(cooin)), sl_epj (SKY_EPOCH(cooout)),
+		    olng, olat)
+	    } else {
+	        olng = ilng
+	        olat = ilat
+	    }
+
+	    switch (SKY_RADECSYS(cooout)) {
+
+	    # The output coordinate system is FK4 with or without the E terms.
+	    case EQTYPE_FK4, EQTYPE_FK4NOE:
+	        if (SKY_EQUINOX(cooin) != 2000.0d0)
+		    call sl_prcs (2, SKY_EQUINOX(cooin), 2000.0d0, olng, olat) 
+		call sl_hf5z (olng, olat, 2000.0d0, olng, olat,
+		    pmr, pmd)
+		call sl_f54z (olng, olat, sl_epb(SKY_EPOCH(cooout)), olng, olat,
+		    pmr, pmd)
+		call sl_suet (olng, olat, 1950.0d0, olng, olat)
+		if (SKY_EQUINOX(cooout) != 1950.0d0)
+		    call sl_prcs (1, 1950.0d0, SKY_EQUINOX(cooout), olng, olat) 
+		if (SKY_RADECSYS(cooout) == EQTYPE_FK4)
+	            call sl_adet (olng, olat, SKY_EQUINOX(cooout), olng, olat)
+
+	    # The output coordinate system is FK5.
+	    case EQTYPE_FK5:
+	        if (SKY_EQUINOX(cooin) != 2000.0d0)
+		    call sl_prcs (2, SKY_EQUINOX(cooin), 2000.0d0, olng, olat) 
+		call sl_hf5z (olng, olat, sl_epj(SKY_EPOCH(cooout)),
+		    olng, olat, pmr, pmd)
+	        if (SKY_EQUINOX(cooout) != 2000.0d0)
+		    call sl_prcs (2, 2000.0d0, SKY_EQUINOX(cooout), olng, olat) 
+
+	    # The output coordinate system is ICRS.
+	    case EQTYPE_ICRS:
+		if (SKY_EQUINOX(cooin) != SKY_EQUINOX(cooout))
+		    call sl_prcs (2, SKY_EQUINOX(cooin), SKY_EQUINOX(cooout),
+		        olng, olat) 
+
+	    # The output coordinate system is geocentric apparent.
+	    case EQTYPE_GAPPT:
+	        if (SKY_EQUINOX(cooin) != 2000.0d0)
+		    call sl_prcs (2, SKY_EQUINOX(cooin), 2000.0d0, olng, olat) 
+		call sl_hf5z (olng, olat, sl_epj(SKY_EPOCH(cooout)),
+		    olng, olat, pmr, pmd)
+		call sl_map (olng, olat, 0.0d0, 0.0d0, px, 0.0d0, 2000.0d0,
+		    SKY_EPOCH(cooout), olng, olat)
+
+	    }
+
+	}
+end
diff --git a/pkg/xtools/skywcs/skwrdstr.x b/pkg/xtools/skywcs/skwrdstr.x
new file mode 100644
index 00000000..a7c6b359
--- /dev/null
+++ b/pkg/xtools/skywcs/skwrdstr.x
@@ -0,0 +1,53 @@
+
+# SK_WRDSTR -- Search a dictionary string for a given string index number.
+# This is the opposite function of strdic(), that returns the index for
+# given string.  The entries in the dictionary string are separated by
+# a delimiter character which is the first character of the dictionary
+# string.  The index of the string found is returned as the function value.
+# Otherwise, if there is no string for that index, a zero is returned.
+
+int procedure sk_wrdstr (index, outstr, maxch, dict)
+
+int     index                   #I the string index
+char    outstr[ARB]             #O the output string as found in dictionary
+int     maxch                   #I the maximum length of output string
+char    dict[ARB]               #I the dictionary string
+
+int     i, len, start, count
+
+int     strlen()
+
+begin
+        # Clear output string
+        outstr[1] = EOS
+
+        # Return if the dictionary is not long enough
+        if (dict[1] == EOS)
+            return (0)
+
+        # Initialize counters
+        count = 1
+        len   = strlen (dict)
+
+        # Search the dictionary string. This loop only terminates
+        # successfully if the index is found. Otherwise the procedure
+        # returns with and error condition.
+        for (start = 2; count < index; start = start + 1) {
+            if (dict[start] == dict[1])
+                count = count + 1
+            if (start == len)
+                return (0)
+        }
+
+        # Extract the output string from the dictionary
+        for (i = start; dict[i] != EOS && dict[i] != dict[1]; i = i + 1) {
+            if (i - start + 1 > maxch)
+                break
+            outstr[i - start + 1] = dict[i]
+        }
+
+        outstr[i - start + 1] = EOS
+
+        # Return index for output string
+        return (count)
+end
diff --git a/pkg/xtools/skywcs/skwrite.x b/pkg/xtools/skywcs/skwrite.x
new file mode 100644
index 00000000..2e779b09
--- /dev/null
+++ b/pkg/xtools/skywcs/skwrite.x
@@ -0,0 +1,510 @@
+include "skywcsdef.h"
+include "skywcs.h"
+
+
+# SK_IIPRINT -- Print a summary of the input image or list coordinate system.
+
+procedure sk_iiprint (label, imagesys, mw, coo)
+
+char	label[ARB]		#I the input label
+char	imagesys[ARB]		#I the input image name and wcs
+pointer	mw			#I pointer to the image wcs
+pointer	coo			#I pointer to the coordinate system structure
+
+begin
+	if (mw == NULL)
+	    call sk_inprint (label, imagesys, SKY_CTYPE(coo),
+	        SKY_RADECSYS(coo), SKY_EQUINOX(coo), SKY_EPOCH(coo))
+	else
+	    call sk_imprint (label, imagesys, SKY_CTYPE(coo), SKY_PLNGAX(coo),
+	        SKY_PLATAX(coo), SKY_WTYPE(coo), SKY_PIXTYPE(coo),
+		SKY_RADECSYS(coo), SKY_EQUINOX(coo), SKY_EPOCH(coo))
+end
+
+
+# SK_IIWRITE -- Write a summary of the input image or list coordinate system
+# to the output file
+
+procedure sk_iiwrite (fd, label, imagesys, mw, coo)
+
+int	fd			#I the output file descriptor
+char	label[ARB]		#I the input label
+char	imagesys[ARB]		#I the input image name and wcs
+pointer	mw			#I pointer to the image wcs
+pointer	coo			#I pointer to the coordinate system structure
+
+begin
+	if (mw == NULL)
+	    call sk_inwrite (fd, label, imagesys, SKY_CTYPE(coo),
+	        SKY_RADECSYS(coo), SKY_EQUINOX(coo), SKY_EPOCH(coo))
+	else
+	    call sk_imwrite (fd, label, imagesys, SKY_CTYPE(coo),
+	        SKY_PLNGAX(coo), SKY_PLATAX(coo), SKY_WTYPE(coo),
+		SKY_PIXTYPE(coo), SKY_RADECSYS(coo), SKY_EQUINOX(coo),
+		SKY_EPOCH(coo))
+end
+
+
+# SK_INPRINT -- Print a summary of the input list coordinate system.
+# This should probably be a call to sk_inwrite with the file descriptor
+# set to STDOUT to avoid duplication of code. There was a reason for
+# having two routines at one point but I can't remember what it was ...
+
+procedure sk_inprint (label, system, ctype, radecsys, equinox, epoch)
+
+char	label[ARB]		#I the input label
+char	system[ARB]		#I the input system
+int	ctype			#I the input coordinate type
+int	radecsys		#I the input equatorial reference system
+double	equinox			#I the input equinox
+double	epoch			#I the input epoch of the observation
+
+pointer	sp, radecstr
+double	sl_epj(), sl_epb()
+int	sk_wrdstr()
+
+begin
+	call smark (sp)
+	call salloc (radecstr, SZ_FNAME, TY_CHAR)
+
+	switch (ctype) {
+
+	case CTYPE_EQUATORIAL:
+	    if (sk_wrdstr (radecsys, Memc[radecstr], SZ_FNAME,
+	        EQTYPE_LIST) <= 0)
+	        call strcpy ("FK5", Memc[radecstr], SZ_FNAME)
+	    call strupr (Memc[radecstr])
+	    call printf ("%s: %s  Coordinates: equatorial %s\n")
+	        call pargstr (label)
+		call pargstr (system)
+		call pargstr (Memc[radecstr])
+	    switch (radecsys) {
+	    case EQTYPE_GAPPT:
+		call printf ("    MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		    call pargd (epoch)
+		    if (IS_INDEFD(epoch)) {
+			call pargd (INDEFD)
+			call pargd (INDEFD)
+		    } else {
+		        call pargd (sl_epj (epoch))
+		        call pargd (sl_epb (epoch))
+		    }
+	    case EQTYPE_FK5, EQTYPE_ICRS:
+		call printf ("    Equinox: J%0.3f Epoch: J%0.8f MJD: %0.5f\n")
+		    call pargd (equinox)
+		    call pargd (sl_epj(epoch))
+		    call pargd (epoch)
+	    default:
+		call printf ("    Equinox: B%0.3f Epoch: B%0.8f MJD: %0.5f\n")
+		    call pargd (equinox)
+		    call pargd (sl_epb(epoch))
+		    call pargd (epoch)
+	    }
+
+	case CTYPE_ECLIPTIC:
+	    call printf ("%s: %s  Coordinates: ecliptic\n")
+		call pargstr (label)
+		call pargstr (system)
+	    call printf ("    MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		if (IS_INDEFD(epoch)) {
+		    call pargd (INDEFD)
+		    call pargd (INDEFD)
+		} else {
+		    call pargd (sl_epj(epoch))
+		    call pargd (sl_epb(epoch))
+		}
+
+	case CTYPE_GALACTIC:
+	    call printf ("%s: %s  Coordinates: galactic\n")
+		call pargstr (label)
+		call pargstr (system)
+	    call printf ("    MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		call pargd (sl_epj (epoch))
+		call pargd (sl_epb (epoch))
+
+	case CTYPE_SUPERGALACTIC:
+	    call printf ("%s: %s  Coordinates: supergalactic\n")
+		call pargstr (label)
+		call pargstr (system)
+	    call printf ("    MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		call pargd (sl_epj (epoch))
+		call pargd (sl_epb (epoch))
+
+	}
+
+	call sfree (sp)
+end
+
+
+# SK_INWRITE -- Write a summary of the input coordinate system.
+
+procedure sk_inwrite (fd, label, system, ctype, radecsys, equinox, epoch)
+
+int	fd			#I the output file descriptor
+char	label[ARB]		#I the input label
+char	system[ARB]		#I the input system
+int	ctype			#I the input coordinate type
+int	radecsys		#I the input equatorial reference system
+double	equinox			#I the input equinox
+double	epoch			#I the input epoch of the observation
+
+pointer	sp, radecstr
+double	sl_epj(), sl_epb()
+int	sk_wrdstr()
+
+begin
+	call smark (sp)
+	call salloc (radecstr, SZ_FNAME, TY_CHAR)
+
+	switch (ctype) {
+
+	case CTYPE_EQUATORIAL:
+	    if (sk_wrdstr (radecsys, Memc[radecstr], SZ_FNAME,
+	        EQTYPE_LIST) <= 0)
+	        call strcpy ("FK5", Memc[radecstr], SZ_FNAME)
+	    call strupr (Memc[radecstr])
+	    call fprintf (fd, "# %s: %s  Coordinates: equatorial %s\n")
+	        call pargstr (label)
+	        call pargstr (system)
+		call pargstr (Memc[radecstr])
+	    switch (radecsys) {
+	    case EQTYPE_GAPPT:
+		call fprintf (fd, "#     MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		    call pargd (epoch)
+		    if (IS_INDEFD(epoch)) {
+		        call pargd (INDEFD)
+		        call pargd (INDEFD)
+		    } else {
+		        call pargd (sl_epj(epoch))
+		        call pargd (sl_epb(epoch))
+		    }
+	    case EQTYPE_FK5, EQTYPE_ICRS:
+		call fprintf (fd,
+		    "#     Equinox: J%0.3f Epoch: J%0.8f MJD: %0.5f\n")
+		    call pargd (equinox)
+		    call pargd (sl_epj(epoch))
+		    call pargd (epoch)
+	    default:
+		call fprintf (fd,
+		    "#     Equinox: B%0.3f Epoch: B%0.8f MJD: %0.5f\n")
+		    call pargd (equinox)
+		    call pargd (sl_epb(epoch))
+		    call pargd (epoch)
+	    }
+
+	case CTYPE_ECLIPTIC:
+	    call fprintf (fd, "# %s: %s  Coordinates: ecliptic\n")
+		call pargstr (label)
+		call pargstr (system)
+	    call fprintf (fd, "#     MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		if (IS_INDEFD(epoch)) {
+		    call pargd (INDEFD)
+		    call pargd (INDEFD)
+		} else {
+		    call pargd (sl_epj(epoch))
+		    call pargd (sl_epb(epoch))
+		}
+
+	case CTYPE_GALACTIC:
+	    call fprintf (fd, "# %s: %s  Coordinates: galactic\n")
+		call pargstr (label)
+		call pargstr (system)
+	    call fprintf (fd, "#     MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		call pargd (sl_epj(epoch))
+		call pargd (sl_epb(epoch))
+
+	case CTYPE_SUPERGALACTIC:
+	    call fprintf (fd, "# %s: %s  Coordinates: supergalactic\n")
+		call pargstr (label)
+		call pargstr (system)
+	    call fprintf (fd, "#     MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		call pargd (sl_epj(epoch))
+		call pargd (sl_epb(epoch))
+
+	}
+
+	call sfree (sp)
+end
+
+
+# SK_IMPRINT -- Print a summary of the input image coordinate system.
+# This should probably be a call to sk_imwrite with the file descriptor
+# set to STDOUT to avoid duplication of code. There was a reason for
+# having two routines at one point but I can't remember what it was ...
+
+procedure sk_imprint (label, imagesys, ctype, lngax, latax, wtype, ptype,
+	radecsys, equinox, epoch)
+
+char	label[ARB]		#I input label
+char	imagesys[ARB]		#I the input image name and system
+int	ctype			#I the image coordinate type
+int	lngax			#I the image ra/glon/elon axis
+int	latax			#I the image dec/glat/elat axis
+int	wtype			#I the image projection type
+int	ptype			#I the image image wcs type
+int	radecsys		#I the image equatorial reference system
+double	equinox			#I the image equinox
+double	epoch			#I the image epoch of the observation
+
+pointer	sp, imname, projstr, wcsstr, radecstr
+double	sl_epj(), sl_epb()
+int	sk_wrdstr()
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (projstr, SZ_FNAME, TY_CHAR)
+	call salloc (wcsstr, SZ_FNAME, TY_CHAR)
+	call salloc (radecstr, SZ_FNAME, TY_CHAR)
+
+	call sscan (imagesys)
+	    call gargwrd (Memc[imname], SZ_FNAME)
+	if (sk_wrdstr (wtype, Memc[projstr], SZ_FNAME, WTYPE_LIST) <= 0)
+	    call strcpy ("linear", Memc[projstr], SZ_FNAME)
+	call strupr (Memc[projstr])
+	if (sk_wrdstr (ptype, Memc[wcsstr], SZ_FNAME, PIXTYPE_LIST) <= 0)
+	    call strcpy ("world", Memc[wcsstr], SZ_FNAME)
+	call strlwr (Memc[wcsstr])
+
+	switch (ctype) {
+
+	case CTYPE_EQUATORIAL:
+	    if (sk_wrdstr (radecsys, Memc[radecstr], SZ_FNAME,
+	        EQTYPE_LIST) <= 0)
+	        call strcpy ("FK5", Memc[radecstr], SZ_FNAME)
+	    call strupr (Memc[radecstr])
+	    call printf (
+	    "%s: %s %s  Projection: %s  Ra/Dec axes: %d/%d\n")
+		call pargstr (label)
+		call pargstr (Memc[imname])
+		call pargstr (Memc[wcsstr])
+	        call pargstr (Memc[projstr])
+	        call pargi (lngax)
+	        call pargi (latax)
+	    switch (radecsys) {
+	    case EQTYPE_GAPPT:
+	        call printf ("    Coordinates: equatorial %s\n")
+		    call pargstr (Memc[radecstr])
+		call printf ("    MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		    call pargd (epoch)
+		    if (IS_INDEFD(epoch)) {
+			call pargd (INDEFD)
+			call pargd (INDEFD)
+		    } else {
+		        call pargd (sl_epj(epoch))
+		        call pargd (sl_epb(epoch))
+		    }
+	    case EQTYPE_FK5, EQTYPE_ICRS:
+	        call printf ("    Coordinates: equatorial %s Equinox: J%0.3f\n")
+		    call pargstr (Memc[radecstr])
+		    call pargd (equinox)
+	        call printf ("    Epoch: J%0.8f MJD: %0.5f\n")
+		    call pargd (sl_epj (epoch))
+		    call pargd (epoch)
+	    default:
+	        call printf ("    Coordinates: equatorial %s Equinox: B%0.3f\n")
+		    call pargstr (Memc[radecstr])
+		    call pargd (equinox)
+	        call printf ("    Epoch: B%0.8f MJD: %0.5f\n")
+		    call pargd (sl_epb (epoch))
+		    call pargd (epoch)
+	    }
+
+	case CTYPE_ECLIPTIC:
+	    call printf (
+	    "%s: %s %s  Projection: %s  Elong/Elat axes: %d/%d\n")
+		call pargstr (label)
+		call pargstr (Memc[imname])
+		call pargstr (Memc[wcsstr])
+	        call pargstr (Memc[projstr])
+	        call pargi (lngax)
+	        call pargi (latax)
+	    call printf ("    Coordinates: ecliptic\n")
+	    call printf ("    MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		if (IS_INDEFD(epoch)) {
+		    call pargd (INDEFD)
+		    call pargd (INDEFD)
+		} else {
+		    call pargd (sl_epj(epoch))
+		    call pargd (sl_epb(epoch))
+		}
+
+	case CTYPE_GALACTIC:
+	    call printf (
+	    "%s: %s %s  Projection: %s  Glong/Glat axes: %d/%d\n")
+		call pargstr (label)
+		call pargstr (Memc[imname])
+		call pargstr (Memc[wcsstr])
+	        call pargstr (Memc[projstr])
+	        call pargi (lngax)
+	        call pargi (latax)
+	    call printf ("    Coordinates: galactic\n")
+	    call printf ("    MJD: %0.5f  Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		call pargd (sl_epj (epoch))
+		call pargd (sl_epb (epoch))
+
+	case CTYPE_SUPERGALACTIC:
+	    call printf (
+	    "%s: %s %s  Projection: %s  Slong/Slat axes: %d/%d\n")
+		call pargstr (label)
+		call pargstr (Memc[imname])
+		call pargstr (Memc[wcsstr])
+	        call pargstr (Memc[projstr])
+	        call pargi (lngax)
+	        call pargi (latax)
+	    call printf ("    Coordinates: supergalactic\n")
+	    call printf ("    MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		call pargd (sl_epj (epoch))
+		call pargd (sl_epb (epoch))
+	}
+
+	call sfree (sp)
+end
+
+
+# SK_IMWRITE -- Write a summary of the image coordinate system to the
+# output file.
+
+procedure sk_imwrite (fd, label, imagesys, ctype, lngax, latax, wtype, ptype,
+	radecsys, equinox, epoch)
+
+int	fd			#I the output file descriptor
+char	label[ARB]		#I input label
+char	imagesys[ARB]		#I the input image name and wcs
+int	ctype			#I the image coordinate type
+int	lngax			#I the image ra/glon/elon axis
+int	latax			#I the image dec/glat/elat axis
+int	wtype			#I the image projection type
+int	ptype			#I the image image wcs type
+int	radecsys		#I the image equatorial reference system
+double	equinox			#I the image equinox
+double	epoch			#I the image epoch of the observation
+
+pointer	sp, imname, projstr, wcsstr, radecstr
+double	sl_epj(), sl_epb()
+int	sk_wrdstr()
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (projstr, SZ_FNAME, TY_CHAR)
+	call salloc (wcsstr, SZ_FNAME, TY_CHAR)
+	call salloc (radecstr, SZ_FNAME, TY_CHAR)
+
+	call sscan (imagesys)
+	    call gargwrd (Memc[imname], SZ_FNAME)
+	if (sk_wrdstr (wtype, Memc[projstr], SZ_FNAME, WTYPE_LIST) <= 0)
+	    call strcpy ("linear", Memc[projstr], SZ_FNAME)
+	call strupr (Memc[projstr])
+	if (sk_wrdstr (ptype, Memc[wcsstr], SZ_FNAME, PIXTYPE_LIST) <= 0)
+	    call strcpy ("world", Memc[wcsstr], SZ_FNAME)
+	call strlwr (Memc[wcsstr])
+
+	switch (ctype) {
+
+	case CTYPE_EQUATORIAL:
+	    if (sk_wrdstr (radecsys, Memc[radecstr], SZ_FNAME,
+	        EQTYPE_LIST) <= 0)
+	        call strcpy ("FK5", Memc[radecstr], SZ_FNAME)
+	    call strupr (Memc[radecstr])
+	    call fprintf (fd,
+	    "# %s: %s %s  Projection: %s  Ra/Dec axes: %d/%d\n")
+		call pargstr (label)
+		call pargstr (Memc[imname])
+		call pargstr (Memc[wcsstr])
+	        call pargstr (Memc[projstr])
+	        call pargi (lngax)
+	        call pargi (latax)
+	    switch (radecsys) {
+	    case EQTYPE_GAPPT:
+	        call fprintf (fd, "#     Coordinates: equatorial %s\n")
+		    call pargstr (Memc[radecstr])
+		call fprintf (fd, "#     MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		    call pargd (epoch)
+		    if (IS_INDEFD(epoch)) {
+		        call pargd (INDEFD)
+		        call pargd (INDEFD)
+		    } else {
+		        call pargd (sl_epj(epoch))
+		        call pargd (sl_epb(epoch))
+		    }
+	    case EQTYPE_FK5, EQTYPE_ICRS:
+	        call fprintf (fd,
+		    "#     Coordinates: equatorial %s Equinox: J%0.3f\n")
+		    call pargstr (Memc[radecstr])
+		    call pargd (equinox)
+	        call fprintf (fd, "#     Epoch: J%0.8f MJD: %0.5f\n")
+		    call pargd (sl_epj(epoch))
+		    call pargd (epoch)
+	    default:
+	        call fprintf (fd,
+		    "#     Coordinates: equatorial %s Equinox: B%0.3f\n")
+		    call pargstr (Memc[radecstr])
+		    call pargd (equinox)
+	        call fprintf (fd, "#     Epoch: B%0.8f MJD: %0.5f\n")
+		    call pargd (sl_epb (epoch))
+		    call pargd (epoch)
+	    }
+
+	case CTYPE_ECLIPTIC:
+	    call fprintf (fd,
+	    "# %s: %s %s  Projection: %s  Elong/Elat axes: %d/%d\n")
+		call pargstr (label)
+		call pargstr (Memc[imname])
+		call pargstr (Memc[wcsstr])
+	        call pargstr (Memc[projstr])
+	        call pargi (lngax)
+	        call pargi (latax)
+	    call fprintf (fd, "#     Coordinates: ecliptic\n")
+	    call fprintf (fd, "#     MJD: %0.5f  Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		if (IS_INDEFD(epoch)) {
+		    call pargd (INDEFD)
+		    call pargd (INDEFD)
+		} else {
+		    call pargd (sl_epj(epoch))
+		    call pargd (sl_epb(epoch))
+		}
+
+	case CTYPE_GALACTIC:
+	    call fprintf (fd,
+	    "# %s: %s %s  Projection: %s  Glong/Glat axes: %d/%d\n")
+		call pargstr (label)
+		call pargstr (Memc[imname])
+		call pargstr (Memc[wcsstr])
+	        call pargstr (Memc[projstr])
+	        call pargi (lngax)
+	        call pargi (latax)
+	    call fprintf (fd, "#     Coordinates: galactic\n")
+	    call fprintf (fd, "#     MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		call pargd (sl_epj(epoch))
+		call pargd (sl_epb(epoch))
+
+	case CTYPE_SUPERGALACTIC:
+	    call fprintf (fd,
+	    "# %s: %s %s  Projection: %s  Slong/Slat axes: %d/%d\n")
+		call pargstr (label)
+		call pargstr (Memc[imname])
+		call pargstr (Memc[wcsstr])
+	        call pargstr (Memc[projstr])
+	        call pargi (lngax)
+	        call pargi (latax)
+	    call fprintf (fd, "#     Coordinates: supergalactic\n")
+	    call fprintf (fd, "#     MJD: %0.5f Epoch: J%0.8f B%0.8f\n")
+		call pargd (epoch)
+		call pargd (sl_epj(epoch))
+		call pargd (sl_epb(epoch))
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/skywcs/skywcs.h b/pkg/xtools/skywcs/skywcs.h
new file mode 100644
index 00000000..85b664c0
--- /dev/null
+++ b/pkg/xtools/skywcs/skywcs.h
@@ -0,0 +1,133 @@
+# Public definitions file for the SKYWCS library.
+
+# Define the SKYWCS library parameters.
+
+define	S_VXOFF		1
+define	S_VYOFF		2
+define	S_VXSTEP	3
+define	S_VYSTEP	4
+define	S_EQUINOX	5
+define	S_EPOCH		6
+define	S_CTYPE		7
+define	S_RADECSYS	8
+define	S_WTYPE		9
+define	S_PLNGAX	10
+define	S_PLATAX	11
+define	S_XLAX		12
+define	S_YLAX		13
+define	S_PIXTYPE	14
+define	S_NLNGAX	15
+define	S_NLATAX	16
+define	S_NLNGUNITS	17
+define	S_NLATUNITS	18
+define	S_COOSYSTEM	19
+define	S_STATUS	20
+
+# Define the list of supported fundamental coordinate systems.
+
+define	FTYPE_LIST	"|fk4|noefk4|fk5|icrs|apparent|ecliptic|galactic|\
+supergalactic|"
+
+define	FTYPE_FK4		1
+define	FTYPE_FK4NOE		2
+define	FTYPE_FK5		3
+define	FTYPE_ICRS		4
+define	FTYPE_GAPPT		5
+define	FTYPE_ECLIPTIC		6
+define	FTYPE_GALACTIC		7
+define	FTYPE_SUPERGALACTIC	8
+
+# Define the list of supported coordinate systems.
+
+define	CTYPE_LIST	"|equatorial|ecliptic|galactic|supergalactic|"
+
+define	CTYPE_EQUATORIAL	1
+define	CTYPE_ECLIPTIC		2
+define	CTYPE_GALACTIC		3
+define	CTYPE_SUPERGALACTIC	4
+
+# Define the supported equatoral reference systems.
+
+define  EQTYPE_LIST     "|fk4|fk4-no-e|fk5|icrs|gappt|"
+
+define	EQTYPE_FK4	1
+define	EQTYPE_FK4NOE	2
+define	EQTYPE_FK5	3
+define	EQTYPE_ICRS	4
+define	EQTYPE_GAPPT	5
+
+# Define the input coordinate file longitude latitude units.
+
+define	SKY_LNG_UNITLIST	"|degrees|radians|hours|"
+define	SKY_LAT_UNITLIST	"|degrees|radians|"
+
+define	SKY_DEGREES	1
+define	SKY_RADIANS	2
+define	SKY_HOURS	3
+
+# Define the list of supported image sky projection types.
+
+define  WTYPE_LIST      "|lin|azp|tan|sin|stg|arc|zpn|zea|air|cyp|car|\
+mer|cea|cop|cod|coe|coo|bon|pco|gls|par|ait|mol|csc|qsc|tsc|tnx|zpx|tpv|"
+
+define  PTYPE_LIST      "|z|z|z|z|z|z|z|z|z|c|c|c|c|n|n|n|n|c|c|c|c|c|c|c|c|c|\
+x|x|z|"
+
+define  WTYPE_LIN       1
+define  WTYPE_AZP       2
+define  WTYPE_TAN       3
+define  WTYPE_SIN       4
+define  WTYPE_STG       5
+define  WTYPE_ARC       6
+define  WTYPE_ZPN       7
+define  WTYPE_ZEA       8
+define  WTYPE_AIR       9
+define  WTYPE_CYP       10
+define  WTYPE_CAR       11
+define  WTYPE_MER       12
+define  WTYPE_CEA       13
+define  WTYPE_COP       14
+define  WTYPE_COD       15
+define  WTYPE_COE       16
+define  WTYPE_COO       17
+define  WTYPE_BON       18
+define  WTYPE_PCO       19
+define  WTYPE_GLS       20
+define  WTYPE_PAR       21
+define  WTYPE_AIT       22
+define  WTYPE_MOL       23
+define  WTYPE_CSC       24
+define  WTYPE_QSC       25
+define  WTYPE_TSC       26
+define  WTYPE_TNX       27
+define  WTYPE_ZPX       28
+define  WTYPE_TPV       29
+
+define  PTYPE_NAMES     "|z|c|n|x|"
+
+define  PTYPE_ZEN       1
+define  PTYPE_CYL       2
+define  PTYPE_CON       3
+define  PTYPE_EXP       4
+
+# Define the supported image axis types.
+
+define  AXTYPE_LIST     "|ra|dec|glon|glat|elon|elat|slon|slat|"
+
+define  AXTYPE_RA       1
+define  AXTYPE_DEC      2
+define  AXTYPE_GLON     3
+define  AXTYPE_GLAT     4
+define  AXTYPE_ELON     5
+define  AXTYPE_ELAT     6
+define  AXTYPE_SLON     7
+define  AXTYPE_SLAT     8
+
+# Define the supported image pixel coordinate systems.
+
+define	PIXTYPE_LIST	"|logical|tv|physical|world|"
+
+define  PIXTYPE_LOGICAL		1
+define  PIXTYPE_TV		2
+define  PIXTYPE_PHYSICAL	3
+define  PIXTYPE_WORLD		4
diff --git a/pkg/xtools/skywcs/skywcsdef.h b/pkg/xtools/skywcs/skywcsdef.h
new file mode 100644
index 00000000..433247bd
--- /dev/null
+++ b/pkg/xtools/skywcs/skywcsdef.h
@@ -0,0 +1,24 @@
+# The SKYWCS library structure.
+
+define	LEN_SKYCOOSTRUCT	(30 + SZ_FNAME + 1)
+
+define	SKY_VXOFF	Memd[P2D($1)]	    # logical ra/longitude offset
+define	SKY_VYOFF	Memd[P2D($1+2)]	    # logical dec/tatitude offset
+define	SKY_VXSTEP	Memd[P2D($1+4)]	    # logical ra/longitude stepsize
+define	SKY_VYSTEP	Memd[P2D($1+6)]	    # logical dec/latitude stepsize
+define	SKY_EQUINOX	Memd[P2D($1+8)]	    # equinox of ra/dec system (B or J)
+define	SKY_EPOCH	Memd[P2D($1+10)]    # epoch of observation (MJD)
+define	SKY_CTYPE	Memi[$1+12]	    # celestial coordinate system code
+define	SKY_RADECSYS	Memi[$1+13]	    # ra/dec system code
+define	SKY_WTYPE	Memi[$1+14]	    # sky projection function code
+define	SKY_PLNGAX	Memi[$1+15]	    # physical ra/longitude axis
+define	SKY_PLATAX	Memi[$1+16]	    # physical dec/latitude axis
+define	SKY_XLAX	Memi[$1+17]	    # logical ra/longitude axis
+define	SKY_YLAX	Memi[$1+18]	    # logical dec/latitude axis
+define	SKY_PIXTYPE	Memi[$1+19]	    # iraf wcs system code
+define	SKY_NLNGAX	Memi[$1+20]	    # length of ra/longitude axis
+define	SKY_NLATAX	Memi[$1+21]	    # length of dec/latitude axis
+define	SKY_NLNGUNITS	Memi[$1+22]	    # the native ra/longitude units
+define	SKY_NLATUNITS	Memi[$1+23]	    # the native dec/latitude units
+define	SKY_STATUS	Memi[$1+24]	    # the status (OK or ERR)
+define	SKY_COOSYSTEM	Memc[P2C($1+25)]    # the coordinate system name
diff --git a/pkg/xtools/strdetab.x b/pkg/xtools/strdetab.x
new file mode 100644
index 00000000..9ce99675
--- /dev/null
+++ b/pkg/xtools/strdetab.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRDETAB -- Procedure to remove tabs from a line of text and replace with
+# blanks.
+
+procedure strdetab (line, outline, maxch, tabsize)
+
+int   ip, op, maxch, tabsize
+char  line[ARB], outline [ARB]
+
+begin
+	op=1
+	ip=1
+
+	while (line[ip] != EOS && op <= maxch) {
+	    if (line[ip] == '\t') {
+		repeat {
+		    outline[op] = ' '
+		    op = op + 1
+		} until ((mod (op, tabsize) == 1) || (op > maxch)) 
+	        ip = ip + 1
+	    } else {
+		outline[op] = line[ip]
+		op = op + 1
+		ip = ip + 1
+	    }
+	}
+
+	outline[op] = EOS
+end
diff --git a/pkg/xtools/strentab.x b/pkg/xtools/strentab.x
new file mode 100644
index 00000000..e2173c47
--- /dev/null
+++ b/pkg/xtools/strentab.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# STRENTAB -- Procedure to replace blanks with tabs and blanks.
+
+procedure strentab (line, outline, maxch, tabsize)
+
+int   maxch, tabsize
+char  line[ARB], outline[ARB]
+
+int   ip, op, ltab
+
+begin
+	op = 1
+	ip = 1
+
+	repeat {
+	    ltab = ip
+	    while (line[ltab] == ' ' && op <= maxch) {
+		ltab = ltab + 1
+		if (mod(ltab, tabsize) == 1) {
+		    outline[op] = '\t'
+		    ip = ltab
+		    op = op + 1
+		}
+	    }
+	    for (; ip < ltab && op <= maxch; ip = ip + 1) {
+		outline[op] = ' '
+		op = op + 1
+	    }
+	    if (line[ip] == EOS || op >= maxch+1)
+		break
+	    outline[op] = line[ip]
+	    op = op + 1
+	    ip = ip + 1
+	} until (line[ip] == EOS || op >= maxch+1)
+
+	outline[op] = EOS
+end
diff --git a/pkg/xtools/syshost.x b/pkg/xtools/syshost.x
new file mode 100644
index 00000000..8136e3ae
--- /dev/null
+++ b/pkg/xtools/syshost.x
@@ -0,0 +1,232 @@
+include	<clset.h>
+include	<ctotok.h>
+
+
+# SYSHOST -- If a task which calls this routine is executed from the host
+# command line (i.e. not through a CL) set any parameters not set on the
+# command line (e.g. with keyword=value or @file arguments).  The application
+# provides three files to search in order.  The first two are keyword=value
+# files and the last is a parameter file.  The parameter file may be encoded
+# as a compiled procedure (see txtcompile).  For this reason xt_txtopen is
+# used which transparently handles disk text files and text encoding
+# procedures.
+#
+# The process type is the return value.
+# The show_pset argument is the name of a boolean parameter to query
+# for showing the default parameter set.  The value of this is returned
+# for show_val.  If the parameter is not used (a null string) or was
+# not specified by the user the return value is false.
+
+int procedure syshost (keyfile1, keyfile2, parfile, show_pset, show_val)
+
+char	keyfile1[ARB]			#I Keyword file
+char	keyfile2[ARB]			#I Keyword file
+char	parfile[ARB]			#I Parameter file
+char	show_pset[ARB]			#I Parameter for requestiong show
+bool	show_val			#O Result of show request
+int	stat				#R Return value
+
+char	line[SZ_LINE], param[SZ_FNAME], value[SZ_LINE]
+int	i, ip, fd, tok
+
+bool	clgetb(), streq()
+int	clstati(), access(), fscan(), ctotok(), strncmp(), xt_txtopen()
+pointer	clc_find()
+errchk	xt_getpars, xt_txtopen
+
+begin
+	# Check if the task is called from the host.
+	stat = clstati (CL_PRTYPE)
+	if (stat != PR_HOST)
+	    return (stat)
+
+	# Read user keyword=value files.
+	if (keyfile1[1] != EOS && access(keyfile1,0,0) == YES)
+	    call xt_getpars (keyfile1)
+	if (keyfile2[1] != EOS && access(keyfile2,0,0) == YES)
+	    call xt_getpars (keyfile2)
+
+	# Read parameter file.
+	if (parfile[1] != EOS &&
+	    (access(parfile,0,0)==YES || strncmp (parfile, "proc:", 5)==0)) {
+
+	    # Open parameter file.
+	    fd = NULL
+	    fd = xt_txtopen (parfile)
+
+	    # Check for request to show default parameters.
+	    if (show_pset[1] != EOS && clc_find(show_pset,param,SZ_FNAME)>0)
+	        show_val = clgetb (show_pset)
+	    else
+	        show_val = false
+	    
+	    # Scan parameter file lines and parse them.
+	    while (fscan (fd) != EOF) {
+		call gargstr (line, SZ_LINE)
+
+		ip = 1
+		if (ctotok (line, ip, param, SZ_FNAME) != TOK_IDENTIFIER)
+		    next
+		if (streq (param, "mode"))
+		    next
+		for (i=0; i<3 && ctotok(line,ip,value,SZ_LINE)!=TOK_EOS;) {
+		    if (value[1] == ',')
+			i = i + 1
+		}
+		tok = ctotok (line, ip, value, SZ_LINE)
+		switch (tok) {
+		case TOK_NUMBER, TOK_STRING, TOK_IDENTIFIER:
+		    ;
+		default:
+		    value[1] = EOS
+		}
+
+		# Enter in clcache if not already defined.
+		if (clc_find (param, line, SZ_LINE) == NULL)
+		    call clc_enter (param, value)
+
+		# Show parameter if desired.
+		if (show_val) {
+		    switch (tok) {
+		    case TOK_STRING:
+			call printf ("%s = ""%s""\n")
+			    call pargstr (param)
+			    call pargstr (value)
+		    default:
+			call printf ("%s = %s\n")
+			    call pargstr (param)
+			    call pargstr (value)
+		    }
+		}
+	    }
+
+	    # Close parameter file.
+	    call xt_txtclose (fd)
+	}
+
+	return (stat)
+end
+
+
+# The following are copies of sys_getpars and sys_paramset with the
+# following changes.
+#   - Return an error rather than a warning for a bad syntax
+#   - Enter parameter in CL cache only if not previously set
+
+
+include	<ctype.h>
+
+define	SZ_VALSTR	1024
+define	SZ_CMDBUF	(SZ_COMMAND+1024)
+
+# XT_GETPARS -- Read a sequence of param=value parameter assignments from
+# the named file and enter them into the CLIO cache for the task.
+
+procedure xt_getpars (fname)
+
+char	fname			# pset file
+
+bool	skip
+int	lineno, fd
+pointer	sp, lbuf, err, ip
+int	open(), getlline()
+errchk	open, getlline
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_CMDBUF, TY_CHAR)
+
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	# Skip whitespace for param = value args in a par file.
+	skip = true
+
+	lineno = 0
+	while (getlline (fd, Memc[lbuf], SZ_CMDBUF) != EOF) {
+	    lineno = lineno + 1
+	    for (ip=lbuf;  IS_WHITE (Memc[ip]);  ip=ip+1)
+		;
+	    if (Memc[ip] == '#' || Memc[ip] == '\n')
+		next
+	    iferr (call xt_paramset (Memc, ip, skip)) {
+		for (;  Memc[ip] != EOS && Memc[ip] != '\n';  ip=ip+1)
+		    ;
+		Memc[ip] = EOS
+		call salloc (err, SZ_LINE, TY_CHAR)
+		call sprintf (Memc[err], SZ_LINE,
+		    "Bad param assignment, line %d: `%s'\n")
+		    call pargi (lineno)
+		    call pargstr (Memc[lbuf])
+		call close (fd)
+		call error (1, Memc[err])
+	    }
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# XT_PARAMSET -- Extract the param and value substrings from a param=value
+# or switch argument and enter them into the CL parameter cache.  (see also
+# clio.clcache).
+
+procedure xt_paramset (args, ip, skip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer to first char of argument
+bool	skip			# skip whitespace within "param=value" args
+
+pointer	sp, param, value, op, clc_find()
+int	stridx()
+
+begin
+	call smark (sp)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+	call salloc (value, SZ_VALSTR, TY_CHAR)
+
+	# Extract the param field.
+	op = param
+	while (IS_ALNUM (args[ip]) || stridx (args[ip], "_.$") > 0) {
+	    Memc[op] = args[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	Memc[op] = EOS
+
+	# Advance to the switch character or assignment operator.
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case '+':
+	    # Boolean switch "yes".
+	    ip = ip + 1
+	    call strcpy ("yes", Memc[value], SZ_VALSTR)
+	
+	case '-':
+	    # Boolean switch "no".
+	    ip = ip + 1
+	    call strcpy ("no", Memc[value], SZ_VALSTR)
+
+	case '=':
+	    # Extract the value field.  This is either a quoted string or a
+	    # string delimited by any of the metacharacters listed below.
+
+	    ip = ip + 1
+	    if (skip) {
+		while (IS_WHITE (args[ip]))
+		    ip = ip + 1
+	    }
+	    call sys_gstrarg (args, ip, Memc[value], SZ_VALSTR)
+
+	default:
+	    call error (1, "IRAF Main: command syntax error")
+	}
+
+	# Enter the param=value pair into the CL parameter cache.
+	if (clc_find (Memc[param], Memc[param], SZ_FNAME) == NULL)
+	    call clc_enter (Memc[param], Memc[value])
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/t_txtcompile.x b/pkg/xtools/t_txtcompile.x
new file mode 100644
index 00000000..1d4b8be4
--- /dev/null
+++ b/pkg/xtools/t_txtcompile.x
@@ -0,0 +1,62 @@
+include	<fset.h>
+
+task	txtcompile = t_txtcompile
+
+
+# T_TXTCOMPILE -- Compile a text file into an SPP routine.
+
+procedure t_txtcompile ()
+
+char	input[SZ_FNAME]
+char	output[SZ_FNAME]
+char	procname[SZ_FNAME]
+
+char	line[SZ_LINE]
+int	i, in, out, fsize
+
+int	open(), fstati(), fscan()
+errchk	open, stropen
+
+begin
+	call clgstr ("input", input, SZ_FNAME)
+	call clgstr ("output", output, SZ_FNAME)
+	call clgstr ("procname", procname, SZ_FNAME)
+
+	# Open files.
+	in = open (input, READ_ONLY, TEXT_FILE)
+	out = open (output, APPEND, TEXT_FILE)
+
+	# Get input file size.
+	fsize = 2 * fstati (in, F_FILESIZE)
+
+	# Write preamble.
+	call fprintf (out, "\n\nprocedure %s (xqzrkc)\n\n")
+	    call pargstr (procname)
+	call fprintf (out, "pointer\txqzrkc\n\n")
+	call fprintf (out, "int\tfd, stropen()\n")
+	call fprintf (out, "errchk\tmalloc\n\nbegin\n")
+	call fprintf (out, "\tcall malloc (xqzrkc, %d, TY_CHAR)\n")
+	    call pargi (fsize)
+	call fprintf (out, "\tfd = stropen (Memc[xqzrkc], ARB, NEW_FILE)\n")
+
+	# Write text.
+	while (fscan (in) != EOF) {
+	    call gargstr (line, SZ_LINE)
+	    call fprintf (out, "\tcall fprintf (fd, """)
+	    for (i=1; line[i]!=EOS; i=i+1) {
+		switch (line[i]) {
+		case '"', '%':
+		    call putc (out, line[i])
+		}
+		call putc (out, line[i])
+	    }
+	    call fprintf (out, "\\\\n"")\n")
+	}
+
+	# Write postamble.
+	call fprintf (out, "\tcall close (fd)\nend\n")
+
+	# Close the files.
+	call close (out)
+	call close (in)
+end
diff --git a/pkg/xtools/txtcompile b/pkg/xtools/txtcompile
new file mode 100755
index 00000000..b763cc92
--- /dev/null
+++ b/pkg/xtools/txtcompile
@@ -0,0 +1,3 @@
+#
+
+$iraf/bin$arch/x_txtcompile.e txtcompile input=$1 output=$2 procname=$3
diff --git a/pkg/xtools/xt21imsum.x b/pkg/xtools/xt21imsum.x
new file mode 100644
index 00000000..ba0461e1
--- /dev/null
+++ b/pkg/xtools/xt21imsum.x
@@ -0,0 +1,148 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# XT_21IMSUM -- Sum 2D image columns or lines to 1D.
+
+procedure xt_21imsum (im, axis, col1, col2, line1, line2, x, y, npts)
+
+pointer	im			# IMIO pointer
+int	axis			# Axis of vector
+int	col1, col2		# Range of columns
+int	line1, line2		# Range of lines
+pointer	x			# Vector ordinates
+pointer	y			# Vector abscissa
+int	npts			# Number of points in vector
+
+int	i, line, ncols, nlines
+
+real	asumr()
+pointer	imgs2r()
+
+begin
+	# If the pointers are defined first free them.
+
+	call mfree (x, TY_REAL)
+	call mfree (y, TY_REAL)
+
+	ncols = col2 - col1 + 1
+	nlines = line2 - line1 + 1
+
+	switch (axis) {
+	case 1:
+	    npts = ncols
+	    call malloc (x, ncols, TY_REAL)
+	    call calloc (y, ncols, TY_REAL)
+
+	    do i = 1, ncols
+	        Memr[x+i-1] = col1 + i - 1
+
+	    do i = 1, nlines {
+		line = line1 + i - 1
+	        call aaddr (Memr[imgs2r (im, col1, col2, line, line)], Memr[y],
+		    Memr[y], ncols)
+	    }
+	case 2:
+	    npts = nlines
+	    call malloc (x, nlines, TY_REAL)
+	    call malloc (y, nlines, TY_REAL)
+
+	    do i = 1, nlines {
+		line = line1 + i - 1
+	        Memr[x+i-1] = line
+	        Memr[y+i-1] = asumr (Memr[imgs2r (im, col1, col2, line, line)],
+		    ncols)
+	    }
+	}
+end
+
+# XT_21IMMED -- Median 2D image columns or lines to 1D.
+
+define	MAXPIX	10000	# Maximum number of pixels to read at one time.
+
+procedure xt_21immed (im, axis, col1, col2, line1, line2, x, y, npts)
+
+pointer	im			# IMIO pointer
+int	axis			# Axis of vector
+int	col1, col2		# Range of columns
+int	line1, line2		# Range of lines
+pointer	x			# Vector ordinates
+pointer	y			# Vector abscissa
+int	npts			# Number of points in vector
+
+int	i, j, k, n, line, ncols, nlines, maxncols
+pointer	buf1, buf2
+
+real	amedr()
+pointer	imgs2r()
+
+begin
+	# If the pointers are defined first free them.
+
+	call mfree (x, TY_REAL)
+	call mfree (y, TY_REAL)
+
+	ncols = col2 - col1 + 1
+	nlines = line2 - line1 + 1
+
+	switch (axis) {
+	case 1:
+	    npts = ncols
+	    call malloc (x, ncols, TY_REAL)
+	    call calloc (y, ncols, TY_REAL)
+	    call malloc (buf1, nlines, TY_REAL)
+
+	    maxncols = MAXPIX / nlines
+	    j = 0
+	    do i = 1, ncols {
+		if (i > j) {
+	            n = min (ncols - j, maxncols)
+		    buf2 = imgs2r (im, col1+j, col1+j+n-1, line1, line2)
+		    j = j + n
+		}
+		do k = 1, nlines
+		    Memr[buf1+k-1] = Memr[buf2+(k-1)*n+i-1]
+		Memr[y+i-1] = amedr (Memr[buf1], nlines)
+	    }
+
+	    call mfree (buf1, TY_REAL)
+
+	    do i = 1, ncols
+	        Memr[x+i-1] = col1 + i - 1
+	case 2:
+	    npts = nlines
+	    call malloc (x, nlines, TY_REAL)
+	    call malloc (y, nlines, TY_REAL)
+
+	    do i = 1, nlines {
+		line = line1 + i - 1
+	        Memr[x+i-1] = line
+	        Memr[y+i-1] = amedr (Memr[imgs2r (im, col1, col2, line, line)],
+		    ncols)
+	    }
+	}
+end
+
+
+# XT_21IMAVG -- Average 2D image columns or lines to 1D.
+
+procedure xt_21imavg (im, axis, col1, col2, line1, line2, x, y, npts)
+
+pointer	im			# IMIO pointer
+int	axis			# Axis of vector
+int	col1, col2		# Range of columns
+int	line1, line2		# Range of lines
+pointer	x			# Vector ordinates
+pointer	y			# Vector abscissa
+int	npts			# Number of points in vector
+
+begin
+	call xt_21imsum (im, axis, col1, col2, line1, line2, x, y, npts)
+
+	switch (axis) {
+	case 1:
+	    call adivkr (Memr[y], real (line2-line1+1), Memr[y], npts)
+	case 2:
+	    call adivkr (Memr[y], real (col2-col1+1), Memr[y], npts)
+	}
+end
diff --git a/pkg/xtools/xtanswer.h b/pkg/xtools/xtanswer.h
new file mode 100644
index 00000000..46c382bf
--- /dev/null
+++ b/pkg/xtools/xtanswer.h
@@ -0,0 +1,5 @@
+# Answers for emphatic yes and no.
+
+define	XT_ANSWERS	"|no|yes|NO|YES|"
+define	ALWAYSNO	2
+define	ALWAYSYES	3
diff --git a/pkg/xtools/xtanswer.x b/pkg/xtools/xtanswer.x
new file mode 100644
index 00000000..f2ebb2cf
--- /dev/null
+++ b/pkg/xtools/xtanswer.x
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pkg/xtanswer.h>
+
+# XT_ANSWER -- Issue an STDOUT prompt and get a STDIN answer with values
+# YES, NO, ALWAYSYES, or ALWAYSNO.
+
+procedure xt_answer (prompt, answer)
+
+char	prompt[ARB]		# Prompt to be issued
+int	answer			# Answer
+
+int	nwrd
+char	word[SZ_LINE]
+
+int	getline(), strdic(), strlen()
+
+begin
+	if ((answer == NO) || (answer == YES)) {
+	    if (answer == NO) {
+	        call printf ("%s (no): ")
+		    call pargstr (prompt)
+	    } else {
+	        call printf ("%s (yes): ")
+		    call pargstr (prompt)
+	    }
+	    call flush (STDOUT)
+
+	    if (getline (STDIN, word) != EOF) {
+		word[strlen(word)] = EOS
+	        nwrd = strdic (word, word, 4, XT_ANSWERS)
+		switch (nwrd) {
+		case 1:
+		    answer = NO
+		case 2:
+		    answer = YES
+		case 3:
+		    answer = ALWAYSNO
+		case 4:
+		    answer = ALWAYSYES
+		}
+	    }
+	}
+end
+
+
+# XT_CLANSWER -- Issue a CLGWRD request and get an answer with values
+# YES, NO, ALWAYSYES, or ALWAYSNO.
+
+procedure xt_clanswer (parameter, answer)
+
+char	parameter[ARB]		# CL parameter
+int	answer			# Answer
+
+pointer	sp, str
+
+int	clgwrd()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	switch (clgwrd (parameter, Memc[str], SZ_LINE, "|no|yes|NO|YES|")) {
+	case 1:
+	    answer = NO
+	case 2:
+	    answer = YES
+	case 3:
+	    answer = ALWAYSNO
+	case 4:
+	    answer = ALWAYSYES
+	default:
+	    answer = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/xtargs.x b/pkg/xtools/xtargs.x
new file mode 100644
index 00000000..ec2e2b5a
--- /dev/null
+++ b/pkg/xtools/xtargs.x
@@ -0,0 +1,141 @@
+include	<ctotok.h>
+
+
+# XTARGS -- Parse strings consisting of a list keyword=value pairs.
+# 
+# This is a limited interface to parse strings containing a list of
+# whitespace separate keyword=value pairs and then provide get procedures
+# for the value as a string or double.  Other datatypes must be coerced or
+# parsed from the string or the double values.
+# 
+# The keyword=value pairs may contain whitespace between around the equal
+# sign but the value must be quoted if it contains blanks.  A keyword must
+# be an "identifier" begining with a letter and consist of letters, numbers,
+# underscore, dollar, and period.
+# 
+# The get procedure posts an error if the requested key is not present.
+# Note that the full power of the symbol table package may be used.
+# The values of the symbols is a single integer having the offset into
+# the string buffer of the symbol table which provides the value as as
+# string.
+#
+# 	stp = xtargs_open (argstr)		# parse string and return symtab
+# 	xtargs_s (stp, key, val, maxchar)	# Get value as a string
+# 	dval = xtargs_d (stp, key)		# Get value as a double
+#
+# Note that there is no close method and instead stclose should be used.
+
+
+
+# XTARGS_OPEN -- Parse an argument string and return a symbol table.
+#
+# Note that this interface does not include a close because the user
+# inherits the symbol table interface.
+
+pointer procedure xtargs_open (argstr)
+
+char	argstr[ARB]			#I Argument string
+
+int	i, tok
+pointer	sp, key, val, stp, sym
+
+bool	strne()
+int	nscan(), stpstr()
+pointer	stopen(), stfind(), stenter()
+
+begin
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (val, SZ_LINE, TY_CHAR)
+
+	# Open symbol table.
+	stp = stopen ("xtargs", 10, 100, 1000)
+
+	# Scan the argument string.
+	call sscan (argstr)
+	repeat {
+	    # Get keyword.
+	    call gargtok (tok, Memc[key], SZ_FNAME)
+	    if (tok == TOK_EOS)
+	        break
+
+	    # Get required delimiter.
+	    call gargtok (i, Memc[val], SZ_LINE)
+	    if (i != TOK_OPERATOR || strne (Memc[val], "="))
+	        break
+
+	    # Get value.
+	    call gargwrd (Memc[val], SZ_LINE)
+
+	    # Check for error.
+	    if (tok != TOK_IDENTIFIER || mod (nscan(), 3) != 0)
+	        break
+
+	    # Ignore case.
+	    call strlwr (Memc[key])
+
+	    # Enter in symbol table.
+	    sym = stfind (stp, Memc[key])
+	    if (sym == NULL) {
+	        sym = stenter (stp, Memc[key], 1)
+		Memi[sym] = stpstr (stp, Memc[val], 1)
+	    }
+	}
+
+	call sfree (sp)
+
+	# Check for error.
+	if (mod (nscan(), 3) != 1) {
+	   call stclose (stp)
+	   call error (1, "Syntax error")
+	}
+	
+	return (stp)
+end
+
+
+# XTARGS_S -- Get string valued parameter.
+# An error is triggered if the key is not in the symbol table.
+
+procedure xtargs_s (stp, key, val, maxchar)
+
+pointer	stp				#I Symbol table
+char	key[ARB]			#I Key to find
+char	val[maxchar]			#O String value
+int	maxchar				#I Maximum number of characters
+
+pointer	sym, stfind(), strefsbuf()
+
+begin
+	sym = stfind (stp, key)
+	if (sym == NULL)
+	    call error (1, "Key not found")
+
+	call strcpy (Memc[strefsbuf(stp,Memi[sym])], val, maxchar)
+end
+
+
+# XTARGS_D -- Get double valued parameter.
+# An error is triggered if the key is not in the symbol table.
+
+double procedure xtargs_d (stp, key)
+
+pointer	stp				#I Symbol table
+char	key[ARB]			#I Key to find
+double	dval				#R Integer value
+
+int	i, j, ctod(), strlen()
+pointer	sym, stfind(), strefsbuf()
+
+begin
+	sym = stfind (stp, key)
+	if (sym == NULL)
+	    call error (1, "Key not found")
+
+	i = 1
+	j = ctod (Memc[strefsbuf(stp,Memi[sym])], i, dval)
+	if (j != strlen(Memc[strefsbuf(stp,Memi[sym])]))
+	    call error (2, "Value not a number")
+
+	return (dval)
+end
diff --git a/pkg/xtools/xtbitarray.x b/pkg/xtools/xtbitarray.x
new file mode 100644
index 00000000..b02fcb90
--- /dev/null
+++ b/pkg/xtools/xtbitarray.x
@@ -0,0 +1,142 @@
+include	<mach.h>
+
+# XT_BAITARRAY -- Routines to manage a 2D bit array.
+# One use for this is to hold a large boolean mask in the minimum amount of
+# memory for random I/O.
+
+define	BA_LEN	6				# Length of structure
+define	BA_NC	Memi[$1]			# Number of columns
+define	BA_NL	Memi[$1+1]			# Number of lines 
+define	BA_NBE	Memi[$1+2]			# Number of bits per element
+define	BA_NEW	Memi[$1+3]			# Number of elements per word
+define	BA_MAX	Memi[$1+4]			# Maximum value
+define	BA_DATA	Memi[$1+5]			# Data pointer
+
+
+# XT_BAOPEN -- Open the bit array by allocating a structure and memory.
+
+pointer procedure xt_baopen (nc, nl, maxval)
+
+int	nc, nl				#I Size of bit array to open
+int	maxval				#I Maximum value
+pointer	ba				#R Bitarray structure
+
+int	nbits
+errchk	calloc
+
+begin
+	nbits = SZB_CHAR * SZ_INT * 8
+
+	call calloc (ba, BA_LEN, TY_STRUCT)
+	BA_NC(ba) = nc
+	BA_NL(ba) = nl
+	BA_MAX(ba) = maxval
+        BA_NBE(ba) = int (log(real(maxval))/log(2.)+1.)
+	BA_NBE(ba) = min (BA_NBE(ba), nbits)
+	BA_NEW(ba) = nbits / BA_NBE(ba)
+	call calloc (BA_DATA(ba),
+	    (BA_NC(ba) * BA_NL(ba) + BA_NEW(ba) - 1) / BA_NEW(ba), TY_INT)
+	return (ba)
+end
+
+
+# XT_BACLOSE -- Close the bit array by freeing memory.
+
+procedure xt_baclose (ba)
+
+pointer	ba				#U Bitarray structure
+
+begin
+	call mfree (BA_DATA(ba), TY_INT)
+	call mfree (ba, TY_STRUCT)
+end
+
+
+# XT_BAPS -- Put short data.
+
+procedure xt_baps (ba, c, l, data, n)
+
+pointer	ba				#I Bitarray structure
+int	c, l				#I Starting element
+short	data[n]				#I Input data array
+int	n				#I Number of data values
+
+int	i, j, k, m, val
+
+begin
+	k = (c - 1) + BA_NC(ba) * (l - 1) - 1
+	do m = 1, n {
+	    k = k + 1
+	    j = k / BA_NEW(ba)
+	    i = BA_NBE(ba) * mod (k, BA_NEW(ba)) + 1
+	    val = min (data[m], BA_MAX(ba))
+	    call bitpak (val, Memi[BA_DATA(ba)+j], i, BA_NBE(ba))
+	}
+end
+
+
+# XT_BAGS -- Get short data.
+
+procedure xt_bags (ba, c, l, data, n)
+
+pointer	ba				#I Bitarray structure
+int	c, l				#I Starting element
+short	data[n]				#I Output data array
+int	n				#I Number of data values
+
+int	i, j, k, m, bitupk()
+
+begin
+	k = (c - 1) + BA_NC(ba) * (l - 1) - 1
+	do m = 1, n {
+	    k = k + 1
+	    j = k / BA_NEW(ba)
+	    i = BA_NBE(ba) * mod (k, BA_NEW(ba)) + 1
+	    data[m] = bitupk (Memi[BA_DATA(ba)+j], i, BA_NBE(ba))
+	}
+end
+
+
+# XT_BAPI -- Put integer data.
+
+procedure xt_bapi (ba, c, l, data, n)
+
+pointer	ba				#I Bitarray structure
+int	c, l				#I Starting element
+int	data[n]				#I Input data array
+int	n				#I Number of data values
+
+int	i, j, k, m, val
+
+begin
+	k = (c - 1) + BA_NC(ba) * (l - 1) - 1
+	do m = 1, n {
+	    k = k + 1
+	    j = k / BA_NEW(ba)
+	    i = BA_NBE(ba) * mod (k, BA_NEW(ba)) + 1
+	    val = min (data[m], BA_MAX(ba))
+	    call bitpak (val, Memi[BA_DATA(ba)+j], i, BA_NBE(ba))
+	}
+end
+
+
+# XT_BAGI -- Get integer data.
+
+procedure xt_bagi (ba, c, l, data, n)
+
+pointer	ba				#I Bitarray structure
+int	c, l				#I Starting element
+int	data[n]				#I Output data array
+int	n				#I Number of data values
+
+int	i, j, k, m, bitupk()
+
+begin
+	k = (c - 1) + BA_NC(ba) * (l - 1) - 1
+	do m = 1, n {
+	    k = k + 1
+	    j = k / BA_NEW(ba)
+	    i = BA_NBE(ba) * mod (k, BA_NEW(ba)) + 1
+	    data[m] = bitupk (Memi[BA_DATA(ba)+j], i, BA_NBE(ba))
+	}
+end
diff --git a/pkg/xtools/xtextns.x b/pkg/xtools/xtextns.x
new file mode 100644
index 00000000..3c95e4f9
--- /dev/null
+++ b/pkg/xtools/xtextns.x
@@ -0,0 +1,587 @@
+include	<error.h>
+include	<pkg/mef.h>
+include	<imhdr.h>
+
+
+define	SZ_RANGE	100		# Size of range list
+
+
+# XT_EXTNS -- Expand template of files into a list of extensions.
+#
+# This supports all MEF extension types.  If IMAGE type or any type is
+# requested this will also return non-FITS images as well.
+#
+# This differs from XT_EXTNS1 in that extension zero is not returned
+# unless it is a simple image and, in that case, the extension is removed.
+
+int procedure xt_extns (files, exttype, index, extname, extver, lindex, lname,
+	lver, dataless, ikparams, err, imext)
+
+char	files[ARB]		#I List of MEF files
+char	exttype[ARB]		#I Extension type (or null for all)
+char	index[ARB]		#I Range list of extension indexes
+char	extname[ARB]		#I Patterns for extension names
+char	extver[ARB]		#I Range list of extension versions
+int	lindex			#I List index number?
+int	lname			#I List extension name?
+int	lver			#I List extension version?
+int	dataless		#I Include dataless image headers?
+char	ikparams[ARB]		#I Image kernel parameters
+int	err			#I Print errors?
+int	imext			#O Image extensions?
+int	list			#O Image list
+
+int	i, j, nphu, nextns, fd
+pointer	sp, temp, patbuf, fname, image, im, immap()
+int	xt_extns1(), patmake(), gpatmatch(), imtopen(), imtgetim(), open()
+errchk	xt_extns1, open, immap, delete
+
+begin
+	call smark (sp)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+	# Get the list.
+	list = xt_extns1 (files, exttype, index, extname, extver, lindex,
+	    lname, lver, ikparams, err)
+
+	# Check and edit the list.
+	i = patmake ("\[[01]\]", Memc[patbuf], SZ_FNAME)
+	nphu = 0
+	nextns = 0
+	call mktemp ("@tmp$iraf", Memc[temp], SZ_FNAME)
+	fd = open (Memc[temp+1], NEW_FILE, TEXT_FILE)
+	while (imtgetim (list, Memc[fname], SZ_FNAME) != EOF) {
+	    if (dataless == NO) {
+		iferr (im = immap (Memc[fname], READ_ONLY, 0))
+		    im = NULL
+		if (im != NULL) {
+		    if (IM_NDIM(im) == 0 || IM_LEN(im,1) == 0) {
+			call imunmap (im)
+			next
+		    }
+		    call imunmap (im)
+		}
+	    }
+	    if (gpatmatch (Memc[fname], Memc[patbuf], i, j) > 0) {
+	        call strcpy (Memc[fname], Memc[image], SZ_FNAME)
+		call strcpy (Memc[image+j], Memc[image+i-1], SZ_FNAME)
+		ifnoerr (im = immap (Memc[image], READ_ONLY, 0)) {
+		    call strcpy (Memc[image], Memc[fname], SZ_FNAME)
+		    call imunmap (im)
+		    nphu = nphu + 1
+		}
+	    }
+	    nextns = nextns + 1
+	    call fprintf (fd, "%s\n")
+		call pargstr (Memc[fname])
+	}
+	call close (fd)
+
+	# Return new list and extension flag.
+	imext = YES
+	if (nphu == nextns)
+	    imext = NO
+	call imtclose (list)
+	list = imtopen (Memc[temp])
+	call delete (Memc[temp+1])
+	call sfree (sp)
+	return (list)
+end
+
+
+# XT_IMEXTNS -- Expand a template of MEF files into a list of image extensions.
+
+int procedure xt_imextns (files, index, extname, extver, lindex, lname, lver,
+	ikparams, err)
+
+char	files[ARB]		#I List of MEF files
+char	index[ARB]		#I Range list of extension indexes
+char	extname[ARB]		#I Patterns for extension names
+char	extver[ARB]		#I Range list of extension versions
+int	lindex			#I List index number?
+int	lname			#I List extension name?
+int	lver			#I List extension version?
+char	ikparams[ARB]		#I Image kernel parameters
+int	err			#I Print errors?
+int	list			#O Image list
+
+int	xt_extns1()
+errchk	xt_extns1
+
+begin
+	list = xt_extns1 (files, "IMAGE", index, extname, extver, lindex,
+	    lname, lver, ikparams, err)
+	return (list)
+end
+
+
+# XT_EXTNS1 -- Expand a template of MEFs into a list of extensions.
+
+int procedure xt_extns1 (files, exttype, index, extname, extver, lindex,
+	lname, lver, ikparams, err)
+
+char	files[ARB]		#I List of MEFs
+char	exttype[ARB]		#I Desired extension type (or null for all)
+char	index[ARB]		#I Range list of extension indexes
+char	extname[ARB]		#I Patterns for extension names
+char	extver[ARB]		#I Range list of extension versions
+int	lindex			#I List index number?
+int	lname			#I List extension name?
+int	lver			#I List extension version?
+char	ikparams[ARB]		#I Image kernel parameters
+int	err			#I Print errors?
+int	list			#O Image list
+
+int	i, fd
+pointer	sp, temp, fname, rindex, rextver, ikp, str
+int	imtopen(), imtgetim()
+int	ix_decode_ranges(), decode_ranges(), nowhite(), open()
+errchk	open, xt_extn, delete
+
+begin
+	call smark (sp)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (ikp, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Expand parameters.
+	list = imtopen (files)
+	call salloc (rindex, 3*SZ_RANGE, TY_INT)
+	if (ix_decode_ranges (index, Memi[rindex], SZ_RANGE, i) == ERR)
+	    call error (1, "Bad index range list")
+
+	rextver = NULL
+	if (nowhite (extver, Memc[str], SZ_LINE) > 0) {
+	    call salloc (rextver, 3*SZ_RANGE, TY_INT)
+	    if (decode_ranges (Memc[str], Memi[rextver], SZ_RANGE, i)==ERR)
+		call error (1, "Bad extension version range list")
+	}
+	i = nowhite (ikparams, Memc[ikp], SZ_LINE)
+
+	# Expand MEFs into list of extensions in a temp file.
+	call mktemp ("@tmp$iraf", Memc[temp], SZ_FNAME)
+	fd = open (Memc[temp+1], NEW_FILE, TEXT_FILE)
+	while (imtgetim (list, Memc[fname], SZ_FNAME) != EOF) {
+	    call xt_extn (fd, Memc[fname], exttype, rindex, extname,
+	    	rextver, lindex, lname, lver, Memc[ikp], err)
+	}
+	call imtclose (list)
+	call close (fd)
+
+	# Return list.
+	list = imtopen (Memc[temp])
+	call delete (Memc[temp+1])
+	call sfree (sp)
+	return (list)
+end
+
+
+# XT_EXTN -- Expand a single MEF into a list of extensions.
+# The extensions are written to the input file descriptor.
+
+procedure xt_extn (fd, fname, exttype, indices, extname, extver, lindex,
+	lname, lver, ikparams, err)
+
+int	fd			#I File descriptor for list 
+char	fname[SZ_FNAME]		#I File name
+char	exttype[ARB]		#I Extension type (or null for all)
+pointer	indices			#I Range list of extension indexes
+char	extname[ARB]		#I Pattern for extension names
+pointer	extver			#I Range list of extension versions
+int	lindex			#I List index number?
+int	lname			#I List extension name?
+int	lver			#I List extension version?
+char	ikparams[ARB]		#I Image kernel parameters
+int	err			#I Print errors?
+
+int	i, j, n, index, ver, stat
+pointer	sp, clust, ksec, imsec, name, str
+pointer	mef, im
+
+bool	streq(), is_in_range(), xt_extmatch()
+int	mef_rdhdr_exnv(), mef_rdhdr_gn(), ix_get_next_number()
+pointer	mefopen(), immap()
+errchk	mefopen, mef_rdhdr_exnv, mef_rdhdr_gn, immap
+
+begin
+	call smark (sp)
+	call salloc (clust, SZ_FNAME, TY_CHAR)
+	call salloc (ksec, SZ_FNAME, TY_CHAR)
+	call salloc (imsec, SZ_FNAME, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Parse the file name syntax.
+	call imparse (fname, Memc[clust], SZ_FNAME, Memc[ksec],
+	    SZ_FNAME, Memc[imsec], SZ_FNAME, index, ver)
+
+	# Open the file and check the error status.
+	iferr (mef = mefopen (Memc[clust], READ_ONLY, 0)) {
+	    if (exttype[1] == EOS || !streq (exttype, "IMAGE"))
+	        call fprintf (fd, fname)
+	    else if (streq (exttype, "IMAGE")) {
+		ifnoerr (im = immap (fname, READ_ONLY, 0)) {
+		    call imunmap (im)
+		    call fprintf (fd, fname)
+		}
+	    }
+	    return
+	}
+
+	# Loop through extensions.
+	if (Memc[ksec] != EOS || index >= 0)
+	    n = 1
+	else
+	    n = ARB
+	j = index
+	do i = 1, n {
+	    iferr {
+		# If a kernel section is given look for the extension/extver.
+		if (Memc[ksec] != EOS) {
+		    call mef_ksection (Memc[ksec], Memc[name], ver)
+		    stat = mef_rdhdr_exnv (mef, Memc[name], ver)
+
+		# If an index is given then look for the indexed extension
+		} else if (j >= 0)
+		    stat = mef_rdhdr_gn (mef, j)
+
+		# If neither is given look for list of indices.
+		else {
+		    stat = ix_get_next_number (Memi[indices], index)
+		    if (stat != EOF)
+			stat = mef_rdhdr_gn (mef, index)
+		}
+	    } then {
+	        # Check if file is an IRAF image.
+		if (exttype[1] == EOS || !streq (exttype, "IMAGE"))
+			call fprintf (fd, fname)
+		else if (streq (exttype, "IMAGE")) {
+		    ifnoerr (im = immap (fname, READ_ONLY, 0)) {
+			call imunmap (im)
+			call fprintf (fd, fname)
+		    }
+		}
+	        stat = EOF
+	    }
+
+	    # Finish if EOF is encountered in either indices or file.
+	    if (stat == EOF)
+	        break
+
+	    # Check the extension type.
+	    if (exttype[1] != EOS && !streq (exttype, MEF_EXTTYPE(mef))) {
+		if (!streq (exttype, "IMAGE") ||
+		    !streq (MEF_EXTTYPE(mef), "SIMPLE")) {
+		    # Check for PLIO mask which is a kind of image.
+		    if (streq (MEF_EXTTYPE(mef), "BINTABLE")) {
+		        call sprintf (Memc[str], SZ_LINE, "%s[%d]")
+			    call pargstr (Memc[clust])
+			    call pargi (MEF_CGROUP(mef))
+			iferr (im = immap (Memc[str], READ_ONLY, 0))
+			    im = NULL
+			if (im == NULL)
+			    next
+			else
+			    call imunmap (im)
+		    }
+		}
+	    }
+
+	    # Check the extension name.
+	    if (!xt_extmatch (MEF_EXTNAME(mef), extname))
+		next
+
+	    # Check the extension version.
+	    if (extver != NULL) {
+	        if (IS_INDEFI(MEF_EXTVER(mef)))
+		    next
+		if (!is_in_range (Memi[extver], MEF_EXTVER(mef)))
+		    next
+	    }
+
+	    # Set the extension name and version.
+	    if (lname == YES)
+	        call strcpy (MEF_EXTNAME(mef), Memc[name], SZ_LINE)
+	    else
+		Memc[name] = EOS
+	    if (lver == YES)
+	        ver = MEF_EXTVER(mef)
+	    else
+		ver = INDEFI
+
+	    # Output the file name with the desired elements.
+	    call fprintf (fd, Memc[clust])
+	    if (lindex == YES || (Memc[name] == EOS && IS_INDEFI(ver))) {
+		call fprintf (fd, "[%d]")
+		    call pargi (MEF_CGROUP(mef))
+	    }
+	    if (Memc[name] != EOS) {
+		call fprintf (fd, "[%s")
+		    call pargstr (Memc[name])
+		if (!IS_INDEFI(ver)) {
+		    call fprintf (fd, ",%d")
+			call pargi (ver)
+		}
+		if (ikparams[1] != EOS) {
+		    call fprintf (fd, ",%s")
+			call pargstr (ikparams)
+		}
+		call fprintf (fd, "]")
+	    } else if (!IS_INDEFI(ver)) {
+		call fprintf (fd, "[extver=%d")
+		    call pargi (ver)
+		if (ikparams[1] != EOS) {
+		    call fprintf (fd, ",%s")
+			call pargstr (ikparams)
+		}
+		call fprintf (fd, "]")
+	    } else if (ikparams[1] != EOS) {
+		call fprintf (fd, "[%s]")
+		    call pargstr (ikparams)
+	    }
+	    if (Memc[imsec] != EOS) {
+		call fprintf (fd, "%s")
+		    call pargstr (Memc[imsec])
+	    }
+	    call fprintf (fd, "\n")
+	}
+
+	# Finish up.
+	call mefclose (mef)
+	call sfree (sp)
+end
+
+
+include	<mach.h>
+include	<ctype.h>
+
+define	FIRST	0		# Default starting range
+define	LAST	MAX_INT		# Default ending range
+define	STEP	1		# Default step
+define	EOLIST	-1		# End of list
+
+# IX_DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas.  Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers.  ERR is returned as
+# the function value if a conversion error occurs.  The list of ranges is
+# delimited by EOLIST.
+
+int procedure ix_decode_ranges (range_string, ranges, max_ranges, nvalues)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	nvalues			# The number of values in the ranges
+
+int	ip, nrange, first, last, step, ctoi()
+
+begin
+	ip = 1
+	nvalues = 0
+
+	do nrange = 1, max_ranges - 1 {
+	    # Defaults to all nonnegative integers
+	    first = FIRST
+	    last = LAST
+	    step = STEP
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get first limit.
+	    # Must be a number, '-', 'x', or EOS.  If not return ERR.
+	    if (range_string[ip] == EOS) {			# end of list
+		if (nrange == 1) {
+		    # Null string defaults
+		    ranges[1, 1] = first
+		    ranges[2, 1] = last
+		    ranges[3, 1] = step
+		    ranges[1, 2] = EOLIST
+	    	    nvalues = MAX_INT
+		    return (OK)
+		} else {
+		    ranges[1, nrange] = EOLIST
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, first) == 0)
+		    return (ERR)
+	    } else
+		return (ERR)
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get last limit
+	    # Must be '-', or 'x' otherwise last = first.
+	    if (range_string[ip] == 'x')
+		;
+	    else if (range_string[ip] == '-') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, last) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		last = first
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get step.
+	    # Must be 'x' or assume default step.
+	    if (range_string[ip] == 'x') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, step) == 0)
+		        ;
+		    if (step == 0)
+			return (ERR)
+		} else if (range_string[ip] == '-')
+		    ;
+		else
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    ranges[1, nrange] = first
+	    ranges[2, nrange] = last
+	    ranges[3, nrange] = step
+	    nvalues = nvalues + abs (last-first) / step + 1
+	}
+
+	return (ERR)					# ran out of space
+end
+
+
+# IX_GET_NEXT_NUMBER -- Given a list of ranges and the current file number,
+# find and return the next file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically increasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure ix_get_next_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number+1 is anywhere in the list, that is the next number,
+	# otherwise the next number is the smallest number in the list which
+	# is greater than number+1.
+
+	number = number + 1
+	next_number = MAX_INT
+
+	for (ip=1;  ranges[ip] != EOLIST;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (step == 0)
+		call error (1, "Step size of zero in range list")
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder + step <= last)
+		    next_number = number - remainder + step
+	    } else if (first > number)
+		next_number = min (next_number, first)
+	}
+
+	if (next_number == MAX_INT)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# XT_EXTMATCH -- Match extname against a comma-delimited list of patterns.
+
+bool procedure xt_extmatch (extname, patterns)
+
+char	extname[ARB]		#I Extension name to match
+char	patterns[ARB]		#I Comma-delimited list of patterns
+bool	stat			#O Match?
+
+int	i, j, k, sz_pat, strlen(), patmake(), patmatch(), nowhite()
+pointer	sp, patstr, patbuf
+
+begin
+	if (patterns[1] == EOS)
+	    return (true)
+
+	stat = false
+
+	sz_pat = strlen (patterns)
+	if (sz_pat == 0)
+	    return (stat)
+	sz_pat = sz_pat + SZ_LINE
+
+	call smark (sp)
+	call salloc (patstr, sz_pat, TY_CHAR)
+	call salloc (patbuf, sz_pat, TY_CHAR)
+
+	i = nowhite (patterns, Memc[patstr], sz_pat)
+	if (i == 0)
+	    stat = true
+	else if (i == 1 && Memc[patstr] == '*')
+	    stat = true
+	else {
+	    i = 1
+	    for (j=i;; j=j+1) {
+		if (patterns[j] != ',' && patterns[j] != EOS)
+		    next
+		if (j > 0 && patterns[j] == ',' && patterns[j-1] == '\\')
+		    next
+		if (j - i > 0) {
+		    if (j-i == 1 && patterns[i] == '*') {
+			stat = true
+			break
+		    }
+		    call strcpy (patterns[i], Memc[patstr+1], j-i)
+		    Memc[patstr] = '^'
+		    Memc[patstr+j-i+1] = '$'
+		    Memc[patstr+j-i+2] = EOS
+		    k = patmake (Memc[patstr], Memc[patbuf], sz_pat)
+		    if (patmatch (extname, Memc[patbuf]) > 0) {
+			stat = true
+			break
+		    }
+		}
+		if (patterns[j] == EOS)
+		    break
+		i = j + 1
+	    }
+	}
+
+	call sfree (sp)
+	return (stat)
+end
diff --git a/pkg/xtools/xtgids.x b/pkg/xtools/xtgids.x
new file mode 100644
index 00000000..ea56c36c
--- /dev/null
+++ b/pkg/xtools/xtgids.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctotok.h>
+
+# XT_GIDS -- Get identifier tokens from a string and match with a dictionary.
+#
+# The input string is scanned for identifier tokens (see definition of
+# identifier token in ctotok) and each token is checked against the
+# dictionary string.  An array of YES/NO values for each dictionary entry,
+# up to a maximum of maxids, is returned.
+
+procedure xt_gids (str, dicstr, ids, maxids)
+
+char	str[ARB]		# Input string
+char	dicstr[ARB]		# Dictionary string
+int	ids[maxids]		# Identifier indices in dictionary
+int	maxids			# Maximum number of identifiers
+
+int	i, ip, token
+char	tokstr[SZ_LINE]
+
+int	ctotok(), strdic()
+
+begin
+	call amovki (NO, ids, maxids)
+
+	ip = 1
+	repeat {
+	    token = ctotok (str, ip, tokstr, SZ_LINE)
+	    switch (token) {
+	    case TOK_EOS:
+		return
+	    case TOK_IDENTIFIER:
+		i = strdic (tokstr, tokstr, SZ_LINE, dicstr)
+		if ((i > 0) && (i <= maxids))
+		    ids[i] = YES
+	    }
+	}
+end
diff --git a/pkg/xtools/xtimleneq.x b/pkg/xtools/xtimleneq.x
new file mode 100644
index 00000000..ece51695
--- /dev/null
+++ b/pkg/xtools/xtimleneq.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# XT_IMLENEQ -- Determine if the lengths of the common image dimensions
+# are equal.
+
+bool procedure xt_imleneq (im1, im2)
+
+pointer	im1			# First IMIO pointer
+pointer	im2			# Second IMIO pointer
+
+int	i, ndim
+
+begin
+	ndim = min (IM_NDIM (im1), IM_NDIM (im2))
+	do i = 1, ndim {
+	    if (IM_LEN (im1, i) != IM_LEN (im2, i))
+		return (FALSE)
+	}
+	return (TRUE)
+end
diff --git a/pkg/xtools/xtimnames.x b/pkg/xtools/xtimnames.x
new file mode 100644
index 00000000..2613a641
--- /dev/null
+++ b/pkg/xtools/xtimnames.x
@@ -0,0 +1,102 @@
+# Routines to deal with image kernel extensions
+# XT_IMROOT   -- Get root name of an image minus it's image kernel extention
+# XT_IMEXT    -- Get image kernel extension with the period.
+# XT_IMNAMEEQ -- Check if two image names are equal.
+
+
+# XT_IMROOT -- Get root name of an image minus it's image kernel extention
+# This calls the IKI routines which is an interface violation.
+
+procedure xt_imroot (image, root, maxchar)
+
+char	image[ARB]		# Full image name
+char	root[maxchar]		# Root name
+int	maxchar			# Size of root name string
+
+int	i, fnextn(), iki_validextn(), strlen()
+pointer	sp, extn
+
+begin
+	call smark (sp)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	call imgimage (image, root, maxchar)
+	i = fnextn (root, Memc[extn], SZ_FNAME)
+	if (i > 0) {
+	    call iki_init()
+	    if (iki_validextn (0, Memc[extn]) != 0)
+		root[strlen(root)-i] = EOS
+	}
+
+	call sfree (sp)
+end
+
+
+# XT_IMEXT -- Get image kernel extension with the period.
+# This calls the IKI routines which is an interface violation.
+
+procedure xt_imext (image, ext, maxchar)
+
+char	image[ARB]		# Full image name
+char	ext[maxchar]		# Extension
+int	maxchar			# Size of extension
+
+int	i, fnextn(), iki_validextn()
+pointer	sp, root
+
+begin
+	call smark (sp)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+
+	ext[1] = EOS
+
+	# Get root and extension
+	call imgimage (image, Memc[root], SZ_LINE)
+	i = fnextn (Memc[root], ext[2], maxchar-1)
+	if (i > 0) {
+	    call iki_init()
+	    if (iki_validextn (0, ext[2]) != 0)
+		ext[1] = '.'
+	}
+
+	call sfree (sp)
+end
+
+
+# XT_IMNAMEEQ -- Check if two image names are equal.
+# Image sections and clusters are removed.  If an image extension is missing
+# it is assumed the same as the other image; i.e. only if both names
+# have extensions are the extensions checked for equality.
+
+bool procedure xt_imnameeq (imname1, imname2)
+
+char	imname1[ARB]		# First image name
+char	imname2[ARB]		# Second image name
+
+bool	stat, streq()
+pointer	sp, str1, str2
+
+begin
+	if (streq (imname1, imname2))
+	    return (true)
+
+	call smark (sp)
+	call salloc (str1, SZ_FNAME, TY_CHAR)
+	call salloc (str2, SZ_FNAME, TY_CHAR)
+
+	# Check roots
+	call xt_imroot (imname1, Memc[str1], SZ_FNAME)
+	call xt_imroot (imname2, Memc[str2], SZ_FNAME)
+	stat = streq (Memc[str1], Memc[str2])
+
+	# If the roots are equal check the extensions.
+	if (stat) {
+	    call xt_imext (imname1, Memc[str1], SZ_FNAME)
+	    call xt_imext (imname2, Memc[str2], SZ_FNAME)
+	    if (Memc[str1] != EOS && Memc[str2] != EOS)
+		stat = streq (Memc[str1], Memc[str2])
+	}
+
+	call sfree (sp)
+	return (stat)
+end
diff --git a/pkg/xtools/xtimtgetim.x b/pkg/xtools/xtimtgetim.x
new file mode 100644
index 00000000..6904f04a
--- /dev/null
+++ b/pkg/xtools/xtimtgetim.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# XT_IMTGETIM -- Given two input lists and an output list return image elements
+# from each of the lists.  The shorter input list is repeated as necessary.
+# EOF is returned when the longer input list is finished or when the output
+# list is finished.  The image name strings are assumed to all be at least
+# of length sz_image.  It is assumed that if the image lists were
+# successfully opened then no errors will occur with imtlen, imtgetim, and
+# imtrew.
+
+int procedure xt_imtgetim (list1, list2, list3, image1, image2, image3,
+    sz_image)
+
+int	list1			# First input image list
+int	list2			# Second input image list
+int	list3			# Output image list
+char	image1[sz_image]	# Returned image from first list
+char	image2[sz_image]	# Returned image from second list
+char	image3[sz_image]	# Returned image from third list
+int	sz_image		# Maximum size of image strings
+
+int	imtlen(), imtgetim()
+
+begin
+	# If list1 is longer than list2 then get next element of list1
+	# and repeat list2 if necessary.
+
+	if (imtlen (list1) > imtlen (list2)) {
+	    if (imtgetim (list1, image1, sz_image) == EOF)
+		return (EOF)
+	    if (imtgetim (list2, image2, sz_image) == EOF) {
+		call imtrew (list2)
+	        if (imtgetim (list2, image2, sz_image) == EOF)
+		    return (EOF)	# Two EOFs are a null list.
+	    }
+
+	# If list2 is longer or equal to list1 then get next element of list2
+	# and repeat list1 if necessary.
+
+	} else {
+	    if (imtgetim (list2, image2, sz_image) == EOF)
+		return (EOF)
+	    if (imtgetim (list1, image1, sz_image) == EOF) {
+		call imtrew (list1)
+	        if (imtgetim (list1, image1, sz_image) == EOF)
+		    return (EOF)	# Two EOFs are a null list.
+	    }
+	}
+
+	# Return the output image and the status of the output list.
+	return (imtgetim (list3, image3, sz_image))
+end
diff --git a/pkg/xtools/xtlogfiles.x b/pkg/xtools/xtlogfiles.x
new file mode 100644
index 00000000..b09a7315
--- /dev/null
+++ b/pkg/xtools/xtlogfiles.x
@@ -0,0 +1,93 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Procedures for opening and closing a list of logfiles.  Given the
+# name of the CL parameter that contains the list, a dynamic array
+# of descriptors for the open files is allocated.  The number of open
+# log files is returned.  The files are time stamped both when opened
+# and when closed.
+
+# XT_LOGOPEN -- Open a list of log files and provide a sysid time stamp.
+
+int procedure xt_logopen (logparam, prefix, logfd, stdflag)
+
+char	logparam[ARB]		#I CL parameter specifying the list
+char	prefix[ARB]		#I String to preceed sysid info
+pointer	logfd			#O Pointer to array of open file descriptors
+int	stdflag			#O Flag that STDOUT or ERR is in the list
+
+int	loglist, nlogfd, fd, i
+pointer	linebuf, fname, sp
+
+int	clpopnu(), clplen(), clgfil(), open()
+errchk	open
+
+begin
+	logfd = NULL
+	stdflag = NO
+
+	loglist = clpopnu (logparam)
+	nlogfd = clplen (loglist)
+
+	if (nlogfd > 0) {
+	    call smark (sp)
+	    call salloc (linebuf, SZ_LINE, TY_CHAR)
+	    call salloc (fname, SZ_FNAME, TY_CHAR)
+	    call malloc (logfd, nlogfd, TY_INT)
+
+	    call sysid (Memc[linebuf], SZ_LINE)
+
+	    for (i=1; clgfil (loglist, Memc[fname], SZ_FNAME) != EOF; i=i+1) {
+		fd = open (Memc[fname], APPEND, TEXT_FILE)
+		Memi[logfd+i-1] = fd
+		if (fd == STDOUT || fd == STDERR)
+		    stdflag = YES
+
+		call fprintf (fd, "\n%s %s\n\n")
+		    call pargstr (prefix)
+		    call pargstr (Memc[linebuf])
+		call flush (fd)
+	    }
+
+	    call sfree (sp)
+	}
+
+	call clpcls (loglist)
+	return (nlogfd)
+end
+
+
+# XT_LOGCLOSE -- Close a list of log files and provide a sysid time stamp.
+
+procedure xt_logclose (logfd, nlogfd, prefix)
+
+pointer	logfd			#I Pointer to array of open file descriptors
+int	nlogfd			#I Number of open files
+char	prefix[ARB]		#I String to preceed sysid info
+
+int	fd, i
+pointer	linebuf, sp
+
+errchk	close
+
+begin
+	if (nlogfd <= 0)
+	    return
+
+	call smark (sp)
+	call salloc (linebuf, SZ_LINE, TY_CHAR)
+
+	call sysid (Memc[linebuf], SZ_LINE)
+
+	do i = 1, nlogfd {
+	    fd = Memi[logfd+i-1]
+
+	    call fprintf (fd, "\n%s %s\n\n")
+		call pargstr (prefix)
+		call pargstr (Memc[linebuf])
+
+	    call close (fd)
+	}
+
+	call mfree (logfd, TY_INT)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/xtmaskname.x b/pkg/xtools/xtmaskname.x
new file mode 100644
index 00000000..70ddfe34
--- /dev/null
+++ b/pkg/xtools/xtmaskname.x
@@ -0,0 +1,125 @@
+# XT_MASKNAME -- Make a mask name.
+# 
+# This creates a FITS mask extension if possible, otherwise it creates a
+# pixel list file.  To override this default the environment variable
+# "masktype" needs to be set to "pl".  To create a FITS extension the
+# filename must explicitly select the FITS kernel or the default image type
+# must be a FITS file.  The input and output strings may be the same.
+# This supports multiextension masks for pl format by using a subdirectory.
+
+procedure xt_maskname (fname, extname, mode, mname, maxchar)
+
+char	fname[ARB]			#I File name
+char	extname[ARB]			#I Default pixel mask extension name
+int	mode				#I Mode
+char	mname[maxchar]			#O Output mask name
+int	maxchar				#I Maximum characters in mask name
+
+int	i, fits
+pointer	sp, extnm, temp
+
+bool	streq()
+int	strmatch(), stridxs(), strldxs(), strncmp()
+int	envfind(), access(), imaccess()
+
+begin
+	call smark (sp)
+	call salloc (extnm, SZ_FNAME, TY_CHAR)
+	call salloc (temp, maxchar, TY_CHAR)
+
+	# Set extension name.
+	if (extname[1] == EOS)
+	    call strcpy ("pl", Memc[extnm], SZ_FNAME)
+	else
+	    call strcpy (extname, Memc[extnm], SZ_FNAME)
+
+	# Determine whether to use FITS pixel mask extensions.
+	if (envfind ("masktype", Memc[temp], maxchar) > 0) {
+	    if (streq (Memc[temp], "pl"))
+		fits = NO
+	    else
+		fits = YES
+	} else
+	    fits = YES
+	i = strldxs ("]", fname)
+
+	# Check for explicit .pl extension.
+	if (strmatch (fname, ".pl$") > 0)
+	    call strcpy (fname, mname, maxchar)
+
+	# Check for explicit mask extension.
+	else if (strmatch (fname, "type=mask") > 0)
+	    call strcpy (fname, mname, maxchar)
+	else if (strmatch (fname, "type\\\=mask") > 0)
+	    call strcpy (fname, mname, maxchar)
+
+	# Check for kernel section and add mask type.
+	else if (i > 0) {
+	    call strcpy (fname, mname, maxchar)
+	    if (mode != READ_ONLY) {
+		call strcpy (fname[i], Memc[temp], maxchar)
+		call sprintf (mname[i], maxchar-i, ",type=mask%s")
+		    call pargstr (Memc[temp])
+	    }
+
+	# Create output from rootname name.
+	} else if (fits == YES) {
+	    if (mode == READ_ONLY) {
+		call sprintf (mname, maxchar, "%s[%s]")
+		    call pargstr (fname)
+		    call pargstr (Memc[extnm])
+	    } else {
+		call sprintf (mname, maxchar, "%s[%s,type=mask]")
+		    call pargstr (fname)
+		    call pargstr (Memc[extnm])
+	    }
+	} else if (extname[1] != EOS) {
+	    call sprintf (mname, maxchar, "%s[%s]")
+	        call pargstr (fname)
+		call pargstr (Memc[extnm])
+	} else {
+	    call sprintf (mname, maxchar, "%s.pl")
+	        call pargstr (fname)
+	}
+
+	# Convert extension references to pl form if required.
+	# Extensions are implemented as directories.
+
+	i = stridxs ("[", mname)
+	if (i > 0 && mode == READ_ONLY)
+	    fits = imaccess (mname, mode)
+	if (fits == NO && i > 0) {
+	    call strcpy (mname, Memc[temp], maxchar)
+	    mname[i] = EOS
+	    if (mode == NEW_IMAGE) {
+		if (access (mname, 0, 0) == NO) {
+		    ifnoerr (call fmkdir (mname))
+			mname[i] =  '/'
+		    else
+			mname[i] = '_'
+		} else
+		    mname[i] =  '/'
+	    } else {
+		if (access (mname, 0, 0) == NO)
+		    mname[i] = '_'
+		else
+		    mname[i] =  '/'
+	    }
+	        
+	    if (strncmp (mname[i+1], "type", 4) == 0 ||
+	        strncmp (mname[i+1], "append", 6) == 0 ||
+	        strncmp (mname[i+1], "inherit", 7) == 0) {
+		mname[i+1] = EOS
+		call strcat (Memc[extnm], mname, maxchar)
+	    } else {
+		i = stridxs (",]", mname)
+		mname[i] = EOS
+	    }
+	    call strcat (".pl", mname, maxchar)
+
+	    if (mode == READ_ONLY && imaccess(mname,0)==NO)
+	        call strcpy (Memc[temp], mname, maxchar)
+	}
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/xtmksection.x b/pkg/xtools/xtmksection.x
new file mode 100644
index 00000000..3dd404cb
--- /dev/null
+++ b/pkg/xtools/xtmksection.x
@@ -0,0 +1,141 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# XT_MKSECTION -- Convert an generalized image section string to an IMIO
+# section string.  The generalized image section string has one of the
+# following formats:
+#	1. An IMIO image section
+#	2. [line|column] [#|middle|last]
+#	3. [#|middle|last] [line|column]
+# where # is a line or column number.  The strings may be abbreviated.
+# This procedure will work for images of dimension greater than 2  provided
+# that missing sections references default to 1.
+
+define	SZ_WRD	10
+
+procedure xt_mksection (image, secstr, section, sz_section)
+
+char	image[ARB]		# Image
+char	secstr[ARB]		# Image section string
+char	section[sz_section]	# Returned image section string
+int	sz_section		# Maximum size of image section string
+
+char	wrd1[SZ_WRD], wrd2[SZ_WRD]
+int	ndim, len1, len2, i, j, k
+pointer	im
+
+int	strdic(), ctoi()
+pointer	immap()
+errchk	immap()
+
+begin
+	im = immap (image, READ_ONLY, 0)
+	ndim = IM_NDIM(im)
+	len1 = IM_LEN(im, 1)
+	len2 = IM_LEN(im, 2)
+	call imunmap (im)
+
+	switch (ndim) {
+	case 1:
+	    section[1] = EOS
+	default:
+	    if (len2 == 1) {
+		section[1] = EOS
+		return
+	    }
+ 
+	    if (secstr[1] == '[')
+	        call strcpy (secstr, section, sz_section)
+	    else {
+		call sscan (secstr)
+		call gargwrd (wrd1, SZ_WRD)
+		i = strdic (wrd1, wrd1, SZ_WRD, "|column|line|middle|last|")
+		call gargwrd (wrd2, SZ_WRD)
+		j = strdic (wrd2, wrd2, SZ_WRD, "|column|line|middle|last|")
+
+		if ((j == 1) || (j == 2)) {
+		    k = i
+		    i = j
+		    j = k
+		    call strcpy (wrd1, wrd2, SZ_WRD)
+		}
+
+		switch (i) {
+		case 1:
+		    switch (j) {
+		    case 3:
+		        call sprintf (section, sz_section, "[%d,*]")
+		            call pargi ((len1 + 1) / 2)
+		    case 4:
+		        call sprintf (section, sz_section, "[%d,*]")
+		            call pargi (len1)
+		    default:
+			i = 1
+			if (ctoi (wrd2, i, len1) == 0)
+			    call error (0, "Bad column number")
+		        call sprintf (section, sz_section, "[%d,*]")
+		            call pargi (len1)
+		    }
+		case 2:
+		    switch (j) {
+		    case 3:
+		        call sprintf (section, sz_section, "[*,%d]")
+		            call pargi ((len2 + 1) / 2)
+		    case 4:
+		        call sprintf (section, sz_section, "[*,%d]")
+		            call pargi (len2)
+		    default:
+			i = 1
+			if (ctoi (wrd2, i, len1) == 0)
+			    call error (0, "Bad line number")
+		        call sprintf (section, sz_section, "[*,%d]")
+		            call pargi (len1)
+		    }
+		default:
+		    call error (0,
+	    "Unknown section specification - Possible non-unique abbreviation")
+		}
+	    }
+	}
+end
+
+
+# XT_MKIMSEC -- Apply a generalized image section to an image.
+
+procedure xt_mkimsec (image, secstr, imagesec, sz_fname)
+
+char	image[ARB]			# Image name
+char	secstr[ARB]			# Image section string
+char	imagesec[sz_fname]		# Image with section
+int	sz_fname			# Maximum size of image name
+
+char	section[SZ_FNAME]
+errchk	xt_mksection()
+
+begin
+	call xt_mksection (image, secstr, section, SZ_FNAME)
+	call sprintf (imagesec, sz_fname, "%s%s")
+	    call pargstr (image)
+	    call pargstr (section)
+end
+
+
+# XT_MK1D -- In some applications a one dimensional image is expected.
+# This procedure checks to see if the image is one dimensional.  If it is
+# not then a section is added to the image name.  This procedure should
+# not be used and xt_mkimsec should be used instead.
+
+procedure xt_mk1d (image, secstr, sz_fname)
+
+char	image[sz_fname]			# Image name
+char	secstr[ARB]			# Image section string
+int	sz_fname			# Maximum size of image name
+
+char	section[SZ_FNAME]
+errchk	xt_mksection()
+
+begin
+	call xt_mksection (image, secstr, section, SZ_FNAME)
+	call strcat (section, image, sz_fname)
+end
diff --git a/pkg/xtools/xtphistory.x b/pkg/xtools/xtphistory.x
new file mode 100644
index 00000000..02be88b9
--- /dev/null
+++ b/pkg/xtools/xtphistory.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# XT_PHISTORY -- Put history string.
+
+procedure xt_phistory (im, str)
+
+pointer	im			# IMIO pointer
+char	str			# String to be put in history
+
+pointer	sp, timestr
+
+long	clktime()
+
+begin
+	call smark (sp)
+	call salloc (timestr, SZ_LINE, TY_CHAR)
+	call cnvdate (clktime (0), Memc[timestr], SZ_LINE)
+	call strcat (Memc[timestr], IM_HISTORY(im), SZ_IMHIST)
+	call strcat (": ", IM_HISTORY(im), SZ_IMHIST)
+	call strcat (str, IM_HISTORY(im), SZ_IMHIST)
+	call sfree (sp)
+end
diff --git a/pkg/xtools/xtsample.gx b/pkg/xtools/xtsample.gx
new file mode 100644
index 00000000..dc4f4173
--- /dev/null
+++ b/pkg/xtools/xtsample.gx
@@ -0,0 +1,107 @@
+include	<imhdr.h>
+
+
+# XT_SAMPLE -- Get sample of pixels.
+#
+# This routine returns a sample of unmasked pixels from an N-dim image.
+# The input is the image pointer, the mask pointer (which may be NULL),
+# the array to be filled, the maximum number of sample plixels, and the
+# minimum number of lines to sample.  The return value is the actual number
+# of pixels which will be less than or equal to the specified maximum number.
+# 
+# The intent of this routine is to sample fairly uniformly but efficiently.
+# If nlines is zero the total number of pixels, in raster order, is divided
+# into uniform steps.  But this may end up reading many lines each for a
+# few pixels.  To be more efficient if nlines is greater than zero then as
+# many pixels per line as possible are read to sample at least the requested
+# number of lines.
+
+$for (sird)
+int procedure xt_sample$t (im, bpm, sample, nsample, nlines)
+
+pointer	im			#I Image pointer
+pointer	bpm			#I Bad pixel pointer
+PIXEL	sample[nsample]		#I Work array
+int	nsample			#I Maximum number of sample pixels
+int	nlines			#I Minimum number of lines to sample
+int	nreturn			#I Number of pixels returned
+
+long	v[IM_MAXDIM], vbuf[IM_MAXDIM]
+int	i, ip, n, ndim, npix, nc
+real	p, c, pstep, cstep
+pointer	buf, bpmbuf
+
+int	imgnls()
+$if (datatype != s)
+int	imgnl$t()
+$endif
+
+begin
+	# Determine the number of pixels in the data, the number
+	# to make up nsample pixels, and the pixel step.
+
+	ndim = IM_NDIM(im)
+	nc = IM_LEN(im,1)
+	npix = 1
+	do i = 1, ndim
+	    npix = npix * IM_LEN(im,i)
+	pstep = real(npix) / min (npix, nsample)
+
+	# To insure a minimum number of lines and efficient use of
+	# pixels in a line, set the column step.
+
+	if (nlines == 0)
+	    cstep = pstep
+	else
+	    cstep = nc / min (min(npix,nsample)/nlines, nc)
+
+	# Step through the pixels.
+	call amovkl (long(1), v, IM_MAXDIM)
+	nreturn = 0
+	for (p=(pstep-0.01)/2; p<npix && nreturn<nsample;) {
+
+	    # Convert pixel number to image vector coordinates.
+	    n = npix; ip = nint(p)
+	    do i = ndim, 1, -1 {
+	        n = n / IM_LEN(im,i)
+	        v[i] = 1 + ip / n
+		ip = mod (ip, n)
+	    }
+
+	    # Sample the pixels in the line.
+	    if (nlines == 0)
+		c = v[1]
+	    else
+		c = (cstep - 0.01) / 2
+
+	    if (bpm == NULL) {
+		v[1] = 1
+		if (imgnl$t (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    nreturn = nreturn + 1
+		    sample[nreturn] = Mem$t[buf+ip]
+		    p = p + pstep
+		}
+	    } else {
+		v[1] = 1
+	        call amovl (v, vbuf, IM_MAXDIM)
+		if (imgnls (bpm, bpmbuf, vbuf) == EOF)
+		    break
+		if (imgnl$t (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    if (Mems[bpmbuf+ip] == 0) {
+			nreturn = nreturn + 1
+			sample[nreturn] = Mem$t[buf+ip]
+		    }
+		    p = p + pstep
+		}
+	    }
+	}
+
+	return (nreturn)
+end
+$endfor
diff --git a/pkg/xtools/xtsample.x b/pkg/xtools/xtsample.x
new file mode 100644
index 00000000..e8184e1d
--- /dev/null
+++ b/pkg/xtools/xtsample.x
@@ -0,0 +1,362 @@
+include	<imhdr.h>
+
+
+# XT_SAMPLE -- Get sample of pixels.
+#
+# This routine returns a sample of unmasked pixels from an N-dim image.
+# The input is the image pointer, the mask pointer (which may be NULL),
+# the array to be filled, the maximum number of sample plixels, and the
+# minimum number of lines to sample.  The return value is the actual number
+# of pixels which will be less than or equal to the specified maximum number.
+# 
+# The intent of this routine is to sample fairly uniformly but efficiently.
+# If nlines is zero the total number of pixels, in raster order, is divided
+# into uniform steps.  But this may end up reading many lines each for a
+# few pixels.  To be more efficient if nlines is greater than zero then as
+# many pixels per line as possible are read to sample at least the requested
+# number of lines.
+
+
+int procedure xt_samples (im, bpm, sample, nsample, nlines)
+
+pointer	im			#I Image pointer
+pointer	bpm			#I Bad pixel pointer
+short	sample[nsample]		#I Work array
+int	nsample			#I Maximum number of sample pixels
+int	nlines			#I Minimum number of lines to sample
+int	nreturn			#I Number of pixels returned
+
+long	v[IM_MAXDIM], vbuf[IM_MAXDIM]
+int	i, ip, n, ndim, npix, nc
+real	p, c, pstep, cstep
+pointer	buf, bpmbuf
+
+int	imgnls()
+
+begin
+	# Determine the number of pixels in the data, the number
+	# to make up nsample pixels, and the pixel step.
+
+	ndim = IM_NDIM(im)
+	nc = IM_LEN(im,1)
+	npix = 1
+	do i = 1, ndim
+	    npix = npix * IM_LEN(im,i)
+	pstep = real(npix) / min (npix, nsample)
+
+	# To insure a minimum number of lines and efficient use of
+	# pixels in a line, set the column step.
+
+	if (nlines == 0)
+	    cstep = pstep
+	else
+	    cstep = nc / min (min(npix,nsample)/nlines, nc)
+
+	# Step through the pixels.
+	call amovkl (long(1), v, IM_MAXDIM)
+	nreturn = 0
+	for (p=(pstep-0.01)/2; p<npix && nreturn<nsample;) {
+
+	    # Convert pixel number to image vector coordinates.
+	    n = npix; ip = nint(p)
+	    do i = ndim, 1, -1 {
+	        n = n / IM_LEN(im,i)
+	        v[i] = 1 + ip / n
+		ip = mod (ip, n)
+	    }
+
+	    # Sample the pixels in the line.
+	    if (nlines == 0)
+		c = v[1]
+	    else
+		c = (cstep - 0.01) / 2
+
+	    if (bpm == NULL) {
+		v[1] = 1
+		if (imgnls (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    nreturn = nreturn + 1
+		    sample[nreturn] = Mems[buf+ip]
+		    p = p + pstep
+		}
+	    } else {
+		v[1] = 1
+	        call amovl (v, vbuf, IM_MAXDIM)
+		if (imgnls (bpm, bpmbuf, vbuf) == EOF)
+		    break
+		if (imgnls (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    if (Mems[bpmbuf+ip] == 0) {
+			nreturn = nreturn + 1
+			sample[nreturn] = Mems[buf+ip]
+		    }
+		    p = p + pstep
+		}
+	    }
+	}
+
+	return (nreturn)
+end
+
+int procedure xt_samplei (im, bpm, sample, nsample, nlines)
+
+pointer	im			#I Image pointer
+pointer	bpm			#I Bad pixel pointer
+int	sample[nsample]		#I Work array
+int	nsample			#I Maximum number of sample pixels
+int	nlines			#I Minimum number of lines to sample
+int	nreturn			#I Number of pixels returned
+
+long	v[IM_MAXDIM], vbuf[IM_MAXDIM]
+int	i, ip, n, ndim, npix, nc
+real	p, c, pstep, cstep
+pointer	buf, bpmbuf
+
+int	imgnls()
+int	imgnli()
+
+begin
+	# Determine the number of pixels in the data, the number
+	# to make up nsample pixels, and the pixel step.
+
+	ndim = IM_NDIM(im)
+	nc = IM_LEN(im,1)
+	npix = 1
+	do i = 1, ndim
+	    npix = npix * IM_LEN(im,i)
+	pstep = real(npix) / min (npix, nsample)
+
+	# To insure a minimum number of lines and efficient use of
+	# pixels in a line, set the column step.
+
+	if (nlines == 0)
+	    cstep = pstep
+	else
+	    cstep = nc / min (min(npix,nsample)/nlines, nc)
+
+	# Step through the pixels.
+	call amovkl (long(1), v, IM_MAXDIM)
+	nreturn = 0
+	for (p=(pstep-0.01)/2; p<npix && nreturn<nsample;) {
+
+	    # Convert pixel number to image vector coordinates.
+	    n = npix; ip = nint(p)
+	    do i = ndim, 1, -1 {
+	        n = n / IM_LEN(im,i)
+	        v[i] = 1 + ip / n
+		ip = mod (ip, n)
+	    }
+
+	    # Sample the pixels in the line.
+	    if (nlines == 0)
+		c = v[1]
+	    else
+		c = (cstep - 0.01) / 2
+
+	    if (bpm == NULL) {
+		v[1] = 1
+		if (imgnli (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    nreturn = nreturn + 1
+		    sample[nreturn] = Memi[buf+ip]
+		    p = p + pstep
+		}
+	    } else {
+		v[1] = 1
+	        call amovl (v, vbuf, IM_MAXDIM)
+		if (imgnls (bpm, bpmbuf, vbuf) == EOF)
+		    break
+		if (imgnli (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    if (Mems[bpmbuf+ip] == 0) {
+			nreturn = nreturn + 1
+			sample[nreturn] = Memi[buf+ip]
+		    }
+		    p = p + pstep
+		}
+	    }
+	}
+
+	return (nreturn)
+end
+
+int procedure xt_sampler (im, bpm, sample, nsample, nlines)
+
+pointer	im			#I Image pointer
+pointer	bpm			#I Bad pixel pointer
+real	sample[nsample]		#I Work array
+int	nsample			#I Maximum number of sample pixels
+int	nlines			#I Minimum number of lines to sample
+int	nreturn			#I Number of pixels returned
+
+long	v[IM_MAXDIM], vbuf[IM_MAXDIM]
+int	i, ip, n, ndim, npix, nc
+real	p, c, pstep, cstep
+pointer	buf, bpmbuf
+
+int	imgnls()
+int	imgnlr()
+
+begin
+	# Determine the number of pixels in the data, the number
+	# to make up nsample pixels, and the pixel step.
+
+	ndim = IM_NDIM(im)
+	nc = IM_LEN(im,1)
+	npix = 1
+	do i = 1, ndim
+	    npix = npix * IM_LEN(im,i)
+	pstep = real(npix) / min (npix, nsample)
+
+	# To insure a minimum number of lines and efficient use of
+	# pixels in a line, set the column step.
+
+	if (nlines == 0)
+	    cstep = pstep
+	else
+	    cstep = nc / min (min(npix,nsample)/nlines, nc)
+
+	# Step through the pixels.
+	call amovkl (long(1), v, IM_MAXDIM)
+	nreturn = 0
+	for (p=(pstep-0.01)/2; p<npix && nreturn<nsample;) {
+
+	    # Convert pixel number to image vector coordinates.
+	    n = npix; ip = nint(p)
+	    do i = ndim, 1, -1 {
+	        n = n / IM_LEN(im,i)
+	        v[i] = 1 + ip / n
+		ip = mod (ip, n)
+	    }
+
+	    # Sample the pixels in the line.
+	    if (nlines == 0)
+		c = v[1]
+	    else
+		c = (cstep - 0.01) / 2
+
+	    if (bpm == NULL) {
+		v[1] = 1
+		if (imgnlr (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    nreturn = nreturn + 1
+		    sample[nreturn] = Memr[buf+ip]
+		    p = p + pstep
+		}
+	    } else {
+		v[1] = 1
+	        call amovl (v, vbuf, IM_MAXDIM)
+		if (imgnls (bpm, bpmbuf, vbuf) == EOF)
+		    break
+		if (imgnlr (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    if (Mems[bpmbuf+ip] == 0) {
+			nreturn = nreturn + 1
+			sample[nreturn] = Memr[buf+ip]
+		    }
+		    p = p + pstep
+		}
+	    }
+	}
+
+	return (nreturn)
+end
+
+int procedure xt_sampled (im, bpm, sample, nsample, nlines)
+
+pointer	im			#I Image pointer
+pointer	bpm			#I Bad pixel pointer
+double	sample[nsample]		#I Work array
+int	nsample			#I Maximum number of sample pixels
+int	nlines			#I Minimum number of lines to sample
+int	nreturn			#I Number of pixels returned
+
+long	v[IM_MAXDIM], vbuf[IM_MAXDIM]
+int	i, ip, n, ndim, npix, nc
+real	p, c, pstep, cstep
+pointer	buf, bpmbuf
+
+int	imgnls()
+int	imgnld()
+
+begin
+	# Determine the number of pixels in the data, the number
+	# to make up nsample pixels, and the pixel step.
+
+	ndim = IM_NDIM(im)
+	nc = IM_LEN(im,1)
+	npix = 1
+	do i = 1, ndim
+	    npix = npix * IM_LEN(im,i)
+	pstep = real(npix) / min (npix, nsample)
+
+	# To insure a minimum number of lines and efficient use of
+	# pixels in a line, set the column step.
+
+	if (nlines == 0)
+	    cstep = pstep
+	else
+	    cstep = nc / min (min(npix,nsample)/nlines, nc)
+
+	# Step through the pixels.
+	call amovkl (long(1), v, IM_MAXDIM)
+	nreturn = 0
+	for (p=(pstep-0.01)/2; p<npix && nreturn<nsample;) {
+
+	    # Convert pixel number to image vector coordinates.
+	    n = npix; ip = nint(p)
+	    do i = ndim, 1, -1 {
+	        n = n / IM_LEN(im,i)
+	        v[i] = 1 + ip / n
+		ip = mod (ip, n)
+	    }
+
+	    # Sample the pixels in the line.
+	    if (nlines == 0)
+		c = v[1]
+	    else
+		c = (cstep - 0.01) / 2
+
+	    if (bpm == NULL) {
+		v[1] = 1
+		if (imgnld (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    nreturn = nreturn + 1
+		    sample[nreturn] = Memd[buf+ip]
+		    p = p + pstep
+		}
+	    } else {
+		v[1] = 1
+	        call amovl (v, vbuf, IM_MAXDIM)
+		if (imgnls (bpm, bpmbuf, vbuf) == EOF)
+		    break
+		if (imgnld (im, buf, v) == EOF)
+		    break
+		for (; c<nc && nreturn<nsample; c=c+cstep) {
+		    ip = nint (c)
+		    if (Mems[bpmbuf+ip] == 0) {
+			nreturn = nreturn + 1
+			sample[nreturn] = Memd[buf+ip]
+		    }
+		    p = p + pstep
+		}
+	    }
+	}
+
+	return (nreturn)
+end
+
diff --git a/pkg/xtools/xtsort.x b/pkg/xtools/xtsort.x
new file mode 100644
index 00000000..9d3535e8
--- /dev/null
+++ b/pkg/xtools/xtsort.x
@@ -0,0 +1,216 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# XT_SORT2 -- Sort 2 dimensional vectors by the first component.
+
+procedure xt_sort2 (a1, a2, npts)
+
+real	a1[npts], a2[npts]		# Arrays to be sorted
+int	npts				# Number of points
+
+int	i, j
+pointer	sp, index, ptr
+
+int	xts_compare()
+extern	xts_compare
+
+begin
+	call smark (sp)
+	call salloc (index, npts, TY_INT)
+	call salloc (ptr, npts, TY_REAL)
+
+	do i = 1, npts
+	    Memi[index+i-1] = ptr + i - 1
+
+	call amovr (a1, Memr[ptr], npts)
+
+	call qsort (Memi[index], npts, xts_compare)
+
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a1[i] = Memr[j]
+	}
+
+	call amovr (a2, Memr[ptr], npts)
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a2[i] = Memr[j]
+	}
+
+	call sfree (sp)
+end
+
+
+# XT_SORT3 -- Sort 3 dimensional vectors by the first component.
+
+procedure xt_sort3 (a1, a2, a3, npts)
+
+real	a1[npts], a2[npts], a3[npts]	# Arrays to be sorted
+int	npts				# Number of points
+
+int	i, j
+pointer	sp, index, ptr
+
+int	xts_compare()
+extern	xts_compare
+
+begin
+	call smark (sp)
+	call salloc (index, npts, TY_INT)
+	call salloc (ptr, npts, TY_REAL)
+
+	do i = 1, npts
+	    Memi[index+i-1] = ptr + i - 1
+
+	call amovr (a1, Memr[ptr], npts)
+
+	call qsort (Memi[index], npts, xts_compare)
+
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a1[i] = Memr[j]
+	}
+
+	call amovr (a2, Memr[ptr], npts)
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a2[i] = Memr[j]
+	}
+
+	call amovr (a3, Memr[ptr], npts)
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a3[i] = Memr[j]
+	}
+
+	call sfree (sp)
+end
+
+
+# XT_SORT4 -- Sort 4 dimensional vectors by the first component.
+
+procedure xt_sort4 (a1, a2, a3, a4, npts)
+
+real	a1[npts], a2[npts], a3[npts], a4[npts]	# Arrays to be sorted
+int	npts					# Number of points
+
+int	i, j
+pointer	sp, index, ptr
+
+int	xts_compare()
+extern	xts_compare
+
+begin
+	call smark (sp)
+	call salloc (index, npts, TY_INT)
+	call salloc (ptr, npts, TY_REAL)
+
+	do i = 1, npts
+	    Memi[index+i-1] = ptr + i - 1
+
+	call amovr (a1, Memr[ptr], npts)
+
+	call qsort (Memi[index], npts, xts_compare)
+
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a1[i] = Memr[j]
+	}
+
+	call amovr (a2, Memr[ptr], npts)
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a2[i] = Memr[j]
+	}
+
+	call amovr (a3, Memr[ptr], npts)
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a3[i] = Memr[j]
+	}
+
+	call amovr (a4, Memr[ptr], npts)
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a4[i] = Memr[j]
+	}
+
+	call sfree (sp)
+end
+
+
+# XTS_COMPARE -- Compare two real values in the Memr array.
+
+int procedure xts_compare (i, j)
+
+pointer	i, j		# Array indices to be compared.
+
+begin
+	if (Memr[i] < Memr[j])
+	    return (-1)
+	else if (Memr[i] > Memr[j])
+	    return (1)
+	else
+	    return (0)
+end
+
+
+# XT_SORT3D -- Sort 3 double precision vectors by the first component.
+
+procedure xt_sort3d (a1, a2, a3, npts)
+
+double	a1[npts], a2[npts], a3[npts]	# Arrays to be sorted
+int	npts				# Number of points
+
+int	i, j
+pointer	sp, index, ptr
+
+int	xts_compared()
+extern	xts_compared
+
+begin
+	call smark (sp)
+	call salloc (index, npts, TY_INT)
+	call salloc (ptr, npts, TY_DOUBLE)
+
+	do i = 1, npts
+	    Memi[index+i-1] = ptr + i - 1
+
+	call amovd (a1, Memd[ptr], npts)
+
+	call qsort (Memi[index], npts, xts_compared)
+
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a1[i] = Memd[j]
+	}
+
+	call amovd (a2, Memd[ptr], npts)
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a2[i] = Memd[j]
+	}
+
+	call amovd (a3, Memd[ptr], npts)
+	do i = 1, npts {
+	    j = Memi[index+i-1]
+	    a3[i] = Memd[j]
+	}
+
+	call sfree (sp)
+end
+
+
+# XTS_COMPARED -- Compare two double values in the Memd array.
+
+int procedure xts_compared (i, j)
+
+pointer	i, j		# Array indices to be compared.
+
+begin
+	if (Memd[i] < Memd[j])
+	    return (-1)
+	else if (Memd[i] > Memd[j])
+	    return (1)
+	else
+	    return (0)
+end
diff --git a/pkg/xtools/xtstat.gx b/pkg/xtools/xtstat.gx
new file mode 100644
index 00000000..99012f71
--- /dev/null
+++ b/pkg/xtools/xtstat.gx
@@ -0,0 +1,107 @@
+# XT_STAT -- Compute statistics from a sample.
+#
+# The sample array will be sorted.
+
+define	NMIN	10	# Minimum number of pixels for mode calculation
+define	ZSTEP	0.01	# Step size for search for mode
+define	ZBIN	0.1	# Bin size for mode.
+
+$for (sird)
+procedure xt_stat$t (sample, nsample, frac, mean, sigma, median, mode)
+
+PIXEL	sample[nsample]			#I Sample
+int	nsample				#I Number of sample pixels
+real	frac				#I Fraction of data to use
+$if (datatype == d)
+double	mean, sigma, median, mode	#O Statistics
+$else
+real	mean, sigma, median, mode	#O Statistics
+$endif
+
+int	i, j, k, nmax
+$if (datatype == d)
+double	z1, z2, zstep, zbin
+bool	fp_equald()
+$else
+real	z1, z2, zstep, zbin
+bool	fp_equalr()
+$endif
+
+begin
+	# Sort the sample.
+	call asrt$t (sample, sample, nsample)
+
+	# Set fraction to use.
+	i = max (1, 1 + nsample * (1. - frac) / 2.)
+	j = min (nsample, 1 + nsample * (1. + frac) / 2.)
+	z1 = sample[i]
+	z2 = sample[j]
+
+	# Compute the mean and sigma.
+	call aavg$t (sample[i], j-i+1, mean, sigma)
+
+	# Compute the median.
+	median =  sample[nsample/2]
+
+	z1 = median - 2 * sigma
+	if (z1 < sample[1])
+	    i = 1
+	else {
+	    k = i
+	    do i = k, 2, -1 {
+		if (sample[i] <= z1)
+		    break
+	    }
+	}
+	z1 = sample[i]
+
+	z2 = median + 2 * sigma
+	if (z2 > sample[nsample])
+	    i = nsample
+	else {
+	    k = j
+	    do j = k, nsample-1 {
+		if (sample[j] >= z1)
+		    break
+	    }
+	}
+	z2 = sample[j]
+
+	# Compute the mode.
+
+	if (nsample < NMIN)
+	    mode = median
+
+$if (datatype == d)
+	else if (fp_equald (z1, z2))
+$else
+	else if (fp_equalr (z1, z2))
+$endif
+	    mode = z1
+
+	else {
+	    zstep = ZSTEP * sigma
+	    zbin = ZBIN * sigma
+	    $if (datatype == sil)
+	    zstep = max (1., zstep)
+	    zbin = max (1., zbin)
+	    $endif
+
+	    z1 = z1 - zstep
+	    k = i
+	    nmax = 0
+	    repeat {
+		z1 = z1 + zstep
+		z2 = z1 + zbin
+		for (; i < j && sample[i] < z1; i=i+1)
+		    ;
+		for (; k < j && sample[k] < z2; k=k+1)
+		    ;
+		if (k - i > nmax) {
+		    nmax = k - i
+		    mode = sample[(i+k)/2]
+		}
+	    } until (k >= j)
+	}
+end
+$endfor
diff --git a/pkg/xtools/xtstat.x b/pkg/xtools/xtstat.x
new file mode 100644
index 00000000..1979fddf
--- /dev/null
+++ b/pkg/xtools/xtstat.x
@@ -0,0 +1,337 @@
+# XT_STAT -- Compute statistics from a sample.
+#
+# The sample array will be sorted.
+
+define	NMIN	10	# Minimum number of pixels for mode calculation
+define	ZSTEP	0.01	# Step size for search for mode
+define	ZBIN	0.1	# Bin size for mode.
+
+
+procedure xt_stats (sample, nsample, frac, mean, sigma, median, mode)
+
+short	sample[nsample]			#I Sample
+int	nsample				#I Number of sample pixels
+real	frac				#I Fraction of data to use
+real	mean, sigma, median, mode	#O Statistics
+
+int	i, j, k, nmax
+real	z1, z2, zstep, zbin
+bool	fp_equalr()
+
+begin
+	# Sort the sample.
+	call asrts (sample, sample, nsample)
+
+	# Set fraction to use.
+	i = max (1, 1 + nsample * (1. - frac) / 2.)
+	j = min (nsample, 1 + nsample * (1. + frac) / 2.)
+	z1 = sample[i]
+	z2 = sample[j]
+
+	# Compute the mean and sigma.
+	call aavgs (sample[i], j-i+1, mean, sigma)
+
+	# Compute the median.
+	median =  sample[nsample/2]
+
+	z1 = median - 2 * sigma
+	if (z1 < sample[1])
+	    i = 1
+	else {
+	    k = i
+	    do i = k, 2, -1 {
+		if (sample[i] <= z1)
+		    break
+	    }
+	}
+	z1 = sample[i]
+
+	z2 = median + 2 * sigma
+	if (z2 > sample[nsample])
+	    i = nsample
+	else {
+	    k = j
+	    do j = k, nsample-1 {
+		if (sample[j] >= z1)
+		    break
+	    }
+	}
+	z2 = sample[j]
+
+	# Compute the mode.
+
+	if (nsample < NMIN)
+	    mode = median
+
+	else if (fp_equalr (z1, z2))
+	    mode = z1
+
+	else {
+	    zstep = ZSTEP * sigma
+	    zbin = ZBIN * sigma
+	    zstep = max (1., zstep)
+	    zbin = max (1., zbin)
+
+	    z1 = z1 - zstep
+	    k = i
+	    nmax = 0
+	    repeat {
+		z1 = z1 + zstep
+		z2 = z1 + zbin
+		for (; i < j && sample[i] < z1; i=i+1)
+		    ;
+		for (; k < j && sample[k] < z2; k=k+1)
+		    ;
+		if (k - i > nmax) {
+		    nmax = k - i
+		    mode = sample[(i+k)/2]
+		}
+	    } until (k >= j)
+	}
+end
+
+procedure xt_stati (sample, nsample, frac, mean, sigma, median, mode)
+
+int	sample[nsample]			#I Sample
+int	nsample				#I Number of sample pixels
+real	frac				#I Fraction of data to use
+real	mean, sigma, median, mode	#O Statistics
+
+int	i, j, k, nmax
+real	z1, z2, zstep, zbin
+bool	fp_equalr()
+
+begin
+	# Sort the sample.
+	call asrti (sample, sample, nsample)
+
+	# Set fraction to use.
+	i = max (1, 1 + nsample * (1. - frac) / 2.)
+	j = min (nsample, 1 + nsample * (1. + frac) / 2.)
+	z1 = sample[i]
+	z2 = sample[j]
+
+	# Compute the mean and sigma.
+	call aavgi (sample[i], j-i+1, mean, sigma)
+
+	# Compute the median.
+	median =  sample[nsample/2]
+
+	z1 = median - 2 * sigma
+	if (z1 < sample[1])
+	    i = 1
+	else {
+	    k = i
+	    do i = k, 2, -1 {
+		if (sample[i] <= z1)
+		    break
+	    }
+	}
+	z1 = sample[i]
+
+	z2 = median + 2 * sigma
+	if (z2 > sample[nsample])
+	    i = nsample
+	else {
+	    k = j
+	    do j = k, nsample-1 {
+		if (sample[j] >= z1)
+		    break
+	    }
+	}
+	z2 = sample[j]
+
+	# Compute the mode.
+
+	if (nsample < NMIN)
+	    mode = median
+
+	else if (fp_equalr (z1, z2))
+	    mode = z1
+
+	else {
+	    zstep = ZSTEP * sigma
+	    zbin = ZBIN * sigma
+	    zstep = max (1., zstep)
+	    zbin = max (1., zbin)
+
+	    z1 = z1 - zstep
+	    k = i
+	    nmax = 0
+	    repeat {
+		z1 = z1 + zstep
+		z2 = z1 + zbin
+		for (; i < j && sample[i] < z1; i=i+1)
+		    ;
+		for (; k < j && sample[k] < z2; k=k+1)
+		    ;
+		if (k - i > nmax) {
+		    nmax = k - i
+		    mode = sample[(i+k)/2]
+		}
+	    } until (k >= j)
+	}
+end
+
+procedure xt_statr (sample, nsample, frac, mean, sigma, median, mode)
+
+real	sample[nsample]			#I Sample
+int	nsample				#I Number of sample pixels
+real	frac				#I Fraction of data to use
+real	mean, sigma, median, mode	#O Statistics
+
+int	i, j, k, nmax
+real	z1, z2, zstep, zbin
+bool	fp_equalr()
+
+begin
+	# Sort the sample.
+	call asrtr (sample, sample, nsample)
+
+	# Set fraction to use.
+	i = max (1, 1 + nsample * (1. - frac) / 2.)
+	j = min (nsample, 1 + nsample * (1. + frac) / 2.)
+	z1 = sample[i]
+	z2 = sample[j]
+
+	# Compute the mean and sigma.
+	call aavgr (sample[i], j-i+1, mean, sigma)
+
+	# Compute the median.
+	median =  sample[nsample/2]
+
+	z1 = median - 2 * sigma
+	if (z1 < sample[1])
+	    i = 1
+	else {
+	    k = i
+	    do i = k, 2, -1 {
+		if (sample[i] <= z1)
+		    break
+	    }
+	}
+	z1 = sample[i]
+
+	z2 = median + 2 * sigma
+	if (z2 > sample[nsample])
+	    i = nsample
+	else {
+	    k = j
+	    do j = k, nsample-1 {
+		if (sample[j] >= z1)
+		    break
+	    }
+	}
+	z2 = sample[j]
+
+	# Compute the mode.
+
+	if (nsample < NMIN)
+	    mode = median
+
+	else if (fp_equalr (z1, z2))
+	    mode = z1
+
+	else {
+	    zstep = ZSTEP * sigma
+	    zbin = ZBIN * sigma
+
+	    z1 = z1 - zstep
+	    k = i
+	    nmax = 0
+	    repeat {
+		z1 = z1 + zstep
+		z2 = z1 + zbin
+		for (; i < j && sample[i] < z1; i=i+1)
+		    ;
+		for (; k < j && sample[k] < z2; k=k+1)
+		    ;
+		if (k - i > nmax) {
+		    nmax = k - i
+		    mode = sample[(i+k)/2]
+		}
+	    } until (k >= j)
+	}
+end
+
+procedure xt_statd (sample, nsample, frac, mean, sigma, median, mode)
+
+double	sample[nsample]			#I Sample
+int	nsample				#I Number of sample pixels
+real	frac				#I Fraction of data to use
+double	mean, sigma, median, mode	#O Statistics
+
+int	i, j, k, nmax
+double	z1, z2, zstep, zbin
+bool	fp_equald()
+
+begin
+	# Sort the sample.
+	call asrtd (sample, sample, nsample)
+
+	# Set fraction to use.
+	i = max (1, 1 + nsample * (1. - frac) / 2.)
+	j = min (nsample, 1 + nsample * (1. + frac) / 2.)
+	z1 = sample[i]
+	z2 = sample[j]
+
+	# Compute the mean and sigma.
+	call aavgd (sample[i], j-i+1, mean, sigma)
+
+	# Compute the median.
+	median =  sample[nsample/2]
+
+	z1 = median - 2 * sigma
+	if (z1 < sample[1])
+	    i = 1
+	else {
+	    k = i
+	    do i = k, 2, -1 {
+		if (sample[i] <= z1)
+		    break
+	    }
+	}
+	z1 = sample[i]
+
+	z2 = median + 2 * sigma
+	if (z2 > sample[nsample])
+	    i = nsample
+	else {
+	    k = j
+	    do j = k, nsample-1 {
+		if (sample[j] >= z1)
+		    break
+	    }
+	}
+	z2 = sample[j]
+
+	# Compute the mode.
+
+	if (nsample < NMIN)
+	    mode = median
+
+	else if (fp_equald (z1, z2))
+	    mode = z1
+
+	else {
+	    zstep = ZSTEP * sigma
+	    zbin = ZBIN * sigma
+
+	    z1 = z1 - zstep
+	    k = i
+	    nmax = 0
+	    repeat {
+		z1 = z1 + zstep
+		z2 = z1 + zbin
+		for (; i < j && sample[i] < z1; i=i+1)
+		    ;
+		for (; k < j && sample[k] < z2; k=k+1)
+		    ;
+		if (k - i > nmax) {
+		    nmax = k - i
+		    mode = sample[(i+k)/2]
+		}
+	    } until (k >= j)
+	}
+end
+
diff --git a/pkg/xtools/xtstripwhite.x b/pkg/xtools/xtstripwhite.x
new file mode 100644
index 00000000..b6cf09c3
--- /dev/null
+++ b/pkg/xtools/xtstripwhite.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# XT_STRIPWHITE -- Strip leading white space from a string.
+# The string must have an EOS.
+
+procedure xt_stripwhite (str)
+
+char	str[ARB]		# String to be stripped
+
+int	i
+
+begin
+	for (i=1; (str[i]!=EOS) && (IS_WHITE(str[i])); i=i+1)
+	    ;
+	call strcpy (str[i], str, ARB)
+end
diff --git a/pkg/xtools/xtsums.x b/pkg/xtools/xtsums.x
new file mode 100644
index 00000000..8d6172f8
--- /dev/null
+++ b/pkg/xtools/xtsums.x
@@ -0,0 +1,394 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# XT_LSUM -- Sum lines
+#
+# A new sum vector is created when the data pointer is null or if the number
+# of columns is changed.  If the previous sum overlaps the requested sum then
+# additions and subtractions are performed on the previous sum to minimize
+# the number of arithmetic operations.
+
+procedure xt_lsum (im, col1, col2, line1, line2, data)
+
+pointer	im		# IMIO pointer
+int	col1, col2	# Column limits of the sum
+int	line1, line2	# Line limits
+pointer	data		# Data pointer
+
+int	i
+int	ncols, nlines, nc, nl, c1, c2, l1, l2
+pointer	j
+
+pointer	imgs2r()
+
+begin
+	ncols = col2 - col1 + 1
+	nlines = line2 - line1 + 1
+
+	if ((data == NULL) || (ncols != nc)) {
+	    call mfree (data, TY_REAL)
+	    call malloc (data, ncols, TY_REAL)
+	    nc = ncols
+	    l1 = 0
+	    l2 = 0
+	}
+
+	if (nlines != nl) {
+	    nl = nlines
+	    l1 = 0
+	    l2 = 0
+	}
+
+	# If only one line then don't bother with summing.
+
+	if (nlines == 1) {
+	    if ((line1 != l1) || (col1 != c1) || (col2 != c2)) {
+	        c1 = col1
+	        c2 = col2
+	        l1 = line1
+	        l2 = line2
+		j = imgs2r (im, c1, c2, l1, l2)
+	        call amovr (Memr[j], Memr[data], nc)
+	    }
+	    return
+	}
+
+	# If the sum limits are outside the last sum limits then form
+	# the sums from scratch.
+
+	if ((line1 > l2) || (line2 < l1) || (col1 != c1) || (col2 != c2)) {
+	    c1 = col1
+	    c2 = col2
+	    l1 = line1
+	    l2 = line2
+	    call aclrr (Memr[data], nc)
+	    do i = l1, l2 {
+		j = imgs2r (im, c1, c2, i, i)
+		call aaddr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+
+	# If the sum limits overlap then add and subtract to compute the
+	# new sums from the previous sums.  This minimizes the number of
+	# arithmetic operations in common applications.
+
+	} else if (line1 > l1) {
+	    do i = l1, line1 - 1 {
+		j = imgs2r (im, c1, c2, i, i)
+		call asubr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+	    do i = l2 + 1, line2 {
+		j = imgs2r (im, c1, c2, i, i)
+		call aaddr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+	    l1 = line1
+	    l2 = line2
+
+	} else {
+	    do i = line2 + 1, l2 {
+		j = imgs2r (im, c1, c2, i, i)
+		call asubr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+	    do i = line1, l1 - 1 {
+		j = imgs2r (im, c1, c2, i, i)
+		call aaddr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+	    l1 = line1
+	    l2 = line2
+	}
+end
+
+
+# XT_CSUM -- Sum columns
+#
+# A new sum vector is created when the data pointer is null or if the number
+# of lines is changed.  If the previous sum overlaps the requested sum then
+# additions and subtractions are performed on the previous sum to minimize
+# the number of arithmetic operations.
+
+procedure xt_csum (co, col1, col2, line1, line2, data)
+
+pointer	co		# COIO pointer
+int	col1, col2	# Column limits of the sum
+int	line1, line2	# Line limits
+pointer	data		# Data pointer
+
+int	i
+int	ncols, nlines, nc, nl, c1, c2, l1, l2
+pointer	j
+
+pointer	cogetr()
+
+begin
+	ncols = col2 - col1 + 1
+	nlines = line2 - line1 + 1
+
+	if ((data == NULL) || (nlines != nl)) {
+	    call mfree (data, TY_REAL)
+	    call malloc (data, nlines, TY_REAL)
+	    nl = nlines
+	    c1 = 0
+	    c2 = 0
+	}
+
+	if (ncols != nc) {
+	    nc = ncols
+	    c1 = 0
+	    c2 = 0
+	}
+
+	# If only one column then don't bother with summing.
+
+	if (ncols == 1) {
+	    if ((col1 != c1) || (line1 != l1) || (line2 != l2)) {
+	        c1 = col1
+	        c2 = col2
+	        l1 = line1
+	        l2 = line2
+		j = cogetr (co, c1, l1, l2)
+	        call amovr (Memr[j], Memr[data], nl)
+	    }
+	    return
+	}
+
+	# If the sum limits are outside the last sum limits then form
+	# the sums from scratch.
+
+	if ((col1 > c2) || (col2 < c1) || (line1 != l1) || (line2 != l2)) {
+	    c1 = col1
+	    c2 = col2
+	    l1 = line1
+	    l2 = line2
+	    call aclrr (Memr[data], nlines)
+	    do i = c1, c2 {
+		j = cogetr (co, i, l1, l2)
+		call aaddr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+
+	# If the sum limits overlap then add and subtract to compute the
+	# new sums from the previous sums.  This minimizes the number of
+	# arithmetic operations in common applications.
+
+	} else if (col1 > c1) {
+	    do i = c1, col1 - 1 {
+		j = cogetr (co, i, l1, l2)
+		call asubr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+	    do i = c2 + 1, col2 {
+		j = cogetr (co, i, l1, l2)
+		call aaddr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+	    c1 = col1
+	    c2 = col2
+
+	} else {
+	    do i = col2 + 1, c2 {
+		j = cogetr (co, i, l1, l2)
+		call asubr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+	    do i = col1, c1 - 1 {
+		j = cogetr (co, i, l1, l2)
+		call aaddr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+	    c1 = col1
+	    c2 = col2
+	}
+end
+
+
+# XT_LSUMB -- Sum lines with buffering
+#
+# A new sum vector is created when the data pointer is null or if the number
+# of columns is changed.  If the previous sum overlaps the requested sum then
+# additions and subtractions are performed on the previous sum to minimize
+# the number of arithmetic operations.  Buffering of previous lines is done.
+
+procedure xt_lsumb (im, col1, col2, line1, line2, data)
+
+pointer	im		# IMIO pointer
+int	col1, col2	# Column limits of the sum
+int	line1, line2	# Line limits
+pointer	data		# Data pointer
+
+int	i
+int	ncols, nlines, nc, nl, c1, c2, l1, l2
+pointer	j
+
+pointer	imgs2r()
+
+begin
+	ncols = col2 - col1 + 1
+	nlines = line2 - line1 + 1
+
+	if ((data == NULL) || (ncols != nc)) {
+	    call mfree (data, TY_REAL)
+	    call malloc (data, (nlines + 1) * ncols, TY_REAL)
+	    nc = ncols
+	    l1 = 0
+	    l2 = 0
+	}
+
+	if (nlines != nl) {
+	    nl = nlines
+	    l1 = 0
+	    l2 = 0
+	}
+
+	# If only one line then don't bother with summing.
+
+	if (nlines == 1) {
+	    if ((line1 != l1) || (col1 != c1) || (col2 != c2)) {
+	        c1 = col1
+	        c2 = col2
+	        l1 = line1
+	        l2 = line2
+		j = imgs2r (im, c1, c2, l1, l2)
+	        call amovr (Memr[j], Memr[data], nc)
+	    }
+	    return
+	}
+
+	# If the sum limits are outside the last sum limits then form
+	# the sums from scratch.
+
+	if ((line1 > l2) || (line2 < l1) || (col1 != c1) || (col2 != c2)) {
+	    c1 = col1
+	    c2 = col2
+	    l1 = line1
+	    l2 = line2
+	    call aclrr (Memr[data], nc)
+	    do i = l1, l2 {
+		j = data + (mod (i, nl) + 1) * nc
+		call amovr (Memr[imgs2r (im, c1, c2, i, i)], Memr[j], nc)
+		call aaddr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+
+	# If the sum limits overlap then add and subtract to compute the
+	# new sums from the previous sums.  This minimizes the number of
+	# arithmetic operations in common applications.
+
+	} else if (line1 > l1) {
+	    do i = l1, line1 - 1 {
+		j = data + (mod (i, nl) + 1) * nc
+		call asubr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+	    do i = l2 + 1, line2 {
+		j = data + (mod (i, nl) + 1) * nc
+		call amovr (Memr[imgs2r (im, c1, c2, i, i)], Memr[j], nc)
+		call aaddr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+	    l1 = line1
+	    l2 = line2
+
+	} else {
+	    do i = line2 + 1, l2 {
+		j = data + (mod (i, nl) + 1) * nc
+		call asubr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+	    do i = line1, l1 - 1 {
+		j = data + (mod (i, nl) + 1) * nc
+		call amovr (Memr[imgs2r (im, c1, c2, i, i)], Memr[j], nc)
+		call aaddr (Memr[data], Memr[j], Memr[data], nc)
+	    }
+	    l1 = line1
+	    l2 = line2
+	}
+end
+
+
+# XT_CSUMB -- Sum columns with buffering
+#
+# A new sum vector is created when the data pointer is null or if the number
+# of lines is changed.  If the previous sum overlaps the requested sum then
+# additions and subtractions are performed on the previous sum to minimize
+# the number of arithmetic operations.  Buffering is done on the previous cols.
+
+procedure xt_csumb (co, col1, col2, line1, line2, data)
+
+pointer	co		# COIO pointer
+int	col1, col2	# Column limits of the sum
+int	line1, line2	# Line limits
+pointer	data		# Data pointer
+
+int	i
+int	ncols, nlines, nc, nl, c1, c2, l1, l2
+pointer	j
+
+pointer	cogetr()
+
+begin
+	ncols = col2 - col1 + 1
+	nlines = line2 - line1 + 1
+
+	if ((data == NULL) || (nlines != nl)) {
+	    call mfree (data, TY_REAL)
+	    call malloc (data, (ncols + 1) * nlines, TY_REAL)
+	    nl = nlines
+	    c1 = 0
+	    c2 = 0
+	}
+
+	if (ncols != nc) {
+	    nc = ncols
+	    c1 = 0
+	    c2 = 0
+	}
+
+	# If only one column then don't bother with summing.
+
+	if (ncols == 1) {
+	    if ((col1 != c1) || (line1 != l1) || (line2 != l2)) {
+	        c1 = col1
+	        c2 = col2
+	        l1 = line1
+	        l2 = line2
+		j = cogetr (co, c1, l1, l2)
+	        call amovr (Memr[j], Memr[data], nl)
+	    }
+	    return
+	}
+
+	# If the sum limits are outside the last sum limits then form
+	# the sums from scratch.
+
+	if ((col1 > c2) || (col2 < c1) || (line1 != l1) || (line2 != l2)) {
+	    c1 = col1
+	    c2 = col2
+	    l1 = line1
+	    l2 = line2
+	    call aclrr (Memr[data], nlines)
+	    do i = c1, c2 {
+		j = data + (mod (i, nc) + 1) * nl
+		call amovr (Memr[cogetr (co, i, l1, l2)], Memr[j], nl)
+		call aaddr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+
+	# If the sum limits overlap then add and subtract to compute the
+	# new sums from the previous sums.  This minimizes the number of
+	# arithmetic operations in common applications.
+
+	} else if (col1 > c1) {
+	    do i = c1, col1 - 1 {
+		j = data + (mod (i, nc) + 1) * nl
+		call asubr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+	    do i = c2 + 1, col2 {
+		j = data + (mod (i, nc) + 1) * nl
+		call amovr (Memr[cogetr (co, i, l1, l2)], Memr[j], nl)
+		call aaddr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+	    c1 = col1
+	    c2 = col2
+
+	} else {
+	    do i = col2 + 1, c2 {
+		j = data + (mod (i, nc) + 1) * nl
+		call asubr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+	    do i = col1, c1 - 1 {
+		j = data + (mod (i, nc) + 1) * nl
+		call amovr (Memr[cogetr (co, i, l1, l2)], Memr[j], nl)
+		call aaddr (Memr[data], Memr[j], Memr[data], nl)
+	    }
+	    c1 = col1
+	    c2 = col2
+	}
+end
diff --git a/pkg/xtools/xttxtfio.x b/pkg/xtools/xttxtfio.x
new file mode 100644
index 00000000..88296670
--- /dev/null
+++ b/pkg/xtools/xttxtfio.x
@@ -0,0 +1,71 @@
+define	TXT_MAXFD	64		# Maximum FD for stropen.
+
+
+# XT_TXTOPEN -- Open a READ_ONLY text file which is possibly compiled into a
+# procedure.
+# 
+# This is used to allow text files to be incorported in binaries but still use
+# FIO.  The text file must be compiled into a program which is linked with
+# into the binary (see txtcompile).  A file name of the form proc:nnnn, where
+# nnnn is a number returned by locpr, calls the procedure which is expected to
+# allocate a string buffer.  In this case the string buffer is opened with
+# stropen.  Any other file name is opened as a READ_ONLY TEXT_FILE with
+# normal FIO.
+
+int procedure xt_txtopen (fname)
+
+char	fname[ARB]		#I File name or proc:nnnn reference
+int	fd			#R Null to open and non-null to close
+
+int	ip, procptr, strncmp(), ctoi(), open(), stropen()
+pointer	strbuf
+errchk	zcall1, open, stropen
+
+int	firsttime
+data	firsttime/YES/
+
+pointer	buf[TXT_MAXFD]
+common	/xttxtn_com/ buf
+
+begin
+	# Make sure array of string buffer pointers is initialized.
+	if (firsttime==YES) {
+	    call aclri (buf, TXT_MAXFD)
+	    firsttime = NO
+	}
+
+	# Determine type of open to use.
+	if (strncmp (fname, "proc:", 5) == 0) {
+	    ip = 1
+	    if (ctoi (fname[6], ip, procptr) == 0)
+		call error (1, "xt_txtopen: bad file specification")
+	    call zcall1 (procptr, strbuf)
+	    fd = stropen (Memc[strbuf], ARB, READ_ONLY)
+	    if (fd > TXT_MAXFD) {
+	        call close (fd)
+		call mfree (strbuf, TY_CHAR)
+		call error (1, "xt_txtopen: Too many file descriptors")
+	    }
+	    buf[fd] = strbuf
+	} else
+	    fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	return (fd)
+end
+
+
+# XT_TXTCLOSE -- Close procedure.
+
+procedure xt_txtclose (fd)
+
+int	fd			#O Null to open and non-null to close
+
+pointer	buf[TXT_MAXFD]
+common	/xttxtn_com/ buf
+
+begin
+	# Close file descriptor.
+	call close (fd); fd = NULL
+	if (fd <= TXT_MAXFD)
+	    call mfree (buf[fd], TY_CHAR)
+end
diff --git a/pkg/xtools/zzdebug.x b/pkg/xtools/zzdebug.x
new file mode 100644
index 00000000..b8ba551e
--- /dev/null
+++ b/pkg/xtools/zzdebug.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	ranges = t_ranges
+
+define	MAX_RANGES	101	# Maximum number of range parameters
+
+
+# T_RANGES -- Test the range expression expansion package.
+
+procedure t_ranges ()
+
+char	range_string[SZ_LINE]		# Range string
+int	number				# Test integer number
+
+int	ranges[3, MAX_RANGES]
+int	nvalues, next_number
+int	decode_ranges(), get_next_number(), get_previous_number()
+bool	is_in_range()
+int	clglpi()
+
+begin
+	# Get program parameters
+	call clgstr ("range_string", range_string, SZ_LINE)
+
+	# Decode the range string
+	if (decode_ranges (range_string, ranges, MAX_RANGES, nvalues) == ERR)
+	    call error (1, "Error parsing range string")
+	call printf ("Number of values = %d\n")
+	    call pargi (nvalues)
+
+	# Test is_in_range
+	while (clglpi ("number", number) != EOF) {
+	    if (is_in_range (ranges, number)) {
+		call printf ("%d is in range\n")
+		    call pargi (number)
+	    } else {
+		call printf ("%d is not in range\n")
+		    call pargi (number)
+	    }
+	    next_number = number
+	    if (get_next_number (ranges, next_number) != EOF) {
+		call printf ("Next number is %d\n")
+		    call pargi (next_number)
+	    }
+	    next_number = number
+	    if (get_previous_number (ranges, next_number) != EOF) {
+		call printf ("Previous number is %d\n")
+		    call pargi (next_number)
+	    }
+	}
+end