Initial commit

122 files changed, 17796 insertions, 0 deletions

diff --git a/sys/mwcs/MWCS.hlp b/sys/mwcs/MWCS.hlp
new file mode 100644
index 00000000..4f77144f
--- /dev/null
+++ b/sys/mwcs/MWCS.hlp
@@ -0,0 +1,1026 @@
+.help MWCS Oct89 "Mini-WCS Interface"
+
+.ce
+\fBMini-WCS Interface\fR
+.ce
+Doug Tody
+.ce
+October 1989
+
+
+.nh
+Introduction
+
+    The mini-WCS interface represents a first cut at the general problem
+of representing a linear or nonlinear world coordinate system (WCS).
+While some of the harder problems are avoided and the general WCS problem
+remains to be solved, the current interface should be largely upwards
+compatible with future versions of the interface.  The main items omitted
+from this initial version of the interface are support for general nonlinear
+world coordinate systems, particularly support for modeling of geometric
+distortions and arbitrary application defined coordinate mapping functions.
+Limited support is provided for the projective geometries.
+
+.nh
+WCS Definition
+.nh 2
+Linear Transformations
+
+    Any linear transformation consisting of some combination of a shift,
+rotate, axis-flip, scale change, etc. can be expressed as
+
+.ks
+.nf
+	|x'|   |a b|   |x|   |u|
+	|  | = |   | * | | + | |                                   [2.1]
+	|y'|   |c d|   |y|   |v|
+.fi
+.ke
+
+where [x,y] are the input coordinates, [x',y'] are the transformed
+coordinates, [a,b,c,d] is a rotation matrix, and [u,v] is a shift vector.
+
+For example, the X term of a combination of a rotation about a point [x0,y0]
+plus a shift to an offset [x1,y1] may be expressed as
+
+.ks
+.nf
+	x' = a(x - x0) + b(y - y0) + x1
+	   = ax - ax0 + by - by0 + x1
+	   = ax + by + u
+.fi
+.ke
+whence
+.nf
+	 u = x1 - ax0 - by0
+and                                                                [2.2]
+	 v = y1 - cx0 - dy0
+.fi
+
+Another way of expressing this is to note that [U,V] is the transform
+of the origin [x,y]=[0,0] of the original coordinate system.
+There is nothing special about the rotation point; a rotation about
+any point [x,y] is equivalent to a rotation about the origin followed
+by a translation equal to the distance of the rotation point from the origin.
+
+The inverse transformation is given by
+
+.nf
+	|x|   |  -1|    / |x'|   |u| \
+	| | = | A  | * <  |  | - | |  >                            [2.3]
+	|y|   |    |    \ |y'|   |v| /
+.fi
+
+where A**(-1) is the inverse of the rotation matrix [a,b,c,d].
+
+.nh 2
+World Coordinate Systems
+
+    A world coordinate system (WCS) defines the transformation between
+a physical coordinate system (e.g., pixel coordinates in a reference image),
+and world coordinates expressed in some arbitrary units.  A two dimensional
+WCS can be expressed as
+
+.ks
+.nf
+	(x',y') = F (l,m, Wx,Wy)
+	(l,m) = [CD] * (x-Rx, y-Ry)                                [2.4]
+
+where
+
+	x,y	Are the coordinates of a point in the physical system.
+	l,m	Is a linearly transformed representation of the point.
+	x',y'	Are the coordinates of the same point in the world system.
+	F	Is the WCS function, possibly a nonlinear function.
+	Rx,Ry	Define the reference point in the physical system.
+	Wx,Wy	Are the world coordinates of the reference point.
+	[CD]	Is the coefficient determination (CD) matrix.
+.fi
+.ke
+
+The notation [CD]*(x,y) denotes a matrix multiply of the CD matrix [CD] and
+the vector (x,y), i.e., a linear transformation of the vector (x,y).
+If the WCS contains a nonlinear component, as for a sky projection,
+this is described by the function F in terms of the intermediate
+coordinates (l,m), e.g., the displacement in degrees from the reference
+point.  Separation of the WCS into linear and nonlinear components allows
+full specification of linear systems using only the basic interface,
+and simplifies the representation of the nonlinear part of the WCS.
+The nonlinear component itself (F) may be an object of arbitrary complexity.
+
+In the case of a simple 2D linear WCS with no rotation this reduces to
+
+.ks
+.nf
+	x' = (x - Rx) * CD[1,1] + Wx
+	y' = (y - Ry) * CD[2,2] + Wy
+.fi
+.ke
+
+In the general case the world system may be rotated with respect to the
+physical system (original image matrix), hence the WCS must include a
+rotation term.  Specifying this as a general linear transformation expressed
+as a matrix multiplication allows the representation of such transformations
+as conversion between skewed and cartesian coordinates as well as the
+more conventional rotation and scale transformation.
+
+The CD matrix representation (developed by STScI and now also associated
+with FITS), in addition to allowing specification of a linear transformation,
+is responsible for converting between the coordinate units used in the
+physical system and those used in the world system (more precisely,
+in the general case the units of (l,m) may differ from those of the
+world system, since F can also change the units).
+It is even possible for the world system to use different units on
+different axes, so long as a rotation is not defined between axes with
+different units.
+
+For example, if the WCS is used to describe an image cube, following
+application of the CD matrix axes 1 and 2 might have units of arc seconds,
+and axis 3 frequency.  In this case rotation would be defined only between
+axes 1 and 2, i.e., the off-diagonal CD matrix terms CD[1:2,3] and CD[3,1:2]
+must be zero, with CD[3,3] giving the scale for axis 3 independently of any
+rotation between axes 1 and 2.  This restriction on rotation between
+dissimilar axes applies only to the world system described by the CD matrix.
+As we shall see in the next section, when the WCS refers to an image,
+arbitrary rotations of the raw pixel matrix are still possible by using
+a separate pixel space transformation to describe transformations
+of the image matrix.
+
+.nh 3
+WCS Rotation Between Dissimilar Axes
+
+    To see why rotation between dissimilar axes is disallowed in some
+circumstances, note that the CD matrix, since it combines a rotation
+(or other pixel space linear transformation) and units conversion in one
+operation, can be expressed as follows in the case of a two dimensional system.
+
+The CD matrix is used as follows:
+
+.ks
+.nf
+	| l |   |    |   | x |
+	|   | = | CD | * |   |
+	| m |   |    |   | y |
+.fi
+.ke
+
+The CD matrix is constructed as follows:
+
+.ks
+.nf
+	|    |   | Dx   0 |   | a  b |
+	| CD | = |        | * |      |
+	|    |   | 0   Dy |   | c  d |
+.fi
+.ke
+
+where (Dx,Dy) is the units conversion matrix, and (a,b,c,d) is the
+rotation matrix.  This is a completely general representation, i.e.,
+any linear transformation may be specified by the matrix (a,b,c,d)
+and combined with the units conversion matrix, since the rotation
+matrix rotates the physical system to align the axes with those of
+the world coordinate system.
+
+The problem comes if we try to \fIrotate the CD matrix\fR.
+Although the CD matrix can express any
+rotation between the physical and world system, once the CD matrix
+has been formed the units conversion and rotation matrices cannot
+be recovered.  In general, further rotation of the system described by
+the CD matrix requires that we rotate the matrix (a,b,c,d), rather than
+the CD matrix itself.  The only exception occurs when Dx=Dy (similar axes),
+in which case the CD matrix and rotation matrix are equivalent except
+for a constant.  Hence, rotations between dissimilar axes of the system
+described by the (already formed) CD matrix are disallowed.  A special
+case is rotation is some multiple of 90 degrees, which can be represented
+by an axis swap or flip.
+
+.nh 2
+MWCS Coordinate System Representation
+
+    The coordinate system representation used by the MWCS interface consists of
+two components called the \fBLterm\fR and \fBWterm\fR, specifying independent
+logical and world transformations relative to a physical, cartesian coordinate
+system.  Three types of coordinate systems are defined, as outlined below.
+
+.ls
+.ls PHYSICAL
+The physical coordinate system is the raw coordinate system of the data.
+In the case of an image, the physical coordinate system refers to the pixel
+coordinates of the original data frame.  All other coordinates systems are
+defined in terms of the physical system (reference frame).
+.le
+.ls LOGICAL
+The logical coordinate system is defined by the \fILterm\fR in terms of the
+physical coordinate system.  In the case of an image, the logical coordinate
+system specifies raw pixel coordinates relative to some image section or
+derived image, i.e., the coordinates used for image i/o.  In the MWCS the
+Lterm specifies a simple linear transformation, in pixel units, between
+the original physical image matrix and the current image section.
+.le
+.ls WORLD
+The world coordinate system is defined by the \fIWterm\fR in terms of the
+physical coordinate system.  Any number of different kinds of world coordinate
+systems are conceivable.  Examples are the tangent (gnonomic) projection,
+specifying right ascension and declination relative to the original data
+image, or any linear WCS, e.g., a linear dispersion relation for spectral
+data.  Multiple world coordinate systems may be simultaneously defined in
+terms of the same physical system.
+.le
+.le
+
+The following observations apply to the behavior of MWCS as applied
+to image data.
+.ls
+.ls 4 1.
+Any linear transformation of the image matrix (shift, scale change,
+axis flip, etc.) affects only the Lterm.  The revised MWCS for the new
+image or image section may be computed merely by doing a linear
+transformation of the Lterm.
+.le
+.ls 4 2.
+If multiple world coordinate systems are associated with an image,
+all share the same Lterm.
+.le
+.ls 4 3.
+Geometric distortion of an image (not currently supported by MWCS) is
+a pixel space operation, i.e. a generalization of the Lterm, hence is
+independent of the WCS.
+.le
+.le
+
+In general, the physical and world coordinate systems are defined whenever
+a new image is created, e.g., by a task such as RFITS.  A new-copy type
+operation, such as most transformations performed by IMAGES tasks, affects
+only the Lterm.
+
+Although we normally speak in terms of images, MWCS is not
+limited to applications involving images.  For example, the physical
+coordinate system could just as well be a graphics frame buffer, and the
+logical coordinate system a pixrect.  A greyscale transformation is
+an example of a non-image WCS.  MWCS, or the successor interface,
+will eventually be used in GIO, e.g., for cursor readback.
+
+Since the Wterm includes the CD matrix, which defines a linear
+transformation, and linear transformations can be combined, in principle
+it is possible to combine the Lterm and Wterm to define a single
+transformation from logical to world coordinates.  In practice this
+can run into problems, as not all pixel space rotations may be
+representable by the CD matrix (since the latter may define different
+world space units on different axes).  Furthermore, if multiple WCS
+are defined, and the WCS are defined in terms of the logical system,
+it would be inefficient to have to transform each WCS to the new logical
+system each time a linear transformation of the data is performed
+(e.g., every time an image is opened with an image section).
+
+For images, the common coordinate transformations are image section (logical)
+coordinates to world coordinates and vice versa, and section coordinates
+to physical coordinates and vice versa.  The physical coordinate system
+can be regarded as a special case of a world coordinate system (the "pixel"
+coordinate system) defined relative to logical image section coordinates.
+
+For example, to convert IMIO image coordinates to world coordinates,
+the interface will first apply the inverse of the Lterm to determine the
+coordinates in the physical system, then apply the Wterm for the desired WCS
+to compute the world coordinates.  If the Wterm is linear and the Lterm
+does not define any rotations between dissimilar axes, the two operations
+can be combined for a more efficient coordinate transformation.
+
+An arbitrary number of world coordinate systems may be defined over the
+same domain in the physical coordinate system.  Every WCS has a name
+uniquely specifying the WCS type.  A WCS may also have attributes such as
+units, axis labels, and numeric output formats specified independently for
+each axis, as well as arbitrary user defined WCS attributes.
+
+.nh 3
+Lterm Representation
+
+    The Lterm is defined by the terms of a general linear transformation,
+as shown in equation [2.1].  For example, in the case of a 2D system the
+following quantities must be given to define the Lterm.
+
+.ks
+.nf
+	[CD] = [a,b,c,d]	rotation matrix
+	tv[] = [u,v]		translation vector
+.fi
+.ke
+
+This defines the transformation between the physical and logical coordinate
+systems, i.e., applying the transformation to a pair of physical coordinates
+[x,y] yields the corresponding logical coordinates [x',y'].  MWCS will
+automatically compute the inverse transformation when asked to convert
+between logical coordinates and physical or world coordinates.
+
+.nh 3
+Wterm Representation
+
+    The Wterm defines the transformation between the physical system and
+some arbitrary world coordinate system.  The Wterm is defined by the
+following quantities:
+
+.nf
+	R[]		reference coordinates in physical system
+	W[]		world coordinates at the reference point
+	[CD]		coordinate determination matrix
+	wtype		type of WCS (function name string)
+	wattr		WCS attributes (string, opaque outside interface)
+.fi
+
+The point R, also known as the \fIreference pixel\fR when dealing
+with image data, defines the origin of the world coordinate system in
+the physical system.  The world coordinates at the reference point are
+given by the vector W (at least for a linear WCS; in general the meaning
+of the W term depends upon the WCS type).  The CD matrix defines any
+rotation between the physical and world systems, as well as the scale
+conversion needed to convert between physical and world (or linear world)
+coordinates.
+
+Although the function name or type \fIwtype\fR is
+accessible to applications, the details of what the WCS means, and how
+it is evaluated, are intended to be internal to the interface, hence
+the use of strings to pass in the WCS information.  Functions complex
+enough to require coefficients should pass the extra information in via
+the \fIwattr\fR term.  WCS attributes such as the axis units and labels
+are also passed in via \fIwattr\fR.
+
+In the general case there may be any number of different WCS types.
+In the case of MWCS, however, only a predefined set of WCS types are
+supported, since the code for each WCS is wired into the interface.
+The predefined WCS types (as selected by \fIwtype\fR) are the following.
+
+.ks
+.nf
+	\fIWtype\fR			\fIDescription\fR
+
+	linear			simple linear WCS
+	sampled			sampled WCS function
+	(TAN etc.)		the sky projections
+.fi
+.ke
+
+A \fIlinear\fR WCS is specified by the physical and world coordinates of the
+reference point, and the row or rows of the CD matrix pertaining to the axes
+to which the WCS is assigned.  A linear WCS is completely specified by the
+linear term of the standard WCS representation.
+  
+A \fIsampled\fR WCS is specified by an array of (physical, world) coordinate
+pairs, i.e., an array of reference points, sampling the linear WCS function
+for that axis.  In the limiting case, for sampled (pixel) data, there is one
+(physical, world) point on the WCS curve for each data point.  If the WCS
+function is smooth a coarser sampling can be used to approximate the curve,
+using some form of interpolation to evaluate the function.  In the MWCS,
+a sampled function must be one-dimensional, i.e., associated with a single
+axis (higher dimensional surfaces can be represented so long as the axes
+are independent).
+
+Note that the sampled function is expressed in terms of the \fIoffset\fR
+from the reference point in both the physical and world systems.
+Any analytic function, e.g., polynomial or spline, can be sampled and
+later reconstructed from the sampled curve with no significant error,
+provided the function type and order are known and there are sufficient
+sample points to determine the system.
+The advantage of the sampled representation is that it is independent of
+the function type, and can be used to fit any analytic function when the
+time comes to evaluate the curve.
+
+The sky projections are a special case used with astronomical direct images. 
+The principal example is the gnomonic projection, the projection of the
+celestial sphere onto a plane tangent at the reference point.
+The sky projections are completely specified by the reference point and the
+standard CD matrix, plus the WCS name which specifies the type of projection,
+e.g., "gnomonic", "sine", "arc", and so on.
+
+The WCS attributes which can be set by the \fIwattr\fR string consist of
+a number of standard attributes, plus an arbitrary number of additional
+WCS specific attributes.  Examples of standard attributes include "system",
+"wtype", "units", "label", etc.  A list of the standard WCS attributes is
+given in section 3.3.1.
+
+.nh
+Interface Overview
+
+    The MWCS interface is a stand-alone interface implementing the linear
+and world coordinate transformation abstractions.  While the interface
+is designed with the typical application to image data in mind, MWCS is
+intended as a general coordinate transformation facility for use with any
+type of data, as an embedded interface in other software, including system
+interfaces such as IMIO and GIO as well as user applications.
+
+.nh 2
+Object Creation and Storage
+
+    The MWCS interface routines used to create or access MWCS objects, or
+save and restore MWCS objects in external storage, are summarized below.
+
+.nf
+		   mw = mw_open (bufptr|NULL, ndim)
+		 mw = mw_openim (im)
+		mw = mw_newcopy (mw)
+		       mw_close (mw)
+
+			mw_load (mw, bufptr)
+		  len = mw_save (mw, bufptr, buflen)
+	       mw_[load|save]im (mw, im)
+.fi
+
+A new MWCS object, initialized either to a unitary transformation of
+dimension \fIndim\fR or to the encoded MWCS in the input buffer,
+is created with \fImw_open\fR.  A MWCS object is be
+created and initialized from an image with \fImw_openim\fR; if the referenced
+image does not currently have any WCS information associated with it,
+a unitary pixel WCS will be created.  The \fImw_newcopy\fR operation
+creates a new MWCS object as a copy of an existing one, as one might wish
+to do prior to modifying a WCS.  When a descriptor is no longer needed it
+should be returned with \fImw_close\fR.
+
+A MWCS object (descriptor) is a memory object.  To encode a MWCS in an opaque
+machine independent binary array, e.g., for storage in a file or transmission
+through a datastream, \fImw_save\fR is called with the \fIchar\fR pointer of
+the buffer in which the encoded MWCS is to be placed.  If the buffer pointer is
+NULL a buffer will be created and the pointer returned, and if a valid buffer
+is passed it will be resized as necessary to store the encoded object.
+An encoded MWCS object is reloaded into a descriptor with \fImw_load\fR.
+A MWCS may be stored or updated in an image header with \fImw_saveim\fR,
+or loaded from the image header into a descriptor with \fImw_loadim\fR.
+These are the only interface routines with knowledge of the parameter names,
+etc., used to store WCS information in image headers.
+
+.nh 2
+Coordinate Transformation Procedures
+
+    The MWCS procedures used to perform coordinate transformations,
+and to modify or examine the Lterm and Wterm, are summarized below.
+
+.nf
+		 ct = mw_sctran (mw, system1, system2, axes)
+	  ndim = mw_gctran[r|d] (ct, ltm, ltv, axtype1, axtype2, maxdim)
+		      mw_ctfree (ct)
+
+	    x2 = mw_c1tran[r|d] (ct, x1)
+		 mw_v1tran[r|d] (ct, x1, x2, npts)
+		 mw_c2tran[r|d] (ct, x1,y1, x2,y2)
+		 mw_v2tran[r|d] (ct, x1,y1, x2,y2, npts)
+		  mw_ctran[r|d] (ct, p1, p2, ndim)
+		  mw_vtran[r|d] (ct, v1, v2, ndim, npts)
+.fi
+
+The procedures \fImw_[cv][12]tran[rd]\fR perform coordinate
+transformations for individual coordinates or coordinate vectors,
+for one or two dimensional systems, for coordinates of type real or double.
+The general N dimensional case is handled by the \fImw_[cv]tran[rd]\fR
+procedures, which transform \fIndim\fR-dimensional points (\fImw_ctran\fR)
+or point vectors (\fImw_vtran\fR).  A single point is specified as a
+vector of length \fIndim\fR; a point vector is expressed as an array of
+points, i.e., a 2-dimensional array V[I,J], where the index I refers to
+the axis within a point vector, and where the index J refers to the point.
+The notation V[1,j] references the 1-dimensional point vector for point J.
+
+The direction of the transformation, and the axes for which the transformation
+is to be performed, is determined by a prior call to \fImw_sctran\fR,
+which specifies the input and output coordinate systems, and performs the
+initialization necessary for efficient evaluation of a series of
+transformations.  A pointer to the optimized transformation descriptor is
+returned, to allow two or more transformations to be prepared and used
+simultaneously without having to repeat the setup, which can be considerably
+more expensive than coordinate evaluation.  The transformation descriptor
+should be freed when no longer needed, else it will be freed automatically
+when the MWCS is closed.
+
+A coordinate system is specified to \fImw_sctran\fR by its name.
+The following standard systems are predefined.
+Additional WCS names may be defined by the application.
+
+.ks
+.nf
+	"logical"		The logical system
+	"physical"		The physical system
+	"world"			The default world system
+	(user-wcs)		User defined systems
+.fi
+.ke
+
+Strings are used to specify the coordinate systems in order to allow user
+defined and named systems to be added at runtime.
+The use of a setup procedure to specify the desired transformation allows
+new types of coordinate transformations to be easily added, for example
+mixed conversions, as for a 2-dimensional system where the X and Y components
+of a coordinate pair belong to different coordinate systems, or computation
+of the derivative at a point.  In MWCS, only simple conversions between any
+two of the physical, logical, and world coordinate systems are supported.
+
+Specification of the axes for which the coordinate transformation is desired
+is necessary for the more complex systems, since there may be different,
+often quite independent coordinate systems defined on different axes.
+The axes for which the transformation is to be prepared are specified as
+a bitmask.  The default, if the mask is zero, is to use axes starting with
+1, up to the number required to satisfy the given dimension transformation.
+
+For example, to convert two dimensional image coordinates (section relative)
+to world coordinates in the default WCS:
+
+.nf
+	call mw_sctran (mw, "logical", "world", 3B)
+	call mw_c2tranr (mw, px,py, wx,wy)
+.fi
+
+Multiple independent world coordinate systems may be defined relative to
+the same physical system.  Most applications, however, are best written
+as if there were only one world system, with the coordinate system to be
+used being switched about transparently to the application.  For this
+reason there is no WCS number argument to the MWCS procedures, and
+the "world" system specifies the \fIcurrent default\fR WCS.  If a MWCS object
+defines multiple world coordinate systems, a \fImw_ssystem\fR call is used
+to select the WCS to be used.  This could be used, for example, to change
+the units appearing on plots in a graphics application, transparently
+to the application.
+
+.nh 2
+Coordinate System Specification
+
+    The MWCS procedures used to enter, modify, or inspect the MWCS
+logical and world coordinate transformations are summarized in the figure
+below.
+
+The procedures \fImw_[sg]lterm\fR are used to directly enter
+or inspect the Lterm, which consists of the linear transformation matrix
+\fIltm\fR and the translation vector \fItv\fR, both of dimension \fIndim\fR,
+defining the transformation from the physical system to the logical system.
+If the logical system undergoes successive linear transformations,
+\fImw_translate\fR may be used to translate, rather than replace,
+the current Lterm, where the given transformation matrix and translation
+vector refer to the relative transformation undergone by the logical system.
+This will always work since the Lterm is initialized to the identity matrix
+when a new MWCS object is created.  The routines \fImw_rotate\fR,
+\fImw_scale\fR, and \fImw_shift\fR provide a convenient front-end to
+\fImw_translate\fR for the more common types of translations.
+
+Specification of the Wterm is somewhat more complicated.  The Wterm for
+a new WCS should first be created and initialized for a system of the given
+dimensionality with \fImw_newsystem\fR.  The linear portion of the Wterm,
+i.e., the CD matrix and the coordinates of the reference point
+in the physical and world systems, and the WCS dimension, may then be entered
+with \fImw_swterm\fR and queried with \fImw_gwterm\fR.
+
+.nf
+	     mw_[s|g]lterm[r|d] (mw, ltm, ltv, ndim)
+	      mw_translate[r|d] (mw, ltv_1, ltm, ltv_2, ndim)
+		      mw_rotate (mw, theta, center, axes)
+		       mw_scale (mw, scale, axes)
+		       mw_shift (mw, shift, axes)
+
+		   mw_newsystem (mw, system, ndim)
+		 mw_[s|g]system (mw, system[, maxch])
+		  mw_[s|g]axmap (mw, axno, axval, ndim)
+		    mw_bindphys (mw)
+
+	     mw_[s|g]wterm[r|d] (mw, r, w, cd, ndim)
+		      mw_swtype (mw, axis, naxes, wtype, wattr)
+	     mw_[s|g]wsamp[r|d] (mw, axis, pv, wv, npts)
+		 mw_[s|g]wattrs (mw, axis, attribute, valstr[, maxch])
+.fi
+
+The world portion of the Wterm is unusual in that the type of WCS may be
+specified independently for each axis.  The WCS function type \fIwtype\fR,
+and any attributes \fIwattr\fR, are specified for the indicated \fIaxes\fR
+with \fImw_swtype\fR.  The axes specified are those required to evaluate
+the named function.
+
+In the case of an axis of type "sampled", the sampled WCS function must
+also be entered via a call to \fImw_swsamp\fR, and may later be retrieved
+with \fImw_gwsamp\fR.  The WCS function is defined as an \fIoffset\fR from
+the reference point in both the physical and world systems, e.g.,
+the vector \fIWv\fR will be added to the world coordinates
+produced by interpolating the sampled function (this can of course be
+defeated by setting R or W to zero).
+
+A WCS always has a number of predefined \fIattributes\fR, and may also
+have any number of user defined, or WCS specific, attributes.  These are
+defined when the WCS is created, in the \fIwattr\fR argument input to
+\fImw_swtype\fR, or in a subsequent call to \fImw_swattrs\fR.  The WCS
+attributes for a specific axis may be queried with the function
+\fImw_gwattrs\fR.  Attribute values may be modified, or new attributes defined,
+with \fImw_swattrs\fR.  The issue of WCS attributes is discussed further
+in the next section.
+
+.nh 3
+WCS Types and Attributes
+
+    The WCS attributes which can be set by the \fIwattr\fR term consist of
+a number of standard attributes, plus an arbitrary number of additional
+WCS specific (application defined) attributes.  The following standard
+attributes are reserved (but not necessarily defined) for each WCS:
+
+.nf
+	"units"		axis units ("pixels", etc.)
+	"label"		axis label, for plots
+	"format"	axis numeric format, for tick labels
+	"wtype"		WCS type, e.g., "linear"
+.fi
+
+In addition, the following are defined for the entire WCS,
+regardless of the axis:
+
+.nf
+	"system"	system name (logical, physical, etc.)
+	"object"	external object with which WCS is associated
+.fi
+
+For example, to determine the WCS type for axis 1:
+
+	call mw_gwattrs (mw, 1, "wtype", wtype, SZ_WTYPE)
+
+The (world coordinate) system name \fIsystem\fR is what is used, e.g.,
+to select a WCS in a call to \fImw_ssystem\fR, or define a coordinate
+transformation in a call to \fImw_sctran\fR.  Note that the system name
+"world" is actually only an alias for the \fIdefault world system\fR.
+This may be any primary system, i.e., the logical or physical system,
+or a user defined world system.  The initial default world system may
+be specified by the user by predefining the environment variable
+\fBdefwcs\fR, otherwise the first-defined user world system is used,
+else the physical system is used.
+
+If the MWCS is associated with an image then the "object" attribute of
+the physical system will return the name of the image or image section
+defined as the physical coordinate system for the MWCS.
+This is not necessarily the full image, e.g., in the case of
+a multidimensional image, the physical system might be any 2D plane of the
+image.  In the case of an event file image, the image name may include a
+filter or blocking factor.  References back to the raw data image based on
+MWCS physical coordinates will work so long as the raw image is opened
+using the name returned by the interface.  If the image is already open
+and was accessed by descriptor via MWCS, the descriptor may be retrieved
+by a \fImw_stati\fR call to fetch MW_IMDES.
+
+All MWCS coordinate systems have the standard attributes, with default values
+being supplied by the interface if not set by the application.  In particular,
+the logical and physical coordinate systems have attributes and may be
+treated as a special case of a world coordinate system by the application.
+
+.nh 3
+Axis Mapping
+
+    The coordinate transformation procedures (section 3.2) include support
+for a feature called \fIaxis mapping\fR, used to implement \fIdimensional
+reduction\fR.  A example of dimensional reduction occurs in IMIO, when
+an image section is used to specify a subraster of an image of dimension
+less than the full physical image.  For example, the section might specify
+a 1 dimensional line or column of a 2 or higher dimensional image, or a
+2 dimensional section of a 3 dimensional image.  When this occurs the
+applications sees a logical image of dimension equal to that of the image
+section, since logically an image section \fIis\fR an image.
+
+Dimensional reduction is implemented in MWCS by a transformation on the
+input and output coordinate vectors.  The internal MWCS coordinate system
+is unaffected by either dimensional reduction or axis mapping; axis mapping
+affects only the view of the WCS as seen by the application using the
+coordinate transformation procedures.
+
+For example, if the physical image is an image cube and we access the
+logical image section "[*,5,*]", an axis mapping may be set up which
+maps \fIphysical\fR axis 1 to logical axis 1, physical axis 2 to the
+constant 5, and physical axis 3 to logical axis 2.  The internal system
+remains 3 dimensional, but the application sees a 2 dimensional system.
+Upon input, the missing axis y=5 is added to the 2 dimensional input
+coordinate vectors, producing a 3 dimensional coordinate vector for
+internal use.  During output axis 2 is dropped and replaced by axis 3.
+
+The axis map is entered with \fImw_saxmap\fR and queried with \fImw_gaxmap\fR.
+Here, \fIaxno\fR is a vector, with \fIaxno[i]\fR specifying the logical axis
+to be mapped onto physical axis I.  If zero is specified the constant
+\fIaxval[i]\fR is used instead.  Axis mapping may be enabled or disabled
+with a call to \fImw_seti\fR.
+
+Axis mapping affects all of the coordinate transformation procedures,
+plus \fImw_translate\fR (since it defines a translation in terms of the
+logical system), and all of the coordinate system specification procedures
+having an "axis" parameter, e.g., \fImw_gwattrs\fR.
+Axis mapping is not used with those procedures which directly access or
+modify the physical or world systems (e.g., \fImw_slterm\fR or
+\fImw_swterm\fR) since full knowledge of the physical system is necessary
+for such operations.
+
+.nh 3
+Binding the Physical System
+
+    Recall that all coordinate systems are defined in terms of the physical
+system, and that the Lterm defines the mapping between the physical system
+and the logical system.  Transformations of the logical system leave the
+physical and world systems unaffected.  The only exception to this is the
+procedure \fImw_bindphys\fR, which binds the physical system to the current
+logical system, i.e., makes the current logical system the new physical system.
+This involves a transformation of the linear term (CD matrix) of each world
+system, since a world system is defined in terms of the physical system,
+and initialization of the Lterm to (normally) the identity matrix and zero
+translation vector.  This operation is irreversible, i.e., once
+\fImw_bindphys\fR is executed the original physical system is lost.
+
+In the case of an MWCS which is associated with an image opened with an image
+section, the new physical system is not strictly speaking the logical system,
+but the image matrix of the image being accessed, i.e,. the current image
+ignoring the image section.  Hence, following a call to \fImw_bindphys\fR,
+the Lterm will always describe the translation between the physical image
+matrix currently being accessed, and the logical system (image section).
+
+.nh 2
+Set/Stat Procedures
+
+    The MWCS status procedures, used to query or set the MWCS parameters,
+are as follows.
+
+.nf
+			mw_seti (mw, what, ival)
+		ival = mw_stati (mw, what)
+			mw_show (mw, outfd, what)
+.fi
+
+The currently defined interface parameters are the following.
+
+.nf
+	   Name       Type          Description
+
+	MW_AXMAP	b	enable or disable axis mapping
+	MW_IMDES	i	descriptor of associated image
+	MW_INTERP	i	interpolator type for sampled wcs
+	MW_NDIM		i	dimensionality of logical system
+	MW_NPHYSDIM	i	dimensionality of physical system
+	MW_NWCS		i	number of wcs defined
+	MW_WCS		i	currently active wcs
+.fi
+
+MW_NDIM may differ from MW_NPHYSDIM if dimensional reduction has been
+specified and axis mapping is enabled.  MW_NWCS returns the number of
+WCS currently defined; at least two WCS are always defined, i.e., the
+logical and physical systems (the world system will default to the
+physical system if not otherwise defined).  The index of the current
+default WCS is given by MW_WCS.  In the case of a sampled WCS, the
+interpolator type used by the coordinate transformation procedures is
+specified by MW_INTERP.
+
+.nh 2
+Utility Routines
+
+    The following routines are used internally within the interface to
+compile or evaluate transformations, and may be useful in applications
+code as well.
+
+.nf
+		 mw_invert[r|d] (o_ltm, n_ltm, ndim)
+		   mw_mmul[r|d] (ltm_1, ltm_2, ltm_out, ndim)
+		   mw_vmul[r|d] (ltm, ltv_in, ltv_out, ndim)
+		    mw_glt[r|d] (v1, v2, ltm, ltv, ndim)
+.fi
+
+These routines perform matrix inversion, multiplication of a matrix by another
+matrix, multiplication of a vector by a matrix, and general linear
+transformation (matrix multiply and addition of translation vector).
+
+.nh 2
+Datatypes and Precision
+
+    All floating point data is stored internally in MWCS using double
+precision.  Most of the interface procedures have both type real and type
+double versions, e.g., for entering Lterm or Wterm data.
+The single precision versions should be normally used unless double
+precision is required to represent the data.
+
+Although all floating point data is stored internally as type double,
+coordinate transformations performed at runtime may be carried out using
+either single or double precision computations, depending upon, e.g., whether
+\fImw_ctranr\fR or \fImw_ctrand\fR is called to perform the transformation.
+What happens is that when the transformation is compiled by \fImw_sctran\fR,
+two transformation descriptors are prepared, one for type real and the other
+for type double, with the appropriate descriptor being selected at runtime
+to carry out the transformation.  Hence the precision appropriate for the
+problem at hand can be employed without requiring that the worst case
+precision be used for all applications.
+
+.nh
+IMIO Interface to MWCS
+.nh 2
+Image Header Representation
+
+    When MWCS is used with image data, the encoded MWCS object is stored
+in the image header, and loaded into an MWCS descriptor when the image is
+accessed by an applications program.  The format in which the MWCS is
+stored in the image header depends upon the type of image.  If the image
+has a "flex-header" (as for QPOE and the new image structures) the MWCS
+is encoded in a machine independent binary format and stored in the image
+header as a variable length byte array.  This provides full generality
+and is the most efficient approach.
+
+For the older image formats which use a FITS header (OIF and STF) it is
+necessary to encode the MWCS as a series of FITS cards.  The proposed FITS
+WCS format, already in use for STF format images (with minor deviations
+from the standard), is used to represent the MWCS Wterm.  Additional FITS
+cards are necessary to represent the Lterm.  The (P,W) array for sampled
+WCS can also be represented in a FITS header, although this is awkward and
+inefficient if the number of samples is large.
+
+The FITS header keywords used to represent the Wterm, Lterm, and sampled
+WCS are the following.
+
+.nf
+	WCSDIM		WCS dimension (may differ from image)
+
+	CTYPEn		coordinate type
+	CRPIXn		reference pixel
+	CRVALn		world coords of reference pixel
+	CDi_j		CD matrix
+
+	CDELTn		CDi_i if CD matrix not used (input only)
+	CROTA2		rotation angle if CD matrix not used
+
+	LTVi		Lterm translation vector
+	LTMi_j		Lterm rotation matrix
+
+	WSVi_LEN	Number of sample points for axis I
+	WSVi_jjj	Sampled WCS array for axis I
+
+	WATi_jjj	WCS attributes for axis I
+.fi
+
+Contrary to MWCS convention, the WCS stored in a FITS format header
+defines the transformation from the logical system (image matrix)
+to the world system, rather than the physical system.  The MWCS Wterm
+is computed from the FITS representation by transforming the FITS WCS
+by the stored Lterm when the stored MWCS is loaded.
+
+The name format CDi_j varies slightly from the proposed FITS standard, but is
+backwards compatible with STF (and more readable than the FITS nomenclature).
+The keywords LTVECn, LTi_j, WSVi_LEN, WSVi_jjj, and WATi_jjj are peculiar
+to MWCS.  A sampled WCS is represented as a series of WSVi_jjj cards,
+wherein the sample points are stored as character strings, storing as
+many sample points as possible on each card, ignoring the card boundaries
+(i.e., a card may end in the middle of a number).  WCS attributes are likewise
+encoded as a series of WATi_jjj cards, giving the attributes for axis I as
+string data of the form "attribute = value", ignoring card boundaries.
+Multiple world coordinate systems (other than the physical and one world
+system) cannot be used with old format image headers.
+
+.nh 2
+Handling of the WCS by IMIO
+
+    When an image is opened by IMIO the image header is read, an MWCS
+descriptor is opened, and the stored MWCS is loaded into the MWCS descriptor
+from the image header.  If an image section has been opened the Lterm
+is then updated to reflect the additional linear transformation defined
+by the section.  The correct logical to physical or world transformation
+is then seen at the IMIO level, and will be propagated to a new image
+in a NEW_COPY image operation when the MWCS is copied to the new image.
+
+In the case of an image format which uses a FITS header, application of
+the section transform during an image open \fIdoes not\fR include updating
+of the FITS representation of the WCS.  There are two problems with doing
+so: all this editing of the FITS image of the header is inefficient
+unless absolutely necessary, and more seriously, if the image is opened
+READ_WRITE with an image section and the header is later updated, the
+stored WCS will be incorrect.  So, while the WCS as represented by the
+MWCS will always be correct, the FITS header parameters will reflect
+the WCS of the raw image ignoring the image section.  If it is necessary
+for some reason to update the FITS header in memory to reflect the image
+section, \fImw_saveim\fR may be called to perform the udpate.
+
+Propagation of the correct logical system in a NEW_COPY operation works
+because once the FITS header is copied, \fImw_saveim\fR is called to
+edit the header of the new image.
+
+.nh
+Implementation
+.nh 2
+Restrictions
+
+    Since there was not time to solve the general WCS problem with the MWCS
+interface, several restrictions were accepted for this version.  These are
+the following.
+.ls
+.ls o
+All WCS functions are built in (hard coded), hence the interface is not
+extensible at runtime and the only way to support new applications is
+through modification of the interface (by adding new function drivers).
+.le
+.ls o
+There is no support for modeling geometric distortions, except possibly
+in one dimension.
+.le
+.ls o
+There is no provision for storing more than one world coordinate system
+in FITS oriented image headers, although multiple WCS are supported internally
+by the interface, and are preserved and restored across \fImw_save\fR and
+\fImw_load\fR operations.
+.le
+.ls o
+Coordinate transforms involving dependent axes must includes all such axes
+explicitly in the transform.  Dependent axes are axes which are related,
+either by a rotation, or by a WCS function.  Operations which could subset
+dependent axis groups, and which are therefore disallowed, include setting
+up a transform with an AXES bitmap which excludes dependent axes, or more
+importantly, an image section involving dimensional reduction, where the
+axis to be removed is not independent.  This could happen, for example,
+if a two-dimensional image were rotated and one tried to open a
+one-dimensional section of the rotated image.
+.le
+.le
+
+All these problems can be solved given enough time, although the last problem
+mentioned becomes very complicated (perhaps intractable) when nonlinear world
+systems of dimension greater than three are involved.
+
+.nh 2
+Function Drivers
+
+    World coordinate systems are implemented in MWCS by providing something
+called a \fIfunction driver\fR for each function type, as specified by the
+\fIwtype\fR argument to \fImw_swtype\fR.  The \fIwtype\fR is the name of
+the function, and the name of the function driver.
+
+A function driver consists of the following procedures.  A given driver
+need not implement all driver procedures; procedures which are not used
+by a driver are set to NULL in the function driver table.
+
+.nf
+        operation                       syntax
+
+        FN_INIT                 wf_FCN_init (fc, dir)
+        FN_DESTROY           wf_FCN_destroy (fc)
+        FN_FWD                   wf_FCN_fwd (fc, pv, wv)
+        FN_INV                   wf_FCN_inv (fc, wv, pv)
+.fi
+
+where FCN is replaced by a 3 letter abbreviation for the function name,
+e.g., "smp" for the sampled WCS function, "tan" for the tangent plane
+projection etc.  This is only a suggested naming convention; the actual
+driver procedure names are arbitrary so long as name conflicts are
+avoided.
+
+The argument FC to each driver procedure is a pointer to the function call
+descriptor set up by \fImw_sctran\fR.  This consists of a number of standard
+fields followed by an area which is reserved for fields which are private
+to the function driver.  During compilation of a transformation, the function
+driver initialization procedure FN_INIT will be called to perform any function
+dependent initialization, e.g., processing of the attribute list for the
+axes assigned to the function, to input any function specific parameters.
+
+During runtime evaluation of a function call, FN_FWD will be called for a
+forward transformation (physical to world), and FN_INV for an inverse
+transformation (world to physical).  Note that the linear portion of the
+WCS, i.e., the CD matrix and all other linear terms except W (the CRVAL
+vector) are handled the same for all WCS functions, outside of the driver.
+Hence when the driver is called for a forward transformation, for example,
+the CD matrix and R vector (defining the reference point) will already
+have been applied to the input vector PV.
+
+To fully understand how function drivers are implemented it is probably
+simplest to study the existing drivers.
+
+.tp 40
+.sh
+Appendix A:  Interface Summary
+
+.nf
+		   mw = mw_open (bufptr|NULL, ndim)
+		 mw = mw_openim (im)
+		mw = mw_newcopy (mw)
+		       mw_close (mw)
+
+			mw_load (mw, bufptr)
+		  len = mw_save (mw, bufptr, buflen)
+	       mw_[load|save]im (mw, im)
+
+		 ct = mw_sctran (mw, system1, system2, axes)
+	  ndim = mw_gctran[r|d] (ct, ltm, ltv, axtype1, axtype2, maxdim)
+		      mw_ctfree (ct)
+
+	    x2 = mw_c1tran[r|d] (ct, x1)
+		 mw_v1tran[r|d] (ct, x1, x2, npts)
+		 mw_c2tran[r|d] (ct, x1,y1, x2,y2)
+		 mw_v2tran[r|d] (ct, x1,y1, x2,y2, npts)
+		  mw_ctran[r|d] (ct, p1, p2, ndim)
+		  mw_vtran[r|d] (ct, v1, v2, ndim, npts)
+
+	     mw_[s|g]lterm[r|d] (mw, ltm, ltv, ndim)
+	      mw_translate[r|d] (mw, ltv_1, ltm, ltv_2, ndim)
+		      mw_rotate (mw, theta, center, axes)
+		       mw_scale (mw, scale, axes)
+		       mw_shift (mw, shift, axes)
+
+		   mw_newsystem (mw, system, ndim)
+		 mw_[s|g]system (mw, system[, maxch])
+		  mw_[s|g]axmap (mw, axno, axval, ndim)
+		    mw_bindphys (mw)
+
+	     mw_[s|g]wterm[r|d] (mw, r, w, cd, ndim)
+		      mw_swtype (mw, axis, naxes, wtype, wattr)
+	     mw_[s|g]wsamp[r|d] (mw, axis, pv, wv, npts)
+		 mw_[s|g]wattrs (mw, axis, attribute, valstr[, maxch])
+
+		 mw_invert[r|d] (o_ltm, n_ltm, ndim)
+		   mw_mmul[r|d] (ltm_1, ltm_2, ltm_out, ndim)
+		   mw_vmul[r|d] (ltm, ltv_in, ltv_out, ndim)
+		    mw_glt[r|d] (v1, v2, ltm, ltv, ndim)
+
+			mw_seti (mw, what, ival)
+		ival = mw_stati (mw, what)
+			mw_show (mw, outfd, what)
+.fi
+.sp
+.endhelp
diff --git a/sys/mwcs/README b/sys/mwcs/README
new file mode 100644
index 00000000..10f44b60
--- /dev/null
+++ b/sys/mwcs/README
@@ -0,0 +1,47 @@
+MWCS Interface Summary
+
+
+		   mw = mw_open (bufptr|NULL, ndim)
+		 mw = mw_openim (im)
+		mw = mw_newcopy (mw)
+		       mw_close (mw)
+
+			mw_load (mw, bufptr)
+		  len = mw_save (mw, bufptr, buflen)
+	       mw_[load|save]im (mw, im)
+
+		 ct = mw_sctran (mw, system1, system2, axes)
+	  ndim = mw_gctran[r|d] (ct, ltm, ltv, axtype1, axtype2, maxdim)
+		      mw_ctfree (ct)
+
+	    x2 = mw_c1tran[r|d] (ct, x1)
+		 mw_v1tran[r|d] (ct, x1, x2, npts)
+		 mw_c2tran[r|d] (ct, x1,y1, x2,y2)
+		 mw_v2tran[r|d] (ct, x1,y1, x2,y2, npts)
+		  mw_ctran[r|d] (ct, p1, p2, ndim)
+		  mw_vtran[r|d] (ct, v1, v2, ndim, npts)
+
+	     mw_[s|g]lterm[r|d] (mw, ltm, ltv, ndim)
+	      mw_translate[r|d] (mw, ltv_1, ltm, ltv_2, ndim)
+		      mw_rotate (mw, theta, center, axes)
+		       mw_scale (mw, scale, axes)
+		       mw_shift (mw, shift, axes)
+
+		   mw_newsystem (mw, system, ndim)
+		 mw_[s|g]system (mw, system[, maxch])
+		  mw_[s|g]axmap (mw, axno, axval, ndim)
+		    mw_bindphys (mw)
+
+	     mw_[s|g]wterm[r|d] (mw, r, w, cd, ndim)
+		      mw_swtype (mw, axis, naxes, wtype, wattr)
+	     mw_[s|g]wsamp[r|d] (mw, axis, pv, wv, npts)
+		 mw_[s|g]wattrs (mw, axis, attribute, valstr[, maxch])
+
+		 mw_invert[r|d] (o_ltm, n_ltm, ndim)
+		   mw_mmul[r|d] (ltm_1, ltm_2, ltm_out, ndim)
+		   mw_vmul[r|d] (ltm, ltv_in, ltv_out, ndim)
+		    mw_glt[r|d] (v1, v2, ltm, ltv, ndim)
+
+			mw_seti (mw, what, ival)
+		ival = mw_stati (mw, what)
+			mw_show (mw, outfd, what)
diff --git a/sys/mwcs/gen/mkpkg b/sys/mwcs/gen/mkpkg
new file mode 100644
index 00000000..bc8fe837
--- /dev/null
+++ b/sys/mwcs/gen/mkpkg
@@ -0,0 +1,29 @@
+# Make the generic portion of MWCS.
+
+$checkout libex.a lib$
+$udate    libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	mwc1trand.x	../mwcs.h
+	mwc1tranr.x	../mwcs.h
+	mwc2trand.x	../mwcs.h
+	mwc2tranr.x	../mwcs.h
+	mwctrand.x	../mwcs.h
+	mwctranr.x	../mwcs.h
+	mwgctrand.x	../mwcs.h
+	mwgctranr.x	../mwcs.h
+	mwltrand.x	
+	mwltranr.x	
+	mwmmuld.x	
+	mwmmulr.x	
+	mwv1trand.x	../mwcs.h
+	mwv1tranr.x	../mwcs.h
+	mwv2trand.x	../mwcs.h
+	mwv2tranr.x	../mwcs.h
+	mwvmuld.x	
+	mwvmulr.x	
+	mwvtrand.x	
+	mwvtranr.x	
+	;
diff --git a/sys/mwcs/gen/mwc1trand.x b/sys/mwcs/gen/mwc1trand.x
new file mode 100644
index 00000000..af46e02d
--- /dev/null
+++ b/sys/mwcs/gen/mwc1trand.x
@@ -0,0 +1,24 @@
+include	"../mwcs.h"
+
+# MW_C1TRAN -- Optimized 1D coordinate transformation.
+
+double procedure mw_c1trand (a_ct, x)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	x			#I coordinates in input system
+
+double	y
+pointer	ct
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	# Perform the transformation; LNR is a simple linear transformation.
+	if (CT_TYPE(ct) == LNR) {
+	    return (Memd[CT_LTM(ct)] * x + Memd[CT_LTV(ct)])
+	} else {
+	    call mw_ctrand (a_ct, x, y, 1)
+	    return (y)
+	}
+end
diff --git a/sys/mwcs/gen/mwc1tranr.x b/sys/mwcs/gen/mwc1tranr.x
new file mode 100644
index 00000000..06ad0bf7
--- /dev/null
+++ b/sys/mwcs/gen/mwc1tranr.x
@@ -0,0 +1,24 @@
+include	"../mwcs.h"
+
+# MW_C1TRAN -- Optimized 1D coordinate transformation.
+
+real procedure mw_c1tranr (a_ct, x)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	x			#I coordinates in input system
+
+real	y
+pointer	ct
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	# Perform the transformation; LNR is a simple linear transformation.
+	if (CT_TYPE(ct) == LNR) {
+	    return (Memr[CT_LTM(ct)] * x + Memr[CT_LTV(ct)])
+	} else {
+	    call mw_ctranr (a_ct, x, y, 1)
+	    return (y)
+	}
+end
diff --git a/sys/mwcs/gen/mwc2trand.x b/sys/mwcs/gen/mwc2trand.x
new file mode 100644
index 00000000..0cb156bd
--- /dev/null
+++ b/sys/mwcs/gen/mwc2trand.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_C2TRAN -- Optimized 2D coordinate transformation.
+
+procedure mw_c2trand (a_ct, x1,y1, x2,y2)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	x1,y1			#I coordinates in input system
+double	x2,y2			#O coordinates in output system
+
+pointer	ct, ltm, ltv
+double	p1[2], p2[2]
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    x2 = Memd[ltm  ] * x1 + Memd[ltv  ]
+	    y2 = Memd[ltm+3] * y1 + Memd[ltv+1]
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    p1[1] = x1;  p1[2] = y1
+	    x2 = Memd[ltm  ] * p1[1] + Memd[ltm+1] * p1[2] + Memd[ltv  ]
+	    y2 = Memd[ltm+2] * p1[1] + Memd[ltm+3] * p1[2] + Memd[ltv+1]
+	} else {
+	    # General case involving one or more functional terms.
+	    p1[1] = x1;  p1[2] = y1
+	    call mw_ctrand (a_ct, p1, p2, 2)
+	    x2 = p2[1];  y2 = p2[2]
+	}
+end
diff --git a/sys/mwcs/gen/mwc2tranr.x b/sys/mwcs/gen/mwc2tranr.x
new file mode 100644
index 00000000..ef5b5ef7
--- /dev/null
+++ b/sys/mwcs/gen/mwc2tranr.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_C2TRAN -- Optimized 2D coordinate transformation.
+
+procedure mw_c2tranr (a_ct, x1,y1, x2,y2)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	x1,y1			#I coordinates in input system
+real	x2,y2			#O coordinates in output system
+
+pointer	ct, ltm, ltv
+real	p1[2], p2[2]
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    x2 = Memr[ltm  ] * x1 + Memr[ltv  ]
+	    y2 = Memr[ltm+3] * y1 + Memr[ltv+1]
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    p1[1] = x1;  p1[2] = y1
+	    x2 = Memr[ltm  ] * p1[1] + Memr[ltm+1] * p1[2] + Memr[ltv  ]
+	    y2 = Memr[ltm+2] * p1[1] + Memr[ltm+3] * p1[2] + Memr[ltv+1]
+	} else {
+	    # General case involving one or more functional terms.
+	    p1[1] = x1;  p1[2] = y1
+	    call mw_ctranr (a_ct, p1, p2, 2)
+	    x2 = p2[1];  y2 = p2[2]
+	}
+end
diff --git a/sys/mwcs/gen/mwctrand.x b/sys/mwcs/gen/mwctrand.x
new file mode 100644
index 00000000..70e575cc
--- /dev/null
+++ b/sys/mwcs/gen/mwctrand.x
@@ -0,0 +1,97 @@
+include	"../mwcs.h"
+
+# MW_CTRAN -- Transform a single N-dimensional point, using the optimized
+# transformation set up by a prior call to MW_SCTRAN.
+
+procedure mw_ctrand (a_ct, p1, p2, ndim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	p1[ndim]		#I coordinates of point in input system
+double	p2[ndim]		#O coordinates of point in output system
+int	ndim			#I dimensionality of point
+
+int	naxes, i, j
+pointer	ct, fc, ltm, ltv, d_ct
+double	v1[MAX_DIM], v2[MAX_DIM], iv[MAX_DIM], ov[MAX_DIM]
+errchk	zcall3
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	# Specially optimized cases.
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, ndim
+		p2[i] = Memd[ltm+(i-1)*(ndim+1)] * p1[i] + Memd[ltv+i-1]
+	    return
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Simple linear, rotated transformation.
+	    call mw_ltrand (p1, p2, Memd[ltm], Memd[ltv], ndim)
+	    return
+	}
+
+	# If we get here the transformation involves a call to one or more
+	# WCS functions.  In this general case, the transformation consists
+	# of zero or more calls to WCS functions to transform the input
+	# world coordinates to the linear input system, followed by a general
+	# linear transformation to the linear output system, followed by zero
+	# or more calls to WCS functions to do the forward transformation
+	# to generate the final output world coordinates.  The WCS function
+	# calls are always evaluated in double precision.
+
+	# Make zero or more WCS function calls for the different axes of the
+	# input system (inverse transform).
+
+	call achtdd (p1, iv, ndim)
+	do j = 1, CT_NCALLI(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCI(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = p1[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the vector IV, replacing the entries associated with
+	    # the WCS function by the transformed values.
+
+	    do i = 1, naxes
+		iv[FC_AXIS(fc,i)] = v2[i]
+	}
+
+	# Apply the general linear transformation.  We may as well do this in
+	# double since we already have to use double for the function calls.
+
+	d_ct = CT_D(a_ct)
+	call mw_ltrand (iv, ov, Memd[CT_LTM(d_ct)], Memd[CT_LTV(d_ct)], ndim)
+
+	# Make zero or more WCS function calls for the different axes of the
+	# output system (forward transform to final world system).
+
+	call achtdd (ov, p2, ndim)
+	do j = 1, CT_NCALLO(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCO(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = ov[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the final output vector, replacing the entries for the
+	    # function axes by their transformed values.
+
+	    do i = 1, naxes
+		p2[FC_AXIS(fc,i)] = v2[i]
+	}
+end
diff --git a/sys/mwcs/gen/mwctranr.x b/sys/mwcs/gen/mwctranr.x
new file mode 100644
index 00000000..0574a563
--- /dev/null
+++ b/sys/mwcs/gen/mwctranr.x
@@ -0,0 +1,97 @@
+include	"../mwcs.h"
+
+# MW_CTRAN -- Transform a single N-dimensional point, using the optimized
+# transformation set up by a prior call to MW_SCTRAN.
+
+procedure mw_ctranr (a_ct, p1, p2, ndim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	p1[ndim]		#I coordinates of point in input system
+real	p2[ndim]		#O coordinates of point in output system
+int	ndim			#I dimensionality of point
+
+int	naxes, i, j
+pointer	ct, fc, ltm, ltv, d_ct
+double	v1[MAX_DIM], v2[MAX_DIM], iv[MAX_DIM], ov[MAX_DIM]
+errchk	zcall3
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	# Specially optimized cases.
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, ndim
+		p2[i] = Memr[ltm+(i-1)*(ndim+1)] * p1[i] + Memr[ltv+i-1]
+	    return
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Simple linear, rotated transformation.
+	    call mw_ltranr (p1, p2, Memr[ltm], Memr[ltv], ndim)
+	    return
+	}
+
+	# If we get here the transformation involves a call to one or more
+	# WCS functions.  In this general case, the transformation consists
+	# of zero or more calls to WCS functions to transform the input
+	# world coordinates to the linear input system, followed by a general
+	# linear transformation to the linear output system, followed by zero
+	# or more calls to WCS functions to do the forward transformation
+	# to generate the final output world coordinates.  The WCS function
+	# calls are always evaluated in double precision.
+
+	# Make zero or more WCS function calls for the different axes of the
+	# input system (inverse transform).
+
+	call achtrd (p1, iv, ndim)
+	do j = 1, CT_NCALLI(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCI(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = p1[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the vector IV, replacing the entries associated with
+	    # the WCS function by the transformed values.
+
+	    do i = 1, naxes
+		iv[FC_AXIS(fc,i)] = v2[i]
+	}
+
+	# Apply the general linear transformation.  We may as well do this in
+	# double since we already have to use double for the function calls.
+
+	d_ct = CT_D(a_ct)
+	call mw_ltrand (iv, ov, Memd[CT_LTM(d_ct)], Memd[CT_LTV(d_ct)], ndim)
+
+	# Make zero or more WCS function calls for the different axes of the
+	# output system (forward transform to final world system).
+
+	call achtdr (ov, p2, ndim)
+	do j = 1, CT_NCALLO(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCO(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = ov[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the final output vector, replacing the entries for the
+	    # function axes by their transformed values.
+
+	    do i = 1, naxes
+		p2[FC_AXIS(fc,i)] = v2[i]
+	}
+end
diff --git a/sys/mwcs/gen/mwgctrand.x b/sys/mwcs/gen/mwgctrand.x
new file mode 100644
index 00000000..cfdca886
--- /dev/null
+++ b/sys/mwcs/gen/mwgctrand.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_GCTRAN -- Get a coordinate transformation compiled in a previous call
+# to mw_sctran.  When the transformation is compiled, it is specified by
+# naming the input and output systems and the axes over which the transform
+# is to be performed.  Rather than return this information, which the
+# application already knows, we return the actual transform, i.e., the
+# linear transformation matrix and translation vector comprising the linear
+# portion of the transform, and axis class arrays for the input and output
+# systems defining the axis types.  If the axis types are all zero, there
+# are no WCS function calls for any axis in either system, and the
+# transformation is completely linear (hence computable by the application
+# if desired, e.g., with mw_ltr).
+
+int procedure mw_gctrand (a_ct, o_ltm, o_ltv, axtype1, axtype2, maxdim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	o_ltm[ARB]		#O linear tranformation matrix
+double	o_ltv[ARB]		#O translation matrix
+int	axtype1[ARB]		#O axis types for input system
+int	axtype2[ARB]		#O axis types for output system
+int	maxdim			#I how much stuff to return
+
+pointer	ct
+int	pdim, ndim, i, j
+
+begin
+	ct = CT_D(a_ct)
+	pdim = CT_NDIM(ct)
+	ndim = min (pdim, maxdim)
+
+	# Output the goods.
+	do j = 1, ndim {
+	    axtype1[j] = WCS_AXCLASS(CT_WCSI(ct),j)
+	    axtype2[j] = WCS_AXCLASS(CT_WCSO(ct),j)
+	    o_ltv[j] = Memd[CT_LTV(ct)+(j-1)]
+	    do i = 1, ndim
+		o_ltm[(j-1)*ndim+i] = Memd[CT_LTM(ct)+(j-1)*pdim+(i-1)]
+	}
+
+	return (pdim)
+end
diff --git a/sys/mwcs/gen/mwgctranr.x b/sys/mwcs/gen/mwgctranr.x
new file mode 100644
index 00000000..7825c6df
--- /dev/null
+++ b/sys/mwcs/gen/mwgctranr.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_GCTRAN -- Get a coordinate transformation compiled in a previous call
+# to mw_sctran.  When the transformation is compiled, it is specified by
+# naming the input and output systems and the axes over which the transform
+# is to be performed.  Rather than return this information, which the
+# application already knows, we return the actual transform, i.e., the
+# linear transformation matrix and translation vector comprising the linear
+# portion of the transform, and axis class arrays for the input and output
+# systems defining the axis types.  If the axis types are all zero, there
+# are no WCS function calls for any axis in either system, and the
+# transformation is completely linear (hence computable by the application
+# if desired, e.g., with mw_ltr).
+
+int procedure mw_gctranr (a_ct, o_ltm, o_ltv, axtype1, axtype2, maxdim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	o_ltm[ARB]		#O linear tranformation matrix
+real	o_ltv[ARB]		#O translation matrix
+int	axtype1[ARB]		#O axis types for input system
+int	axtype2[ARB]		#O axis types for output system
+int	maxdim			#I how much stuff to return
+
+pointer	ct
+int	pdim, ndim, i, j
+
+begin
+	ct = CT_R(a_ct)
+	pdim = CT_NDIM(ct)
+	ndim = min (pdim, maxdim)
+
+	# Output the goods.
+	do j = 1, ndim {
+	    axtype1[j] = WCS_AXCLASS(CT_WCSI(ct),j)
+	    axtype2[j] = WCS_AXCLASS(CT_WCSO(ct),j)
+	    o_ltv[j] = Memr[CT_LTV(ct)+(j-1)]
+	    do i = 1, ndim
+		o_ltm[(j-1)*ndim+i] = Memr[CT_LTM(ct)+(j-1)*pdim+(i-1)]
+	}
+
+	return (pdim)
+end
diff --git a/sys/mwcs/gen/mwltrand.x b/sys/mwcs/gen/mwltrand.x
new file mode 100644
index 00000000..d35670c7
--- /dev/null
+++ b/sys/mwcs/gen/mwltrand.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_LTRAN -- Perform a general N-dimensional linear transformation, i.e.,
+# matrix multiply and translation.
+
+procedure mw_ltrand (p1, p2, ltm, ltv, ndim)
+
+double	p1[ndim]			#I input point
+double	p2[ndim]			#O transformed output point
+double	ltm[ndim,ndim]			#I linear transformation matrix
+double	ltv[ndim]			#I linear translation vector
+int	ndim				#I dimension of system
+
+int	i, j
+double	p3[MAX_DIM]
+
+begin
+	call amovd (p1, p3, ndim)
+	do j = 1, ndim {
+	    p2[j] = ltv[j]
+	    do i = 1, ndim
+		p2[j] = p2[j] + ltm[i,j] * p3[i]
+	}
+end
diff --git a/sys/mwcs/gen/mwltranr.x b/sys/mwcs/gen/mwltranr.x
new file mode 100644
index 00000000..9cafe4d2
--- /dev/null
+++ b/sys/mwcs/gen/mwltranr.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_LTRAN -- Perform a general N-dimensional linear transformation, i.e.,
+# matrix multiply and translation.
+
+procedure mw_ltranr (p1, p2, ltm, ltv, ndim)
+
+real	p1[ndim]			#I input point
+real	p2[ndim]			#O transformed output point
+real	ltm[ndim,ndim]			#I linear transformation matrix
+real	ltv[ndim]			#I linear translation vector
+int	ndim				#I dimension of system
+
+int	i, j
+real	p3[MAX_DIM]
+
+begin
+	call amovr (p1, p3, ndim)
+	do j = 1, ndim {
+	    p2[j] = ltv[j]
+	    do i = 1, ndim
+		p2[j] = p2[j] + ltm[i,j] * p3[i]
+	}
+end
diff --git a/sys/mwcs/gen/mwmmuld.x b/sys/mwcs/gen/mwmmuld.x
new file mode 100644
index 00000000..ae35f082
--- /dev/null
+++ b/sys/mwcs/gen/mwmmuld.x
@@ -0,0 +1,21 @@
+# MW_MMUL -- Matrix multiply.
+
+procedure mw_mmuld (a, b, c, ndim)
+
+double	a[ndim,ndim]		#I left input matrix
+double	b[ndim,ndim]		#I right input matrix
+double	c[ndim,ndim]		#O output matrix
+int	ndim			#I dimensionality of system
+
+int	i, j, k
+double	v
+
+begin
+	do j = 1, ndim
+	    do i = 1, ndim {
+		v = 0
+		do k = 1, ndim
+		    v = v + a[k,j] * b[i,k]
+		c[i,j] = v
+	    }
+end
diff --git a/sys/mwcs/gen/mwmmulr.x b/sys/mwcs/gen/mwmmulr.x
new file mode 100644
index 00000000..83e14d2c
--- /dev/null
+++ b/sys/mwcs/gen/mwmmulr.x
@@ -0,0 +1,21 @@
+# MW_MMUL -- Matrix multiply.
+
+procedure mw_mmulr (a, b, c, ndim)
+
+real	a[ndim,ndim]		#I left input matrix
+real	b[ndim,ndim]		#I right input matrix
+real	c[ndim,ndim]		#O output matrix
+int	ndim			#I dimensionality of system
+
+int	i, j, k
+real	v
+
+begin
+	do j = 1, ndim
+	    do i = 1, ndim {
+		v = 0
+		do k = 1, ndim
+		    v = v + a[k,j] * b[i,k]
+		c[i,j] = v
+	    }
+end
diff --git a/sys/mwcs/gen/mwv1trand.x b/sys/mwcs/gen/mwv1trand.x
new file mode 100644
index 00000000..3c3ac124
--- /dev/null
+++ b/sys/mwcs/gen/mwv1trand.x
@@ -0,0 +1,32 @@
+include	"../mwcs.h"
+
+# MW_V1TRAN -- Optimized 1D coordinate transformation for an array of points.
+
+procedure mw_v1trand (a_ct, x1, x2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	x1[ARB]			#I coordinates in input system
+double	x2[ARB]			#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct
+double	scale, offset
+errchk	mw_ctrand
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	scale  = Memd[CT_LTM(ct)]
+	offset = Memd[CT_LTV(ct)]
+
+	# Perform the transformation; case LNR is a simple linear transform.
+	if (CT_TYPE(ct) == LNR) {
+	    do i = 1, npts
+		x2[i] = scale * x1[i] + offset
+	} else {
+	    do i = 1, npts
+		call mw_ctrand (a_ct, x1[i], x2[i], 1)
+	}
+end
diff --git a/sys/mwcs/gen/mwv1tranr.x b/sys/mwcs/gen/mwv1tranr.x
new file mode 100644
index 00000000..045f6a33
--- /dev/null
+++ b/sys/mwcs/gen/mwv1tranr.x
@@ -0,0 +1,32 @@
+include	"../mwcs.h"
+
+# MW_V1TRAN -- Optimized 1D coordinate transformation for an array of points.
+
+procedure mw_v1tranr (a_ct, x1, x2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	x1[ARB]			#I coordinates in input system
+real	x2[ARB]			#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct
+real	scale, offset
+errchk	mw_ctranr
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	scale  = Memr[CT_LTM(ct)]
+	offset = Memr[CT_LTV(ct)]
+
+	# Perform the transformation; case LNR is a simple linear transform.
+	if (CT_TYPE(ct) == LNR) {
+	    do i = 1, npts
+		x2[i] = scale * x1[i] + offset
+	} else {
+	    do i = 1, npts
+		call mw_ctranr (a_ct, x1[i], x2[i], 1)
+	}
+end
diff --git a/sys/mwcs/gen/mwv2trand.x b/sys/mwcs/gen/mwv2trand.x
new file mode 100644
index 00000000..3a1cf329
--- /dev/null
+++ b/sys/mwcs/gen/mwv2trand.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_V2TRAN -- Optimized 2D coordinate transformation for an array of points.
+
+procedure mw_v2trand (a_ct, x1,y1, x2,y2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+double	x1[ARB],y1[ARB]		#I coordinates in input system
+double	x2[ARB],y2[ARB]		#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct, ltm, ltv
+double	p1[2], p2[2]
+errchk	mw_ctrand
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_D(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, npts {
+		x2[i] = Memd[ltm  ] * x1[i] + Memd[ltv  ]
+		y2[i] = Memd[ltm+3] * y1[i] + Memd[ltv+1]
+	    }
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		x2[i] = Memd[ltm  ] * p1[1] + Memd[ltm+1] * p2[1] +
+		    Memd[ltv  ]
+		y2[i] = Memd[ltm+2] * p1[1] + Memd[ltm+3] * p2[1] +
+		    Memd[ltv+1]
+	    }
+	} else {
+	    # General case involving one or more functional terms.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		call mw_ctrand (a_ct, p1, p2, 2)
+		x2[i] = p2[1];  y2[i] = p2[2]
+	    }
+	}
+end
diff --git a/sys/mwcs/gen/mwv2tranr.x b/sys/mwcs/gen/mwv2tranr.x
new file mode 100644
index 00000000..dc2fe58f
--- /dev/null
+++ b/sys/mwcs/gen/mwv2tranr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_V2TRAN -- Optimized 2D coordinate transformation for an array of points.
+
+procedure mw_v2tranr (a_ct, x1,y1, x2,y2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+real	x1[ARB],y1[ARB]		#I coordinates in input system
+real	x2[ARB],y2[ARB]		#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct, ltm, ltv
+real	p1[2], p2[2]
+errchk	mw_ctranr
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_R(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, npts {
+		x2[i] = Memr[ltm  ] * x1[i] + Memr[ltv  ]
+		y2[i] = Memr[ltm+3] * y1[i] + Memr[ltv+1]
+	    }
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		x2[i] = Memr[ltm  ] * p1[1] + Memr[ltm+1] * p2[1] +
+		    Memr[ltv  ]
+		y2[i] = Memr[ltm+2] * p1[1] + Memr[ltm+3] * p2[1] +
+		    Memr[ltv+1]
+	    }
+	} else {
+	    # General case involving one or more functional terms.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		call mw_ctranr (a_ct, p1, p2, 2)
+		x2[i] = p2[1];  y2[i] = p2[2]
+	    }
+	}
+end
diff --git a/sys/mwcs/gen/mwvmuld.x b/sys/mwcs/gen/mwvmuld.x
new file mode 100644
index 00000000..0af8dfa7
--- /dev/null
+++ b/sys/mwcs/gen/mwvmuld.x
@@ -0,0 +1,20 @@
+# MW_VMUL -- Vector multiply.
+
+procedure mw_vmuld (a, b, c, ndim)
+
+double	a[ndim,ndim]		#I input matrix
+double	b[ndim]			#I input vector
+double	c[ndim]			#O output vector
+int	ndim			#I system dimension
+
+int	i, j
+double	v
+
+begin
+	do j = 1, ndim {
+	    v = 0
+	    do i = 1, ndim
+		v = v + a[i,j] * b[i]
+	    c[j] = v
+	}
+end
diff --git a/sys/mwcs/gen/mwvmulr.x b/sys/mwcs/gen/mwvmulr.x
new file mode 100644
index 00000000..54a0776e
--- /dev/null
+++ b/sys/mwcs/gen/mwvmulr.x
@@ -0,0 +1,20 @@
+# MW_VMUL -- Vector multiply.
+
+procedure mw_vmulr (a, b, c, ndim)
+
+real	a[ndim,ndim]		#I input matrix
+real	b[ndim]			#I input vector
+real	c[ndim]			#O output vector
+int	ndim			#I system dimension
+
+int	i, j
+real	v
+
+begin
+	do j = 1, ndim {
+	    v = 0
+	    do i = 1, ndim
+		v = v + a[i,j] * b[i]
+	    c[j] = v
+	}
+end
diff --git a/sys/mwcs/gen/mwvtrand.x b/sys/mwcs/gen/mwvtrand.x
new file mode 100644
index 00000000..1a1cb662
--- /dev/null
+++ b/sys/mwcs/gen/mwvtrand.x
@@ -0,0 +1,18 @@
+# MW_VTRAN -- Transform an array of N-dimensional points, expressed as a
+# 2D vector where v[1,i] is point I of vector V.
+
+procedure mw_vtrand (ct, v1, v2, ndim, npts)
+
+pointer	ct			#I pointer to CTRAN descriptor
+double	v1[ndim,npts]		#I points to be transformed
+double	v2[ndim,npts]		#O vector to get the transformed points
+int	ndim			#I dimensionality of each point
+int	npts			#I number of points
+
+int	i
+errchk	mw_ctrand
+
+begin
+	do i = 1, npts
+	    call mw_ctrand (ct, v1[1,i], v2[1,i], ndim)
+end
diff --git a/sys/mwcs/gen/mwvtranr.x b/sys/mwcs/gen/mwvtranr.x
new file mode 100644
index 00000000..ca705c8b
--- /dev/null
+++ b/sys/mwcs/gen/mwvtranr.x
@@ -0,0 +1,18 @@
+# MW_VTRAN -- Transform an array of N-dimensional points, expressed as a
+# 2D vector where v[1,i] is point I of vector V.
+
+procedure mw_vtranr (ct, v1, v2, ndim, npts)
+
+pointer	ct			#I pointer to CTRAN descriptor
+real	v1[ndim,npts]		#I points to be transformed
+real	v2[ndim,npts]		#O vector to get the transformed points
+int	ndim			#I dimensionality of each point
+int	npts			#I number of points
+
+int	i
+errchk	mw_ctranr
+
+begin
+	do i = 1, npts
+	    call mw_ctranr (ct, v1[1,i], v2[1,i], ndim)
+end
diff --git a/sys/mwcs/imwcs.h b/sys/mwcs/imwcs.h
new file mode 100644
index 00000000..6266a1d1
--- /dev/null
+++ b/sys/mwcs/imwcs.h
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMWCS.H -- Definitions used by MW_SAVEIM and MW_LOADIM to encode and
+# decode the FITS (image header) version of a MWCS.
+
+define	DEF_MAXCARDS	128		# initial number of card descriptors
+define	INC_MAXCARDS	128		# increment if overflow occurs
+define	IDB_STARTVALUE	10		# column at which data field begins
+define	MAX_FITSCOLS	68		# max chars of data per FITS card
+define	DEF_BIGBUF	680		# initial size of "big" FITS buffer
+define	INC_BIGBUF	680		# initial size of "big" FITS buffer
+define	SZ_KWNAME	8		# size of FITS keyword
+define	SZ_VALSTR	21		# size of FITS value string
+define	SZ_SBUF		163840		# string buffer size (2048 WCS cards)
+define	SZ_OBUF		680		# biggest "attribute = value" string
+define	SZ_CARD		80		# card width, chars
+define	SZ_BIGSTR	MAX_FITSCOLS	# max size FITS string (one card)
+
+# WCS FITS main descriptor.
+define	LEN_IMWCS	310
+define	IW_IM		Memi[$1]	# image descriptor
+define	IW_NDIM		Memi[$1+1]	# image dimension
+define	IW_NCARDS	Memi[$1+2]	# number of WCS cards
+define	IW_CBUF		Memi[$1+3]	# card descriptors
+define	IW_MAXCARDS	Memi[$1+4]	# CBUF allocated length, cards
+define	IW_SBUF		Memi[$1+5]	# string buffer
+define	IW_SBUFLEN	Memi[$1+6]	# SBUF allocated length, chars
+define	IW_SBUFOP	Memi[$1+7]	# current offset in sbuf
+define	IW_CARD		(IW_CBUF($1)+(($2)-1)*LEN_CDES)
+	# (avail)
+define	IW_CROTA	Memr[P2R($1+9)]				# obsolete
+define	IW_CTYPE	Memi[$1+10+($2)-1]			# axtype (strp)
+define	IW_CRPIX	Memd[P2D($1+20)+($2)-1]			# CRPIXi
+define	IW_CRVAL	Memd[P2D($1+40)+($2)-1]			# CRVALi
+define	IW_CDELT	Memd[P2D($1+60)+($2)-1]			# CDELTi
+define	IW_CD		Memd[P2D($1+80)+(($3)-1)*7+($2)-1]	# CDi_j
+define	IW_LTV		Memd[P2D($1+180)+($2)-1]		# LTVi
+define	IW_LTM		Memd[P2D($1+200)+(($3)-1)*7+($2)-1]	# LTMi_j
+define	IW_WSVLEN	Memi[$1+300+($2)-1]			# WSVi_LEN
+
+# WCS FITS card descriptor.
+define	LEN_CDES	6
+define	C_TYPE		Memi[$1]	# card type
+define	C_AXIS		Memi[$1+1]	# wcs axis
+define	C_INDEX		Memi[$1+2]	# card number on axis
+define	C_CARDNO	Memi[$1+3]	# card number in header
+define	C_UPDATED	Memi[$1+4]	# card has been updated
+define	C_RP		Memi[$1+5]	# pointer to card
+
+# Card types.
+define	TY_CTYPE	1
+define	TY_CDELT	2
+define	TY_CROTA	3
+define	TY_CRPIX	4
+define	TY_CRVAL	5
+define	TY_CD		6
+define	TY_LTV		7
+define	TY_LTM		8
+define	TY_WATDATA	9
+define	TY_WSVLEN	10
+define	TY_WSVDATA	11
+define	TY_WCSDIM	12
+define	TY_WAXMAP	13
+
+# IW_RFITS definitions.
+define	RF_REFERENCE	0		# reference directly into header
+define	RF_COPY		1		# reference copies of header cards
diff --git a/sys/mwcs/iwcfits.x b/sys/mwcs/iwcfits.x
new file mode 100644
index 00000000..61e90b93
--- /dev/null
+++ b/sys/mwcs/iwcfits.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_CFITS -- Close (free) an IMWCS descriptor allocated previously by
+# IW_RFITS.
+
+procedure iw_cfits (iw)
+
+pointer	iw			#I pointer to IMWCS descriptor
+
+begin
+	if (IW_CBUF(iw) != NULL)
+	    call mfree (IW_CBUF(iw), TY_STRUCT)
+	if (IW_SBUF(iw) != NULL)
+	    call mfree (IW_SBUF(iw), TY_CHAR)
+	call mfree (iw, TY_STRUCT)
+end
diff --git a/sys/mwcs/iwctype.x b/sys/mwcs/iwctype.x
new file mode 100644
index 00000000..b37494ba
--- /dev/null
+++ b/sys/mwcs/iwctype.x
@@ -0,0 +1,126 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"imwcs.h"
+
+# IW_CARDTYPE -- Examine a FITS card to see if it is a WCS specification card,
+# and if so, return the card type, axis number, and index number.  ERR is
+# return if the card is not a WCS card.
+
+int procedure iw_cardtype (card, type, axis, index)
+
+char	card[ARB]		#I card to be examined
+int	type			#O card type
+int	axis			#O axis number or ERR
+int	index			#O index number or ERR
+
+int	ch1, ch2, ip
+int	strncmp(), ctoi()
+
+begin
+	ch1 = card[1]
+	ch2 = card[2]
+	type = ERR
+	ip = 6
+
+	# This is hardcoded for the sake of efficiency.
+	if (ch1 == 'C') {
+	    if (ch2 == 'D') {
+		if (IS_DIGIT (card[3])) {
+		    # CDi_j
+		    type = TY_CD
+		    axis = TO_INTEG (card[5])
+		    index = TO_INTEG (card[3])
+		    if (card[6] != ' ')
+			type = ERR
+		} else if (strncmp (card, "CDELT", 5) == 0) {
+		    # CDELTi
+		    type = TY_CDELT
+		    axis = TO_INTEG (card[6])
+		    index = ERR
+		    if (card[7] != ' ')
+			type = ERR
+		}
+	    } else if (ch2 == 'R') {
+		if (strncmp (card, "CROTA2", 6) == 0) {
+		    # CROTA2
+		    type = TY_CROTA
+		    axis = ERR
+		    index = ERR
+		} else if (strncmp (card, "CRPIX", 5) == 0) {
+		    # CRPIXi
+		    type = TY_CRPIX
+		    axis = TO_INTEG (card[6])
+		    index = ERR
+		    if (card[7] != ' ')
+			type = ERR
+		} else if (strncmp (card, "CRVAL", 5) == 0) {
+		    # CRVALi
+		    type = TY_CRVAL
+		    axis = TO_INTEG (card[6])
+		    index = ERR
+		    if (card[7] != ' ')
+			type = ERR
+		}
+	    } else if (ch2 == 'T') {
+		if (strncmp (card, "CTYPE", 5) == 0) {
+		    # CTYPEi
+		    type = TY_CTYPE
+		    axis = TO_INTEG (card[6])
+		    index = ERR
+		    if (card[7] != ' ')
+			type = ERR
+		}
+	    }
+	} else if (ch1 == 'L' && ch2 == 'T') {
+	    if (card[3] == 'V' && IS_DIGIT (card[4])) {
+		type = TY_LTV
+		axis = TO_INTEG (card[4])
+		index = ERR
+	    } else if (card[3] == 'M' && IS_DIGIT (card[4])) {
+		type = TY_LTM
+		axis = TO_INTEG (card[4])
+		index = TO_INTEG (card[6])
+	    }
+	} else if (ch1 == 'W') {
+	    if (ch2 == 'A') {
+		if (card[3] == 'T' && IS_DIGIT (card[4])) {
+		    type = TY_WATDATA
+		    axis = TO_INTEG (card[4])
+		    if (IS_DIGIT(card[5]))
+			ip = 5
+		    if (ctoi (card, ip, index) <= 0)
+			type = ERR
+		} else if (strncmp (card, "WAXMAP", 6) == 0) {
+		    type = TY_WAXMAP
+		    axis = ERR
+		    ip = 7
+		    if (ctoi (card, ip, index) <= 0)
+			type = ERR
+		}
+	    } else if (ch2 == 'C') {
+		if (strncmp (card, "WCSDIM", 6) == 0) {
+		    type = TY_WCSDIM
+		    axis = ERR
+		    index = ERR
+		}
+	    } else if (ch2 == 'S') {
+		if (card[3] == 'V' && IS_DIGIT (card[4])) {
+		    if (strncmp (card[5], "_LEN", 4) == 0) {
+			type = TY_WSVLEN
+			axis = TO_INTEG (card[4])
+			index = ERR
+		    } else {
+			if (IS_DIGIT(card[5]))
+			    ip = 5
+			if (ctoi (card, ip, index) > 0) {
+			    type = TY_WSVDATA
+			    axis = TO_INTEG (card[4])
+			}
+		    }
+		}
+	    }
+	}
+
+	return (type)
+end
diff --git a/sys/mwcs/iwewcs.x b/sys/mwcs/iwewcs.x
new file mode 100644
index 00000000..1f5ca72a
--- /dev/null
+++ b/sys/mwcs/iwewcs.x
@@ -0,0 +1,336 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<math.h>
+include	"mwcs.h"
+include	"imwcs.h"
+
+# IW_ENTERWCS -- Enter a WCS as represented in an IMWCS (FITS oriented)
+# wcs descriptor into an MWCS descriptor.  This routine is called by MW_LOADIM
+# after IW_RFITS has been called to scan a FITS image header to build the
+# IMWCS descriptor used as input here.
+
+procedure iw_enterwcs (mw, iw, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+pointer	iw			#I pointer to IMWCS descriptor
+int	ndim			#I system dimension
+
+double	theta
+char	ctype[8]
+bool	have_ltm, have_ltv, have_wattr
+int	axes[2], axis, npts, ch, ip, raax, decax, ax1, ax2, i, j, ea_type
+double	maxval
+pointer	sp, r, o_r, cd, ltm, cp, rp, bufp, pv, wv, o_cd, o_ltm, str
+
+bool	streq()
+pointer	iw_gbigfits(), iw_findcard()
+int	strncmp(), ctod(), strldxs(), envgeti()
+errchk	mw_swtermd, iw_gbigfits, malloc, mw_swtype, mw_swsampd
+define	samperr_ 91
+
+begin
+	call smark (sp)
+	call salloc (r, ndim, TY_DOUBLE)
+	call salloc (o_r, ndim, TY_DOUBLE)
+	call salloc (cd, ndim*ndim, TY_DOUBLE)
+	call salloc (ltm, ndim*ndim, TY_DOUBLE)
+	call salloc (o_cd, ndim*ndim, TY_DOUBLE)
+	call salloc (o_ltm, ndim*ndim, TY_DOUBLE)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	raax = 1
+	decax = 2
+
+	# Set any nonlinear functions on the axes.
+	do axis = 1, ndim {
+	    rp = IW_CTYPE(iw,axis)
+	    if (rp == NULL)
+		next
+
+	    # Get the value of CTYPEi.  Ignore case and treat '_' and '-'
+	    # as equivalent.
+
+	    do i = 1, 8 {
+		ch = Memc[rp+i-1]
+		if (ch == EOS || ch == ' ' || ch == '\'')
+		    break
+		else if (IS_UPPER(ch))
+		    ch = TO_LOWER(ch)
+		else if (ch == '_')
+		    ch = '-'
+		ctype[i] = ch
+	    }
+	    ctype[i] = EOS
+
+	    # Determine the type of function on this axis.
+	    if (streq (ctype, "linear")) {
+		;   # Linear is the default.
+
+	    } else if (streq (ctype, "sampled")) {
+		# A sampled WCS is an array of [P,W] points.
+
+		bufp = iw_gbigfits (iw, TY_WSVDATA, axis)
+		npts = IW_WSVLEN(iw,axis)
+		call malloc (pv, npts, TY_DOUBLE)
+		call malloc (wv, npts, TY_DOUBLE)
+
+		ip = 1
+		do i = 1, npts {
+		    if (ctod (Memc[bufp], ip, Memd[pv+i-1]) <= 0)
+			goto samperr_
+		    if (ctod (Memc[bufp], ip, Memd[wv+i-1]) <= 0) {
+samperr_		call eprintf (
+			    "Image %s, axis %d: Cannot read sampled WCS\n")
+			    call pargstr (IM_NAME(IW_IM(iw)))
+			    call pargi (axis)
+			break
+		    }
+		}
+
+		call mw_swtype (mw, axis, 1, "sampled", "")
+		call mw_swsampd (mw, axis, Memd[pv], Memd[wv], npts)
+
+		call mfree (wv, TY_DOUBLE)
+		call mfree (pv, TY_DOUBLE)
+		call mfree (bufp, TY_CHAR)
+
+	    } else if (strncmp (ctype, "ra--", 4) == 0) {
+		# The projections are restricted to two axes and are indicated
+		# by CTYPEi values such as, e.g., "RA---TAN" and "DEC--TAN"
+		# for the TAN projection.
+
+		raax = axis
+
+		# Locate the DEC axis.
+		decax = 0
+		do j = 1, ndim {
+		    cp = IW_CTYPE(iw,j)
+		    if (cp != NULL)
+			if (Memc[cp+3] == '-' || Memc[cp+3] == '_')
+			    if (strncmp (Memc[cp], "DEC", 3) == 0 ||
+				strncmp (Memc[cp], "dec", 3) == 0) {
+				decax = j
+				break
+			    }
+		}
+
+		# Did we find it?
+		if (decax == 0) {
+		    call eprintf (
+			"Image %s, axis %d: Cannot locate dec-%s axis\n")
+			call pargstr (IM_NAME(IW_IM(iw)))
+			call pargi (axis)
+			call pargstr (ctype[5])
+		}
+
+		# Get the function type.
+		ip = strldxs ("-", ctype) + 1
+
+		# Assign the function to the two axes.
+		axes[1] = axis
+		axes[2] = decax
+		call mw_swtype (mw, axes, 2, ctype[ip],
+		    "axis 1: axtype=ra axis 2: axtype=dec")
+
+	    } else if (strncmp (ctype, "dec-", 4) == 0) {
+		;   # This case is handled when RA-- is seen.
+
+	    } else if (strncmp (ctype[2], "lon-", 4) == 0) {
+		# The projections are restricted to two axes and are indicated
+		# by CTYPEi values such as, e.g., "xLON-TAN" and "xLAT-TAN"
+		# for the TAN projection. The letter x may be any character
+		# but must be the same for both the longitude and latitude
+		# axes. The standard values of x are G/g for galactic, E/e
+		# for ecliptic, and S/s for supergalactic coordinates.
+
+		raax = axis
+
+		# Locate the corresponding LAT axis.
+		decax = 0
+		do j = 1, ndim {
+		    cp = IW_CTYPE(iw,j)
+		    if (cp != NULL) {
+			if (Memc[cp+4] == '-' || Memc[cp+4] == '_') {
+			    if (strncmp (Memc[cp+1], "LAT", 3) == 0 ||
+			        strncmp (Memc[cp+1], "lat", 3) == 0) {
+			        decax = j
+			        break
+			    }
+			}
+		    }
+		}
+
+		# Did we find it?
+		if (decax == 0) {
+		    call eprintf (
+		        "Image %s, axis %d: Cannot locate %clat%s axis\n")
+		        call pargstr (IM_NAME(IW_IM(iw)))
+		        call pargi (axis)
+			call pargc (ctype[1])
+		        call pargstr (ctype[5])
+		}
+
+		# Get the function type.
+		ip = strldxs ("-", ctype) + 1
+
+		# Assign the function to the two axes.
+		axes[1] = axis
+		axes[2] = decax
+		call sprintf (Memc[str], SZ_LINE,
+		    "axis 1: axtype=%clon axis 2: axtype=%clat")
+		    call pargc (ctype[1])
+		    call pargc (ctype[1])
+		call mw_swtype (mw, axes, 2, ctype[ip], Memc[str])
+
+	    } else if (strncmp (ctype[2], "lat-", 4) == 0) { 
+		;   # This case is handled when xLON is seen.
+
+	    } else if (strncmp (ctype, "multispec", 8) == 0) {
+		# Multispec format image.  Axis 1,2 are coupled.
+		if (axis == 1) {
+		    axes[1] = 1;  axes[2] = 2
+		    call mw_swtype (mw, axes, 2, "multispec", "")
+		}
+
+	    } else {
+		# Since we have to be able to read any FITS header, we have
+		# no control over the value of CTYPEi.  If the value is
+		# something we don't know about, assume a LINEAR axis, using
+		# the given value of CTYPEi as the default axis label.
+
+		call mw_swattrs (mw, axis, "label", ctype)
+	    }
+	}
+
+	# Compute the CD matrix, or verify that one was read.  Either the
+	# CD matrix was input, the CROTA/CDELT representation was input,
+	# or nothing was input, in which case we have the identity matrix.
+
+	if (iw_findcard (iw, TY_CD, ERR, 0) == NULL) {
+	    # Initialize CD matrix to the identity matrix.  Can't use mw_mkidm
+	    # here as IW_CD is not dimensioned ndim.
+
+	    do j = 1, ndim {
+		do i = 1, ndim
+		    IW_CD(iw,i,j) = 0.0
+		IW_CD(iw,j,j) = 1.0
+	    }
+
+	    # Convert CDELT/CROTA to CD matrix.
+	    if (iw_findcard (iw, TY_CDELT, ERR, 0) != NULL) {
+		theta = DEGTORAD(IW_CROTA(iw))
+		ax1 = raax
+		ax2 = decax
+		IW_CD(iw,ax1,ax1) =  IW_CDELT(iw,ax1) * cos(theta)
+		IW_CD(iw,ax1,ax2) =  IW_CDELT(iw,ax1) * sin(theta)
+		IW_CD(iw,ax2,ax1) = -IW_CDELT(iw,ax2) * sin(theta)
+		IW_CD(iw,ax2,ax2) =  IW_CDELT(iw,ax2) * cos(theta)
+	    }
+
+	    do j = 1, ndim {
+		if (j == raax || j == decax)
+		    next
+		IW_CD(iw,j,j) =  IW_CDELT(iw,j)
+	    }
+	}
+
+	# Set axes with no scales to unit scales.  Issue a warning by
+	# default but use "wcs_matrix_err" to allow setting other error
+	# actions.
+
+	do i = 1, ndim {
+	    maxval = 0D0
+	    do j = 1, ndim
+		maxval = max (maxval, abs(IW_CD(iw,i,j)))
+	    if (maxval == 0D0) {
+		iferr (ea_type = envgeti ("wcs_matrix_err"))
+		    ea_type = EA_WARN
+		iferr {
+		    switch (ea_type) {
+		    case EA_FATAL, EA_ERROR:
+			call sprintf (Memc[str], SZ_FNAME, 
+			    "CD keywords for axis %d undefined")
+			    call pargi (i)
+			call error (SYS_MWMISSAX, Memc[str])
+		    case EA_WARN:
+			IW_CD(iw,i,i) = 1D0
+			call sprintf (Memc[str], SZ_LINE, 
+			    "setting CD%d_%d to %.4g")
+			    call pargi (i)
+			    call pargi (i)
+			    call pargd (IW_CD(iw,i,i))
+			call error (SYS_MWMISSAX, Memc[str])
+		    default:
+			IW_CD(iw,i,i) = 1D0
+		    }
+		} then
+		    call erract (ea_type)
+	    }
+	}
+
+	# Extract an NDIM submatrix from LTM and CD.
+	do j = 1, ndim
+	    do i = 1, ndim {
+		Memd[o_cd+(j-1)*ndim+(i-1)] = IW_CD(iw,i,j)
+		Memd[o_ltm+(j-1)*ndim+(i-1)] = IW_LTM(iw,i,j)
+	    }
+
+	# Set the linear portion of the Wterm.  First we have to transform
+	# it from the FITS logical->world representation to the MWCS
+	# physical->world form, by separating out the Lterm.  We have
+	# CD = CD' * LTM and R = inv(LTM) * (R' - LTV), where CD' and R' are
+	# the FITS versions of the MWCS CD matrix and R vector (CRPIX), and
+	# LTM and LTV are the Lterm rotation matrix and translation vector.
+
+	# First, determine if either LTM or LTV was specified in the header.
+	have_ltm = (iw_findcard (iw, TY_LTM, ERR, 0) != NULL)
+	have_ltv = (iw_findcard (iw, TY_LTV, ERR, 0) != NULL)
+
+	# Compute CD = CD' * LTM.
+	if (have_ltm)
+	    call mw_mmuld (Memd[o_cd], Memd[o_ltm], Memd[cd], ndim)
+	else
+	    call amovd (Memd[o_cd], Memd[cd], ndim*ndim)
+
+	# Compute R = inv(LTM) * (R' - LTV).
+	if (have_ltm || have_ltv) {
+	    call asubd (IW_CRPIX(iw,1), IW_LTV(iw,1), Memd[o_r], ndim)
+	    if (have_ltm) {
+		call mw_invertd (Memd[o_ltm], Memd[ltm], ndim)
+		call mw_vmuld (Memd[ltm], Memd[o_r], Memd[r], ndim)
+	    } else
+		call amovd (Memd[o_r], Memd[r], ndim)
+	} else
+	    call amovd (IW_CRPIX(iw,1), Memd[r], ndim)
+
+	# Set the Wterm.
+	call mw_swtermd (mw, Memd[r], IW_CRVAL(iw,1), Memd[cd], ndim)
+	# Process in any axis attributes.  The pseudo-axis 0 is used by
+	# any global WCS attributes.
+
+	do axis = 0, ndim {
+	    # Is there any attribute data for axis J?
+	    have_wattr = false
+	    do i = 1, IW_NCARDS(iw) {
+		cp = IW_CARD(iw,i)
+		if (C_TYPE(cp) == TY_WATDATA && C_AXIS(cp) == axis) {
+		    have_wattr = true
+		    break
+		}
+	    }
+
+	    # Reconstruct the attribute list and enter into MWCS.
+	    if (have_wattr) {
+		bufp = iw_gbigfits (iw, TY_WATDATA, axis)
+		call mw_swtype (mw, axis, 1, "", Memc[bufp])
+		call mfree (bufp, TY_CHAR)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/iwfind.x b/sys/mwcs/iwfind.x
new file mode 100644
index 00000000..e400f9ee
--- /dev/null
+++ b/sys/mwcs/iwfind.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_FINDCARD -- Search the card list in the IMWCS descriptor for a card of
+# the given type, with the given axis and index numbers.  Return a pointer to
+# the card if found, else NULL.
+
+pointer procedure iw_findcard (iw, type, axis, index)
+
+pointer	iw			#I pointer to IMWCS descriptor
+int	type			#I card type code
+int	axis			#I axis number, or <0 to ignore
+int	index			#I index number, or <=0 to ignore
+
+int	i
+pointer	cp
+
+begin
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    if (C_TYPE(cp) != type)
+		next
+	    if (axis >= 0)
+		if (C_AXIS(cp) != axis)
+		    next
+	    if (index > 0)
+		if (C_INDEX(cp) != index)
+		    next
+	    return (cp)
+	}
+
+	return (NULL)
+end
diff --git a/sys/mwcs/iwgbfits.x b/sys/mwcs/iwgbfits.x
new file mode 100644
index 00000000..5fd1810d
--- /dev/null
+++ b/sys/mwcs/iwgbfits.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_GBIGFITS -- Get a FITS string valued parameter of arbitrary size.
+# Since a FITS string stored as a single parameter is limited to at most
+# 69 characters, multiple FITS cards must be used to store longer strings.
+# At the time that this routine is called, IW_RFITS has already been called
+# to scan the FITS header and build up a list of WCS oriented cards,
+# including card types and pointers to the card data.  Our job is merely
+# to take these cards in order and concatenate the string values into one
+# large string, returning a pointer to the string as the function value.
+# The caller must later make a MFREE call to free this buffer.
+
+pointer procedure iw_gbigfits (iw, ctype, axis)
+
+pointer	iw			#I pointer to IMWCS descriptor
+int	ctype			#I card type
+int	axis			#I axis to which card refers
+
+int	ncards, i, j, ch
+pointer	cp, bp, ip, op, rp
+define	put_ 10
+
+begin
+	# How much space do we need?
+	ncards = 0
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    if (C_AXIS(cp) == axis && C_TYPE(cp) == ctype)
+		ncards = ncards + 1
+	}
+
+	# Allocate the space.
+	call calloc (bp, ncards * MAX_FITSCOLS, TY_CHAR)
+
+	# For successive cards 1, 2, 3, etc...
+	op = bp
+	do j = 1, ncards {
+	    # Find the card.
+	    rp = NULL
+	    do i = 1, IW_NCARDS(iw) {
+		cp = IW_CARD(iw,i)
+		if (C_AXIS(cp) != axis)
+		    next
+		if (C_INDEX(cp) != j)
+		    next
+		if (C_TYPE(cp) != ctype)
+		    next
+
+		rp = C_RP(cp)
+		break
+	    }
+
+	    # Append to the string buffer.
+	    if (rp != NULL) {
+		#call amovc (Memc[rp+IDB_STARTVALUE+1], Memc[op], MAX_FITSCOLS)
+		#op = op + MAX_FITSCOLS
+
+		do i = 1, MAX_FITSCOLS {
+		    ip = rp + IDB_STARTVALUE + i
+		    ch = Memc[ip]
+
+		    if (ch == EOS || ch == '\n') {
+			break
+		    } else if (ch == '\'') {
+			if (Memc[ip+1] == '\'') {
+			    goto put_
+			} else if (Memc[ip-1] == '\'') {
+			    ;
+			} else if (i > 1 && i <= MAX_FITSCOLS) {
+			    # If we're not at the end of the card, we have a
+			    # complete string, but add a space for appending
+			    # so we don't concatenate.
+			    Memc[op] = ' ' 
+			    op = op + 1
+			    break
+			} else
+			    break
+		    } else {
+put_			Memc[op] = ch
+			op = op + 1
+		    }
+		}
+	    }
+	}
+
+	Memc[op] = EOS
+	return (bp)
+end
diff --git a/sys/mwcs/iwparray.x b/sys/mwcs/iwparray.x
new file mode 100644
index 00000000..cb6cb0d9
--- /dev/null
+++ b/sys/mwcs/iwparray.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_PUTARRAY -- Output a double floating array as a sequence of FITS cards,
+# one value per card in the form "keyword = value", using the format string
+# given to format the name of the FITS keyword.
+
+procedure iw_putarray (iw, new, old, ndim, kw_format, kw_type, kw_index)
+
+pointer	iw			#I pointer to IMWCS descriptor
+double	new[ndim]		#I new array values
+double	old[ndim]		#I old array values from header
+int	ndim			#I image and WCS dimension
+char	kw_format[ARB]		#I format for encoding keyword name
+int	kw_type			#I IMWCS keyword type code
+int	kw_index		#I keword index or 0 if don't care
+
+int	axis
+pointer	cp, im
+char	kwname[SZ_KWNAME]
+bool	fp_equald()
+pointer	iw_findcard()
+errchk	imaddf, imputd
+
+begin
+	do axis = 1, ndim {
+	    # If new value is zero, no output, delete old card if present.
+	    if (fp_equald (new[axis], 0.0D0))
+		next
+
+	    # See if we read the card for this parameter.
+	    cp = iw_findcard (iw, kw_type, axis, kw_index)
+	    im = IW_IM(iw)
+
+	    # If value is unchanged, no need to do anything.
+	    if (fp_equald (new[axis], old[axis])) {
+		if (cp != NULL)
+		    C_UPDATED(cp) = YES
+		next
+	    }
+
+	    # Update the keyword in the image header.
+	    call sprintf (kwname, SZ_KWNAME, kw_format)
+		call pargi (axis)
+
+	    if (cp == NULL)
+		call imaddf (im, kwname, "d")
+	    call imputd (im, kwname, new[axis])
+	    if (cp != NULL)
+		C_UPDATED(cp) = YES
+	}
+end
diff --git a/sys/mwcs/iwpstr.x b/sys/mwcs/iwpstr.x
new file mode 100644
index 00000000..27b7e351
--- /dev/null
+++ b/sys/mwcs/iwpstr.x
@@ -0,0 +1,80 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"imwcs.h"
+
+# IW_PUTSTR -- Put an arbitrarily large string valued parameter to a FITS
+# header, using multiple FITS cards if necessary.  The input string value is
+# passed in as a byte stream file.
+
+procedure iw_putstr (fd, iw, axis, ctype, fmt1, fmt2, max_index)
+
+int	fd			#I input file
+pointer	iw			#I pointer to IMWCS descriptor
+int	axis			#I axis to which parameter belongs
+int	ctype			#I card type
+char	fmt1[ARB], fmt2[ARB]	#I keyword name formats
+int	max_index		#I use fmt2 if index > max_index
+
+bool	update
+int	index, nchars
+pointer	sp, bigstr, im, cp
+char	kwname[SZ_KWNAME]
+
+pointer	iw_findcard()
+int	read(), strncmp()
+errchk	read, imaddf, impstr
+
+begin
+	call smark (sp)
+	call salloc (bigstr, SZ_BIGSTR, TY_CHAR)
+
+	index = 0
+	im = IW_IM(iw)
+
+	repeat {
+	    # Get enough data to fit on a FITS card.
+	    nchars = read (fd, Memc[bigstr], SZ_BIGSTR)
+	    if (nchars <= 0)
+		break
+
+	    # Blank fill the last card if necessary.
+	    #while (nchars < SZ_BIGSTR && mod (nchars, SZ_BIGSTR) != 0) {
+	    #	Memc[bigstr+nchars] = ' '
+	    #	nchars = nchars + 1
+	    #}
+	    Memc[bigstr+nchars] = EOS
+
+	    index = index + 1
+	    cp = iw_findcard (iw, ctype, axis, index)
+
+	    update = true
+	    if (cp != NULL)
+		if (strncmp (Memc[C_RP(cp)+IDB_STARTVALUE+1],
+		    Memc[bigstr], SZ_BIGSTR) == 0) {
+		    update = false
+		}
+
+	    # Output the card.  The format string should contain two %d
+	    # fields, unless axis=ERR, in which case only the index value
+	    # is used.  If the index value is greater than max_index then
+	    # fmt2 is used as the print format, otherwise fmt1 is used.
+
+	    if (update) {
+		if (max_index > 0 && index > max_index)
+		    call sprintf (kwname, SZ_KWNAME, fmt2)
+		else
+		    call sprintf (kwname, SZ_KWNAME, fmt1)
+		if (axis >= 0)
+		    call pargi (axis)
+		call pargi (index)
+		if (cp == NULL)
+		    call imaddf (im, kwname, "c")
+		call impstr (im, kwname, Memc[bigstr])
+	    }
+
+	    if (cp != NULL)
+		C_UPDATED(cp) = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/iwrfits.x b/sys/mwcs/iwrfits.x
new file mode 100644
index 00000000..b70208a5
--- /dev/null
+++ b/sys/mwcs/iwrfits.x
@@ -0,0 +1,167 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include <ctype.h>
+include	<imio.h>
+include	"mwcs.h"
+include	"imwcs.h"
+
+# IW_RFITS -- Read a FITS image header into an IMWCS (FITS oriented) world
+# coordinate system descriptor.  For reasons of efficiency (especially due
+# to the possibly of large sampled WCS arrays) this is done with a single
+# pass through the header to get all the WCS data, with interpretation of
+# the data being a separate independent step.  A pointer to an IMWCS descriptor
+# is returned as the function value.  When no longer needed, this should be
+# freed with IW_CLOSE.  The dimensionality of the WCS is determined first
+# from the image dimensionality (which may be zero) and then overridden
+# if there is a WCSDIM card.  If the final dimensionality is zero then
+# the maximum axis of the WCS cards sets the dimensionality.
+
+
+pointer procedure iw_rfits (mw, im, mode)
+
+pointer	mw			#I pointer to MWCS descriptor
+pointer	im			#I pointer to image header
+int	mode			#I RF_REFERENCE or RF_COPY
+
+double	dval
+bool	omit, copy
+pointer	iw, idb, rp, cp, fp
+int	ndim, recno, ualen, type, axis, index, ip, temp, i
+
+pointer	idb_open()
+int	idb_nextcard(), iw_cardtype(), ctod(), ctoi()
+errchk	calloc, realloc, syserrs
+
+begin
+	ndim = max (IM_NDIM(im), IM_NPHYSDIM(im))
+	copy = (mode == RF_COPY)
+
+	# Allocate and initialize the FITS-WCS descriptor.
+	call calloc (iw, LEN_IMWCS, TY_STRUCT)
+	call calloc (IW_CBUF(iw), LEN_CDES * DEF_MAXCARDS, TY_STRUCT)
+
+	# Allocate string buffer if we must keep a local copy of the data.
+	if (copy) {
+	    call calloc (IW_SBUF(iw), SZ_SBUF, TY_CHAR)
+	    IW_SBUFLEN(iw) = SZ_SBUF
+	    IW_SBUFOP(iw) = 0
+	}
+
+	IW_MAXCARDS(iw) = DEF_MAXCARDS
+	IW_NDIM(iw) = ndim
+	IW_IM(iw) = im
+
+	# Scan the image header, examining successive cards to see if they
+	# are WCS specification cards, making an entry for each such card
+	# in the IMWCS descriptor.  The values of simple scalar valued cards
+	# are interpreted immediately and used to modify the default WCS
+	# data values established above.  For the array valued parameters we
+	# merely record the particulars for each card, leaving reconstruction
+	# of the array until all the cards have been located.
+
+	idb = idb_open (im, ualen)
+	recno = 0
+	while (idb_nextcard (idb, rp) != EOF) {
+	    recno = recno + 1
+	    if (iw_cardtype (Memc[rp], type, axis, index) <= 0)
+		next
+
+
+	    # Has this card already been seen?
+	    omit = false
+	    do i = 1, IW_NCARDS(iw) {
+		cp = IW_CARD(iw,i)
+		if (C_TYPE(cp) != type)
+		    next
+		if (C_AXIS(cp) != axis)
+		    next
+		if (C_INDEX(cp) != index)
+		    next
+		omit = true
+		break
+	    }
+
+	    # Ignore duplicate cards.
+	    if (omit)
+		next
+
+	    # Get another card descriptor.
+	    IW_NCARDS(iw) = IW_NCARDS(iw) + 1
+	    if (IW_NCARDS(iw) > IW_MAXCARDS(iw)) {
+		IW_MAXCARDS(iw) = IW_MAXCARDS(iw) + INC_MAXCARDS
+		call realloc (IW_CBUF(iw),
+		    IW_MAXCARDS(iw) * LEN_CDES, TY_STRUCT)
+		cp = IW_CARD(iw,IW_NCARDS(iw))
+		call aclri (Memi[cp],
+		    (IW_MAXCARDS(iw) - IW_NCARDS(iw) + 1) * LEN_CDES)
+	    }
+	    cp = IW_CARD(iw,IW_NCARDS(iw))
+
+	    C_TYPE(cp) = type
+	    C_AXIS(cp) = axis
+	    C_INDEX(cp) = index
+	    C_CARDNO(cp) = recno
+
+	    ndim = max (ndim, axis)
+
+	    # The FITS data must be copied into local storage if the header
+	    # will be edited, since otherwise the cards may move, invalidating
+	    # the pointer.  Always save whole cards; don't bother with an EOS
+	    # or newline between cards.
+
+	    if (copy) {
+		if (IW_SBUFOP(iw) + SZ_CARD > IW_SBUFLEN(iw))
+		    call syserrs (SYS_MWFITSOVFL, IM_NAME(im))
+		C_RP(cp) = IW_SBUF(iw) + IW_SBUFOP(iw)
+		call strcpy (Memc[rp], Memc[C_RP(cp)], SZ_CARD)
+		IW_SBUFOP(iw) = IW_SBUFOP(iw) + SZ_CARD
+	    } else
+		C_RP(cp) = rp
+
+	    # Decode the card value. 
+	    ip = IDB_STARTVALUE
+	    switch (type) {
+	    case TY_CTYPE:
+		fp = C_RP(cp) + ip
+		while (IS_WHITE(Memc[fp]) || Memc[fp] == '\'')
+		    fp = fp + 1
+		IW_CTYPE(iw,axis) =  fp
+	    case TY_CDELT:
+		if (ctod (Memc[rp], ip, IW_CDELT(iw,axis)) <= 0)
+		    IW_CDELT(iw,axis) = 0.0
+	    case TY_CROTA:
+		if (ctod (Memc[rp], ip, dval) > 0)
+		    IW_CROTA(iw) = dval
+	    case TY_CRPIX:
+		if (ctod (Memc[rp], ip, IW_CRPIX(iw,axis)) <= 0)
+		    IW_CRPIX(iw,axis) = 0.0
+	    case TY_CRVAL:
+		if (ctod (Memc[rp], ip, IW_CRVAL(iw,axis)) <= 0)
+		    IW_CRVAL(iw,axis) = 0.0
+	    case TY_CD:
+		if (ctod (Memc[rp], ip, IW_CD(iw,axis,index)) <= 0)
+		    IW_CD(iw,axis,index) = 0.0
+	    case TY_LTV:
+		if (ctod (Memc[rp], ip, IW_LTV(iw,axis)) <= 0)
+		    IW_LTV(iw,axis) = 0.0
+	    case TY_LTM:
+		if (ctod (Memc[rp], ip, IW_LTM(iw,axis,index)) <= 0)
+		    IW_LTM(iw,axis,index) = 0.0
+	    case TY_WSVLEN:
+		if (ctoi (Memc[rp], ip, IW_WSVLEN(iw,axis)) <= 0)
+		    IW_WSVLEN(iw,axis) = 0
+	    case TY_WCSDIM:
+		if (ctoi (Memc[rp], ip, temp) > 0)
+		    IW_NDIM(iw) = temp
+	    }
+	}
+
+	# Set dimension to the maximum axis seen.
+	if (IW_NDIM(iw) == 0)
+	    IW_NDIM(iw) = ndim
+
+	call idb_close (idb)
+	return (iw)
+end
diff --git a/sys/mwcs/iwsaxmap.x b/sys/mwcs/iwsaxmap.x
new file mode 100644
index 00000000..47ad9f09
--- /dev/null
+++ b/sys/mwcs/iwsaxmap.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"mwcs.h"
+
+# IW_SETAXMAP -- If the reference image was opened with an image section,
+# modify the Lterm to reflect the section transformation, and enable the
+# axis map if any dimensional reduction was involved.
+
+procedure iw_setaxmap (mw, im)
+
+pointer	mw			#I pointer to MWCS descriptor
+pointer	im			#I pointer to reference image
+
+double	v
+pointer	sp, ltv_1, ltv_2, ltm
+int	wcsdim, ndim, physax, i, j
+int	axno[MAX_DIM], axval[MAX_DIM]
+int	o_axno[MAX_DIM], o_axval[MAX_DIM]
+int	n_axno[MAX_DIM], n_axval[MAX_DIM]
+
+begin
+	# If there is no section we don't need to do anything.
+	if (IM_SECTUSED(im) == NO)
+	    return
+
+	call smark (sp)
+
+	ndim = IM_NPHYSDIM(im)
+	call salloc (ltv_1, ndim, TY_DOUBLE)
+	call salloc (ltv_2, ndim, TY_DOUBLE)
+	call salloc (ltm, ndim*ndim, TY_DOUBLE)
+
+	# The section transformation is  px = VSTEP * lx + VOFF, specifying
+	# the transformation from logical to physical image coordinates.
+	# The IMIO axis map is given by j=VMAP[i], mapping logical axis I to
+	# physical axis J.  Hence the physical to logical transformation in
+	# terms of IMIO units is given by  lx = (1/VSTEP) * px + (-VOFF/VSTEP).
+	# Since the section transform forbids rotation the axes are independent.
+
+	call aclrd (Memd[ltv_1], ndim)
+	call aclrd (Memd[ltm], ndim * ndim)
+
+	do i = 1, ndim {
+	    if (IM_VSTEP(im,i) == 0)
+		v = 1.0D0
+	    else
+		v = 1.0D0 / IM_VSTEP(im,i)
+
+	    Memd[ltm+(i-1)*ndim+i-1] = v
+	    Memd[ltv_2+(i-1)] = -(IM_VOFF(im,i) * v)
+	}
+
+	# Enter the section transformation.  This uses the axis map, but the
+	# transformation is defined in terms of the physical image matrix,
+	# which is defined by the old axis map before modification by the new
+	# image section.  Hence we must do this step before editing the axis
+	# map below.
+
+	call mw_translated (mw, Memd[ltv_1], Memd[ltm], Memd[ltv_2], ndim)
+
+	# Compute the axis map for the active image section relative to the
+	# current physical image matrix.
+
+	do j = 1, ndim {
+	    for (i=1;  i <= IM_NDIM(im);  i=i+1)
+		if (IM_VMAP(im,i) == j)
+		    break
+	    if (i > IM_NDIM(im)) {
+		axno[j] = 0
+		axval[j] = IM_VOFF(im,j)
+	    } else {
+		axno[j] = i
+		axval[j] = 0
+	    }
+	}
+
+	# Get the old axis map for the WCS.  In the general case the WCS can
+	# have a dimension higher than the current image, i.e. if the current
+	# image was produced by extracting a section of an image of higher
+	# dimension.  In such a case the WCS will have an axis map relating
+	# the physical axes of the current image back to the original physical
+	# system.
+
+	wcsdim = MI_NDIM(mw)
+	call mw_gaxmap (mw, o_axno, o_axval, wcsdim)
+
+	# Combine the old axis map and the axis map for the current image
+	# section.  The old axis map physical->logical mapping maps WCS
+	# physical axes to logical axes, which are the physical axes of the
+	# current image.  The axis map for the current image section maps the
+	# physical axes of the current image to the logical axes of the
+	# section.  An axis removed in the WCS axis map is not visible in the
+	# image axno/axval computed above; the corresponding axis in the
+	# combined WCS axis map is unchanged.  The remaining axes are subject
+	# to remapping by the mage axno/axval.  This mapping may set any of
+	# the axes to a constant to further reduce the dimensionality of the
+	# logical system, however that does not concern us here, we just pass
+	# on the combined axno/axval vectors to mw_saxmap.
+
+        do i = 1, wcsdim {
+            if (o_axno[i] == 0) {
+                n_axno[i] = 0
+                n_axval[i] = o_axval[i]
+            } else {
+                physax = o_axno[i]
+                n_axno[i] = axno[physax]
+                n_axval[i] = axval[physax]
+            }
+	}
+
+	# Set the new axis map.
+	call mw_saxmap (mw, n_axno, n_axval, wcsdim)
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mkpkg b/sys/mwcs/mkpkg
new file mode 100644
index 00000000..05179ce6
--- /dev/null
+++ b/sys/mwcs/mkpkg
@@ -0,0 +1,120 @@
+# Make the MWCS interface.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+generic:
+	$set G = "$$generic -k -p gen/ -t rd"
+	$ifolder (gen/mwc1tranr.x, mwc1tran.gx)	$(G) mwc1tran.gx	$endif
+	$ifolder (gen/mwc2tranr.x, mwc2tran.gx)	$(G) mwc2tran.gx	$endif
+	$ifolder (gen/mwctranr.x, mwctran.gx)	$(G) mwctran.gx		$endif
+	$ifolder (gen/mwgctranr.x, mwgctran.gx)	$(G) mwgctran.gx	$endif
+	$ifolder (gen/mwltranr.x, mwltran.gx)	$(G) mwltran.gx		$endif
+	$ifolder (gen/mwmmulr.x, mwmmul.gx)	$(G) mwmmul.gx		$endif
+	$ifolder (gen/mwv1tranr.x, mwv1tran.gx)	$(G) mwv1tran.gx	$endif
+	$ifolder (gen/mwv2tranr.x, mwv2tran.gx)	$(G) mwv2tran.gx	$endif
+	$ifolder (gen/mwvmulr.x, mwvmul.gx)	$(G) mwvmul.gx		$endif
+	$ifolder (gen/mwvtranr.x, mwvtran.gx)	$(G) mwvtran.gx		$endif
+	;
+
+zzdebug:
+zzdebug.e:
+	$checkout libex.a lib$
+	$update   libex.a
+	$checkin  libex.a lib$
+
+	$omake zzdebug.x <mwset.h> imwcs.h
+	$link -z zzdebug.o
+	;
+
+libex.a:
+	# $set xflags = "$(xflags) -qfx"
+	$ifeq (USE_GENERIC, yes)  $call generic  $endif
+	@gen
+
+	iwcfits.x	imwcs.h
+	iwctype.x	imwcs.h <ctype.h>
+	iwewcs.x	imwcs.h mwcs.h <ctype.h> <imhdr.h> <imio.h> <math.h>
+	iwfind.x	imwcs.h
+	iwgbfits.x	imwcs.h
+	iwparray.x	imwcs.h
+	iwpstr.x	imwcs.h
+	iwrfits.x	imwcs.h mwcs.h <imhdr.h> <imio.h> <ctype.h>
+	iwsaxmap.x	mwcs.h <imhdr.h> <imio.h>
+	mwallocd.x	mwcs.h
+	mwallocs.x	mwcs.h
+	mwclose.x	mwcs.h <error.h>
+	mwctfree.x	mwcs.com mwcs.h
+	mwfindsys.x	mwcs.h
+	mwflookup.x	mwcs.com mwcs.h
+	mwgaxlist.x	mwcs.h
+	mwgaxmap.x	mwcs.h
+	mwgltermd.x	mwcs.h
+	mwgltermr.x	mwcs.h
+	mwgsys.x	mwcs.h
+	mwgwattrs.x	mwcs.h
+	mwgwsampd.x	mwcs.h
+	mwgwsampr.x	mwcs.h
+	mwgwtermd.x	mwcs.h
+	mwgwtermr.x	mwcs.h
+	mwinvertd.x	
+	mwinvertr.x	
+	mwload.x	mwcs.h mwsv.h <error.h> <mach.h>
+	mwloadim.x	imwcs.h mwcs.h <error.h> <imhdr.h> <imio.h>
+	mwlu.x		<mach.h>
+	mwmkidmd.x	
+	mwmkidmr.x	
+	mwnewcopy.x	mwcs.h
+	mwnewsys.x	mwcs.h
+	mwopen.x	mwcs.h <error.h>
+	mwopenim.x	<imhdr.h> <imio.h>
+	mwrefstr.x	mwcs.h
+	mwrotate.x	mwcs.h
+	mwsave.x	mwcs.h mwsv.h <mach.h>
+	mwsaveim.x	imwcs.h mwcs.com mwcs.h <imhdr.h> <imio.h> <mach.h>
+	mwsaxmap.x	mwcs.h
+	mwscale.x	mwcs.h
+	mwsctran.x	mwcs.com mwcs.h <error.h> <mach.h>
+	mwsdefwcs.x	mwcs.h <mwset.h>
+	mwseti.x	mwcs.h <mwset.h>
+	mwshift.x	mwcs.h
+	mwshow.x	mwcs.h <imio.h>
+	mwsltermd.x	mwcs.h
+	mwsltermr.x	mwcs.h
+	mwssys.x	mwcs.h
+	mwstati.x	mwcs.h <mach.h> <mwset.h>
+	mwswattrs.x	mwcs.h
+	mwswsampd.x	mwcs.h
+	mwswsampr.x	mwcs.h
+	mwswtermd.x	mwcs.h
+	mwswtermr.x	mwcs.h
+	mwswtype.x	mwcs.h <ctype.h>
+	mwtransd.x	mwcs.h
+	mwtransr.x	
+	wfait.x		mwcs.h <math.h>
+	wfarc.x		mwcs.h <math.h>
+	wfcar.x		mwcs.h <math.h>
+	wfcsc.x		mwcs.h <math.h>
+	wfdecaxis.x	mwcs.h
+	wfgls.x		mwcs.h <math.h>
+	wfgsurfit.x
+	wfinit.x	mwcs.com mwcs.h
+	wfmer.x		mwcs.h <math.h>
+	wfmol.x		mwcs.h <math.h>
+	wfmspec.x	mwcs.h <imhdr.h>
+	wfpar.x		mwcs.h <math.h>
+	wfpco.x		mwcs.h <math.h>
+	wfqsc.x		mwcs.h <math.h>
+	wfsamp.x	mwcs.h
+	wfsin.x		mwcs.h <math.h>
+	wfstg.x		mwcs.h <math.h>
+	wftan.x		mwcs.h <math.h>
+	wftnx.x		mwcs.h <math.h>
+	wftpv.x		mwcs.h <math.h>
+	wftsc.x		mwcs.h <math.h>
+	wfzea.x		mwcs.h <math.h>
+	wfzpn.x		mwcs.h <math.h>
+	wfzpx.x		mwcs.h <math.h>
+	;
diff --git a/sys/mwcs/mwallocd.x b/sys/mwcs/mwallocd.x
new file mode 100644
index 00000000..96623015
--- /dev/null
+++ b/sys/mwcs/mwallocd.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_ALLOCD -- Allocate space in the data buffer.  The size of the buffer
+# is automatically increased if necessary.  Note that reallocation of the
+# buffer may cause it to move, hence all data items are referred to by their
+# offset in the buffer, rather than by an absolute pointer.
+
+int procedure mw_allocd (mw, nelem)
+
+pointer	mw		#I pointer to MWCS descriptor
+int	nelem		#I number of elements to alloc space for
+
+int	dbufused, dbuflen, offset
+errchk	realloc
+
+begin
+	dbufused = MI_DBUFUSED(mw)
+	dbuflen  = MI_DBUFLEN(mw)
+	offset   = dbufused + 1
+
+	# Increase buffer size?
+	if (dbufused + nelem > dbuflen) {
+	    dbuflen = dbuflen + INC_SZDBUF
+	    while (dbufused + nelem > dbuflen)
+		dbuflen = dbuflen + INC_SZDBUF
+
+	    call realloc (MI_DBUF(mw), dbuflen, TY_DOUBLE)
+	    call aclrd (D(mw,offset), dbuflen - offset + 1)
+	    MI_DBUFLEN(mw) = dbuflen
+	}
+
+	# Allocate the space in the buffer, and return the buffer offset
+	# of the allocated area.
+
+	MI_DBUFUSED(mw) = max (0, dbufused + nelem)
+	return (offset)
+end
diff --git a/sys/mwcs/mwallocs.x b/sys/mwcs/mwallocs.x
new file mode 100644
index 00000000..6a9caf5b
--- /dev/null
+++ b/sys/mwcs/mwallocs.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_ALLOCS -- Allocate space in the global string buffer.  The size of the
+# buffer is automatically increased if necessary.  Note that reallocation of
+# the buffer may cause it to move, hence all data items are referred to by
+# their offset in the buffer, rather than by an absolute pointer.  Since we
+# are allocating space for string data, a space for the EOS is automatically
+# allocated in addition to space for the indicated number of data chars.
+
+int procedure mw_allocs (mw, nchars)
+
+pointer	mw		#I pointer to MWCS descriptor
+int	nchars		#I number of chars to allocate space for
+
+int	sbufused, sbuflen, offset, nelem
+errchk	realloc
+
+begin
+	sbufused = MI_SBUFUSED(mw)
+	sbuflen  = MI_SBUFLEN(mw)
+	offset   = sbufused + 1
+	nelem	 = nchars + 1
+
+	# Increase buffer size?
+	if (sbufused + nelem > sbuflen) {
+	    sbuflen = sbuflen + INC_SZSBUF
+	    while (sbufused + nelem > sbuflen)
+		sbuflen = sbuflen + INC_SZSBUF
+
+	    call realloc (MI_SBUF(mw), sbuflen, TY_CHAR)
+	    call aclrc (S(mw,offset), sbuflen - offset + 1)
+	    MI_SBUFLEN(mw) = sbuflen
+	}
+
+	# Allocate the space in the buffer, and return the buffer offset
+	# of the allocated area.
+
+	MI_SBUFUSED(mw) = max (0, sbufused + nelem)
+	return (offset)
+end
diff --git a/sys/mwcs/mwc1tran.gx b/sys/mwcs/mwc1tran.gx
new file mode 100644
index 00000000..b2cbbcfc
--- /dev/null
+++ b/sys/mwcs/mwc1tran.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_C1TRAN -- Optimized 1D coordinate transformation.
+
+PIXEL procedure mw_c1tran$t (a_ct, x)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	x			#I coordinates in input system
+
+PIXEL	y
+pointer	ct
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	# Perform the transformation; LNR is a simple linear transformation.
+	if (CT_TYPE(ct) == LNR) {
+	    return (Mem$t[CT_LTM(ct)] * x + Mem$t[CT_LTV(ct)])
+	} else {
+	    call mw_ctran$t (a_ct, x, y, 1)
+	    return (y)
+	}
+end
diff --git a/sys/mwcs/mwc2tran.gx b/sys/mwcs/mwc2tran.gx
new file mode 100644
index 00000000..1c757d31
--- /dev/null
+++ b/sys/mwcs/mwc2tran.gx
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_C2TRAN -- Optimized 2D coordinate transformation.
+
+procedure mw_c2tran$t (a_ct, x1,y1, x2,y2)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	x1,y1			#I coordinates in input system
+PIXEL	x2,y2			#O coordinates in output system
+
+pointer	ct, ltm, ltv
+PIXEL	p1[2], p2[2]
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    x2 = Mem$t[ltm  ] * x1 + Mem$t[ltv  ]
+	    y2 = Mem$t[ltm+3] * y1 + Mem$t[ltv+1]
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    p1[1] = x1;  p1[2] = y1
+	    x2 = Mem$t[ltm  ] * p1[1] + Mem$t[ltm+1] * p1[2] + Mem$t[ltv  ]
+	    y2 = Mem$t[ltm+2] * p1[1] + Mem$t[ltm+3] * p1[2] + Mem$t[ltv+1]
+	} else {
+	    # General case involving one or more functional terms.
+	    p1[1] = x1;  p1[2] = y1
+	    call mw_ctran$t (a_ct, p1, p2, 2)
+	    x2 = p2[1];  y2 = p2[2]
+	}
+end
diff --git a/sys/mwcs/mwclose.x b/sys/mwcs/mwclose.x
new file mode 100644
index 00000000..441a78c2
--- /dev/null
+++ b/sys/mwcs/mwclose.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <error.h>
+include "mwcs.h"
+
+# MW_CLOSE -- Close a MWCS descriptor and deallocate all resources used
+# by the descriptor.  Any CTRAN descriptors which have been opened on
+# the MWCS are automatically closed if not already manually closed by
+# the application.
+
+procedure mw_close (mw)
+
+pointer	mw		#U pointer to MWCS descriptor
+
+int	i
+pointer	ct
+
+begin
+	# Free any still allocated CTRAN descriptors.
+	do i = 1, MAX_CTRAN {
+	    ct = MI_CTRAN(mw,i)
+	    if (ct != NULL)
+		iferr (call mw_ctfree (ct))
+		    call erract (EA_WARN)
+	}
+
+	# Free the string and data buffers.
+	if (MI_SBUF(mw) != NULL)
+	    call mfree (MI_SBUF(mw), TY_CHAR)
+	if (MI_DBUF(mw) != NULL)
+	    call mfree (MI_DBUF(mw), TY_DOUBLE)
+
+	# Free the main descriptor.
+	call mfree (mw, TY_STRUCT)
+end
diff --git a/sys/mwcs/mwcs.com b/sys/mwcs/mwcs.com
new file mode 100644
index 00000000..80c2b79d
--- /dev/null
+++ b/sys/mwcs/mwcs.com
@@ -0,0 +1,8 @@
+# MWCS common.  Used for things that are global and don't change, i.e.,
+# the WCS function drivers.
+
+int	fn_nfn				# number of defined functions
+int	fn_table[LEN_FN,MAX_FN]		# function table
+char	fn_names[SZ_FNNAME,MAX_FN]	# function names
+
+common	/mwcscom/ fn_nfn, fn_table, fn_names
diff --git a/sys/mwcs/mwcs.h b/sys/mwcs/mwcs.h
new file mode 100644
index 00000000..b202159e
--- /dev/null
+++ b/sys/mwcs/mwcs.h
@@ -0,0 +1,152 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MWCS.H -- Global (internal) definitions for the mini-WCS interface.
+
+define	MWCS_MAGIC	4D57X		# identifies MWCS descriptors
+define	DEF_SZSBUF	512		# initial string buffer size
+define	INC_SZSBUF	512		# increment string buffer size
+define	DEF_SZDBUF	64		# initial double buffer size
+define	INC_SZDBUF	64		# increment double buffer size
+define	MAX_DIM		7		# max dimension of a wcs
+define	MAX_WCS		8		# max wcs per mwcs
+define	MAX_WATTR	512		# max attributes per wcs
+define	MAX_CTRAN	20		# max runtime ctran descriptors
+define	MAX_CALL	7		# max CTRAN function calls
+define	MAX_FUNC	7		# max WCS function descriptors
+define	MAX_WCSFD	10		# max loaded WCS function drivers
+define	MAX_FN		32		# max MWCS function drivers
+define	SZ_FNNAME	20		# max size function name
+define	SZ_ATNAME	20		# max size attribute name
+
+# MWCS descriptor.  This consists of the base descriptor, global string
+# buffer, global data buffer (TY_DOUBLE), and separately allocated buffers
+# for each runtime CT (coordinate transformation) descriptor.  All character
+# data is stored in SBUF.  All floating point data is stored as type double
+# in DBUF (this does not mean that coordinate transformations are necessarily
+# carried out in double precision).  All string and floating data is
+# referenced in the base descriptor by its index in the appropriate data
+# buffer, to make the descriptor invariant with respect to relocation of DBUF.
+# To keep things simple, space is preallocated for a fixed number of WCS,
+# and for each WCS, for a fixed number of attributes.
+
+define	LEN_BASEMWCS	70
+define	LEN_WCS		1626 # (depends upon MAX_WATTR)
+define	LEN_MWCS	(LEN_BASEMWCS+LEN_WCS*MAX_WCS)
+define	MI_LEN		(LEN_BASEMWCS+LEN_WCS*MI_NWCS($1))
+
+define	MI_MAGIC	Memi[$1]		# magic marker
+define	MI_NDIM		Memi[$1+1]		# wcs physical dimension
+define	MI_WCS		Memi[$1+2]		# pointer to current wcs
+define	MI_NWCS		Memi[$1+3]		# number of wcs defined
+define	MI_REFIM	Memi[$1+4]		# reference image, if any
+define	MI_SBUF		Memi[$1+5]		# string buffer pointer
+define	MI_SBUFLEN	Memi[$1+6]		# string buffer alloclen
+define	MI_SBUFUSED	Memi[$1+7]		# string buffer chars used
+define	MI_DBUF		Memi[$1+8]		# double buffer pointer
+define	MI_DBUFLEN	Memi[$1+9]		# double buffer alloclen
+define	MI_DBUFUSED	Memi[$1+10]		# double buffer doubles used
+define	MI_USEAXMAP	Memi[$1+11]		# enable axis mapping
+define	MI_NLOGDIM	Memi[$1+12]		# dimension of logical system
+	# (available)
+define	MI_LTV		Memi[$1+18]		# dbuf index of LT vector
+define	MI_LTM		Memi[$1+19]		# dbuf index of LT matrix
+define	MI_AXNO		Memi[$1+20+($2)-1]	# axis map, log[phys]
+define	MI_AXVAL	Memi[$1+30+($2)-1]	# axis value, if axno[i]=0
+define	MI_PHYSAX	Memi[$1+40+($2)-1]	# inverted map, phys[log]
+define	MI_CTRAN	Memi[$1+50+($2)-1]	# ctran descriptor pointers
+define	MI_WCSP		($1+70+(($2)-1)*LEN_WCS)
+
+# WCS descriptor.  This consists of a base structure, used to index string
+# and double data which is stored in the global buffers SBUF and DBUF.
+# An array of WCS descriptors is preallocated in the main MWCS descriptor.
+
+define	WCS_NDIM	Memi[$1]		# dimension of world system
+define	WCS_SYSTEM	Memi[$1+1]		# sbuf index of system name
+define	WCS_AXCLASS	Memi[$1+2+($2)-1]	# axis type, 0 or FUNC index
+define	WCS_R		Memi[$1+10]		# dbuf index of R array
+define	WCS_W		Memi[$1+11]		# dbuf index of W array
+define	WCS_CD		Memi[$1+12]		# dbuf index of CD matrix
+define	WCS_NPTS	Memi[$1+20+($2)-1]	# number of points in wsampv
+define	WCS_PV		Memi[$1+30+($2)-1]	# wsamp physical vector
+define	WCS_WV		Memi[$1+40+($2)-1]	# wsamp world vector
+define	WCS_NFUNC	Memi[$1+49]		# number of functions
+define	WCS_FUNC	($1+50+(($2)-1)*5)	# function descriptors
+define	WCS_NWATTR	Memi[$1+89]		# number of wcs attributes
+define	WCS_WATTR	($1+90+(($2)-1)*3)	# pointer to wattr substruct
+
+# WCS function descriptor.
+define	LEN_WF		5
+define	WF_FN		Memi[$1]		# function code
+define	WF_NAXES	Memi[$1+1]		# number of axes 
+define	WF_AXIS		Memi[$1+2+($2)-1]	# axes function applies to
+
+# Function type flags.
+define	FORWARD		0			# forward transform (P->W)
+define	INVERSE		1			# inverse transform (W->P)
+
+# WCS attribute descriptor.
+define	LEN_AT		3
+define	AT_AXIS		Memi[$1]		# wcs axis which owns attribute
+define	AT_NAME		Memi[$1+1]		# sbuf index of name string
+define	AT_VALUE	Memi[$1+2]		# sbuf index of value string
+
+# CTRAN descriptor.  Prepared when a coordinate transformation is set up
+# with mw_sctran.  The transformation is optimized and reduced to a series
+# of matrix multiply, translate, wcs function call etc. instructions as
+# described by this descriptor.  Both single and double precision versions
+# of the transform are prepared, with the application deciding at runtime
+# which precision routine to call.
+
+define	LEN_CTBASE	(20+MAX_CALL*LEN_FC*2)
+
+define	CT_D		($1)			# pointer to type double CT
+define	CT_R		Memi[$1]		# pointer to type real CT
+define	CT_MW		Memi[$1+1]		# pointer back to MWCS
+define	CT_WCSI		Memi[$1+2]		# pointer back to system 1
+define	CT_WCSO		Memi[$1+3]		# pointer back to system 2
+define	CT_TYPE		Memi[$1+4]		# ctran type (optimized)
+define	CT_NDIM		Memi[$1+5]		# ctran physical dimension
+define	CT_LTM		Memi[$1+6]		# pointer to rot matrix
+define	CT_LTV		Memi[$1+7]		# pointer to translation vector
+define	CT_NCALLI	Memi[$1+8]		# number of function calls
+define	CT_NCALLO	Memi[$1+9]		# number of function calls
+define	CT_AXIS		Memi[$1+10+($2)-1]	# maps ctran axis to physax
+define	CT_FCI		($1+20+(($2)-1)*LEN_FC)	# pointer to CALL descriptor
+define	CT_FCO		($1+188+(($2)-1)*LEN_FC)
+
+# CT types, for optimized transforms.
+define	LNR		0			# linear, not rotated
+define	LRO		1			# linear, rotated
+define	GEN		2			# general catch all case
+
+# Base FC (WCS function call) descriptor.  This consists of a base descriptor
+# common to all WCS functions, followed by a private area reserved for use
+# by the WCS function.
+
+define	LEN_FC		64
+define	FC_CT		Memi[$1]		# CTRAN descriptor
+define	FC_WCS		Memi[$1+1]		# WCS descriptor
+define	FC_WF		Memi[$1+2]		# WF descriptor
+define	FC_FCN		Memi[$1+3]		# epa of WCS function
+define	FC_NAXES	Memi[$1+4]		# number of axes in call
+define	FC_AXIS		Memi[$1+5+($2)-1]	# CTRAN axes used by FC (max 3)
+define	FCU		8			# offset to first user field
+
+# WCS function driver (stored in common).
+define	LEN_FN		5			# length of function driver
+define	FN_FLAGS	fn_table[1,$1]		# function type flags
+define	FN_INIT		fn_table[2,$1]		# initialize call descriptor
+define	FN_DESTROY	fn_table[3,$1]		# free call descriptor
+define	FN_FWD		fn_table[4,$1]		# forward transformation
+define	FN_INV		fn_table[5,$1]		# inverse transformation
+define	FN_NAME		fn_names[1,$1]		# function name
+
+# WCS function codes.
+define	F_LINEAR	0			# linear (not a function)
+
+# WCS function type bit flags.
+define	F_RADEC		01B			# function requires RA/DEC
+
+# Handy macros.
+define	S		Memc[MI_SBUF($1)+$2-1]	# string = S(mw,i)
+define	D		Memd[MI_DBUF($1)+$2-1]	# double = D(mw,i)
diff --git a/sys/mwcs/mwctfree.x b/sys/mwcs/mwctfree.x
new file mode 100644
index 00000000..e495320b
--- /dev/null
+++ b/sys/mwcs/mwctfree.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_CTFREE -- Free a CTRAN (coordinate transformation) descriptor.  We keep
+# track of all allocated CTRAN descriptors in the parent MWCS descriptor, and
+# NULL the saved entry for a descriptor when it is freed, thus guaranteeing
+# that a descriptor will be freed only once.
+
+procedure mw_ctfree (ct)
+
+pointer	ct		#U pointer to CTRAN descriptor
+
+int	fn, i, j
+pointer mw, fc
+include	"mwcs.com"
+
+begin
+	if (ct != NULL) {
+	    mw = CT_MW(ct)
+	    if (mw != NULL)
+		do i = 1, MAX_CTRAN
+		    if (MI_CTRAN(mw,i) == ct) {
+			# Free private storage for any input WCS functions.
+			do j = 1, CT_NCALLI(ct) {
+			    fc = CT_FCI(ct,j)
+			    fn = WF_FN(FC_WF(fc))
+			    if (FN_DESTROY(fn) != NULL)
+				call zcall1 (FN_DESTROY(fn), fc)
+			}
+			# Free private storage for any output WCS functions.
+			do j = 1, CT_NCALLO(ct) {
+			    fc = CT_FCO(ct,j)
+			    fn = WF_FN(FC_WF(fc))
+			    if (FN_DESTROY(fn) != NULL)
+				call zcall1 (FN_DESTROY(fn), fc)
+			}
+			# Free the main CTRAN descriptor.
+			call mfree (ct, TY_STRUCT)
+			MI_CTRAN(mw,i) = NULL
+			break
+		    }
+	}
+end
diff --git a/sys/mwcs/mwctran.gx b/sys/mwcs/mwctran.gx
new file mode 100644
index 00000000..2d614569
--- /dev/null
+++ b/sys/mwcs/mwctran.gx
@@ -0,0 +1,99 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_CTRAN -- Transform a single N-dimensional point, using the optimized
+# transformation set up by a prior call to MW_SCTRAN.
+
+procedure mw_ctran$t (a_ct, p1, p2, ndim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	p1[ndim]		#I coordinates of point in input system
+PIXEL	p2[ndim]		#O coordinates of point in output system
+int	ndim			#I dimensionality of point
+
+int	naxes, i, j
+pointer	ct, fc, ltm, ltv, d_ct
+double	v1[MAX_DIM], v2[MAX_DIM], iv[MAX_DIM], ov[MAX_DIM]
+errchk	zcall3
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	# Specially optimized cases.
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, ndim
+		p2[i] = Mem$t[ltm+(i-1)*(ndim+1)] * p1[i] + Mem$t[ltv+i-1]
+	    return
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Simple linear, rotated transformation.
+	    call mw_ltran$t (p1, p2, Mem$t[ltm], Mem$t[ltv], ndim)
+	    return
+	}
+
+	# If we get here the transformation involves a call to one or more
+	# WCS functions.  In this general case, the transformation consists
+	# of zero or more calls to WCS functions to transform the input
+	# world coordinates to the linear input system, followed by a general
+	# linear transformation to the linear output system, followed by zero
+	# or more calls to WCS functions to do the forward transformation
+	# to generate the final output world coordinates.  The WCS function
+	# calls are always evaluated in double precision.
+
+	# Make zero or more WCS function calls for the different axes of the
+	# input system (inverse transform).
+
+	call acht$td (p1, iv, ndim)
+	do j = 1, CT_NCALLI(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCI(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = p1[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the vector IV, replacing the entries associated with
+	    # the WCS function by the transformed values.
+
+	    do i = 1, naxes
+		iv[FC_AXIS(fc,i)] = v2[i]
+	}
+
+	# Apply the general linear transformation.  We may as well do this in
+	# double since we already have to use double for the function calls.
+
+	d_ct = CT_D(a_ct)
+	call mw_ltrand (iv, ov, Memd[CT_LTM(d_ct)], Memd[CT_LTV(d_ct)], ndim)
+
+	# Make zero or more WCS function calls for the different axes of the
+	# output system (forward transform to final world system).
+
+	call achtd$t (ov, p2, ndim)
+	do j = 1, CT_NCALLO(ct) {
+	    # Get pointer to function call descriptor.
+	    fc = CT_FCO(ct,j)
+	    naxes = FC_NAXES(fc)
+
+	    # Extract the coordinate vector for the function call.
+	    do i = 1, naxes
+		v1[i] = ov[FC_AXIS(fc,i)]
+
+	    # Call the WCS function.
+	    call zcall3 (FC_FCN(fc), fc, v1, v2)
+
+	    # Edit the final output vector, replacing the entries for the
+	    # function axes by their transformed values.
+
+	    do i = 1, naxes
+		p2[FC_AXIS(fc,i)] = v2[i]
+	}
+end
diff --git a/sys/mwcs/mwfindsys.x b/sys/mwcs/mwfindsys.x
new file mode 100644
index 00000000..e997fc42
--- /dev/null
+++ b/sys/mwcs/mwfindsys.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_FINDSYS -- Lookup the named world coordinate system and return a pointer
+# to the WCS descriptor, or NULL if the system is not defined.
+
+pointer procedure mw_findsys (mw, system)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	system[ARB]		#I system to be looked up
+
+int	i
+pointer	wp
+bool	streq()
+
+begin
+	# Search the list of defined systems.
+	do i = 1, MI_NWCS(mw) {
+	    wp = MI_WCSP(mw,i)
+	    if (WCS_SYSTEM(wp) != NULL)
+		if (streq (S(mw,WCS_SYSTEM(wp)), system))
+		    return (wp)
+	}
+
+	# Not found.
+	return (NULL)
+end
diff --git a/sys/mwcs/mwflookup.x b/sys/mwcs/mwflookup.x
new file mode 100644
index 00000000..e9f28f8d
--- /dev/null
+++ b/sys/mwcs/mwflookup.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_FLOOKUP -- Look up the named WCS function in the driver table, and
+# return the index of the associated driver.  ERR is returned if the named
+# function is not found, 0 if the function is "linear", otherwise the
+# index of the function driver is returned.
+
+int procedure mw_flookup (mw, fnname)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	fnname[ARB]		#I function to be lookup up
+
+int	fn, i
+bool	streq()
+include	"mwcs.com"
+
+begin
+	if (streq (fnname, "linear"))
+	    return (F_LINEAR)
+
+	fn = ERR
+	do i = 1, fn_nfn
+	    if (streq (fnname, FN_NAME(i))) {
+		fn = i
+		break
+	    }
+	
+	return (fn)
+end
diff --git a/sys/mwcs/mwgaxlist.x b/sys/mwcs/mwgaxlist.x
new file mode 100644
index 00000000..01b4b394
--- /dev/null
+++ b/sys/mwcs/mwgaxlist.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_GAXLIST -- Get the physical axis list.  The bitflags in AXBITS define the
+# axes in the logical system; run these through the axis map (if enabled) to
+# get the list of physical axes for which the transformation is to be prepared.
+
+procedure mw_gaxlist (mw, axbits, axis, naxes)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axbits			#I bitflag marking the desired axes
+int	axis[MAX_DIM]		#O output axis array
+int	naxes			#O number of axes in axis array
+
+int	bits, ax, i
+int	bitupk()
+
+begin
+	bits = axbits
+	if (bits == 0)
+	    bits = 177B		# default to all axes
+
+	naxes = 0
+	do i = 1, MAX_DIM
+	    if (bitupk (bits, i, 1) != 0) {
+		if (MI_USEAXMAP(mw) == YES) {
+		    if (i > MI_NLOGDIM(mw))
+			break
+		    # Map logical axis to physical axis.
+		    ax = MI_PHYSAX(mw,i)
+		} else {
+		    if (i > MI_NDIM(mw))
+			break
+		    ax = i
+		}
+
+		# Add physical axis to axis list.
+		naxes = naxes + 1
+		axis[naxes] = ax
+	    }
+end
diff --git a/sys/mwcs/mwgaxmap.x b/sys/mwcs/mwgaxmap.x
new file mode 100644
index 00000000..b888b433
--- /dev/null
+++ b/sys/mwcs/mwgaxmap.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GAXMAP -- Get the axis map.  This assigns a logical axis axno[i] to
+# each physical axis I.  If axno[i]=0, the value of the physical axis
+# coordinate is the constant axval[i], and the dimension of the logical
+# system is reduced by one.
+
+procedure mw_gaxmap (mw, axno, axval, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axno[ndim]		#O physical -> logical axis assignments
+int	axval[ndim]		#O value of physical axis if axno=0
+int	ndim			#I physical dimension of axis map
+
+int	i
+errchk	syserrs
+
+begin
+	# Verify dimension.
+	if (MI_NDIM(mw) != ndim)
+	    call syserrs (SYS_MWNDIM, "mw_gaxmap")
+
+	# Copy out the current axis map.
+	do i = 1, ndim {
+	    axno[i] = MI_AXNO(mw,i)
+	    axval[i] = MI_AXVAL(mw,i)
+	}
+end
diff --git a/sys/mwcs/mwgctran.gx b/sys/mwcs/mwgctran.gx
new file mode 100644
index 00000000..10a35179
--- /dev/null
+++ b/sys/mwcs/mwgctran.gx
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_GCTRAN -- Get a coordinate transformation compiled in a previous call
+# to mw_sctran.  When the transformation is compiled, it is specified by
+# naming the input and output systems and the axes over which the transform
+# is to be performed.  Rather than return this information, which the
+# application already knows, we return the actual transform, i.e., the
+# linear transformation matrix and translation vector comprising the linear
+# portion of the transform, and axis class arrays for the input and output
+# systems defining the axis types.  If the axis types are all zero, there
+# are no WCS function calls for any axis in either system, and the
+# transformation is completely linear (hence computable by the application
+# if desired, e.g., with mw_ltr).
+
+int procedure mw_gctran$t (a_ct, o_ltm, o_ltv, axtype1, axtype2, maxdim)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	o_ltm[ARB]		#O linear tranformation matrix
+PIXEL	o_ltv[ARB]		#O translation matrix
+int	axtype1[ARB]		#O axis types for input system
+int	axtype2[ARB]		#O axis types for output system
+int	maxdim			#I how much stuff to return
+
+pointer	ct
+int	pdim, ndim, i, j
+
+begin
+	ct = CT_$T(a_ct)
+	pdim = CT_NDIM(ct)
+	ndim = min (pdim, maxdim)
+
+	# Output the goods.
+	do j = 1, ndim {
+	    axtype1[j] = WCS_AXCLASS(CT_WCSI(ct),j)
+	    axtype2[j] = WCS_AXCLASS(CT_WCSO(ct),j)
+	    o_ltv[j] = Mem$t[CT_LTV(ct)+(j-1)]
+	    do i = 1, ndim
+		o_ltm[(j-1)*ndim+i] = Mem$t[CT_LTM(ct)+(j-1)*pdim+(i-1)]
+	}
+
+	return (pdim)
+end
diff --git a/sys/mwcs/mwgltermd.x b/sys/mwcs/mwgltermd.x
new file mode 100644
index 00000000..e2db0c0d
--- /dev/null
+++ b/sys/mwcs/mwgltermd.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GLTERMD -- Get the current Lterm, double precision version.
+
+procedure mw_gltermd (mw, ltm, ltv, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	ltm[ndim,ndim]		#O linear transformation matrix
+double	ltv[ndim]		#O translation vector
+int	ndim			#I dimensionality of system
+
+int	i
+errchk	syserrs
+
+begin
+	# The dimensionality of the data must match that of the current Lterm.
+	if (ndim != MI_NDIM(mw))
+	    call syserrs (SYS_MWNDIM, "mw_gltermd")
+
+	# Copy out the data.  Default to a unitary transformation if the
+	# Lterm has not been initialized.
+
+	if (MI_LTM(mw) == NULL) {
+	    call aclrd (ltm, ndim*ndim)
+	    do i = 1, ndim
+		ltm[i,i] = 1.0D0
+	} else
+	    call amovd (D(mw,MI_LTM(mw)), ltm, ndim*ndim)
+
+	if (MI_LTV(mw) == NULL)
+	    call aclrd (ltv, ndim)
+	else
+	    call amovd (D(mw,MI_LTV(mw)), ltv, ndim)
+end
diff --git a/sys/mwcs/mwgltermr.x b/sys/mwcs/mwgltermr.x
new file mode 100644
index 00000000..290bc6dc
--- /dev/null
+++ b/sys/mwcs/mwgltermr.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GLTERMR -- Get the current Lterm, single precision version.
+
+procedure mw_gltermr (mw, ltm, ltv, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	ltm[ndim,ndim]		#O linear transformation matrix
+real	ltv[ndim]		#O translation vector
+int	ndim			#I dimensionality of system
+
+int	i
+errchk	syserrs
+
+begin
+	# The dimensionality of the data must match that of the current Lterm.
+	if (ndim != MI_NDIM(mw))
+	    call syserrs (SYS_MWNDIM, "mw_gltermr")
+
+	# Copy out the data.  Default to a unitary transformation if the
+	# Lterm has not been initialized.
+
+	if (MI_LTM(mw) == NULL) {
+	    call aclrr (ltm, ndim*ndim)
+	    do i = 1, ndim
+		ltm[i,i] = 1.0
+	} else
+	    call achtdr (D(mw,MI_LTM(mw)), ltm, ndim*ndim)
+
+	if (MI_LTV(mw) == NULL)
+	    call aclrr (ltv, ndim)
+	else
+	    call achtdr (D(mw,MI_LTV(mw)), ltv, ndim)
+end
diff --git a/sys/mwcs/mwgsys.x b/sys/mwcs/mwgsys.x
new file mode 100644
index 00000000..a1559b8f
--- /dev/null
+++ b/sys/mwcs/mwgsys.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_GSYSTEM -- Return the name of the current default world system.
+
+procedure mw_gsystem (mw, outstr, maxch)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	outstr[ARB]		#O receives name of world system
+int	maxch			#I max chars out
+
+pointer	wp
+
+begin
+	wp = MI_WCS(mw)
+	call strcpy (S(mw,WCS_SYSTEM(wp)), outstr, maxch)
+end
diff --git a/sys/mwcs/mwgwattrs.x b/sys/mwcs/mwgwattrs.x
new file mode 100644
index 00000000..3a5fbf80
--- /dev/null
+++ b/sys/mwcs/mwgwattrs.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWATTRS -- Get the string value of the named WCS attribute for axis N.
+# If the attribute name is a number N, attribute number N is returned instead,
+# allowing the attributes to be listed without knowing their names.
+
+procedure mw_gwattrs (mw, axis, attribute, valstr, maxch)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis to which attribute belongs
+char	attribute[SZ_ATNAME]	#U attribute name
+char	valstr[ARB]		#O attribute value
+int	maxch			#I max chars to output value string
+
+pointer	wp, ap
+int	item, atno, i
+
+int	ctoi()
+bool	streq()
+errchk	syserrs
+
+begin
+	# Get current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_gwattrs")
+
+	# Get attribute number if number was given.
+	i = 1
+	if (ctoi (attribute, i, atno) == 0)
+	    atno = 0
+
+	# Lookup the named or numbered attribute and output the value
+	# string if found.
+
+	item = 0
+	do i = 1, WCS_NWATTR(wp) {
+	    ap = WCS_WATTR(wp,i)
+	    if (AT_AXIS(ap) == axis) {
+		item = item + 1
+		if (atno > 0) {
+		    if (atno == item) {
+			call strcpy (S(mw,AT_NAME(ap)), attribute, SZ_ATNAME)
+			call strcpy (S(mw,AT_VALUE(ap)), valstr, maxch)
+			return
+		    }
+		} else if (streq (S(mw,AT_NAME(ap)), attribute)) {
+		    call strcpy (S(mw,AT_VALUE(ap)), valstr, maxch)
+		    return
+		}
+	    }
+	}
+
+	call syserrs (SYS_MWWATTRNF, attribute)
+end
diff --git a/sys/mwcs/mwgwsampd.x b/sys/mwcs/mwgwsampd.x
new file mode 100644
index 00000000..8149d814
--- /dev/null
+++ b/sys/mwcs/mwgwsampd.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWSAMPD -- Get the sampled WCS curve for an axis.
+
+procedure mw_gwsampd (mw, axis, pv, wv, npts)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis which gets the wsamp vector
+double	pv[ARB]			#O physical coordinates of points
+double	wv[ARB]			#O world coordinates of points
+int	npts			#I number of data point in curve
+
+pointer	wp
+errchk	syserrs
+string	s_name "mw_gwsampd"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify that there is a sampled curve for this WCS.
+	if (WCS_NPTS(wp,axis) <= 0 || WCS_PV(wp,axis) == NULL
+	    || WCS_WV(wp,axis) == NULL)
+	    call syserrs (SYS_MWNOWSAMP, s_name)
+
+	# Copy out the curves.
+	call amovd (D(mw,WCS_PV(wp,axis)), pv, min(WCS_NPTS(wp,axis), npts))
+	call amovd (D(mw,WCS_WV(wp,axis)), wv, min(WCS_NPTS(wp,axis), npts))
+end
diff --git a/sys/mwcs/mwgwsampr.x b/sys/mwcs/mwgwsampr.x
new file mode 100644
index 00000000..881177e4
--- /dev/null
+++ b/sys/mwcs/mwgwsampr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWSAMPR -- Get the sampled WCS curve for an axis.
+
+procedure mw_gwsampr (mw, axis, pv, wv, npts)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis which gets the wsamp vector
+real	pv[ARB]			#O physical coordinates of points
+real	wv[ARB]			#O world coordinates of points
+int	npts			#I number of data point in curve
+
+pointer	wp
+errchk	syserrs
+string	s_name "mw_gwsampr"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify that there is a sampled curve for this WCS.
+	if (WCS_NPTS(wp,axis) <= 0 || WCS_PV(wp,axis) == NULL
+	    || WCS_WV(wp,axis) == NULL)
+	    call syserrs (SYS_MWNOWSAMP, s_name)
+
+	# Copy out the curves.
+	call achtdr (D(mw,WCS_PV(wp,axis)), pv, min(WCS_NPTS(wp,axis), npts))
+	call achtdr (D(mw,WCS_WV(wp,axis)), wv, min(WCS_NPTS(wp,axis), npts))
+end
diff --git a/sys/mwcs/mwgwtermd.x b/sys/mwcs/mwgwtermd.x
new file mode 100644
index 00000000..be6b015a
--- /dev/null
+++ b/sys/mwcs/mwgwtermd.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWTERMD -- Get the linear part of the Wterm, i.e., the physical and world
+# coordinates of the reference point and the CD matrix.  It is the Wterm of
+# the current default WCS which is read.
+
+procedure mw_gwtermd (mw, r, w, cd, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	r[ndim]			#O physical coordinates of reference point
+double	w[ndim]			#O world coordinates of reference point
+double	cd[ndim,ndim]		#O CD matrix
+int	ndim			#I dimension of Wterm
+
+pointer	wp
+errchk	syserrs
+string	s_name "mw_gwtermd"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify the dimension.
+	if (WCS_NDIM(wp) != ndim)
+	    call syserrs (SYS_MWNDIM, s_name)
+
+	# Copy out the data.  Return the unitary transformation if the
+	# Wterm has not been set.
+
+	if (WCS_R(wp) == NULL)
+	    call aclrd (r, ndim)
+	else
+	    call amovd (D(mw,WCS_R(wp)), r, ndim)
+
+	if (WCS_W(wp) == NULL)
+	    call aclrd (w, ndim)
+	else
+	    call amovd (D(mw,WCS_W(wp)), w, ndim)
+
+	if (WCS_CD(wp) == NULL)
+	    call mw_mkidmd (cd, ndim)
+	else
+	    call amovd (D(mw,WCS_CD(wp)), cd, ndim*ndim)
+end
diff --git a/sys/mwcs/mwgwtermr.x b/sys/mwcs/mwgwtermr.x
new file mode 100644
index 00000000..8ee44c4c
--- /dev/null
+++ b/sys/mwcs/mwgwtermr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_GWTERMR -- Get the linear part of the Wterm, i.e., the physical and world
+# coordinates of the reference point and the CD matrix.  It is the Wterm of
+# the current default WCS which is read.
+
+procedure mw_gwtermr (mw, r, w, cd, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	r[ndim]			#O physical coordinates of reference point
+real	w[ndim]			#O world coordinates of reference point
+real	cd[ndim,ndim]		#O CD matrix
+int	ndim			#I dimension of Wterm
+
+pointer	wp
+errchk	syserrs
+string	s_name "mw_gwtermr"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify the dimension.
+	if (WCS_NDIM(wp) != ndim)
+	    call syserrs (SYS_MWNDIM, s_name)
+
+	# Copy out the data.  Return the unitary transformation of the
+	# Wterm has not been set.
+
+	if (WCS_R(wp) == NULL)
+	    call aclrr (r, ndim)
+	else
+	    call achtdr (D(mw,WCS_R(wp)), r, ndim)
+
+	if (WCS_W(wp) == NULL)
+	    call aclrr (w, ndim)
+	else
+	    call achtdr (D(mw,WCS_W(wp)), w, ndim)
+
+	if (WCS_CD(wp) == NULL)
+	    call mw_mkidmr (cd, ndim)
+	else
+	    call achtdr (D(mw,WCS_CD(wp)), cd, ndim*ndim)
+end
diff --git a/sys/mwcs/mwinvertd.x b/sys/mwcs/mwinvertd.x
new file mode 100644
index 00000000..e2744821
--- /dev/null
+++ b/sys/mwcs/mwinvertd.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_INVERTD -- Invert a square matrix, double precision version.  The matrix
+# need not be symmetric.  The input and output matrices cannot be the same.
+
+procedure mw_invertd (o_ltm, n_ltm, ndim)
+
+double	o_ltm[ndim,ndim]	#I input matrix
+double	n_ltm[ndim,ndim]	#O output (inverted) matrix
+int	ndim			#I dimensionality of system
+
+pointer	sp, ix, ltm
+int	nelem, i, j
+
+begin
+	call smark (sp)
+
+	nelem = ndim * ndim
+	call salloc (ix, ndim, TY_INT)
+	call salloc (ltm, nelem, TY_DOUBLE)
+
+	# Make scratch copy (to be modified) of input matrix.
+	call amovd (o_ltm, Memd[ltm], nelem)
+
+	# Set up identity matrix.
+	do i = 1, ndim {
+	    do j = 1, ndim
+		n_ltm[i,j] = 0.0
+	    n_ltm[i,i] = 1.0
+	}
+
+	# Perform the LU decomposition.
+	call mw_ludecompose (Memd[ltm], Memi[ix], ndim)
+
+	# Compute the inverse matrix by backsubstitution.
+	do j = 1, ndim
+	    call mw_lubacksub (Memd[ltm], Memi[ix], n_ltm[1,j], ndim)
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwinvertr.x b/sys/mwcs/mwinvertr.x
new file mode 100644
index 00000000..28274754
--- /dev/null
+++ b/sys/mwcs/mwinvertr.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_INVERTR -- Invert a square matrix, single precision version.  The matrix
+# need not be symmetric.  The input and output matrices should not be the same.
+
+procedure mw_invertr (o_ltm, n_ltm, ndim)
+
+real	o_ltm[ndim,ndim]	#I input matrix
+real	n_ltm[ndim,ndim]	#O output (inverted) matrix
+int	ndim			#I dimensionality of system
+
+int	nelem, i, j
+pointer	sp, ix, ltm, inv
+
+begin
+	call smark (sp)
+
+	nelem = ndim * ndim
+	call salloc (ix, ndim, TY_INT)
+	call salloc (ltm, nelem, TY_DOUBLE)
+	call salloc (inv, nelem, TY_DOUBLE)
+
+	# Make scratch copy (to be modified) of input matrix.
+	call achtrd (o_ltm, Memd[ltm], nelem)
+
+	# Set up identity matrix.
+	call aclrd (Memd[inv], nelem)
+	do i = 1, ndim
+	    Memd[inv+(i-1)*ndim+i-1] = 1.0
+
+	# Perform the LU decomposition.
+	call mw_ludecompose (Memd[ltm], Memi[ix], ndim)
+
+	# Compute the inverse matrix by backsubstitution.
+	do j = 1, ndim
+	    call mw_lubacksub (Memd[ltm], Memi[ix], Memd[inv+(j-1)*ndim], ndim)
+
+	# Output the inverted matrix.
+	call achtdr (Memd[inv], n_ltm, nelem)
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwload.x b/sys/mwcs/mwload.x
new file mode 100644
index 00000000..993ba48b
--- /dev/null
+++ b/sys/mwcs/mwload.x
@@ -0,0 +1,124 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<mach.h>
+include	"mwcs.h"
+include	"mwsv.h"
+
+# MW_LOAD -- Load a saved MWCS into a descriptor.  The saved MWCS will
+# have been created in a previous call to MW_SAVE.  In its saved form,
+# the MWCS is a machine independent binary array of arbitrary length.
+
+procedure mw_load (mw, bp)
+
+pointer	mw			#I pointer to MWCS descriptor
+pointer	bp			#I pointer to save buffer, type char
+
+pointer	sp, sv, ct, ip, cw, ms, wp
+int	nelem, cwlen, mslen, nwcs, lenwcs, n, i
+errchk	syserrs, malloc
+pointer	coerce()
+int	pl_l2pi()
+
+begin
+	call smark (sp)
+	call salloc (sv, LEN_SVHDR, TY_STRUCT)
+
+	# Get the save header.
+	ip = coerce (bp, TY_CHAR, TY_STRUCT)
+	call miiupk32 (Memi[ip], Memi[sv], LEN_SVHDR, TY_INT)
+	if (SV_MAGIC(sv) != MWSV_MAGIC)
+	    call syserrs (SYS_MWMAGIC, "MWCS save file")
+
+	cwlen = SV_CWCSLEN(sv)
+	mslen = SV_MWSVLEN(sv)
+
+	# Prior to MWSV version 1 lenwcs and nwcs were not recorded.
+	if (SV_VERSION(sv) < 1) {
+	    lenwcs = MWSV_LENWCS0
+	    nwcs = (mslen - MWSV_BASELEN) / lenwcs
+	} else {
+	    lenwcs = SV_LENWCS(sv)
+	    nwcs = SV_NWCS(sv)
+	}
+
+	call salloc (cw, cwlen, TY_INT)
+	call salloc (ms, mslen, TY_INT)
+
+	# Unpack the saved MWSV descriptor.  Due to a bug in MWCS prior to
+	# V2.10.4 IRAF the packed descriptor was erroneously encoded using
+	# miipak32, so if unpacking with miiupk16 doesn't work try using
+	# miiupk32.  This should allow old saved MWCS written on a similar
+	# architecture to still be read - the data is not portable however
+	# unless miipak16 is used, since pl_p2li produces a short array.
+
+	ip = coerce (bp + SV_MWSVOFF(sv), TY_CHAR, TY_STRUCT)
+	call miiupk16 (Memi[ip], Memi[cw], SV_CWCSLEN(sv), TY_SHORT)
+	n = pl_l2pi (Memi[cw], 1, Memi[ms], mslen)
+	if (MI_MAGIC(ms) != MWCS_MAGIC) {
+	    call miiupk32 (Memi[ip], Memi[cw], SV_CWCSLEN(sv), TY_INT)
+	    n = pl_l2pi (Memi[cw], 1, Memi[ms], mslen)
+	}
+
+	# Free any storage associated with the old descriptor.
+	# Start with any still allocated CTRAN descriptors.
+
+	do i = 1, MAX_CTRAN {
+	    ct = MI_CTRAN(mw,i)
+	    if (ct != NULL)
+		iferr (call mw_ctfree (ct))
+		    call erract (EA_WARN)
+	}
+
+	# Free the old string and data buffers.
+	if (MI_SBUF(mw) != NULL)
+	    call mfree (MI_SBUF(mw), TY_CHAR)
+	if (MI_DBUF(mw) != NULL)
+	    call mfree (MI_DBUF(mw), TY_DOUBLE)
+
+	# Copy the MWSV descriptor to the active MWCS descriptor.  This
+	# assumes that the base descriptor and the WCS sub-descriptor have
+	# identical structures, except for the length of each element.
+
+	call amovi (Memi[ms], Memi[mw], LEN_BASEMWCS)
+	nelem = min (lenwcs, LEN_WCS)
+	do i = 1, nwcs {
+	    wp = MI_WCSP(mw,i)
+	    call amovi (Memi[MS_WCSP(ms,i,lenwcs)], Memi[wp], nelem)
+	    if (nelem < LEN_WCS)
+		call aclri (Memi[wp+nelem], LEN_WCS-nelem)
+	}
+	do i = nwcs+1, MAX_WCS
+	    call aclri (Memi[MI_WCSP(mw,i)], LEN_WCS)
+
+	# Initialize the axis map (not preserved over a save/load).
+	do i = 1, MI_NDIM(mw) {
+	    MI_AXNO(mw,i) = i
+	    MI_PHYSAX(mw,i) = i
+	}
+
+	# Load the data buffer.
+	nelem = SV_DBUFLEN(sv)
+	if (nelem > 0) {
+	    ip = coerce (bp + SV_DBUFOFF(sv), TY_CHAR, TY_DOUBLE)
+	    call malloc (MI_DBUF(mw), nelem, TY_DOUBLE)
+	    call miiupkd (Memd[ip], D(mw,1), nelem, TY_DOUBLE)
+	    MI_DBUFUSED(mw) = nelem
+	    MI_DBUFLEN(mw) = nelem
+	}
+
+	# Load the string buffer.
+	nelem = SV_SBUFLEN(sv)
+	if (nelem > 0) {
+	    ip = coerce (bp + SV_SBUFOFF(sv), TY_CHAR, TY_CHAR)
+	    call malloc (MI_SBUF(mw), nelem, TY_CHAR)
+	    call miiupk8 (Memc[ip], S(mw,1), nelem, TY_CHAR)
+	    MI_SBUFUSED(mw) = nelem
+	    MI_SBUFLEN(mw) = nelem
+	}
+
+	# Set the default WCS.
+	call mw_sdefwcs (mw)
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwloadim.x b/sys/mwcs/mwloadim.x
new file mode 100644
index 00000000..231f5b9a
--- /dev/null
+++ b/sys/mwcs/mwloadim.x
@@ -0,0 +1,198 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"mwcs.h"
+include	"imwcs.h"
+
+# MW_LOADIM -- Load a MWCS object saved in an image header in FITS format
+# into an MWCS descriptor.  Note that the MWCS descriptor is allocated
+# if the input is NULL.  This is to allow the WCS cards to be read to
+# determine the WCS dimensionality.
+
+procedure mw_loadim (mw, im)
+
+pointer	mw			#U pointer to MWCS descriptor
+pointer	im			#I pointer to image header
+
+bool	have_wcs
+int	ndim, i, j, ea_type
+int	axno[MAX_DIM], axval[MAX_DIM]
+double	maxval
+pointer	sp, sysname, iw, ct, wp, cp, bufp, ip
+
+int	mw_allocd(), mw_refstr(), ctoi(), envgeti()
+pointer	iw_rfits(), iw_findcard(), iw_gbigfits(), mw_open()
+errchk	iw_rfits, mw_allocd, mw_newsystem, mw_swtype, iw_enterwcs, mw_saxmap
+errchk	mw_open
+string	s_physical "physical"
+define	axerr_ 91
+define	axinit_ 92
+
+begin
+	call smark (sp)
+	call salloc (sysname, SZ_FNAME, TY_CHAR)
+
+	# Read the FITS image header into an IMWCS descriptor.
+	iw = iw_rfits (mw, im, RF_REFERENCE)
+	if (mw == NULL) {
+	    ndim = max (IW_NDIM(iw), IM_NPHYSDIM(im))
+	    mw = mw_open (NULL, ndim)
+	}
+	ndim = IW_NDIM(iw)
+
+	# Initialize the MWCS descriptor from the IMWCS descriptor.
+	# Free any storage associated with the old descriptor.
+	# Start with any still allocated CTRAN descriptors.
+
+	do i = 1, MAX_CTRAN {
+	    ct = MI_CTRAN(mw,i)
+	    if (ct != NULL)
+		iferr (call mw_ctfree (ct))
+		    call erract (EA_WARN)
+	}
+
+	# Free the old string and data buffers.
+	if (MI_SBUF(mw) != NULL)
+	    call mfree (MI_SBUF(mw), TY_CHAR)
+	if (MI_DBUF(mw) != NULL)
+	    call mfree (MI_DBUF(mw), TY_DOUBLE)
+
+	# Initialize the new descriptor.
+	call aclri (Memi[mw], LEN_MWCS)
+
+	MI_MAGIC(mw) = MWCS_MAGIC
+	MI_REFIM(mw) = im
+	MI_NDIM(mw) = ndim
+	MI_LTV(mw) = mw_allocd (mw, ndim)
+	MI_LTM(mw) = mw_allocd (mw, ndim * ndim)
+
+	# Set the Lterm.  Set axes with no LTM scales to unit scales.
+	# Issue a warning by default but use "wcs_matrix_err" to allow
+	# setting other error actions.
+
+	call amovd (IW_LTV(iw,1), D(mw,MI_LTV(mw)), ndim)
+	if (iw_findcard (iw, TY_LTM, ERR, 0) != NULL) {
+	    do i = 1, ndim {
+		maxval = 0D0
+		do j = 1, ndim {
+		    D(mw,MI_LTM(mw)+(j-1)*ndim+(i-1)) = IW_LTM(iw,i,j)
+		    maxval = max (maxval, abs (IW_LTM(iw,i,j)))
+		}
+		if (maxval == 0D0) {
+		    iferr (ea_type = envgeti ("wcs_matrix_err"))
+			ea_type = EA_WARN
+		    iferr {
+			switch (ea_type) {
+			case EA_FATAL, EA_ERROR:
+			    call sprintf (Memc[sysname], SZ_FNAME, 
+				"LTM keywords for axis %d undefined")
+				call pargi (i)
+			    call error (SYS_MWMISSAX, Memc[sysname])
+			case EA_WARN:
+			    IW_LTM(iw,i,i) = 1D0
+			    D(mw,MI_LTM(mw)+(i-1)*ndim+(i-1)) = IW_LTM(iw,i,i)
+			    call sprintf (Memc[sysname], SZ_FNAME, 
+				"setting LTM%d_%d to %.4g")
+				call pargi (i)
+				call pargi (i)
+				call pargd (IW_LTM(iw,i,i))
+			    call error (SYS_MWMISSAX, Memc[sysname])
+			default:
+			    IW_LTM(iw,i,i) = 1D0
+			    D(mw,MI_LTM(mw)+(i-1)*ndim+(i-1)) = IW_LTM(iw,i,i)
+			}
+		    } then
+			call erract (ea_type)
+		}
+	    }
+	} else
+	    call mw_mkidmd (D(mw,MI_LTM(mw)), ndim)
+
+	# Set up the builtin world systems "physical" and "logical".
+	# Both are linear systems.  The physical system is a unitary
+	# transformation (since world systems are defined relative to
+	# the physical system), and the logical system has the Lterm
+	# for its linear term.  No wcs attributes other than wtype are
+	# defined.
+
+	# Create the physical system.
+	call mw_newsystem (mw, s_physical, ndim)
+	do i = 1, ndim
+	    call mw_swtype (mw, i, 1, "linear", "")
+
+	# Create the logical system.
+	call mw_newsystem (mw, "logical", ndim)
+	do i = 1, ndim
+	    call mw_swtype (mw, i, 1, "linear", "")
+
+	# Set W and CD for the logical system to point to the Lterm.
+	wp = MI_WCS(mw)
+	WCS_W(wp) = MI_LTV(mw)
+	WCS_CD(wp) = MI_LTM(mw)
+
+	# Did the image header specify a WCS?
+	have_wcs = false
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    switch (C_TYPE(cp)) {
+	    case TY_CTYPE, TY_CRPIX, TY_CRVAL, TY_CD, TY_CDELT:
+		have_wcs = true
+		break
+	    }
+	}
+
+	# Enter the saved WCS.  We make up a system name for now, and patch
+	# it up later once the real name has been recalled along with the
+	# attributes.
+
+	if (have_wcs) {
+	    call mw_newsystem (mw, "image", ndim)
+	    call iw_enterwcs (mw, iw, ndim)
+	    ifnoerr {
+		call mw_gwattrs (mw, 0, "system", Memc[sysname], SZ_FNAME)
+	    } then
+		WCS_SYSTEM(MI_WCS(mw)) = mw_refstr (mw, Memc[sysname])
+	}
+
+	# Restore the saved WCS axis map if any.
+	if (iw_findcard (iw, TY_WAXMAP, ERR, 0) != NULL) {
+	    bufp = iw_gbigfits (iw, TY_WAXMAP, ERR)
+
+	    ip = bufp
+	    do i = 1, ndim {
+		if (ctoi (Memc, ip, axno[i]) <= 0)
+		    goto axerr_
+		if (ctoi (Memc, ip, axval[i]) <= 0) {
+axerr_		    call eprintf ("Image %s: cannot decode WAXMAP\n")
+			call pargstr (IM_NAME(IW_IM(iw)))
+		    goto axinit_
+		}
+	    }
+
+	    call mfree (bufp, TY_CHAR)
+	    call mw_saxmap (mw, axno, axval, ndim)
+
+	} else {
+axinit_	    do i = 1, ndim {
+		MI_AXNO(mw,i) = i
+		MI_AXVAL(mw,i) = 0
+	    }
+	    MI_USEAXMAP(mw) = NO
+	    MI_NLOGDIM(mw) = ndim
+	}
+
+	# Apply the section transform, if the image was opened with an image
+	# section.  This edits the axis map restored above, if any, and must
+	# be done after restoring the original WCS axis map.
+
+	call iw_setaxmap (mw, im)
+
+	# Set the default world system.
+	call mw_sdefwcs (mw)
+
+	call iw_cfits (iw)
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwltran.gx b/sys/mwcs/mwltran.gx
new file mode 100644
index 00000000..d7b823b6
--- /dev/null
+++ b/sys/mwcs/mwltran.gx
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_LTRAN -- Perform a general N-dimensional linear transformation, i.e.,
+# matrix multiply and translation.
+
+procedure mw_ltran$t (p1, p2, ltm, ltv, ndim)
+
+PIXEL	p1[ndim]			#I input point
+PIXEL	p2[ndim]			#O transformed output point
+PIXEL	ltm[ndim,ndim]			#I linear transformation matrix
+PIXEL	ltv[ndim]			#I linear translation vector
+int	ndim				#I dimension of system
+
+int	i, j
+PIXEL	p3[MAX_DIM]
+
+begin
+	call amov$t (p1, p3, ndim)
+	do j = 1, ndim {
+	    p2[j] = ltv[j]
+	    do i = 1, ndim
+		p2[j] = p2[j] + ltm[i,j] * p3[i]
+	}
+end
diff --git a/sys/mwcs/mwlu.x b/sys/mwcs/mwlu.x
new file mode 100644
index 00000000..f6a606f1
--- /dev/null
+++ b/sys/mwcs/mwlu.x
@@ -0,0 +1,143 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# MULU -- Matrix utilities for MWCS.
+#
+#	mw_ludecompose		performs LU decomposition of a square matrix
+#	mw_lubacksub		performs backsubstitution to solve a system
+#
+# These routines are derived from routines in the book Numerical Recipes,
+# Press et. al. 1986.
+
+
+# MW_LUDECOMPOSE -- Replace an NxN matrix A by the LU decomposition of a
+# rowwise permutation of the matrix.  The LU decomposed matrix A and the
+# permutation index IX are output.  The decomposition is performed in place.
+
+procedure mw_ludecompose (a, ix, ndim)
+
+double	a[ndim,ndim]		#U matrix to be inverted; inverted matrix
+int	ix[ndim]		#O vector describing row permutation
+int	ndim			#I dimension of square matrix
+
+pointer	sp, vv
+int	d, i, j, k, imax
+double	aamax, sum, dum
+
+begin
+	call smark (sp)
+	call salloc (vv, ndim, TY_DOUBLE)
+
+	# Keep track of the number of row interchanges, odd or even (not used).
+	d = 1
+
+	# Loop over rows to get implicit scaling information.
+	do i = 1, ndim {
+	    aamax = 0.0
+	    do j = 1, ndim
+		if (abs(a[i,j]) > aamax)
+		    aamax = abs(a[i,j])
+	    if (aamax == 0.0)
+		call error (1, "singular matrix")
+	    Memd[vv+i-1] = 1.0 / aamax
+	}
+
+	# Loop over columns using Crout's method.
+	do j = 1, ndim {
+	    do i = 1, j-1 {
+		sum = a[i,j]
+		do k = 1, i-1
+		    sum = sum - a[i,k] * a[k,j]
+		a[i,j] = sum
+	    }
+
+	    # Search for the largest pivot element.
+	    aamax = 0.0
+	    do i = j, ndim {
+		sum = a[i,j]
+		do k = 1, j-1
+		    sum = sum - a[i,k] * a[k,j]
+		a[i,j] = sum
+
+		# Figure of merit for the pivot.
+		dum = Memd[vv+i-1] * abs(sum)
+		if (dum >= aamax) {
+		    imax = i
+		    aamax = dum
+		}
+	    }
+
+	    # Do we need to interchange rows?
+	    if (j != imax) {
+		# Yes, do so...
+		do k = 1, ndim {
+		    dum = a[imax,k]
+		    a[imax,k] = a[j,k]
+		    a[j,k] = dum
+		}
+		d = -d
+		Memd[vv+imax-1] = Memd[vv+j-1]
+	    }
+
+	    ix[j] = imax
+	    if (a[j,j] == 0.0)
+		a[j,j] = EPSILOND
+
+	    # Divide by the pivot element.
+	    if (j != ndim) {
+		dum = 1.0 / a[j,j]
+		do i = j+1, ndim
+		    a[i,j] = a[i,j] * dum
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# MW_LUBACKSUB -- Solves the set of N linear equations A*X=B.  Here A is input,
+# not as the matrix A but rather as its LU decomposition, determined by the
+# routine mw_ludecompose.  IX is input as the permutation vector as returned by
+# mw_ludecompose.  B is input as the right hand side vector B, and returns with
+# the solution vector X.
+
+procedure mw_lubacksub (a, ix, b, ndim)
+
+double	a[ndim,ndim]		#I LU decomposition of the matrix A
+int	ix[ndim]		#I permutation vector for A
+double	b[ndim]			#U rhs vector; solution vector
+int	ndim			#I dimension of system
+
+int	ii, ll, i, j
+double	sum
+
+begin
+	# Do the forward substitution, unscrambling the permutation as we
+	# go.  When II is set to a positive value, it will become the index
+	# of the first nonvanishing element of B.
+
+	ii = 0
+	do i = 1, ndim {
+	    ll = ix[i]
+	    sum = b[ll]
+	    b[ll] = b[i]
+
+	    if (ii != 0) {
+		do j = ii, i-1
+		    sum = sum - a[i,j] * b[j]
+	    } else if (sum != 0)
+		ii = i
+
+	    b[i] = sum
+	}
+
+	# Now do the backsubstitution.
+	do i = ndim, 1, -1 {
+	    sum = b[i]
+	    if (i < ndim)
+		do j = i+1, ndim
+		    sum = sum - a[i,j] * b[j]
+	    b[i] = sum / a[i,i]
+	}
+end
diff --git a/sys/mwcs/mwmkidmd.x b/sys/mwcs/mwmkidmd.x
new file mode 100644
index 00000000..acdbb077
--- /dev/null
+++ b/sys/mwcs/mwmkidmd.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_MKIDMD -- Make the identity matrix.
+
+procedure mw_mkidmd (ltm, ndim)
+
+double	ltm[ndim,ndim]		#O set to the identity matrix
+int	ndim			#I dimension of (square) matrix
+
+int	i, j
+
+begin
+	do j = 1, ndim {
+	    do i = 1, ndim
+		ltm[i,j] = 0.0
+	    ltm[j,j] = 1.0
+	}
+end
diff --git a/sys/mwcs/mwmkidmr.x b/sys/mwcs/mwmkidmr.x
new file mode 100644
index 00000000..f4771217
--- /dev/null
+++ b/sys/mwcs/mwmkidmr.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_MKIDMR -- Make the identity matrix.
+
+procedure mw_mkidmr (ltm, ndim)
+
+real	ltm[ndim,ndim]		#O set to the identity matrix
+int	ndim			#I dimension of (square) matrix
+
+int	i, j
+
+begin
+	do j = 1, ndim {
+	    do i = 1, ndim
+		ltm[i,j] = 0.0
+	    ltm[j,j] = 1.0
+	}
+end
diff --git a/sys/mwcs/mwmmul.gx b/sys/mwcs/mwmmul.gx
new file mode 100644
index 00000000..b86449c2
--- /dev/null
+++ b/sys/mwcs/mwmmul.gx
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_MMUL -- Matrix multiply.
+
+procedure mw_mmul$t (a, b, c, ndim)
+
+PIXEL	a[ndim,ndim]		#I left input matrix
+PIXEL	b[ndim,ndim]		#I right input matrix
+PIXEL	c[ndim,ndim]		#O output matrix
+int	ndim			#I dimensionality of system
+
+int	i, j, k
+PIXEL	v
+
+begin
+	do j = 1, ndim
+	    do i = 1, ndim {
+		v = 0
+		do k = 1, ndim
+		    v = v + a[k,j] * b[i,k]
+		c[i,j] = v
+	    }
+end
diff --git a/sys/mwcs/mwnewcopy.x b/sys/mwcs/mwnewcopy.x
new file mode 100644
index 00000000..cdc7907b
--- /dev/null
+++ b/sys/mwcs/mwnewcopy.x
@@ -0,0 +1,129 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_NEWCOPY -- Copy a MWCS.  The copy is done by constructing a new MWCS
+# from the objects stored in the first one, freeing any dead storage in the
+# process.
+
+pointer procedure mw_newcopy (o_mw)
+
+pointer	o_mw			#I pointer to old MWCS descriptor
+
+int	ndim, nelem, i, j
+pointer	mw, wp, o_wp, at, o_at
+
+bool	streq()
+int	mw_copys(), mw_copyd()
+errchk	calloc, mw_copys, mw_copyd
+
+begin
+	# Make a copy of the main descriptor.
+	call malloc (mw, LEN_MWCS, TY_STRUCT)
+	call amovi (Memi[o_mw], Memi[mw], LEN_MWCS)
+
+	# We have to allocate our own string and data buffers.
+	MI_SBUF(mw) = NULL
+	MI_SBUFLEN(mw) = 0
+	MI_SBUFUSED(mw) = 0
+	MI_DBUF(mw) = NULL
+	MI_DBUFLEN(mw) = 0
+	MI_DBUFUSED(mw) = 0
+
+	# Copy the Lterm data.
+	ndim = MI_NDIM(mw)
+	nelem = ndim * ndim
+	MI_LTV(mw) = mw_copyd (mw, o_mw, MI_LTV(o_mw), ndim)
+	MI_LTM(mw) = mw_copyd (mw, o_mw, MI_LTM(o_mw), nelem)
+
+	# We don't inherit open CTRAN descriptors.
+	call aclri (MI_CTRAN(mw,1), MAX_CTRAN)
+
+	# Copy the WCS.
+	do i = 1, MI_NWCS(o_mw) {
+	    wp = MI_WCSP(mw,i)
+	    o_wp = MI_WCSP(o_mw,i)
+	    ndim = WCS_NDIM(wp)
+	    nelem = ndim * ndim
+
+	    # Copy the WCS data.
+	    WCS_R(wp) = mw_copyd (mw, o_mw, WCS_R(o_wp), ndim)
+	    WCS_W(wp) = mw_copyd (mw, o_mw, WCS_W(o_wp), ndim)
+	    WCS_CD(wp) = mw_copyd (mw, o_mw, WCS_CD(o_wp), nelem)
+
+	    # Each axis can have its own sampled WCS.
+	    do j = 1, ndim {
+		WCS_PV(wp,j) =
+		    mw_copyd (mw, o_mw, WCS_PV(o_wp,j), WCS_NPTS(o_wp,j))
+		WCS_WV(wp,j) =
+		    mw_copyd (mw, o_mw, WCS_WV(o_wp,j), WCS_NPTS(o_wp,j))
+	    }
+
+	    # Copy the WCS attributes.
+	    do j = 1, WCS_NWATTR(o_wp) {
+		at = WCS_WATTR(wp,j)
+		o_at = WCS_WATTR(o_wp,j)
+		AT_NAME(at) = mw_copys (mw, o_mw, AT_NAME(o_at))
+		AT_VALUE(at) = mw_copys (mw, o_mw, AT_VALUE(o_at))
+		if (streq (S(mw,AT_NAME(at)), "system"))
+		    WCS_SYSTEM(wp) = AT_VALUE(at)
+	    }
+
+	    # Preserve the default WCS.
+	    if (MI_WCS(o_mw) == o_wp)
+		MI_WCS(mw) = wp
+	}
+
+	return (mw)
+end
+
+
+# MW_COPYD -- Copy a block of type double data from one MWCS to another.
+# If the buffer offset in the old system is NULL, there was no data, and
+# a null offset is output.
+
+int procedure mw_copyd (mw, o_mw, o_off, nelem)
+
+pointer	mw			#I pointer to output MWCS
+pointer	o_mw			#I pointer to input (old) MWCS
+int	o_off			#I buffer offset in old MWCS
+int	nelem			#I number of type double data elements
+
+int	off
+int	mw_allocd()
+errchk	mw_allocd
+
+begin
+	if (o_off == NULL)
+	    off = NULL
+	else {
+	    off = mw_allocd (mw, nelem)
+	    call amovd (D(o_mw,o_off), D(mw,off), nelem)
+	}
+
+	return (off)
+end
+
+
+# MW_COPYS -- Copy an EOS delimited string from one MWCS to another.
+# If the buffer offset in the old system is NULL, there is no data, and
+# a null offset is output.
+
+int procedure mw_copys (mw, o_mw, o_off)
+
+pointer	mw			#I pointer to output MWCS
+pointer	o_mw			#I pointer to input (old) MWCS
+int	o_off			#I buffer offset in old MWCS
+
+int	off
+int	mw_refstr()
+errchk	mw_refstr
+
+begin
+	if (o_off == NULL)
+	    off = NULL
+	else
+	    off = mw_refstr (mw, S(o_mw,o_off))
+
+	return (off)
+end
diff --git a/sys/mwcs/mwnewsys.x b/sys/mwcs/mwnewsys.x
new file mode 100644
index 00000000..e7d1e117
--- /dev/null
+++ b/sys/mwcs/mwnewsys.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_NEWSYSTEM -- Add a new world coordinate system with the given name
+# and dimensionality to the MWCS.  Make the new system the current system,
+# since a number of WCS initialization calls will (should) surely follow.
+
+procedure mw_newsystem (mw, system, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	system[ARB]		#I system name
+int	ndim			#I system dimensionality
+
+pointer	wp
+int	mw_refstr()
+pointer	mw_findsys()
+errchk	syserrs, mw_refstr
+
+begin
+	# Check that the system does not already exist.
+	if (mw_findsys (mw, system) != NULL)
+	    call syserrs (SYS_MWWCSREDEF, system)
+
+	# Add the new system.
+	if (MI_NWCS(mw) + 1 > MAX_WCS)
+	    call syserrs (SYS_MWMAXWCS, system)
+	MI_NWCS(mw) = MI_NWCS(mw) + 1
+	wp = MI_WCSP(mw,MI_NWCS(mw))
+
+	# Initialize the WCS.
+	WCS_NDIM(wp) = ndim
+
+	# Make the new WCS the default WCS.
+	MI_WCS(mw) = wp
+
+	# The system name is stored as a global (axis=0) attribute of the WCS.
+	call mw_swattrs (mw, 0, "system", system)
+	WCS_SYSTEM(wp) = mw_refstr (mw, system)
+end
diff --git a/sys/mwcs/mwopen.x b/sys/mwcs/mwopen.x
new file mode 100644
index 00000000..7841f904
--- /dev/null
+++ b/sys/mwcs/mwopen.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	"mwcs.h"
+
+# MW_OPEN -- Create a new MWCS descriptor.  If the non-NULL address of a
+# buffer containing a saved MWCS is given, the saved MWCS will be loaded,
+# otherwise a unitary MWCS of the indicated dimension is created.
+
+pointer procedure mw_open (bufptr, ndim)
+
+pointer	bufptr		#I pointer to encoded MWCS, or NULL
+int	ndim		#I dimension of system to be created
+
+int	i
+pointer	mw, wp
+int	mw_allocd()
+errchk	calloc, mw_load, syserrs, mw_allocd
+string	s_physical "physical"
+
+begin
+	# Initialize the function drivers.
+	call wf_init()
+
+	# Allocate the base descriptor.
+	call calloc (mw, LEN_MWCS, TY_STRUCT)
+
+	# Load saved MWCS, if one was given.
+	if (bufptr != NULL) {
+	    call mw_load (mw, bufptr)
+	    return (mw)
+	}
+
+	# Initialize the new descriptor to a unitary transform of dimension
+	# NDIM.  Most of this is accomplished by merely creating a zeroed
+	# descriptor.
+
+	if (ndim < 1 || ndim > MAX_DIM) {
+	    call mfree (mw, TY_STRUCT)
+	    call syserrs (SYS_MWNDIM, "mw_open")
+	}
+
+	MI_MAGIC(mw) = MWCS_MAGIC
+	MI_NDIM(mw) = ndim
+	MI_NLOGDIM(mw) = ndim
+	MI_LTV(mw) = mw_allocd (mw, ndim)
+	MI_LTM(mw) = mw_allocd (mw, ndim * ndim)
+	call mw_mkidmd (D(mw,MI_LTM(mw)), ndim)
+	do i = 1, ndim {
+	    MI_AXNO(mw,i) = i
+	    MI_PHYSAX(mw,i) = i
+	}
+
+	# Set up the builtin world systems "physical" and "logical".
+	# Both are linear systems.  The physical system is a unitary
+	# transformation (since world systems are defined relative to
+	# the physical system), and the logical system has the Lterm
+	# for its linear term.  No wcs attributes other than wtype are
+	# defined.
+
+	# Create the physical system.
+	call mw_newsystem (mw, s_physical, ndim)
+	do i = 1, ndim
+	    call mw_swtype (mw, i, 1, "linear", "")
+
+	# Create the logical system.
+	call mw_newsystem (mw, "logical", ndim)
+	do i = 1, ndim
+	    call mw_swtype (mw, i, 1, "linear", "")
+
+	# Set W and CD for the logical system to point to the Lterm.
+	wp = MI_WCS(mw)
+	WCS_W(wp) = MI_LTV(mw)
+	WCS_CD(wp) = MI_LTM(mw)
+
+	# Set the default world system.
+	call mw_sdefwcs (mw)
+
+	return (mw)
+end
diff --git a/sys/mwcs/mwopenim.x b/sys/mwcs/mwopenim.x
new file mode 100644
index 00000000..f4e86180
--- /dev/null
+++ b/sys/mwcs/mwopenim.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+
+# MW_OPENIM -- Open an MWCS descriptor on an image, loading the descriptor
+# from the image if there is one.  The MWCS descriptor is allocated after
+# the WCS cards are read in mw_loadim so that the WCS dimensionality can
+# be determined when the image header is dataless.
+
+pointer procedure mw_openim (im)
+
+pointer	im			#I pointer to image descriptor
+
+pointer	mw
+
+begin
+	mw = NULL
+	call mw_loadim (mw, im)
+	return (mw)
+end
diff --git a/sys/mwcs/mwrefstr.x b/sys/mwcs/mwrefstr.x
new file mode 100644
index 00000000..07385976
--- /dev/null
+++ b/sys/mwcs/mwrefstr.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "mwcs.h"
+
+# MW_REFSTR -- Search the string buffer for the named string and return the
+# string offset if found, otherwise enter the new string and return its
+# offset.  This is used to avoid storing the same string many times, but
+# use of this technique means that string data cannot be modified once
+# entered.
+
+int procedure mw_refstr (mw, str)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	str[ARB]		#I string to be referenced or entered
+
+bool	match
+pointer	sbuf, btop, ip
+int	nchars, off, ch, i
+int	strlen(), mw_allocs()
+errchk	mw_allocs
+
+begin
+	sbuf = MI_SBUF(mw)
+	btop = sbuf + MI_SBUFLEN(mw)
+	nchars = strlen (str)
+
+	# Search the string buffer for the given string.
+	match = false
+	if (sbuf != NULL)
+	    for (ip=sbuf;  !match && ip < btop;  ) {
+		match = true
+		do i = 1, btop-ip {
+		    ch = Memc[ip+i-1]
+		    if (i <= nchars)
+			if (ch != str[i])
+			    match = false
+		    if (ch == EOS) {
+			if (!match)
+			    ip = ip + i
+			break
+		    }
+		}
+		if (ch != EOS)
+		    break
+	    }
+
+	# Add the string if not found.
+	if (!match) {
+	    off = mw_allocs (mw, nchars)
+	    call strcpy (str, S(mw,off), nchars)
+	} else
+	    off = ip - sbuf + 1
+
+	return (off)
+end
diff --git a/sys/mwcs/mwrotate.x b/sys/mwcs/mwrotate.x
new file mode 100644
index 00000000..27972659
--- /dev/null
+++ b/sys/mwcs/mwrotate.x
@@ -0,0 +1,71 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+define	LTM	Memd[ltm+(($2)-1)*pdim+($1)-1]
+
+# MW_ROTATE -- Front end to mw_translate, used to perform simple rotations
+# of the logical system by specifying the rotation angle in degrees, and the
+# center of rotation.  Since only one rotation angle can be specified, this
+# routine is useful only for 2-dim rotations (between any two axes).  Note
+# that the transformation is performed in double precision even though the
+# rotation angle and center are specified in single precision, preserving
+# the full internal precision of the Lterm.
+
+procedure mw_rotate (mw, theta, center, axbits)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	theta			#I rotation angle, degrees
+real	center[ARB]		#I center of rotation
+int	axbits			#I bitflags defining axes to be rotated
+
+double	d_theta
+pointer	sp, ltm, ltv_1, ltv_2
+int	axis[MAX_DIM], naxes, ax1, ax2, axmap, pdim, nelem
+errchk	syserr
+
+begin
+	# Convert axis bitflags to axis list.
+	call mw_gaxlist (mw, axbits, axis, naxes)
+	if (naxes != 2)
+	    call syserr (SYS_MWROT2AX)
+
+	pdim = MI_NDIM(mw)
+	nelem = pdim * pdim
+	axmap = MI_USEAXMAP(mw)
+	MI_USEAXMAP(mw) = NO
+	d_theta = theta
+	ax1 = axis[1]
+	ax2 = axis[2]
+
+	call smark (sp)
+	call salloc (ltm, nelem, TY_DOUBLE)
+	call salloc (ltv_1, pdim, TY_DOUBLE)
+	call salloc (ltv_2, pdim, TY_DOUBLE)
+
+	# Initialize the translation matrix and vectors.
+	call mw_mkidmd (Memd[ltm], pdim)
+	call aclrd (Memd[ltv_1], pdim)
+	call aclrd (Memd[ltv_2], pdim)
+
+	# Set up a 2-dim rotation between the specified axes.
+	LTM(ax1,ax1) =  cos(d_theta)
+	LTM(ax2,ax1) =  sin(d_theta)
+	LTM(ax1,ax2) = -sin(d_theta)
+	LTM(ax2,ax2) =  cos(d_theta)
+
+	# Set the rotation center.
+	Memd[ltv_1+ax1-1] = center[1]
+	Memd[ltv_1+ax2-1] = center[2]
+
+	# Set the back translation vector.
+	Memd[ltv_2+ax1-1] = center[1]
+	Memd[ltv_2+ax2-1] = center[2]
+
+	# Perform the translation.
+	call mw_translated (mw, Memd[ltv_1], Memd[ltm], Memd[ltv_2], pdim)
+
+	MI_USEAXMAP(mw) = axmap
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwsave.x b/sys/mwcs/mwsave.x
new file mode 100644
index 00000000..22b92212
--- /dev/null
+++ b/sys/mwcs/mwsave.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"mwcs.h"
+include	"mwsv.h"
+
+# MW_SAVE -- Save the contents of a MWCS descriptor, i.e., the MWCS object,
+# in a machine independent binary array.  This may be stored in a file or
+# database, passed through a network interface, etc., and later reopened
+# on a descriptor with MW_LOAD or MW_OPEN.
+
+int procedure mw_save (o_mw, bp, buflen)
+
+pointer	o_mw			#I pointer to MWCS descriptor
+pointer	bp			#U pointer to save buffer of type char
+int	buflen			#U allocated length of save buffer
+
+int	nchars, olen
+pointer	mw, sp, sv, op, oo
+errchk	coerce, realloc, mw_newcopy
+pointer	coerce(), mw_newcopy()
+int	pl_p2li()
+
+begin
+	call smark (sp)
+	call salloc (sv, LEN_SVHDR, TY_STRUCT)
+
+	# We save a new copy of the MWCS, rather than the MWCS itself,
+	# to discard any dead storage and to cause the runtime descriptor
+	# pointers to be set to NULL.
+
+	mw = mw_newcopy (o_mw)
+
+	# Clear runtime fields that cannot be meaningfully saved.
+	MI_WCS(mw) = NULL
+	MI_REFIM(mw) = NULL
+	call aclri (MI_AXNO(mw,1), MAX_DIM)
+	call aclri (MI_AXVAL(mw,1), MAX_DIM)
+	call aclri (MI_PHYSAX(mw,1), MAX_DIM)
+
+	# Compress the main header to save space.
+	call salloc (oo, MI_LEN(mw) * 3 + 32, TY_SHORT)
+	olen = pl_p2li (Memi[mw], 1, Mems[oo], MI_LEN(mw))
+
+	# Determine how much space will be needed.
+	nchars = LEN_SVHDR * SZ_STRUCT + olen * SZ_SHORT +
+	    (MI_DBUFUSED(mw) + 1) * SZ_DOUBLE +
+	    (MI_SBUFUSED(mw) + SZB_CHAR-1) / SZB_CHAR
+
+	# Get the space.
+	if (nchars > buflen) {
+	    call realloc (bp, nchars, TY_CHAR)
+	    buflen = nchars
+	}
+
+	# Prepare the save header.
+	call aclri (Memi[sv], LEN_SVHDR)
+
+	SV_MAGIC(sv)   = MWSV_MAGIC
+	SV_CWCSLEN(sv) = olen
+	SV_MWSVLEN(sv) = MI_LEN(mw)
+	SV_DBUFLEN(sv) = MI_DBUFUSED(mw)
+	SV_SBUFLEN(sv) = MI_SBUFUSED(mw)
+	SV_MWSVOFF(sv) = LEN_SVHDR * SZ_STRUCT
+	SV_DBUFOFF(sv) = (SV_MWSVOFF(sv) + olen * SZ_SHORT + SZ_DOUBLE-1) /
+			    SZ_DOUBLE * SZ_DOUBLE
+	SV_SBUFOFF(sv) = SV_DBUFOFF(sv) + MI_DBUFUSED(mw) * SZ_DOUBLE
+	SV_VERSION(sv) = MWSV_VERSION
+	SV_NWCS(sv)    = MI_NWCS(mw)
+	SV_LENWCS(sv)  = LEN_WCS
+
+	# Output the save header.
+	op = coerce (bp, TY_CHAR, TY_STRUCT)
+	call miipak32 (Memi[sv], Memi[op], LEN_SVHDR, TY_INT)
+
+	# Store the three segments of the MWCS, i.e., the main descriptor
+	# and the data and string buffers.
+
+	op = coerce (bp + SV_MWSVOFF(sv), TY_CHAR, TY_SHORT)
+	call miipak16 (Mems[oo], Mems[op], olen, TY_SHORT)
+	op = coerce (bp + SV_DBUFOFF(sv), TY_CHAR, TY_DOUBLE)
+	call miipakd (D(mw,1), Memd[op], SV_DBUFLEN(sv), TY_DOUBLE)
+	op = coerce (bp + SV_SBUFOFF(sv), TY_CHAR, TY_CHAR)
+	call miipak8 (S(mw,1), Memc[op], SV_SBUFLEN(sv), TY_CHAR)
+
+	call mw_close (mw)
+	call sfree (sp)
+
+	return (nchars)
+end
diff --git a/sys/mwcs/mwsaveim.x b/sys/mwcs/mwsaveim.x
new file mode 100644
index 00000000..a74ef99a
--- /dev/null
+++ b/sys/mwcs/mwsaveim.x
@@ -0,0 +1,394 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"imwcs.h"
+include	"mwcs.h"
+
+# MW_SAVEIM -- Save the current MWCS in an image header in FITS format.
+# This is only possible to some degree.  Although the Lterm is always saved,
+# only one world system can be saved.  FITS convention requires that the
+# FITS wcs represent the transformation from image (logical) coordinates
+# to world coordinates, whereas the MWCS Wterm represents the physical to
+# world transformation, so what we save is actually a combination of the
+# Wterm and Lterm; combining the two is only possible if there are no
+# rotations between dissimilar axes.  Sampled WCS vectors and WCS attributes
+# can be saved, although this can be inefficient for large vectors and can
+# result in header overflow, and there can be problems preserving the
+# precision of double precision data since the FITS representation is ASCII.
+# Since the WCS is represented by a variable set of cards, we must be careful
+# to delete any old WCS cards which are not updated by the save operation.
+
+procedure mw_saveim (mw, im)
+
+pointer	mw				#I pointer to MWCS descriptor
+pointer	im				#I pointer to image descriptor
+
+double	cdelt
+char	label[SZ_VALSTR]
+bool	update, output_cdelt
+char	kwname[SZ_KWNAME], ctype[SZ_KWNAME], axtype[4]
+int	ndim, axis, fn, ira, idec, i, j, pv, wv, npts, fd
+pointer	sp, iw, wp, wf, vp, cp, at, o_r, n_r, o_cd, n_cd, ltm
+int	op
+
+bool	streq(), fp_equald()
+pointer	iw_rfits(), iw_findcard()
+int	strncmp(), strlen(), open(), nowhite(), stridxs()
+errchk	iw_rfits, mw_ssystem, iw_putarray, iw_putstr, open
+include	"mwcs.com"
+define	ewcs_  91
+
+begin
+	# Scan the old image header, recording all WCS cards.
+	iw = iw_rfits (mw, im, RF_COPY)
+
+	# Save the WCS dimension (not necessarily same as that of the image).
+	ndim = MI_NDIM(mw)
+	cp = iw_findcard (iw, TY_WCSDIM, -1, 0)
+	if (cp == NULL || IW_NDIM(iw) != ndim) {
+	    call strcpy ("WCSDIM", kwname, SZ_KWNAME)
+	    if (cp == NULL)
+		call imaddf (im, kwname, "i")
+	    call imputi (im, kwname, ndim)
+	}
+	if (cp != NULL)
+	    C_UPDATED(cp) = YES
+
+	call smark (sp)
+	call salloc (o_r, ndim, TY_DOUBLE)
+	call salloc (n_r, ndim, TY_DOUBLE)
+	call salloc (o_cd, ndim*ndim, TY_DOUBLE)
+	call salloc (n_cd, ndim*ndim, TY_DOUBLE)
+	call salloc (ltm, ndim*ndim, TY_DOUBLE)
+
+	# Get pointer to the world system to be saved.  Currently only one
+	# such system can be saved since the image header is FITS based and
+	# FITS doesn't support multiple world coordinate systems.  The system
+	# to be saved can be set by calling MW_SSYSTEM before doing the
+	# mw_saveim.
+
+	wp = MI_WCS(mw)
+
+	# Do we need to save any WCS information at all?
+	if (MI_NWCS(mw) <= 2)
+	    goto ewcs_
+
+	# Store the current WCS in the image header.  This is optimized to
+	# use the knowledge of the current header contents obtained by
+	# iw_rfits above, to determine if each header card needs to be
+	# modified in the header, or added to the header.  If the card
+	# already exists with the correct value nothing is done.
+
+	# Output CTYPEi for each axis.
+	do axis = 1, ndim {
+
+	    # Get the new value of CTYPEi.
+	    if (WCS_AXCLASS(wp,axis) == F_LINEAR) {
+		# For the default case of a linear axis, set CTYPEi to the
+		# value of the axis label, if there is one and it is a simple
+		# keyword but not one of the CTYPE keywords reserved by MWCS.
+
+		call strcpy ("LINEAR  ", ctype, SZ_KWNAME)
+		ifnoerr {
+		    call mw_gwattrs (mw, axis, "label", label, SZ_VALSTR)
+		} then {
+		    call strupr (label)
+		    if (nowhite (label, label, SZ_VALSTR) <= SZ_KWNAME) {
+			if (strncmp (label, "SAMPLED", 8) != 0 &&
+			    strncmp (label, "RA--", 4) != 0 &&
+			    strncmp (label, "DEC-", 4) != 0 &&
+			    strncmp (label[2], "LON", 3) != 0 &&
+			    strncmp (label[2], "LAT", 3) != 0) {
+
+			    call sprintf (ctype, SZ_KWNAME, "%-8s%9t")
+				call pargstr (label)
+			}
+		    }
+		}
+
+	    } else {
+		wf = WCS_FUNC(wp,WCS_AXCLASS(wp,axis))
+		fn = WF_FN(wf)
+
+		if (and (FN_FLAGS(fn), F_RADEC) != 0) {
+		    # Determine the axis type.
+		    ira = 0
+		    idec = 0
+		    axtype[1] = EOS
+		    do i = 1, 2 {
+			ifnoerr (call mw_gwattrs (mw,
+				WF_AXIS(wf,i), "axtype", axtype, 4)) {
+			    call strlwr (axtype)
+			    if (streq (axtype, "ra") ||
+				    streq (axtype[2], "lon")) {
+				ira  = i
+				idec = 3 - i
+				break
+			    } else if (streq (axtype, "dec") ||
+				    streq (axtype[2], "lat")) {
+				ira  = 3 - i
+				idec = i
+				break
+			    } 
+			}
+		    }
+
+		    # RA and DEC had better be flagged, but if not, assume
+		    # that the first axis is RA and the second DEC.
+
+		    if (ira == 0)
+			ira = 1
+		    if (idec == 0)
+			idec = 2
+			
+		    # Make a name like "RA---TAN".
+		    if (WF_AXIS(wf,idec) == axis) {
+			if (streq (axtype, "ra") || streq (axtype, "dec")) {
+			    call strcpy ("DEC-----", ctype, SZ_KWNAME)
+			} else if (streq (axtype[2], "lon") ||
+				streq (axtype[2], "lat")) {
+			    call sprintf (ctype, SZ_KWNAME, "%cLAT----")
+				call pargc (axtype[1])
+			} else {
+			    call strcpy ("DEC-----", ctype, SZ_KWNAME)
+			}
+		    } else {
+			if (streq (axtype, "ra") || streq (axtype, "dec")) {
+			    call strcpy ("RA------", ctype, SZ_KWNAME)
+			} else if (streq (axtype[2], "lon") ||
+				streq (axtype[2], "lat")) {
+			    call sprintf (ctype, SZ_KWNAME, "%cLON----")
+				call pargc (axtype[1])
+			} else {
+			    call strcpy ("RA------", ctype, SZ_KWNAME)
+			}
+		    }
+
+		    op = max (1, SZ_KWNAME - strlen (FN_NAME(fn)) + 1)
+		    call strcpy (FN_NAME(fn), ctype[op], SZ_KWNAME-op+1)
+		    call strupr (ctype)
+
+		} else {
+		    # Just output the WCS function name as CTYPE.
+		    call strcpy ("        ", ctype, SZ_KWNAME)
+		    call strcpy (FN_NAME(fn), ctype, SZ_KWNAME)
+		    call strupr (ctype)
+		}
+	    }
+
+	    # Update the header value if there is any change.
+	    update = true
+	    vp = IW_CTYPE(iw,axis)
+	    if (vp != NULL)
+		update = (strncmp (Memc[vp], ctype, SZ_KWNAME) != 0)
+
+	    cp = iw_findcard (iw, TY_CTYPE, axis, 0)
+	    if (update) {
+		call sprintf (kwname, SZ_KWNAME, "CTYPE%d")
+		    call pargi (axis)
+		if (cp == NULL)
+		    call imaddf (im, kwname, "c")
+		call impstr (im, kwname, ctype)
+	    }
+	    if (cp != NULL)
+		C_UPDATED(cp) = YES
+	}
+
+	# FITS requires that the WCS specify the transformation from raw
+	# image (logical) coordinates to world coordinates, whereas the
+	# MWCS Wterm specifies the transformation from physical coordinates
+	# to world coordinates.  Hence, we must modify CD and CRPIX (R)
+	# to specify the transformation from logical to world coordinates.
+
+	# Get the MWCS R vector.
+	if (WCS_R(wp) != NULL)
+	    call amovd (D(mw,WCS_R(wp)), Memd[o_r], ndim)
+	else
+	    call aclrd (Memd[o_r], ndim)
+
+	# Get the MWCS CD matrix.
+	if (WCS_CD(wp) != NULL)
+	    call amovd (D(mw,WCS_CD(wp)), Memd[o_cd], ndim*ndim)
+	else
+	    call mw_mkidmd (Memd[o_cd], ndim)
+	    
+	# Output CRVAL (this is unaffected by the Lterm).
+	if (WCS_W(wp) != NULL)
+	    call iw_putarray (iw, D(mw,WCS_W(wp)), IW_CRVAL(iw,1), ndim,
+		"CRVAL%d", TY_CRVAL, 0)
+
+	# Output CRPIX = R' =  (LTM * R + LTV).
+	call mw_vmuld (D(mw,MI_LTM(mw)), Memd[o_r], Memd[n_r], ndim)
+	call aaddd (D(mw,MI_LTV(mw)), Memd[n_r], Memd[n_r], ndim)
+	call iw_putarray (iw, Memd[n_r], IW_CRPIX(iw,1), ndim,
+	    "CRPIX%d", TY_CRPIX, 0)
+
+	# Output the CD matrix = CD' =  (CD * inv(LTM)).  If the system
+	# dimensionality is 2 or less and there is no rotation, output
+	# the CDELT notation in addition to the CD matrix to enhance
+	# compatibility with older programs.
+
+	call mw_invertd (D(mw,MI_LTM(mw)), Memd[ltm], ndim)
+	call mw_mmuld (Memd[o_cd], Memd[ltm], Memd[n_cd], ndim)
+
+	# Output CDELT1/CDELT2 if the image dimension is 2 or less and the
+	# CD matrix is a diagonal matrix (no rotational or skew terms).
+
+	output_cdelt = false
+	if (ndim == 1)
+	    output_cdelt = true
+	else if (ndim == 2) {
+	    output_cdelt = (fp_equald(Memd[n_cd+1],0.0D0) &&
+			    fp_equald(Memd[n_cd+2],0.0D0))
+	}
+
+	if (output_cdelt) {
+	    do j = 1, ndim {
+		cdelt = Memd[n_cd+(j-1)*(ndim+1)]
+		cp = iw_findcard (iw, TY_CDELT, j, 0)
+		if (cp == NULL || !fp_equald(IW_CDELT(iw,j),cdelt)) {
+		    call sprintf (kwname, SZ_KWNAME, "CDELT%d")
+			call pargi (j)
+		    if (cp == NULL)
+			call imaddf (im, kwname, "d")
+		    call imputd (im, kwname, cdelt)
+		}
+		if (cp != NULL)
+		    C_UPDATED(cp) = YES
+	    }
+	}
+
+	# Update the CD matrix.
+	do j = 1, ndim {
+	    call sprintf (kwname, SZ_KWNAME, "CD%d_%%d")
+		call pargi (j)
+	    call iw_putarray (iw, Memd[n_cd+(j-1)*ndim],
+		IW_CD(iw,1,j), ndim, kwname, TY_CD, j)
+	}
+
+	# Output the Lterm.
+ewcs_
+	# Output LTV.
+	if (MI_LTV(mw) != NULL)
+	    call iw_putarray (iw, D(mw,MI_LTV(mw)), IW_LTV(iw,1), ndim,
+		"LTV%d", TY_LTV, 0)
+
+	# Output LTM.
+	if (MI_LTM(mw) != NULL) {
+	    do j = 1, ndim {
+		call sprintf (kwname, SZ_KWNAME, "LTM%%d_%d")
+		    call pargi (j)
+		call iw_putarray (iw, D(mw,MI_LTM(mw)+(j-1)*ndim),
+		    IW_LTM(iw,1,j), ndim, kwname, TY_LTM, j)
+	    }
+	}
+
+	# Output axis map if any.
+	if (MI_USEAXMAP(mw) == YES) {
+	    fd = open ("WAXMAP", READ_WRITE, SPOOL_FILE)
+	    axis = ERR
+
+	    do i = 1, ndim {
+		call fprintf (fd, "%d %d ")
+		    call pargi (MI_AXNO(mw,i))
+		    call pargi (MI_AXVAL(mw,i))
+	    }
+
+	    # Output successive WAXMAPj FITS cards.
+	    call seek (fd, BOFL)
+	    call iw_putstr (fd, iw, axis, TY_WAXMAP, "WAXMAP%02d", "", 0)
+	    call close (fd)
+	}
+
+	# Output any WCS attributes.
+	do axis = 0, ndim {
+	    fd = open ("WAT", READ_WRITE, SPOOL_FILE)
+	    npts = 0
+
+	    # Dump the attribute=value assignments for this axis into a single
+	    # large string buffer, using a spool file.
+
+	    do i = 1, WCS_NWATTR(wp) {
+		at = WCS_WATTR(wp,i)
+		if (AT_AXIS(at) != axis)
+		    next
+
+		if (npts > 0)
+		    call putline (fd, " ")
+		call putline (fd, S(mw,AT_NAME(at)))
+		if (stridxs (" \t", S(mw,(AT_VALUE(at)))) > 0) {
+		    call putline (fd, " = \"")
+		    call putline (fd, S(mw,AT_VALUE(at)))
+		    call putline (fd, "\"")
+		} else {
+		    call putline (fd, "=")
+		    call putline (fd, S(mw,AT_VALUE(at)))
+		}
+
+		npts = npts + 1
+	    }
+
+	    # Output successive WATi_jjj FITS cards.
+	    call seek (fd, BOFL)
+	    if (npts > 0)
+		call iw_putstr (fd, iw, axis, TY_WATDATA, "WAT%d_%03d",
+		    "WAT%d%04d", 999)
+	    call close (fd)
+	}
+
+	# Update any sampled WCS in the header.
+	do axis = 1, ndim {
+	    npts = WCS_NPTS(wp,axis)
+	    if (npts == 0)
+		next
+
+	    # Update the LEN card.
+	    cp = iw_findcard (iw, TY_WSVLEN, axis, 0)
+	    if (IW_WSVLEN(iw,axis) != npts) {
+		call sprintf (kwname, SZ_KWNAME, "WSV%d_LEN")
+		    call pargi (axis)
+		if (cp == NULL)
+		    call imaddf (im, kwname, "i")
+		call imputi (im, kwname, npts)
+	    }
+	    if (cp != NULL)
+		C_UPDATED(cp) = YES
+
+	    pv = WCS_PV(wp,axis)
+	    wv = WCS_WV(wp,axis)
+
+	    # Dump the entire array into an ASCII spool file as successive
+	    # points [PV,WV].
+
+	    fd = open ("WSV", READ_WRITE, SPOOL_FILE)
+	    do i = 1, npts {
+		call fprintf (fd, "%0.*g %0.*g ")
+		    call pargi (NDIGITS_DP);  call pargd (D(mw,pv+i-1))
+		    call pargi (NDIGITS_DP);  call pargd (D(mw,wv+i-1))
+	    }
+
+	    # Output successive WSVi_jjj FITS cards.
+	    call seek (fd, BOFL)
+	    call iw_putstr (fd, iw, axis, TY_WSVDATA, "WSV%d_%03d",
+		"WSV%d%04d", 999)
+	    call close (fd)
+	}
+
+	# Delete any old WCS cards which were not updated, and hence which
+	# are no longer valid, or which are not needed because the value is
+	# the default (in which case the old card is probably invalid).
+
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    if (C_UPDATED(cp) == NO) {
+		call strcpy (Memc[C_RP(cp)], kwname, SZ_KWNAME)
+		if (nowhite (kwname, kwname, SZ_KWNAME) > 0)
+		    call imdelf (im, kwname)
+	    }
+	}
+
+	call iw_cfits (iw)
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwsaxmap.x b/sys/mwcs/mwsaxmap.x
new file mode 100644
index 00000000..3070969b
--- /dev/null
+++ b/sys/mwcs/mwsaxmap.x
@@ -0,0 +1,52 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SAXMAP -- Set the axis map.  This assigns a logical axis axno[i] to
+# each physical axis I.  If axno[i]=0, the value of the physical axis
+# coordinate is the constant axval[i], and the dimension of the logical
+# system is reduced by one.  Setting the axis map automatically enables
+# axis mapping if a nonstandard map is entered.
+
+procedure mw_saxmap (mw, axno, axval, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axno[ndim]		#I physical -> logical axis assignments
+int	axval[ndim]		#I value of physical axis if axno=0
+int	ndim			#I physical dimension of axis map
+
+int	i, j
+errchk	syserrs, syserr
+
+begin
+	# Verify dimension.
+	if (MI_NDIM(mw) != ndim)
+	    call syserrs (SYS_MWNDIM, "mw_saxmap")
+
+	# Store the arrays, and determine the dimension of the logical system.
+	# Enable axis mapping if an interesting map has been entered.
+
+	MI_NLOGDIM(mw) = 0
+	MI_USEAXMAP(mw) = NO
+
+	do i = 1, ndim {
+	    MI_AXNO(mw,i) = axno[i]
+	    MI_AXVAL(mw,i) = axval[i]
+	    if (axno[i] > 0)
+		MI_NLOGDIM(mw) = MI_NLOGDIM(mw) + 1
+	    if (axno[i] != i)
+		MI_USEAXMAP(mw) = YES
+	}
+
+	# Invert the axis map to facilitate logical->physical mappings.
+	do j = 1, MI_NLOGDIM(mw) {
+	    for (i=1;  i <= ndim;  i=i+1)
+		if (axno[i] == j) {
+		    MI_PHYSAX(mw,j) = i
+		    break
+		}
+	    if (i > ndim)
+		call syserr (SYS_MWINVAXMAP)
+	}
+end
diff --git a/sys/mwcs/mwscale.x b/sys/mwcs/mwscale.x
new file mode 100644
index 00000000..2ae7167a
--- /dev/null
+++ b/sys/mwcs/mwscale.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_SCALE -- Front end to mw_translate, used to perform a simple rescaling
+# of the logical system.
+
+procedure mw_scale (mw, scale, axbits)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	scale[ARB]		#I scale factor for each axis in axbits
+int	axbits			#I bitflags defining axes
+
+pointer	sp, ltm, ltv_1, ltv_2
+int	axis[MAX_DIM], naxes, pdim, nelem, axmap, i, j
+
+begin
+	# Convert axis bitflags to axis list.
+	call mw_gaxlist (mw, axbits, axis, naxes)
+	if (naxes <= 0)
+	    return
+
+	pdim = MI_NDIM(mw)
+	nelem = pdim * pdim
+	axmap = MI_USEAXMAP(mw)
+	MI_USEAXMAP(mw) = NO
+
+	call smark (sp)
+	call salloc (ltm, nelem, TY_DOUBLE)
+	call salloc (ltv_1, pdim, TY_DOUBLE)
+	call salloc (ltv_2, pdim, TY_DOUBLE)
+
+	# Initialize the translation matrix and vectors.
+	call mw_mkidmd (Memd[ltm], pdim)
+	call aclrd (Memd[ltv_1], pdim)
+	call aclrd (Memd[ltv_2], pdim)
+
+	# Enter the axis scale factors.
+	do i = 1, naxes {
+	    j = axis[i] - 1
+	    Memd[ltm+j*pdim+j] = scale[i]
+	}
+
+	# Perform the translation.
+	call mw_translated (mw, Memd[ltv_1], Memd[ltm], Memd[ltv_2], pdim)
+
+	MI_USEAXMAP(mw) = axmap
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwsctran.x b/sys/mwcs/mwsctran.x
new file mode 100644
index 00000000..c529bc80
--- /dev/null
+++ b/sys/mwcs/mwsctran.x
@@ -0,0 +1,410 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<mach.h>
+include	"mwcs.h"
+
+# MW_SCTRAN -- Set up a coordinate transformation (CTRAN) descriptor.
+# The general idea is to reduce the coordinate transformation to as simple
+# a form as possible for efficient evaluation at runtime.  Most of the
+# complexities of the actual coordinate system, e.g., axis mapping, multiple
+# WCS, separate linear and world terms, forward and inverse transforms, etc.,
+# can be dealt with at CTRAN compile time.  The result is a CTRAN descriptor
+# for an N-d coordinate defining an N-d linear transformation and zero or
+# more calls to WCS functions for individual axes, where N can be anything
+# less than or equal to the dimensionality of the full system.
+#
+# A transformation may be set up between any two coordinate systems
+# SYSTEM1 and SYSTEM2.  The dimensionality of the transformation, and the
+# axes to which it applies, is determined by the axis bitflags in AXBITS.
+# A pointer to the optimized transformation descriptor is returned as the
+# function value.  An arbitrary number of transformation descriptors may be
+# simultaneously open (a limit of 16 or so is imposed by the main MWCS
+# descriptor).  A CTRAN descriptor reflects the state of the WCS *at the
+# time that the descriptor was compiled*, i.e., subsequent changes to
+# the MWCS descriptor do not affect any compiled transformation descriptors.
+# CTRAN descriptors not subsequently closed by CTFREE are automatically
+# closed when the main MWCS descriptor is closed.
+
+pointer procedure mw_sctran (mw, system1, system2, axbits)
+
+pointer mw			#I pointer to MWCS descriptor
+char	system1[ARB]		#I input coordinate system
+char	system2[ARB]		#I output coordinate system
+int	axbits			#I bitmap defining axes to be transformed
+
+bool	newfunc
+int	naxes, axis[MAX_DIM], wfno, fn, epa
+int	i, j, k , matlen, ndata, ctlen, pdim
+pointer	i_ltm, i_ltv, o_ltm, o_ltv, t_ltm, t_ltv, ltm, ltv
+pointer	sp, w1, w2, ct, wf, fc, lp, ip, op, ct_r, sv_wcs
+
+pointer	coerce()
+errchk	syserr, syserrs, calloc, zcall2, mw_invertd, mw_ssystem
+include	"mwcs.com"
+
+begin
+	call smark (sp)
+
+	# Get pointers to the input and output systems.
+	sv_wcs = MI_WCS(mw)
+	iferr {
+	    call mw_ssystem (mw, system1)
+	    w1 = MI_WCS(mw)
+	    call mw_ssystem (mw, system2)
+	    w2 = MI_WCS(mw)
+	} then {
+	    MI_WCS(mw) = sv_wcs
+	    call erract (EA_ERROR)
+	} else
+	    MI_WCS(mw) = sv_wcs
+
+	# Get the physical axis list.  The bitflags in AXBITS define the axes
+	# in the logical system; run these through the axis map (if enabled)
+	# to get the list of physical axes for which the transformation is to
+	# be prepared.
+
+	call mw_gaxlist (mw, axbits, axis, naxes)
+
+	# Allocate the CTRAN descriptor.  First we must figure out how
+	# much space is required.  The space required is for the base
+	# descriptor, plus additional space for the LTM and LTV, which vary
+	# in size depending upon the dimensionality of the transformation.
+	# The whole thing is then doubled to provide 2 versions of the
+	# descriptor, providing both single and double precision versions
+	# of the LTM and LTV.  Any additional storage utilized by the WCS
+	# functions is separately allocated by the initialization routines
+	# in the function drivers.
+
+	matlen = naxes * naxes
+	ndata = matlen + naxes
+	ctlen = LEN_CTBASE + ndata * SZ_DOUBLE / SZ_STRUCT
+	call calloc (ct, ctlen*2, TY_STRUCT)
+
+	# Save a pointer to the CTRAN descriptor in the main MWCS descriptor,
+	# to permit automatic deallocation at close time.
+
+	do i = 1, MAX_CTRAN+1 {
+	    if (i > MAX_CTRAN) {
+		call mfree (ct, TY_STRUCT)
+		call syserr (SYS_MWCTOVFL)
+	    }
+
+	    if (MI_CTRAN(mw,i) == NULL) {
+		MI_CTRAN(mw,i) = ct
+		break
+	    }
+	}
+
+	CT_MW(ct) = mw
+	CT_WCSI(ct) = w1
+	CT_WCSO(ct) = w2
+	CT_NDIM(ct) = naxes
+	CT_R(ct) = ct + ctlen
+	call amovi (axis, CT_AXIS(ct,1), naxes)
+	CT_LTM(ct) = coerce (ct + LEN_CTBASE, TY_STRUCT, TY_DOUBLE)
+	CT_LTV(ct) = CT_LTM(ct) + matlen
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	# We also need some full-system matrix and vector buffers.
+	pdim = min (WCS_NDIM(w1), WCS_NDIM(w2))
+	pdim = min (MI_NDIM(mw), pdim)
+
+	i = pdim * pdim
+	call salloc (i_ltm, i, TY_DOUBLE)
+	call salloc (i_ltv, pdim, TY_DOUBLE)
+	call salloc (o_ltm, i, TY_DOUBLE)
+	call salloc (o_ltv, pdim, TY_DOUBLE)
+	call salloc (t_ltm, i, TY_DOUBLE)
+	call salloc (t_ltv, pdim, TY_DOUBLE)
+
+	# Compute the transformation.  A transformation between any two
+	# world systems W1 and W2 consists of the transformation W1->P
+	# from W1 to the physical system, followed by a transformation
+	# P->W2 to the second world system.  The linear portions of these
+	# two transformations can be combined to produce a single linear
+	# transformation, and if no WCS function calls are involved at
+	# either end, the entire transformation reduces to a single linear
+	# transformation defined by LTM and LTV.  Note that as far as we
+	# are concerned here, the special world systems "logical" and
+	# "physical" are just like other world systems, except that both are
+	# always linear systems.  The linear term for the logical system is
+	# the MWCS Lterm; for the physical system it is the identity matrix.
+
+	# Set up the transformation W1->P.  First we must determine if there
+	# are any WCS function calls.  We do this by going ahead and compiling
+	# the "in" function calls in the CTRAN descriptor.
+
+	do i = 1, naxes {
+	    wfno = WCS_AXCLASS(w1,axis[i])
+
+	    # Skip to next axis if no WCS function is assigned to this axis.
+	    if (wfno == 0)
+		next
+
+	    # Has function call for this axis already been compiled?
+	    newfunc = true
+	    do j = 1, CT_NCALLI(ct) {
+		fc = CT_FCI(ct,j)
+		do k = 1, FC_NAXES(fc)
+		    if (FC_AXIS(fc,k) == i)
+			newfunc = false
+	    }
+
+	    # Compile a function call for the inverse transformation.
+	    if (newfunc) {
+		CT_NCALLI(ct) = CT_NCALLI(ct) + 1
+		if (CT_NCALLI(ct) > MAX_CALL)
+		    call syserrs (SYS_MWFCOVFL, system1)
+
+		fc = CT_FCI(ct,CT_NCALLI(ct))
+		wf = WCS_FUNC(w1,wfno)
+		fn = WF_FN(wf)
+
+		FC_CT(fc)    = ct
+		FC_WCS(fc)   = w1
+		FC_WF(fc)    = wf
+		FC_FCN(fc)   = FN_INV(fn)
+		FC_NAXES(fc) = WF_NAXES(wf)
+
+		# Store CTRAN-relative list of axes in function call
+		# descriptor.  Verify that all the axes needed for the
+		# function call are included in the transformation.
+		# This requirement can theoretically be relaxed in
+		# some cases but this is not supported in MWCS.
+
+		do j = 1, WF_NAXES(wf) {
+		    for (k=1;  k <= naxes;  k=k+1)
+			if (axis[k] == WF_AXIS(wf,j)) {
+			    FC_AXIS(fc,j) = k
+			    break
+			}
+		    if (k > naxes)
+			call syserrs (SYS_MWMISSAX, system1)
+		}
+
+		# Call the function driver to perform any driver dependent
+		# initialization.
+
+		epa = FN_INIT(fn)
+		if (epa != NULL)
+		    call zcall2 (epa, fc, INVERSE)
+	    }
+	}
+
+	# Prepare the linear part of the input transformation W1->P.
+	# This is LTM=inv(CD), and for axis I, LTV[i]=(R[i]-inv(CD)*W)
+	# if no function call, or LTV[i]=R[i] if there is a function
+	# assigned to axis I which already deals with the W[i].  All
+	# this is done in the full dimension of the internal system for
+	# now; extraction of the portion of the full system affecting
+	# the CTRAN axes is done later to permit verification of the
+	# legality of the reduction step required.
+
+	# Invert CD matrix.
+	if (WCS_CD(w1) == NULL)
+	    call mw_mkidmd (Memd[i_ltm], pdim)
+	else
+	    call mw_invertd (D(mw,WCS_CD(w1)), Memd[i_ltm], pdim)
+
+	# If no function calls for an axis and W is set, LTV=(R-inv(CD)*W).
+	if (WCS_W(w1) != NULL) {
+	    call amovd (D(mw,WCS_W(w1)), Memd[i_ltv], pdim)
+	    do i = 1, CT_NCALLI(ct) {
+		fc = CT_FCI(ct,i)
+		do j = 1, FC_NAXES(fc) {
+		    k = axis[FC_AXIS(fc,j)]
+		    Memd[i_ltv+k-1] = 0.0d0
+		}
+	    }
+	    call mw_vmuld (Memd[i_ltm], Memd[i_ltv], Memd[t_ltv], pdim)
+
+	    # Copy R to LTV.
+	    if (WCS_R(w1) == NULL)
+	        call anegd (Memd[t_ltv], Memd[i_ltv], pdim)
+	    else
+		call asubd (D(mw,WCS_R(w1)), Memd[t_ltv], Memd[i_ltv], pdim)
+
+	} else {
+	    # Copy R to LTV.
+	    if (WCS_R(w1) == NULL)
+	        call aclrd (Memd[i_ltv], pdim)
+	    else
+	        call amovd (D(mw,WCS_R(w1)), Memd[i_ltv], pdim)
+	}
+
+	# Now prepare the output side of the transformation, from P->W2.
+	# Like the input half, this consists of a linear term and a list
+	# of zero or more function calls.
+
+	# Compile the "out" function calls in the CTRAN descriptor.
+	do i = 1, naxes {
+	    wfno = WCS_AXCLASS(w2,axis[i])
+
+	    # Skip to next axis if no WCS function is assigned to this axis.
+	    if (wfno == 0)
+		next
+
+	    # Has function call for this axis already been compiled?
+	    newfunc = true
+	    do j = 1, CT_NCALLO(ct) {
+		fc = CT_FCO(ct,j)
+		do k = 1, FC_NAXES(fc)
+		    if (FC_AXIS(fc,k) == i)
+			newfunc = false
+	    }
+
+	    # Compile a function call for the forward transformation.
+	    if (newfunc) {
+		CT_NCALLO(ct) = CT_NCALLO(ct) + 1
+		if (CT_NCALLO(ct) > MAX_CALL)
+		    call syserrs (SYS_MWFCOVFL, system2)
+
+		fc = CT_FCO(ct,CT_NCALLO(ct))
+		wf = WCS_FUNC(w2,wfno)
+		fn = WF_FN(wf)
+
+		FC_CT(fc)    = ct
+		FC_WCS(fc)   = w2
+		FC_WF(fc)    = wf
+		FC_FCN(fc)   = FN_FWD(fn)
+		FC_NAXES(fc) = WF_NAXES(wf)
+
+		# Store CTRAN-relative list of axes in function call
+		# descriptor.  Verify that all the axes needed for the
+		# function call are included in the transformation.
+
+		do j = 1, WF_NAXES(wf) {
+		    for (k=1;  k <= naxes;  k=k+1)
+			if (axis[k] == WF_AXIS(wf,j)) {
+			    FC_AXIS(fc,j) = k
+			    break
+			}
+		    if (k > naxes)
+			call syserrs (SYS_MWMISSAX, system2)
+		}
+
+		# Call the function driver to perform any driver dependent
+		# initialization.
+
+		epa = FN_INIT(fn)
+		if (epa != NULL)
+		    call zcall2 (epa, fc, FORWARD)
+	    }
+	}
+
+	# Prepare the linear part of the input transformation P->W2.
+	# This is LTM=CD, and for axis I, LTV[i]=(W-CD*R) if no function
+	# call, or LTV[i]=(-CD*R) if there is a function assigned to axis
+	# I which already deals with the W[i].
+
+	# Copy CD matrix to LTM.
+	if (WCS_CD(w2) == NULL)
+	    call mw_mkidmd (Memd[o_ltm], pdim)
+	else
+	    call amovd (D(mw,WCS_CD(w2)), Memd[o_ltm], pdim*pdim)
+
+	# Copy -R to t_ltv.
+	if (WCS_R(w2) == NULL)
+	    call aclrd (Memd[t_ltv], pdim)
+	else
+	    call amulkd (D(mw,WCS_R(w2)), -1.0D0, Memd[t_ltv], pdim)
+
+	# Compute -CD*R in LTV.
+	call mw_vmuld (Memd[o_ltm], Memd[t_ltv], Memd[o_ltv], pdim)
+
+	# If no function calls for an axis and W is set, LTV=(W-CD*R).
+	if (WCS_W(w2) != NULL) {
+	    call amovd (D(mw,WCS_W(w2)), Memd[t_ltv], pdim)
+	    call aaddd (Memd[t_ltv], Memd[o_ltv], Memd[o_ltv], pdim)
+	    do i = 1, CT_NCALLO(ct) {
+		fc = CT_FCO(ct,i)
+		do j = 1, FC_NAXES(fc) {
+		    k = axis[FC_AXIS(fc,j)]		# undo +W[k]
+		    lp = o_ltv + k - 1
+		    Memd[lp] = Memd[lp] - Memd[t_ltv+k-1]
+		}
+	    }
+	}
+
+	# Now combine the linear terms of the input and output transformations
+	# to produce the linear portion of the full transformation.
+
+	call mw_mmuld (Memd[o_ltm], Memd[i_ltm], Memd[t_ltm], pdim)
+	call mw_vmuld (Memd[o_ltm], Memd[i_ltv], Memd[t_ltv], pdim)
+	call    aaddd (Memd[o_ltv], Memd[t_ltv], Memd[t_ltv], pdim)
+
+	# Extract the rows of the full linear transformation which are used
+	# for the axes involved in the transformation we are compiling.
+	# In the process we must examine the off-diagonal elements of the
+	# matrix to verify that the system does not include any dependencies
+	# upon axes other than those included in the transformation we are
+	# compiling.  (This restriction prohibits dimensional reduction via
+	# an image section which results in loss of a rotated axis).
+
+	do i = 1, naxes {
+	    # Get matrix line pointers for axis[i].
+	    ip = t_ltm + (axis[i]-1) * pdim
+	    op = ltm + (i-1) * naxes
+
+	    do j = 1, pdim {
+		# Is column J used by transform?
+		for (k=1;  k <= naxes;  k=k+1)
+		    if (axis[k] == j)
+			break
+
+		# If column J is not used in the transform but is not zero,
+		# then transform I is dependent upon physical axis J and
+		# we cannot do the transform.  If column J is used in the
+		# transform, copy the value to the final output matrix LTM
+		# discarding unused columns as we go.
+
+		if (k > naxes) {
+		    # Check for dependency on axis outside transform.
+		    if (abs(Memd[ip+j-1]) > EPSILOND*100.0D0)
+			call syserr (SYS_MWROTDEP)
+		} else {
+		    # Add matrix element to final LTM.
+		    Memd[op+k-1] = Memd[ip+j-1]
+		}
+	    }
+
+	    # Copy the LTV vector element.
+	    Memd[ltv+i-1] = Memd[t_ltv+axis[i]-1]
+	}
+
+	# Determine the transformation type.  This is LNR for a purely
+	# linear transformation with no rotational (off-diagonal) terms,
+	# LRO for a purely linear transform with rotational terms, and
+	# GEN for everything else.
+
+	if (CT_NCALLI(ct) > 0 || CT_NCALLO(ct) > 0)
+	    CT_TYPE(ct) = GEN
+	else {
+	    CT_TYPE(ct) = LNR
+	    do j = 1, naxes
+		do i = 1, naxes
+		    if (i != j) {
+			lp = ltm + (j-1)*naxes + i-1
+			if (abs(Memd[lp]) > EPSILOND*100.0D0) {
+			    CT_TYPE(ct) = LRO
+			    break
+			}
+		    }
+	}
+
+	# Prepare the single precision part of the transform.
+	call amovi (Memi[CT_D(ct)], Memi[CT_R(ct)], ctlen)
+
+	ct_r = CT_R(ct)
+	CT_LTM(ct_r) = coerce (ct_r + LEN_CTBASE, TY_STRUCT, TY_REAL)
+	CT_LTV(ct_r) = CT_LTM(ct_r) + matlen
+	call achtdr (Memd[CT_LTM(ct)], Memr[CT_LTM(ct_r)], matlen)
+	call achtdr (Memd[CT_LTV(ct)], Memr[CT_LTV(ct_r)], naxes)
+
+	call sfree (sp)
+	return (ct)
+end
diff --git a/sys/mwcs/mwsdefwcs.x b/sys/mwcs/mwsdefwcs.x
new file mode 100644
index 00000000..2cddc6ac
--- /dev/null
+++ b/sys/mwcs/mwsdefwcs.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mwset.h>
+include	"mwcs.h"
+
+# MW_SDEFWCS -- Set the default WCS.  This is the WCS indicated by the user
+# environment variable "setwcs", if defined and the named WCS exists, else
+# the first world system is used, else the physical system is used.
+
+procedure mw_sdefwcs (mw)
+
+pointer	mw			#I pointer to MWCS descriptor
+
+pointer	sp, defwcs
+int	envfind()
+
+begin
+	call smark (sp)
+	call salloc (defwcs, SZ_FNAME, TY_CHAR)
+
+	MI_WCS(mw) = NULL
+
+	# Set the default WCS defined in the user environment, if defined
+	# and the named WCS exists in this MWCS.
+
+	if (envfind ("defwcs", Memc[defwcs], SZ_FNAME) > 0)
+	    iferr (call mw_ssystem (mw, Memc[defwcs]))
+		;
+
+	# Otherwise, the default WCS is the first world system, if any,
+	# else it is the physical system.  The first world system is WCS 3
+	# as the physical and logical systems are systems 1 and 2 and are
+	# always defined in any MWCS.
+
+	if (MI_WCS(mw) == NULL) {
+	    if (MI_NWCS(mw) >= 3)
+		MI_WCS(mw) = MI_WCSP(mw,3)
+	    else
+		call mw_ssystem (mw, "physical")
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwseti.x b/sys/mwcs/mwseti.x
new file mode 100644
index 00000000..ac1a4baa
--- /dev/null
+++ b/sys/mwcs/mwseti.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mwset.h>
+include	"mwcs.h"
+
+# MW_SETI -- Set the value of a MWCS interface parameter.
+
+procedure mw_seti (mw, param, value)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	param			#I parameter code as defined in <mwset.h>
+int	value			#I new value for parameter
+
+begin
+	switch (param) {
+	case MW_NWCS:
+	    MI_NWCS(mw) = max (2, value)
+	case MW_REFIM:
+	    MI_REFIM(mw) = value
+	case MW_USEAXMAP:
+	    MI_USEAXMAP(mw) = value
+	default:
+	    call syserr (SYS_MWSET)
+	}
+end
diff --git a/sys/mwcs/mwshift.x b/sys/mwcs/mwshift.x
new file mode 100644
index 00000000..d863f813
--- /dev/null
+++ b/sys/mwcs/mwshift.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+# MW_SHIFT -- Front end to mw_translate, used to perform a simple shift
+# of the logical system.
+
+procedure mw_shift (mw, shift, axbits)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	shift[ARB]		#I shift for each axis in axbits
+int	axbits			#I bitflags defining axes
+
+pointer	sp, ltm, ltv_1, ltv_2
+int	axis[MAX_DIM], naxes, pdim, nelem, axmap, i
+
+begin
+	# Convert axis bitflags to axis list.
+	call mw_gaxlist (mw, axbits, axis, naxes)
+	if (naxes <= 0)
+	    return
+
+	pdim = MI_NDIM(mw)
+	nelem = pdim * pdim
+	axmap = MI_USEAXMAP(mw)
+	MI_USEAXMAP(mw) = NO
+
+	call smark (sp)
+	call salloc (ltm, nelem, TY_DOUBLE)
+	call salloc (ltv_1, pdim, TY_DOUBLE)
+	call salloc (ltv_2, pdim, TY_DOUBLE)
+
+	# Initialize the translation matrix and vectors.
+	call mw_mkidmd (Memd[ltm], pdim)
+	call aclrd (Memd[ltv_1], pdim)
+	call aclrd (Memd[ltv_2], pdim)
+
+	# Enter the axis shifts.
+	do i = 1, naxes
+	    Memd[ltv_2+axis[i]-1] = shift[i]
+
+	# Perform the translation.
+	call mw_translated (mw, Memd[ltv_1], Memd[ltm], Memd[ltv_2], pdim)
+
+	MI_USEAXMAP(mw) = axmap
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwshow.x b/sys/mwcs/mwshow.x
new file mode 100644
index 00000000..1fbb991c
--- /dev/null
+++ b/sys/mwcs/mwshow.x
@@ -0,0 +1,152 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imio.h>
+include	"mwcs.h"
+
+# MW_SHOW -- Print information about a MWCS object to a file.
+
+procedure mw_show (mw, fd, what)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	fd			#I output file
+int	what			#I type of output (not used at present)
+
+pointer	wp
+int	ndim, nwcs, wcs, i, j
+bool	itob()
+
+begin
+	ndim = MI_NDIM(mw)
+	nwcs = MI_NWCS(mw)
+
+	call fprintf (fd,
+	    "MWCS=%x, ndim=%d, nwcs=%d, curwcs=%d(%s), refim=%s\n")
+	    call pargi (mw)
+	    call pargi (ndim)
+	    call pargi (nwcs)
+
+	    wcs = INDEFI
+	    do i = 1, MI_NWCS(mw)
+		if (MI_WCS(mw) == MI_WCSP(mw,i)) {
+		    wcs = i
+		    break
+		}
+	    call pargi (wcs)
+	    if (MI_WCS(mw) != NULL) {
+		wp = MI_WCS(mw)
+		if (WCS_SYSTEM(wp) != NULL)
+		    call pargstr (S(mw,WCS_SYSTEM(wp)))
+		else
+		    call pargstr ("noname")
+	    }
+
+	    if (MI_REFIM(mw) != NULL)
+		call pargstr (IM_NAME(MI_REFIM(mw)))
+	    else
+		call pargstr ("none")
+
+	call fprintf (fd, "sbuflen=%d, sbufused=%d, dbuflen=%d, dbufused=%d\n")
+	    call pargi (MI_SBUFLEN(mw))
+	    call pargi (MI_SBUFUSED(mw))
+	    call pargi (MI_DBUFLEN(mw))
+	    call pargi (MI_DBUFUSED(mw))
+
+	# Print the axis map.
+	call fprintf (fd, "useaxmap=%b, nlogdim=%d")
+	    call pargb (itob(MI_USEAXMAP(mw)))
+	    call pargi (MI_NLOGDIM(mw))
+	    call fprintf (fd, " axno=[")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%d")
+			call pargi (MI_AXNO(mw,i))
+		}
+	    call fprintf (fd, "] axval=[")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%d")
+			call pargi (MI_AXVAL(mw,i))
+		}
+	    call fprintf (fd, "] physax=[")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%d")
+			call pargi (MI_PHYSAX(mw,i))
+		}
+	    call fprintf (fd, "]\n")
+
+	# Print the LTERM.
+	call fprintf (fd, "ltv = [")
+	    do i = 1, ndim {
+		if (i > 1)
+		    call fprintf (fd, " ")
+		call fprintf (fd, "%g")
+		    call pargd (D(mw,MI_LTV(mw)+i-1))
+	    }
+	    call fprintf (fd, "]\n")
+
+	call fprintf (fd, "ltm = [")
+	    do j = 1, ndim {
+		if (j > 1)
+		    call fprintf (fd, "; ")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%g")
+			call pargd (D(mw,MI_LTM(mw)+(j-1)*ndim+i-1))
+		}
+	    }
+	    call fprintf (fd, "]\n")
+
+	# Print the world systems.
+	do wcs = 1, nwcs {
+	    wp = MI_WCSP(mw,wcs)
+	    ndim = WCS_NDIM(wp)
+
+	    call fprintf (fd,
+		"WCS %d, ndim=%d, name=%s, nwattr=%d, nfunc=%d\n")
+		call pargi (wcs)
+		call pargi (ndim)
+		if (WCS_SYSTEM(wp) != NULL)
+		    call pargstr (S(mw,WCS_SYSTEM(wp)))
+		else
+		    call pargstr ("noname")
+		call pargi (WCS_NWATTR(wp))
+		call pargi (WCS_NFUNC(wp))
+
+	    call fprintf (fd, "R = [")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%g")
+			call pargd (D(mw,WCS_R(wp)+i-1))
+		}
+		call fprintf (fd, "]\n")
+
+	    call fprintf (fd, "W = [")
+		do i = 1, ndim {
+		    if (i > 1)
+			call fprintf (fd, " ")
+		    call fprintf (fd, "%g")
+			call pargd (D(mw,WCS_W(wp)+i-1))
+		}
+		call fprintf (fd, "]\n")
+
+	    call fprintf (fd, "CD = [")
+		do j = 1, ndim {
+		    if (j > 1)
+			call fprintf (fd, "; ")
+		    do i = 1, ndim {
+			if (i > 1)
+			    call fprintf (fd, " ")
+			call fprintf (fd, "%g")
+			    call pargd (D(mw,WCS_CD(wp)+(j-1)*ndim+i-1))
+		    }
+		}
+		call fprintf (fd, "]\n")
+	}
+
+end
diff --git a/sys/mwcs/mwsltermd.x b/sys/mwcs/mwsltermd.x
new file mode 100644
index 00000000..f5619fd7
--- /dev/null
+++ b/sys/mwcs/mwsltermd.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SLTERMD -- Set the Lterm, double precision version.  Since all floating
+# data is stored as double internally, we merely copy the data in.
+
+procedure mw_sltermd (mw, ltm, ltv, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	ltm[ndim,ndim]		#I linear transformation matrix
+double	ltv[ndim]		#I translation vector
+int	ndim			#I dimensionality of system
+
+pointer	mw_allocd()
+errchk	syserrs, mw_allocd
+
+begin
+	# The dimensionality of the data must match that of the current Lterm.
+	if (ndim != MI_NDIM(mw))
+	    call syserrs (SYS_MWNDIM, "mw_sltermd")
+
+	# Copy in the data.  Cobber the old data if the Lterm has been set,
+	# otherwise allocate space in the global data area.
+
+	if (MI_LTM(mw) == NULL)
+	    MI_LTM(mw) = mw_allocd (mw, ndim*ndim)
+	call amovd (ltm, D(mw,MI_LTM(mw)), ndim*ndim)
+
+	if (MI_LTV(mw) == NULL)
+	    MI_LTV(mw) = mw_allocd (mw, ndim)
+	call amovd (ltv, D(mw,MI_LTV(mw)), ndim)
+end
diff --git a/sys/mwcs/mwsltermr.x b/sys/mwcs/mwsltermr.x
new file mode 100644
index 00000000..975221f6
--- /dev/null
+++ b/sys/mwcs/mwsltermr.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SLTERMR -- Set the Lterm, single precision version.  Since all floating
+# data is stored as double internally, a real->double conversion is involved,
+# but no precision is lost provided single precision is adequate to describe
+# the input data (an example of a case where precision is lost is a rotation,
+# where there is a difference between the single and double precision version
+# of, e.g., "sin(theta)").
+
+procedure mw_sltermr (mw, ltm, ltv, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	ltm[ndim,ndim]		#I linear transformation matrix
+real	ltv[ndim]		#I translation vector
+int	ndim			#I dimensionality of system
+
+int	nelem
+pointer	mw_allocd()
+errchk	syserrs, mw_allocd
+
+begin
+	# The dimensionality of the data must match that of the current Lterm.
+	if (ndim != MI_NDIM(mw))
+	    call syserrs (SYS_MWNDIM, "mw_sltermr")
+
+	# Copy in the data.  Cobber the old data if the Lterm has been set,
+	# otherwise allocate space in the global data area.
+
+	nelem = ndim * ndim
+	if (MI_LTM(mw) == NULL)
+	    MI_LTM(mw) = mw_allocd (mw, nelem)
+	call achtrd (ltm, D(mw,MI_LTM(mw)), nelem)
+
+	if (MI_LTV(mw) == NULL)
+	    MI_LTV(mw) = mw_allocd (mw, ndim)
+	call achtrd (ltv, D(mw,MI_LTV(mw)), ndim)
+end
diff --git a/sys/mwcs/mwssys.x b/sys/mwcs/mwssys.x
new file mode 100644
index 00000000..ec1558eb
--- /dev/null
+++ b/sys/mwcs/mwssys.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SSYSTEM -- Make the named world coordinate system the default.
+
+procedure mw_ssystem (mw, system)
+
+pointer	mw			#I pointer to MWCS descriptor
+char	system[ARB]		#I system name
+
+pointer	wp
+bool	streq()
+pointer	mw_findsys()
+errchk	mw_findsys
+
+begin
+	if (streq (system, "world"))
+	    call mw_sdefwcs (mw)		# set default world system
+	else {
+	    wp = mw_findsys (mw, system)
+	    if (wp != NULL)
+		MI_WCS(mw) = wp
+	    else
+		call syserrs (SYS_MWWCSNF, system)
+	}
+end
diff --git a/sys/mwcs/mwstati.x b/sys/mwcs/mwstati.x
new file mode 100644
index 00000000..03e80587
--- /dev/null
+++ b/sys/mwcs/mwstati.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<mwset.h>
+include	<mach.h>
+include	"mwcs.h"
+
+# MW_STATI -- Get the value of a MWCS interface parameter.
+
+int procedure mw_stati (mw, param)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	param			#I parameter code as defined in <mwset.h>
+
+begin
+	switch (param) {
+	case MW_NDIM:
+	    if (MI_USEAXMAP(mw) == NO)
+		return (MI_NDIM(mw))
+	    else
+		return (MI_NLOGDIM(mw))
+	case MW_NWCS:
+	    return (MI_NWCS(mw))
+	case MW_REFIM:
+	    return (MI_REFIM(mw))
+	case MW_USEAXMAP:
+	    return (MI_USEAXMAP(mw))
+	case MW_NPHYSDIM:
+	    return (MI_NDIM(mw))
+	case MW_SAVELEN:
+	    return (MI_LEN(mw) * SZ_STRUCT + MI_DBUFUSED(mw) * SZ_DOUBLE +
+		(MI_SBUFUSED(mw) + SZB_CHAR-1) / SZB_CHAR)
+	default:
+	    call syserr (SYS_MWSTAT)
+	}
+end
diff --git a/sys/mwcs/mwsv.h b/sys/mwcs/mwsv.h
new file mode 100644
index 00000000..e08a6069
--- /dev/null
+++ b/sys/mwcs/mwsv.h
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MWSV.H -- Definitions for the MWSV external save-MWSV data format.  This
+# has been generalized slightly over the original "version 0" design, but is
+# still not very general and should be redone at some point.  There is an
+# implicit assumption that most of the elements of the MWSV structure are
+# identical to those in the MWCS runtime descriptor.
+
+define	MWSV_MAGIC	4D57X			# identifies MWSV descriptor
+define	MWSV_VERSION	1			# current MWSV version
+define	MWSV_MAXWCS	8			# max wcs per mwcs
+define	MWSV_LENWCS0	282			# LENWCS for MWSV version 0
+
+# Header for the saved MWCS object.  Object LENs are in the natural units of
+# whatever object the field refers to.  Save buffer offsets are type char
+# regardless of the object type.  The unused fields at the end of the header
+# are reserved for future use and are set to zero in the current version.
+
+define	LEN_SVHDR	16
+define	SV_MAGIC	Memi[$1]		# magic marker
+define	SV_CWCSLEN	Memi[$1+1]		# length of compressed MWSV
+define	SV_MWSVLEN	Memi[$1+2]		# full length of MWSV descr.
+define	SV_MWSVOFF	Memi[$1+3]		# char offset of saved MWSV
+define	SV_DBUFLEN	Memi[$1+4]		# length of saved DBUF
+define	SV_DBUFOFF	Memi[$1+5]		# char offset of saved DBUF
+define	SV_SBUFLEN	Memi[$1+6]		# length of saved SBUF
+define	SV_SBUFOFF	Memi[$1+7]		# char offset of saved SBUF
+define	SV_VERSION	Memi[$1+8]		# MWSV save file version number
+define	SV_NWCS		Memi[$1+9]		# number of saved WCS structs
+define	SV_LENWCS	Memi[$1+10]		# length of WCS substruct
+
+# MWSV descriptor.  This is very similar to the MWCS runtime descriptor
+# except that the size of a WCS sub-structure (LENWCS) can vary.  If the
+# MWSV version is 0 lenwcs is fixed at MS_LENWCS0, otherwise the value of
+# lenwcs is given in the save header as the value of field SV_LENWCS.
+
+define	MWSV_BASELEN	70
+define	LEN_MWSV	(MWSV_BASELEN+($1)*($2))
+
+define	MS_MAGIC	Memi[$1]		# magic marker
+define	MS_WCSP		($1+70+(($2)-1)*($3))	# $1=ms $2=wcs $3=lenwcs
diff --git a/sys/mwcs/mwswattrs.x b/sys/mwcs/mwswattrs.x
new file mode 100644
index 00000000..14fc72bd
--- /dev/null
+++ b/sys/mwcs/mwswattrs.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWATTRS -- Set the string value of the named WCS attribute for axis N.
+# The attribute is created if not already defined.  If axis N=0 is specified,
+# the attribute pertains to the entire WCS, not just one axis.
+
+procedure mw_swattrs (mw, axis, attribute, valstr)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis to which attribute belongs
+char	attribute[ARB]		#I attribute name
+char	valstr[ARB]		#I attribute value
+
+pointer	wp, ap
+int	atno, i
+bool	streq()
+int	mw_refstr()
+errchk	syserrs, mw_refstr
+
+begin
+	# Get current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_swattrs")
+
+	# Lookup the named attribute and replace the pointer to the value
+	# string if found.  Otherwise, add a new attribute.
+
+	atno = 0
+	do i = 1, WCS_NWATTR(wp) {
+	    ap = WCS_WATTR(wp,i)
+	    if (AT_AXIS(ap) == axis)
+		if (streq (S(mw,AT_NAME(ap)), attribute)) {
+		    atno = i
+		    break
+		}
+	}
+
+	# Add a new attribute?
+	if (atno == 0) {
+	    atno = WCS_NWATTR(wp) + 1
+	    if (atno > MAX_WATTR)
+		call syserrs (SYS_MWATOVFL, attribute)
+	    else {
+		WCS_NWATTR(wp) = atno
+		ap = WCS_WATTR(wp,atno)
+		AT_AXIS(ap) = axis
+		AT_NAME(ap) = mw_refstr (mw, attribute)
+	    }
+	}
+
+	# Store the value string.
+	AT_VALUE(ap) = mw_refstr (mw, valstr)
+end
diff --git a/sys/mwcs/mwswsampd.x b/sys/mwcs/mwswsampd.x
new file mode 100644
index 00000000..10d02068
--- /dev/null
+++ b/sys/mwcs/mwswsampd.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWSAMPD -- Set the sampled WCS curve for an axis.
+
+procedure mw_swsampd (mw, axis, pv, wv, npts)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis which gets the wsamp vector
+double	pv[ARB]			#I physical coordinates of points
+double	wv[ARB]			#I world coordinates of points
+int	npts			#I number of data point in curve
+
+pointer	wp
+int	mw_allocd()
+errchk	syserrs, mw_allocd
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_swsampd")
+
+	# Overwrite the current curve, if any, else allocate new storage.
+	if (WCS_PV(wp,axis) == NULL || WCS_NPTS(wp,axis) < npts)
+	    WCS_PV(wp,axis) = mw_allocd (mw, npts)
+	call amovd (pv, D(mw,WCS_PV(wp,axis)), npts)
+
+	if (WCS_WV(wp,axis) == NULL || WCS_NPTS(wp,axis) < npts)
+	    WCS_WV(wp,axis) = mw_allocd (mw, npts)
+	call amovd (wv, D(mw,WCS_WV(wp,axis)), npts)
+
+	WCS_NPTS(wp,axis) = npts
+end
diff --git a/sys/mwcs/mwswsampr.x b/sys/mwcs/mwswsampr.x
new file mode 100644
index 00000000..3fcf3f70
--- /dev/null
+++ b/sys/mwcs/mwswsampr.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWSAMPR -- Set the sampled WCS curve for an axis.
+
+procedure mw_swsampr (mw, axis, pv, wv, npts)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis			#I axis which gets the wsamp vector
+real	pv[ARB]			#I physical coordinates of points
+real	wv[ARB]			#I world coordinates of points
+int	npts			#I number of data point in curve
+
+pointer	wp
+int	mw_allocd()
+errchk	syserrs, mw_allocd
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_swsampr")
+
+	# Overwrite the current curve, if any, else allocate new storage.
+	if (WCS_PV(wp,axis) == NULL || WCS_NPTS(wp,axis) < npts)
+	    WCS_PV(wp,axis) = mw_allocd (mw, npts)
+	call achtrd (pv, D(mw,WCS_PV(wp,axis)), npts)
+
+	if (WCS_WV(wp,axis) == NULL || WCS_NPTS(wp,axis) < npts)
+	    WCS_WV(wp,axis) = mw_allocd (mw, npts)
+	call achtrd (wv, D(mw,WCS_WV(wp,axis)), npts)
+
+	WCS_NPTS(wp,axis) = npts
+end
diff --git a/sys/mwcs/mwswtermd.x b/sys/mwcs/mwswtermd.x
new file mode 100644
index 00000000..0e392dc4
--- /dev/null
+++ b/sys/mwcs/mwswtermd.x
@@ -0,0 +1,47 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWTERMD -- Set the linear part of the Wterm, i.e., the physical and world
+# coordinates of the reference point and the CD matrix.  It is the Wterm of
+# the current default WCS which is affected.
+
+procedure mw_swtermd (mw, r, w, cd, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	r[ndim]			#I physical coordinates of reference point
+double	w[ndim]			#I world coordinates of reference point
+double	cd[ndim,ndim]		#I CD matrix
+int	ndim			#I dimension of Wterm
+
+pointer	wp
+pointer	mw_allocd()
+errchk	mw_allocd, syserrs
+string	s_name "mw_swtermd"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify the dimension.
+	if (WCS_NDIM(wp) != ndim)
+	    call syserrs (SYS_MWNDIM, s_name)
+
+	# Copy in the data.  Cobber the old data if the Wterm has been set,
+	# otherwise allocate space in the global data area.
+
+	if (WCS_R(wp) == NULL)
+	    WCS_R(wp) = mw_allocd (mw, ndim)
+	call amovd (r, D(mw,WCS_R(wp)), ndim)
+
+	if (WCS_W(wp) == NULL)
+	    WCS_W(wp) = mw_allocd (mw, ndim)
+	call amovd (w, D(mw,WCS_W(wp)), ndim)
+
+	if (WCS_CD(wp) == NULL)
+	    WCS_CD(wp) = mw_allocd (mw, ndim*ndim)
+	call amovd (cd, D(mw,WCS_CD(wp)), ndim*ndim)
+end
diff --git a/sys/mwcs/mwswtermr.x b/sys/mwcs/mwswtermr.x
new file mode 100644
index 00000000..0f52419c
--- /dev/null
+++ b/sys/mwcs/mwswtermr.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_SWTERMR -- Set the linear part of the Wterm, i.e., the physical and world
+# coordinates of the reference point and the CD matrix.  It is the Wterm of
+# the current default WCS which is affected.
+
+procedure mw_swtermr (mw, r, w, cd, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	r[ndim]			#I physical coordinates of reference point
+real	w[ndim]			#I world coordinates of reference point
+real	cd[ndim,ndim]		#I CD matrix
+int	ndim			#I dimension of Wterm
+
+pointer	wp
+int	nelem
+pointer	mw_allocd()
+errchk	mw_allocd, syserrs
+string	s_name "mw_swtermr"
+
+begin
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, s_name)
+
+	# Verify the dimension.
+	if (WCS_NDIM(wp) != ndim)
+	    call syserrs (SYS_MWNDIM, s_name)
+
+	# Copy in the data.  Cobber the old data if the Wterm has been set,
+	# otherwise allocate space in the global data area.
+
+	if (WCS_R(wp) == NULL)
+	    WCS_R(wp) = mw_allocd (mw, ndim)
+	call achtrd (r, D(mw,WCS_R(wp)), ndim)
+
+	if (WCS_W(wp) == NULL)
+	    WCS_W(wp) = mw_allocd (mw, ndim)
+	call achtrd (w, D(mw,WCS_W(wp)), ndim)
+
+	nelem = ndim * ndim
+	if (WCS_CD(wp) == NULL)
+	    WCS_CD(wp) = mw_allocd (mw, nelem)
+	call achtrd (cd, D(mw,WCS_CD(wp)), nelem)
+end
diff --git a/sys/mwcs/mwswtype.x b/sys/mwcs/mwswtype.x
new file mode 100644
index 00000000..13ab5938
--- /dev/null
+++ b/sys/mwcs/mwswtype.x
@@ -0,0 +1,131 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	"mwcs.h"
+
+# MW_SWTYPE -- Set the coordinate (WCS function) type and any related
+# attributes for an axis, or set of related axes, of a WCS.  Each call
+# defines a group of one or more axes which share the same WCS function
+# and which are dependent, i.e., all axes are required to evaluate the
+# coordinate of any axis in the group.  Independent axes or groups of
+# axes should be defined in separate calls.
+#
+# Although the attributes for each axis in the group are all entered in
+# a single call via the WATTR string, each attribute is still assigned
+# to a single axis.  The syntax is as follows:
+#
+#	axis 1: format="...", label="..."
+#	axis 2: ...(etc.)
+#
+# where the axis number is relative to the start of the group.
+# The WATTR string may be any length and may contain multiple lines of text.
+# A typical use of attributes is to define WCS specific parameters; these
+# may be read by the initialization routine in the WCS function driver,
+# called when a coordinate transformation is compiled.
+
+procedure mw_swtype (mw, axis, naxes, wtype, wattr)
+
+pointer	mw			#I pointer to MWCS descriptor
+int	axis[naxes]		#I axis number, 1:ndim
+int	naxes			#I number of axes in function group
+char	wtype[ARB]		#I axis coordinate type
+char	wattr[ARB]		#I axis attributes, "attr=value, ..."
+
+pointer	sp, atname, valstr, wp, op, wf
+int	ip, ch, fn, wfno, ax, sz_valstr, i
+int	ctowrd(), mw_flookup(), ctoi(), strlen()
+errchk	syserrs, mw_swattrs, mw_flookup
+bool	streq()
+
+begin
+	call smark (sp)
+	sz_valstr = strlen (wattr)
+	call salloc (valstr, sz_valstr, TY_CHAR)
+	call salloc (atname, SZ_ATNAME, TY_CHAR)
+
+	# Get the current WCS.
+	wp = MI_WCS(mw)
+	if (wp == NULL)
+	    call syserrs (SYS_MWNOWCS, "mw_swtype")
+
+	# Set the function type?
+	if (wtype[1] != EOS) {
+	    # Determine the function type for this axis group.
+	    fn = mw_flookup (mw, wtype)
+	    if (fn == ERR)
+		call syserrs (SYS_MWUNKFN, wtype)
+
+	    # For anything except a simple linear relation, add a new function
+	    # descriptor to the WCS.
+
+	    if (fn != F_LINEAR) {
+		# Allocate new WCS function descriptor.
+		wfno = WCS_NFUNC(wp) + 1
+		if (wfno > MAX_FUNC)
+		    call syserrs (SYS_MWFUNCOVFL, wtype)
+		WCS_NFUNC(wp) = wfno
+
+		# Initialize the descriptor. 
+		wf = WCS_FUNC(wp,wfno)
+		WF_FN(wf) = fn
+		WF_NAXES(wf) = naxes
+		call amovi (axis, WF_AXIS(wf,1), naxes)
+	    } else
+		wfno = 0
+
+	    # Set the axis type and class.
+	    do i = 1, naxes {
+		call mw_swattrs (mw, axis[i], "wtype", wtype)
+		WCS_AXCLASS(wp,axis[i]) = wfno
+	    }
+	}
+
+	# Process the attributes into the WCS descriptor.
+	ax = axis[1]
+	for (ip=1;  wattr[ip] != EOS;  ) {
+	    # Skip to next token.
+	    ch = wattr[ip]
+	    while (IS_WHITE(ch) || ch == ',' || ch == '\n' || ch == ':') {
+		ip = ip + 1
+		ch = wattr[ip]
+	    }
+
+	    # Done?
+	    if (ch == EOS)
+		break
+
+	    # Extract attribute name string.
+	    op = atname
+	    ch = wattr[ip]
+	    while (IS_ALNUM(ch) || ch == '_' || ch == '$') {
+		Memc[op] = ch
+		op = min (atname+SZ_ATNAME, op + 1)
+		ip = ip + 1
+		ch = wattr[ip]
+	    }
+	    Memc[op] = EOS
+
+	    # Check for "axis N:" and set AX if encountered.
+	    if (streq (Memc[atname], "axis"))
+		if (ctoi (wattr, ip, i) > 0) {
+		    ax = axis[i]
+		    next
+		}
+
+	    # Skip to value string.
+	    ch = wattr[ip]
+	    while (IS_WHITE(ch) || ch == '=' || ch == '\n') {
+		ip = ip + 1
+		ch = wattr[ip]
+	    }
+
+	    # Extract value string.
+	    ch = ctowrd (wattr, ip, Memc[valstr], sz_valstr)
+
+	    # Add the attribute to the WCS.
+	    call mw_swattrs (mw, ax, Memc[atname], Memc[valstr])
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwtransd.x b/sys/mwcs/mwtransd.x
new file mode 100644
index 00000000..267317ce
--- /dev/null
+++ b/sys/mwcs/mwtransd.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# MW_TRANSLATE -- Translate the logical system, i.e., perform a linear
+# transformation of the logical system by modifying the Lterm of the MWCS.
+# The transformation is defined in terms of the CURRENT LOGICAL SYSTEM,
+# subject to axis mapping, dimensional reduction, etc.  This is unlike
+# MW_SLTERM, which defines the Lterm relative to the physical system in
+# physical terms (no axis mapping, full dimensionality, etc.).
+#
+#	p' = ltm * (p - ltv_1) + ltv_2
+#	
+# For convenience the transformation is specified using separate translation
+# vectors for the input and output systems.  If ltv_1 is set to zero a
+# "fully reduced" transformation of the form used internally may be entered.
+
+procedure mw_translated (mw, ltv_1, ltm, ltv_2, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+double	ltv_1[ndim]		#I input translation vector
+double	ltm[ndim,ndim]		#I linear transformation matrix
+double	ltv_2[ndim]		#I output translation vector
+int	ndim			#I dimensionality of transform
+
+double	v
+pointer	sp, o_ltm, o_ltv, n_ltm, n_ltv, ltv
+int	pdim, nelem, axis[MAX_DIM], i, j
+errchk	syserrs
+define	err_ 91
+
+begin
+	pdim = MI_NDIM(mw)
+	nelem = pdim * pdim
+
+	call smark (sp)
+	call salloc (ltv, ndim, TY_DOUBLE)
+	call salloc (o_ltm, nelem, TY_DOUBLE)
+	call salloc (o_ltv, pdim, TY_DOUBLE)
+	call salloc (n_ltm, nelem, TY_DOUBLE)
+	call salloc (n_ltv, pdim, TY_DOUBLE)
+
+	# Combine the input and output translation vectors.
+	do j = 1, ndim {
+	    v = ltv_2[j]
+	    do i = 1, ndim
+		v = v + ltm[i,j] * (-ltv_1[i])
+	    Memd[ltv+j-1] = v
+	}
+
+	# Get axis map.
+	if (MI_USEAXMAP(mw) == NO) {
+	    if (ndim > MI_NDIM(mw))
+		goto err_
+	    do i = 1, ndim
+		axis[i] = i
+	} else {
+	    if (ndim > MI_NLOGDIM(mw))
+err_		call syserrs (SYS_MWNDIM, "mw_translate")
+	    do i = 1, ndim
+		axis[i] = MI_PHYSAX(mw,i)
+	}
+
+	# Perform the transformation.  Use a procedure call to dereference
+	# the pointers to simplify the notation.
+
+	call mw_axtran (D(mw,MI_LTM(mw)), D(mw,MI_LTV(mw)),
+	    Memd[n_ltm], Memd[n_ltv], pdim, ltm, Memd[ltv], axis, ndim)
+
+	# Update the Lterm.
+	call amovd (Memd[n_ltm], D(mw,MI_LTM(mw)), nelem)
+	call amovd (Memd[n_ltv], D(mw,MI_LTV(mw)), pdim)
+
+	call sfree (sp)
+end
+
+
+# MW_AXTRAN -- Axis mapped linear transformation.  Matrix or vector elements
+# not included in the axis map are propagated unchanged.
+
+procedure mw_axtran (o_ltm,o_ltv, n_ltm,n_ltv, pdim, ltm,ltv, ax, ndim)
+
+double	o_ltm[pdim,pdim]	#I matrix to be transformed
+double	o_ltv[pdim]		#I vector to be transformed
+double	n_ltm[pdim,pdim]	#O transformed matrix
+double	n_ltv[pdim]		#O transformed vector
+int	pdim			#I dimension of these guys
+double	ltm[ndim,ndim]		#I transform matrix
+double	ltv[ndim]		#I transform vector
+int	ax[ndim]		#I transform axis map: physax=axis[logax]
+int	ndim			#I dimension of these guys
+
+double	v
+int	i, j, k
+
+begin
+	# Transform the matrix.
+	call amovd (o_ltm, n_ltm, pdim * pdim)
+	do j = 1, ndim
+	    do i = 1, ndim {
+		v = 0
+		do k = 1, ndim
+		    # v = v + o_ltm[ax[k],ax[j]] * ltm[i,k]
+		    v = v + ltm[k,j] * o_ltm[ax[i],ax[k]]
+		n_ltm[ax[i],ax[j]] = v
+	    }
+
+	# Transform the vector.	    
+	call amovd (o_ltv, n_ltv, pdim)
+	do j = 1, ndim {
+	    v = ltv[j]
+	    do i = 1, ndim
+		v = v + ltm[i,j] * o_ltv[ax[i]]
+	    n_ltv[ax[j]] = v
+	}
+end
diff --git a/sys/mwcs/mwtransr.x b/sys/mwcs/mwtransr.x
new file mode 100644
index 00000000..3947e3d1
--- /dev/null
+++ b/sys/mwcs/mwtransr.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_TRANSLATE -- Translate the logical system, i.e., perform a linear
+# transformation of the logical system by modifying the Lterm of the MWCS.
+
+procedure mw_translater (mw, ltv_1, ltm, ltv_2, ndim)
+
+pointer	mw			#I pointer to MWCS descriptor
+real	ltv_1[ndim]		#I input translation vector
+real	ltm[ndim,ndim]		#I linear transformation matrix
+real	ltv_2[ndim]		#I output translation vector
+int	ndim			#I dimensionality of transform
+
+int	nelem
+pointer	sp, d_ltm, d_ltv1, d_ltv2
+
+begin
+	call smark (sp)
+	nelem = ndim * ndim
+	call salloc (d_ltm, nelem, TY_DOUBLE)
+	call salloc (d_ltv1, ndim, TY_DOUBLE)
+	call salloc (d_ltv2, ndim, TY_DOUBLE)
+
+	call achtrd (ltm, Memd[d_ltm], nelem)
+	call achtrd (ltv_1, Memd[d_ltv1], ndim)
+	call achtrd (ltv_2, Memd[d_ltv2], ndim)
+
+	call mw_translated (mw, Memd[d_ltv1], Memd[d_ltm], Memd[d_ltv2], ndim)
+	call sfree (sp)
+end
diff --git a/sys/mwcs/mwv1tran.gx b/sys/mwcs/mwv1tran.gx
new file mode 100644
index 00000000..170d8239
--- /dev/null
+++ b/sys/mwcs/mwv1tran.gx
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_V1TRAN -- Optimized 1D coordinate transformation for an array of points.
+
+procedure mw_v1tran$t (a_ct, x1, x2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	x1[ARB]			#I coordinates in input system
+PIXEL	x2[ARB]			#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct
+PIXEL	scale, offset
+errchk	mw_ctran$t
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	scale  = Mem$t[CT_LTM(ct)]
+	offset = Mem$t[CT_LTV(ct)]
+
+	# Perform the transformation; case LNR is a simple linear transform.
+	if (CT_TYPE(ct) == LNR) {
+	    do i = 1, npts
+		x2[i] = scale * x1[i] + offset
+	} else {
+	    do i = 1, npts
+		call mw_ctran$t (a_ct, x1[i], x2[i], 1)
+	}
+end
diff --git a/sys/mwcs/mwv2tran.gx b/sys/mwcs/mwv2tran.gx
new file mode 100644
index 00000000..6fd701f7
--- /dev/null
+++ b/sys/mwcs/mwv2tran.gx
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../mwcs.h"
+
+# MW_V2TRAN -- Optimized 2D coordinate transformation for an array of points.
+
+procedure mw_v2tran$t (a_ct, x1,y1, x2,y2, npts)
+
+pointer	a_ct			#I pointer to CTRAN descriptor
+PIXEL	x1[ARB],y1[ARB]		#I coordinates in input system
+PIXEL	x2[ARB],y2[ARB]		#O coordinates in output system
+int	npts
+
+int	i
+pointer	ct, ltm, ltv
+PIXEL	p1[2], p2[2]
+errchk	mw_ctran$t
+
+begin
+	# Get real or double version of descriptor.
+	ct = CT_$T(a_ct)
+
+	ltm = CT_LTM(ct)
+	ltv = CT_LTV(ct)
+
+	if (CT_TYPE(ct) == LNR) {
+	    # Simple linear, nonrotated transformation.
+	    do i = 1, npts {
+		x2[i] = Mem$t[ltm  ] * x1[i] + Mem$t[ltv  ]
+		y2[i] = Mem$t[ltm+3] * y1[i] + Mem$t[ltv+1]
+	    }
+	} else if (CT_TYPE(ct) == LRO) {
+	    # Linear, rotated transformation.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		x2[i] = Mem$t[ltm  ] * p1[1] + Mem$t[ltm+1] * p2[1] +
+		    Mem$t[ltv  ]
+		y2[i] = Mem$t[ltm+2] * p1[1] + Mem$t[ltm+3] * p2[1] +
+		    Mem$t[ltv+1]
+	    }
+	} else {
+	    # General case involving one or more functional terms.
+	    do i = 1, npts {
+		p1[1] = x1[i];  p1[2] = y1[i]
+		call mw_ctran$t (a_ct, p1, p2, 2)
+		x2[i] = p2[1];  y2[i] = p2[2]
+	    }
+	}
+end
diff --git a/sys/mwcs/mwvmul.gx b/sys/mwcs/mwvmul.gx
new file mode 100644
index 00000000..1c5f4867
--- /dev/null
+++ b/sys/mwcs/mwvmul.gx
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_VMUL -- Vector multiply.
+
+procedure mw_vmul$t (a, b, c, ndim)
+
+PIXEL	a[ndim,ndim]		#I input matrix
+PIXEL	b[ndim]			#I input vector
+PIXEL	c[ndim]			#O output vector
+int	ndim			#I system dimension
+
+int	i, j
+PIXEL	v
+
+begin
+	do j = 1, ndim {
+	    v = 0
+	    do i = 1, ndim
+		v = v + a[i,j] * b[i]
+	    c[j] = v
+	}
+end
diff --git a/sys/mwcs/mwvtran.gx b/sys/mwcs/mwvtran.gx
new file mode 100644
index 00000000..ddd59cb7
--- /dev/null
+++ b/sys/mwcs/mwvtran.gx
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MW_VTRAN -- Transform an array of N-dimensional points, expressed as a
+# 2D vector where v[1,i] is point I of vector V.
+
+procedure mw_vtran$t (ct, v1, v2, ndim, npts)
+
+pointer	ct			#I pointer to CTRAN descriptor
+PIXEL	v1[ndim,npts]		#I points to be transformed
+PIXEL	v2[ndim,npts]		#O vector to get the transformed points
+int	ndim			#I dimensionality of each point
+int	npts			#I number of points
+
+int	i
+errchk	mw_ctran$t
+
+begin
+	do i = 1, npts
+	    call mw_ctran$t (ct, v1[1,i], v2[1,i], ndim)
+end
diff --git a/sys/mwcs/wfait.x b/sys/mwcs/wfait.x
new file mode 100644
index 00000000..481ba7a1
--- /dev/null
+++ b/sys/mwcs/wfait.x
@@ -0,0 +1,463 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFAIT
+.nf -------------------------------------------------------------------------
+WFAIT -- WCS function driver for the Hammer-Aitoff projection.
+
+Driver routines:
+
+	FN_INIT		    wf_ait_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_ait_fwd (fc, v1, v2)
+	FN_INV		     wf_ait_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # 2 * RO * RO
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # 1 / (4 * RO * RO) (degs)
+define	FC_C3		Memd[P2D($1+FCU+20)]	     # 1 / (16 * RO * RO) (degs)
+define	FC_C4		Memd[P2D($1+FCU+22)]	     # 1 / (2 * RO) (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+24)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+26)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_AIT_INIT -- Initialize the forward or inverse Hammer-Aitoff transform.
+# Initialization for this transformation consists of, determining which axis
+# is RA / LON and which is DEC / LAT, reading in the native longitude and
+# latitude of the pole in celestial coordinates LONGPOLE and LATPOLE from the
+# attribute list, computing the celestial longitude and colatitude of the
+# native pole, precomputing the Euler angles and associated intermediary
+# functions of the reference point, reading in the projection parameter RO
+# from the attribute list, and precomputing the various required intermediate
+# quantities. If LONGPOLE is undefined then a value of 180.0 degrees is assumed
+# if the celestial latitude of the reference point is less than 0, otherwise
+# 0 degrees is assumed. If LATPOLE is undefined, the more northerly of the
+# two possible solutions is assumed, otherwise the solution closest to 
+# LATPOLE is assumed. If RO is undefined a value of 180.0 / PI is assumed.
+# In order to determine the axis order, the "axtype={ra|dec} {xlon|ylat}"
+# must have been set in the attribute list for the function. The LONGPOLE,
+# LATPOLE, and RO parameters may be set in either or both of the axes attribute
+# lists, but the value in the RA axis attribute list takes precedence. 
+
+procedure wf_ait_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_AIT_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_AIT_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_AIT_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_AIT_INIT: Invalid projection parameters")
+
+	FC_C1(fc) = 2.0d0 * FC_RODEG(fc) * FC_RODEG(fc)
+	FC_C2(fc) = 1.0d0 / (2.0d0 * FC_C1(fc))
+	FC_C3(fc) = FC_C2(fc) / 4.0d0
+	FC_C4(fc) = 1.0d0 / (2.0d0 * FC_RODEG(fc))
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_AIT_FWD -- Forward transform (physical to world) for the Hammer-Aitoff
+# projection.
+
+procedure wf_ait_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, u, z, s, xp, yp, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	ra, dec, dlng
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	u = 1.0d0 - x * x * FC_C3(fc) - y * y * FC_C2(fc)
+	if (u < 0.0d0) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+	}
+	z = sqrt (u)
+	s = z * y / FC_RODEG(fc)
+	if (s < -1.0d0 || s > 1.0d0) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+	}
+	xp = 2.0d0 * z * z - 1.0d0
+	yp = z * x * FC_C4(fc)
+	if (xp == 0.0d0 && yp == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = 2.0d0 * atan2 (yp, xp)
+
+	# Compute THETA.
+	theta = asin (s)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+       if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG (FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_AIT_INV -- Inverse transform (world to physical) for the Hammer-Aitoff
+# projection.
+
+procedure wf_ait_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, costhe, wconst
+double	dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+	if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	costhe = cos (theta)
+	wconst = sqrt (FC_C1(fc) / (1.0d0 + costhe * cos (phi / 2.0d0)))
+	p[ira] = 2.0d0 * wconst * costhe * sin (phi / 2.0d0)
+	p[idec] = wconst * sin (theta)
+end
diff --git a/sys/mwcs/wfarc.x b/sys/mwcs/wfarc.x
new file mode 100644
index 00000000..46b072b6
--- /dev/null
+++ b/sys/mwcs/wfarc.x
@@ -0,0 +1,166 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFARC
+.nf -------------------------------------------------------------------------
+WFARC -- WCS function driver for the arc projection.
+
+Driver routines:
+
+	FN_INIT		    wf_arc_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_arc_fwd (fc, v1, v2)
+	FN_INV		     wf_arc_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		# DEC axis (1 or 2)
+define	FC_COSDEC	Memd[P2D($1+FCU+2)]	# cosine(dec)
+define	FC_SINDEC	Memd[P2D($1+FCU+4)]	# sine(dec)
+define	FC_W		Memd[P2D($1+FCU+6)+($2)-1] # W (CRVAL) for each axis
+
+
+# WF_ARC_INIT -- Initialize the arc forward or inverse transform.
+# Initialization for this transformation consists of determining which axis
+# is RA and which is DEC, and precomputing the sine and cosine of the
+# declination at the reference point.  In order to determine the axis order,
+# the parameter "axtype={ra|dec}" must have been set in the attribute list
+# for the function.
+# NOTE:  This is identical to wf_tan_init.
+
+procedure wf_arc_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	ct, mw, wp, wv
+errchk	wf_decaxis
+
+begin
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e., the world coordinate at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Precompute the sin and cos of the declination at the reference pixel.
+	dec = DEGTORAD(FC_W(fc,FC_IDEC(fc)))
+	FC_COSDEC(fc) = cos(dec)
+	FC_SINDEC(fc) = sin(dec)
+end
+
+
+# WF_ARC_FWD -- Forward transform (physical to world), arc
+# projection.  Based on code from STScI, Hodge et al.
+
+procedure wf_arc_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (xi, eta)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	xi, eta, x, y, z, ra, dec
+double	theta		# distance (radians) from ref pixel to object
+double	v[3]		# unit vector with v[1] pointing toward ref pixel
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	xi  = DEGTORAD(p[ira])
+	eta = DEGTORAD(p[idec])
+
+	theta = sqrt (xi*xi + eta*eta)
+	if (theta == 0.d0) {
+	    v[1] = 1.d0
+	    v[2] = 0.d0
+	    v[3] = 0.d0
+	} else {
+	    v[1] = cos (theta)
+	    v[2] = sin (theta) / theta * xi
+	    v[3] = sin (theta) / theta * eta
+	}
+
+	# Rotate the rectangular coordinate system of the vector v by the
+	# declination so the X axis will pass through the equator.
+
+	x = v[1] * FC_COSDEC(fc) - v[3] * FC_SINDEC(fc)
+	y = v[2]
+	z = v[1] * FC_SINDEC(fc) + v[3] * FC_COSDEC(fc)
+
+	if (x == 0.d0 && y == 0.d0)
+	    ra = 0.d0
+	else
+	    ra = atan2 (y, x)
+	dec = atan2 (z, sqrt (x*x + y*y))
+
+	# Return RA and DEC in degrees.
+	dec = RADTODEG(dec)
+	ra  = RADTODEG(ra) + FC_W(fc,ira)
+
+	if (ra < 0.d0)
+	    ra = ra + 360.D0
+	else if (ra > 360.D0)
+	    ra = ra - 360.D0
+
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_ARC_INV -- Inverse transform (world to physical) for the arc
+# projection.  Based on code from Eric Greisen, AIPS Memo No. 27.
+
+procedure wf_arc_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#O output physical coordinates
+
+int	ira, idec
+double	ra, dec, xi, eta
+double	cosra, cosdec, sinra, sindec
+double	theta		# distance (radians) from ref pixel to object
+double	r		# theta / sin (theta)
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	ra  = DEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DEGTORAD (w[idec])
+
+	cosra = cos (ra)
+	sinra = sin (ra)
+
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	theta = acos (sindec * FC_SINDEC(fc) + cosdec * FC_COSDEC(fc) * cosra)
+	if (theta == 0.d0)
+	    r = 1.d0
+	else
+	    r = theta / sin (theta)
+
+	xi = r * cosdec * sinra
+	eta = r * (sindec * FC_COSDEC(fc) - cosdec * FC_SINDEC(fc) * cosra)
+
+	p[ira]  = RADTODEG(xi)
+	p[idec] = RADTODEG(eta)
+end
+
diff --git a/sys/mwcs/wfcar.x b/sys/mwcs/wfcar.x
new file mode 100644
index 00000000..a09281ac
--- /dev/null
+++ b/sys/mwcs/wfcar.x
@@ -0,0 +1,437 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFCAR
+.nf -------------------------------------------------------------------------
+WFCAR -- WCS function driver for the cylindrical cartesian projection.
+
+Driver routines:
+
+	FN_INIT		    wf_car_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_car_fwd (fc, v1, v2)
+	FN_INV		     wf_car_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define	FC_LONGP	Memd[P2D($1+FCU+6)]	     # LONGPOLE (rads)
+define	FC_COSDEC	Memd[P2D($1+FCU+8)]	     # cosine (NATDEC)
+define	FC_SINDEC	Memd[P2D($1+FCU+10)]	     # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RECRODEG	Memd[P2D($1+FCU+16)]	     # 1.0 / RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_CAR_INIT -- Initialize the cylindical cartesian forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, reading in the the native
+# longitude and latitude of the pole in celestial coordinates LONGPOLE and
+# LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and various
+# intermediary functions derived from the reference point, and reading in the
+# projection parameter RO from the attribute list. If LONGPOLE is undefined
+# then a value of 180.0 degrees is assumed if the celestial latitude of the
+# reference point is less than 0, otherwise 0 is assumed. If LATPOLE is 
+# undefined than the most northerly of the two possible solutions for the
+# latitude of the native pole is chosen, otherwise the solution closest to
+# LATPOLE is chosen. If RO is undefined a value of 180.0 / PI is assumed.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|xlat}" must have been set in the attribute list for the function.
+# The LONGPOLE, LATPOLE, and RO parameters may be set in either or both of
+# the axes attribute lists, but the value in the RA axis attribute list takes
+# precedence. 
+
+procedure wf_car_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data	tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Determine the native longitude and latitude of the pole of the
+	# celestial coordinate system corresponding to the FITS keywords
+	# LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+	# to 180 or 0 depending on the value of the declination of the
+	# reference point. LATPOLE has no default but will be set depending
+	# on the values of LONGPOLE and the reference declination.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = INDEFD
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = INDEFD
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = INDEFD
+	}
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_CAR_INIT: Invalid projection parameters")
+	    if (IS_INDEFD(latpole))
+		latp = 999.0d0
+	    else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_CAR_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+		    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_CAR_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+	if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+	    if (FC_NATRA(fc) < 0.0d0)
+		FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+	} else {
+	    if (FC_NATRA(fc) > 0.0d0)
+		FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+	}
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_CAR_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_RECRODEG(fc) = 1.0d0 / FC_RODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_CAR_FWD -- Forward transform (physical to world) for the cartesian
+# projection.
+
+procedure wf_car_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, ra, dec
+double	dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	phi = FC_RECRODEG(fc) * x
+
+	# Compute THETA.
+	theta = FC_RECRODEG(fc) * y
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  DRADTODEG( FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+	if (FC_NATRA(fc) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_CAR_INV -- Inverse transform (world to physical) for the cartesian
+# projection.
+
+procedure wf_car_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, z, dphi
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	p[ira] = FC_RODEG(fc) * phi
+	p[idec] = FC_RODEG(fc) * theta
+end
diff --git a/sys/mwcs/wfcsc.x b/sys/mwcs/wfcsc.x
new file mode 100644
index 00000000..3dedc178
--- /dev/null
+++ b/sys/mwcs/wfcsc.x
@@ -0,0 +1,624 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFCSC
+.nf -------------------------------------------------------------------------
+WFCSC -- WCS function driver for the COBE quadrilateratized cube projection.
+
+Driver routines:
+
+	FN_INIT		    wf_csc_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_csc_fwd (fc, v1, v2)
+	FN_INV		     wf_csc_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # RO * (PI / 4)
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # (4 / PI) * RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+20)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+22)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_CSC_INIT -- Initialize the forward or inverse Cobe quadrilateralized
+# forward or inverse transform. Initialization for this transformation consists
+# of, determining which axis is RA / LON and which is DEC / LAT, reading in the
+# native longitude and latitude of the pole in celestial coordinates LONGPOLE
+# and LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, Euler angles and various intermediary
+# functions of the reference point reading in the projection parameter RO from
+# the attribute list, and precomputing the various required intermediate
+# quantities. If LONGPOLE is undefined then a value of 180.0 degrees is assumed
+# if the celestial latitude is less than 0, otherwise 0 degrees is assumed.
+# If RO is undefined a value of 180.0 / PI is assumed. In order to determine
+# the axis order, the parameter "axtype={ra|dec} {xlon|ylat}" must have been
+# set in the attribute list for the function. The LONGPOLE, LATPOLE and RO
+# parameters may be set in either or both of the axes attribute lists, but the
+# value in the RA axis attribute list takes precedence. 
+
+procedure wf_csc_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_CSC_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_CSC_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_CSC_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_CSC_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_C1(fc) = FC_RODEG(fc) * (DPI / 4.0d0)
+	FC_C2(fc) = 1.0d0 / FC_C1(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_CSC_FWD -- Forward transform (physical to world) for the COBE
+# quarilateralized spherical projection.
+
+procedure wf_csc_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, face
+double	l, m, n, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, x, y, z
+double	ra, dec, dlng
+real	a, b, xf, xx, yf, yy
+real	p00, p01, p02, p03, p04, p05, p06, p10, p11, p12, p13, p14, p15, p20
+real	p21, p22, p23, p24, p30, p31, p32, p33, p40, p41, p42, p50, p51, p60
+data	p00/-.27292696/, p10/-.07629969/, p20/-.22797056/, p30/.54852384/
+data	p40/-.62930065/, p50/.25795794/, p60/.02584375/, p01/-.02819452/
+data	p11/-.01471565/, p21/.48051509/, p31/-1.74114454/, p41/1.71547508/
+data	p51/-.53022337/, p02/.27058160/, p12/-.56800938/, p22/.30803317/
+data	p32/.98938102/, p42/-.83180469/, p03/-.60441560/, p13/1.50880086/
+data	p23/-.93678576/, p33/.08693841/, p04/.93412077/, p14/-1.41601920/
+data	p24/.33887446/, p05/-.63915306/, p15/.52032238/, p06/.14381585/
+
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	xf = p[ira] * FC_C2(fc)
+	yf = p[idec] * FC_C2(fc)
+	if (xf > 5.0) {
+	    face = 4
+	    xf = xf - 6.0
+	} else if (xf > 3.0) {
+	    face = 3
+	    xf = xf - 4.0
+	} else if (xf > 1.0) {
+	    face = 2
+	    xf = xf - 2.0
+	} else if (yf > 1.0) {
+	    face = 0
+	    yf = yf - 2.0
+	} else if (yf < -1.0) {
+	    face = 5
+	    yf = yf + 2.0
+	} else {
+	    face = 1
+	}
+
+	xx = xf * xf
+	yy = yf * yf
+	a =    (p00+xx*(p10+xx*(p20+xx*(p30+xx*(p40+xx*(p50+xx*(p60)))))) + 
+	    yy*(p01+xx*(p11+xx*(p21+xx*(p31+xx*(p41+xx*(p51))))) +
+	    yy*(p02+xx*(p12+xx*(p22+xx*(p32+xx*(p42)))) +
+	    yy*(p03+xx*(p13+xx*(p23+xx*(p33))) +
+	    yy*(p04+xx*(p14+xx*(p24)) +
+	    yy*(p05+xx*(p15) +
+	    yy*(p06)))))))
+	a = xf + xf * (1.0 - xx) * a
+	b =    (p00+yy*(p10+yy*(p20+yy*(p30+yy*(p40+yy*(p50+yy*(p60)))))) + 
+	    xx*(p01+yy*(p11+yy*(p21+yy*(p31+yy*(p41+yy*(p51))))) +
+	    xx*(p02+yy*(p12+yy*(p22+yy*(p32+yy*(p42)))) +
+	    xx*(p03+yy*(p13+yy*(p23+yy*(p33))) +
+	    xx*(p04+yy*(p14+yy*(p24)) +
+	    xx*(p05+yy*(p15) +
+	    xx*(p06)))))))
+	b = yf + yf * (1.0 - yy) * b
+
+	switch (face) {
+	case 0:
+	    n = 1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    l = a * n
+	    m = -b * n
+	case 1:
+	    m = 1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    l = a * m
+	    n = b * m
+	case 2:
+	    l = 1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    m = -a * l
+	    n = b * l
+	case 3:
+	    m = -1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    l = a * m
+	    n = -b * m
+	case 4:
+	    l = -1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    m = -a * l
+	    n = -b * l
+	case 5:
+	    n = -1.0d0 / sqrt (a * a + b * b + 1.0d0)
+	    l = -a * n
+	    m = -b * n
+	}
+
+	# Compute PHI.
+	if (l == 0.0d0 && m == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (l, m)
+
+	# Compute THETA.
+	theta = asin(n)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_CSC_INV -- Inverse transform (world to physical) for the COBE
+# quadilateralized spherical projection.
+
+procedure wf_csc_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, face
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, phi, theta, dphi
+double	costhe, eta, l, m, n, rho, xi
+real	tol, a, a2, a2b2, a4, b, b2, b4, ca2, cb2, x0, xf, y0, yf
+real	c00, c10, c01, c11, c20, c02, d0, d1, mm, gamma, gstar, omega1
+data	gstar/1.37484847732/, mm/.004869491981/, gamma/-.13161671474/
+data	omega1/-.159596235474/, d0/.0759196200467/, d1/-.0217762490699/
+data	c00/.141189631152/, c10/.0809701286525/, c01/-.281528535557/
+data	c11/.15384112876/, c20/-.178251207466/, c02/.106959469314/
+data	tol /1.0e-7/
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+	costhe = cos (theta)
+	l = costhe * sin (phi)
+	m = costhe * cos (phi)
+	n = sin (theta)
+
+	face = 0
+	rho = n
+	if (m > rho) {
+	    face = 1 
+	    rho = m
+	}
+	if (l > rho) {
+	    face = 2
+	    rho = l
+	}
+	if (-m > rho) {
+	    face = 3
+	    rho = -m
+	}
+	if (-l > rho) {
+	    face = 4
+	    rho = -l
+	}
+	if (-n > rho) {
+	    face = 5
+	    rho = -n
+	}
+
+	switch (face) {
+	case 0:
+	    xi = l
+	    eta = -m
+	    x0 = 0.0
+	    y0 = 2.0
+	case 1:
+	    xi = l
+	    eta = n
+	    x0 = 0.0
+	    y0 = 0.0
+	case 2:
+	    xi = -m
+	    eta = n
+	    x0 = 2.0
+	    y0 = 0.0
+	case 3:
+	    xi = -l
+	    eta = n
+	    x0 = 4.0
+	    y0 = 0.0
+	case 4:
+	    xi = m
+	    eta = n
+	    x0 = 6.0
+	    y0 = 0.0
+	case 5:
+	    xi = l
+	    eta = m
+	    x0 = 0.0
+	    y0 = -2.0
+	}
+
+	a = xi / rho
+	b = eta / rho
+	a2 = a * a
+	b2 = b * b
+	a4 = a2 * a2
+	b4 = b2 * b2
+	a2b2 = a2 * b2
+	ca2 = 1.0 - a2
+	cb2 = 1.0 - b2
+
+	xf = a*(a2+ca2*(gstar+b2*(gamma*ca2+mm*a2 +
+	     cb2*(c00+c10*a2+c01*b2+c11*a2b2+c20*a4+c02*b4)) +
+	     a2*(omega1-ca2*(d0+d1*a2))))
+	yf = b*(b2+cb2*(gstar+a2*(gamma*cb2+mm*b2 +
+	     ca2*(c00+c10*b2+c01*a2+c11*a2b2+c20*b4+c02*a4)) +
+	     b2*(omega1-cb2*(d0+d1*b2))))
+
+	if (abs(xf) > 1.0) {
+	    if (abs(xf) > (1.0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (xf >= 0.0)
+		xf = 1.0
+	    else
+		xf = -1.0
+	}
+	if (abs(yf) > 1.0) {
+	    if (abs(yf) > (1.0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (yf >= 0.0)
+		yf = 1.0
+	    else
+		yf = -1.0
+	}
+
+	p[ira] = FC_C1(fc) * (x0 + xf)
+	p[idec] = FC_C1(fc) * (y0 + yf)
+end
diff --git a/sys/mwcs/wfdecaxis.x b/sys/mwcs/wfdecaxis.x
new file mode 100644
index 00000000..32c59bd8
--- /dev/null
+++ b/sys/mwcs/wfdecaxis.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+
+# WF_DECAXIS -- Determine which of the 2 axes for the current function is
+# the DEC axis.
+
+procedure wf_decaxis (fc, ira, idec)
+
+pointer	fc			#I pointer to function call descriptor
+int	ira, idec		#O CTRAN relative RA, DEC axis numbers
+
+pointer	ct, mw
+int	ax[2], i
+char	axtype[4]
+bool	streq()
+
+begin
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+
+	# This function requires exactly 2 axes.
+	if (FC_NAXES(fc) != 2)
+	    call error (1, "A projection WCS requires 2 axes")
+
+	# Map FC axis (1 or 2) to CTRAN axis to physical axis.
+	do i = 1, 2
+	    ax[i] = CT_AXIS(ct,FC_AXIS(fc,i))
+
+	# Determine which is the DEC/LAT axis, and hence the axis order.
+	ira = 0
+	idec = 0
+	do i = 1, 2
+	    ifnoerr (call mw_gwattrs (mw, ax[i], "axtype", axtype, 4)) {
+		call strlwr (axtype)
+		if (streq (axtype, "ra") || streq (axtype[2], "lon")) {
+		    ira  = i
+		    idec = 3 - i
+		    break
+		} else if (streq (axtype, "dec") || streq (axtype[2], "lat")) {
+		    ira  = 3 - i
+		    idec = i
+		    break
+		} 
+	    }
+
+	if (idec == 0)
+	    call error (2,
+	    "DEC/xLAT axis must be specified for a projection WCS")
+end
diff --git a/sys/mwcs/wfgls.x b/sys/mwcs/wfgls.x
new file mode 100644
index 00000000..942cfdd1
--- /dev/null
+++ b/sys/mwcs/wfgls.x
@@ -0,0 +1,442 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFGLS
+.nf -------------------------------------------------------------------------
+WFGLS -- WCS function driver for the Sanson-Flamsteed sinusoidal projection.
+
+Driver routines:
+
+	FN_INIT		    wf_gls_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_gls_fwd (fc, v1, v2)
+	FN_INV		     wf_gls_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RECRODEG	Memd[P2D($1+FCU+16)]	     # 1 / RO (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_GLS_INIT -- Initialize the forward or inverse Sanson-Flamsteed global
+# sinusoidal transform. Initialization for this transformation consists of,
+# determining which axis is RA / LON and which is DEC / LAT, reading in the 
+# ative longitudend latitude of the pole in celestial coordinates LONGPOLE
+# and LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and various
+# intermediary functions of the reference point, reading in the projection
+# parameter RO from the attribute list, and precomputing the various required
+# intermediate quantities. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed if the native latitude of the reference point is less
+# than 0, otherwise 0 degrees is assumed. If LATPOLE is undefined then the
+# most northerly of the two possible solutions for the latitude of the
+# native pole is chosen. If RO is undefined a value of 180.0 / PI is assumed.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|xlat}" must have been set in the attribute list for the function.
+# The LONGPOLE, LATPOLE,  and RO parameters may be set in either or both of
+# the axes attribute lists, but the value in the RA axis attribute list
+# takes precedence. 
+
+procedure wf_gls_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+	iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+       # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_GLS_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_GLS_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_GLS_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_GLS_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_RECRODEG(fc) = 1.0d0 / FC_RODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_GLS_FWD -- Forward transform (physical to world) for the Sanson-Flamsteed
+# global sinusoidal projection.
+
+procedure wf_gls_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, wconst, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	ra, dec, dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI
+	wconst = cos (y * FC_RECRODEG(fc))
+	if (wconst == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = x * FC_RECRODEG(fc) / wconst
+
+	# Compute THETA.
+	theta = y * FC_RECRODEG(fc)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+        # Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+        # Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_GLS_INV -- Inverse transform (world to physical) for the Sanson-Flamsteed
+# global sinusoidal projection.
+
+procedure wf_gls_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, phi, theta, dphi
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	p[ira] = FC_RODEG(fc) * phi * cos (theta)
+	p[idec] = FC_RODEG(fc) * theta
+
+end
diff --git a/sys/mwcs/wfgsurfit.x b/sys/mwcs/wfgsurfit.x
new file mode 100644
index 00000000..8dca0f70
--- /dev/null
+++ b/sys/mwcs/wfgsurfit.x
@@ -0,0 +1,575 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# WFGSURFIT.X -- Surface fitting package used by WCS function drivers.
+#
+# The following routines are used by the experimental function drivers tnx
+# and zpx to decode polynomial fits stored in the image header in the form
+# of a list of parameters and coefficients into surface descriptors in
+# ra / dec or longitude latitude. The polynomial surfaces so encoded consist
+# of corrections to function drivers tan and zpn. The package routines are
+# modelled after the equivalent gsurfit routines and are consistent with them.
+# The routines are:
+#
+#                 sf = wf_gsopen (wattstr)
+#                     wf_gsclose (sf)
+#
+#                  z = wf_gseval (sf, x, y)
+#                     wf_gscoeff (sf, coeff, ncoeff)
+#                zder = wf_gsder (sf, x, y, nxder, nyder)
+#
+# WF_GSOPEN is used to open a surface fit encoded in a WCS attribute, returning
+# the SF surface fitting descriptor.  wf_gsclose should be called later to free
+# the descriptor.  WF_GSEVAL is called to evaluate the surface at a point.
+
+
+define  SZ_GSCOEFFBUF     20
+
+# Define the surface descriptor.
+define  LEN_WFGSSTRUCT    20
+
+define  WF_XRANGE       Memd[P2D($1)]   # 2. / (xmax - xmin), polynomials
+define  WF_XMAXMIN      Memd[P2D($1+2)] # - (xmax + xmin) / 2., polynomials
+define  WF_YRANGE       Memd[P2D($1+4)] # 2. / (ymax - ymin), polynomials
+define  WF_YMAXMIN      Memd[P2D($1+6)] # - (ymax + ymin) / 2., polynomials
+define  WF_TYPE         Memi[$1+8]      # Type of curve to be fitted
+define  WF_XORDER       Memi[$1+9]      # Order of the fit in x
+define  WF_YORDER       Memi[$1+10]     # Order of the fit in y
+define  WF_XTERMS       Memi[$1+11]     # Cross terms for polynomials
+define  WF_NCOEFF       Memi[$1+12]     # Total number of coefficients
+define  WF_COEFF        Memi[$1+13]     # Pointer to coefficient vector
+define  WF_XBASIS       Memi[$1+14]     # Pointer to basis functions (all x)
+define  WF_YBASIS       Memi[$1+15]     # Pointer to basis functions (all y)
+
+# Define the structure elements for the wf_gsrestore task.
+define  WF_SAVETYPE     $1[1]
+define  WF_SAVEXORDER   $1[2]
+define  WF_SAVEYORDER   $1[3]
+define  WF_SAVEXTERMS   $1[4]
+define  WF_SAVEXMIN     $1[5]
+define  WF_SAVEXMAX     $1[6]
+define  WF_SAVEYMIN     $1[7]
+define  WF_SAVEYMAX     $1[8]
+
+# Define the permitted types of surfaces.
+define  WF_CHEBYSHEV    1
+define  WF_LEGENDRE     2
+define  WF_POLYNOMIAL   3
+
+# Define the cross-terms flags.
+define  WF_XNONE        0       # no x-terms (old NO)
+define  WF_XFULL        1       # full x-terms (new YES)
+define  WF_XHALF        2       # half x-terms (new)
+
+define	WF_SAVECOEFF	8
+
+
+# WF_GSOPEN -- Decode the longitude / latitude or ra / dec mwcs attribute
+# and return a gsurfit compatible surface descriptor.
+
+pointer procedure wf_gsopen (atstr)
+
+char    atstr[ARB]              #I the input mwcs attribute string
+
+double  dval
+int     ip, npar, szcoeff
+pointer gs, sp, par, coeff
+int     nscan(), ctod()
+errchk  wf_gsrestore()
+
+begin
+        if (atstr[1] == EOS)
+            return (NULL)
+
+        call smark (sp)
+        call salloc (par, SZ_LINE, TY_CHAR)
+
+        gs = NULL
+        npar = 0
+        szcoeff = SZ_GSCOEFFBUF
+        call malloc (coeff, szcoeff, TY_DOUBLE)
+
+        call sscan (atstr)
+        repeat {
+            call gargwrd (Memc[par], SZ_LINE)
+            if (nscan() == npar)
+                break
+            if (Memc[par] == EOS)
+                break
+            ip = 1
+            if (ctod (Memc[par], ip, dval) <= 0)
+                break
+            if (npar >= szcoeff) {
+                szcoeff =szcoeff + SZ_GSCOEFFBUF
+                call realloc (coeff, szcoeff, TY_DOUBLE)
+            }
+            Memd[coeff+npar] = dval
+            npar = npar + 1
+        }
+
+        iferr (call wf_gsrestore (gs, Memd[coeff]))
+            gs = NULL
+
+        call sfree (sp)
+        call mfree (coeff, TY_DOUBLE)
+
+        if (npar == 0)
+            return (NULL)
+        else
+            return (gs)
+end
+
+
+# WF_GSCLOSE -- Procedure to free the surface descriptor.
+
+procedure wf_gsclose (sf)
+
+pointer sf      	#U the surface descriptor
+errchk  mfree
+
+begin
+        if (sf == NULL)
+            return
+
+        if (WF_XBASIS(sf) != NULL)
+            call mfree (WF_XBASIS(sf), TY_DOUBLE)
+        if (WF_YBASIS(sf) != NULL)
+            call mfree (WF_YBASIS(sf), TY_DOUBLE)
+        if (WF_COEFF(sf) != NULL)
+            call mfree (WF_COEFF(sf), TY_DOUBLE)
+
+        if (sf != NULL)
+            call mfree (sf, TY_STRUCT)
+end
+
+
+# WF_GSEVAL -- Procedure to evaluate the fitted surface at a single point.
+# The WF_NCOEFF(sf) coefficients are stored in the vector pointed to by
+# WF_COEFF(sf).
+
+double procedure wf_gseval (sf, x, y)
+
+pointer sf              #I pointer to surface descriptor structure
+double  x               #I x value
+double  y               #I y value
+
+double  sum, accum
+int     i, ii, k, maxorder, xorder
+
+begin
+        # Calculate the basis functions.
+        switch (WF_TYPE(sf)) {
+        case WF_CHEBYSHEV:
+            call wf_gsb1cheb (x, WF_XORDER(sf), WF_XMAXMIN(sf), WF_XRANGE(sf),
+                Memd[WF_XBASIS(sf)])
+            call wf_gsb1cheb (y, WF_YORDER(sf), WF_YMAXMIN(sf), WF_YRANGE(sf),
+                Memd[WF_YBASIS(sf)])
+        case WF_LEGENDRE:
+            call wf_gsb1leg (x, WF_XORDER(sf), WF_XMAXMIN(sf), WF_XRANGE(sf),
+                Memd[WF_XBASIS(sf)])
+            call wf_gsb1leg (y, WF_YORDER(sf), WF_YMAXMIN(sf), WF_YRANGE(sf),
+                Memd[WF_YBASIS(sf)])
+        case WF_POLYNOMIAL:
+            call wf_gsb1pol (x, WF_XORDER(sf), WF_XMAXMIN(sf), WF_XRANGE(sf),
+                Memd[WF_XBASIS(sf)])
+            call wf_gsb1pol (y, WF_YORDER(sf), WF_YMAXMIN(sf), WF_YRANGE(sf),
+                Memd[WF_YBASIS(sf)])
+        default:
+            call error (0, "WF_GSEVAL: Unknown surface type.")
+        }
+
+        # Initialize accumulator basis functions.
+        sum = 0.
+
+        # Loop over y basis functions.
+        maxorder = max (WF_XORDER(sf) + 1, WF_YORDER(sf) + 1)
+        xorder = WF_XORDER(sf)
+        ii = 1
+
+        do i = 1, WF_YORDER(sf) {
+            # Loop over the x basis functions.
+            accum = 0.
+            do k = 1, xorder {
+                accum = accum + Memd[WF_COEFF(sf)+ii-1] *
+		    Memd[WF_XBASIS(sf)+k-1) 
+                ii = ii + 1
+            }
+            accum = accum * Memd[WF_YBASIS(sf)+i-1]
+            sum = sum + accum
+
+            # Elements of the coefficient vector where neither k = 1 or i = 1
+            # are not calculated if WF_XTERMS(sf) = NO.
+
+            switch (WF_XTERMS(sf)) {
+            case WF_XNONE:
+                xorder = 1
+            case WF_XHALF:
+                if ((i + WF_XORDER(sf) + 1) > maxorder)
+                    xorder = xorder - 1
+            default:
+                ;
+            }
+        }
+
+        return (sum)
+end
+
+
+# WF_GSCOEFF -- Procedure to fetch the number and magnitude of the coefficients.
+# If the WF_XTERMS(sf) = WF_XBI (YES) then the number of coefficients will be
+# (WF_XORDER(sf) * WF_YORDER(sf)); if WF_XTERMS is WF_XTRI then the number
+# of coefficients will be (WF_XORDER(sf) *  WF_YORDER(sf) - order *
+# (order - 1) / 2) where order is the minimum of the x and yorders;  if
+# WF_XTERMS(sf) = WF_XNONE then the number of coefficients will be
+# (WF_XORDER(sf) + WF_YORDER(sf) - 1).
+
+procedure wf_gscoeff (sf, coeff, ncoeff)
+
+pointer	sf		#I pointer to the surface fitting descriptor
+double	coeff[ARB]	#O the coefficients of the fit
+int	ncoeff		#O the number of coefficients
+
+begin
+	# Calculate the number of coefficients.
+	ncoeff = WF_NCOEFF(sf)
+	call amovd (Memd[WF_COEFF(sf)], coeff, ncoeff)
+end
+
+
+# WF_GSDER -- Procedure to calculate a new surface which is a derivative of
+# the input surface.
+
+double procedure wf_gsder (sf1, x, y, nxd, nyd)
+
+pointer	sf1		#I pointer to the previous surface
+double	x		#I x values
+double	y		#I y values
+int	nxd, nyd	#I order of the derivatives in x and y
+
+int	ncoeff, nxder, nyder, i, j, k
+int	order, maxorder1, maxorder2, nmove1, nmove2
+pointer	sf2, sp, coeff, ptr1, ptr2
+double	zfit, norm
+double	wf_gseval()
+
+begin
+	if (sf1 == NULL)
+	    return (0)
+
+	if (nxd < 0 || nyd < 0)
+	    call error (0, "GSDER: Order of derivatives cannot be < 0")
+
+	if (nxd == 0 && nyd == 0) {
+	    zfit = wf_gseval (sf1, x, y)
+	    return (zfit)
+	}
+
+	# Allocate space for new surface.
+	call calloc (sf2, LEN_WFGSSTRUCT, TY_STRUCT)
+
+	# check the order of the derivatives
+	nxder = min (nxd, WF_XORDER(sf1) - 1)
+	nyder = min (nyd, WF_YORDER(sf1) - 1)
+
+	# Set up new surface.
+	WF_TYPE(sf2) = WF_TYPE(sf1)
+
+	# Set the derivative surface parameters.
+	switch (WF_TYPE(sf2)) {
+	case WF_LEGENDRE, WF_CHEBYSHEV, WF_POLYNOMIAL:
+
+	    WF_XTERMS(sf2) = WF_XTERMS(sf1)
+
+	    # Find the order of the new surface.
+	    switch (WF_XTERMS(sf2)) {
+	    case WF_XNONE: 
+		if (nxder > 0 && nyder > 0) {
+		    WF_XORDER(sf2) = 1
+		    WF_YORDER(sf2) = 1
+		    WF_NCOEFF(sf2) = 1
+		} else if (nxder > 0) {
+		    WF_XORDER(sf2) = max (1, WF_XORDER(sf1) - nxder)
+		    WF_YORDER(sf2) = 1
+		    WF_NCOEFF(sf2) = WF_XORDER(sf2)
+		} else if (nyder > 0) {
+		    WF_XORDER(sf2) = 1
+		    WF_YORDER(sf2) = max (1, WF_YORDER(sf1) - nyder)
+		    WF_NCOEFF(sf2) = WF_YORDER(sf2)
+		}
+
+	    case WF_XHALF:
+		maxorder1 = max (WF_XORDER(sf1) + 1, WF_YORDER(sf1) + 1)
+		order = max (1, min (maxorder1 - 1 - nyder - nxder,
+		    WF_XORDER(sf1) - nxder))
+	        WF_XORDER(sf2) = order
+		order = max (1, min (maxorder1 - 1 - nyder - nxder,
+		    WF_YORDER(sf1) - nyder))
+	        WF_YORDER(sf2) = order
+		order = min (WF_XORDER(sf2), WF_YORDER(sf2))
+		WF_NCOEFF(sf2) = WF_XORDER(sf2) * WF_YORDER(sf2)  -
+			order * (order - 1) / 2
+
+	    default:
+	        WF_XORDER(sf2) = max (1, WF_XORDER(sf1) - nxder)
+	        WF_YORDER(sf2) = max (1, WF_YORDER(sf1) - nyder)
+		WF_NCOEFF(sf2) = WF_XORDER(sf2) * WF_YORDER(sf2) 
+	    }
+
+	    # Define the data limits.
+	    WF_XRANGE(sf2) = WF_XRANGE(sf1)
+	    WF_XMAXMIN(sf2) = WF_XMAXMIN(sf1)
+	    WF_YRANGE(sf2) = WF_YRANGE(sf1)
+	    WF_YMAXMIN(sf2) = WF_YMAXMIN(sf1)
+
+	default:
+	    call error (0, "WF_GSDER: Unknown surface type.")
+	}
+
+	# Allocate space for coefficients and basis functions.
+	call calloc (WF_COEFF(sf2), WF_NCOEFF(sf2), TY_DOUBLE)
+	call calloc (WF_XBASIS(sf2), WF_XORDER(sf2), TY_DOUBLE)
+	call calloc (WF_YBASIS(sf2), WF_YORDER(sf2), TY_DOUBLE)
+
+	# Get coefficients.
+	call smark (sp)
+	call salloc (coeff, WF_NCOEFF(sf1), TY_DOUBLE)
+	call wf_gscoeff (sf1, Memd[coeff], ncoeff)
+
+	# Compute the new coefficients.
+	switch (WF_XTERMS(sf2)) {
+	case WF_XFULL:
+	    ptr2 = WF_COEFF(sf2) + (WF_YORDER(sf2) - 1) * WF_XORDER(sf2)
+	    ptr1 = coeff + (WF_YORDER(sf1) - 1) * WF_XORDER(sf1)
+	    do i = WF_YORDER(sf1), nyder + 1, -1 {
+		do j = i, i - nyder + 1, -1
+		    call amulkd (Memd[ptr1+nxder], double (j - 1),
+		        Memd[ptr1+nxder], WF_XORDER(sf2))
+		do j = WF_XORDER(sf1), nxder + 1, - 1 {
+		    do k = j , j - nxder + 1, - 1
+			Memd[ptr1+j-1] = Memd[ptr1+j-1] * (k - 1)
+		}
+		call amovd (Memd[ptr1+nxder], Memd[ptr2], WF_XORDER(sf2))
+		ptr2 = ptr2 - WF_XORDER(sf2)
+		ptr1 = ptr1 - WF_XORDER(sf1)
+	    }
+
+	case WF_XHALF:
+	    maxorder1 = max (WF_XORDER(sf1) + 1, WF_YORDER(sf1) + 1)
+	    maxorder2 = max (WF_XORDER(sf2) + 1, WF_YORDER(sf2) + 1)
+	    ptr2 = WF_COEFF(sf2) + WF_NCOEFF(sf2)
+	    ptr1 = coeff + WF_NCOEFF(sf1)
+	    do i = WF_YORDER(sf1), nyder + 1, -1 {
+		nmove1 = max (0, min (maxorder1 - i, WF_XORDER(sf1)))
+		nmove2 = max (0, min (maxorder2 - i + nyder, WF_XORDER(sf2)))
+		ptr1 = ptr1 - nmove1
+		ptr2 = ptr2 - nmove2
+		do j = i, i - nyder + 1, -1
+		    call amulkd (Memd[ptr1+nxder], double (j - 1),
+		        Memd[ptr1+nxder], nmove2)
+		do j = nmove1, nxder + 1, - 1 {
+		    do k = j , j - nxder + 1, - 1
+			Memd[ptr1+j-1] = Memd[ptr1+j-1] * (k - 1)
+		}
+		call amovd (Memd[ptr1+nxder], Memd[ptr2], nmove2)
+	    }
+
+	default:
+	    if (nxder > 0 && nyder > 0) {
+		Memd[WF_COEFF(sf2)] = 0.
+
+	    } else if (nxder > 0) { 
+		ptr1 = coeff
+		ptr2 = WF_COEFF(sf2) + WF_NCOEFF(sf2) - 1
+		do j = WF_XORDER(sf1), nxder + 1, -1 {
+		    do k = j, j - nxder + 1, -1
+			Memd[ptr1+j-1] = Memd[ptr1+j-1] * (k - 1)
+		    Memd[ptr2] = Memd[ptr1+j-1]
+		    ptr2 = ptr2 - 1
+		}
+
+	    } else if (nyder > 0) {
+		ptr1 = coeff + WF_NCOEFF(sf1) - 1
+		ptr2 = WF_COEFF(sf2)
+		do i = WF_YORDER(sf1), nyder + 1, -1 {
+		    do j = i, i - nyder + 1, - 1
+			Memd[ptr1] = Memd[ptr1] * (j - 1)	
+		    ptr1 = ptr1 - 1
+		}
+		call amovd (Memd[ptr1+1], Memd[ptr2], WF_NCOEFF(sf2))
+	    }
+	}
+
+	# Evaluate the derivatives.
+	zfit = wf_gseval (sf2, x, y)
+
+	# Normalize.
+	if (WF_TYPE(sf2) != WF_POLYNOMIAL) { 
+	    norm = WF_XRANGE(sf2) ** nxder * WF_YRANGE(sf2) ** nyder
+	    zfit = norm * zfit
+	}
+
+	# Free the space.
+	call wf_gsclose (sf2)
+	call sfree (sp)
+
+	return (zfit)
+end
+
+
+# WF_GSRESTORE -- Procedure to restore the surface fit encoded in the
+# image header as a list of double precision parameters and coefficients
+# to the surface descriptor for use by the evaluating routines. The
+# surface parameters, surface type, xorder (or number of polynomial
+# terms in x), yorder (or number of polynomial terms in y), xterms,
+# xmin, xmax and ymin and ymax, are stored in the first eight elements
+# of the double array fit, followed by the WF_NCOEFF(sf) surface coefficients.
+
+procedure wf_gsrestore (sf, fit)
+
+pointer	sf		#O surface descriptor
+double	fit[ARB]	#I array containing the surface parameters and
+			#I coefficients
+
+int	surface_type, xorder, yorder, order
+double	xmin, xmax, ymin, ymax	
+
+begin
+	# Allocate space for the surface descriptor.
+	call calloc (sf, LEN_WFGSSTRUCT, TY_STRUCT)
+
+	xorder = nint (WF_SAVEXORDER(fit))
+	if (xorder < 1)
+	    call error (0, "WF_GSRESTORE: Illegal x order.")
+	yorder = nint (WF_SAVEYORDER(fit))
+	if (yorder < 1)
+	    call error (0, "WF_GSRESTORE: Illegal y order.")
+
+	xmin = WF_SAVEXMIN(fit)
+	xmax = WF_SAVEXMAX(fit)
+	if (xmax <= xmin)
+	    call error (0, "WF_GSRESTORE: Illegal x range.")
+	ymin = WF_SAVEYMIN(fit)
+	ymax = WF_SAVEYMAX(fit)
+	if (ymax <= ymin)
+	    call error (0, "WF_GSRESTORE: Illegal y range.")
+
+	# Set surface type dependent surface descriptor parameters.
+	surface_type = nint (WF_SAVETYPE(fit))
+
+	switch (surface_type) {
+	case WF_LEGENDRE, WF_CHEBYSHEV, WF_POLYNOMIAL:
+	    WF_XORDER(sf) = xorder
+	    WF_XRANGE(sf) = double(2.0) / (xmax - xmin)
+	    WF_XMAXMIN(sf) =  - (xmax + xmin) / double(2.0)
+	    WF_YORDER(sf) = yorder
+	    WF_YRANGE(sf) = double(2.0) / (ymax - ymin)
+	    WF_YMAXMIN(sf) =  - (ymax + ymin) / double(2.0)
+	    WF_XTERMS(sf) = WF_SAVEXTERMS(fit)
+	    switch (WF_XTERMS(sf)) {
+	    case WF_XNONE:
+		WF_NCOEFF(sf) = WF_XORDER(sf) + WF_YORDER(sf) - 1
+	    case WF_XHALF:
+		order = min (xorder, yorder)
+		WF_NCOEFF(sf) = WF_XORDER(sf) * WF_YORDER(sf) - order *
+		    (order - 1) / 2
+	    case WF_XFULL:
+		WF_NCOEFF(sf) = WF_XORDER(sf) * WF_YORDER(sf)
+	    }
+	default:
+	    call error (0, "WF_GSRESTORE: Unknown surface type.")
+	}
+
+	# Set remaining curve parameters.
+	WF_TYPE(sf) = surface_type
+
+	call malloc (WF_COEFF(sf), WF_NCOEFF(sf), TY_DOUBLE)
+	call malloc (WF_XBASIS(sf), WF_XORDER(sf), TY_DOUBLE)
+	call malloc (WF_YBASIS(sf), WF_YORDER(sf), TY_DOUBLE)
+
+	# restore coefficient array
+	call amovd (fit[WF_SAVECOEFF+1], Memd[WF_COEFF(sf)], WF_NCOEFF(sf))
+end
+
+
+# WF_GSB1POL -- Procedure to evaluate all the non-zero polynomial functions
+# for a single point and given order.
+
+procedure wf_gsb1pol (x, order, k1, k2, basis)
+
+double  x               #I data point
+int     order           #I order of polynomial, order = 1, constant
+double  k1, k2          #I nomalizing constants, dummy in this case
+double  basis[ARB]      #O basis functions
+
+int     i
+
+begin
+        basis[1] = 1.
+        if (order == 1)
+            return
+
+        basis[2] = x
+        if (order == 2)
+            return
+
+        do i = 3, order
+            basis[i] = x * basis[i-1]
+end
+
+
+# WF_GSB1LEG -- Procedure to evaluate all the non-zero Legendre functions for
+# a single point and given order.
+
+procedure wf_gsb1leg (x, order, k1, k2, basis)
+
+double  x               #I data point
+int     order           #I order of polynomial, order = 1, constant
+double  k1, k2          #I normalizing constants
+double  basis[ARB]      #O basis functions
+
+int     i
+double  ri, xnorm
+
+begin
+        basis[1] = 1.
+        if (order == 1)
+            return
+
+        xnorm = (x + k1) * k2 
+        basis[2] = xnorm
+        if (order == 2)
+            return
+
+        do i = 3, order {
+            ri = i
+            basis[i] = ((2. * ri - 3.) * xnorm * basis[i-1] -
+                       (ri - 2.) * basis[i-2]) / (ri - 1.)
+        }
+end
+
+
+# WF_GSB1CHEB -- Procedure to evaluate all the non zero Chebyshev function
+# for a given x and order.
+
+procedure wf_gsb1cheb (x, order, k1, k2, basis)
+
+double  x               #I number of data points
+int     order           #I order of polynomial, 1 is a constant
+double  k1, k2          #I normalizing constants
+double  basis[ARB]      #O array of basis functions
+
+int     i
+double  xnorm
+
+begin
+        basis[1] = 1.
+        if (order == 1)
+            return
+
+        xnorm = (x + k1) * k2
+        basis[2] = xnorm
+        if (order == 2)
+            return
+
+        do i = 3, order
+            basis[i] = 2. * xnorm * basis[i-1] - basis[i-2]
+end
diff --git a/sys/mwcs/wfinit.x b/sys/mwcs/wfinit.x
new file mode 100644
index 00000000..eb9c8e26
--- /dev/null
+++ b/sys/mwcs/wfinit.x
@@ -0,0 +1,140 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"mwcs.h"
+
+# WF_INIT -- Initialize the WCS function table.  Everything MWCS related
+# having to do with a world function is contained either in this file or
+# in the driver source file.  If the WCS must also be translated to/from
+# a FITS image header representation, the image header translation routine
+# iwewcs.x must also be modified.
+
+procedure wf_init()
+
+extern	wf_smp_init(), wf_smp_tran()
+extern	wf_tan_init(), wf_tan_fwd(), wf_tan_inv()
+extern	wf_arc_init(), wf_arc_fwd(), wf_arc_inv()
+extern	wf_gls_init(), wf_gls_fwd(), wf_gls_inv()
+extern	wf_sin_init(), wf_sin_fwd(), wf_sin_inv()
+extern	wf_msp_init(), wf_msp_fwd(), wf_msp_inv(), wf_msp_destroy()
+
+extern	wf_ait_init(), wf_ait_fwd(), wf_ait_inv()
+extern	wf_car_init(), wf_car_fwd(), wf_car_inv()
+extern	wf_csc_init(), wf_csc_fwd(), wf_csc_inv()
+extern	wf_mer_init(), wf_mer_fwd(), wf_mer_inv()
+extern	wf_mol_init(), wf_mol_fwd(), wf_mol_inv()
+extern	wf_par_init(), wf_par_fwd(), wf_par_inv()
+extern	wf_pco_init(), wf_pco_fwd(), wf_pco_inv()
+extern	wf_qsc_init(), wf_qsc_fwd(), wf_qsc_inv()
+extern	wf_stg_init(), wf_stg_fwd(), wf_stg_inv()
+extern	wf_tsc_init(), wf_tsc_fwd(), wf_tsc_inv()
+extern	wf_zea_init(), wf_zea_fwd(), wf_zea_inv()
+
+extern	wf_zpx_init(), wf_zpx_fwd(), wf_zpx_inv(), wf_zpx_destroy()
+extern	wf_zpn_init(), wf_zpn_fwd(), wf_zpn_inv(), wf_zpn_destroy()
+extern	wf_tnx_init(), wf_tnx_fwd(), wf_tnx_inv(), wf_tnx_destroy()
+extern	wf_tpv_init(), wf_tpv_fwd(), wf_tpv_inv(), wf_tpv_destroy()
+
+bool	first_time
+data	first_time /true/
+errchk	wf_fnload
+include	"mwcs.com"
+int	locpr()
+
+begin
+	# Only do this once.
+	if (!first_time)
+	    return
+
+	fn_nfn = 0
+	first_time = false
+
+	# Load the function drivers.
+	call wf_fnload ("sampled", 0,
+	    locpr(wf_smp_init), NULL, locpr(wf_smp_tran), locpr(wf_smp_tran))
+
+	# For compatibility reasons (FN index codes) new functions should
+	# be added at the end of the following list.
+
+	call wf_fnload ("tan", F_RADEC,
+	    locpr(wf_tan_init), NULL, locpr(wf_tan_fwd), locpr(wf_tan_inv))
+	call wf_fnload ("arc", F_RADEC,
+	    locpr(wf_arc_init), NULL, locpr(wf_arc_fwd), locpr(wf_arc_inv))
+	call wf_fnload ("gls", F_RADEC,
+	    locpr(wf_gls_init), NULL, locpr(wf_gls_fwd), locpr(wf_gls_inv))
+	call wf_fnload ("sin", F_RADEC,
+	    locpr(wf_sin_init), NULL, locpr(wf_sin_fwd), locpr(wf_sin_inv))
+
+	# Custom IRAF WCS for images containing multiple spectra.
+	call wf_fnload ("multispec", F_RADEC,
+	    locpr(wf_msp_init), locpr(wf_msp_destroy), locpr(wf_msp_fwd),
+	    locpr(wf_msp_inv))
+
+	# Most of the following are from G&C (also GLS above).
+	call wf_fnload ("ait", F_RADEC,
+	    locpr(wf_ait_init), NULL, locpr(wf_ait_fwd), locpr(wf_ait_inv))
+	call wf_fnload ("car", F_RADEC,
+	    locpr(wf_car_init), NULL, locpr(wf_car_fwd), locpr(wf_car_inv))
+	call wf_fnload ("csc", F_RADEC,
+	    locpr(wf_csc_init), NULL, locpr(wf_csc_fwd), locpr(wf_csc_inv))
+	call wf_fnload ("mer", F_RADEC,
+	    locpr(wf_mer_init), NULL, locpr(wf_mer_fwd), locpr(wf_mer_inv))
+	call wf_fnload ("mol", F_RADEC,
+	    locpr(wf_mol_init), NULL, locpr(wf_mol_fwd), locpr(wf_mol_inv))
+	call wf_fnload ("par", F_RADEC,
+	    locpr(wf_par_init), NULL, locpr(wf_par_fwd), locpr(wf_par_inv))
+	call wf_fnload ("pco", F_RADEC,
+	    locpr(wf_pco_init), NULL, locpr(wf_pco_fwd), locpr(wf_pco_inv))
+	call wf_fnload ("qsc", F_RADEC,
+	    locpr(wf_qsc_init), NULL, locpr(wf_qsc_fwd), locpr(wf_qsc_inv))
+	call wf_fnload ("stg", F_RADEC,
+	    locpr(wf_stg_init), NULL, locpr(wf_stg_fwd), locpr(wf_stg_inv))
+	call wf_fnload ("tsc", F_RADEC,
+	    locpr(wf_tsc_init), NULL, locpr(wf_tsc_fwd), locpr(wf_tsc_inv))
+	call wf_fnload ("zea", F_RADEC,
+	    locpr(wf_zea_init), NULL, locpr(wf_zea_fwd), locpr(wf_zea_inv))
+
+	# Experimental WCS for astrometric approximations.
+	call wf_fnload ("zpx", F_RADEC,
+	    locpr(wf_zpx_init), locpr(wf_zpx_destroy), locpr(wf_zpx_fwd),
+	    locpr(wf_zpx_inv))
+	call wf_fnload ("zpn", F_RADEC,
+	    locpr(wf_zpn_init), locpr(wf_zpn_destroy), locpr(wf_zpn_fwd),
+	    locpr(wf_zpn_inv))
+	call wf_fnload ("tnx", F_RADEC,
+	    locpr(wf_tnx_init), locpr(wf_tnx_destroy), locpr(wf_tnx_fwd),
+	    locpr(wf_tnx_inv))
+	call wf_fnload ("tpv", F_RADEC,
+	    locpr(wf_tpv_init), locpr(wf_tpv_destroy), locpr(wf_tpv_fwd),
+	    locpr(wf_tpv_inv))
+end
+
+
+# WF_FNLOAD -- Load a driver into the WCS function table.
+
+procedure wf_fnload (name, flags, init, destroy, fwd, inv)
+
+char	name[ARB]			#I function name
+int	init				#I initialize procedure
+int	flags				#I function type flags
+int	destroy				#I destroy procedure
+int	fwd				#I forward transform procedure
+int	inv				#I inverse transform procedure
+
+errchk	syserrs
+include	"mwcs.com"
+
+begin
+	# Get a new driver slot.
+	if (fn_nfn + 1 > MAX_FN)
+	    call syserrs (SYS_MWFNOVFL, name)
+	fn_nfn = fn_nfn + 1
+
+	# Load the driver.
+	FN_INIT(fn_nfn) = init
+	FN_FLAGS(fn_nfn) = flags
+	FN_DESTROY(fn_nfn) = destroy
+	FN_FWD(fn_nfn) = fwd
+	FN_INV(fn_nfn) = inv
+	call strcpy (name, FN_NAME(fn_nfn), SZ_FNNAME)
+end
diff --git a/sys/mwcs/wfmer.x b/sys/mwcs/wfmer.x
new file mode 100644
index 00000000..efee2be9
--- /dev/null
+++ b/sys/mwcs/wfmer.x
@@ -0,0 +1,446 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFMER
+.nf -------------------------------------------------------------------------
+WFMER -- WCS function driver for the cylindrical mercator projection.
+
+Driver routines:
+
+	FN_INIT		    wf_mer_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_mer_fwd (fc, v1, v2)
+	FN_INV		     wf_mer_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RECRODEG	Memd[P2D($1+FCU+16)]	     # 1 / RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_MER_INIT -- Initialize the cylindical mercator forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, reading in the the native
+# longitude and latitude of the pole in celestial coordinates LONGPOLE and
+# LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and various
+# intermediary functions of the reference point, reading in the projection
+# parameter RO from the attribute list, and precomputing the various required
+# intermediate quantities. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed if the celestial latitude of the reference point is less
+# than 0, otherwise 0 degrees is assumed. If LATPOLE is undefined the
+# more northerly of the two possible solutions for latitude of the native
+# pole is chosen, otherwise the solution closest to LATPOLE is chosen. If
+# RO is undefined a value of 180.0 / PI is assumed. In order to determine
+# the axis order, the parameter "axtype={ra|dec} {xlon|xlat}" must have been
+# set in the attribute list for the function. The LONGPOLE, LATPOLE, and RO
+# parameters may be set in either or both of the axes attribute lists, but the
+# value in the RA axis attribute list takes precedence. 
+
+procedure wf_mer_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data	tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_MER_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_MER_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_MER_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_MER_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	if (FC_RODEG(fc) == 0.0d0)
+	    call error (0, "WF_MER_INIT: Invalid projection parameters") 
+	FC_RECRODEG(fc) = 1.0d0 / FC_RODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_MER_FWD -- Forward transform (physical to world) for the mercator
+# projection.
+
+procedure wf_mer_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, ra, dec
+double	dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	phi = FC_RECRODEG(fc) * x
+
+	# Compute THETA.
+	theta = 2.0d0 * atan (exp (y / FC_RODEG(fc))) - DHALFPI
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+        ra =  DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_MER_INV -- Inverse transform (world to physical) for the mercator
+# projection.
+
+procedure wf_mer_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, dphi, phi, theta
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+       if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	if (theta <= -DHALFPI || theta >= DHALFPI) {
+	    p[ira] = FC_BADCVAL(fc)
+	    p[idec] = FC_BADCVAL(fc)
+	} else {
+	    p[ira] = FC_RODEG(fc) * phi
+	    p[idec] = FC_RODEG(fc) * log (tan ((DHALFPI + theta) / 2.0d0))
+	}
+end
diff --git a/sys/mwcs/wfmol.x b/sys/mwcs/wfmol.x
new file mode 100644
index 00000000..b02c00f8
--- /dev/null
+++ b/sys/mwcs/wfmol.x
@@ -0,0 +1,518 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFMOL
+.nf -------------------------------------------------------------------------
+WFMOL -- WCS function driver for the Mollweide projection.
+
+Driver routines:
+
+	FN_INIT		    wf_mol_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_mol_fwd (fc, v1, v2)
+	FN_INV		     wf_mol_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # sqrt (2) * RO
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # sqrt (2) * RO / 90
+define	FC_C3		Memd[P2D($1+FCU+20)]	     # 1 / (sqrt (2) * RO)
+define	FC_C4		Memd[P2D($1+FCU+22)]	     # 90 / RO
+define	FC_C5		Memd[P2D($1+FCU+24)]	     # 2 / PI
+define	FC_BADCVAL	Memd[P2D($1+FCU+26)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+28)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_MOL_INIT -- Initialize the forward or inverse Mollweide transform.
+# Initialization for this transformation consists of, determining which axis
+# is RA / LON and which is DEC / LAT, reading in the native longitude and
+# latitude of the pole in celestial coordinates LONGPOLE and LATPOLE from the
+# attribute list, computing the Euler angles and various intermediate
+# functions of the reference point, reading in the projection parameter RO
+# from the attribute list, and precomputing the various required intermediate
+# quantities. If LONGPOLE is undefined then a value of 180.0 degrees is assumed
+# if the celestial latitude of the reference point is less than 0, otherwise
+# 0 degrees is assumed.  If LATPOLE is undefined then the most northerly of
+# the two possible solutions is chosen, otherwise the solution closest to
+# LATPOLE is chosen. If RO is undefined a # value of 180.0 / PI is assumed.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|xlat}" must have been set in the attribute list for the function.
+# The LONGPOLE, LATPOLE,  and RO parameters may be set in either or both of
+# the axes attribute lists, but the value in the RA axis attribute list takes
+# precedence. 
+
+procedure wf_mol_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_MOL_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_MOL_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_MOL_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_MOL_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_C1(fc) = sqrt (2.0d0) * FC_RODEG(fc)
+	FC_C2(fc) = FC_C1(fc) / 90.0d0
+	FC_C3(fc) = 1.0d0 / FC_C1(fc)
+	FC_C4(fc) = 90.0d0 / FC_RODEG(fc)
+	FC_C5(fc) = 2.0d0 / DPI
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_MOL_FWD -- Forward transform (physical to world) for the Mollweide
+# projection.
+
+procedure wf_mol_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, y0, s, z, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	tol, ra, dec, dlng
+data	tol/1.0d-12/
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	y0 = y / FC_RODEG(fc)
+	s = 2.0d0 - y0 * y0
+	if (s < tol) {
+	    if (s < -tol) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    s = 0.0d0
+	    if (abs(x) > tol) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    phi = 0.0d0
+	} else {
+	    s = sqrt (s)
+	    phi = FC_C4(fc) * DDEGTORAD(x) / s
+	}
+
+	# Compute THETA.
+	z = y * FC_C3(fc)
+	if (abs(z) > 1.0d0) {
+	    if (abs(z) > (1.0d0 + tol)) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (z >= 0.0d0)
+		z = 1.0d0 + y0 * s / DPI
+	    else
+		z = -1.0d0 + y0 * s / DPI
+	} else
+	    z = asin (z) * FC_C5(fc) + y0 * s / DPI
+
+	if (abs(z) > 1.0d0) {
+	    if (abs(z) > (1.0d0 + tol)) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (z >= 0.0d0)
+		z = 1.0d0
+	    else
+		z = -1.0d0
+	}
+	theta = asin (z)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_MOL_INV -- Inverse transform (world to physical) for the Mollweide
+# projection.
+
+procedure wf_mol_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	j, ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, dphi
+double	u, v0, v1, v, resid, alpha, tol, z
+data	tol /1.0d-13/
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	if (abs(theta) == DHALFPI) {
+	    p[ira] = 0.0d0
+	    if (theta >= 0.0d0)
+	        p[idec] = FC_C1(fc) 
+	    else
+	        p[idec] = -FC_C1(fc) 
+	} else if (theta == 0.0d0) {
+	    p[ira] = FC_C2(fc) * DRADTODEG(phi) 
+	    p[idec] = 0.0d0
+	} else {
+	    u = DPI * sin (theta)
+	    v0 = -DPI
+	    v1 = DPI
+	    v = u
+	    do j = 1, 100 {
+		resid = (v - u) + sin (v)
+		if (resid < 0.0d0) {
+		    if (resid > -tol)
+			break
+		    v0 = v
+		} else {
+		    if (resid < tol)
+			break
+		    v1 = v
+		}
+		v = (v0 + v1) / 2.0d0
+	    }
+	    alpha = v / 2.0d0
+	    p[ira] = FC_C2(fc) * DRADTODEG(phi) * cos (alpha)
+	    p[idec] = FC_C1(fc) * sin (alpha)
+	}
+end
diff --git a/sys/mwcs/wfmspec.x b/sys/mwcs/wfmspec.x
new file mode 100644
index 00000000..2f5b5a91
--- /dev/null
+++ b/sys/mwcs/wfmspec.x
@@ -0,0 +1,578 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	"mwcs.h"
+
+.help WFMSPEC
+.nf -------------------------------------------------------------------------
+WFMSPEC -- WCS function driver for MULTISPEC spectral format.
+
+The dispersion coordinate is along image lines and each line has independent
+linear or nonlinear dispersion coordinates.  The dispersion coordinates are
+defined by specn attributes where n is the physical line number.  The format
+of the attributes is:
+
+	ap beam dtype w1 dw nw z aplow aphigh coeffs...
+
+where ap is the aperture number (unique within an image), beam is a beam
+number (not used by the driver), dtype is the dispersion type with values
+
+	0 = linear dispersion
+	1 = log linear dispersion
+	2 = nonlinear dispersion
+
+w1 is the wavelength of the first physical pixel, dw is the average
+increment per pixel between the first and last pixel, nw is the number of
+pixels, z is a redshift factor to be applied to the dispersion coordinates,
+aplow and aphigh are aperture limits defining the origin of the spectra (not
+used by the driver), and coeffs are the nonlinear dispersion coefficients.
+
+The nonlinear dispersion function coefficients may describe several function
+types; chebyshev polynomial, legendre polynomial, linear spline, cubic
+spline, linear interpolation in a pixel coordinate array, and linear
+interpolation in a sampled array.
+
+The axes and dispersion parameters are in terms of the physical image.  The
+aperture number is used for the world coordinate of the line coordinate.
+Coordinates outside the valid range are mapped to nearest valid world
+coordinate.  In application this would give a correct world coordinate graph
+for a general WCS blind graphics task (especially if all invalid pixels have
+the same value as the last valid pixel).
+
+Driver routines:
+
+	FN_INIT		    wf_msp_init (fc, dir)
+	FN_DESTROY	 wf_msp_destroy (fc)
+	FN_FWD		     wf_msp_fwd (fc, v1, v2)
+	FN_INV		     wf_msp_inv (fc, v1, v2)
+
+In addition the nonlinear dispersion functions use the following routines:
+
+	wf_msp_coeff	Convert the attribute string to a coefficient array
+	wf_msp_eval	Evaluate the function (P->W)
+	wf_msp_evali	Evaluate the inverse function (W->P)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_NAPS		Memi[$1+FCU]		# number of apertures
+define	FC_APS		Memi[$1+FCU+1]		# pointer to indep coords
+define	FC_DTYPE	Memi[$1+FCU+2]		# pointer to dispersion type
+define	FC_CRVAL	Memi[$1+FCU+3]		# pointer to linear origins
+define	FC_CDELT	Memi[$1+FCU+4]		# pointer to linear intervals
+define	FC_NPTS		Memi[$1+FCU+5]		# pointer to number of points
+define	FC_Z		Memi[$1+FCU+6]		# pointer to doppler corrections
+define	FC_COEFF	Memi[$1+FCU+7]		# pointer to nonlinear coeffs
+define	FC_X		Memi[$1+FCU+8]		# pointer to last phys. coord.
+define	FC_DYDX		Memi[$1+FCU+9]		# pointer to last deriv.
+define	FC_DIR		Memi[$1+FCU+10]		# direction of transform
+
+# Function types.
+define	CHEBYSHEV	1	# CURFIT Chebyshev polynomial
+define	LEGENDRE	2	# CURFIT Legendre polynomial
+define	SPLINE3		3	# CURFIT cubic spline
+define	SPLINE1		4	# CURFIT linear spline
+define	PIXEL		5	# pixel coordinate array
+define	SAMPLE		6	# sampled coordinates
+
+# Dispersion types.
+define	LINEAR		0	# linear
+define	LOG		1	# log linear
+define	NONLINEAR	2	# nonlinear
+
+# Iterative inversion parameters.
+define	NALLOC		10	# size of allocation increments
+define  NIT		10	# max interations in determining inverse
+define  DX		0.0001  # accuracy limit in pixels for inverse
+
+# Size limiting definitions.
+define	DEF_SZATVAL	2048	# dynamically resized if overflow
+
+
+# WF_MSP_INIT -- Initialize the function call descriptor for the indicated
+# type of transform (forward or inverse).
+
+procedure wf_msp_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I type of transformation
+
+pointer	ct, mw
+int	sz_atval, naps, ip, i
+pointer	sp, atkey, atval, aps, dtype, crval, cdelt, npts, z, coeff
+int	strlen(), ctoi(), ctod()
+double	x, dval, wf_msp_eval()
+errchk	malloc, realloc
+
+begin
+	# Get pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+
+	# Check axes.
+	if (FC_NAXES(fc) != 2 || CT_AXIS(ct,1) != 1 || CT_AXIS(ct,2) != 2)
+	    call error (1, "WFMSPEC: Wrong axes")
+
+	# Get spectrum information.
+	call smark (sp)
+	sz_atval = DEF_SZATVAL
+	call malloc (atval, sz_atval, TY_CHAR)
+	call salloc (atkey, SZ_ATNAME, TY_CHAR)
+
+	for (naps=0;  ;  naps=naps+1) {
+	    call sprintf (Memc[atkey], SZ_ATNAME, "spec%d")
+		call pargi (naps+1)
+	    iferr (call mw_gwattrs (mw, 2, Memc[atkey], Memc[atval], sz_atval))
+		break
+
+	    while (strlen (Memc[atval]) == sz_atval) {
+		sz_atval = 2 * sz_atval
+		call realloc (atval, sz_atval, TY_CHAR)
+		call mw_gwattrs (mw, 2, Memc[atkey], Memc[atval], sz_atval)
+	    }
+
+	    if (naps == 0) {
+		call malloc (aps, NALLOC, TY_INT) 
+		call malloc (dtype, NALLOC, TY_INT) 
+		call malloc (crval, NALLOC, TY_DOUBLE) 
+		call malloc (cdelt, NALLOC, TY_DOUBLE) 
+		call malloc (npts, NALLOC, TY_INT) 
+		call malloc (z, NALLOC, TY_DOUBLE) 
+		call malloc (coeff, NALLOC, TY_POINTER)
+	    } else if (mod (naps, NALLOC) == 0) {
+		call realloc (aps, naps+NALLOC, TY_INT) 
+		call realloc (dtype, naps+NALLOC, TY_INT) 
+		call realloc (crval, naps+NALLOC, TY_DOUBLE)
+		call realloc (cdelt, naps+NALLOC, TY_DOUBLE) 
+		call realloc (npts, naps+NALLOC, TY_INT) 
+		call realloc (z, naps+NALLOC, TY_DOUBLE) 
+		call realloc (coeff, naps+NALLOC, TY_POINTER) 
+	    }
+
+	    # Linear dispersion function.
+	    ip = 1
+	    if (ctoi (Memc[atval], ip, Memi[aps+naps]) <= 0)
+		next
+	    if (ctoi (Memc[atval], ip, Memi[dtype+naps]) <= 0)
+		next
+	    if (ctoi (Memc[atval], ip, Memi[dtype+naps]) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, Memd[crval+naps]) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, Memd[cdelt+naps]) <= 0)
+		next
+	    if (ctoi (Memc[atval], ip, Memi[npts+naps]) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, Memd[z+naps]) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, dval) <= 0)
+		next
+	    if (ctod (Memc[atval], ip, dval) <= 0)
+		next
+	    Memd[z+naps] = Memd[z+naps] + 1
+
+	    # Set nonlinear dispersion function.
+	    if (Memi[dtype+naps] == NONLINEAR)
+		call wf_msp_coeff (Memc[atval+ip], Memi[coeff+naps],
+		    double (0.5), double (Memi[npts+naps]+0.5))
+	}
+
+	if (naps <= 0)
+	    call error (2, "WFMSPEC: No aperture information")
+
+	call realloc (aps, naps, TY_INT) 
+	call realloc (dtype, naps, TY_INT) 
+	call realloc (crval, naps, TY_DOUBLE) 
+	call realloc (cdelt, naps, TY_DOUBLE) 
+	call realloc (npts, naps, TY_INT) 
+	call realloc (z, naps, TY_DOUBLE) 
+	call realloc (coeff, naps, TY_POINTER) 
+
+	FC_NAPS(fc) = naps
+	FC_APS(fc) = aps
+	FC_DTYPE(fc) = dtype
+	FC_CRVAL(fc) = crval
+	FC_CDELT(fc) = cdelt
+	FC_NPTS(fc) = npts
+	FC_Z(fc) = z
+	FC_COEFF(fc) = coeff
+	FC_DIR(fc) = dir
+
+	# Setup inverse parameters if needed.
+	# The parameters make the interative inversion more efficient
+	# when the inverse transformation is evaluated sequentially.
+
+	if (dir == INVERSE) {
+	   call malloc (crval, naps, TY_DOUBLE)
+	   call malloc (cdelt, naps, TY_DOUBLE)
+	   do i = 0, naps-1 {
+		if (Memi[FC_NPTS(fc)+i] == 0)
+		    next
+		if (Memi[FC_DTYPE(fc)+i] == NONLINEAR) {
+		    coeff = Memi[FC_COEFF(fc)+i]
+		    x = Memi[FC_NPTS(fc)+i]
+		    Memd[crval+i] = x
+		    Memd[cdelt+i] = wf_msp_eval (Memd[coeff], x) -
+			wf_msp_eval (Memd[coeff], x - 1)
+		}
+	    }
+	    FC_X(fc) = crval
+	    FC_DYDX(fc) = cdelt
+	} else {
+	    FC_X(fc) = NULL
+	    FC_DYDX(fc) = NULL
+	}
+
+	call mfree (atval, TY_CHAR)
+	call sfree (sp)
+end
+
+
+# WF_MSP_DESTROY -- Free function driver descriptor.
+
+procedure wf_msp_destroy (fc)
+
+pointer	fc			#I pointer to FC descriptor
+int	i
+
+begin
+	do i = 1, FC_NAPS(fc)
+	    if (Memi[FC_DTYPE(fc)+i-1] == NONLINEAR)
+		call mfree (Memi[FC_COEFF(fc)+i-1], TY_DOUBLE)
+
+	call mfree (FC_APS(fc), TY_INT)
+	call mfree (FC_DTYPE(fc), TY_INT)
+	call mfree (FC_CRVAL(fc), TY_DOUBLE)
+	call mfree (FC_CDELT(fc), TY_DOUBLE)
+	call mfree (FC_NPTS(fc), TY_INT)
+	call mfree (FC_Z(fc), TY_DOUBLE)
+	call mfree (FC_COEFF(fc), TY_POINTER)
+	call mfree (FC_X(fc), TY_DOUBLE)
+	call mfree (FC_DYDX(fc), TY_DOUBLE)
+end
+
+
+# WF_MSP_FWD -- Evaluate P -> W (physical to world transformation).
+
+procedure wf_msp_fwd (fc, in, out)
+
+pointer	fc			#I pointer to FC descriptor
+double	in[2]			#I point to sample WCS at
+double	out[2]			#O value of WCS at that point
+
+int	i
+pointer	coeff
+double	din, wf_msp_eval()
+
+begin
+	i = nint (in[2]) - 1
+	if (i < 0 || i >= FC_NAPS(fc))
+	    call error (3, "WFMSPEC: Coordinate out of bounds")
+	if (Memi[FC_NPTS(fc)+i] == 0)
+	    call error (4, "WFMSPEC: No dispersion function")
+
+	if (Memi[FC_DTYPE(fc)+i] == NONLINEAR) {
+	    coeff = Memi[FC_COEFF(fc)+i]
+	    out[2] = Memi[FC_APS(fc)+i]
+	    out[1] = wf_msp_eval (Memd[coeff], in[1])
+	} else {
+	    din = max (0.5D0, min (double (Memi[FC_NPTS(fc)+i]+0.5), in[1]))
+	    out[2] = Memi[FC_APS(fc)+i]
+	    out[1] = Memd[FC_CRVAL(fc)+i] + Memd[FC_CDELT(fc)+i] * (din - 1)
+	    if (Memi[FC_DTYPE(fc)+i] == LOG)
+		out[1] = 10. ** out[1]
+	}
+
+	out[1] = out[1] / Memd[FC_Z(fc)+i]
+end
+
+
+# WF_MSP_INV -- Evaluate W -> P (world to physical transformation).
+
+procedure wf_msp_inv (fc, in, out)
+
+pointer	fc			#I pointer to FC descriptor
+double	in[2]			#I point to sample WCS at
+double	out[2]			#O value of WCS at that point
+
+int	i
+pointer	coeff
+double	din, dinmin
+double	wf_msp_evali()
+
+begin
+	out[2] = 1
+	dinmin = abs (in[2] - Memi[FC_APS(fc)])
+	do i = 1, FC_NAPS(fc)-1 {
+	    din = abs (in[2] - Memi[FC_APS(fc)+i])
+	    if (din < dinmin) {
+		out[2] = i + 1
+		dinmin = din
+	    }
+	}
+
+	i = nint (out[2]) - 1
+	if (i < 0 || i >= FC_NAPS(fc))
+	    call error (5, "WFMSPEC: Coordinate out of bounds")
+	if (Memi[FC_NPTS(fc)+i] == 0)
+	    call error (6, "WFMSPEC: No dispersion function")
+
+	din = in[1] * Memd[FC_Z(fc)+i]
+	if (Memi[FC_DTYPE(fc)+i] == NONLINEAR) {
+	    coeff = Memi[FC_COEFF(fc)+i]
+	    out[1] = wf_msp_evali (Memd[coeff], din, Memd[FC_X(fc)+i],
+		Memd[FC_DYDX(fc)+i])
+	} else {
+	    if (Memi[FC_DTYPE(fc)+i] == LOG)
+		din = log10 (din)
+	    out[1] = (din-Memd[FC_CRVAL(fc)+i]) / Memd[FC_CDELT(fc)+i] + 1
+	    out[1] = max (0.5D0, min (double(Memi[FC_NPTS(fc)+i]+0.5), out[1]))
+	}
+end
+
+
+# WF_MSP_COEFF -- Initialize nonlinear coefficient array.
+
+procedure wf_msp_coeff (atval, coeff, xmin, xmax)
+
+char	atval[ARB]		#I attribute string
+pointer	coeff			#O coefficient array
+double	xmin, xmax		#I x limits
+
+double	dval, temp
+int	ncoeff, type, order, ip, i
+errchk	malloc, realloc
+double	wf_msp_eval()
+int	ctod()
+
+begin
+	coeff = NULL
+	ncoeff = 5
+
+	ip = 1
+	while (ctod (atval, ip, dval) > 0) {
+	    if (coeff == NULL)
+		call malloc (coeff, NALLOC, TY_DOUBLE)
+	    else if (mod (ncoeff, NALLOC) == 0)
+		call realloc (coeff, ncoeff+NALLOC, TY_DOUBLE)
+	    Memd[coeff+ncoeff] = dval
+	    ncoeff = ncoeff + 1
+	}
+	if (coeff == NULL)
+	    return
+
+	# Convert range elements to a more efficient form.
+	call realloc (coeff, ncoeff, TY_DOUBLE)
+	Memd[coeff] = ncoeff
+	i = 6
+	while (i < ncoeff) {
+	    type = nint (Memd[coeff+i+1])
+	    order = nint (Memd[coeff+i+2])
+	    switch (type) {
+	    case CHEBYSHEV, LEGENDRE:
+		dval = 2 / (Memd[coeff+i+4] - Memd[coeff+i+3])
+		Memd[coeff+i+3] = (Memd[coeff+i+4] + Memd[coeff+i+3]) / 2
+		Memd[coeff+i+4] = dval
+		i = i + 6 + order
+	    case SPLINE3:
+		Memd[coeff+i+4] = nint (Memd[coeff+i+2]) /
+		    (Memd[coeff+i+4] - Memd[coeff+i+3])
+		i = i + 9 + order
+	    case SPLINE1:
+		Memd[coeff+i+4] = nint (Memd[coeff+i+2]) /
+		    (Memd[coeff+i+4] - Memd[coeff+i+3])
+		i = i + 7 + order
+	    case PIXEL:
+		i = i + 4 + order
+	    case SAMPLE:
+		Memd[coeff+i+3] = i + 5
+		i = i + 5 + order
+	    }
+	}
+
+	# Set function limits.
+	Memd[coeff+1] = xmin
+	Memd[coeff+2] = xmax
+	dval = wf_msp_eval (Memd[coeff], xmin)
+	temp = wf_msp_eval (Memd[coeff], xmax)
+	Memd[coeff+3] = min (dval, temp)
+	Memd[coeff+4] = max (dval, temp)
+end
+
+
+# WF_MSP_EVAL -- Evaluate nonlinear function.
+
+double procedure wf_msp_eval (coeff, xin)
+
+double	coeff[ARB]			#I coefficients
+double	xin				#I physical coordinate for evaluation
+
+int	i, j, k, ncoeff, type, order
+double	xval, x, y, w, ysum, wsum, a, b, c	
+
+begin
+	ncoeff = nint (coeff[1])
+	xval = max (coeff[2], min (coeff[3], xin))
+	ysum = 0.
+	wsum = 0.
+	j = 6
+	while (j < ncoeff) {
+	    type = nint (coeff[j+2])
+	    order = nint (coeff[j+3])
+	    y = coeff[j+1]
+	    w = coeff[j]
+	    switch (type) {
+	    case CHEBYSHEV:
+		x = (xval - coeff[j+4]) * coeff[j+5]
+		y = y + coeff[j+6]
+		if (order > 1)
+		    y = y + coeff[j+7] * x
+		if (order > 2) {
+		    k = j + 8
+		    a = 1
+		    b = x
+		    do i = 3, order {
+			c = 2 * x * b - a
+			y = y + coeff[k] * c
+			a = b
+			b = c
+			k = k + 1
+		    }
+		}
+		j = j + 6 + order
+	    case LEGENDRE:
+		x = (xval - coeff[j+4]) * coeff[j+5]
+		y = y + coeff[j+6]
+		if (order > 1)
+		    y = y + coeff[j+7] * x
+		if (order > 2) {
+		    k = j + 8
+		    a = 1
+		    b = x
+		    do i = 3, order {
+			c = ((2 * i - 3) * x * b - (i - 2) * a) / (i - 1)
+			y = y + coeff[k] * c
+			a = b
+			b = c
+			k = k + 1
+		    }
+		}
+		j = j + 6 + order
+	    case SPLINE3:
+		x = (xval - coeff[j+4]) * coeff[j+5]
+		i = max (0, min (int (x), order-1))
+		k = j + 6 + i
+		b = x - i
+		a = 1 - b
+		c = a * a * a
+		y = y + c * coeff[k]
+		c = 1 + 3 * a * (1 + a * b)
+		y = y + c * coeff[k+1]
+		c = 1 + 3 * b * (1 + a * b)
+		y = y + c * coeff[k+2]
+		c = b * b * b
+		y = y + c * coeff[k+3]
+		j = j + 9 + order
+	    case SPLINE1:
+		x = (xval - coeff[j+4]) * coeff[j+5]
+		i = max (0, min (int (x), order-1))
+		k = j + 6 + i
+		b = x - i
+		a = 1 - b
+		y = y + a * coeff[k] + b * coeff[k+1]
+		j = j + 7 + order
+	    case PIXEL:
+		i = max (1, min (int (xval), order-1))
+		x = xval - i
+		y = y + (1 - x) * coeff[j+3+i] + x * coeff[j+4+i]
+		j = j + 4 + order
+	    case SAMPLE:
+		i = nint (coeff[j+4])
+		for (k=j+2+order; i < k && xval > coeff[i+2]; i=i+2)
+		    ;
+		for (k=j+5; i > k && xval < coeff[i-2]; i=i-2)
+		    ;
+		coeff[j+4] = i
+		x = (xval - coeff[i]) / (coeff[i+2] - coeff[i])
+		y = y + (1 - x) * coeff[i+1] + x * coeff[i+3]
+		j = j + 5 + order
+	    }
+	    ysum = ysum + w * y
+	    wsum = wsum + w
+	}
+	ysum = ysum / wsum
+
+	return (ysum)
+end
+
+
+# WF_MSP_EVALI -- Evaluate inverse of nonlinear function.
+
+double procedure wf_msp_evali (coeff, y, x, dydx)
+
+double	coeff[ARB]		#I function coefficients
+double	y			#I world coord to invert
+double	x			#U last physical coordinate
+double	dydx			#U last coordinate derivative
+
+int     i
+double  xval, yval, y1, dx, dy
+double  wf_msp_eval()
+bool	fp_equald()
+
+begin
+	yval = max (coeff[4], min (coeff[5], y))
+
+        dx = 0.
+	dy = 0.
+        do i = 1, NIT {
+            y1 = wf_msp_eval (coeff, x)
+            if (dx > 1.) {
+		if (x + 1 < coeff[3])
+		    dy = wf_msp_eval (coeff, x+1.) - y1
+		else
+		    dy = y1 - wf_msp_eval (coeff, x-1.)
+            } else if (dx < -1.) {
+		if (x - 1 > coeff[2])
+		    dy = y1 - wf_msp_eval (coeff, x-1.)
+		else
+		    dy = wf_msp_eval (coeff, x+1.) - y1
+	    }
+	    if (!fp_equald (dy, 0.0D0))
+		dydx = dy
+            dx = (yval - y1) / dydx
+            x = x + dx
+	    x = max (coeff[2], min (coeff[3], x))
+            if (abs (dx) < DX)
+                break
+        }
+
+	if (i > NIT) {
+	    xval = (coeff[2] + coeff[3]) / 2.
+	    yval = abs (wf_msp_eval (coeff, xval) - y)
+	    dx = (coeff[3] - coeff[2]) / 18.
+	    while (dx > DX) {
+		for (x=max (coeff[2],xval-9*dx); x<=min (coeff[3],xval+9*dx);
+		    x=x+dx) {
+		    dy = abs (wf_msp_eval (coeff, x) - y)
+		    if (dy < yval) {
+			xval = x
+			yval = dy
+		    }
+		}
+		dx = dx / 10.
+	    }
+	    x = xval
+	    if (x + 1 < coeff[3])
+		dy = wf_msp_eval (coeff, x+1.) - wf_msp_eval (coeff, x)
+	    else
+		dy = wf_msp_eval (coeff, x) - wf_msp_eval (coeff, x-1.)
+	    if (!fp_equald (dy, 0.0D0))
+		dydx = dy
+	}
+		
+	yval = int (x)
+	x = yval + nint ((x-yval) / DX) * DX
+
+	return (x)
+end
diff --git a/sys/mwcs/wfpar.x b/sys/mwcs/wfpar.x
new file mode 100644
index 00000000..673aa81e
--- /dev/null
+++ b/sys/mwcs/wfpar.x
@@ -0,0 +1,458 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFPAR
+.nf -------------------------------------------------------------------------
+WFPAR -- WCS function driver for the Craster or parabolic projection.
+
+Driver routines:
+
+	FN_INIT		    wf_par_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_par_fwd (fc, v1, v2)
+	FN_INV		     wf_par_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RECRODEG	Memd[P2D($1+FCU+16)]	     # 1 / RO (degs)
+define	FC_PIRODEG	Memd[P2D($1+FCU+18)]	     # PI * RO (degs)
+define	FC_RECPIRODEG	Memd[P2D($1+FCU+20)]	     # 1 / (PI * RO) (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+22)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+24)+($2)-1]  # CRVAL axis (1 and 2)
+
+# WF_PAR_INIT -- Initialize the forward or inverse Craster or parabolic
+# transform. Initialization for this transformation consists of,
+# determining which axis is RA / LON and which is DEC / LAT, reading in the
+# native longitude and latitude of the pole in celestial coordinates LONGPOLE
+# and LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and associated
+# intermediary functions of the reference point, reading in the projection
+# parameter RO from the attribute list, and precomputing the various required
+# intermediate quantities. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed if the celestial latitude of the reference point is less
+# than 0, otherwise 0 degrees is assumed. If LATPOLE is undefined then the
+# most northerly of the two possible solutions is chosen, otherwise the
+# solution closest to LATPOLE is chosen. If RO is undefined a value of 180.0 /
+# PI is assumed. In order to determine the axis order, the  parameter
+# "axtype={ra|dec} {xlon|xlat}" must have been set in the attribute list for
+# the function. The LONGPOLE, LATPOLE,  and RO parameters may be set in either
+# or both of the axes attribute lists, but the value in the RA axis attribute
+# list takes precedence. 
+
+procedure wf_par_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_PAR_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_PAR_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_PAR_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_PAR_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_RECRODEG(fc) = 1.0d0 / FC_RODEG(fc)
+	FC_PIRODEG(fc) = DPI * FC_RODEG(fc)
+	FC_RECPIRODEG(fc) = 1.0d0 / FC_PIRODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_PAR_FWD -- Forward transform (physical to world) for the Craster or
+# parabolic projection.
+
+procedure wf_par_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, s, t, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	ra, dec, dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI.
+	s = y * FC_RECPIRODEG(fc)
+	if (s > 1.0d0 || s < -1.0d0) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+	}
+	t = 1.0d0 - 4.0d0 * s * s
+	if (t == 0.0d0) {
+	    if (x == 0.0d0) {
+		phi = 0.0d0
+	    } else {
+	        w[ira] = FC_BADCVAL(fc)
+	        w[idec] = FC_BADCVAL(fc)
+	        return
+	    }
+	} else
+	    phi = FC_RECRODEG(fc) * x / t
+
+	# Compute THETA.
+	theta = 3.0d0 * asin (s)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_PAR_INV -- Inverse transform (world to physical) for the Craster
+# or parabolic projection.
+
+procedure wf_par_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = sin (theta / 3.0d0)
+	p[ira] = FC_RODEG(fc) * phi * (1.0d0 - 4.0 * s * s)
+	p[idec] = FC_PIRODEG(fc) * s
+end
diff --git a/sys/mwcs/wfpco.x b/sys/mwcs/wfpco.x
new file mode 100644
index 00000000..a9cd8e12
--- /dev/null
+++ b/sys/mwcs/wfpco.x
@@ -0,0 +1,518 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFPCO
+.nf -------------------------------------------------------------------------
+WFPCO -- WCS function driver for the polyconic projection.
+
+Driver routines:
+
+	FN_INIT		    wf_pco_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_pco_fwd (fc, v1, v2)
+	FN_INV		     wf_pco_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_RORAD	Memd[P2D($1+FCU+16)]	     # RO (rads)
+define	FC_RECRORAD	Memd[P2D($1+FCU+18)]	     # 1 / RO (rads)
+define	FC_2RODEG	Memd[P2D($1+FCU+20)]	     # 2 * RO 
+define	FC_BADCVAL	Memd[P2D($1+FCU+22)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+24)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_PCO_INIT -- Initialize the polyconic forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, reading in the the native
+# longitude and latitude  of the pole in celestial coordinates LONGPOLE and
+# LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler anges and various
+# intermediary functions of the reference point, and reading in the
+# projection parameter RO from the attribute list. If LONGPOLE is undefined
+# then a value of 180.0 degrees is assumed if the native latitude of the
+# reference point is less than 0, otherwise 0 is assumed. If LATPOLE is
+# undefined then the most northerly of the two possible solutions for the
+# latitude of the native pole is chosen, otherwise the solution closest to
+# LATPOLE is chosen. If RO is undefined a value of 180.0 / PI is assumed.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|xlat}" must have been set in the attribute list for the function.
+# The LONGPOLE, LATPOLE and RO parameters may be set in either or both of the
+# axes attribute lists, but the value in the RA axis attribute list takes
+# precedence. 
+
+procedure wf_pco_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_PCO_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_PCO_INIT: Invalid projection parameters")
+
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_PCO_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_PCO_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_RORAD(fc) = DDEGTORAD(FC_RODEG(fc))
+	FC_RECRORAD(fc) = 1.0d0 / FC_RORAD(fc)
+	FC_2RODEG(fc) = 2.0d0 * FC_RODEG(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_PCO_FWD -- Forward transform (physical to world) for the polyconic
+# projection.
+
+procedure wf_pco_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, j
+double	x, y, z, phi, theta, costhe, sinthe, dphi, cosphi, sinphi
+double	ra, dec, wconst, tol, thepos, theneg, xx, ymthe, fpos, fneg, lambda
+double	tanthe, f, dlng
+double	xp, yp
+data	tol / 1.0d-12/
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+
+	# Compute PHI and THETA.
+	wconst = abs (y * FC_RECRORAD(fc))
+	if (wconst < tol) {
+	    phi = x * FC_RECRORAD(fc)
+	    theta = 0.0d0
+	} else if (abs (wconst - 90.0d0) < tol) {
+	    phi = 0.0d0
+	    if (y >= 0.0d0)
+		theta = DHALFPI
+	    else
+		theta = -DHALFPI
+	} else {
+	    if (y > 0.0d0)
+		thepos = 90.0d0
+	    else
+		thepos = -90.0d0
+	    theneg = 0.0d0
+
+	    xx = x * x
+	    ymthe = y - FC_RORAD(fc) * thepos
+	    fpos = xx + ymthe * ymthe
+	    fneg = -999.0d0
+
+	    do j = 1, 64 {
+
+		# Compute the required interval.
+		if (fneg < -100.0d0)
+		    theta = (thepos + theneg) / 2.0d0
+		else {
+		    lambda = fpos / (fpos - fneg)
+		    if (lambda < 0.1d0)
+			lambda = 0.1d0
+		    else if (lambda > 0.9d0)
+			lambda = 0.9d0
+		    theta = thepos - lambda * (thepos - theneg)
+		}
+
+		# Compute the residue.
+		ymthe = y - FC_RORAD(fc) * theta
+		tanthe = tan (DDEGTORAD(theta))
+		f = xx + ymthe * (ymthe - FC_2RODEG(fc) / tanthe)
+
+		# Check for convergence.
+		if (abs(f) < tol)
+		    break
+		if (abs (thepos - theneg) < tol)
+		    break
+
+		# Redefine the interval
+		if (f > 0.0d0) {
+		    thepos = theta
+		    fpos = f
+		} else {
+		    theneg = theta
+		    fneg = f
+		}
+	    }
+
+	    theta = DDEGTORAD(theta)
+	    xp = FC_RODEG(fc) - ymthe * tanthe
+	    yp = x * tanthe
+	    if (xp == 0.0d0 && yp == 0.0d0)
+		phi = 0.0d0
+	    else
+		phi = atan2 (yp, xp) / sin (theta)
+	}
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+	if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_PCO_INV -- Inverse transform (world to physical) for the polyconic
+# projection.
+
+procedure wf_pco_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, costhe
+double	a, sinthe, cotthe, dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x) 
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+	if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	a = phi * sinthe
+	if (sinthe == 0.0d0) {
+	    p[ira] = FC_RODEG(fc) * phi 
+	    p[idec] = 0.0d0
+	} else {
+	    cotthe = costhe / sinthe
+	    p[ira] = FC_RODEG(fc) * cotthe * sin (a)
+	    p[idec] = FC_RODEG(fc) * (cotthe * (1.0d0 - cos(a)) + theta) 
+	}
+
+end
diff --git a/sys/mwcs/wfqsc.x b/sys/mwcs/wfqsc.x
new file mode 100644
index 00000000..b75535e7
--- /dev/null
+++ b/sys/mwcs/wfqsc.x
@@ -0,0 +1,758 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFQSC
+.nf -------------------------------------------------------------------------
+WFQSC -- WCS function driver for quadrilateralized spherical cube projection.
+
+Driver routines:
+
+	FN_INIT		    wf_qsc_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_qsc_fwd (fc, v1, v2)
+	FN_INV		     wf_qsc_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # RO * (PI / 4)
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # (4 / PI) / RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+20)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+22)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_QSC_INIT -- Initialize the forward or inverse quarilateralized spherical
+# cube projection transform. Initialization for this transformation consists
+# of, determining which axis is RA / LON and which is DEC / LAT, reading in
+# the native longitude and latitude of the pole in celestial coordinates
+# LONGPOLE and LATPOLE from the attribute list, computing the celestial
+# longitude and colatitude of the native pole, precomputing the Euler angles
+# and various intermediary functions of the reference point, reading in the
+# projection parameter RO from the attribute list, and precomputing the various
+# required intermediate quantities. If LONGPOLE is undefined then a value of
+# 180.0 degrees is assumed if the celestial latitude is less than 0, otherwise
+# 0 degrees is assumed. If LATPOLE is undefined the most northerly of the two
+# possible solutions is chosen, otherwise the solution closest to LATPOLE is
+# chosen. If RO is undefined a value of 180.0 / PI is assumed. In order to
+# determine the axis order, the parameter "axtype={ra|dec} {xlon|xlat}" must
+# have been set in the attribute list for the function. The LONGPOLE, LATPOLE,
+# and RO parameters may be set in either or both of the axes attribute lists,
+# but the value in the RA axis attribute list takes precedence. 
+
+procedure wf_qsc_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_QSC_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_QSC_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_QSC_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_QCS_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_C1(fc) = FC_RODEG(fc) * (DPI / 4.0d0)
+	FC_C2(fc) = 1.0d0 / FC_C1(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_QSC_FWD -- Forward transform (physical to world) for the quarilateralized
+# spherical projection.
+
+procedure wf_qsc_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, face, direct
+double	l, m, n, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, x, y, z
+double	xf, yf, rho, chi, psi, tol, wconst, ra, dec, dlng, rhu
+data	tol /1.0d-12/
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	xf = p[ira] * FC_C2(fc)
+	yf = p[idec] * FC_C2(fc)
+	if (xf > 5.0d0) {
+	    face = 4
+	    xf = xf - 6.0d0
+	} else if (xf > 3.0d0) {
+	    face = 3
+	    xf = xf - 4.0d0
+	} else if (xf > 1.0d0) {
+	    face = 2
+	    xf = xf - 2.0d0
+	} else if (yf > 1.0d0) {
+	    face = 0
+	    yf = yf - 2.0d0
+	} else if (yf < -1.0d0) {
+	    face = 5
+	    yf = yf + 2.0d0
+	} else {
+	    face = 1
+	}
+
+	if (abs(xf) > abs(yf))
+	    direct = YES
+	else
+	    direct = NO
+	if (direct == YES) {
+	    if (xf == 0.0d0) {
+		psi = 0.0d0
+		chi = 1.0d0
+		rho = 1.0d0
+		rhu = 0.0d0
+	    } else {
+		wconst = DDEGTORAD(15.0d0 * yf / xf)
+		psi = sin (wconst) / (cos (wconst) - 1.0d0 / DSQRTOF2)
+		chi = 1.0d0 + psi * psi
+		rhu = xf * xf * (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi))
+		rho = 1.0d0 - rhu
+	    }
+	} else {
+	    if (yf == 0.0d0) {
+		psi = 0.0d0
+		chi = 1.0d0
+		rho = 1.0d0
+		rhu = 0.0d0
+	    } else {
+		wconst = DDEGTORAD(15.0d0 * xf / yf)
+		psi = sin (wconst) / (cos (wconst) - 1.0d0 / DSQRTOF2)
+		chi = 1.0d0 + psi * psi
+		rhu = yf * yf * (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi))
+		rho = 1.0d0 - rhu
+	    }
+	}
+
+	if (rho < -1.0d0) {
+	    if (rho < (-1.0d0 - tol)) {
+		w[ira] = FC_BADCVAL(fc)
+		w[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    rho = -1.0d0
+	    rhu = 2.0d0
+	    wconst = 0.0d0
+	} else {
+	    wconst = sqrt (rhu * (2.0d0 - rhu) / chi)
+	}
+
+	switch (face) {
+	case 0:
+	    n = rho
+	    if (direct == YES) {
+		l = wconst
+		if (xf < 0.0d0)
+		    l = -l
+		m = -l * psi
+	    } else {
+		m = wconst
+		if (yf > 0.0d0)
+		    m = -m
+		l = -m * psi
+	    }
+
+	case 1:
+	    m = rho
+	    if (direct == YES) {
+		l = wconst
+		if (xf < 0.0d0)
+		    l = -l
+		n = l * psi
+	    } else {
+		n = wconst
+		if (yf < 0.0d0)
+		    n = -n
+		l = n * psi
+	    }
+
+	case 2:
+	    l = rho
+	    if (direct == YES) {
+		m = wconst
+		if (xf > 0.0d0)
+		    m = -m
+		n = -m * psi
+	    } else {
+		n = wconst
+		if (yf < 0.0d0)
+		    n = -n
+		m = -n * psi
+	    }
+
+	case 3:
+	    m = -rho
+	    if (direct == YES) {
+		l = wconst
+		if (xf > 0.0d0)
+		    l = -l
+		n = -l * psi
+	    } else {
+		n = wconst
+		if (yf < 0.0d0)
+		    n = -n
+		l = -n * psi
+	    }
+
+	case 4:
+	    l = -rho
+	    if (direct == YES) {
+		m = wconst
+		if (xf < 0.0d0)
+		    m = -m
+		n = m * psi
+	    } else {
+		n = wconst
+		if (yf < 0.0d0)
+		    n = -n
+		m = n * psi
+	    }
+
+	case 5:
+	    n = -rho
+	    if (direct == YES) {
+		l = wconst
+		if (xf < 0.0d0)
+		    l = -l
+		m = l * psi
+	    } else {
+		m = wconst
+		if (yf < 0.0d0)
+		    m = -m
+		l = m * psi
+	    }
+	}
+
+	# Compute PHI.
+	if (l == 0.0d0 && m == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (l, m)
+
+	# Compute THETA.
+	theta = asin(n)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_QSC_INV -- Inverse transform (world to physical) for the quadilateralized
+# spherical projection.
+
+procedure wf_qsc_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, face
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, phi, theta, dphi
+double	costhe, eta, l, m, n, rho, xi, tol, x0, y0, psi, chi, xf, yf
+double	pconst, t, rhu
+data	tol /1.0d-12/
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+	if (abs(theta) == DHALFPI) {
+	    p[ira] = 0.0d0
+	    if (theta >= 0.0d0)
+	        p[idec] = 2.0d0 * FC_C1(fc) 
+	    else
+	        p[idec] = -2.0d0 * FC_C1(fc) 
+	    return
+	}
+
+	costhe = cos (theta)
+	l = costhe * sin (phi)
+	m = costhe * cos (phi)
+	n = sin (theta)
+
+	face = 0
+	rho = n
+	if (m > rho) {
+	    face = 1 
+	    rho = m
+	}
+	if (l > rho) {
+	    face = 2
+	    rho = l
+	}
+	if (-m > rho) {
+	    face = 3
+	    rho = -m
+	}
+	if (-l > rho) {
+	    face = 4
+	    rho = -l
+	}
+	if (-n > rho) {
+	    face = 5
+	    rho = -n
+	}
+	rhu = 1.0d0 - rho
+
+	switch (face) {
+	case 0:
+	    xi = l
+	    eta = -m
+	    if (rhu < 1.0d-8) {
+		t = (DHALFPI - theta)
+		rhu = t * t / 2.0d0
+	    }
+	    x0 = 0.0d0
+	    y0 = 2.0d0
+	case 1:
+	    xi = l
+	    eta = n
+	    if (rhu < 1.0d-8) {
+		t = theta
+		pconst = mod (phi, DTWOPI)
+		if (pconst < -DPI)
+		     pconst = pconst + DTWOPI
+		if (pconst > DPI)
+		     pconst = pconst - DTWOPI
+		rhu = (pconst * pconst + t * t) / 2.0d0
+	    }
+	    x0 = 0.0d0
+	    y0 = 0.0d0
+	case 2:
+	    xi = -m
+	    eta = n
+	    if (rhu < 1.0d-8) {
+		t = theta
+		pconst = mod (phi, DTWOPI)
+		if (pconst < -DPI)
+		     pconst = pconst + DTWOPI
+		pconst = (DHALFPI - pconst)
+		rhu = (pconst * pconst + t * t) / 2.0d0
+	    }
+	    x0 = 2.0d0
+	    y0 = 0.0d0
+	case 3:
+	    xi = -l
+	    eta = n
+	    if (rhu < 1.0d-8) {
+		t = theta
+		pconst = mod (phi, DTWOPI)
+		if (pconst < 0.0d0)
+		     pconst = pconst + DTWOPI
+		pconst = (DPI - pconst)
+		rhu = (pconst * pconst + t * t) / 2.0d0
+	    }
+	    x0 = 4.0d0
+	    y0 = 0.0d0
+	case 4:
+	    xi = m
+	    eta = n
+	    if (rhu < 1.0d-8) {
+		t = theta
+		pconst = mod (phi, DTWOPI)
+		if (pconst > DPI)
+		     pconst = pconst - DTWOPI
+		pconst = (DHALFPI + pconst)
+		rhu = (pconst * pconst + t * t) / 2.0d0
+	    }
+	    x0 = 6.0d0
+	    y0 = 0.0d0
+	case 5:
+	    xi = l
+	    eta = m
+	    if (rhu < 1.0d-8) {
+		t = (DHALFPI + theta)
+		rhu = t * t / 2.0d0
+	    }
+	    x0 = 0.0d0
+	    y0 = -2.0d0
+	}
+
+	if (xi == 0.0d0 && eta == 0.0d0) {
+	    xf = 0.0d0
+	    yf = 0.0d0
+	} else if (-xi >= abs(eta)) {
+	    psi = eta / xi
+	    chi = 1.0d0 + psi * psi
+	    xf = -sqrt (rhu / (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi)))
+	    yf = (xf / 15.0d0) * DRADTODEG ((atan (psi) - asin (psi /
+	        sqrt (chi + chi))))
+	} else if (xi >= abs(eta)) {
+	    psi = eta / xi
+	    chi = 1.0d0 + psi * psi
+	    xf = sqrt (rhu / (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi)))
+	    yf = (xf / 15.0d0) * DRADTODEG ((atan (psi) - asin (psi /
+	        sqrt (chi + chi))))
+	} else if (-eta > abs (xi)) {
+	    psi = xi / eta
+	    chi = 1.0d0 + psi * psi
+	    yf = -sqrt (rhu / (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi)))
+	    xf = (yf / 15.0d0) * DRADTODEG ((atan (psi) - asin (psi /
+	        sqrt (chi + chi))))
+	} else if (eta > abs (xi)) {
+	    psi = xi / eta
+	    chi = 1.0d0 + psi * psi
+	    yf = sqrt (rhu / (1.0d0 - 1.0d0 / sqrt (1.0d0 + chi)))
+	    xf = (yf / 15.0d0) * DRADTODEG ((atan (psi) - asin (psi /
+	        sqrt (chi + chi))))
+	}
+
+	if (abs(xf) > 1.0d0) {
+	    if (abs(xf) > (1.0d0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (xf >= 0.0d0)
+		xf = 1.0d0
+	    else
+		xf = -1.0d0
+	}
+	if (abs(yf) > 1.0d0) {
+	    if (abs(yf) > (1.0d0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (yf >= 0.0d0)
+		yf = 1.0d0
+	    else
+		yf = -1.0d0
+	}
+
+	p[ira] = FC_C1(fc) * (x0 + xf)
+	p[idec] = FC_C1(fc) * (y0 + yf)
+end
diff --git a/sys/mwcs/wfsamp.x b/sys/mwcs/wfsamp.x
new file mode 100644
index 00000000..992f3211
--- /dev/null
+++ b/sys/mwcs/wfsamp.x
@@ -0,0 +1,233 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"mwcs.h"
+
+.help WFSAMP
+.nf -------------------------------------------------------------------------
+WFSAMP -- WCS function driver for the one dimensional sampled wcs function.
+For this driver, the function P<->W (physical to/from world) is defined by
+a sampled WCS curve.
+
+Driver routines:
+
+	FN_INIT		    wf_smp_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		   wf_smp_ctran (fc, v1, v2)
+	FN_INV				(same)
+
+In this initial implementation, only linear interpolation of the sampled
+curve is provided, but the driver is easily extended to provide additional
+interpolators.  NOTE that this entire driver assumes that the sampled function
+is monotonic.
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_NPTS		Memi[$1+FCU]		# number of points in curve
+define	FC_LOC		Memi[$1+FCU+1]		# location in IN vector
+define	FC_V1		Memi[$1+FCU+2]		# pointer to IN vector
+define	FC_V2		Memi[$1+FCU+3]		# pointer to OUT vector
+define	FC_W		Memd[P2D($1+FCU+4)]	# W value (CRVAL)
+define	FC_DIR		Memi[$1+FCU+6]		# direction of transform
+
+
+# WF_SMP_INIT -- Initialize the function call descriptor for the indicated
+# type of transform (forward or inverse).
+
+procedure wf_smp_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I type of transformation
+
+int	axis, npts
+pointer	wp, mw, sp, emsg, pv, wv
+
+begin
+	# Enforce the current restriction to 1-dim sampled functions.
+	if (FC_NAXES(fc) != 1)
+	    call error (1, "Sampled wcs functions must be 1-dimensional")
+
+	wp = FC_WCS(fc)
+	mw = CT_MW(FC_CT(fc))
+	axis = CT_AXIS(FC_CT(fc),1)
+
+	# Get pointers to the input and output sample vectors.  For our
+	# purposes there is no difference between the forward and inverse
+	# transform; we just swap the vectors for the inverse transform.
+	# The use of direct pointers here assumes that the DBUF is not
+	# reallocated while the CTRAN is being used.
+
+	npts = WCS_NPTS(wp,axis)
+	pv   = WCS_PV(wp,axis)
+	wv   = WCS_WV(wp,axis)
+
+	# Verify that we have a sampled WCS for this axis.
+	if (npts <= 0 || pv == NULL || wv == NULL) {
+	    call smark (sp)
+	    call salloc (emsg, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[emsg], SZ_LINE,
+		"No sampled wcs entered for axis %d")
+		call pargi (axis)
+	    call error (2, Memc[emsg])
+	    call sfree (sp)
+	}
+
+	if (dir == FORWARD) {
+	    FC_V1(fc) = MI_DBUF(mw) + pv - 1
+	    FC_V2(fc) = MI_DBUF(mw) + wv - 1
+	} else {
+	    FC_V1(fc) = MI_DBUF(mw) + wv - 1
+	    FC_V2(fc) = MI_DBUF(mw) + pv - 1
+	}
+
+	FC_NPTS(fc) = npts
+	if (WCS_W(wp) == NULL)
+	    FC_W(fc) = 0.0
+	else
+	    FC_W(fc) = D(mw,WCS_W(wp)+axis-1)
+
+	FC_LOC(fc) = 1
+	FC_DIR(fc) = dir
+end
+
+
+# WF_SMP_CTRAN -- Given the coordinates of a point X in the input curve,
+# locate the sample interval containing the point, and return the coordinate
+# of the same point in the output curve using simple linear interpolation
+# (currently) to evaluate the WCS function value.
+
+procedure wf_smp_ctran (fc, a_x, a_y)
+
+pointer	fc			#I pointer to FC descriptor
+double	a_x			#I point to sample WCS at
+double	a_y			#O value of WCS at that point
+
+int	index, i, step
+double	frac, x, y
+pointer	ip, op, i1, i2
+int	wf_smp_binsearch()
+define	sample_ 91
+define	oor_ 92
+
+begin
+	# Get the input X value.
+	if (FC_DIR(fc) == FORWARD)
+	    x = a_x
+	else
+	    x = a_x - FC_W(fc)
+
+	# Check for out of bounds and set step.
+	i1 = FC_V1(fc)
+	i2 = i1 + FC_NPTS(fc) - 1
+	if (Memd[i1] <= Memd[i2]) {
+	    if (x < Memd[i1] || x > Memd[i2])
+		goto oor_
+	    step = 1
+	} else {
+	    if (x < Memd[i2] || x > Memd[i1])
+		goto oor_
+	    step = -1
+	}
+
+	# Check the endpoints and the last inverval to optimize the case of
+	# repeated samplings of the same region of the curve.
+
+	if (x == Memd[i1])
+	    ip = i1 - min (0, step)
+	else if (x == Memd[i2])
+	    ip = i2 - max (0, step)
+	else
+	    ip = FC_LOC(fc) + i1 - 1
+	if (Memd[ip] <= x && x <= Memd[ip+step])
+	    goto sample_
+
+	# Next check several intervals to either side.
+	if (x < Memd[ip]) {
+	    do i = 1, 5 {
+		ip = ip - step
+		if (Memd[ip] <= x)
+		    goto sample_
+	    }
+	} else {
+	    do i = 1, 5 {
+		if (Memd[ip+step] >= x)
+		    goto sample_
+		ip = ip + step
+	    }
+	}
+
+	# Give up and do a full binary search!
+	index = wf_smp_binsearch (x, Memd[i1], FC_NPTS(fc))
+	if (index == 0)
+	    goto oor_
+	else
+	    ip = i1 + index - 1
+
+	# Having found the proper interval, compute the function value by
+	# interpolating the output vector.
+sample_
+	op = FC_V2(fc) + ip-i1
+	frac = (x - Memd[ip]) / (Memd[ip+step] - Memd[ip])
+	y = (Memd[op+step] - Memd[op]) * frac + Memd[op]
+
+	# Get the output Y value.
+	if (FC_DIR(fc) == FORWARD)
+	    a_y = y
+	else
+	    a_y = y + FC_W(fc)
+
+	# Save last location.
+	FC_LOC(fc) = ip - i1 + 1
+
+	return
+oor_
+	# Given X value is not in the region covered by the sampled curve,
+	# or at least we couldn't find it with a binary search.
+
+	call error (2, "Out of bounds reference on sampled WCS curve")
+end
+
+
+# WF_SMP_BINSEARCH -- Perform a binary search of a sorted array for the
+# interval containing the given point.
+
+int procedure wf_smp_binsearch (x, v, npts)
+
+double	x				#I point we want interval for
+double	v[ARB]				#I array to be searched
+int	npts				#I number of points in array
+
+int	low, high, pos, i
+
+begin
+	low = 1
+	high = max (1, npts)
+
+	# Cut range of search in half until interval is found, or until range
+	# vanishes (high - low <= 1).
+
+	if (v[1] < v[npts]) {
+	    do i = 1, npts {
+		pos = min ((high - low) / 2 + low, npts-1)
+		if (pos == low)
+		    return (0)				# not found
+		else if (v[pos] <= x && x <= v[pos+1])
+		    return (pos)
+		else if (x < v[pos])
+		    high = pos
+		else
+		    low = pos
+	    }
+	} else {
+	    do i = 1, npts {
+		pos = min ((high - low) / 2 + low, npts-1)
+		if (pos == low)
+		    return (0)				# not found
+		else if (v[pos+1] <= x && x <= v[pos])
+		    return (pos+1)
+		else if (x > v[pos])
+		    high = pos
+		else
+		    low = pos
+	    }
+	}
+end
diff --git a/sys/mwcs/wfsin.x b/sys/mwcs/wfsin.x
new file mode 100644
index 00000000..a1b18d82
--- /dev/null
+++ b/sys/mwcs/wfsin.x
@@ -0,0 +1,150 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFSIN
+.nf -------------------------------------------------------------------------
+WFSIN -- WCS function driver for the sine projection.
+
+Driver routines:
+
+	FN_INIT		    wf_sin_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_sin_fwd (fc, v1, v2)
+	FN_INV		     wf_sin_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		# DEC axis (1 or 2)
+define	FC_COSDEC	Memd[P2D($1+FCU+2)]	# cosine(dec)
+define	FC_SINDEC	Memd[P2D($1+FCU+4)]	# sine(dec)
+define	FC_W		Memd[P2D($1+FCU+6)+($2)-1] # W (CRVAL) for each axis
+
+
+# WF_SIN_INIT -- Initialize the sine forward or inverse transform.
+# Initialization for this transformation consists of determining which axis
+# is RA and which is DEC, and precomputing the sine and cosine of the
+# declination at the reference point.  In order to determine the axis order,
+# the parameter "axtype={ra|dec}" must have been set in the attribute list
+# for the function.
+# NOTE:  This is identical to wf_tan_init.
+
+procedure wf_sin_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	ct, mw, wp, wv
+errchk	wf_decaxis
+
+begin
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e., the world coordinate at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Precompute the sin and cos of the declination at the reference pixel.
+	dec = DEGTORAD(FC_W(fc,FC_IDEC(fc)))
+	FC_COSDEC(fc) = cos(dec)
+	FC_SINDEC(fc) = sin(dec)
+end
+
+
+# WF_SIN_FWD -- Forward transform (physical to world), sine
+# projection.  Based on code from STScI, Hodge et al.
+
+procedure wf_sin_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (xi, eta)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	v1, xi, eta, x, y, z, ra, dec
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	xi  = DEGTORAD(p[ira])
+	eta = DEGTORAD(p[idec])
+
+	v1 = 1.d0 - xi*xi - eta*eta
+	if (v1 > 0.d0)
+	    v1 = sqrt (1.d0 - xi*xi - eta*eta)
+	else
+	    v1 = 0.d0
+
+	# Rotate the rectangular coordinate system of the vector (v1, xi, eta)
+	# by the declination so the X axis will pass through the equator.
+
+	x = v1 * FC_COSDEC(fc) - eta * FC_SINDEC(fc)
+	y = xi
+	z = v1 * FC_SINDEC(fc) + eta * FC_COSDEC(fc)
+
+	if (x == 0.d0 && y == 0.d0)
+	    ra = 0.d0
+	else
+	    ra = atan2 (y, x)
+	dec = atan2 (z, sqrt (x*x + y*y))
+
+	# Return RA and DEC in degrees.
+	dec = RADTODEG(dec)
+	ra  = RADTODEG(ra) + FC_W(fc,ira)
+
+	if (ra < 0.d0)
+	    ra = ra + 360.D0
+	else if (ra > 360.D0)
+	    ra = ra - 360.D0
+
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_SIN_INV -- Inverse transform (world to physical) for the sine
+# projection.  Based on code from Eric Greisen, AIPS Memo No. 27.
+
+procedure wf_sin_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#O output physical coordinates
+
+int	ira, idec
+double	ra, dec, xi, eta
+double	cosra, cosdec, sinra, sindec
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	ra  = DEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DEGTORAD (w[idec])
+
+	cosra = cos (ra)
+	sinra = sin (ra)
+
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	xi = cosdec * sinra
+	eta = sindec * FC_COSDEC(fc) - cosdec * FC_SINDEC(fc) * cosra
+
+	p[ira]  = RADTODEG(xi)
+	p[idec] = RADTODEG(eta)
+end
diff --git a/sys/mwcs/wfstg.x b/sys/mwcs/wfstg.x
new file mode 100644
index 00000000..e8ee66b4
--- /dev/null
+++ b/sys/mwcs/wfstg.x
@@ -0,0 +1,327 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFSTG
+.nf -------------------------------------------------------------------------
+WFSTG -- WCS function driver for the stereographic projection.
+
+Driver routines:
+
+	FN_INIT		    wf_stg_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_stg_fwd (fc, v1, v2)
+	FN_INV		     wf_stg_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]			# DEC axis (1 or 2)
+define	FC_LONGP	Memd[P2D($1+FCU+2)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+4)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+6)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+8)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+10)]		# trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+12)]		# RO (degs)
+define	FC_2RODEG	Memd[P2D($1+FCU+14)]		# 2 * RO (degs)
+define	FC_REC2RODEG	Memd[P2D($1+FCU+16)]		# 1 / (2 * RO) (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]		# Bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1] 	# CRVAL (axis 1 and 2)
+
+
+# WF_STG_INIT -- Initialize the stereographic forward or inverse transform.
+# Initialization for this transformation consists of, determining which
+# axis is RA / LON and which is DEC / LAT, computing the celestial longitude
+# and colatitude of the native pole, reading in the the native longitude of the
+# pole of the celestial coordinate system LONGPOLE from the attribute list,
+# precomputing the Euler angles and various intermediary functions of the
+# reference coordinates, reading in the projection parameter RO from the
+# attribute list, and precomputing some intermediate parameters. If LONGPOLE
+# is undefined then a value of 180.0 degrees is assumed. If RO is undefined a
+# value of 180.0 / PI is assumed. The STG projection is equivalent to the AZP
+# projection with MU set to 1.0. In order to determine the axis order, the
+# parameter "axtype={ra|dec} {xlon|xlat}" must have been set in the attribute
+# list for the function. The LONGPOLE and RO parameters may be set in either
+# or both of the axes attribute lists, but the value in the RA axis attribute
+# list takes precedence. 
+
+procedure wf_stg_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = 180.0d0
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = 180.0d0
+		if (IS_INDEFD(FC_LONGP(fc)))
+		    FC_LONGP(fc) = 180.0d0
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = 180.0d0
+	    if (IS_INDEFD(FC_LONGP(fc)))
+	        FC_LONGP(fc) = 180.0d0
+	}
+	FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+	FC_2RODEG(fc) = 2.0d0 * FC_RODEG(fc)
+	FC_REC2RODEG(fc) = 1.0d0 / FC_2RODEG(fc)
+
+	# Fetch the spherical trigonometry tolerance.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Fetch the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_STG_FWD -- Forward transform (physical to world) for the stereographic
+# projection.
+
+procedure wf_stg_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, r, phi, theta, costhe, sinthe, dphi, cosphi, sinphi,  ra, dec
+double	dlng, z
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+	r = sqrt (x * x + y * y)
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	theta = DHALFPI - 2.0d0 * atan (r * FC_REC2RODEG(fc))
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_STG_INV -- Inverse transform (world to physical) for the stereographic
+# projection.
+
+procedure wf_stg_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, r, dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) ==0.0) {
+            theta = dec + cosra * FC_COLATP(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = 1.0d0 + sin (theta)
+	if (s == 0.0d0) {
+	    p[ira]  = FC_BADCVAL(fc)
+	    p[idec] = FC_BADCVAL(fc)
+	} else {
+	    r = FC_2RODEG(fc) * cos (theta) / s
+	    p[ira]  = r * sin (phi)
+	    p[idec] = -r * cos (phi)
+	}
+end
diff --git a/sys/mwcs/wftan.x b/sys/mwcs/wftan.x
new file mode 100644
index 00000000..2c5a0c5f
--- /dev/null
+++ b/sys/mwcs/wftan.x
@@ -0,0 +1,145 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFTAN
+.nf -------------------------------------------------------------------------
+WFTAN -- WCS function driver for the tangent plane (gnonomic) projection.
+
+Driver routines:
+
+	FN_INIT		    wf_tan_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_tan_fwd (fc, v1, v2)
+	FN_INV		     wf_tan_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		# DEC axis (1 or 2)
+define	FC_COSDEC	Memd[P2D($1+FCU+2)]	# cosine(dec)
+define	FC_SINDEC	Memd[P2D($1+FCU+4)]	# sine(dec)
+define	FC_W		Memd[P2D($1+FCU+6)+($2)-1] # W (CRVAL) for each axis
+
+
+# WF_TAN_INIT -- Initialize the tangent plane forward or inverse transform.
+# Initialization for this transformation consists of determining which axis
+# is RA and which is DEC, and precomputing the sine and cosine of the
+# declination at the reference point.  In order to determine the axis order,
+# the parameter "axtype={ra|dec}" must have been set in the attribute list
+# for the function.
+
+procedure wf_tan_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	ct, mw, wp, wv
+errchk	wf_decaxis
+
+begin
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e., the world coordinate at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Precompute the sin and cos of the declination at the reference pixel.
+	dec = DEGTORAD(FC_W(fc,FC_IDEC(fc)))
+	FC_COSDEC(fc) = cos(dec)
+	FC_SINDEC(fc) = sin(dec)
+end
+
+
+# WF_TAN_FWD -- Forward transform (physical to world), tangent plane
+# projection.  Based on code from STScI, Hodge et. al.
+
+procedure wf_tan_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (xi, eta)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	xi, eta, x, y, z, ra, dec
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	xi  = DEGTORAD(p[ira])
+	eta = DEGTORAD(p[idec])
+
+	# Rotate the rectangular coordinate system of the vector [1,xi,eta]
+	# by the declination so that the X axis will pass through the equator.
+
+	x = FC_COSDEC(fc) - eta * FC_SINDEC(fc)
+	y = xi
+	z = FC_SINDEC(fc) + eta * FC_COSDEC(fc)
+
+	# Compute RA and DEC in radians.
+	if (x == 0.0D0 && y == 0.0D0)
+	    ra = 0.0D0
+	else
+	    ra = atan2 (y, x)
+	dec = atan2 (z, sqrt (x*x + y*y))
+
+	# Return RA and DEC in degrees.
+	dec = RADTODEG(dec)
+	ra  = RADTODEG(ra) + FC_W(fc,ira)
+
+	if (ra < 0)
+	    ra = ra + 360D0
+	else if (ra > 360D0)
+	    ra = ra - 360D0
+
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_TAN_INV -- Inverse transform (world to physical) for the tangent plane
+# projection.  Based on code from STScI, Hodge et. al.
+
+procedure wf_tan_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, xi, eta
+double	cosra, cosdec, sinra, sindec, cosdist
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	ra  = DEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DEGTORAD (w[idec])
+
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+	cosdist = sindec * FC_SINDEC(fc) + cosdec * FC_COSDEC(fc) * cosra
+
+	xi = cosdec * sinra / cosdist
+	eta = (sindec * FC_COSDEC(fc) - cosdec * FC_SINDEC(fc) * cosra) /
+	    cosdist
+
+	p[ira]  = RADTODEG(xi)
+	p[idec] = RADTODEG(eta)
+end
diff --git a/sys/mwcs/wftnx.x b/sys/mwcs/wftnx.x
new file mode 100644
index 00000000..d8b753a6
--- /dev/null
+++ b/sys/mwcs/wftnx.x
@@ -0,0 +1,439 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFTNX
+.nf -------------------------------------------------------------------------
+WFTNX -- WCS function driver for the gnomonic projection.
+
+Driver routines:
+
+	FN_INIT		    wf_tn_init (fc, dir)
+	FN_DESTROY       wf_tnx_destroy (fc)
+	FN_FWD		     wf_tnx_fwd (fc, v1, v2)
+	FN_INV		     wf_tnx_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+define	MAX_NITER	20
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_LNGCOR	Memi[$1+FCU]			# RA axis (1 or 2)
+define	FC_LATCOR	Memi[$1+FCU+1]			# DEC axis (1 or 2)
+define	FC_IRA		Memi[$1+FCU+2]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+3]			# DEC axis (1 or 2)
+define	FC_LONGP	Memd[P2D($1+FCU+4)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+6)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+8)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+10)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+12)]		# trig toleracne
+define	FC_RODEG	Memd[P2D($1+FCU+14)]		# RO (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+16)]		# Bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+18)+($2)-1] 	# CRVAL (axis 1 and 2)
+
+
+# WF_TNX_INIT -- Initialize the gnomonic forward or inverse transform.
+# Initialization for this transformation consists of, determining which
+# axis is RA / LON and which is DEC / LAT, computing the celestial longitude
+# and colatitude of the native pole, reading in the the native longitude
+# of the pole of the celestial coordinate system LONGPOLE from the attribute
+# list, precomputing Euler angles and various intermediaries derived from the
+# coordinate reference values, and reading in the projection parameter RO
+# from the attribute list. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed. If RO is undefined a value of 180.0 / PI is assumed.
+# The TAN projection is equivalent to the AZP projection with MU set to 0.0.
+# In order to determine the axis order, the parameter "axtype={ra|dec}
+# {xlon|glat}{xlon|elat}" must have been set in the attribute list for the
+# function. The LONGPOLE and RO parameters may be set in either or both of
+# the axes attribute lists, but the value in the RA axis attribute list takes
+# precedence. 
+
+procedure wf_tnx_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i, szatstr
+double	dec
+pointer	atvalue, ct, mw, wp, wv
+int	ctod(), strlen()
+pointer	wf_gsopen()
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call malloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = 180.0d0
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = 180.0d0
+	        if (IS_INDEFD(FC_LONGP(fc)))
+	            FC_LONGP(fc) = 180.0d0
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = 180.0d0
+	    if (IS_INDEFD(FC_LONGP(fc)))
+	        FC_LONGP(fc) = 180.0d0
+	}
+	FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+
+	szatstr = SZ_LINE
+
+	# Fetch the longitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+	iferr {
+	    repeat {
+	        call mw_gwattrs (mw, FC_IRA(fc), "lngcor", Memc[atvalue],
+		    szatstr)
+		if (strlen (Memc[atvalue]) < szatstr)
+		    break
+		szatstr = szatstr + SZ_LINE 
+		call realloc (atvalue, szatstr, TY_CHAR)
+
+	    }
+	} then {
+	    FC_LNGCOR(fc) = NULL
+	} else {
+	    FC_LNGCOR(fc) = wf_gsopen (Memc[atvalue])
+	}
+
+	# Fetch the latitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+	iferr {
+	    repeat {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "latcor", Memc[atvalue],
+		    szatstr)
+		if (strlen (Memc[atvalue]) < szatstr)
+		    break
+		szatstr = szatstr + SZ_LINE 
+		call realloc (atvalue, szatstr, TY_CHAR)
+	    }
+	} then {
+	    FC_LATCOR(fc) = NULL
+	} else {
+	    FC_LATCOR(fc) = wf_gsopen (Memc[atvalue])
+	}
+
+	# Set the small angle spherical trigonometry tolerance.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call mfree (atvalue, TY_CHAR)
+end
+
+
+# WF_TNX_FWD -- Forward transform (physical to world) gnomonic projection.
+
+procedure wf_tnx_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, r, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, dlng, z
+double	ra, dec
+double	wf_gseval()
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	if (FC_LNGCOR(fc) == NULL)
+	    x = p[ira]
+	else
+	    x = p[ira] + wf_gseval (FC_LNGCOR(fc), p[ira], p[idec])
+	if (FC_LATCOR(fc) == NULL)
+	    y = p[idec]
+	else
+	    y = p[idec] + wf_gseval (FC_LATCOR(fc), p[ira], p[idec])
+	r = sqrt (x * x + y * y)
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	theta = atan2 (FC_RODEG(fc), r)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+	if (abs (x) < FC_SPHTOL(fc))
+	    x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+		(1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI 
+	}
+	ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+	if (mod (dphi, DPI) == 0.0d0) {
+	    dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+	    if (dec > 90.0d0)
+		dec = 180.0d0 - dec
+	    if (dec < -90.0d0)
+		dec = -180.0d0 - dec
+	} else {
+	    z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+	    if (abs(z) > 0.99d0) {
+		if (z >= 0.0d0)
+		    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+		else
+		    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+	    } else
+		dec = DRADTODEG(asin (z))
+	}
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_TNX_INV -- Inverse transform (world to physical) for the gnomic
+# projection.
+
+procedure wf_tnx_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, niter
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, r, dphi, z
+double	xm, ym, f, fx, fy, g, gx, gy, denom, dx, dy, dmax
+double	wf_gseval(), wf_gsder()
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+	if (abs(x) < FC_SPHTOL(fc))
+	    x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+		(1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+	if (mod (ra, DPI) ==0.0) {
+	    theta = dec + cosra * FC_COLATP(fc)
+	    if (theta > DHALFPI)
+		theta = DPI - theta
+	    if (theta < -DHALFPI)
+		theta = -DPI - theta
+	} else {
+	    z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+	    if (abs (z) > 0.99d0) {
+		if (z >= 0.0)
+		    theta = acos (sqrt(x * x + y * y))
+		else
+		    theta = -acos (sqrt(x * x + y * y))
+	    } else
+		theta = asin (z)
+	}
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = sin (theta)
+	if (s == 0.0d0) {
+	    p[ira] = FC_BADCVAL(fc)
+	    p[idec] = FC_BADCVAL(fc)
+	} else {
+	    r = FC_RODEG(fc) * cos (theta) / s
+	    if (FC_LNGCOR(fc) == NULL && FC_LATCOR(fc) == NULL) {
+	        p[ira]  = r * sin (phi)
+	        p[idec] = -r * cos (phi)
+	    } else {
+	        xm  = r * sin (phi)
+	        ym = -r * cos (phi)
+		x = xm
+		y = ym
+		niter = 0
+		dmax = 30. / 3600.
+		repeat {
+
+		    if (FC_LNGCOR(fc) != NULL) {
+		        f = x + wf_gseval (FC_LNGCOR(fc), x, y) - xm
+		        fx = wf_gsder (FC_LNGCOR(fc), x, y, 1, 0)
+		        fx = 1.0 + fx
+		        fy = wf_gsder (FC_LNGCOR(fc), x, y, 0, 1)
+		    } else {
+		        f = x - xm
+		        fx = 1.0 
+		        fy = 0.0
+		    }
+		    if (FC_LATCOR(fc) != NULL) {
+		        g = y + wf_gseval (FC_LATCOR(fc), x, y) - ym
+		        gx = wf_gsder (FC_LATCOR(fc), x, y, 1, 0)
+		        gy = wf_gsder (FC_LATCOR(fc), x, y, 0, 1)
+		        gy = 1.0 + gy
+		    } else {
+		        g = y - ym
+		        gx = 0.0 
+		        gy = 1.0
+		    }
+
+		    denom = fx * gy - fy * gx
+		    if (denom == 0.0d0)
+			break
+		    dx = (-f * gy + g * fy) / denom
+		    dy = (-g * fx + f * gx) / denom
+		    x = x + max (-dmax, min (dmax, dx))
+		    y = y + max (-dmax, min (dmax, dy))
+		    if (max (abs (dx), abs (dy), abs(f), abs(g)) < 2.80d-7)
+			break
+
+		    niter = niter + 1
+
+		} until (niter >= MAX_NITER)
+
+	        p[ira]  = x
+	        p[idec] = y
+	    }
+	}
+end
+
+
+# WF_TNX_DESTROY -- Free up the distortion surface pointers.
+
+procedure wf_tnx_destroy (fc)
+
+pointer	fc			#I pointer to the FC descriptor
+
+begin
+	if (FC_LNGCOR(fc) != NULL)
+	    call wf_gsclose (FC_LNGCOR(fc))
+	if (FC_LATCOR(fc) != NULL)
+	    call wf_gsclose (FC_LATCOR(fc))
+end
diff --git a/sys/mwcs/wftpv.x b/sys/mwcs/wftpv.x
new file mode 100644
index 00000000..812362be
--- /dev/null
+++ b/sys/mwcs/wftpv.x
@@ -0,0 +1,556 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include <ctype.h>
+include "imwcs.h"
+include	"mwcs.h"
+
+.help WFTPV
+.nf -------------------------------------------------------------------------
+# WFTPV -- WCS function driver for the TPV polynomial projection.
+
+Driver routines:
+
+	FN_INIT		 wf_tpv_init (fc, dir)
+	FN_DESTROY	 wf_tpv_destroy (fc)
+	FN_FWD		 wf_tpv_fwd (fc, v1, v2)
+	FN_INV		 wf_tpv_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+define  MAX_NITER       20
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		# DEC axis (1 or 2)
+define	FC_COSDEC	Memd[P2D($1+FCU+2)]	# cosine(dec)
+define	FC_SINDEC	Memd[P2D($1+FCU+4)]	# sine(dec)
+define	FC_W		Memd[P2D($1+FCU+6)+($2)-1] # W (CRVAL) for each axis
+define	FC_NPRA		Memi[$1+FCU+10]		# poly order (0-39)
+define	FC_NPDEC	Memi[$1+FCU+11]		# poly order (0-39)
+define	FC_PV		Memi[$1+FCU+12]		# pointer to PV data (double)
+
+define	FC_A		Memd[FC_PV($1)+($2)]	# RA coefficient
+define	FC_B		Memd[FC_PV($1)+40+($2)]	# DEC coefficient
+
+# WF_TPV_INIT -- Initialize the tan polynomial forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, computing the celestial
+# longitude and colatitude of the native pole, reading in the the native
+# longitude of the pole of the celestial coordinate system LONGPOLE from the
+# attribute list, precomputing the Euler angles and various intermediary
+# functions of the reference coordinates, reading in the projection parameter
+# RO from the attribute list, reading in up to ten polynomial coefficients,
+# and, for polynomial orders greater than 2 computing the colatitude and radius
+# of the  first point of inflection. If LONGPOLE is undefined then a value of
+# 180.0 degrees is assumed. If RO is undefined a value of 180.0 / PI is
+# assumed. If the polynomial coefficients are all zero then an error condition
+# is posted. If the order of the polynomial is 2 or greater and there is no
+# point of inflection an error condition is posted. The TPV projection with
+# an order of 1 and 0th and 1st coefficients of 0.0 and 1.0 respectively is
+# equivalent to the ARC projtection. In order to determine the axis order,
+# the parameter "axtype={ra|dec} {xlon|xlat}" must have been set in the
+# attribute list for the function. The LONGPOLE and RO parameters may be set
+# in either or both of the axes attribute lists, but the value in the RA axis
+# attribute list takes precedence. 
+
+procedure wf_tpv_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i, ualen, index, ip
+double	dec, dval
+pointer	ct, mw, wp, wv, im, idb, rp
+
+int	idb_nextcard(), itoc(), ctod()
+pointer	idb_open()
+errchk	wf_decaxis()
+
+begin
+	# Allocate PV storage.  This is freed in wf_tpv_destroy.
+	call calloc (FC_PV(fc), 80, TY_DOUBLE)
+
+	# Set non-zero defaults.
+	FC_NPRA(fc) = 1
+	FC_NPDEC(fc) = 1
+	FC_A(fc,1) = 1D0
+	FC_B(fc,1) = 1D0
+
+	# Get the required mwcs pointers.
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Precompute the sin and cos of the declination at the reference pixel.
+	dec = DEGTORAD(FC_W(fc,FC_IDEC(fc)))
+	FC_COSDEC(fc) = cos(dec)
+	FC_SINDEC(fc) = sin(dec)
+
+        # Read through the fits header once more and pick up the PV cards.
+        # Read the values and store them, keeping track of what is
+        # the highest order coefficient.
+
+	im = MI_REFIM(mw)
+	idb = idb_open(im,ualen)
+	while (idb_nextcard(idb,rp) != EOF) {
+	    if (Memc[rp] != 'P' || Memc[rp+1] != 'V' || Memc[rp+3] != '_')
+	        next
+	    if (Memc[rp+2] != '1' && Memc[rp+2] != '2')
+	        next
+            if (! IS_DIGIT(Memc[rp+4]))
+                next
+            index = TO_INTEG(Memc[rp+4])
+            do i = 5,7 {
+                if (! IS_DIGIT(Memc[rp+i]))
+		    break
+		else
+		    index = 10*index + TO_INTEG(Memc[rp+i])
+            }
+	    if (index > 39)
+	        next
+            ip = IDB_STARTVALUE
+            if (ctod(Memc[rp],ip,dval) <= 0) 
+	        dval = 0.0d0
+	    i = TO_INTEG(Memc[rp+2])
+	    if (i == FC_IRA(fc)) {
+		FC_A(fc,index) = dval
+		if (index > FC_NPRA(fc))
+		    FC_NPRA(fc) = double(index)
+	    } else {
+		FC_B(fc,index) = dval
+		if (index > FC_NPDEC(fc))
+		    FC_NPDEC(fc) = double(index)
+	    }
+        }
+	call idb_close(idb)
+
+end
+
+
+# WF_TPV_FWD -- Forward transform (physical to world) for the tangent plane
+# with polynomial distortion.
+
+procedure wf_tpv_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+double  x, y, z, a, b, ra, dec
+
+begin
+	# Compute the standard coordinates.
+
+	x = p[1]
+	y = p[2]
+	call tpv_poly (fc, x, y, a, b)
+
+        # Rotate the rectangular coordinate system of the vector [1,xi,eta]
+        # by the declination so that the X axis will pass through the equator.
+
+        a = DEGTORAD(a)
+        b = DEGTORAD(b)
+
+        x = FC_COSDEC(fc) - b * FC_SINDEC(fc)
+        y = a
+        z = FC_SINDEC(fc) + b * FC_COSDEC(fc)
+
+        # Compute RA and DEC in radians.
+        if (x == 0.0D0 && y == 0.0D0)
+            ra = 0.0D0
+        else
+            ra = atan2 (y, x)
+        dec = atan2 (z, sqrt (x*x + y*y))
+
+        # Return RA and DEC in degrees.
+        dec = RADTODEG(dec)
+        ra  = RADTODEG(ra) + FC_W(fc,FC_IRA(fc))
+
+        if (ra < 0D0)
+            ra = ra + 360D0
+        else if (ra > 360D0)
+            ra = ra - 360D0
+
+        w[FC_IRA(fc)]  = ra
+        w[FC_IDEC(fc)] = dec
+
+end
+
+
+# WF_TPV_INV -- Inverse transform (world to physical) for the tangent plane
+# projection with polynomials.
+
+procedure wf_tpv_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, niter
+double	ra, dec
+double	cosra, cosdec, sinra, sindec, cosdist
+double	a, b, x, y, f, g, fx, gx, fy, gy, denom, dx, dy, dmax
+
+begin
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	ra  = DEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DEGTORAD (w[idec])
+
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+	cosdist = sindec * FC_SINDEC(fc) + cosdec * FC_COSDEC(fc) * cosra
+
+	a = RADTODEG(cosdec * sinra / cosdist)
+	b = RADTODEG((sindec * FC_COSDEC(fc) - cosdec * FC_SINDEC(fc) * cosra) /
+	    cosdist)
+
+	x = a
+	y = b
+	dmax = 30. / 3600.
+	niter = 0
+
+	repeat {
+	    call tpv_poly (fc, x, y, f, g)
+	    call tpv_der (fc, x, y, fx, gx, fy, gy)
+	    
+	    f = f - a
+	    g = g - b
+
+	    denom = fx * gy - fy * gx
+	    if (denom == 0.0d0)
+		break
+		
+	    dx = (-f * gy + g * fy) / denom
+	    dy = (-g * fx + f * gx) / denom
+	    x = x + max (-dmax, min (dmax, dx))
+	    y = y + max (-dmax, min (dmax, dy))
+	    
+	    if (max (abs (dx), abs (dy), abs(f), abs(g)) < 2.0d-7)
+		break
+
+	    niter = niter + 1
+
+	} until (niter >= MAX_NITER)
+
+	p[ira]  = x
+	p[idec] = y
+
+end
+
+
+# WF_TPV_DESTROY -- Free up the distortion surface pointers.
+
+procedure wf_tpv_destroy (fc)
+
+pointer fc                      #I pointer to the FC descriptor
+
+begin
+	call mfree (FC_PV(fc), TY_DOUBLE)
+end
+
+
+# TPV_POLY -- Evaluate TPV polynomial (x,y -> xi,eta)
+
+procedure tpv_poly (fc, x, y, a, b)
+
+pointer	fc			#I pointer to FC descriptor
+double	x, y			#I physical coordinates
+double	a, b			#O standard coordinates (xi, eta) in deg
+
+int	n
+double	r, r2, r3, r5, r7, x2, x3, x4, x5, x6, x7, y2, y3, y4, y5, y6, y7
+
+begin
+	# Compute the standard coordinates.
+	# This depends on undefined coefficients being zero.
+
+	x2 = x * x
+	y2 = y * y
+	r2 = x2 + y2
+	r = sqrt (r2)
+	n = max (FC_NPRA(fc), FC_NPDEC(fc))
+	
+	a = FC_A(fc,0) + FC_A(fc,1) * x + FC_A(fc,2) * y + FC_A(fc,3) * r
+	b = FC_B(fc,0) + FC_B(fc,1) * y + FC_B(fc,2) * x + FC_B(fc,3) * r
+	if (n <= 3)
+	    return
+	a = a + FC_A(fc,4) * x2 + FC_A(fc,5) * x*y + FC_A(fc,6) * y2
+	b = b + FC_B(fc,4) * y2 + FC_B(fc,5) * x*y + FC_B(fc,6) * x2
+	if (n <= 6)
+	    return
+	x3 = x * x2
+	y3 = y * y2
+	r3 = r * r2
+	a = a + FC_A(fc,7) * x3
+	b = b + FC_B(fc,7) * y3
+	a = a + FC_A(fc,8) * x2*y
+	b = b + FC_B(fc,8) * y2*x
+	a = a + FC_A(fc,9) * x*y2
+	b = b + FC_B(fc,9) * y*x2
+	a = a + FC_A(fc,10) * y3
+	b = b + FC_B(fc,10) * x3
+	a = a + FC_A(fc,11) * r3
+	b = b + FC_B(fc,11) * r3
+	if (n <= 11)
+	    return
+	x4 = x * x3
+	y4 = y * y3
+	a = a + FC_A(fc,12) * x4
+	b = b + FC_B(fc,12) * y4
+	a = a + FC_A(fc,13) * x3*y
+	b = b + FC_B(fc,13) * y3*x
+	a = a + FC_A(fc,14) * x2*y2
+	b = b + FC_B(fc,14) * y2*x2
+	a = a + FC_A(fc,15) * x*y3
+	b = b + FC_B(fc,15) * y*x3
+	a = a + FC_A(fc,16) * y4
+	b = b + FC_B(fc,16) * x4
+	if (n <= 16)
+	    return
+	x5 = x * x4
+	y5 = y * y4
+	r5 = r3 * r2
+	a = a + FC_A(fc,17) * x5
+	b = b + FC_B(fc,17) * y5
+	a = a + FC_A(fc,18) * x4*y
+	b = b + FC_B(fc,18) * y4*x
+	a = a + FC_A(fc,19) * x3*y2
+	b = b + FC_B(fc,19) * y3*x2
+	a = a + FC_A(fc,20) * x2*y3
+	b = b + FC_B(fc,20) * y2*x3
+	a = a + FC_A(fc,21) * x*y4
+	b = b + FC_B(fc,21) * y*x4
+	a = a + FC_A(fc,22) * y5
+	b = b + FC_B(fc,22) * x5
+	a = a + FC_A(fc,23) * r5
+	b = b + FC_B(fc,23) * r5
+	if (n <= 23)
+	    return
+	x6 = x * x5
+	y6 = y * y5
+	a = a + FC_A(fc,14) * x6
+	b = b + FC_B(fc,24) * y6
+	a = a + FC_A(fc,25) * x5*y
+	b = b + FC_B(fc,25) * y5*x
+	a = a + FC_A(fc,26) * x4*y2
+	b = b + FC_B(fc,26) * y4*x2
+	a = a + FC_A(fc,27) * x3*y3
+	b = b + FC_B(fc,27) * y3*x3
+	a = a + FC_A(fc,28) * x2*y4
+	b = b + FC_B(fc,28) * y2*x4
+	a = a + FC_A(fc,29) * x*y5
+	b = b + FC_B(fc,29) * y*x5
+	a = a + FC_A(fc,30) * y6
+	b = b + FC_B(fc,30) * x6
+	if (n <= 30)
+	    return
+	x7 = x * x6
+	y7 = y * y6
+	r7 = r5 * r2
+	a = a + FC_A(fc,31) * x7
+	b = b + FC_B(fc,31) * y7
+	a = a + FC_A(fc,32) * x6*y
+	b = b + FC_B(fc,32) * y6*x
+	a = a + FC_A(fc,33) * x5*y2
+	b = b + FC_B(fc,33) * y5*x2
+	a = a + FC_A(fc,34) * x4*y3
+	b = b + FC_B(fc,34) * y4*x3
+	a = a + FC_A(fc,35) * x3*y4
+	b = b + FC_B(fc,35) * y3*x4
+	a = a + FC_A(fc,36) * x2*y5
+	b = b + FC_B(fc,36) * y2*x5
+	a = a + FC_A(fc,37) * x*y6
+	b = b + FC_B(fc,37) * y*x6
+	a = a + FC_A(fc,38) * y7
+	b = b + FC_B(fc,38) * x7
+	a = a + FC_A(fc,39) * r7
+	b = b + FC_B(fc,39) * r7
+
+end
+
+
+# TPV_DER -- Evaluate TPV polynomial (x,y -> xi,eta)
+
+procedure tpv_der (fc, x, y, ax, bx, ay, by)
+
+pointer	fc			#I pointer to FC descriptor
+double	x, y			#I physical coordinates
+double	ax, bx			#O standard coordinates (xi, eta) in deg
+double	ay, by			#O standard coordinates (xi, eta) in deg
+
+int	n
+double	r, r2, r4, r6, x2, x3, x4, x5, x6, y2, y3, y4, y5, y6, rx, ry
+
+begin
+	x2 = x * x
+	y2 = y * y
+	r2 = x2 + y2
+	r = sqrt (r2)
+	if (r < 2.0d-7) {
+	    rx = 1D0
+	    ry = 1D0
+	} else {
+	    rx = x / r
+	    ry = y / r
+	}
+	n = max (FC_NPRA(fc), FC_NPDEC(fc))
+	
+	ax = FC_A(fc,1) + FC_A(fc,3) * rx
+	by = FC_B(fc,1) + FC_B(fc,3) * ry
+	ay = FC_A(fc,2) + FC_A(fc,3) * ry
+	bx = FC_B(fc,2) + FC_B(fc,3) * rx
+	if (n <= 3)
+	    return
+	ax = ax + 2 * FC_A(fc,4) * x + FC_A(fc,5) * y
+	by = by + 2 * FC_B(fc,4) * y + FC_B(fc,5) * x
+	ay = ay + FC_A(fc,5) * x + 2 * FC_A(fc,6) * y
+	bx = bx + FC_B(fc,5) * y + 2 * FC_B(fc,6) * x
+	if (n <= 6)
+	    return
+	ax = ax + 3 * FC_A(fc,7) * x2
+	by = by + 3 * FC_B(fc,7) * y2
+	ax = ax + 2 * FC_A(fc,8) * x*y
+	by = by + 2 * FC_B(fc,8) * y*x
+	ax = ax + FC_A(fc,9) * y2
+	by = by + FC_B(fc,9) * x2
+	ax = ax + 3 * FC_A(fc,11) * r2 * rx
+	by = by + 3 * FC_B(fc,11) * r2 * ry
+	ay = ay + FC_A(fc,8) * x2
+	bx = bx + FC_B(fc,8) * y2
+	ay = ay + 2 * FC_A(fc,9) * x*y
+	bx = bx + 2 * FC_B(fc,9) * y*x
+	ay = ay + 3 * FC_A(fc,10) * y2
+	bx = bx + 3 * FC_B(fc,10) * x2
+	ay = ay + 3 * FC_A(fc,11) * r2 * ry
+	bx = bx + 3 * FC_B(fc,11) * r2 * rx
+	if (n <= 11)
+	    return
+	x3 = x * x2
+	y3 = y * y2
+	ax = ax + 4 * FC_A(fc,12) * x3
+	by = by + 4 * FC_B(fc,12) * y3
+	ax = ax + 3 * FC_A(fc,13) * x2*y
+	by = by + 3 * FC_B(fc,13) * y2*x
+	ax = ax + 2 * FC_A(fc,14) * x*y2
+	by = by + 2 * FC_B(fc,14) * y*x2
+	ax = ax + FC_A(fc,15) * y3
+	by = by + FC_B(fc,15) * x3
+	ay = ay + FC_A(fc,13) * x3
+	bx = bx + FC_B(fc,13) * y3
+	ay = ay + 2 * FC_A(fc,14) * x2*y
+	bx = bx + 2 * FC_B(fc,14) * y2*x
+	ay = ay + 3 * FC_A(fc,15) * x*y2
+	bx = bx + 3 * FC_B(fc,15) * y*x2
+	ay = ay + 4 * FC_A(fc,16) * y3
+	bx = bx + 4 * FC_B(fc,16) * x3
+	if (n <= 16)
+	    return
+	x4 = x * x3
+	y4 = y * y3
+	r4 = r2 * r2
+	ax = ax + 5 * FC_A(fc,17) * x4
+	by = by + 5 * FC_B(fc,17) * y4
+	ax = ax + 4 * FC_A(fc,18) * x3*y
+	by = by + 4 * FC_B(fc,18) * y3*x
+	ax = ax + 3 * FC_A(fc,19) * x2*y2
+	by = by + 3 * FC_B(fc,19) * y2*x2
+	ax = ax + 2 * FC_A(fc,20) * x*y3
+	by = by + 2 * FC_B(fc,20) * y*x3
+	ax = ax + FC_A(fc,21) * y4
+	by = by + FC_B(fc,21) * x4
+	ax = ax + 5 * FC_A(fc,23) * r4 * rx
+	by = by + 5 * FC_B(fc,23) * r4 * ry
+	ay = ay + FC_A(fc,18) * x4
+	bx = bx + FC_B(fc,18) * y4
+	ay = ay + 2 * FC_A(fc,19) * x3*y
+	bx = bx + 2 * FC_B(fc,19) * y3*x
+	ay = ay + 3 * FC_A(fc,20) * x2*y2
+	bx = bx + 3 * FC_B(fc,20) * y2*x2
+	ay = ay + 4 * FC_A(fc,21) * x*y3
+	bx = bx + 4 * FC_B(fc,21) * y*x3
+	ay = ay + 5 * FC_A(fc,22) * y4
+	bx = bx + 5 * FC_B(fc,22) * x4
+	ay = ay + 5 * FC_A(fc,23) * r4 * ry
+	bx = bx + 5 * FC_B(fc,23) * r4 * rx
+	if (n <= 23)
+	    return
+	x5 = x * x4
+	y5 = y * y4
+	ax = ax + 6 * FC_A(fc,14) * x5
+	by = by + 6 * FC_B(fc,24) * y5
+	ax = ax + 5 * FC_A(fc,25) * x4*y
+	by = by + 5 * FC_B(fc,25) * y4*x
+	ax = ax + 4 * FC_A(fc,26) * x3*y2
+	by = by + 4 * FC_B(fc,26) * y3*x2
+	ax = ax + 3 * FC_A(fc,27) * x2*y3
+	by = by + 3 * FC_B(fc,27) * y2*x3
+	ax = ax + 2 * FC_A(fc,28) * x*y4
+	by = by + 2 * FC_B(fc,28) * y*x4
+	ax = ax + FC_A(fc,29) * y5
+	by = by + FC_B(fc,29) * x5
+	ay = ay + FC_A(fc,25) * x5
+	bx = bx + FC_B(fc,25) * y5
+	ay = ay + 2 * FC_A(fc,26) * x4*y
+	bx = bx + 2 * FC_B(fc,26) * y4*x
+	ay = ay + 3 * FC_A(fc,27) * x3*y2
+	bx = bx + 3 * FC_B(fc,27) * y3*x2
+	ay = ay + 4 * FC_A(fc,28) * x2*y3
+	bx = bx + 4 * FC_B(fc,28) * y2*x3
+	ay = ay + 5 * FC_A(fc,29) * x*y4
+	bx = bx + 5 * FC_B(fc,29) * y*x4
+	ay = ay + 6 * FC_A(fc,30) * y5
+	bx = bx + 6 * FC_B(fc,30) * x5
+	if (n <= 30)
+	    return
+	x6 = x * x5
+	y6 = y * y5
+	r6 = r4 * r2
+	ax = ax + 7 * FC_A(fc,31) * x6
+	by = by + 7 * FC_B(fc,31) * y6
+	ax = ax + 6 * FC_A(fc,32) * x5*y
+	by = by + 6 * FC_B(fc,32) * y5*x
+	ax = ax + 5 * FC_A(fc,33) * x4*y2
+	by = by + 5 * FC_B(fc,33) * y4*x2
+	ax = ax + 4 * FC_A(fc,34) * x3*y3
+	by = by + 4 * FC_B(fc,34) * y3*x3
+	ax = ax + 3 * FC_A(fc,35) * x2*y4
+	by = by + 3 * FC_B(fc,35) * y2*x4
+	ax = ax + 2 * FC_A(fc,36) * x*y5
+	by = by + 2 * FC_B(fc,36) * y*x5
+	ax = ax + FC_A(fc,37) * y6
+	by = by + FC_B(fc,37) * x6
+	ax = ax + 7 * FC_A(fc,39) * r6 * rx
+	by = by + 7 * FC_B(fc,39) * r6 * ry
+	ay = ay + FC_A(fc,32) * x6
+	bx = bx + FC_B(fc,32) * y6
+	ay = ay + 2 * FC_A(fc,33) * x5*y
+	bx = bx + 2 * FC_B(fc,33) * y5*x
+	ay = ay + 3 * FC_A(fc,34) * x4*y2
+	bx = bx + 3 * FC_B(fc,34) * y4*x2
+	ay = ay + 4 * FC_A(fc,35) * x3*y3
+	bx = bx + 4 * FC_B(fc,35) * y3*x3
+	ay = ay + 5 * FC_A(fc,36) * x2*y4
+	bx = bx + 5 * FC_B(fc,36) * y2*x4
+	ay = ay + 6 * FC_A(fc,37) * x*y5
+	bx = bx + 6 * FC_B(fc,37) * y*x5
+	ay = ay + 7 * FC_A(fc,38) * y6
+	bx = bx + 7 * FC_B(fc,38) * x6
+	ay = ay + 7 * FC_A(fc,39) * r6 * ry
+	bx = bx + 7 * FC_B(fc,39) * r6 * rx
+
+end
diff --git a/sys/mwcs/wftsc.x b/sys/mwcs/wftsc.x
new file mode 100644
index 00000000..65445653
--- /dev/null
+++ b/sys/mwcs/wftsc.x
@@ -0,0 +1,563 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFTSC
+.nf -------------------------------------------------------------------------
+WFTSC -- WCS function driver for the tangentil spherical cube projection.
+
+Driver routines:
+
+	FN_INIT		    wf_tsc_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_tsc_fwd (fc, v1, v2)
+	FN_INV		     wf_tsc_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]		     # RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]		     # DEC axis (1 or 2)
+define  FC_NATRA        Memd[P2D($1+FCU+2)]          # RA of native pole (rads)
+define  FC_NATDEC       Memd[P2D($1+FCU+4)]          # DEC of native pole (rads)
+define  FC_LONGP        Memd[P2D($1+FCU+6)]          # LONGPOLE (rads)
+define  FC_COSDEC       Memd[P2D($1+FCU+8)]          # cosine (NATDEC)
+define  FC_SINDEC       Memd[P2D($1+FCU+10)]         # sine (NATDEC)
+define  FC_SPHTOL       Memd[P2D($1+FCU+12)]         # trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+14)]	     # RO (degs)
+define	FC_C1		Memd[P2D($1+FCU+16)]	     # RO * (PI / 4)
+define	FC_C2		Memd[P2D($1+FCU+18)]	     # (4 / PI) / RO
+define	FC_BADCVAL	Memd[P2D($1+FCU+20)]	     # bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+22)+($2)-1]  # CRVAL axis (1 and 2)
+
+
+# WF_TSC_INIT -- Initialize the forward or inverse tangential spherical cube
+# projection transform. Initialization for this transformation consists of,
+# determining which axis is RA / LON and which is DEC / LAT, reading in the
+# native longitude and latitude of the pole in celestial coordinates LONGPOLE
+# and LATPOLE from the attribute list, computing the celestial longitude and
+# colatitude of the native pole, precomputing the Euler angles and various
+# intermediary functions of the reference point, reading in the projection
+# parameter RO from the attribute list, and precomputing the various required
+# intermediate quantities. If LONGPOLE is undefined then a value of 180.0
+# degrees is assumed if the celestial latitude is less than 0, otherwise 0
+# is assumed. If LATPOLE is undefined then the most northerly of the two
+# possible solutions is chosen, otherwise the solution closest to LATPOLE
+# is chosen. If RO is undefined a value of 180.0 / PI is assumed. In order to
+# determine the axis order, the parameter "axtype={ra|dec} {xlon|xlat}" must
+# have been set in the attribute list for the function. The LONGPOLE, LATPOLE,
+# and RO parameters may be set in either or both of the axes attribute lists,
+# but the value in the RA axis attribute list takes precedence. 
+
+procedure wf_tsc_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double  dec, latpole, theta0, clat0, slat0, cphip, sphip, cthe0, sthe0, x, y, z
+double  u, v, latp1, latp2, latp, maxlat, tol
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+data    tol/1.0d-10/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+        # Determine the native longitude and latitude of the pole of the
+        # celestial coordinate system corresponding to the FITS keywords
+        # LONGPOLE and LATPOLE. LONGPOLE has no default but will be set
+        # to 180 or 0 depending on the value of the declination of the
+        # reference point. LATPOLE has no default but will be set depending
+        # on the values of LONGPOLE and the reference declination.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_LONGP(fc) = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                    FC_LONGP(fc) = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+                FC_LONGP(fc) = INDEFD
+        }
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "latpole", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latpole", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                latpole = INDEFD
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, latpole) <= 0)
+                    latpole = INDEFD
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, latpole) <= 0)
+                latpole = INDEFD
+        }
+
+        # Fetch the RO projection parameter which is the radius of the
+        # generating sphere for the projection. If RO is absent which
+        # is the usual case set it to 180 / PI. Search both axes for
+        # this quantity.
+
+        iferr {
+            call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+        } then {
+            iferr {
+                call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+                    SZ_LINE)
+            } then {
+                FC_RODEG(fc) = 180.0d0 / DPI
+            } else {
+                i = 1
+                if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                    FC_RODEG(fc) = 180.0d0 / DPI
+            }
+        } else {
+            i = 1
+            if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+                FC_RODEG(fc) = 180.0d0 / DPI
+        }
+
+        # Compute the native longitude of the celestial pole.
+        dec = DDEGTORAD(FC_W(fc,FC_IDEC(fc)))
+        theta0 = 0.0d0
+        if (IS_INDEFD(FC_LONGP(fc))) {
+            if (dec < theta0)
+                FC_LONGP(fc) = DPI
+            else
+                FC_LONGP(fc) = 0.0d0
+        } else
+            FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+        # Compute the celestial longitude and latitude of the native pole.
+        clat0 = cos (dec)
+        slat0 = sin (dec)
+        cphip = cos (FC_LONGP(fc))
+        sphip = sin (FC_LONGP(fc))
+        cthe0 = cos (theta0)
+        sthe0 = sin (theta0)
+
+        x = cthe0 * cphip
+        y = sthe0
+        z = sqrt (x * x + y * y)
+
+        # The latitude of the native pole is determined by LATPOLE in this
+        # case.
+        if (z == 0.0d0) {
+
+            if (slat0 != 0.0d0)
+                call error (0, "WF_TSC_INIT: Invalid projection parameters")
+            if (IS_INDEFD(latpole))
+                latp = 999.0d0
+            else
+                latp = DDEGTORAD(latpole)
+
+        } else {
+            if (abs (slat0 / z) > 1.0d0)
+                call error (0, "WF_TSC_INIT: Invalid projection parameters")
+
+            u = atan2 (y, x)
+            v = acos (slat0 / z)
+            latp1 = u + v
+            if (latp1 > DPI)
+                latp1 = latp1 - DTWOPI
+            else if (latp1 < -DPI)
+                latp1 = latp1 + DTWOPI
+
+            latp2 = u - v
+            if (latp2 > DPI)
+                latp2 = latp2 - DTWOPI
+            else if (latp2 < -DPI)
+                latp2 = latp2 + DTWOPI
+
+            if (IS_INDEFD(latpole))
+                maxlat = 999.0d0
+            else
+                maxlat = DDEGTORAD(latpole)
+            if (abs (maxlat - latp1) < abs (maxlat - latp2)) {
+                if (abs (latp1) < (DHALFPI + tol))
+                    latp = latp1
+                else
+                    latp = latp2
+            } else {
+                if (abs (latp2) < (DHALFPI + tol))
+                    latp = latp2
+                else
+                    latp = latp1
+            }
+        }
+        FC_NATDEC(fc) = DHALFPI - latp
+
+        z = cos (latp) * clat0
+        if (abs(z) < tol) {
+
+            # Celestial pole at the reference point.
+            if (abs(clat0) < tol) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc)))
+                FC_NATDEC(fc) = DHALFPI - theta0
+            # Celestial pole at the native north pole.
+            } else if (latp > 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) + FC_LONGP(fc) -
+                    DPI
+                FC_NATDEC(fc) = 0.0d0
+            # Celestial pole at the native south pole.
+            } else if (latp < 0.0d0) {
+                FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - FC_LONGP(fc)
+                FC_NATDEC(fc) = DPI
+            }
+
+        } else {
+            x = (sthe0 - sin (latp) * slat0) / z
+            y = sphip * cthe0 / clat0
+            if (x == 0.0d0 && y == 0.0d0)
+                call error (0, "WF_TSC_INIT: Invalid projection parameters")
+            FC_NATRA(fc) = DDEGTORAD(FC_W(fc,FC_IRA(fc))) - atan2 (y,x)
+        }
+
+        if (FC_W(fc,FC_IRA(fc)) >= 0.0d0) {
+            if (FC_NATRA(fc) < 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) + DTWOPI
+        } else {
+            if (FC_NATRA(fc) > 0.0d0)
+                FC_NATRA(fc) = FC_NATRA(fc) - DTWOPI
+        }
+        FC_COSDEC(fc) = cos (FC_NATDEC(fc))
+        FC_SINDEC(fc) = sin (FC_NATDEC(fc))
+
+        # Check for ill-conditioned parameters.
+        if (abs(latp) > (DHALFPI+tol))
+            call error (0, "WF_TSC_INIT: Invalid projection parameters")
+
+	# Compute the required intermediate quantities.
+	FC_C1(fc) = FC_RODEG(fc) * (DPI / 4.0d0)
+	FC_C2(fc) = 1.0d0 / FC_C1(fc)
+
+        # Set the bad coordinate value.
+        FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_TSC_FWD -- Forward transform (physical to world) for the tangential
+# spherical projection.
+
+procedure wf_tsc_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, face
+double	l, m, n, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, x, y, z
+double	xf, yf, ra, dec, dlng
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	xf = p[ira] * FC_C2(fc)
+	yf = p[idec] * FC_C2(fc)
+	if (xf > 5.0d0) {
+	    face = 4
+	    xf = xf - 6.0d0
+	    l = -1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    m = -l * xf
+	    n = -l * yf
+	} else if (xf > 3.0d0) {
+	    face = 3
+	    xf = xf - 4.0d0
+	    m = -1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    l = m * xf
+	    n = -m * yf
+	} else if (xf > 1.0d0) {
+	    face = 2
+	    xf = xf - 2.0d0
+	    l = 1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    m = -l * xf
+	    n = l * yf
+	} else if (yf > 1.0d0) {
+	    face = 0
+	    yf = yf - 2.0d0
+	    n = 1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    l = n * xf
+	    m = -n * yf
+	} else if (yf < -1.0d0) {
+	    face = 5
+	    yf = yf + 2.0d0
+	    n = -1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    l = -n * xf
+	    m = -n * yf
+	} else {
+	    face = 1
+	    m = 1.0d0 / sqrt (1.0d0 + xf * xf + yf * yf)
+	    l = m * xf
+	    n = m * yf
+	}
+
+	# Compute PHI.
+	if (l == 0.0d0 && m == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (l, m)
+
+	# Compute THETA.
+	theta = asin(n)
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+	x = sinthe * FC_SINDEC(fc) - costhe * FC_COSDEC(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_NATDEC(fc)) + costhe * FC_COSDEC(fc) *
+                (1.0d0 - cosphi)
+	y = -costhe * sinphi
+	if (x != 0.0d0 || y != 0.0d0) {
+	    dlng = atan2 (y, x)
+	} else {
+	    dlng = dphi + DPI
+	}
+	ra = DRADTODEG(FC_NATRA(fc) + dlng)
+
+	# Normalize the RA.
+        if (FC_NATRA(fc) >= 0.0d0) {
+            if (ra < 0.0d0)
+                ra = ra + 360.0d0
+        } else {
+            if (ra > 0.0d0)
+                ra = ra - 360.0d0
+        }
+	if (ra > 360.0d0)
+	    ra = ra - 360.0d0
+	else if (ra < -360.0d0)
+	    ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_NATDEC(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSDEC(fc) + costhe * FC_SINDEC(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_TSC_INV -- Inverse transform (world to physical) for the tangential
+# spherical projection.
+
+procedure wf_tsc_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, face
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, z, dphi, phi, theta
+double	costhe, l, m, n, rho, tol, x0, y0, xf, yf
+data	tol /1.0d-12/
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira]) - FC_NATRA(fc)
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+	x = sindec * FC_SINDEC(fc) - cosdec * FC_COSDEC(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_NATDEC(fc)) + cosdec * FC_COSDEC(fc) *
+                (1.0d0 - cosra)
+	y = -cosdec * sinra
+	if (x != 0.0d0 || y != 0.0d0)
+	    dphi = atan2 (y, x)
+	else
+	    dphi = ra - DPI
+	phi = FC_LONGP(fc) + dphi
+	if (phi > DPI)
+	    phi = phi - DTWOPI
+	else if (phi < -DPI)
+	    phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) == 0.0) {
+            theta = dec + cosra * FC_NATDEC(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSDEC(fc) + cosdec * FC_SINDEC(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	costhe = cos (theta)
+	l = costhe * sin (phi)
+	m = costhe * cos (phi)
+	n = sin (theta)
+
+	face = 0
+	rho = n
+	if (m > rho) {
+	    face = 1 
+	    rho = m
+	}
+	if (l > rho) {
+	    face = 2
+	    rho = l
+	}
+	if (-m > rho) {
+	    face = 3
+	    rho = -m
+	}
+	if (-l > rho) {
+	    face = 4
+	    rho = -l
+	}
+	if (-n > rho) {
+	    face = 5
+	    rho = -n
+	}
+
+	switch (face) {
+	case 0:
+	    xf = l / rho
+	    yf = -m / rho
+	    x0 = 0.0d0
+	    y0 = 2.0d0
+	case 1:
+	    xf = l / rho
+	    yf = n / rho
+	    x0 = 0.0d0
+	    y0 = 0.0d0
+	case 2:
+	    xf = -m / rho
+	    yf = n / rho
+	    x0 = 2.0d0
+	    y0 = 0.0d0
+	case 3:
+	    xf = -l / rho
+	    yf = n / rho
+	    x0 = 4.0d0
+	    y0 = 0.0d0
+	case 4:
+	    xf = m / rho
+	    yf = n / rho
+	    x0 = 6.0d0
+	    y0 = 0.0d0
+	case 5:
+	    xf = l / rho
+	    yf = m / rho
+	    x0 = 0.0d0
+	    y0 = -2.0d0
+	}
+
+	if (abs(xf) > 1.0d0) {
+	    if (abs(xf) > (1.0d0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (xf >= 0.0d0)
+		xf = 1.0d0
+	    else
+		xf = -1.0d0
+	}
+	if (abs(yf) > 1.0d0) {
+	    if (abs(yf) > (1.0d0 + tol)) {
+		p[ira] = FC_BADCVAL(fc)
+		p[idec] = FC_BADCVAL(fc)
+		return
+	    }
+	    if (yf >= 0.0d0)
+		yf = 1.0d0
+	    else
+		yf = -1.0d0
+	}
+
+	p[ira] = FC_C1(fc) * (x0 + xf)
+	p[idec] = FC_C1(fc) * (y0 + yf)
+end
diff --git a/sys/mwcs/wfzea.x b/sys/mwcs/wfzea.x
new file mode 100644
index 00000000..f25640aa
--- /dev/null
+++ b/sys/mwcs/wfzea.x
@@ -0,0 +1,324 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFZEA
+.nf -------------------------------------------------------------------------
+WFZEA -- WCS function driver for the zenithal equal area projection.
+
+Driver routines:
+
+	FN_INIT		    wf_zea_init (fc, dir)
+	FN_DESTROY			(none)
+	FN_FWD		     wf_zea_fwd (fc, v1, v2)
+	FN_INV		     wf_zea_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+# Driver specific fields of function call (FC) descriptor.
+define	FC_IRA		Memi[$1+FCU]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+1]			# DEC axis (1 or 2)
+define	FC_LONGP	Memd[P2D($1+FCU+2)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+4)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+6)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+8)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+10)]		# trig tolerance
+define	FC_RODEG	Memd[P2D($1+FCU+12)]		# RO (degs)
+define	FC_2RODEG	Memd[P2D($1+FCU+14)]		# 2 * RO (degs)
+define	FC_REC2RODEG	Memd[P2D($1+FCU+16)]		# 1 / 2 * RO (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+18)]		# bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+20)+($2)-1] 	# CRVAL (axis 1 and 2)
+
+
+# WF_ZEA_INIT -- Initialize the zenithal equal area forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, computing the celestial
+# longitude and colatitude of the native pole, reading in the the native
+# longitude of the pole of the celestial coordinate system LONGPOLE from the
+# attribute list, precomputing the Euler angles and intermediary functions
+# of the reference point, and reading in the projection parameter RO from the
+# attribute list. If LONGPOLE is undefined then a value of 180.0 degrees is
+# assumed. If RO is undefined a value of 180.0 / PI is assumed. In order to
+# determine the axis order, the parameter "axtype={ra|dec}{xlon|xlat}" must
+# have been set in the attribute list for the function. The LONGPOLE and RO
+# parameters may be set in either or both of the axes attribute lists, but
+# the value in the RA axis attribute list takes precedence. 
+
+procedure wf_zea_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i
+double	dec
+pointer	sp, atvalue, ct, mw, wp, wv
+int	ctod()
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = 180.0d0
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = 180.0d0
+		if (IS_INDEFD(FC_LONGP(fc)))
+		    FC_LONGP(fc) = 180.0d0
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = 180.0d0
+	    if (IS_INDEFD(FC_LONGP(fc)))
+		FC_LONGP(fc) = 180.0d0
+	}
+	FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+	FC_2RODEG(fc) = 2.0d0 * FC_RODEG(fc)
+	FC_REC2RODEG(fc) = 1.0d0 / FC_2RODEG(fc)
+
+	# Set the bad coordinate value.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+end
+
+
+# WF_ZEA_FWD -- Forward transform (physical to world) for the zenithal
+# equal area projection.
+
+procedure wf_zea_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec
+double	x, y, r, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, ra, dec, tol
+double	dlng, z
+data	tol /1.0d-12/
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	x = p[ira]
+	y = p[idec]
+	r = sqrt (x * x + y * y)
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	if (abs (r - FC_2RODEG(fc)) < tol)
+	    theta = -DHALFPI
+	else
+	    theta = DHALFPI - 2.0d0 * asin (r * FC_REC2RODEG(fc))
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize the RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_ZEA_INV -- Inverse transform (world to physical) for the zenithal
+# equal area projection.
+
+procedure wf_zea_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, r, dphi, z
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) ==0.0) {
+            theta = dec + cosra * FC_COLATP(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	r = FC_2RODEG(fc) * sin ((DHALFPI - theta) / 2.0d0)
+	p[ira]  = r * sin (phi)
+	p[idec] = -r * cos (phi)
+end
diff --git a/sys/mwcs/wfzpn.x b/sys/mwcs/wfzpn.x
new file mode 100644
index 00000000..6c8db38a
--- /dev/null
+++ b/sys/mwcs/wfzpn.x
@@ -0,0 +1,600 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include <ctype.h>
+include "imwcs.h"
+include	"mwcs.h"
+
+.help WFZPN
+.nf -------------------------------------------------------------------------
+# WFZPN -- WCS function driver for the zenithal / azimuthal polynomial 
+# projection.
+
+Driver routines:
+
+	FN_INIT		    wf_zpn_init (fc, dir)
+	FN_DESTROY	 wf_zpn_destroy (fc)
+	FN_FWD		     wf_zpn_fwd (fc, v1, v2)
+	FN_INV		     wf_zpn_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+define  MAX_NITER       20
+
+# Driver specific fields of function call (FC) descriptor.
+define  FC_LNGCOR       Memi[$1+FCU]                    # RA axis correction
+define  FC_LATCOR       Memi[$1+FCU+1]                  # DEC axis correction
+define	FC_IRA		Memi[$1+FCU+2]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+3]			# DEC axis (1 or 2)
+define	FC_NP		Memd[P2D($1+FCU+4)]		# poly order (0-9)
+define	FC_LONGP	Memd[P2D($1+FCU+6)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+8)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+10)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+12)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+14)]		# trig tolerance
+define	FC_PC		Memd[P2D($1+FCU+16)+($2)]	# poly coefficients (9)
+define	FC_RODEG	Memd[P2D($1+FCU+36)]		# RO (degs)
+define	FC_ZD		Memd[P2D($1+FCU+38)]		# colat of FIP (degs)
+define	FC_R		Memd[P2D($1+FCU+40)]		# radius of FIP (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+42)]		# Bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+44)+($2)-1]	# CRVAL (axis 1 and 2)
+
+
+# WF_ZPN_INIT -- Initialize the zenithal/azimuthal polynomial forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, computing the celestial
+# longitude and colatitude of the native pole, reading in the the native
+# longitude of the pole of the celestial coordinate system LONGPOLE from the
+# attribute list, precomputing the Euler angles and various intermediary
+# functions of the reference coordinates, reading in the projection parameter
+# RO from the attribute list, reading in up to ten polynomial coefficients,
+# and, for polynomial orders greater than 2 computing the colatitude and radius
+# of the  first point of inflection. If LONGPOLE is undefined then a value of
+# 180.0 degrees is assumed. If RO is undefined a value of 180.0 / PI is
+# assumed. If the polynomial coefficients are all zero then an error condition
+# is posted. If the order of the polynomial is 2 or greater and there is no
+# point of inflection an error condition is posted. The ZPN projection with
+# an order of 1 and 0th and 1st coefficients of 0.0 and 1.0 respectively is
+# equivalent to the ARC projtection. In order to determine the axis order,
+# the parameter "axtype={ra|dec} {xlon|xlat}" must have been set in the
+# attribute list for the function. The LONGPOLE and RO parameters may be set
+# in either or both of the axes attribute lists, but the value in the RA axis
+# attribute list takes precedence. 
+
+procedure wf_zpn_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i, j, np, szatstr, maxorder, ualen, index, ip
+double	dec, zd1, d1, zd2, d2, zd, d, r, tol, dval
+pointer	sp, atname, atvalue, ct, mw, wp, wv, im, idb, rp
+char    compare[4]
+bool    match
+int	ctod(), strlen(), idb_nextcard(), itoc()
+pointer	wf_gsopen(), idb_open()
+data	tol/1.0d-13/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atname, SZ_ATNAME, TY_CHAR)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+	im = MI_REFIM(mw)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	FC_LONGP(fc) = DDEGTORAD(180.0d0)
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	FC_RODEG(fc) = 180.0d0/DPI
+        szatstr = SZ_LINE
+
+	# Fetch the longitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+        FC_LNGCOR(fc) = NULL
+
+	# Fetch the latitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+        FC_LATCOR(fc) = NULL
+
+        # Read through the fits header once more and pick up the PV matrix
+        # cards.  Read the values and store them, keeping track of what is
+        # the highest order coefficient. With this projection only the dec
+	# axis coefficients matter. Technically we can have up to 99 
+	# coefficients. But we restrict this to 10 for the moment.
+
+        maxorder = -1
+	idb = idb_open(im,ualen)
+	compare[1] = 'P'
+        compare[2] = 'V'
+        i = itoc(FC_IDEC(fc),compare[3],1)
+	compare[4] = '_'
+	while (idb_nextcard(idb,rp) != EOF) {
+            match = true
+	    do i = 0,3 {
+	        if (Memc[rp+i] != compare[i+1]) {
+		    match = false
+		    break;
+                }
+            }
+            if (! match) 
+		next
+            if (! IS_DIGIT(Memc[rp+4]))
+                next
+            index = TO_INTEG(Memc[rp+4])
+            do i = 5,7 {
+                if (! IS_DIGIT(Memc[rp+i]))
+		    break
+		else
+		    index = 10*index + TO_INTEG(Memc[rp+i])
+            }
+	    if (index > 9)
+	        next
+            ip = IDB_STARTVALUE
+            if (ctod(Memc[rp],ip,dval) <= 0) 
+	        dval = 0.0d0
+	    if (index > maxorder)
+	        maxorder = index
+	    FC_PC(fc,index) = dval
+        }
+	call idb_close(idb)
+
+	# If all the coefficients are 0.0 the polynomial is undefined.
+	if (maxorder < 0) {
+	    call sfree (sp)
+	    call error (0, "WFT_ZPN_INIT: The polynomial is undefined")
+	}
+
+	# Determine the number of coefficients.
+	FC_NP(fc) = double(maxorder)
+	np = maxorder
+
+	if (np >= 3) {
+	    # Find the point of inflection closest to the pole.
+	    zd1 = 0.0d0
+	    d1 = FC_PC(fc,1)
+	    if (d1 <= 0.0d0) {
+		call sfree (sp)
+	        call error (0,
+		    "WFT_ZPN_INIT: The point of inflection does not exist")
+	    }
+
+	    # Find the point where the derivative first goes negative.
+	    do i = 1, 180 {
+		zd2 = DPI * double (i) / 180.0d0
+		d2 = 0.0d0
+		do j = np, 1, -1
+		    d2 = d2 * zd2 + j * FC_PC(fc,j)
+		if (d2 <= 0.0d0)
+		    break
+		zd1 = zd2
+		d1 = d2
+	    }
+
+	    # Find where the derivative is 0.
+	    if (d2 <= 0.0d0) {
+		do i = 1, 10 {
+		    zd = zd1 - d1 * (zd2 - zd1) / (d2 - d1)
+		    d = 0.0d0
+		    do j = np, 1, -1
+			d = d * zd + j * FC_PC(fc,j)
+		    if (abs(d) < tol)
+			break
+		    if (d < 0.0d0) {
+			zd2 = zd
+			d2 = d
+		    } else {
+			zd1 = zd
+			d1 = d
+		    }
+		}
+
+	    # No negative derivative.
+	    } else
+		zd = DPI
+
+	    r = 0.0d0
+	    do j = np, 0, -1
+		r = r * zd + FC_PC(fc,j)
+	    FC_ZD(fc) = zd
+	    FC_R(fc) = r
+	}
+
+	# Set the spherical trigonometric tolerance.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+
+end
+
+
+# WF_ZPN_FWD -- Forward transform (physical to world) for the zenithal /
+# azimuthal polynomial projection.
+
+procedure wf_zpn_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, i, j, k
+double	x, y, r, zd, a, b, c, d, zd1, zd2, r1, r2, lambda, rt, tol
+double	phi, theta, costhe, sinthe, dphi, cosphi, sinphi,  ra, dec, dlng, z
+double	wf_gseval()
+data	tol/1.0d-13/
+
+define	phitheta_	11
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	k = nint (FC_NP(fc))
+        if (FC_LNGCOR(fc) == NULL)
+            x = p[ira]
+        else
+            x = p[ira] + wf_gseval (FC_LNGCOR(fc), p[ira], p[idec])
+        if (FC_LATCOR(fc) == NULL)
+            y = p[idec]
+        else
+            y = p[idec] + wf_gseval (FC_LATCOR(fc), p[ira], p[idec])
+	r = sqrt (x * x + y * y) / FC_RODEG(fc)
+
+	# Solve.
+
+	# Constant no solution
+	if (k < 1) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+
+	# Linear.
+	} else if (k == 1) {
+	    zd = (r - FC_PC(fc,0)) / FC_PC(fc,1)
+
+	# Quadratic.
+	} else if (k == 2) {
+
+	    a = FC_PC(fc,2) 
+	    b = FC_PC(fc,1) 
+	    c = FC_PC(fc,0) - r 
+	    d = b * b - 4.0d0 * a * c
+	    if (d < 0.0d0) {
+	        w[ira] = FC_BADCVAL(fc)
+	        w[idec] = FC_BADCVAL(fc)
+	        return
+	    }
+	    d = sqrt (d)
+
+	    # Choose solution closet to the pole.
+	    zd1 = (-b + d) / (2.0d0 * a)
+	    zd2 = (-b - d) / (2.0d0 * a)
+	    zd = min (zd1, zd2)
+	    if (zd < -tol)
+		zd = max (zd1, zd2)
+	    if (zd < 0.0d0) {
+		if (zd < -tol) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = 0.0d0
+	    } else if (zd > DPI) {
+		if (zd > (DPI + tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = DPI
+	    }
+
+	# Higher order solve iteratively.
+	} else {
+
+	    zd1 = 0.0d0
+	    r1 = FC_PC(fc,0)
+	    zd2 = FC_ZD(fc)
+	    r2 = FC_R(fc)
+
+	    if (r < r1) {
+		if (r < (r1 - tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = zd1
+		goto phitheta_
+	    } else if (r > r2) {
+		if (r > (r2 + tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = zd2
+		goto phitheta_
+	    } else {
+		do j = 1, 100 {
+		    lambda = (r2 - r) / (r2 - r1)
+		    if (lambda < 0.1d0)
+			lambda = 0.1d0
+		    else if (lambda > 0.9d0)
+			lambda = 0.9d0
+		    zd = zd2 - lambda * (zd2 - zd1)
+		    rt = 0.0d0
+		    do i = k, 0, -1
+			rt = (rt * zd) + FC_PC(fc,i)
+		    if (rt < r) {
+			if ((r - rt) < tol)
+			    goto phitheta_
+			r1 = rt
+			zd1 = zd
+		    } else {
+			if ((rt - r) < tol)
+			    goto phitheta_
+			r2 = rt
+			zd2 = zd
+		    }
+		    if (abs(zd2 - zd1) < tol)
+			goto phitheta_
+		}
+	    }
+
+	}
+
+phitheta_
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	theta = DHALFPI - zd
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize the RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_ZPN_INV -- Inverse transform (world to physical) for the zenithal /
+# azimuthal polynomial projection.
+
+procedure wf_zpn_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, i, niter
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, r, dphi, z
+double	xm, ym, f, fx, fy, g, gx, gy, denom, dx, dy
+double	wf_gseval(), wf_gsder()
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) ==0.0) {
+            theta = dec + cosra * FC_COLATP(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = DHALFPI - theta
+	r = 0.0d0
+	do i = 9, 0, -1
+	    r = r * s + FC_PC(fc,i)
+	r = FC_RODEG(fc) * r
+
+        if (FC_LNGCOR(fc) == NULL && FC_LATCOR(fc) == NULL) {
+	    p[ira]  = r * sin (phi)
+	    p[idec] = -r * cos (phi)
+
+	} else {
+            xm  = r * sin (phi)
+            ym = -r * cos (phi)
+            x = xm
+            y = ym
+            niter = 0
+
+            repeat {
+                if (FC_LNGCOR(fc) != NULL) {
+                    f = x + wf_gseval (FC_LNGCOR(fc), x, y) - xm
+                    fx = wf_gsder (FC_LNGCOR(fc), x, y, 1, 0)
+                    fx = 1.0 + fx
+                    fy = wf_gsder (FC_LNGCOR(fc), x, y, 0, 1)
+                } else {
+                    f = x - xm
+                    fx = 1.0
+                    fy = 0.0
+                }
+                if (FC_LATCOR(fc) != NULL) {
+                    g = y + wf_gseval (FC_LATCOR(fc), x, y) - ym
+                    gx = wf_gsder (FC_LATCOR(fc), x, y, 1, 0)
+                    gy = wf_gsder (FC_LATCOR(fc), x, y, 0, 1)
+                    gy = 1.0 + gy
+                } else {
+                    g = y - ym
+                    gx = 0.0
+                    gy = 1.0
+                }
+                denom = fx * gy - fy * gx
+                if (denom == 0.0d0)
+                    break
+                dx = (-f * gy + g * fy) / denom
+                dy = (-g * fx + f * gx) / denom
+                x = x + max (-1.0D0, min (1.0D0, dx))
+                y = y + max (-1.0D0, min (1.0D0, dy))
+                if (max (abs (dx), abs (dy), abs(f), abs(g)) < 2.80d-7)
+                    break
+
+                niter = niter + 1
+
+            } until (niter >= MAX_NITER)
+
+            p[ira]  = x
+            p[idec] = y
+	}
+end
+
+
+# WF_ZPN_DESTROY -- Free up the distortion surface pointers.
+
+procedure wf_zpn_destroy (fc)
+
+pointer fc                      #I pointer to the FC descriptor
+
+begin
+        if (FC_LNGCOR(fc) != NULL)
+            call wf_gsclose (FC_LNGCOR(fc))
+        if (FC_LATCOR(fc) != NULL)
+            call wf_gsclose (FC_LATCOR(fc))
+end
diff --git a/sys/mwcs/wfzpx.x b/sys/mwcs/wfzpx.x
new file mode 100644
index 00000000..c5eced4a
--- /dev/null
+++ b/sys/mwcs/wfzpx.x
@@ -0,0 +1,654 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+include	"mwcs.h"
+
+.help WFZPX
+.nf -------------------------------------------------------------------------
+# WFZPX -- WCS function driver for the zenithal / azimuthal polynomial 
+# projection.
+
+Driver routines:
+
+	FN_INIT		    wf_zpx_init (fc, dir)
+	FN_DESTROY	 wf_zpx_destroy (fc)
+	FN_FWD		     wf_zpx_fwd (fc, v1, v2)
+	FN_INV		     wf_zpx_inv (fc, v1, v2)
+
+.endhelp --------------------------------------------------------------------
+
+define  MAX_NITER       20
+
+# Driver specific fields of function call (FC) descriptor.
+define  FC_LNGCOR       Memi[$1+FCU]                    # RA axis correction
+define  FC_LATCOR       Memi[$1+FCU+1]                  # DEC axis correction
+define	FC_IRA		Memi[$1+FCU+2]			# RA axis (1 or 2)
+define	FC_IDEC		Memi[$1+FCU+3]			# DEC axis (1 or 2)
+define	FC_NP		Memd[P2D($1+FCU+4)]		# poly order (0-9)
+define	FC_LONGP	Memd[P2D($1+FCU+6)]		# LONGPOLE (rads)
+define	FC_COLATP	Memd[P2D($1+FCU+8)]		# (90 - DEC) (rads)
+define	FC_COSLATP	Memd[P2D($1+FCU+10)]		# cosine (90 - DEC)
+define	FC_SINLATP	Memd[P2D($1+FCU+12)]		# sine (90 - DEC)
+define	FC_SPHTOL	Memd[P2D($1+FCU+14)]		# trig tolerance
+define	FC_PC		Memd[P2D($1+FCU+16)+($2)]	# poly coefficients (9)
+define	FC_RODEG	Memd[P2D($1+FCU+36)]		# RO (degs)
+define	FC_ZD		Memd[P2D($1+FCU+38)]		# colat of FIP (degs)
+define	FC_R		Memd[P2D($1+FCU+40)]		# radius of FIP (degs)
+define	FC_BADCVAL	Memd[P2D($1+FCU+42)]		# Bad coordinate value
+define	FC_W		Memd[P2D($1+FCU+44)+($2)-1]	# CRVAL (axis 1 and 2)
+
+
+# WF_ZPX_INIT -- Initialize the zenithal/azimuthal polynomial forward or inverse
+# transform. Initialization for this transformation consists of, determining
+# which axis is RA / LON and which is DEC / LAT, computing the celestial
+# longitude and colatitude of the native pole, reading in the the native
+# longitude of the pole of the celestial coordinate system LONGPOLE from the
+# attribute list, precomputing the Euler angles and various intermediary
+# functions of the reference coordinates, reading in the projection parameter
+# RO from the attribute list, reading in up to ten polynomial coefficients,
+# and, for polynomial orders greater than 2 computing the colatitude and radius
+# of the  first point of inflection. If LONGPOLE is undefined then a value of
+# 180.0 degrees is assumed. If RO is undefined a value of 180.0 / PI is
+# assumed. If the polynomial coefficients are all zero then an error condition
+# is posted. If the order of the polynomial is 2 or greater and there is no
+# point of inflection an error condition is posted. The ZPX projection with
+# an order of 1 and 0th and 1st coefficients of 0.0 and 1.0 respectively is
+# equivalent to the ARC projtection. In order to determine the axis order,
+# the parameter "axtype={ra|dec} {xlon|xlat}" must have been set in the
+# attribute list for the function. The LONGPOLE and RO parameters may be set
+# in either or both of the axes attribute lists, but the value in the RA axis
+# attribute list takes precedence. 
+
+procedure wf_zpx_init (fc, dir)
+
+pointer	fc			#I pointer to FC descriptor
+int	dir			#I direction of transform
+
+int	i, j, np, szatstr
+double	dec, zd1, d1, zd2, d2, zd, d, r, tol
+pointer	sp, atname, atvalue, ct, mw, wp, wv
+int	ctod(), strlen()
+pointer	wf_gsopen()
+data	tol/1.0d-13/
+errchk	wf_decaxis(), mw_gwattrs()
+
+begin
+	# Allocate space for the attribute string.
+	call smark (sp)
+	call salloc (atname, SZ_ATNAME, TY_CHAR)
+	call salloc (atvalue, SZ_LINE, TY_CHAR)
+
+	# Get the required mwcs pointers.
+	ct = FC_CT(fc)
+	mw = CT_MW(ct)
+	wp = FC_WCS(fc)
+
+	# Determine which is the DEC axis, and hence the axis order.
+	call wf_decaxis (fc, FC_IRA(fc), FC_IDEC(fc))
+
+	# Get the value of W for each axis, i.e. the world coordinates at
+	# the reference point.
+
+	wv = MI_DBUF(mw) + WCS_W(wp) - 1
+	do i = 1, 2
+	    FC_W(fc,i) = Memd[wv+CT_AXIS(ct,FC_AXIS(fc,i))-1]
+
+	# Get the celestial coordinates of the native pole which are in
+	# this case the ra and 90 - dec of the reference point.
+
+	dec = DDEGTORAD(90.0d0 - FC_W(fc,FC_IDEC(fc)))
+
+	# Determine the native longitude of the pole of the celestial
+	# coordinate system corresponding to the FITS keyword LONGPOLE.
+	# This number has no default and should normally be set to 180
+	# degrees. Search both axes for this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "longpole", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "longpole", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_LONGP(fc) = 180.0d0
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		    FC_LONGP(fc) = 180.0d0
+		if (IS_INDEFD(FC_LONGP(fc)))
+		    FC_LONGP(fc) = 180.0d0
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_LONGP(fc)) <= 0)
+		FC_LONGP(fc) = 180.0d0
+	    if (IS_INDEFD(FC_LONGP(fc)))
+	        FC_LONGP(fc) = 180.0d0
+	}
+	FC_LONGP(fc) = DDEGTORAD(FC_LONGP(fc))
+
+	# Precompute the trigomometric functions used by the spherical geometry
+	# code to improve efficiency.
+
+	FC_COLATP(fc) = dec
+	FC_COSLATP(fc) = cos(dec)
+	FC_SINLATP(fc) = sin(dec)
+
+	# Fetch the RO projection parameter which is the radius of the
+	# generating sphere for the projection. If RO is absent which
+	# is the usual case set it to 180 / PI. Search both axes for
+	# this quantity.
+
+	iferr {
+	    call mw_gwattrs (mw, FC_IRA(fc), "ro", Memc[atvalue], SZ_LINE)
+	} then {
+	    iferr {
+	        call mw_gwattrs (mw, FC_IDEC(fc), "ro", Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+		FC_RODEG(fc) = 180.0d0 / DPI
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		    FC_RODEG(fc) = 180.0d0 / DPI
+	    }
+	} else {
+	    i = 1
+	    if (ctod (Memc[atvalue], i, FC_RODEG(fc)) <= 0)
+		FC_RODEG(fc) = 180.0d0 / DPI
+	}
+
+        szatstr = SZ_LINE
+
+	# Fetch the longitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+        iferr {
+            repeat {
+                call mw_gwattrs (mw, FC_IRA(fc), "lngcor", Memc[atvalue],
+                    szatstr)
+                if (strlen (Memc[atvalue]) < szatstr)
+                    break
+                szatstr = szatstr + SZ_LINE
+                call realloc (atvalue, szatstr, TY_CHAR)
+
+            }
+        } then {
+            FC_LNGCOR(fc) = NULL
+        } else {
+            FC_LNGCOR(fc) = wf_gsopen (Memc[atvalue])
+        }
+
+	# Fetch the latitude correction surface. Note that the attribute
+	# string may be of any length so the length of atvalue may have
+	# to be adjusted.
+
+        iferr {
+            repeat {
+                call mw_gwattrs (mw, FC_IDEC(fc), "latcor", Memc[atvalue],
+                    szatstr)
+                if (strlen (Memc[atvalue]) < szatstr)
+                    break
+                szatstr = szatstr + SZ_LINE
+                call realloc (atvalue, szatstr, TY_CHAR)
+            }
+        } then {
+            FC_LATCOR(fc) = NULL
+        } else {
+            FC_LATCOR(fc) = wf_gsopen (Memc[atvalue])
+        }
+
+	# Fetch the projection coefficients
+	do j = 0, 9 {
+	    call sprintf (Memc[atname], SZ_ATNAME, "projp%d")
+		call pargi (j)
+	    iferr {
+	        call mw_gwattrs (mw, FC_IRA(fc), Memc[atname], Memc[atvalue],
+		    SZ_LINE)
+	    } then {
+	        iferr {
+	            call mw_gwattrs (mw, FC_IDEC(fc), Memc[atname],
+		        Memc[atvalue], SZ_LINE)
+	        } then {
+		    FC_PC(fc,j) = 0.0d0
+	        } else {
+	            i = 1
+	            if (ctod (Memc[atvalue], i, FC_PC(fc,j)) <= 0)
+		        FC_PC(fc,j) = 0.0d0
+	        }
+	    } else {
+	        i = 1
+	        if (ctod (Memc[atvalue], i, FC_PC(fc,j)) <= 0)
+		    FC_PC(fc,j) = 0.0d0
+	    }
+	}
+
+	# Determine the order of the polynomial by finding the first
+	# non-zero coefficient.
+
+	do j = 9, 0, -1 {
+	    if (FC_PC(fc,j) != 0.0d0)
+		break
+	}
+
+	# If all the coefficients are 0.0 the polynomial is undefined.
+	if (j < 0) {
+	    call sfree (sp)
+	    call error (0, "WFT_ZPX_INIT: The polynomial is undefined")
+	}
+
+	# Determine the number of coefficients.
+	FC_NP(fc) = double (j)
+	np = j
+
+	if (np >= 3) {
+	    # Find the point of inflection closest to the pole.
+	    zd1 = 0.0d0
+	    d1 = FC_PC(fc,1)
+	    if (d1 <= 0.0d0) {
+		call sfree (sp)
+	        call error (0,
+		    "WFT_ZPX_INIT: The point of inflection does not exist")
+	    }
+
+	    # Find the point where the derivative first goes negative.
+	    do i = 1, 180 {
+		zd2 = DPI * double (i) / 180.0d0
+		d2 = 0.0d0
+		do j = np, 1, -1
+		    d2 = d2 * zd2 + j * FC_PC(fc,j)
+		if (d2 <= 0.0d0)
+		    break
+		zd1 = zd2
+		d1 = d2
+	    }
+
+	    # Find where the derivative is 0.
+	    if (d2 <= 0.0d0) {
+		do i = 1, 10 {
+		    zd = zd1 - d1 * (zd2 - zd1) / (d2 - d1)
+		    d = 0.0d0
+		    do j = np, 1, -1
+			d = d * zd + j * FC_PC(fc,j)
+		    if (abs(d) < tol)
+			break
+		    if (d < 0.0d0) {
+			zd2 = zd
+			d2 = d
+		    } else {
+			zd1 = zd
+			d1 = d
+		    }
+		}
+
+	    # No negative derivative.
+	    } else
+		zd = DPI
+
+	    r = 0.0d0
+	    do j = np, 0, -1
+		r = r * zd + FC_PC(fc,j)
+	    FC_ZD(fc) = zd
+	    FC_R(fc) = r
+	}
+
+	# Set the spherical trigonometric tolerance.
+	FC_SPHTOL(fc) = 1.0d-5
+
+	# Set the bad coordinate value.
+	FC_BADCVAL(fc) = INDEFD
+
+	# Free working space.
+	call sfree (sp)
+
+end
+
+
+# WF_ZPX_FWD -- Forward transform (physical to world) for the zenithal /
+# azimuthal polynomial projection.
+
+procedure wf_zpx_fwd (fc, p, w)
+
+pointer	fc			#I pointer to FC descriptor
+double	p[2]			#I physical coordinates (x, y)
+double	w[2]			#O world coordinates (ra, dec)
+
+int	ira, idec, i, j, k
+double	x, y, r, zd, a, b, c, d, zd1, zd2, r1, r2, lambda, rt, tol
+double	phi, theta, costhe, sinthe, dphi, cosphi, sinphi,  ra, dec, dlng, z
+double	wf_gseval()
+data	tol/1.0d-13/
+
+define	phitheta_	11
+
+begin
+	# Get the axis numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute native spherical coordinates PHI and THETA in degrees from
+	# the projected coordinates. This is the projection part of the
+	# computation.
+
+	k = nint (FC_NP(fc))
+        if (FC_LNGCOR(fc) == NULL)
+            x = p[ira]
+        else
+            x = p[ira] + wf_gseval (FC_LNGCOR(fc), p[ira], p[idec])
+        if (FC_LATCOR(fc) == NULL)
+            y = p[idec]
+        else
+            y = p[idec] + wf_gseval (FC_LATCOR(fc), p[ira], p[idec])
+	r = sqrt (x * x + y * y) / FC_RODEG(fc)
+
+	# Solve.
+
+	# Constant no solution
+	if (k < 1) {
+	    w[ira] = FC_BADCVAL(fc)
+	    w[idec] = FC_BADCVAL(fc)
+	    return
+
+	# Linear.
+	} else if (k == 1) {
+	    zd = (r - FC_PC(fc,0)) / FC_PC(fc,1)
+
+	# Quadratic.
+	} else if (k == 2) {
+
+	    a = FC_PC(fc,2) 
+	    b = FC_PC(fc,1) 
+	    c = FC_PC(fc,0) - r 
+	    d = b * b - 4.0d0 * a * c
+	    if (d < 0.0d0) {
+	        w[ira] = FC_BADCVAL(fc)
+	        w[idec] = FC_BADCVAL(fc)
+	        return
+	    }
+	    d = sqrt (d)
+
+	    # Choose solution closet to the pole.
+	    zd1 = (-b + d) / (2.0d0 * a)
+	    zd2 = (-b - d) / (2.0d0 * a)
+	    zd = min (zd1, zd2)
+	    if (zd < -tol)
+		zd = max (zd1, zd2)
+	    if (zd < 0.0d0) {
+		if (zd < -tol) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = 0.0d0
+	    } else if (zd > DPI) {
+		if (zd > (DPI + tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = DPI
+	    }
+
+	# Higher order solve iteratively.
+	} else {
+
+	    zd1 = 0.0d0
+	    r1 = FC_PC(fc,0)
+	    zd2 = FC_ZD(fc)
+	    r2 = FC_R(fc)
+
+	    if (r < r1) {
+		if (r < (r1 - tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = zd1
+		goto phitheta_
+	    } else if (r > r2) {
+		if (r > (r2 + tol)) {
+	            w[ira] = FC_BADCVAL(fc)
+	            w[idec] = FC_BADCVAL(fc)
+	            return
+		}
+		zd = zd2
+		goto phitheta_
+	    } else {
+		do j = 1, 100 {
+		    lambda = (r2 - r) / (r2 - r1)
+		    if (lambda < 0.1d0)
+			lambda = 0.1d0
+		    else if (lambda > 0.9d0)
+			lambda = 0.9d0
+		    zd = zd2 - lambda * (zd2 - zd1)
+		    rt = 0.0d0
+		    do i = k, 0, -1
+			rt = (rt * zd) + FC_PC(fc,i)
+		    if (rt < r) {
+			if ((r - rt) < tol)
+			    goto phitheta_
+			r1 = rt
+			zd1 = zd
+		    } else {
+			if ((rt - r) < tol)
+			    goto phitheta_
+			r2 = rt
+			zd2 = zd
+		    }
+		    if (abs(zd2 - zd1) < tol)
+			goto phitheta_
+		}
+	    }
+
+	}
+
+phitheta_
+
+	# Compute PHI.
+	if (r == 0.0d0)
+	    phi = 0.0d0
+	else
+	    phi = atan2 (x, -y)
+
+	# Compute THETA.
+	theta = DHALFPI - zd
+
+	# Compute the celestial coordinates RA and DEC from the native
+	# coordinates PHI and THETA. This is the spherical geometry part
+	# of the computation.
+
+	costhe = cos (theta)
+	sinthe = sin (theta)
+	dphi = phi - FC_LONGP(fc)
+	cosphi = cos (dphi)
+	sinphi = sin (dphi)
+
+	# Compute the RA.
+        x = sinthe * FC_SINLATP(fc) - costhe * FC_COSLATP(fc) * cosphi
+        if (abs (x) < FC_SPHTOL(fc))
+            x = -cos (theta + FC_COLATP(fc)) + costhe * FC_COSLATP(fc) *
+                (1.0d0 - cosphi)
+        y = -costhe * sinphi
+        if (x != 0.0d0 || y != 0.0d0) {
+            dlng = atan2 (y, x)
+        } else {
+            dlng = dphi + DPI
+        }
+        ra =  FC_W(fc,ira) + DRADTODEG(dlng)
+
+	# Normalize the RA.
+	if (FC_W(fc,ira) >= 0.0d0) {
+	    if (ra < 0.0d0)
+		ra = ra + 360.0d0
+	} else {
+	    if (ra > 0.0d0)
+		ra = ra - 360.0d0
+	}
+        if (ra > 360.0d0)
+            ra = ra - 360.0d0
+        else if (ra < -360.0d0)
+            ra = ra + 360.0d0
+
+	# Compute the DEC.
+        if (mod (dphi, DPI) == 0.0d0) {
+            dec = DRADTODEG(theta + cosphi * FC_COLATP(fc))
+            if (dec > 90.0d0)
+                dec = 180.0d0 - dec
+            if (dec < -90.0d0)
+                dec = -180.0d0 - dec
+        } else {
+            z = sinthe * FC_COSLATP(fc) + costhe * FC_SINLATP(fc) * cosphi
+            if (abs(z) > 0.99d0) {
+                if (z >= 0.0d0)
+                    dec = DRADTODEG(acos (sqrt(x * x + y * y)))
+                else
+                    dec = DRADTODEG(-acos (sqrt(x * x + y * y)))
+            } else
+                dec = DRADTODEG(asin (z))
+        }
+
+	# Store the results.
+	w[ira]  = ra
+	w[idec] = dec
+end
+
+
+# WF_ZPX_INV -- Inverse transform (world to physical) for the zenithal /
+# azimuthal polynomial projection.
+
+procedure wf_zpx_inv (fc, w, p)
+
+pointer	fc			#I pointer to FC descriptor
+double	w[2]			#I input world (RA, DEC) coordinates
+double	p[2]			#I output physical coordinates
+
+int	ira, idec, i, niter
+double	ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta, s, r, dphi, z
+double	xm, ym, f, fx, fy, g, gx, gy, denom, dx, dy, dmax
+double	wf_gseval(), wf_gsder()
+
+begin
+	# Get the axes numbers.
+	ira = FC_IRA(fc)
+	idec = FC_IDEC(fc)
+
+	# Compute the transformation from celestial coordinates RA and
+	# DEC to native coordinates PHI and THETA. This is the spherical
+	# geometry part of the transformation.
+
+	ra  = DDEGTORAD (w[ira] - FC_W(fc,ira))
+	dec = DDEGTORAD (w[idec])
+	cosra = cos (ra)
+	sinra = sin (ra)
+	cosdec = cos (dec)
+	sindec = sin (dec)
+
+	# Compute PHI.
+        x = sindec * FC_SINLATP(fc) - cosdec * FC_COSLATP(fc) * cosra
+        if (abs(x) < FC_SPHTOL(fc))
+            x = -cos (dec + FC_COLATP(fc)) + cosdec * FC_COSLATP(fc) *
+                (1.0d0 - cosra)
+        y = -cosdec * sinra
+        if (x != 0.0d0 || y != 0.0d0)
+            dphi = atan2 (y, x)
+        else
+            dphi = ra - DPI
+        phi = FC_LONGP(fc) + dphi
+        if (phi > DPI)
+            phi = phi - DTWOPI
+        else if (phi < -DPI)
+            phi = phi + DTWOPI
+
+	# Compute THETA.
+        if (mod (ra, DPI) ==0.0) {
+            theta = dec + cosra * FC_COLATP(fc)
+            if (theta > DHALFPI)
+                theta = DPI - theta
+            if (theta < -DHALFPI)
+                theta = -DPI - theta
+        } else {
+            z = sindec * FC_COSLATP(fc) + cosdec * FC_SINLATP(fc) * cosra
+            if (abs (z) > 0.99d0) {
+                if (z >= 0.0)
+                    theta = acos (sqrt(x * x + y * y))
+                else
+                    theta = -acos (sqrt(x * x + y * y))
+            } else
+                theta = asin (z)
+        }
+
+	# Compute the transformation from native coordinates PHI and THETA
+	# to projected coordinates X and Y.
+
+	s = DHALFPI - theta
+	r = 0.0d0
+	do i = 9, 0, -1
+	    r = r * s + FC_PC(fc,i)
+	r = FC_RODEG(fc) * r
+
+        if (FC_LNGCOR(fc) == NULL && FC_LATCOR(fc) == NULL) {
+	    p[ira]  = r * sin (phi)
+	    p[idec] = -r * cos (phi)
+
+	} else {
+            xm  = r * sin (phi)
+            ym = -r * cos (phi)
+            x = xm
+            y = ym
+            niter = 0
+	    dmax = 30. / 3600.
+
+            repeat {
+                if (FC_LNGCOR(fc) != NULL) {
+                    f = x + wf_gseval (FC_LNGCOR(fc), x, y) - xm
+                    fx = wf_gsder (FC_LNGCOR(fc), x, y, 1, 0)
+                    fx = 1.0 + fx
+                    fy = wf_gsder (FC_LNGCOR(fc), x, y, 0, 1)
+                } else {
+                    f = x - xm
+                    fx = 1.0
+                    fy = 0.0
+                }
+                if (FC_LATCOR(fc) != NULL) {
+                    g = y + wf_gseval (FC_LATCOR(fc), x, y) - ym
+                    gx = wf_gsder (FC_LATCOR(fc), x, y, 1, 0)
+                    gy = wf_gsder (FC_LATCOR(fc), x, y, 0, 1)
+                    gy = 1.0 + gy
+                } else {
+                    g = y - ym
+                    gx = 0.0
+                    gy = 1.0
+                }
+                denom = fx * gy - fy * gx
+                if (denom == 0.0d0)
+                    break
+                dx = (-f * gy + g * fy) / denom
+                dy = (-g * fx + f * gx) / denom
+                x = x + max (-dmax, min (dmax, dx))
+                y = y + max (-dmax, min (dmax, dy))
+                if (max (abs (dx), abs (dy), abs(f), abs(g)) < 2.80d-7)
+                    break
+
+                niter = niter + 1
+
+            } until (niter >= MAX_NITER)
+
+            p[ira]  = x
+            p[idec] = y
+	}
+end
+
+
+# WF_ZPX_DESTROY -- Free up the distortion surface pointers.
+
+procedure wf_zpx_destroy (fc)
+
+pointer fc                      #I pointer to the FC descriptor
+
+begin
+        if (FC_LNGCOR(fc) != NULL)
+            call wf_gsclose (FC_LNGCOR(fc))
+        if (FC_LATCOR(fc) != NULL)
+            call wf_gsclose (FC_LATCOR(fc))
+end
diff --git a/sys/mwcs/zzdebug.x b/sys/mwcs/zzdebug.x
new file mode 100644
index 00000000..d098f68b
--- /dev/null
+++ b/sys/mwcs/zzdebug.x
@@ -0,0 +1,507 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<math.h>
+include	<mwset.h>
+include	"imwcs.h"
+
+task	simple	= t_simple,
+	wcs	= t_wcs,
+	float	= t_float,
+	imtest	= t_imtest,
+	inv	= t_inv,
+	save	= t_save,
+	load	= t_load
+
+define	SAVELEN		10240
+
+
+# SIMPLE -- Simple test of the most common interface routines.
+
+procedure t_simple()
+
+pointer	mw, ct, bp
+int	buflen, nchars
+real	ltm[2,2], ltv[2], x1,y1, x2,y2
+pointer	mw_open(), mw_sctran()
+int	mw_save()
+
+begin
+	call memchk()
+	mw = mw_open (NULL, 2)
+
+	ltm[1,1] = 1.0;  ltm[1,2] = 0.0
+	ltm[2,1] = 0.0;  ltm[2,2] = 1.0
+	ltv[1]   = 0.0;  ltv[2]   = 0.0
+	call mw_sltermr (mw, ltm, ltv, 2)
+
+	ct = mw_sctran (mw, "logical", "physical", 0)
+	x1 = 0.5;  y1 = 0.5
+	call mw_c2tranr (ct, x1, y1, x2, y2)
+
+	call eprintf ("[%g,%g] -> [%g,%g]\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	bp = NULL
+	nchars = mw_save (mw, bp, buflen)
+	call mw_load (mw, bp)
+
+	call eprintf ("save/load, save buflen = %d chars, nchars=%d\n")
+	    call pargi (buflen)
+	    call pargi (nchars)
+
+	ct = mw_sctran (mw, "logical", "physical", 0)
+	x1 = 0.5;  y1 = 0.5
+	call mw_c2tranr (ct, x1, y1, x2, y2)
+
+	call eprintf ("[%g,%g] -> [%g,%g]\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	call mw_close (mw)
+end
+
+
+# WCS -- Test the creation and use of a world coordinate system.
+
+procedure t_wcs()
+
+pointer	mw, ct1, ct2, ct3
+real	pv[100], wv[100]
+real	theta, center[2], scale[2], shift[2]
+real	ltm[3,3], ltv[3], x1,y1, x2,y2
+double	r[3], w[3], cd[3,3]
+double	l2m[2,2], l2v_1[2], l2v_2[2], d_theta
+int	ndim, axes[3], naxes, npts, i
+pointer	mw_open(), mw_sctran()
+real	mw_c1tranr()
+
+begin
+	call memchk()
+	ndim = 3
+
+	# Create a unitary, 3 dim WCS.
+	mw = mw_open (NULL, ndim)
+
+	# Examine the Lterm.
+	call plterm (mw, ltm, ltv, ndim)
+
+	# Apply a transform to the first 2 axes.
+	d_theta = DEGTORAD(30.0D0)
+	l2m[1,1] =  cos(d_theta);  l2m[2,1] = sin(d_theta)
+	l2m[1,2] = -sin(d_theta);  l2m[2,2] = cos(d_theta)
+	l2v_1[1] = 0.0;   l2v_1[2] = 0.0
+	l2v_2[1] = 10.0;  l2v_2[2] = 20.0
+	#l2v_2[1] = 0.0;  l2v_2[2] = 0.0
+
+	#call mw_translated (mw, l2v_1, l2m, l2v_2, 2)
+	theta = d_theta;  call aclrr (center, 2)
+	call mw_rotate (mw, theta, center, 3B)
+	shift[1] = 10.0;  shift[2] = 20.0
+	call mw_shift (mw, shift, 3B)
+	scale[1] = 4.0;  scale[2] = 0.2
+	call mw_scale (mw, scale, 3B)
+
+	# Examine the Lterm.
+	call plterm (mw, ltm, ltv, ndim)
+
+	# Apply the inverse transform.
+	d_theta = -d_theta
+	l2m[1,1] =  cos(d_theta);  l2m[2,1] = sin(d_theta)
+	l2m[1,2] = -sin(d_theta);  l2m[2,2] = cos(d_theta)
+	call amovd (l2v_2, l2v_1, 2);  call aclrd (l2v_2, 2)
+
+	#call mw_translated (mw, l2v_1, l2m, l2v_2, 2)
+	scale[1] = 1.0/scale[1];  scale[2] = 1.0/scale[2]
+	call mw_scale (mw, scale, 3B)
+	shift[1] = -shift[1];  shift[2] = -shift[2]
+	call mw_shift (mw, shift, 3B)
+	call mw_rotate (mw, -theta, center, 3B)
+
+	# Examine the Lterm.
+	call plterm (mw, ltm, ltv, ndim)
+
+	# Add a WCS.
+	call mw_newsystem (mw, "sky", 3)
+
+	cd[1,1] = .01D0;  cd[2,1] = 0;    cd[3,1] = 0
+	cd[1,2] = 0;    cd[2,2] = .01D0;  cd[3,2] = 0
+	cd[1,3] = 0;    cd[2,3] = 0;    cd[3,3] = 1
+	r[1]    = 0;    r[2]    = 0;    r[3]    = 0
+	w[1]    = 100;  w[2]    = 20;   w[3]    = 0
+
+	# Put a tangent projection on axis 1&2.
+	call mw_swtermd (mw, r, w, cd, ndim)
+	axes[1] = 1;  axes[2] = 2;  naxes = 2
+	call mw_swtype (mw, axes, naxes, "tan",
+	    "axis 1: axtype=ra  axis 2: axtype=dec")
+
+	# Put a simple sampled curve on axis 3.
+	call mw_swtype (mw, 3, 1, "sampled", "")
+	npts = 10
+	do i = 1, npts {
+	    pv[i] = i
+	    wv[i] = i * 2
+	}
+	call mw_swsampr (mw, 3, pv, wv, npts)
+
+	# Try a transform on the axis 1-2 plane.
+	ct1 = mw_sctran (mw, "logical", "sky", 3B)
+	x1 = 50.0;  y1 = -20.0
+	call mw_c2tranr (ct1, x1,y1, x2,y2)
+	call eprintf ("[%g,%g]logical -> [%g,%g]sky\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	# Check out the reverse transform.
+	ct2 = mw_sctran (mw, "sky", "logical", 3B)
+	call mw_c2tranr (ct2, x2,y2, x1,y1)
+	call eprintf ("[%g,%g]sky -> [%g,%g]logical\n")
+	    call pargr (x2);  call pargr (y2)
+	    call pargr (x1);  call pargr (y1)
+
+	# Try evaluating the sampled axis.
+	ct3 = mw_sctran (mw, "physical", "sky", 4B)
+	x1 = 4.5;  x2 = mw_c1tranr (ct3, x1)
+	call eprintf ("axis 3: %gL -> %gS\n")
+	    call pargr (x1)
+	    call pargr (x2)
+
+	call mw_close (mw)
+end
+
+
+# PLTERM -- Print the Lterm.
+
+procedure plterm (mw, ltm, ltv, ndim)
+
+pointer	mw
+real	ltm[ndim,ndim]
+real	ltv[ndim]
+int	ndim
+
+int	i, j
+
+begin
+	# Examine the Lterm.
+	call mw_gltermr (mw, ltm, ltv, ndim)
+	call eprintf ("----- lterm -----\n")
+
+	do j = 1, ndim {
+	    do i = 1, ndim {
+		call eprintf (" %8.3f")
+		    call pargr (ltm[i,j])
+	    }
+	    call eprintf (" : %8.3f\n")
+		call pargr (ltv[j])
+	}
+end
+
+
+# IMTEST -- Test the image header WCS save and load facilities.
+
+procedure t_imtest()
+
+double	cd[3,3], r[3], w[3]
+int	ndim, naxes, axes[2], npts, i
+pointer	mw, ct1, ct2, ct3, im, iw, cp
+real	theta, center[3], shift[3], scale[3], x1,y1, x2,y2, pv[10], wv[10]
+pointer	mw_open(), mw_sctran(), immap(), iw_rfits()
+real	mw_c1tranr()
+
+begin
+	call memchk()
+	ndim = 3
+
+	# Create a unitary, 3 dim WCS.
+	mw = mw_open (NULL, ndim)
+
+	# Apply a transform to the first 2 axes.
+	call aclrr (center, 2)
+	theta = DEGTORAD(30.0D0)
+	shift[1] = 10.0;  shift[2] = 20.0
+	scale[1] = 4.0;   scale[2] = 0.2
+
+	call mw_rotate (mw, theta, center, 3B)
+	call mw_shift (mw, shift, 3B)
+	call mw_scale (mw, scale, 3B)
+
+	# Add a WCS.
+	call mw_newsystem (mw, "sky", 3)
+
+	cd[1,1] = .01D0;  cd[2,1] = 0;    cd[3,1] = 0
+	cd[1,2] = 0;    cd[2,2] = .01D0;  cd[3,2] = 0
+	cd[1,3] = 0;    cd[2,3] = 0;    cd[3,3] = 1
+	r[1]    = 0;    r[2]    = 0;    r[3]    = 0
+	w[1]    = 100;  w[2]    = 20;   w[3]    = 0
+
+	# Put a tangent projection on axis 1&2.
+	call mw_swtermd (mw, r, w, cd, ndim)
+	axes[1] = 1;  axes[2] = 2;  naxes = 2
+	call mw_swtype (mw, axes, naxes, "tan",
+	    "axis 1: axtype=ra  axis 2: axtype=dec")
+
+	# Put a simple sampled curve on axis 3.
+	call mw_swtype (mw, 3, 1, "sampled", "")
+	npts = 10
+	do i = 1, npts {
+	    pv[i] = i
+	    wv[i] = i * 2
+	}
+	call mw_swsampr (mw, 3, pv, wv, npts)
+
+	# Evaluate tests 1.
+	# -----------------
+
+	# Try a transform on the axis 1-2 plane.
+	ct1 = mw_sctran (mw, "logical", "sky", 3B)
+	x1 = 50.0;  y1 = -20.0
+	call mw_c2tranr (ct1, x1,y1, x2,y2)
+	call eprintf ("[%g,%g]logical -> [%g,%g]sky\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	# Check out the reverse transform.
+	ct2 = mw_sctran (mw, "sky", "logical", 3B)
+	call mw_c2tranr (ct2, x2,y2, x1,y1)
+	call eprintf ("[%g,%g]sky -> [%g,%g]logical\n")
+	    call pargr (x2);  call pargr (y2)
+	    call pargr (x1);  call pargr (y1)
+
+	# Try evaluating the sampled axis.
+	ct3 = mw_sctran (mw, "physical", "sky", 4B)
+	x1 = 4.5;  x2 = mw_c1tranr (ct3, x1)
+	call eprintf ("axis 3: %gL -> %gS\n")
+	    call pargr (x1)
+	    call pargr (x2)
+
+	# Test image header save/load.
+	call eprintf ("save WCS in image header...\n")
+	#iferr (call imdelete ("pix"))
+	#    ;
+	im = immap ("pix", READ_WRITE, 0)
+	call mw_saveim (mw, im)
+
+	# See what we saved.
+	call printf ("-------- IMAGE HEADER --------\n")
+	iw = iw_rfits (mw, im, RF_REFERENCE)
+	do i = 1, IW_NCARDS(iw) {
+	    cp = IW_CARD(iw,i)
+	    call write (STDOUT, Memc[C_RP(cp)], 80)
+	    call putci (STDOUT, '\n')
+	}
+	call iw_cfits (iw)
+	call printf ("------------------------------\n")
+	call flush (STDOUT)
+
+	# Reload saved header.
+	call mw_loadim (mw, im)
+
+	# Evaluate tests 2.
+	# -----------------
+
+	# Try a transform on the axis 1-2 plane.
+	ct1 = mw_sctran (mw, "logical", "sky", 3B)
+	x1 = 50.0;  y1 = -20.0
+	call mw_c2tranr (ct1, x1,y1, x2,y2)
+	call eprintf ("[%g,%g]logical -> [%g,%g]sky\n")
+	    call pargr (x1);  call pargr (y1)
+	    call pargr (x2);  call pargr (y2)
+
+	# Check out the reverse transform.
+	ct2 = mw_sctran (mw, "sky", "logical", 3B)
+	call mw_c2tranr (ct2, x2,y2, x1,y1)
+	call eprintf ("[%g,%g]sky -> [%g,%g]logical\n")
+	    call pargr (x2);  call pargr (y2)
+	    call pargr (x1);  call pargr (y1)
+
+	# Try evaluating the sampled axis.
+	ct3 = mw_sctran (mw, "physical", "sky", 4B)
+	x1 = 4.5;  x2 = mw_c1tranr (ct3, x1)
+	call eprintf ("axis 3: %gL -> %gS\n")
+	    call pargr (x1)
+	    call pargr (x2)
+
+	call mw_close (mw)
+end
+
+
+# INV -- Test matrix inversion.
+
+procedure t_inv()
+
+int	i, j
+double	a[3,3], b[3,3], c[3,3]
+long	seed, clktime()
+real	urand()
+
+begin
+	# Construct the identity matrix.
+	do i = 1, 3 {
+	    do j = 1, 3
+		a[i,j] = 0.0
+	    a[i,i] = 1.0
+	}
+
+	# Invert the matrix.
+	call mw_invertd (a, b, 3)
+
+	# Print the inverse.
+	call printf ("inverse of identity matrix:\n")
+	do i = 1, 3 {
+	    do j = 1, 3 {
+		call printf ("  %20.*f")
+		    call pargi (NDIGITS_DP)
+		    call pargd (b[i,j])
+	    }
+	    call printf ("\n")
+	}
+
+	# Compute a random matrix.
+	seed = clktime(0)
+	do i = 1, 3
+	    do j = 1, 3
+		a[i,j] = urand (seed)
+
+	# Invert the matrix.
+	call mw_invertd (a, b, 3)
+	call mw_invertd (b, c, 3)
+
+	# Print the difference of the original and the inverted inverse.
+	call printf ("difference of inverse of random matrix:\n")
+	do i = 1, 3 {
+	    do j = 1, 3 {
+		call printf ("  %20.*f")
+		    call pargi (NDIGITS_DP)
+		    call pargd (a[i,j] - c[i,j])
+	    }
+	    call printf ("\n")
+	}
+end
+
+
+# SAVE -- Save a test WCS to a file.
+
+procedure t_save()
+
+pointer	mw, bp
+double	cd[3,3], r[3], w[3]
+int	ndim, naxes, axes[2], npts, buflen, nchars, fd, i
+real	theta, center[3], shift[3], scale[3], pv[10], wv[10]
+int	open(), mw_save
+pointer	mw_open()
+
+begin
+	ndim = 3
+
+	# Create a unitary, 3 dim WCS.
+	mw = mw_open (NULL, ndim)
+
+	# Apply a transform to the first 2 axes.
+	call aclrr (center, 2)
+	theta = DEGTORAD(30.0D0)
+	shift[1] = 10.0;  shift[2] = 20.0
+	scale[1] = 4.0;   scale[2] = 0.2
+
+	call mw_rotate (mw, theta, center, 3B)
+	call mw_shift (mw, shift, 3B)
+	call mw_scale (mw, scale, 3B)
+
+	# Add a WCS.
+	call mw_newsystem (mw, "sky", 3)
+
+	cd[1,1] = .01D0;  cd[2,1] = 0;    cd[3,1] = 0
+	cd[1,2] = 0;    cd[2,2] = .01D0;  cd[3,2] = 0
+	cd[1,3] = 0;    cd[2,3] = 0;    cd[3,3] = 1
+	r[1]    = 0;    r[2]    = 0;    r[3]    = 0
+	w[1]    = 100;  w[2]    = 20;   w[3]    = 0
+
+	# Put a tangent projection on axis 1&2.
+	call mw_swtermd (mw, r, w, cd, ndim)
+	axes[1] = 1;  axes[2] = 2;  naxes = 2
+	call mw_swtype (mw, axes, naxes, "tan",
+	    "axis 1: axtype=ra  axis 2: axtype=dec")
+
+	# Put a simple sampled curve on axis 3.
+	call mw_swtype (mw, 3, 1, "sampled", "")
+	npts = 10
+	do i = 1, npts {
+	    pv[i] = i
+	    wv[i] = i * 2
+	}
+	call mw_swsampr (mw, 3, pv, wv, npts)
+
+	# Display the new WCS.
+	call mw_show (mw, STDOUT, 0)
+
+	# Save to a file.
+	bp = NULL;  buflen = 0
+	nchars = mw_save (mw, bp, buflen)
+
+	fd = open ("mwcs.sav", NEW_FILE, BINARY_FILE)
+	call write (fd, Memc[bp], nchars)
+	call close (fd)
+
+	call mfree (bp, TY_CHAR)
+	call mw_close (mw)
+end
+
+
+# LOAD -- Load a test WCS from a file.
+
+procedure t_load()
+
+pointer	mw, bp
+int	fd, nchars
+char	fname[SZ_FNAME]
+int	open(), read()
+pointer	mw_open()
+
+begin
+	call clgstr ("savefile", fname, SZ_FNAME)
+	call malloc (bp, SAVELEN, TY_CHAR)
+
+	# Open and read save file.
+	fd = open (fname, READ_ONLY, BINARY_FILE)
+	nchars = read (fd, Memc[bp], SAVELEN)
+	call printf ("read %d chars from %s\n")
+	    call pargi (nchars)
+	    call pargstr (fname)
+
+	mw = mw_open (NULL, 3)
+	call mw_load (mw, bp)
+
+	# Display the new WCS.
+	call mw_show (mw, STDOUT, 0)
+
+	call mw_close (mw)
+	call mfree (bp, TY_CHAR)
+end
+
+
+# FLOAT -- Test single to double conversions.
+
+procedure t_float()
+
+real	r
+double	x
+
+begin
+	x = sin(0.34567D0)
+	r = 1.0
+	call achtrd (r, x, 1)
+	call printf ("x = %g\n")
+	    call pargd (x)
+end
+
+
+# MEMCHK -- Enable runtime dynamic memory verification.  System dependent,
+# should be commented out unless a Fortran callable MEMVER is available for
+# linking.
+
+procedure memchk()
+
+begin
+	# call memver (2)
+end