Initial commit

30 files changed, 18320 insertions, 0 deletions

diff --git a/pkg/images/lib/coomap.key b/pkg/images/lib/coomap.key
new file mode 100644
index 00000000..2a44520a
--- /dev/null
+++ b/pkg/images/lib/coomap.key
@@ -0,0 +1,33 @@
+	Interactive Keystroke Commands
+
+?	Print options
+f	Fit data and graph fit with the current graph type (g,x,r,y,s)
+g	Graph the data and the current fit
+x,r	Graph the xi fit residuals versus x and y respectively
+y,s	Graph the eta fit residuals versus x and y respectively
+d,u	Delete or undelete the data point nearest the cursor
+o	Overplot the next graph
+c	Toggle the line of constant x and y plotting option
+t       Plot a line of constant x and y through nearest data point	
+l	Print xishift, etashift, xscale, yscale, xrotate, yrotate
+q	Exit the interactive surface fitting code
+
+	Interactive 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	 	     List parameters
+:projection          Sky projection (lin,tan,arc,sin,tnx, ...)
+:refpoint	     Sky projection reference point
+:fit 	  [value]    Fit geometry (shift,xyscale,rotate,rscale,rxyscale,general)
+:function [value]    Fitting function (chebyshev,legendre,polynomial)
+:order	  [value]    Xi and Eta fitting orders in x and y
+:xxorder  [value]    Xi fitting function order in x
+:xyorder  [value]    Xi fitting function order in y
+:yxorder  [value]    Eta fitting function order in x
+:yyorder  [value]    Eta fitting function order in y
+:xxterms  [y/n]      Include cross-terms in xi fit
+:yxterms  [y/n]	     Include cross-terms in eta fit
+:maxiter  [value]    Maximum number of rejection operations
+:reject   [value]    K-sigma rejection threshold
diff --git a/pkg/images/lib/geofit.gx b/pkg/images/lib/geofit.gx
new file mode 100644
index 00000000..7aae63a9
--- /dev/null
+++ b/pkg/images/lib/geofit.gx
@@ -0,0 +1,1605 @@
+# Copyright(c) 1986 Assocation of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <math.h>
+include <math/gsurfit.h>
+include "geomap.h"
+
+$for (r)
+
+# GEO_MINIT -- Initialize the fitting routines.
+
+procedure geo_minit (fit, projection, geometry, function, xxorder, xyorder,
+	xxterms, yxorder, yyorder, yxterms, maxiter, reject)
+
+pointer	fit		#I pointer to the fit structure
+int	projection	#I the coordinate projection type
+int	geometry	#I the fitting geometry
+int	function	#I fitting function
+int	xxorder		#I order of x fit in x
+int	xyorder		#I order of x fit in y
+int	xxterms		#I include cross terms in x fit
+int	yxorder		#I order of y fit in x
+int	yyorder		#I order of y fit in y
+int	yxterms		#I include cross-terms in y fit
+int	maxiter		#I the maximum number of rejection interations
+double	reject		#I rejection threshold in sigma
+
+begin
+	# Allocate the space.
+	call malloc (fit, LEN_GEOMAP, TY_STRUCT)
+
+	# Set function and order.
+	GM_PROJECTION(fit) = projection
+	GM_PROJSTR(fit) = EOS
+	GM_FIT(fit) = geometry
+	GM_FUNCTION(fit) = function
+	GM_XXORDER(fit) = xxorder
+	GM_XYORDER(fit) = xyorder
+	GM_XXTERMS(fit) = xxterms
+	GM_YXORDER(fit) = yxorder
+	GM_YYORDER(fit) = yyorder
+	GM_YXTERMS(fit) = yxterms
+
+	# Set rejection parameters.
+	GM_XRMS(fit) = 0.0d0
+	GM_YRMS(fit) = 0.0d0
+	GM_MAXITER(fit) = maxiter
+	GM_REJECT(fit) = reject
+	GM_NREJECT(fit) = 0
+	GM_REJ(fit) = NULL
+
+	# Set origin parameters.
+	GM_XO(fit) = INDEFD
+	GM_YO(fit) = INDEFD
+	GM_XOREF(fit) = INDEFD
+	GM_YOREF(fit) = INDEFD
+end
+
+
+# GEO_FREE -- Release the fitting space.
+
+procedure geo_free (fit)
+
+pointer	fit		#I pointer to the fitting structure
+
+begin
+	if (GM_REJ(fit) != NULL)
+	    call mfree (GM_REJ(fit), TY_INT)
+	call mfree (fit, TY_STRUCT)
+end
+
+$endfor
+
+
+$for (rd)
+
+# GEO_FIT -- Fit the surface in batch.
+
+procedure geo_fit$t (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts, npts,
+	xerrmsg, yerrmsg, maxch)
+
+pointer	fit		#I pointer to fitting structure
+pointer	sx1, sy1	#U pointer to linear surface
+pointer	sx2, sy2	#U pointer to higher order correction
+PIXEL	xref[ARB]	#I x reference array
+PIXEL	yref[ARB]	#I y reference array
+PIXEL	xin[ARB]	#I x array
+PIXEL	yin[ARB]	#I y array
+PIXEL	wts[ARB]	#I weight array
+int	npts		#I the number of data points
+char	xerrmsg[ARB]	#O the x fit error message
+char	yerrmsg[ARB]	#O the y fit error message
+int	maxch		#I maximum size of the error message
+
+pointer	sp, xresidual, yresidual
+errchk	geo_fxy$t(), geo_mreject$t(), geo_ftheta$t(), geo_fmagnify$t()
+errchk	geo_flinear$t()
+
+begin
+	call smark (sp)
+	call salloc (xresidual, npts, TY_PIXEL)
+	call salloc (yresidual, npts, TY_PIXEL)
+
+	switch (GM_FIT(fit)) {
+	case GM_ROTATE:
+	    call geo_ftheta$t (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Mem$t[xresidual], Mem$t[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RSCALE:
+	    call geo_fmagnify$t (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Mem$t[xresidual], Mem$t[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RXYSCALE:
+	    call geo_flinear$t (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Mem$t[xresidual], Mem$t[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	default:
+	    GM_ZO(fit) = GM_XOREF(fit)
+	    call geo_fxy$t (fit, sx1, sx2, xref, yref, xin, wts,
+	        Mem$t[xresidual], npts, YES, xerrmsg, maxch)
+	    GM_ZO(fit) = GM_YOREF(fit)
+	    call geo_fxy$t (fit, sy1, sy2, xref, yref, yin, wts,
+	        Mem$t[yresidual], npts, NO, yerrmsg, maxch)
+	}
+	if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	    GM_NREJECT(fit) = 0
+	else
+	    call geo_mreject$t (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin,
+		wts, Mem$t[xresidual], Mem$t[yresidual], npts, xerrmsg,
+		maxch, yerrmsg, maxch)
+
+	call sfree (sp)
+end
+
+
+# GEO_FTHETA -- Compute the shift and rotation angle required to match one
+# set of coordinates to another.
+
+procedure geo_ftheta$t (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+PIXEL	xref[npts]	#I reference image x values
+PIXEL	yref[npts]	#I reference image y values
+PIXEL	xin[npts]	#I input image x values
+PIXEL	yin[npts]	#I input image y values
+PIXEL	wts[npts]	#I array of weights
+PIXEL	xresid[npts]	#O x fit residuals
+PIXEL	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, num, denom, theta, det 
+double	ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+PIXEL	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_PIXEL)
+
+	# Initialize the fit.
+$if (datatype == r)
+        if (sx1 != NULL)
+            call gsfree (sx1)
+        if (sy1 != NULL)
+            call gsfree (sy1)
+$else
+        if (sx1 != NULL)
+            call dgsfree (sx1)
+        if (sy1 != NULL)
+            call dgsfree (sy1)
+$endif
+
+        # Determine the minimum and maximum values
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+
+	} else {
+
+	    # Compute the sums required to compute the rotation angle.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    if (det < 0.0d0) {
+	        cthetax = -ctheta
+	        sthetay = -stheta
+	    } else {
+	        cthetax = ctheta
+	        sthetay = stheta
+	    }
+	    sthetax = stheta
+	    cthetay = ctheta
+
+	    # Compute the x fit coefficients.
+$if (datatype == r)
+	    call gsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sx1, Memr[savefit])
+	    call gsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymax + ymin) / 2
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sx1, Memr[savefit])
+$else
+	    call dgsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sx1, Memd[savefit])
+	    call dgsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sx1, Memd[savefit])
+$endif
+
+	    # Compute the y fit coefficients.
+$if (datatype == r)
+	    call gsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sy1, Memr[savefit])
+	    call gsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymax + ymin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sy1, Memr[savefit])
+$else
+	    call dgsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sy1, Memd[savefit])
+	    call dgsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sy1, Memd[savefit])
+$endif
+
+	    # Compute the residuals
+$if (datatype == r)
+	    call gsvector (sx1, xref, yref, xresid, npts)
+	    call gsvector (sy1, xref, yref, yresid, npts)
+$else
+	    call dgsvector (sx1, xref, yref, xresid, npts)
+	    call dgsvector (sy1, xref, yref, yresid, npts)
+$endif
+	    call asub$t (xin, xresid, xresid, npts) 
+	    call asub$t (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= PIXEL(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FMAGNIFY -- Compute the shift, the rotation angle, and the magnification
+# factor which is assumed to be the same in x and y, required to match one
+# set of coordinates to another.
+
+procedure geo_fmagnify$t (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+PIXEL	xref[npts]	#I reference image x values
+PIXEL	yref[npts]	#I reference image y values
+PIXEL	xin[npts]	#I input image x values
+PIXEL	yin[npts]	#I input image y values
+PIXEL	wts[npts]	#I array of weights
+PIXEL	xresid[npts]	#O x fit residuals
+PIXEL	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, det, theta
+double	mag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+PIXEL	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_PIXEL)
+
+	# Initialize the fit.
+$if (datatype == r)
+        if (sx1 != NULL)
+            call gsfree (sx1)
+        if (sy1 != NULL)
+            call gsfree (sy1)
+$else
+        if (sx1 != NULL)
+            call dgsfree (sx1)
+        if (sy1 != NULL)
+            call dgsfree (sy1)
+$endif
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+
+	    # Compute the sums.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the magnification factor.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    num = denom * ctheta + num * stheta
+	    denom = sxrxr + syryr
+	    if (denom <= 0.0d0) {
+		mag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		mag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    if (det < 0.0d0) {
+	        cthetax = -mag * ctheta
+	        sthetay = -mag * stheta
+	    } else {
+	        cthetax = mag * ctheta
+	        sthetay = mag * stheta
+	    }
+	    sthetax = mag * stheta
+	    cthetay = mag * ctheta
+
+	    # Compute the x fit coefficients.
+$if (datatype == r)
+	    call gsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sx1, Memr[savefit])
+	    call gsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymax + ymin) / 2
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sx1, Memr[savefit])
+$else
+	    call dgsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sx1, Memd[savefit])
+	    call dgsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sx1, Memd[savefit])
+$endif
+
+	    # Compute the y fit coefficients.
+$if (datatype == r)
+	    call gsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sy1, Memr[savefit])
+	    call gsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymax + ymin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sy1, Memr[savefit])
+$else
+	    call dgsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sy1, Memd[savefit])
+	    call dgsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sy1, Memd[savefit])
+$endif
+
+	    # Compute the residuals
+$if (datatype == r)
+	    call gsvector (sx1, xref, yref, xresid, npts)
+	    call gsvector (sy1, xref, yref, yresid, npts)
+$else
+	    call dgsvector (sx1, xref, yref, xresid, npts)
+	    call dgsvector (sy1, xref, yref, yresid, npts)
+$endif
+	    call asub$t (xin, xresid, xresid, npts) 
+	    call asub$t (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= PIXEL(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FLINEAR -- Compute the shift, the rotation angle, and the x and y scale
+# factors required to match one set of coordinates to another.
+
+procedure geo_flinear$t (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+PIXEL	xref[npts]	#I reference image x values
+PIXEL	yref[npts]	#I reference image y values
+PIXEL	xin[npts]	#I input image x values
+PIXEL	yin[npts]	#I input image y values
+PIXEL	wts[npts]	#I array of weights
+PIXEL	xresid[npts]	#O x fit residuals
+PIXEL	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, theta
+double	xmag, ymag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+PIXEL	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_PIXEL)
+
+	# Initialize the fit.
+$if (datatype == r)
+        if (sx1 != NULL)
+            call gsfree (sx1)
+        if (sy1 != NULL)
+            call gsfree (sy1)
+$else
+        if (sx1 != NULL)
+            call dgsfree (sx1)
+        if (sy1 != NULL)
+            call dgsfree (sy1)
+$endif
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 3) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = 2.0d0 * (sxrxr * syrxi * syryi - syryr * sxrxi * sxryi)
+	    denom = syryr * (sxrxi - sxryi) * (sxrxi + sxryi) - sxrxr *
+	        (syrxi + syryi) * (syrxi - syryi) 
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom) / 2.0d0
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+
+	    # Compute the x magnification factor.
+	    num = sxrxi * ctheta - sxryi * stheta
+	    denom = sxrxr
+	    if (denom <= 0.0d0) {
+		xmag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		xmag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the y magnification factor.
+	    num = syrxi * stheta + syryi * ctheta
+	    denom = syryr
+	    if (denom <= 0.0d0) {
+		ymag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		ymag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    cthetax = xmag * ctheta
+	    sthetax = ymag * stheta
+	    sthetay = xmag * stheta
+	    cthetay = ymag * ctheta
+
+	    # Compute the x fit coefficients.
+$if (datatype == r)
+	    call gsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sx1, Memr[savefit])
+	    call gsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymax + ymin) / 2
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sx1, Memr[savefit])
+$else
+	    call dgsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sx1, Memd[savefit])
+	    call dgsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sx1, Memd[savefit])
+$endif
+
+	    # Compute the y fit coefficients.
+$if (datatype == r)
+	    call gsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sy1, Memr[savefit])
+	    call gsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymax + ymin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sy1, Memr[savefit])
+$else
+	    call dgsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sy1, Memd[savefit])
+	    call dgsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sy1, Memd[savefit])
+$endif
+
+	    # Compute the residuals
+$if (datatype == r)
+	    call gsvector (sx1, xref, yref, xresid, npts)
+	    call gsvector (sy1, xref, yref, yresid, npts)
+$else
+	    call dgsvector (sx1, xref, yref, xresid, npts)
+	    call dgsvector (sy1, xref, yref, yresid, npts)
+$endif
+	    call asub$t (xin, xresid, xresid, npts) 
+	    call asub$t (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= PIXEL(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FXY -- Fit the surface.
+
+procedure geo_fxy$t (fit, sf1, sf2, x, y, z, wts, resid, npts, xfit, errmsg,
+	maxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sf1		#U pointer to linear surface
+pointer	sf2		#U pointer to higher order surface
+PIXEL	x[npts]		#I reference image x values
+PIXEL	y[npts]		#I reference image y values
+PIXEL	z[npts]	        #I z values 
+PIXEL	wts[npts]	#I array of weights
+PIXEL	resid[npts]	#O fitted residuals
+int	npts		#I number of points
+int	xfit		#I X fit ?
+char	errmsg[ARB]	#O returned error message
+int	maxch		#I maximum number of characters in error message
+
+int	i, ier, ncoeff
+pointer	sp, zfit, savefit, coeff
+PIXEL	xmin, xmax, ymin, ymax
+bool	fp_equald()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (zfit, npts, TY_PIXEL)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_PIXEL)
+	call salloc (coeff, 3, TY_PIXEL)
+
+	# Determine the minimum and maximum values
+	if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+	    xmin = GM_XMIN(fit) - 0.5d0
+	    xmax = GM_XMAX(fit) + 0.5d0
+	} else {
+	    xmin = GM_XMIN(fit)
+	    xmax = GM_XMAX(fit)
+	}
+	if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+	    ymin = GM_YMIN(fit) - 0.5d0
+	    ymax = GM_YMAX(fit) + 0.5d0
+	} else {
+	    ymin = GM_YMIN(fit)
+	    ymax = GM_YMAX(fit)
+	}
+
+	# Initalize fit
+$if (datatype == r)
+	if (sf1 != NULL)
+	    call gsfree (sf1)
+	if (sf2 != NULL)
+	    call gsfree (sf2)
+
+	if (xfit == YES) {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call gssave (sf1, Memr[savefit])
+		call gsfree (sf1)
+	        call gsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubr (z, x, Memr[zfit], npts)
+	        call gsfit (sf1, x, y, Memr[zfit], wts, npts, WTS_USER, ier)
+		call gscoeff (sf1, Memr[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff]
+		    Memr[savefit+GS_SAVECOEFF+1] = 1.0
+		    Memr[savefit+GS_SAVECOEFF+2] = 0.0
+		} else {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff] + (xmax + xmin) /
+		        2.0
+		    Memr[savefit+GS_SAVECOEFF+1] = (xmax - xmin) / 2.0
+		    Memr[savefit+GS_SAVECOEFF+2] = 0.0
+		}
+		call gsfree (sf1)
+		call gsrestore (sf1, Memr[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        sf2 = NULL
+
+	    default:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		if (IS_INDEFD(GM_XO(fit)))
+		    call gsset (sf1, GSXREF, INDEFR)
+		else
+		    call gsset (sf1, GSXREF, real (GM_XO(fit)))
+		if (IS_INDEFD(GM_YO(fit)))
+		    call gsset (sf1, GSYREF, INDEFR)
+		else
+		    call gsset (sf1, GSYREF, real (GM_YO(fit)))
+		if (IS_INDEFD(GM_ZO(fit)))
+		    call gsset (sf1, GSZREF, INDEFR)
+		else
+		    call gsset (sf1, GSZREF, real (GM_ZO(fit)))
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_XXORDER(fit) > 2 || GM_XYORDER(fit) > 2 ||
+		    GM_XXTERMS(fit) == GS_XFULL)
+	            call gsinit (sf2, GM_FUNCTION(fit), GM_XXORDER(fit),
+		        GM_XYORDER(fit), GM_XXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+	    }
+
+	} else {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call gssave (sf1, Memr[savefit])
+		call gsfree (sf1)
+	        call gsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubr (z, y, Memr[zfit], npts)
+	        call gsfit (sf1, x, y, Memr[zfit], wts, npts, WTS_USER, ier)
+		call gscoeff (sf1, Memr[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff]
+		    Memr[savefit+GS_SAVECOEFF+1] = 0.0
+		    Memr[savefit+GS_SAVECOEFF+2] = 1.0
+		} else {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff] + (ymin + ymax) /
+			2.0
+		    Memr[savefit+GS_SAVECOEFF+1] = 0.0
+		    Memr[savefit+GS_SAVECOEFF+2] = (ymax - ymin) / 2.0
+		}
+		call gsfree (sf1)
+		call gsrestore (sf1, Memr[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call gsinit (sf1, GM_FUNCTION(fit), 1, 2, GS_XNONE, xmin,
+	            xmax, ymin, ymax)
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        sf2 = NULL
+
+	    default:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin,
+	            xmax, ymin, ymax)
+		if (IS_INDEFD(GM_XO(fit)))
+		    call gsset (sf1, GSXREF, INDEFR)
+		else
+		    call gsset (sf1, GSXREF, real (GM_XO(fit)))
+		if (IS_INDEFD(GM_YO(fit)))
+		    call gsset (sf1, GSYREF, INDEFR)
+		else
+		    call gsset (sf1, GSYREF, real (GM_YO(fit)))
+		if (IS_INDEFD(GM_ZO(fit)))
+		    call gsset (sf1, GSZREF, INDEFR)
+		else
+		    call gsset (sf1, GSZREF, real (GM_ZO(fit)))
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_YXORDER(fit) > 2 || GM_YYORDER(fit) > 2 ||
+	            GM_YXTERMS(fit) == GS_XFULL)
+	            call gsinit (sf2, GM_FUNCTION(fit), GM_YXORDER(fit),
+	                GM_YYORDER(fit), GM_YXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+
+	    }
+
+	}
+
+$else
+	if (sf1 != NULL)
+	    call dgsfree (sf1)
+	if (sf2 != NULL)
+	    call dgsfree (sf2)
+
+	if (xfit == YES) {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgssave (sf1, Memd[savefit])
+		call dgsfree (sf1)
+	        call dgsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubd (z, x, Memd[zfit], npts)
+	        call dgsfit (sf1, x, y, Memd[zfit], wts, npts, WTS_USER, ier)
+		call dgscoeff (sf1, Memd[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff]
+		    Memd[savefit+GS_SAVECOEFF+1] = 1.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = 0.0d0
+		} else {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff] + (xmax + xmin) /
+			2.0d0
+		    Memd[savefit+GS_SAVECOEFF+1] = (xmax - xmin) / 2.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = 0.0d0
+		}
+		call dgsfree (sf1)
+		call dgsrestore (sf1, Memd[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+		sf2 = NULL
+
+	    default:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgsset (sf1, GSXREF, GM_XO(fit))
+		call dgsset (sf1, GSYREF, GM_YO(fit))
+		call dgsset (sf1, GSZREF, GM_ZO(fit))
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_XXORDER(fit) > 2 || GM_XYORDER(fit) > 2 ||
+		    GM_XXTERMS(fit) == GS_XFULL)
+	            call dgsinit (sf2, GM_FUNCTION(fit), GM_XXORDER(fit),
+		        GM_XYORDER(fit), GM_XXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+	    }
+
+	} else {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgssave (sf1, Memd[savefit])
+		call dgsfree (sf1)
+	        call dgsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubd (z, y, Memd[zfit], npts)
+	        call dgsfit (sf1, x, y, Memd[zfit], wts, npts, WTS_USER, ier)
+		call dgscoeff (sf1, Memd[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff]
+		    Memd[savefit+GS_SAVECOEFF+1] = 0.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = 1.0d0
+		} else {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff] + (ymin + ymax) /
+			2.0d0
+		    Memd[savefit+GS_SAVECOEFF+1] = 0.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = (ymax - ymin) / 2.0d0
+		}
+		call dgsfree (sf1)
+		call dgsrestore (sf1, Memd[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 1, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+		sf2 = NULL
+
+	    default:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgsset (sf1, GSXREF, GM_XO(fit))
+		call dgsset (sf1, GSYREF, GM_YO(fit))
+		call dgsset (sf1, GSZREF, GM_ZO(fit))
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_YXORDER(fit) > 2 || GM_YYORDER(fit) > 2 ||
+	            GM_YXTERMS(fit) == GS_XFULL)
+	            call dgsinit (sf2, GM_FUNCTION(fit), GM_YXORDER(fit),
+	                GM_YYORDER(fit), GM_YXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+	    }
+	}
+
+$endif
+
+	if (ier == NO_DEG_FREEDOM) {
+	    call sfree (sp)
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for X fit.")
+	            call error (1, "Too few data points for X fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for XI fit.")
+	            call error (1, "Too few data points for XI fit.")
+		}
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for Y fit.")
+	            call error (1, "Too few data points for Y fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for ETA fit.")
+	            call error (1, "Too few data points for ETA fit.")
+		}
+	    }
+	} else if (ier == SINGULAR) {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+	            call sprintf (errmsg, maxch, "Warning singular X fit.")
+		else
+	            call sprintf (errmsg, maxch, "Warning singular XI fit.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		else
+		    call sprintf (errmsg, maxch, "Warning singular ETA fit.")
+	    }
+	} else {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "X fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "XI fit ok.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Y fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "ETA fit ok.")
+	    }
+	}
+
+$if (datatype == r)
+	call gsvector (sf1, x, y, resid, npts)
+$else
+	call dgsvector (sf1, x, y, resid, npts)
+$endif
+	call asub$t (z, resid, resid, npts)
+
+	# Calculate higher order fit.
+	if (sf2 != NULL) {
+$if (datatype == r)
+	    call gsfit (sf2, x, y, resid, wts, npts, WTS_USER, ier)
+$else
+	    call dgsfit (sf2, x, y, resid, wts, npts, WTS_USER, ier)
+$endif
+	    if (ier == NO_DEG_FREEDOM) {
+		call sfree (sp)
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for X fit.")
+		       call error (1, "Too few data points for X fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for XI fit.")
+		       call error (1, "Too few data points for XI fit.")
+		    }
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for Y fit.")
+			call error (1, "Too few data points for Y fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for ETA fit.")
+			call error (1, "Too few data points for ETA fit.")
+		    }
+		}
+	    } else if (ier == SINGULAR) {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular X fit.")
+		    else
+		        call sprintf (errmsg, maxch, "Warning singular XI fit.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		    else
+		        call sprintf (errmsg, maxch,
+			    "Warning singular ETA fit.")
+		}
+	    } else {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "X fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "XI fit ok.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Y fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "ETA fit ok.")
+		}
+	    }
+$if (datatype == r)
+	    call gsvector (sf2, x, y, Mem$t[zfit], npts)
+$else
+	    call dgsvector (sf2, x, y, Mem$t[zfit], npts)
+$endif
+	    call asub$t (resid, Mem$t[zfit], resid, npts)
+	}
+
+	# Compute the number of zero weighted points.
+	GM_NWTS0(fit) = 0
+	do i = 1, npts {
+	    if (wts[i] <= PIXEL(0.0))
+	        GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	}
+
+	# calculate the rms of the fit
+	if (xfit == YES) {
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * resid[i] ** 2
+	} else {
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+		GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * resid[i] ** 2
+	}
+
+	GM_NPTS(fit) = npts
+
+	call sfree (sp)
+end
+
+
+# GEO_MREJECT -- Reject points from the fit.
+
+procedure geo_mreject$t (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts,
+        xresid, yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch) 
+
+pointer	fit		#I pointer to the fit structure
+pointer	sx1, sy1	#I pointers to the linear surface
+pointer sx2, sy2	#I pointers to the higher order surface
+PIXEL	xref[npts]	#I reference image x values
+PIXEL	yref[npts]	#I yreference values
+PIXEL	xin[npts]	#I x values
+PIXEL	yin[npts]	#I yvalues
+PIXEL	wts[npts]	#I weights
+PIXEL	xresid[npts]	#I residuals
+PIXEL	yresid[npts]	#I yresiduals
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x error message
+int	xmaxch		#I maximum number of characters in the x error message
+char	yerrmsg[ARB]	#O the output y error message
+int	ymaxch		#I maximum number of characters in the y error message
+
+int	i
+int	nreject, niter
+pointer	sp, twts
+PIXEL	cutx, cuty
+errchk	geo_fxy$t(), geo_ftheta$t(), geo_fmagnify$t(), geo_flinear$t()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (twts, npts, TY_PIXEL)
+
+	# Allocate space for the residuals.
+	if (GM_REJ(fit) != NULL)
+	    call mfree (GM_REJ(fit), TY_INT)
+	call malloc (GM_REJ(fit), npts, TY_INT)
+	GM_NREJECT(fit) = 0
+
+	# Initialize the temporary weights array and the number of rejected
+	# points.
+	call amov$t (wts, Mem$t[twts], npts)
+	nreject = 0
+
+	niter = 0
+	repeat {
+
+	    # Compute the rejection limits.
+	    if ((npts - GM_NWTS0(fit)) > 1) {
+	        cutx = GM_REJECT(fit) * sqrt (GM_XRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	        cuty = GM_REJECT(fit) * sqrt (GM_YRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	    } else {
+	        cutx = MAX_REAL
+	        cuty = MAX_REAL
+	    }
+
+	    # Reject points from the fit.
+	    do i = 1, npts {
+	        if (Mem$t[twts+i-1] > 0.0 && ((abs (xresid[i]) > cutx) ||
+		    (abs (yresid[i]) > cuty))) {
+		    Mem$t[twts+i-1] = PIXEL(0.0)
+		    nreject = nreject + 1
+		    Memi[GM_REJ(fit)+nreject-1] = i
+	        }
+	    }
+	    if ((nreject - GM_NREJECT(fit)) <= 0)
+		break
+	    GM_NREJECT(fit) = nreject
+
+	    # Compute number of deleted points.
+	    GM_NWTS0(fit) = 0
+	    do i = 1, npts {
+		if (wts[i] <= 0.0)
+		    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	    }
+
+	    # Recompute the X and Y fit.
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_ftheta$t (fit, sx1, sy1, xref, yref, xin, yin,
+		    Mem$t[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnify$t (fit, sx1, sy1, xref, yref, xin, yin,
+		    Mem$t[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flinear$t (fit, sx1, sy1, xref, yref, xin, yin,
+		    Mem$t[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+		GM_ZO(fit) = GM_XOREF(fit)
+	        call geo_fxy$t (fit, sx1, sx2, xref, yref, xin, Mem$t[twts],
+	            xresid, npts, YES, xerrmsg, xmaxch)
+		GM_ZO(fit) = GM_YOREF(fit)
+	        call geo_fxy$t (fit, sy1, sy2, xref, yref, yin, Mem$t[twts],
+	            yresid, npts, NO, yerrmsg, ymaxch)
+	    }
+
+	    # Compute the x fit rms.
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + Mem$t[twts+i-1] * xresid[i] ** 2
+
+	    # Compute the y fit rms.
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_YRMS(fit) = GM_YRMS(fit) + Mem$t[twts+i-1] * yresid[i] ** 2
+
+	    niter = niter + 1
+
+	} until (niter >= GM_MAXITER(fit))
+
+	call sfree (sp)
+end
+
+
+# GEO_MMFREE - Free the space used to fit the surfaces.
+
+procedure geo_mmfree$t (sx1, sy1, sx2, sy2)
+
+pointer	sx1		#U pointer to the x fits
+pointer	sy1		#U pointer to the y fit
+pointer	sx2		#U pointer to the higher order x fit
+pointer	sy2		#U pointer to the higher order y fit
+
+begin
+$if (datatype == r)
+	if (sx1 != NULL)
+	    call gsfree (sx1)
+	if (sy1 != NULL)
+	    call gsfree (sy1)
+	if (sx2 != NULL)
+	    call gsfree (sx2)
+	if (sy2 != NULL)
+	    call gsfree (sy2)
+$else
+	if (sx1 != NULL)
+	    call dgsfree (sx1)
+	if (sy1 != NULL)
+	    call dgsfree (sy1)
+	if (sx2 != NULL)
+	    call dgsfree (sx2)
+	if (sy2 != NULL)
+	    call dgsfree (sy2)
+$endif
+end
+
+$endfor
diff --git a/pkg/images/lib/geofit.x b/pkg/images/lib/geofit.x
new file mode 100644
index 00000000..0eb82a48
--- /dev/null
+++ b/pkg/images/lib/geofit.x
@@ -0,0 +1,2539 @@
+# Copyright(c) 1986 Assocation of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <math.h>
+include <math/gsurfit.h>
+include "geomap.h"
+
+
+
+# GEO_MINIT -- Initialize the fitting routines.
+
+procedure geo_minit (fit, projection, geometry, function, xxorder, xyorder,
+	xxterms, yxorder, yyorder, yxterms, maxiter, reject)
+
+pointer	fit		#I pointer to the fit structure
+int	projection	#I the coordinate projection type
+int	geometry	#I the fitting geometry
+int	function	#I fitting function
+int	xxorder		#I order of x fit in x
+int	xyorder		#I order of x fit in y
+int	xxterms		#I include cross terms in x fit
+int	yxorder		#I order of y fit in x
+int	yyorder		#I order of y fit in y
+int	yxterms		#I include cross-terms in y fit
+int	maxiter		#I the maximum number of rejection interations
+double	reject		#I rejection threshold in sigma
+
+begin
+	# Allocate the space.
+	call malloc (fit, LEN_GEOMAP, TY_STRUCT)
+
+	# Set function and order.
+	GM_PROJECTION(fit) = projection
+	GM_PROJSTR(fit) = EOS
+	GM_FIT(fit) = geometry
+	GM_FUNCTION(fit) = function
+	GM_XXORDER(fit) = xxorder
+	GM_XYORDER(fit) = xyorder
+	GM_XXTERMS(fit) = xxterms
+	GM_YXORDER(fit) = yxorder
+	GM_YYORDER(fit) = yyorder
+	GM_YXTERMS(fit) = yxterms
+
+	# Set rejection parameters.
+	GM_XRMS(fit) = 0.0d0
+	GM_YRMS(fit) = 0.0d0
+	GM_MAXITER(fit) = maxiter
+	GM_REJECT(fit) = reject
+	GM_NREJECT(fit) = 0
+	GM_REJ(fit) = NULL
+
+	# Set origin parameters.
+	GM_XO(fit) = INDEFD
+	GM_YO(fit) = INDEFD
+	GM_XOREF(fit) = INDEFD
+	GM_YOREF(fit) = INDEFD
+end
+
+
+# GEO_FREE -- Release the fitting space.
+
+procedure geo_free (fit)
+
+pointer	fit		#I pointer to the fitting structure
+
+begin
+	if (GM_REJ(fit) != NULL)
+	    call mfree (GM_REJ(fit), TY_INT)
+	call mfree (fit, TY_STRUCT)
+end
+
+
+
+
+
+
+# GEO_FIT -- Fit the surface in batch.
+
+procedure geo_fitr (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts, npts,
+	xerrmsg, yerrmsg, maxch)
+
+pointer	fit		#I pointer to fitting structure
+pointer	sx1, sy1	#U pointer to linear surface
+pointer	sx2, sy2	#U pointer to higher order correction
+real	xref[ARB]	#I x reference array
+real	yref[ARB]	#I y reference array
+real	xin[ARB]	#I x array
+real	yin[ARB]	#I y array
+real	wts[ARB]	#I weight array
+int	npts		#I the number of data points
+char	xerrmsg[ARB]	#O the x fit error message
+char	yerrmsg[ARB]	#O the y fit error message
+int	maxch		#I maximum size of the error message
+
+pointer	sp, xresidual, yresidual
+errchk	geo_fxyr(), geo_mrejectr(), geo_fthetar(), geo_fmagnifyr()
+errchk	geo_flinearr()
+
+begin
+	call smark (sp)
+	call salloc (xresidual, npts, TY_REAL)
+	call salloc (yresidual, npts, TY_REAL)
+
+	switch (GM_FIT(fit)) {
+	case GM_ROTATE:
+	    call geo_fthetar (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memr[xresidual], Memr[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RSCALE:
+	    call geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memr[xresidual], Memr[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RXYSCALE:
+	    call geo_flinearr (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memr[xresidual], Memr[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	default:
+	    GM_ZO(fit) = GM_XOREF(fit)
+	    call geo_fxyr (fit, sx1, sx2, xref, yref, xin, wts,
+	        Memr[xresidual], npts, YES, xerrmsg, maxch)
+	    GM_ZO(fit) = GM_YOREF(fit)
+	    call geo_fxyr (fit, sy1, sy2, xref, yref, yin, wts,
+	        Memr[yresidual], npts, NO, yerrmsg, maxch)
+	}
+	if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	    GM_NREJECT(fit) = 0
+	else
+	    call geo_mrejectr (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin,
+		wts, Memr[xresidual], Memr[yresidual], npts, xerrmsg,
+		maxch, yerrmsg, maxch)
+
+	call sfree (sp)
+end
+
+
+# GEO_FTHETA -- Compute the shift and rotation angle required to match one
+# set of coordinates to another.
+
+procedure geo_fthetar (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+real	xref[npts]	#I reference image x values
+real	yref[npts]	#I reference image y values
+real	xin[npts]	#I input image x values
+real	yin[npts]	#I input image y values
+real	wts[npts]	#I array of weights
+real	xresid[npts]	#O x fit residuals
+real	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, num, denom, theta, det 
+double	ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+real	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_REAL)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call gsfree (sx1)
+        if (sy1 != NULL)
+            call gsfree (sy1)
+
+        # Determine the minimum and maximum values
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+
+	} else {
+
+	    # Compute the sums required to compute the rotation angle.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    if (det < 0.0d0) {
+	        cthetax = -ctheta
+	        sthetay = -stheta
+	    } else {
+	        cthetax = ctheta
+	        sthetay = stheta
+	    }
+	    sthetax = stheta
+	    cthetay = ctheta
+
+	    # Compute the x fit coefficients.
+	    call gsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sx1, Memr[savefit])
+	    call gsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymax + ymin) / 2
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sx1, Memr[savefit])
+
+	    # Compute the y fit coefficients.
+	    call gsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sy1, Memr[savefit])
+	    call gsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymax + ymin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sy1, Memr[savefit])
+
+	    # Compute the residuals
+	    call gsvector (sx1, xref, yref, xresid, npts)
+	    call gsvector (sy1, xref, yref, yresid, npts)
+	    call asubr (xin, xresid, xresid, npts) 
+	    call asubr (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= real(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FMAGNIFY -- Compute the shift, the rotation angle, and the magnification
+# factor which is assumed to be the same in x and y, required to match one
+# set of coordinates to another.
+
+procedure geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+real	xref[npts]	#I reference image x values
+real	yref[npts]	#I reference image y values
+real	xin[npts]	#I input image x values
+real	yin[npts]	#I input image y values
+real	wts[npts]	#I array of weights
+real	xresid[npts]	#O x fit residuals
+real	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, det, theta
+double	mag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+real	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_REAL)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call gsfree (sx1)
+        if (sy1 != NULL)
+            call gsfree (sy1)
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+
+	    # Compute the sums.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the magnification factor.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    num = denom * ctheta + num * stheta
+	    denom = sxrxr + syryr
+	    if (denom <= 0.0d0) {
+		mag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		mag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    if (det < 0.0d0) {
+	        cthetax = -mag * ctheta
+	        sthetay = -mag * stheta
+	    } else {
+	        cthetax = mag * ctheta
+	        sthetay = mag * stheta
+	    }
+	    sthetax = mag * stheta
+	    cthetay = mag * ctheta
+
+	    # Compute the x fit coefficients.
+	    call gsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sx1, Memr[savefit])
+	    call gsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymax + ymin) / 2
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sx1, Memr[savefit])
+
+	    # Compute the y fit coefficients.
+	    call gsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sy1, Memr[savefit])
+	    call gsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymax + ymin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sy1, Memr[savefit])
+
+	    # Compute the residuals
+	    call gsvector (sx1, xref, yref, xresid, npts)
+	    call gsvector (sy1, xref, yref, yresid, npts)
+	    call asubr (xin, xresid, xresid, npts) 
+	    call asubr (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= real(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FLINEAR -- Compute the shift, the rotation angle, and the x and y scale
+# factors required to match one set of coordinates to another.
+
+procedure geo_flinearr (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+real	xref[npts]	#I reference image x values
+real	yref[npts]	#I reference image y values
+real	xin[npts]	#I input image x values
+real	yin[npts]	#I input image y values
+real	wts[npts]	#I array of weights
+real	xresid[npts]	#O x fit residuals
+real	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, theta
+double	xmag, ymag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+real	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_REAL)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call gsfree (sx1)
+        if (sy1 != NULL)
+            call gsfree (sy1)
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 3) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = 2.0d0 * (sxrxr * syrxi * syryi - syryr * sxrxi * sxryi)
+	    denom = syryr * (sxrxi - sxryi) * (sxrxi + sxryi) - sxrxr *
+	        (syrxi + syryi) * (syrxi - syryi) 
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom) / 2.0d0
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+
+	    # Compute the x magnification factor.
+	    num = sxrxi * ctheta - sxryi * stheta
+	    denom = sxrxr
+	    if (denom <= 0.0d0) {
+		xmag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		xmag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the y magnification factor.
+	    num = syrxi * stheta + syryi * ctheta
+	    denom = syryr
+	    if (denom <= 0.0d0) {
+		ymag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		ymag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    cthetax = xmag * ctheta
+	    sthetax = ymag * stheta
+	    sthetay = xmag * stheta
+	    cthetay = ymag * ctheta
+
+	    # Compute the x fit coefficients.
+	    call gsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sx1, Memr[savefit])
+	    call gsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymax + ymin) / 2
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sx1, Memr[savefit])
+
+	    # Compute the y fit coefficients.
+	    call gsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sy1, Memr[savefit])
+	    call gsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymax + ymin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sy1, Memr[savefit])
+
+	    # Compute the residuals
+	    call gsvector (sx1, xref, yref, xresid, npts)
+	    call gsvector (sy1, xref, yref, yresid, npts)
+	    call asubr (xin, xresid, xresid, npts) 
+	    call asubr (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= real(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FXY -- Fit the surface.
+
+procedure geo_fxyr (fit, sf1, sf2, x, y, z, wts, resid, npts, xfit, errmsg,
+	maxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sf1		#U pointer to linear surface
+pointer	sf2		#U pointer to higher order surface
+real	x[npts]		#I reference image x values
+real	y[npts]		#I reference image y values
+real	z[npts]	        #I z values 
+real	wts[npts]	#I array of weights
+real	resid[npts]	#O fitted residuals
+int	npts		#I number of points
+int	xfit		#I X fit ?
+char	errmsg[ARB]	#O returned error message
+int	maxch		#I maximum number of characters in error message
+
+int	i, ier, ncoeff
+pointer	sp, zfit, savefit, coeff
+real	xmin, xmax, ymin, ymax
+bool	fp_equald()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (zfit, npts, TY_REAL)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_REAL)
+	call salloc (coeff, 3, TY_REAL)
+
+	# Determine the minimum and maximum values
+	if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+	    xmin = GM_XMIN(fit) - 0.5d0
+	    xmax = GM_XMAX(fit) + 0.5d0
+	} else {
+	    xmin = GM_XMIN(fit)
+	    xmax = GM_XMAX(fit)
+	}
+	if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+	    ymin = GM_YMIN(fit) - 0.5d0
+	    ymax = GM_YMAX(fit) + 0.5d0
+	} else {
+	    ymin = GM_YMIN(fit)
+	    ymax = GM_YMAX(fit)
+	}
+
+	# Initalize fit
+	if (sf1 != NULL)
+	    call gsfree (sf1)
+	if (sf2 != NULL)
+	    call gsfree (sf2)
+
+	if (xfit == YES) {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call gssave (sf1, Memr[savefit])
+		call gsfree (sf1)
+	        call gsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubr (z, x, Memr[zfit], npts)
+	        call gsfit (sf1, x, y, Memr[zfit], wts, npts, WTS_USER, ier)
+		call gscoeff (sf1, Memr[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff]
+		    Memr[savefit+GS_SAVECOEFF+1] = 1.0
+		    Memr[savefit+GS_SAVECOEFF+2] = 0.0
+		} else {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff] + (xmax + xmin) /
+		        2.0
+		    Memr[savefit+GS_SAVECOEFF+1] = (xmax - xmin) / 2.0
+		    Memr[savefit+GS_SAVECOEFF+2] = 0.0
+		}
+		call gsfree (sf1)
+		call gsrestore (sf1, Memr[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        sf2 = NULL
+
+	    default:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		if (IS_INDEFD(GM_XO(fit)))
+		    call gsset (sf1, GSXREF, INDEFR)
+		else
+		    call gsset (sf1, GSXREF, real (GM_XO(fit)))
+		if (IS_INDEFD(GM_YO(fit)))
+		    call gsset (sf1, GSYREF, INDEFR)
+		else
+		    call gsset (sf1, GSYREF, real (GM_YO(fit)))
+		if (IS_INDEFD(GM_ZO(fit)))
+		    call gsset (sf1, GSZREF, INDEFR)
+		else
+		    call gsset (sf1, GSZREF, real (GM_ZO(fit)))
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_XXORDER(fit) > 2 || GM_XYORDER(fit) > 2 ||
+		    GM_XXTERMS(fit) == GS_XFULL)
+	            call gsinit (sf2, GM_FUNCTION(fit), GM_XXORDER(fit),
+		        GM_XYORDER(fit), GM_XXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+	    }
+
+	} else {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call gssave (sf1, Memr[savefit])
+		call gsfree (sf1)
+	        call gsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubr (z, y, Memr[zfit], npts)
+	        call gsfit (sf1, x, y, Memr[zfit], wts, npts, WTS_USER, ier)
+		call gscoeff (sf1, Memr[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff]
+		    Memr[savefit+GS_SAVECOEFF+1] = 0.0
+		    Memr[savefit+GS_SAVECOEFF+2] = 1.0
+		} else {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff] + (ymin + ymax) /
+			2.0
+		    Memr[savefit+GS_SAVECOEFF+1] = 0.0
+		    Memr[savefit+GS_SAVECOEFF+2] = (ymax - ymin) / 2.0
+		}
+		call gsfree (sf1)
+		call gsrestore (sf1, Memr[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call gsinit (sf1, GM_FUNCTION(fit), 1, 2, GS_XNONE, xmin,
+	            xmax, ymin, ymax)
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        sf2 = NULL
+
+	    default:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin,
+	            xmax, ymin, ymax)
+		if (IS_INDEFD(GM_XO(fit)))
+		    call gsset (sf1, GSXREF, INDEFR)
+		else
+		    call gsset (sf1, GSXREF, real (GM_XO(fit)))
+		if (IS_INDEFD(GM_YO(fit)))
+		    call gsset (sf1, GSYREF, INDEFR)
+		else
+		    call gsset (sf1, GSYREF, real (GM_YO(fit)))
+		if (IS_INDEFD(GM_ZO(fit)))
+		    call gsset (sf1, GSZREF, INDEFR)
+		else
+		    call gsset (sf1, GSZREF, real (GM_ZO(fit)))
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_YXORDER(fit) > 2 || GM_YYORDER(fit) > 2 ||
+	            GM_YXTERMS(fit) == GS_XFULL)
+	            call gsinit (sf2, GM_FUNCTION(fit), GM_YXORDER(fit),
+	                GM_YYORDER(fit), GM_YXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+
+	    }
+
+	}
+
+
+	if (ier == NO_DEG_FREEDOM) {
+	    call sfree (sp)
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for X fit.")
+	            call error (1, "Too few data points for X fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for XI fit.")
+	            call error (1, "Too few data points for XI fit.")
+		}
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for Y fit.")
+	            call error (1, "Too few data points for Y fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for ETA fit.")
+	            call error (1, "Too few data points for ETA fit.")
+		}
+	    }
+	} else if (ier == SINGULAR) {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+	            call sprintf (errmsg, maxch, "Warning singular X fit.")
+		else
+	            call sprintf (errmsg, maxch, "Warning singular XI fit.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		else
+		    call sprintf (errmsg, maxch, "Warning singular ETA fit.")
+	    }
+	} else {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "X fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "XI fit ok.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Y fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "ETA fit ok.")
+	    }
+	}
+
+	call gsvector (sf1, x, y, resid, npts)
+	call asubr (z, resid, resid, npts)
+
+	# Calculate higher order fit.
+	if (sf2 != NULL) {
+	    call gsfit (sf2, x, y, resid, wts, npts, WTS_USER, ier)
+	    if (ier == NO_DEG_FREEDOM) {
+		call sfree (sp)
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for X fit.")
+		       call error (1, "Too few data points for X fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for XI fit.")
+		       call error (1, "Too few data points for XI fit.")
+		    }
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for Y fit.")
+			call error (1, "Too few data points for Y fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for ETA fit.")
+			call error (1, "Too few data points for ETA fit.")
+		    }
+		}
+	    } else if (ier == SINGULAR) {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular X fit.")
+		    else
+		        call sprintf (errmsg, maxch, "Warning singular XI fit.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		    else
+		        call sprintf (errmsg, maxch,
+			    "Warning singular ETA fit.")
+		}
+	    } else {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "X fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "XI fit ok.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Y fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "ETA fit ok.")
+		}
+	    }
+	    call gsvector (sf2, x, y, Memr[zfit], npts)
+	    call asubr (resid, Memr[zfit], resid, npts)
+	}
+
+	# Compute the number of zero weighted points.
+	GM_NWTS0(fit) = 0
+	do i = 1, npts {
+	    if (wts[i] <= real(0.0))
+	        GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	}
+
+	# calculate the rms of the fit
+	if (xfit == YES) {
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * resid[i] ** 2
+	} else {
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+		GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * resid[i] ** 2
+	}
+
+	GM_NPTS(fit) = npts
+
+	call sfree (sp)
+end
+
+
+# GEO_MREJECT -- Reject points from the fit.
+
+procedure geo_mrejectr (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts,
+        xresid, yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch) 
+
+pointer	fit		#I pointer to the fit structure
+pointer	sx1, sy1	#I pointers to the linear surface
+pointer sx2, sy2	#I pointers to the higher order surface
+real	xref[npts]	#I reference image x values
+real	yref[npts]	#I yreference values
+real	xin[npts]	#I x values
+real	yin[npts]	#I yvalues
+real	wts[npts]	#I weights
+real	xresid[npts]	#I residuals
+real	yresid[npts]	#I yresiduals
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x error message
+int	xmaxch		#I maximum number of characters in the x error message
+char	yerrmsg[ARB]	#O the output y error message
+int	ymaxch		#I maximum number of characters in the y error message
+
+int	i
+int	nreject, niter
+pointer	sp, twts
+real	cutx, cuty
+errchk	geo_fxyr(), geo_fthetar(), geo_fmagnifyr(), geo_flinearr()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (twts, npts, TY_REAL)
+
+	# Allocate space for the residuals.
+	if (GM_REJ(fit) != NULL)
+	    call mfree (GM_REJ(fit), TY_INT)
+	call malloc (GM_REJ(fit), npts, TY_INT)
+	GM_NREJECT(fit) = 0
+
+	# Initialize the temporary weights array and the number of rejected
+	# points.
+	call amovr (wts, Memr[twts], npts)
+	nreject = 0
+
+	niter = 0
+	repeat {
+
+	    # Compute the rejection limits.
+	    if ((npts - GM_NWTS0(fit)) > 1) {
+	        cutx = GM_REJECT(fit) * sqrt (GM_XRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	        cuty = GM_REJECT(fit) * sqrt (GM_YRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	    } else {
+	        cutx = MAX_REAL
+	        cuty = MAX_REAL
+	    }
+
+	    # Reject points from the fit.
+	    do i = 1, npts {
+	        if (Memr[twts+i-1] > 0.0 && ((abs (xresid[i]) > cutx) ||
+		    (abs (yresid[i]) > cuty))) {
+		    Memr[twts+i-1] = real(0.0)
+		    nreject = nreject + 1
+		    Memi[GM_REJ(fit)+nreject-1] = i
+	        }
+	    }
+	    if ((nreject - GM_NREJECT(fit)) <= 0)
+		break
+	    GM_NREJECT(fit) = nreject
+
+	    # Compute number of deleted points.
+	    GM_NWTS0(fit) = 0
+	    do i = 1, npts {
+		if (wts[i] <= 0.0)
+		    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	    }
+
+	    # Recompute the X and Y fit.
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_fthetar (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memr[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memr[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flinearr (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memr[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+		GM_ZO(fit) = GM_XOREF(fit)
+	        call geo_fxyr (fit, sx1, sx2, xref, yref, xin, Memr[twts],
+	            xresid, npts, YES, xerrmsg, xmaxch)
+		GM_ZO(fit) = GM_YOREF(fit)
+	        call geo_fxyr (fit, sy1, sy2, xref, yref, yin, Memr[twts],
+	            yresid, npts, NO, yerrmsg, ymaxch)
+	    }
+
+	    # Compute the x fit rms.
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + Memr[twts+i-1] * xresid[i] ** 2
+
+	    # Compute the y fit rms.
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_YRMS(fit) = GM_YRMS(fit) + Memr[twts+i-1] * yresid[i] ** 2
+
+	    niter = niter + 1
+
+	} until (niter >= GM_MAXITER(fit))
+
+	call sfree (sp)
+end
+
+
+# GEO_MMFREE - Free the space used to fit the surfaces.
+
+procedure geo_mmfreer (sx1, sy1, sx2, sy2)
+
+pointer	sx1		#U pointer to the x fits
+pointer	sy1		#U pointer to the y fit
+pointer	sx2		#U pointer to the higher order x fit
+pointer	sy2		#U pointer to the higher order y fit
+
+begin
+	if (sx1 != NULL)
+	    call gsfree (sx1)
+	if (sy1 != NULL)
+	    call gsfree (sy1)
+	if (sx2 != NULL)
+	    call gsfree (sx2)
+	if (sy2 != NULL)
+	    call gsfree (sy2)
+end
+
+
+
+# GEO_FIT -- Fit the surface in batch.
+
+procedure geo_fitd (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts, npts,
+	xerrmsg, yerrmsg, maxch)
+
+pointer	fit		#I pointer to fitting structure
+pointer	sx1, sy1	#U pointer to linear surface
+pointer	sx2, sy2	#U pointer to higher order correction
+double	xref[ARB]	#I x reference array
+double	yref[ARB]	#I y reference array
+double	xin[ARB]	#I x array
+double	yin[ARB]	#I y array
+double	wts[ARB]	#I weight array
+int	npts		#I the number of data points
+char	xerrmsg[ARB]	#O the x fit error message
+char	yerrmsg[ARB]	#O the y fit error message
+int	maxch		#I maximum size of the error message
+
+pointer	sp, xresidual, yresidual
+errchk	geo_fxyd(), geo_mrejectd(), geo_fthetad(), geo_fmagnifyd()
+errchk	geo_flineard()
+
+begin
+	call smark (sp)
+	call salloc (xresidual, npts, TY_DOUBLE)
+	call salloc (yresidual, npts, TY_DOUBLE)
+
+	switch (GM_FIT(fit)) {
+	case GM_ROTATE:
+	    call geo_fthetad (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memd[xresidual], Memd[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RSCALE:
+	    call geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memd[xresidual], Memd[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RXYSCALE:
+	    call geo_flineard (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memd[xresidual], Memd[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	default:
+	    GM_ZO(fit) = GM_XOREF(fit)
+	    call geo_fxyd (fit, sx1, sx2, xref, yref, xin, wts,
+	        Memd[xresidual], npts, YES, xerrmsg, maxch)
+	    GM_ZO(fit) = GM_YOREF(fit)
+	    call geo_fxyd (fit, sy1, sy2, xref, yref, yin, wts,
+	        Memd[yresidual], npts, NO, yerrmsg, maxch)
+	}
+	if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	    GM_NREJECT(fit) = 0
+	else
+	    call geo_mrejectd (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin,
+		wts, Memd[xresidual], Memd[yresidual], npts, xerrmsg,
+		maxch, yerrmsg, maxch)
+
+	call sfree (sp)
+end
+
+
+# GEO_FTHETA -- Compute the shift and rotation angle required to match one
+# set of coordinates to another.
+
+procedure geo_fthetad (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+double	xref[npts]	#I reference image x values
+double	yref[npts]	#I reference image y values
+double	xin[npts]	#I input image x values
+double	yin[npts]	#I input image y values
+double	wts[npts]	#I array of weights
+double	xresid[npts]	#O x fit residuals
+double	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, num, denom, theta, det 
+double	ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+double	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_DOUBLE)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call dgsfree (sx1)
+        if (sy1 != NULL)
+            call dgsfree (sy1)
+
+        # Determine the minimum and maximum values
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+
+	} else {
+
+	    # Compute the sums required to compute the rotation angle.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    if (det < 0.0d0) {
+	        cthetax = -ctheta
+	        sthetay = -stheta
+	    } else {
+	        cthetax = ctheta
+	        sthetay = stheta
+	    }
+	    sthetax = stheta
+	    cthetay = ctheta
+
+	    # Compute the x fit coefficients.
+	    call dgsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sx1, Memd[savefit])
+	    call dgsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sx1, Memd[savefit])
+
+	    # Compute the y fit coefficients.
+	    call dgsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sy1, Memd[savefit])
+	    call dgsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sy1, Memd[savefit])
+
+	    # Compute the residuals
+	    call dgsvector (sx1, xref, yref, xresid, npts)
+	    call dgsvector (sy1, xref, yref, yresid, npts)
+	    call asubd (xin, xresid, xresid, npts) 
+	    call asubd (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= double(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FMAGNIFY -- Compute the shift, the rotation angle, and the magnification
+# factor which is assumed to be the same in x and y, required to match one
+# set of coordinates to another.
+
+procedure geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+double	xref[npts]	#I reference image x values
+double	yref[npts]	#I reference image y values
+double	xin[npts]	#I input image x values
+double	yin[npts]	#I input image y values
+double	wts[npts]	#I array of weights
+double	xresid[npts]	#O x fit residuals
+double	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, det, theta
+double	mag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+double	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_DOUBLE)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call dgsfree (sx1)
+        if (sy1 != NULL)
+            call dgsfree (sy1)
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+
+	    # Compute the sums.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the magnification factor.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    num = denom * ctheta + num * stheta
+	    denom = sxrxr + syryr
+	    if (denom <= 0.0d0) {
+		mag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		mag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    if (det < 0.0d0) {
+	        cthetax = -mag * ctheta
+	        sthetay = -mag * stheta
+	    } else {
+	        cthetax = mag * ctheta
+	        sthetay = mag * stheta
+	    }
+	    sthetax = mag * stheta
+	    cthetay = mag * ctheta
+
+	    # Compute the x fit coefficients.
+	    call dgsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sx1, Memd[savefit])
+	    call dgsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sx1, Memd[savefit])
+
+	    # Compute the y fit coefficients.
+	    call dgsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sy1, Memd[savefit])
+	    call dgsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sy1, Memd[savefit])
+
+	    # Compute the residuals
+	    call dgsvector (sx1, xref, yref, xresid, npts)
+	    call dgsvector (sy1, xref, yref, yresid, npts)
+	    call asubd (xin, xresid, xresid, npts) 
+	    call asubd (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= double(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FLINEAR -- Compute the shift, the rotation angle, and the x and y scale
+# factors required to match one set of coordinates to another.
+
+procedure geo_flineard (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+double	xref[npts]	#I reference image x values
+double	yref[npts]	#I reference image y values
+double	xin[npts]	#I input image x values
+double	yin[npts]	#I input image y values
+double	wts[npts]	#I array of weights
+double	xresid[npts]	#O x fit residuals
+double	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, theta
+double	xmag, ymag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+double	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_DOUBLE)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call dgsfree (sx1)
+        if (sy1 != NULL)
+            call dgsfree (sy1)
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 3) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = 2.0d0 * (sxrxr * syrxi * syryi - syryr * sxrxi * sxryi)
+	    denom = syryr * (sxrxi - sxryi) * (sxrxi + sxryi) - sxrxr *
+	        (syrxi + syryi) * (syrxi - syryi) 
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom) / 2.0d0
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+
+	    # Compute the x magnification factor.
+	    num = sxrxi * ctheta - sxryi * stheta
+	    denom = sxrxr
+	    if (denom <= 0.0d0) {
+		xmag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		xmag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the y magnification factor.
+	    num = syrxi * stheta + syryi * ctheta
+	    denom = syryr
+	    if (denom <= 0.0d0) {
+		ymag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		ymag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    cthetax = xmag * ctheta
+	    sthetax = ymag * stheta
+	    sthetay = xmag * stheta
+	    cthetay = ymag * ctheta
+
+	    # Compute the x fit coefficients.
+	    call dgsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sx1, Memd[savefit])
+	    call dgsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sx1, Memd[savefit])
+
+	    # Compute the y fit coefficients.
+	    call dgsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sy1, Memd[savefit])
+	    call dgsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sy1, Memd[savefit])
+
+	    # Compute the residuals
+	    call dgsvector (sx1, xref, yref, xresid, npts)
+	    call dgsvector (sy1, xref, yref, yresid, npts)
+	    call asubd (xin, xresid, xresid, npts) 
+	    call asubd (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= double(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FXY -- Fit the surface.
+
+procedure geo_fxyd (fit, sf1, sf2, x, y, z, wts, resid, npts, xfit, errmsg,
+	maxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sf1		#U pointer to linear surface
+pointer	sf2		#U pointer to higher order surface
+double	x[npts]		#I reference image x values
+double	y[npts]		#I reference image y values
+double	z[npts]	        #I z values 
+double	wts[npts]	#I array of weights
+double	resid[npts]	#O fitted residuals
+int	npts		#I number of points
+int	xfit		#I X fit ?
+char	errmsg[ARB]	#O returned error message
+int	maxch		#I maximum number of characters in error message
+
+int	i, ier, ncoeff
+pointer	sp, zfit, savefit, coeff
+double	xmin, xmax, ymin, ymax
+bool	fp_equald()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (zfit, npts, TY_DOUBLE)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_DOUBLE)
+	call salloc (coeff, 3, TY_DOUBLE)
+
+	# Determine the minimum and maximum values
+	if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+	    xmin = GM_XMIN(fit) - 0.5d0
+	    xmax = GM_XMAX(fit) + 0.5d0
+	} else {
+	    xmin = GM_XMIN(fit)
+	    xmax = GM_XMAX(fit)
+	}
+	if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+	    ymin = GM_YMIN(fit) - 0.5d0
+	    ymax = GM_YMAX(fit) + 0.5d0
+	} else {
+	    ymin = GM_YMIN(fit)
+	    ymax = GM_YMAX(fit)
+	}
+
+	# Initalize fit
+	if (sf1 != NULL)
+	    call dgsfree (sf1)
+	if (sf2 != NULL)
+	    call dgsfree (sf2)
+
+	if (xfit == YES) {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgssave (sf1, Memd[savefit])
+		call dgsfree (sf1)
+	        call dgsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubd (z, x, Memd[zfit], npts)
+	        call dgsfit (sf1, x, y, Memd[zfit], wts, npts, WTS_USER, ier)
+		call dgscoeff (sf1, Memd[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff]
+		    Memd[savefit+GS_SAVECOEFF+1] = 1.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = 0.0d0
+		} else {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff] + (xmax + xmin) /
+			2.0d0
+		    Memd[savefit+GS_SAVECOEFF+1] = (xmax - xmin) / 2.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = 0.0d0
+		}
+		call dgsfree (sf1)
+		call dgsrestore (sf1, Memd[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+		sf2 = NULL
+
+	    default:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgsset (sf1, GSXREF, GM_XO(fit))
+		call dgsset (sf1, GSYREF, GM_YO(fit))
+		call dgsset (sf1, GSZREF, GM_ZO(fit))
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_XXORDER(fit) > 2 || GM_XYORDER(fit) > 2 ||
+		    GM_XXTERMS(fit) == GS_XFULL)
+	            call dgsinit (sf2, GM_FUNCTION(fit), GM_XXORDER(fit),
+		        GM_XYORDER(fit), GM_XXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+	    }
+
+	} else {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgssave (sf1, Memd[savefit])
+		call dgsfree (sf1)
+	        call dgsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubd (z, y, Memd[zfit], npts)
+	        call dgsfit (sf1, x, y, Memd[zfit], wts, npts, WTS_USER, ier)
+		call dgscoeff (sf1, Memd[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff]
+		    Memd[savefit+GS_SAVECOEFF+1] = 0.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = 1.0d0
+		} else {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff] + (ymin + ymax) /
+			2.0d0
+		    Memd[savefit+GS_SAVECOEFF+1] = 0.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = (ymax - ymin) / 2.0d0
+		}
+		call dgsfree (sf1)
+		call dgsrestore (sf1, Memd[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 1, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+		sf2 = NULL
+
+	    default:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgsset (sf1, GSXREF, GM_XO(fit))
+		call dgsset (sf1, GSYREF, GM_YO(fit))
+		call dgsset (sf1, GSZREF, GM_ZO(fit))
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_YXORDER(fit) > 2 || GM_YYORDER(fit) > 2 ||
+	            GM_YXTERMS(fit) == GS_XFULL)
+	            call dgsinit (sf2, GM_FUNCTION(fit), GM_YXORDER(fit),
+	                GM_YYORDER(fit), GM_YXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+	    }
+	}
+
+
+	if (ier == NO_DEG_FREEDOM) {
+	    call sfree (sp)
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for X fit.")
+	            call error (1, "Too few data points for X fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for XI fit.")
+	            call error (1, "Too few data points for XI fit.")
+		}
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for Y fit.")
+	            call error (1, "Too few data points for Y fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for ETA fit.")
+	            call error (1, "Too few data points for ETA fit.")
+		}
+	    }
+	} else if (ier == SINGULAR) {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+	            call sprintf (errmsg, maxch, "Warning singular X fit.")
+		else
+	            call sprintf (errmsg, maxch, "Warning singular XI fit.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		else
+		    call sprintf (errmsg, maxch, "Warning singular ETA fit.")
+	    }
+	} else {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "X fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "XI fit ok.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Y fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "ETA fit ok.")
+	    }
+	}
+
+	call dgsvector (sf1, x, y, resid, npts)
+	call asubd (z, resid, resid, npts)
+
+	# Calculate higher order fit.
+	if (sf2 != NULL) {
+	    call dgsfit (sf2, x, y, resid, wts, npts, WTS_USER, ier)
+	    if (ier == NO_DEG_FREEDOM) {
+		call sfree (sp)
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for X fit.")
+		       call error (1, "Too few data points for X fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for XI fit.")
+		       call error (1, "Too few data points for XI fit.")
+		    }
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for Y fit.")
+			call error (1, "Too few data points for Y fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for ETA fit.")
+			call error (1, "Too few data points for ETA fit.")
+		    }
+		}
+	    } else if (ier == SINGULAR) {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular X fit.")
+		    else
+		        call sprintf (errmsg, maxch, "Warning singular XI fit.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		    else
+		        call sprintf (errmsg, maxch,
+			    "Warning singular ETA fit.")
+		}
+	    } else {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "X fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "XI fit ok.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Y fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "ETA fit ok.")
+		}
+	    }
+	    call dgsvector (sf2, x, y, Memd[zfit], npts)
+	    call asubd (resid, Memd[zfit], resid, npts)
+	}
+
+	# Compute the number of zero weighted points.
+	GM_NWTS0(fit) = 0
+	do i = 1, npts {
+	    if (wts[i] <= double(0.0))
+	        GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	}
+
+	# calculate the rms of the fit
+	if (xfit == YES) {
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * resid[i] ** 2
+	} else {
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+		GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * resid[i] ** 2
+	}
+
+	GM_NPTS(fit) = npts
+
+	call sfree (sp)
+end
+
+
+# GEO_MREJECT -- Reject points from the fit.
+
+procedure geo_mrejectd (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts,
+        xresid, yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch) 
+
+pointer	fit		#I pointer to the fit structure
+pointer	sx1, sy1	#I pointers to the linear surface
+pointer sx2, sy2	#I pointers to the higher order surface
+double	xref[npts]	#I reference image x values
+double	yref[npts]	#I yreference values
+double	xin[npts]	#I x values
+double	yin[npts]	#I yvalues
+double	wts[npts]	#I weights
+double	xresid[npts]	#I residuals
+double	yresid[npts]	#I yresiduals
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x error message
+int	xmaxch		#I maximum number of characters in the x error message
+char	yerrmsg[ARB]	#O the output y error message
+int	ymaxch		#I maximum number of characters in the y error message
+
+int	i
+int	nreject, niter
+pointer	sp, twts
+double	cutx, cuty
+errchk	geo_fxyd(), geo_fthetad(), geo_fmagnifyd(), geo_flineard()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (twts, npts, TY_DOUBLE)
+
+	# Allocate space for the residuals.
+	if (GM_REJ(fit) != NULL)
+	    call mfree (GM_REJ(fit), TY_INT)
+	call malloc (GM_REJ(fit), npts, TY_INT)
+	GM_NREJECT(fit) = 0
+
+	# Initialize the temporary weights array and the number of rejected
+	# points.
+	call amovd (wts, Memd[twts], npts)
+	nreject = 0
+
+	niter = 0
+	repeat {
+
+	    # Compute the rejection limits.
+	    if ((npts - GM_NWTS0(fit)) > 1) {
+	        cutx = GM_REJECT(fit) * sqrt (GM_XRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	        cuty = GM_REJECT(fit) * sqrt (GM_YRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	    } else {
+	        cutx = MAX_REAL
+	        cuty = MAX_REAL
+	    }
+
+	    # Reject points from the fit.
+	    do i = 1, npts {
+	        if (Memd[twts+i-1] > 0.0 && ((abs (xresid[i]) > cutx) ||
+		    (abs (yresid[i]) > cuty))) {
+		    Memd[twts+i-1] = double(0.0)
+		    nreject = nreject + 1
+		    Memi[GM_REJ(fit)+nreject-1] = i
+	        }
+	    }
+	    if ((nreject - GM_NREJECT(fit)) <= 0)
+		break
+	    GM_NREJECT(fit) = nreject
+
+	    # Compute number of deleted points.
+	    GM_NWTS0(fit) = 0
+	    do i = 1, npts {
+		if (wts[i] <= 0.0)
+		    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	    }
+
+	    # Recompute the X and Y fit.
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_fthetad (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memd[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memd[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flineard (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memd[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+		GM_ZO(fit) = GM_XOREF(fit)
+	        call geo_fxyd (fit, sx1, sx2, xref, yref, xin, Memd[twts],
+	            xresid, npts, YES, xerrmsg, xmaxch)
+		GM_ZO(fit) = GM_YOREF(fit)
+	        call geo_fxyd (fit, sy1, sy2, xref, yref, yin, Memd[twts],
+	            yresid, npts, NO, yerrmsg, ymaxch)
+	    }
+
+	    # Compute the x fit rms.
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + Memd[twts+i-1] * xresid[i] ** 2
+
+	    # Compute the y fit rms.
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_YRMS(fit) = GM_YRMS(fit) + Memd[twts+i-1] * yresid[i] ** 2
+
+	    niter = niter + 1
+
+	} until (niter >= GM_MAXITER(fit))
+
+	call sfree (sp)
+end
+
+
+# GEO_MMFREE - Free the space used to fit the surfaces.
+
+procedure geo_mmfreed (sx1, sy1, sx2, sy2)
+
+pointer	sx1		#U pointer to the x fits
+pointer	sy1		#U pointer to the y fit
+pointer	sx2		#U pointer to the higher order x fit
+pointer	sy2		#U pointer to the higher order y fit
+
+begin
+	if (sx1 != NULL)
+	    call dgsfree (sx1)
+	if (sy1 != NULL)
+	    call dgsfree (sy1)
+	if (sx2 != NULL)
+	    call dgsfree (sx2)
+	if (sy2 != NULL)
+	    call dgsfree (sy2)
+end
+
+
diff --git a/pkg/images/lib/geofiti.x b/pkg/images/lib/geofiti.x
new file mode 100644
index 00000000..9f11da2b
--- /dev/null
+++ b/pkg/images/lib/geofiti.x
@@ -0,0 +1,2521 @@
+# Copyright(c) 1986 Assocation of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <math.h>
+include <math/gsurfit.h>
+include "geomap.h"
+
+
+
+# GEO_MINIT -- Initialize the fitting routines.
+
+procedure geo_minit (fit, projection, geometry, function, xxorder, xyorder,
+	xxterms, yxorder, yyorder, yxterms, maxiter, reject)
+
+pointer	fit		#I pointer to the fit structure
+int	projection	#I the coordinate projection type
+int	geometry	#I the fitting geometry
+int	function	#I fitting function
+int	xxorder		#I order of x fit in x
+int	xyorder		#I order of x fit in y
+int	xxterms		#I include cross terms in x fit
+int	yxorder		#I order of y fit in x
+int	yyorder		#I order of y fit in y
+int	yxterms		#I include cross-terms in y fit
+int	maxiter		#I the maximum number of rejection interations
+double	reject		#I rejection threshold in sigma
+
+begin
+	# Allocate the space.
+	call malloc (fit, LEN_GEOMAP, TY_STRUCT)
+
+	# Set function and order.
+	GM_PROJECTION(fit) = projection
+	GM_PROJSTR(fit) = EOS
+	GM_FIT(fit) = geometry
+	GM_FUNCTION(fit) = function
+	GM_XXORDER(fit) = xxorder
+	GM_XYORDER(fit) = xyorder
+	GM_XXTERMS(fit) = xxterms
+	GM_YXORDER(fit) = yxorder
+	GM_YYORDER(fit) = yyorder
+	GM_YXTERMS(fit) = yxterms
+
+	# Set rejection parameters.
+	GM_XRMS(fit) = 0.0d0
+	GM_YRMS(fit) = 0.0d0
+	GM_MAXITER(fit) = maxiter
+	GM_REJECT(fit) = reject
+	GM_NREJECT(fit) = 0
+	GM_REJ(fit) = NULL
+
+	# Set origin parameters.
+	GM_XO(fit) = INDEFD
+	GM_YO(fit) = INDEFD
+	GM_XOREF(fit) = INDEFD
+	GM_YOREF(fit) = INDEFD
+end
+
+
+# GEO_FREE -- Release the fitting space.
+
+procedure geo_free (fit)
+
+pointer	fit		#I pointer to the fitting structure
+
+begin
+	if (GM_REJ(fit) != NULL)
+	    call mfree (GM_REJ(fit), TY_INT)
+	call mfree (fit, TY_STRUCT)
+end
+
+
+
+
+
+
+# GEO_FIT -- Fit the surface in batch.
+
+procedure geo_fitr (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts, npts,
+	xerrmsg, yerrmsg, maxch)
+
+pointer	fit		#I pointer to fitting structure
+pointer	sx1, sy1	#U pointer to linear surface
+pointer	sx2, sy2	#U pointer to higher order correction
+real	xref[ARB]	#I x reference array
+real	yref[ARB]	#I y reference array
+real	xin[ARB]	#I x array
+real	yin[ARB]	#I y array
+real	wts[ARB]	#I weight array
+int	npts		#I the number of data points
+char	xerrmsg[ARB]	#O the x fit error message
+char	yerrmsg[ARB]	#O the y fit error message
+int	maxch		#I maximum size of the error message
+
+pointer	sp, xresidual, yresidual
+errchk	geo_fxyr(), geo_mrejectr(), geo_fthetar(), geo_fmagnifyr()
+errchk	geo_flinearr()
+
+begin
+	call smark (sp)
+	call salloc (xresidual, npts, TY_REAL)
+	call salloc (yresidual, npts, TY_REAL)
+
+	switch (GM_FIT(fit)) {
+	case GM_ROTATE:
+	    call geo_fthetar (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memr[xresidual], Memr[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RSCALE:
+	    call geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memr[xresidual], Memr[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RXYSCALE:
+	    call geo_flinearr (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memr[xresidual], Memr[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	default:
+	    GM_ZO(fit) = GM_XOREF(fit)
+	    call geo_fxyr (fit, sx1, sx2, xref, yref, xin, wts,
+	        Memr[xresidual], npts, YES, xerrmsg, maxch)
+	    GM_ZO(fit) = GM_YOREF(fit)
+	    call geo_fxyr (fit, sy1, sy2, xref, yref, yin, wts,
+	        Memr[yresidual], npts, NO, yerrmsg, maxch)
+	}
+	if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	    GM_NREJECT(fit) = 0
+	else
+	    call geo_mrejectr (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin,
+		wts, Memr[xresidual], Memr[yresidual], npts, xerrmsg,
+		maxch, yerrmsg, maxch)
+
+	call sfree (sp)
+end
+
+
+# GEO_FTHETA -- Compute the shift and rotation angle required to match one
+# set of coordinates to another.
+
+procedure geo_fthetar (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+real	xref[npts]	#I reference image x values
+real	yref[npts]	#I reference image y values
+real	xin[npts]	#I input image x values
+real	yin[npts]	#I input image y values
+real	wts[npts]	#I array of weights
+real	xresid[npts]	#O x fit residuals
+real	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, num, denom, theta, det 
+double	ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+real	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_REAL)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call gsfree (sx1)
+        if (sy1 != NULL)
+            call gsfree (sy1)
+
+        # Determine the minimum and maximum values
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+
+	} else {
+
+	    # Compute the sums required to compute the rotation angle.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    if (det < 0.0d0) {
+	        cthetax = -ctheta
+	        sthetay = -stheta
+	    } else {
+	        cthetax = ctheta
+	        sthetay = stheta
+	    }
+	    sthetax = stheta
+	    cthetay = ctheta
+
+	    # Compute the x fit coefficients.
+	    call gsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sx1, Memr[savefit])
+	    call gsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymax + ymin) / 2
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sx1, Memr[savefit])
+
+	    # Compute the y fit coefficients.
+	    call gsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sy1, Memr[savefit])
+	    call gsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymax + ymin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sy1, Memr[savefit])
+
+	    # Compute the residuals
+	    call gsvector (sx1, xref, yref, xresid, npts)
+	    call gsvector (sy1, xref, yref, yresid, npts)
+	    call asubr (xin, xresid, xresid, npts) 
+	    call asubr (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= real(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FMAGNIFY -- Compute the shift, the rotation angle, and the magnification
+# factor which is assumed to be the same in x and y, required to match one
+# set of coordinates to another.
+
+procedure geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+real	xref[npts]	#I reference image x values
+real	yref[npts]	#I reference image y values
+real	xin[npts]	#I input image x values
+real	yin[npts]	#I input image y values
+real	wts[npts]	#I array of weights
+real	xresid[npts]	#O x fit residuals
+real	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, det, theta
+double	mag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+real	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_REAL)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call gsfree (sx1)
+        if (sy1 != NULL)
+            call gsfree (sy1)
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+
+	    # Compute the sums.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the magnification factor.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    num = denom * ctheta + num * stheta
+	    denom = sxrxr + syryr
+	    if (denom <= 0.0d0) {
+		mag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		mag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    if (det < 0.0d0) {
+	        cthetax = -mag * ctheta
+	        sthetay = -mag * stheta
+	    } else {
+	        cthetax = mag * ctheta
+	        sthetay = mag * stheta
+	    }
+	    sthetax = mag * stheta
+	    cthetay = mag * ctheta
+
+	    # Compute the x fit coefficients.
+	    call gsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sx1, Memr[savefit])
+	    call gsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymax + ymin) / 2
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sx1, Memr[savefit])
+
+	    # Compute the y fit coefficients.
+	    call gsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sy1, Memr[savefit])
+	    call gsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymax + ymin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sy1, Memr[savefit])
+
+	    # Compute the residuals
+	    call gsvector (sx1, xref, yref, xresid, npts)
+	    call gsvector (sy1, xref, yref, yresid, npts)
+	    call asubr (xin, xresid, xresid, npts) 
+	    call asubr (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= real(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FLINEAR -- Compute the shift, the rotation angle, and the x and y scale
+# factors required to match one set of coordinates to another.
+
+procedure geo_flinearr (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+real	xref[npts]	#I reference image x values
+real	yref[npts]	#I reference image y values
+real	xin[npts]	#I input image x values
+real	yin[npts]	#I input image y values
+real	wts[npts]	#I array of weights
+real	xresid[npts]	#O x fit residuals
+real	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, theta
+double	xmag, ymag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+real	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_REAL)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call gsfree (sx1)
+        if (sy1 != NULL)
+            call gsfree (sy1)
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 3) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = 2.0d0 * (sxrxr * syrxi * syryi - syryr * sxrxi * sxryi)
+	    denom = syryr * (sxrxi - sxryi) * (sxrxi + sxryi) - sxrxr *
+	        (syrxi + syryi) * (syrxi - syryi) 
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom) / 2.0d0
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+
+	    # Compute the x magnification factor.
+	    num = sxrxi * ctheta - sxryi * stheta
+	    denom = sxrxr
+	    if (denom <= 0.0d0) {
+		xmag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		xmag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the y magnification factor.
+	    num = syrxi * stheta + syryi * ctheta
+	    denom = syryr
+	    if (denom <= 0.0d0) {
+		ymag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		ymag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    cthetax = xmag * ctheta
+	    sthetax = ymag * stheta
+	    sthetay = xmag * stheta
+	    cthetay = ymag * ctheta
+
+	    # Compute the x fit coefficients.
+	    call gsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sx1, Memr[savefit])
+	    call gsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymax + ymin) / 2
+	        Memr[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sx1, Memr[savefit])
+
+	    # Compute the y fit coefficients.
+	    call gsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gssave (sy1, Memr[savefit])
+	    call gsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memr[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymax + ymin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memr[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call gsrestore (sy1, Memr[savefit])
+
+	    # Compute the residuals
+	    call gsvector (sx1, xref, yref, xresid, npts)
+	    call gsvector (sy1, xref, yref, yresid, npts)
+	    call asubr (xin, xresid, xresid, npts) 
+	    call asubr (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= real(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FXY -- Fit the surface.
+
+procedure geo_fxyr (fit, sf1, sf2, x, y, z, wts, resid, npts, xfit, errmsg,
+	maxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sf1		#U pointer to linear surface
+pointer	sf2		#U pointer to higher order surface
+real	x[npts]		#I reference image x values
+real	y[npts]		#I reference image y values
+real	z[npts]	        #I z values 
+real	wts[npts]	#I array of weights
+real	resid[npts]	#O fitted residuals
+int	npts		#I number of points
+int	xfit		#I X fit ?
+char	errmsg[ARB]	#O returned error message
+int	maxch		#I maximum number of characters in error message
+
+int	i, ier, ncoeff
+pointer	sp, zfit, savefit, coeff
+real	xmin, xmax, ymin, ymax
+bool	fp_equald()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (zfit, npts, TY_REAL)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_REAL)
+	call salloc (coeff, 3, TY_REAL)
+
+	# Determine the minimum and maximum values
+	if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+	    xmin = GM_XMIN(fit) - 0.5d0
+	    xmax = GM_XMAX(fit) + 0.5d0
+	} else {
+	    xmin = GM_XMIN(fit)
+	    xmax = GM_XMAX(fit)
+	}
+	if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+	    ymin = GM_YMIN(fit) - 0.5d0
+	    ymax = GM_YMAX(fit) + 0.5d0
+	} else {
+	    ymin = GM_YMIN(fit)
+	    ymax = GM_YMAX(fit)
+	}
+
+	# Initalize fit
+	if (sf1 != NULL)
+	    call gsfree (sf1)
+	if (sf2 != NULL)
+	    call gsfree (sf2)
+
+	if (xfit == YES) {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call gssave (sf1, Memr[savefit])
+		call gsfree (sf1)
+	        call gsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubr (z, x, Memr[zfit], npts)
+	        call gsfit (sf1, x, y, Memr[zfit], wts, npts, WTS_USER, ier)
+		call gscoeff (sf1, Memr[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff]
+		    Memr[savefit+GS_SAVECOEFF+1] = 1.0
+		    Memr[savefit+GS_SAVECOEFF+2] = 0.0
+		} else {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff] + (xmax + xmin) /
+		        2.0
+		    Memr[savefit+GS_SAVECOEFF+1] = (xmax - xmin) / 2.0
+		    Memr[savefit+GS_SAVECOEFF+2] = 0.0
+		}
+		call gsfree (sf1)
+		call gsrestore (sf1, Memr[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        sf2 = NULL
+
+	    default:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call gsset (sf1, GSXREF, GM_XO(fit))
+		call gsset (sf1, GSYREF, GM_YO(fit))
+		call gsset (sf1, GSZREF, GM_ZO(fit))
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_XXORDER(fit) > 2 || GM_XYORDER(fit) > 2 ||
+		    GM_XXTERMS(fit) == GS_XFULL)
+	            call gsinit (sf2, GM_FUNCTION(fit), GM_XXORDER(fit),
+		        GM_XYORDER(fit), GM_XXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+	    }
+
+	} else {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call gssave (sf1, Memr[savefit])
+		call gsfree (sf1)
+	        call gsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubr (z, y, Memr[zfit], npts)
+	        call gsfit (sf1, x, y, Memr[zfit], wts, npts, WTS_USER, ier)
+		call gscoeff (sf1, Memr[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff]
+		    Memr[savefit+GS_SAVECOEFF+1] = 0.0
+		    Memr[savefit+GS_SAVECOEFF+2] = 1.0
+		} else {
+		    Memr[savefit+GS_SAVECOEFF] = Memr[coeff] + (ymin + ymax) /
+			2.0
+		    Memr[savefit+GS_SAVECOEFF+1] = 0.0
+		    Memr[savefit+GS_SAVECOEFF+2] = (ymax - ymin) / 2.0
+		}
+		call gsfree (sf1)
+		call gsrestore (sf1, Memr[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call gsinit (sf1, GM_FUNCTION(fit), 1, 2, GS_XNONE, xmin,
+	            xmax, ymin, ymax)
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        sf2 = NULL
+
+	    default:
+	        call gsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin,
+	            xmax, ymin, ymax)
+		call gsset (sf1, GSXREF, GM_XO(fit))
+		call gsset (sf1, GSYREF, GM_YO(fit))
+		call gsset (sf1, GSZREF, GM_ZO(fit))
+	        call gsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_YXORDER(fit) > 2 || GM_YYORDER(fit) > 2 ||
+	            GM_YXTERMS(fit) == GS_XFULL)
+	            call gsinit (sf2, GM_FUNCTION(fit), GM_YXORDER(fit),
+	                GM_YYORDER(fit), GM_YXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+
+	    }
+
+	}
+
+
+	if (ier == NO_DEG_FREEDOM) {
+	    call sfree (sp)
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for X fit.")
+	            call error (1, "Too few data points for X fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for XI fit.")
+	            call error (1, "Too few data points for XI fit.")
+		}
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for Y fit.")
+	            call error (1, "Too few data points for Y fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for ETA fit.")
+	            call error (1, "Too few data points for ETA fit.")
+		}
+	    }
+	} else if (ier == SINGULAR) {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+	            call sprintf (errmsg, maxch, "Warning singular X fit.")
+		else
+	            call sprintf (errmsg, maxch, "Warning singular XI fit.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		else
+		    call sprintf (errmsg, maxch, "Warning singular ETA fit.")
+	    }
+	} else {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "X fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "XI fit ok.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Y fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "ETA fit ok.")
+	    }
+	}
+
+	call gsvector (sf1, x, y, resid, npts)
+	call asubr (z, resid, resid, npts)
+
+	# Calculate higher order fit.
+	if (sf2 != NULL) {
+	    call gsfit (sf2, x, y, resid, wts, npts, WTS_USER, ier)
+	    if (ier == NO_DEG_FREEDOM) {
+		call sfree (sp)
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for X fit.")
+		       call error (1, "Too few data points for X fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for XI fit.")
+		       call error (1, "Too few data points for XI fit.")
+		    }
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for Y fit.")
+			call error (1, "Too few data points for Y fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for ETA fit.")
+			call error (1, "Too few data points for ETA fit.")
+		    }
+		}
+	    } else if (ier == SINGULAR) {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular X fit.")
+		    else
+		        call sprintf (errmsg, maxch, "Warning singular XI fit.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		    else
+		        call sprintf (errmsg, maxch,
+			    "Warning singular ETA fit.")
+		}
+	    } else {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "X fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "XI fit ok.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Y fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "ETA fit ok.")
+		}
+	    }
+	    call gsvector (sf2, x, y, Memr[zfit], npts)
+	    call asubr (resid, Memr[zfit], resid, npts)
+	}
+
+	# Compute the number of zero weighted points.
+	GM_NWTS0(fit) = 0
+	do i = 1, npts {
+	    if (wts[i] <= real(0.0))
+	        GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	}
+
+	# calculate the rms of the fit
+	if (xfit == YES) {
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * resid[i] ** 2
+	} else {
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+		GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * resid[i] ** 2
+	}
+
+	GM_NPTS(fit) = npts
+
+	call sfree (sp)
+end
+
+
+# GEO_MREJECT -- Reject points from the fit.
+
+procedure geo_mrejectr (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts,
+        xresid, yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch) 
+
+pointer	fit		#I pointer to the fit structure
+pointer	sx1, sy1	#I pointers to the linear surface
+pointer sx2, sy2	#I pointers to the higher order surface
+real	xref[npts]	#I reference image x values
+real	yref[npts]	#I yreference values
+real	xin[npts]	#I x values
+real	yin[npts]	#I yvalues
+real	wts[npts]	#I weights
+real	xresid[npts]	#I residuals
+real	yresid[npts]	#I yresiduals
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x error message
+int	xmaxch		#I maximum number of characters in the x error message
+char	yerrmsg[ARB]	#O the output y error message
+int	ymaxch		#I maximum number of characters in the y error message
+
+int	i
+int	nreject, niter
+pointer	sp, twts
+real	cutx, cuty
+errchk	geo_fxyr(), geo_fthetar(), geo_fmagnifyr(), geo_flinearr()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (twts, npts, TY_REAL)
+
+	# Allocate space for the residuals.
+	if (GM_REJ(fit) != NULL)
+	    call mfree (GM_REJ(fit), TY_INT)
+	call malloc (GM_REJ(fit), npts, TY_INT)
+	GM_NREJECT(fit) = 0
+
+	# Initialize the temporary weights array and the number of rejected
+	# points.
+	call amovr (wts, Memr[twts], npts)
+	nreject = 0
+
+	niter = 0
+	repeat {
+
+	    # Compute the rejection limits.
+	    if ((npts - GM_NWTS0(fit)) > 1) {
+	        cutx = GM_REJECT(fit) * sqrt (GM_XRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	        cuty = GM_REJECT(fit) * sqrt (GM_YRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	    } else {
+	        cutx = MAX_REAL
+	        cuty = MAX_REAL
+	    }
+
+	    # Reject points from the fit.
+	    do i = 1, npts {
+	        if (Memr[twts+i-1] > 0.0 && ((abs (xresid[i]) > cutx) ||
+		    (abs (yresid[i]) > cuty))) {
+		    Memr[twts+i-1] = real(0.0)
+		    nreject = nreject + 1
+		    Memi[GM_REJ(fit)+nreject-1] = i
+	        }
+	    }
+	    if ((nreject - GM_NREJECT(fit)) <= 0)
+		break
+	    GM_NREJECT(fit) = nreject
+
+	    # Compute number of deleted points.
+	    GM_NWTS0(fit) = 0
+	    do i = 1, npts {
+		if (wts[i] <= 0.0)
+		    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	    }
+
+	    # Recompute the X and Y fit.
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_fthetar (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memr[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memr[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flinearr (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memr[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+		GM_ZO(fit) = GM_XOREF(fit)
+	        call geo_fxyr (fit, sx1, sx2, xref, yref, xin, Memr[twts],
+	            xresid, npts, YES, xerrmsg, xmaxch)
+		GM_ZO(fit) = GM_YOREF(fit)
+	        call geo_fxyr (fit, sy1, sy2, xref, yref, yin, Memr[twts],
+	            yresid, npts, NO, yerrmsg, ymaxch)
+	    }
+
+	    # Compute the x fit rms.
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + Memr[twts+i-1] * xresid[i] ** 2
+
+	    # Compute the y fit rms.
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_YRMS(fit) = GM_YRMS(fit) + Memr[twts+i-1] * yresid[i] ** 2
+
+	    niter = niter + 1
+
+	} until (niter >= GM_MAXITER(fit))
+
+	call sfree (sp)
+end
+
+
+# GEO_MMFREE - Free the space used to fit the surfaces.
+
+procedure geo_mmfreer (sx1, sy1, sx2, sy2)
+
+pointer	sx1		#U pointer to the x fits
+pointer	sy1		#U pointer to the y fit
+pointer	sx2		#U pointer to the higher order x fit
+pointer	sy2		#U pointer to the higher order y fit
+
+begin
+	if (sx1 != NULL)
+	    call gsfree (sx1)
+	if (sy1 != NULL)
+	    call gsfree (sy1)
+	if (sx2 != NULL)
+	    call gsfree (sx2)
+	if (sy2 != NULL)
+	    call gsfree (sy2)
+end
+
+
+
+# GEO_FIT -- Fit the surface in batch.
+
+procedure geo_fitd (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts, npts,
+	xerrmsg, yerrmsg, maxch)
+
+pointer	fit		#I pointer to fitting structure
+pointer	sx1, sy1	#U pointer to linear surface
+pointer	sx2, sy2	#U pointer to higher order correction
+double	xref[ARB]	#I x reference array
+double	yref[ARB]	#I y reference array
+double	xin[ARB]	#I x array
+double	yin[ARB]	#I y array
+double	wts[ARB]	#I weight array
+int	npts		#I the number of data points
+char	xerrmsg[ARB]	#O the x fit error message
+char	yerrmsg[ARB]	#O the y fit error message
+int	maxch		#I maximum size of the error message
+
+pointer	sp, xresidual, yresidual
+errchk	geo_fxyd(), geo_mrejectd(), geo_fthetad(), geo_fmagnifyd()
+errchk	geo_flineard()
+
+begin
+	call smark (sp)
+	call salloc (xresidual, npts, TY_DOUBLE)
+	call salloc (yresidual, npts, TY_DOUBLE)
+
+	switch (GM_FIT(fit)) {
+	case GM_ROTATE:
+	    call geo_fthetad (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memd[xresidual], Memd[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RSCALE:
+	    call geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memd[xresidual], Memd[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	case GM_RXYSCALE:
+	    call geo_flineard (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	        Memd[xresidual], Memd[yresidual], npts, xerrmsg, maxch,
+		yerrmsg, maxch)
+		sx2 = NULL
+		sy2 = NULL
+	default:
+	    GM_ZO(fit) = GM_XOREF(fit)
+	    call geo_fxyd (fit, sx1, sx2, xref, yref, xin, wts,
+	        Memd[xresidual], npts, YES, xerrmsg, maxch)
+	    GM_ZO(fit) = GM_YOREF(fit)
+	    call geo_fxyd (fit, sy1, sy2, xref, yref, yin, wts,
+	        Memd[yresidual], npts, NO, yerrmsg, maxch)
+	}
+	if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	    GM_NREJECT(fit) = 0
+	else
+	    call geo_mrejectd (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin,
+		wts, Memd[xresidual], Memd[yresidual], npts, xerrmsg,
+		maxch, yerrmsg, maxch)
+
+	call sfree (sp)
+end
+
+
+# GEO_FTHETA -- Compute the shift and rotation angle required to match one
+# set of coordinates to another.
+
+procedure geo_fthetad (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+double	xref[npts]	#I reference image x values
+double	yref[npts]	#I reference image y values
+double	xin[npts]	#I input image x values
+double	yin[npts]	#I input image y values
+double	wts[npts]	#I array of weights
+double	xresid[npts]	#O x fit residuals
+double	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, num, denom, theta, det 
+double	ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+double	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_DOUBLE)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call dgsfree (sx1)
+        if (sy1 != NULL)
+            call dgsfree (sy1)
+
+        # Determine the minimum and maximum values
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+
+	} else {
+
+	    # Compute the sums required to compute the rotation angle.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    if (det < 0.0d0) {
+	        cthetax = -ctheta
+	        sthetay = -stheta
+	    } else {
+	        cthetax = ctheta
+	        sthetay = stheta
+	    }
+	    sthetax = stheta
+	    cthetay = ctheta
+
+	    # Compute the x fit coefficients.
+	    call dgsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sx1, Memd[savefit])
+	    call dgsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sx1, Memd[savefit])
+
+	    # Compute the y fit coefficients.
+	    call dgsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sy1, Memd[savefit])
+	    call dgsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sy1, Memd[savefit])
+
+	    # Compute the residuals
+	    call dgsvector (sx1, xref, yref, xresid, npts)
+	    call dgsvector (sy1, xref, yref, yresid, npts)
+	    call asubd (xin, xresid, xresid, npts) 
+	    call asubd (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= double(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FMAGNIFY -- Compute the shift, the rotation angle, and the magnification
+# factor which is assumed to be the same in x and y, required to match one
+# set of coordinates to another.
+
+procedure geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+double	xref[npts]	#I reference image x values
+double	yref[npts]	#I reference image y values
+double	xin[npts]	#I input image x values
+double	yin[npts]	#I input image y values
+double	wts[npts]	#I array of weights
+double	xresid[npts]	#O x fit residuals
+double	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, det, theta
+double	mag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+double	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_DOUBLE)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call dgsfree (sx1)
+        if (sy1 != NULL)
+            call dgsfree (sy1)
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 2) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+
+	    # Compute the sums.
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = sxrxi * syryi
+	    denom = syrxi * sxryi
+	    if (fp_equald (num, denom))
+		det = 0.0d0
+	    else
+		det = num - denom
+	    if (det < 0.0d0) {
+		num = syrxi + sxryi
+	        denom = -sxrxi + syryi
+	    } else {
+	        num = syrxi - sxryi
+	        denom = sxrxi + syryi
+	    }
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom)
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the magnification factor.
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+	    num = denom * ctheta + num * stheta
+	    denom = sxrxr + syryr
+	    if (denom <= 0.0d0) {
+		mag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		mag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    if (det < 0.0d0) {
+	        cthetax = -mag * ctheta
+	        sthetay = -mag * stheta
+	    } else {
+	        cthetax = mag * ctheta
+	        sthetay = mag * stheta
+	    }
+	    sthetax = mag * stheta
+	    cthetay = mag * ctheta
+
+	    # Compute the x fit coefficients.
+	    call dgsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sx1, Memd[savefit])
+	    call dgsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sx1, Memd[savefit])
+
+	    # Compute the y fit coefficients.
+	    call dgsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sy1, Memd[savefit])
+	    call dgsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sy1, Memd[savefit])
+
+	    # Compute the residuals
+	    call dgsvector (sx1, xref, yref, xresid, npts)
+	    call dgsvector (sy1, xref, yref, yresid, npts)
+	    call asubd (xin, xresid, xresid, npts) 
+	    call asubd (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= double(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FLINEAR -- Compute the shift, the rotation angle, and the x and y scale
+# factors required to match one set of coordinates to another.
+
+procedure geo_flineard (fit, sx1, sy1, xref, yref, xin, yin, wts, xresid,
+	yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sx1		#U pointer to linear x fit surface
+pointer	sy1		#U pointer to linear y fit surface
+double	xref[npts]	#I reference image x values
+double	yref[npts]	#I reference image y values
+double	xin[npts]	#I input image x values
+double	yin[npts]	#I input image y values
+double	wts[npts]	#I array of weights
+double	xresid[npts]	#O x fit residuals
+double	yresid[npts]	#O y fit residuals
+int	npts		#I number of points
+char	xerrmsg[ARB]	#O returned x fit error message
+int	xmaxch		#I maximum number of characters in x fit error message
+char	yerrmsg[ARB]	#O returned y fit error message
+int	ymaxch		#I maximum number of characters in y fit error message
+
+int	i
+double	sw, sxr, syr, sxi, syi, xr0, yr0, xi0, yi0
+double	syrxi, sxryi, sxrxi, syryi, sxrxr, syryr, num, denom, theta
+double	xmag, ymag, ctheta, stheta, cthetax, sthetax, cthetay, sthetay
+double	xmin, xmax, ymin, ymax
+pointer	sp, savefit
+bool	fp_equald()
+
+begin
+	# Allocate some working space
+	call smark (sp)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_DOUBLE)
+
+	# Initialize the fit.
+        if (sx1 != NULL)
+            call dgsfree (sx1)
+        if (sy1 != NULL)
+            call dgsfree (sy1)
+
+        # Determine the minimum and maximum values.
+        if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+            xmin = GM_XMIN(fit) - 0.5d0
+            xmax = GM_XMAX(fit) + 0.5d0
+        } else {
+            xmin = GM_XMIN(fit)
+            xmax = GM_XMAX(fit)
+        }
+        if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+            ymin = GM_YMIN(fit) - 0.5d0
+            ymax = GM_YMAX(fit) + 0.5d0
+        } else {
+            ymin = GM_YMIN(fit)
+            ymax = GM_YMAX(fit)
+        }
+
+	# Compute the sums required to determine the offsets.
+	sw = 0.0d0
+	sxr = 0.0d0
+	syr = 0.0d0
+	sxi = 0.0d0
+	syi = 0.0d0
+	do i = 1, npts {
+	    sw = sw + wts[i]
+	    sxr = sxr + wts[i] * xref[i]
+	    syr = syr + wts[i] * yref[i]
+	    sxi = sxi + wts[i] * xin[i]
+	    syi = syi + wts[i] * yin[i]
+	}
+
+	# Do the fit.
+	if (sw < 3) {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for X and Y fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for X and Y fits.")
+	        call error (1, "Too few data points for X and Y fits.")
+	    } else {
+	        call sprintf (xerrmsg, xmaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call sprintf (yerrmsg, ymaxch,
+		    "Too few data points for XI and ETA fits.")
+	        call error (1, "Too few data points for XI and ETA fits.")
+	    }
+	} else {
+	    xr0 = sxr / sw
+	    yr0 = syr / sw
+	    xi0 = sxi / sw
+	    yi0 = syi / sw
+	    sxrxr = 0.0d0
+	    syryr = 0.0d0
+	    syrxi = 0.0d0
+	    sxryi = 0.0d0
+	    sxrxi = 0.0d0
+	    syryi = 0.0d0
+	    do i = 1, npts {
+		sxrxr = sxrxr + wts[i] * (xref[i] - xr0) * (xref[i] - xr0)
+		syryr = syryr + wts[i] * (yref[i] - yr0) * (yref[i] - yr0)
+		syrxi = syrxi + wts[i] * (yref[i] - yr0) * (xin[i] - xi0)
+		sxryi = sxryi + wts[i] * (xref[i] - xr0) * (yin[i] - yi0)
+		sxrxi = sxrxi + wts[i] * (xref[i] - xr0) * (xin[i] - xi0)
+		syryi = syryi + wts[i] * (yref[i] - yr0) * (yin[i] - yi0)
+	    }
+
+	    # Compute the rotation angle.
+	    num = 2.0d0 * (sxrxr * syrxi * syryi - syryr * sxrxi * sxryi)
+	    denom = syryr * (sxrxi - sxryi) * (sxrxi + sxryi) - sxrxr *
+	        (syrxi + syryi) * (syrxi - syryi) 
+	    if (fp_equald (num, 0.0d0) && fp_equald (denom, 0.0d0)) {
+		theta = 0.0d0
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		theta = atan2 (num, denom) / 2.0d0
+		if (theta < 0.0d0)
+		    theta = theta + TWOPI
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+	    ctheta = cos (theta)
+	    stheta = sin (theta)
+
+	    # Compute the x magnification factor.
+	    num = sxrxi * ctheta - sxryi * stheta
+	    denom = sxrxr
+	    if (denom <= 0.0d0) {
+		xmag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		xmag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the y magnification factor.
+	    num = syrxi * stheta + syryi * ctheta
+	    denom = syryr
+	    if (denom <= 0.0d0) {
+		ymag = 1.0 
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular X fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular Y fit.")
+		} else {
+	            call sprintf (xerrmsg, xmaxch, "Warning singular XI fit.")
+	            call sprintf (yerrmsg, ymaxch, "Warning singular ETA fit.")
+		}
+	    } else {
+		ymag = num / denom
+	        if (GM_PROJECTION(fit) == GM_NONE) {
+		    call sprintf (xerrmsg, xmaxch, "X fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "Y fit ok.")
+		} else {
+		    call sprintf (xerrmsg, xmaxch, "XI fit ok.")
+		    call sprintf (yerrmsg, ymaxch, "ETA fit ok.")
+		}
+	    }
+
+	    # Compute the polynomial coefficients.
+	    cthetax = xmag * ctheta
+	    sthetax = ymag * stheta
+	    sthetay = xmag * stheta
+	    cthetay = ymag * ctheta
+
+	    # Compute the x fit coefficients.
+	    call dgsinit (sx1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sx1, Memd[savefit])
+	    call dgsfree (sx1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax)
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = xi0 - (xr0 * cthetax + yr0 *
+		    sthetax) + cthetax * (xmax + xmin) / 2.0 + sthetax * 
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = cthetax * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = sthetax * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sx1, Memd[savefit])
+
+	    # Compute the y fit coefficients.
+	    call dgsinit (sy1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call dgssave (sy1, Memd[savefit])
+	    call dgsfree (sy1)
+	    if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay)
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay
+	    } else {
+	        Memd[savefit+GS_SAVECOEFF] = yi0 - (-xr0 * sthetay + yr0 *
+		    cthetay) - sthetay * (xmax + xmin) / 2.0 + cthetay *
+		    (ymin + ymax) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+1] = -sthetay * (xmax - xmin) / 2.0
+	        Memd[savefit+GS_SAVECOEFF+2] = cthetay * (ymax - ymin) / 2.0
+	    }
+	    call dgsrestore (sy1, Memd[savefit])
+
+	    # Compute the residuals
+	    call dgsvector (sx1, xref, yref, xresid, npts)
+	    call dgsvector (sy1, xref, yref, yresid, npts)
+	    call asubd (xin, xresid, xresid, npts) 
+	    call asubd (yin, yresid, yresid, npts) 
+
+            # Compute the number of zero weighted points.
+            GM_NWTS0(fit) = 0
+            do i = 1, npts {
+                if (wts[i] <= double(0.0))
+                    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+            }
+
+            # Compute the rms of the x and y fits.
+            GM_XRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * xresid[i] ** 2
+            GM_YRMS(fit) = 0.0d0
+            do i = 1, npts
+                GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * yresid[i] ** 2
+
+            GM_NPTS(fit) = npts
+
+	}
+
+        call sfree (sp)
+end
+
+
+# GEO_FXY -- Fit the surface.
+
+procedure geo_fxyd (fit, sf1, sf2, x, y, z, wts, resid, npts, xfit, errmsg,
+	maxch)
+
+pointer	fit		#I pointer to the fit sturcture
+pointer	sf1		#U pointer to linear surface
+pointer	sf2		#U pointer to higher order surface
+double	x[npts]		#I reference image x values
+double	y[npts]		#I reference image y values
+double	z[npts]	        #I z values 
+double	wts[npts]	#I array of weights
+double	resid[npts]	#O fitted residuals
+int	npts		#I number of points
+int	xfit		#I X fit ?
+char	errmsg[ARB]	#O returned error message
+int	maxch		#I maximum number of characters in error message
+
+int	i, ier, ncoeff
+pointer	sp, zfit, savefit, coeff
+double	xmin, xmax, ymin, ymax
+bool	fp_equald()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (zfit, npts, TY_DOUBLE)
+	call salloc (savefit, GS_SAVECOEFF + 3, TY_DOUBLE)
+	call salloc (coeff, 3, TY_DOUBLE)
+
+	# Determine the minimum and maximum values
+	if (fp_equald (GM_XMIN(fit), GM_XMAX(fit))) {
+	    xmin = GM_XMIN(fit) - 0.5d0
+	    xmax = GM_XMAX(fit) + 0.5d0
+	} else {
+	    xmin = GM_XMIN(fit)
+	    xmax = GM_XMAX(fit)
+	}
+	if (fp_equald (GM_YMIN(fit), GM_YMAX(fit))) {
+	    ymin = GM_YMIN(fit) - 0.5d0
+	    ymax = GM_YMAX(fit) + 0.5d0
+	} else {
+	    ymin = GM_YMIN(fit)
+	    ymax = GM_YMAX(fit)
+	}
+
+	# Initalize fit
+	if (sf1 != NULL)
+	    call dgsfree (sf1)
+	if (sf2 != NULL)
+	    call dgsfree (sf2)
+
+	if (xfit == YES) {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgssave (sf1, Memd[savefit])
+		call dgsfree (sf1)
+	        call dgsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubd (z, x, Memd[zfit], npts)
+	        call dgsfit (sf1, x, y, Memd[zfit], wts, npts, WTS_USER, ier)
+		call dgscoeff (sf1, Memd[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff]
+		    Memd[savefit+GS_SAVECOEFF+1] = 1.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = 0.0d0
+		} else {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff] + (xmax + xmin) /
+			2.0d0
+		    Memd[savefit+GS_SAVECOEFF+1] = (xmax - xmin) / 2.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = 0.0d0
+		}
+		call dgsfree (sf1)
+		call dgsrestore (sf1, Memd[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+		sf2 = NULL
+
+	    default:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgsset (sf1, GSXREF, GM_XO(fit))
+		call dgsset (sf1, GSYREF, GM_YO(fit))
+		call dgsset (sf1, GSZREF, GM_ZO(fit))
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_XXORDER(fit) > 2 || GM_XYORDER(fit) > 2 ||
+		    GM_XXTERMS(fit) == GS_XFULL)
+	            call dgsinit (sf2, GM_FUNCTION(fit), GM_XXORDER(fit),
+		        GM_XYORDER(fit), GM_XXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+	    }
+
+	} else {
+
+	    switch (GM_FIT(fit)) {
+
+	    case GM_SHIFT:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgssave (sf1, Memd[savefit])
+		call dgsfree (sf1)
+	        call dgsinit (sf1, GM_FUNCTION(fit), 1, 1, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call asubd (z, y, Memd[zfit], npts)
+	        call dgsfit (sf1, x, y, Memd[zfit], wts, npts, WTS_USER, ier)
+		call dgscoeff (sf1, Memd[coeff], ncoeff)
+		if (GM_FUNCTION(fit) == GS_POLYNOMIAL) {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff]
+		    Memd[savefit+GS_SAVECOEFF+1] = 0.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = 1.0d0
+		} else {
+		    Memd[savefit+GS_SAVECOEFF] = Memd[coeff] + (ymin + ymax) /
+			2.0d0
+		    Memd[savefit+GS_SAVECOEFF+1] = 0.0d0
+		    Memd[savefit+GS_SAVECOEFF+2] = (ymax - ymin) / 2.0d0
+		}
+		call dgsfree (sf1)
+		call dgsrestore (sf1, Memd[savefit])
+	        sf2 = NULL
+
+	    case GM_XYSCALE:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 1, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+		sf2 = NULL
+
+	    default:
+	        call dgsinit (sf1, GM_FUNCTION(fit), 2, 2, GS_XNONE, xmin, xmax,
+	            ymin, ymax)
+		call dgsset (sf1, GSXREF, GM_XO(fit))
+		call dgsset (sf1, GSYREF, GM_YO(fit))
+		call dgsset (sf1, GSZREF, GM_ZO(fit))
+	        call dgsfit (sf1, x, y, z, wts, npts, WTS_USER, ier)
+	        if (GM_YXORDER(fit) > 2 || GM_YYORDER(fit) > 2 ||
+	            GM_YXTERMS(fit) == GS_XFULL)
+	            call dgsinit (sf2, GM_FUNCTION(fit), GM_YXORDER(fit),
+	                GM_YYORDER(fit), GM_YXTERMS(fit), xmin, xmax, ymin,
+			ymax)
+	        else 
+	            sf2 = NULL
+	    }
+	}
+
+
+	if (ier == NO_DEG_FREEDOM) {
+	    call sfree (sp)
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for X fit.")
+	            call error (1, "Too few data points for X fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for XI fit.")
+	            call error (1, "Too few data points for XI fit.")
+		}
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE) {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for Y fit.")
+	            call error (1, "Too few data points for Y fit.")
+		} else {
+	            call sprintf (errmsg, maxch,
+		        "Too few data points for ETA fit.")
+	            call error (1, "Too few data points for ETA fit.")
+		}
+	    }
+	} else if (ier == SINGULAR) {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+	            call sprintf (errmsg, maxch, "Warning singular X fit.")
+		else
+	            call sprintf (errmsg, maxch, "Warning singular XI fit.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		else
+		    call sprintf (errmsg, maxch, "Warning singular ETA fit.")
+	    }
+	} else {
+	    if (xfit == YES) {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "X fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "XI fit ok.")
+	    } else {
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call sprintf (errmsg, maxch, "Y fit ok.")
+		else
+		    call sprintf (errmsg, maxch, "ETA fit ok.")
+	    }
+	}
+
+	call dgsvector (sf1, x, y, resid, npts)
+	call asubd (z, resid, resid, npts)
+
+	# Calculate higher order fit.
+	if (sf2 != NULL) {
+	    call dgsfit (sf2, x, y, resid, wts, npts, WTS_USER, ier)
+	    if (ier == NO_DEG_FREEDOM) {
+		call sfree (sp)
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for X fit.")
+		       call error (1, "Too few data points for X fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for XI fit.")
+		       call error (1, "Too few data points for XI fit.")
+		    }
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE) {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for Y fit.")
+			call error (1, "Too few data points for Y fit.")
+		    } else {
+		       call sprintf (errmsg, maxch,
+		           "Too few data points for ETA fit.")
+			call error (1, "Too few data points for ETA fit.")
+		    }
+		}
+	    } else if (ier == SINGULAR) {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular X fit.")
+		    else
+		        call sprintf (errmsg, maxch, "Warning singular XI fit.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Warning singular Y fit.")
+		    else
+		        call sprintf (errmsg, maxch,
+			    "Warning singular ETA fit.")
+		}
+	    } else {
+		if (xfit == YES) {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "X fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "XI fit ok.")
+		} else {
+		    if (GM_PROJECTION(fit) == GM_NONE)
+		        call sprintf (errmsg, maxch, "Y fit ok.")
+		    else
+		        call sprintf (errmsg, maxch, "ETA fit ok.")
+		}
+	    }
+	    call dgsvector (sf2, x, y, Memd[zfit], npts)
+	    call asubd (resid, Memd[zfit], resid, npts)
+	}
+
+	# Compute the number of zero weighted points.
+	GM_NWTS0(fit) = 0
+	do i = 1, npts {
+	    if (wts[i] <= double(0.0))
+	        GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	}
+
+	# calculate the rms of the fit
+	if (xfit == YES) {
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + wts[i] * resid[i] ** 2
+	} else {
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+		GM_YRMS(fit) = GM_YRMS(fit) + wts[i] * resid[i] ** 2
+	}
+
+	GM_NPTS(fit) = npts
+
+	call sfree (sp)
+end
+
+
+# GEO_MREJECT -- Reject points from the fit.
+
+procedure geo_mrejectd (fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, wts,
+        xresid, yresid, npts, xerrmsg, xmaxch, yerrmsg, ymaxch) 
+
+pointer	fit		#I pointer to the fit structure
+pointer	sx1, sy1	#I pointers to the linear surface
+pointer sx2, sy2	#I pointers to the higher order surface
+double	xref[npts]	#I reference image x values
+double	yref[npts]	#I yreference values
+double	xin[npts]	#I x values
+double	yin[npts]	#I yvalues
+double	wts[npts]	#I weights
+double	xresid[npts]	#I residuals
+double	yresid[npts]	#I yresiduals
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x error message
+int	xmaxch		#I maximum number of characters in the x error message
+char	yerrmsg[ARB]	#O the output y error message
+int	ymaxch		#I maximum number of characters in the y error message
+
+int	i
+int	nreject, niter
+pointer	sp, twts
+double	cutx, cuty
+errchk	geo_fxyd(), geo_fthetad(), geo_fmagnifyd(), geo_flineard()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (twts, npts, TY_DOUBLE)
+
+	# Allocate space for the residuals.
+	if (GM_REJ(fit) != NULL)
+	    call mfree (GM_REJ(fit), TY_INT)
+	call malloc (GM_REJ(fit), npts, TY_INT)
+	GM_NREJECT(fit) = 0
+
+	# Initialize the temporary weights array and the number of rejected
+	# points.
+	call amovd (wts, Memd[twts], npts)
+	nreject = 0
+
+	niter = 0
+	repeat {
+
+	    # Compute the rejection limits.
+	    if ((npts - GM_NWTS0(fit)) > 1) {
+	        cutx = GM_REJECT(fit) * sqrt (GM_XRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	        cuty = GM_REJECT(fit) * sqrt (GM_YRMS(fit) / (npts -
+	            GM_NWTS0(fit) - 1))
+	    } else {
+	        cutx = MAX_REAL
+	        cuty = MAX_REAL
+	    }
+
+	    # Reject points from the fit.
+	    do i = 1, npts {
+	        if (Memd[twts+i-1] > 0.0 && ((abs (xresid[i]) > cutx) ||
+		    (abs (yresid[i]) > cuty))) {
+		    Memd[twts+i-1] = double(0.0)
+		    nreject = nreject + 1
+		    Memi[GM_REJ(fit)+nreject-1] = i
+	        }
+	    }
+	    if ((nreject - GM_NREJECT(fit)) <= 0)
+		break
+	    GM_NREJECT(fit) = nreject
+
+	    # Compute number of deleted points.
+	    GM_NWTS0(fit) = 0
+	    do i = 1, npts {
+		if (wts[i] <= 0.0)
+		    GM_NWTS0(fit) = GM_NWTS0(fit) + 1
+	    }
+
+	    # Recompute the X and Y fit.
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_fthetad (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memd[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memd[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flineard (fit, sx1, sy1, xref, yref, xin, yin,
+		    Memd[twts], xresid, yresid, npts, xerrmsg, xmaxch,
+		    yerrmsg, ymaxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+		GM_ZO(fit) = GM_XOREF(fit)
+	        call geo_fxyd (fit, sx1, sx2, xref, yref, xin, Memd[twts],
+	            xresid, npts, YES, xerrmsg, xmaxch)
+		GM_ZO(fit) = GM_YOREF(fit)
+	        call geo_fxyd (fit, sy1, sy2, xref, yref, yin, Memd[twts],
+	            yresid, npts, NO, yerrmsg, ymaxch)
+	    }
+
+	    # Compute the x fit rms.
+	    GM_XRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_XRMS(fit) = GM_XRMS(fit) + Memd[twts+i-1] * xresid[i] ** 2
+
+	    # Compute the y fit rms.
+	    GM_YRMS(fit) = 0.0d0
+	    do i = 1, npts
+	        GM_YRMS(fit) = GM_YRMS(fit) + Memd[twts+i-1] * yresid[i] ** 2
+
+	    niter = niter + 1
+
+	} until (niter >= GM_MAXITER(fit))
+
+	call sfree (sp)
+end
+
+
+# GEO_MMFREE - Free the space used to fit the surfaces.
+
+procedure geo_mmfreed (sx1, sy1, sx2, sy2)
+
+pointer	sx1		#U pointer to the x fits
+pointer	sy1		#U pointer to the y fit
+pointer	sx2		#U pointer to the higher order x fit
+pointer	sy2		#U pointer to the higher order y fit
+
+begin
+	if (sx1 != NULL)
+	    call dgsfree (sx1)
+	if (sy1 != NULL)
+	    call dgsfree (sy1)
+	if (sx2 != NULL)
+	    call dgsfree (sx2)
+	if (sy2 != NULL)
+	    call dgsfree (sy2)
+end
+
+
diff --git a/pkg/images/lib/geogmap.gx b/pkg/images/lib/geogmap.gx
new file mode 100644
index 00000000..e52a129e
--- /dev/null
+++ b/pkg/images/lib/geogmap.gx
@@ -0,0 +1,494 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <math.h>
+include <math/gsurfit.h>
+include	<gset.h>
+include "geomap.h"
+include "geogmap.h"
+
+define	GHELPFILE 	"images$lib/geomap.key"
+define	CHELPFILE 	"images$lib/coomap.key"
+
+$for (rd)
+
+# GEO_MGFIT -- Fit the surface using interactive graphics.
+
+procedure geo_mgfit$t (gd, fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+        yin, wts, npts, xerrmsg, yerrmsg, maxch)
+
+pointer	gd		#I graphics file descriptor
+pointer	fit		#I pointer to the fit structure
+pointer	sx1		#I pointer to the linear x surface fit
+pointer	sy1		#I pointer to the linear y surface fit
+pointer	sx2		#I pointer to higher order x surface fit
+pointer	sy2		#I pointer to higher order y surface fit
+PIXEL	xref[npts]	#I the x reference coordinates
+PIXEL	yref[npts]	#I the y reference coordinates
+PIXEL	xin[npts]	#I input x coordinates
+PIXEL	yin[npts]	#I input y coordinates
+PIXEL	wts[npts]	#I array of weights
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x fit error message 
+char	yerrmsg[ARB]	#O the output x fit error message 
+int	maxch		#I the size of the error messages
+
+char	errstr[SZ_LINE]
+int	newgraph, delete, wcs, key, errcode
+pointer	sp, w, gfit, xresid, yresid, cmd
+pointer	gt1, gt2, gt3, gt4, gt5
+real	wx, wy
+PIXEL	xshift, yshift, xscale, yscale, thetax, thetay
+
+int	clgcur(), errget()
+pointer	gt_init()
+
+errchk	geo_fxy$t(), geo_mreject$t(), geo_ftheta$t()
+errchk	geo_fmagnify$t(), geo_flinear$t()
+
+begin
+	# Initialize gfit structure and working space.
+	call smark (sp)
+	call salloc (gfit, LEN_GEOGRAPH, TY_STRUCT)
+	call salloc (xresid, npts, TY_PIXEL)
+	call salloc (yresid, npts, TY_PIXEL)
+	call salloc (w, npts, TY_PIXEL)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Do initial fit.
+	iferr {
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_ftheta$t (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Mem$t[xresid], Mem$t[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnify$t (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Mem$t[xresid], Mem$t[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flinear$t (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Mem$t[xresid], Mem$t[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+	        call geo_fxy$t (fit, sx1, sx2, xref, yref, xin, wts,
+		    Mem$t[xresid], npts, YES, xerrmsg, maxch)
+	        call geo_fxy$t (fit, sy1, sy2, xref, yref, yin, wts,
+		    Mem$t[yresid], npts, NO, yerrmsg, maxch)
+	    }
+	    if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	        GM_NREJECT(fit) = 0
+	    else
+	        call geo_mreject$t (fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+		    yin, wts, Mem$t[xresid], Mem$t[yresid], npts, xerrmsg,
+		    maxch, yerrmsg, maxch)
+	} then {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call error (2, "Too few points for X and Y fits.")
+	    else
+	        call error (2, "Too few points for XI and ETA fits.")
+	}
+
+	GG_NEWFUNCTION(gfit) = NO
+	GG_FITERROR(gfit) = NO
+	errcode = OK
+
+	# Set up plotting defaults.
+	GG_PLOTTYPE(gfit) = FIT
+	GG_OVERPLOT(gfit) = NO
+	GG_CONSTXY(gfit) = YES
+	newgraph = NO
+
+	# Allocate graphics tools.
+	gt1 = gt_init ()
+	gt2 = gt_init ()
+	gt3 = gt_init ()
+	gt4 = gt_init ()
+	gt5 = gt_init ()
+
+	# Set the plot title and x and y axis labels.
+	call geo_gtset (FIT, gt1, fit)
+	call geo_gtset (XXRESID, gt2, fit)
+	call geo_gtset (XYRESID, gt3, fit)
+	call geo_gtset (YXRESID, gt4, fit)
+	call geo_gtset (YYRESID, gt5, fit)
+
+	# Make the first plot.
+	call gclear (gd)
+	call geo_label (FIT, gt1, fit)
+	call geo_1graph$t (gd, gt1, fit, gfit, xref, yref, xin, yin, wts,
+	    npts)
+	if (GG_CONSTXY(gfit) == YES)
+	    call geo_conxy$t (gd, fit, sx1, sy1, sx2, sy2)
+	call printf ("%s  %s\n")
+	    call pargstr (xerrmsg)
+	    call pargstr (yerrmsg)
+
+	# Read the cursor commands.
+	call amov$t (wts, Mem$t[w], npts)
+	while (clgcur ("cursor", wx, wy, wcs, key, Memc[cmd], SZ_LINE) != EOF) {
+
+	    switch (key) {
+
+	    case 'q':
+		call amov$t (Mem$t[w], wts, npts)
+		break
+
+	    case '?':
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call gpagefile (gd, GHELPFILE, "")
+		else
+		    call gpagefile (gd, CHELPFILE, "")
+
+	    case ':':
+		call geo_colon (gd, fit, gfit, Memc[cmd], newgraph)
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call gt_colon (Memc[cmd], gd, gt1, newgraph)
+		case XXRESID:
+		    call gt_colon (Memc[cmd], gd, gt2, newgraph)
+		case XYRESID:
+		    call gt_colon (Memc[cmd], gd, gt3, newgraph)
+		case YXRESID:
+		    call gt_colon (Memc[cmd], gd, gt4, newgraph)
+		case YYRESID:
+		    call gt_colon (Memc[cmd], gd, gt5, newgraph)
+		}
+
+	    case 'l':
+		if (GG_FITERROR(gfit) == NO) {
+		    call geo_lcoeff$t (sx1, sy1, xshift, yshift, xscale, yscale,
+		        thetax, thetay)
+		    call printf ("xshift: %.2f yshift: %.2f ")
+		        call parg$t (xshift)
+		        call parg$t (yshift)
+		    call printf ("xmag: %0.3g ymag: %0.3g ")
+		        call parg$t (xscale)
+		        call parg$t (yscale)
+		    call printf ("xrot: %.2f yrot: %.2f\n")
+		        call parg$t (thetax)
+		        call parg$t (thetay)
+		}
+
+	    case 't':
+		if (GG_FITERROR(gfit) == NO && GG_PLOTTYPE(gfit) == FIT)
+		    call geo_lxy$t (gd, fit, sx1, sy1, sx2, sy2, xref, yref,
+		        xin, yin, npts, wx, wy)
+
+	    case 'c':
+		if (GG_CONSTXY(gfit) == YES)
+		    GG_CONSTXY(gfit) = NO
+		else if (GG_CONSTXY(gfit) == NO)
+		    GG_CONSTXY(gfit) = YES
+
+	    case 'd', 'u':
+		if (key == 'd')
+		    delete = YES
+		else
+		    delete = NO
+
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_1delete$t (gd, xin, yin, Mem$t[w], wts, npts, wx,
+		        wy, delete)
+		case XXRESID:
+		    call geo_2delete$t (gd, xref, Mem$t[xresid], Mem$t[w], wts,
+		        npts, wx, wy, delete)
+		case XYRESID:
+		    call geo_2delete$t (gd, yref, Mem$t[xresid], Mem$t[w], wts,
+		        npts, wx, wy, delete)
+		case YXRESID:
+		    call geo_2delete$t (gd, xref, Mem$t[yresid], Mem$t[w], wts,
+		        npts, wx, wy, delete)
+		case YYRESID:
+		    call geo_2delete$t (gd, yref, Mem$t[yresid], Mem$t[w], wts,
+		        npts, wx, wy, delete)
+		}
+
+		GG_NEWFUNCTION(gfit) = YES
+
+	    case 'g':
+		if (GG_PLOTTYPE(gfit) != FIT)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = FIT
+
+	    case 'x':
+		if (GG_PLOTTYPE(gfit) != XXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XXRESID
+
+	    case 'r':
+		if (GG_PLOTTYPE(gfit) != XYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XYRESID
+
+	    case 'y':
+		if (GG_PLOTTYPE(gfit) != YXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YXRESID
+
+	    case 's':
+		if (GG_PLOTTYPE(gfit) != YYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YYRESID
+
+	    case 'f':
+		# do fit
+		if (GG_NEWFUNCTION(gfit) == YES) {
+		    iferr {
+			switch (GM_FIT(fit)) {
+			case GM_ROTATE:
+		            call geo_ftheta$t (fit, sx1, sy1, xref, yref, xin,
+			        yin, Mem$t[w], Mem$t[xresid], Mem$t[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RSCALE:
+		            call geo_fmagnify$t (fit, sx1, sy1, xref, yref, xin,
+			        yin, Mem$t[w], Mem$t[xresid], Mem$t[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RXYSCALE:
+		            call geo_flinear$t (fit, sx1, sy1, xref, yref, xin,
+			        yin, Mem$t[w], Mem$t[xresid], Mem$t[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			default:
+		            call geo_fxy$t (fit, sx1, sx2, xref, yref, xin,
+			        Mem$t[w], Mem$t[xresid], npts, YES,
+				xerrmsg, maxch) 
+		            call geo_fxy$t (fit, sy1, sy2, xref, yref, yin,
+			        Mem$t[w], Mem$t[yresid], npts, NO,
+				yerrmsg, maxch) 
+			}
+		        if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+			    GM_NREJECT(fit) = 0
+		        else
+			    call geo_mreject$t (fit, sx1, sy1, sx2, sy2, xref,
+			        yref, xin, yin, Mem$t[w], Mem$t[xresid],
+				Mem$t[yresid], npts, xerrmsg, maxch,
+				yerrmsg, maxch)
+			GG_NEWFUNCTION(gfit) = NO
+			GG_FITERROR(gfit) = NO
+			errcode = OK
+		    } then {
+	    		errcode = errget (errstr, SZ_LINE)
+	    		call printf ("%s\n")
+			    call pargstr (errstr)
+			GG_FITERROR(gfit) = YES
+		    }
+		}
+
+		# plot new graph
+		if (GG_FITERROR(gfit) == YES)
+		    newgraph = NO
+		else
+		    newgraph = YES
+
+	    case 'o':
+		GG_OVERPLOT(gfit) = YES
+
+	    default:
+		call printf ("\07")
+
+	    }
+
+	    if (newgraph == YES) {
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_label (FIT, gt1, fit)
+	    	    call geo_1graph$t (gd, gt1, fit, gfit, xref, yref, xin, yin,
+		        Mem$t[w], npts)
+		    if (GG_CONSTXY(gfit) == YES)
+			call geo_conxy$t (gd, fit, sx1, sy1, sx2, sy2)
+		case XXRESID:
+		    call geo_label (XXRESID, gt2, fit)
+	    	    call geo_2graph$t (gd, gt2, fit, gfit, xref, Mem$t[xresid],
+		        Mem$t[w], npts)
+		case XYRESID:
+		    call geo_label (XYRESID, gt3, fit)
+	    	    call geo_2graph$t (gd, gt3, fit, gfit, yref, Mem$t[xresid],
+		         Mem$t[w], npts)
+		case YXRESID:
+		    call geo_label (YXRESID, gt4, fit)
+	    	    call geo_2graph$t (gd, gt4, fit, gfit, xref, Mem$t[yresid],
+		         Mem$t[w], npts)
+		case YYRESID:
+		    call geo_label (YYRESID, gt5, fit)
+	    	    call geo_2graph$t (gd, gt5, fit, gfit, yref, Mem$t[yresid],
+		         Mem$t[w], npts)
+		}
+	        call printf ("%s  %s\n")
+	    	    call pargstr (xerrmsg)
+	    	    call pargstr (yerrmsg)
+		newgraph = NO
+	    }
+	}
+
+	# Free space.
+	call gt_free (gt1)
+	call gt_free (gt2)
+	call gt_free (gt3)
+	call gt_free (gt4)
+	call gt_free (gt5)
+	call sfree (sp)
+
+	# Call an error if appropriate.
+	if (errcode > 0)
+	    call error (2, errstr)
+end
+
+# GEO_LCOEFF -- Print the coefficents of the linear portion of the
+# fit, xshift, yshift, xexpansion, yexpansion, x and y rotations.
+
+procedure geo_lcoeff$t (sx, sy, xshift, yshift, xscale, yscale, xrot, yrot)
+
+pointer sx              #I pointer to the x surface fit
+pointer sy              #I pointer to the y surface fit
+PIXEL   xshift          #O output x shift
+PIXEL   yshift          #O output y shift
+PIXEL   xscale          #O output x scale
+PIXEL   yscale          #O output y scale
+PIXEL   xrot            #O rotation of point on x axis
+PIXEL   yrot            #O rotation of point on y axis
+
+int     nxxcoeff, nxycoeff, nyxcoeff, nyycoeff
+pointer sp, xcoeff, ycoeff
+PIXEL   xxrange, xyrange, xxmaxmin, xymaxmin
+PIXEL   yxrange, yyrange, yxmaxmin, yymaxmin
+PIXEL   a, b, c, d
+
+bool    fp_equal$t()
+$if (datatype == r)
+int     gsgeti()
+real    gsgetr()
+$else
+int     dgsgeti()
+double  dgsgetd()
+$endif
+
+begin
+        # Allocate working space.
+        call smark (sp)
+$if (datatype == r)
+        call salloc (xcoeff, gsgeti (sx, GSNCOEFF), TY_PIXEL)
+        call salloc (ycoeff, gsgeti (sy, GSNCOEFF), TY_PIXEL)
+$else
+        call salloc (xcoeff, dgsgeti (sx, GSNCOEFF), TY_PIXEL)
+        call salloc (ycoeff, dgsgeti (sy, GSNCOEFF), TY_PIXEL)
+$endif
+
+        # Get coefficients and numbers of coefficients.
+$if (datatype == r)
+        call gscoeff (sx, Mem$t[xcoeff], nxxcoeff)
+        call gscoeff (sy, Mem$t[ycoeff], nyycoeff)
+        nxxcoeff = gsgeti (sx, GSNXCOEFF)
+        nxycoeff = gsgeti (sx, GSNYCOEFF)
+        nyxcoeff = gsgeti (sy, GSNXCOEFF)
+        nyycoeff = gsgeti (sy, GSNYCOEFF)
+$else
+        call dgscoeff (sx, Mem$t[xcoeff], nxxcoeff)
+        call dgscoeff (sy, Mem$t[ycoeff], nyycoeff)
+        nxxcoeff = dgsgeti (sx, GSNXCOEFF)
+        nxycoeff = dgsgeti (sx, GSNYCOEFF)
+        nyxcoeff = dgsgeti (sy, GSNXCOEFF)
+        nyycoeff = dgsgeti (sy, GSNYCOEFF)
+$endif
+
+        # Get the data range.
+$if (datatype == r)
+        if (gsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+            xxrange = (gsgetr (sx, GSXMAX) - gsgetr (sx, GSXMIN)) / 2.0
+            xxmaxmin = - (gsgetr (sx, GSXMAX) + gsgetr (sx, GSXMIN)) / 2.0
+            xyrange = (gsgetr (sx, GSYMAX) - gsgetr (sx, GSYMIN)) / 2.0
+            xymaxmin = - (gsgetr (sx, GSYMAX) + gsgetr (sx, GSYMIN)) / 2.0
+$else
+        if (dgsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+            xxrange = (dgsgetd (sx, GSXMAX) - dgsgetd (sx, GSXMIN)) / 2.0d0
+            xxmaxmin = - (dgsgetd (sx, GSXMAX) + dgsgetd (sx, GSXMIN)) / 2.0d0
+            xyrange = (dgsgetd (sx, GSYMAX) - dgsgetd (sx, GSYMIN)) / 2.0d0
+            xymaxmin = - (dgsgetd (sx, GSYMAX) + dgsgetd (sx, GSYMIN)) / 2.0d0
+$endif
+        } else {
+            xxrange = PIXEL(1.0)
+            xxmaxmin = PIXEL(0.0)
+            xyrange = PIXEL(1.0)
+            xymaxmin = PIXEL(0.0)
+        }
+
+$if (datatype == r)
+        if (gsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+            yxrange = (gsgetr (sy, GSXMAX) - gsgetr (sy, GSXMIN)) / 2.0
+            yxmaxmin = - (gsgetr (sy, GSXMAX) + gsgetr (sy, GSXMIN)) / 2.0
+            yyrange = (gsgetr (sy, GSYMAX) - gsgetr (sy, GSYMIN)) / 2.0
+            yymaxmin = - (gsgetr (sy, GSYMAX) + gsgetr (sy, GSYMIN)) / 2.0
+$else
+        if (dgsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+            yxrange = (dgsgetd (sy, GSXMAX) - dgsgetd (sy, GSXMIN)) / 2.0d0
+            yxmaxmin = - (dgsgetd (sy, GSXMAX) + dgsgetd (sy, GSXMIN)) / 2.0d0
+            yyrange = (dgsgetd (sy, GSYMAX) - dgsgetd (sy, GSYMIN)) / 2.0d0
+            yymaxmin = - (dgsgetd (sy, GSYMAX) + dgsgetd (sy, GSYMIN)) / 2.0d0
+$endif
+        } else {
+            yxrange = PIXEL(1.0)
+            yxmaxmin = PIXEL(0.0)
+            yyrange = PIXEL(1.0)
+            yymaxmin = PIXEL(0.0)
+        }
+
+        # Get the shifts.
+        xshift = Mem$t[xcoeff] + Mem$t[xcoeff+1] * xxmaxmin / xxrange +
+            Mem$t[xcoeff+2] * xymaxmin / xyrange
+        yshift = Mem$t[ycoeff] + Mem$t[ycoeff+1] * yxmaxmin / yxrange +
+            Mem$t[ycoeff+2] * yymaxmin / yyrange
+
+        # Get the rotation and scaling parameters and correct for normalization.
+        if (nxxcoeff > 1)
+            a = Mem$t[xcoeff+1] / xxrange
+        else
+            a = PIXEL(0.0)
+        if (nxycoeff > 1)
+            b = Mem$t[xcoeff+nxxcoeff] / xyrange
+        else
+            b = PIXEL(0.0)
+        if (nyxcoeff > 1)
+            c = Mem$t[ycoeff+1] / yxrange
+        else
+            c = PIXEL(0.0)
+        if (nyycoeff > 1)
+            d = Mem$t[ycoeff+nyxcoeff] / yyrange
+        else
+            d = PIXEL(0.0)
+
+        # Get the magnification factors.
+        xscale = sqrt (a * a + c * c)
+        yscale = sqrt (b * b + d * d)
+
+        # Get the x and y axes rotation factors.
+        if (fp_equal$t (a, PIXEL(0.0)) && fp_equal$t (c, PIXEL(0.0)))
+            xrot = PIXEL(0.0)
+        else
+            xrot = RADTODEG (atan2 (-c, a))
+        if (xrot < PIXEL(0.0))
+            xrot = xrot + PIXEL(360.0)
+
+        if (fp_equal$t (b, PIXEL(0.0)) && fp_equal$t (d, PIXEL(0.0)))
+            yrot = PIXEL(0.0)
+        else
+            yrot = RADTODEG (atan2 (b, d))
+        if (yrot < PIXEL(0.0))
+            yrot = yrot + PIXEL(360.0)
+
+        call sfree (sp)
+end
+
+$endfor
diff --git a/pkg/images/lib/geogmap.h b/pkg/images/lib/geogmap.h
new file mode 100644
index 00000000..7efc3658
--- /dev/null
+++ b/pkg/images/lib/geogmap.h
@@ -0,0 +1,37 @@
+# Structure definitions for fitting surface graphically
+
+define	LEN_GEOGRAPH	10
+
+define	GG_NEWFUNCTION		Memi[$1]	# New function
+define	GG_PLOTTYPE		Memi[$1+1]	# Type of plot
+define	GG_OVERPLOT		Memi[$1+2]	# Overplot previous graph?
+define	GG_FITERROR		Memi[$1+3]	# Error fitting x function
+define	GG_CONSTXY		Memi[$1+4]	# Plot lines of constant x-y
+
+# define plot types
+
+define	FIT		1		# plot x y fit
+define	XXRESID		2		# x fit residuals versus x
+define	XYRESID		3		# x fit residuals versus y
+define	YXRESID		4		# y fit residuals versus x
+define	YYRESID		5		# y fit residuals versus y
+
+# define the permitted colon commands
+
+define  GM_CMDS         "|show|projection|refpoint|fitgeometry|function|\
+order|xxorder|xyorder|yxorder|yyorder|xxterms|yxterms|reject|maxiter|"
+
+define  GMCMD_SHOW      	1
+define	GMCMD_PROJECTION	2
+define	GMCMD_REFPOINT		3
+define  GMCMD_GEOMETRY  	4
+define  GMCMD_FUNCTION  	5
+define  GMCMD_ORDER  		6
+define  GMCMD_XXORDER   	7
+define  GMCMD_XYORDER   	8
+define  GMCMD_YXORDER   	9
+define  GMCMD_YYORDER   	10
+define  GMCMD_XXTERMS   	11
+define  GMCMD_YXTERMS   	12
+define  GMCMD_REJECT    	13
+define  GMCMD_MAXITER    	14
diff --git a/pkg/images/lib/geogmap.x b/pkg/images/lib/geogmap.x
new file mode 100644
index 00000000..9dc63610
--- /dev/null
+++ b/pkg/images/lib/geogmap.x
@@ -0,0 +1,905 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <math.h>
+include <math/gsurfit.h>
+include	<gset.h>
+include "geomap.h"
+include "geogmap.h"
+
+define	GHELPFILE 	"images$lib/geomap.key"
+define	CHELPFILE 	"images$lib/coomap.key"
+
+
+
+# GEO_MGFIT -- Fit the surface using interactive graphics.
+
+procedure geo_mgfitr (gd, fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+        yin, wts, npts, xerrmsg, yerrmsg, maxch)
+
+pointer	gd		#I graphics file descriptor
+pointer	fit		#I pointer to the fit structure
+pointer	sx1		#I pointer to the linear x surface fit
+pointer	sy1		#I pointer to the linear y surface fit
+pointer	sx2		#I pointer to higher order x surface fit
+pointer	sy2		#I pointer to higher order y surface fit
+real	xref[npts]	#I the x reference coordinates
+real	yref[npts]	#I the y reference coordinates
+real	xin[npts]	#I input x coordinates
+real	yin[npts]	#I input y coordinates
+real	wts[npts]	#I array of weights
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x fit error message 
+char	yerrmsg[ARB]	#O the output x fit error message 
+int	maxch		#I the size of the error messages
+
+char	errstr[SZ_LINE]
+int	newgraph, delete, wcs, key, errcode
+pointer	sp, w, gfit, xresid, yresid, cmd
+pointer	gt1, gt2, gt3, gt4, gt5
+real	wx, wy
+real	xshift, yshift, xscale, yscale, thetax, thetay
+
+int	clgcur(), errget()
+pointer	gt_init()
+
+errchk	geo_fxyr(), geo_mrejectr(), geo_fthetar()
+errchk	geo_fmagnifyr(), geo_flinearr()
+
+begin
+	# Initialize gfit structure and working space.
+	call smark (sp)
+	call salloc (gfit, LEN_GEOGRAPH, TY_STRUCT)
+	call salloc (xresid, npts, TY_REAL)
+	call salloc (yresid, npts, TY_REAL)
+	call salloc (w, npts, TY_REAL)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Do initial fit.
+	iferr {
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_fthetar (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memr[xresid], Memr[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memr[xresid], Memr[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flinearr (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memr[xresid], Memr[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+	        call geo_fxyr (fit, sx1, sx2, xref, yref, xin, wts,
+		    Memr[xresid], npts, YES, xerrmsg, maxch)
+	        call geo_fxyr (fit, sy1, sy2, xref, yref, yin, wts,
+		    Memr[yresid], npts, NO, yerrmsg, maxch)
+	    }
+	    if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	        GM_NREJECT(fit) = 0
+	    else
+	        call geo_mrejectr (fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+		    yin, wts, Memr[xresid], Memr[yresid], npts, xerrmsg,
+		    maxch, yerrmsg, maxch)
+	} then {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call error (2, "Too few points for X and Y fits.")
+	    else
+	        call error (2, "Too few points for XI and ETA fits.")
+	}
+
+	GG_NEWFUNCTION(gfit) = NO
+	GG_FITERROR(gfit) = NO
+	errcode = OK
+
+	# Set up plotting defaults.
+	GG_PLOTTYPE(gfit) = FIT
+	GG_OVERPLOT(gfit) = NO
+	GG_CONSTXY(gfit) = YES
+	newgraph = NO
+
+	# Allocate graphics tools.
+	gt1 = gt_init ()
+	gt2 = gt_init ()
+	gt3 = gt_init ()
+	gt4 = gt_init ()
+	gt5 = gt_init ()
+
+	# Set the plot title and x and y axis labels.
+	call geo_gtset (FIT, gt1, fit)
+	call geo_gtset (XXRESID, gt2, fit)
+	call geo_gtset (XYRESID, gt3, fit)
+	call geo_gtset (YXRESID, gt4, fit)
+	call geo_gtset (YYRESID, gt5, fit)
+
+	# Make the first plot.
+	call gclear (gd)
+	call geo_label (FIT, gt1, fit)
+	call geo_1graphr (gd, gt1, fit, gfit, xref, yref, xin, yin, wts,
+	    npts)
+	if (GG_CONSTXY(gfit) == YES)
+	    call geo_conxyr (gd, fit, sx1, sy1, sx2, sy2)
+	call printf ("%s  %s\n")
+	    call pargstr (xerrmsg)
+	    call pargstr (yerrmsg)
+
+	# Read the cursor commands.
+	call amovr (wts, Memr[w], npts)
+	while (clgcur ("cursor", wx, wy, wcs, key, Memc[cmd], SZ_LINE) != EOF) {
+
+	    switch (key) {
+
+	    case 'q':
+		call amovr (Memr[w], wts, npts)
+		break
+
+	    case '?':
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call gpagefile (gd, GHELPFILE, "")
+		else
+		    call gpagefile (gd, CHELPFILE, "")
+
+	    case ':':
+		call geo_colon (gd, fit, gfit, Memc[cmd], newgraph)
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call gt_colon (Memc[cmd], gd, gt1, newgraph)
+		case XXRESID:
+		    call gt_colon (Memc[cmd], gd, gt2, newgraph)
+		case XYRESID:
+		    call gt_colon (Memc[cmd], gd, gt3, newgraph)
+		case YXRESID:
+		    call gt_colon (Memc[cmd], gd, gt4, newgraph)
+		case YYRESID:
+		    call gt_colon (Memc[cmd], gd, gt5, newgraph)
+		}
+
+	    case 'l':
+		if (GG_FITERROR(gfit) == NO) {
+		    call geo_lcoeffr (sx1, sy1, xshift, yshift, xscale, yscale,
+		        thetax, thetay)
+		    call printf ("xshift: %.2f yshift: %.2f ")
+		        call pargr (xshift)
+		        call pargr (yshift)
+		    call printf ("xmag: %0.3g ymag: %0.3g ")
+		        call pargr (xscale)
+		        call pargr (yscale)
+		    call printf ("xrot: %.2f yrot: %.2f\n")
+		        call pargr (thetax)
+		        call pargr (thetay)
+		}
+
+	    case 't':
+		if (GG_FITERROR(gfit) == NO && GG_PLOTTYPE(gfit) == FIT)
+		    call geo_lxyr (gd, fit, sx1, sy1, sx2, sy2, xref, yref,
+		        xin, yin, npts, wx, wy)
+
+	    case 'c':
+		if (GG_CONSTXY(gfit) == YES)
+		    GG_CONSTXY(gfit) = NO
+		else if (GG_CONSTXY(gfit) == NO)
+		    GG_CONSTXY(gfit) = YES
+
+	    case 'd', 'u':
+		if (key == 'd')
+		    delete = YES
+		else
+		    delete = NO
+
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_1deleter (gd, xin, yin, Memr[w], wts, npts, wx,
+		        wy, delete)
+		case XXRESID:
+		    call geo_2deleter (gd, xref, Memr[xresid], Memr[w], wts,
+		        npts, wx, wy, delete)
+		case XYRESID:
+		    call geo_2deleter (gd, yref, Memr[xresid], Memr[w], wts,
+		        npts, wx, wy, delete)
+		case YXRESID:
+		    call geo_2deleter (gd, xref, Memr[yresid], Memr[w], wts,
+		        npts, wx, wy, delete)
+		case YYRESID:
+		    call geo_2deleter (gd, yref, Memr[yresid], Memr[w], wts,
+		        npts, wx, wy, delete)
+		}
+
+		GG_NEWFUNCTION(gfit) = YES
+
+	    case 'g':
+		if (GG_PLOTTYPE(gfit) != FIT)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = FIT
+
+	    case 'x':
+		if (GG_PLOTTYPE(gfit) != XXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XXRESID
+
+	    case 'r':
+		if (GG_PLOTTYPE(gfit) != XYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XYRESID
+
+	    case 'y':
+		if (GG_PLOTTYPE(gfit) != YXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YXRESID
+
+	    case 's':
+		if (GG_PLOTTYPE(gfit) != YYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YYRESID
+
+	    case 'f':
+		# do fit
+		if (GG_NEWFUNCTION(gfit) == YES) {
+		    iferr {
+			switch (GM_FIT(fit)) {
+			case GM_ROTATE:
+		            call geo_fthetar (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memr[w], Memr[xresid], Memr[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RSCALE:
+		            call geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memr[w], Memr[xresid], Memr[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RXYSCALE:
+		            call geo_flinearr (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memr[w], Memr[xresid], Memr[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			default:
+		            call geo_fxyr (fit, sx1, sx2, xref, yref, xin,
+			        Memr[w], Memr[xresid], npts, YES,
+				xerrmsg, maxch) 
+		            call geo_fxyr (fit, sy1, sy2, xref, yref, yin,
+			        Memr[w], Memr[yresid], npts, NO,
+				yerrmsg, maxch) 
+			}
+		        if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+			    GM_NREJECT(fit) = 0
+		        else
+			    call geo_mrejectr (fit, sx1, sy1, sx2, sy2, xref,
+			        yref, xin, yin, Memr[w], Memr[xresid],
+				Memr[yresid], npts, xerrmsg, maxch,
+				yerrmsg, maxch)
+			GG_NEWFUNCTION(gfit) = NO
+			GG_FITERROR(gfit) = NO
+			errcode = OK
+		    } then {
+	    		errcode = errget (errstr, SZ_LINE)
+	    		call printf ("%s\n")
+			    call pargstr (errstr)
+			GG_FITERROR(gfit) = YES
+		    }
+		}
+
+		# plot new graph
+		if (GG_FITERROR(gfit) == YES)
+		    newgraph = NO
+		else
+		    newgraph = YES
+
+	    case 'o':
+		GG_OVERPLOT(gfit) = YES
+
+	    default:
+		call printf ("\07")
+
+	    }
+
+	    if (newgraph == YES) {
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_label (FIT, gt1, fit)
+	    	    call geo_1graphr (gd, gt1, fit, gfit, xref, yref, xin, yin,
+		        Memr[w], npts)
+		    if (GG_CONSTXY(gfit) == YES)
+			call geo_conxyr (gd, fit, sx1, sy1, sx2, sy2)
+		case XXRESID:
+		    call geo_label (XXRESID, gt2, fit)
+	    	    call geo_2graphr (gd, gt2, fit, gfit, xref, Memr[xresid],
+		        Memr[w], npts)
+		case XYRESID:
+		    call geo_label (XYRESID, gt3, fit)
+	    	    call geo_2graphr (gd, gt3, fit, gfit, yref, Memr[xresid],
+		         Memr[w], npts)
+		case YXRESID:
+		    call geo_label (YXRESID, gt4, fit)
+	    	    call geo_2graphr (gd, gt4, fit, gfit, xref, Memr[yresid],
+		         Memr[w], npts)
+		case YYRESID:
+		    call geo_label (YYRESID, gt5, fit)
+	    	    call geo_2graphr (gd, gt5, fit, gfit, yref, Memr[yresid],
+		         Memr[w], npts)
+		}
+	        call printf ("%s  %s\n")
+	    	    call pargstr (xerrmsg)
+	    	    call pargstr (yerrmsg)
+		newgraph = NO
+	    }
+	}
+
+	# Free space.
+	call gt_free (gt1)
+	call gt_free (gt2)
+	call gt_free (gt3)
+	call gt_free (gt4)
+	call gt_free (gt5)
+	call sfree (sp)
+
+	# Call an error if appropriate.
+	if (errcode > 0)
+	    call error (2, errstr)
+end
+
+# GEO_LCOEFF -- Print the coefficents of the linear portion of the
+# fit, xshift, yshift, xexpansion, yexpansion, x and y rotations.
+
+procedure geo_lcoeffr (sx, sy, xshift, yshift, xscale, yscale, xrot, yrot)
+
+pointer sx              #I pointer to the x surface fit
+pointer sy              #I pointer to the y surface fit
+real   xshift          #O output x shift
+real   yshift          #O output y shift
+real   xscale          #O output x scale
+real   yscale          #O output y scale
+real   xrot            #O rotation of point on x axis
+real   yrot            #O rotation of point on y axis
+
+int     nxxcoeff, nxycoeff, nyxcoeff, nyycoeff
+pointer sp, xcoeff, ycoeff
+real   xxrange, xyrange, xxmaxmin, xymaxmin
+real   yxrange, yyrange, yxmaxmin, yymaxmin
+real   a, b, c, d
+
+bool    fp_equalr()
+int     gsgeti()
+real    gsgetr()
+
+begin
+        # Allocate working space.
+        call smark (sp)
+        call salloc (xcoeff, gsgeti (sx, GSNCOEFF), TY_REAL)
+        call salloc (ycoeff, gsgeti (sy, GSNCOEFF), TY_REAL)
+
+        # Get coefficients and numbers of coefficients.
+        call gscoeff (sx, Memr[xcoeff], nxxcoeff)
+        call gscoeff (sy, Memr[ycoeff], nyycoeff)
+        nxxcoeff = gsgeti (sx, GSNXCOEFF)
+        nxycoeff = gsgeti (sx, GSNYCOEFF)
+        nyxcoeff = gsgeti (sy, GSNXCOEFF)
+        nyycoeff = gsgeti (sy, GSNYCOEFF)
+
+        # Get the data range.
+        if (gsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+            xxrange = (gsgetr (sx, GSXMAX) - gsgetr (sx, GSXMIN)) / 2.0
+            xxmaxmin = - (gsgetr (sx, GSXMAX) + gsgetr (sx, GSXMIN)) / 2.0
+            xyrange = (gsgetr (sx, GSYMAX) - gsgetr (sx, GSYMIN)) / 2.0
+            xymaxmin = - (gsgetr (sx, GSYMAX) + gsgetr (sx, GSYMIN)) / 2.0
+        } else {
+            xxrange = real(1.0)
+            xxmaxmin = real(0.0)
+            xyrange = real(1.0)
+            xymaxmin = real(0.0)
+        }
+
+        if (gsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+            yxrange = (gsgetr (sy, GSXMAX) - gsgetr (sy, GSXMIN)) / 2.0
+            yxmaxmin = - (gsgetr (sy, GSXMAX) + gsgetr (sy, GSXMIN)) / 2.0
+            yyrange = (gsgetr (sy, GSYMAX) - gsgetr (sy, GSYMIN)) / 2.0
+            yymaxmin = - (gsgetr (sy, GSYMAX) + gsgetr (sy, GSYMIN)) / 2.0
+        } else {
+            yxrange = real(1.0)
+            yxmaxmin = real(0.0)
+            yyrange = real(1.0)
+            yymaxmin = real(0.0)
+        }
+
+        # Get the shifts.
+        xshift = Memr[xcoeff] + Memr[xcoeff+1] * xxmaxmin / xxrange +
+            Memr[xcoeff+2] * xymaxmin / xyrange
+        yshift = Memr[ycoeff] + Memr[ycoeff+1] * yxmaxmin / yxrange +
+            Memr[ycoeff+2] * yymaxmin / yyrange
+
+        # Get the rotation and scaling parameters and correct for normalization.
+        if (nxxcoeff > 1)
+            a = Memr[xcoeff+1] / xxrange
+        else
+            a = real(0.0)
+        if (nxycoeff > 1)
+            b = Memr[xcoeff+nxxcoeff] / xyrange
+        else
+            b = real(0.0)
+        if (nyxcoeff > 1)
+            c = Memr[ycoeff+1] / yxrange
+        else
+            c = real(0.0)
+        if (nyycoeff > 1)
+            d = Memr[ycoeff+nyxcoeff] / yyrange
+        else
+            d = real(0.0)
+
+        # Get the magnification factors.
+        xscale = sqrt (a * a + c * c)
+        yscale = sqrt (b * b + d * d)
+
+        # Get the x and y axes rotation factors.
+        if (fp_equalr (a, real(0.0)) && fp_equalr (c, real(0.0)))
+            xrot = real(0.0)
+        else
+            xrot = RADTODEG (atan2 (-c, a))
+        if (xrot < real(0.0))
+            xrot = xrot + real(360.0)
+
+        if (fp_equalr (b, real(0.0)) && fp_equalr (d, real(0.0)))
+            yrot = real(0.0)
+        else
+            yrot = RADTODEG (atan2 (b, d))
+        if (yrot < real(0.0))
+            yrot = yrot + real(360.0)
+
+        call sfree (sp)
+end
+
+
+
+# GEO_MGFIT -- Fit the surface using interactive graphics.
+
+procedure geo_mgfitd (gd, fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+        yin, wts, npts, xerrmsg, yerrmsg, maxch)
+
+pointer	gd		#I graphics file descriptor
+pointer	fit		#I pointer to the fit structure
+pointer	sx1		#I pointer to the linear x surface fit
+pointer	sy1		#I pointer to the linear y surface fit
+pointer	sx2		#I pointer to higher order x surface fit
+pointer	sy2		#I pointer to higher order y surface fit
+double	xref[npts]	#I the x reference coordinates
+double	yref[npts]	#I the y reference coordinates
+double	xin[npts]	#I input x coordinates
+double	yin[npts]	#I input y coordinates
+double	wts[npts]	#I array of weights
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x fit error message 
+char	yerrmsg[ARB]	#O the output x fit error message 
+int	maxch		#I the size of the error messages
+
+char	errstr[SZ_LINE]
+int	newgraph, delete, wcs, key, errcode
+pointer	sp, w, gfit, xresid, yresid, cmd
+pointer	gt1, gt2, gt3, gt4, gt5
+real	wx, wy
+double	xshift, yshift, xscale, yscale, thetax, thetay
+
+int	clgcur(), errget()
+pointer	gt_init()
+
+errchk	geo_fxyd(), geo_mrejectd(), geo_fthetad()
+errchk	geo_fmagnifyd(), geo_flineard()
+
+begin
+	# Initialize gfit structure and working space.
+	call smark (sp)
+	call salloc (gfit, LEN_GEOGRAPH, TY_STRUCT)
+	call salloc (xresid, npts, TY_DOUBLE)
+	call salloc (yresid, npts, TY_DOUBLE)
+	call salloc (w, npts, TY_DOUBLE)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Do initial fit.
+	iferr {
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_fthetad (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memd[xresid], Memd[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memd[xresid], Memd[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flineard (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memd[xresid], Memd[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+	        call geo_fxyd (fit, sx1, sx2, xref, yref, xin, wts,
+		    Memd[xresid], npts, YES, xerrmsg, maxch)
+	        call geo_fxyd (fit, sy1, sy2, xref, yref, yin, wts,
+		    Memd[yresid], npts, NO, yerrmsg, maxch)
+	    }
+	    if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	        GM_NREJECT(fit) = 0
+	    else
+	        call geo_mrejectd (fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+		    yin, wts, Memd[xresid], Memd[yresid], npts, xerrmsg,
+		    maxch, yerrmsg, maxch)
+	} then {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call error (2, "Too few points for X and Y fits.")
+	    else
+	        call error (2, "Too few points for XI and ETA fits.")
+	}
+
+	GG_NEWFUNCTION(gfit) = NO
+	GG_FITERROR(gfit) = NO
+	errcode = OK
+
+	# Set up plotting defaults.
+	GG_PLOTTYPE(gfit) = FIT
+	GG_OVERPLOT(gfit) = NO
+	GG_CONSTXY(gfit) = YES
+	newgraph = NO
+
+	# Allocate graphics tools.
+	gt1 = gt_init ()
+	gt2 = gt_init ()
+	gt3 = gt_init ()
+	gt4 = gt_init ()
+	gt5 = gt_init ()
+
+	# Set the plot title and x and y axis labels.
+	call geo_gtset (FIT, gt1, fit)
+	call geo_gtset (XXRESID, gt2, fit)
+	call geo_gtset (XYRESID, gt3, fit)
+	call geo_gtset (YXRESID, gt4, fit)
+	call geo_gtset (YYRESID, gt5, fit)
+
+	# Make the first plot.
+	call gclear (gd)
+	call geo_label (FIT, gt1, fit)
+	call geo_1graphd (gd, gt1, fit, gfit, xref, yref, xin, yin, wts,
+	    npts)
+	if (GG_CONSTXY(gfit) == YES)
+	    call geo_conxyd (gd, fit, sx1, sy1, sx2, sy2)
+	call printf ("%s  %s\n")
+	    call pargstr (xerrmsg)
+	    call pargstr (yerrmsg)
+
+	# Read the cursor commands.
+	call amovd (wts, Memd[w], npts)
+	while (clgcur ("cursor", wx, wy, wcs, key, Memc[cmd], SZ_LINE) != EOF) {
+
+	    switch (key) {
+
+	    case 'q':
+		call amovd (Memd[w], wts, npts)
+		break
+
+	    case '?':
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call gpagefile (gd, GHELPFILE, "")
+		else
+		    call gpagefile (gd, CHELPFILE, "")
+
+	    case ':':
+		call geo_colon (gd, fit, gfit, Memc[cmd], newgraph)
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call gt_colon (Memc[cmd], gd, gt1, newgraph)
+		case XXRESID:
+		    call gt_colon (Memc[cmd], gd, gt2, newgraph)
+		case XYRESID:
+		    call gt_colon (Memc[cmd], gd, gt3, newgraph)
+		case YXRESID:
+		    call gt_colon (Memc[cmd], gd, gt4, newgraph)
+		case YYRESID:
+		    call gt_colon (Memc[cmd], gd, gt5, newgraph)
+		}
+
+	    case 'l':
+		if (GG_FITERROR(gfit) == NO) {
+		    call geo_lcoeffd (sx1, sy1, xshift, yshift, xscale, yscale,
+		        thetax, thetay)
+		    call printf ("xshift: %.2f yshift: %.2f ")
+		        call pargd (xshift)
+		        call pargd (yshift)
+		    call printf ("xmag: %0.3g ymag: %0.3g ")
+		        call pargd (xscale)
+		        call pargd (yscale)
+		    call printf ("xrot: %.2f yrot: %.2f\n")
+		        call pargd (thetax)
+		        call pargd (thetay)
+		}
+
+	    case 't':
+		if (GG_FITERROR(gfit) == NO && GG_PLOTTYPE(gfit) == FIT)
+		    call geo_lxyd (gd, fit, sx1, sy1, sx2, sy2, xref, yref,
+		        xin, yin, npts, wx, wy)
+
+	    case 'c':
+		if (GG_CONSTXY(gfit) == YES)
+		    GG_CONSTXY(gfit) = NO
+		else if (GG_CONSTXY(gfit) == NO)
+		    GG_CONSTXY(gfit) = YES
+
+	    case 'd', 'u':
+		if (key == 'd')
+		    delete = YES
+		else
+		    delete = NO
+
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_1deleted (gd, xin, yin, Memd[w], wts, npts, wx,
+		        wy, delete)
+		case XXRESID:
+		    call geo_2deleted (gd, xref, Memd[xresid], Memd[w], wts,
+		        npts, wx, wy, delete)
+		case XYRESID:
+		    call geo_2deleted (gd, yref, Memd[xresid], Memd[w], wts,
+		        npts, wx, wy, delete)
+		case YXRESID:
+		    call geo_2deleted (gd, xref, Memd[yresid], Memd[w], wts,
+		        npts, wx, wy, delete)
+		case YYRESID:
+		    call geo_2deleted (gd, yref, Memd[yresid], Memd[w], wts,
+		        npts, wx, wy, delete)
+		}
+
+		GG_NEWFUNCTION(gfit) = YES
+
+	    case 'g':
+		if (GG_PLOTTYPE(gfit) != FIT)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = FIT
+
+	    case 'x':
+		if (GG_PLOTTYPE(gfit) != XXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XXRESID
+
+	    case 'r':
+		if (GG_PLOTTYPE(gfit) != XYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XYRESID
+
+	    case 'y':
+		if (GG_PLOTTYPE(gfit) != YXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YXRESID
+
+	    case 's':
+		if (GG_PLOTTYPE(gfit) != YYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YYRESID
+
+	    case 'f':
+		# do fit
+		if (GG_NEWFUNCTION(gfit) == YES) {
+		    iferr {
+			switch (GM_FIT(fit)) {
+			case GM_ROTATE:
+		            call geo_fthetad (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memd[w], Memd[xresid], Memd[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RSCALE:
+		            call geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memd[w], Memd[xresid], Memd[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RXYSCALE:
+		            call geo_flineard (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memd[w], Memd[xresid], Memd[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			default:
+		            call geo_fxyd (fit, sx1, sx2, xref, yref, xin,
+			        Memd[w], Memd[xresid], npts, YES,
+				xerrmsg, maxch) 
+		            call geo_fxyd (fit, sy1, sy2, xref, yref, yin,
+			        Memd[w], Memd[yresid], npts, NO,
+				yerrmsg, maxch) 
+			}
+		        if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+			    GM_NREJECT(fit) = 0
+		        else
+			    call geo_mrejectd (fit, sx1, sy1, sx2, sy2, xref,
+			        yref, xin, yin, Memd[w], Memd[xresid],
+				Memd[yresid], npts, xerrmsg, maxch,
+				yerrmsg, maxch)
+			GG_NEWFUNCTION(gfit) = NO
+			GG_FITERROR(gfit) = NO
+			errcode = OK
+		    } then {
+	    		errcode = errget (errstr, SZ_LINE)
+	    		call printf ("%s\n")
+			    call pargstr (errstr)
+			GG_FITERROR(gfit) = YES
+		    }
+		}
+
+		# plot new graph
+		if (GG_FITERROR(gfit) == YES)
+		    newgraph = NO
+		else
+		    newgraph = YES
+
+	    case 'o':
+		GG_OVERPLOT(gfit) = YES
+
+	    default:
+		call printf ("\07")
+
+	    }
+
+	    if (newgraph == YES) {
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_label (FIT, gt1, fit)
+	    	    call geo_1graphd (gd, gt1, fit, gfit, xref, yref, xin, yin,
+		        Memd[w], npts)
+		    if (GG_CONSTXY(gfit) == YES)
+			call geo_conxyd (gd, fit, sx1, sy1, sx2, sy2)
+		case XXRESID:
+		    call geo_label (XXRESID, gt2, fit)
+	    	    call geo_2graphd (gd, gt2, fit, gfit, xref, Memd[xresid],
+		        Memd[w], npts)
+		case XYRESID:
+		    call geo_label (XYRESID, gt3, fit)
+	    	    call geo_2graphd (gd, gt3, fit, gfit, yref, Memd[xresid],
+		         Memd[w], npts)
+		case YXRESID:
+		    call geo_label (YXRESID, gt4, fit)
+	    	    call geo_2graphd (gd, gt4, fit, gfit, xref, Memd[yresid],
+		         Memd[w], npts)
+		case YYRESID:
+		    call geo_label (YYRESID, gt5, fit)
+	    	    call geo_2graphd (gd, gt5, fit, gfit, yref, Memd[yresid],
+		         Memd[w], npts)
+		}
+	        call printf ("%s  %s\n")
+	    	    call pargstr (xerrmsg)
+	    	    call pargstr (yerrmsg)
+		newgraph = NO
+	    }
+	}
+
+	# Free space.
+	call gt_free (gt1)
+	call gt_free (gt2)
+	call gt_free (gt3)
+	call gt_free (gt4)
+	call gt_free (gt5)
+	call sfree (sp)
+
+	# Call an error if appropriate.
+	if (errcode > 0)
+	    call error (2, errstr)
+end
+
+# GEO_LCOEFF -- Print the coefficents of the linear portion of the
+# fit, xshift, yshift, xexpansion, yexpansion, x and y rotations.
+
+procedure geo_lcoeffd (sx, sy, xshift, yshift, xscale, yscale, xrot, yrot)
+
+pointer sx              #I pointer to the x surface fit
+pointer sy              #I pointer to the y surface fit
+double   xshift          #O output x shift
+double   yshift          #O output y shift
+double   xscale          #O output x scale
+double   yscale          #O output y scale
+double   xrot            #O rotation of point on x axis
+double   yrot            #O rotation of point on y axis
+
+int     nxxcoeff, nxycoeff, nyxcoeff, nyycoeff
+pointer sp, xcoeff, ycoeff
+double   xxrange, xyrange, xxmaxmin, xymaxmin
+double   yxrange, yyrange, yxmaxmin, yymaxmin
+double   a, b, c, d
+
+bool    fp_equald()
+int     dgsgeti()
+double  dgsgetd()
+
+begin
+        # Allocate working space.
+        call smark (sp)
+        call salloc (xcoeff, dgsgeti (sx, GSNCOEFF), TY_DOUBLE)
+        call salloc (ycoeff, dgsgeti (sy, GSNCOEFF), TY_DOUBLE)
+
+        # Get coefficients and numbers of coefficients.
+        call dgscoeff (sx, Memd[xcoeff], nxxcoeff)
+        call dgscoeff (sy, Memd[ycoeff], nyycoeff)
+        nxxcoeff = dgsgeti (sx, GSNXCOEFF)
+        nxycoeff = dgsgeti (sx, GSNYCOEFF)
+        nyxcoeff = dgsgeti (sy, GSNXCOEFF)
+        nyycoeff = dgsgeti (sy, GSNYCOEFF)
+
+        # Get the data range.
+        if (dgsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+            xxrange = (dgsgetd (sx, GSXMAX) - dgsgetd (sx, GSXMIN)) / 2.0d0
+            xxmaxmin = - (dgsgetd (sx, GSXMAX) + dgsgetd (sx, GSXMIN)) / 2.0d0
+            xyrange = (dgsgetd (sx, GSYMAX) - dgsgetd (sx, GSYMIN)) / 2.0d0
+            xymaxmin = - (dgsgetd (sx, GSYMAX) + dgsgetd (sx, GSYMIN)) / 2.0d0
+        } else {
+            xxrange = double(1.0)
+            xxmaxmin = double(0.0)
+            xyrange = double(1.0)
+            xymaxmin = double(0.0)
+        }
+
+        if (dgsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+            yxrange = (dgsgetd (sy, GSXMAX) - dgsgetd (sy, GSXMIN)) / 2.0d0
+            yxmaxmin = - (dgsgetd (sy, GSXMAX) + dgsgetd (sy, GSXMIN)) / 2.0d0
+            yyrange = (dgsgetd (sy, GSYMAX) - dgsgetd (sy, GSYMIN)) / 2.0d0
+            yymaxmin = - (dgsgetd (sy, GSYMAX) + dgsgetd (sy, GSYMIN)) / 2.0d0
+        } else {
+            yxrange = double(1.0)
+            yxmaxmin = double(0.0)
+            yyrange = double(1.0)
+            yymaxmin = double(0.0)
+        }
+
+        # Get the shifts.
+        xshift = Memd[xcoeff] + Memd[xcoeff+1] * xxmaxmin / xxrange +
+            Memd[xcoeff+2] * xymaxmin / xyrange
+        yshift = Memd[ycoeff] + Memd[ycoeff+1] * yxmaxmin / yxrange +
+            Memd[ycoeff+2] * yymaxmin / yyrange
+
+        # Get the rotation and scaling parameters and correct for normalization.
+        if (nxxcoeff > 1)
+            a = Memd[xcoeff+1] / xxrange
+        else
+            a = double(0.0)
+        if (nxycoeff > 1)
+            b = Memd[xcoeff+nxxcoeff] / xyrange
+        else
+            b = double(0.0)
+        if (nyxcoeff > 1)
+            c = Memd[ycoeff+1] / yxrange
+        else
+            c = double(0.0)
+        if (nyycoeff > 1)
+            d = Memd[ycoeff+nyxcoeff] / yyrange
+        else
+            d = double(0.0)
+
+        # Get the magnification factors.
+        xscale = sqrt (a * a + c * c)
+        yscale = sqrt (b * b + d * d)
+
+        # Get the x and y axes rotation factors.
+        if (fp_equald (a, double(0.0)) && fp_equald (c, double(0.0)))
+            xrot = double(0.0)
+        else
+            xrot = RADTODEG (atan2 (-c, a))
+        if (xrot < double(0.0))
+            xrot = xrot + double(360.0)
+
+        if (fp_equald (b, double(0.0)) && fp_equald (d, double(0.0)))
+            yrot = double(0.0)
+        else
+            yrot = RADTODEG (atan2 (b, d))
+        if (yrot < double(0.0))
+            yrot = yrot + double(360.0)
+
+        call sfree (sp)
+end
+
+
diff --git a/pkg/images/lib/geogmapi.x b/pkg/images/lib/geogmapi.x
new file mode 100644
index 00000000..9dc63610
--- /dev/null
+++ b/pkg/images/lib/geogmapi.x
@@ -0,0 +1,905 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <math.h>
+include <math/gsurfit.h>
+include	<gset.h>
+include "geomap.h"
+include "geogmap.h"
+
+define	GHELPFILE 	"images$lib/geomap.key"
+define	CHELPFILE 	"images$lib/coomap.key"
+
+
+
+# GEO_MGFIT -- Fit the surface using interactive graphics.
+
+procedure geo_mgfitr (gd, fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+        yin, wts, npts, xerrmsg, yerrmsg, maxch)
+
+pointer	gd		#I graphics file descriptor
+pointer	fit		#I pointer to the fit structure
+pointer	sx1		#I pointer to the linear x surface fit
+pointer	sy1		#I pointer to the linear y surface fit
+pointer	sx2		#I pointer to higher order x surface fit
+pointer	sy2		#I pointer to higher order y surface fit
+real	xref[npts]	#I the x reference coordinates
+real	yref[npts]	#I the y reference coordinates
+real	xin[npts]	#I input x coordinates
+real	yin[npts]	#I input y coordinates
+real	wts[npts]	#I array of weights
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x fit error message 
+char	yerrmsg[ARB]	#O the output x fit error message 
+int	maxch		#I the size of the error messages
+
+char	errstr[SZ_LINE]
+int	newgraph, delete, wcs, key, errcode
+pointer	sp, w, gfit, xresid, yresid, cmd
+pointer	gt1, gt2, gt3, gt4, gt5
+real	wx, wy
+real	xshift, yshift, xscale, yscale, thetax, thetay
+
+int	clgcur(), errget()
+pointer	gt_init()
+
+errchk	geo_fxyr(), geo_mrejectr(), geo_fthetar()
+errchk	geo_fmagnifyr(), geo_flinearr()
+
+begin
+	# Initialize gfit structure and working space.
+	call smark (sp)
+	call salloc (gfit, LEN_GEOGRAPH, TY_STRUCT)
+	call salloc (xresid, npts, TY_REAL)
+	call salloc (yresid, npts, TY_REAL)
+	call salloc (w, npts, TY_REAL)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Do initial fit.
+	iferr {
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_fthetar (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memr[xresid], Memr[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memr[xresid], Memr[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flinearr (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memr[xresid], Memr[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+	        call geo_fxyr (fit, sx1, sx2, xref, yref, xin, wts,
+		    Memr[xresid], npts, YES, xerrmsg, maxch)
+	        call geo_fxyr (fit, sy1, sy2, xref, yref, yin, wts,
+		    Memr[yresid], npts, NO, yerrmsg, maxch)
+	    }
+	    if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	        GM_NREJECT(fit) = 0
+	    else
+	        call geo_mrejectr (fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+		    yin, wts, Memr[xresid], Memr[yresid], npts, xerrmsg,
+		    maxch, yerrmsg, maxch)
+	} then {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call error (2, "Too few points for X and Y fits.")
+	    else
+	        call error (2, "Too few points for XI and ETA fits.")
+	}
+
+	GG_NEWFUNCTION(gfit) = NO
+	GG_FITERROR(gfit) = NO
+	errcode = OK
+
+	# Set up plotting defaults.
+	GG_PLOTTYPE(gfit) = FIT
+	GG_OVERPLOT(gfit) = NO
+	GG_CONSTXY(gfit) = YES
+	newgraph = NO
+
+	# Allocate graphics tools.
+	gt1 = gt_init ()
+	gt2 = gt_init ()
+	gt3 = gt_init ()
+	gt4 = gt_init ()
+	gt5 = gt_init ()
+
+	# Set the plot title and x and y axis labels.
+	call geo_gtset (FIT, gt1, fit)
+	call geo_gtset (XXRESID, gt2, fit)
+	call geo_gtset (XYRESID, gt3, fit)
+	call geo_gtset (YXRESID, gt4, fit)
+	call geo_gtset (YYRESID, gt5, fit)
+
+	# Make the first plot.
+	call gclear (gd)
+	call geo_label (FIT, gt1, fit)
+	call geo_1graphr (gd, gt1, fit, gfit, xref, yref, xin, yin, wts,
+	    npts)
+	if (GG_CONSTXY(gfit) == YES)
+	    call geo_conxyr (gd, fit, sx1, sy1, sx2, sy2)
+	call printf ("%s  %s\n")
+	    call pargstr (xerrmsg)
+	    call pargstr (yerrmsg)
+
+	# Read the cursor commands.
+	call amovr (wts, Memr[w], npts)
+	while (clgcur ("cursor", wx, wy, wcs, key, Memc[cmd], SZ_LINE) != EOF) {
+
+	    switch (key) {
+
+	    case 'q':
+		call amovr (Memr[w], wts, npts)
+		break
+
+	    case '?':
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call gpagefile (gd, GHELPFILE, "")
+		else
+		    call gpagefile (gd, CHELPFILE, "")
+
+	    case ':':
+		call geo_colon (gd, fit, gfit, Memc[cmd], newgraph)
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call gt_colon (Memc[cmd], gd, gt1, newgraph)
+		case XXRESID:
+		    call gt_colon (Memc[cmd], gd, gt2, newgraph)
+		case XYRESID:
+		    call gt_colon (Memc[cmd], gd, gt3, newgraph)
+		case YXRESID:
+		    call gt_colon (Memc[cmd], gd, gt4, newgraph)
+		case YYRESID:
+		    call gt_colon (Memc[cmd], gd, gt5, newgraph)
+		}
+
+	    case 'l':
+		if (GG_FITERROR(gfit) == NO) {
+		    call geo_lcoeffr (sx1, sy1, xshift, yshift, xscale, yscale,
+		        thetax, thetay)
+		    call printf ("xshift: %.2f yshift: %.2f ")
+		        call pargr (xshift)
+		        call pargr (yshift)
+		    call printf ("xmag: %0.3g ymag: %0.3g ")
+		        call pargr (xscale)
+		        call pargr (yscale)
+		    call printf ("xrot: %.2f yrot: %.2f\n")
+		        call pargr (thetax)
+		        call pargr (thetay)
+		}
+
+	    case 't':
+		if (GG_FITERROR(gfit) == NO && GG_PLOTTYPE(gfit) == FIT)
+		    call geo_lxyr (gd, fit, sx1, sy1, sx2, sy2, xref, yref,
+		        xin, yin, npts, wx, wy)
+
+	    case 'c':
+		if (GG_CONSTXY(gfit) == YES)
+		    GG_CONSTXY(gfit) = NO
+		else if (GG_CONSTXY(gfit) == NO)
+		    GG_CONSTXY(gfit) = YES
+
+	    case 'd', 'u':
+		if (key == 'd')
+		    delete = YES
+		else
+		    delete = NO
+
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_1deleter (gd, xin, yin, Memr[w], wts, npts, wx,
+		        wy, delete)
+		case XXRESID:
+		    call geo_2deleter (gd, xref, Memr[xresid], Memr[w], wts,
+		        npts, wx, wy, delete)
+		case XYRESID:
+		    call geo_2deleter (gd, yref, Memr[xresid], Memr[w], wts,
+		        npts, wx, wy, delete)
+		case YXRESID:
+		    call geo_2deleter (gd, xref, Memr[yresid], Memr[w], wts,
+		        npts, wx, wy, delete)
+		case YYRESID:
+		    call geo_2deleter (gd, yref, Memr[yresid], Memr[w], wts,
+		        npts, wx, wy, delete)
+		}
+
+		GG_NEWFUNCTION(gfit) = YES
+
+	    case 'g':
+		if (GG_PLOTTYPE(gfit) != FIT)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = FIT
+
+	    case 'x':
+		if (GG_PLOTTYPE(gfit) != XXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XXRESID
+
+	    case 'r':
+		if (GG_PLOTTYPE(gfit) != XYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XYRESID
+
+	    case 'y':
+		if (GG_PLOTTYPE(gfit) != YXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YXRESID
+
+	    case 's':
+		if (GG_PLOTTYPE(gfit) != YYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YYRESID
+
+	    case 'f':
+		# do fit
+		if (GG_NEWFUNCTION(gfit) == YES) {
+		    iferr {
+			switch (GM_FIT(fit)) {
+			case GM_ROTATE:
+		            call geo_fthetar (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memr[w], Memr[xresid], Memr[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RSCALE:
+		            call geo_fmagnifyr (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memr[w], Memr[xresid], Memr[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RXYSCALE:
+		            call geo_flinearr (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memr[w], Memr[xresid], Memr[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			default:
+		            call geo_fxyr (fit, sx1, sx2, xref, yref, xin,
+			        Memr[w], Memr[xresid], npts, YES,
+				xerrmsg, maxch) 
+		            call geo_fxyr (fit, sy1, sy2, xref, yref, yin,
+			        Memr[w], Memr[yresid], npts, NO,
+				yerrmsg, maxch) 
+			}
+		        if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+			    GM_NREJECT(fit) = 0
+		        else
+			    call geo_mrejectr (fit, sx1, sy1, sx2, sy2, xref,
+			        yref, xin, yin, Memr[w], Memr[xresid],
+				Memr[yresid], npts, xerrmsg, maxch,
+				yerrmsg, maxch)
+			GG_NEWFUNCTION(gfit) = NO
+			GG_FITERROR(gfit) = NO
+			errcode = OK
+		    } then {
+	    		errcode = errget (errstr, SZ_LINE)
+	    		call printf ("%s\n")
+			    call pargstr (errstr)
+			GG_FITERROR(gfit) = YES
+		    }
+		}
+
+		# plot new graph
+		if (GG_FITERROR(gfit) == YES)
+		    newgraph = NO
+		else
+		    newgraph = YES
+
+	    case 'o':
+		GG_OVERPLOT(gfit) = YES
+
+	    default:
+		call printf ("\07")
+
+	    }
+
+	    if (newgraph == YES) {
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_label (FIT, gt1, fit)
+	    	    call geo_1graphr (gd, gt1, fit, gfit, xref, yref, xin, yin,
+		        Memr[w], npts)
+		    if (GG_CONSTXY(gfit) == YES)
+			call geo_conxyr (gd, fit, sx1, sy1, sx2, sy2)
+		case XXRESID:
+		    call geo_label (XXRESID, gt2, fit)
+	    	    call geo_2graphr (gd, gt2, fit, gfit, xref, Memr[xresid],
+		        Memr[w], npts)
+		case XYRESID:
+		    call geo_label (XYRESID, gt3, fit)
+	    	    call geo_2graphr (gd, gt3, fit, gfit, yref, Memr[xresid],
+		         Memr[w], npts)
+		case YXRESID:
+		    call geo_label (YXRESID, gt4, fit)
+	    	    call geo_2graphr (gd, gt4, fit, gfit, xref, Memr[yresid],
+		         Memr[w], npts)
+		case YYRESID:
+		    call geo_label (YYRESID, gt5, fit)
+	    	    call geo_2graphr (gd, gt5, fit, gfit, yref, Memr[yresid],
+		         Memr[w], npts)
+		}
+	        call printf ("%s  %s\n")
+	    	    call pargstr (xerrmsg)
+	    	    call pargstr (yerrmsg)
+		newgraph = NO
+	    }
+	}
+
+	# Free space.
+	call gt_free (gt1)
+	call gt_free (gt2)
+	call gt_free (gt3)
+	call gt_free (gt4)
+	call gt_free (gt5)
+	call sfree (sp)
+
+	# Call an error if appropriate.
+	if (errcode > 0)
+	    call error (2, errstr)
+end
+
+# GEO_LCOEFF -- Print the coefficents of the linear portion of the
+# fit, xshift, yshift, xexpansion, yexpansion, x and y rotations.
+
+procedure geo_lcoeffr (sx, sy, xshift, yshift, xscale, yscale, xrot, yrot)
+
+pointer sx              #I pointer to the x surface fit
+pointer sy              #I pointer to the y surface fit
+real   xshift          #O output x shift
+real   yshift          #O output y shift
+real   xscale          #O output x scale
+real   yscale          #O output y scale
+real   xrot            #O rotation of point on x axis
+real   yrot            #O rotation of point on y axis
+
+int     nxxcoeff, nxycoeff, nyxcoeff, nyycoeff
+pointer sp, xcoeff, ycoeff
+real   xxrange, xyrange, xxmaxmin, xymaxmin
+real   yxrange, yyrange, yxmaxmin, yymaxmin
+real   a, b, c, d
+
+bool    fp_equalr()
+int     gsgeti()
+real    gsgetr()
+
+begin
+        # Allocate working space.
+        call smark (sp)
+        call salloc (xcoeff, gsgeti (sx, GSNCOEFF), TY_REAL)
+        call salloc (ycoeff, gsgeti (sy, GSNCOEFF), TY_REAL)
+
+        # Get coefficients and numbers of coefficients.
+        call gscoeff (sx, Memr[xcoeff], nxxcoeff)
+        call gscoeff (sy, Memr[ycoeff], nyycoeff)
+        nxxcoeff = gsgeti (sx, GSNXCOEFF)
+        nxycoeff = gsgeti (sx, GSNYCOEFF)
+        nyxcoeff = gsgeti (sy, GSNXCOEFF)
+        nyycoeff = gsgeti (sy, GSNYCOEFF)
+
+        # Get the data range.
+        if (gsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+            xxrange = (gsgetr (sx, GSXMAX) - gsgetr (sx, GSXMIN)) / 2.0
+            xxmaxmin = - (gsgetr (sx, GSXMAX) + gsgetr (sx, GSXMIN)) / 2.0
+            xyrange = (gsgetr (sx, GSYMAX) - gsgetr (sx, GSYMIN)) / 2.0
+            xymaxmin = - (gsgetr (sx, GSYMAX) + gsgetr (sx, GSYMIN)) / 2.0
+        } else {
+            xxrange = real(1.0)
+            xxmaxmin = real(0.0)
+            xyrange = real(1.0)
+            xymaxmin = real(0.0)
+        }
+
+        if (gsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+            yxrange = (gsgetr (sy, GSXMAX) - gsgetr (sy, GSXMIN)) / 2.0
+            yxmaxmin = - (gsgetr (sy, GSXMAX) + gsgetr (sy, GSXMIN)) / 2.0
+            yyrange = (gsgetr (sy, GSYMAX) - gsgetr (sy, GSYMIN)) / 2.0
+            yymaxmin = - (gsgetr (sy, GSYMAX) + gsgetr (sy, GSYMIN)) / 2.0
+        } else {
+            yxrange = real(1.0)
+            yxmaxmin = real(0.0)
+            yyrange = real(1.0)
+            yymaxmin = real(0.0)
+        }
+
+        # Get the shifts.
+        xshift = Memr[xcoeff] + Memr[xcoeff+1] * xxmaxmin / xxrange +
+            Memr[xcoeff+2] * xymaxmin / xyrange
+        yshift = Memr[ycoeff] + Memr[ycoeff+1] * yxmaxmin / yxrange +
+            Memr[ycoeff+2] * yymaxmin / yyrange
+
+        # Get the rotation and scaling parameters and correct for normalization.
+        if (nxxcoeff > 1)
+            a = Memr[xcoeff+1] / xxrange
+        else
+            a = real(0.0)
+        if (nxycoeff > 1)
+            b = Memr[xcoeff+nxxcoeff] / xyrange
+        else
+            b = real(0.0)
+        if (nyxcoeff > 1)
+            c = Memr[ycoeff+1] / yxrange
+        else
+            c = real(0.0)
+        if (nyycoeff > 1)
+            d = Memr[ycoeff+nyxcoeff] / yyrange
+        else
+            d = real(0.0)
+
+        # Get the magnification factors.
+        xscale = sqrt (a * a + c * c)
+        yscale = sqrt (b * b + d * d)
+
+        # Get the x and y axes rotation factors.
+        if (fp_equalr (a, real(0.0)) && fp_equalr (c, real(0.0)))
+            xrot = real(0.0)
+        else
+            xrot = RADTODEG (atan2 (-c, a))
+        if (xrot < real(0.0))
+            xrot = xrot + real(360.0)
+
+        if (fp_equalr (b, real(0.0)) && fp_equalr (d, real(0.0)))
+            yrot = real(0.0)
+        else
+            yrot = RADTODEG (atan2 (b, d))
+        if (yrot < real(0.0))
+            yrot = yrot + real(360.0)
+
+        call sfree (sp)
+end
+
+
+
+# GEO_MGFIT -- Fit the surface using interactive graphics.
+
+procedure geo_mgfitd (gd, fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+        yin, wts, npts, xerrmsg, yerrmsg, maxch)
+
+pointer	gd		#I graphics file descriptor
+pointer	fit		#I pointer to the fit structure
+pointer	sx1		#I pointer to the linear x surface fit
+pointer	sy1		#I pointer to the linear y surface fit
+pointer	sx2		#I pointer to higher order x surface fit
+pointer	sy2		#I pointer to higher order y surface fit
+double	xref[npts]	#I the x reference coordinates
+double	yref[npts]	#I the y reference coordinates
+double	xin[npts]	#I input x coordinates
+double	yin[npts]	#I input y coordinates
+double	wts[npts]	#I array of weights
+int	npts		#I number of data points
+char	xerrmsg[ARB]	#O the output x fit error message 
+char	yerrmsg[ARB]	#O the output x fit error message 
+int	maxch		#I the size of the error messages
+
+char	errstr[SZ_LINE]
+int	newgraph, delete, wcs, key, errcode
+pointer	sp, w, gfit, xresid, yresid, cmd
+pointer	gt1, gt2, gt3, gt4, gt5
+real	wx, wy
+double	xshift, yshift, xscale, yscale, thetax, thetay
+
+int	clgcur(), errget()
+pointer	gt_init()
+
+errchk	geo_fxyd(), geo_mrejectd(), geo_fthetad()
+errchk	geo_fmagnifyd(), geo_flineard()
+
+begin
+	# Initialize gfit structure and working space.
+	call smark (sp)
+	call salloc (gfit, LEN_GEOGRAPH, TY_STRUCT)
+	call salloc (xresid, npts, TY_DOUBLE)
+	call salloc (yresid, npts, TY_DOUBLE)
+	call salloc (w, npts, TY_DOUBLE)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Do initial fit.
+	iferr {
+	    switch (GM_FIT(fit)) {
+	    case GM_ROTATE:
+	        call geo_fthetad (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memd[xresid], Memd[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RSCALE:
+	        call geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memd[xresid], Memd[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    case GM_RXYSCALE:
+	        call geo_flineard (fit, sx1, sy1, xref, yref, xin, yin, wts,
+	            Memd[xresid], Memd[yresid], npts, xerrmsg, maxch,
+		    yerrmsg, maxch)
+		    sx2 = NULL
+		    sy2 = NULL
+	    default:
+	        call geo_fxyd (fit, sx1, sx2, xref, yref, xin, wts,
+		    Memd[xresid], npts, YES, xerrmsg, maxch)
+	        call geo_fxyd (fit, sy1, sy2, xref, yref, yin, wts,
+		    Memd[yresid], npts, NO, yerrmsg, maxch)
+	    }
+	    if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+	        GM_NREJECT(fit) = 0
+	    else
+	        call geo_mrejectd (fit, sx1, sy1, sx2, sy2, xref, yref, xin,
+		    yin, wts, Memd[xresid], Memd[yresid], npts, xerrmsg,
+		    maxch, yerrmsg, maxch)
+	} then {
+	    call sfree (sp)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call error (2, "Too few points for X and Y fits.")
+	    else
+	        call error (2, "Too few points for XI and ETA fits.")
+	}
+
+	GG_NEWFUNCTION(gfit) = NO
+	GG_FITERROR(gfit) = NO
+	errcode = OK
+
+	# Set up plotting defaults.
+	GG_PLOTTYPE(gfit) = FIT
+	GG_OVERPLOT(gfit) = NO
+	GG_CONSTXY(gfit) = YES
+	newgraph = NO
+
+	# Allocate graphics tools.
+	gt1 = gt_init ()
+	gt2 = gt_init ()
+	gt3 = gt_init ()
+	gt4 = gt_init ()
+	gt5 = gt_init ()
+
+	# Set the plot title and x and y axis labels.
+	call geo_gtset (FIT, gt1, fit)
+	call geo_gtset (XXRESID, gt2, fit)
+	call geo_gtset (XYRESID, gt3, fit)
+	call geo_gtset (YXRESID, gt4, fit)
+	call geo_gtset (YYRESID, gt5, fit)
+
+	# Make the first plot.
+	call gclear (gd)
+	call geo_label (FIT, gt1, fit)
+	call geo_1graphd (gd, gt1, fit, gfit, xref, yref, xin, yin, wts,
+	    npts)
+	if (GG_CONSTXY(gfit) == YES)
+	    call geo_conxyd (gd, fit, sx1, sy1, sx2, sy2)
+	call printf ("%s  %s\n")
+	    call pargstr (xerrmsg)
+	    call pargstr (yerrmsg)
+
+	# Read the cursor commands.
+	call amovd (wts, Memd[w], npts)
+	while (clgcur ("cursor", wx, wy, wcs, key, Memc[cmd], SZ_LINE) != EOF) {
+
+	    switch (key) {
+
+	    case 'q':
+		call amovd (Memd[w], wts, npts)
+		break
+
+	    case '?':
+		if (GM_PROJECTION(fit) == GM_NONE)
+		    call gpagefile (gd, GHELPFILE, "")
+		else
+		    call gpagefile (gd, CHELPFILE, "")
+
+	    case ':':
+		call geo_colon (gd, fit, gfit, Memc[cmd], newgraph)
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call gt_colon (Memc[cmd], gd, gt1, newgraph)
+		case XXRESID:
+		    call gt_colon (Memc[cmd], gd, gt2, newgraph)
+		case XYRESID:
+		    call gt_colon (Memc[cmd], gd, gt3, newgraph)
+		case YXRESID:
+		    call gt_colon (Memc[cmd], gd, gt4, newgraph)
+		case YYRESID:
+		    call gt_colon (Memc[cmd], gd, gt5, newgraph)
+		}
+
+	    case 'l':
+		if (GG_FITERROR(gfit) == NO) {
+		    call geo_lcoeffd (sx1, sy1, xshift, yshift, xscale, yscale,
+		        thetax, thetay)
+		    call printf ("xshift: %.2f yshift: %.2f ")
+		        call pargd (xshift)
+		        call pargd (yshift)
+		    call printf ("xmag: %0.3g ymag: %0.3g ")
+		        call pargd (xscale)
+		        call pargd (yscale)
+		    call printf ("xrot: %.2f yrot: %.2f\n")
+		        call pargd (thetax)
+		        call pargd (thetay)
+		}
+
+	    case 't':
+		if (GG_FITERROR(gfit) == NO && GG_PLOTTYPE(gfit) == FIT)
+		    call geo_lxyd (gd, fit, sx1, sy1, sx2, sy2, xref, yref,
+		        xin, yin, npts, wx, wy)
+
+	    case 'c':
+		if (GG_CONSTXY(gfit) == YES)
+		    GG_CONSTXY(gfit) = NO
+		else if (GG_CONSTXY(gfit) == NO)
+		    GG_CONSTXY(gfit) = YES
+
+	    case 'd', 'u':
+		if (key == 'd')
+		    delete = YES
+		else
+		    delete = NO
+
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_1deleted (gd, xin, yin, Memd[w], wts, npts, wx,
+		        wy, delete)
+		case XXRESID:
+		    call geo_2deleted (gd, xref, Memd[xresid], Memd[w], wts,
+		        npts, wx, wy, delete)
+		case XYRESID:
+		    call geo_2deleted (gd, yref, Memd[xresid], Memd[w], wts,
+		        npts, wx, wy, delete)
+		case YXRESID:
+		    call geo_2deleted (gd, xref, Memd[yresid], Memd[w], wts,
+		        npts, wx, wy, delete)
+		case YYRESID:
+		    call geo_2deleted (gd, yref, Memd[yresid], Memd[w], wts,
+		        npts, wx, wy, delete)
+		}
+
+		GG_NEWFUNCTION(gfit) = YES
+
+	    case 'g':
+		if (GG_PLOTTYPE(gfit) != FIT)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = FIT
+
+	    case 'x':
+		if (GG_PLOTTYPE(gfit) != XXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XXRESID
+
+	    case 'r':
+		if (GG_PLOTTYPE(gfit) != XYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = XYRESID
+
+	    case 'y':
+		if (GG_PLOTTYPE(gfit) != YXRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YXRESID
+
+	    case 's':
+		if (GG_PLOTTYPE(gfit) != YYRESID)
+		    newgraph = YES
+		GG_PLOTTYPE(gfit) = YYRESID
+
+	    case 'f':
+		# do fit
+		if (GG_NEWFUNCTION(gfit) == YES) {
+		    iferr {
+			switch (GM_FIT(fit)) {
+			case GM_ROTATE:
+		            call geo_fthetad (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memd[w], Memd[xresid], Memd[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RSCALE:
+		            call geo_fmagnifyd (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memd[w], Memd[xresid], Memd[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			case GM_RXYSCALE:
+		            call geo_flineard (fit, sx1, sy1, xref, yref, xin,
+			        yin, Memd[w], Memd[xresid], Memd[yresid],
+				npts, xerrmsg, maxch, yerrmsg, maxch) 
+				sx2 = NULL
+				sy2 = NULL
+			default:
+		            call geo_fxyd (fit, sx1, sx2, xref, yref, xin,
+			        Memd[w], Memd[xresid], npts, YES,
+				xerrmsg, maxch) 
+		            call geo_fxyd (fit, sy1, sy2, xref, yref, yin,
+			        Memd[w], Memd[yresid], npts, NO,
+				yerrmsg, maxch) 
+			}
+		        if (GM_MAXITER(fit) <= 0 || IS_INDEFD(GM_REJECT(fit)))
+			    GM_NREJECT(fit) = 0
+		        else
+			    call geo_mrejectd (fit, sx1, sy1, sx2, sy2, xref,
+			        yref, xin, yin, Memd[w], Memd[xresid],
+				Memd[yresid], npts, xerrmsg, maxch,
+				yerrmsg, maxch)
+			GG_NEWFUNCTION(gfit) = NO
+			GG_FITERROR(gfit) = NO
+			errcode = OK
+		    } then {
+	    		errcode = errget (errstr, SZ_LINE)
+	    		call printf ("%s\n")
+			    call pargstr (errstr)
+			GG_FITERROR(gfit) = YES
+		    }
+		}
+
+		# plot new graph
+		if (GG_FITERROR(gfit) == YES)
+		    newgraph = NO
+		else
+		    newgraph = YES
+
+	    case 'o':
+		GG_OVERPLOT(gfit) = YES
+
+	    default:
+		call printf ("\07")
+
+	    }
+
+	    if (newgraph == YES) {
+		switch (GG_PLOTTYPE(gfit)) {
+		case FIT:
+		    call geo_label (FIT, gt1, fit)
+	    	    call geo_1graphd (gd, gt1, fit, gfit, xref, yref, xin, yin,
+		        Memd[w], npts)
+		    if (GG_CONSTXY(gfit) == YES)
+			call geo_conxyd (gd, fit, sx1, sy1, sx2, sy2)
+		case XXRESID:
+		    call geo_label (XXRESID, gt2, fit)
+	    	    call geo_2graphd (gd, gt2, fit, gfit, xref, Memd[xresid],
+		        Memd[w], npts)
+		case XYRESID:
+		    call geo_label (XYRESID, gt3, fit)
+	    	    call geo_2graphd (gd, gt3, fit, gfit, yref, Memd[xresid],
+		         Memd[w], npts)
+		case YXRESID:
+		    call geo_label (YXRESID, gt4, fit)
+	    	    call geo_2graphd (gd, gt4, fit, gfit, xref, Memd[yresid],
+		         Memd[w], npts)
+		case YYRESID:
+		    call geo_label (YYRESID, gt5, fit)
+	    	    call geo_2graphd (gd, gt5, fit, gfit, yref, Memd[yresid],
+		         Memd[w], npts)
+		}
+	        call printf ("%s  %s\n")
+	    	    call pargstr (xerrmsg)
+	    	    call pargstr (yerrmsg)
+		newgraph = NO
+	    }
+	}
+
+	# Free space.
+	call gt_free (gt1)
+	call gt_free (gt2)
+	call gt_free (gt3)
+	call gt_free (gt4)
+	call gt_free (gt5)
+	call sfree (sp)
+
+	# Call an error if appropriate.
+	if (errcode > 0)
+	    call error (2, errstr)
+end
+
+# GEO_LCOEFF -- Print the coefficents of the linear portion of the
+# fit, xshift, yshift, xexpansion, yexpansion, x and y rotations.
+
+procedure geo_lcoeffd (sx, sy, xshift, yshift, xscale, yscale, xrot, yrot)
+
+pointer sx              #I pointer to the x surface fit
+pointer sy              #I pointer to the y surface fit
+double   xshift          #O output x shift
+double   yshift          #O output y shift
+double   xscale          #O output x scale
+double   yscale          #O output y scale
+double   xrot            #O rotation of point on x axis
+double   yrot            #O rotation of point on y axis
+
+int     nxxcoeff, nxycoeff, nyxcoeff, nyycoeff
+pointer sp, xcoeff, ycoeff
+double   xxrange, xyrange, xxmaxmin, xymaxmin
+double   yxrange, yyrange, yxmaxmin, yymaxmin
+double   a, b, c, d
+
+bool    fp_equald()
+int     dgsgeti()
+double  dgsgetd()
+
+begin
+        # Allocate working space.
+        call smark (sp)
+        call salloc (xcoeff, dgsgeti (sx, GSNCOEFF), TY_DOUBLE)
+        call salloc (ycoeff, dgsgeti (sy, GSNCOEFF), TY_DOUBLE)
+
+        # Get coefficients and numbers of coefficients.
+        call dgscoeff (sx, Memd[xcoeff], nxxcoeff)
+        call dgscoeff (sy, Memd[ycoeff], nyycoeff)
+        nxxcoeff = dgsgeti (sx, GSNXCOEFF)
+        nxycoeff = dgsgeti (sx, GSNYCOEFF)
+        nyxcoeff = dgsgeti (sy, GSNXCOEFF)
+        nyycoeff = dgsgeti (sy, GSNYCOEFF)
+
+        # Get the data range.
+        if (dgsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+            xxrange = (dgsgetd (sx, GSXMAX) - dgsgetd (sx, GSXMIN)) / 2.0d0
+            xxmaxmin = - (dgsgetd (sx, GSXMAX) + dgsgetd (sx, GSXMIN)) / 2.0d0
+            xyrange = (dgsgetd (sx, GSYMAX) - dgsgetd (sx, GSYMIN)) / 2.0d0
+            xymaxmin = - (dgsgetd (sx, GSYMAX) + dgsgetd (sx, GSYMIN)) / 2.0d0
+        } else {
+            xxrange = double(1.0)
+            xxmaxmin = double(0.0)
+            xyrange = double(1.0)
+            xymaxmin = double(0.0)
+        }
+
+        if (dgsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+            yxrange = (dgsgetd (sy, GSXMAX) - dgsgetd (sy, GSXMIN)) / 2.0d0
+            yxmaxmin = - (dgsgetd (sy, GSXMAX) + dgsgetd (sy, GSXMIN)) / 2.0d0
+            yyrange = (dgsgetd (sy, GSYMAX) - dgsgetd (sy, GSYMIN)) / 2.0d0
+            yymaxmin = - (dgsgetd (sy, GSYMAX) + dgsgetd (sy, GSYMIN)) / 2.0d0
+        } else {
+            yxrange = double(1.0)
+            yxmaxmin = double(0.0)
+            yyrange = double(1.0)
+            yymaxmin = double(0.0)
+        }
+
+        # Get the shifts.
+        xshift = Memd[xcoeff] + Memd[xcoeff+1] * xxmaxmin / xxrange +
+            Memd[xcoeff+2] * xymaxmin / xyrange
+        yshift = Memd[ycoeff] + Memd[ycoeff+1] * yxmaxmin / yxrange +
+            Memd[ycoeff+2] * yymaxmin / yyrange
+
+        # Get the rotation and scaling parameters and correct for normalization.
+        if (nxxcoeff > 1)
+            a = Memd[xcoeff+1] / xxrange
+        else
+            a = double(0.0)
+        if (nxycoeff > 1)
+            b = Memd[xcoeff+nxxcoeff] / xyrange
+        else
+            b = double(0.0)
+        if (nyxcoeff > 1)
+            c = Memd[ycoeff+1] / yxrange
+        else
+            c = double(0.0)
+        if (nyycoeff > 1)
+            d = Memd[ycoeff+nyxcoeff] / yyrange
+        else
+            d = double(0.0)
+
+        # Get the magnification factors.
+        xscale = sqrt (a * a + c * c)
+        yscale = sqrt (b * b + d * d)
+
+        # Get the x and y axes rotation factors.
+        if (fp_equald (a, double(0.0)) && fp_equald (c, double(0.0)))
+            xrot = double(0.0)
+        else
+            xrot = RADTODEG (atan2 (-c, a))
+        if (xrot < double(0.0))
+            xrot = xrot + double(360.0)
+
+        if (fp_equald (b, double(0.0)) && fp_equald (d, double(0.0)))
+            yrot = double(0.0)
+        else
+            yrot = RADTODEG (atan2 (b, d))
+        if (yrot < double(0.0))
+            yrot = yrot + double(360.0)
+
+        call sfree (sp)
+end
+
+
diff --git a/pkg/images/lib/geograph.gx b/pkg/images/lib/geograph.gx
new file mode 100644
index 00000000..5c42de24
--- /dev/null
+++ b/pkg/images/lib/geograph.gx
@@ -0,0 +1,1379 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math/gsurfit.h>
+include <pkg/gtools.h>
+include <mach.h>
+include <math.h>
+include <gset.h>
+include "geomap.h"
+include "geogmap.h"
+
+define	MAX_PARAMS	(10 * SZ_LINE)	
+define	NINTERVALS	5
+define	NGRAPH		100
+
+$for (r)
+
+# GEO_LABEL -- Annotate the plot.
+
+procedure geo_label (plot_type, gt, fit)
+
+int	plot_type	#I type of plot
+pointer	gt		#I gtools descriptor
+pointer	fit		#I geomap fit parameters
+
+int	npts
+pointer	sp, params, xtermlab, ytermlab
+real	xrms, yrms, rej
+int	strlen(), rg_wrdstr()
+
+begin
+	call smark (sp)
+	call salloc (params, MAX_PARAMS, TY_CHAR)
+	call salloc (xtermlab, SZ_FNAME, TY_CHAR)
+	call salloc (ytermlab, SZ_FNAME, TY_CHAR)
+
+	npts = max (0, GM_NPTS(fit) - GM_NWTS0(fit))
+	xrms = max (0.0d0, GM_XRMS(fit))
+	yrms = max (0.0d0, GM_YRMS(fit))
+	if (npts > 1) {
+	    xrms = sqrt (xrms / (npts - 1))
+	    yrms = sqrt (yrms / (npts - 1))
+	} else {
+	    xrms = 0.0
+	    yrms = 0.0
+	}
+	if (IS_INDEFD(GM_REJECT(fit)))
+	    rej = INDEFR
+	else if (GM_REJECT(fit) > MAX_REAL)
+	    rej = INDEFR
+	else
+	    rej = GM_REJECT(fit)
+
+	# Print data parameters.
+	if (GM_PROJECTION(fit) == GM_NONE)
+	    call sprintf (Memc[params], MAX_PARAMS,
+	        "GEOMAP: function = %s npts = %d reject = %g nrej = %d\n")
+	else
+	    call sprintf (Memc[params], MAX_PARAMS,
+	        "CCMAP: function = %s npts = %d reject = %g nrej = %d\n")
+
+	    switch (GM_FUNCTION(fit)) {
+	    case GS_LEGENDRE:
+		call pargstr ("legendre")
+	    case GS_CHEBYSHEV:
+		call pargstr ("chebyshev")
+	    case GS_POLYNOMIAL:
+		call pargstr ("polynomial")
+	    }
+	    call pargi (GM_NPTS(fit))
+	    call pargr (rej)
+	    call pargi (GM_NWTS0(fit))
+
+	# Print fit parameters.
+	switch (plot_type) {
+	case FIT:
+
+	    if (rg_wrdstr ((GM_XXTERMS(fit) + 1), Memc[xtermlab], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[xtermlab], SZ_FNAME)
+	    if (rg_wrdstr ((GM_YXTERMS(fit) + 1), Memc[ytermlab], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[ytermlab], SZ_FNAME)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	        "X fit: xorder = %d yorder = %d xterms = %s stdev = %8.3g\n")
+	    else
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	   "XI fit: xorder = %d yorder = %d xterms = %s stdev = %8.3g arcsec\n")
+		call pargi (GM_XXORDER(fit))
+		call pargi (GM_XYORDER(fit))
+		call pargstr (Memc[xtermlab])
+		call pargr (xrms)
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	        "Y fit: xorder = %d yorder = %d xterms = %s stdev = %8.3g\n")
+	    else
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	  "ETA fit: xorder = %d yorder = %d xterms = %s stdev = %8.3g arcsec\n")
+		call pargi (GM_YXORDER(fit))
+		call pargi (GM_YYORDER(fit))
+		call pargstr (Memc[ytermlab])
+		call pargr (yrms)
+
+	case XXRESID, XYRESID:
+
+	    if (rg_wrdstr ((GM_XXTERMS(fit) + 1), Memc[xtermlab], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[xtermlab], SZ_FNAME)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	        "X fit: xorder = %d yorder = %d xterms = %s rms = %8.3g\n")
+	    else
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	    "XI fit: xorder = %d yorder = %d xterms = %s rms = %8.3g arcsec\n")
+		call pargi (GM_XXORDER(fit))
+		call pargi (GM_XYORDER(fit))
+		call pargstr (Memc[xtermlab])
+		call pargr (xrms)
+
+	case YXRESID, YYRESID:
+
+	    if (rg_wrdstr ((GM_YXTERMS(fit) + 1), Memc[ytermlab], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[ytermlab], SZ_FNAME)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	        "Y fit: xorder = %d yorder = %d xterms = %s rms = %8.3g\n")
+	    else
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	    "ETA fit: xorder = %d yorder = %d xterms = %s rms = %8.3g arcsec\n")
+		call pargi (GM_YXORDER(fit))
+		call pargi (GM_YYORDER(fit))
+		call pargstr (Memc[ytermlab])
+		call pargr (yrms)
+
+	default:
+
+	    # do nothing gracefully
+	}
+
+	call gt_sets (gt, GTPARAMS, Memc[params])
+
+	call sfree (sp)
+end
+
+
+# GEO_GTSET -- Write title and labels.
+
+procedure geo_gtset (plot_type, gt, fit)
+
+int	plot_type	#I plot type
+pointer	gt		#I plot descriptor
+pointer	fit		#I fit descriptor
+
+char	str[SZ_LINE]
+int	nchars
+int	gstrcpy()
+
+begin
+	nchars =  gstrcpy (GM_RECORD(fit), str, SZ_LINE)
+
+	switch (plot_type) {
+	case FIT:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": Coordinate Transformation", str[nchars+1],
+		    SZ_LINE)
+	    else
+	        call strcpy (": Celestial Coordinate Transformation",
+		    str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "X (in units)")
+	        call gt_sets (gt, GTYLABEL, "Y (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "XI (arcsec)")
+	        call gt_sets (gt, GTYLABEL, "ETA (arcsec)") 
+	    }
+
+	case XXRESID:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": X fit Residuals", str[nchars+1], SZ_LINE)
+	    else
+	        call strcpy (": XI fit Residuals", str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "X (ref units)")
+	        call gt_sets (gt, GTYLABEL, "X Residuals (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "X (pixels)")
+	        call gt_sets (gt, GTYLABEL, "XI Residuals (arcsec)") 
+	    }
+
+	case XYRESID:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": X fit Residuals", str[nchars+1], SZ_LINE)
+	    else
+	        call strcpy (": XI fit Residuals", str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "Y (ref units)")
+	        call gt_sets (gt, GTYLABEL, "X Residuals (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "Y (pixels)")
+	        call gt_sets (gt, GTYLABEL, "XI Residuals (arcsec)") 
+	    }
+
+	case YXRESID:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": Y fit Residuals", str[nchars+1], SZ_LINE)
+	    else
+	        call strcpy (": ETA fit Residuals", str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "X (ref units)")
+	        call gt_sets (gt, GTYLABEL, "Y (Residuals (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "X (pixels)")
+	        call gt_sets (gt, GTYLABEL, "ETA Residuals (arcsec)") 
+	    }
+
+	case YYRESID:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": Y fit Residuals", str[nchars+1], SZ_LINE)
+	    else
+	        call strcpy (": ETA fit Residuals", str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "Y (ref units)")
+	        call gt_sets (gt, GTYLABEL, "Y Residuals (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "Y (pixels)")
+	        call gt_sets (gt, GTYLABEL, "ETA Residuals (arcsec)") 
+	    }
+
+	default:
+	    
+	    # do nothing gracefully
+	}
+end
+
+
+# GEO_COLON -- Process the colon commands.
+
+procedure geo_colon (gd, fit, gfit, cmdstr, newgraph)
+
+pointer	gd		#I graphics stream
+pointer	fit		#I pointer to fit structure
+pointer	gfit		#I pointer to the gfit structure
+char	cmdstr[ARB]	#I command string
+int	newgraph	#I plot new graph
+
+int	ncmd, ival
+pointer	sp, str, cmd
+real	rval
+int	nscan(), strdic(), rg_wrdstr()
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], SZ_LINE)
+	if (nscan() == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_CMDS)
+	switch (ncmd) {
+	case GMCMD_SHOW:
+	    call gdeactivate (gd, AW_CLEAR)
+	    call printf ("Current Fitting Parameters\n\n")
+	    if (GM_PROJECTION(fit) != GM_NONE) {
+	        if (rg_wrdstr (GM_PROJECTION(fit), Memc[str], SZ_FNAME,
+	            GM_PROJLIST) <= 0)
+		    ;
+	        call printf ("\tprojection = %s\n")
+		    call pargstr (Memc[str])
+	        call printf ("\tlngref = %h\n")
+		    call pargd (GM_XREFPT(fit))
+	        call printf ("\tlatref = %h\n")
+		    call pargd (GM_YREFPT(fit))
+	    }
+	    if (rg_wrdstr (GM_FIT(fit), Memc[str], SZ_FNAME,
+	        GM_GEOMETRIES) <= 0)
+		call strcpy ("general", Memc[str], SZ_FNAME)
+	    call printf ("\tfitgeometry = %s\n")
+		call pargstr (Memc[str])
+	    if (rg_wrdstr (GM_FUNCTION(fit), Memc[str], SZ_FNAME,
+	        GM_FUNCS) <= 0)
+		call strcpy ("polynomial", Memc[str], SZ_FNAME)
+	    call printf ("\tfunction = %s\n")
+		Call pargstr (Memc[str])
+	    call printf ("\txxorder = %d\n")
+		call pargi (GM_XXORDER(fit))
+	    call printf ("\txyorder = %d\n")
+		call pargi (GM_XYORDER(fit))
+	    if (rg_wrdstr ((GM_XXTERMS(fit) + 1), Memc[str], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[str], SZ_FNAME)
+	    call printf ("\txxterms = %s\n")
+		call pargstr (Memc[str])
+	    call printf ("\tyxorder = %d\n")
+		call pargi (GM_YXORDER(fit))
+	    call printf ("\tyyorder = %d\n")
+		call pargi (GM_YYORDER(fit))
+	    if (rg_wrdstr ((GM_YXTERMS(fit) + 1), Memc[str], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[str], SZ_FNAME)
+	    call printf ("\tyxterms = %s\n")
+		call pargstr (Memc[str])
+	    if (IS_INDEFD(GM_REJECT(fit)))
+		rval = INDEFR
+	    else if (GM_REJECT(fit) > MAX_REAL)
+		rval = INDEFR
+	    else
+		rval = GM_REJECT(fit)
+	    call printf ("\treject = %f\n")
+		call pargr (rval)
+	    call greactivate (gd, AW_PAUSE)
+
+	case GMCMD_PROJECTION:
+	    if (rg_wrdstr (GM_PROJECTION(fit), Memc[str], SZ_FNAME,
+	        GM_PROJLIST) <= 0)
+	        call strcpy ("INDEF", Memc[str], SZ_FNAME)
+	    call printf ("projection = %s\n")
+	        call pargstr (Memc[str])
+
+	case GMCMD_REFPOINT:
+	    call printf ("lngref = %h latref = %h\n")
+		call pargd (GM_XREFPT(fit))
+		call pargd (GM_YREFPT(fit))
+
+	case GMCMD_GEOMETRY:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        if (rg_wrdstr (GM_FIT(fit), Memc[str], SZ_FNAME,
+	            GM_GEOMETRIES) <= 0)
+		    call strcpy ("general", Memc[str], SZ_FNAME)
+	        call printf ("fitgeometry = %s\n")
+		    call pargstr (Memc[str])
+	    } else {
+		ival = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_GEOMETRIES)
+		if (ival > 0) {
+		    GM_FIT(fit) = ival
+		    GG_NEWFUNCTION(gfit) = YES
+		    GG_FITERROR(gfit) = NO
+		}
+	    }
+
+	case GMCMD_FUNCTION:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        if (rg_wrdstr (GM_FUNCTION(fit), Memc[str], SZ_FNAME,
+	            GM_FUNCS) <= 0)
+		    call strcpy ("polynomial", Memc[str], SZ_FNAME)
+	        call printf ("function = %s\n")
+		    call pargstr (Memc[str])
+	    } else {
+		ival = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_FUNCS)
+		if (ival > 0) {
+		    GM_FUNCTION(fit) = ival
+		    GG_NEWFUNCTION(gfit) = YES
+		    GG_FITERROR(gfit) = NO
+		}
+	    }
+
+	case GMCMD_ORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf (
+		    "xxorder = %d xyorder = %d yxorder = %d yyorder = %d\n")
+		    call pargi (GM_XXORDER(fit))
+		    call pargi (GM_XYORDER(fit))
+		    call pargi (GM_YXORDER(fit))
+		    call pargi (GM_YYORDER(fit))
+	    } else {
+		GM_XXORDER(fit) = max (ival, 2)
+		GM_XYORDER(fit) = max (ival, 2)
+		GM_YXORDER(fit) = max (ival, 2)
+		GM_YYORDER(fit) = max (ival, 2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_XXORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("xxorder = %d\n")
+		    call pargi (GM_XXORDER(fit))
+	    } else {
+		GM_XXORDER(fit) = max (ival, 2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_XYORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("xyorder = %d\n")
+		    call pargi (GM_XYORDER(fit))
+	    } else {
+		GM_XYORDER(fit) = max (ival,2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_YXORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("yxorder = %d\n")
+		    call pargi (GM_YXORDER(fit))
+	    } else {
+		GM_YXORDER(fit) = max (ival, 2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_YYORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("yyorder = %d\n")
+		    call pargi (GM_YYORDER(fit))
+	    } else {
+		GM_YYORDER(fit) = max (ival, 2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_XXTERMS:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        if (rg_wrdstr ((GM_XXTERMS(fit) + 1), Memc[str], SZ_FNAME,
+	            GM_XFUNCS) <= 0)
+		    call strcpy ("none", Memc[str], SZ_FNAME)
+	        call printf ("xxterms = %s\n")
+		    call pargstr (Memc[str])
+	    } else {
+		ival = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_XFUNCS)
+		if (ival > 0) {
+		    GM_XXTERMS(fit) = ival - 1
+		    GG_NEWFUNCTION(gfit) = YES
+		    GG_FITERROR(gfit) = NO
+		}
+	    }
+
+	case GMCMD_YXTERMS:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        if (rg_wrdstr ((GM_YXTERMS(fit) + 1), Memc[str], SZ_FNAME,
+	            GM_XFUNCS) <= 0)
+		    call strcpy ("none", Memc[str], SZ_FNAME)
+	        call printf ("yxterms = %s\n")
+		    call pargstr (Memc[str])
+	    } else {
+		ival = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_XFUNCS)
+		if (ival > 0) {
+		    GM_YXTERMS(fit) = ival - 1
+		    GG_NEWFUNCTION(gfit) = YES
+		    GG_FITERROR(gfit) = NO
+		}
+	    }
+
+	case GMCMD_REJECT:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		if (IS_INDEFD(GM_REJECT(fit)))
+		    rval = INDEFR
+		else if (GM_REJECT(fit) > MAX_REAL)
+		    rval = INDEFR
+		else
+		    rval = GM_REJECT(fit)
+		call printf ("reject = %f\n")
+		    call pargr (rval)
+	    } else {
+		GM_REJECT(fit) = rval
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_MAXITER:
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("maxiter = %d\n")
+		    call pargi (GM_MAXITER(fit))
+	    } else {
+		GM_MAXITER(fit) = ival
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	}
+
+	call sfree (sp)
+end
+
+$endfor
+
+
+$for (rd)
+
+# GEO_1DELETE -- Delete a point from the fit.
+
+procedure geo_1delete$t (gd, xin, yin, wts, userwts, npts, wx, wy, delete)
+
+pointer	gd		#I pointer to graphics descriptor
+PIXEL	xin[ARB]	#I x array
+PIXEL	yin[ARB]	#I y array
+PIXEL	wts[ARB]	#I array of weights
+PIXEL	userwts[ARB]	#I array of user weights
+int	npts		#I number of points
+real	wx, wy		#I world coordinates
+int	delete		#I delete points ?
+
+int	i, j, pmltype
+real	r2min, r2, x0, y0
+int	gstati()
+
+begin
+	call gctran (gd, wx, wy, wx, wy, 1, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	if (delete == YES) {
+
+	    # Search for nearest point that has not been deleted.
+	    do i = 1, npts {
+	        if (wts[i] <= PIXEL(0.0))
+		    next
+$if (datatype == r)
+	        call gctran (gd, xin[i], yin[i], x0, y0, 1, 0)
+$else
+	        call gctran (gd, real (xin[i]), real (yin[i]), x0, y0, 1, 0)
+$endif
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Mark point and set weights to 0.
+	    if (j != 0) {
+$if (datatype == r)
+		call gscur (gd, xin[j], yin[j])
+		call gmark (gd, xin[j], yin[j], GM_CROSS, 2., 2.)
+$else
+		call gscur (gd, real(xin[j]), real(yin[j]))
+		call gmark (gd, real(xin[j]), real(yin[j]), GM_CROSS, 2., 2.)
+$endif
+		wts[j] = PIXEL(0.0)
+	    }
+
+	} else {
+
+	    # Search for the nearest deleted point.
+	    do i = 1, npts {
+	        if (wts[i] > PIXEL(0.0))
+		    next
+$if (datatype == r)
+	        call gctran (gd, xin[i], yin[i], x0, y0, 1, 0)
+$else
+	        call gctran (gd, real(xin[i]), real(yin[i]), x0, y0, 1, 0)
+$endif
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Erase cross and remark with a plus.
+	    if (j != 0) {
+$if (datatype == r)
+		call gscur (gd, xin[j], yin[j])
+		pmltype = gstati (gd, G_PMLTYPE)
+		call gseti (gd, G_PMLTYPE, 0)
+		call gmark (gd, xin[j], yin[j], GM_CROSS, 2., 2.)
+		call gseti (gd, G_PMLTYPE, pmltype)
+		call gmark (gd, xin[j], yin[j], GM_PLUS, 2., 2.)
+$else
+		call gscur (gd, real(xin[j]), real(yin[j]))
+		pmltype = gstati (gd, G_PMLTYPE)
+		call gseti (gd, G_PMLTYPE, 0)
+		call gmark (gd, real(xin[j]), real(yin[j]), GM_CROSS, 2., 2.)
+		call gseti (gd, G_PMLTYPE, pmltype)
+		call gmark (gd, real(xin[j]), real(yin[j]), GM_PLUS, 2., 2.)
+$endif
+		wts[j] = userwts[j]
+	    }
+	}
+end
+
+
+# GEO_2DELETE -- Delete the residuals.
+
+procedure geo_2delete$t (gd, x, resid, wts, userwts, npts, wx, wy, delete)
+
+pointer	gd		#I pointer to graphics descriptor
+PIXEL	x[ARB]		#I reference x values
+PIXEL	resid[ARB]	#I residuals
+PIXEL	wts[ARB]	#I weight array
+PIXEL	userwts[ARB]	#I user weight array
+int	npts		#I number of points
+real	wx		#I world x coordinate
+real	wy		#I world y coordinate
+int	delete		#I delete point
+
+int	i, j, pmltype
+real	r2, r2min, x0, y0
+int	gstati()
+
+begin
+	# Delete the point.
+        call gctran (gd, wx, wy, wx, wy, 1, 0)
+        r2min = MAX_REAL
+        j = 0
+
+	# Delete or add a point.
+        if (delete == YES) {
+
+	    # Find the nearest undeleted point.
+	    do i = 1, npts {
+	        if (wts[i] <= PIXEL(0.0))
+		    next
+$if (datatype == r)
+	        call gctran (gd, x[i], resid[i], x0, y0, 1, 0)
+$else
+	        call gctran (gd, real(x[i]), real(resid[i]), x0, y0, 1, 0)
+$endif
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Mark the point with a cross and set weight to zero.
+	    if (j != 0) {
+$if (datatype == r)
+	        call gscur (gd, x[j], resid[j])
+	        call gmark (gd, x[j], resid[j], GM_CROSS, 2., 2.)
+$else
+	        call gscur (gd, real(x[j]), real(resid[j]))
+	        call gmark (gd, real(x[j]), real(resid[j]), GM_CROSS, 2., 2.)
+$endif
+	        wts[j] = PIXEL(0.0)
+	    }
+
+        } else {
+
+	    # Find the nearest deleted point.
+	    do i = 1, npts {
+	        if (wts[i] > PIXEL(0.0))
+		    next
+$if (datatype == r)
+	        call gctran (gd, x[i], resid[i], x0, y0, 1, 0)
+$else
+	        call gctran (gd, real(x[i]), real(resid[i]), x0, y0, 1, 0)
+$endif
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Erase the cross and remark with a plus.
+	    if (j != 0) {
+$if (datatype == r)
+	        call gscur (gd, x[j], resid[j])
+	        pmltype = gstati (gd, G_PMLTYPE)
+	        call gseti (gd, G_PMLTYPE, 0)
+	        call gmark (gd, x[j], resid[j], GM_CROSS, 2., 2.)
+	        call gseti (gd, G_PMLTYPE, pmltype)
+	        call gmark (gd, x[j], resid[j], GM_PLUS, 2., 2.)
+$else
+	        call gscur (gd, real(x[j]), real(resid[j]))
+	        pmltype = gstati (gd, G_PMLTYPE)
+	        call gseti (gd, G_PMLTYPE, 0)
+	        call gmark (gd, real(x[j]), real(resid[j]), GM_CROSS, 2., 2.)
+	        call gseti (gd, G_PMLTYPE, pmltype)
+	        call gmark (gd, real(x[j]), real(resid[j]), GM_PLUS, 2., 2.)
+$endif
+	        wts[j] = userwts[j]
+	    }
+        }
+end
+
+
+# GEO_1GRAPH - Procedure to graph the distribution of the data in the x-y
+# plane. Rejected points are marked by a ' ' and deleted points are marked
+# by a ' '. The shift in position of the data points are indicated by
+# vectors. Sample fits of constant x and y are marked on the plots.
+
+procedure geo_1graph$t (gd, gt, fit, gfit, xref, yref, xin, yin, wts, npts)
+
+pointer	gd		#I pointer to the graphics device
+pointer	gt		#I pointer to the plot descriptor
+pointer	fit		#I pointer to the geofit structure
+pointer	gfit		#I pointer to the plot structure
+PIXEL	xref[ARB]	#I x reference values
+PIXEL	yref[ARB]	#I y reference values
+PIXEL	xin[ARB]	#I x values
+PIXEL	yin[ARB]	#I y values
+PIXEL	wts[ARB]	#I array of weights
+int	npts		#I number of points
+
+int	i, j
+$if (datatype == d)
+pointer	sp, rxin, ryin
+$endif
+
+begin
+	# If previous plot different type don't overplot.
+	if (GG_PLOTTYPE(gfit) != FIT)
+	    GG_OVERPLOT(gfit) = NO
+
+	# If not overplottting start new plot.
+	if (GG_OVERPLOT(gfit) == NO) {
+
+	    # Set scale and axes.
+	    call gclear (gd)
+$if (datatype == r)
+	    call gascale (gd, xin, npts, 1)
+	    call gascale (gd, yin, npts, 2)
+$else
+	    call smark (sp)
+	    call salloc (rxin, npts, TY_REAL)
+	    call salloc (ryin, npts, TY_REAL)
+	    call achtdr (xin, Memr[rxin], npts)
+	    call achtdr (yin, Memr[ryin], npts)
+	    call gascale (gd, Memr[rxin], npts, 1)
+	    call gascale (gd, Memr[ryin], npts, 2)
+	    call sfree (sp)
+$endif
+	    call gt_swind (gd, gt)
+	    call gtlabax (gd, gt)
+
+	    # Mark the data and deleted points.
+	    do i = 1, npts {
+$if (datatype == r)
+		if (wts[i] == PIXEL(0.0))
+		    call gmark (gd, xin[i], yin[i], GM_CROSS, 2., 2.)
+		else
+		    call gmark (gd, xin[i], yin[i], GM_PLUS, 2., 2.)
+$else
+		if (wts[i] == PIXEL(0.0))
+		    call gmark (gd, real(xin[i]), real(yin[i]), GM_CROSS,
+		        2., 2.)
+		else
+		    call gmark (gd, real(xin[i]), real(yin[i]), GM_PLUS,
+		        2., 2.)
+$endif
+	    }
+
+	    call gflush (gd)
+	}
+
+	# Mark the rejected points.
+	do i = 1, GM_NREJECT(fit) {
+	    j = Memi[GM_REJ(fit)+i-1]
+$if (datatype == r)
+	    call gmark (gd, xin[j], yin[j], GM_CIRCLE, 2., 2.)
+$else
+	    call gmark (gd, real(xin[j]), real(yin[j]), GM_CIRCLE, 2., 2.)
+$endif
+	}
+
+	call gflush (gd)
+
+	# Reset the status flags
+	GG_OVERPLOT(gfit) = NO
+end
+
+
+# GEO_2GRAPH -- Graph the x and y fit residuals versus x or y .
+
+procedure geo_2graph$t (gd, gt, fit, gfit, x, resid, wts, npts)
+
+pointer	gd		#I pointer to the graphics device
+pointer	gt		#I pointer to the plot descriptor
+pointer	fit		#I pointer to geomap structure
+pointer	gfit		#I pointer to the plot structure
+PIXEL	x[ARB]		#I x reference values
+PIXEL	resid[ARB]	#I residual
+PIXEL	wts[ARB]	#I array of weights
+int	npts		#I number of points
+
+int	i, j
+pointer	sp, zero
+$if (datatype == d)
+pointer	rxin, ryin
+$endif
+
+begin
+	# Allocate space.
+	call smark (sp)
+	call salloc (zero, npts, TY_REAL)
+	call amovkr (0.0, Memr[zero], npts)
+
+	# Calculate the residuals.
+	if (GG_PLOTTYPE(gfit) == FIT)
+	    GG_OVERPLOT(gfit) = NO
+
+	if (GG_OVERPLOT(gfit) == NO) {
+
+	    call gclear (gd)
+
+	    # Set scale and axes.
+$if (datatype == r)
+	    call gascale (gd, x, npts, 1)
+	    call gascale (gd, resid, npts, 2)
+$else
+	    call salloc (rxin, npts, TY_REAL)
+	    call salloc (ryin, npts, TY_REAL)
+	    call achtdr (x, Memr[rxin], npts)
+	    call achtdr (resid, Memr[ryin], npts)
+	    call gascale (gd, Memr[rxin], npts, 1)
+	    call gascale (gd, Memr[ryin], npts, 2)
+$endif
+	    call gt_swind (gd, gt)
+	    call gtlabax (gd, gt)
+
+$if (datatype == r)
+	    call gpline (gd, x, Memr[zero], npts)
+$else
+	    call gpline (gd, Memr[rxin], Memr[zero], npts)
+$endif
+	}
+
+	# Graph residuals and mark deleted points.
+	if (GG_OVERPLOT(gfit) == NO || GG_NEWFUNCTION(gfit) == YES) {
+	    do i = 1, npts {
+$if (datatype == r)
+		if (wts[i] == PIXEL(0.0))
+		    call gmark (gd, x[i], resid[i], GM_CROSS, 2., 2.)
+		else
+		    call gmark (gd, x[i], resid[i], GM_PLUS, 2., 2.)
+$else
+		if (wts[i] == PIXEL(0.0))
+		    call gmark (gd, Memr[rxin+i-1], Memr[ryin+i-1],
+		        GM_CROSS, 2., 2.)
+		else
+		    call gmark (gd, Memr[rxin+i-1], Memr[ryin+i-1],
+		        GM_PLUS, 2., 2.)
+$endif
+	    }
+	}
+
+	# plot rejected points
+	if (GM_NREJECT(fit) > 0) {
+	    do i = 1, GM_NREJECT(fit) {
+		j = Memi[GM_REJ(fit)+i-1]
+$if (datatype == r)
+		call gmark (gd, x[j], resid[j], GM_CIRCLE, 2., 2.)
+$else
+		call gmark (gd, Memr[rxin+j-1], Memr[ryin+j-1], GM_CIRCLE,
+		    2., 2.)
+$endif
+	    }
+	}
+
+	# Reset the status flag.
+	GG_OVERPLOT(gfit) = NO
+
+	call gflush (gd)
+	call sfree (sp)
+end
+
+
+# GEO_CONXY -- Plot a set of default lines of xref = const and yref = const.
+
+procedure geo_conxy$t (gd, fit, sx1, sy1, sx2, sy2)
+
+pointer	gd		#I graphics file descriptor
+pointer	fit		#I fit descriptor
+pointer	sx1, sy1	#I pointer to the linear x and y surface fits
+pointer sx2, sy2	#I pointer to the linear x and y surface fits
+
+int	i
+pointer	sp, xtemp, ytemp, xfit1, yfit1, xfit2, yfit2
+$if (datatype == d)
+pointer	xbuf, ybuf
+$endif
+PIXEL	xint, yint, dx, dy
+
+begin
+	# allocate temporary space
+	call smark (sp)
+	call salloc (xtemp, NGRAPH, TY_PIXEL)
+	call salloc (ytemp, NGRAPH, TY_PIXEL)
+	call salloc (xfit1, NGRAPH, TY_PIXEL)
+	call salloc (yfit1, NGRAPH, TY_PIXEL)
+	call salloc (xfit2, NGRAPH, TY_PIXEL)
+	call salloc (yfit2, NGRAPH, TY_PIXEL)
+$if (datatype == d)
+	call salloc (xbuf, NGRAPH, TY_REAL)
+	call salloc (ybuf, NGRAPH, TY_REAL)
+$endif
+
+	# Calculate intervals in x and y.
+	dx = (GM_XMAX(fit) - GM_XMIN(fit)) / NINTERVALS
+	dy = (GM_YMAX(fit) - GM_YMIN(fit)) / (NGRAPH - 1)
+
+	# Set up an array of y values.
+	Mem$t[ytemp] = GM_YMIN(fit)
+	do i = 2, NGRAPH
+	    Mem$t[ytemp+i-1] = Mem$t[ytemp+i-2] + dy
+
+	# Mark lines of constant x.
+	xint = GM_XMIN(fit)
+	for (i = 1; i <= NINTERVALS + 1; i = i + 1) {
+
+	    # Set the x value.
+	    call amovk$t (xint, Mem$t[xtemp], NGRAPH)
+
+	    # X fit.
+$if (datatype == r)
+	    call gsvector (sx1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit1],
+	        NGRAPH)
+$else
+	    call dgsvector (sx1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit1],
+	        NGRAPH)
+$endif
+	    if (sx2 != NULL) {
+$if (datatype == r)
+	        call gsvector (sx2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit2],
+		    NGRAPH)
+$else
+	        call dgsvector (sx2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit2],
+		    NGRAPH)
+$endif
+	        call aadd$t (Mem$t[xfit1], Mem$t[xfit2], Mem$t[xfit1], NGRAPH)
+	    }
+
+	    # Y fit.
+$if (datatype == r)
+	    call gsvector (sy1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit1],
+	        NGRAPH)
+$else
+	    call dgsvector (sy1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit1],
+	        NGRAPH)
+$endif
+	    if (sy2 != NULL) {
+$if (datatype == r)
+	        call gsvector (sy2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit2],
+		    NGRAPH)
+$else
+	        call dgsvector (sy2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit2],
+		    NGRAPH)
+$endif
+	        call aadd$t (Mem$t[yfit1], Mem$t[yfit2], Mem$t[yfit1], NGRAPH)
+	    }
+
+	    # Plot line of constant x.
+$if (datatype == r)
+	    call gpline (gd, Memr[xfit1], Memr[yfit1], NGRAPH)
+$else
+	    call achtdr (Memd[xfit1], Memr[xbuf], NGRAPH)
+	    call achtdr (Memd[yfit1], Memr[ybuf], NGRAPH)
+	    call gpline (gd, Memr[xbuf], Memr[ybuf], NGRAPH)
+$endif
+
+	    # Update the x value.
+	    xint = xint + dx
+	}
+
+	call gflush (gd)
+
+	# Calculate x and y intervals.
+	dx = (GM_XMAX(fit) - GM_XMIN(fit)) / (NGRAPH - 1)
+	dy = (GM_YMAX(fit) - GM_YMIN(fit)) / NINTERVALS
+
+	# Set up array of x values.
+	Mem$t[xtemp] = GM_XMIN(fit)
+	do i = 2, NGRAPH
+	    Mem$t[xtemp+i-1] = Mem$t[xtemp+i-2] + dx
+
+	# Mark lines of constant y.
+	yint = GM_YMIN(fit)
+	for (i = 1; i <= NINTERVALS + 1; i = i + 1) {
+
+	    # set the y value
+	    call amovk$t (yint, Mem$t[ytemp], NGRAPH)
+
+	    # X fit.
+$if (datatype == r)
+	    call gsvector (sx1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit1],
+	        NGRAPH)
+$else
+	    call dgsvector (sx1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit1],
+	        NGRAPH)
+$endif
+	    if (sx2 != NULL) {
+$if (datatype == r)
+	        call gsvector (sx2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit2],
+		    NGRAPH)
+$else
+	        call dgsvector (sx2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit2],
+		    NGRAPH)
+$endif
+	        call aadd$t (Mem$t[xfit1], Mem$t[xfit2], Mem$t[xfit1], NGRAPH)
+	    }
+
+
+	    # Y fit.
+$if (datatype == r)
+	    call gsvector (sy1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit1],
+	        NGRAPH)
+$else
+	    call dgsvector (sy1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit1],
+	        NGRAPH)
+$endif
+	    if (sy2 != NULL) {
+$if (datatype == r)
+	        call gsvector (sy2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit2],
+		    NGRAPH)
+$else
+	        call dgsvector (sy2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit2],
+		    NGRAPH)
+$endif
+	        call aadd$t (Mem$t[yfit1], Mem$t[yfit2], Mem$t[yfit1], NGRAPH)
+	    }
+
+	    # Plot line of constant y.
+$if (datatype == r)
+	    call gpline (gd, Memr[xfit1], Memr[yfit1], NGRAPH)
+$else
+	    call achtdr (Memd[xfit1], Memr[xbuf], NGRAPH)
+	    call achtdr (Memd[yfit1], Memr[ybuf], NGRAPH)
+	    call gpline (gd, Memr[xbuf], Memr[ybuf], NGRAPH)
+$endif
+
+	    # Update the y value.
+	    yint = yint + dy
+	}
+
+	call gflush (gd)
+
+	call sfree (sp)
+end
+
+
+# GEO_LXY -- Draw a line of constant x-y.
+
+procedure geo_lxy$t (gd, fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, npts, 
+        wx, wy)
+
+pointer	gd		#I pointer to graphics descriptor
+pointer	fit		#I pointer to the fit parameters
+pointer	sx1		#I pointer to the linear x fit
+pointer	sy1		#I pointer to the linear y fit
+pointer	sx2		#I pointer to the higher order x fit
+pointer	sy2		#I pointer to the higher order y fit
+PIXEL	xref[ARB]	#I x reference values
+PIXEL	yref[ARB]	#I y reference values
+PIXEL	xin[ARB]	#I x input values
+PIXEL	yin[ARB]	#I y input values
+int	npts		#I number of data points
+real	wx, wy		#I x and y world coordinates
+
+int	i, j
+pointer	sp, xtemp, ytemp, xfit1, yfit1, xfit2, yfit2
+$if (datatype == d)
+pointer	xbuf, ybuf
+$endif
+real	x0, y0, r2, r2min
+PIXEL	delta, deltax, deltay
+$if (datatype == r)
+real	gseval()
+$else
+double	dgseval()
+$endif
+
+begin
+	# Transform world coordinates.
+	call gctran (gd, wx, wy, wx, wy, 1, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	# Find the nearest data point.
+	do i = 1, npts {
+$if (datatype == r)
+	    call gctran (gd, xin[i], yin[i], x0, y0, 1, 0)
+$else
+	    call gctran (gd, real(xin[i]), real(yin[i]), x0, y0, 1, 0)
+$endif
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+	        r2min = r2
+	        j = i
+	    }
+	}
+
+	# Fit the line
+	if (j != 0) {
+
+	    # Allocate temporary space.
+	    call smark (sp)
+	    call salloc (xtemp, NGRAPH, TY_PIXEL)
+	    call salloc (ytemp, NGRAPH, TY_PIXEL)
+	    call salloc (xfit1, NGRAPH, TY_PIXEL)
+	    call salloc (yfit1, NGRAPH, TY_PIXEL)
+	    call salloc (xfit2, NGRAPH, TY_PIXEL)
+	    call salloc (yfit2, NGRAPH, TY_PIXEL)
+$if (datatype == d)
+	    call salloc (xbuf, NGRAPH, TY_REAL)
+	    call salloc (ybuf, NGRAPH, TY_REAL)
+$endif
+
+	    # Compute the deltas.
+$if (datatype == r)
+	    deltax = xin[j] - gseval (sx1, xref[j], yref[j])
+	    if (sx2 != NULL)
+	        deltax = deltax - gseval (sx2, xref[j], yref[j])
+	    deltay = yin[j] - gseval (sy1, xref[j], yref[j])
+	    if (sy2 != NULL)
+		deltay = deltay - gseval (sy2, xref[j], yref[j])
+$else
+	    deltax = xin[j] - dgseval (sx1, xref[j], yref[j])
+	    if (sx2 != NULL)
+	        deltax = deltax - dgseval (sx2, xref[j], yref[j])
+	    deltay = yin[j] - dgseval (sy1, xref[j], yref[j])
+	    if (sy2 != NULL)
+		deltay = deltay - dgseval (sy2, xref[j], yref[j])
+$endif
+
+	    # Set up line of constant x.
+	    call amovk$t (xref[j], Mem$t[xtemp], NGRAPH)
+	    delta = (GM_YMAX(fit) - GM_YMIN(fit)) / (NGRAPH - 1)
+	    Mem$t[ytemp] = GM_YMIN(fit)
+	    do i = 2, NGRAPH
+	        Mem$t[ytemp+i-1] = Mem$t[ytemp+i-2] + delta
+
+	    # X solution.
+$if (datatype == r)
+	    call gsvector (sx1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit1],
+	        NGRAPH)
+$else
+	    call dgsvector (sx1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit1],
+	        NGRAPH)
+$endif
+	    if (sx2 != NULL) {
+$if (datatype == r)
+	        call gsvector (sx2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit2],
+		    NGRAPH)
+$else
+	        call dgsvector (sx2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit2],
+		    NGRAPH)
+$endif
+	        call aadd$t (Mem$t[xfit1], Mem$t[xfit2], Mem$t[xfit1], NGRAPH)
+	    }
+	    call aaddk$t (Mem$t[xfit1], deltax, Mem$t[xfit1], NGRAPH)
+
+	    # Y solution.
+$if (datatype == r)
+	    call gsvector (sy1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit1],
+	        NGRAPH)
+$else
+	    call dgsvector (sy1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit1],
+	        NGRAPH)
+$endif
+	    if (sy2 != NULL) {
+$if (datatype == r)
+	        call gsvector (sy2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit2],
+		    NGRAPH)
+$else
+	        call dgsvector (sy2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit2],
+		    NGRAPH)
+$endif
+	        call aadd$t (Mem$t[yfit1], Mem$t[yfit2], Mem$t[yfit1], NGRAPH)
+	    }
+	    call aaddk$t (Mem$t[yfit1], deltay, Mem$t[yfit1], NGRAPH)
+
+	    # Plot line of constant x.
+$if (datatype == r)
+	    call gpline (gd, Memr[xfit1], Memr[yfit1], NGRAPH)
+$else
+	    call achtdr (Memd[xfit1], Memr[xbuf], NGRAPH)
+	    call achtdr (Memd[yfit1], Memr[ybuf], NGRAPH)
+	    call gpline (gd, Memr[xbuf], Memr[ybuf], NGRAPH)
+$endif
+	    call gflush (gd)
+
+	    # Set up line of constant y.
+	    call amovk$t (yref[j], Mem$t[ytemp], NGRAPH)
+	    delta = (GM_XMAX(fit) - GM_XMIN(fit)) / (NGRAPH - 1)
+	    Mem$t[xtemp] = GM_XMIN(fit)
+	    do i = 2, NGRAPH
+	        Mem$t[xtemp+i-1] = Mem$t[xtemp+i-2] + delta
+
+	    # X fit.
+$if (datatype == r)
+	    call gsvector (sx1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit1],
+	        NGRAPH)
+$else
+	    call dgsvector (sx1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit1],
+	        NGRAPH)
+$endif
+	    if (sx2 != NULL) {
+$if (datatype == r)
+	        call gsvector (sx2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit2],
+		    NGRAPH)
+$else
+	        call dgsvector (sx2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[xfit2],
+		    NGRAPH)
+$endif
+	        call aadd$t (Mem$t[xfit1], Mem$t[xfit2], Mem$t[xfit1], NGRAPH)
+	    }
+	    call aaddk$t (Mem$t[xfit1], deltax, Mem$t[xfit1], NGRAPH)
+
+	    # Y fit.
+$if (datatype == r)
+	    call gsvector (sy1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit1],
+	        NGRAPH)
+$else
+	    call dgsvector (sy1, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit1],
+	        NGRAPH)
+$endif
+	    if (sy2 != NULL) {
+$if (datatype == r)
+	        call gsvector (sy2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit2],
+		    NGRAPH)
+$else
+	        call dgsvector (sy2, Mem$t[xtemp], Mem$t[ytemp], Mem$t[yfit2],
+		    NGRAPH)
+$endif
+	        call aadd$t (Mem$t[yfit1], Mem$t[yfit2], Mem$t[yfit1], NGRAPH)
+	    }
+	    call aaddk$t (Mem$t[yfit1], deltay, Mem$t[yfit1], NGRAPH)
+
+	    # Plot line of constant y.
+$if (datatype == r)
+	    call gpline (gd, Memr[xfit1], Memr[yfit1], NGRAPH)
+$else
+	    call achtdr (Memd[xfit1], Memr[xbuf], NGRAPH)
+	    call achtdr (Memd[yfit1], Memr[ybuf], NGRAPH)
+	    call gpline (gd, Memr[xbuf], Memr[ybuf], NGRAPH)
+$endif
+	    call gflush (gd)
+
+	    # Free space.
+	    call sfree (sp)
+	}
+end
+
+
+# GEO_GCOEFF -- Print the coefficents of the linear portion of the
+# fit, xshift, yshift, 
+
+procedure geo_gcoeff$t (sx, sy, xshift, yshift, a, b, c, d)
+
+pointer	sx		#I pointer to the x surface fit
+pointer	sy		#I pointer to the y surface fit
+PIXEL	xshift		#O output x shift
+PIXEL	yshift		#O output y shift
+PIXEL	a		#O output x coefficient of x fit
+PIXEL	b		#O output y coefficient of x fit
+PIXEL	c		#O output x coefficient of y fit
+PIXEL	d		#O output y coefficient of y fit
+
+int	nxxcoeff, nxycoeff, nyxcoeff, nyycoeff
+pointer	sp, xcoeff, ycoeff
+PIXEL	xxrange, xyrange, xxmaxmin, xymaxmin
+PIXEL	yxrange, yyrange, yxmaxmin, yymaxmin
+
+$if (datatype == r)
+int	gsgeti()
+real	gsgetr()
+$else
+int	dgsgeti()
+double	dgsgetd()
+$endif
+
+begin
+	# Allocate working space.
+	call smark (sp)
+$if (datatype == r)
+	call salloc (xcoeff, gsgeti (sx, GSNCOEFF), TY_PIXEL)
+	call salloc (ycoeff, gsgeti (sy, GSNCOEFF), TY_PIXEL)
+$else
+	call salloc (xcoeff, dgsgeti (sx, GSNCOEFF), TY_PIXEL)
+	call salloc (ycoeff, dgsgeti (sy, GSNCOEFF), TY_PIXEL)
+$endif
+
+	# Get coefficients and numbers of coefficients.
+$if (datatype == r)
+	call gscoeff (sx, Mem$t[xcoeff], nxxcoeff)
+	call gscoeff (sy, Mem$t[ycoeff], nyycoeff)
+	nxxcoeff = gsgeti (sx, GSNXCOEFF)
+	nxycoeff = gsgeti (sx, GSNYCOEFF)
+	nyxcoeff = gsgeti (sy, GSNXCOEFF)
+	nyycoeff = gsgeti (sy, GSNYCOEFF)
+$else
+	call dgscoeff (sx, Mem$t[xcoeff], nxxcoeff)
+	call dgscoeff (sy, Mem$t[ycoeff], nyycoeff)
+	nxxcoeff = dgsgeti (sx, GSNXCOEFF)
+	nxycoeff = dgsgeti (sx, GSNYCOEFF)
+	nyxcoeff = dgsgeti (sy, GSNXCOEFF)
+	nyycoeff = dgsgeti (sy, GSNYCOEFF)
+$endif
+
+	# Get the data range.
+$if (datatype == r)
+	if (gsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+	    xxrange = (gsgetr (sx, GSXMAX) - gsgetr (sx, GSXMIN)) / 2.0
+	    xxmaxmin = - (gsgetr (sx, GSXMAX) + gsgetr (sx, GSXMIN)) / 2.0
+	    xyrange = (gsgetr (sx, GSYMAX) - gsgetr (sx, GSYMIN)) / 2.0
+	    xymaxmin = - (gsgetr (sx, GSYMAX) + gsgetr (sx, GSYMIN)) / 2.0
+$else
+	if (dgsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+	    xxrange = (dgsgetd (sx, GSXMAX) - dgsgetd (sx, GSXMIN)) / 2.0d0
+	    xxmaxmin = - (dgsgetd (sx, GSXMAX) + dgsgetd (sx, GSXMIN)) / 2.0d0
+	    xyrange = (dgsgetd (sx, GSYMAX) - dgsgetd (sx, GSYMIN)) / 2.0d0
+	    xymaxmin = - (dgsgetd (sx, GSYMAX) + dgsgetd (sx, GSYMIN)) / 2.0d0
+$endif
+	} else {
+	    xxrange = PIXEL(1.0)
+	    xxmaxmin = PIXEL(0.0)
+	    xyrange = PIXEL(1.0)
+	    xymaxmin = PIXEL(0.0)
+	}
+
+$if (datatype == r)
+	if (gsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+	    yxrange = (gsgetr (sy, GSXMAX) - gsgetr (sy, GSXMIN)) / 2.0
+	    yxmaxmin = - (gsgetr (sy, GSXMAX) + gsgetr (sy, GSXMIN)) / 2.0
+	    yyrange = (gsgetr (sy, GSYMAX) - gsgetr (sy, GSYMIN)) / 2.0
+	    yymaxmin = - (gsgetr (sy, GSYMAX) + gsgetr (sy, GSYMIN)) / 2.0
+$else
+	if (dgsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+	    yxrange = (dgsgetd (sy, GSXMAX) - dgsgetd (sy, GSXMIN)) / 2.0d0
+	    yxmaxmin = - (dgsgetd (sy, GSXMAX) + dgsgetd (sy, GSXMIN)) / 2.0d0
+	    yyrange = (dgsgetd (sy, GSYMAX) - dgsgetd (sy, GSYMIN)) / 2.0d0
+	    yymaxmin = - (dgsgetd (sy, GSYMAX) + dgsgetd (sy, GSYMIN)) / 2.0d0
+$endif
+	} else {
+	    yxrange = PIXEL(1.0)
+	    yxmaxmin = PIXEL(0.0)
+	    yyrange = PIXEL(1.0)
+	    yymaxmin = PIXEL(0.0)
+	}
+
+	# Get the shifts.
+	xshift = Mem$t[xcoeff] + Mem$t[xcoeff+1] * xxmaxmin / xxrange +
+	    Mem$t[xcoeff+2] * xymaxmin / xyrange
+	yshift = Mem$t[ycoeff] + Mem$t[ycoeff+1] * yxmaxmin / yxrange +
+	    Mem$t[ycoeff+2] * yymaxmin / yyrange
+
+	# Get the rotation and scaling parameters and correct for normalization.
+	if (nxxcoeff > 1)
+	    a = Mem$t[xcoeff+1] / xxrange
+	else
+	    a = PIXEL(0.0)
+	if (nxycoeff > 1)
+	    b = Mem$t[xcoeff+nxxcoeff] / xyrange
+	else
+	    b = PIXEL(0.0)
+	if (nyxcoeff > 1)
+	    c = Mem$t[ycoeff+1] / yxrange
+	else
+	    c = PIXEL(0.0)
+	if (nyycoeff > 1)
+	    d = Mem$t[ycoeff+nyxcoeff] / yyrange
+	else
+	    d = PIXEL(0.0)
+
+	call sfree (sp)
+end
+
+$endfor
diff --git a/pkg/images/lib/geograph.x b/pkg/images/lib/geograph.x
new file mode 100644
index 00000000..6597311a
--- /dev/null
+++ b/pkg/images/lib/geograph.x
@@ -0,0 +1,1740 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math/gsurfit.h>
+include <pkg/gtools.h>
+include <mach.h>
+include <math.h>
+include <gset.h>
+include "geomap.h"
+include "geogmap.h"
+
+define	MAX_PARAMS	(10 * SZ_LINE)	
+define	NINTERVALS	5
+define	NGRAPH		100
+
+
+
+# GEO_LABEL -- Annotate the plot.
+
+procedure geo_label (plot_type, gt, fit)
+
+int	plot_type	#I type of plot
+pointer	gt		#I gtools descriptor
+pointer	fit		#I geomap fit parameters
+
+int	npts
+pointer	sp, params, xtermlab, ytermlab
+real	xrms, yrms, rej
+int	strlen(), rg_wrdstr()
+
+begin
+	call smark (sp)
+	call salloc (params, MAX_PARAMS, TY_CHAR)
+	call salloc (xtermlab, SZ_FNAME, TY_CHAR)
+	call salloc (ytermlab, SZ_FNAME, TY_CHAR)
+
+	npts = max (0, GM_NPTS(fit) - GM_NWTS0(fit))
+	xrms = max (0.0d0, GM_XRMS(fit))
+	yrms = max (0.0d0, GM_YRMS(fit))
+	if (npts > 1) {
+	    xrms = sqrt (xrms / (npts - 1))
+	    yrms = sqrt (yrms / (npts - 1))
+	} else {
+	    xrms = 0.0
+	    yrms = 0.0
+	}
+	if (IS_INDEFD(GM_REJECT(fit)))
+	    rej = INDEFR
+	else if (GM_REJECT(fit) > MAX_REAL)
+	    rej = INDEFR
+	else
+	    rej = GM_REJECT(fit)
+
+	# Print data parameters.
+	if (GM_PROJECTION(fit) == GM_NONE)
+	    call sprintf (Memc[params], MAX_PARAMS,
+	        "GEOMAP: function = %s npts = %d reject = %g nrej = %d\n")
+	else
+	    call sprintf (Memc[params], MAX_PARAMS,
+	        "CCMAP: function = %s npts = %d reject = %g nrej = %d\n")
+
+	    switch (GM_FUNCTION(fit)) {
+	    case GS_LEGENDRE:
+		call pargstr ("legendre")
+	    case GS_CHEBYSHEV:
+		call pargstr ("chebyshev")
+	    case GS_POLYNOMIAL:
+		call pargstr ("polynomial")
+	    }
+	    call pargi (GM_NPTS(fit))
+	    call pargr (rej)
+	    call pargi (GM_NWTS0(fit))
+
+	# Print fit parameters.
+	switch (plot_type) {
+	case FIT:
+
+	    if (rg_wrdstr ((GM_XXTERMS(fit) + 1), Memc[xtermlab], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[xtermlab], SZ_FNAME)
+	    if (rg_wrdstr ((GM_YXTERMS(fit) + 1), Memc[ytermlab], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[ytermlab], SZ_FNAME)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	        "X fit: xorder = %d yorder = %d xterms = %s stdev = %8.3g\n")
+	    else
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	   "XI fit: xorder = %d yorder = %d xterms = %s stdev = %8.3g arcsec\n")
+		call pargi (GM_XXORDER(fit))
+		call pargi (GM_XYORDER(fit))
+		call pargstr (Memc[xtermlab])
+		call pargr (xrms)
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	        "Y fit: xorder = %d yorder = %d xterms = %s stdev = %8.3g\n")
+	    else
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	  "ETA fit: xorder = %d yorder = %d xterms = %s stdev = %8.3g arcsec\n")
+		call pargi (GM_YXORDER(fit))
+		call pargi (GM_YYORDER(fit))
+		call pargstr (Memc[ytermlab])
+		call pargr (yrms)
+
+	case XXRESID, XYRESID:
+
+	    if (rg_wrdstr ((GM_XXTERMS(fit) + 1), Memc[xtermlab], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[xtermlab], SZ_FNAME)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	        "X fit: xorder = %d yorder = %d xterms = %s rms = %8.3g\n")
+	    else
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	    "XI fit: xorder = %d yorder = %d xterms = %s rms = %8.3g arcsec\n")
+		call pargi (GM_XXORDER(fit))
+		call pargi (GM_XYORDER(fit))
+		call pargstr (Memc[xtermlab])
+		call pargr (xrms)
+
+	case YXRESID, YYRESID:
+
+	    if (rg_wrdstr ((GM_YXTERMS(fit) + 1), Memc[ytermlab], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[ytermlab], SZ_FNAME)
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	        "Y fit: xorder = %d yorder = %d xterms = %s rms = %8.3g\n")
+	    else
+	        call sprintf (Memc[params+strlen(Memc[params])], MAX_PARAMS,
+	    "ETA fit: xorder = %d yorder = %d xterms = %s rms = %8.3g arcsec\n")
+		call pargi (GM_YXORDER(fit))
+		call pargi (GM_YYORDER(fit))
+		call pargstr (Memc[ytermlab])
+		call pargr (yrms)
+
+	default:
+
+	    # do nothing gracefully
+	}
+
+	call gt_sets (gt, GTPARAMS, Memc[params])
+
+	call sfree (sp)
+end
+
+
+# GEO_GTSET -- Write title and labels.
+
+procedure geo_gtset (plot_type, gt, fit)
+
+int	plot_type	#I plot type
+pointer	gt		#I plot descriptor
+pointer	fit		#I fit descriptor
+
+char	str[SZ_LINE]
+int	nchars
+int	gstrcpy()
+
+begin
+	nchars =  gstrcpy (GM_RECORD(fit), str, SZ_LINE)
+
+	switch (plot_type) {
+	case FIT:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": Coordinate Transformation", str[nchars+1],
+		    SZ_LINE)
+	    else
+	        call strcpy (": Celestial Coordinate Transformation",
+		    str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "X (in units)")
+	        call gt_sets (gt, GTYLABEL, "Y (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "XI (arcsec)")
+	        call gt_sets (gt, GTYLABEL, "ETA (arcsec)") 
+	    }
+
+	case XXRESID:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": X fit Residuals", str[nchars+1], SZ_LINE)
+	    else
+	        call strcpy (": XI fit Residuals", str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "X (ref units)")
+	        call gt_sets (gt, GTYLABEL, "X Residuals (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "X (pixels)")
+	        call gt_sets (gt, GTYLABEL, "XI Residuals (arcsec)") 
+	    }
+
+	case XYRESID:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": X fit Residuals", str[nchars+1], SZ_LINE)
+	    else
+	        call strcpy (": XI fit Residuals", str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "Y (ref units)")
+	        call gt_sets (gt, GTYLABEL, "X Residuals (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "Y (pixels)")
+	        call gt_sets (gt, GTYLABEL, "XI Residuals (arcsec)") 
+	    }
+
+	case YXRESID:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": Y fit Residuals", str[nchars+1], SZ_LINE)
+	    else
+	        call strcpy (": ETA fit Residuals", str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "X (ref units)")
+	        call gt_sets (gt, GTYLABEL, "Y (Residuals (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "X (pixels)")
+	        call gt_sets (gt, GTYLABEL, "ETA Residuals (arcsec)") 
+	    }
+
+	case YYRESID:
+
+	    if (GM_PROJECTION(fit) == GM_NONE)
+	        call strcpy (": Y fit Residuals", str[nchars+1], SZ_LINE)
+	    else
+	        call strcpy (": ETA fit Residuals", str[nchars+1], SZ_LINE)
+	    call gt_sets (gt, GTTITLE, str)
+	    if (GM_PROJECTION(fit) == GM_NONE) {
+	        call gt_sets (gt, GTXLABEL, "Y (ref units)")
+	        call gt_sets (gt, GTYLABEL, "Y Residuals (in units)") 
+	    } else {
+	        call gt_sets (gt, GTXLABEL, "Y (pixels)")
+	        call gt_sets (gt, GTYLABEL, "ETA Residuals (arcsec)") 
+	    }
+
+	default:
+	    
+	    # do nothing gracefully
+	}
+end
+
+
+# GEO_COLON -- Process the colon commands.
+
+procedure geo_colon (gd, fit, gfit, cmdstr, newgraph)
+
+pointer	gd		#I graphics stream
+pointer	fit		#I pointer to fit structure
+pointer	gfit		#I pointer to the gfit structure
+char	cmdstr[ARB]	#I command string
+int	newgraph	#I plot new graph
+
+int	ncmd, ival
+pointer	sp, str, cmd
+real	rval
+int	nscan(), strdic(), rg_wrdstr()
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], SZ_LINE)
+	if (nscan() == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_CMDS)
+	switch (ncmd) {
+	case GMCMD_SHOW:
+	    call gdeactivate (gd, AW_CLEAR)
+	    call printf ("Current Fitting Parameters\n\n")
+	    if (GM_PROJECTION(fit) != GM_NONE) {
+	        if (rg_wrdstr (GM_PROJECTION(fit), Memc[str], SZ_FNAME,
+	            GM_PROJLIST) <= 0)
+		    ;
+	        call printf ("\tprojection = %s\n")
+		    call pargstr (Memc[str])
+	        call printf ("\tlngref = %h\n")
+		    call pargd (GM_XREFPT(fit))
+	        call printf ("\tlatref = %h\n")
+		    call pargd (GM_YREFPT(fit))
+	    }
+	    if (rg_wrdstr (GM_FIT(fit), Memc[str], SZ_FNAME,
+	        GM_GEOMETRIES) <= 0)
+		call strcpy ("general", Memc[str], SZ_FNAME)
+	    call printf ("\tfitgeometry = %s\n")
+		call pargstr (Memc[str])
+	    if (rg_wrdstr (GM_FUNCTION(fit), Memc[str], SZ_FNAME,
+	        GM_FUNCS) <= 0)
+		call strcpy ("polynomial", Memc[str], SZ_FNAME)
+	    call printf ("\tfunction = %s\n")
+		Call pargstr (Memc[str])
+	    call printf ("\txxorder = %d\n")
+		call pargi (GM_XXORDER(fit))
+	    call printf ("\txyorder = %d\n")
+		call pargi (GM_XYORDER(fit))
+	    if (rg_wrdstr ((GM_XXTERMS(fit) + 1), Memc[str], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[str], SZ_FNAME)
+	    call printf ("\txxterms = %s\n")
+		call pargstr (Memc[str])
+	    call printf ("\tyxorder = %d\n")
+		call pargi (GM_YXORDER(fit))
+	    call printf ("\tyyorder = %d\n")
+		call pargi (GM_YYORDER(fit))
+	    if (rg_wrdstr ((GM_YXTERMS(fit) + 1), Memc[str], SZ_FNAME,
+	        GM_XFUNCS) <= 0)
+		call strcpy ("none", Memc[str], SZ_FNAME)
+	    call printf ("\tyxterms = %s\n")
+		call pargstr (Memc[str])
+	    if (IS_INDEFD(GM_REJECT(fit)))
+		rval = INDEFR
+	    else if (GM_REJECT(fit) > MAX_REAL)
+		rval = INDEFR
+	    else
+		rval = GM_REJECT(fit)
+	    call printf ("\treject = %f\n")
+		call pargr (rval)
+	    call greactivate (gd, AW_PAUSE)
+
+	case GMCMD_PROJECTION:
+	    if (rg_wrdstr (GM_PROJECTION(fit), Memc[str], SZ_FNAME,
+	        GM_PROJLIST) <= 0)
+	        call strcpy ("INDEF", Memc[str], SZ_FNAME)
+	    call printf ("projection = %s\n")
+	        call pargstr (Memc[str])
+
+	case GMCMD_REFPOINT:
+	    call printf ("lngref = %h latref = %h\n")
+		call pargd (GM_XREFPT(fit))
+		call pargd (GM_YREFPT(fit))
+
+	case GMCMD_GEOMETRY:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        if (rg_wrdstr (GM_FIT(fit), Memc[str], SZ_FNAME,
+	            GM_GEOMETRIES) <= 0)
+		    call strcpy ("general", Memc[str], SZ_FNAME)
+	        call printf ("fitgeometry = %s\n")
+		    call pargstr (Memc[str])
+	    } else {
+		ival = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_GEOMETRIES)
+		if (ival > 0) {
+		    GM_FIT(fit) = ival
+		    GG_NEWFUNCTION(gfit) = YES
+		    GG_FITERROR(gfit) = NO
+		}
+	    }
+
+	case GMCMD_FUNCTION:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        if (rg_wrdstr (GM_FUNCTION(fit), Memc[str], SZ_FNAME,
+	            GM_FUNCS) <= 0)
+		    call strcpy ("polynomial", Memc[str], SZ_FNAME)
+	        call printf ("function = %s\n")
+		    call pargstr (Memc[str])
+	    } else {
+		ival = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_FUNCS)
+		if (ival > 0) {
+		    GM_FUNCTION(fit) = ival
+		    GG_NEWFUNCTION(gfit) = YES
+		    GG_FITERROR(gfit) = NO
+		}
+	    }
+
+	case GMCMD_ORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf (
+		    "xxorder = %d xyorder = %d yxorder = %d yyorder = %d\n")
+		    call pargi (GM_XXORDER(fit))
+		    call pargi (GM_XYORDER(fit))
+		    call pargi (GM_YXORDER(fit))
+		    call pargi (GM_YYORDER(fit))
+	    } else {
+		GM_XXORDER(fit) = max (ival, 2)
+		GM_XYORDER(fit) = max (ival, 2)
+		GM_YXORDER(fit) = max (ival, 2)
+		GM_YYORDER(fit) = max (ival, 2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_XXORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("xxorder = %d\n")
+		    call pargi (GM_XXORDER(fit))
+	    } else {
+		GM_XXORDER(fit) = max (ival, 2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_XYORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("xyorder = %d\n")
+		    call pargi (GM_XYORDER(fit))
+	    } else {
+		GM_XYORDER(fit) = max (ival,2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_YXORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("yxorder = %d\n")
+		    call pargi (GM_YXORDER(fit))
+	    } else {
+		GM_YXORDER(fit) = max (ival, 2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_YYORDER:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("yyorder = %d\n")
+		    call pargi (GM_YYORDER(fit))
+	    } else {
+		GM_YYORDER(fit) = max (ival, 2)
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_XXTERMS:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        if (rg_wrdstr ((GM_XXTERMS(fit) + 1), Memc[str], SZ_FNAME,
+	            GM_XFUNCS) <= 0)
+		    call strcpy ("none", Memc[str], SZ_FNAME)
+	        call printf ("xxterms = %s\n")
+		    call pargstr (Memc[str])
+	    } else {
+		ival = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_XFUNCS)
+		if (ival > 0) {
+		    GM_XXTERMS(fit) = ival - 1
+		    GG_NEWFUNCTION(gfit) = YES
+		    GG_FITERROR(gfit) = NO
+		}
+	    }
+
+	case GMCMD_YXTERMS:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        if (rg_wrdstr ((GM_YXTERMS(fit) + 1), Memc[str], SZ_FNAME,
+	            GM_XFUNCS) <= 0)
+		    call strcpy ("none", Memc[str], SZ_FNAME)
+	        call printf ("yxterms = %s\n")
+		    call pargstr (Memc[str])
+	    } else {
+		ival = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GM_XFUNCS)
+		if (ival > 0) {
+		    GM_YXTERMS(fit) = ival - 1
+		    GG_NEWFUNCTION(gfit) = YES
+		    GG_FITERROR(gfit) = NO
+		}
+	    }
+
+	case GMCMD_REJECT:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		if (IS_INDEFD(GM_REJECT(fit)))
+		    rval = INDEFR
+		else if (GM_REJECT(fit) > MAX_REAL)
+		    rval = INDEFR
+		else
+		    rval = GM_REJECT(fit)
+		call printf ("reject = %f\n")
+		    call pargr (rval)
+	    } else {
+		GM_REJECT(fit) = rval
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	case GMCMD_MAXITER:
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("maxiter = %d\n")
+		    call pargi (GM_MAXITER(fit))
+	    } else {
+		GM_MAXITER(fit) = ival
+		GG_NEWFUNCTION(gfit) = YES
+		GG_FITERROR(gfit) = NO
+	    }
+
+	}
+
+	call sfree (sp)
+end
+
+
+
+
+
+
+# GEO_1DELETE -- Delete a point from the fit.
+
+procedure geo_1deleter (gd, xin, yin, wts, userwts, npts, wx, wy, delete)
+
+pointer	gd		#I pointer to graphics descriptor
+real	xin[ARB]	#I x array
+real	yin[ARB]	#I y array
+real	wts[ARB]	#I array of weights
+real	userwts[ARB]	#I array of user weights
+int	npts		#I number of points
+real	wx, wy		#I world coordinates
+int	delete		#I delete points ?
+
+int	i, j, pmltype
+real	r2min, r2, x0, y0
+int	gstati()
+
+begin
+	call gctran (gd, wx, wy, wx, wy, 1, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	if (delete == YES) {
+
+	    # Search for nearest point that has not been deleted.
+	    do i = 1, npts {
+	        if (wts[i] <= real(0.0))
+		    next
+	        call gctran (gd, xin[i], yin[i], x0, y0, 1, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Mark point and set weights to 0.
+	    if (j != 0) {
+		call gscur (gd, xin[j], yin[j])
+		call gmark (gd, xin[j], yin[j], GM_CROSS, 2., 2.)
+		wts[j] = real(0.0)
+	    }
+
+	} else {
+
+	    # Search for the nearest deleted point.
+	    do i = 1, npts {
+	        if (wts[i] > real(0.0))
+		    next
+	        call gctran (gd, xin[i], yin[i], x0, y0, 1, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Erase cross and remark with a plus.
+	    if (j != 0) {
+		call gscur (gd, xin[j], yin[j])
+		pmltype = gstati (gd, G_PMLTYPE)
+		call gseti (gd, G_PMLTYPE, 0)
+		call gmark (gd, xin[j], yin[j], GM_CROSS, 2., 2.)
+		call gseti (gd, G_PMLTYPE, pmltype)
+		call gmark (gd, xin[j], yin[j], GM_PLUS, 2., 2.)
+		wts[j] = userwts[j]
+	    }
+	}
+end
+
+
+# GEO_2DELETE -- Delete the residuals.
+
+procedure geo_2deleter (gd, x, resid, wts, userwts, npts, wx, wy, delete)
+
+pointer	gd		#I pointer to graphics descriptor
+real	x[ARB]		#I reference x values
+real	resid[ARB]	#I residuals
+real	wts[ARB]	#I weight array
+real	userwts[ARB]	#I user weight array
+int	npts		#I number of points
+real	wx		#I world x coordinate
+real	wy		#I world y coordinate
+int	delete		#I delete point
+
+int	i, j, pmltype
+real	r2, r2min, x0, y0
+int	gstati()
+
+begin
+	# Delete the point.
+        call gctran (gd, wx, wy, wx, wy, 1, 0)
+        r2min = MAX_REAL
+        j = 0
+
+	# Delete or add a point.
+        if (delete == YES) {
+
+	    # Find the nearest undeleted point.
+	    do i = 1, npts {
+	        if (wts[i] <= real(0.0))
+		    next
+	        call gctran (gd, x[i], resid[i], x0, y0, 1, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Mark the point with a cross and set weight to zero.
+	    if (j != 0) {
+	        call gscur (gd, x[j], resid[j])
+	        call gmark (gd, x[j], resid[j], GM_CROSS, 2., 2.)
+	        wts[j] = real(0.0)
+	    }
+
+        } else {
+
+	    # Find the nearest deleted point.
+	    do i = 1, npts {
+	        if (wts[i] > real(0.0))
+		    next
+	        call gctran (gd, x[i], resid[i], x0, y0, 1, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Erase the cross and remark with a plus.
+	    if (j != 0) {
+	        call gscur (gd, x[j], resid[j])
+	        pmltype = gstati (gd, G_PMLTYPE)
+	        call gseti (gd, G_PMLTYPE, 0)
+	        call gmark (gd, x[j], resid[j], GM_CROSS, 2., 2.)
+	        call gseti (gd, G_PMLTYPE, pmltype)
+	        call gmark (gd, x[j], resid[j], GM_PLUS, 2., 2.)
+	        wts[j] = userwts[j]
+	    }
+        }
+end
+
+
+# GEO_1GRAPH - Procedure to graph the distribution of the data in the x-y
+# plane. Rejected points are marked by a ' ' and deleted points are marked
+# by a ' '. The shift in position of the data points are indicated by
+# vectors. Sample fits of constant x and y are marked on the plots.
+
+procedure geo_1graphr (gd, gt, fit, gfit, xref, yref, xin, yin, wts, npts)
+
+pointer	gd		#I pointer to the graphics device
+pointer	gt		#I pointer to the plot descriptor
+pointer	fit		#I pointer to the geofit structure
+pointer	gfit		#I pointer to the plot structure
+real	xref[ARB]	#I x reference values
+real	yref[ARB]	#I y reference values
+real	xin[ARB]	#I x values
+real	yin[ARB]	#I y values
+real	wts[ARB]	#I array of weights
+int	npts		#I number of points
+
+int	i, j
+
+begin
+	# If previous plot different type don't overplot.
+	if (GG_PLOTTYPE(gfit) != FIT)
+	    GG_OVERPLOT(gfit) = NO
+
+	# If not overplottting start new plot.
+	if (GG_OVERPLOT(gfit) == NO) {
+
+	    # Set scale and axes.
+	    call gclear (gd)
+	    call gascale (gd, xin, npts, 1)
+	    call gascale (gd, yin, npts, 2)
+	    call gt_swind (gd, gt)
+	    call gtlabax (gd, gt)
+
+	    # Mark the data and deleted points.
+	    do i = 1, npts {
+		if (wts[i] == real(0.0))
+		    call gmark (gd, xin[i], yin[i], GM_CROSS, 2., 2.)
+		else
+		    call gmark (gd, xin[i], yin[i], GM_PLUS, 2., 2.)
+	    }
+
+	    call gflush (gd)
+	}
+
+	# Mark the rejected points.
+	do i = 1, GM_NREJECT(fit) {
+	    j = Memi[GM_REJ(fit)+i-1]
+	    call gmark (gd, xin[j], yin[j], GM_CIRCLE, 2., 2.)
+	}
+
+	call gflush (gd)
+
+	# Reset the status flags
+	GG_OVERPLOT(gfit) = NO
+end
+
+
+# GEO_2GRAPH -- Graph the x and y fit residuals versus x or y .
+
+procedure geo_2graphr (gd, gt, fit, gfit, x, resid, wts, npts)
+
+pointer	gd		#I pointer to the graphics device
+pointer	gt		#I pointer to the plot descriptor
+pointer	fit		#I pointer to geomap structure
+pointer	gfit		#I pointer to the plot structure
+real	x[ARB]		#I x reference values
+real	resid[ARB]	#I residual
+real	wts[ARB]	#I array of weights
+int	npts		#I number of points
+
+int	i, j
+pointer	sp, zero
+
+begin
+	# Allocate space.
+	call smark (sp)
+	call salloc (zero, npts, TY_REAL)
+	call amovkr (0.0, Memr[zero], npts)
+
+	# Calculate the residuals.
+	if (GG_PLOTTYPE(gfit) == FIT)
+	    GG_OVERPLOT(gfit) = NO
+
+	if (GG_OVERPLOT(gfit) == NO) {
+
+	    call gclear (gd)
+
+	    # Set scale and axes.
+	    call gascale (gd, x, npts, 1)
+	    call gascale (gd, resid, npts, 2)
+	    call gt_swind (gd, gt)
+	    call gtlabax (gd, gt)
+
+	    call gpline (gd, x, Memr[zero], npts)
+	}
+
+	# Graph residuals and mark deleted points.
+	if (GG_OVERPLOT(gfit) == NO || GG_NEWFUNCTION(gfit) == YES) {
+	    do i = 1, npts {
+		if (wts[i] == real(0.0))
+		    call gmark (gd, x[i], resid[i], GM_CROSS, 2., 2.)
+		else
+		    call gmark (gd, x[i], resid[i], GM_PLUS, 2., 2.)
+	    }
+	}
+
+	# plot rejected points
+	if (GM_NREJECT(fit) > 0) {
+	    do i = 1, GM_NREJECT(fit) {
+		j = Memi[GM_REJ(fit)+i-1]
+		call gmark (gd, x[j], resid[j], GM_CIRCLE, 2., 2.)
+	    }
+	}
+
+	# Reset the status flag.
+	GG_OVERPLOT(gfit) = NO
+
+	call gflush (gd)
+	call sfree (sp)
+end
+
+
+# GEO_CONXY -- Plot a set of default lines of xref = const and yref = const.
+
+procedure geo_conxyr (gd, fit, sx1, sy1, sx2, sy2)
+
+pointer	gd		#I graphics file descriptor
+pointer	fit		#I fit descriptor
+pointer	sx1, sy1	#I pointer to the linear x and y surface fits
+pointer sx2, sy2	#I pointer to the linear x and y surface fits
+
+int	i
+pointer	sp, xtemp, ytemp, xfit1, yfit1, xfit2, yfit2
+real	xint, yint, dx, dy
+
+begin
+	# allocate temporary space
+	call smark (sp)
+	call salloc (xtemp, NGRAPH, TY_REAL)
+	call salloc (ytemp, NGRAPH, TY_REAL)
+	call salloc (xfit1, NGRAPH, TY_REAL)
+	call salloc (yfit1, NGRAPH, TY_REAL)
+	call salloc (xfit2, NGRAPH, TY_REAL)
+	call salloc (yfit2, NGRAPH, TY_REAL)
+
+	# Calculate intervals in x and y.
+	dx = (GM_XMAX(fit) - GM_XMIN(fit)) / NINTERVALS
+	dy = (GM_YMAX(fit) - GM_YMIN(fit)) / (NGRAPH - 1)
+
+	# Set up an array of y values.
+	Memr[ytemp] = GM_YMIN(fit)
+	do i = 2, NGRAPH
+	    Memr[ytemp+i-1] = Memr[ytemp+i-2] + dy
+
+	# Mark lines of constant x.
+	xint = GM_XMIN(fit)
+	for (i = 1; i <= NINTERVALS + 1; i = i + 1) {
+
+	    # Set the x value.
+	    call amovkr (xint, Memr[xtemp], NGRAPH)
+
+	    # X fit.
+	    call gsvector (sx1, Memr[xtemp], Memr[ytemp], Memr[xfit1],
+	        NGRAPH)
+	    if (sx2 != NULL) {
+	        call gsvector (sx2, Memr[xtemp], Memr[ytemp], Memr[xfit2],
+		    NGRAPH)
+	        call aaddr (Memr[xfit1], Memr[xfit2], Memr[xfit1], NGRAPH)
+	    }
+
+	    # Y fit.
+	    call gsvector (sy1, Memr[xtemp], Memr[ytemp], Memr[yfit1],
+	        NGRAPH)
+	    if (sy2 != NULL) {
+	        call gsvector (sy2, Memr[xtemp], Memr[ytemp], Memr[yfit2],
+		    NGRAPH)
+	        call aaddr (Memr[yfit1], Memr[yfit2], Memr[yfit1], NGRAPH)
+	    }
+
+	    # Plot line of constant x.
+	    call gpline (gd, Memr[xfit1], Memr[yfit1], NGRAPH)
+
+	    # Update the x value.
+	    xint = xint + dx
+	}
+
+	call gflush (gd)
+
+	# Calculate x and y intervals.
+	dx = (GM_XMAX(fit) - GM_XMIN(fit)) / (NGRAPH - 1)
+	dy = (GM_YMAX(fit) - GM_YMIN(fit)) / NINTERVALS
+
+	# Set up array of x values.
+	Memr[xtemp] = GM_XMIN(fit)
+	do i = 2, NGRAPH
+	    Memr[xtemp+i-1] = Memr[xtemp+i-2] + dx
+
+	# Mark lines of constant y.
+	yint = GM_YMIN(fit)
+	for (i = 1; i <= NINTERVALS + 1; i = i + 1) {
+
+	    # set the y value
+	    call amovkr (yint, Memr[ytemp], NGRAPH)
+
+	    # X fit.
+	    call gsvector (sx1, Memr[xtemp], Memr[ytemp], Memr[xfit1],
+	        NGRAPH)
+	    if (sx2 != NULL) {
+	        call gsvector (sx2, Memr[xtemp], Memr[ytemp], Memr[xfit2],
+		    NGRAPH)
+	        call aaddr (Memr[xfit1], Memr[xfit2], Memr[xfit1], NGRAPH)
+	    }
+
+
+	    # Y fit.
+	    call gsvector (sy1, Memr[xtemp], Memr[ytemp], Memr[yfit1],
+	        NGRAPH)
+	    if (sy2 != NULL) {
+	        call gsvector (sy2, Memr[xtemp], Memr[ytemp], Memr[yfit2],
+		    NGRAPH)
+	        call aaddr (Memr[yfit1], Memr[yfit2], Memr[yfit1], NGRAPH)
+	    }
+
+	    # Plot line of constant y.
+	    call gpline (gd, Memr[xfit1], Memr[yfit1], NGRAPH)
+
+	    # Update the y value.
+	    yint = yint + dy
+	}
+
+	call gflush (gd)
+
+	call sfree (sp)
+end
+
+
+# GEO_LXY -- Draw a line of constant x-y.
+
+procedure geo_lxyr (gd, fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, npts, 
+        wx, wy)
+
+pointer	gd		#I pointer to graphics descriptor
+pointer	fit		#I pointer to the fit parameters
+pointer	sx1		#I pointer to the linear x fit
+pointer	sy1		#I pointer to the linear y fit
+pointer	sx2		#I pointer to the higher order x fit
+pointer	sy2		#I pointer to the higher order y fit
+real	xref[ARB]	#I x reference values
+real	yref[ARB]	#I y reference values
+real	xin[ARB]	#I x input values
+real	yin[ARB]	#I y input values
+int	npts		#I number of data points
+real	wx, wy		#I x and y world coordinates
+
+int	i, j
+pointer	sp, xtemp, ytemp, xfit1, yfit1, xfit2, yfit2
+real	x0, y0, r2, r2min
+real	delta, deltax, deltay
+real	gseval()
+
+begin
+	# Transform world coordinates.
+	call gctran (gd, wx, wy, wx, wy, 1, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	# Find the nearest data point.
+	do i = 1, npts {
+	    call gctran (gd, xin[i], yin[i], x0, y0, 1, 0)
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+	        r2min = r2
+	        j = i
+	    }
+	}
+
+	# Fit the line
+	if (j != 0) {
+
+	    # Allocate temporary space.
+	    call smark (sp)
+	    call salloc (xtemp, NGRAPH, TY_REAL)
+	    call salloc (ytemp, NGRAPH, TY_REAL)
+	    call salloc (xfit1, NGRAPH, TY_REAL)
+	    call salloc (yfit1, NGRAPH, TY_REAL)
+	    call salloc (xfit2, NGRAPH, TY_REAL)
+	    call salloc (yfit2, NGRAPH, TY_REAL)
+
+	    # Compute the deltas.
+	    deltax = xin[j] - gseval (sx1, xref[j], yref[j])
+	    if (sx2 != NULL)
+	        deltax = deltax - gseval (sx2, xref[j], yref[j])
+	    deltay = yin[j] - gseval (sy1, xref[j], yref[j])
+	    if (sy2 != NULL)
+		deltay = deltay - gseval (sy2, xref[j], yref[j])
+
+	    # Set up line of constant x.
+	    call amovkr (xref[j], Memr[xtemp], NGRAPH)
+	    delta = (GM_YMAX(fit) - GM_YMIN(fit)) / (NGRAPH - 1)
+	    Memr[ytemp] = GM_YMIN(fit)
+	    do i = 2, NGRAPH
+	        Memr[ytemp+i-1] = Memr[ytemp+i-2] + delta
+
+	    # X solution.
+	    call gsvector (sx1, Memr[xtemp], Memr[ytemp], Memr[xfit1],
+	        NGRAPH)
+	    if (sx2 != NULL) {
+	        call gsvector (sx2, Memr[xtemp], Memr[ytemp], Memr[xfit2],
+		    NGRAPH)
+	        call aaddr (Memr[xfit1], Memr[xfit2], Memr[xfit1], NGRAPH)
+	    }
+	    call aaddkr (Memr[xfit1], deltax, Memr[xfit1], NGRAPH)
+
+	    # Y solution.
+	    call gsvector (sy1, Memr[xtemp], Memr[ytemp], Memr[yfit1],
+	        NGRAPH)
+	    if (sy2 != NULL) {
+	        call gsvector (sy2, Memr[xtemp], Memr[ytemp], Memr[yfit2],
+		    NGRAPH)
+	        call aaddr (Memr[yfit1], Memr[yfit2], Memr[yfit1], NGRAPH)
+	    }
+	    call aaddkr (Memr[yfit1], deltay, Memr[yfit1], NGRAPH)
+
+	    # Plot line of constant x.
+	    call gpline (gd, Memr[xfit1], Memr[yfit1], NGRAPH)
+	    call gflush (gd)
+
+	    # Set up line of constant y.
+	    call amovkr (yref[j], Memr[ytemp], NGRAPH)
+	    delta = (GM_XMAX(fit) - GM_XMIN(fit)) / (NGRAPH - 1)
+	    Memr[xtemp] = GM_XMIN(fit)
+	    do i = 2, NGRAPH
+	        Memr[xtemp+i-1] = Memr[xtemp+i-2] + delta
+
+	    # X fit.
+	    call gsvector (sx1, Memr[xtemp], Memr[ytemp], Memr[xfit1],
+	        NGRAPH)
+	    if (sx2 != NULL) {
+	        call gsvector (sx2, Memr[xtemp], Memr[ytemp], Memr[xfit2],
+		    NGRAPH)
+	        call aaddr (Memr[xfit1], Memr[xfit2], Memr[xfit1], NGRAPH)
+	    }
+	    call aaddkr (Memr[xfit1], deltax, Memr[xfit1], NGRAPH)
+
+	    # Y fit.
+	    call gsvector (sy1, Memr[xtemp], Memr[ytemp], Memr[yfit1],
+	        NGRAPH)
+	    if (sy2 != NULL) {
+	        call gsvector (sy2, Memr[xtemp], Memr[ytemp], Memr[yfit2],
+		    NGRAPH)
+	        call aaddr (Memr[yfit1], Memr[yfit2], Memr[yfit1], NGRAPH)
+	    }
+	    call aaddkr (Memr[yfit1], deltay, Memr[yfit1], NGRAPH)
+
+	    # Plot line of constant y.
+	    call gpline (gd, Memr[xfit1], Memr[yfit1], NGRAPH)
+	    call gflush (gd)
+
+	    # Free space.
+	    call sfree (sp)
+	}
+end
+
+
+# GEO_GCOEFF -- Print the coefficents of the linear portion of the
+# fit, xshift, yshift, 
+
+procedure geo_gcoeffr (sx, sy, xshift, yshift, a, b, c, d)
+
+pointer	sx		#I pointer to the x surface fit
+pointer	sy		#I pointer to the y surface fit
+real	xshift		#O output x shift
+real	yshift		#O output y shift
+real	a		#O output x coefficient of x fit
+real	b		#O output y coefficient of x fit
+real	c		#O output x coefficient of y fit
+real	d		#O output y coefficient of y fit
+
+int	nxxcoeff, nxycoeff, nyxcoeff, nyycoeff
+pointer	sp, xcoeff, ycoeff
+real	xxrange, xyrange, xxmaxmin, xymaxmin
+real	yxrange, yyrange, yxmaxmin, yymaxmin
+
+int	gsgeti()
+real	gsgetr()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (xcoeff, gsgeti (sx, GSNCOEFF), TY_REAL)
+	call salloc (ycoeff, gsgeti (sy, GSNCOEFF), TY_REAL)
+
+	# Get coefficients and numbers of coefficients.
+	call gscoeff (sx, Memr[xcoeff], nxxcoeff)
+	call gscoeff (sy, Memr[ycoeff], nyycoeff)
+	nxxcoeff = gsgeti (sx, GSNXCOEFF)
+	nxycoeff = gsgeti (sx, GSNYCOEFF)
+	nyxcoeff = gsgeti (sy, GSNXCOEFF)
+	nyycoeff = gsgeti (sy, GSNYCOEFF)
+
+	# Get the data range.
+	if (gsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+	    xxrange = (gsgetr (sx, GSXMAX) - gsgetr (sx, GSXMIN)) / 2.0
+	    xxmaxmin = - (gsgetr (sx, GSXMAX) + gsgetr (sx, GSXMIN)) / 2.0
+	    xyrange = (gsgetr (sx, GSYMAX) - gsgetr (sx, GSYMIN)) / 2.0
+	    xymaxmin = - (gsgetr (sx, GSYMAX) + gsgetr (sx, GSYMIN)) / 2.0
+	} else {
+	    xxrange = real(1.0)
+	    xxmaxmin = real(0.0)
+	    xyrange = real(1.0)
+	    xymaxmin = real(0.0)
+	}
+
+	if (gsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+	    yxrange = (gsgetr (sy, GSXMAX) - gsgetr (sy, GSXMIN)) / 2.0
+	    yxmaxmin = - (gsgetr (sy, GSXMAX) + gsgetr (sy, GSXMIN)) / 2.0
+	    yyrange = (gsgetr (sy, GSYMAX) - gsgetr (sy, GSYMIN)) / 2.0
+	    yymaxmin = - (gsgetr (sy, GSYMAX) + gsgetr (sy, GSYMIN)) / 2.0
+	} else {
+	    yxrange = real(1.0)
+	    yxmaxmin = real(0.0)
+	    yyrange = real(1.0)
+	    yymaxmin = real(0.0)
+	}
+
+	# Get the shifts.
+	xshift = Memr[xcoeff] + Memr[xcoeff+1] * xxmaxmin / xxrange +
+	    Memr[xcoeff+2] * xymaxmin / xyrange
+	yshift = Memr[ycoeff] + Memr[ycoeff+1] * yxmaxmin / yxrange +
+	    Memr[ycoeff+2] * yymaxmin / yyrange
+
+	# Get the rotation and scaling parameters and correct for normalization.
+	if (nxxcoeff > 1)
+	    a = Memr[xcoeff+1] / xxrange
+	else
+	    a = real(0.0)
+	if (nxycoeff > 1)
+	    b = Memr[xcoeff+nxxcoeff] / xyrange
+	else
+	    b = real(0.0)
+	if (nyxcoeff > 1)
+	    c = Memr[ycoeff+1] / yxrange
+	else
+	    c = real(0.0)
+	if (nyycoeff > 1)
+	    d = Memr[ycoeff+nyxcoeff] / yyrange
+	else
+	    d = real(0.0)
+
+	call sfree (sp)
+end
+
+
+
+# GEO_1DELETE -- Delete a point from the fit.
+
+procedure geo_1deleted (gd, xin, yin, wts, userwts, npts, wx, wy, delete)
+
+pointer	gd		#I pointer to graphics descriptor
+double	xin[ARB]	#I x array
+double	yin[ARB]	#I y array
+double	wts[ARB]	#I array of weights
+double	userwts[ARB]	#I array of user weights
+int	npts		#I number of points
+real	wx, wy		#I world coordinates
+int	delete		#I delete points ?
+
+int	i, j, pmltype
+real	r2min, r2, x0, y0
+int	gstati()
+
+begin
+	call gctran (gd, wx, wy, wx, wy, 1, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	if (delete == YES) {
+
+	    # Search for nearest point that has not been deleted.
+	    do i = 1, npts {
+	        if (wts[i] <= double(0.0))
+		    next
+	        call gctran (gd, real (xin[i]), real (yin[i]), x0, y0, 1, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Mark point and set weights to 0.
+	    if (j != 0) {
+		call gscur (gd, real(xin[j]), real(yin[j]))
+		call gmark (gd, real(xin[j]), real(yin[j]), GM_CROSS, 2., 2.)
+		wts[j] = double(0.0)
+	    }
+
+	} else {
+
+	    # Search for the nearest deleted point.
+	    do i = 1, npts {
+	        if (wts[i] > double(0.0))
+		    next
+	        call gctran (gd, real(xin[i]), real(yin[i]), x0, y0, 1, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Erase cross and remark with a plus.
+	    if (j != 0) {
+		call gscur (gd, real(xin[j]), real(yin[j]))
+		pmltype = gstati (gd, G_PMLTYPE)
+		call gseti (gd, G_PMLTYPE, 0)
+		call gmark (gd, real(xin[j]), real(yin[j]), GM_CROSS, 2., 2.)
+		call gseti (gd, G_PMLTYPE, pmltype)
+		call gmark (gd, real(xin[j]), real(yin[j]), GM_PLUS, 2., 2.)
+		wts[j] = userwts[j]
+	    }
+	}
+end
+
+
+# GEO_2DELETE -- Delete the residuals.
+
+procedure geo_2deleted (gd, x, resid, wts, userwts, npts, wx, wy, delete)
+
+pointer	gd		#I pointer to graphics descriptor
+double	x[ARB]		#I reference x values
+double	resid[ARB]	#I residuals
+double	wts[ARB]	#I weight array
+double	userwts[ARB]	#I user weight array
+int	npts		#I number of points
+real	wx		#I world x coordinate
+real	wy		#I world y coordinate
+int	delete		#I delete point
+
+int	i, j, pmltype
+real	r2, r2min, x0, y0
+int	gstati()
+
+begin
+	# Delete the point.
+        call gctran (gd, wx, wy, wx, wy, 1, 0)
+        r2min = MAX_REAL
+        j = 0
+
+	# Delete or add a point.
+        if (delete == YES) {
+
+	    # Find the nearest undeleted point.
+	    do i = 1, npts {
+	        if (wts[i] <= double(0.0))
+		    next
+	        call gctran (gd, real(x[i]), real(resid[i]), x0, y0, 1, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Mark the point with a cross and set weight to zero.
+	    if (j != 0) {
+	        call gscur (gd, real(x[j]), real(resid[j]))
+	        call gmark (gd, real(x[j]), real(resid[j]), GM_CROSS, 2., 2.)
+	        wts[j] = double(0.0)
+	    }
+
+        } else {
+
+	    # Find the nearest deleted point.
+	    do i = 1, npts {
+	        if (wts[i] > double(0.0))
+		    next
+	        call gctran (gd, real(x[i]), real(resid[i]), x0, y0, 1, 0)
+	        r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	        if (r2 < r2min) {
+		    r2min = r2
+		    j = i
+	        }
+	    }
+
+	    # Erase the cross and remark with a plus.
+	    if (j != 0) {
+	        call gscur (gd, real(x[j]), real(resid[j]))
+	        pmltype = gstati (gd, G_PMLTYPE)
+	        call gseti (gd, G_PMLTYPE, 0)
+	        call gmark (gd, real(x[j]), real(resid[j]), GM_CROSS, 2., 2.)
+	        call gseti (gd, G_PMLTYPE, pmltype)
+	        call gmark (gd, real(x[j]), real(resid[j]), GM_PLUS, 2., 2.)
+	        wts[j] = userwts[j]
+	    }
+        }
+end
+
+
+# GEO_1GRAPH - Procedure to graph the distribution of the data in the x-y
+# plane. Rejected points are marked by a ' ' and deleted points are marked
+# by a ' '. The shift in position of the data points are indicated by
+# vectors. Sample fits of constant x and y are marked on the plots.
+
+procedure geo_1graphd (gd, gt, fit, gfit, xref, yref, xin, yin, wts, npts)
+
+pointer	gd		#I pointer to the graphics device
+pointer	gt		#I pointer to the plot descriptor
+pointer	fit		#I pointer to the geofit structure
+pointer	gfit		#I pointer to the plot structure
+double	xref[ARB]	#I x reference values
+double	yref[ARB]	#I y reference values
+double	xin[ARB]	#I x values
+double	yin[ARB]	#I y values
+double	wts[ARB]	#I array of weights
+int	npts		#I number of points
+
+int	i, j
+pointer	sp, rxin, ryin
+
+begin
+	# If previous plot different type don't overplot.
+	if (GG_PLOTTYPE(gfit) != FIT)
+	    GG_OVERPLOT(gfit) = NO
+
+	# If not overplottting start new plot.
+	if (GG_OVERPLOT(gfit) == NO) {
+
+	    # Set scale and axes.
+	    call gclear (gd)
+	    call smark (sp)
+	    call salloc (rxin, npts, TY_REAL)
+	    call salloc (ryin, npts, TY_REAL)
+	    call achtdr (xin, Memr[rxin], npts)
+	    call achtdr (yin, Memr[ryin], npts)
+	    call gascale (gd, Memr[rxin], npts, 1)
+	    call gascale (gd, Memr[ryin], npts, 2)
+	    call sfree (sp)
+	    call gt_swind (gd, gt)
+	    call gtlabax (gd, gt)
+
+	    # Mark the data and deleted points.
+	    do i = 1, npts {
+		if (wts[i] == double(0.0))
+		    call gmark (gd, real(xin[i]), real(yin[i]), GM_CROSS,
+		        2., 2.)
+		else
+		    call gmark (gd, real(xin[i]), real(yin[i]), GM_PLUS,
+		        2., 2.)
+	    }
+
+	    call gflush (gd)
+	}
+
+	# Mark the rejected points.
+	do i = 1, GM_NREJECT(fit) {
+	    j = Memi[GM_REJ(fit)+i-1]
+	    call gmark (gd, real(xin[j]), real(yin[j]), GM_CIRCLE, 2., 2.)
+	}
+
+	call gflush (gd)
+
+	# Reset the status flags
+	GG_OVERPLOT(gfit) = NO
+end
+
+
+# GEO_2GRAPH -- Graph the x and y fit residuals versus x or y .
+
+procedure geo_2graphd (gd, gt, fit, gfit, x, resid, wts, npts)
+
+pointer	gd		#I pointer to the graphics device
+pointer	gt		#I pointer to the plot descriptor
+pointer	fit		#I pointer to geomap structure
+pointer	gfit		#I pointer to the plot structure
+double	x[ARB]		#I x reference values
+double	resid[ARB]	#I residual
+double	wts[ARB]	#I array of weights
+int	npts		#I number of points
+
+int	i, j
+pointer	sp, zero
+pointer	rxin, ryin
+
+begin
+	# Allocate space.
+	call smark (sp)
+	call salloc (zero, npts, TY_REAL)
+	call amovkr (0.0, Memr[zero], npts)
+
+	# Calculate the residuals.
+	if (GG_PLOTTYPE(gfit) == FIT)
+	    GG_OVERPLOT(gfit) = NO
+
+	if (GG_OVERPLOT(gfit) == NO) {
+
+	    call gclear (gd)
+
+	    # Set scale and axes.
+	    call salloc (rxin, npts, TY_REAL)
+	    call salloc (ryin, npts, TY_REAL)
+	    call achtdr (x, Memr[rxin], npts)
+	    call achtdr (resid, Memr[ryin], npts)
+	    call gascale (gd, Memr[rxin], npts, 1)
+	    call gascale (gd, Memr[ryin], npts, 2)
+	    call gt_swind (gd, gt)
+	    call gtlabax (gd, gt)
+
+	    call gpline (gd, Memr[rxin], Memr[zero], npts)
+	}
+
+	# Graph residuals and mark deleted points.
+	if (GG_OVERPLOT(gfit) == NO || GG_NEWFUNCTION(gfit) == YES) {
+	    do i = 1, npts {
+		if (wts[i] == double(0.0))
+		    call gmark (gd, Memr[rxin+i-1], Memr[ryin+i-1],
+		        GM_CROSS, 2., 2.)
+		else
+		    call gmark (gd, Memr[rxin+i-1], Memr[ryin+i-1],
+		        GM_PLUS, 2., 2.)
+	    }
+	}
+
+	# plot rejected points
+	if (GM_NREJECT(fit) > 0) {
+	    do i = 1, GM_NREJECT(fit) {
+		j = Memi[GM_REJ(fit)+i-1]
+		call gmark (gd, Memr[rxin+j-1], Memr[ryin+j-1], GM_CIRCLE,
+		    2., 2.)
+	    }
+	}
+
+	# Reset the status flag.
+	GG_OVERPLOT(gfit) = NO
+
+	call gflush (gd)
+	call sfree (sp)
+end
+
+
+# GEO_CONXY -- Plot a set of default lines of xref = const and yref = const.
+
+procedure geo_conxyd (gd, fit, sx1, sy1, sx2, sy2)
+
+pointer	gd		#I graphics file descriptor
+pointer	fit		#I fit descriptor
+pointer	sx1, sy1	#I pointer to the linear x and y surface fits
+pointer sx2, sy2	#I pointer to the linear x and y surface fits
+
+int	i
+pointer	sp, xtemp, ytemp, xfit1, yfit1, xfit2, yfit2
+pointer	xbuf, ybuf
+double	xint, yint, dx, dy
+
+begin
+	# allocate temporary space
+	call smark (sp)
+	call salloc (xtemp, NGRAPH, TY_DOUBLE)
+	call salloc (ytemp, NGRAPH, TY_DOUBLE)
+	call salloc (xfit1, NGRAPH, TY_DOUBLE)
+	call salloc (yfit1, NGRAPH, TY_DOUBLE)
+	call salloc (xfit2, NGRAPH, TY_DOUBLE)
+	call salloc (yfit2, NGRAPH, TY_DOUBLE)
+	call salloc (xbuf, NGRAPH, TY_REAL)
+	call salloc (ybuf, NGRAPH, TY_REAL)
+
+	# Calculate intervals in x and y.
+	dx = (GM_XMAX(fit) - GM_XMIN(fit)) / NINTERVALS
+	dy = (GM_YMAX(fit) - GM_YMIN(fit)) / (NGRAPH - 1)
+
+	# Set up an array of y values.
+	Memd[ytemp] = GM_YMIN(fit)
+	do i = 2, NGRAPH
+	    Memd[ytemp+i-1] = Memd[ytemp+i-2] + dy
+
+	# Mark lines of constant x.
+	xint = GM_XMIN(fit)
+	for (i = 1; i <= NINTERVALS + 1; i = i + 1) {
+
+	    # Set the x value.
+	    call amovkd (xint, Memd[xtemp], NGRAPH)
+
+	    # X fit.
+	    call dgsvector (sx1, Memd[xtemp], Memd[ytemp], Memd[xfit1],
+	        NGRAPH)
+	    if (sx2 != NULL) {
+	        call dgsvector (sx2, Memd[xtemp], Memd[ytemp], Memd[xfit2],
+		    NGRAPH)
+	        call aaddd (Memd[xfit1], Memd[xfit2], Memd[xfit1], NGRAPH)
+	    }
+
+	    # Y fit.
+	    call dgsvector (sy1, Memd[xtemp], Memd[ytemp], Memd[yfit1],
+	        NGRAPH)
+	    if (sy2 != NULL) {
+	        call dgsvector (sy2, Memd[xtemp], Memd[ytemp], Memd[yfit2],
+		    NGRAPH)
+	        call aaddd (Memd[yfit1], Memd[yfit2], Memd[yfit1], NGRAPH)
+	    }
+
+	    # Plot line of constant x.
+	    call achtdr (Memd[xfit1], Memr[xbuf], NGRAPH)
+	    call achtdr (Memd[yfit1], Memr[ybuf], NGRAPH)
+	    call gpline (gd, Memr[xbuf], Memr[ybuf], NGRAPH)
+
+	    # Update the x value.
+	    xint = xint + dx
+	}
+
+	call gflush (gd)
+
+	# Calculate x and y intervals.
+	dx = (GM_XMAX(fit) - GM_XMIN(fit)) / (NGRAPH - 1)
+	dy = (GM_YMAX(fit) - GM_YMIN(fit)) / NINTERVALS
+
+	# Set up array of x values.
+	Memd[xtemp] = GM_XMIN(fit)
+	do i = 2, NGRAPH
+	    Memd[xtemp+i-1] = Memd[xtemp+i-2] + dx
+
+	# Mark lines of constant y.
+	yint = GM_YMIN(fit)
+	for (i = 1; i <= NINTERVALS + 1; i = i + 1) {
+
+	    # set the y value
+	    call amovkd (yint, Memd[ytemp], NGRAPH)
+
+	    # X fit.
+	    call dgsvector (sx1, Memd[xtemp], Memd[ytemp], Memd[xfit1],
+	        NGRAPH)
+	    if (sx2 != NULL) {
+	        call dgsvector (sx2, Memd[xtemp], Memd[ytemp], Memd[xfit2],
+		    NGRAPH)
+	        call aaddd (Memd[xfit1], Memd[xfit2], Memd[xfit1], NGRAPH)
+	    }
+
+
+	    # Y fit.
+	    call dgsvector (sy1, Memd[xtemp], Memd[ytemp], Memd[yfit1],
+	        NGRAPH)
+	    if (sy2 != NULL) {
+	        call dgsvector (sy2, Memd[xtemp], Memd[ytemp], Memd[yfit2],
+		    NGRAPH)
+	        call aaddd (Memd[yfit1], Memd[yfit2], Memd[yfit1], NGRAPH)
+	    }
+
+	    # Plot line of constant y.
+	    call achtdr (Memd[xfit1], Memr[xbuf], NGRAPH)
+	    call achtdr (Memd[yfit1], Memr[ybuf], NGRAPH)
+	    call gpline (gd, Memr[xbuf], Memr[ybuf], NGRAPH)
+
+	    # Update the y value.
+	    yint = yint + dy
+	}
+
+	call gflush (gd)
+
+	call sfree (sp)
+end
+
+
+# GEO_LXY -- Draw a line of constant x-y.
+
+procedure geo_lxyd (gd, fit, sx1, sy1, sx2, sy2, xref, yref, xin, yin, npts, 
+        wx, wy)
+
+pointer	gd		#I pointer to graphics descriptor
+pointer	fit		#I pointer to the fit parameters
+pointer	sx1		#I pointer to the linear x fit
+pointer	sy1		#I pointer to the linear y fit
+pointer	sx2		#I pointer to the higher order x fit
+pointer	sy2		#I pointer to the higher order y fit
+double	xref[ARB]	#I x reference values
+double	yref[ARB]	#I y reference values
+double	xin[ARB]	#I x input values
+double	yin[ARB]	#I y input values
+int	npts		#I number of data points
+real	wx, wy		#I x and y world coordinates
+
+int	i, j
+pointer	sp, xtemp, ytemp, xfit1, yfit1, xfit2, yfit2
+pointer	xbuf, ybuf
+real	x0, y0, r2, r2min
+double	delta, deltax, deltay
+double	dgseval()
+
+begin
+	# Transform world coordinates.
+	call gctran (gd, wx, wy, wx, wy, 1, 0)
+	r2min = MAX_REAL
+	j = 0
+
+	# Find the nearest data point.
+	do i = 1, npts {
+	    call gctran (gd, real(xin[i]), real(yin[i]), x0, y0, 1, 0)
+	    r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2
+	    if (r2 < r2min) {
+	        r2min = r2
+	        j = i
+	    }
+	}
+
+	# Fit the line
+	if (j != 0) {
+
+	    # Allocate temporary space.
+	    call smark (sp)
+	    call salloc (xtemp, NGRAPH, TY_DOUBLE)
+	    call salloc (ytemp, NGRAPH, TY_DOUBLE)
+	    call salloc (xfit1, NGRAPH, TY_DOUBLE)
+	    call salloc (yfit1, NGRAPH, TY_DOUBLE)
+	    call salloc (xfit2, NGRAPH, TY_DOUBLE)
+	    call salloc (yfit2, NGRAPH, TY_DOUBLE)
+	    call salloc (xbuf, NGRAPH, TY_REAL)
+	    call salloc (ybuf, NGRAPH, TY_REAL)
+
+	    # Compute the deltas.
+	    deltax = xin[j] - dgseval (sx1, xref[j], yref[j])
+	    if (sx2 != NULL)
+	        deltax = deltax - dgseval (sx2, xref[j], yref[j])
+	    deltay = yin[j] - dgseval (sy1, xref[j], yref[j])
+	    if (sy2 != NULL)
+		deltay = deltay - dgseval (sy2, xref[j], yref[j])
+
+	    # Set up line of constant x.
+	    call amovkd (xref[j], Memd[xtemp], NGRAPH)
+	    delta = (GM_YMAX(fit) - GM_YMIN(fit)) / (NGRAPH - 1)
+	    Memd[ytemp] = GM_YMIN(fit)
+	    do i = 2, NGRAPH
+	        Memd[ytemp+i-1] = Memd[ytemp+i-2] + delta
+
+	    # X solution.
+	    call dgsvector (sx1, Memd[xtemp], Memd[ytemp], Memd[xfit1],
+	        NGRAPH)
+	    if (sx2 != NULL) {
+	        call dgsvector (sx2, Memd[xtemp], Memd[ytemp], Memd[xfit2],
+		    NGRAPH)
+	        call aaddd (Memd[xfit1], Memd[xfit2], Memd[xfit1], NGRAPH)
+	    }
+	    call aaddkd (Memd[xfit1], deltax, Memd[xfit1], NGRAPH)
+
+	    # Y solution.
+	    call dgsvector (sy1, Memd[xtemp], Memd[ytemp], Memd[yfit1],
+	        NGRAPH)
+	    if (sy2 != NULL) {
+	        call dgsvector (sy2, Memd[xtemp], Memd[ytemp], Memd[yfit2],
+		    NGRAPH)
+	        call aaddd (Memd[yfit1], Memd[yfit2], Memd[yfit1], NGRAPH)
+	    }
+	    call aaddkd (Memd[yfit1], deltay, Memd[yfit1], NGRAPH)
+
+	    # Plot line of constant x.
+	    call achtdr (Memd[xfit1], Memr[xbuf], NGRAPH)
+	    call achtdr (Memd[yfit1], Memr[ybuf], NGRAPH)
+	    call gpline (gd, Memr[xbuf], Memr[ybuf], NGRAPH)
+	    call gflush (gd)
+
+	    # Set up line of constant y.
+	    call amovkd (yref[j], Memd[ytemp], NGRAPH)
+	    delta = (GM_XMAX(fit) - GM_XMIN(fit)) / (NGRAPH - 1)
+	    Memd[xtemp] = GM_XMIN(fit)
+	    do i = 2, NGRAPH
+	        Memd[xtemp+i-1] = Memd[xtemp+i-2] + delta
+
+	    # X fit.
+	    call dgsvector (sx1, Memd[xtemp], Memd[ytemp], Memd[xfit1],
+	        NGRAPH)
+	    if (sx2 != NULL) {
+	        call dgsvector (sx2, Memd[xtemp], Memd[ytemp], Memd[xfit2],
+		    NGRAPH)
+	        call aaddd (Memd[xfit1], Memd[xfit2], Memd[xfit1], NGRAPH)
+	    }
+	    call aaddkd (Memd[xfit1], deltax, Memd[xfit1], NGRAPH)
+
+	    # Y fit.
+	    call dgsvector (sy1, Memd[xtemp], Memd[ytemp], Memd[yfit1],
+	        NGRAPH)
+	    if (sy2 != NULL) {
+	        call dgsvector (sy2, Memd[xtemp], Memd[ytemp], Memd[yfit2],
+		    NGRAPH)
+	        call aaddd (Memd[yfit1], Memd[yfit2], Memd[yfit1], NGRAPH)
+	    }
+	    call aaddkd (Memd[yfit1], deltay, Memd[yfit1], NGRAPH)
+
+	    # Plot line of constant y.
+	    call achtdr (Memd[xfit1], Memr[xbuf], NGRAPH)
+	    call achtdr (Memd[yfit1], Memr[ybuf], NGRAPH)
+	    call gpline (gd, Memr[xbuf], Memr[ybuf], NGRAPH)
+	    call gflush (gd)
+
+	    # Free space.
+	    call sfree (sp)
+	}
+end
+
+
+# GEO_GCOEFF -- Print the coefficents of the linear portion of the
+# fit, xshift, yshift, 
+
+procedure geo_gcoeffd (sx, sy, xshift, yshift, a, b, c, d)
+
+pointer	sx		#I pointer to the x surface fit
+pointer	sy		#I pointer to the y surface fit
+double	xshift		#O output x shift
+double	yshift		#O output y shift
+double	a		#O output x coefficient of x fit
+double	b		#O output y coefficient of x fit
+double	c		#O output x coefficient of y fit
+double	d		#O output y coefficient of y fit
+
+int	nxxcoeff, nxycoeff, nyxcoeff, nyycoeff
+pointer	sp, xcoeff, ycoeff
+double	xxrange, xyrange, xxmaxmin, xymaxmin
+double	yxrange, yyrange, yxmaxmin, yymaxmin
+
+int	dgsgeti()
+double	dgsgetd()
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (xcoeff, dgsgeti (sx, GSNCOEFF), TY_DOUBLE)
+	call salloc (ycoeff, dgsgeti (sy, GSNCOEFF), TY_DOUBLE)
+
+	# Get coefficients and numbers of coefficients.
+	call dgscoeff (sx, Memd[xcoeff], nxxcoeff)
+	call dgscoeff (sy, Memd[ycoeff], nyycoeff)
+	nxxcoeff = dgsgeti (sx, GSNXCOEFF)
+	nxycoeff = dgsgeti (sx, GSNYCOEFF)
+	nyxcoeff = dgsgeti (sy, GSNXCOEFF)
+	nyycoeff = dgsgeti (sy, GSNYCOEFF)
+
+	# Get the data range.
+	if (dgsgeti (sx, GSTYPE) != GS_POLYNOMIAL) {
+	    xxrange = (dgsgetd (sx, GSXMAX) - dgsgetd (sx, GSXMIN)) / 2.0d0
+	    xxmaxmin = - (dgsgetd (sx, GSXMAX) + dgsgetd (sx, GSXMIN)) / 2.0d0
+	    xyrange = (dgsgetd (sx, GSYMAX) - dgsgetd (sx, GSYMIN)) / 2.0d0
+	    xymaxmin = - (dgsgetd (sx, GSYMAX) + dgsgetd (sx, GSYMIN)) / 2.0d0
+	} else {
+	    xxrange = double(1.0)
+	    xxmaxmin = double(0.0)
+	    xyrange = double(1.0)
+	    xymaxmin = double(0.0)
+	}
+
+	if (dgsgeti (sy, GSTYPE) != GS_POLYNOMIAL) {
+	    yxrange = (dgsgetd (sy, GSXMAX) - dgsgetd (sy, GSXMIN)) / 2.0d0
+	    yxmaxmin = - (dgsgetd (sy, GSXMAX) + dgsgetd (sy, GSXMIN)) / 2.0d0
+	    yyrange = (dgsgetd (sy, GSYMAX) - dgsgetd (sy, GSYMIN)) / 2.0d0
+	    yymaxmin = - (dgsgetd (sy, GSYMAX) + dgsgetd (sy, GSYMIN)) / 2.0d0
+	} else {
+	    yxrange = double(1.0)
+	    yxmaxmin = double(0.0)
+	    yyrange = double(1.0)
+	    yymaxmin = double(0.0)
+	}
+
+	# Get the shifts.
+	xshift = Memd[xcoeff] + Memd[xcoeff+1] * xxmaxmin / xxrange +
+	    Memd[xcoeff+2] * xymaxmin / xyrange
+	yshift = Memd[ycoeff] + Memd[ycoeff+1] * yxmaxmin / yxrange +
+	    Memd[ycoeff+2] * yymaxmin / yyrange
+
+	# Get the rotation and scaling parameters and correct for normalization.
+	if (nxxcoeff > 1)
+	    a = Memd[xcoeff+1] / xxrange
+	else
+	    a = double(0.0)
+	if (nxycoeff > 1)
+	    b = Memd[xcoeff+nxxcoeff] / xyrange
+	else
+	    b = double(0.0)
+	if (nyxcoeff > 1)
+	    c = Memd[ycoeff+1] / yxrange
+	else
+	    c = double(0.0)
+	if (nyycoeff > 1)
+	    d = Memd[ycoeff+nyxcoeff] / yyrange
+	else
+	    d = double(0.0)
+
+	call sfree (sp)
+end
+
+
diff --git a/pkg/images/lib/geomap.h b/pkg/images/lib/geomap.h
new file mode 100644
index 00000000..f67d64f3
--- /dev/null
+++ b/pkg/images/lib/geomap.h
@@ -0,0 +1,109 @@
+# Header file for GEOMAP
+
+define	LEN_GEOMAP	(54 + SZ_FNAME + SZ_LINE + 2)
+
+define	GM_XO		Memd[P2D($1)]		# X origin
+define	GM_YO		Memd[P2D($1+2)]		# Y origin
+define	GM_ZO		Memd[P2D($1+4)]		# Z origin
+define	GM_XOREF	Memd[P2D($1+6)]		# X reference origin
+define	GM_YOREF	Memd[P2D($1+8)]		# Y reference origin
+define	GM_XMIN		Memd[P2D($1+10)]	# Minimum x value
+define	GM_XMAX		Memd[P2D($1+12)]	# Maximum x value
+define	GM_YMIN		Memd[P2D($1+14)]	# Minimum y value
+define	GM_YMAX		Memd[P2D($1+16)]	# Maximum y value
+define	GM_XOREF	Memd[P2D($1+18)]	# Mean of xref coords
+define	GM_YOREF	Memd[P2D($1+20)]	# Mean of yref coords
+define	GM_XOIN		Memd[P2D($1+22)]	# Mean of x coords
+define	GM_YOIN		Memd[P2D($1+24)]	# Mean of y coords
+define	GM_XREFPT	Memd[P2D($1+26)]	# Computed X reference point
+define	GM_YREFPT	Memd[P2D($1+28)]	# Computed Y reference point
+define	GM_XRMS		Memd[P2D($1+30)]	# Rms of x fit
+define	GM_YRMS		Memd[P2D($1+32)]	# Rms of y fit
+define	GM_REJECT	Memd[P2D($1+34)]	# Sigma limit for rejection
+define	GM_PROJECTION	Memi[$1+36]		# Coordinate projection type
+define	GM_FIT		Memi[$1+37]		# Fit geometry type
+define	GM_FUNCTION	Memi[$1+38]		# Function type
+define	GM_XXORDER	Memi[$1+39]		# X fit X order
+define	GM_XYORDER	Memi[$1+40]		# X fit Y order
+define	GM_XXTERMS	Memi[$1+41]		# X fit cross-terms
+define	GM_YXORDER	Memi[$1+42]		# Y fit X order
+define	GM_YYORDER	Memi[$1+43]		# Y fit Y order
+define	GM_YXTERMS	Memi[$1+44]		# Y fit cross-terms
+define	GM_MAXITER	Memi[$1+45]		# maximum number of iterations
+define	GM_NPTS		Memi[$1+46]		# Number of data points
+define	GM_NREJECT	Memi[$1+47]		# Number of rejected pixels
+define	GM_NWTS0	Memi[$1+48]		# Number of pts with wts <= 0
+define	GM_REJ		Memi[$1+49]		# Pointer to rejected pixels
+define	GM_RECORD	Memc[P2C($1+50)]	# Record name
+define	GM_PROJSTR	Memc[P2C($1+50+SZ_FNAME+1)]	# Projection parameters
+
+# geoset parameters
+define	GMXO		1
+define	GMYO		2
+define	GMXOREF		3
+define	GMYOREF		4
+define	GMPROJECTION	5
+define  GMFIT	  	6
+define  GMFUNCTION  	7
+define  GMXXORDER   	8
+define  GMXYORDER   	9
+define  GMYXORDER   	10
+define  GMYYORDER   	11
+define  GMXXTERMS   	12
+define  GMYXTERMS   	13
+define  GMREJECT    	14
+define  GMMAXITER    	15
+
+# define the permitted coordinate projections
+
+define  GM_PROJLIST      "|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|"
+
+define	GM_NONE	     0
+define  GM_LIN	     1
+define  GM_AZP       2
+define  GM_TAN       3
+define  GM_SIN       4
+define  GM_STG       5
+define  GM_ARC       6
+define  GM_ZPN       7
+define  GM_ZEA       8
+define  GM_AIR       9
+define  GM_CYP       10
+define  GM_CAR       11
+define  GM_MER       12
+define  GM_CEA       13
+define  GM_COP       14
+define  GM_COD       15
+define  GM_COE       16
+define  GM_COO       17
+define  GM_BON       18
+define  GM_PCO       19
+define  GM_GLS       20
+define  GM_PAR       21
+define  GM_AIT       22
+define  GM_MOL       23
+define  GM_CSC       24
+define  GM_QSC       25
+define  GM_TSC       26
+define  GM_TNX       27
+define  GM_ZPX       28
+
+# define the permitted fitting geometries 
+
+define	GM_GEOMETRIES	"|shift|xyscale|rotate|rscale|rxyscale|general|"
+
+define	GM_SHIFT		1
+define	GM_XYSCALE		2
+define	GM_ROTATE		3
+define	GM_RSCALE		4
+define	GM_RXYSCALE		5
+define	GM_GENERAL		6
+
+# define the permitted fitting functions
+
+define	GM_FUNCS	"|chebyshev|legendre|polynomial|"
+
+# define the permitted x-terms functions
+
+define	GM_XFUNCS	"|none|full|half|"
diff --git a/pkg/images/lib/geomap.key b/pkg/images/lib/geomap.key
new file mode 100644
index 00000000..5cc5d043
--- /dev/null
+++ b/pkg/images/lib/geomap.key
@@ -0,0 +1,31 @@
+	Interactive Keystroke Commands
+
+?	Print options
+f	Fit data and graph fit with the current graph type (g,x,r,y,s)
+g	Graph the data and the current fit
+x,r	Graph the x(in) fit residuals versus x(ref) and y(ref) respectively
+y,s	Graph the y(in) fit residuals versus x(ref) and y(ref) respectively
+d,u	Delete or undelete the data point nearest the cursor
+o	Overplot the next graph
+c	Toggle the line of constant x(ref), y(ref) plotting option
+t       Plot a line of constant x(ref), y(ref) through nearest data point	
+l	Print xshift, yshift, xscale, yscale, xrotate, yrotate
+q	Exit the interactive surface fitting code
+
+	Interactive 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	 	     List parameters
+:fit 	  [value]    Fit geometry (shift,xyscale,rotate,rscale,rxyscale,general)
+:function [value]    Fitting function (chebyshev,legendre,polynomial)
+:order	  [value]    X and Y fitting orders in x and y
+:xxorder  [value]    X fitting function order in x
+:xyorder  [value]    X fitting function order in y
+:yxorder  [value]    Y fitting function order in x
+:yyorder  [value]    Y fitting function order in y
+:xxterms  [n/h/f]    X fit cross terms type
+:yxterms  [n/h/f]    Y fit cross terms type
+:maxiter  [value]    Maximum number of rejection iterations
+:reject   [value]    K-sigma rejection threshold
diff --git a/pkg/images/lib/geoset.x b/pkg/images/lib/geoset.x
new file mode 100644
index 00000000..9591fa21
--- /dev/null
+++ b/pkg/images/lib/geoset.x
@@ -0,0 +1,61 @@
+# Copyright(c) 1986 Assocation of Universities for Research in Astronomy Inc.
+
+include "geomap.h"
+
+
+# GEO_SETI -- Set integer parameters.
+
+procedure geo_seti (fit, param, ival)
+
+pointer	fit		#I pointer to the fit structure
+int	param		#I paramter ID
+int	ival		#I value
+
+begin
+	switch (param) {
+	case GMPROJECTION:
+	    GM_PROJECTION(fit) = ival
+	case GMFIT:
+	    GM_FIT(fit) = ival
+	case GMFUNCTION:
+	    GM_FUNCTION(fit) = ival
+	case GMXXORDER:
+	    GM_XXORDER(fit) = ival
+	case GMXYORDER:
+	    GM_XYORDER(fit) = ival
+	case GMYXORDER:
+	    GM_YXORDER(fit) = ival
+	case GMYYORDER:
+	    GM_YYORDER(fit) = ival
+	case GMXXTERMS:
+	    GM_XXTERMS(fit) = ival
+	case GMYXTERMS:
+	    GM_YXTERMS(fit) = ival
+	case GMMAXITER:
+	    GM_MAXITER(fit) = ival
+	}
+end
+
+
+# GEO_SETD -- Set double parameters.
+
+procedure geo_setd (fit, param, dval)
+
+pointer	fit		#I pointer to the fit structure
+int	param		#I paramter ID
+double	dval		#I value
+
+begin
+	switch (param) {
+	case GMXO:
+	    GM_XO(fit) = dval
+	case GMYO:
+	    GM_YO(fit) = dval
+	case GMXOREF:
+	    GM_XOREF(fit) = dval
+	case GMYOREF:
+	    GM_YOREF(fit) = dval
+	case GMREJECT:
+	    GM_REJECT(fit) = dval
+	}
+end
diff --git a/pkg/images/lib/imcopy.x b/pkg/images/lib/imcopy.x
new file mode 100644
index 00000000..1d33693d
--- /dev/null
+++ b/pkg/images/lib/imcopy.x
@@ -0,0 +1,106 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+
+# IMG_IMCOPY -- Copy an image.  Use sequential routines to permit copying
+# images of any dimension.  Perform pixel i/o in the datatype of the image,
+# to avoid unnecessary type conversion.
+
+procedure img_imcopy (image1, image2, verbose)
+
+char	image1[ARB]			# Input image
+char	image2[ARB]			# Output image
+bool	verbose				# Print the operation
+
+int	npix, junk
+pointer	buf1, buf2, im1, im2
+pointer	sp, root1, root2, imtemp, section
+long	v1[IM_MAXDIM], v2[IM_MAXDIM]
+
+bool	strne()
+int	imgnls(), imgnll(), imgnlr(), imgnld(), imgnlx()
+int	impnls(), impnll(), impnlr(), impnld(), impnlx()
+pointer	immap()
+
+begin
+	call smark (sp)
+	call salloc (root1, SZ_PATHNAME, TY_CHAR)
+	call salloc (root2, SZ_PATHNAME, TY_CHAR)
+	call salloc (imtemp, SZ_PATHNAME, TY_CHAR)
+	call salloc (section, SZ_FNAME, TY_CHAR)
+
+	# If verbose print the operation.
+	if (verbose) {
+	    call printf ("%s -> %s\n")
+		call pargstr (image1)
+		call pargstr (image2)
+	    call flush (STDOUT)
+	}
+
+	# Get the input and output root names and the output section.
+	call imgimage (image1, Memc[root1], SZ_PATHNAME)
+	call imgimage (image2, Memc[root2], SZ_PATHNAME)
+	call imgsection (image2, Memc[section], SZ_FNAME)
+
+	# Map the input image.
+	im1 = immap (image1, READ_ONLY, 0)
+
+	# If the output has a section appended we are writing to a
+	# section of an existing image.  Otherwise get a temporary
+	# output image name and map it as a copy of the input image.
+	# Copy the input image to the temporary output image and unmap
+	# the images.  Release the temporary image name.
+
+	if (strne (Memc[root1], Memc[root2]) && Memc[section] != EOS) {
+	    call strcpy (image2, Memc[imtemp], SZ_PATHNAME)
+	    im2 = immap (image2, READ_WRITE, 0)
+	} else {
+	    call xt_mkimtemp (image1, image2, Memc[imtemp], SZ_PATHNAME)
+	    im2 = immap (image2, NEW_COPY, im1)
+	}
+
+	# Setup start vector for sequential reads and writes.
+
+	call amovkl (long(1), v1, IM_MAXDIM)
+	call amovkl (long(1), v2, IM_MAXDIM)
+
+	# Copy the image.
+
+	npix = IM_LEN(im1, 1)
+	switch (IM_PIXTYPE(im1)) {
+	case TY_SHORT:
+	    while (imgnls (im1, buf1, v1) != EOF) {
+		junk = impnls (im2, buf2, v2)
+		call amovs (Mems[buf1], Mems[buf2], npix)
+	    }
+	case TY_USHORT, TY_INT, TY_LONG:
+	    while (imgnll (im1, buf1, v1) != EOF) {
+		junk = impnll (im2, buf2, v2)
+		call amovl (Meml[buf1], Meml[buf2], npix)
+	    }
+	case TY_REAL:
+	    while (imgnlr (im1, buf1, v1) != EOF) {
+		junk = impnlr (im2, buf2, v2)
+		call amovr (Memr[buf1], Memr[buf2], npix)
+	    }
+	case TY_DOUBLE:
+	    while (imgnld (im1, buf1, v1) != EOF) {
+		junk = impnld (im2, buf2, v2)
+		call amovd (Memd[buf1], Memd[buf2], npix)
+	    }
+	case TY_COMPLEX:
+	    while (imgnlx (im1, buf1, v1) != EOF) {
+	        junk = impnlx (im2, buf2, v2)
+		call amovx (Memx[buf1], Memx[buf2], npix)
+	    }
+	default:
+	    call error (1, "unknown pixel datatype")
+	}
+
+	# Unmap the images.
+
+	call imunmap (im2)
+	call imunmap (im1)
+	call xt_delimtemp (image2, Memc[imtemp])
+	call sfree (sp)
+end
diff --git a/pkg/images/lib/liststr.gx b/pkg/images/lib/liststr.gx
new file mode 100644
index 00000000..ec627e0c
--- /dev/null
+++ b/pkg/images/lib/liststr.gx
@@ -0,0 +1,427 @@
+include <ctype.h>
+
+$for (r)
+
+# LI_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 li_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
+
+
+# LI_CAPPEND_LINE -- Fields are copied from the input buffer to the
+# output buffer.
+
+procedure li_cappend_line (inbuf, outbuf, maxch, xoffset, yoffset,
+	xwidth, ywidth) 
+
+char	inbuf[ARB]		#I the input string buffer
+char	outbuf[maxch]		#O the output string buffer
+int	maxch			#I the maximum size of the output buffer
+int	xoffset			#I the offset to the x field
+int	yoffset			#I the offset to the y field
+int	xwidth			#I the width of the x field
+int	ywidth			#I the width of the y field
+
+int	ip, op
+int	gstrcpy()
+
+begin
+	# Copy the input buffer into the output buffer minus the newline.
+	op = 1
+	for (ip = 1; ip <= maxch; ip = ip + 1) {
+	    if (inbuf[ip] == '\n' || inbuf[ip] == EOS)
+		break
+	    outbuf[op] = inbuf[ip]
+	    op = op + 1
+	}
+
+	# Add a blank.
+	if (op <= maxch) {
+	    outbuf[op] = ' '
+	    op = op + 1
+	}
+
+	# Copy the two fields.
+	op = op + gstrcpy (inbuf[xoffset], outbuf[op], min (maxch - op + 1,
+	    xwidth))
+	op = op + gstrcpy (inbuf[yoffset], outbuf[op], min (maxch - op + 1,
+	    ywidth))
+
+	# Add a newline.
+	if (op <= maxch) {
+	    outbuf[op] = '\n'
+	    op = op + 1
+	}
+	outbuf[op] = EOS
+end
+
+$endfor
+
+$for (rd)
+
+# LT_GET_NUM -- The field entry is converted from character to real or double
+# in preparation for the transformation.  The number of significant
+# digits is counted and returned as an argument; the number of chars in
+# the number is returned as the function value.
+
+int procedure li_get_num$t (linebuf, fval, nsdig) 
+
+char	linebuf[ARB]		#I the input line buffer
+PIXEL	fval			#O the output floating point value
+int	nsdig			#O the number of significant digits
+
+char	ch
+int 	nchar, ip
+int	cto$t(), stridx()
+
+begin
+	ip = 1
+	nsdig = 0
+	nchar = cto$t (linebuf, ip, fval)
+	if (nchar == 0 || fval == $INDEF$T)
+	    return (nchar)
+
+	# Skip leading white space.
+	ip = 1
+    	repeat {
+	    ch = linebuf[ip]
+	    if (! IS_WHITE(ch)) 
+		break
+	    ip = ip + 1
+	} 
+
+	# Count signifigant digits
+	for (; ! IS_WHITE(ch) && ch != '\n' && ch != EOS; ch=linebuf[ip]) {
+	    if (stridx (ch, "eEdD") > 0)
+		break
+	    if (IS_DIGIT (ch))
+		nsdig = nsdig + 1
+	    ip = ip + 1
+	}
+
+	return (nchar)
+end
+
+
+# LI_PACK_LINE -- Fields are packed into the outbuf buffer.  Transformed
+# fields are converted to strings; other fields are copied from
+# the input line to output buffer.
+
+procedure li_pack_line$t (inbuf, outbuf, maxch, field_pos, nfields, 
+	xfield, yfield, xt, yt, xformat, yformat, nsdig_x, nsdig_y,
+	min_sigdigits)
+
+char	inbuf[ARB]		#I the input string buffer
+char	outbuf[maxch]		#O the output string buffer
+int	maxch			#I the maximum size of the output buffer
+int	field_pos[ARB]		#I starting positions for the fields
+int	nfields			#I the number of fields
+int	xfield			#I the field number of the x coordinate column
+int	yfield			#I the field number of the y coordinate column
+PIXEL	xt			#I the transformed x coordinate
+PIXEL	yt			#I the transformed y coordinate
+char	xformat[ARB]		#I the output format for the x column
+char	yformat[ARB]		#I the output format for the y column
+int	nsdig_x			#I the number of significant digits in x
+int	nsdig_y			#I the number of significant digits in y
+int	min_sigdigits		#I the minimum number of significant digits
+
+int	num_field, width, op
+pointer	sp, field
+int	gstrcpy()
+
+begin
+	call smark (sp)
+	call salloc (field, SZ_LINE, TY_CHAR)
+
+	# Initialize output pointer.
+	op = 1
+
+	do num_field = 1, nfields {
+	    width = field_pos[num_field + 1] - field_pos[num_field]
+
+	    if (num_field == xfield) {
+	        call li_format_field$t (xt, Memc[field], maxch, xformat,
+		    nsdig_x, width, min_sigdigits)
+	    } else if (num_field == yfield) {
+		call li_format_field$t (yt, Memc[field], maxch, yformat,
+		    nsdig_y, width, min_sigdigits)
+	    } else {
+	        # Put "width" characters from inbuf into field
+		call strcpy (inbuf[field_pos[num_field]], Memc[field], width)
+	    }
+
+	    # Fields must be delimited by at least one blank.
+	    if (num_field > 1 && !IS_WHITE (Memc[field])) {
+		outbuf[op] = ' '
+		op = op + 1
+	    }
+
+	    # Copy "field" to output buffer.
+	    op = op + gstrcpy (Memc[field], outbuf[op], maxch)
+	}
+
+	outbuf[op] = '\n'
+	outbuf[op+1] = EOS
+
+	call sfree (sp)
+end
+
+
+# LI_APPEND_LINE -- Fields are appened to the input buffer.  Transformed
+# fields are converted to strings and added to the end of the input buffer.
+
+procedure li_append_line$t (inbuf, outbuf, maxch, xt, yt, xformat, yformat,
+	nsdig_x, nsdig_y, min_sigdigits)
+
+char	inbuf[ARB]		#I the input string buffer
+char	outbuf[maxch]		#O the output string buffer
+int	maxch			#I the maximum size of the output buffer
+PIXEL	xt			#I the transformed x coordinate
+PIXEL	yt			#I the transformed y coordinate
+char	xformat[ARB]		#I the output format for the x column
+char	yformat[ARB]		#I the output format for the y column
+int	nsdig_x			#I the number of significant digits in x
+int	nsdig_y			#I the number of significant digits in y
+int	min_sigdigits		#I the minimum number of significant digits
+
+int	ip, op
+pointer	sp, field
+int	gstrcpy()
+
+begin
+	# Allocate some working space.
+	call smark (sp)
+	call salloc (field, SZ_LINE, TY_CHAR)
+
+	# Copy the input buffer into the output buffer minus the newline.
+	op = 1
+	for (ip = 1; ip <= maxch; ip = ip + 1) {
+	    if (inbuf[ip] == '\n' || inbuf[ip] == EOS)
+		break
+	    outbuf[op] = inbuf[ip]
+	    op = op + 1
+	}
+
+	# Add two blanks.
+	op = op + gstrcpy ("  ", outbuf[op], maxch - op + 1)
+
+	# Format and add the the two extra fields with a blank between.
+	call li_format_field$t (xt, Memc[field], SZ_LINE, xformat,
+	    nsdig_x, 0, min_sigdigits)
+	op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1)
+	if (op <= maxch) {
+	    outbuf[op] = ' '
+	    op = op + 1
+	}
+	call li_format_field$t (yt, Memc[field], SZ_LINE, yformat,
+	    nsdig_y, 0, min_sigdigits)
+	op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1)
+
+	# Add a newline.
+	if (op <= maxch) {
+	    outbuf[op] = '\n'
+	    op = op + 1
+	}
+	outbuf[op] = EOS
+
+	call sfree (sp)
+end
+
+
+# LI_FORMAT_FIELD -- A transformed coordinate is written into a string
+# buffer.  The output field is of (at least) the same width and significance
+# as the input list entry.
+
+procedure li_format_field$t (fval, wordbuf, maxch, format, nsdig, width,
+	min_sigdigits)
+
+PIXEL	fval			#I the input value to be formatted
+char	wordbuf[maxch]		#O the output formatted string
+int	maxch			#I the maximum length of the output string
+char	format[ARB]		#I the output format
+int	nsdig 			#I the number of sig-digits in current value
+int	width			#I the width of the curent field
+int	min_sigdigits		#I the minimum number of significant digits
+
+int	fdigits, fwidth
+begin
+	if (format[1] == EOS) {
+	    fdigits = max (min_sigdigits, nsdig)
+	    fwidth = max (width, fdigits + 1)
+	    call sprintf (wordbuf, maxch, "%*.*g")
+	        call pargi (fwidth)
+	        call pargi (fdigits)
+	        call parg$t (fval)
+	} else {
+	    call sprintf (wordbuf, maxch, format)
+		call parg$t (fval)
+	}
+end
+
+# LI_NPACK_LINE -- Fields are packed into the outbuf buffer.  Transformed
+# fields are converted to strings; other fields are copied from
+# the input line to output buffer.
+
+procedure li_npack_line$t (inbuf, outbuf, maxch, field_pos, nfields, 
+        vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits)
+
+char    inbuf[ARB]              #I the input string buffer
+char    outbuf[maxch]           #O the output string buffer
+int     maxch                   #I the maximum size of the output buffer
+int     field_pos[ARB]          #I starting positions for the fields
+int     nfields                 #I the number of fields
+int     vfields[ARB]            #I the fields to be formatted
+PIXEL   values[ARB]             #I the field values to be formatted
+int     nsdigits[ARB]           #I the number of field significant digits
+int     nvalues                 #I the number of fields to be formatted
+char    vformats[sz_fmt,ARB]    #I the field formats
+int     sz_fmt                  #I the size of the format string
+int     min_sigdigits           #I the minimum number of significant digits
+
+bool    found
+int     op, num_field, num_var, width
+pointer sp, field
+int     gstrcpy()
+
+begin
+        call smark (sp)
+        call salloc (field, SZ_LINE, TY_CHAR)
+
+        # Initialize output pointer.
+        op = 1
+
+        do num_field = 1, nfields {
+            width = field_pos[num_field + 1] - field_pos[num_field]
+
+            found = false
+            do num_var = 1, nvalues {
+                if (num_field == vfields[num_var]) {
+                    found = true
+                    break
+                }
+            }
+
+            if (found) {
+                call li_format_field$t (values[num_var], Memc[field],
+                    maxch, vformats[1,num_var], nsdigits[num_var], width,
+                    min_sigdigits)
+            } else {
+                # Put "width" characters from inbuf into field
+                call strcpy (inbuf[field_pos[num_field]], Memc[field], width)
+            }
+
+            # Fields must be delimited by at least one blank.
+            if (num_field > 1 && !IS_WHITE (Memc[field])) {
+                outbuf[op] = ' '
+                op = op + 1
+            }
+
+            # Copy "field" to output buffer.
+            op = op + gstrcpy (Memc[field], outbuf[op], maxch)
+        }
+
+        outbuf[op] = '\n'
+        outbuf[op+1] = EOS
+
+        call sfree (sp)
+end
+
+
+# LI_NAPPEND_LINE -- Fields are appened to the input buffer.  Transformed
+# fields are converted to strings and added to the end of the input buffer.
+
+procedure li_nappend_line$t (inbuf, outbuf, maxch, field_pos, nfields, 
+        vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits)
+
+char    inbuf[ARB]              #I the input string buffer
+char    outbuf[maxch]           #O the output string buffer
+int     maxch                   #I the maximum size of the output buffer
+int     field_pos[ARB]          #I starting positions for the fields
+int     nfields                 #I the number of fields
+int     vfields[ARB]            #I the fields to be formatted
+PIXEL   values[ARB]             #I the field values to be formatted
+int     nsdigits[ARB]           #I the number of field significant digits
+int     nvalues                 #I the number of fields to be formatted
+char    vformats[sz_fmt,ARB]    #I the field formats
+int     sz_fmt                  #I the size of the format string
+int     min_sigdigits           #I the minimum number of significant digits
+
+int     num_var, ip, op, index
+pointer sp, field, nvfields
+int     gstrcpy()
+
+begin
+        # Allocate some working space.
+        call smark (sp)
+        call salloc (field, SZ_LINE, TY_CHAR)
+        call salloc (nvfields, nvalues, TY_INT)
+        do num_var = 1, nvalues
+            Memi[nvfields+num_var-1] = num_var
+        call rg_qsorti (vfields, Memi[nvfields], Memi[nvfields], nvalues)
+
+        # Copy the input buffer into the output buffer minus the newline.
+        op = 1
+        for (ip = 1; ip <= maxch; ip = ip + 1) {
+            if (inbuf[ip] == '\n' || inbuf[ip] == EOS)
+                break
+            outbuf[op] = inbuf[ip]
+            op = op + 1
+        }
+
+        # Add two blanks.
+        op = op + gstrcpy ("  ", outbuf[op], maxch - op + 1)
+
+        do num_var = 1, nvalues {
+            index = Memi[nvfields+num_var-1]
+            call li_format_field$t (values[index], Memc[field], SZ_LINE,
+                vformats[sz_fmt,index], nsdigits[index], 0, min_sigdigits)
+            op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1)
+            if (num_var == nvalues) {
+                if (op <= maxch) {
+                    outbuf[op] = '\n'
+                    op = op + 1
+                }
+            } else {
+                if (op <= maxch) {
+                    outbuf[op] = ' '
+                    op = op + 1
+                }
+            }
+        }
+
+        outbuf[op] = EOS
+
+        call sfree (sp)
+end
+
+
+$endfor
diff --git a/pkg/images/lib/liststr.x b/pkg/images/lib/liststr.x
new file mode 100644
index 00000000..edb2903c
--- /dev/null
+++ b/pkg/images/lib/liststr.x
@@ -0,0 +1,766 @@
+include <ctype.h>
+
+
+
+# LI_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 li_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
+
+
+# LI_CAPPEND_LINE -- Fields are copied from the input buffer to the
+# output buffer.
+
+procedure li_cappend_line (inbuf, outbuf, maxch, xoffset, yoffset,
+	xwidth, ywidth) 
+
+char	inbuf[ARB]		#I the input string buffer
+char	outbuf[maxch]		#O the output string buffer
+int	maxch			#I the maximum size of the output buffer
+int	xoffset			#I the offset to the x field
+int	yoffset			#I the offset to the y field
+int	xwidth			#I the width of the x field
+int	ywidth			#I the width of the y field
+
+int	ip, op
+int	gstrcpy()
+
+begin
+	# Copy the input buffer into the output buffer minus the newline.
+	op = 1
+	for (ip = 1; ip <= maxch; ip = ip + 1) {
+	    if (inbuf[ip] == '\n' || inbuf[ip] == EOS)
+		break
+	    outbuf[op] = inbuf[ip]
+	    op = op + 1
+	}
+
+	# Add a blank.
+	if (op <= maxch) {
+	    outbuf[op] = ' '
+	    op = op + 1
+	}
+
+	# Copy the two fields.
+	op = op + gstrcpy (inbuf[xoffset], outbuf[op], min (maxch - op + 1,
+	    xwidth))
+	op = op + gstrcpy (inbuf[yoffset], outbuf[op], min (maxch - op + 1,
+	    ywidth))
+
+	# Add a newline.
+	if (op <= maxch) {
+	    outbuf[op] = '\n'
+	    op = op + 1
+	}
+	outbuf[op] = EOS
+end
+
+
+
+
+
+# LT_GET_NUM -- The field entry is converted from character to real or double
+# in preparation for the transformation.  The number of significant
+# digits is counted and returned as an argument; the number of chars in
+# the number is returned as the function value.
+
+int procedure li_get_numr (linebuf, fval, nsdig) 
+
+char	linebuf[ARB]		#I the input line buffer
+real	fval			#O the output floating point value
+int	nsdig			#O the number of significant digits
+
+char	ch
+int 	nchar, ip
+int	ctor(), stridx()
+
+begin
+	ip = 1
+	nsdig = 0
+	nchar = ctor (linebuf, ip, fval)
+	if (nchar == 0 || fval == INDEFR)
+	    return (nchar)
+
+	# Skip leading white space.
+	ip = 1
+    	repeat {
+	    ch = linebuf[ip]
+	    if (! IS_WHITE(ch)) 
+		break
+	    ip = ip + 1
+	} 
+
+	# Count signifigant digits
+	for (; ! IS_WHITE(ch) && ch != '\n' && ch != EOS; ch=linebuf[ip]) {
+	    if (stridx (ch, "eEdD") > 0)
+		break
+	    if (IS_DIGIT (ch))
+		nsdig = nsdig + 1
+	    ip = ip + 1
+	}
+
+	return (nchar)
+end
+
+
+# LI_PACK_LINE -- Fields are packed into the outbuf buffer.  Transformed
+# fields are converted to strings; other fields are copied from
+# the input line to output buffer.
+
+procedure li_pack_liner (inbuf, outbuf, maxch, field_pos, nfields, 
+	xfield, yfield, xt, yt, xformat, yformat, nsdig_x, nsdig_y,
+	min_sigdigits)
+
+char	inbuf[ARB]		#I the input string buffer
+char	outbuf[maxch]		#O the output string buffer
+int	maxch			#I the maximum size of the output buffer
+int	field_pos[ARB]		#I starting positions for the fields
+int	nfields			#I the number of fields
+int	xfield			#I the field number of the x coordinate column
+int	yfield			#I the field number of the y coordinate column
+real	xt			#I the transformed x coordinate
+real	yt			#I the transformed y coordinate
+char	xformat[ARB]		#I the output format for the x column
+char	yformat[ARB]		#I the output format for the y column
+int	nsdig_x			#I the number of significant digits in x
+int	nsdig_y			#I the number of significant digits in y
+int	min_sigdigits		#I the minimum number of significant digits
+
+int	num_field, width, op
+pointer	sp, field
+int	gstrcpy()
+
+begin
+	call smark (sp)
+	call salloc (field, SZ_LINE, TY_CHAR)
+
+	# Initialize output pointer.
+	op = 1
+
+	do num_field = 1, nfields {
+	    width = field_pos[num_field + 1] - field_pos[num_field]
+
+	    if (num_field == xfield) {
+	        call li_format_fieldr (xt, Memc[field], maxch, xformat,
+		    nsdig_x, width, min_sigdigits)
+	    } else if (num_field == yfield) {
+		call li_format_fieldr (yt, Memc[field], maxch, yformat,
+		    nsdig_y, width, min_sigdigits)
+	    } else {
+	        # Put "width" characters from inbuf into field
+		call strcpy (inbuf[field_pos[num_field]], Memc[field], width)
+	    }
+
+	    # Fields must be delimited by at least one blank.
+	    if (num_field > 1 && !IS_WHITE (Memc[field])) {
+		outbuf[op] = ' '
+		op = op + 1
+	    }
+
+	    # Copy "field" to output buffer.
+	    op = op + gstrcpy (Memc[field], outbuf[op], maxch)
+	}
+
+	outbuf[op] = '\n'
+	outbuf[op+1] = EOS
+
+	call sfree (sp)
+end
+
+
+# LI_APPEND_LINE -- Fields are appened to the input buffer.  Transformed
+# fields are converted to strings and added to the end of the input buffer.
+
+procedure li_append_liner (inbuf, outbuf, maxch, xt, yt, xformat, yformat,
+	nsdig_x, nsdig_y, min_sigdigits)
+
+char	inbuf[ARB]		#I the input string buffer
+char	outbuf[maxch]		#O the output string buffer
+int	maxch			#I the maximum size of the output buffer
+real	xt			#I the transformed x coordinate
+real	yt			#I the transformed y coordinate
+char	xformat[ARB]		#I the output format for the x column
+char	yformat[ARB]		#I the output format for the y column
+int	nsdig_x			#I the number of significant digits in x
+int	nsdig_y			#I the number of significant digits in y
+int	min_sigdigits		#I the minimum number of significant digits
+
+int	ip, op
+pointer	sp, field
+int	gstrcpy()
+
+begin
+	# Allocate some working space.
+	call smark (sp)
+	call salloc (field, SZ_LINE, TY_CHAR)
+
+	# Copy the input buffer into the output buffer minus the newline.
+	op = 1
+	for (ip = 1; ip <= maxch; ip = ip + 1) {
+	    if (inbuf[ip] == '\n' || inbuf[ip] == EOS)
+		break
+	    outbuf[op] = inbuf[ip]
+	    op = op + 1
+	}
+
+	# Add two blanks.
+	op = op + gstrcpy ("  ", outbuf[op], maxch - op + 1)
+
+	# Format and add the the two extra fields with a blank between.
+	call li_format_fieldr (xt, Memc[field], SZ_LINE, xformat,
+	    nsdig_x, 0, min_sigdigits)
+	op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1)
+	if (op <= maxch) {
+	    outbuf[op] = ' '
+	    op = op + 1
+	}
+	call li_format_fieldr (yt, Memc[field], SZ_LINE, yformat,
+	    nsdig_y, 0, min_sigdigits)
+	op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1)
+
+	# Add a newline.
+	if (op <= maxch) {
+	    outbuf[op] = '\n'
+	    op = op + 1
+	}
+	outbuf[op] = EOS
+
+	call sfree (sp)
+end
+
+
+# LI_FORMAT_FIELD -- A transformed coordinate is written into a string
+# buffer.  The output field is of (at least) the same width and significance
+# as the input list entry.
+
+procedure li_format_fieldr (fval, wordbuf, maxch, format, nsdig, width,
+	min_sigdigits)
+
+real	fval			#I the input value to be formatted
+char	wordbuf[maxch]		#O the output formatted string
+int	maxch			#I the maximum length of the output string
+char	format[ARB]		#I the output format
+int	nsdig 			#I the number of sig-digits in current value
+int	width			#I the width of the curent field
+int	min_sigdigits		#I the minimum number of significant digits
+
+int	fdigits, fwidth
+begin
+	if (format[1] == EOS) {
+	    fdigits = max (min_sigdigits, nsdig)
+	    fwidth = max (width, fdigits + 1)
+	    call sprintf (wordbuf, maxch, "%*.*g")
+	        call pargi (fwidth)
+	        call pargi (fdigits)
+	        call pargr (fval)
+	} else {
+	    call sprintf (wordbuf, maxch, format)
+		call pargr (fval)
+	}
+end
+
+# LI_NPACK_LINE -- Fields are packed into the outbuf buffer.  Transformed
+# fields are converted to strings; other fields are copied from
+# the input line to output buffer.
+
+procedure li_npack_liner (inbuf, outbuf, maxch, field_pos, nfields, 
+        vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits)
+
+char    inbuf[ARB]              #I the input string buffer
+char    outbuf[maxch]           #O the output string buffer
+int     maxch                   #I the maximum size of the output buffer
+int     field_pos[ARB]          #I starting positions for the fields
+int     nfields                 #I the number of fields
+int     vfields[ARB]            #I the fields to be formatted
+real   values[ARB]             #I the field values to be formatted
+int     nsdigits[ARB]           #I the number of field significant digits
+int     nvalues                 #I the number of fields to be formatted
+char    vformats[sz_fmt,ARB]    #I the field formats
+int     sz_fmt                  #I the size of the format string
+int     min_sigdigits           #I the minimum number of significant digits
+
+bool    found
+int     op, num_field, num_var, width
+pointer sp, field
+int     gstrcpy()
+
+begin
+        call smark (sp)
+        call salloc (field, SZ_LINE, TY_CHAR)
+
+        # Initialize output pointer.
+        op = 1
+
+        do num_field = 1, nfields {
+            width = field_pos[num_field + 1] - field_pos[num_field]
+
+            found = false
+            do num_var = 1, nvalues {
+                if (num_field == vfields[num_var]) {
+                    found = true
+                    break
+                }
+            }
+
+            if (found) {
+                call li_format_fieldr (values[num_var], Memc[field],
+                    maxch, vformats[1,num_var], nsdigits[num_var], width,
+                    min_sigdigits)
+            } else {
+                # Put "width" characters from inbuf into field
+                call strcpy (inbuf[field_pos[num_field]], Memc[field], width)
+            }
+
+            # Fields must be delimited by at least one blank.
+            if (num_field > 1 && !IS_WHITE (Memc[field])) {
+                outbuf[op] = ' '
+                op = op + 1
+            }
+
+            # Copy "field" to output buffer.
+            op = op + gstrcpy (Memc[field], outbuf[op], maxch)
+        }
+
+        outbuf[op] = '\n'
+        outbuf[op+1] = EOS
+
+        call sfree (sp)
+end
+
+
+# LI_NAPPEND_LINE -- Fields are appened to the input buffer.  Transformed
+# fields are converted to strings and added to the end of the input buffer.
+
+procedure li_nappend_liner (inbuf, outbuf, maxch, field_pos, nfields, 
+        vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits)
+
+char    inbuf[ARB]              #I the input string buffer
+char    outbuf[maxch]           #O the output string buffer
+int     maxch                   #I the maximum size of the output buffer
+int     field_pos[ARB]          #I starting positions for the fields
+int     nfields                 #I the number of fields
+int     vfields[ARB]            #I the fields to be formatted
+real   values[ARB]             #I the field values to be formatted
+int     nsdigits[ARB]           #I the number of field significant digits
+int     nvalues                 #I the number of fields to be formatted
+char    vformats[sz_fmt,ARB]    #I the field formats
+int     sz_fmt                  #I the size of the format string
+int     min_sigdigits           #I the minimum number of significant digits
+
+int     num_var, ip, op, index
+pointer sp, field, nvfields
+int     gstrcpy()
+
+begin
+        # Allocate some working space.
+        call smark (sp)
+        call salloc (field, SZ_LINE, TY_CHAR)
+        call salloc (nvfields, nvalues, TY_INT)
+        do num_var = 1, nvalues
+            Memi[nvfields+num_var-1] = num_var
+        call rg_qsorti (vfields, Memi[nvfields], Memi[nvfields], nvalues)
+
+        # Copy the input buffer into the output buffer minus the newline.
+        op = 1
+        for (ip = 1; ip <= maxch; ip = ip + 1) {
+            if (inbuf[ip] == '\n' || inbuf[ip] == EOS)
+                break
+            outbuf[op] = inbuf[ip]
+            op = op + 1
+        }
+
+        # Add two blanks.
+        op = op + gstrcpy ("  ", outbuf[op], maxch - op + 1)
+
+        do num_var = 1, nvalues {
+            index = Memi[nvfields+num_var-1]
+            call li_format_fieldr (values[index], Memc[field], SZ_LINE,
+                vformats[sz_fmt,index], nsdigits[index], 0, min_sigdigits)
+            op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1)
+            if (num_var == nvalues) {
+                if (op <= maxch) {
+                    outbuf[op] = '\n'
+                    op = op + 1
+                }
+            } else {
+                if (op <= maxch) {
+                    outbuf[op] = ' '
+                    op = op + 1
+                }
+            }
+        }
+
+        outbuf[op] = EOS
+
+        call sfree (sp)
+end
+
+
+
+
+# LT_GET_NUM -- The field entry is converted from character to real or double
+# in preparation for the transformation.  The number of significant
+# digits is counted and returned as an argument; the number of chars in
+# the number is returned as the function value.
+
+int procedure li_get_numd (linebuf, fval, nsdig) 
+
+char	linebuf[ARB]		#I the input line buffer
+double	fval			#O the output floating point value
+int	nsdig			#O the number of significant digits
+
+char	ch
+int 	nchar, ip
+int	ctod(), stridx()
+
+begin
+	ip = 1
+	nsdig = 0
+	nchar = ctod (linebuf, ip, fval)
+	if (nchar == 0 || fval == INDEFD)
+	    return (nchar)
+
+	# Skip leading white space.
+	ip = 1
+    	repeat {
+	    ch = linebuf[ip]
+	    if (! IS_WHITE(ch)) 
+		break
+	    ip = ip + 1
+	} 
+
+	# Count signifigant digits
+	for (; ! IS_WHITE(ch) && ch != '\n' && ch != EOS; ch=linebuf[ip]) {
+	    if (stridx (ch, "eEdD") > 0)
+		break
+	    if (IS_DIGIT (ch))
+		nsdig = nsdig + 1
+	    ip = ip + 1
+	}
+
+	return (nchar)
+end
+
+
+# LI_PACK_LINE -- Fields are packed into the outbuf buffer.  Transformed
+# fields are converted to strings; other fields are copied from
+# the input line to output buffer.
+
+procedure li_pack_lined (inbuf, outbuf, maxch, field_pos, nfields, 
+	xfield, yfield, xt, yt, xformat, yformat, nsdig_x, nsdig_y,
+	min_sigdigits)
+
+char	inbuf[ARB]		#I the input string buffer
+char	outbuf[maxch]		#O the output string buffer
+int	maxch			#I the maximum size of the output buffer
+int	field_pos[ARB]		#I starting positions for the fields
+int	nfields			#I the number of fields
+int	xfield			#I the field number of the x coordinate column
+int	yfield			#I the field number of the y coordinate column
+double	xt			#I the transformed x coordinate
+double	yt			#I the transformed y coordinate
+char	xformat[ARB]		#I the output format for the x column
+char	yformat[ARB]		#I the output format for the y column
+int	nsdig_x			#I the number of significant digits in x
+int	nsdig_y			#I the number of significant digits in y
+int	min_sigdigits		#I the minimum number of significant digits
+
+int	num_field, width, op
+pointer	sp, field
+int	gstrcpy()
+
+begin
+	call smark (sp)
+	call salloc (field, SZ_LINE, TY_CHAR)
+
+	# Initialize output pointer.
+	op = 1
+
+	do num_field = 1, nfields {
+	    width = field_pos[num_field + 1] - field_pos[num_field]
+
+	    if (num_field == xfield) {
+	        call li_format_fieldd (xt, Memc[field], maxch, xformat,
+		    nsdig_x, width, min_sigdigits)
+	    } else if (num_field == yfield) {
+		call li_format_fieldd (yt, Memc[field], maxch, yformat,
+		    nsdig_y, width, min_sigdigits)
+	    } else {
+	        # Put "width" characters from inbuf into field
+		call strcpy (inbuf[field_pos[num_field]], Memc[field], width)
+	    }
+
+	    # Fields must be delimited by at least one blank.
+	    if (num_field > 1 && !IS_WHITE (Memc[field])) {
+		outbuf[op] = ' '
+		op = op + 1
+	    }
+
+	    # Copy "field" to output buffer.
+	    op = op + gstrcpy (Memc[field], outbuf[op], maxch)
+	}
+
+	outbuf[op] = '\n'
+	outbuf[op+1] = EOS
+
+	call sfree (sp)
+end
+
+
+# LI_APPEND_LINE -- Fields are appened to the input buffer.  Transformed
+# fields are converted to strings and added to the end of the input buffer.
+
+procedure li_append_lined (inbuf, outbuf, maxch, xt, yt, xformat, yformat,
+	nsdig_x, nsdig_y, min_sigdigits)
+
+char	inbuf[ARB]		#I the input string buffer
+char	outbuf[maxch]		#O the output string buffer
+int	maxch			#I the maximum size of the output buffer
+double	xt			#I the transformed x coordinate
+double	yt			#I the transformed y coordinate
+char	xformat[ARB]		#I the output format for the x column
+char	yformat[ARB]		#I the output format for the y column
+int	nsdig_x			#I the number of significant digits in x
+int	nsdig_y			#I the number of significant digits in y
+int	min_sigdigits		#I the minimum number of significant digits
+
+int	ip, op
+pointer	sp, field
+int	gstrcpy()
+
+begin
+	# Allocate some working space.
+	call smark (sp)
+	call salloc (field, SZ_LINE, TY_CHAR)
+
+	# Copy the input buffer into the output buffer minus the newline.
+	op = 1
+	for (ip = 1; ip <= maxch; ip = ip + 1) {
+	    if (inbuf[ip] == '\n' || inbuf[ip] == EOS)
+		break
+	    outbuf[op] = inbuf[ip]
+	    op = op + 1
+	}
+
+	# Add two blanks.
+	op = op + gstrcpy ("  ", outbuf[op], maxch - op + 1)
+
+	# Format and add the the two extra fields with a blank between.
+	call li_format_fieldd (xt, Memc[field], SZ_LINE, xformat,
+	    nsdig_x, 0, min_sigdigits)
+	op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1)
+	if (op <= maxch) {
+	    outbuf[op] = ' '
+	    op = op + 1
+	}
+	call li_format_fieldd (yt, Memc[field], SZ_LINE, yformat,
+	    nsdig_y, 0, min_sigdigits)
+	op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1)
+
+	# Add a newline.
+	if (op <= maxch) {
+	    outbuf[op] = '\n'
+	    op = op + 1
+	}
+	outbuf[op] = EOS
+
+	call sfree (sp)
+end
+
+
+# LI_FORMAT_FIELD -- A transformed coordinate is written into a string
+# buffer.  The output field is of (at least) the same width and significance
+# as the input list entry.
+
+procedure li_format_fieldd (fval, wordbuf, maxch, format, nsdig, width,
+	min_sigdigits)
+
+double	fval			#I the input value to be formatted
+char	wordbuf[maxch]		#O the output formatted string
+int	maxch			#I the maximum length of the output string
+char	format[ARB]		#I the output format
+int	nsdig 			#I the number of sig-digits in current value
+int	width			#I the width of the curent field
+int	min_sigdigits		#I the minimum number of significant digits
+
+int	fdigits, fwidth
+begin
+	if (format[1] == EOS) {
+	    fdigits = max (min_sigdigits, nsdig)
+	    fwidth = max (width, fdigits + 1)
+	    call sprintf (wordbuf, maxch, "%*.*g")
+	        call pargi (fwidth)
+	        call pargi (fdigits)
+	        call pargd (fval)
+	} else {
+	    call sprintf (wordbuf, maxch, format)
+		call pargd (fval)
+	}
+end
+
+# LI_NPACK_LINE -- Fields are packed into the outbuf buffer.  Transformed
+# fields are converted to strings; other fields are copied from
+# the input line to output buffer.
+
+procedure li_npack_lined (inbuf, outbuf, maxch, field_pos, nfields, 
+        vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits)
+
+char    inbuf[ARB]              #I the input string buffer
+char    outbuf[maxch]           #O the output string buffer
+int     maxch                   #I the maximum size of the output buffer
+int     field_pos[ARB]          #I starting positions for the fields
+int     nfields                 #I the number of fields
+int     vfields[ARB]            #I the fields to be formatted
+double   values[ARB]             #I the field values to be formatted
+int     nsdigits[ARB]           #I the number of field significant digits
+int     nvalues                 #I the number of fields to be formatted
+char    vformats[sz_fmt,ARB]    #I the field formats
+int     sz_fmt                  #I the size of the format string
+int     min_sigdigits           #I the minimum number of significant digits
+
+bool    found
+int     op, num_field, num_var, width
+pointer sp, field
+int     gstrcpy()
+
+begin
+        call smark (sp)
+        call salloc (field, SZ_LINE, TY_CHAR)
+
+        # Initialize output pointer.
+        op = 1
+
+        do num_field = 1, nfields {
+            width = field_pos[num_field + 1] - field_pos[num_field]
+
+            found = false
+            do num_var = 1, nvalues {
+                if (num_field == vfields[num_var]) {
+                    found = true
+                    break
+                }
+            }
+
+            if (found) {
+                call li_format_fieldd (values[num_var], Memc[field],
+                    maxch, vformats[1,num_var], nsdigits[num_var], width,
+                    min_sigdigits)
+            } else {
+                # Put "width" characters from inbuf into field
+                call strcpy (inbuf[field_pos[num_field]], Memc[field], width)
+            }
+
+            # Fields must be delimited by at least one blank.
+            if (num_field > 1 && !IS_WHITE (Memc[field])) {
+                outbuf[op] = ' '
+                op = op + 1
+            }
+
+            # Copy "field" to output buffer.
+            op = op + gstrcpy (Memc[field], outbuf[op], maxch)
+        }
+
+        outbuf[op] = '\n'
+        outbuf[op+1] = EOS
+
+        call sfree (sp)
+end
+
+
+# LI_NAPPEND_LINE -- Fields are appened to the input buffer.  Transformed
+# fields are converted to strings and added to the end of the input buffer.
+
+procedure li_nappend_lined (inbuf, outbuf, maxch, field_pos, nfields, 
+        vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits)
+
+char    inbuf[ARB]              #I the input string buffer
+char    outbuf[maxch]           #O the output string buffer
+int     maxch                   #I the maximum size of the output buffer
+int     field_pos[ARB]          #I starting positions for the fields
+int     nfields                 #I the number of fields
+int     vfields[ARB]            #I the fields to be formatted
+double   values[ARB]             #I the field values to be formatted
+int     nsdigits[ARB]           #I the number of field significant digits
+int     nvalues                 #I the number of fields to be formatted
+char    vformats[sz_fmt,ARB]    #I the field formats
+int     sz_fmt                  #I the size of the format string
+int     min_sigdigits           #I the minimum number of significant digits
+
+int     num_var, ip, op, index
+pointer sp, field, nvfields
+int     gstrcpy()
+
+begin
+        # Allocate some working space.
+        call smark (sp)
+        call salloc (field, SZ_LINE, TY_CHAR)
+        call salloc (nvfields, nvalues, TY_INT)
+        do num_var = 1, nvalues
+            Memi[nvfields+num_var-1] = num_var
+        call rg_qsorti (vfields, Memi[nvfields], Memi[nvfields], nvalues)
+
+        # Copy the input buffer into the output buffer minus the newline.
+        op = 1
+        for (ip = 1; ip <= maxch; ip = ip + 1) {
+            if (inbuf[ip] == '\n' || inbuf[ip] == EOS)
+                break
+            outbuf[op] = inbuf[ip]
+            op = op + 1
+        }
+
+        # Add two blanks.
+        op = op + gstrcpy ("  ", outbuf[op], maxch - op + 1)
+
+        do num_var = 1, nvalues {
+            index = Memi[nvfields+num_var-1]
+            call li_format_fieldd (values[index], Memc[field], SZ_LINE,
+                vformats[sz_fmt,index], nsdigits[index], 0, min_sigdigits)
+            op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1)
+            if (num_var == nvalues) {
+                if (op <= maxch) {
+                    outbuf[op] = '\n'
+                    op = op + 1
+                }
+            } else {
+                if (op <= maxch) {
+                    outbuf[op] = ' '
+                    op = op + 1
+                }
+            }
+        }
+
+        outbuf[op] = EOS
+
+        call sfree (sp)
+end
+
+
+
diff --git a/pkg/images/lib/mkpkg b/pkg/images/lib/mkpkg
new file mode 100644
index 00000000..dd55f750
--- /dev/null
+++ b/pkg/images/lib/mkpkg
@@ -0,0 +1,72 @@
+# Library for the IMAGES package containing routines used by tasks in
+# different subpackages
+
+$checkout libpkg.a ../
+$update	libpkg.a
+$checkin libpkg.a ../
+$exit
+
+generic:
+        $set    GEN = "$$generic -k"
+
+        $ifolder (geofit.x,geofit.gx)
+            $(GEN) geofit.gx -o geofit.x $endif
+        $ifolder (geogmap.x,geogmap.gx)
+            $(GEN) geogmap.gx -o geogmap.x $endif
+        $ifolder (geograph.x,geograph.gx)
+            $(GEN) geograph.gx -o geograph.x $endif
+
+        $ifolder (liststr.x, liststr.gx)
+	    $(GEN) liststr.gx -o liststr.x $endif
+	;
+
+libpkg.a:
+        $ifeq (USE_GENERIC, yes) $call generic $endif
+
+	# used by imcopy, lineclean tasks
+	imcopy.x	<imhdr.h>
+
+	# used by xregister, psfmatch tasks
+	rgbckgrd.x	<mach.h> <math.h> <math/gsurfit.h>
+	rgcontour.x	<error.h> <mach.h> <gset.h> <config.h> <xwhen.h> \
+			<fset.h>
+	rgfft.x
+
+	# used by geoxytran and other list reading and writing tasks
+	liststr.x	<ctype.h>
+
+	# geomap, ccmap, and other tasks?, should be fmtio routine which is
+	# the reverse of strdic
+	rgwrdstr.x
+
+	# used by ccmap, ccsetwcs, cctran, skyxymatch, skyctran, imcctran
+	# ccxymatch tasks
+	# put in xtools at some point ?
+	#skywcs.x	<imhdr.h> <imio.h> <math.h> <mwset.h> \
+	#		"skywcs.h" "skywcsdef.h"
+
+	# used by ccmap, ccxymatch
+	rgccwcs.x	<imhdr.h> <math.h> <mwset.h> <pkg/skywcs.h>
+
+	# used by xyxymatch, ccxymatch, imtile tasks
+	rgsort.x
+
+	# used by skyxymatch and imctran tasks, include in skywcs.x ?
+	rglltran.x	<math.h> <pkg/skywcs.h>
+
+	# used by skyxymatch, wcsxymatch, imcctran tasks
+	rgxymatch.x	<mwset.h>
+
+	# used by ccxymatch, xyxymatch tasks
+	rgmerge.x       <mach.h> <plset.h> "xyxymatch.h"
+	rgtransform.x   <math.h> <math/gsurfit.h> "xyxymatch.h"
+        xymatch.x       "xyxymatch.h"
+
+	# used by ccmap, geomap tasks
+        geofit.x        <mach.h> <math.h> <math/gsurfit.h> "geomap.h"
+        geogmap.x       <error.h> <math.h> <math/gsurfit.h> "geomap.h" \
+			"geogmap.h"
+        geograph.x      <mach.h> <math.h> <gset.h> <math/gsurfit.h> \
+                        <pkg/gtools.h> "geomap.h" "geogmap.h"
+	geoset.x	"geomap.h"
+	;
diff --git a/pkg/images/lib/rgbckgrd.x b/pkg/images/lib/rgbckgrd.x
new file mode 100644
index 00000000..feef4fd4
--- /dev/null
+++ b/pkg/images/lib/rgbckgrd.x
@@ -0,0 +1,661 @@
+include <mach.h>
+include <math.h>
+include <math/gsurfit.h>
+
+
+# RG_BORDER -- Fetch the border pixels from a 2D subraster.
+
+int procedure rg_border (buf, nx, ny, pnx, pny, ptr)
+
+real	buf[nx,ARB]	#I the input data subraster
+int	nx, ny		#I the dimensions of the input subraster
+int	pnx, pny	#I the size of the data region
+pointer	ptr		#I the pointer to the output buffer
+	
+int	j, nborder, wxborder, wyborder, index
+
+begin
+	# Compute the size of the array
+	nborder = nx * ny - pnx * pny
+	if (nborder <= 0) {
+	    ptr = NULL
+	    return (0)
+	} else if (nborder >= nx * ny) {
+	    call malloc (ptr, nx * ny, TY_REAL)
+	    call amovr (buf, Memr[ptr], nx * ny)
+	    return (nx * ny)
+	} else
+	    call malloc (ptr, nborder, TY_REAL)
+
+	# Fill the array.
+	wxborder = (nx - pnx) / 2
+	wyborder = (ny - pny) / 2
+	index = ptr
+	do j = 1, wyborder {
+	    call amovr (buf[1,j], Memr[index], nx)
+	    index = index + nx
+	}
+	do j = wyborder + 1, ny - wyborder {
+	    call amovr (buf[1,j], Memr[index], wxborder) 
+	    index = index + wxborder
+	    call amovr (buf[nx-wxborder+1,j], Memr[index], wxborder)
+	    index = index + wxborder
+	}
+	do j = ny - wyborder + 1, ny {
+	    call amovr (buf[1,j], Memr[index], nx)
+	    index = index + nx
+	}
+
+	return (nborder)
+end
+
+
+# RG_SUBTRACT -- Subtract a plane from the data.
+
+procedure rg_subtract (data, nx, ny, zero, xslope, yslope)
+
+real	data[nx,ARB]		#I/O the input/output data array
+int	nx, ny			#I the dimensions of the input data array
+real	zero			#I the input zero point
+real	xslope			#I the input x slope
+real	yslope			#I the input y slope
+
+int	i, j
+real	ydelta
+
+begin
+	do j = 1, ny {
+	    ydelta = yslope * j
+	    do i = 1, nx
+		data[i,j] = data[i,j] - zero - xslope * i - ydelta
+	}
+end
+
+
+# RG_APODIZE -- Apply a cosine bell to the data. The operation can be
+# performed in place
+
+procedure rg_apodize (data, nx, ny, apodize, forward)
+
+real    data[nx,ARB]            #I the input data array
+int     nx, ny                  #I the size of the input array
+real    apodize                 #I the percentage of the end to apodize
+int     forward                 #I YES for forward, NO for reverse
+
+int     i, j, nxpercent, nypercent, iindex, jindex
+real    f
+
+begin
+        nxpercent = apodize * nx
+        nypercent = apodize * ny
+
+        if (forward == YES) {
+            do j = 1, ny {
+                do i = 1, nxpercent {
+                    iindex = nx - i + 1
+                    f = (1.0 - cos (PI * real (i-1) / real(nxpercent))) / 2.0
+                    data[i,j] =  f * data[i,j]
+                    data[iindex,j] = f * data[iindex,j]
+                }
+            }
+            do i = 1, nx {
+                do j = 1, nypercent {
+                    jindex = ny - j + 1
+                    f = (1.0 - cos (PI * real (j-1) / real(nypercent))) / 2.0
+                    data[i,j] =  f * data[i,j]
+                    data[i,jindex] = f * data[i,jindex]
+                }
+            }
+	} else {
+            do j = 1, ny {
+                do i = 1, nxpercent {
+                    iindex = nx - i + 1
+                    f = (1.0 - cos (PI * real (i-1) / real(nxpercent))) / 2.0
+                    if (f < 1.0e-3)
+                        f = 1.0e-3
+                    data[i,j] =  data[i,j] / f
+                    data[iindex,j] = data[iindex,j] / f
+                }
+            }
+            do i = 1, nx {
+                do j = 1, nypercent {
+                    jindex = ny - j + 1
+                    f = (1.0 - cos (PI * real (j-1) / real(nypercent))) / 2.0
+                    if (f < 1.0e-3)
+                        f = 1.0e-3
+                    data[i,j] =  data[i,j] / f
+                    data[i,jindex] = data[i,jindex] / f
+                }
+            }
+        }
+end
+
+
+# RG_ZNSUM -- Compute the mean and number of good points in the array with
+# one optional level of rejections.
+
+int procedure rg_znsum (data, npts, mean, lcut, hcut)
+
+real	data[ARB]	#I the input data array
+int	npts		#I the number of data points
+real	mean		#O the mean of the data
+real	lcut, hcut	#I the good data limits
+
+int	i, ngpts
+real	dif, sigma, sum, sumsq, lo, hi
+real	asumr(), assqr()
+
+begin
+	# Get the mean.
+	if (npts == 0) {
+	    mean = INDEFR
+	    return (0)
+	} else if (npts == 1) {
+	    mean = data[1]
+	    return (1)
+	} else {
+	    sum = asumr (data, npts)
+	    mean = sum / npts
+	}
+
+	# Quit if the rejection flags are not set.
+	if (IS_INDEFR(lcut) && IS_INDEFR(hcut))
+	    return (npts)
+
+	# Compute sigma
+	sumsq = assqr (data, npts)
+	sigma = sumsq / (npts - 1) - mean * sum / (npts - 1)
+	if (sigma <= 0.0)
+	    sigma = 0.0
+	else
+	    sigma = sqrt (sigma)
+	if (sigma <= 0.0)
+	    return (npts)
+
+	# Do the k-sigma rejection.
+	if (IS_INDEF(lcut))
+	    lo = -MAX_REAL
+	else
+	    lo = -lcut * sigma
+	if (IS_INDEFR(hcut))
+	    hi = MAX_REAL
+	else
+	    hi = hcut * sigma
+
+	# Reject points.
+	ngpts = npts
+	do i = 1, npts {
+	    dif = (data[i] - mean)
+	    if (dif >= lo && dif <= hi)
+	        next
+	    ngpts = ngpts - 1
+	    sum = sum - data[i]
+	    sumsq = sumsq - data[i] ** 2
+	}
+
+	# Get the final mean.
+	if (ngpts == 0) {
+	    mean = INDEFR
+	    return (0)
+	} else if (ngpts == 1) {
+	    mean = sum
+	    return (1)
+	} else
+	    mean = sum / ngpts
+
+	return (ngpts)
+end
+
+
+# RG_ZNMEDIAN -- Compute the median and number of good points in the array
+# with one level of rejection.
+
+int procedure rg_znmedian (data, npts, median, lcut, hcut)
+
+real	data[ARB]	#I the input data array
+int	npts		#I the number of data points
+real	median		#O the median of the data
+real	lcut, hcut	#I the good data limits
+
+int	i, ngpts, lindex, hindex
+pointer	sp, sdata
+real	mean, sigma, dif, lo, hi
+real	amedr()
+
+begin
+	if (IS_INDEFR (lcut) && IS_INDEFR(hcut))  {
+	    median = amedr (data, npts)
+	    return (npts)
+	}
+
+	# Allocate working space.
+	call smark (sp)
+	call salloc (sdata, npts, TY_REAL)
+	call asrtr (data, Memr[sdata], npts)
+	if (mod (npts, 2) == 0)
+	    median = (Memr[sdata+(1+npts)/2-1] + Memr[sdata+(1+npts)/2]) / 2.0
+	else
+	    median = Memr[sdata+(1+npts)/2-1]
+
+	# Compute the sigma.
+	call aavgr (Memr[sdata], npts, mean, sigma)
+	if (sigma <= 0.0) {
+	    call sfree (sp)
+	    return (npts)
+	}
+
+	# Do rejection.
+	ngpts = npts
+	if (IS_INDEFR(lo))
+	    lo = -MAX_REAL
+	else
+	    lo = -lcut * sigma
+	if (IS_INDEFR(hi))
+	    hi = MAX_REAL
+	else
+	    hi = hcut * sigma
+
+	do i = 1, npts {
+	    lindex = i
+	    dif = Memr[sdata+i-1] - median
+	    if (dif >= lo)
+		break
+	}
+	do i = npts, 1, -1 {
+	    hindex = i
+	    dif = Memr[sdata+i-1] - median
+	    if (dif <= hi)
+		break
+	}
+
+	ngpts = hindex - lindex + 1
+	if (ngpts <= 0)
+	    median = INDEFR
+	else if (mod (ngpts, 2) == 0)
+	    median = (Memr[sdata+lindex-1+(ngpts+1)/2-1] + Memr[sdata+lindex-1+
+	        (ngpts+1)/2]) / 2.0
+	else
+	    median = Memr[sdata+lindex-1+(ngpts+1)/2-1]
+
+	call sfree (sp)
+
+	return (ngpts)
+end
+
+
+# RG_SLOPE -- Subtract a slope from the data to be psf matched.
+
+int procedure rg_slope (gs, data, npts, nx, ny, wxborder, wyborder, loreject,
+	hireject)
+
+pointer	gs			#I the pointer to surfit structure
+real	data[ARB]		#I/O the input/output data
+int	npts			#I the number of points
+int	nx, ny			#I dimensions of the original data
+int	wxborder, wyborder	#I the x and y width of the border
+real	loreject, hireject	#I the rejection criteria
+
+int	i, stat, ier
+pointer	sp, x, y, w, zfit
+real	lcut, hcut, sigma
+int	rg_reject(), rg_breject()
+real	rg_sigma(), rg_bsigma()
+
+begin
+	# Initialize.
+	call smark (sp)
+	call salloc (x, nx, TY_REAL)
+	call salloc (y, nx, TY_REAL)
+	call salloc (w, nx, TY_REAL)
+	call salloc (zfit, nx, TY_REAL)
+	do i = 1, nx
+	    Memr[x+i-1] = i
+	call amovkr (1.0, Memr[w], nx)
+
+	# Accumulate the fit.
+	call gszero (gs)
+	if (npts >= nx * ny)
+	    call rg_gsaccum (gs, Memr[x], Memr[y], Memr[w], data, nx, ny)
+	else
+	    call rg_gsborder (gs, Memr[x], Memr[y], Memr[w], data, nx, ny,
+		wxborder, wyborder)
+
+	# Solve the surface.
+	call gssolve (gs, ier)
+	if (ier == NO_DEG_FREEDOM) {
+	    call sfree (sp)
+	    return (ERR)
+	}
+
+	# Perform the rejection.
+	if (! IS_INDEFR(loreject) || ! IS_INDEFR(hireject)) {
+	    if (npts >= nx * ny)
+		sigma = rg_sigma (gs, Memr[x], Memr[y], Memr[w], Memr[zfit],
+		    data, nx, ny)
+	    else
+		sigma = rg_bsigma (gs, Memr[x], Memr[y], Memr[w], Memr[zfit],
+		    data, nx, ny, wxborder, wyborder)
+	    if (sigma <= 0.0) {
+		call sfree (sp)
+		return (OK)
+	    }
+	    if (! IS_INDEFR(loreject))
+		lcut  = -loreject * sigma
+	    else
+		lcut = -MAX_REAL
+	    if (! IS_INDEFR(hireject))
+		hcut  = hireject * sigma
+	    else
+		hcut = MAX_REAL
+	    if (npts >= nx * ny)
+		stat = rg_reject (gs, Memr[x], Memr[y], Memr[w], Memr[zfit],
+		    data, nx, ny, lcut, hcut)
+	    else
+		stat = rg_breject (gs, Memr[x], Memr[y], Memr[w], Memr[zfit],
+		    data, nx, ny, wxborder, wyborder, lcut, hcut)
+	}
+
+	call sfree (sp)
+	return (stat)
+end
+
+
+# RG_GSACCUM -- Accumulate the points into the fits assuming the data is in the
+# form of a two-dimensional subraster.
+
+procedure rg_gsaccum (gs, x, y, w, data, nx, ny)
+
+pointer	gs		#I pointer to the surface fitting structure
+real	x[ARB]		#I the input x array
+real	y[ARB]		#I the input y array
+real	w[ARB]		#I the input weight array
+real	data[ARB]	#I the input data array
+int	nx, ny		#I the size of the input data array
+
+int	i, index
+
+begin
+	index = 1
+	do i = 1, ny {
+	    call amovkr (real (i), y, nx)
+	    call gsacpts (gs, x, y, data[index], w, nx, WTS_USER)
+	    index = index + nx
+	}
+end
+
+
+# RG_GSBORDER -- Procedure to accumulate the points into the fit assuming
+# that a border has been extracted
+
+procedure rg_gsborder (gs, x, y, w, data, nx, ny, wxborder, wyborder)
+
+pointer	gs			#I pointer to the surface fitting structure
+real	x[ARB]			#I the input x array
+real	y[ARB]			#I the input y array
+real	w[ARB]			#I the input weight array
+real	data[ARB]		#I the input data array
+int	nx, ny			#I the dimensions of the input data
+int	wxborder, wyborder	#I the width of the border
+
+int	i, index, nborder
+
+begin
+	nborder = nx * ny - (nx - wxborder) * (ny - wyborder)
+
+	index = 1
+	do i = 1, wyborder {
+	    call amovkr (real (i), y, nx)
+	    call gsacpts (gs, x, y, data[index], w, nx, WTS_USER)
+	    index = index + nx
+	}
+
+	index = nx * wyborder + 1
+	do i = wyborder + 1, ny - wyborder {
+	    call amovkr (real (i), y, nx)
+	    call gsacpts (gs, x, y, data[index], w, wxborder, WTS_USER)
+	    index = index + wxborder
+	    call gsacpts (gs, x[1+nx-wxborder], y[1+nx-wxborder],
+	        data[index], w[1+nx-wxborder], wxborder, WTS_USER)
+	    index = index + wxborder
+	}
+
+	index = 1 + nborder - nx * wyborder
+	do i = ny - wyborder + 1, ny {
+	    call amovkr (real (i), y, nx)
+	    call gsacpts (gs, x, y, data[index], w, nx, WTS_USER)
+	    index = index + nx
+	}
+
+end
+
+
+# RG_SIGMA -- Compute sigma assuming the data is in the form of a
+# two-dimensional subraster.
+
+real procedure rg_sigma (gs, x, y, w, zfit, data, nx, ny)
+
+pointer	gs		#I the pointer to the surface fitting structure
+real	x[ARB]		#I the input x array
+real	y[ARB]		#I the input y array
+real	w[ARB]		#I the input w array
+real	zfit[ARB]	#O the output fitted data
+real	data[ARB]	#I/O the input/output data array
+int	nx, ny		#I the dimensions of the output data
+
+int	i, j, index, npts
+real	sum
+
+begin
+	npts = 0
+	index = 1
+	sum = 0.0
+
+	do i = 1, ny {
+	    call amovkr (real (i), y, nx)
+	    call gsvector (gs, x, y, zfit, nx)
+	    call asubr (data[index], zfit, zfit, nx)
+	    do j = 1, nx {
+		if (w[j] > 0.0) {
+		    sum = sum + zfit[j] ** 2
+		    npts = npts + 1
+		}
+	    }
+	    index = index + nx
+	}
+
+	return (sqrt (sum / npts))
+end
+
+
+# RG_BSIGMA -- Procedure to compute sigma assuming a border has been
+# extracted from a subraster.
+
+real procedure rg_bsigma (gs, x, y, w, zfit, data, nx, ny, wxborder, wyborder)
+
+pointer	gs			#I the pointer to the surface fitting structure
+real	x[ARB]			#I the input x array
+real	y[ARB]			#I the output y array
+real	w[ARB]			#I the output weight array
+real	zfit[ARB]		#O the fitted z array
+real	data[ARB]		#I/O the input/output data array
+int	nx, ny			#I the dimensions of original subraster
+int	wxborder, wyborder	#I the width of the border
+
+int	i, j, npts, nborder, index
+real	sum
+
+begin
+	nborder = nx * ny - (nx - wxborder) * (ny - wyborder)
+	npts = 0
+	index = 1
+	sum = 0.0
+
+	do i = 1, wyborder {
+	    call amovkr (real (i), y, nx)
+	    call gsvector (gs, x, y, zfit, nx)
+	    call asubr (data[index], zfit, zfit, nx)
+	    do j = 1, nx {
+		if (w[j] > 0.0) {
+		    npts = npts + 1
+		    sum = sum + zfit[j] ** 2
+		}
+	    }
+	    index = index + nx
+	}
+
+	index = nx * wyborder + 1
+	do i = wyborder + 1, ny - wyborder {
+	    call amovkr (real (i), y, nx)
+	    call gsvector (gs, x, y, zfit, wxborder)
+	    call asubr (data[index], zfit, zfit, wxborder)
+	    do j = 1, wxborder {
+		if (w[j] > 0.0) {
+		    npts = npts + 1
+		    sum = sum + zfit[j] ** 2
+		}
+	    }
+	    index = index + wxborder
+	    call gsvector (gs, x[1+nx-wxborder], y[1+nx-wxborder], zfit,
+	        wxborder)
+	    call asubr (data[index], zfit, zfit, wxborder)
+	    do j = 1, wxborder {
+		if (w[j] > 0.0) {
+		    npts = npts + 1
+		    sum = sum + zfit[j] ** 2
+		}
+	    }
+	    index = index + wxborder
+	}
+
+	index = 1 + nborder - nx * wyborder
+	do i = ny - wyborder + 1, ny {
+	    call amovkr (real (i), y, nx)
+	    call gsvector (gs, x, y, zfit, nx)
+	    call asubr (data[index], zfit, zfit, nx)
+	    do j = 1, nx {
+		if (w[j] > 0.0) {
+		    npts = npts + 1
+		    sum = sum + zfit[j] ** 2
+		}
+	    }
+	    index = index + nx
+	}
+
+	return (sqrt (sum / npts))
+end
+
+
+# RG_REJECT -- Reject points from the fit assuming the data is in the form of a
+# two-dimensional subraster.
+
+int procedure rg_reject (gs, x, y, w, zfit, data, nx, ny, lcut, hcut)
+
+pointer	gs		#I the pointer to the surface fitting structure
+real	x[ARB]		#I the input x array
+real	y[ARB]		#I the input y array
+real	w[ARB]		#I the input w array
+real	zfit[ARB]	#O the fitted data
+real	data[ARB]	#I/O the input/output data array
+int	nx, ny		#I the dimensions of the data
+real	lcut, hcut	#I the lo and high side rejection criteria
+
+int	i, j, index, ier
+
+begin
+	index = 1
+
+	do i = 1, ny {
+	    call amovkr (real (i), y, nx)
+	    call gsvector (gs, x, y, zfit, nx)
+	    call asubr (data[index], zfit, zfit, nx)
+	    do j = 1, nx {
+		if (zfit[j] < lcut || zfit[j] > hcut)
+		    call gsrej (gs, x[j], y[j], data[index+j-1], w[j], WTS_USER)
+	    }
+	    index = index + nx
+	}
+
+	call gssolve (gs, ier)
+	if (ier == NO_DEG_FREEDOM)
+	    return (ERR)
+	else
+	    return (OK)
+end
+
+
+# RG_BREJECT -- Reject deviant points from the fits assuming a border has
+# been extracted from the subraster.
+
+int procedure rg_breject (gs, x, y, w, zfit, data, nx, ny, wxborder,
+	wyborder, lcut, hcut)
+
+pointer	gs			#I the pointer to the surface fitting structure
+real	x[ARB]			#I the input x array
+real	y[ARB]			#I the input y array
+real	w[ARB]			#I the input weight array
+real	zfit[ARB]		#O the fitted z array
+real	data[ARB]		#I/O the input/output data array
+int	nx, ny			#I the dimensions of the original subraster
+int	wxborder, wyborder	#I the width of the border
+real	lcut, hcut		#I the low and high rejection criteria
+
+int	i, j, nborder, index, ier
+
+begin
+	nborder = nx * ny - (nx - wxborder) * (ny - wyborder)
+	index = 1
+
+	do i = 1, wyborder {
+	    call amovkr (real (i), y, nx)
+	    call gsvector (gs, x, y, zfit, nx)
+	    call asubr (data[index], zfit, zfit, nx)
+	    do j = 1, nx {
+		if (zfit[j] < lcut || zfit[j] > hcut)
+		    call gsrej (gs, x[j], y[j], data[index+j-1], w[j],
+		        WTS_USER)
+	    }
+	    index = index + nx
+	}
+
+	index = nx * wyborder + 1
+	do i = wyborder + 1, ny - wyborder {
+	    call amovkr (real (i), y, nx)
+	    call gsvector (gs, x, y, zfit, wxborder)
+	    call asubr (data[index], zfit, zfit, wxborder)
+	    do j = 1, wxborder {
+		if (zfit[j] < lcut || zfit[j] > hcut) 
+		    call gsrej (gs, x[j], y[j], data[index+j-1], w[j],
+		        WTS_USER)
+	    }
+	    index = index + wxborder
+	    call gsvector (gs, x[1+nx-wxborder], y[1+nx-wxborder], zfit,
+	        wxborder)
+	    call asubr (data[index], zfit, zfit, wxborder)
+	    do j = 1, wxborder {
+		if (zfit[j] < lcut || zfit[j] > hcut)
+		    call gsrej (gs, x[j], y[j], data[index+j-1], w[j],
+		        WTS_USER)
+	    }
+	    index = index + wxborder
+	}
+
+	index = 1 + nborder - nx * wyborder
+	do i = ny - wyborder + 1, ny {
+	    call amovkr (real (i), y, nx)
+	    call gsvector (gs, x, y, zfit, nx)
+	    call asubr (data[index], zfit, zfit, nx)
+	    do j = 1, nx {
+		if (zfit[j] < lcut || zfit[j] > hcut)
+		    call gsrej (gs, x[j], y[j], data[index+j-1], w[j], 
+		        WTS_USER)
+	    }
+	    index = index + nx
+	}
+
+	call gssolve (gs, ier)
+	if (ier == NO_DEG_FREEDOM)
+	    return (ERR)
+	else
+	    return (OK)
+end
+
diff --git a/pkg/images/lib/rgccwcs.x b/pkg/images/lib/rgccwcs.x
new file mode 100644
index 00000000..519c2cb3
--- /dev/null
+++ b/pkg/images/lib/rgccwcs.x
@@ -0,0 +1,221 @@
+include <imhdr.h>
+include <math.h>
+include <mwset.h>
+include <pkg/skywcs.h>
+
+
+# RG_CELTOSTD - Convert the longitude / latitude coordinates to standard
+# coordinates given the position of the reference point and the form of
+# the projection.
+
+procedure rg_celtostd (projection, lngref, latref, xi, eta, npts, reflng,
+        reflat, lngunits, latunits)
+
+char    projection[ARB]         #I the projection type
+double  lngref[ARB]             #I the input ra / longitude coordinates
+double  latref[ARB]             #I the input dec / latitude coordinates
+double  xi[ARB]                 #O the output ra / longitude std coordinates
+double  eta[ARB]                #O the output dec / latitude std coordinates
+int     npts                    #I the number of data points
+double  reflng                  #I the ra / longitude reference point
+double  reflat                  #I the dec / latitude reference point
+int     lngunits                #I the ra / longitude units
+int     latunits                #I the dec / latitude units
+
+
+double  tlngref, tlatref
+int     i
+pointer mw, ct
+pointer rg_projwcs(),  mw_sctran()
+errchk  mw_sctran()
+
+begin
+        # Initialize the projection transformation.
+        mw = rg_projwcs (projection, reflng, reflat, lngunits, latunits)
+
+        # Compile the transformation.
+        ct = mw_sctran (mw, "world", "logical", 03B)
+
+        # Evaluate the standard coordinates.
+        do i = 1, npts {
+
+            switch (lngunits) {
+            case SKY_DEGREES:
+                tlngref = lngref[i]
+            case SKY_RADIANS:
+                tlngref = RADTODEG(lngref[i])
+            case SKY_HOURS:
+                tlngref = 15.0d0 * lngref[i]
+            default:
+                tlngref = lngref[i]
+            }
+
+            switch (latunits) {
+            case SKY_DEGREES:
+                tlatref = latref[i]
+            case SKY_RADIANS:
+                tlatref = RADTODEG(latref[i])
+            case SKY_HOURS:
+                tlatref = 15.0d0 * latref[i]
+            default:
+                tlatref = latref[i]
+            }
+
+            call mw_c2trand (ct, tlngref, tlatref, xi[i], eta[i])
+        }
+
+        call mw_close (mw)
+
+end
+
+
+# RG_STDTOCEL - Convert the longitude / latitude coordinates to standard
+# coordinates given the position of the reference point and the form of
+# the projection.
+
+procedure rg_stdtocel (projection, xi, eta, lngfit, latfit, npts, reflng,
+        reflat, lngunits, latunits)
+
+char    projection[ARB]         #I the sky projection geometry
+double  xi[ARB]                 #I the output ra / longitude std coordinates
+double  eta[ARB]                #I the output dec / latitude std coordinates
+double  lngfit[ARB]             #O the input ra / longitude coordinates
+double  latfit[ARB]             #O the input dec / latitude coordinates
+int     npts                    #I the number of data points
+double  reflng                  #I the ra / longitude reference point
+double  reflat                  #I the dec / latitude reference point
+int     lngunits                #I the ra / longitude units
+int     latunits                #I the dec / latitude units
+
+double  tlngref, tlatref
+int     i
+pointer mw, ct
+pointer rg_projwcs(), mw_sctran()
+errchk  mw_sctran()
+
+begin
+        # Initialize the projection transformation.
+        mw = rg_projwcs (projection, reflng, reflat, lngunits, latunits)
+
+        # Compile the transformation.
+        ct = mw_sctran (mw, "logical", "world", 03B)
+
+        # Evaluate the standard coordinates.
+        do i = 1, npts {
+
+            call mw_c2trand (ct, xi[i], eta[i], tlngref, tlatref)
+
+            switch (lngunits) {
+            case SKY_DEGREES:
+                lngfit[i] = tlngref
+            case SKY_RADIANS:
+                lngfit[i] = DEGTORAD(tlngref)
+            case SKY_HOURS:
+                lngfit[i] = tlngref / 15.0d0
+            default:
+                lngfit[i] = tlngref
+            }
+
+            switch (latunits) {
+            case SKY_DEGREES:
+                latfit[i] = tlatref
+            case SKY_RADIANS:
+                latfit[i] = DEGTORAD(tlatref)
+            case SKY_HOURS:
+                latfit[i] = tlatref / 15.0d0
+            default:
+                latfit[i] = tlatref
+            }
+
+        }
+
+        call mw_close (mw)
+end
+
+
+# RG_PROJWCS -- Set up a projection wcs given the projection type, the
+# coordinates of the reference point, and the reference point units.
+
+pointer procedure rg_projwcs (projection, reflng, reflat, lngunits, latunits)
+
+char    projection[ARB]         #I the projection type
+double  reflng                  #I the ra / longitude reference point
+double  reflat                  #I the dec / latitude reference point
+int     lngunits                #I the ra / longitude units
+int     latunits                #I the dec / latitude units
+
+int     ndim
+pointer sp, projstr, projpars, wpars, ltm, ltv, cd, r, w, mw, axes
+pointer mw_open()
+
+begin
+        ndim = 2
+
+        # Allocate working space.
+        call smark (sp)
+        call salloc (projstr, SZ_FNAME, TY_CHAR)
+        call salloc (projpars, SZ_LINE, TY_CHAR)
+        call salloc (wpars, SZ_LINE, TY_CHAR)
+        call salloc (ltm, ndim * ndim, TY_DOUBLE)
+        call salloc (ltv, ndim, TY_DOUBLE)
+        call salloc (cd, ndim * ndim, TY_DOUBLE)
+        call salloc (r, ndim, TY_DOUBLE)
+        call salloc (w, ndim, TY_DOUBLE)
+        call salloc (axes, IM_MAXDIM, TY_INT)
+
+        # Open the wcs.
+        mw = mw_open (NULL, ndim)
+
+        # Set the axes and projection type.
+        Memi[axes] = 1
+        Memi[axes+1] = 2
+        if (projection[1] == EOS)
+            call mw_swtype (mw, Memi[axes], ndim, "linear", "")
+        else {
+            call sscan (projection)
+                call gargwrd (Memc[projstr], SZ_FNAME)
+                call gargstr (Memc[projpars], SZ_LINE)
+            call sprintf (Memc[wpars], SZ_LINE,
+                "axis 1: axtype = ra %s axis 2: axtype = dec %s")
+                call pargstr (Memc[projpars])
+                call pargstr (Memc[projpars])
+            call mw_swtype (mw, Memi[axes], ndim, Memc[projstr], Memc[wpars])
+        }
+
+
+        # Set the lterm.
+        call mw_mkidmd (Memd[ltm], ndim)
+        call aclrd (Memd[ltv], ndim)
+        call mw_sltermd (mw, Memd[ltm], Memd[ltv], ndim)
+
+        # Set the wterm.
+        call mw_mkidmd (Memd[cd], ndim)
+        call aclrd (Memd[r], ndim)
+        switch (lngunits) {
+        case SKY_DEGREES:
+            Memd[w] = reflng
+        case SKY_RADIANS:
+            Memd[w] = RADTODEG(reflng)
+        case SKY_HOURS:
+            Memd[w] = 15.0d0 * reflng
+        default:
+            Memd[w] = reflng
+        }
+        switch (latunits) {
+        case SKY_DEGREES:
+            Memd[w+1] = reflat
+        case SKY_RADIANS:
+            Memd[w+1] = RADTODEG(reflat)
+        case SKY_HOURS:
+            Memd[w+1] = 15.0d0 * reflat
+        default:
+            Memd[w+1] = reflat
+        }
+        call mw_swtermd (mw, Memd[r], Memd[w], Memd[cd], ndim)
+
+
+        call sfree (sp)
+
+        return (mw)
+end
+
diff --git a/pkg/images/lib/rgcontour.x b/pkg/images/lib/rgcontour.x
new file mode 100644
index 00000000..62ed1934
--- /dev/null
+++ b/pkg/images/lib/rgcontour.x
@@ -0,0 +1,475 @@
+include	<error.h>
+include	<mach.h>
+include	<gset.h>
+include	<config.h>
+include	<xwhen.h>
+include	<fset.h>
+
+
+define	DUMMY		6
+define	XCEN		0.5
+define	YCEN		0.52
+define	EDGE1		0.1
+define	EDGE2		0.93
+define	SZ_LABEL	10
+define	SZ_FMT		20
+
+
+# RG_CONTOUR -- Produce a contour plot of a subrasteer.
+
+procedure rg_contour (gp, htitle, btitle, data, ncols, nlines)
+
+pointer	gp			#I pointer to graphics stream
+char	htitle[ARB]		#I the plot header title
+char	btitle[ARB]		#I the plot trailer title
+real	data[ncols,ARB]		#I input data
+int	ncols, nlines		#I dimensions of data
+
+bool	perimeter
+int	tcojmp[LEN_JUMPBUF]
+int	epa, status, wkid
+int	nset, ncontours, dashpat, nhi, old_onint
+int	isizel, isizem, isizep, nrep, ncrt, ilab, nulbll, ioffd
+int	ioffm, isolid, nla, nlm, first
+pointer	sp, label, temp
+real	interval, floor, ceiling, dmin, dmax, zero, finc, ybot
+real	vx1, vx2, vy1, vy2, wx1, wx2, wy1, wy2
+real	first_col, last_col, first_row, last_row
+real	xlt, ybt, side, ext, hold[5]
+
+extern	rg_onint()
+
+common	/tcocom/ tcojmp
+common  /conflg/ first
+common  /noaolb/ hold
+common  /conre4/ isizel, isizem , isizep, nrep, ncrt, ilab, nulbll, ioffd,
+	ext, ioffm, isolid, nla, nlm, xlt, ybt, side
+
+begin
+	# Return if the pointer is NULL.
+	if (gp == NULL)
+	    return
+	call greactivate (gp, 0)
+
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (label, SZ_LINE, TY_CHAR)
+	call salloc (temp, ncols * nlines, TY_REAL)
+
+	# First of all, intialize conrec's block data before altering any
+	# parameters in common.
+	first = 1
+	call conbd
+
+	# Set the local variables.
+	zero	= 0.0
+	floor	= INDEFR
+	ceiling	= INDEFR
+	nhi	= -1
+	dashpat	= 528
+
+	# Suppress the contour labelling by setting the common
+	# parameter "ilab" to zero.
+	ilab = 0
+
+	# User can specify either the number of contours or the contour
+	# interval, or let conrec pick a nice number.  Set ncontours to 0
+	# and encode the FINC param expected by conrec.
+
+	ncontours = 0
+	if (ncontours <= 0) {
+	    interval = 0.0
+	    if (interval <= 0.0)
+		finc = 0
+	    else
+		finc = interval
+	} else
+	    finc = - abs (ncontours)
+
+	# Define the data limits.
+
+	first_col = 1.0
+	last_col = real (ncols)
+	first_row = 1.0
+	last_row = real (nlines)
+
+	# The floor and ceiling are in absolute units, but the zero shift is
+	# applied first, so correct the numbers for the zero shift.  Zero is
+	# a special number for the floor and ceiling, so do not change value
+	# if set to zero.
+
+	call alimr (data, ncols * nlines, dmin, dmax) 
+	if (IS_INDEFR(floor))
+	    floor = dmin
+	floor = floor - zero
+	if (IS_INDEFR (ceiling))
+	    ceiling = dmax
+	ceiling = ceiling - zero
+
+	# Make a copy of the image and contour this.
+	call amovr (data,  Memr[temp], nlines * ncols)
+
+	# Apply the zero point shift.
+	if (abs (zero) > EPSILON)
+	    call asubkr (Memr[temp], zero, Memr[temp], ncols * nlines)
+
+	# Open device and make contour plot.
+	call gopks (STDERR)
+	wkid = 1
+	call gclear (gp)
+	call gopwk (wkid, DUMMY, gp)
+	call gacwk (wkid)
+
+	# Always draw the perimeter.
+	perimeter = true
+
+	# The viewport can be set by the user.  If not, the viewport is
+	# assumed to be centered on the device.  In either case, the
+	# viewport to window mapping is established in rg_map_viewport
+	# and conrec's automatic mapping scheme is avoided by setting nset=1.
+	vx1 = 0.0
+	vx2 = 0.0
+	vy1 = 0.0
+	vy2 = 0.0
+	call rg_map_viewport (gp, ncols, nlines, vx1, vx2, vy1, vy2, false,
+	    perimeter)
+	nset = 1
+
+	# Supress conrec's plot label generation.
+	ioffm = 1
+
+	# Install interrupt exception handler.
+	call zlocpr (rg_onint, epa)
+	call xwhen (X_INT, epa, old_onint)
+
+	# Make the contour plot.  If an interrupt occurs ZSVJMP is reeentered
+	# with an error status.
+	call zsvjmp (tcojmp, status)
+	if (status == OK) {
+	    call conrec (Memr[temp], ncols, ncols, nlines, floor, ceiling,
+	        finc, nset, nhi, -dashpat)
+	} else {
+	    call gcancel (gp)
+	    call fseti (STDOUT, F_CANCEL, OK)
+	}
+
+	# Now find window and output text string title.  The window is
+	# set to the full image coordinates for labelling.
+	if (perimeter) {
+
+	    call gswind (gp, first_col, last_col, first_row, last_row)
+	    call rg_perimeter (gp)
+
+	    call ggview (gp, wx1, wx2, wy1, wy2)
+	    call gseti (gp, G_WCS, 0)
+	    ybot = min (wy2 + .06, 0.99)
+	    call gtext (gp, (wx1 + wx2) / 2.0, ybot, htitle,
+	        "h=c;v=t;f=b;s=.7")
+
+	    # Add system id banner to plot
+	    call gseti (gp, G_CLIP, NO)
+	    ybot = max (wy1 - 0.08, 0.01)
+	    call gtext (gp, (wx1 + wx2) / 2.0, ybot, btitle, "h=c;v=b;s=.5")
+	
+	    call sprintf (Memc[label], SZ_LINE, 
+	        "contoured from %g to %g, interval = %g")
+	        call pargr (hold(1))
+	        call pargr (hold(2))
+	        call pargr (hold(3))
+	    ybot = max (wy1 - 0.06, .03)
+	    call gtext (gp, (wx1 + wx2) / 2.0, ybot, Memc[label],
+	        "h=c;v=b;s=.6")
+	}
+
+	call gswind (gp, first_col, last_col, first_row, last_row)
+	call gamove (gp, last_col, last_row)
+	call gflush (gp)
+
+	call gdawk (wkid)
+	call gclks ()
+
+	call sfree (sp)
+end
+
+
+# RG_ONINT -- Interrupt handler for the task contour.  Branches back to ZSVJMP
+# in the main routine to permit shutdown without an error message.
+
+procedure rg_onint (vex, next_handler)
+
+int	vex		#I virtual exception
+int	next_handler	#U not used
+
+int	tcojmp[LEN_JUMPBUF]
+common	/tcocom/ tcojmp
+
+begin
+	call xer_reset()
+	call zdojmp (tcojmp, vex)
+end
+
+
+# RG_PERIMETER -- draw and annotate the axes drawn around the perimeter
+# of the image pixels.  The viewport and window have been set by 
+# the calling procedure.  Plotting is done in window coordinates.
+# This procedure is called by both crtpict and the ncar plotting routines
+# contour and hafton.
+
+procedure rg_perimeter (gp)
+
+pointer	gp			#I graphics descriptor
+
+real	xs, xe, ys, ye
+int	i, first_col, last_col, first_tick, last_tick, bias
+int	nchar, dummy, first_row, last_row, cnt_step, cnt_label
+pointer	sp, label, fmt1, fmt2, fmt3, fmt4
+real	dist, kk, col, row, dx, dy, sz_char, cw, xsz, label_pos
+real	xdist, ydist, xspace, yspace, k[3]
+data 	k/1.0,2.0,3.0/
+
+bool	ggetb()
+int	itoc()
+real 	ggetr()
+errchk	ggwind, gseti, gctran, gline, gtext, itoc
+
+begin
+	call smark (sp)
+	call salloc (label, SZ_LABEL, TY_CHAR)
+	call salloc (fmt1, SZ_FMT, TY_CHAR)
+	call salloc (fmt2, SZ_FMT, TY_CHAR)
+	call salloc (fmt3, SZ_FMT, TY_CHAR)
+	call salloc (fmt4, SZ_FMT, TY_CHAR)
+
+	# First, get window coordinates and turn off clipping
+	call ggwind (gp, xs, xe, ys, ye)
+	call gseti (gp, G_CLIP, NO)
+
+	# A readable character width seems to be about 1.mm.  A readable
+	# perimeter seperation seems to be about .80mm.  If the physical
+	# size of the output device is contained in the graphcap file, the
+	# NDC sizes of these measurements can be determined.  If not, 
+	# the separation between perimeter axes equals one quarter character
+	# width or one quarter percent of frame, which ever is larger, and 
+	# the character size is set to 0.40.
+
+	cw = max (ggetr (gp, "cw"), 0.01)
+	if (ggetb (gp, "xs")) {
+	    xsz = ggetr (gp, "xs")
+	    dist = .80 / (xsz * 1000.)
+	    sz_char = dist / cw
+	} else {
+	    # Get character width and calculate perimeter separation.
+	    dist = cw * 0.25
+	    sz_char = 0.40
+	}
+
+	# Convert distance to user coordinates
+	call ggscale (gp, xs, ys, dx, dy)
+	xdist = dist * dx
+	ydist = dist * dy
+
+	# Generate four possible format strings for gtext
+	call sprintf (Memc[fmt1], SZ_LINE, "h=c;v=t;s=%.2f")
+	    call pargr (sz_char)
+	call sprintf (Memc[fmt2], SZ_LINE, "h=c;v=b;s=%.2f")
+	    call pargr (sz_char)
+	call sprintf (Memc[fmt3], SZ_LINE, "h=r;v=c;s=%.2f")
+	    call pargr (sz_char)
+	call sprintf (Memc[fmt4], SZ_LINE, "h=l;v=c;s=%.2f")
+	    call pargr (sz_char)
+
+	# Draw inner and outer perimeter
+	kk = k[1]
+	do i = 1, 2 {
+	    xspace = kk * xdist
+	    yspace = kk * ydist
+	    call gline (gp, xs - xspace, ys - yspace, xe + xspace, ys - yspace)
+	    call gline (gp, xe + xspace, ys - yspace, xe + xspace, ye + yspace)
+	    call gline (gp, xe + xspace, ye + yspace, xs - xspace, ye + yspace)
+	    call gline (gp, xs - xspace, ye + yspace, xs - xspace, ys - yspace)
+	    kk = k[2]
+	}
+
+	# Now draw x axis tick marks, along both the bottom and top of
+	# the picture.  First find the endpoint integer pixels.
+
+	first_col = int (xs)
+	last_col = int (xe)
+
+	# Determine increments of ticks and tick labels for x axis
+	cnt_step  = 1
+	cnt_label = 10
+	if (last_col - first_col > 256) {
+	    cnt_step = 10
+	    cnt_label = 100
+	} else if (last_col - first_col < 26) {
+	    cnt_step = 1
+	    cnt_label = 1
+	}
+
+	first_tick = first_col
+	bias = mod (first_tick, cnt_step)
+	last_tick = last_col + bias
+
+	do i = first_tick, last_tick, cnt_step {
+	    col = real (i - bias)
+	    call gline (gp, col, ys - k[1] * ydist, col, ys - k[2] * ydist)
+	    call gline (gp, col, ye + k[1] * ydist, col, ye + k[2] * ydist)
+
+	    if (mod ((i - bias), cnt_label)  == 0) {
+		# Label tick mark; calculate number of characters needed
+		nchar = 3
+		if (int (col) == 0)
+		    nchar = 1
+		if (int (col) >= 1000)
+		    nchar = 4
+
+		dummy = itoc (int(col), Memc[label], nchar)
+
+		# Position label slightly below outer perimeter.  Seperation
+		# is twenty percent of a character width, in WCS.
+		label_pos = ys - (k[2] * ydist + (cw * 0.20 * dy))
+		call gtext (gp, col, label_pos, Memc[label], Memc[fmt1])
+
+		# Position label slightly above outer perimeter
+		label_pos = ye + (k[2] * ydist + (cw * 0.20 * dy))
+		call gtext (gp, col, label_pos, Memc[label], Memc[fmt2])
+	    }
+	}
+
+	# Label the y axis tick marks along the left and right sides of the
+	# picture.  First find the integer pixel endpoints.
+	
+	first_row = int (ys)
+	last_row = int (ye)
+
+	# Determine increments of ticks and tick labels for y axis
+	cnt_step  = 1
+	cnt_label = 10
+	if (last_row - first_row > 256) {
+	    cnt_step = 10
+	    cnt_label = 100
+	} else if (last_row - first_row < 26) {
+	    cnt_step = 1
+	    cnt_label = 1
+	}
+
+	first_tick = first_row 
+	bias = mod (first_tick, cnt_step)
+	last_tick = last_row + bias
+
+	do i = first_tick, last_tick, cnt_step {
+	    row = real (i - bias)
+	    call gline (gp, xs - k[1] * xdist, row, xs - k[2] * xdist, row)
+	    call gline (gp, xe + k[1] * xdist, row, xe + k[2] * xdist, row)
+
+	    if (mod ((i - bias), cnt_label) == 0) {
+		# Label tick mark; calculate number of characters needed
+		nchar = 3
+		if (int (row) == 0)
+		    nchar = 1
+		else if (int (row) >= 1000)
+		    nchar = 4
+		
+	        dummy = itoc (int(row), Memc[label], nchar)
+
+		# Position label slightly to the left of outer perimeter.
+		# Separation twenty percent of a character width, in WCS.
+		label_pos = xs - (k[2] * xdist + (cw * 0.20 * dx))
+	        call gtext (gp, label_pos, row, Memc[label], Memc[fmt3])
+
+		# Position label slightly to the right of outer perimeter
+		label_pos = xe + (k[2] * xdist + (cw * 0.20 * dx))
+	        call gtext (gp, label_pos, row, Memc[label], Memc[fmt4])
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# RG_MAP_VIEWPORT -- set device viewport for contour and hafton plots.  If not
+# specified by user, a default viewport centered on the device is used.
+
+procedure rg_map_viewport (gp, ncols, nlines, ux1, ux2, uy1, uy2, fill,
+	perimeter)
+
+pointer	gp			#I graphics stream descriptor
+int	ncols			#I number of image cols
+int	nlines			#I number of image lines
+real	ux1, ux2, uy1, uy2	#I/O NDC coordinates of requested viewort
+bool	fill			#I fill viewport
+bool	perimeter		#I draw the perimeter
+
+real	ncolsr, nlinesr, ratio, aspect_ratio, xcen, ycen
+real	x1, x2, y1, y2, ext, xdis, ydis
+bool	fp_equalr()
+real	ggetr()
+data    ext /0.0625/
+
+begin
+	ncolsr = real (ncols)
+	nlinesr = real (nlines)
+
+	if (fp_equalr (ux1, 0.0) && fp_equalr (ux2, 0.0) && 
+	    fp_equalr (uy1, 0.0) && fp_equalr (uy2, 0.0)) {
+
+	    if (fill && ! perimeter) {
+		x1 = 0.0
+		x2 = 1.0
+		y1 = 0.0
+		y2 = 1.0
+		xcen = 0.5
+		ycen = 0.5
+	    } else {
+	        x1 = EDGE1
+	        x2 = EDGE2
+	        y1 = EDGE1
+	        y2 = EDGE2
+		xcen = XCEN
+		ycen = YCEN
+	    }
+
+	    # Calculate optimum viewport, as in NCAR's conrec, hafton
+	    if (! fill) {
+	        ratio = min (ncolsr, nlinesr) / max (ncolsr, nlinesr)
+	        if (ratio >= ext) {
+		    if (ncols > nlines) 
+		        y2 = (y2 - y1) * nlinesr / ncolsr + y1
+		    else 
+		        x2 = (x2 - x1) * ncolsr / nlinesr + x1
+	        }
+	    }
+
+	    xdis = x2 - x1
+	    ydis = y2 - y1
+
+	    # So far, the viewport has been calculated so that equal numbers of
+	    # image pixels map to equal distances in NDC space, regardless of 
+	    # the aspect ratio of the device.  If the parameter "fill" has been
+	    # set to no, the user wants to compensate for a non-unity aspect 
+	    # ratio and make equal numbers of image pixels map to into the same 
+	    # physical distance on the device, not the same NDC distance.
+
+	    if (! fill) {
+	        aspect_ratio = ggetr (gp, "ar")
+	        if (fp_equalr (aspect_ratio, 0.0))
+	            aspect_ratio = 1.0
+		if (aspect_ratio < 1.0)
+	            xdis = xdis * aspect_ratio
+		else if (aspect_ratio > 1.0)
+	            ydis = ydis / aspect_ratio
+	    }
+
+	    ux1 = xcen - (xdis / 2.0)
+	    ux2 = xcen + (xdis / 2.0)
+	    uy1 = ycen - (ydis / 2.0)
+	    uy2 = ycen + (ydis / 2.0)
+	}
+
+	# Set window and viewport for WCS 1
+	call gseti  (gp, G_WCS, 1)
+	call gsview (gp, ux1, ux2, uy1, uy2)
+	call gswind (gp, 1.0, ncolsr, 1.0, nlinesr)
+	call set (ux1, ux2, uy1, uy2, 1.0, ncolsr, 1.0, nlinesr, 1)
+end
diff --git a/pkg/images/lib/rgfft.x b/pkg/images/lib/rgfft.x
new file mode 100644
index 00000000..b986a9d7
--- /dev/null
+++ b/pkg/images/lib/rgfft.x
@@ -0,0 +1,269 @@
+
+# RG_SZFFT -- Compute the size of the required FFT given the dimension of the
+# image the window size and the fact that the FFT must be a power of 2.
+
+int procedure rg_szfft (npts, window)
+
+int	npts			#I the number of points in the data
+int	window			#I the width of the valid cross correlation
+
+int	nfft, pow2
+
+begin
+	nfft = npts + window / 2
+
+	pow2 = 2
+	while (pow2 < nfft)
+	    pow2 = pow2 * 2
+
+	return (pow2)
+end
+
+
+# RG_RLOAD -- Procedure to load a real array into the real part of a complex
+# array.
+
+procedure rg_rload (buf, ncols, nlines, fft, nxfft, nyfft)
+
+real    buf[ARB]        	#I the input data buffer
+int     ncols, nlines   	#I the size of the input buffer
+real    fft[ARB]        	#O the out array to be fft'd
+int     nxfft, nyfft    	#I the dimensions of the fft
+
+int     i, dindex, findex
+
+begin
+        # Load the reference and image data.
+        dindex = 1
+        findex = 1
+        do i = 1, nlines {
+            call rg_rweave (buf[dindex], fft[findex], ncols)
+            dindex = dindex + ncols
+            findex = findex + 2 * nxfft
+        }
+end
+
+
+# RG_ILOAD -- Procedure to load a real array into the complex part of a complex
+# array.
+
+procedure rg_iload (buf, ncols, nlines, fft, nxfft, nyfft)
+
+real    buf[ARB]        	#I the input data buffer
+int     ncols, nlines   	#I the size of the input buffer
+real    fft[ARB]        	#O the output array to be fft'd
+int     nxfft, nyfft    	#I the dimensions of the fft
+
+int     i, dindex, findex
+
+begin
+        # Load the reference and image data.
+        dindex = 1
+        findex = 1
+        do i = 1, nlines {
+            call rg_iweave (buf[dindex], fft[findex], ncols)
+            dindex = dindex + ncols
+            findex = findex + 2 * nxfft
+        }
+end
+
+
+# RG_RWEAVE -- Weave a real array into the real part of a complex array.
+# The output array must be twice as long as the input array.
+
+procedure rg_rweave (a, b, npts)
+
+real    a[ARB]          	#I input array
+real    b[ARB]          	#O output array
+int     npts            	#I the number of data points
+
+int     i
+
+begin
+        do i = 1, npts
+            b[2*i-1] = a[i]
+end
+
+
+# RG_IWEAVE -- Weave a real array into the complex part of a complex array.
+# The output array must be twice as long as the input array.
+
+procedure rg_iweave (a, b, npts)
+
+real    a[ARB]          	#I the input array
+real    b[ARB]          	#O the output array
+int     npts            	#I the number of data points
+
+int     i
+
+begin
+        do i = 1, npts
+            b[2*i] = a[i]
+end
+
+
+# RG_FOURN -- Replaces datas by its n-dimensional discreter Fourier transform,
+# if isign is input as 1. NN is an integer array of length ndim containing
+# the lengths of each dimension (number of complex values), which must all
+# be powers of 2. Data is a real array of length twice the product of these
+# lengths, in which the data are stored as in a multidimensional complex
+# Fortran array. If isign is input as -1, data is replaced by its inverse
+# transform times the product of the lengths of all dimensions.
+
+procedure rg_fourn (data, nn, ndim, isign)
+
+real    data[ARB]               #I/O input data and output fft
+int     nn[ndim]                #I array of dimension lengths
+int     ndim                    #I number of dimensions
+int     isign                   #I forward or inverse transform
+
+int     idim, i1, i2, i3, ip1, ip2, ip3, ifp1, ifp2, i2rev, i3rev, k1, k2
+int     ntot, nprev, n, nrem, pibit
+double  wr, wi, wpr, wpi, wtemp, theta
+real    tempr, tempi
+
+begin
+        ntot = 1
+        do idim = 1, ndim
+            ntot = ntot * nn[idim]
+
+        nprev = 1
+        do idim = 1, ndim {
+
+            n = nn[idim]
+            nrem = ntot / (n * nprev)
+            ip1 = 2 * nprev
+            ip2 = ip1 * n
+            ip3 = ip2 * nrem
+            i2rev = 1
+
+	    do i2 = 1, ip2, ip1 {
+
+                if (i2 < i2rev) {
+                    do i1 = i2, i2 + ip1 - 2, 2 {
+                        do i3 = i1, ip3, ip2 {
+                            i3rev = i2rev + i3 - i2
+                            tempr = data [i3]
+                            tempi = data[i3+1]
+                            data[i3] = data[i3rev]
+                            data[i3+1] = data[i3rev+1]
+                            data[i3rev] = tempr
+                            data[i3rev+1] = tempi
+                        }
+                    }
+                }
+
+                pibit = ip2 / 2
+                while ((pibit >= ip1) && (i2rev > pibit)) {
+                    i2rev = i2rev - pibit
+                    pibit = pibit / 2
+                }
+
+                i2rev = i2rev + pibit
+            }
+
+    	    ifp1 = ip1
+            while (ifp1 < ip2) {
+
+                ifp2 = 2 * ifp1
+                theta = isign * 6.28318530717959d0 / (ifp2 / ip1)
+                wpr = - 2.0d0 * dsin (0.5d0 * theta) ** 2
+                wpi = dsin (theta)
+                wr = 1.0d0
+                wi = 0.0d0
+
+                do i3 = 1, ifp1, ip1 {
+                    do i1 = i3, i3 + ip1 - 2, 2 {
+                        do i2 = i1, ip3, ifp2 {
+                            k1 = i2
+                            k2 = k1 + ifp1
+                            tempr = sngl (wr) * data[k2] - sngl (wi) *
+                                data[k2+1]
+                            tempi = sngl (wr) * data[k2+1] + sngl (wi) *
+                                data[k2]
+                            data[k2] = data[k1] - tempr
+                            data[k2+1] = data[k1+1] - tempi
+                            data[k1] = data[k1] + tempr
+                            data[k1+1] = data[k1+1] + tempi
+                        }
+                    }
+                    wtemp = wr
+                    wr = wr * wpr - wi * wpi + wr
+                    wi = wi * wpr + wtemp * wpi + wi
+                }
+
+                ifp1 = ifp2
+            }
+            nprev = n * nprev
+        }
+end
+
+
+# RG_FSHIFT -- Center the array after doing the FFT.
+
+procedure rg_fshift (fft1, fft2, nx, ny)
+
+real    fft1[nx,ARB]            #I input fft array
+real    fft2[nx,ARB]            #O output fft array
+int     nx, ny                  #I fft array dimensions
+
+int     i, j
+real    fac
+
+begin
+        fac = 1.0
+        do j = 1, ny {
+            do i = 1, nx, 2 {
+                fft2[i,j] = fac * fft1[i,j]
+                fft2[i+1,j] = fac * fft1[i+1,j]
+                fac = -fac
+            }
+            fac = -fac
+        }
+end
+
+
+# RG_MOVEXR -- Extract the portion of the FFT for which the computed lags
+# are valid. The dimensions of the the FFT are a  power of two
+# and the 0 frequency is in the position nxfft / 2 + 1, nyfft / 2 + 1.
+
+procedure rg_movexr (fft, nxfft, nyfft, xcor, xwindow, ywindow)
+
+real    fft[ARB]                #I the input fft
+int     nxfft, nyfft            #I the dimensions of the input fft
+real    xcor[ARB]   	        #O the output cross-correlation function
+int     xwindow, ywindow        #I the cross-correlation function window
+
+int     j, ix, iy, findex, xindex
+
+begin
+        # Compute the starting index of the extraction array.
+        ix = 1 + nxfft  - 2 * (xwindow / 2)
+        iy = 1 + nyfft / 2 - ywindow / 2
+
+        # Copy the real part of the Fourier transform into the
+        # cross-correlation array.
+        findex = ix + 2 * nxfft * (iy - 1)
+	xindex = 1
+        do j = 1, ywindow {
+            call rg_extract (fft[findex], xcor[xindex], xwindow)
+            findex = findex + 2 * nxfft
+	    xindex = xindex + xwindow
+        }
+end
+
+
+# RG_EXTRACT -- Extract the real part of a complex array.
+
+procedure rg_extract (a, b, npts)
+
+real    a[ARB]          #I the input array
+real    b[ARB]          #O the output array
+int     npts            #I the number of data points
+
+int     i
+
+begin
+        do i = 1, npts
+            b[i] = a[2*i-1]
+end
diff --git a/pkg/images/lib/rglltran.x b/pkg/images/lib/rglltran.x
new file mode 100644
index 00000000..890cec0b
--- /dev/null
+++ b/pkg/images/lib/rglltran.x
@@ -0,0 +1,42 @@
+include <math.h>
+include <pkg/skywcs.h>
+
+# RG_LLTRANSFORM -- Transform the reference image world coordinates to the
+# input image world coordinate system.
+
+procedure rg_lltransform (cooref, cooin, rxlng, rylat, ixlng, iylat, npts)
+
+pointer	cooref		#I pointer to the reference image coordinate structure
+pointer	cooin		#I pointer to the input image coordinate structure
+double	rxlng[ARB]	#I the x refererence image world coordinates (degrees)
+double	rylat[ARB]	#I the y refererence image world coordinates (degrees)
+double	ixlng[ARB]	#O the x refererence image world coordinates (degrees)
+double	iylat[ARB]	#O the y refererence image world coordinates (degrees)
+int	npts		#I the number of coordinates
+
+int	i
+double	ilng, ilat, olng, olat
+int	sk_stati()
+
+begin
+	if (sk_stati (cooref, S_PLNGAX) < sk_stati (cooref, S_PLATAX)) {
+	    do i = 1, npts {
+	        ilng = DEGTORAD (rxlng[i])
+	        ilat = DEGTORAD (rylat[i])
+	        call sk_lltran (cooref, cooin, ilng, ilat, INDEFD,
+		    INDEFD, 0.0d0, 0.0d0, olng, olat)
+	        ixlng[i] = RADTODEG (olng)
+	        iylat[i] = RADTODEG (olat)
+	    }
+	} else {
+	    do i = 1, npts {
+	        ilng = DEGTORAD (rylat[i])
+	        ilat = DEGTORAD (rxlng[i])
+	        call sk_lltran (cooref, cooin, ilng, ilat, INDEFD,
+		    INDEFD, 0.0d0, 0.0d0, olng, olat)
+	        ixlng[i] = RADTODEG (olat)
+	        iylat[i] = RADTODEG (olng)
+	    }
+	}
+end
+
diff --git a/pkg/images/lib/rgmerge.x b/pkg/images/lib/rgmerge.x
new file mode 100644
index 00000000..5e218bd0
--- /dev/null
+++ b/pkg/images/lib/rgmerge.x
@@ -0,0 +1,1023 @@
+include <mach.h>
+include <plset.h>
+include "xyxymatch.h"
+
+# RG_MATCH -- Compute the intersection of two lists using a pattern matching
+# algorithm. This algorithm is based on one developed by Edward Groth
+# 1986 A.J. 91, 1244. The algorithm matches pairs of coordinates from
+# two lists based on the triangles that can be formed from triplets of
+# points in each list. The algorithm is insensitive to coordinate translation,
+# rotation, magnification, or inversion and can tolerate distortions and
+# random errors.
+
+int procedure rg_match (xref, yref, nref, xin, yin, nin, reftri, reftrirat,
+	nreftri, nrmaxtri, nrefstars, intri, intrirat, nintri, ninmaxtri,
+	nliststars, tolerance, ptolerance, ratio, nreject)
+
+real	xref[ARB]		#I the reference x coordinates
+real	yref[ARB]		#I the reference y coordinates
+int	nref			#I the number of reference coordinates
+real	xin[ARB]		#I the input x coordinates
+real	yin[ARB]		#I the input y coordinates
+int	nin			#I the number of input coordinates
+int	reftri[nrmaxtri,ARB]	#U list of reference triangles
+real	reftrirat[nrmaxtri,ARB]	#U list of reference triangle parameters
+int	nreftri			#U number of reference triangles
+int	nrmaxtri		#I maximum number of reference triangles
+int	nrefstars		#I the number of reference stars
+int	intri[ninmaxtri,ARB]	#U list of input triangles
+real	intrirat[ninmaxtri,ARB]	#U list of input triangle parameters
+int	nintri			#U number of input triangles
+int	ninmaxtri		#I maximum number of input triangles
+int	nliststars		#I the number of input stars
+real	tolerance		#I the reference triangles matching tolerance
+real	ptolerance		#I the input triangles matching tolerance
+real	ratio			#I the maximum ratio of triangle sides
+int	nreject			#I maximum number of rejection iterations
+
+int	i, nmerge, nkeep, nmatch, ncheck
+pointer	sp, rindex, lindex
+int	rg_tmerge(), rg_treject(), rg_tvote(), rg_triangle
+
+begin
+	# Match the triangles in the input list to those in the reference list.
+	if (nreftri < nintri)
+	    nmerge = rg_tmerge (reftri, reftrirat, nreftri, nrmaxtri, intri,
+	        intrirat, nintri, ninmaxtri)
+	else
+	    nmerge = rg_tmerge (intri, intrirat, nintri, ninmaxtri, reftri,
+	        reftrirat, nreftri, nrmaxtri)
+	if (nmerge <= 0)
+	    return (0)
+
+	# Perform the rejection cycle.
+	nkeep = rg_treject (reftri, reftrirat, nreftri, nrmaxtri,
+	    intri, intrirat, nintri, ninmaxtri, nmerge, nreject)
+	if (nkeep <= 0)
+	    return (0)
+
+	# Match the coordinates.
+	nmatch = rg_tvote (reftri, nrmaxtri, nrefstars, intri, ninmaxtri,
+	    nliststars, nkeep)
+	if (nmatch <= 0)
+	    return (0)
+	else if (nmatch <= 3 && nkeep < nmerge)
+	    return (0)
+
+	# If all the coordinates were not matched then make another pass
+	# through the triangles matching algorithm. If the number of
+	# matches decreases as a result of this then all the matches were
+	# not true matches and declare the list unmatched.
+	if (nmatch < min (nref, nin) && nmatch > 2) {
+
+	    # Find the indices of the matched points.
+	    call smark (sp)
+	    call salloc (rindex, nmatch, TY_INT)
+	    call salloc (lindex, nmatch, TY_INT)
+	    do i = 1, nmatch {
+		Memi[rindex+i-1] = reftri[i,RG_MATCH]
+		Memi[lindex+i-1] = intri[i,RG_MATCH]
+	    }
+
+	    # Recompute the triangles.
+	    nreftri = rg_triangle (xref, yref, Memi[rindex], nmatch, reftri,
+		reftrirat, nrmaxtri, nrefstars, tolerance, ratio)
+	    nintri = rg_triangle (xin, yin, Memi[lindex], nmatch, intri,
+		intrirat, ninmaxtri, nliststars, ptolerance, ratio)
+
+	    # Rematch the triangles.
+	    if (nreftri < nintri)
+	        nmerge = rg_tmerge (reftri, reftrirat, nreftri, nrmaxtri, intri,
+	            intrirat, nintri, ninmaxtri)
+	    else
+	        nmerge = rg_tmerge (intri, intrirat, nintri, ninmaxtri, reftri,
+	            reftrirat, nreftri, nrmaxtri)
+
+	    # Reperform the rejection cycle.
+	    if (nmerge > 0)
+	        nkeep = rg_treject (reftri, reftrirat, nreftri, nrmaxtri,
+	            intri, intrirat, nintri, ninmaxtri, nmerge, nreject)
+
+	    # Reperform the vote.
+	    if (nkeep > 0) {
+	        ncheck = rg_tvote (reftri, nrmaxtri, nrefstars, intri,
+	            ninmaxtri, nliststars, nkeep)
+		if (ncheck <= 3 && nkeep < nmerge)
+		    ncheck = 0
+	    } else
+		ncheck = 0
+
+	    if (ncheck < nmatch)
+		nmatch = 0
+	    else
+		nmatch = ncheck
+
+	    call sfree (sp)
+	}
+
+	return (nmatch)
+end
+ 
+
+# RG_TRIANGLE -- Construct all the the possible triangles from
+# an input coordinate list. The triangles are constructed in such a way
+# that the shortest side of the triangle lies between vertices 1 and 2 and the
+# longest side between vertices 1 and 3. The parameters of each triangle
+# including the log of the perimeter, the ratio of the longest to shortest
+# side, the cosine of the angle at vertex 1, the tolerances in the ratio
+# and cosine and the sense of the triangle (clockwise or anti-clockwise)
+# are also computed. Triangles with a ratio greater than maxratio are
+# rejected as are triangles with vertices closer together than tolerance.
+
+int procedure rg_triangle (xref, yref, refindex, nrefstars, reftri, tripar,
+	nmaxtri, maxnpts, tolerance, maxratio)
+
+real	xref[ARB]		#I x reference coordinates
+real	yref[ARB]		#I y reference coordinates
+int	refindex[ARB]		#I the reference list sort index
+int	nrefstars		#I number of reference stars
+int	reftri[nmaxtri,ARB]	#O reference triangles
+real	tripar[nmaxtri,ARB]	#O triangle parameters
+int	nmaxtri			#I maximum number of triangles
+int	maxnpts			#I the maximum number of points
+real	tolerance		#I matching tolerance
+real	maxratio		#I maximum ratio of triangle sides
+
+int	i, j, k, nsample, npts, ntri
+real	rij, rjk, rki, dx1, dy1, dx2, dy2, dx3, dy3, r1, r2sq, r2, r3sq, r3
+real	ratio, cosc, cosc2, sinc2, tol2, tol
+
+begin
+	# Create the tolerance.
+	tol2 = tolerance ** 2
+	nsample = max (1, nrefstars / maxnpts) 
+	npts = min (nrefstars, nsample * maxnpts)
+
+	# Construct the triangles.
+	ntri = 1
+	do i = 1, npts - 2 * nsample, nsample {
+	    do j = i + nsample, npts - nsample, nsample {
+		do k = j + nsample, npts, nsample {
+
+		    # Compute the lengths of the three sides of the triangle,
+		    # eliminating triangles with sides that are less than
+		    # tolerance.
+		    rij = (xref[refindex[i]] - xref[refindex[j]]) ** 2 +
+		        (yref[refindex[i]] - yref[refindex[j]]) ** 2
+		    if (rij <= tol2)
+		        next
+		    rjk = (xref[refindex[j]] - xref[refindex[k]]) ** 2 +
+		        (yref[refindex[j]] - yref[refindex[k]]) ** 2
+		    if (rjk <= tol2)
+			next
+		    rki = (xref[refindex[k]] - xref[refindex[i]]) ** 2 +
+		        (yref[refindex[k]] - yref[refindex[i]]) ** 2
+		    if (rki <= tol2)
+			next
+
+		    # Order the vertices with the shortest side of the triangle
+		    # between vertices 1 and 2 and the intermediate side between
+		    # vertices 2 and 3.
+		    reftri[ntri,RG_INDEX] = ntri
+		    if (rij <= rjk) {
+	                if (rki <= rij) {
+			    reftri[ntri,RG_X1] = refindex[k]
+			    reftri[ntri,RG_X2] = refindex[i]
+			    reftri[ntri,RG_X3] = refindex[j]
+	    		} else if (rki >= rjk) {
+			    reftri[ntri,RG_X1] = refindex[i]
+			    reftri[ntri,RG_X2] = refindex[j]
+			    reftri[ntri,RG_X3] = refindex[k]
+	    		} else {
+			    reftri[ntri,RG_X1] = refindex[j]
+			    reftri[ntri,RG_X2] = refindex[i]
+			    reftri[ntri,RG_X3] = refindex[k]
+	    	        }
+		    } else {
+	    	        if (rki <= rjk) {
+			    reftri[ntri,RG_X1] = refindex[i]
+			    reftri[ntri,RG_X2] = refindex[k]
+			    reftri[ntri,RG_X3] = refindex[j]
+	    	        } else if (rki >= rij) {
+			    reftri[ntri,RG_X1] = refindex[k]
+			    reftri[ntri,RG_X2] = refindex[j]
+			    reftri[ntri,RG_X3] = refindex[i]
+	    	        } else {
+			    reftri[ntri,RG_X1] = refindex[j]
+			    reftri[ntri,RG_X2] = refindex[k]
+			    reftri[ntri,RG_X3] = refindex[i]
+	    	        }
+		    }
+
+		    # Compute the lengths of the sides.
+		    dx1 = xref[reftri[ntri,RG_X3]] - xref[reftri[ntri,RG_X2]]
+		    dy1 = yref[reftri[ntri,RG_X3]] - yref[reftri[ntri,RG_X2]]
+		    dx2 = xref[reftri[ntri,RG_X2]] - xref[reftri[ntri,RG_X1]]
+		    dy2 = yref[reftri[ntri,RG_X2]] - yref[reftri[ntri,RG_X1]]
+		    dx3 = xref[reftri[ntri,RG_X3]] - xref[reftri[ntri,RG_X1]]
+		    dy3 = yref[reftri[ntri,RG_X3]] - yref[reftri[ntri,RG_X1]]
+
+		    # Compute the ratio of the longest side of the triangle
+		    # to the shortest side.
+		    r1 = sqrt (dx1 ** 2 + dy1 ** 2)
+		    r2sq = dx2 ** 2 + dy2 ** 2
+		    r2 = sqrt (r2sq)
+		    r3sq = dx3 ** 2 + dy3 ** 2
+		    r3 = sqrt (r3sq)
+		    if (r2 <= 0.)
+	    	        next
+		    ratio = r3 / r2
+		    if (ratio > maxratio)
+	    		next
+
+		    # Compute the cos, cos ** 2 and sin ** 2 of the angle at 
+		    # vertex 1.
+		    cosc = (dx3 * dx2 + dy3 * dy2) / (r3 * r2)
+		    cosc2 = max (0.0, min (1.0, cosc * cosc))
+		    sinc2 = max (0.0, min (1.0, 1.0 - cosc2))
+
+		    # Determine whether the triangles vertices are arranged
+		    # clockwise of anticlockwise.
+		    if ((dx2 * dy1 - dy2 * dx1) > 0.0)
+			reftri[ntri,RG_CC] = YES
+		    else
+			reftri[ntri,RG_CC] = NO
+
+		    # Compute the tolerances.
+		    tol = (1.0 / r3sq - cosc / (r3 * r2) + 1.0 / r2sq)
+		    tripar[ntri,RG_TOLR] = 2.0 * ratio ** 2 * tol2 * tol 
+		    tripar[ntri,RG_TOLC] = 2.0 * sinc2 * tol2 * tol + 3.0 *
+		        cosc2 * tol2 ** 2 * tol * tol
+
+		    # Compute the perimeter.
+		    tripar[ntri,RG_LOGP] = log (r1 + r2 + r3)
+		    tripar[ntri,RG_RATIO] = ratio
+		    tripar[ntri,RG_COS1] = cosc
+
+		    ntri = ntri + 1
+		}
+	    }
+	}
+
+	ntri = ntri - 1
+
+	# Sort the triangles in increasing order of ratio.
+	call rg_qsortr (tripar[1,RG_RATIO], reftri[1,RG_INDEX],
+	    reftri[1,RG_INDEX], ntri)
+
+	return (ntri)
+end
+
+
+# RG_TMERGE -- Compute the intersection of two sorted files of triangles
+# using the tolerance parameter.
+
+int procedure rg_tmerge (reftri, rtripar, nrtri, nmrtri, listri, ltripar,
+	nltri, nmltri)
+
+int	reftri[nmrtri,ARB]	#U list of reference triangles
+real	rtripar[nmrtri,ARB]	#I reference triangle parameters
+int	nrtri			#I number of reference triangles
+int	nmrtri			#I maximum number of reference triangles
+int	listri[nmltri,ARB]	#U list of reference triangles
+real	ltripar[nmltri,ARB]	#I reference triangle parameters
+int	nltri			#I number of reference triangles
+int	nmltri			#I maximum number of reference triangles
+
+int	rp, blp, lp, ninter, rindex, lindex, mindex
+real	rmaxtol, lmaxtol, maxtol, dr, dr2, mdr2, dcos2, mdcos2, dtolr, dtolc 
+
+begin
+	# Find the maximum tolerance for each list.
+	call alimr (rtripar[1,RG_TOLR], nrtri, maxtol, rmaxtol)
+	call alimr (ltripar[1,RG_TOLR], nltri, maxtol, lmaxtol)
+	maxtol = sqrt (rmaxtol + lmaxtol)
+
+	# Define the beginning of the search range for each triangle.
+	blp = 1
+
+	# Loop over all the triangles in the reference list.
+	ninter = 0
+	for (rp = 1; rp <= nrtri; rp = rp + 1) {
+
+	    # Get the index for the reference triangle.
+	    rindex = reftri[rp,RG_INDEX]
+
+	    # Move to the first triangle in the input list that satisfies the
+	    # ratio tolerance requirement.
+	    for  (; blp <= nltri; blp = blp + 1) {
+		lindex = listri[blp,RG_INDEX]
+		dr = rtripar[rindex,RG_RATIO] - ltripar[lindex,RG_RATIO]
+		if (dr <= maxtol)
+		    break
+	    }
+
+	    # If the beginning of the search range becomes greater than
+	    # the length of the list then there is no match.
+	    if (blp > nltri)
+		break
+
+	    # If the first triangle in the list is past the tolerance
+	    # limit skip to the next reference triangle
+	    if (dr < -maxtol)
+		next
+
+	    # Search through the appropriate range of triangles for the 
+	    # closest fit.
+
+	    # Initialize the tolerances.
+	    mindex = 0
+	    mdr2 = 0.5 * MAX_REAL
+	    mdcos2 = 0.5 * MAX_REAL
+
+	    for (lp = blp; lp <= nltri; lp = lp + 1) {
+
+		# Quit the loop if the next triangle is out of match range.
+		lindex = listri[lp,RG_INDEX]
+		dr = rtripar[rindex,RG_RATIO] - ltripar[lindex,RG_RATIO]
+		if (dr < -maxtol)
+		    break
+
+		# Compute the tolerances for the two triangles.
+		dr2 = dr * dr
+		dcos2 = (rtripar[rindex,RG_COS1] - ltripar[lindex,RG_COS1]) ** 2
+		dtolr = rtripar[rindex,RG_TOLR] + ltripar[lindex,RG_TOLR]
+		dtolc = rtripar[rindex,RG_TOLC] + ltripar[lindex,RG_TOLC] 
+
+		# Find the best of all possible matches.
+		if (dr2 <= dtolr && dcos2 <= dtolc) {
+		    if ((dr2 + dcos2) < (mdr2 + mdcos2)) {
+			mindex = lindex
+			mdr2 = dr2
+			mdcos2 = dcos2
+		    }
+		}
+
+	    }
+
+	    # Add the match to the list.
+	    if (mindex > 0) {
+		ninter = ninter + 1
+		reftri[ninter,RG_MATCH] = rindex
+		listri[ninter,RG_MATCH] = mindex
+	    }
+	}
+
+	return (ninter)
+end
+
+
+# RG_TREJECT -- Remove false matches from the list of matched triangles.
+
+int procedure rg_treject (reftri, rtripar, nrtri, nmrtri, listri, ltripar,
+	nltri, nmltri, nmatch, maxiter)
+
+int	reftri[nmrtri,ARB]	#U list of reference triangles
+real	rtripar[nmrtri,ARB]	#I reference triangle parameters
+int	nrtri			#I number of reference triangles
+int	nmrtri			#I maximum number of reference triangles
+int	listri[nmltri,ARB]	#U list of reference triangles
+real	ltripar[nmltri,ARB]	#I reference triangle parameters
+int	nltri			#I number of reference triangles
+int	nmltri			#I maximum number of reference triangles
+int	nmatch			#I initial number of matches
+int	maxiter			#I maximum number of rejection iterations
+
+double	dif, mode, sum, sumsq
+int	i, nrej, nplus, nminus, ntrue, nfalse, npts, ncount, niter, rindex
+int	lindex
+pointer	sp, adif
+real	sigma, factor, locut, hicut
+double	rg_moded()
+
+begin
+	call smark (sp)
+	call salloc (adif, nmatch, TY_DOUBLE)
+
+	# Accumulate the number of same sense and number of opposite sense
+	# matches as well as the log perimeter statistics.
+	sum = 0.0d0
+	sumsq = 0.0d0
+	nplus = 0
+	do i = 1, nmatch {
+	    rindex = reftri[i,RG_MATCH]
+	    lindex = listri[i,RG_MATCH]
+	    dif = (rtripar[rindex,RG_LOGP] - ltripar[lindex,RG_LOGP])
+	    Memd[adif+i-1] = dif
+	    sum = sum + dif
+	    sumsq = sumsq + dif * dif
+	    if (reftri[rindex,RG_CC] == listri[lindex,RG_CC])
+		nplus = nplus + 1
+	}
+	nminus = nmatch - nplus
+
+	# Compute the mean, mode, and sigma of the logP distribution,
+	ntrue = abs (nplus - nminus)
+	nfalse = nplus + nminus - ntrue
+	#mean = sum / nmatch
+	if (nmatch <= 1)
+	    sigma = 0.0
+	else
+	    sigma = (sumsq - (sum / nmatch) * sum) / (nmatch - 1)
+	if (sigma <= 0.0) {
+	    call sfree (sp)
+	    return (nmatch)
+	} else
+	    sigma = sqrt (sigma)
+	call asrtd (Memd[adif], Memd[adif], nmatch)
+        #if (mod (nmatch,2) == 1)
+            #median = Memd[adif+nmatch/2]
+        #else
+	    #median = (Memd[adif+nmatch/2] + Memd[adif+(nmatch-1)/2]) / 2.0d0
+	mode = rg_moded (Memd[adif], nmatch, 10, 1.0d0, 0.1d0 * sigma,
+	    0.01d0 * sigma)
+	if (nfalse > ntrue)
+	    factor = 1.0
+	else if ((0.1 * ntrue) > nfalse)
+	    factor = 3.0
+	else
+	    factor = 2.0
+
+	# Begin the rejection cycle.
+	npts = nmatch
+	niter = 0
+	repeat {
+
+	    ncount = 0
+	    nrej = 0
+	    locut = mode - factor * sigma
+	    hicut = mode + factor * sigma
+
+	    # Reject matched triangles which are too far from the mean logP.
+	    do i = 1, npts {
+		rindex = reftri[i,RG_MATCH]
+		lindex = listri[i,RG_MATCH]
+		dif = rtripar[rindex,RG_LOGP] - ltripar[lindex,RG_LOGP]
+		if (dif < locut || dif > hicut) {
+		    sum = sum - dif
+		    sumsq = sumsq - dif * dif
+	    	    if (reftri[rindex,RG_CC] == listri[lindex,RG_CC])
+			nplus = nplus - 1
+		    else
+			nminus = nminus - 1
+		    nrej = nrej + 1
+		} else {
+		    Memd[adif+ncount] = dif
+		    ncount = ncount + 1
+		    reftri[ncount,RG_MATCH] = rindex
+		    listri[ncount,RG_MATCH] = lindex
+		}
+	    }
+
+	    # No more points were rejected.
+	    npts = ncount
+	    if (nrej <= 0)
+		break
+
+	    # All the points were rejected.
+	    if (npts <= 0)
+		break
+
+	    # The rejection iteration limit was reached.
+	    niter = niter + 1
+	    if (niter >= maxiter)
+		break
+
+	    # Compute the new mean and sigma of the logP distribution.
+	    #mean = sum / npts
+	    if (npts <= 1)
+	        sigma = 0.0
+	    else
+	        sigma = (sumsq - (sum / npts) * sum) / (npts - 1)
+	    if (sigma <= 0.0)
+		break
+	    sigma = sqrt (sigma)
+	    call asrtd (Memd[adif], Memd[adif], npts)
+            #if (mod (npts,2) == 1)
+                #median = Memd[adif+npts/2]
+            #else
+		#median = (Memd[adif+npts/2] + Memd[adif+(npts-1)/2]) / 2.0d0
+	    mode = rg_moded (Memd[adif], npts, 10, 1.0d0, 0.10d0 * sigma,
+	        0.01d0 * sigma)
+
+	    # Recompute the ksigma rejection criterion based on the number of
+	    # same and opposite sense matches.
+	    ntrue = abs (nplus - nminus)
+	    nfalse = nplus + nminus - ntrue
+	    if (nfalse > ntrue)
+	        factor = 1.0
+	    else if ((0.1 * ntrue) > nfalse)
+	        factor = 3.0
+	    else
+	        factor = 2.0
+	}
+
+	# One last iteration to get rid of opposite sense of matches.
+	if (npts <= 0)
+	    npts = 0
+	else if (nplus > nminus) {
+	    ncount = 0
+	    do i = 1, npts {
+	        rindex = reftri[i,RG_MATCH]
+	        lindex = listri[i,RG_MATCH]
+	    	if (reftri[rindex,RG_CC] == listri[lindex,RG_CC]) {
+		    ncount = ncount + 1
+		    reftri[ncount,RG_MATCH] = rindex
+		    listri[ncount,RG_MATCH] = lindex
+		}
+	    }
+	    npts = ncount
+	} else {
+	    ncount = 0
+	    do i = 1, npts {
+	        rindex = reftri[i,RG_MATCH]
+	        lindex = listri[i,RG_MATCH]
+	    	if (reftri[rindex,RG_CC] != listri[lindex,RG_CC]) {
+		    ncount = ncount + 1
+		    reftri[ncount,RG_MATCH] = rindex
+		    listri[ncount,RG_MATCH] = lindex
+		}
+	    }
+	    npts = ncount
+	}
+
+	call sfree (sp)
+	return (npts)
+end
+
+
+# RG_TVOTE -- Count the number a times a particular pair of
+# coordinates is matched in the set of matched triangles. If a particular
+# pair of points occurs in many triangles it is much more likely to be
+# a true match than if it occurs in very few. Since this vote array
+# may be quite sparsely occupied, use the PLIO package to store and
+# maintain the list.
+
+int procedure rg_tvote (reftri, nmrtri, nrefstars, listri, nmltri, nliststars,
+	nmatch)
+
+int	reftri[nmrtri,ARB]		#U reference triangles
+int	nmrtri				#I maximum number of reference triangles
+int	nrefstars			#I number of reference stars
+int	listri[nmltri,ARB]		#U input list triangles
+int	nmltri				#I maximum number of list triangles
+int	nliststars			#I number of list stars
+int	nmatch				#I number of match triangles
+
+int	i, j, rp, lp, vp, pixval, tminvote, tmaxvote, minvote, maxvote, hmaxvote
+int	ninter, axes[2], laxes[2], pvp
+pointer	sp, vote, vindex, pl, lmatch, rmatch
+bool	pl_linenotempty()
+pointer	pl_create()
+
+begin
+	# Open the pixel list.
+	axes[1] = nliststars
+	axes[2] = nrefstars
+	pl = pl_create (2, axes, 16)
+
+	# Acumulate the votes.
+	do i = 1, nmatch {
+	    rp = reftri[i,RG_MATCH]
+	    lp = listri[i,RG_MATCH]
+	    laxes[1] = listri[lp,RG_X1]
+	    laxes[2] = reftri[rp,RG_X1]
+	    if (! pl_linenotempty (pl, laxes))
+	        call pl_point (pl, laxes[1], laxes[2], PIX_SET + PIX_VALUE(1))
+	    else {
+		call pl_glpi (pl, laxes, pixval, 16, 1, PIX_SRC)
+		pixval = pixval + 1
+	        call pl_point (pl, laxes[1], laxes[2], PIX_SET +
+		    PIX_VALUE(pixval))
+	    }
+	    laxes[1] = listri[lp,RG_X2]
+	    laxes[2] = reftri[rp,RG_X2]
+	    if (! pl_linenotempty (pl, laxes))
+	        call pl_point (pl, laxes[1], laxes[2], PIX_SET + PIX_VALUE(1))
+	    else {
+		call pl_glpi (pl, laxes, pixval, 16, 1, PIX_SRC)
+		pixval = pixval + 1
+	        call pl_point (pl, laxes[1], laxes[2], PIX_SET +
+		    PIX_VALUE(pixval))
+	    }
+	    laxes[1] = listri[lp,RG_X3]
+	    laxes[2] = reftri[rp,RG_X3]
+	    if (! pl_linenotempty (pl, laxes))
+	        call pl_point (pl, laxes[1], laxes[2], PIX_SET + PIX_VALUE(1))
+	    else {
+		call pl_glpi (pl, laxes, pixval, 16, 1, PIX_SRC)
+		pixval = pixval + 1
+	        call pl_point (pl, laxes[1], laxes[2], PIX_SET +
+		    PIX_VALUE(pixval))
+	    }
+	}
+
+	# Allocate temporary working space.
+	call smark (sp)
+	call salloc (vote, axes[1], TY_INT)
+	call salloc (vindex, axes[1], TY_INT)
+	call salloc (lmatch, axes[1], TY_INT)
+	call salloc (rmatch, axes[2], TY_INT)
+	call amovki (NO, Memi[lmatch], axes[1])
+	call amovki (NO, Memi[rmatch], axes[2])
+
+	# Find the maximum value in the mask.
+	minvote = MAX_INT
+	maxvote = -MAX_INT
+	do i = 1, axes[2] {
+	    laxes[1] = 1
+	    laxes[2] = i
+	    if (! pl_linenotempty (pl, laxes))
+		next
+	    call pl_glpi (pl, laxes, Memi[vote], 16, axes[1], PIX_SRC)
+	    call alimi (Memi[vote], axes[1], tminvote, tmaxvote)
+	    minvote = min (minvote, tminvote)
+	    maxvote = max (maxvote, tmaxvote)
+	}
+	if (maxvote < 0) {
+	    maxvote = 0
+	    hmaxvote = 0
+	} else
+	    hmaxvote = maxvote / 2
+
+	# Vote on the matched pairs.
+	ninter = 0
+	if (maxvote > 0) {
+	    do j = 1, axes[2] {
+
+	        # Sort the vote array.
+	        do i = 1, axes[1]
+		    Memi[vindex+i-1] = i
+	        laxes[1] = 1
+	        laxes[2] = j
+	        call pl_glpi (pl, laxes, Memi[vote], 16, axes[1], PIX_SRC)
+	        call rg_qsorti (Memi[vote], Memi[vindex], Memi[vindex],
+		    axes[1])
+
+	        # Reject points which have no votes, which have only a
+		# single vote if the maximum number of votest is > 1,
+		# less or equal to half the  maximum number of votes,
+		# the same number of votes as the next largest index,
+		# or which have already been matched.
+
+		vp = Memi[vindex+axes[1]-1]
+		pvp = Memi[vindex+axes[1]-2]
+	        if (Memi[vote+vp-1] <= 0)
+		    next
+		if (Memi[vote+vp-1] == Memi[vote+pvp-1])
+		    next
+		if (Memi[vote+vp-1] <= hmaxvote)
+		    next
+		if (Memi[lmatch+vp-1] == YES || Memi[rmatch+j-1] == YES)
+		    next
+	        if (Memi[vote+vp-1] == 1 && (maxvote > 1 || nmatch > 1))
+		    next
+
+		ninter = ninter + 1
+		reftri[ninter, RG_MATCH] = j
+		listri[ninter,RG_MATCH] = vp
+		Memi[rmatch+j-1] = YES
+		Memi[lmatch+vp-1] = YES
+	    }
+	} else if (maxvote > 0) {
+	}
+
+	call sfree (sp)
+	call pl_close (pl)
+
+	return (ninter)
+end
+
+
+# RG_MLINCOEFF -- Compute the coefficients of a new linear transformation
+# using the first one to three matched stars as input.
+
+int procedure rg_mlincoeff (xref, yref, xlist, ylist, reftri, nmrtri, listri,
+	nmltri, nmatch, coeff, ncoeff)
+
+real	xref[ARB]		#I the x reference coordinates
+real	yref[ARB]		#I the y reference coordinates
+real	xlist[ARB]		#I the x list coordinates
+real	ylist[ARB]		#I the y list coordinates
+int	reftri[nmrtri,ARB]	#I list of reference triangles
+int	nmrtri			#I maximum number of reference triangles
+int	listri[nmltri,ARB]	#I list of reference triangles
+int	nmltri			#I maximum number of list triangles
+int	nmatch			#I number of matches
+real	coeff[ARB]		#O the new computed coefficients
+int	ncoeff			#I the number of coefficients
+
+int	i, rindex, lindex, stat
+pointer	sp, xr, yr, xin, yin
+int	rg_lincoeff()
+
+begin
+	if (nmatch <= 0)
+	    return (ERR)
+
+	call smark (sp)
+	call salloc (xr, nmatch, TY_REAL)
+	call salloc (yr, nmatch, TY_REAL)
+	call salloc (xin, nmatch, TY_REAL)
+	call salloc (yin, nmatch, TY_REAL)
+
+	# Load the points to be fit.
+	do i = 1, nmatch {
+	    rindex = reftri[i,RG_MATCH]
+	    lindex = listri[i,RG_MATCH]
+	    Memr[xr+i-1] = xref[rindex] 
+	    Memr[yr+i-1] = yref[rindex] 
+	    Memr[xin+i-1] = xlist[lindex]
+	    Memr[yin+i-1] = ylist[lindex]
+	}
+
+	# Compute the new coefficients.
+	stat = rg_lincoeff (Memr[xr], Memr[yr], Memr[xin], Memr[yin],
+	    nmatch, coeff, ncoeff)
+
+	call sfree (sp)
+
+	return (stat)
+end
+
+
+# RG_MWRITE -- Write out the intersection of the two matched pixel lists to the
+# output file.
+
+procedure rg_mwrite (ofd, xref, yref, rlineno, xlist, ylist, ilineno,
+	reftri, nmrtri, listri, nmltri, nmatch, xformat, yformat)
+
+int	ofd			#I the output file descriptor
+real	xref[ARB]		#I the x reference coordinates
+real	yref[ARB]		#I the y reference coordinates
+int	rlineno[ARB]		#I the reference coordinate line numbers
+real	xlist[ARB]		#I the x list coordinates
+real	ylist[ARB]		#I the y list coordinates
+int	ilineno[ARB]		#I the input list line numbers
+int	reftri[nmrtri,ARB]	#I list of reference triangles
+int	nmrtri			#I maximum number of reference triangles
+int	listri[nmltri,ARB]	#I list of reference triangles
+int	nmltri			#I maximum number of list triangles
+int	nmatch			#I number of matches
+char	xformat[ARB]		#I the output x column format
+char	yformat[ARB]		#I the output y column format
+
+int	i, lindex, rindex
+pointer	sp, fmtstr
+
+begin
+	call smark (sp)
+	call salloc (fmtstr, SZ_LINE, TY_CHAR)
+
+	# Construct the format string.
+	call sprintf (Memc[fmtstr], SZ_LINE, "%s %s  %s %s  %%5d %%5d\n")
+	if (xformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (xformat)
+	if (yformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (yformat)
+	if (xformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (xformat)
+	if (yformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (yformat)
+
+	do i = 1, nmatch {
+	    rindex = reftri[i,RG_MATCH]
+	    lindex = listri[i,RG_MATCH]
+	    call fprintf (ofd, Memc[fmtstr])
+		call pargr (xref[rindex])
+		call pargr (yref[rindex])
+		call pargr (xlist[lindex])
+		call pargr (ylist[lindex])
+		call pargi (rlineno[rindex])
+		call pargi (ilineno[lindex])
+	}
+
+	call sfree (sp)
+end
+
+
+# RG_LMWRITE -- Write out the intersection of the matched celestial coordinate
+# and pixel lists to the output file.
+
+procedure rg_lmwrite (ofd, lngref, latref, rlineno, xlist, ylist, ilineno,
+	reftri, nmrtri, listri, nmltri, nmatch, lngformat, latformat,
+	xformat, yformat)
+
+int	ofd			#I the output file descriptor
+double	lngref[ARB]		#I the x reference coordinates
+double	latref[ARB]		#I the y reference coordinates
+int	rlineno[ARB]		#I the reference coordinate line numbers
+real	xlist[ARB]		#I the x list coordinates
+real	ylist[ARB]		#I the y list coordinates
+int	ilineno[ARB]		#I the input list line numbers
+int	reftri[nmrtri,ARB]	#I list of reference triangles
+int	nmrtri			#I maximum number of reference triangles
+int	listri[nmltri,ARB]	#I list of reference triangles
+int	nmltri			#I maximum number of list triangles
+int	nmatch			#I number of matches
+char	lngformat[ARB]		#I the output longitude column format
+char	latformat[ARB]		#I the output latitude column format
+char	xformat[ARB]		#I the output x column format
+char	yformat[ARB]		#I the output y column format
+
+int	i, lindex, rindex
+pointer	sp, fmtstr
+
+begin
+	call smark (sp)
+	call salloc (fmtstr, SZ_LINE, TY_CHAR)
+
+	# Construct the format string.
+	call sprintf (Memc[fmtstr], SZ_LINE, "%s %s  %s %s  %%5d %%5d\n")
+	if (lngformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (lngformat)
+	if (latformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (latformat)
+	if (xformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (xformat)
+	if (yformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (yformat)
+
+	do i = 1, nmatch {
+	    rindex = reftri[i,RG_MATCH]
+	    lindex = listri[i,RG_MATCH]
+	    call fprintf (ofd, Memc[fmtstr])
+		call pargd (lngref[rindex])
+		call pargd (latref[rindex])
+		call pargr (xlist[lindex])
+		call pargr (ylist[lindex])
+		call pargi (rlineno[rindex])
+		call pargi (ilineno[lindex])
+	}
+
+	call sfree (sp)
+end
+
+
+# RG_FACTORIAL -- Compute the combinatorial function which is defined as
+# n! / ((n - ngroup)! * ngroup!).
+
+int procedure rg_factorial (n, ngroup)
+
+int	n		#I input argument
+int	ngroup		#I combinatorial factor
+
+int	i, fac, grfac
+
+begin
+	if (n <= 0)
+	    return (1)
+
+	fac = n
+	do i = n - 1, n - 3 + 1, -1
+	    fac = fac * i
+
+	grfac = ngroup
+	do i = ngroup - 1, 2, -1
+	    grfac = grfac * i
+
+	return (fac / grfac)
+end
+
+
+# RG_MODED -- Compute mode of an array.  The mode is found by binning
+# with a bin size based on the data range over a fraction of the
+# pixels about the median and a bin step which may be smaller than the
+# bin size.  If there are too few points the median is returned.
+# The input array must be sorted.
+
+double procedure rg_moded (a, npts, nmin, zrange, fzbin, fzstep)
+
+double  a[npts]                 #I the sorted input data array
+int     npts                    #I the number of points
+int     nmin                    #I the minimum number of points
+double  zrange                  #I fraction of pixels around median to use
+double  fzbin                   #I the bin size for the mode search
+double  fzstep                  #I the step size for the mode search
+
+int     x1, x2, x3, nmax
+double  zstep, zbin, y1, y2, mode
+bool    fp_equald()
+
+begin
+        # If there are too few points return the median.
+        if (npts < nmin) {
+            if (mod (npts,2) == 1)
+                return (a[1+npts/2])
+            else
+                return ((a[npts/2] + a[1+npts/2]) / 2.0d0)
+        }
+
+        # Compute the data range that will be used to do the mode search.
+        # If the data has no range then the constant value will be returned.
+        x1 = max (1, int (1.0d0 + npts * (1.0d0 - zrange) / 2.0d0))
+        x3 = min (npts, int (1.0d0 + npts * (1.0d0 + zrange) / 2.0d0))
+        if (fp_equald (a[x1], a[x3]))
+            return (a[x1])
+
+
+        # Compute the bin and step size. The bin size is based on the
+        # data range over a fraction of the pixels around the median
+        # and a bin step which may be smaller than the bin size.
+
+        zstep = fzstep #* (a[x3] - a[x1])
+        zbin = fzbin #* (a[x3] - a[x1])
+
+        nmax = 0
+        x2 = x1
+        for (y1 = a[x1]; x2 < x3; y1 = y1 + zstep) {
+            for (; a[x1] < y1; x1 = x1 + 1)
+                ;
+            y2 = y1 + zbin
+            for (; (x2 < x3) && (a[x2] < y2); x2 = x2 + 1)
+                ;
+            if (x2 - x1 > nmax) {
+                nmax = x2 - x1
+                if (mod (x2+x1,2) == 0)
+                    mode = a[(x2+x1)/2]
+                else
+                    mode = (a[(x2+x1)/2] + a[(x2+x1)/2+1]) / 2.0d0
+            }
+        }
+
+        return (mode)
+end
+
+
+#define  NMIN    10        # Minimum number of pixels for mode calculation
+#define  ZRANGE  0.8d0     # Fraction of pixels about median to use
+#define  ZSTEP   0.01d0    # Step size for search for mode
+#define  ZBIN    0.1d0     # Bin size for mode.
+#
+## RG_MODED -- Compute mode of an array.  The mode is found by binning
+## with a bin size based on the data range over a fraction of the
+## pixels about the median and a bin step which may be smaller than the
+## bin size.  If there are too few points the median is returned.
+## The input array must be sorted.
+#
+#double	procedure rg_moded (a, n)
+#
+#double  a[n]                    # Data array
+#int     n                       # Number of points
+#
+#int     i, j, k, nmax
+#real    z1, z2, zstep, zbin
+#double  mode
+#bool    fp_equald()
+#
+#begin
+#        if (n < NMIN)
+#            return (a[n/2])
+#
+#        # Compute the mode.  The array must be sorted.  Consider a
+#        # range of values about the median point.  Use a bin size which
+#        # is ZBIN of the range.  Step the bin limits in ZSTEP fraction of
+#        # the bin size.
+#
+#	i = 1 + n * (1. - ZRANGE) / 2.0d0
+#        j = 1 + n * (1. + ZRANGE) / 2.0d0
+#        z1 = a[i]
+#        z2 = a[j]
+#        if (fp_equald (z1, z2)) {
+#            mode = z1
+#            return (mode)
+#        }
+#
+#        zstep = ZSTEP * (z2 - z1)
+#        zbin = ZBIN * (z2 - z1)
+#
+#        z1 = z1 - zstep
+#        k = i
+#        nmax = 0
+#        repeat {
+#            z1 = z1 + zstep
+#            z2 = z1 + zbin
+#            for (; i < j && a[i] < z1; i=i+1)
+#                ;
+#            for (; k < j && a[k] < z2; k=k+1)
+#                ;
+#            if (k - i > nmax) {
+#                nmax = k - i
+#                mode = a[(i+k)/2]
+#            }
+#        } until (k >= j)
+#
+#        return (mode)
+#end
+#
diff --git a/pkg/images/lib/rgsort.x b/pkg/images/lib/rgsort.x
new file mode 100644
index 00000000..afaab085
--- /dev/null
+++ b/pkg/images/lib/rgsort.x
@@ -0,0 +1,162 @@
+
+define	LOGPTR		20			# log2(maxpts) (1e6)
+
+# RG_QSORTR -- Vector quicksort a real array. In this version the index array
+# is sorted not the data array. The input and output index arrays may be the
+# same.
+
+procedure rg_qsortr (data, a, b, npix)
+
+real	data[ARB]		#I the input data array
+int	a[ARB]			#I the input index array
+int	b[ARB]			#O the output index array
+int	npix			#I the number of pixels
+
+int	i, j, lv[LOGPTR], p, uv[LOGPTR], temp
+real	pivot
+
+begin
+	# Initialize the indices for an inplace sort.
+	call amovi (a, b, npix)
+
+	p = 1
+	lv[1] = 1
+	uv[1] = npix
+	while (p > 0) {
+
+	    # If only one elem in subset pop stack otherwise pivot line.
+	    if (lv[p] >= uv[p])
+		p = p - 1
+	    else {
+		i = lv[p] - 1
+		j = uv[p]
+		pivot = data[b[j]]
+
+		while (i < j) {
+		    for (i=i+1;  data[b[i]] < pivot;  i=i+1)
+			;
+		    for (j=j-1;  j > i;  j=j-1)
+			if (data[b[j]] <= pivot)
+			    break
+		    if (i < j) {		# out of order pair
+			temp = b[j]		# interchange elements
+			b[j] = b[i]
+			b[i] = temp
+		    }
+		}
+
+		j = uv[p]			# move pivot to position i
+		temp = b[j]			# interchange elements
+		b[j] = b[i]
+		b[i] = temp
+
+		if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+		    lv[p+1] = lv[p]
+		    uv[p+1] = i - 1
+		    lv[p] = i + 1
+		} else {
+		    lv[p+1] = i + 1
+		    uv[p+1] = uv[p]
+		    uv[p] = i - 1
+		}
+
+		p = p + 1			# push onto stack
+	    }
+	}
+end
+
+
+# RG_QSORTI -- Vector quicksort an integer array. In this version the index
+# array is actually sorted not the data array. The input and output index
+# arrays may be the same.
+
+procedure rg_qsorti (data, a, b, npix)
+
+int	data[ARB]		# data array
+int	a[ARB]			# input index array
+int	b[ARB]			# output index array
+int	npix			# number of pixels
+
+int	i, j, lv[LOGPTR], p, uv[LOGPTR], temp, pivot
+
+begin
+	# Initialize the indices for an inplace sort.
+	call amovi (a, b, npix)
+
+	p = 1
+	lv[1] = 1
+	uv[1] = npix
+	while (p > 0) {
+
+	    # If only one elem in subset pop stack otherwise pivot line.
+	    if (lv[p] >= uv[p])
+		p = p - 1
+	    else {
+		i = lv[p] - 1
+		j = uv[p]
+		pivot = data[b[j]]
+
+		while (i < j) {
+		    for (i=i+1;  data[b[i]] < pivot;  i=i+1)
+			;
+		    for (j=j-1;  j > i;  j=j-1)
+			if (data[b[j]] <= pivot)
+			    break
+		    if (i < j) {		# out of order pair
+			temp = b[j]		# interchange elements
+			b[j] = b[i]
+			b[i] = temp
+		    }
+		}
+
+		j = uv[p]			# move pivot to position i
+		temp = b[j]			# interchange elements
+		b[j] = b[i]
+		b[i] = temp
+
+		if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+		    lv[p+1] = lv[p]
+		    uv[p+1] = i - 1
+		    lv[p] = i + 1
+		} else {
+		    lv[p+1] = i + 1
+		    uv[p+1] = uv[p]
+		    uv[p] = i - 1
+		}
+
+		p = p + 1			# push onto stack
+	    }
+	}
+end
+
+
+# RG_SQSORT -- Sort two real arrays of data in increasing order using a
+# secondary key. The data is assumed to have been already sorted on
+# the primary key. The input and output index arrays may be the same.
+
+procedure rg_sqsort (sdata, pdata, a, b, npix)
+
+real	sdata[npix]		#I the secondary key
+real	pdata[npix]		#I the primary key
+int	a[npix]			#I the sorted index from the primary key
+int	b[npix]			#O the sorted output index
+int	npix			#I number of pixels
+
+int	i, ndup, first
+
+begin
+	# Copy the index array.
+	call amovi (a, b, npix)
+
+	# Initialize.
+	ndup = 0
+	for (i = 2; i <= npix; i = i + 1) {
+	    if (pdata[b[i]] <= pdata[b[i-1]])
+		ndup = ndup + 1 
+	    else if (ndup > 0) {
+		first = i - 1 - ndup
+		call rg_qsortr (sdata, b[first], b[first], ndup + 1)
+		ndup = 0
+	    }
+	}
+end
diff --git a/pkg/images/lib/rgtransform.x b/pkg/images/lib/rgtransform.x
new file mode 100644
index 00000000..da9f8210
--- /dev/null
+++ b/pkg/images/lib/rgtransform.x
@@ -0,0 +1,947 @@
+include <math.h>
+include <math/gsurfit.h>
+include "xyxymatch.h"
+
+# RG_GETREFTIE -- Get the reference pixel coordinate tie points by reading
+# the image cursor or a file.
+
+int procedure rg_getreftie (fd, xreftie, yreftie, ntie, file_type, interactive)
+
+int	fd			#I the input file descriptor
+real	xreftie[ARB]		#O the output x coordinates of the tie points
+real	yreftie[ARB]		#O the output y coordinates of the tie points
+int	ntie			#I the number of tie points
+int	file_type		#I the input file type
+bool	interactive		#I the 
+
+int	nref, wcs, key
+pointer	sp, str
+int	clgcur(), fscan(), nscan()
+
+begin
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Print the prompt string.
+	if (interactive) {
+
+	    # Issue prompt.
+	    if (file_type == RG_REFFILE) {
+	        call printf (
+	            "\nMark 1-%d reference objects on the display\n")
+	    } else {
+	        call printf (
+	            "\nMark the same %d input objects on the display\n")
+	    }
+		call pargi (ntie)
+
+	    # Mark the points
+	    nref = 0
+	    while (clgcur ("icommands", xreftie[nref+1], yreftie[nref+1],
+	        wcs, key, Memc[str], SZ_LINE) != EOF) {
+	        nref = nref + 1
+	        if (file_type == RG_REFFILE) {
+		    call printf ("    Reference coordinate %d %0.3f %0.3f\n")
+			call pargi (nref)
+			call pargr (xreftie[nref])
+			call pargr (yreftie[nref])
+		} else {
+		    call printf ("    Input coordinate %d %0.3f %0.3f\n")
+			call pargi (nref)
+			call pargr (xreftie[nref])
+			call pargr (yreftie[nref])
+		}
+	        if (nref >= ntie)
+		    break
+	    }
+
+	} else {
+
+	    # Issue prompt.
+	    if (fd == STDIN) {
+	        if (file_type == RG_REFFILE) {
+	            call printf (
+	            "\nEnter coordinates of 1-%d reference objects\n")
+	        } else {
+	            call printf (
+	            "Enter coordinates of %d corresponding input objects\n")
+	        }
+		    call pargi (ntie)
+	    }
+
+	    nref = 0
+	    while (fscan (fd) != EOF) {
+		call gargr (xreftie[nref+1])
+		call gargr (yreftie[nref+1])
+		if (nscan() < 2)
+		    break
+		nref = nref + 1
+		if (nref >= ntie)
+		    break
+		call gargr (xreftie[nref+1])
+		call gargr (yreftie[nref+1])
+		if (nscan() < 4)
+		    break
+		nref = nref + 1
+		if (nref >= ntie)
+		    break
+		call gargr (xreftie[nref+1])
+		call gargr (yreftie[nref+1])
+		if (nscan() < 6)
+		    break
+		nref = nref + 1
+		break
+	    }
+
+	}
+
+	call sfree (sp)
+
+	return (nref)
+end
+
+
+# RG_GETREFCEL -- Get the reference pixel coordinate tie points by reading
+# the image cursor or a file.
+
+int procedure rg_getrefcel (fd, xreftie, yreftie, ntie, projection,
+	reflng, reflat, lngunits, latunits, file_type)
+
+int	fd			#I the input file descriptor
+real	xreftie[ARB]		#O the output x coordinates of the tie points
+real	yreftie[ARB]		#O the output y coordinates of the tie points
+int	ntie			#I the number of tie points
+char	projection[ARB]		#I the sky projection geometry
+double	reflng			#I the ra / longitude of the reference point
+double	reflat			#I the dec / latitude of the reference point
+int	lngunits		#I the ra / longitude units
+int	latunits		#I the dec / latitude units
+int	file_type		#I the input file type
+
+int	nref
+pointer	sp, dxref, dyref, str
+int	fscan(), nscan()
+
+begin
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (dxref, ntie, TY_DOUBLE)
+	call salloc (dyref, ntie, TY_DOUBLE)
+
+	# Issue prompt.
+	if (fd == STDIN) {
+	    if (file_type == RG_REFFILE) {
+	        call printf (
+	            "\nEnter coordinates of 1-%d reference objects\n")
+	    } else {
+	        call printf (
+	            "Enter coordinates of %d corresponding input objects\n")
+	    }
+	        call pargi (ntie)
+	}
+
+	# Read in the tie point.
+	nref = 0
+	while (fscan (fd) != EOF) {
+	    call gargd (Memd[dxref+nref])
+	    call gargd (Memd[dyref+nref])
+	    if (nscan() < 2)
+	        break
+	    nref = nref + 1
+	    if (nref >= ntie)
+	        break
+	    call gargd (Memd[dxref+nref])
+	    call gargd (Memd[dyref+nref])
+	    if (nscan() < 4)
+	        break
+	    nref = nref + 1
+	    if (nref >= ntie)
+	        break
+	    call gargd (Memd[dxref+nref])
+	    call gargd (Memd[dyref+nref])
+	    if (nscan() < 6)
+	        break
+	    nref = nref + 1
+	    break
+	}
+
+	# Convert to standard coordinates.
+	if (nref > 0) {
+	    call rg_celtostd (projection, Memd[dxref], Memd[dyref],
+	        Memd[dxref], Memd[dyref], nref, reflng, reflat, lngunits,
+		latunits)
+	    call amulkd (Memd[dxref], 3600.0d0, Memd[dxref], nref)
+	    call amulkd (Memd[dyref], 3600.0d0, Memd[dyref], nref)
+	    call achtdr (Memd[dxref], xreftie, nref)
+	    call achtdr (Memd[dyref], yreftie, nref)
+	}
+
+	call sfree (sp)
+
+	return (nref)
+end
+
+
+# RG_PLINCOEFF -- Print the computed transformation on the standard output.
+
+procedure rg_plincoeff (xlabel, ylabel, xref, yref, xlist, ylist, ntie,
+	coeff, ncoeff)
+
+char	xlabel[ARB]		#I the x equation label
+char	ylabel[ARB]		#I the x equation label
+real	xref[ARB]		#I the input x reference coordinates
+real	yref[ARB]		#I the input  y reference coordinates
+real	xlist[ARB]		#I the input x input coordinates
+real	ylist[ARB]		#I the input y input coordinates
+int	ntie			#I number of tie points
+real	coeff[ARB]		#I the output coefficient array
+int	ncoeff			#I the number of coefficients
+
+int	i
+real	xmag, ymag, xrot, yrot
+
+begin
+	# List the tie points on the standard output.
+	if (ntie > 0) {
+	    do i = 1, ntie {
+	        call printf (
+	        "    tie point: %3d  ref: %9.3f %9.3f  input: %9.3f %9.3f\n")
+	            call pargi (i)
+		    call pargr (xref[i])
+		    call pargr (yref[i])
+		    call pargr (xlist[i])
+		    call pargr (ylist[i])
+	    }
+	    call printf ("\n")
+	}
+
+	# Print the transformation coefficients to the standard output.
+	call printf ("Initial linear transformation\n")
+	call printf ("    %4.4s[tie] = %10g + %10g * x[tie] + %10g * y[tie]\n")
+	    call pargstr (xlabel)
+	    call pargr (coeff[3])
+	    call pargr (coeff[1])
+	    call pargr (coeff[2])
+	call printf ("    %4.4s[tie] = %10g + %10g * x[tie] + %10g * y[tie]\n")
+	    call pargstr (ylabel)
+	    call pargr (coeff[6])
+	    call pargr (coeff[4])
+	    call pargr (coeff[5])
+	call rg_ctogeo (coeff[1], -coeff[2], -coeff[4], coeff[5], xmag, ymag,
+	    xrot, yrot)
+	call printf (
+	"    dx: %0.2f dy: %0.2f xmag: %0.3f ymag: %0.3f xrot: %0.1f yrot: %0.1f\n")
+	    call pargr (coeff[3])
+	    call pargr (coeff[6])
+	    call pargr (xmag)
+	    call pargr (ymag)
+	    call pargr (xrot)
+	    call pargr (yrot)
+	call printf ("\n")
+end
+
+
+# RG_PMLINCOEFF -- Print the computed transformation on the standard output.
+
+procedure rg_pmlincoeff (xlabel, ylabel, coeff, ncoeff)
+
+char	xlabel[ARB]		#I the x equation label
+char	ylabel[ARB]		#I the x equation label
+real	coeff[ARB]		#I the output coefficient array
+int	ncoeff			#I the number of coefficients
+
+real	xmag, ymag, xrot, yrot
+
+begin
+	# Write the matched transformation coefficients to the standard output.
+	call printf ("Matched triangles transformation\n")
+	call printf ("    %4.4s[tie] = %10g + %10g * x[tie] + %10g * y[tie]\n")
+	    call pargstr (xlabel)
+	    call pargr (coeff[3])
+	    call pargr (coeff[1])
+	    call pargr (coeff[2])
+	call printf ("    %4.4s[tie] = %10g + %10g * x[tie] + %10g * y[tie]\n")
+	    call pargstr (ylabel)
+	    call pargr (coeff[6])
+	    call pargr (coeff[4])
+	    call pargr (coeff[5])
+	call rg_ctogeo (coeff[1], -coeff[2], -coeff[4], coeff[5], xmag, ymag,
+	    xrot, yrot)
+	call printf (
+	"    dx: %0.2f dy: %0.2f xmag: %0.3f ymag: %0.3f xrot: %0.1f yrot: %0.1f\n")
+	    call pargr (coeff[3])
+	    call pargr (coeff[6])
+	    call pargr (xmag)
+	    call pargr (ymag)
+	    call pargr (xrot)
+	    call pargr (yrot)
+	call printf ("\n")
+end
+
+
+# RG_WLINCOEFF -- Write the computed transformation to the output file.
+
+procedure rg_wlincoeff (fd, xlabel, ylabel, xref, yref, xlist, ylist, ntie,
+	coeff, ncoeff)
+
+int	fd			#I pointer to the output file
+char	xlabel[ARB]		#I the x equation label
+char	ylabel[ARB]		#I the x equation label
+real	xref[ARB]		#I the input x reference coordinates
+real	yref[ARB]		#I the input  y reference coordinates
+real	xlist[ARB]		#I the input x input coordinates
+real	ylist[ARB]		#I the input y input coordinates
+int	ntie			#I number of tie points
+real	coeff[ARB]		#I the output coefficient array
+int	ncoeff			#I the number of coefficients
+
+int	i
+real	xmag, ymag, xrot, yrot
+
+begin
+	# List the tie points.
+	if (ntie > 0) {
+	    do i = 1, ntie {
+	        call fprintf (fd,
+	        "#     tie point: %3d  ref: %9.3f %9.3f  input: %9.3f %9.3f\n")
+	            call pargi (i)
+		    call pargr (xref[i])
+		    call pargr (yref[i])
+		    call pargr (xlist[i])
+		    call pargr (ylist[i])
+	    }
+	    call fprintf (fd, "#\n")
+	}
+
+	# Write the transformation coefficients to the output file.
+	call fprintf (fd, "# Initial linear transformation\n")
+	call fprintf (fd,
+	    "#     %4.4s[tie] = %10g + %10g * x[tie] + %10g * y[tie]\n")
+	    call pargstr (xlabel)
+	    call pargr (coeff[3])
+	    call pargr (coeff[1])
+	    call pargr (coeff[2])
+	call fprintf (fd,
+	    "#     %4.4s[tie] = %10g + %10g * x[tie] + %10g * y[tie]\n")
+	    call pargstr (ylabel)
+	    call pargr (coeff[6])
+	    call pargr (coeff[4])
+	    call pargr (coeff[5])
+	call rg_ctogeo (coeff[1], -coeff[2], -coeff[4], coeff[5], xmag, ymag,
+	    xrot, yrot)
+	call fprintf (fd,
+	"# dx: %0.2f dy: %0.2f xmag: %0.3f ymag: %0.3f xrot: %0.1f yrot: %0.1f\n")
+	    call pargr (coeff[3])
+	    call pargr (coeff[6])
+	    call pargr (xmag)
+	    call pargr (ymag)
+	    call pargr (xrot)
+	    call pargr (yrot)
+	call fprintf (fd, "#\n")
+end
+
+
+# RG_WMLINCOEFF -- Print the computed transformation on the standard output.
+
+procedure rg_wmlincoeff (ofd, xlabel, ylabel, coeff, ncoeff)
+
+int	ofd			#I the output file descriptor
+char	xlabel[ARB]		#I the x equation label
+char	ylabel[ARB]		#I the x equation label
+real	coeff[ARB]		#I the output coefficient array
+int	ncoeff			#I the number of coefficients
+
+real	xmag, ymag, xrot, yrot
+
+begin
+	# Write the matched transformation coefficients to the output file.
+	call fprintf (ofd, "# Matched triangles transformation\n")
+	call fprintf (ofd,
+	    "#     %4.4s[tie] = %10g + %10g * x[tie] + %10g * y[tie]\n")
+	    call pargstr (xlabel)
+	    call pargr (coeff[3])
+	    call pargr (coeff[1])
+	    call pargr (coeff[2])
+	call fprintf (ofd,
+	    "#     %4.4s[tie] = %10g + %10g * x[tie] + %10g * y[tie]\n")
+	    call pargstr (ylabel)
+	    call pargr (coeff[6])
+	    call pargr (coeff[4])
+	    call pargr (coeff[5])
+	call rg_ctogeo (coeff[1], -coeff[2], -coeff[4], coeff[5], xmag, ymag,
+	    xrot, yrot)
+	call fprintf (ofd,
+	"# dx: %0.2f dy: %0.2f xmag: %0.3f ymag: %0.3f xrot: %0.1f yrot: %0.1f\n")
+	    call pargr (coeff[3])
+	    call pargr (coeff[6])
+	    call pargr (xmag)
+	    call pargr (ymag)
+	    call pargr (xrot)
+	    call pargr (yrot)
+	call fprintf (ofd, "#\n")
+end
+
+
+# RG_LINCOEFF -- Compute the transformation given one to three tie points.
+
+int procedure rg_lincoeff (xref, yref, xlist, ylist, ntie, coeff, ncoeff)
+
+real	xref[ARB]		#I the input x reference coordinates
+real	yref[ARB]		#I the input  y reference coordinates
+real	xlist[ARB]		#I the input x input coordinates
+real	ylist[ARB]		#I the input y input coordinates
+int	ntie			#I number of tie points
+real	coeff[ARB]		#O the output coefficient array
+int	ncoeff			#I the number of coefficients
+
+int	ier, xier, yier, nfcoeff
+pointer	sp, wts, fcoeff, sx, sy
+real	xmin, xmax, ymin, ymax
+int	rg_onestar(), rg_twostar(), rg_threestar()
+
+begin
+	switch (ntie) {
+	case 0:
+	    ier = ERR
+	case 1:
+	    ier = rg_onestar (xref, yref, xlist, ylist, ntie, coeff, ncoeff)
+	case 2:
+	    ier = rg_twostar (xref, yref, xlist, ylist, ntie, coeff, ncoeff)
+	case 3:
+	    ier = rg_threestar (xref, yref, xlist, ylist, ntie,
+	        coeff, ncoeff)
+	default:
+	    call smark (sp)
+	    call salloc (fcoeff, 3, TY_REAL)
+	    call salloc (wts, ntie, TY_REAL)
+	    call alimr (xlist, ntie, xmin, xmax)
+	    call alimr (ylist, ntie, ymin, ymax)
+	    call gsinit (sx, GS_POLYNOMIAL, 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call gsinit (sy, GS_POLYNOMIAL, 2, 2, GS_XNONE, xmin, xmax,
+	        ymin, ymax)
+	    call amovkr (1.0, Memr[wts], ntie)
+	    call gsfit (sx, xlist, ylist, xref, Memr[wts], ntie, WTS_UNIFORM,
+		xier)
+	    call gsfit (sy, xlist, ylist, yref, Memr[wts], ntie, WTS_UNIFORM,
+		yier)
+	    if (xier == OK && xier == OK) {
+	        call gscoeff (sx, Memr[fcoeff], nfcoeff)
+		coeff[3] = Memr[fcoeff]
+		coeff[1] = Memr[fcoeff+1]
+		coeff[2] = Memr[fcoeff+2]
+	        call gscoeff (sy, Memr[fcoeff], nfcoeff)
+		coeff[6] = Memr[fcoeff]
+		coeff[4] = Memr[fcoeff+1]
+		coeff[5] = Memr[fcoeff+2]
+		ier = OK
+	    } else
+		ier = ERR
+	    call gsfree (sx)
+	    call gsfree (sy)
+	    call sfree (sp)
+	}
+
+	return (ier)
+end
+
+
+# RG_COMPUTE -- Transform the input list coordinates. The transformation
+# may be done in place.
+
+procedure rg_compute (xlist, ylist, xtrans, ytrans, nstars, coeff, ncoeff)
+
+real	xlist[ARB]		#I the input x coordinates
+real	ylist[ARB]		#I the input y coordinates
+real	xtrans[ARB]		#O the output x transformed coordinates
+real	ytrans[ARB]		#O the output y transformed coordinates
+int	nstars			#I the number of points
+real	coeff[ARB]		#I the input coefficient array
+int	ncoeff			#I the number of coefficients
+
+int	i
+real	xval, yval
+
+begin
+	do i = 1, nstars {
+	    xval = xlist[i]
+	    yval = ylist[i]
+	    xtrans[i] = coeff[1] * xval + coeff[2] * yval + coeff[3]
+	    ytrans[i] = coeff[4] * xval + coeff[5] * yval + coeff[6]
+	}
+end
+
+
+# RG_INTERSECT -- Compute the intersection of two sorted lists given a
+# matching tolerance.
+
+int procedure rg_intersection (ofd, xref, yref, refindex, rlineno, nrefstars,
+	xlist, ylist, xtrans, ytrans, listindex, ilineno, nliststars,
+	tolerance, xformat, yformat)
+
+int	ofd			#I the output file descriptor
+real	xref[ARB]		#I the input x reference coordinates
+real	yref[ARB]		#I the input y reference coordinates
+int	refindex[ARB]		#I the input reference coordinates sort index
+int	rlineno[ARB]		#I the input reference coordinate line numbers
+int	nrefstars		#I the number of reference stars
+real	xlist[ARB]		#I the input x list coordinates
+real	ylist[ARB]		#I the input y list coordinates
+real	xtrans[ARB]		#I the input x transformed list coordinates
+real	ytrans[ARB]		#I the input y transformed list coordinates
+int	listindex[ARB]		#I the input list sort index
+int	ilineno[ARB]		#I the input input line numbers
+int	nliststars		#I the number of input stars
+real	tolerance		#I the matching tolerance
+char	xformat[ARB]		#I the output x coordinate format
+char	yformat[ARB]		#I the output y coordinate format
+
+int	blp, rp, rindex, lp, lindex, rmatch, lmatch, ninter
+pointer	sp, fmtstr
+real	dx, dy, tol2, rmax2, r2
+
+begin
+	call smark (sp)
+	call salloc (fmtstr, SZ_LINE, TY_CHAR)
+
+	# Construct the fromat string
+	call sprintf (Memc[fmtstr], SZ_LINE, "%s %s  %s %s  %%5d %%5d\n")
+	if (xformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (xformat)
+	if (yformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (yformat)
+	if (xformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (xformat)
+	if (yformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (yformat)
+
+	# Initialize the intersection routine.
+	tol2 = tolerance ** 2
+	blp = 1
+	ninter = 0
+
+	# Loop over the reference list stars.
+	for (rp = 1; rp <= nrefstars; rp = rp + 1)  {
+
+	    # Get the index of the reference star in question.
+	    rindex = refindex[rp]
+
+	    # Compute the start of the search range.
+	    for (; blp <= nliststars; blp = blp + 1) {
+		lindex = listindex[blp]
+	        dy = yref[rindex] - ytrans[lindex]
+		if (dy < tolerance)
+		    break
+	    }
+
+	    # Break if the end of the input list is reached.
+	    if (blp > nliststars)
+		break
+
+	    # If one is outside the tolerance limits skip to next reference
+	    # object.
+	    if (dy < -tolerance)
+		next
+
+	    # Find the closest match to the reference object.
+	    rmax2  = tol2
+	    rmatch = 0
+	    lmatch = 0
+	    for (lp = blp; lp <= nliststars; lp = lp + 1) {
+
+		# Compute the distance between the two points.
+		lindex = listindex[lp]
+		dy = yref[rindex] - ytrans[lindex]
+	        if (dy < -tolerance)
+		    break
+	        dx = xref[rindex] - xtrans[lindex]
+	        r2 = dx ** 2 + dy ** 2
+
+	        # A match has been found.
+	        if (r2 <= rmax2) {
+		    rmax2 = r2
+		    rmatch = rindex
+		    lmatch = lindex
+	        }
+	    }
+
+	    # A match was found so write the results to the output file.
+	    if (rmatch > 0 && lmatch > 0) {
+		ninter = ninter + 1
+		call fprintf (ofd, Memc[fmtstr])
+		    call pargr (xref[rmatch])
+		    call pargr (yref[rmatch])
+		    call pargr (xlist[lmatch])
+		    call pargr (ylist[lmatch])
+		    call pargi (rlineno[rmatch])
+		    call pargi (ilineno[lmatch])
+	    }
+	}
+
+	call sfree (sp)
+
+	return (ninter)
+end
+
+
+# RG_LLINTERSECT -- Compute the intersection of two sorted lists given a
+# matching tolerance.
+
+int procedure rg_llintersect (ofd, lngref, latref, xref, yref, refindex,
+        rlineno, nrefstars, xlist, ylist, xtrans, ytrans, listindex, ilineno,
+	nliststars, tolerance, lngformat, latformat, xformat, yformat)
+
+int	ofd			#I the output file descriptor
+double	lngref[ARB]		#I the input ra/longitude reference coordinates
+double	latref[ARB]		#I the input dec/latitude reference coordinates
+real	xref[ARB]		#I the input x reference coordinates
+real	yref[ARB]		#I the input y reference coordinates
+int	refindex[ARB]		#I the input reference coordinates sort index
+int	rlineno[ARB]		#I the input reference coordinate line numbers
+int	nrefstars		#I the number of reference stars
+real	xlist[ARB]		#I the input x list coordinates
+real	ylist[ARB]		#I the input y list coordinates
+real	xtrans[ARB]		#I the input x transformed list coordinates
+real	ytrans[ARB]		#I the input y transformed list coordinates
+int	listindex[ARB]		#I the input list sort index
+int	ilineno[ARB]		#I the input input line numbers
+int	nliststars		#I the number of input stars
+real	tolerance		#I the matching tolerance
+char	lngformat[ARB]		#I the output ra / longitude coordinate format
+char	latformat[ARB]		#I the output dec / latitude coordinate format
+char	xformat[ARB]		#I the output x coordinate format
+char	yformat[ARB]		#I the output y coordinate format
+
+int	blp, rp, rindex, lp, lindex, rmatch, lmatch, ninter
+pointer	sp, fmtstr
+real	dx, dy, tol2, rmax2, r2
+
+begin
+	call smark (sp)
+	call salloc (fmtstr, SZ_LINE, TY_CHAR)
+
+	# Construct the fromat string
+	call sprintf (Memc[fmtstr], SZ_LINE, "%s %s  %s %s  %%5d %%5d\n")
+	if (lngformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (lngformat)
+	if (latformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (latformat)
+	if (xformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (xformat)
+	if (yformat[1] == EOS)
+	    call pargstr ("%13.7g")
+	else
+	    call pargstr (yformat)
+
+	# Initialize the intersection routine.
+	tol2 = tolerance ** 2
+	blp = 1
+	ninter = 0
+
+	# Loop over the reference list stars.
+	for (rp = 1; rp <= nrefstars; rp = rp + 1)  {
+
+	    # Get the index of the reference star in question.
+	    rindex = refindex[rp]
+
+	    # Compute the start of the search range.
+	    for (; blp <= nliststars; blp = blp + 1) {
+		lindex = listindex[blp]
+	        dy = yref[rindex] - ytrans[lindex]
+		if (dy < tolerance)
+		    break
+	    }
+
+	    # Break if the end of the input list is reached.
+	    if (blp > nliststars)
+		break
+
+	    # If one is outside the tolerance limits skip to next reference
+	    # object.
+	    if (dy < -tolerance)
+		next
+
+	    # Find the closest match to the reference object.
+	    rmax2  = tol2
+	    rmatch = 0
+	    lmatch = 0
+	    for (lp = blp; lp <= nliststars; lp = lp + 1) {
+
+		# Compute the distance between the two points.
+		lindex = listindex[lp]
+		dy = yref[rindex] - ytrans[lindex]
+	        if (dy < -tolerance)
+		    break
+	        dx = xref[rindex] - xtrans[lindex]
+	        r2 = dx ** 2 + dy ** 2
+
+	        # A match has been found.
+	        if (r2 <= rmax2) {
+		    rmax2 = r2
+		    rmatch = rindex
+		    lmatch = lindex
+	        }
+	    }
+
+	    # A match was found so write the results to the output file.
+	    if (rmatch > 0 && lmatch > 0) {
+		ninter = ninter + 1
+		call fprintf (ofd, Memc[fmtstr])
+		    call pargd (lngref[rmatch])
+		    call pargd (latref[rmatch])
+		    call pargr (xlist[lmatch])
+		    call pargr (ylist[lmatch])
+		    call pargi (rlineno[rmatch])
+		    call pargi (ilineno[lmatch])
+	    }
+	}
+
+	call sfree (sp)
+
+	return (ninter)
+end
+
+
+# RG_LMKCOEFF -- Given the geometry of a linear transformation compute
+# the coefficients required to tranform from the input to the reference
+# system.
+
+procedure rg_lmkcoeff (xin, yin, xmag, ymag, xrot, yrot, xout, yout,
+	coeff, ncoeff)
+
+real	xin, yin		#I the origin of the input coordinates
+real	xmag, ymag		#I the input x and y scale factors
+real	xrot, yrot		#I the iput x and y rotation factors
+real	xout, yout		#I the origin of the reference coordinates
+real	coeff[ARB]		#O the output coefficient array
+int	ncoeff			#I the  number of coefficients
+
+begin
+	# Compute the x fit coefficients.
+	coeff[1] = xmag * cos (DEGTORAD(xrot))
+	coeff[2] = -ymag * sin (DEGTORAD(yrot))
+	coeff[3] = xout - coeff[1] * xin - coeff[2] * yin
+
+	# Compute the y fit coefficients.
+	coeff[4] = xmag * sin (DEGTORAD(xrot))
+	coeff[5] = ymag * cos (DEGTORAD(yrot))
+	coeff[6] = yout - coeff[4] * xin - coeff[5] * yin
+end
+
+
+# RG_ONESTAR -- Compute the transformation coefficients for a simple
+# shift operation.
+
+int procedure rg_onestar (xref, yref, xlist, ylist, ntie, coeff, ncoeff)
+
+real	xref[ARB]		#I the input x reference coordinates
+real	yref[ARB]		#I the input y reference coordinates
+real	xlist[ARB]		#I the input x list coordinates
+real	ylist[ARB]		#I the input y list coordinates
+int	ntie			#I the number of tie points
+real	coeff[ARB]		#O the output coefficient array
+int	ncoeff			#I the  number of coefficients
+
+begin
+	# Compute the x transformation.
+	coeff[1] = 1.0
+	coeff[2] = 0.0
+	coeff[3] = xref[1] - xlist[1]
+
+	# Compute the y transformation.
+	coeff[4] = 0.0
+	coeff[5] = 1.0
+	coeff[6] = yref[1] - ylist[1]
+
+	return (OK)
+end
+
+
+# RG_TWOSTAR -- Compute the transformation coefficients of a simple shift,
+# magnification, and rotation.
+
+int procedure rg_twostar (xref, yref, xlist, ylist, ntie, coeff, ncoeff)
+
+real	xref[ARB]		#I the input x reference coordinates
+real	yref[ARB]		#I the input y reference coordinates
+real	xlist[ARB]		#I the input x list coordinates
+real	ylist[ARB]		#I the input y list coordinates
+int	ntie			#I the number of tie points
+real	coeff[ARB]		#O the output coefficient array
+int	ncoeff			#I the number of coefficients
+
+real	rot, mag, dxlis, dylis, dxref, dyref, cosrot, sinrot
+real	rg_posangle()
+
+begin
+	# Compute the deltas.
+	dxlis = xlist[2] - xlist[1]
+	dylis = ylist[2] - ylist[1]
+	dxref = xref[2] - xref[1]
+	dyref = yref[2] - yref[1]
+
+	# Compute the rotation angle.
+	rot = rg_posangle (dxref, dyref) - rg_posangle (dxlis, dylis)
+	cosrot = cos (rot)
+	sinrot = sin (rot)
+
+	# Compute the magnification factor.
+	mag = dxlis ** 2 + dylis ** 2
+	if (mag <= 0.0)
+	    mag = 0.0
+	else
+	    mag = sqrt ((dxref ** 2 + dyref ** 2) / mag)
+
+	# Compute the transformation coefficicents.
+	coeff[1] = mag * cosrot
+	coeff[2] = - mag * sinrot
+	coeff[3] = xref[1] - mag * cosrot * xlist[1] + mag * sinrot * ylist[1]
+	coeff[4] = mag * sinrot
+	coeff[5] = mag * cosrot
+	coeff[6] = yref[1] - mag * sinrot * xlist[1] - mag * cosrot * ylist[1]
+
+	return (OK)
+end
+
+
+# RG_THREESTAR -- Compute the transformation coefficients using a simple
+# shift, magnification in x and y, rotation, and skew.
+
+int procedure rg_threestar (xref, yref, xlist, ylist, ntie, coeff, ncoeff)
+
+real	xref[ARB]		#I the input x reference coordinates
+real	yref[ARB]		#I the input y reference coordinates
+real	xlist[ARB]		#I the input x list coordinates
+real	ylist[ARB]		#I the input y list coordinates
+int	ntie			#I the number of tie points
+real	coeff[ARB]		#O the output coefficient array
+int	ncoeff			#I the number of coefficients
+
+real	dx23, dx13, dx12, dy23, dy13, dy12, det
+bool	fp_equalr()
+int	rg_twostar()
+
+begin
+	# Compute the deltas.
+	dx23 = xlist[2] - xlist[3]
+	dx13 = xlist[1] - xlist[3]
+	dx12 = xlist[1] - xlist[2]
+	dy23 = ylist[2] - ylist[3]
+	dy13 = ylist[1] - ylist[3]
+	dy12 = ylist[1] - ylist[2]
+
+	# Compute the determinant.
+	det = xlist[1] * dy23 - xlist[2] * dy13 + xlist[3] * dy12
+	if (fp_equalr (det, 0.0))
+	    return (rg_twostar (xref, yref, xlist, ylist, ntie,
+	        coeff, ncoeff))
+
+	# Compute the x transformation.
+	coeff[1] = (xref[1] * dy23 - xref[2] * dy13 + xref[3] * dy12) / det
+	coeff[2] = (-xref[1] * dx23 + xref[2] * dx13 - xref[3] * dx12) / det
+	coeff[3] = (xref[1] * (xlist[2] * ylist[3] - xlist[3] * ylist[2]) +
+	    xref[2] * (ylist[1] * xlist[3] - xlist[1] * ylist[3]) +
+	    xref[3] * (xlist[1] * ylist[2] - ylist[1] * xlist[2])) / det
+
+	# Compute the y transformation.
+	coeff[4] = (yref[1] * dy23 - yref[2] * dy13 + yref[3] * dy12) / det
+	coeff[5] = (-yref[1] * dx23 + yref[2] * dx13 - yref[3] * dx12) / det
+	coeff[6] = (yref[1] * (xlist[2] * ylist[3] - xlist[3] * ylist[2]) +
+	    yref[2] * (ylist[1] * xlist[3] - xlist[1] * ylist[3]) +
+	    yref[3] * (xlist[1] * ylist[2] - ylist[1] * xlist[2])) / det
+
+	return (OK)
+end
+
+
+# RG_POSANGLE -- Compute the position angle of a 2D vector. The angle is
+# measured counter-clockwise from the positive x axis.
+
+real procedure rg_posangle (x, y)
+
+real	x		#I the x vector component
+real	y		#I the y vector component
+
+real	theta
+bool	fp_equalr()
+
+begin
+	if (fp_equalr (y, 0.0)) {		# 0-valued y component
+	    if (x > 0.0)
+		theta = 0.0
+	    else if (x < 0.0)
+		theta = PI
+	    else
+		theta = 0.0
+	} else if (fp_equalr (x, 0.0)) {	# 0-valued x component
+	    if (y > 0.0)
+		theta = PI / 2.0
+	    else if (y < 0.0)
+		theta = 3.0 * PI / 2.0
+	    else
+		theta = 0.0
+	} else if (x > 0.0 && y > 0.0) {	# 1st quadrant
+	    theta = atan (y / x)
+	} else if (x > 0.0 && y < 0.0) {	# 4th quadrant
+	    theta = 2.0 * PI + atan (y / x)
+	} else if (x < 0.0 && y > 0.0) {	# 2nd quadrant
+	    theta = PI + atan (y / x)
+	} else if (x < 0.0 && y < 0.0) {	# 3rd quadrant
+	    theta = PI + atan (y / x)
+	}
+
+	return (theta)
+end
+
+
+# RG_CTOGEO -- Transform the linear transformation coefficients to useful
+# geometric parameters.
+
+procedure rg_ctogeo (a, b, c, d, xscale, yscale, xrot, yrot)
+
+real	a		#I the x coefficient of the x coordinate fit
+real	b		#I the y coefficient of the x coordinate fit
+real	c		#I the x coefficient of the y coordinate fit
+real	d		#I the y coefficient of the y coordinate fit
+real	xscale		#I output x scale
+real	yscale		#I output y scale
+real	xrot		#I rotation of point on x axis
+real	yrot		#I rotation of point on y axis
+
+bool	fp_equalr()
+
+begin
+	xscale = sqrt (a * a + c * c)
+	yscale = sqrt (b * b + d * d)
+
+	# Get the x and y axes rotation factors.
+        if (fp_equalr (a, 0.0) && fp_equalr (c, 0.0))
+            xrot = 0.0
+        else
+            xrot = RADTODEG (atan2 (-c, a))
+        if (xrot < 0.0)
+            xrot = xrot + 360.0
+
+        if (fp_equalr (b, 0.0) && fp_equalr (d, 0.0))
+            yrot = 0.0
+        else
+            yrot = RADTODEG (atan2 (b, d))
+        if (yrot < 0.0)
+            yrot = yrot + 360.0
+end
diff --git a/pkg/images/lib/rgwrdstr.x b/pkg/images/lib/rgwrdstr.x
new file mode 100644
index 00000000..5c3cee28
--- /dev/null
+++ b/pkg/images/lib/rgwrdstr.x
@@ -0,0 +1,53 @@
+
+# RG_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 rg_wrdstr (index, outstr, maxch, dict)
+
+int	index			#I String index
+char	outstr[ARB]		#O Output string as found in dictionary
+int	maxch			#I Maximum length of output string
+char	dict[ARB]		#IDictionary string
+
+int	i, len, start, count
+
+int	strlen()
+
+begin
+	# Clear the output string.
+	outstr[1] = EOS
+
+	# Return if the dictionary is not long enough.
+	if (dict[1] == EOS)
+	    return (0)
+
+	# Initialize the 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/images/lib/rgxymatch.x b/pkg/images/lib/rgxymatch.x
new file mode 100644
index 00000000..3b2b45cb
--- /dev/null
+++ b/pkg/images/lib/rgxymatch.x
@@ -0,0 +1,97 @@
+include <mwset.h>
+
+# RG_RXYL -- Compute the grid of logical coordinates.
+
+procedure rg_rxyl (xl, yl, nx, ny, x1, x2, y1, y2)
+
+double	xl[ARB]			#O array of output x coordinates
+double	yl[ARB]			#O array of output y coordinates
+int	nx			#I the size of the grid in x
+int	ny			#I the size of the grid in y
+double	x1			#I the lower limit of the grid in x
+double	x2			#I the upper limit of the grid in x
+double	y1			#I the lower limit of the grid in y
+double	y2			#I the upper limit of the grid in y
+
+double	xstep, ystep, x, y
+int	i, j, npts
+
+begin
+	if (nx == 1)
+	    xstep = 0.0d0
+	else
+	    xstep = (x2 - x1) / (nx - 1)
+	if (ny == 1)
+	    ystep = 0.0d0
+	else
+	    ystep = (y2 - y1) / (ny - 1)
+	npts = 0
+
+	y = y1
+	do j = 1, ny {
+	    x = x1
+	    do i = 1, nx {
+		npts = npts + 1
+		xl[npts] = x
+		yl[npts] = y
+		x = x + xstep
+	    }
+	    y = y + ystep
+	}
+end
+
+
+# RG_XYTOXY -- Compute the world coordinate list give the wcs descriptor
+# and the logical coordinates.
+
+pointer procedure rg_xytoxy (mw, xl, yl, xw, yw, npts, inwcs, outwcs, ax1, ax2)
+
+pointer	mw			#I the wcs descriptor
+double	xl[ARB]			#I the input logical x coordinate
+double	yl[ARB]			#I the input logical y coordinate
+double	xw[ARB]			#O the output world x coordinate
+double	yw[ARB]			#O the output world y coordinate
+int	npts			#I the number of coordinates.
+char	inwcs[ARB]		#I the input wcs
+char	outwcs[ARB]		#I the output wcs
+int	ax1			#I the logical x axis
+int	ax2			#I the logical y axis
+
+int	i, axbits
+pointer	ct
+double	mw_c1trand()
+int	mw_stati()
+pointer	mw_sctran()
+errchk	mw_sctran()
+
+begin
+	# Compile the transformation.
+	if (mw == NULL) {
+	    ct = NULL
+	} else if (mw_stati (mw, MW_NDIM) >= 2) {
+	    axbits = 2 ** (ax1 - 1) + 2 ** (ax2 - 1)
+	    iferr (ct = mw_sctran (mw, inwcs, outwcs, axbits))
+	        ct = NULL
+	} else {
+	    axbits = 2 ** (ax1 - 1)
+	    iferr (ct = mw_sctran (mw, inwcs, outwcs, axbits))
+	        ct = NULL
+	}
+
+	# Compute the world coordinates.
+	if (ct == NULL) {
+	    call amovd (xl, xw, npts)
+	    call amovd (yl, yw, npts)
+	} else if (mw_stati (mw, MW_NDIM) == 2) {
+	    do i = 1, npts
+		call mw_c2trand (ct, xl[i], yl[i], xw[i], yw[i])
+	} else {
+	    do i = 1, npts {
+		xw[i] = mw_c1trand (ct, xl[i])
+		yw[i] = yl[i]
+	    }
+	}
+
+	return (ct)
+end
+
diff --git a/pkg/images/lib/xymatch.x b/pkg/images/lib/xymatch.x
new file mode 100644
index 00000000..96907578
--- /dev/null
+++ b/pkg/images/lib/xymatch.x
@@ -0,0 +1,175 @@
+include "xyxymatch.h"
+
+# RG_RDXYI -- Read in the x and y coordinates from a file and set the
+# line number index.
+
+int procedure rg_rdxyi (fd, x, y, lineno, xcolumn, ycolumn)
+
+int	fd			#I the input file descriptor
+pointer	x			#U pointer to the x coordinates
+pointer	y			#U pointer to the y coordinates
+pointer	lineno			#U pointer to the line numbers
+int	xcolumn			#I column containing the x coordinate
+int	ycolumn			#I column containing the y coordinate
+
+int	i, ip, bufsize, npts, lnpts, maxcols
+pointer	sp, str
+real	xval, yval
+int	fscan(), nscan(), ctor()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	bufsize = DEF_BUFSIZE
+	call malloc (x, bufsize, TY_REAL)
+	call malloc (y, bufsize, TY_REAL)
+	call malloc (lineno, bufsize, TY_INT)
+	maxcols = max (xcolumn, ycolumn)
+
+	npts = 0
+	lnpts = 0
+	while (fscan(fd) != EOF) {
+
+	    lnpts = lnpts + 1
+	    xval = INDEFR
+	    yval = INDEFR
+	    do i = 1, maxcols {
+		call gargwrd (Memc[str], SZ_LINE)
+		if (i != nscan())
+		    break
+		ip = 1
+		if (i == xcolumn) {
+		    if (ctor (Memc[str], ip, xval) <= 0)
+			xval = INDEFR
+		} else if (i == ycolumn) {
+		    if (ctor (Memc[str], ip, yval) <= 0)
+			yval = INDEFR
+		}
+	    }
+	    if (IS_INDEFR(xval) || IS_INDEFR(yval))
+		next
+
+	    Memr[x+npts] = xval
+	    Memr[y+npts] = yval
+	    Memi[lineno+npts] = lnpts
+	    npts = npts + 1
+	    if (npts >= bufsize) {
+		bufsize = bufsize + DEF_BUFSIZE
+		call realloc (x, bufsize, TY_REAL)
+		call realloc (y, bufsize, TY_REAL)
+		call realloc (lineno, bufsize, TY_INT)
+	    }
+	}
+
+	call sfree (sp)
+
+	return (npts)
+end
+
+
+# RG_SORT --  If the coordinates are not already sorted, sort the coordinates
+# first in y then in x. Remove points which are close together than a given
+# tolerance, if the coincident point remove flag is on.
+
+int procedure rg_sort (xcoord, ycoord, rsindex, npts, tolerance, sort, coincid)
+
+real	xcoord[ARB]		#I pointer to the x coordinates
+real	ycoord[ARB]		#I pointer to the y coordinates
+int	rsindex[ARB]		#I pointer to sort index
+int	npts			#I the number of objects
+real	tolerance		#I coincidence tolerance in pixels
+int	sort			#I sort the pixels ?
+int	coincid			#I remove coincident points
+
+int	i, ndif
+int	rg_xycoincide()
+
+begin
+	# Initialize the sort index.
+	do i = 1, npts
+	    rsindex[i] = i
+
+	# Sort the pixels in y and then x if the arrays are unsorted.
+	if (sort == YES) {
+	    call rg_qsortr (ycoord, rsindex, rsindex, npts)
+	    call rg_sqsort (xcoord, ycoord, rsindex, rsindex, npts)
+	}
+
+	# Remove objects that are closer together than tolerance.
+	if (coincid == NO)
+	    ndif = npts
+	else
+	    ndif = rg_xycoincide (xcoord, ycoord, rsindex, rsindex, npts,
+	        tolerance)
+
+	return (ndif)
+end
+
+
+# RG_XYCOINCIDE -- Remove points from a list which are closer together than
+# a specified tolerance. The arrays are assumed to be sorted first in y then
+# in x.
+
+int procedure rg_xycoincide (xcoord, ycoord, a, b, npts, tolerance)
+
+real	xcoord[ARB]		#I the input x coordinate values
+real	ycoord[ARB]		#I the input y coordinate values
+int	a[ARB]			#I the input sort index
+int	b[ARB]			#O the output sort index
+int	npts			#I the  number of points
+real	tolerance		#I the coincidence tolerace
+
+int	iprev, i, nunique
+real	tol2, r2
+
+begin
+	tol2 = tolerance ** 2
+	nunique = npts
+
+	iprev = 1
+	repeat {
+
+	    do i = iprev + 1, npts {
+
+		# Jump to the next object if this one has been deleted
+		# since all comparisons are then invalid.
+		if (a[iprev] == 0)
+		    break
+
+		# Skip to the next object if this one has been deleted.
+		if (a[i] == 0)
+		    next
+
+	        # Check the tolerance limit in y and step to the next object
+	        # if the bounds are exceeded.
+	        r2 = (ycoord[a[i]] - ycoord[a[iprev]]) ** 2
+	        if (r2 > tol2)
+		    break
+
+	        # Check the tolerance limit.
+	        r2 = r2 + (xcoord[a[i]] - xcoord[a[iprev]]) ** 2
+	        if (r2 <= tol2) {
+		    a[i] = 0
+		    nunique = nunique - 1
+	        }
+	    }
+
+	    iprev = iprev + 1
+
+	} until (iprev >= npts)
+
+	# Reorder the index array.
+	if (nunique < npts) {
+	    iprev = 0
+	    do i = 1, npts {
+		if (a[i] != 0) {
+		    iprev = iprev + 1
+		    b[iprev] = a[i]
+		}
+	    }
+	}
+
+	return (nunique)
+end
+
diff --git a/pkg/images/lib/xyxymatch.h b/pkg/images/lib/xyxymatch.h
new file mode 100644
index 00000000..50e44e74
--- /dev/null
+++ b/pkg/images/lib/xyxymatch.h
@@ -0,0 +1,35 @@
+# The definitions file for the LINXYMATCH task
+
+# Define the matching algorithms
+
+define	RG_MATCHSTR	"|tolerance|triangles|"
+define	RG_TOLERANCE	1	# Match by tolerance only
+define	RG_TRIANGLES	2	# Match by triangles
+
+# Define the reference and input files types
+
+define	RG_REFFILE	1	# The input reference coordinate file
+define	RG_INFILE	2	# The input coordinate file
+
+# Define some useful constants
+
+define	MAX_NTIE	3	# Maximum number of tie points
+define	MAX_NCOEFF	6       # Maximum number of coefficients
+define	DEF_BUFSIZE	1000	# The default buffer size
+define	SZ_TRIINDEX	6	# Number of triangle indices to save.
+define	SZ_TRIPAR	5	# Number of triangle parameters
+
+# Define the structure of the internal arrays used by the trangles algorithm
+
+define	RG_INDEX	1	# Sort index
+define	RG_X1		2	# Vertex 1
+define	RG_X2		3	# Vertex 2
+define	RG_X3		4	# Vertex 3
+define	RG_CC		5	# Counterclockwise ?
+define	RG_MATCH	6	# Match index
+
+define	RG_LOGP		1	# Log of the perimeter
+define	RG_RATIO	2	# Ratio of longest to shortest side
+define	RG_COS1		3	# Cos of angle at vertex 1
+define	RG_TOLR		4	# Tolerance in the ratio
+define	RG_TOLC		5	# Tolerance in the cosine
diff --git a/pkg/images/lib/zzdebug.x b/pkg/images/lib/zzdebug.x
new file mode 100644
index 00000000..d80be43f
--- /dev/null
+++ b/pkg/images/lib/zzdebug.x
@@ -0,0 +1,430 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+
+# Simples IMIO test routines.
+
+task	mkimage		= t_mkimage,
+	mktest		= t_mktest,
+	cube		= t_cube,
+	maxmin		= t_maxmin,
+	gsubras		= t_gsubras,
+	dump		= t_dump
+
+
+include	<imhdr.h>
+include	<printf.h>
+include	<ctype.h>
+include	<mach.h>
+
+
+define	NTYPES		7
+
+# MKIMAGE -- Make a new two dimensional image of a specified size
+# and datatype.  The image pixels are all set to zero.
+
+procedure t_mkimage()
+
+int	dtype
+real	pixval
+int	ncols, nlines
+char	imname[SZ_FNAME]
+char	title[SZ_LINE]
+short	ty_code[NTYPES]
+
+real	clgetr()
+char	clgetc(), ch
+int	clgeti(), stridx()
+
+string	types "usilrdx"			# Supported pixfile datatypes
+data	ty_code /TY_USHORT, TY_SHORT, TY_INT, TY_LONG, TY_REAL,
+	TY_DOUBLE, TY_COMPLEX/
+begin
+	call clgstr ("image", imname, SZ_FNAME)
+	ncols  = clgeti ("ncols")
+	nlines = clgeti ("nlines")
+	ch = clgetc ("datatype")
+	dtype  = ty_code[stridx(ch,types)]
+	pixval = clgetr ("pixval")
+	call clgstr ("title", title, SZ_LINE)
+
+	call immake2 (imname, ncols, nlines, dtype, pixval, title)
+end
+
+
+# IMMAKE2 -- Make a two dimensional image of datatype [usilr] with all pixels
+# set to the given value.
+
+procedure immake2 (imname, ncols, nlines, dtype, pixval, title)
+
+char	imname[ARB]		# name of new image
+int	ncols, nlines		# image size
+int	dtype			# datatype
+real	pixval			# constant pixel value
+char	title[ARB]		# image title
+
+int	i
+pointer	im, buf
+pointer	immap(), impl2r()
+
+begin
+	im = immap (imname, NEW_IMAGE, 0)
+
+	IM_PIXTYPE(im) = dtype
+	IM_LEN(im,1)   = ncols
+	IM_LEN(im,2)   = nlines
+	call strcpy (title, IM_TITLE(im), SZ_IMTITLE)
+
+	# Write out the lines.
+
+	do i = 1, nlines {
+	    buf = impl2r (im, i)
+	    call amovkr (pixval, Memr[buf], ncols)
+	}
+
+	call imunmap (im)
+end
+
+
+# MKTEST -- Make a test image.
+
+procedure t_mktest()
+
+char	imname[SZ_FNAME]
+int	ndim, dim[IM_MAXDIM]
+int	i, j, k, scalar
+long	offset
+int	clgeti(), nscan(), clscan(), stridx()
+pointer	buf, im, immap(), impl3l()
+
+int	dtype
+string	types "usilrdx"			# Supported pixfile datatypes
+char	ty_code[7], clgetc()
+data	ty_code /TY_USHORT, TY_SHORT, TY_INT, TY_LONG, TY_REAL,
+	TY_DOUBLE, TY_COMPLEX, EOS/
+
+begin
+	call clgstr ("image_name", imname, SZ_FNAME)
+	dtype = ty_code[stridx (clgetc ("datatype"), types)]
+	ndim = clgeti ("ndim")
+
+	call amovki (1, dim, 3)
+	if (clscan ("axis_lengths") != EOF) {
+	    do i = 1, ndim
+		call gargi (dim[i])
+	    if (nscan() < ndim)
+		call error (1, "Insufficient dimensions")
+	}
+
+	im = immap (imname, NEW_IMAGE, 0)
+
+	IM_PIXTYPE(im) = dtype
+	do i = 1, ndim
+	    IM_LEN(im,i) = dim[i]
+
+	do k = 1, dim[3]
+	    do j = 1, dim[2] {
+		buf = impl3l (im, j, k)
+
+		# Pixel value eq pixel coords.
+		offset = 1
+		if (ndim > 1) {
+		    if (dim[1] < 100)
+			scalar = 100
+		    else
+			scalar = 1000
+		    offset = offset + j * scalar
+		}
+
+		if (ndim > 2)
+		    offset = offset + k * (scalar ** 2)
+
+		# Avoid integer overflow if large type short image.
+		if (IM_PIXTYPE(im) == TY_SHORT)
+		    offset = min (MAX_SHORT, offset - dim[1])
+
+		# Initialize line of pixels.
+		do i = 0, dim[1]-1
+		    Meml[buf+i] = offset + i
+	    }
+
+	call imunmap (im)
+end
+
+
+# CUBE -- Get a subraster from an image, and print out the pixel values
+# on the standard output.
+
+define	MAXDIM		3
+
+procedure t_cube()
+
+char	imname[SZ_FNAME], fmt
+int	i, nx, ny, nz, ndim
+int	vs[IM_MAXDIM], ve[IM_MAXDIM]
+pointer	im, ras, imgs3r(), immap()
+int	clscan(), nscan()
+char	clgetc()
+
+begin
+	call clgstr ("image_name", imname, SZ_FNAME)
+	fmt = clgetc ("numeric_format")
+
+	im = immap (imname, READ_ONLY, 0)
+
+	# Get the coordinates of the subraster to be extracted.  Determine
+	# dimensionality of subraster.
+
+	if (clscan ("subraster_coordinates") != EOF) {
+	    for (ndim=1;  ndim <= MAXDIM;  ndim=ndim+1) {
+		switch (fmt) {
+		case FMT_DECIMAL:
+		    call gargi (vs[ndim])
+		    call gargi (ve[ndim])
+		case FMT_OCTAL:
+		    call gargrad (vs[ndim], 8)
+		    call gargrad (ve[ndim], 8)
+		case FMT_HEX:
+		    call gargrad (vs[ndim], 16)
+		    call gargrad (ve[ndim], 16)
+		}
+
+		if (nscan() < ndim * 2) {
+		    ndim = nscan() / 2
+		    break
+		}
+	    }
+	}
+
+	if (ndim == 0)
+	    return
+
+	for (i=ndim+1;  i <= MAXDIM;  i=i+1) {
+	    vs[i] = 1
+	    ve[i] = 1
+	}
+
+	# Extract subraster from image.  Print table on the standard
+	# output.
+
+	ras = imgs3r (im, vs[1], ve[1], vs[2], ve[2], vs[3], ve[3])
+	call imbln3 (im, nx, ny, nz)
+
+	call print_cube (STDOUT, Memr[ras], nx, ny, nz, vs, ve, fmt)
+	call imunmap (im)
+end
+
+
+# PRINT_CUBE -- Print a cube of pixels of type REAL on a file.
+
+procedure print_cube (fd, cube, nx, ny, nz, vs, ve, fmt)
+
+char	fmt
+int	fd, nx, ny, nz
+real	cube[nx,ny,nz]
+int	vs[MAXDIM], ve[MAXDIM], vinc[MAXDIM]
+int	i, j, k
+errchk	fprintf, pargi, pargr
+
+begin
+	do i = 1, MAXDIM				# loop increments
+	    if (vs[i] <= ve[i])
+		vinc[i] = 1
+	    else
+		vinc[i] = -1
+
+	# Print table of pixel values on the standard output.  Label bands,
+	# lines, and columns.
+
+	do k = 1, nz {
+	    call fprintf (fd, "Band %0.0*:\n")
+		call pargc (fmt)
+		call pargi (vs[MAXDIM] + (k-1) * vinc[MAXDIM])
+
+	    call fprintf (fd, "%9w")
+	    do i = 1, nx {				# label columns
+		call fprintf (fd, "%9*   ")
+		    call pargc (fmt)
+		    call pargi (vs[1] + (i-1) * vinc[1])
+	    }
+	    call fprintf (fd, "\n")
+
+	    do j = 1, ny {
+		call fprintf (fd, "%5*  ")
+		    call pargc (fmt)
+		    call pargi (vs[2] + (j-1) * vinc[2])
+		do i = 1, nx {				# print pixels
+		    call fprintf (fd, "%12*")
+			call pargc (fmt)
+			call pargr (cube[i,j,k])
+		}
+		call fprintf (fd, "\n")
+	    }
+	    call fprintf (fd, "\n")
+	}
+end
+
+
+# MAXMIN -- Compute the minimum and maximum pixel values of an image.
+# Works for images of any dimensionality, size, or datatype.
+
+procedure t_maxmin()
+
+char	imname[SZ_FNAME]
+real	minval, maxval
+long	v[IM_MAXDIM], clktime()
+pointer	im, buf, immap(), imgnlr()
+
+begin
+	call clgstr ("imname", imname, SZ_FNAME)
+	call amovkl (long(1), v, IM_MAXDIM)		# start vector
+
+	im = immap (imname, READ_WRITE, 0)
+
+	# Only calculate minimum, maximum pixel values if the current
+	# values are unknown, or if the image was modified since the
+	# old values were computed.
+
+	if (IM_LIMTIME(im) < IM_MTIME(im)) {
+	    IM_MIN(im) = MAX_REAL
+	    IM_MAX(im) = -MAX_REAL
+
+	    while (imgnlr (im, buf, v) != EOF) {
+		call alimr (Memr[buf], IM_LEN(im,1), minval, maxval)
+		IM_MIN(im) = min (IM_MIN(im), minval)
+		IM_MAX(im) = max (IM_MAX(im), maxval)
+	    }
+
+	    IM_LIMTIME(im) = clktime (long(0))
+	}
+
+	call clputr ("minval", IM_MIN(im))
+	call clputr ("maxval", IM_MAX(im))
+
+	call imunmap (im)
+end
+
+
+define	MAXDIM		3
+
+# GSUBRAS -- Get a type short subraster from an image, and print out the
+# minimum and maximum pixel values on the standard output.
+
+procedure t_gsubras()
+
+char	imname[SZ_FNAME], fmt
+int	i, nx, ny, nz, ndim
+int	vs[IM_MAXDIM], ve[IM_MAXDIM]
+short	minval, maxval
+pointer	im, ras
+pointer	imgs1s(), imgs2s(), imgs3s(), immap()
+int	clscan(), nscan()
+char	clgetc()
+
+begin
+	call clgstr ("image_name", imname, SZ_FNAME)
+	fmt = clgetc ("numeric_format")
+
+	im = immap (imname, READ_ONLY, 0)
+
+	# Get the coordinates of the subraster to be extracted.  Determine
+	# dimensionality of subraster.
+
+	if (clscan ("subraster_coordinates") != EOF) {
+	    for (ndim=1;  ndim <= MAXDIM;  ndim=ndim+1) {
+		switch (fmt) {
+		case FMT_DECIMAL:
+		    call gargi (vs[ndim])
+		    call gargi (ve[ndim])
+		case FMT_OCTAL:
+		    call gargrad (vs[ndim], 8)
+		    call gargrad (ve[ndim], 8)
+		case FMT_HEX:
+		    call gargrad (vs[ndim], 16)
+		    call gargrad (ve[ndim], 16)
+		}
+
+		if (nscan() < ndim * 2) {
+		    ndim = nscan() / 2
+		    break
+		}
+	    }
+	    ndim = min (MAXDIM, ndim)
+	}
+
+	if (ndim == 0)
+	    return
+
+	for (i=ndim+1;  i <= MAXDIM;  i=i+1) {
+	    vs[i] = 1
+	    ve[i] = 1
+	}
+
+	# Extract subraster from image.  Print table on the standard
+	# output.
+
+	switch (ndim) {
+	case 1:
+	    ras = imgs1s (im, vs[1], ve[1])
+	    call imbln1 (im, nx)
+	    ny = 1
+	    nz = 1
+	case 2:
+	    ras = imgs2s (im, vs[1], ve[1], vs[2], ve[2])
+	    call imbln2 (im, nx, ny)
+	    nz = 1
+	case 3:
+	    ras = imgs3s (im, vs[1], ve[1], vs[2], ve[2], vs[3], ve[3])
+	    call imbln3 (im, nx, ny, nz)
+	}
+
+	minval = MAX_SHORT
+	maxval = -MAX_SHORT
+	call alims (Mems[ras], nx * ny * nz, minval, maxval)
+
+	call printf ("min = %0.0*, max = %0.0*\n")
+	    call pargc (fmt)
+	    call pargs (minval)
+	    call pargc (fmt)
+	    call pargs (maxval)
+
+	call imunmap (im)
+end
+
+
+# DUMP -- Dump the user area of an image header for diagnostic purposes.
+# Blanks are rendered into underscores to make them visible.  This is a
+# throwaway task.
+
+procedure t_dump()
+
+char	image[SZ_FNAME]
+int	i
+pointer	ip, im
+pointer	immap()
+
+begin
+	call clgstr ("image", image, SZ_FNAME)
+	im = immap (image, READ_ONLY, 0)
+
+	# Print ruler.
+	do i = 1, 80
+	    if (mod(i,10) == 0)
+		call putci (STDOUT, TO_DIGIT(i/10))
+	    else
+		call putci (STDOUT, ' ')
+	call putci (STDOUT, '\n')
+
+	do i = 1, 80
+	    call putci (STDOUT, TO_DIGIT(mod(i,10)))
+	call putci (STDOUT, '\n')
+
+	# Map blanks into underscores.
+	for (ip = IM_USERAREA(im);  Memc[ip] != EOS;  ip=ip+1)
+	    if (Memc[ip] == ' ')
+		Memc[ip] = '_'
+
+	# Dump user area.
+	call putline (STDOUT, Memc[IM_USERAREA(im)])
+	call imunmap (im)
+end
+