Repatch (from linux) of OSX IRAF

117 files changed, 15438 insertions, 0 deletions

diff --git a/sys/imio/iki/README b/sys/imio/iki/README
new file mode 100644
index 00000000..14b0f3f5
--- /dev/null
+++ b/sys/imio/iki/README
@@ -0,0 +1,383 @@
+			Image Kernel Interface (IKI)
+				Doug Tody
+			       08 May 1986
+
+
+1. INTRODUCTION
+
+    The IKI is the interface between IMIO and some particular image storage
+format.  IMIO itself has no knowledge of the storage format.  The primary
+function of the IKI is to access image headers, mapping the host header
+storage format into the IMIO image header descriptor and vice versa.
+The IKI is responsible for all image management operations, including
+opening/creating/updating headers, opening/creating pixfiles (pixel storage
+files), deleting, renaming, and copying images, checking for the existence
+of images, and so on.
+
+The IKI can support an arbitrary number of different storage formats.
+Each format requires a set of format dependent driver subroutines implementing
+the standard IKI functions.  The IKI will dynamically select the driver to be
+used to access a particular format at runtime.  New drivers may be dynamically
+loaded at runtime, in a way similar to that used for FIO.  While IMIO directly
+accesses the pixel storage file via binary FIO for efficiency reasons, the
+pixfile is opened by the IKI driver, hence a special driver may be used if
+desired.  For example, this feature may be used to access image display frame
+as a pixfile, or an image stored in archival format on an optical disk.
+
+
+2. STRUCTURE
+
+    The role played by the IKI and format specific IKI drivers in the image
+i/o subsystem is illustrated in the figure below.
+
+
+	       IMIO		Format independent; primarily does i/o to
+	         | 		the pixel file.  The image header is read
+		 |		into a dynamically allocated descriptor at
+		 |		open time.
+		 |
+		IKI		Selects driver to be used.  Maintains table
+		 |		of open images, handles cleanup during error
+		 |		recovery.
+		 |
+	     (drivers)		Physically accesses/creates/deletes etc. an
+				image stored in a particular format.  Maps
+				the header stored in some particular external
+				format into the standardized IMIO descriptor.
+				Responsible for opening/creating the pixfile,
+				returning a FIO file descriptor to IMIO, which
+				directly accesses the pixel data.
+
+
+The format specific driver packages are written in SPP using only standard
+VOS i/o facilities, e.g., FIO and MEMIO.  This is necessary due to the use
+of an SPP descriptor structure to maintain the incore version of the image
+header, due to the need to return an FIO file descriptor to IMIO, and so on.
+To add support for a new format, one need only add a new driver to the IKI
+and relink the system.
+
+
+3. LOGICAL SCHEMA
+
+    The logical schema of the current IKI is highly constrained by the fact
+that the IKI is an add-on to the existing IMIO interface.  It is not worthwhile
+in this revision to try to address the limitations/design flaws of the initial
+IMIO interface, hence our intention is to add the IKI in such a way that few
+changes are required to IMIO, and no changes are required to programs which
+use IMIO.  One or two further major revisions are planned before the final
+interface is realized.  The concept of the IKI is here to stay, but the current
+interface attempts only to address the immediate need to support multiple
+image formats with the least impact on current software.
+
+An image consists of a header and a pixel array stored in a random access
+binary file.  Images may be grouped together into an array or "cluster" of
+images, with the individual images being accessed by a one indexed subscript
+appended to the cluster name, e.g., "pix[3]" refers to image 3 of the cluster
+"pix".  To create a cluster containing more than one image a / followed by
+the cluster size may be included in the cluster index, e.g., "pix[3/10]" to
+create a cluster of 10 images and write into image 3.  An image section may
+optionally be appended to access some subset of the pixels in the image, e.g.,
+"pix[3][*,5]".  Lastly, if the image is stored as a disk file, the filename
+extension of the header file may be given to explicitly indicate the image
+format (IKI driver) to be used to access the image.
+
+A full specification (referencing an existing image) might therefore be
+"pix.hhh[3][*,5]", where the ".hhh" extension indicates that the cluster is
+physically stored in an SDAS GEIS (group format) data structure, the "[3]"
+indicates image 3, and the "[*,5]" is a conventional IMIO image section.
+If the minimal specification "pix" were given, the IKI would determine that
+"pix" was a GEIS format image, accessing the entire contents of image [1].
+As an aside, note that image sections are handled entirely by IMIO and are
+not seen at the IKI level.  Likewise, the cluster subscript is parsed by
+IMIO and passed to the IKI as an integer argument.
+
+
+	IM_PIXTYPE	int		pixel type (usilrdx)
+	IM_NDIM		int		number of axes (0:7)
+	IM_LEN		long[7]		logical length of each axis (>=1)
+	IM_PHYSLEN	long[7]		physical length of each axis (>=1)
+	IM_CLINDEX	int		index of image in cluster
+	IM_CLSIZE	int		number of images in cluster
+	IM_PIXOFF	long		char file offset to the pixels
+	IM_CTIME	long		image creation time
+	IM_MTIME	long		most recent image modification time
+	IM_LIMTIME	long		time when max/min last updated
+	IM_MAX		real		maximum pixel value
+	IM_MIN		real		minimum pixel value
+	IM_PIXFILE	char*80		pathname of pixel file (optional)
+	IM_TITLE	char*80		image title string
+
+
+The important fields of the IMIO image descriptor are summarized above, along
+with their datatype and length in the case of arrays.  This is from the original
+IMIO design and has not been modified in any way, except for the addition of the
+cluster fields to the runtime descriptor.  The IKI drivers directly read and
+write these fields in the image descriptor.
+
+In addition to these standard fields (for which the IKI driver must supply
+reasonable values at open time) the image descriptor contains a "user area"
+containing an arbitrary sequence of keyword=value parameters encoded in
+FITS character format.  The FITS cards are trimmed at the right and
+concatenated into an EOS delimited string with newline characters delimiting
+each card.  All host format specific header parameters should be passed to
+IMIO in the user area.  In the case of group format images, the user area
+will contain both the group parameters (parameters shared by the entire group
+of images) and the group header parameters (parameters for the individual
+image in the group specified at open time).  IMIO makes no distinction
+between the two types of parameters.  All header parameters are available
+to the high level applications code via the IMIO/IDBI interface.
+
+
+4. IKI INTERFACE PROCEDURES
+
+    The IMIO code calls only the IKI procedures and has no knowledge of the
+IKI drivers, or of which driver has been connected to a particular image
+descriptor.  The high level IKI procedures are summarized below.  The interface
+is fairly small due to the use of the descriptor to maintain all information
+describing the image, and due to the fact that IMIO directly accesses the
+pixel data via FIO.
+
+
+	       iki_open (im, image, group, gcount, acmode, o_im)
+	      iki_close (im)
+	       iki_opix (im)			# open/create pixfile
+	     iki_updhdr (im)			# update image header
+
+	       iki_copy (oldname, newname)	# fast copy of entire group
+	     iki_delete (group)			# delete entire group
+	     iki_rename (oldname, newname)	# rename entire group
+
+         k = iki_access (image, acmode)		# test existence, legal extn
+	   iki_lddriver (open,close,		# install new driver
+			 opix,updhdr, access,copy,delete,rename)
+
+
+The OPEN procedure opens or creates the indicated image in the named cluster.
+In the case of a new image or new copy image, only the header is created by
+the open call; the pixfile is not created until the OPIX routine is called,
+allowing the high level code time to set the image dimensions, datatype,
+number of groups, etc., in the image descriptor.  Once OPIX has been called
+to create a new group, the number of axes, size of each axis, pixel type,
+etc. is fixed.
+
+In the case of image stored in the SDAS/GEIS group format, all of the images
+in a cluster (group) must be of the same size, must have the same header
+parameters, and the header parameters must be defined when the group is
+created (new parameters or images cannot be added to the group later).
+The first open call for a image will allocate space for all images in the
+cluster, but only the indicated image will be initialized in the first call.
+Multiple images may be simultaneously open in the same cluster, and the same
+image may be multiply opened on independent logical FIO file descriptors.
+
+The high level IRAF software has little or no knowledge of the physical
+association of images into clusters.  In particular, the high level software
+is ignorant about the SDAS/GEIS image storage format, but this need not
+prevent processing of these images.  The main limitations of the group
+format derive from the fact that new images can neither be added to nor
+deleted from to a group format cluster, and new parameters cannot be added
+to a group header.  To create a group format image via IMIO, one will normally
+make a NEW_COPY copy of an existing group format image (to define the fields
+of the group headers), specifing the number of images in the new group in
+the cluster size field of the image name specification.  For example, writing
+to the new image "pix[3/10]" will cause a cluster of 10 images to be created
+and image 3 to be initialized.  Subsequent calls to write to either "pix[I]"
+or "pix[I/10]" will be necessary to initialize the remaining images in the
+cluster.
+
+
+5. KERNEL PROCEDURES
+
+    Each supported image format requires a dedicated set of kernel procedures
+to be called by the IKI to access images stored in that format.  The calling
+sequences for these procedures are shown below.
+
+
+               xxx_open (im, root, extn, cl_index, cl_size, acmode, status)
+              xxx_close (im, status)
+               xxx_opix (im, status)
+             xxx_updhdr (im, status)
+
+             xxx_access (root, extn, acmode, status)
+               xxx_copy (old_root, old_extn, new_root, new_extn, status)
+             xxx_delete (root, extn, status)
+             xxx_rename (old_root, old_extn, new_root, new_extn, status)
+
+
+Here, the package prefix "xxx" is OIF for the old IRAF image format, and STF
+for the STScI/SDAS GEIS format.  Note that the OPEN procedure fills in selected
+fields in a preallocated image descriptor rather than allocating the descriptor
+itself.  Image names are parsed into root, extension, cl_index, etc. fields by
+the IKI or higher level code, to further simplify the kernel code.  The IKI
+verifies the existence or nonexistence of all operand images before calling
+a kernel procedure, hence the kernel procedures need not perform these
+functions.  The kernel procedures should return an ERR status if they cannot
+perform their function for some reason (rather than take an error action).
+The locpr() entry point addresses of the kernel procedures are saved in a
+runtime table maintained by the IKI.
+
+The syntax and semantics of the kernel procedures are discussed in detail below.
+Since the interface routines have full access to the IMIO descriptors, it is
+important to realize what does and does not have to be set.
+
+
+5.1 IMAGE OPEN PRIMITIVE
+
+include	<imhdr.h>
+include	<imio.h>
+include	"xxx.h"
+
+# XXX_OPEN -- Open/create an image.
+
+procedure oif_open (im, root, extn, cl_index, cl_size, acmode, status)
+
+pointer	im			# image descriptor (allocated by IMIO)
+char	root[ARB]		# root image name
+char	extn[ARB]		# extension, if any
+int	cl_index		# index of image to be opened
+int	cl_size			# number of images in cluster
+int	acmode			# access mode
+int	status			# return status (OK|ERR)
+
+begin
+	1.  Construct the filename of the header file and open or create the
+	    image header file.
+
+	2.  If opening an existing image, read the image header and fill in
+	    the following fields of the IMIO image header descriptor.  If
+	    creating a new image set only the field IM_HDRFILE.
+
+	    IM_PIXTYPE		# datatype of the pixels		**
+	    IM_NDIM		# number of dimensions			**
+	    IM_LEN		# length of the dimensions		**
+
+	    IM_CTIME		# time of image creation
+	    IM_MTIME		# time of last modify
+	    IM_LIMTIME		# time min,max computed
+	    IM_MAX		# max pixel value
+	    IM_MIN		# min pixel value
+	    IM_PIXFILE		# name of pixel storage file
+	    IM_HDRFILE		# name of header storage file
+	    IM_TITLE		# image name string
+	    IM_HISTORY		# history comment string
+
+	    The really essential fields are marked with a ** at the right.
+	    CTIME, PIXFILE, HDRFILE, TITLE, and HISTORY are for information
+	    only.  MTIME and LIMTIME are used to determine if the min/max
+	    pixel values are up to date, and the actual values do not matter
+	    provided the conclusion about the min/max values is correct.
+
+	3.  If opening an existing image, call IMIO to set those fields of the
+	    image header/descriptor describing the format in which the pixels
+	    are stored in the pixel storage file.
+
+		[] call imioff (im, pixoff, COMPRESS, blklen)
+
+	    where
+		    pixoff	FIO file offset of first pixel.
+		    compress	Set to NO to enable alignment of image
+				  lines on block boundaries, to YES for
+				  compressed byte stream image.
+		    blklen	Device block size, chars.  Set to 1 to
+				  defeat all block alignment.
+
+	    If opening a new image, this step may be left until the OPIX
+	    primitive is called.
+
+	3.  If the kernel procedures use their own internal descriptor,
+	    allocate and initialize the descriptor and save a pointer to
+	    it in IM_KDES(im).
+
+	4.  Set return status.
+end
+
+
+5.2  OPEN PIXEL FILE PRIMITIVE
+
+include	<imhdr.h>
+include	<imio.h>
+include	"xxx.h"
+
+# XXX_OPIX -- Open (or create) the pixel storage file.  Call IMIO to set the
+# file offsets and buffer sizes. 
+
+procedure xxx_opix (im, status)
+
+pointer	im				# image descriptor
+int	status				# return status
+
+begin
+	1.  Opening existing image:
+	    1.1 Open pixel file read only or read write.
+
+	2.  Opening (creating) new image:
+	    2.1 Call IMIO to set the offset parameters, assuming this was not
+		already done in the OPEN primitive:
+
+		    [] call imioff (im, pixoff, COMPRESS, blklen)
+
+	    2.2 Using the file size computed by imioff or determined by more
+		format specific means, open (falloc) the pixel storage file.
+		The IM_HGMOFF field of the image header is set by imioff
+		to the file offset of the end of the image.
+
+	3.  Call IMIO to set the i/o buffer parameters:
+
+		    [] call imsetbuf (pfd, im)
+
+	    This sets the FIO buffer size and the IM_FAST parameter.
+	    The buffer size should be set before doing any i/o on the
+	    pixel file.  If in doubt, skip the call and simply set
+	    IM_FAST(im) = NO (i/o will be suboptimal but not too bad).
+
+	4.  Save the pixfile FIO file descriptor (required for pixel i/o)
+	    in the image descriptor:
+
+		    [] IM_PFD(im) = pfd
+end
+
+
+5.3  UPDATE HEADER PRIMITIVE
+
+include	<imhdr.h>
+include	<imio.h>
+
+# XXX_UPDHDR -- Update the image header.
+
+procedure xxx_updhdr (im, status)
+
+pointer	im			# image descriptor
+int	status			# return status
+
+begin	
+	1.  Update the values of the standard logical image header fields
+	    in the physical image header, e.g., PIXTYPE, NDIM, LEN, and CTIME
+	    (for new images), MTIME, LIMTIME, MIN, MAX (any image).
+
+	2.  Save the "user fields" in the physical image header.  Some of
+	    these may have been inserted in the user area by the kernel open
+	    procedure, others may have been added by IRAF programs or by
+	    the user since the image was opened.
+end
+
+
+5.4  CLOSE IMAGE PRIMITIVE
+
+include <imio.h>
+
+# XXX_CLOSE -- Close an image.
+
+procedure xxx_close (im, status)
+
+pointer	im			# image descriptor
+int	status
+
+begin
+	1.  If the pixel file has been opened, close it.  Note that if no
+	    pixel i/o was done to the image, the pixel file will never have
+	    been opened.
+
+	2.  If the header file is still open, close it.
+
+	3.  If a special kernel descriptor was allocated at image open time
+	    by the kernel, deallocate it.
+end
diff --git a/sys/imio/iki/fxf/Notes b/sys/imio/iki/fxf/Notes
new file mode 100644
index 00000000..2a2fd74d
--- /dev/null
+++ b/sys/imio/iki/fxf/Notes
@@ -0,0 +1,81 @@
+Fits kernel notes / unresolved issues
+----------------------------------------------------------------------------
+
+Extraneous env variables - put in fkinit
+
+    ENV_DEFIMTYPE   "imtype"
+    ENV_FITSCACHE   "fitscache"
+
+
+Rename
+
+    minhdrlns
+
+
+Cache
+
+    hard upper limit - is this a restriction?
+    convert from common to dynamic descriptor
+    referenced:  open delete rename rfits updhdr
+
+Extensions
+    should not use imtype to set extension (this is copied from STF which
+    also has the same problem)
+
+Defaults / ksection / fkinit
+    should overwrite be allowed in fkinit? (fxfopen)
+
+check on file clobber
+
+
+----------------------------------------------------------------------------
+Extension, default image type
+
+imtype
+    The purpose of imtype is to control the types of images automatically
+    created by the system if no image extension is specified.
+
+    new image - determines default image type
+    new copy  - determines default image type if noinherit 
+    no extn   - up to kernel whether this is legal
+
+    imtype = [(oif|fxf|plf|qpf|stf) | <any-valid-extn>] [[no]inherit]
+
+    save format codes ("oif" etc) in driver descriptors
+    extensions are mapped to drivers using imextn
+
+
+imextn
+    map file extensions to image type (kernel)
+    default extension for new images of a given type
+
+    imextn = "oif:imh stf:hhh,??h fits:,fits,fit
+
+    or possibly imextn = "imh:oif hhh,??h:stf fits,fit:fit
+
+    kernels:	oif fxf plf qpf stf
+
+	     iki_extninit (imtype, def_imtype, imextn, def_imextn)
+	    iki_validextn (kernel, extn)
+     status = iki_getextn (kernel, index, extn, maxch)
+
+    Initialize extension processing stuff at iki_init time - only once when
+    the process starts up.
+
+    nextn
+    { kernel extn patbuf }
+    sbuf, sbufused
+    defimtype
+    inherit
+
+IKI - add kernel arg to:
+    access
+    copy
+    delete
+    open
+    rename
+
+
+
+
+
diff --git a/sys/imio/iki/fxf/README b/sys/imio/iki/fxf/README
new file mode 100644
index 00000000..9c723b94
--- /dev/null
+++ b/sys/imio/iki/fxf/README
@@ -0,0 +1,5 @@
+# IKI/FXF -- Fits extension image kernel.
+# There is a document describing the differents FK supported parameters:
+#   iraf.noao.edu/iraf/web/docs/fitsuserguide.html
+# A PS file of this can be found in iraf.noao.edu/iraf/docs/fitsuserguide.ps.Z
+
diff --git a/sys/imio/iki/fxf/fxf.h b/sys/imio/iki/fxf/fxf.h
new file mode 100644
index 00000000..c4e6188b
--- /dev/null
+++ b/sys/imio/iki/fxf/fxf.h
@@ -0,0 +1,172 @@
+# FITS.H -- IKI/FITS internal definitions.
+
+define	FITS_ORIGIN	"NOAO-IRAF FITS Image Kernel July 2003"
+
+define	FITS_LENEXTN	4		# max length imagefile extension
+define	SZ_DATATYPE	16		# size of datatype string (eg "REAL*4")
+define	SZ_EXTTYPE	20		# size of exttype string (eg BINTABLE)
+define	SZ_KEYWORD	8		# size of a FITS keyword
+define	SZ_EXTRASPACE	(81*32)		# extra space for new cards in header
+define	DEF_PHULINES	0		# initial allocation for PHU
+define	DEF_EHULINES	0		# initial allocation for EHU
+define	DEF_PADLINES	0		# initial value for extra lines in HU
+define	DEF_PLMAXLEN	32768		# default max PLIO encoded line length
+define	DEF_PLDEPTH	0		# default PLIO mask depth
+
+define	FITS_BLOCK_BYTES 2880		# FITS logical block length (bytes)
+define	FITS_BLOCK_CHARS 1440		# FITS logical block length (spp chars)
+define	FITS_STARTVALUE 10		# first column of value field
+define	FITS_ENDVALUE	30		# last	column of value field
+define	FITS_SZVALSTR	21		# nchars in value string
+define	LEN_CARD	80		# length of FITS card.
+define	LEN_UACARD	81		# size of a Userarea line.
+define	LEN_OBJECT	63		# maximum length of a FITS string value
+define	LEN_FORMAT	40		# maximum length of a TFORM value
+define	NO_KEYW		-1		# indicates no keyword is present.
+
+define	MAX_OFFSETS	100		# max number of offsets per cache entry.
+define	MAX_CACHE	60		# max number of cache entries.
+define	DEF_CACHE	10		# default number of cache entries.
+
+define	DEF_HDREXTN	"fits"		# default header file extension
+define	ENV_FKINIT	"fkinit"	# FITS kernel initialization
+
+define	DEF_ISOCUTOVER	0		# date when ISO format dates kick in
+define	ENV_ISOCUTOVER	"isodates"	# environment override for default
+
+define	FITS_BYTE	8	# Bits in a FITS byte
+define	FITS_SHORT	16	# Bits in a FITS short
+define	FITS_LONG	32	# Bits in a FITS long
+define	FITS_REAL	-32	# 32 Bits FITS IEEE float representation
+define	FITS_DOUBLE	-64	# 64 Bits FITS IEEE double representation
+
+define	COL_VALUE	11	# Starting column for parameter values
+define	NDEC_REAL	7	# Precision of real
+define	NDEC_DOUBLE	14	# Precision of double
+
+define	FITS_LEN_CHAR	(((($1) + 1439)/1440)* 1440)
+
+# Extension subtypes.
+define	FK_PLIO		1
+
+# Mapping of FITS Keywords to IRAF image header.  All unrecognized keywords
+# are stored here.
+
+#define	UNKNOWN	 Memc[($1+IMU-1)*SZ_MII_INT+1]
+define	UNKNOWN	 Memc[($1+IMU-1)*SZ_STRUCT+1]
+
+
+# FITS image descriptor, used internally by the FITS kernel.  The required
+# header parameters are maintained in this descriptor, everything else is
+# simply copied into the user area of the IMIO descriptor.
+
+define	LEN_FITDES	500
+define	LEN_FITBASE	400
+
+define	FIT_ACMODE	Memi[$1]	# image access mode
+define	FIT_PFD		Memi[$1+1]	# pixel file descriptor
+define	FIT_PIXOFF	Memi[$1+2]	# pixel offset
+define	FIT_TOTPIX	Memi[$1+3]	# size of image in pixfile, chars
+define	FIT_IO		Memi[$1+4]	# FITS I/O channel
+define	FIT_ZCNV	Memi[$1+5]	# set if on-the-fly conversion needed
+define	FIT_IOSTAT	Memi[$1+6]	# i/o status for zfio routines
+define  FIT_TFORMP      Memi[$1+7]      # TFORM keyword value pointer
+define  FIT_TTYPEP      Memi[$1+8]      # TTYPE keyword value pointer
+define  FIT_TFIELDS     Memi[$1+9]      # number of fields in binary table
+define  FIT_PCOUNT      Memi[$1+10]     # PCOUNT keyword value
+			# extra space
+define	FIT_BSCALE	Memd[P2D($1+16)]
+define	FIT_BZERO	Memd[P2D($1+18)]
+define	FIT_BITPIX	Memi[$1+20]	# bits per pixel
+define	FIT_NAXIS	Memi[$1+21]	# number of axes in image
+define	FIT_LENAXIS	Memi[$1+22+$2-1]# 35:41 = [7] max
+define	FIT_ZBYTES	Memi[$1+30]	# Status value for FIT_ZCNV mode
+define	FIT_HFD		Memi[$1+31]	# Header file descriptor
+define	FIT_PIXTYPE	Memi[$1+32]
+define	FIT_CACHEHDR	Memi[$1+33]	# Cached main header unit's address.
+define	FIT_CACHEHLEN	Memi[$1+34]	# Lenght of the above.
+define	FIT_IM		Memi[$1+35]	# Has the 'im' descriptor value 
+define	FIT_GROUP	Memi[$1+36]
+define	FIT_NEWIMAGE	Memi[$1+37]	# Newimage flag
+define	FIT_HDRPTR	Memi[$1+38]	# Header data Xtension pointer
+define	FIT_PIXPTR	Memi[$1+39]	# Pixel data Xtension pointer
+define	FIT_NUMOFFS	Memi[$1+40]	# Number of offsets in cache header.
+define	FIT_EOFSIZE	Memi[$1+41]	# Size in char of file before append.
+define	FIT_XTENSION	Memi[$1+42]	# Yes, if an Xtension has been read.
+define	FIT_INHERIT	Memi[$1+43]	# INHERIT header keyword value.
+define	FIT_EXTVER	Memi[$1+44]	# EXTVER value (integer only)
+define	FIT_EXPAND	Memi[$1+45]	# Expand the header?
+define	FIT_MIN		Memr[P2R($1+46)]# Minimum pixel value
+define	FIT_MAX		Memr[P2R($1+47)]# Maximum pixel value
+define	FIT_MTIME	Meml[$1+48]	# Time of last mod. for FITS unit 
+define	FIT_SVNANR	Memr[P2R($1+49)]
+define	FIT_SVNAND	Memd[P2D($1+50)]
+define	FIT_SVMAPRIN	Memi[$1+52]
+define	FIT_SVMAPROUT	Memi[$1+53]
+define	FIT_SVMAPDIN	Memi[$1+54]
+define	FIT_SVMAPDOUT	Memi[$1+55]
+define	FIT_EXTEND	Memi[$1+56]	# FITS extend keyword
+define	FIT_PLMAXLEN	Memi[$1+57]	# PLIO maximum linelen
+			# extra space
+define	FIT_EXTTYPE	Memc[P2C($1+70)]  # extension type
+define	FIT_FILENAME	Memc[P2C($1+110)] # FILENAME value 
+define	FIT_EXTNAME	Memc[P2C($1+150)] # EXTNAME value 
+define	FIT_DATATYPE	Memc[P2C($1+190)] # datatype string
+define	FIT_TITLE	Memc[P2C($1+230)] # title string
+define	FIT_OBJECT	Memc[P2C($1+270)] # object string
+define  FIT_EXTSTYPE    Memc[P2C($1+310)] # FITS extension subtype
+			# extra space
+
+# The FKS terms carry the fkinit or kernel section arguments.
+define	FKS_APPEND	Memi[$1+400]	# YES, NO append an extension
+define	FKS_INHERIT	Memi[$1+401]	# YES, NO inherit the main header
+define	FKS_OVERWRITE	Memi[$1+402]	# YES, NO overwrite an extension
+define	FKS_DUPNAME	Memi[$1+403]	# YES, NO allow duplicated EXTNAME
+define	FKS_EXTVER	Memi[$1+404]	# YES, NO allow duplicated EXTNAME
+define	FKS_EXPAND	Memi[$1+405]	# YES, NO expand the header
+define	FKS_PHULINES	Memi[$1+406]	# Allocated lines in PHU
+define	FKS_EHULINES	Memi[$1+407]	# Allocated lines in EHU
+define	FKS_PADLINES	Memi[$1+408]	# Additional lines for HU
+define	FKS_NEWFILE	Memi[$1+409]	# YES, NO force newfile
+define	FKS_CACHESIZE	Memi[$1+410]	# size of header cache
+define  FKS_SUBTYPE     Memi[$1+411]	# BINTABLE subtype
+define	FKS_EXTNAME	Memc[P2C($1+412)] # EXTNAME value
+			# extra space
+
+
+# Reserved FITS keywords known to this code.
+
+define	FK_KEYWORDS "|bitpix|datatype|end|naxis|naxisn|simple|bscale|bzero\
+|origin|iraf-tlm|filename|extend|irafname|irafmax|irafmin|datamax\
+|datamin|xtension|object|pcount|extname|extver|nextend|inherit\
+|zcmptype|tform|ttype|tfields|date|"
+
+define	KW_BITPIX	1
+define	KW_DATATYPE	2
+define	KW_END		3
+define	KW_NAXIS	4
+define	KW_NAXISN	5
+define	KW_SIMPLE	6
+define	KW_BSCALE	7
+define	KW_BZERO	8
+define	KW_ORIGIN	9
+define	KW_IRAFTLM	10
+define	KW_FILENAME	11
+define	KW_EXTEND	12
+define	KW_IRAFNAME	13
+define	KW_IRAFMAX	14
+define	KW_IRAFMIN	15
+define	KW_DATAMAX	16
+define	KW_DATAMIN	17
+define	KW_XTENSION	18
+define	KW_OBJECT	19
+define	KW_PCOUNT	20
+define	KW_EXTNAME	21
+define	KW_EXTVER	22
+define	KW_NEXTEND	23
+define	KW_INHERIT	24
+define  KW_ZCMPTYPE     25
+define  KW_TFORM        26
+define  KW_TTYPE        27
+define  KW_TFIELDS      28
+define  KW_DATE         29
diff --git a/sys/imio/iki/fxf/fxfaccess.x b/sys/imio/iki/fxf/fxfaccess.x
new file mode 100644
index 00000000..860724f0
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfaccess.x
@@ -0,0 +1,59 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"fxf.h"
+
+
+# FXF_ACCESS -- Test the accessibility or existence of an existing image, or
+# the legality of the name of a new image.  Returns status = YES or NO.
+
+procedure fxf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O status code
+
+int	i
+pointer	sp, fname, kextn
+int	access(), iki_validextn(), iki_getextn(), btoi()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (kextn, FITS_LENEXTN, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+	    call sfree (sp)
+	    return
+	}
+
+	status = NO
+
+	# If no extension was given, look for a file with the default
+	# extension, and return the actual extension if an image with the
+	# default extension is found.
+
+	if (extn[1] == EOS) {
+	    do i = 1, ARB {
+		if (iki_getextn (kernel, i, Memc[kextn], FITS_LENEXTN) <= 0)
+		    break
+		call iki_mkfname (root, Memc[kextn], Memc[fname], SZ_PATHNAME)
+		if (access (Memc[fname], acmode, 0) == YES) {
+		    call strcpy (Memc[kextn], extn, FITS_LENEXTN)
+		    status = YES
+		    break
+		}
+	    }		
+	} else if (iki_validextn (kernel, extn) == kernel) {
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	    if (access (Memc[fname], acmode, 0) == YES)
+		status = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfaddpar.x b/sys/imio/iki/fxf/fxfaddpar.x
new file mode 100644
index 00000000..ce7849f5
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfaddpar.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include "fxf.h"
+
+# FXF_ADDPAR -- Encode a parameter in FITS format and add it to the FITS format
+# IMIO userarea.
+
+procedure fxf_addpar (im, pname, dtype, pval)
+
+pointer	im			#I image descriptor
+char	pname[ARB]		#I parameter name
+int	dtype			#I SPP datatype of parameter
+char	pval[ARB]		#I string encoded parameter value
+
+bool	bval
+real	rval
+double	dval
+short	sval
+long	lval
+int	ival, ip, junk
+int	ctoi(), ctor(), ctod()
+errchk	imadds, imaddl, imaddr, imaddd, imastr
+
+begin
+	ip  = 1
+
+	switch (dtype) {
+	case TY_BOOL:
+	    bval = (pval[1] == 'T')
+	    call imaddb (im, pname, bval)
+	case TY_SHORT:
+	    junk = ctoi (pval, ip, ival)
+	    sval = ival
+	    call imadds (im, pname, sval)
+	case TY_INT, TY_LONG:
+	    junk = ctoi (pval, ip, ival)
+	    lval = ival
+	    call imaddl (im, pname, lval)
+	case TY_REAL:
+	    junk = ctor (pval, ip, rval)
+	    call imaddr (im, pname, rval)
+	case TY_DOUBLE:
+	    junk = ctod (pval, ip, dval)
+	    call imaddd (im, pname, dval)
+	default:
+	    call imastr (im, pname, pval)
+	}
+end
diff --git a/sys/imio/iki/fxf/fxfcache.com b/sys/imio/iki/fxf/fxfcache.com
new file mode 100644
index 00000000..c38317aa
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfcache.com
@@ -0,0 +1,24 @@
+# FXFCACHE.COM -- Named common block used to cache filenames and image
+# extension information.
+#
+# ##### This should be reimplemented to use a small package (i.e. functions)
+# ##### rather than global common.  rf_fname below is using a lot of memory.
+# ##### Dynamic memory allocation or a packed string buffer should be used
+# ##### instead.  Not worth fixing though until the cache code is redone.
+
+int	rf_cachesize
+pointer rf_fit[MAX_CACHE]		# FITS descriptor
+pointer rf_hdrp[MAX_CACHE]		# Fits headers pointer
+pointer rf_pixp[MAX_CACHE]		# Fits pixels pointer
+pointer rf_pextn[MAX_CACHE]		# EXTNAME pointer
+pointer rf_pextv[MAX_CACHE]		# EXTVER pointer
+int	rf_lru[MAX_CACHE]		# Lowest value is oldest slot
+long	rf_time[MAX_CACHE]		# Time when entry was cached
+long	rf_mtime[MAX_CACHE]		# Modify time of file in cache
+int	rf_hdr[MAX_CACHE]		# FITS Primary header data
+int	rf_fitslen[MAX_CACHE]		# Size Primary header data
+char	rf_fname[SZ_PATHNAME,MAX_CACHE] # Header file pathname
+
+common /fxflcachec/ rf_time, rf_mtime
+common /fxfcachec/ rf_cachesize, rf_fit, rf_hdrp, rf_pixp, rf_pextn,
+       rf_pextv, rf_lru, rf_hdr, rf_fitslen, rf_fname
diff --git a/sys/imio/iki/fxf/fxfclose.x b/sys/imio/iki/fxf/fxfclose.x
new file mode 100644
index 00000000..72313316
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfclose.x
@@ -0,0 +1,42 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <imhdr.h>
+include <imio.h>
+include	"fxf.h"
+
+# FXF_CLOSE -- Close a FITS format image.  There is little for us to do, since
+# IMIO will already have updated the header if necessary and flushed any pixel
+# output.  Neither do we have to deallocate the IMIO descriptor, since it was
+# allocated by IMIO.
+
+procedure fxf_close (im, status)
+
+pointer	im		#I image descriptor
+int	status		#O status value
+
+pointer fit
+errchk	close
+
+begin
+	fit = IM_KDES(im)
+
+	# Reset the IEEE interface to its original state.
+	switch (IM_ACMODE(im)) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY:
+	    call ieesnanr (FIT_SVNANR(fit))
+	    call ieesmapr (FIT_SVMAPRIN(fit), FIT_SVMAPROUT(fit))
+	    call ieesnand (FIT_SVNAND(fit))
+	    call ieesmapd (FIT_SVMAPDIN(fit), FIT_SVMAPDOUT(fit))
+	default:
+	    ;
+	}
+
+	# Close the fits file.
+	if (IM_PFD(im) != NULL) 
+	    call close (IM_PFD(im))
+	
+	# Deallocate the FIT descriptor.
+	call mfree (fit, TY_STRUCT)
+
+	status = OK
+end
diff --git a/sys/imio/iki/fxf/fxfcopy.x b/sys/imio/iki/fxf/fxfcopy.x
new file mode 100644
index 00000000..3fb4d51b
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfcopy.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<error.h>
+
+# FXF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure fxf_copy (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		#I old image root name
+char	oextn[ARB]		#I old image extn
+char	nroot[ARB]		#I new image root name
+char	nextn[ARB]		#I old image extn
+int	status
+
+pointer	sp
+pointer	ohdr_fname, nhdr_fname
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	iferr (call fcopy (Memc[ohdr_fname], Memc[nhdr_fname]))
+	    call erract (EA_WARN)
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/fxf/fxfctype.x b/sys/imio/iki/fxf/fxfctype.x
new file mode 100644
index 00000000..f916e344
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfctype.x
@@ -0,0 +1,72 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<ctype.h>
+include	"fxf.h"
+
+
+# FXF_CTYPE -- Determine the type of a FITS card. 
+
+int procedure fxf_ctype (card, kwindex)
+
+char	card[ARB]			#I FITS card (or keyword)
+int	kwindex				#O index number, if any
+
+pointer sp, kwname
+char	kw[SZ_KEYWORD]
+int	index, ch, i, ip
+int	strncmp(), strdic(), strlen(), ctoi()
+string  keywords FK_KEYWORDS
+
+begin
+	call smark (sp)
+	call salloc (kwname, LEN_CARD, TY_CHAR)
+
+	# Check for a reference to one of the NAXIS keywords.
+	kwindex= 0
+	if (card[1] == 'N')
+	    if (strncmp (card, "NAXIS", 5) == 0) {
+		ch = card[6]
+		if (ch == EOS || (IS_DIGIT(ch) && card[7] == ' ')) {
+		    kwindex = TO_INTEG(ch)
+		}
+		call sfree (sp)
+		return (KW_NAXIS)
+	    }
+
+	# See if it is one of the "T"-prefixed (binary table) keywords.
+	if (card[1] == 'T') {
+	    ip = 6
+	    if (strncmp (card, "TFORM", 5) == 0) {
+		if (ctoi (card, ip,  kwindex) < 1)
+		    kwindex = 0
+		call sfree (sp)
+		return (KW_TFORM)
+	    }
+	    if (strncmp (card, "TTYPE", 5) == 0) {
+		if (ctoi (card, ip,  kwindex) < 1)
+		    kwindex = 0
+		call sfree (sp)
+		return (KW_TTYPE)
+	    }
+	}
+
+	# Get keyword name in lower case with no blanks. 
+        do i = 1, SZ_KEYWORD {
+	    if (IS_WHITE(card[i])) {
+		kw[i] = EOS
+		break
+	    } else if (IS_UPPER(card[i]))
+		kw[i] = TO_LOWER (card[i])
+	    else
+		kw[i] = card[i]
+	}
+
+	# Look up keyword in dictionary.  Abbreviations are not permitted.
+	index = strdic (kw, Memc[kwname], LEN_CARD, keywords)
+	if (index != 0)
+	    if (strlen(kw) != strlen(Memc[kwname]))
+		index = 0
+
+	call sfree (sp)
+	return (index)
+end
diff --git a/sys/imio/iki/fxf/fxfdelete.x b/sys/imio/iki/fxf/fxfdelete.x
new file mode 100644
index 00000000..ae7fbffc
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfdelete.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include "fxf.h"
+
+# FXF_DELETE -- Delete a FITS file.  NOTE: it is not possible to delete an
+# individual extension at this time.
+
+procedure fxf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I header file extension
+int	status			#O status value
+
+int	cindx
+pointer	sp, fname, im, tmp
+pointer	immapz()
+bool    streq()
+
+errchk  syserrs
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+        call salloc (tmp, SZ_PATHNAME, TY_CHAR)
+
+	call fxf_init()
+	status = OK
+
+	# Get the file extension if not given.
+        if (extn[1] == EOS) {
+	    call fxf_access (kernel, root, extn, READ_ONLY, status)
+	    if (status == NO) {
+		call sfree (sp)
+		status = ERR
+		return
+	    }
+	}
+
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	call strcpy (Memc[fname], Memc[tmp], SZ_PATHNAME)
+	call strcat ("[0]", Memc[tmp], SZ_PATHNAME)
+	iferr (im = immapz (Memc[tmp], READ_ONLY, 0))
+	    call syserrs (SYS_FXFDELMEF, Memc[fname])
+	else
+	    call imunmap (im)
+
+	iferr (call delete (Memc[fname]))
+	    call erract (EA_WARN)
+
+	# Remove the image from the FITS cache if found.
+	do cindx=1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+		next
+	    if (streq (Memc[fname], rf_fname[1,cindx])) {
+		call mfree (rf_pextv[cindx], TY_INT)
+		call mfree (rf_pextn[cindx], TY_CHAR)
+		call mfree (rf_pixp[cindx], TY_INT)
+		call mfree (rf_hdrp[cindx], TY_INT)
+		call mfree (rf_fit[cindx], TY_STRUCT)
+		call mfree (rf_hdr[cindx], TY_CHAR)
+		rf_fit[cindx] = NULL
+		rf_lru[cindx] = 0
+		rf_fname[1,cindx] = EOS
+	    }
+	}
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfencode.x b/sys/imio/iki/fxf/fxfencode.x
new file mode 100644
index 00000000..ea2e83dd
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfencode.x
@@ -0,0 +1,348 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <time.h>
+include "fxf.h"
+
+# FXFENCODE.X -- Routines to encode a keyword, its value and a comment into
+# a FITS card.
+#
+#	fxf_encode_axis (root, keyword, axisno)
+#	fxf_encode_date (ctime, datestr, szdate, format, cutover)
+#
+#	    fxf_encodeb (keyword, param, card, comment)
+#	    fxf_encodei (keyword, param, card, comment)
+#	    fxf_encodel (keyword, param, card, comment)
+#	    fxf_encoder (keyword, param, card, comment, precision)
+#	    fxf_encoded (keyword, param, card, comment, precision)
+#	    fxf_encodec (keyword, param, maxch, card, comment)
+#
+#	       fxf_akwc (keyword, value, len, comment, pn)
+#	       fxf_akwb (keyword, value, comment, pn)
+#	       fxf_akwi (keyword, value, comment, pn)
+#	       fxf_akwr (keyword, value, comment, precision, pn)
+#	       fxf_akwd (keyword, value, comment, precision, pn)
+#
+# Encode_axis adds an axis number to a keyword ("rootXXX").  Encode_date
+# encodes the current date as a string in the form "dd/mm/yy".
+
+
+# FXF_ENCODEB -- Encode a boolean parameter into a FITS card.
+
+procedure fxf_encodeb (keyword, param, card, comment)
+
+char	keyword[ARB]	# FITS keyword
+int	param		# integer parameter equal to YES/NO
+char	card[ARB]	# FITS card image
+char	comment[ARB]	# FITS comment string
+
+char	truth
+
+begin
+	if (param == YES)
+	    truth = 'T'
+	else
+	    truth = 'F'
+
+	call sprintf (card, LEN_CARD, "%-8.8s= %20c / %-47.47s")
+	    call pargstr (keyword)
+	    call pargc (truth)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODEI -- Encode an integer parameter into a FITS card.
+
+procedure fxf_encodei (keyword, param, card, comment)
+
+char	keyword[ARB]	# FITS keyword
+int	param		# integer parameter
+char	card[ARB]	# FITS card image
+char	comment[ARB]	# FITS comment string
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20d / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (param)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODEL -- Encode a long parameter into a FITS card.
+
+procedure fxf_encodel (keyword, param, card, comment)
+
+char	keyword[ARB]		# FITS keyword
+long	param			# long integer parameter
+char	card[ARB]		# FITS card image
+char	comment[ARB]		# FITS comment string
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20d / %-47.47s")
+	    call pargstr (keyword)
+	    call pargl (param)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODER -- Encode a real parameter into a FITS card.
+
+procedure fxf_encoder (keyword, param, card, comment, precision)
+
+char	keyword[ARB]		# FITS keyword
+real	param			# real parameter
+char	card[ARB]		# FITS card image
+char	comment[ARB]		# FITS comment card
+int	precision		# precision of real
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20.*e / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargr (param)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODED -- Encode a double parameter into a FITS card.
+
+procedure fxf_encoded (keyword, param, card, comment, precision)
+
+char	keyword[ARB]		# FITS keyword
+double	param			# double parameter
+char	card[ARB]		# FITS card image
+char	comment[ARB]		# FITS comment string
+int	precision		# FITS precision
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20.*e / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargd (param)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODE_AXIS -- Add the axis number to axis dependent keywords.
+
+procedure fxf_encode_axis (root, keyword, axisno)
+
+char	root[ARB]		# FITS root keyword
+char	keyword[ARB]		# FITS keyword
+int	axisno			# FITS axis number
+
+int	len, strlen()
+
+begin
+	call strcpy (root, keyword, SZ_KEYWORD)
+	len = strlen (keyword)
+	call sprintf (keyword, SZ_KEYWORD, "%*.*s%d")
+	    call pargi (-len)
+	    call pargi (len)
+	    call pargstr (root)
+	    call pargi (axisno)
+end
+
+
+# FXF_ENCODEC -- Procedure to encode an IRAF string parameter into a FITS card.
+
+procedure fxf_encodec (keyword, param, maxch, card, comment)
+
+char	keyword[LEN_CARD]	# FITS keyword
+char	param[LEN_CARD]		# FITS string parameter
+int	maxch			# maximum chars in value string
+char	card[LEN_CARD+1]	# FITS card image
+char	comment[LEN_CARD]	# comment string
+
+int	nblanks, maxchar, slashp
+
+begin
+	maxchar = max(8, min (maxch, LEN_OBJECT))
+	slashp = 32 
+	nblanks = LEN_CARD - (slashp + 1)
+	if (maxchar >= 19) {
+	   slashp = 1
+	   nblanks = max (LEN_OBJECT - maxchar - slashp+3, 1)
+	}
+
+	call sprintf (card, LEN_CARD, "%-8.8s= '%*.*s' %*t/ %*.*s")
+	    call pargstr (keyword)
+	    call pargi (-maxchar)
+	    call pargi (maxchar)
+	    call pargstr (param)
+	    call pargi (slashp)
+	    call pargi (-nblanks)
+	    call pargi (nblanks)
+	    call pargstr (comment)
+end
+
+
+# FXF_ENCODE_DATE -- Encode the current date as a string value.
+#
+# New Y2K format:	yyyy-mm-ddThh:mm:sec
+# Old FITS format:	dd/mm/yy
+# Old TLM format:	hh:mm:ss (dd/mm/yyyy)
+#
+# We still write the old format for dates 1999 or less.
+
+procedure fxf_encode_date (ctime, datestr, maxch, format, cutover)
+
+long	ctime			#I time value to be encoded
+char	datestr[ARB]		#O string containing the date
+int	maxch			#I number of chars in the date string
+char	format[ARB]		#I desired date format for old dates
+int	cutover			#I write new format for years >= cutover
+
+int	tm[LEN_TMSTRUCT], nchars
+int	dtm_encode_hms()
+long	lsttogmt()
+bool	streq()
+
+begin
+	# Find out what year it is.
+	call brktime (ctime, tm)
+
+	# Encode in ISO format for years >= cutover year.
+
+	if (TM_YEAR(tm) >= cutover) {
+	    # ISO format is used for all new date stamps.
+	    call brktime (lsttogmt(ctime), tm)
+	    nchars = dtm_encode_hms (datestr, maxch,
+		TM_YEAR(tm), TM_MONTH(tm), TM_MDAY(tm),
+		TM_HOUR(tm), TM_MIN(tm), double(TM_SEC(tm)), 0, 0)
+
+	} else if (streq (format, "TLM")) {
+	    # TLM format is for old-format DATE-TLM keywords.
+	    call sprintf (datestr, maxch, "%02d:%02d:%02d (%02d/%02d/%d)")
+		call pargi (TM_HOUR(tm))
+		call pargi (TM_MIN(tm))
+		call pargi (TM_SEC(tm))
+		call pargi (TM_MDAY(tm))
+		call pargi (TM_MONTH(tm))
+		call pargi (TM_YEAR(tm))
+
+	} else {
+	    # The default otherwise is the old FITS format.
+	    call sprintf (datestr, maxch, "%02d/%02d/%02d")
+		call pargi (TM_MDAY(tm))
+		call pargi (TM_MONTH(tm))
+		call pargi (mod(TM_YEAR(tm),100))
+
+	}
+end
+
+
+# FXF_AKWC -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwc (keyword, value, len, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# keyword name
+char	value[ARB]		# keyword value
+int	len			# length of value
+char	comment[ARB]		# comment
+pointer pn			# pointer to a char area
+char	card[LEN_CARD]
+
+begin
+	call fxf_encodec (keyword, value, len, card, comment)
+	call amovc (card, Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+end
+
+
+# FXF_AKWB -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwb (keyword, value, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+int	value			# I Keyword value (YES, NO)
+char	comment[ARB]		# I Comment
+pointer pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+	call smark (sp)
+	call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call fxf_encodeb (keyword, value, Memc[pc], comment)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree (sp)
+end
+
+
+# FXF_AKWI -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwi (keyword, value, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+int	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+pointer pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+	call smark (sp)
+	call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call fxf_encodei (keyword, value, Memc[pc], comment)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree (sp)
+end
+
+
+# FXF_AKWR -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwr (keyword, value, comment, precision, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+real	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+int	precision
+pointer pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+	call smark (sp)
+	call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call fxf_encoder (keyword, value, Memc[pc], comment, precision)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree (sp)
+end
+
+
+# FXF_AKWD -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure fxf_akwd (keyword, value, comment, precision, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+double	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+int	precision
+pointer pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+	call smark (sp)
+	call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call fxf_encoded (keyword, value, Memc[pc], comment, precision)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfexpandh.x b/sys/imio/iki/fxf/fxfexpandh.x
new file mode 100644
index 00000000..9e00d582
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfexpandh.x
@@ -0,0 +1,375 @@
+include <imio.h>
+include <imhdr.h>
+include <mii.h>
+include <fset.h>
+include <mach.h>
+include <syserr.h>
+include "fxf.h"
+
+define MIN_BUFSIZE     2880
+
+
+# FXF_EXPANDH -- Routine to expand all the headers of a MEF file. The calling
+# routine only requires that extension 'group' be expanded but when dealing
+# with large MEF files with many extensions this procedure can take a long
+# time if the application code wants to expand more than one header.
+# fxf_expandh will expand all the headers in the file so they will have at 
+# least 'nlines' blank cards.
+
+procedure fxf_expandh (in_fd, out_fd, nlines, group, nbks, hdroff, pixoff)
+
+int	in_fd		#I input file descriptor
+int	out_fd		#I output file descriptor
+int	nlines		#I minimum number of blank cards
+int	group		#I group that initiated the expansion
+int	nbks		#I numbers of blocks to expand group 'group'
+int	hdroff		#O new offset for beginning of 'group' 
+int	pixoff		#0 new offset for beginning of data
+
+pointer hd, ip, op, buf
+char	line[80], endl[80]
+int	gn, newc, k, nchars, nbk, hsize
+int	fxf_xaddl(), read()
+
+int	bufsize, psize, rem, hoffset, poffset
+int	note(), fstati()
+errchk	malloc, read, write
+
+begin
+	# In case nlines is zero set a minimum > 0.
+	nlines = max (nlines, 10)
+
+	# Initialize a blank line.
+	call amovks (" ", line, LEN_CARD)
+
+	# Initialize END card image.
+	call amovc ("END", endl, 3)
+	call amovks (" ", endl[4], LEN_CARD-3)
+
+	call fseti (in_fd, F_ADVICE, SEQUENTIAL)
+	call fseti (out_fd, F_ADVICE, SEQUENTIAL)
+
+	bufsize = max (MIN_BUFSIZE, fstati (in_fd, F_BUFSIZE))
+	call malloc (buf, bufsize, TY_CHAR)
+
+	gn = 0
+	hd = buf
+
+	repeat { 
+	    hd = buf
+	    if (group == gn) 
+	        hdroff = note(out_fd)
+
+	    # Read and write header information. The last block must 
+	    # have the END card and is output from this routine.
+
+	    iferr (call fxf_xhrd (in_fd, out_fd, Memc[buf], bufsize, hoffset, 
+		poffset, hsize))
+		    break
+	    
+	    # Determine the number of cards to expand. newc is in blocks
+	    # of 36 cards. 0, 36, 72, ...
+
+	    newc = fxf_xaddl (buf, hsize, nlines)
+
+	    # expand the given group at least one block
+	    if (newc == 0 && nbks > 0 && group == gn)
+		newc = nbks * 36
+
+	    # OP points to the top of the last block read, IP to the bottom.
+	    op = buf + hsize - FITS_BLOCK_BYTES
+	    ip = buf + hsize
+
+	    if (newc == 0) {
+		# Leave space for the END card.
+	        ip = ip - 80
+	    } else {
+	        # Write current buffer before writing blanks.
+		call miipak (Memc[op], Memc[op], FITS_BLOCK_BYTES, 
+		    TY_CHAR,MII_BYTE)
+		call write (out_fd, Memc[op], FITS_BLOCK_CHARS)
+
+		# Use the same buffer space since we are using blanks
+		ip = ip - FITS_BLOCK_BYTES
+		op = ip
+	    }
+
+	    # Write the blank cards.
+	    do k = 1, newc-1 {
+	        call amovc (line, Memc[ip], LEN_CARD)
+	        ip = ip + LEN_CARD
+		if (mod (k,36) == 0) {
+		    # We have more than one block of blanks.
+		    call miipak (Memc[op], Memc[op], nchars, TY_CHAR, MII_BYTE)
+		    call write (out_fd, Memc[op], FITS_BLOCK_CHARS)
+
+		    # Notice we used the same buffer space
+		    ip = ip - FITS_BLOCK_BYTES
+		    op = ip
+	        }
+	    }
+	    
+	    # Finally the END card.
+	    call amovc (endl, Memc[ip], LEN_CARD)
+	    nchars = 2880
+	    call miipak (Memc[op], Memc[op], nchars, TY_CHAR, MII_BYTE)
+	    call write (out_fd, Memc[op], nchars/2)
+
+	    # Get the number of blocks of pixel data to copy.  We are not
+	    # changing anything; it is straight copy.
+
+	    psize = (hoffset - poffset)
+
+	    nbk = psize / bufsize
+	    rem = mod(psize,bufsize)
+
+            if (group == gn)
+		pixoff = note(out_fd)
+
+	    do k = 1, nbk {
+		nchars = read (in_fd, Memc[buf], bufsize)
+		call write (out_fd, Memc[buf], bufsize)
+	    }
+	    if (rem > 0) {
+		nchars = read (in_fd, Memc[buf], rem)
+		call write (out_fd, Memc[buf], rem)
+	    }
+	    gn = gn + 1
+	}
+ 
+	call mfree (buf, TY_CHAR)
+end
+
+
+# FXF_XHRD -- Procedure to read 2880 bytes blocks of header from 'in'
+# and copy them to 'out'.  The last block read contains the END card
+# and is pass to the calling routine which will write it out to 'out.
+
+procedure fxf_xhrd (in, out, buf, bufsize, hoffset, poffset, hsize)
+
+int	in		#I Input file descriptor
+int	out		#I output file descriptor
+char	buf[ARB]	#I Working buffer
+int	bufsize		#I Workign buffer size
+int	hoffset		#O Header offset for next group
+int	poffset		#O Data offset for current group
+int	hsize		#O Number of cards read in header
+
+pointer	sp, hb
+int	nblks, totpix, i, j, ip, nchars
+int	strncmp(), note(), read()
+bool	end_card, fxf_xn_decode_blk1()
+
+include "fxfcache.com"
+errchk  syserr, read, write
+
+begin
+	call smark (sp)
+	call salloc (hb, 1440, TY_CHAR)
+
+	hoffset = note (in)
+
+	# Read first block of header.
+	nchars = read (in, Memc[hb], FITS_BLOCK_CHARS)
+	if (nchars == EOF) {
+	    call sfree (sp)
+	    call syserr (SYS_FXFRFEOF)
+	}
+
+	call miiupk (Memc[hb], buf, FITS_BLOCK_BYTES, MII_BYTE,TY_CHAR)
+	end_card = fxf_xn_decode_blk1 (buf, totpix)
+	if (!end_card) {
+	    call miipak (buf, Memc[hb], FITS_BLOCK_BYTES, TY_CHAR, MII_BYTE)
+	    call write (out, Memc[hb], FITS_BLOCK_CHARS)
+	}
+	ip = FITS_BLOCK_BYTES + 1
+
+	nblks = 1
+	if (!end_card) {
+	    # Continue reading header until the block with END
+	    # which is the last before the data block.
+
+	    while (read (in, Memc[hb], FITS_BLOCK_CHARS) != EOF) {
+	        call miiupk (Memc[hb], buf[ip], FITS_BLOCK_BYTES,
+		    MII_BYTE,TY_CHAR)
+
+		# Look for the END card
+		do i = 0, 35 {
+		   j = ip + i*LEN_CARD
+		   if (buf[j] == 'E') {
+		       if (strncmp (buf[j], "END     ", 8) == 0)
+			   end_card = true
+		   }
+		}
+	        nblks = nblks + 1
+		if (end_card)
+		    break
+	        call miipak (buf[ip], Memc[hb], FITS_BLOCK_BYTES, 
+		    TY_CHAR, MII_BYTE)
+		call write (out, Memc[hb], FITS_BLOCK_CHARS)
+	        ip = ip + FITS_BLOCK_BYTES
+
+		# If the header is really big we can run out of
+		# buffer space. Revert back to the beginning.
+
+		if (ip > bufsize) {
+		    ip = 1
+		    nblks = 1
+		}
+	    }
+	}
+
+	hsize = nblks * 36 * LEN_CARD
+
+	# We are at the beginning of the pixel area.
+	poffset = note (in)
+	
+	# Get the beginnning of the next header.
+	hoffset = poffset + totpix
+
+	call sfree (sp)
+end
+
+
+# FXF_XN_DECODE_BLK1 -- Function that return true if the 1st block of a header
+# contains the END card. The size of the pixel are is also returned.
+
+bool procedure fxf_xn_decode_blk1 (buf, datalen)
+
+char	buf[ARB]		#I header data buffer
+int	datalen			#O length of data area in chars
+
+char	card[LEN_CARD]
+int	totpix, nbytes, index, k, i, pcount, bitpix, naxis, ip
+int	len_axis[7]
+int	fxf_ctype()
+bool	end_card
+errchk	syserr, syserrs
+
+begin
+	# Read successive lines of the 1st header block
+	pcount = 0
+
+	end_card = false
+	do k = 0, 35 {
+	    ip = k*LEN_CARD + 1
+	    
+	    # Copy into a one line buffer, we need to EOS mark.
+	    call strcpy (buf[ip], card, LEN_CARD)
+	    switch (fxf_ctype (card, index)) {
+	    case KW_END:
+		end_card = true
+		break
+	    case KW_PCOUNT:
+		call fxf_geti (card, pcount)
+	    case KW_BITPIX:
+		call fxf_geti (card, bitpix)
+	    case KW_NAXIS:
+		if (index == 0) {
+		    call fxf_geti (card, naxis)
+		    if (naxis < 0 )
+			call syserr (SYS_FXFRFBNAXIS)
+	  	} else
+		    call fxf_geti (card, len_axis[index])
+	    default:
+	        ;
+	    }
+	}
+
+	# Calculate the length of the data area of the current extension,
+	# measured in SPP chars and rounded up to an integral number of FITS
+	# logical blocks.
+
+	if (naxis != 0) {
+	    totpix =  len_axis[1]
+	    do i = 2, naxis
+		totpix = totpix * len_axis[i]
+
+	    # Compute the size of the data area (pixel matrix plus PCOUNT)
+	    # in bytes.  Be careful not to overflow a 32 bit integer.
+
+	    nbytes = (totpix + pcount) * (abs(bitpix) / NBITS_BYTE)
+
+	    # Round up to fill the final 2880 byte FITS logical block.
+	    nbytes = ((nbytes + 2880-1) / 2880) * 2880
+
+	    datalen = nbytes / SZB_CHAR
+
+	} else
+	    datalen = 0
+
+	return (end_card)
+end
+
+
+# FXF_XADDL -- Algorithm to find the number of blank cards stored in the
+# input buffer.  This is the number from the end of the buffer up to the
+# last non blank card (excluding the END card).  The function returns the
+# number of extra header cards (in multiple of 36) that is necessary to 
+# add to the current header.
+
+int procedure fxf_xaddl (hd, ncua, nlines)
+
+pointer hd		#U header area pointer
+int	ncua		#I number of characters in the user area
+int	nlines		#I minimum number of header lines to be added 
+
+int	ip, nbc, k, ncards, nkeyw
+int	strncmp()
+
+begin
+	# Go to the end of buffer and get last line pointer
+	ip = hd + ncua - LEN_CARD
+	
+	# See if line is blank.
+	nbc = 0
+	while (ip > hd) {
+	    # Check for nonblank card
+	    do k = 0, LEN_CARD-1 
+		if (Memc[ip+k] != ' ')
+		    break
+
+	    # Since we are counting from the bottom, the first keyword
+	    # (except END) would end counting.
+
+	    if (k != LEN_CARD && k != 0)   # nonblank keyw card reached
+		break
+	    else if (k == 0) {
+		# Just bypass END and continue looking for blank cards
+		if (strncmp ("END     ", Memc[ip], 8) == 0) {
+		    # Clear this card as it will be written at the 
+		    # end of the output header.
+		    call amovkc (" ", Memc[ip], LEN_CARD)
+	    	    ip = ip - LEN_CARD
+		    next
+		} else
+		    break
+	    } else
+		nbc = nbc + 1
+	    ip = ip - LEN_CARD
+	}
+
+	# Calculate the number of keywords right before the last blank
+	# card and right after the last non-blank keyword, excluding the
+	# END card
+
+	nkeyw = (ip-hd)/80 + 1
+
+	ncards = ncua / LEN_CARD
+
+	# Calculate the complement with respect to 36
+	ncards = ((ncards + 35)/36)*36 - ncards
+	nbc = nbc + ncards
+
+
+	if (nbc < nlines) {
+	    # Lets add nlines-nbc cards to the header
+	    ncards = nlines - nbc
+
+	    # Adjust to a 36 cards boundary.
+	    ncards = 36 - mod (ncards, 36) + ncards
+	} else
+	    ncards = 0
+
+	return (ncards)
+end
diff --git a/sys/imio/iki/fxf/fxfget.x b/sys/imio/iki/fxf/fxfget.x
new file mode 100644
index 00000000..87b80d4f
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfget.x
@@ -0,0 +1,182 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<ctype.h>
+include	"fxf.h"
+
+# FXFGET.X -- Procedures used to get (decode) typed values from FITS cards.
+#
+#	  fxf_get[bird] (card, value)
+#	       fxf_gstr (card, outstr, maxch)
+#	     fxf_getcmt (card, comment, maxch)
+#	       fxf_gltm (time, date, limtime)
+#
+# The value is returned in the output argument.  Zero is returned if the
+# conversion fails.
+
+
+# FXF_GETI -- Return the integer value of a FITS encoded card.
+
+procedure fxf_geti (card, ival)
+
+char	card[ARB]		# card to be decoded
+int	ival			# receives integer value
+
+int	ip, ctoi()
+char	sval[FITS_SZVALSTR]
+
+begin
+	call fxf_gstr (card, sval, FITS_SZVALSTR)
+	ip = 1
+	if (ctoi (sval, ip, ival) <= 0)
+	    ival = 0
+end
+
+
+# FXF_GETR -- Return the real value of a FITS encoded card.
+
+procedure fxf_getr (card, rval)
+
+char	card[ARB]		# card to be decoded
+real	rval			# receives integer value
+
+int	ip, ctor()
+char	sval[FITS_SZVALSTR]
+
+begin
+	call fxf_gstr (card, sval, FITS_SZVALSTR)
+	ip = 1
+	if (ctor (sval, ip, rval) <= 0)
+	    rval = 0.0
+end
+
+
+# FXF_GETD -- Return the double value of a FITS encoded card.
+
+procedure fxf_getd (card, dval)
+
+char	card[ARB]		# card to be decoded
+double	dval			# receives integer value
+
+int	ip, ctod()
+char	sval[FITS_SZVALSTR]
+
+begin
+	call fxf_gstr (card, sval, FITS_SZVALSTR)
+	ip = 1
+	if (ctod (sval, ip, dval) <= 0)
+	    dval = 0.0
+end
+
+
+# FXF_GETB -- Return the boolean/integer value of a FITS encoded card.
+
+procedure fxf_getb (card, bval)
+
+char	card[ARB]		# card to be decoded
+int	bval			# receives YES/NO
+
+char	sval[FITS_SZVALSTR]
+
+begin
+	call fxf_gstr (card, sval, FITS_SZVALSTR)
+	if (sval[1] == 'T')
+	    bval = YES
+	else
+	    bval = NO
+end
+
+
+# FXF_GSTR -- Get the string value of a FITS encoded card.  Strip leading
+# and trailing whitespace and any quotes.
+
+procedure fxf_gstr (card, outstr, maxch)
+
+char	card[ARB]		# FITS card to be decoded
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+int	ip, op
+int	ctowrd(), strlen()
+
+begin
+	ip = FITS_STARTVALUE
+	if (ctowrd (card, ip, outstr, maxch) > 0) {
+	    # Strip trailing whitespace.
+	    op = strlen (outstr)
+	    while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n'))
+		op = op - 1
+	    outstr[op+1] = EOS
+	} else
+	    outstr[1] = EOS
+end
+
+
+# FXF_GETCMT -- Get the comment field of a FITS encoded card.
+
+procedure fxf_getcmt (card, comment, maxch)
+
+char	card[ARB]		#I FITS card to be decoded
+char	comment[ARB]		#O output string to receive comment
+int	maxch			#I max chars out
+
+int	ip, op
+int	lastch
+
+begin
+	# Find the slash which marks the beginning of the comment field.
+	ip = FITS_ENDVALUE + 1
+	while (card[ip] != EOS && card[ip] != '\n' && card[ip] != '/')
+	    ip = ip + 1
+
+	# Copy the comment to the output string, omitting the /, any
+	# trailing blanks, and the newline.
+
+	lastch = 0
+	do op = 1, maxch {
+	    if (card[ip] == EOS)
+		break
+	    ip = ip + 1
+	    comment[op] = card[ip]
+	    if (card[ip] > ' ')
+		lastch = op
+	}
+	comment[lastch+1] = EOS
+end
+
+
+# FXF_GLTM -- Procedure to convert an input time stream with hh:mm:ss
+# and date stream dd/mm/yy into seconds from jan 1st 1980.
+
+procedure fxf_gltm (time, date, limtime)
+
+char    time[ARB], date[ARB]
+int	limtime
+
+int	month_to_days[12], adays
+int     hr,mn,sec,days,month,year, ip, iy, days_per_year, ctoi(), i
+data    month_to_days / 0,31,59,90,120,151,181,212,243,273,304,334/
+
+begin
+
+	ip = 1;  ip = ctoi (time, ip, hr)
+	ip = 1;  ip = ctoi (time[4], ip, mn)
+	ip = 1;  ip = ctoi (time[7], ip, sec)
+
+	sec = sec + mn * 60 + hr * 3600
+
+	ip = 1;  ip = ctoi (date, ip, days)
+	ip = 1;  ip = ctoi (date[4], ip, month)
+	ip = 1;  ip = ctoi (date[7], ip, year)
+
+	days_per_year = 0
+	iy = year + 1900
+	do i = 1, iy - 1980
+	   days_per_year = days_per_year + 365
+
+	adays = (year - 80) / 4
+	if (month > 2)
+	    adays = adays + 1
+
+	days = adays + days-1 + days_per_year + month_to_days[month]
+	limtime = sec + days * 86400
+end
diff --git a/sys/imio/iki/fxf/fxfhextn.x b/sys/imio/iki/fxf/fxfhextn.x
new file mode 100644
index 00000000..7f8a879d
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfhextn.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <imhdr.h>
+include <imio.h>
+include	"fxf.h"
+
+
+# FXF_GETHDREXTN -- Get the default header file extension.
+
+procedure fxf_gethdrextn (im, o_im, acmode, outstr, maxch)
+
+pointer im, o_im		#I image descriptors
+int	acmode			#I image access mode
+char	outstr[ARB]		#O receives header extension
+int	maxch			#I max chars out
+
+bool	inherit
+int	kernel, old_kernel
+int	fnextn(), iki_getextn(), iki_getpar()
+
+begin
+	# Use the same extension as the input file if this is a new copy
+	# image of the same type as the input and inherit is enabled.
+	# If we have to get the extension using iki_getextn, the default
+	# extension for a new image is the first extension defined (index=1).
+
+	kernel = IM_KERNEL(im)
+
+	old_kernel = 0
+	if (acmode == NEW_COPY && o_im != NULL)
+	    old_kernel = IM_KERNEL(o_im)
+
+	inherit = (iki_getpar ("inherit") == YES)
+	if (inherit && acmode == NEW_COPY && kernel == old_kernel) {
+	    if (fnextn (IM_HDRFILE(im), outstr, maxch) <= 0)
+		call strcpy (DEF_HDREXTN, outstr, maxch)
+	} else if (iki_getextn (kernel, 1, outstr, maxch) < 0)
+	    call strcpy (DEF_HDREXTN, outstr, maxch)
+end
diff --git a/sys/imio/iki/fxf/fxfksection.x b/sys/imio/iki/fxf/fxfksection.x
new file mode 100644
index 00000000..cb37b4e5
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfksection.x
@@ -0,0 +1,475 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include	<error.h>
+include <ctotok.h>
+include <lexnum.h>
+include <imhdr.h>
+include "fxf.h"
+
+# FXFKSECTION.X -- Routines to parse the FITS kernel section into 
+# parameter names and values.
+
+define	KS_EXTNAME	1
+define	KS_EXTVER	2
+define	KS_APPEND	3
+define	KS_NOAPPEND	4
+define	KS_OVERWRITE	5
+define	KS_DUPNAME	6
+define	KS_INHERIT	7
+define	KS_NOINHERIT    8 
+define	KS_NODUPNAME	9
+define	KS_NOOVERWRITE	10
+define	KS_EXPAND	11
+define	KS_PHULINES	12
+define	KS_EHULINES	13
+define	KS_PADLINES	14
+define	KS_NOEXPAND	15
+define	KS_CACHESIZE	16
+define	KS_TYPE		17
+define	ERROR           -2
+
+
+# FXF_KSECTION -- Procedure to parse and analyze a string of the form:
+#
+#     "keyword=value,keyword+,keyword-,..."
+# e.g.,
+#     "[extname=]name,[extver=]23,append,inherit+,overwrite+,dupname-"
+#
+# The 'extver' numeric field is position dependent if it does not have
+# the parameter name.  The 'group' output variable is not -1 when specified
+# as the 1st number in the section.
+
+procedure fxf_ksection (ksection, fit, group)
+
+char 	ksection[ARB]		#I String with kernel section
+pointer fit			#I Fits structure pointer
+int	group			#O Extension number
+
+bool    extn
+char    outstr[LEN_CARD]
+char 	identif[LEN_CARD]
+int     ip, jp, nident, nexpr, junk, nch, ty, token, ival
+int	lex_type, fxf_ks_lex(), ctoi(), ctotok(), lexnum()
+errchk	syserr, syserrs
+
+begin
+       # The default values should have been already initialized 
+       # with a call fxf_ksinit().
+
+       ip = 1
+       nexpr = 0
+       nident = 0
+       extn = false
+       group = -1
+       identif[1] = EOS
+
+       repeat {
+	   # Advance to the next keyword.
+	   token = ctotok (ksection, ip, outstr, LEN_CARD)
+
+	   switch (token) {
+	   case TOK_EOS:
+	       break
+	   case TOK_NEWLINE:
+	       break
+
+	   case TOK_NUMBER:
+	       if (nexpr != 1 && nexpr != 2 && extn) 
+		   call syserr (SYS_FXFKSNV)
+	       jp = 1
+	       ty = lexnum (outstr, jp, nch)
+	       if (ty != LEX_DECIMAL)
+		   call syserr (SYS_FXFKSNDEC)
+	       jp = 1
+	       junk = ctoi (outstr, jp, ival)
+	       if (nexpr == 0) {
+		   group = ival
+		   identif[1] = 1
+	       } else
+	           FKS_EXTVER(fit) = ival
+	       nexpr = nexpr + 1
+
+	   case TOK_PUNCTUATION:
+	       if (outstr[1] == ',' && identif[1] == EOS)
+		   call syserr (SYS_FXFKSSYN)
+
+	   case TOK_STRING:
+	       if (nexpr != 0 && nexpr != 1)
+		   call syserr (SYS_FXFKSSVAL)
+	       call strcpy (outstr, FKS_EXTNAME(fit), LEN_CARD)
+	       nexpr = nexpr + 1
+	       extn = true
+
+	   case TOK_IDENTIFIER:
+	       nident = nident + 1
+	       call strcpy (outstr, identif, LEN_CARD] 
+	       call strlwr (outstr)
+	       lex_type = fxf_ks_lex (outstr)
+
+	       # look for =<value>, + or -
+	       if (lex_type > 0) {
+	   	   call fxf_ks_gvalue (lex_type, ksection, ip, fit)
+	       } else {
+	           if (nexpr == 0 || nexpr == 1)
+		       call strcpy (identif, FKS_EXTNAME(fit), LEN_CARD)
+	           else
+		       call syserr (SYS_FXFKSSVAL)
+	       }
+	       nexpr = nexpr + 1
+	       extn = true
+
+	   default:
+		call syserr (SYS_FXFKSSYN)
+	   }
+	}	   
+end
+
+
+# FXF_KS_LEX -- Map an identifier into a FITS kernel parameter code.
+
+int procedure fxf_ks_lex (outstr)
+
+char    outstr[ARB]
+
+int	len, strlen(), strncmp()
+errchk	syserr, syserrs
+
+begin
+	len = strlen (outstr)
+
+	# Allow for small string to be taken as extname values and not
+	# kernel paramaters; like 'ap' instead of 'ap(ppend)'.
+	if (len < 3)
+	    return(0)
+
+	# See if it is extname or extver.
+	if (strncmp (outstr, "ext", 3) == 0 && len < 8 ) {
+	    if (len == 3)
+	        call syserr (SYS_FXFKSEXT)
+	    if (strncmp (outstr[4], "name", len-3) == 0)
+		return (KS_EXTNAME)
+	    else if (strncmp (outstr[4], "ver", len-3) == 0)
+		return (KS_EXTVER)
+
+	# Check for the "no" versions of selected keywords.
+	} else if (strncmp (outstr, "no", 2) == 0 && len < 12) {
+	    if (strncmp (outstr[3], "append", len-2) == 0)
+	        return (KS_NOAPPEND)
+	    if (strncmp (outstr[3], "inherit", len-2) == 0)
+	        return (KS_NOINHERIT)
+	    if (strncmp (outstr[3], "overwrite", len-2) == 0)
+	        return (KS_NOOVERWRITE)
+	    if (strncmp (outstr[3], "dupname", len-2) == 0)
+	        return (KS_NODUPNAME)
+	    if (strncmp (outstr[3], "expand", len-2) == 0)
+		return (KS_NOEXPAND)
+	}
+
+	# Other kernel keywords.
+	if (strncmp (outstr, "inherit", len) == 0)
+	    return (KS_INHERIT)
+	if (strncmp (outstr, "overwrite", len) == 0)
+	    return (KS_OVERWRITE)
+	if (strncmp (outstr, "dupname", len) == 0)
+	    return (KS_DUPNAME)
+	if (strncmp (outstr, "append", len) == 0)
+	    return (KS_APPEND)
+	if (strncmp (outstr, "noappend", len) == 0)
+	    return (KS_NOAPPEND)
+	if (strncmp (outstr, "type", len) == 0)
+	    return (KS_TYPE)
+	if (strncmp (outstr, "expand", len) == 0)
+	    return (KS_EXPAND)
+	if (strncmp (outstr, "phulines", len) == 0)
+	    return (KS_PHULINES)
+	if (strncmp (outstr, "ehulines", len) == 0)
+	    return (KS_EHULINES)
+	if (strncmp (outstr, "padlines", len) == 0)
+	    return (KS_PADLINES)
+	if (strncmp (outstr, "cachesize", len) == 0)
+	    return (KS_CACHESIZE)
+
+	return (0)	# not recognized; probably a value
+end
+
+
+# FXF_KS_GVALUE -- Given a parameter code get its value at the 'ip' character
+# position in the 'ksection' string.  Put the values in the FKS structure.
+
+procedure fxf_ks_gvalue (param, ksection, ip, fit)
+
+int	param			#I parameter code
+char	ksection[ARB]		#I Ksection
+int	ip			#I Current parsing pointer in ksection
+pointer	fit			#U Update the values in the FKS structure
+
+pointer sp, ln
+int     jp, token
+int	ctotok()
+errchk	syserr, syserrs
+
+begin
+	jp = ip
+
+	call smark (sp)
+	call salloc (ln, LEN_CARD, TY_CHAR)
+
+	# See if the parameter value is given as par=<value> or '+/-'
+	if (ctotok (ksection, jp, Memc[ln], LEN_CARD) == TOK_OPERATOR) {
+	    if (Memc[ln] == '=' ) {
+		token = ctotok (ksection, jp, Memc[ln], LEN_CARD)
+		if (token != TOK_IDENTIFIER &&
+			token != TOK_STRING && token != TOK_NUMBER) {
+		    call syserr (SYS_FXFKSSYN)
+		} else {
+		    call fxf_ks_val (Memc[ln], param, fit)
+		    ip = jp
+	        }
+	    } else if (Memc[ln] == '+' || Memc[ln] == '-') {
+		call fxf_ks_pm (Memc[ln], param, fit)
+		ip = jp
+	    }
+	} else {
+	    switch (param) {
+	    case  KS_APPEND:
+		FKS_APPEND(fit) = YES
+	    case  KS_NOAPPEND:
+		FKS_APPEND(fit) = NO
+	    case  KS_OVERWRITE:
+		FKS_OVERWRITE(fit) = YES
+	    case  KS_NOOVERWRITE:
+		FKS_OVERWRITE(fit) = NO
+	    case  KS_DUPNAME:
+		FKS_DUPNAME(fit) = YES
+	    case  KS_INHERIT:
+		FKS_INHERIT(fit) = YES
+	    case  KS_NOINHERIT:
+		FKS_INHERIT(fit) = NO
+	    case  KS_EXPAND:
+		FKS_EXPAND(fit) = YES
+	    case  KS_NOEXPAND:
+		FKS_EXPAND(fit) = NO
+	    default:
+		call syserr (SYS_FXFKSSYN)
+	    }
+	} 
+
+	call sfree (sp)
+end
+
+
+# FXF_KS_VALUE -- Returns the value of a parameter in the kernel section.
+
+procedure fxf_ks_val (outstr, param, fit)
+
+char	outstr[ARB] 		#I Input string with value		
+int	param			#I Parameter code
+pointer fit			#U Fits kernel descriptor
+
+int	ty, ip, ival, nchars
+int	lexnum(), ctoi(), strcmp()
+errchk	syserr, syserrs
+
+begin
+	call strlwr (outstr)
+	if (strcmp (outstr, "yes") == 0)
+	    ival = YES
+	else if (strcmp (outstr, "no") == 0)
+	    ival = NO
+	else
+	    ival = ERROR
+
+	switch (param) {
+	case  KS_EXTNAME:
+	    call strcpy (outstr, FKS_EXTNAME(fit), LEN_CARD)
+
+	case  KS_TYPE:
+	    call strlwr (outstr)
+	    if (strcmp ("mask", outstr) == 0)
+		FKS_SUBTYPE(fit) = FK_PLIO
+	    else
+		call syserrs (SYS_FXFKSINVAL, "type")
+	case KS_EXTVER:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0)
+	        call syserrs (SYS_FXFKSINVAL, "extver")
+	    FKS_EXTVER(fit) = ival
+
+	case KS_APPEND:
+	    if (ival != ERROR)
+	        FKS_APPEND(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "append")
+
+	case KS_OVERWRITE:
+	    if (ival != ERROR)
+	        FKS_OVERWRITE(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "overwrite")
+
+	case KS_DUPNAME:
+	    if (ival != ERROR)
+	        FKS_DUPNAME(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "dupname")
+
+	case KS_INHERIT:
+	    if (ival != ERROR)
+	        FKS_INHERIT(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "inherit")
+
+	case KS_EXPAND:
+	    if (ival != ERROR)
+	        FKS_EXPAND(fit) = ival
+	    else
+	        call syserrs (SYS_FXFKSINVAL, "expand")
+
+	case KS_PHULINES:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0 || ival < 0)
+	        call syserrs (SYS_FXFKSPVAL, "phulines")
+	    FKS_PHULINES(fit) = ival
+
+	case KS_EHULINES:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0 || ival < 0)
+	        call syserrs (SYS_FXFKSPVAL, "ehulines")
+	    FKS_EHULINES(fit) = ival
+
+	case KS_PADLINES:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0 || ival < 0)
+	        call syserrs (SYS_FXFKSPVAL, "padlines")
+	    FKS_PADLINES(fit) = ival
+
+	case KS_CACHESIZE:
+	    ip = 1
+	    ty = lexnum (outstr, ip, nchars)
+	    if (ty != LEX_DECIMAL)
+	        call syserr (SYS_FXFKSNDEC)
+	    ip = 1
+	    nchars = ctoi (outstr, ip, ival)
+	    if (nchars <= 0 || ival < 0)
+	        call syserrs (SYS_FXFKSPVAL, "cachesize")
+	    FKS_CACHESIZE(fit) = ival
+
+	default:
+            call syserr (SYS_FXFKSSYN)
+	}
+end
+
+
+# FXF_KS_PM -- Return the character YES or NO based on the value '+' or '-'
+ 
+procedure fxf_ks_pm (pm, param, fit)
+
+char	pm[1]		#I contains "+" or "-"
+int	param		#I Parameter code
+pointer fit		#U Fits kernel descriptor
+
+int	ival
+errchk	syserr, syserrs
+
+begin
+	if (pm[1] == '+') 
+	   ival = YES
+	else
+	   ival = NO
+
+	switch (param) {
+	case KS_APPEND:
+	    FKS_APPEND(fit) = ival
+	case KS_OVERWRITE:
+	    FKS_OVERWRITE(fit) = ival
+	case KS_DUPNAME:
+	    FKS_DUPNAME(fit) = ival
+	case KS_INHERIT:
+	    FKS_INHERIT(fit) = ival
+	case KS_EXPAND:
+	    FKS_EXPAND(fit) = ival
+	default:
+	    call syserr (SYS_FXFKSSYN)
+	}
+end
+
+
+# FXF_KS_ERRORS -- Handle an error condition in the kernel section.
+
+procedure fxf_ks_errors (fit, acmode)
+
+pointer fit 			#I fits kernel descriptor
+int	acmode			#I image access mode
+
+int	group
+errchk	syserr, syserrs
+
+begin
+	group = FIT_GROUP(fit)
+
+	if (FKS_OVERWRITE(fit) == YES) {
+	    if (FIT_NEWIMAGE(fit) == YES)
+		iferr (call syserrs (SYS_FOPNNEXFIL, IM_HDRFILE(FIT_IM(fit))))
+		    call erract (EA_WARN)
+	    if (acmode == APPEND)
+		call syserrs (SYS_FXFKSNOVR, "APPEND")
+	    if (group == -1 &&
+		    (FKS_EXTNAME(fit) == EOS && IS_INDEFL(FKS_EXTVER(fit))))
+		call syserr (SYS_FXFKSOVR)
+	} else {
+	    switch (acmode) {
+	    case NEW_COPY:
+		if (group != -1 && FKS_APPEND(fit) == NO)
+		    call syserr (SYS_FXFKSBOP)
+	    case NEW_IMAGE:
+		if (group != -1)
+		    call syserrs (SYS_FXFKSNEXT, "NEW_IMAGE" )
+	    case APPEND:
+	        if (group != -1)
+		    call syserrs (SYS_FXFKSNEXT, "APPEND" )
+	    }
+        }
+end			
+
+
+# FXF_KSINIT -- Initialize default values for ks parameters.
+
+procedure fxf_ksinit (fit)
+
+pointer	fit			#I fits kernel descriptor
+
+begin
+	FKS_EXTNAME(fit)   = EOS
+	FKS_SUBTYPE(fit)   = NO
+	FKS_EXTVER(fit)    = INDEFL
+	FKS_APPEND(fit)    = NO
+	FKS_OVERWRITE(fit) = NO
+	FKS_DUPNAME(fit)   = NO
+	FKS_EXPAND(fit)    = YES
+	FKS_PHULINES(fit)  = DEF_PHULINES
+	FKS_EHULINES(fit)  = DEF_EHULINES
+	FKS_PADLINES(fit)  = DEF_PADLINES
+	FKS_INHERIT(fit)   = YES
+	FKS_CACHESIZE(fit) = DEF_CACHE
+end
diff --git a/sys/imio/iki/fxf/fxfmkcard.x b/sys/imio/iki/fxf/fxfmkcard.x
new file mode 100644
index 00000000..81bb3ab7
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfmkcard.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+# FXF_MK_CARD --  Fetch a single line from a string parameter, padding it to
+# a maximum of maxcols characters and trimmimg the delim character.
+
+procedure fxf_make_card (instr, ip, card, col_out, maxcols, delim)
+
+char	instr[ARB]	#I input string
+int	ip		#U input string pointer, updated at each call
+char	card[ARB]	#O FITS card image
+int	col_out		#I pointer to column in card
+int	maxcols		#I maximum columns in card
+int	delim		#I 1 character string delimiter
+
+int	op
+
+begin
+	op = col_out
+
+	# Copy string
+	while (op <= maxcols && instr[ip] != EOS && instr[ip] != delim) {
+	    card[op] = instr[ip]
+	    ip = ip + 1
+	    op = op + 1
+	}
+
+	# Fill remainder of card with blanks
+	while (op <= maxcols ) {
+	    card[op] = ' '
+	    op = op + 1
+	}
+
+	if (instr[ip] == delim)
+	    ip = ip + 1
+end
diff --git a/sys/imio/iki/fxf/fxfnull.x b/sys/imio/iki/fxf/fxfnull.x
new file mode 100644
index 00000000..ce3baece
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfnull.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include "fxf.h"
+
+# FXF_NULL -- Null driver entry point.
+
+procedure fxf_null()
+
+errchk	syserr, syserrs
+
+begin
+	call syserr (SYS_FXFFKNULL)
+end
diff --git a/sys/imio/iki/fxf/fxfopen.x b/sys/imio/iki/fxf/fxfopen.x
new file mode 100644
index 00000000..bceed618
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfopen.x
@@ -0,0 +1,1014 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include <finfo.h>
+include <fset.h>
+include <mii.h>
+include <mach.h>
+include	"fxf.h"
+
+
+# FXF_OPEN -- Open/create a FITS format image with extensions.
+
+procedure fxf_open (kernel, im, o_im, root, extn, ksection, group, gc_arg,
+	acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I other descriptor for NEW_COPY image
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I extension, if any
+char	ksection[ARB]		#I [extname,extver,overwrite,append,inherit..]
+int	group			#I index of group to be accessed
+int	gc_arg			#I [NOT USED]
+int	acmode			#I access mode
+int	status			#O status flag to calling routine
+
+long	fi[LEN_FINFO]
+int	newimage, i, gn, ksinh, type, fmode
+pointer	sp, path, fit_extn, ua, o_fit, fit
+bool    pre_read, fks_extn_or_ver, dyh, fsec, plio
+int	fxf_check_dup_extnv(), itoc(), strcmp(), strncmp()
+int     open(), access(), imgeti(), fstatl(), finfo(), fxf_header_size()
+pointer pl_open()
+
+errchk	fmkcopy, calloc, open, fxf_rheader, fxf_prhdr, fxf_gaccess
+errchk	fxf_fclobber, fxf_ksection, fxf_alloc, syserr, syserrs
+errchk  fxf_check_group
+define	duperr_ 91
+define	err_ 92
+
+begin
+	call smark (sp)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+	call salloc (fit_extn, FITS_LENEXTN, TY_CHAR)
+	call fxf_init()
+	ua = IM_USERAREA(im)
+
+	fmode = acmode
+
+	# Allocate internal FITS image descriptor.
+	call fxf_alloc (fit)
+
+	IM_KDES(im) = fit
+	IM_HFD(im) = NULL
+	FIT_IM(fit) = im
+	call amovki (1, FIT_LENAXIS(fit,1), IM_MAXDIM)
+
+	# Generate full header file name.
+	if (extn[1] == EOS) {
+	    call fxf_gethdrextn (im, o_im, fmode, Memc[fit_extn], FITS_LENEXTN)
+	    call iki_mkfname (root, Memc[fit_extn], Memc[path], SZ_PATHNAME)
+	    call strcpy (Memc[fit_extn], extn, FITS_LENEXTN)
+	} else                                 
+	    call iki_mkfname (root, extn, Memc[path], SZ_PATHNAME)
+
+	# Header and pixel filename are the same.
+	call strcpy (Memc[path], IM_HDRFILE(im), SZ_IMHDRFILE)
+	call strcpy (IM_HDRFILE(im), IM_PIXFILE(im), SZ_IMPIXFILE)
+
+	newimage = NO
+	if (access (IM_HDRFILE(im), 0, 0) == NO)
+	    newimage = YES
+	FIT_NEWIMAGE(fit) = newimage 
+
+	# Initialize kernel section default values.
+	call fxf_ksinit (fit)
+
+	# For simplicity treat the APPEND mode as NEW_IMAGE.  For the FK
+	# is the same.
+
+	if (fmode == APPEND)
+	    fmode = NEW_IMAGE
+	FIT_ACMODE(fit) = fmode
+
+	# Read fkinit and ksection and check that the extension number
+	# specifications therein and the IMIO cluster index "group" are
+	# consistent.
+
+	call fxf_check_group (im, ksection, fmode, group, ksinh)
+
+	fks_extn_or_ver = FKS_EXTNAME(fit) != EOS || !IS_INDEFL(FKS_EXTVER(fit))
+
+	# Check if a file section is necessary.
+	fsec = (fks_extn_or_ver || group >= 0)
+	call fxf_gaccess (im, fsec)
+
+	# The previous call could have changed FIT_NEWIMAGE; reset value.
+	newimage = FIT_NEWIMAGE(fit)
+
+	if (fks_extn_or_ver)
+	   FIT_GROUP(fit) = -1
+
+	# See if we want to write a dummy primary unit.
+	#
+	# For PLIO, if creating a new output file and we want to create a
+	# BINTABLE, create a dummy header.  Otherwise see if a type is
+	# requested, in which case we would need to create a dummmy header
+	# if no file is present yet.
+
+	type = 0
+	if (FKS_SUBTYPE(fit) == FK_PLIO)
+	    type = FK_PLIO
+
+	dyh = false
+	if (newimage == YES && (fks_extn_or_ver || type > 0)) {
+	    call fxf_dummy_header (im, status)
+	    if (status == ERR)
+		goto err_ 
+	    newimage = NO
+	    dyh = true
+	    if (fmode == NEW_COPY && type == FK_PLIO) 
+		FIT_PIXOFF(fit) = fxf_header_size(im) + FITS_BLOCK_CHARS
+	}
+	if (newimage == NO) {
+	    if (finfo (IM_HDRFILE(im), fi) != ERR)
+		FIT_EOFSIZE(fit) = (FI_SIZE(fi)+SZB_CHAR-1)/SZB_CHAR + 1
+	    else
+		call syserrs (SYS_FOPEN, IM_HDRFILE(im))
+	}
+
+	if (newimage == YES)
+	    FKS_OVERWRITE(fit) = NO
+	else
+	    FIT_XTENSION(fit) = YES
+
+	FIT_NEWIMAGE(fit) = newimage
+
+	# If all these conditions are met then set the pre_read flag.
+	pre_read = (fks_extn_or_ver ||
+	    FKS_OVERWRITE(fit) == YES || FKS_INHERIT(fit) == YES)
+
+	if (newimage == NO && fmode != READ_ONLY) {
+	    # See that INHERIT makes sense if it has been set by
+	    # 'fkinit' when reading a file with PHU (naxis != 0).
+
+	    if (FKS_INHERIT(fit) == YES && group != 0) {
+		gn = 0
+		iferr (call fxf_prhdr (im, gn)) {
+		    FKS_INHERIT(fit) = NO
+
+		    # Issue an error only if the inherit is in the filename.
+		    if (fmode == NEW_COPY && ksinh == YES)
+			call syserr (SYS_FXFBADINH)
+	        } else if (FIT_NAXIS(fit) != 0)
+		    FKS_INHERIT(fit) = NO
+
+	        # Reset the pre_read flag.
+		pre_read = ((FKS_DUPNAME(fit) == NO && 
+		    FKS_INHERIT(fit) == YES) || FKS_OVERWRITE(fit) == YES)
+	    }
+
+	    if (pre_read && fmode != NEW_COPY && !dyh)
+	        call fxf_prhdr (im, group)
+
+	    if (access (IM_HDRFILE(im), fmode, 0) == NO)
+		call syserrs (SYS_FNOWRITEPERM, IM_HDRFILE(im))
+	}
+
+	switch (fmode) {
+	case NEW_IMAGE, APPEND:
+	    if (newimage == NO) {
+	        # Make sure the UA is empty when overwriting.
+	        if (pre_read && FKS_OVERWRITE(fit) == YES)  
+		    Memc[ua] = EOS
+		 
+	        if (FKS_DUPNAME(fit) == NO)
+	            if (fxf_check_dup_extnv (im, group) == YES)
+		        goto duperr_
+	    } else {
+		# See if it is necessary to invalidate the cache entry for the
+		# current filename. It could happen that the user has deleted
+		# the filename and a new file with the same is created.
+
+		call fxf_check_old_name (im)
+	    }
+	    
+	    if (FKS_INHERIT(fit) == YES)
+		FIT_INHERIT(fit) = YES
+
+	    # Initialize a new copy of a PLIO image mask.
+	    if (type == FK_PLIO) 
+		IM_PL(im) = pl_open (NULL)
+
+	case NEW_COPY:
+	    # Completely new copy of an existing image. This could mean a
+	    # new file or append a new image to an existing file.
+
+	    # Initialize a new copy of a PLIO image mask.
+	    if (type == FK_PLIO) {
+		IM_PL(im) = pl_open (NULL)
+	        if (IM_PL(o_im) != NULL)
+	            call fxf_plpf (im)
+	    }
+
+	    if (newimage == YES || FKS_APPEND(fit) == NO) 
+		call fxf_check_old_name (im)
+
+	    # For a PLIO mask, make sure there are no SUBYTPE keywords in
+	    # the UA since this will be rewritten by fxf_updhdr().
+	    
+	    if (IM_PL(o_im) != NULL)
+		call fxf_clean_pl (im)
+
+	    if (IM_KDES(o_im) != NULL && IM_KERNEL(o_im) == IM_KERNEL(im)) {
+		o_fit = IM_KDES(o_im)
+	        call strcpy (FIT_EXTTYPE(o_fit), FIT_EXTTYPE(fit), SZ_EXTTYPE)
+		call strcpy (FIT_EXTNAME(o_fit), FIT_EXTNAME(fit), LEN_CARD)
+		FIT_EXTVER(fit) =  FIT_EXTVER(o_fit) 
+
+		# Reset the value of the keyword INHERIT in the new_copy
+		# image if the input has a no_inherit in the filename.
+
+		FIT_INHERIT(fit) = NO
+		call fxf_filter_keyw (im, "INHERIT")
+
+		# Change the value only if explicitly done in the output
+		# kernel section.
+
+		if (FKS_INHERIT(fit) == YES)
+	            FIT_INHERIT(fit) = YES
+
+	    } else {
+		# Reblock if old image is imh for example.
+		if (IM_UABLOCKED(im) != YES)
+		    call fxf_reblock (im)
+
+		# See if the old image have EXTNAME or EXTVER keywords.
+		# Notice that old image does not have to be of FITS type.
+
+		iferr (call imgstr (o_im,"EXTNAME",FIT_EXTNAME(fit),LEN_CARD))
+		    FIT_EXTNAME(fit) = EOS
+		iferr (FIT_EXTVER(fit) = imgeti (o_im, "EXTVER"))
+		    FIT_EXTVER(fit) = INDEFL
+		call strcpy ("IMAGE", FIT_EXTTYPE(fit), SZ_EXTTYPE)
+	    }
+
+	    # Delete ORIGIN keyword, since we are going to put a new one.
+	    call fxf_filter_keyw (im, "ORIGIN")
+
+	    # Now that we have a new_copy of the input FITS structure,
+	    # initialize some of its members.
+
+	    FIT_HFD(fit) = NULL
+	    FIT_NEWIMAGE(fit) = newimage
+	    if (newimage == NO)
+		FIT_XTENSION(fit) = YES
+	    FIT_ACMODE(fit) = fmode
+	    if (FKS_APPEND(fit) != YES)
+	        FIT_GROUP(fit) = group
+	    FIT_BSCALE(fit) = 1.0d0
+	    FIT_BZERO(fit) = 0.0d0
+
+            if (FKS_OVERWRITE(fit) == NO) {
+		if (FKS_EXTNAME(fit) == EOS)
+		    call strcpy (FIT_EXTNAME(fit), FKS_EXTNAME(fit), LEN_CARD)
+		else
+		    call imastr (im, "EXTNAME", FKS_EXTNAME(fit))
+    
+		if (IS_INDEFL(FKS_EXTVER(fit)))
+		    FKS_EXTVER(fit) =  FIT_EXTVER(fit) 
+		else
+		    call imaddi (im, "EXTVER", FKS_EXTVER(fit))
+
+		# We need to pre_read extensions headers to check for
+		# duplicates with these extname and extver.
+
+		if (FKS_EXTNAME(fit) != EOS ||!IS_INDEFL(FKS_EXTVER(fit))) 
+		    pre_read = true
+	    }
+
+	    if (newimage == NO && !dyh) {
+	        if (pre_read) {
+		    iferr (call fxf_prhdr (im, group))
+			;
+	        }
+
+		# Check for duplicated EXTNAME and/or EXTVER if any of the
+		# following conditions are met.
+
+		if (FKS_DUPNAME(fit) == NO && FKS_OVERWRITE(fit) == NO && 
+		    (fks_extn_or_ver || FIT_EXTNAME(fit) != EOS || 
+		    !IS_INDEFL(FIT_EXTVER(fit)))) {
+		    if (fxf_check_dup_extnv (im, group) == YES)
+		        goto duperr_
+		}
+	    }
+
+	    FIT_NAXIS(fit) = IM_NDIM(im)
+	    do i = 1, IM_NDIM(im)
+		FIT_LENAXIS(fit,i) = IM_LEN(im,i)
+
+	    # Inherit datatype of input template image if specified,
+	    # otherwise default datatype to real.
+
+	    if (IM_PIXTYPE(o_im) != NULL)
+		IM_PIXTYPE(im) = IM_PIXTYPE(o_im)
+	    else
+		IM_PIXTYPE(im) = TY_REAL
+
+	default:
+	    # No Overwrite allowed in READ_ONLY or READ_WRITE.
+	    FKS_OVERWRITE(fit) = NO
+
+	    # Check that we have single FITS file.
+	    if (!fsec && group == -1)
+	        group = 0
+
+	    # Open an existing image.
+            iferr (call fpathname (IM_HDRFILE(im), Memc[path], SZ_PATHNAME))
+		goto err_
+	    if (fmode == READ_WRITE)
+		IM_HFD(im) = open (Memc[path], READ_WRITE, BINARY_FILE)
+	    else
+		IM_HFD(im) = open (Memc[path], READ_ONLY, BINARY_FILE)
+
+	    iferr (call fxf_rheader (im, group, fmode)) {
+		call close (IM_HFD(im))
+		call mfree (fit, TY_STRUCT)
+		call sfree (sp)
+		status = ERR
+		call erract (EA_ERROR)
+	    }
+
+	    if (group == 0) 
+	        FIT_XTENSION(fit) = NO
+	    else
+	        FIT_XTENSION(fit) = YES
+
+	    # Some non-iraf fits files might have keywords that are
+	    # imcompatible with our header. For example if hediting the header,
+	    # make sure that they are eliminated.
+
+	    if (fmode == READ_WRITE)
+	       call fxf_discard_keyw (im)
+
+	    FIT_EOFSIZE(fit) = fstatl (IM_HFD(im), F_FILESIZE) + 1
+
+	    # PLIO.  If we read the header of a PLIO_1 compressed image file
+	    # then it is a PL file; now read the data.
+
+	    plio = (strncmp (FIT_EXTSTYPE(fit), "PLIO_1", 6) == 0)
+	    if (plio)  {
+		call fxf_plread (im)
+
+		# We need to setup the IMIO descriptor if we need to write
+		# over a section; in particular IM_PFD needs to be defined.
+
+		if (fmode == READ_WRITE)
+		    call fxf_plpf (im)
+	    }
+
+	    # Close the header file.
+	    call close (IM_HFD(im))
+	    IM_HFD(im) = NULL
+
+	    # Do not allow the user to see any non_IMAGE extensions.
+	    if (strcmp ("IMAGE", FIT_EXTTYPE(fit)) != 0 &&
+		    strcmp ("SIMPLE", FIT_EXTTYPE(fit)) != 0 && !plio)
+		call syserrs (SYS_IKIEXTN, IM_NAME(im))
+	}
+
+	FIT_HFD(fit) = IM_HFD(im)
+	status = OK
+
+	call sfree (sp)
+	return
+duperr_
+	i = itoc (group, Memc[path], LEN_CARD)
+	call syserrs (SYS_FXFOPEXTNV, Memc[path])
+err_
+	status = ERR
+	call mfree (fit, TY_STRUCT)
+	call sfree (sp)
+end
+
+
+# FXF_ALLOC -- Initialize memory for the FIT descriptor.
+
+procedure fxf_alloc (fit)
+
+pointer fit	 		#I input fits descriptor
+
+errchk	calloc
+
+begin
+	call calloc (fit, LEN_FITDES, TY_STRUCT)
+
+	FIT_GROUP(fit) = -1
+	FIT_PIXTYPE(fit) = NULL
+	FIT_BSCALE(fit) = 1.0d0
+	FIT_BZERO(fit) = 0.0d0
+	FIT_XTENSION(fit) = NO
+	FIT_INHERIT(fit) = NO
+	FIT_EOFSIZE(fit) = 0
+	FIT_EXTNAME(fit) = EOS
+	FIT_EXTVER(fit) = INDEFL
+end
+
+
+# FXF_INIT -- Initialize any runtime FITS kernel descriptors to their
+# process startup state.
+
+procedure fxf_init()
+
+int	i
+bool	first_time
+data	first_time /true/
+
+include "fxfcache.com"
+
+begin
+	# Disable the hdrcache until it is fully initialized in rfitshdr.
+	if (first_time) {
+	    rf_cachesize = 0
+	    do i = 1, MAX_CACHE {
+		rf_fit[i] = 0
+	    }
+
+	    first_time = false
+	}
+end
+
+
+# FXF_KS_RDHDR -- Procedure to preread the FITS headers up to group
+# 'group'.  The idea is to have the offset pointers in memory since the
+# can be overwritten or when no group (i.e. -1) is given and the extname or
+# extver are specified.
+
+procedure fxf_prhdr (im, group)
+
+pointer	im  	 		#I image descriptor
+int	group			#I maximum group number to read
+
+int	poff, extv
+pointer	fit, lim, lfit, sp, path
+errchk	fpathname, open, syserr, fxf_alloc, calloc
+int	open(), imgeti()
+
+begin
+	call smark (sp)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+
+	# We will use a local temporary imio and fit structures.
+#	call calloc (lim, LEN_IMDES+LEN_IMHDR+MIN_LENUSERAREA, TY_STRUCT)
+	call calloc (lim, LEN_IMDES+IM_LENHDRMEM(im), TY_STRUCT)
+
+	call fxf_alloc (lfit)
+
+	IM_KDES(lim) = lfit
+	fit = IM_KDES(im)
+
+	FIT_GROUP(lfit) = group
+	FIT_ACMODE(lfit) = FIT_ACMODE(fit)
+	call strcpy (FKS_EXTNAME(fit), FKS_EXTNAME(lfit), LEN_CARD)
+	FKS_EXTVER(lfit) = FKS_EXTVER(fit)
+
+	iferr (extv = imgeti (im, "EXTVER"))
+	     extv = INDEFL
+
+	FKS_OVERWRITE(lfit) = FKS_OVERWRITE(fit)
+	FKS_DUPNAME(lfit) = FKS_DUPNAME(fit)
+        FKS_INHERIT(lfit) = FKS_INHERIT(fit)
+        FKS_CACHESIZE(lfit) = FKS_CACHESIZE(fit)
+
+	# Open an existing image.
+        call strcpy (IM_HDRFILE(im), IM_HDRFILE(lim), SZ_PATHNAME)
+        call strcpy (IM_NAME(im), IM_NAME(lim), SZ_PATHNAME)
+
+        call fpathname (IM_HDRFILE(im), Memc[path], SZ_PATHNAME)
+	IM_HFD(lim) = open (Memc[path], READ_ONLY, BINARY_FILE)
+
+	IM_LENHDRMEM(lim) = IM_LENHDRMEM(im)
+
+	# If we want to inherit the global header we need to read
+	# the group specified in the filename.
+
+	iferr (call fxf_rfitshdr (lim, group, poff)) {
+	     call close (IM_HFD(lim))
+             call mfree (lfit, TY_STRUCT)
+	     call mfree (lim, TY_STRUCT)
+	     call sfree (sp)
+	     call erract (EA_ERROR)
+
+	} else {
+	    call close (IM_HFD(lim))
+	    call sfree (sp)
+	    if (FKS_OVERWRITE(fit) == YES)
+		FIT_GROUP(fit) = FIT_GROUP(lfit)
+   	    group = FIT_GROUP(lfit)
+
+	    # Now set the offset pointers to the original 'fit' struct.
+	    FIT_HDRPTR(fit) = FIT_HDRPTR(lfit)
+	    FIT_PIXPTR(fit) = FIT_PIXPTR(lfit)
+	    FIT_EXTEND(fit) = FIT_EXTEND(lfit)
+
+	    FIT_CACHEHDR(fit) = FIT_CACHEHDR(lfit)
+	    FIT_CACHEHLEN(fit) = FIT_CACHEHLEN(lfit)
+
+	    FIT_NAXIS(fit) = FIT_NAXIS(lfit)
+	    FIT_INHERIT(fit) = FIT_INHERIT(lfit)
+	    FIT_PLMAXLEN(fit) = FIT_PLMAXLEN(lfit)
+
+	    IM_CTIME(im) = IM_CTIME(lim)
+
+	    call mfree (lfit, TY_STRUCT)
+	    call mfree (lim, TY_STRUCT)
+
+  	    if (extv != INDEFL)
+	        call imaddi (im, "EXTVER", extv)
+	}
+end
+
+
+# FXF_DUMMY_HEADER -- Built a minimum Primary Fits header.  This is
+# necessary in case we are creating an IMAGE extension and we don't 
+# want to put any information in the PHU.
+
+procedure fxf_dummy_header (im, status)
+
+pointer im 			#I image descriptor
+int	status			#O status flag
+
+char    blank[1]	
+pointer sp, path, spp, mii, pn, n
+int	iso_cutover, fd, nblanks, size_rec
+
+int	strlen(), open(), envgeti()
+long	clktime()
+
+begin
+	call smark (sp)
+	call salloc (spp, FITS_BLOCK_BYTES, TY_CHAR)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+
+	status = OK
+
+	iferr {
+	    call fpathname (IM_HDRFILE(IM), Memc[path], SZ_PATHNAME)
+	    fd = open (Memc[path], NEW_FILE, BINARY_FILE)
+	} then {
+	    call sfree (sp)
+	    status = ERR
+	    return
+	}
+
+	pn = spp
+	call fxf_akwb ("SIMPLE", YES, "FITS STANDARD", pn)
+	call fxf_akwi ("BITPIX", 8, "Character information", pn)
+	call fxf_akwi ("NAXIS", 0, "No image data array present", pn)
+	call fxf_akwb ("EXTEND", YES, "File may contain extensions", pn)
+        call fxf_akwc ("ORIGIN", FITS_ORIGIN,
+	    strlen(FITS_ORIGIN), "FITS file originator", pn)
+
+	# Dates after iso_cutover use ISO format dates.
+	iferr (iso_cutover = envgeti (ENV_ISOCUTOVER))
+	    iso_cutover = DEF_ISOCUTOVER
+
+	# Encode the DATE keyword.
+        call fxf_encode_date (clktime(long(0)), Memc[path], LEN_CARD,
+	    "ISO", 2000)
+	call fxf_akwc ("DATE", Memc[path],
+	    strlen(Memc[path]), "Date FITS file was generated", pn)
+
+	blank[1] = ' '
+        call amovkc (blank[1], Memc[pn], LEN_CARD)
+	call amovc ("END", Memc[pn], 3)
+	pn = pn + LEN_CARD
+
+	n = pn - spp
+	size_rec = FITS_BLOCK_CHARS
+        nblanks = FITS_BLOCK_BYTES - n
+	call amovkc (blank[1], Memc[spp+n], nblanks)
+	call miipak (Memc[spp], Memi[mii], size_rec*2, TY_CHAR, MII_BYTE)
+	call write (fd, Memi[mii], size_rec)
+
+	call close (fd)
+
+	call sfree (sp)
+end
+
+
+# FXF_CHECK_DUP_EXTN_VER --- Function to check for a duplicate EXTNAME or
+# EXTVER in the FITS file open with NEW_COPY mode. The filename specification
+# does not have EXTNAME nor EXTVER in the ksection.
+# Returns YES if there are duplicates.
+
+int procedure fxf_check_dup_extnv (im, group)
+
+pointer im			#I image descriptor
+int	group			#O extension number where there is a duplicate
+
+int	cindx
+pointer extn, extv, sp, hdrfile, fit, poff
+int	fxf_extnv_error()
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+        call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	fit = IM_KDES(im)
+	
+	do cindx=1, rf_cachesize {
+            if (rf_fit[cindx] == NULL)
+	        next
+
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+	        extn = rf_pextn[cindx]
+	        extv = rf_pextv[cindx]
+	        poff = rf_pixp[cindx]      # pixel offset -1 if EOF
+	        group = 1
+
+	        # Now compare the input image FIT_EXT(NAME,VER) with
+	        # the cache values of the NEW_COPY images.
+
+	        while (Memc[extn+LEN_CARD*group] != EOS || 
+		    !IS_INDEFL(Memi[extv+group]) || Memi[poff+group] != -1) {
+		    if (fxf_extnv_error (fit, group, extn, extv) == YES) {
+		        call sfree (sp)
+		        if (FKS_OVERWRITE(fit) == YES)
+		            return (NO)
+	                else
+		            return (YES)
+		    } else
+		        group = group + 1
+	        } 
+	    }
+	}
+
+	call sfree (sp)
+	return (NO)
+end
+
+
+# FXF_CHECK_OLD_NAME -- Check is the filename is already in cache for a
+# NEWIMAGE == YES mode; if so, make the entry obsolete.
+
+procedure fxf_check_old_name (im)
+
+pointer im				#I image descriptor
+
+int	cindx
+pointer sp, hdrfile, fit
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+        call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+
+	fit = IM_KDES(im)
+	do cindx=1, rf_cachesize {
+            if (rf_fit[cindx] == NULL)
+	        next
+
+	    # Verify that we have the correct file.
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+                call mfree (rf_pextv[cindx], TY_INT)
+                call mfree (rf_pextn[cindx], TY_CHAR)
+                call mfree (rf_pixp[cindx], TY_INT)
+                call mfree (rf_hdrp[cindx], TY_INT)
+                call mfree (rf_fit[cindx], TY_STRUCT)
+                call mfree (rf_hdr[cindx], TY_CHAR)
+	        rf_fit[cindx] = NULL
+	        rf_mtime[cindx] = 0      # invalidate cache entry
+	        rf_fname[1,cindx] = EOS
+	        break
+            }		
+	}
+
+	call sfree (sp)
+end
+
+
+# FXF_REBLOCK -- If the user area is not blocked to fixed length records, e.g.,
+# as is possible in a new copy image, reblock it fixed length.
+
+procedure fxf_reblock (im)
+
+pointer	im				#I image descriptor
+
+pointer	sp, lbuf, op, ua
+int	fd, spool, nlines, nchars, sz_userarea, len_hdrmem
+errchk	stropen, open, getline, putline, realloc, seek, fcopyo
+int	open(), stropen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], ARB, READ_ONLY)
+	spool = open ("rb_spool", READ_WRITE, SPOOL_FILE)
+	
+	# Reblock into a spool file, counting the lines.
+	for (nlines=0;  ;  nlines=nlines+1) {
+	    nchars = getline (fd, Memc[lbuf])
+	    if (nchars <= 0)
+		break
+
+	    for (op=nchars;  op <= LEN_CARD;  op=op+1)
+		Memc[lbuf+op-1] = ' '
+	    Memc[lbuf+LEN_CARD] = '\n'
+	    Memc[lbuf+LEN_CARD+1] = EOS
+	    call putline (spool, Memc[lbuf])
+	}
+
+	call close (fd)
+
+	# Reallocate header the right size.
+	sz_userarea = nlines * (LEN_CARD+1) + SZ_EXTRASPACE
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+	# Move spooled data back to user area.
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], sz_userarea, NEW_FILE)
+	call seek (spool, BOFL)
+	call fcopyo (spool, fd)
+
+	IM_UABLOCKED(im) = YES
+	call close (fd)
+	call close (spool)
+	call sfree (sp)
+end
+
+
+# FXF_FCLOBBER -- Clobber an existing FITS file.  We use the environment
+# variable 'clobber' rather than 'imclobber' because is a file and not
+# an image.
+
+procedure fxf_fclobber (file)
+
+char	file			#I input filename to delete
+
+int	cindx
+bool    streq()
+include	"fxfcache.com"
+
+begin
+	iferr (call delete (file))
+	    call filerr (file, SYS_FCANTCLOB)
+				     
+	# Remove the name from the cache.
+	do cindx=1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+		next
+
+	    # Verify that we have the correct file.
+	    if (streq (file, rf_fname[1,cindx])) {
+		if (rf_fit[cindx] != NULL) {
+		    call mfree (rf_pextv[cindx], TY_INT)
+		    call mfree (rf_pextn[cindx], TY_CHAR)
+		    call mfree (rf_pixp[cindx], TY_INT)
+		    call mfree (rf_hdrp[cindx], TY_INT)
+		    call mfree (rf_fit[cindx], TY_STRUCT)
+		    call mfree (rf_hdr[cindx], TY_CHAR)
+                    rf_fit[cindx] = NULL
+		}
+	    }
+	}
+end
+
+
+# FXF_ACCESS -- Check if a file section is necessary to access any
+# particular extension.
+
+procedure fxf_gaccess (im, fsec)
+
+pointer	im		#I image descriptor
+bool	fsec		#I true if extname,extver or group have values
+
+bool	mef
+int	acmode, fit, newimage, group
+bool    envgetb(), fnullfile()
+errchk	syserr, syserrs, fxf_fclobber
+
+begin
+	fit = IM_KDES(im)
+	acmode = FIT_ACMODE(fit) 
+	newimage = FIT_NEWIMAGE(fit)
+
+	if (acmode == READ_ONLY || acmode == READ_WRITE) {
+	    # If no file section then see if it is a MEF by prereading an
+	    # extension.
+
+	    if (!fsec) {
+		group = 1
+		mef = false
+		ifnoerr (call fxf_prhdr (im, group))
+		    mef = true
+		else {
+		    # Flag error if the group does not exist and overwrite+.
+		    if (FKS_OVERWRITE(fit) == YES)
+		        call syserrs (SYS_FXFEXTNF, IM_NAME(im))
+		}
+		# Multi-extension file but no extension was specified.
+		if (mef)
+		    call syserrs (SYS_FXFOPNOEXTNV, IM_NAME(im))
+		FIT_GROUP(fit) = 0
+		FIT_XTENSION(fit) = NO
+	    }
+	}
+	
+	switch (acmode) {
+	case NEW_COPY, NEW_IMAGE, APPEND:
+	    if (envgetb ("imclobber")) {
+		if (newimage == NO) {
+	            if (FKS_APPEND(fit) != YES && FKS_OVERWRITE(fit) != YES) {
+		        # Clobber the file.
+		        call fxf_fclobber (IM_HDRFILE(im))
+		        FIT_NEWIMAGE(fit) = YES
+		    }
+		}
+	    } else {
+	        if (newimage == NO)
+		    if (FKS_APPEND(fit) != YES && FKS_OVERWRITE(fit) != YES) {
+			if (!fnullfile (IM_HDRFILE(im)))
+			    call syserrs (SYS_IKICLOB, IM_HDRFILE(im))
+		    }
+	   }
+	default:
+	    ;
+	}
+
+end
+
+
+# FXF_CHECK_GROUP -- Check for group specification from fkinit, ksection
+# and cluster index are equal when specifified and they are also compatible
+# when (extname,extver) is in the kernel sections.
+
+procedure fxf_check_group (im, ksection, acmode, group, ksinh)
+
+pointer	im			#I imio descriptor
+char	ksection[ARB]		#I kernel section
+int	acmode			#I fits unit extension mode
+int	group			#U extension number in the image section
+int	ksinh			#O INHERIT value from the filename ksection
+
+pointer sp, ks, fit
+bool    fks_extn_or_ver, inherit_override	
+int	igroup, kgroup, fgroup, tgroup, sv_inherit, newimage, append
+bool    fnullfile()
+int	envgets()
+
+errchk  syserrs, fxf_ks_error
+
+begin
+	call smark (sp)
+	call salloc (ks, SZ_LINE, TY_CHAR)
+
+	fit = IM_KDES(im)
+	newimage = FIT_NEWIMAGE(fit)
+
+	# Set the FKINIT defaults; these override the builtin defaults.
+	fgroup = -1
+	igroup = -1
+
+	FKS_APPEND(fit) = NO_KEYW
+	if (envgets (ENV_FKINIT, Memc[ks], SZ_LINE) != 0)
+	    call fxf_ksection (Memc[ks], fit, igroup)
+
+	append = FKS_APPEND(fit)
+
+	sv_inherit = FKS_INHERIT(fit)
+	FKS_INHERIT(fit) = NO_KEYW
+	FKS_APPEND(fit) = NO_KEYW
+
+	# Parse the kernel section.
+	call fxf_ksection (ksection, fit, kgroup)
+	ksinh = FKS_INHERIT(fit)
+
+	# Check for various error conditions.
+	if (FKS_OVERWRITE(fit) == YES && FKS_APPEND(fit) == YES)
+	    call syserrs (SYS_FXFKSNOVR, "append")
+
+	if (append == NO_KEYW && FKS_APPEND(fit) == NO_KEYW)
+	    FKS_APPEND(fit) = NO
+	else if (append != NO_KEYW)
+	    FKS_APPEND(fit) = append
+
+	if (append == YES && FKS_OVERWRITE(fit) == YES)
+	    FKS_APPEND(fit) = NO
+
+	if (group != -1) {
+	    if (kgroup != -1 && group != kgroup)
+	        call syserrs (SYS_FXFKSBADGR, IM_NAME(im))
+	    else if (igroup != -1 && group != igroup)
+	        call syserrs (SYS_FXFKSBADFKIG, IM_NAME(im))
+	    fgroup = group
+	} else if (kgroup != -1) {
+	    if (group != -1 && group != kgroup)
+	        call syserrs (SYS_FXFKSBADGR, IM_NAME(im))
+	    else if (igroup != -1 && group != igroup)
+	        call syserrs (SYS_FXFKSBADFKIG, IM_NAME(im))
+	    fgroup = kgroup
+	} else if (igroup != -1) {
+	    if ((group != -1 && group != igroup) ||
+		    (kgroup != -1 && kgroup != igroup))
+	        call syserrs (SYS_FXFKSBADFKIG, IM_NAME(im))
+	    fgroup = igroup
+        }	       
+	group = fgroup      
+
+	# Pre-read the data header.  This is done after processing the user
+	# ksection as we need to get the extname/extver if any.
+	# EXTNAME or EXTVER has priority when defined over group.
+
+	fks_extn_or_ver =
+	    (FKS_EXTNAME(fit) != EOS || !IS_INDEFL(FKS_EXTVER(fit)))
+
+	tgroup = fgroup
+	if (fks_extn_or_ver) 
+	    tgroup = -1
+
+	if (newimage == NO && !fnullfile (IM_HDRFILE(im))) {
+	    iferr (call fxf_prhdr (im, tgroup)) {
+		# If group does not exist and over+, it is an error.
+		if (FKS_OVERWRITE(fit) == YES)
+		    call syserrs (SYS_FXFEXTNF, IM_NAME(im))
+	        else
+		    call erract (EA_ERROR)
+	    }   
+	}
+
+	if (fgroup != -1 && tgroup != fgroup && fks_extn_or_ver)
+	    call syserrs (SYS_FXFKSBADEXN, IM_NAME(im))
+
+	if (fgroup == -1 && fks_extn_or_ver)
+	    group = tgroup
+
+	FIT_EXPAND(fit) = FKS_EXPAND(fit)
+
+	# For overwrite we need to force group to be the kernel section
+	# extension number. 
+
+	if (FKS_OVERWRITE(fit) == YES)
+	    FIT_GROUP(fit) = max(kgroup,group)
+	else
+	    FIT_GROUP(fit) = group
+
+	if (FKS_APPEND(fit) == YES)
+	    FIT_GROUP(fit) = -1
+
+	# See if there are some error conditions with the ksection.
+	call fxf_ks_errors (fit, acmode)
+
+	# Check to see if the user ksection sets the inherit flag.  If so
+	# this overrides all the defaults, including the data header.
+
+	inherit_override = (FKS_INHERIT(fit) != NO_KEYW)
+	if (!inherit_override)
+	    FKS_INHERIT(fit) = sv_inherit
+
+	# A data header has precedence over the more global fkinit.
+	# If inherit is disabled in the data header don't enable it here.
+
+	if (!inherit_override && FIT_INHERIT(fit) == NO)
+	    FKS_INHERIT(fit) = NO
+
+	call sfree (sp)
+end
+
+
+# FXF_CLEAN_PL -- Filter PLIO keywords from the UA.
+
+procedure fxf_clean_pl (im)
+
+pointer	im	#I image descriptor
+
+begin
+	#### (This is incredibly inefficient...)
+	call fxf_filter_keyw (im, "TFORM1")
+	call fxf_filter_keyw (im, "TFIELDS")
+	call fxf_filter_keyw (im, "ZIMAGE")
+	call fxf_filter_keyw (im, "ZCMPTYPE")
+	call fxf_filter_keyw (im, "ZBITPIX")
+	call fxf_filter_keyw (im, "ZNAXIS")
+	call fxf_filter_keyw (im, "ZNAXIS1")
+	call fxf_filter_keyw (im, "ZNAXIS2")
+	call fxf_filter_keyw (im, "ZTILE1")
+	call fxf_filter_keyw (im, "ZTILE2")
+	call fxf_filter_keyw (im, "ZNAME1")
+	call fxf_filter_keyw (im, "ZVAL1")
+end
diff --git a/sys/imio/iki/fxf/fxfopix.x b/sys/imio/iki/fxf/fxfopix.x
new file mode 100644
index 00000000..0401601b
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfopix.x
@@ -0,0 +1,746 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <syserr.h>
+include <error.h>
+include	<imhdr.h>
+include	<imio.h>
+include <mach.h>
+include	"fxf.h"
+include	<fset.h>
+
+define	MIN_BUFSIZE  512
+
+
+# FXF_OPIX -- Open (or create) the pixel storage file.
+
+procedure fxf_opix (im, status)
+
+pointer	im			#I image descriptor
+int	status 			#O return status
+
+pointer sp, fn, fit
+char    pathname[SZ_PATHNAME]
+int	compress, blklen, pixoff, filesize
+int	i, hdr_size, sz_pixfile, sz_fitfile, junk, npix
+extern  fxfzop(), fxfzrd(), fxfzwr(), fxfzwt(), fxfzst(), fxfzcl()
+int	strncmp(), fxf_header_size(), fxf_totpix()
+int     strlen(), fopnbf(), fstatl(), itoc()
+
+include	<szpixtype.inc>
+
+define  err_ 91
+define  endowr_ 92
+
+begin
+	call smark (sp)
+	call salloc (fn, SZ_PATHNAME, TY_CHAR)
+
+	status = OK
+	fit = IM_KDES(im)
+
+	compress = YES
+	blklen   = 1
+	pixoff   = 1
+
+	# Tell IMIO where the pixels are.  Append the 'fit' mem descriptor
+	# to filename so that low level zfiofit routines can use it.
+
+        call strcpy (IM_HDRFILE(im), Memc[fn], SZ_PATHNAME)
+	call strcat ("_", Memc[fn], SZ_PATHNAME)
+	i = strlen (Memc[fn])
+	junk = itoc (fit, Memc[fn+i], SZ_PATHNAME) 
+        iferr (call fpathname (Memc[fn], pathname, SZ_PATHNAME))
+	    goto err_
+
+	if (FKS_OVERWRITE(fit) == YES) {
+	    call fxf_overwrite_unit (fit, im)
+	    goto endowr_
+	}
+
+	switch (IM_ACMODE(im)) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY:
+	    # Turn on IEEE mapping on input only.
+	    call ieegnanr (FIT_SVNANR(fit))
+	    call ieegmapr (FIT_SVMAPRIN(fit), FIT_SVMAPROUT(fit))
+	    call ieegnand (FIT_SVNAND(fit))
+	    call ieegmapd (FIT_SVMAPDIN(fit), FIT_SVMAPDOUT(fit))
+	    call ieesnanr (0.0)
+	    call ieemapr (YES, NO)
+	    call ieesnand (0.0D0)
+	    call ieemapd (YES, NO)
+
+	    # If the FIT datatype is BYTE or SHORT with scaling then
+	    # convert to TY_SHORT and TY_REAL respectively before
+	    # releasing the data to the upper level calls. This is
+	    # because IMIO does not support BYTE datatype and the need
+	    # to scale 16 bits to 32 bits.
+	    
+	    # Do not open pixel portion if it is empty or is not
+	    # an IMAGE type.
+
+	    if ((strncmp (FIT_EXTTYPE(fit), "IMAGE", 5) != 0 &&
+		 strncmp (FIT_EXTTYPE(fit), "SIMPLE", 6) != 0) || 
+		 IM_NDIM(im) <= 0) {
+
+	        goto err_
+	    }
+
+	    FIT_IM(fit) = im
+	    iferr (IM_PFD(im) = fopnbf (pathname, IM_ACMODE(im),
+		    fxfzop, fxfzrd, fxfzwr, fxfzwt, fxfzst, fxfzcl)) {
+	        IM_PFD(im) = NULL
+	        goto err_
+	    }
+	    
+	    FIT_TOTPIX(fit) = fxf_totpix(im)
+	    filesize = fstatl (IM_PFD(im), F_FILESIZE)
+	    FIT_PFD(fit) = IM_PFD(im)
+
+	case NEW_COPY, NEW_IMAGE, APPEND:
+	    # See if the application has set the number of dimensions.
+	    call fxf_chk_ndim (im)
+	    FIT_PIXTYPE(fit) = IM_PIXTYPE(im)
+	    npix = fxf_totpix (im)
+	    FIT_NAXIS(fit) = IM_NDIM(im)
+	    call amovi (IM_LEN(im,1), FIT_LENAXIS(fit,1), IM_NDIM(im))
+
+	    call fxf_discard_keyw (im)
+	    FIT_TOTPIX(fit) = npix
+
+	    # Do not allow BSCALE and BZERO in the UA when making a new copy or
+	    # new image if bitpix is negative. Except for ushort
+
+	    if (IM_PIXTYPE(im) != TY_USHORT) {
+		call fxf_filter_keyw (im, "BSCALE")
+		call fxf_filter_keyw (im, "BZERO")
+	    }
+
+	    # Hdr_size is in char units. (i.e. 1440 chars per FITS block).
+	    hdr_size = fxf_header_size (im)
+
+            # Reset the scaling parameter because in NEW_COPY mode there
+	    # should not be scaled pixels.  The previous call will get these
+	    # values from the input image.
+
+	    FIT_BSCALE(fit) = 1.0d0
+	    FIT_BZERO(fit) = 0.0d0
+
+	    sz_pixfile = npix * pix_size[IM_PIXTYPE(im)]
+
+	    # The pixel file needs to be a multiple of 1440 chars.
+	    sz_pixfile = FITS_LEN_CHAR (sz_pixfile)
+	    sz_fitfile = sz_pixfile + hdr_size
+
+	    if (FIT_NEWIMAGE(fit) == YES)
+	       call falloc (IM_PIXFILE(im), sz_fitfile) 
+	      
+	    FIT_IM(fit) = im
+
+	    iferr (IM_PFD(im) = fopnbf (pathname, READ_WRITE,
+		    fxfzop, fxfzrd, fxfzwr, fxfzwt, fxfzst, fxfzcl)) {
+		IM_PFD(im) = NULL
+		call erract (EA_FATAL)
+		goto err_
+	    }
+
+	    FIT_PFD(fit) = IM_PFD(im)
+	    filesize = fstatl (IM_PFD(im), F_FILESIZE)
+	    FIT_EOFSIZE(fit) = filesize + 1
+
+	    if (FIT_NEWIMAGE(fit) == NO) {
+	        # Now we are appending a new IMAGE extension.
+	        # Write a blank header in order to append the
+	        # pixels after it.
+
+	        pixoff = filesize + hdr_size + 1
+
+		# Update the offset for the blank write to follow which uses
+		# a local file driver tied to the IM_PFD descriptor and not
+		# the normal FIO.
+                FIT_PIXOFF(fit) = pixoff
+
+	        # Update filesize
+	        filesize = filesize + sz_fitfile
+	        call fxf_write_blanks (IM_PFD(im), hdr_size)
+	    } else 
+	        pixoff = hdr_size + 1
+
+            FIT_PIXOFF(fit) = pixoff
+	    call imioff (im, pixoff, compress, blklen)
+
+	    IM_HFD(im) = NULL
+
+	default:
+	    call imerr (IM_NAME(im), SYS_IMACMODE)
+	}
+
+endowr_
+	FIT_PFD(fit) = IM_PFD(im)
+	FIT_HFD(fit) = IM_HFD(im)
+
+	# The following statement is to pass the datatype at the low
+	# level fits read and write routines. The datatype value can
+	# change after the image is open. Hopefully the value of 'im'
+	# will remain static.
+	
+	FIT_IM(fit) = im
+	status = OK
+
+ 	call sfree (sp)
+	return
+err_
+	status = ERR
+        call sfree (sp)
+end
+ 
+
+# FXF_HEADER_SIZE -- Function to calculate the header size that would go 
+# into the output file extension.
+
+int procedure fxf_header_size (im)
+
+pointer im 				#I Image descriptor
+
+bool	inherit
+int	merge, hdr_size
+pointer op, fit, sp, tb, pb
+int	nheader_cards, ualen, ulines, clines
+int	strlen()
+
+begin
+	fit = IM_KDES(im)
+        inherit = false
+
+	# Fks_inherit is a combined value.
+        if (FKS_INHERIT(fit) == YES)
+	    inherit = true
+
+	call fxf_mandatory_cards (im, nheader_cards)
+
+	if (FIT_NEWIMAGE(fit) == NO && inherit) {
+	    # See if current UA keywords are in the global header, if not
+	    # there put it in a spool file. At the end, the spool file size is
+	    # the output extension header size to be use in fitupdhdr.
+
+	    # Check if the file is still in cache. We need CACHELEN and
+            # CACHEHDR. 
+
+            call fxf_not_incache (im)
+
+	    op = IM_USERAREA(im)
+	    ualen = strlen (Memc[op])
+	    ulines = ualen / LEN_UACARD
+	    clines = FIT_CACHEHLEN(fit) / LEN_UACARD
+
+	    call smark (sp)
+	    call salloc (tb, ualen+1, TY_CHAR)
+
+	    merge = NO
+	    pb = tb
+
+	    # Now select those lines from the UA (pointed by op) that are
+	    # not in the cache and accumulate them in 'pb'.
+
+	    call fxf_match_str (op, ulines, FIT_CACHEHDR(fit), clines,merge,pb)
+	    Memc[pb+1] = EOS
+	    ualen = strlen (Memc[tb])
+
+	    call sfree (sp)
+
+	} else {
+	    op = IM_USERAREA(im)
+	    ualen = strlen (Memc[op])
+	}
+
+	ulines = ualen / LEN_UACARD + nheader_cards + FKS_PADLINES(fit)
+
+	##### Note: PHULINES is not currently used, should be implemented
+	##### Not clear to me if this code here is used for the PHU since
+	##### it is in opix!
+
+	# See if the application has set a minumum number of card for the UA.
+
+	ulines = max (ulines, FKS_EHULINES(fit))
+
+	# The user area contains new_lines (81 chars, LEN_UACARD).  Scale to
+	# 80 chars (LEN_CARD).  Ualen is in bytes.
+
+	ualen = ulines * LEN_CARD 
+
+	# Calculate the number of header FITS blocks in chars.
+	hdr_size = FITS_LEN_CHAR (ualen / 2)
+
+	return (hdr_size)
+end
+
+
+# FXF_BYTE_SHORT -- This routine is obsolete and has been deleted, but is
+# being preserved for the V2.11.2 patch so that a new shared library version
+# does not have to be created.  It can be deleted in the next major release.
+
+procedure fxf_byte_short (im, fname)
+
+pointer	im
+char	fname[ARB]
+
+begin
+end
+
+
+# FXF_WRITE_BLANKS --Procedure to append a blank header to an existing
+# file, preparing to write data after it.
+
+procedure fxf_write_blanks (fd, size)
+
+int	fd			#I File descriptor
+int	size			#I New size (chars) to allocate.
+
+pointer sp, bf
+int	nblocks,i, fits_lenc
+
+begin
+	call smark (sp)
+
+	# Length of a FITS block (2880) in chars.
+	fits_lenc = FITS_BLOCK_BYTES/SZB_CHAR
+	call salloc (bf, fits_lenc, TY_INT)
+	call amovki (0, Memi[bf], fits_lenc)
+
+	size = FITS_LEN_CHAR(size)
+	nblocks = size / fits_lenc
+
+	call seek (fd, EOF)
+	do i = 1, nblocks 
+	    call write (fd, Memi[bf], fits_lenc)
+
+	call sfree (sp)
+end
+
+
+# FXF_MANDATORY_CARDS --  Count the required FITS header cards.
+# The cards for the Main Unit are: SIMPLE, BITPIX, NAXIS, 
+# EXTEND, ORIGIN, DATE, IRAF_TLM, OBJECT and END; 
+# 'IM_NDIM(im)', DATAMIN and DATAMAX will be put out
+# only if the LIMTIME > MTIME.
+# would  take care of NAXISi. For an Extension unit, the cards are:
+# XTENSION, BITPIX, NAXIS, PCOUNT, GCOUNT, ORIGIN, DATE, INHERIT,
+# EXTNAME, IRAF_TLM, OBJECT and END; IM_NDIM(im) takes care of
+# NAXISi. Same as above for DATAMIN, DATAMAX.
+# If these cards are in the main header, reduce the number of
+# mandatory cards that are going to be created at closing time
+# (in fitupdhdr).
+	  
+procedure fxf_mandatory_cards (im, nheader_cards)
+
+pointer im			#I im structure
+int	nheader_cards		#O Number of mandatory cards in header.
+
+pointer ua
+int	ncards, rp, fit, acmode
+int	idb_findrecord()
+
+begin
+	ua = IM_USERAREA(im)
+	fit = IM_KDES(im)
+
+	if (FIT_NEWIMAGE(fit) == YES)		# create a PHU
+	    ncards = 9 + IM_NDIM(im) 
+	else					# create an EHU
+	    ncards = 12 + IM_NDIM(im) 
+
+	if (idb_findrecord (im, "PCOUNT", rp) > 0) {
+	    if (FIT_XTENSION(fit) == YES) 
+	        ncards = ncards - 1
+	    else
+	        call fxf_filter_keyw (im, "PCOUNT")
+	}
+	if (idb_findrecord (im, "GCOUNT", rp) > 0) {
+	    if (FIT_XTENSION(fit) == YES) 
+	        ncards = ncards - 1
+	    else
+	        call fxf_filter_keyw (im, "GCOUNT")
+	}
+	if (idb_findrecord (im, "EXTNAME", rp) > 0) {
+	    if (FIT_XTENSION(fit) == YES) 
+	        ncards = ncards - 1
+	    else
+	        call fxf_filter_keyw (im, "EXTNAME")
+	}
+	if (idb_findrecord (im, "INHERIT", rp) > 0) {
+	    if (FIT_XTENSION(fit) == YES) 
+	        ncards = ncards - 1
+	    else
+	        call fxf_filter_keyw (im, "INHERIT")
+	}
+	if (idb_findrecord (im, "EXTEND", rp) > 0)  {
+	    if (FIT_XTENSION(fit) == NO)  {
+	        ncards = ncards - 1
+	    } else {
+		# Delete the keyword from the UA because EXTEND is not
+		# recommended in XTENSION units.
+
+	        call fxf_filter_keyw (im, "EXTEND")
+	    }
+	}
+
+	if (idb_findrecord (im, "ORIGIN", rp) > 0)
+	    ncards = ncards - 1
+	if (idb_findrecord (im, "DATE", rp) > 0 ) 
+	    ncards = ncards - 1
+	if (idb_findrecord (im, "IRAF-TLM", rp) > 0) 
+	    ncards = ncards - 1
+	if (idb_findrecord (im, "OBJECT", rp) > 0) 
+	    ncards = ncards - 1
+
+	# See if we need to add one more mandatory card when an EXTVER value
+	# was specified when appending a new extension.
+
+	if (FIT_NEWIMAGE(fit) == NO && idb_findrecord(im,"EXTVER",rp) == 0) {
+	    # Keyword does not exist.
+	    acmode = IM_ACMODE(im)
+	    if ((acmode == NEW_IMAGE || acmode == NEW_COPY) && 
+		FKS_EXTVER(fit) != INDEFL )
+	    ncards = ncards + 1
+	}
+
+	# We want to keep BSCALE and BZERO in the UA in case we are 
+	# editing the values. Is up to the user or application
+	# responsability to deal with the change in pixel value when reading.
+	# If we are reading pixels the values will change according to the
+	# input BSCALE and BZERO. If we are adding BSCALE and BZERO before 
+	# accessing any pixels, these will get scale. If adding or
+	# changing right before closing the image, the pixel value will be 
+	# unchanged.
+
+	# See if BSCALE and BZERO are in the UA for ushort, otherwise
+	# increase the number.
+
+	if (IM_PIXTYPE(im) == TY_USHORT) {
+	    if (idb_findrecord (im, "BSCALE", rp) == 0) 
+	        ncards = ncards + 1
+	    if (idb_findrecord (im, "BZERO", rp) == 0) 
+	        ncards = ncards + 1
+        }
+	nheader_cards = ncards
+end
+
+
+# FXF_OVERWRITE_UNIT -- Overwrite an existent extension. A temporary file
+# is created that contains the current file upto the extension before the
+# one to be overwrite.
+
+procedure fxf_overwrite_unit (fit, im)
+
+pointer	fit			#I Fits descriptor
+pointer	im			#I Image descriptor
+
+pointer sp, file, mii
+int	pixoff, compress, blklen, sz_fitfile, i, group, filesize
+int	junk, in_fd, out_fd, nblocks, nk, hdr_size, sz_pixfile
+extern  fxfzop(), fxfzrd(), fxfzwr(), fxfzwt(), fxfzst(), fxfzcl()
+int	fnroot(), open(), read(), fxf_totpix(), strncmp(), itoc()
+int	strlen(), fopnbf(), fstatl(), fxf_header_size()
+
+include	<szpixtype.inc>
+
+errchk	syserr, syserrs
+define  err_ 91
+
+begin
+	group = FIT_GROUP(fit)
+
+	# Do not overwrite extensions that are not IMAGE.
+	if (group != 0 && strncmp (FIT_EXTTYPE(fit), "IMAGE", 5) != 0 &&
+		strncmp (FIT_EXTTYPE(fit), "SIMPLE", 6) != 0) {
+
+	    call syserr (SYS_FXFOVRBEXTN)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (file, SZ_FNAME, TY_CHAR)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+	
+	junk = fnroot (IM_HDRFILE(im), Memc[file], SZ_FNAME)
+
+	# Keep the temporary filename in IM_PIXFILE(im).
+	call mktemp (Memc[file], IM_PIXFILE(im), SZ_PATHNAME)
+	call strcat (".fits", IM_PIXFILE(im), SZ_PATHNAME)
+
+	# If we want to overwrite the first group there is nothing
+	# to copy first.
+
+	if (group != 0) {
+	    # Copy from the old file up to hdr_off[group] into a temporary file.
+	    in_fd = open (IM_HDRFILE(im), READ_ONLY, BINARY_FILE)
+	    out_fd = open (IM_PIXFILE(im), NEW_FILE, BINARY_FILE)
+	    nblocks = Memi[FIT_HDRPTR(fit)+group]/ FITS_BLOCK_CHARS
+	    do nk = 1, nblocks {
+		junk = read (in_fd, Memi[mii], FITS_BLOCK_CHARS)
+		call write (out_fd, Memi[mii], FITS_BLOCK_CHARS)
+	    }
+	    call close (in_fd)
+	    call close (out_fd)
+	}
+
+	FIT_NAXIS(fit) = IM_NDIM(im)
+	call amovi (IM_LEN(im,1), FIT_LENAXIS(fit,1), IM_NDIM(im))
+	
+	FIT_TOTPIX(fit) = fxf_totpix(im)
+
+	# Do not allow BSCALE and BZERO in the UA when making a new copy or
+	# new image if bitpix is negative. Except for ushort.
+
+	if (IM_PIXTYPE(im) != TY_USHORT) {
+	    call fxf_filter_keyw (im, "BSCALE")
+	    call fxf_filter_keyw (im, "BZERO")
+	}
+
+	# The new copy header should not have the following keywords:
+	# GROUPS, PSIZE and that could come from a GEIS file. 
+
+	call fxf_discard_keyw (im)
+	hdr_size = fxf_header_size (im)
+
+	# Reset the scaling parameter because in NEW_COPY mode there
+	# should not be scaled pixels. The previous call will get these
+	# values from the input image.
+
+	FIT_BSCALE(fit) = 1.0d0
+	FIT_BZERO(fit) = 0.0d0
+
+        call fpathname (IM_PIXFILE(im), Memc[file], SZ_PATHNAME)
+	call strcat("_", Memc[file], SZ_PATHNAME)
+	i = strlen(Memc[file])
+	junk = itoc (fit, Memc[file+i], SZ_PATHNAME) 
+
+	# The pixel file needs to be a multiple of 1440 chars.
+	sz_pixfile = fxf_totpix(im) * pix_size[IM_PIXTYPE(im)]
+	sz_pixfile = FITS_LEN_CHAR(sz_pixfile)
+	sz_fitfile = sz_pixfile + hdr_size
+
+	if (group == 0)
+	   call falloc (IM_PIXFILE(im), sz_fitfile)
+
+	FIT_IM(fit) = im
+	iferr (IM_PFD(im) = fopnbf (Memc[file], READ_WRITE,
+		fxfzop, fxfzrd, fxfzwr, fxfzwt, fxfzst, fxfzcl)) {
+
+	    IM_PFD(im) = NULL
+	    goto err_
+	}
+
+	filesize = fstatl (IM_PFD(im), F_FILESIZE)
+	FIT_EOFSIZE(fit) = filesize + 1
+	# Now write a blank header.
+	if (group != 0) {
+	    call amovki (0, Memi[mii], FITS_BLOCK_CHARS)
+	    nblocks = hdr_size/FITS_BLOCK_CHARS
+	    FIT_HFD(fit) = -1
+
+	    call seek (IM_PFD(im), EOF)
+	    do nk = 1, nblocks 
+		call write (IM_PFD(im), Memi[mii], FITS_BLOCK_CHARS)
+	    
+	    pixoff = filesize + hdr_size + 1
+	    filesize = filesize + sz_fitfile
+	} else
+	   pixoff = hdr_size + 1
+
+
+	FIT_PIXOFF(fit) = pixoff
+	IM_HFD(im) = NULL
+
+	blklen = 1
+	compress = YES
+	call imioff (im, pixoff, compress, blklen)
+
+        FIT_PFD(fit) = IM_PFD(im)
+	FIT_HFD(fit) = IM_HFD(im)
+		 
+	call sfree (sp)
+	return
+err_
+	call syserr (SYS_FXFOVRTOPN)
+        call sfree (sp)
+end
+
+
+# TOTPIX -- Calculate the total number of pixels in the image.
+
+int procedure fxf_totpix (im) 
+
+pointer im			#I image descriptor
+int	i, pix, ndim
+
+begin
+	ndim = IM_NDIM(im)
+	if (ndim == 0)
+	    return (0)
+
+	pix = IM_LEN(im,1)
+	do i = 2, ndim
+	    pix = pix * IM_LEN(im,i)
+
+	return (pix)
+end
+
+
+# FXF_DISCARD_FITS_KEYW -- Exclude certain keywords from a new copy image.
+
+procedure fxf_discard_keyw (im)
+
+pointer im 			#I image descriptor
+pointer fit
+
+begin
+	fit = IM_KDES(im)
+
+	call fxf_filter_keyw (im, "GROUPS")
+	call fxf_filter_keyw (im, "PSIZE")
+	call fxf_filter_keyw (im, "BLOCKED")
+	call fxf_filter_keyw (im, "IRAFNAME")
+	call fxf_filter_keyw (im, "IRAF-BPX")
+	call fxf_filter_keyw (im, "IRAFTYPE")
+
+	if (FIT_NEWIMAGE(fit) == NO)
+	    call fxf_filter_keyw (im, "EXTEND")
+
+	# Create a PHU.
+	if (FIT_NEWIMAGE(fit) == YES) {
+	    call fxf_filter_keyw (im, "PCOUNT")
+	    call fxf_filter_keyw (im, "GCOUNT")
+	    call fxf_filter_keyw (im, "INHERIT")
+	    call fxf_filter_keyw (im, "EXTNAME")
+	    call fxf_filter_keyw (im, "EXTVER")
+	    call fxf_filter_keyw (im, "EXTLEVEL")
+	}
+end
+
+
+# FXF_FILTER_KEYW -- Delete the names keyword from the userarea.
+
+procedure fxf_filter_keyw (im, key)
+
+pointer	im	 	 #I image descriptor
+char	key[ARB] 	 #I keyword name to delete from USERAREA.
+
+pointer rp
+int     off
+int     idb_findrecord(), stridxs()
+
+begin
+	# Verify that the named user field exists.
+	if (idb_findrecord (im, key, rp) <= 0)
+	    return
+
+        # Delete the field.
+        off = stridxs ("\n", Memc[rp])
+	if (off > 0)
+	    call strcpy (Memc[rp+off], Memc[rp], ARB)
+	else
+	    Memc[rp] = EOS
+end
+
+
+# FXF_FALLOC -- Preallocate space on disk by writing blanks.
+
+procedure fxf_falloc (fname, size)
+
+char	fname[ARB]	#I filename
+int	size      	#I size to preallocate in chars
+
+pointer sp, cp
+int	nb,i, fd
+errchk  open, write
+int	open()
+
+begin
+	call smark (sp)
+	call salloc (cp, FITS_BLOCK_CHARS, TY_CHAR)
+	
+        call amovkc (' ', Memc[cp], FITS_BLOCK_CHARS)
+	nb = size / FITS_BLOCK_CHARS
+	fd = open (fname, NEW_FILE, BINARY_FILE)
+
+	do i = 1, nb
+	    call write (fd, Memc[cp], FITS_BLOCK_CHARS)
+
+	call flush (fd)
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# FXF_CKH_NDIM -- Check that the application has indeed set the number
+# of dimension, otherwise count the axes.
+
+procedure fxf_chk_ndim (im)
+
+pointer im		#I imio descriptor
+int	ndim		#I number of dimension for image
+
+begin
+	ndim = IM_NDIM(im)
+
+	# If ndim was not explicitly set, compute it by counting the number
+	# of nonzero dimensions.
+
+	if (ndim == 0) {
+	    for (ndim=1;  IM_LEN(im,ndim) > 0 && ndim <= IM_MAXDIM; ndim=ndim+1)
+	        ;
+	    ndim = ndim - 1
+	    IM_NDIM(im) = ndim
+	}
+end
+
+        
+# FXF_NOT_INCACHE -- Procedure to find whether the file is in the
+# cache. It could happen that the slot with the entry might have been
+# freed to make room for another file. We want to have valid pointers
+# for FIT_CACHEHDR and FIT_CACHELEN since the calling routine will use them.
+
+procedure fxf_not_incache (im)
+
+pointer im                      #I image descriptor
+
+int     cindx, group, sfit[4]
+pointer sp, hdrfile, fit
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+        call smark (sp)
+        call salloc (hdrfile, SZ_PATHNAME, TY_CHAR) 
+
+        call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+        fit = IM_KDES(im)
+
+        do cindx=1, rf_cachesize {
+            if (rf_fit[cindx] == NULL)
+                next
+
+            if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+                call sfree (sp)
+                return      
+            }
+        }
+        sfit[1]= FIT_NAXIS(fit)
+        sfit[2] = FIT_INHERIT(fit)
+        sfit[3] = FIT_PLMAXLEN(fit)
+        sfit[4] = IM_CTIME(im)  
+
+        group = max (0, FIT_GROUP(fit))
+
+        call fxf_prhdr(im,group)
+
+        FIT_NAXIS(fit) = sfit[1]
+        FIT_INHERIT(fit) = sfit[2]
+        FIT_PLMAXLEN(fit) = sfit[3]
+        IM_CTIME(im) = sfit[4]
+
+        call sfree (sp)
+        return
+end
+
diff --git a/sys/imio/iki/fxf/fxfpak.x b/sys/imio/iki/fxf/fxfpak.x
new file mode 100644
index 00000000..01db148d
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfpak.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include <mach.h>
+include "fxf.h"
+
+
+# FXF_PAK_DATA -- Convert npix elements of type pixtype as needed for storage
+# in a FITS file.  All floating point data will be converted to IEEE format.
+# The input and output buffers may be the same if desired.
+
+procedure fxf_pak_data (ibuf, obuf, npix, pixtype)
+
+char    ibuf[ARB]		#I input data buffer
+char    obuf[ARB]		#I output data buffer
+int	npix			#I number of pixels in buffer
+int	pixtype			#I input pixel datatype
+
+int	nbytes, nchars
+errchk	syserr
+
+include <szpixtype.inc>
+
+begin
+	### Possibly the MII conversion routines should be used here as
+	### they handle all these datatypes (except maybe ushort).
+
+	nchars = npix * pix_size[pixtype]
+	nbytes = nchars * SZB_CHAR
+
+	switch (pixtype) {
+	case TY_USHORT:
+	    call fxf_altmu (ibuf, obuf, npix)
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (obuf, 1, obuf, 1, nbytes)
+
+	case TY_SHORT:
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (ibuf, 1, obuf, 1, nbytes)
+	    else
+		call amovc (ibuf, obuf, nchars)
+
+	case TY_INT, TY_LONG:
+	    if (BYTE_SWAP4 == YES)
+		call bswap4 (ibuf, 1, obuf, 1, nbytes)
+	    else
+		call amovc (ibuf, obuf, nchars)
+
+	case TY_REAL:
+	    call ieevpakr (ibuf, obuf, npix)
+
+	case TY_DOUBLE:
+	    call ieevpakd (ibuf, obuf, npix)
+
+	default:
+	   call syserr (SYS_FXFPKDTYP)
+	}
+end
diff --git a/sys/imio/iki/fxf/fxfplread.x b/sys/imio/iki/fxf/fxfplread.x
new file mode 100644
index 00000000..4d4c3e83
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfplread.x
@@ -0,0 +1,160 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <syserr.h>
+include <plset.h>
+include <imhdr.h>
+include <imio.h>
+include <mach.h>
+include "fxf.h"
+
+
+# FXF_PLREAD -- Read a PLIO mask stored in a FITS binary table extension
+# and load it into an image descriptor.
+#
+# There is a builtin assumption in this code (also in fxf_plwrite) that
+# masks will not be more than 3-dimensional.  This could be generalized
+# if necessary, but we have never seen a mask of dimensionality higher
+# than 3.  The dimensionality, size, and depth of the mask is preserved.
+
+procedure fxf_plread (im)
+
+pointer	im			#I image descriptor
+
+char	kwname[SZ_KEYWORD]
+pointer sp, fk, pl, lp, ip, ix
+long	data_offset, data_len, heap_offset, llen, loff
+int	naxes, axlen[IM_MAXDIM], depth, maxlen
+int	fd, i, j, nelem, nlines, v[PL_MAXDIM], maxoff, nbytes
+
+long	note()
+bool	streq()
+int	imgeti(), pl_create(), miireadi(), miireads()
+errchk	imgeti, pl_create, miireadi, miireads, seek, pl_update, syserrs
+
+begin
+	call smark (sp)
+
+	fk = IM_KDES(im)
+	fd = IM_HFD(im)
+
+	# The maximum encoded line list length is (normally) passed in via
+	# the binary table format keywords, and stored in FIT_PLMAXLEN.
+
+	maxlen = FIT_PLMAXLEN(fk)
+	if (maxlen <= 0)
+	    maxlen = DEF_PLMAXLEN
+
+	# Scratch buffer for encoded line lists.
+	call salloc (lp, maxlen, TY_SHORT)
+
+	# Get the dimensionality and size of the stored mask.
+	call amovki (1, axlen, IM_MAXDIM)
+	naxes = imgeti (im, "ZNAXIS")
+	call fxf_filter_keyw (im, "ZNAXIS")
+	do i = 1, naxes {
+	    call sprintf (kwname, LEN_CARD, "ZNAXIS%d")
+		call pargi(i)
+	    axlen[i] = imgeti (im, kwname)
+	    call fxf_filter_keyw (im, kwname)
+	    call sprintf (kwname, LEN_CARD, "ZTILE%d")
+		call pargi(i)
+	    call fxf_filter_keyw (im, kwname)
+	}
+
+	# Get the mask depth, passed as compression algorithm parameter
+	# number 1 for a PLIO-compressed image.
+
+	depth = DEF_PLDEPTH
+	ifnoerr (call imgstr (im, "ZNAME1", kwname, SZ_KEYWORD)) {
+	    if (streq (kwname, "depth"))
+		iferr (depth = imgeti (im, "ZVAL1"))
+		    depth = DEF_PLDEPTH
+	    call fxf_filter_keyw (im, "ZNAME1")
+	    call fxf_filter_keyw (im, "ZVAL1")
+	    call fxf_filter_keyw (im, "ZBITPIX")
+	    call fxf_filter_keyw (im, "ZIMAGE")
+	}
+
+	# Create an initially empty mask of the given size.
+	pl = pl_create (naxes, axlen, depth)
+
+	# Create a buffer for the line list index (maxdim 3 assumed).
+	nlines = axlen[3] * axlen[2]
+	call salloc (ix, nlines * 2, TY_INT)
+
+	# Compute the file offsets of the table data and heap areas.  The
+	# file position is assumed to be already positioned at the start
+	# of the data area of the file.
+
+	data_offset = note (fd)
+	data_len = FIT_LENAXIS(fk,3) * FIT_LENAXIS(fk,2) * FIT_LENAXIS(fk,1)
+	heap_offset = data_offset + data_len/SZB_CHAR
+
+	# Read the line list index from the input file.  The index contains
+	# one entry for every line in the (possibly multidimensional) image.
+	# Each entry consists of two integer values, the length of the
+	# stored line list, and the heap offset (in bytes) of the stored list.
+
+	nelem = miireadi (fd, Memi[ix], nlines * 2)
+	if (nelem != nlines * 2)
+	    call syserrs (SYS_FXFRMASK, IM_NAME(im))
+	
+	# Find out the maximum offset value to determine if they were
+	# written using the 2 byte units rather than the standard (byte unit)
+
+	maxoff = 0
+        ip = ix
+	do j = 1, axlen[3] {
+            do i = 1, axlen[2] {
+	       maxoff = max (maxoff, Memi[ip+1]+2*Memi[ip]) 
+   	       ip = ip + 2
+	    }
+	}
+
+	if (maxoff < (FIT_PCOUNT(fk) - maxoff/2)) {
+	    nbytes = 1
+        } else {	
+	    nbytes = 2
+	}
+
+	# Read the line list data and insert it into the PLIO mask.  
+	# pl_update will be called for each line of the mask even if multiple
+	# lines point to the same line list data, but pl_update will sort
+	# all this out and restore the multiple references as the mask is
+	# built.
+
+	ip = ix
+	v[1] = 1
+
+	do j = 1, axlen[3] {
+	    v[3] = j
+	    do i = 1, axlen[2] {
+		v[2] = i
+
+		llen = Memi[ip]
+
+		# This offset on the table data is in byte units, convert
+		# to short.
+
+		loff = Memi[ip+1] / nbytes
+
+		call seek (fd, heap_offset + loff)
+		nelem = miireads (fd, Mems[lp], llen)
+		if (nelem != llen)
+		    call syserrs (SYS_FXFRMASK, IM_NAME(im))
+
+		call pl_update (pl, v, Mems[lp])
+
+		ip = ip + 2
+	    }
+	}
+
+	# Set up IMIO descriptor.
+	call amovl (axlen, IM_LEN(im,1), IM_MAXDIM)
+	call amovl (axlen, IM_PHYSLEN(im,1), IM_MAXDIM)
+        IM_NDIM(im) = naxes
+	IM_PIXTYPE(im) = TY_INT
+	IM_PL(im) = pl
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfplwrite.x b/sys/imio/iki/fxf/fxfplwrite.x
new file mode 100644
index 00000000..65909dcb
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfplwrite.x
@@ -0,0 +1,418 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <mach.h>
+include <imio.h>
+include <imhdr.h>
+include <mii.h>
+include <plset.h>
+include <pmset.h>
+include "fxf.h"
+
+
+# FXFPLWRITE.X -- Routines to handle masks in FITS extensions.
+#
+#	 fxf_plwrite     (im, fd)
+#	 fxf_plinfo      (im, maxlen, pcount, depth)
+#	 fxf_pl_adj_heap (im, hdr_fd, pcount)
+#        fxf_copy_adj    (im, in_fd, hdroff, poff, datasize)
+#	 fxf_plpf        (im)
+#
+
+
+# FXF_PLWRITE -- Write the data from a PLIO mask into the data area of a
+# FITS compressed image (ZIMAGE) binary table extension.  The data is
+# written to the file pointed to by file descriptor FD.
+#
+# The data to be written consists of the data for the ZIMAGE binary table
+# records, followed by the heap area of the BINTABLE extension, which
+# contains the actual encoded line lists.  For simplicity we assume that
+# the table contains only one column, the COMPRESSED_DATA column, which is
+# of type variable length integer array.  Each element of this column is a
+# BINTABLE variable length array descriptor which physically consists of two
+# integer values: an integer giving the length of the stored array (encoded
+# line list), followed by an integer (in byte unit) giving the offset of 
+# the array data (encoded line list) in the heap area.  Multiple variable 
+# length array descriptors may point to the same stored array, and in 
+# fact PLIO uses this feature to implement compression in the Y direction 
+# (adjacent mask lines will point to the same encoded line list).  
+# The code here supports masks of up to 3 dimensions.
+
+procedure fxf_plwrite (im, fd)
+
+pointer	im			#I image descriptor
+int	fd			#I output file descriptor
+
+int	i, j, v_in[PL_MAXDIM], lp_len
+int	naxes, axlen[PL_MAXDIM], depth
+int	heap_offset, ep_off, lp_off, vararray[2]
+pointer	pl, lp, op, emptyline, lastline
+
+int	pl_llen()
+pointer	pl_access(), pl_emptyline()
+errchk	pl_access
+
+begin
+	pl = IM_PL(im)
+	call pl_gsize (pl, naxes, axlen, depth)
+
+	# Write the COMPRESSED_DATA table column.  This is an index giving
+	# the length and heap offset of the encoded PLIO line list for each
+	# line of the image.  Multiple image lines (index entries) may point
+	# to the same stored line list: this happens if a mask line is empty
+	# (the empty line) or if successive lines are all the same.  For the
+	# sake of simplicity, only masks of up to 3 dimensions are supported.
+
+	op = 0
+	heap_offset = 0
+	emptyline = pl_emptyline (pl)
+	ep_off = -1
+	lastline = NULL
+	lp_off = -1
+	call amovkl(long(1), v_in, PL_MAXDIM)
+
+	do j = 1, axlen[3] {
+	    v_in[3] = j
+	    do i = 1, axlen[2] {
+		v_in[2] = i
+		lp = pl_access (pl, v_in)
+		lp_len = pl_llen (Mems[lp])
+
+		if (lp == emptyline && ep_off >= 0)
+		    op = ep_off
+	        else if (lp == lastline)
+		    op = lp_off
+		else
+		    op = heap_offset
+
+		vararray[1] = lp_len
+
+		# The offsets on the FITS BINTABLE is in byte unit 
+		# as establish by the FITS standard.
+
+		vararray[2] = op * 2              # Byte offset
+
+		call miiwritei (fd, vararray, 2)
+
+		lastline = lp
+		lp_off = op 
+		if (lp == emptyline && ep_off < 0)
+		    ep_off = op
+
+		if (op == heap_offset)
+		    heap_offset = heap_offset + lp_len
+	    }
+	}
+	# Now write the line list data to the heap area.  The logic here must
+	# follow that above or the line offsets won't match.
+
+	ep_off = -1
+	lp_off = -1
+	lastline = NULL
+
+	do j = 1, axlen[3] {
+	    v_in[3] = j
+	    do i = 1, axlen[2] {
+		v_in[2] = i
+		lp = pl_access (pl, v_in)
+		lp_len = pl_llen (Mems[lp])
+
+		if (lp == emptyline && ep_off >= 0)
+		    next
+		else if (lp == lastline)
+		    next
+
+		call miiwrites (fd, Mems[lp], lp_len)
+
+		lastline = lp
+		if (lp == emptyline && ep_off < 0)
+		    ep_off = 0
+	    }
+	}
+end
+
+
+# FXF_PLINFO -- Examine a PLIO mask and compute the maximum length of an
+# encoded line list, and the storage in bytes required to store the mask
+# data in the heap area of a FITS binary table.
+
+procedure fxf_plinfo (im, maxlen, pcount, depth)
+
+pointer	im			#I image descriptor
+int	maxlen			#O maximum line list length
+int	pcount			#O storage required to store mask (bytes)
+int	depth			#O mask depth
+
+int	naxes, axlen[PL_MAXDIM]
+int	i, j, v_in[PL_MAXDIM], lp_len
+int	heap_offset, ep_off, lp_off
+pointer	pl, lp, op, emptyline, lastline
+
+int	pl_llen()
+pointer	pl_access(), pl_emptyline()
+errchk	pl_access
+
+begin
+	pl = IM_PL(im)
+	call pl_gsize (pl, naxes, axlen, depth)
+
+	op = 0
+	maxlen = 0
+	heap_offset = 0
+	emptyline = pl_emptyline (pl)
+	ep_off = -1
+	lastline = NULL
+	lp_off = -1
+	call amovkl(long(1), v_in, PL_MAXDIM)
+
+	# The following must duplicate the logic above for determining what
+	# gets written to the heap area.  All we are doing here is computing
+	# the amount of heap storage required to store the compressed mask.
+
+	do j = 1, axlen[3] {
+	    v_in[3] = j
+	    do i = 1, axlen[2] {
+		v_in[2] = i
+		lp = pl_access (pl, v_in)
+		lp_len = pl_llen (Mems[lp])
+		maxlen = max (maxlen, lp_len)
+
+		if (lp == emptyline && ep_off >= 0)
+		    op = ep_off
+		else if (lp == lastline)
+		    op = lp_off
+		else
+		    op = heap_offset
+
+		lastline = lp
+		lp_off = op
+		if (lp == emptyline && ep_off < 0)
+		    ep_off = op
+
+		if (op == heap_offset)
+		    heap_offset = heap_offset + lp_len
+	    }
+	}
+
+	pcount = heap_offset * (SZ_SHORT * SZB_CHAR)
+end
+
+
+# FXF_PL_ADJ_HEAP -- Resize heap when we have a hole bigger than 2880 bytes
+# or if we overwrite the next extension.
+
+procedure fxf_pl_adj_heap (im, hdr_fd, pcount)
+
+pointer	im			#I imio descriptor
+int	hdr_fd			#U file descriptor
+int	pcount			#I new heap size in bytes
+
+pointer fk, hdrp, pixp
+int	datasize, hdroff, diff, nb, group, i
+
+begin
+	fk = IM_KDES(im)
+
+	# Calculate the size of the TABLE data. (8 bytes per line)
+	datasize = FIT_LENAXIS(fk,1)*FIT_LENAXIS(fk,2)*
+		FIT_LENAXIS(fk,3)
+	datasize = (datasize + pcount)/SZB_CHAR
+
+	call fxf_not_incache(im)
+	hdrp = FIT_HDRPTR(fk)
+	pixp = FIT_PIXPTR(fk)
+	group = FIT_GROUP(fk)
+
+	hdroff = Memi[hdrp+group]
+
+	# Calculate the amount of space left  or grown in the heap
+	# as a result of the READ-WRITE operation on the data.
+
+	diff = datasize - (Memi[hdrp+group+1] - Memi[pixp+group])
+	
+	# See if the new data overwrites the next unit or
+	# there is a hole with more than 2880 bytes.
+
+	if ( (diff > 0) || ((-diff / 2880) > 0) ) {
+
+	    # Adjust the header and pixel offset for subsequent groups.
+	    # Add header size.
+	    datasize = datasize + Memi[pixp+group] - Memi[hdrp+group]
+	    call fxf_copy_adj (im, hdr_fd, hdroff, Memi[hdrp+group+1], datasize)
+
+	    if (diff > 0)
+		nb = FITS_LEN_CHAR (diff)
+	    else
+		nb = (diff / 1440) * 1440
+
+	    # Update FK cache offset values
+	    do i = group+1, FIT_NUMOFFS(fk) {
+	        Memi[hdrp+i] = Memi[hdrp+i] + nb
+		if (Memi[pixp+i] > 0) {
+		    Memi[pixp+i] = Memi[pixp+i] + nb
+		} else
+		    break
+	    }
+	}
+end
+
+
+# FXF_COPY_ADJ -- Make a copy of the input file extending or shrinking
+# the heap area.
+
+procedure fxf_copy_adj (im, in_fd, hdroff, poff, datasize)
+	
+pointer	im		#I Imio descriptor
+int	in_fd		#I Input file descriptor
+int	hdroff		#I Header offset
+int 	poff		#I Pixel offset
+int	datasize	#I New FITS unit size
+
+pointer sp, tempfile, outname
+int	nchars, junk, inoff, out_fd, size
+int	fnldir(), fnroot(), open(), note()
+errchk	open, note, seek, close, delete, rename
+errchk	fxf_make_adj_copy, fxf_write_blanks
+
+begin
+	call smark (sp)
+	call salloc (tempfile, SZ_FNAME, TY_CHAR)
+	call salloc (outname, SZ_FNAME, TY_CHAR)
+
+	nchars = fnldir (IM_HDRFILE(im), Memc[tempfile], SZ_FNAME)
+	junk = fnroot (IM_HDRFILE(im), Memc[tempfile+nchars], SZ_FNAME)
+	call mktemp (Memc[tempfile], Memc[outname], SZ_PATHNAME)
+	call strcat (".fits", Memc[outname], SZ_PATHNAME)
+
+	inoff = note (in_fd)
+	out_fd = open (Memc[outname], NEW_FILE, BINARY_FILE)
+
+	call fxf_make_adj_copy (in_fd, out_fd, hdroff, poff, datasize)
+
+	# Pad to 2880 bytes block
+	size =  note (out_fd) - 1
+	size = mod(size, FITS_BLOCK_CHARS)
+	if (size != 0) {
+	    size = FITS_BLOCK_CHARS - size
+	    call fxf_write_blanks (out_fd, size)
+	}
+
+	size = note (out_fd) - 1
+	call close (in_fd)
+	call delete (IM_HDRFILE(im))
+	call rename (Memc[outname], IM_HDRFILE(im))
+
+	in_fd = out_fd
+	call seek (in_fd, inoff)
+	call sfree (sp)
+end
+
+
+# FXF_PLPF -- Initialize IMIO dependencies when dealing with a PLIO
+# image mask.
+
+procedure fxf_plpf (im)
+
+pointer im				#I IMIO descriptor
+
+int	pfd
+pointer	sp, imname, ref_im
+int	sv_acmode, sv_update, ndim, i, depth
+errchk	iki_opix, open
+int	open()
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_IMNAME, TY_CHAR)
+
+	# Complete the initialization of a mask image.
+	ref_im = IM_PLREFIM(im)
+
+	sv_acmode = IM_ACMODE(im)
+	sv_update = IM_UPDATE(im)
+	call strcpy (IM_NAME(im), Memc[imname], SZ_IMNAME)
+
+	if (ref_im != NULL) {
+	    # Create a mask the same size as the physical size of the
+	    # reference image.  Inherit any image section from the
+	    # reference image.
+
+	    IM_NDIM(im) = IM_NDIM(ref_im)
+	    IM_NPHYSDIM(im) = IM_NPHYSDIM(ref_im)
+	    IM_SECTUSED(im) = IM_SECTUSED(ref_im)
+	    call amovl (IM_LEN(ref_im,1), IM_LEN(im,1), IM_MAXDIM)
+	    call amovl (IM_PHYSLEN(ref_im,1),IM_PHYSLEN(im,1),IM_MAXDIM)
+	    call amovl (IM_SVLEN(ref_im,1), IM_SVLEN(im,1), IM_MAXDIM)
+	    call amovl (IM_VMAP(ref_im,1), IM_VMAP(im,1), IM_MAXDIM)
+	    call amovl (IM_VOFF(ref_im,1), IM_VOFF(im,1), IM_MAXDIM)
+	    call amovl (IM_VSTEP(ref_im,1), IM_VSTEP(im,1), IM_MAXDIM)
+
+	    # Tell PMIO to use this image as the reference image.
+	    call pm_seti (IM_PL(im), P_REFIM, im)
+
+	} else if (sv_acmode == NEW_IMAGE || sv_acmode == NEW_COPY) {
+	    # If ndim was not explicitly set, compute it by counting
+	    # the number of nonzero dimensions.
+
+	    ndim = IM_NDIM(im)
+	    if (ndim == 0) {
+		ndim = 1
+		while (IM_LEN(im,ndim) > 0 && ndim <= IM_MAXDIM)
+		    ndim = ndim + 1
+		ndim = ndim - 1
+		IM_NDIM(im) = ndim
+	    }
+
+	    # Make sure dimension stuff makes sense.
+	    if (ndim < 0 || ndim > IM_MAXDIM)
+		call imerr (IM_NAME(im), SYS_IMNDIM)
+
+	    do i = 1, ndim
+		if (IM_LEN(im,i) <= 0)
+		    call imerr (IM_NAME(im), SYS_IMDIMLEN)
+
+	    # Set the unused higher dimensions to 1.  This makes it
+	    # possible to access the image as if it were higher
+	    # dimensional, and in a way it truely is.
+
+	    do i = ndim + 1, IM_MAXDIM
+		IM_LEN(im,i) = 1
+
+	    IM_NPHYSDIM(im) = ndim
+	    call amovl (IM_LEN(im,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+	    call amovl (IM_LEN(im,1), IM_SVLEN(im,1), IM_MAXDIM)
+	    if (sv_acmode == NEW_IMAGE)
+		call amovkl (long(1), IM_VSTEP(im,1), IM_MAXDIM)	
+
+	    depth = PL_MAXDEPTH
+	    if (and (IM_PLFLAGS(im), PL_BOOL) != 0)
+                 depth = 1
+	    call pl_ssize (IM_PL(im), IM_NDIM(im), IM_LEN(im,1), depth)
+
+	}
+
+	call strcpy (Memc[imname], IM_NAME(im), SZ_IMNAME)
+	IM_ACMODE(im) = sv_acmode
+	IM_UPDATE(im) = sv_update
+	IM_PIXOFF(im) = 1	
+	IM_HGMOFF(im) = NULL
+	IM_BLIST(im) = NULL
+	IM_HFD(im) = NULL
+
+	pfd = open ("dev$null", READ_WRITE, BINARY_FILE)
+	IM_PFD(im) = pfd
+
+	# Execute this even if pixel file has already been opened.
+	call imsetbuf (IM_PFD(im), im)
+
+	# "Fast i/o" in the conventional sense no IMIO buffering)
+	# is not permitted for mask images, since IMIO must buffer
+	# the pixels, which are generated at run time.
+
+	if (IM_FAST(im) == YES) {
+	    IM_PLFLAGS(im) = or (IM_PLFLAGS(im), PL_FAST)
+	    IM_FAST(im) = NO
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfrcard.x b/sys/imio/iki/fxf/fxfrcard.x
new file mode 100644
index 00000000..e025283e
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfrcard.x
@@ -0,0 +1,35 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <mii.h>
+include "fxf.h"
+
+# FXF_READ_CARD -- Read a FITS header card.
+
+int procedure fxf_read_card (fd, ibuf, obuf, ncards)
+
+int	fd			#I Input file descriptor
+char	ibuf[ARB]		#I input buffer
+char    obuf[ARB]		#O Output buffer
+int	ncards			#I ncards read so far
+
+int	ip, nchars_read
+int	read()
+errchk	read
+
+begin
+	# We read one FITS block first, read card from it until 36
+	# cards have been processed, where we read again.
+
+	if (mod (ncards, 36) == 0) {
+	    nchars_read = read (fd, ibuf, FITS_BLOCK_CHARS)
+	    if (nchars_read ==  EOF)
+	        return (EOF)
+	    call miiupk (ibuf, ibuf, FITS_BLOCK_BYTES, MII_BYTE, TY_CHAR)
+	    ip = 1
+	}
+	
+	call amovc (ibuf[ip], obuf, LEN_CARD)
+	ip = ip + LEN_CARD
+
+	return (LEN_CARD)
+end
diff --git a/sys/imio/iki/fxf/fxfrdhdr.x b/sys/imio/iki/fxf/fxfrdhdr.x
new file mode 100644
index 00000000..7cfc7855
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfrdhdr.x
@@ -0,0 +1,176 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"fxf.h"
+
+
+# FXF_RHEADER -- Read a FITS header into the image descriptor and the 
+# internal FITS descriptor.
+
+procedure fxf_rheader (im, group, acmode)
+
+pointer	im			#I image descriptor
+int	group			#I group number to read
+int	acmode			#I access mode
+
+long	pixoff,	mtime
+pointer	sp, fit, lbuf, poff
+int	compress, devblksz, i, impixtype
+bool    bfloat, lscale, lzero
+bool    fxf_fpl_equald()
+int	strncmp()
+
+errchk	fxf_rfitshdr, realloc, syserr, syserrs
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	fit = IM_KDES(im)
+
+	FIT_MAX(fit) = 0.0
+	FIT_MIN(fit) = 0.0
+	FIT_MTIME(fit) = 0.0
+	FIT_IM(fit) = im
+	FIT_OBJECT(fit) = EOS
+	IM_CLSIZE(im) = 0
+
+	# Read the header unit number 'group', setting the values of the 
+	# reserved fields in the FIT descriptor saving it in the FITS cache.
+
+	call fxf_rfitshdr (im, group, poff)
+
+	IM_MIN(im) = FIT_MIN(fit)
+	IM_MAX(im) = FIT_MAX(fit)
+	IM_MTIME(im) = FIT_MTIME(fit)
+	call strcpy (FIT_OBJECT(fit), IM_TITLE(im), LEN_CARD)
+
+	# If there is no group specification in the filename, group is -1;
+	# new group number is in FIT_GROUP.
+
+	group = FIT_GROUP(fit)
+	IM_CLINDEX(im) = group
+
+	# Process the reserved keywords (set in the FIT descriptor) into the
+	# corresponding fields of the IMIO descriptor.
+
+	if (acmode != NEW_COPY) {
+	    IM_NDIM(im) = FIT_NAXIS(fit)		# IM_NDIM
+	    do i = 1, IM_NDIM(im) {			# IM_LEN
+		IM_LEN(im,i) = FIT_LENAXIS(fit,i)
+		if (IM_LEN(im,i) == 0) {
+		    IM_NDIM(im) = 0
+		    break
+	        }
+	    }
+	}
+
+	lscale = fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 1)
+	lzero =  fxf_fpl_equald (0.0d0, FIT_BZERO(fit), 1)
+
+	# Determine if scaling is necessary.
+	bfloat = (!lscale || !lzero)
+
+	FIT_PIXTYPE(fit) = NULL
+	FIT_ZCNV(fit) = NO
+
+	switch (FIT_BITPIX(fit)) {
+	case  8:
+	    FIT_PIXTYPE(fit) = TY_UBYTE
+	    if (bfloat)
+		impixtype = TY_REAL
+	    else
+		impixtype = TY_SHORT              # convert from byte to short
+	    FIT_ZCNV(fit) = YES
+	case 16:
+	    FIT_PIXTYPE(fit) = TY_SHORT
+	    if (bfloat) {
+		impixtype = TY_REAL
+	        FIT_ZCNV(fit) = YES
+	    } else
+		impixtype = TY_SHORT
+
+	    if ((strncmp ("USHORT", FIT_DATATYPE(fit), 6) == 0) ||
+		    (lscale && fxf_fpl_equald (32768.0d0, FIT_BZERO(fit),4))) {
+		impixtype = TY_USHORT
+	        FIT_ZCNV(fit) = NO
+	    }
+	case 32:
+	    FIT_PIXTYPE(fit) = TY_INT
+	    if (bfloat)
+		impixtype = TY_REAL
+	    else
+		impixtype = TY_INT
+	case -32:
+	    FIT_PIXTYPE(fit) = TY_REAL
+	    impixtype = TY_REAL
+	case -64:
+	    FIT_PIXTYPE(fit) = TY_DOUBLE
+	    impixtype = TY_DOUBLE
+	default:
+	    impixtype = ERR
+	}
+
+	IM_PIXTYPE(im) = impixtype
+
+	IM_NBPIX(im)   = 0			# no. bad pixels
+	mtime = IM_MTIME(im)
+		
+	if (IM_MAX(im) > IM_MIN(im))
+	   IM_LIMTIME(im) = mtime + 1		# time max/min last updated
+	else
+	   IM_LIMTIME(im) = mtime - 1		# Invalidate DATA(MIN,MAX)
+	IM_HISTORY(im) = EOS
+
+	# Call up IMIO to set up the remaining image header fields used to
+	# define the physical offsets of the pixels in the pixfile.
+
+	compress = YES		# do not align image lines on blocks
+	devblksz = 1		# disable all alignment
+
+	pixoff = Memi[poff+group]
+	FIT_PIXOFF(fit) = pixoff
+	call imioff (im, pixoff, compress, devblksz)
+	
+	call sfree (sp)
+end
+
+
+# FXF_FPL_EQUALD -- Compare 2 double precision quantities up to a precision
+# given by a tolerance.
+
+bool procedure fxf_fpl_equald (x, y, it)
+
+double	x, y		#I Input quantities to be compare for equality
+int	it		#I Tolerance factor of 10 to compare the values
+
+int	ex, ey
+double	x1, x2, normx, normy, tol
+
+begin
+	# Check for the obvious first.
+	if (x == y)
+	    return (true)
+
+	# We can't normalize zero, so handle the zero operand cases first.
+	# Note that the case 0 equals 0 is handled above.
+
+	if (x == 0.0D0 || y == 0.0D0)
+	    return (false)
+
+	# Normalize operands and do an epsilon compare.
+	call fp_normd (x, normx, ex)
+	call fp_normd (y, normy, ey)
+
+	if (ex != ey)
+	    return (false)
+	else {
+	    tol = EPSILOND * 10.0D0 * it
+	    x1 = 1.0D0 + abs (normx - normy)
+	    x2 = 1.0D0 + tol
+	    return (x1 <= x2)
+	}
+end
diff --git a/sys/imio/iki/fxf/fxfrename.x b/sys/imio/iki/fxf/fxfrename.x
new file mode 100644
index 00000000..677c02dd
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfrename.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<error.h>
+include "fxf.h"
+
+
+# FIT_RENAME -- Rename a fits file. NOTE: There is no prevision at this
+# time to rename an extension.
+
+procedure fxf_rename (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		#I old image root name
+char	oextn[ARB]		#I old image extn
+char	nroot[ARB]		#I new image root name
+char	nextn[ARB]		#I old image extn
+int	status			#O status value
+
+pointer	sp
+int	cindx
+pointer	ohdr_fname, nhdr_fname
+bool	streq()
+
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+
+	call fxf_init()
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	if (!streq (Memc[ohdr_fname], Memc[nhdr_fname])) {
+	    iferr (call rename (Memc[ohdr_fname], Memc[nhdr_fname]))
+		call erract (EA_WARN)
+	 
+	    # Update the cache with the new name.
+	    do cindx=1, rf_cachesize {
+	        if (rf_fit[cindx] == NULL)
+		    next
+	        # Rename the cached entry.
+	        if (streq (Memc[ohdr_fname], rf_fname[1,cindx]))
+		    call strcpy (Memc[nhdr_fname], rf_fname[1,cindx], SZ_FNAME)
+	    }
+	}
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfrfits.x b/sys/imio/iki/fxf/fxfrfits.x
new file mode 100644
index 00000000..30a8d5f7
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfrfits.x
@@ -0,0 +1,1322 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <syserr.h>
+include <time.h>
+include <ctype.h>
+include <imhdr.h>
+include <imio.h>
+include <finfo.h>
+include <fset.h>
+include <mach.h>
+include <imset.h>
+include <error.h>
+include "fxf.h"
+
+# FXFRFITS.X -- Routines to load FITS header in memory and set up the cache
+# mechanism.
+
+define	LEN_UACARD_100	 8100
+define	LEN_UACARD_5	 405
+
+
+# FXF_RFITSHDR -- Procedure to read one or more FITS header while caching
+# the primary header, set the FITS memory structure for each
+# filename, the header and pixel offset from the beginning
+# and the EXTNAME and EXTVER value for each extension.
+
+procedure fxf_rfitshdr (im, group, poff)
+
+pointer im		#I image descriptor
+int	group		#I Group number to read
+int	poff		#O char offset the the pixel area in the FITS image
+
+long	fi[LEN_FINFO]
+pointer hoff,totpix, extn, extv
+pointer sp, fit, o_fit, lbuf, hdrfile, hdr
+int	cindx, cfit, user, fitslen, offs_count
+int	in, spool, slot, i, nrec1440, acmode
+
+bool	initialized, reload, extname_or_ver, ext_append
+data	initialized /false/
+int	rf_refcount
+
+bool	streq()
+long	cputime(), fstatl()
+
+int	finfo(), open(), stropen(), getline()
+
+errchk	putline, syserrs, seek, calloc, realloc, syserr
+errchk	fpathname, calloc, fxf_load_header, fxf_skip_xtn, fxf_read_xtn
+
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	# Initialize the header file cache on the first call.  The kernel
+	# doesn't appear to work with the cache completely deactivated, so
+	# the minimum cachesize is 1.
+
+	if (!initialized) {
+	    rf_refcount = 0
+	    do i = 1, MAX_CACHE
+		rf_fit[i] = 0
+	    rf_cachesize = max(1, min(MAX_CACHE, FKS_CACHESIZE(IM_KDES(im))))
+	    initialized = true
+	} else
+	    rf_refcount = rf_refcount + 1
+
+	o_fit = IM_KDES(im)
+	reload = false
+	slot = 1
+	# Get file system info on the desired header file.
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+
+	if (finfo (Memc[hdrfile], fi) == ERR) 
+	    call syserrs (SYS_FOPEN, IM_HDRFILE(im))
+
+        acmode = FIT_ACMODE(o_fit)
+	ext_append = (acmode == NEW_IMAGE || acmode == NEW_COPY)
+	repeat {
+	    # Search the header file cache for the named image.
+	    do cindx = 1, rf_cachesize {
+		if (rf_fit[cindx] == NULL) {
+		   slot = cindx
+		   next
+		}
+		if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+		    # File is in cache; is cached entry still valid?
+		    # If we are appending extension, do not reload from
+		    # disk.
+
+		    if (FI_MTIME(fi) != rf_mtime[cindx] && !ext_append) {
+			# File modify date has changed, reuse slot.
+			slot = cindx
+			break
+		    } 
+		    
+		    # For every non-empty file the fxf_open() call
+		    # pre reads every PHU, so that when the fxf_rdhdr()
+		    # comes, the cache entry is already here.
+
+		    # Return the cached header.
+		    rf_lru[cindx] = rf_refcount
+		    cfit = rf_fit[cindx]
+		    FIT_XTENSION(cfit) = FIT_XTENSION(o_fit)
+		    FIT_ACMODE(cfit) = FIT_ACMODE(o_fit)
+		    FIT_EXPAND(cfit) = FIT_EXPAND(o_fit)
+
+		    # Load Extend value from cache header entry to
+		    # the current fit struct entry.
+
+		    FIT_EXTEND(o_fit) = FIT_EXTEND(cfit)
+
+		    call amovi (FIT_ACMODE(cfit), FIT_ACMODE(o_fit),
+			LEN_FITBASE)
+		    hoff = rf_hdrp[cindx]
+		    poff = rf_pixp[cindx]
+		    extn = rf_pextn[cindx]
+		    extv = rf_pextv[cindx]
+		    FIT_GROUP(o_fit) = group
+		    FIT_HDRPTR(o_fit) = hoff
+		    FIT_PIXPTR(o_fit) = poff
+
+		    extname_or_ver = (FKS_EXTNAME(o_fit) != EOS ||
+			!IS_INDEFL (FKS_EXTVER(o_fit)))
+
+		    # If the group number or extname_or_ver has not been
+		    # specified we need to load the group number where there
+		    # is data i.e., FIT_NAXIS != 0. The 'cfit' structure would
+		    # have this group number.
+
+		    if (group == -1 && !extname_or_ver) {
+			if (FIT_GROUP(cfit) != -1) {
+			    group = FIT_GROUP(cfit)
+			    FIT_GROUP(o_fit) = group
+
+			} else if (FIT_NAXIS(cfit) != 0) {
+			    # See if the main FITS unit has data when
+			    # group = -1 is specified.
+
+			    group = 0
+			    FIT_GROUP(cfit) = 0
+			    FIT_GROUP(o_fit) = 0
+			}	
+		    }
+
+		    # The main header has already been read at this point,
+		    # now merge with UA.
+
+		    if (group == 0) {
+			hdr = rf_hdr[cindx]
+			fitslen = rf_fitslen[cindx]
+			FIT_EXTEND(o_fit) = FIT_EXTEND(cfit)
+			call fxf_merge_w_ua (im, hdr, fitslen)
+
+		    } else {
+			# Read intermediate xtension headers if not in
+			# hoff and poff yet.
+			offs_count = FIT_NUMOFFS(cfit)
+			call fxf_read_xtn (im,
+			    cfit, group, hoff, poff, extn, extv)
+		    } 
+
+		    # IM_CTIME takes the value of the DATE keyword
+		    if (IM_CTIME(im)==0) {
+			IM_CTIME(im) = FI_CTIME(fi)
+		    }
+
+		    # FIT_MTIME takes the value of keyword IRAF-TLM.
+		    # If not present use the mtime from the finfo value.
+
+		    if (FIT_MTIME(cfit) == 0) {
+			FIT_MTIME(cfit) = FI_MTIME(fi)
+		    }
+
+		    # Invalidate entry if cache is disabled.
+		    if (rf_cachesize <= 0)
+			rf_time[cindx] = 0
+
+		    call sfree (sp)
+		    return				# IN CACHE
+
+		} else {
+		    # Keep track of least recently used slot.
+		    if (rf_lru[cindx] < rf_lru[slot])
+			slot = cindx
+		}
+	    }
+
+	    # Either the image header is not in the cache, or the cached
+	    # entry is invalid.	 Prepare the given cache slot and read the
+	    # header into it.
+
+	    # Free old save buffer and descriptor.
+	    if (rf_fit[slot] != NULL) {
+		call mfree (rf_pextv[slot], TY_INT)
+		call mfree (rf_pextn[slot], TY_CHAR)
+		call mfree (rf_pixp[slot], TY_INT)
+		call mfree (rf_hdrp[slot], TY_INT)
+		call mfree (rf_fit[slot], TY_STRUCT)
+		call mfree (rf_hdr[slot], TY_CHAR)
+		rf_fit[slot] = NULL
+		rf_lru[slot] = 0
+		rf_fname[1,slot] = EOS
+	    }
+
+	    # Allocate a spool file for the FITS data.
+	    spool = open ("spool", NEW_FILE, SPOOL_FILE)
+
+	    # Allocate cache version of FITS descriptor.
+	    call calloc (fit, LEN_FITBASE, TY_STRUCT)
+	    call calloc (hoff, MAX_OFFSETS, TY_INT) 
+	    call calloc (poff, MAX_OFFSETS, TY_INT) 
+	    call calloc (extn, MAX_OFFSETS*LEN_CARD, TY_CHAR) 
+	    call calloc (extv, MAX_OFFSETS, TY_INT) 
+
+	    # Initialize the entries.
+	    call amovki (INDEFL, Memi[extv], MAX_OFFSETS)
+	    call aclrc (Memc[extn], MAX_OFFSETS)
+	    call amovki (-1, Memi[poff], MAX_OFFSETS)
+
+	    FIT_GROUP(fit) = -1
+	    FIT_HDRPTR(fit) = hoff
+	    FIT_PIXPTR(fit) = poff
+	    FIT_NUMOFFS(fit) = MAX_OFFSETS
+	    FIT_ACMODE(fit) = FIT_ACMODE(o_fit)
+	    FIT_BSCALE(fit) = 1.0d0
+	    FIT_BZERO(fit) = 0.0d0
+	    FIT_XTENSION(fit) = NO
+	    FIT_EXTNAME(fit) = EOS
+	    FIT_EXTVER(fit) = INDEFL
+	    FIT_EXTEND(fit) = -3
+
+	    # Initialize the cache entry.
+	    call strcpy (Memc[hdrfile], rf_fname[1,slot], SZ_PATHNAME)
+	    rf_fit[slot] = fit
+	    rf_hdrp[slot] = hoff
+	    rf_pixp[slot] = poff
+	    rf_pextn[slot] = extn
+	    rf_pextv[slot] = extv
+	    rf_lru[slot] = rf_refcount
+	    rf_mtime[slot] = FI_MTIME(fi)
+
+	    if (!reload)
+		rf_time[slot] = cputime (0)
+
+	    reload = true
+
+	    in = IM_HFD(im)
+	    call seek (in, BOFL)
+	    
+	    # Read main FITS header and copy to spool fd.
+	    FIT_IM(fit) = im
+	    call amovki (1, FIT_LENAXIS(fit,1), IM_MAXDIM)
+
+	    call fxf_load_header (in, fit, spool, nrec1440, totpix)
+
+
+	    # Record group 0 (PHU) as having just been read.
+	    FIT_GROUP(fit) = 0
+
+	    call seek (spool, BOFL)
+	    fitslen = fstatl (spool, F_FILESIZE)
+
+	    # Prepare cache area to store the FITS header.
+	    call calloc (hdr, fitslen, TY_CHAR)
+	    user = stropen (Memc[hdr], fitslen, NEW_FILE)
+	    rf_hdr[slot] = hdr
+	    rf_fitslen[slot] = fitslen
+	    FIT_CACHEHDR(fit) = hdr
+	    FIT_CACHEHLEN(fit) = fitslen
+
+	    # Append the saved FITS cards to saved cache.
+	    while (getline (spool, Memc[lbuf]) != EOF) 
+		call putline (user, Memc[lbuf])
+
+	    call close (user)
+	    call close (spool)
+	    
+	    # Group 0 (i.e. Main Fits unit)
+	    Memi[hoff] = 1	       # beginning of primary h.u.
+	    Memi[poff] = nrec1440 + 1  # first pixel data of main u.
+
+	    # Set group 1 offsets.
+	    Memi[hoff+1] = Memi[poff] + totpix
+	    Memi[poff+1] = -1
+	}
+
+        call sfree (sp)
+end
+
+
+# FXF_READ_XTN -- Procedure to read a FITS extension header and at the same
+# time make sure that the EXTNAME and EXTVER values are not repeated 
+# with those in the cache.
+
+procedure fxf_read_xtn (im, cfit, igroup, hoff, poff, extn, extv)
+
+pointer im			#I Image descriptor
+pointer cfit			#I Cached FITS descriptor
+int	igroup			#I Group number to process
+pointer hoff			#I Pointer to header offsets array
+pointer poff			#I Pointer to pixel offsets array
+pointer extn			#I Pointer to extname's array
+pointer extv			#I Pointer to extver's array
+
+char	messg[SZ_LINE]
+pointer lfit, sp, po, ln
+int	spool, ig, acmode, i
+int	fitslen, xtn_hd, nrec1440, totpix, in, group
+int	strcmp(), getline()
+long	offset, fstatl()
+int	open(), fxf_extnv_error()
+bool	ext_append, get_group
+
+errchk	fxf_load_header, fxf_skip_xtn, syserr, syserrs
+define	rxtn_ 91
+
+begin
+	# Allocate a spool file for the FITS header.
+	spool = open ("FITSHDRX", READ_WRITE, SPOOL_FILE)
+
+	lfit = IM_KDES(im)
+	group = FIT_GROUP(lfit)
+	acmode = FIT_ACMODE(lfit)
+	ext_append = (acmode == NEW_IMAGE || acmode == NEW_COPY)
+
+	# If we have 'overwrite' in the ksection then look for the
+	# existent extname/extver we want to overwrite since we don't
+	# want to append.
+
+	if (FKS_OVERWRITE(lfit) == YES)
+	    ext_append = false
+
+	# See if we want to look at an extension given the EXT(NAME,VER)
+	# field in the ksection.
+
+	if (FKS_EXTNAME(lfit) != EOS || !IS_INDEFL (FKS_EXTVER(lfit))) {
+	    ig = 1
+	    repeat {
+		call fseti (spool, F_CANCEL, YES)
+		xtn_hd = NO
+
+		# Has last extension header been read?
+		if (Memi[poff+ig] <= 0) { 
+		    iferr {
+			call fxf_skip_xtn (im,
+			    ig, cfit, hoff, poff, extn, extv, spool)
+			xtn_hd = YES
+		    } then {
+			if (ext_append) {
+			    # We have reach the end of extensions.
+			    FIT_GROUP(lfit) = -1    # message for fxf_updhdr
+			    return
+			} else {
+			    call fxf_form_messg (lfit, messg)
+			    call syserrs (SYS_FXFRFNEXTNV, messg)
+			}
+		    } else {	
+			# If we want to append an extension then.
+			if (ext_append && FKS_DUPNAME(lfit) == NO)
+			    if (fxf_extnv_error (lfit, ig, extn, extv) == YES) {
+				call fxf_form_messg (lfit, messg)
+				call syserrs (SYS_FXFOPEXTNV, messg)
+			    } 
+		    }
+		}
+
+		if (fxf_extnv_error (lfit, ig, extn, extv) == YES) {
+		    # We have matched either or both FKS_EXTNAME and FKS_EXTVER
+		    # with the values in the cache.
+
+		    if (ext_append && FKS_DUPNAME(lfit) == NO)	{
+			call fxf_form_messg (lfit, messg)
+			call syserrs (SYS_FXFOPEXTNV, messg)
+		    } 
+		    group = ig
+		    FIT_GROUP(lfit) = ig
+		    goto rxtn_
+
+		} else {
+		    ig = ig + 1
+		    next
+		}
+	    }
+
+	} else {
+	    # No extname or extver specified.
+	    # Read through the Extensions until group number is reached;
+	    # if no number is supplied, read until EOF to load header and
+	    # pixel offsets necessary to append and extension.
+	    
+	    if (igroup == -1 && FIT_GROUP(cfit) == -1)
+		group = MAX_INT
+
+	    # We are trying to get the first group that meets these condition.
+	    get_group = (FIT_GROUP(cfit) == -1 && igroup == -1) 
+
+	    do ig = 0, group  {
+		xtn_hd = NO
+
+		# Has last extension header been read?
+		if (Memi[poff+ig] <= 0 ) {
+		    call fseti (spool, F_CANCEL, YES)
+		    iferr {
+			call fxf_skip_xtn (im,
+			    ig, cfit, hoff, poff, extn, extv, spool)
+			xtn_hd = YES
+		    } then {
+			if (ext_append) {
+			    # We have reach the end of extensions.
+			    FIT_GROUP(lfit) = -1    # message for fxf_updhdr
+			    return
+			} else {
+			    call syserrs (SYS_FXFRFEOF, IM_NAME(im))
+			    return
+			}
+		    }
+
+		    # Mark the first group that contains an image
+		    # i.e. naxis != 0. 
+
+		    if (FIT_NAXIS(lfit) != 0 && 
+			    strcmp ("IMAGE", FIT_EXTTYPE(lfit)) == 0) {
+			if (get_group) {
+			    FIT_GROUP(cfit) = ig   # save on cache fits struct
+			    FIT_GROUP(lfit) = ig   # also on current
+			    break
+			} else if (FIT_GROUP(cfit) <= 0)
+			    FIT_GROUP(cfit) = ig 
+		    }
+	       }
+	    }
+	}
+rxtn_
+	if (xtn_hd == NO) {
+	    in = IM_HFD(im)
+	    offset = Memi[hoff+group]
+	    call seek (in, offset)
+	    FIT_IM(lfit) = im
+	    call fseti (spool, F_CANCEL, YES)
+	    call fxf_load_header (in, lfit, spool, nrec1440, totpix)
+	}
+
+	# If requested a non supported BINTABLE format, post an error
+	# message and return to the caller.
+
+	if (strcmp(FIT_EXTTYPE(lfit), "BINTABLE") == 0) {
+	    if (strcmp(FIT_EXTSTYPE(lfit), "PLIO_1") != 0) {
+	        call close (spool)
+		call syserrs (SYS_IKIEXTN, IM_NAME(im))
+            }
+	}
+	
+	# Merge Image Extension header to the user area.
+	fitslen = fstatl (spool, F_FILESIZE)
+
+	# Copy the spool array into a static array. We cannot reliable
+	# get the pointer from the spool file.
+	call smark (sp)
+	call salloc (ln, LEN_UACARD, TY_CHAR)
+
+	if (po != NULL)
+	    call mfree(po, TY_CHAR)
+	call calloc (po, fitslen+1, TY_CHAR)
+
+	i = po
+	call seek (spool, BOFL)
+	while (getline (spool, Memc[ln]) != EOF) {
+
+	    call amovc (Memc[ln], Memc[i], LEN_UACARD)
+	    i = i + LEN_UACARD
+	}
+	Memc[i] = EOS
+
+	# Make the user aware that they cannot use inheritance
+	# if the PDU contains a data array.
+
+	if (Memi[poff] != Memi[hoff+1]) {
+	    if (FKS_INHERIT(lfit) == YES) {
+		call syserr (SYS_FXFBADINH)
+	    }
+	} else {
+	    # Disable inheritance if PHDU has a DU.
+	    if (Memi[poff+0] != Memi[hoff+1])
+		FIT_INHERIT(lfit) = NO
+	}
+
+	# Reset the value of FIT_INHERIT if FKS_INHERIT is set
+	if (FKS_INHERIT(lfit) != NO_KEYW)
+	    FIT_INHERIT(lfit) = FKS_INHERIT(lfit)
+
+	if (FIT_TFIELDS(lfit) > 0) {
+	    fitslen = fitslen + FIT_TFIELDS(lfit)*LEN_UACARD
+	    call realloc (po, fitslen, TY_CHAR)
+        }
+
+	call fxf_merge_w_ua (im, po, fitslen)
+
+	call mfree (po, TY_CHAR)
+
+	call sfree (sp)
+	call close (spool)
+end
+
+
+# FXF_EXTNV_ERROR -- Integer boolean function (YES,NO) to find out if the
+# value of kernel section parameter FKS_EXTNAME and FKS_EXTVER are not
+# repeated in the cache pointed by extn and extv.
+
+int procedure fxf_extnv_error (fit, ig, extn, extv)
+
+pointer fit			#I fit descriptor
+int	ig			#I extension number
+pointer extn, extv		#I pointers to arrays for extname and extver 
+
+bool	bxtn, bxtv, bval, bxtn_eq, bxtv_eq
+int	fxf_strcmp_lwr()
+
+begin
+	bxtn = (FKS_EXTNAME(fit) != EOS)
+	bxtv = (!IS_INDEFL (FKS_EXTVER(fit)))
+
+	if (bxtn)
+	    bxtn_eq =
+		(fxf_strcmp_lwr(FKS_EXTNAME(fit), Memc[extn+LEN_CARD*ig]) == 0)
+	if (bxtv)
+	    bxtv_eq = (FKS_EXTVER(fit) == Memi[extv+ig])
+	
+	if (bxtn && bxtv) {
+	    # Since both FKS_EXTNAME and FKS_EXTVER are defined, see if they
+	    # repeated in the cache.
+
+	    bval = (bxtn_eq && bxtv_eq)
+
+	} else if (bxtn && !bxtv) {
+	    # We have a duplicated in this case when extver in the image
+	    # header is INDEFL.
+
+	    bval = bxtn_eq
+
+	} else if (!bxtn && bxtv) {
+	    # If the FKS_EXTNAME is not defined (i.e. EOS) and the FKS_EXTVER
+	    # value is the same as the cached, then we have a match.
+
+	    bval = bxtv_eq 
+
+	} else
+	    bval = false
+	
+	if (bval)
+	    return (YES)
+	else
+	    return (NO)
+end
+
+
+# FXF_SKIP_XTN -- Skip over a FITS extension.  The procedure will read the
+# current extension header and calculates the respectives offset for later
+# usage.
+
+procedure fxf_skip_xtn (im, group, cfit, hoff, poff, extn, extv, spool)
+
+pointer im			#I image descriptor
+int	group			#I groupheader number to read
+pointer cfit			#I cached fits descriptor
+pointer hoff			#I extension header offset
+pointer poff			#I extension data offset
+pointer extn			#I points to the array of extname
+pointer extv			#I points to the arrays of extver
+
+pointer sp, lfit, fit, hdrfile
+bool    streq()
+int	spool, in, nrec1440, totpix, i, k, cindx
+long	offset
+errchk	fxf_load_header
+int	strcmp()
+
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (lfit, LEN_FITBASE, TY_STRUCT)
+        call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	call seek (spool, BOFL)
+	fit = IM_KDES(im)
+
+	# Allocate more memory for offsets in case we are pass MAX_OFFSETS.
+	if (group >= FIT_NUMOFFS(cfit)) {
+	    FIT_NUMOFFS(cfit) = FIT_NUMOFFS(cfit) + MAX_OFFSETS 
+	    call realloc (hoff, FIT_NUMOFFS(cfit), TY_INT)
+	    call realloc (poff, FIT_NUMOFFS(cfit), TY_INT)
+	    call realloc (extn, FIT_NUMOFFS(cfit)*LEN_CARD, TY_CHAR)
+	    call realloc (extv, FIT_NUMOFFS(cfit), TY_INT)
+
+	    offset = FIT_NUMOFFS(cfit) - MAX_OFFSETS
+	    call amovki (INDEFL, Memi[extv+offset], MAX_OFFSETS)
+	    call amovki (-1, Memi[poff+offset], MAX_OFFSETS)
+
+	    do i = 0,  MAX_OFFSETS-1  {
+		k = (offset+i)*LEN_CARD
+		Memc[extn+k] = EOS
+	    }
+	 
+	    # Update the fits structure with the new pointer values
+	    call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	    fit = IM_KDES(im)
+	    do cindx = 1, rf_cachesize {
+	        if (rf_fit[cindx] == NULL)
+	            next
+	        if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+	            rf_pextn[cindx] = extn
+		    rf_pextv[cindx] = extv
+		    rf_hdrp[cindx] = hoff
+		    rf_pixp[cindx] = poff
+		    FIT_HDRPTR(fit) = hoff
+		    FIT_PIXPTR(fit) = poff
+	        }
+	    }
+	}
+		
+	in = IM_HFD(im)
+	offset = Memi[hoff+group]
+
+	call seek (in, offset)
+	lfit = IM_KDES(im)
+	FIT_IM(lfit) = im
+	call fxf_load_header (in, lfit, spool, nrec1440, totpix)
+
+	# Record the first group that has NAXIS !=0 and is an IMAGE.
+	if (FIT_GROUP(cfit) == -1) {
+	    if (FIT_NAXIS(lfit) != 0 &&
+		    strcmp ("IMAGE", FIT_EXTTYPE(lfit)) == 0)
+		FIT_GROUP(cfit) = group
+	}
+
+	Memi[poff+group] = Memi[hoff+group] + nrec1440
+	# The offset for the beginning of next group.
+	Memi[hoff+group+1] = Memi[poff+group] + totpix
+
+	# Mark next group pixel offset in case we are at EOF.
+	Memi[poff+group+1] = -1
+	call strcpy (FIT_EXTNAME(lfit), Memc[extn+LEN_CARD*group], LEN_CARD) 
+	Memi[extv+group] = FIT_EXTVER(lfit)
+
+	call sfree (sp)
+end
+
+
+# FXF_LOAD_HEADER -- Load a FITS header from a file descriptor into a
+# spool file.
+
+procedure fxf_load_header (in, fit, spool, nrec1440, datalen)
+
+int	in			#I input FITS header file descriptor
+pointer fit			#I FITS descriptor
+int	spool			#I spool output file descriptor
+int	nrec1440		#O number of 1440 char records output
+int	datalen			#O length of data area in chars
+
+int	ncols
+pointer lbuf, sp, im, stime, fb, ttp
+int	totpix, nchars, nbytes, index, ncards, simple, i, pcount, junk
+int	fxf_read_card(), fxf_ctype(), ctoi(), strsearch()
+bool	fxf_fpl_equald()
+errchk	syserr, syserrs
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (stime, LEN_CARD, TY_CHAR)
+	call salloc (fb, FITS_BLOCK_BYTES, TY_CHAR)
+
+	FIT_BSCALE(fit) = 1.0d0
+	FIT_BZERO(fit) = 0.0d0
+	FIT_EXTNAME(fit) = EOS
+	FIT_EXTVER(fit) = INDEFL
+	im = FIT_IM(fit)
+
+	# Read successive lines of the FITS header. 
+	nrec1440 = 0
+	pcount = 0
+	ncards = 0
+
+	repeat {
+	    # Get the next input line.
+	    nchars = fxf_read_card (in, Memc[fb], Memc[lbuf], ncards)
+	    if (nchars == EOF) {
+		call close (spool)
+		call syserrs (SYS_FXFRFEOF, IM_NAME(im))
+            }
+	    ncards = ncards + 1
+
+	    # A FITS header card already has 80 chars, just add the newline.
+	    Memc[lbuf+LEN_CARD] = '\n'
+	    Memc[lbuf+LEN_CARD+1] = EOS
+
+	    # Process the header card.
+	    switch (fxf_ctype (Memc[lbuf], index)) {
+	    case KW_END:
+		nrec1440 = FITS_LEN_CHAR(ncards*40)
+		break
+	    case KW_SIMPLE:
+		call strcpy ("SIMPLE", FIT_EXTTYPE(fit), SZ_EXTTYPE)
+		call fxf_getb (Memc[lbuf], simple)
+		FIT_EXTEND(fit) = NO_KEYW
+		if (simple == NO)
+		    call syserr (SYS_FXFRFSIMPLE)
+	    case KW_EXTEND:
+		call putline (spool, Memc[lbuf])
+		call fxf_getb (Memc[lbuf], FIT_EXTEND(fit)) 
+	    case KW_XTENSION:
+		FIT_XTENSION(fit) = YES 
+		call fxf_gstr (Memc[lbuf], FIT_EXTTYPE(fit), SZ_EXTTYPE)
+	    case KW_EXTNAME:
+		call fxf_gstr (Memc[lbuf], FIT_EXTNAME(fit), LEN_CARD)
+		call putline (spool, Memc[lbuf])
+	    case KW_EXTVER:
+		call fxf_geti (Memc[lbuf], FIT_EXTVER(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_ZCMPTYPE:
+		call fxf_gstr (Memc[lbuf], FIT_EXTSTYPE(fit), SZ_EXTTYPE)
+	    case KW_PCOUNT:
+		call fxf_geti (Memc[lbuf], pcount)
+		call putline (spool, Memc[lbuf])
+		FIT_PCOUNT(fit) = pcount
+	    case KW_INHERIT:
+		call fxf_getb (Memc[lbuf], FIT_INHERIT(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_BITPIX:
+		call fxf_geti (Memc[lbuf], FIT_BITPIX(fit))
+	    case KW_DATATYPE:
+		call fxf_gstr (Memc[lbuf], FIT_DATATYPE(fit), SZ_DATATYPE)
+	    case KW_NAXIS:
+		if (index == 0) {
+		    call fxf_geti (Memc[lbuf], FIT_NAXIS(fit))
+		    if (FIT_NAXIS(fit) < 0 )
+			call syserr (SYS_FXFRFBNAXIS)
+	  	} else
+		    call fxf_geti (Memc[lbuf], FIT_LENAXIS(fit,index))
+	    case KW_BSCALE:
+		call fxf_getd (Memc[lbuf], FIT_BSCALE(fit))
+		# If BSCALE is like 1.00000011 reset to 1.0.
+		if (fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 4))
+		    FIT_BSCALE(fit) = 1.0d0
+		call putline (spool, Memc[lbuf])
+	    case KW_BZERO:
+		call fxf_getd (Memc[lbuf], FIT_BZERO(fit))
+		# If BZERO is like 0.00000011 reset to 0.0.
+		if (fxf_fpl_equald (0.0d0, FIT_BZERO(fit), 4))
+		    FIT_BZERO(fit) = 0.0d0
+		call putline (spool, Memc[lbuf])
+	    case KW_DATAMAX:
+		call fxf_getr (Memc[lbuf], FIT_MAX(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_DATAMIN:
+		call fxf_getr (Memc[lbuf], FIT_MIN(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_TFIELDS:
+		# Allocate space for TFORM and TTYPE keyword values
+		call fxf_geti (Memc[lbuf], ncols)
+		FIT_TFIELDS(fit) = ncols
+		if (FIT_TFORMP(fit) != NULL) {
+		    call mfree (FIT_TFORMP(fit), TY_CHAR)
+		    call mfree (FIT_TTYPEP(fit), TY_CHAR)
+	        }
+		call calloc (FIT_TFORMP(fit), ncols*LEN_FORMAT, TY_CHAR)
+		call calloc (FIT_TTYPEP(fit), ncols*LEN_OBJECT, TY_CHAR)
+	    case KW_TFORM:
+		call fxf_gstr (Memc[lbuf], Memc[stime], LEN_CARD)
+		if (index == 1) {
+		    # PLMAXLEN is used to indicate the maximum line list
+		    # length for PLIO masks in bintables.  The syntax
+		    # "PI(maxlen)" is used in bintables to pass the max
+		    # vararray length for a column.
+
+		    i = strsearch (Memc[stime], "PI(") 
+		    if (i > 0)
+			junk = ctoi (Memc[stime], i, FIT_PLMAXLEN(fit))
+		}
+	    case KW_TTYPE:
+		ttp = FIT_TTYPEP(fit) + (index-1)*LEN_OBJECT
+		call fxf_gstr (Memc[lbuf], Memc[ttp], LEN_CARD)
+	    case KW_OBJECT:
+		# Since only OBJECT can go into the header and IM_TITLE has its
+		# values as well, we need to save both to see which one has
+		# changed at closing time.
+
+		call fxf_gstr (Memc[lbuf], FIT_OBJECT(fit), LEN_CARD)
+		if (FIT_OBJECT(fit) == EOS)
+		    call strcpy ("        ", FIT_OBJECT(fit), SZ_KEYWORD)
+		call strcpy (FIT_OBJECT(fit), FIT_TITLE(fit), LEN_CARD)
+		call strcpy (FIT_OBJECT(fit), IM_TITLE(im), LEN_CARD)
+		call putline (spool, Memc[lbuf])
+	    case KW_IRAFTLM:
+		call fxf_gstr (Memc[lbuf], Memc[stime], LEN_CARD)
+		call fxf_date2limtime (Memc[stime], FIT_MTIME(fit))
+		call putline (spool, Memc[lbuf])
+	    case KW_DATE:
+		call fxf_gstr (Memc[lbuf], Memc[stime], LEN_CARD)
+		call fxf_date2limtime (Memc[stime], IM_CTIME(im))
+		call putline (spool, Memc[lbuf])
+	    default:
+		call putline (spool, Memc[lbuf])
+	    }
+	}
+
+	# Calculate the length of the data area of the current extension,
+	# measured in SPP chars and rounded up to an integral number of FITS
+	# logical blocks.
+
+	if (FIT_NAXIS(fit) != 0) {
+	    totpix =  FIT_LENAXIS(fit,1)
+	    do i = 2, FIT_NAXIS(fit)
+		totpix = totpix * FIT_LENAXIS(fit,i)
+
+	    # Compute the size of the data area (pixel matrix plus PCOUNT)
+	    # in bytes.  Be careful not to overflow a 32 bit integer.
+
+	    nbytes = (totpix + pcount) * (abs(FIT_BITPIX(fit)) / NBITS_BYTE)
+
+	    # Round up to fill the final 2880 byte FITS logical block.
+	    nbytes = ((nbytes + 2880-1) / 2880) * 2880
+
+	    datalen = nbytes / SZB_CHAR
+
+	} else
+	    datalen = 0
+
+	call sfree (sp)
+end
+
+
+# FXF_MERGE_W_UA --  Merge a spool user area with the im_userarea.
+
+procedure fxf_merge_w_ua (im, userh, fitslen) 
+
+pointer im		#I image descriptor
+int	userh		#I pointer to user area spool
+int	fitslen		#I length in chars of the user area
+
+bool	inherit
+pointer sp, lbuf, ua, ln
+int	elen, elines, nbl, i, k
+int	sz_userarea, merge, len_hdrmem, fit, clines, ulines
+bool	fxf_is_blank()
+int	strlen()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (ln, LEN_UACARD, TY_CHAR)
+
+	fit = IM_KDES(im)
+
+	# FIT_INHERIT has the logically combined value of the fkinit inherit's
+	# value, if any; the ksection value, if any and the INHERIT value in
+	# the extension header.
+
+	inherit = (FIT_INHERIT(fit) == YES)
+	inherit = (inherit && (FIT_GROUP(fit) != 0))
+
+	# Reallocate the image descriptor to allow space for the spooled user
+	# FITS cards plus a little extra for new parameters.
+
+	sz_userarea = fitslen + SZ_EXTRASPACE
+	# Add size of main header if necessary.
+	if (inherit)
+	    sz_userarea = sz_userarea + FIT_CACHEHLEN(fit)
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+
+	# Copy the extension header to the USERAREA if not inherit or copy
+	# the global header plus the extension header if inherit is set.
+
+	if (fitslen > 0) {
+	    ua = IM_USERAREA(im)
+	    elen = fitslen
+
+	    if (inherit) {
+		# First, copy those cards in the global header that 
+		# are not in the current extension header.
+
+		clines = strlen (Memc[FIT_CACHEHDR(fit)])
+		ulines = strlen (Memc[userh])
+		clines = clines / LEN_UACARD
+		ulines = ulines / LEN_UACARD
+		merge = YES
+		call fxf_match_str (FIT_CACHEHDR(fit),
+		    clines, userh, ulines, merge, ua)
+		elen = LEN_UACARD * ulines
+	    }
+
+	    # Append the extension header to the UA.
+	    elines = elen / LEN_UACARD
+	    k = userh
+	    nbl = 0
+
+	    do i = 1, elines {
+		call strcpy (Memc[k], Memc[ln], LEN_UACARD)
+		if (fxf_is_blank (Memc[ln]))
+		    nbl = nbl + 1
+		else {
+		    # If there are blank cards, add them.
+		    if (nbl > 0)
+			call fxf_blank_lines (nbl, ua)
+		    call amovc (Memc[ln], Memc[ua], LEN_UACARD)
+		    ua = ua + LEN_UACARD
+		}
+		k = k + LEN_UACARD
+	    }
+
+	    Memc[ua] = EOS
+	}	
+	call sfree (sp)
+end
+
+
+# FXF_STRCMP_LWR -- Compare 2 strings in lower case mode.
+
+int procedure fxf_strcmp_lwr (s1, s2)
+
+char s1[ARB], s2[ARB]		#I strings to be compare for equality
+
+int	istat
+pointer sp, l1, l2
+int	strcmp()
+
+begin
+	call smark (sp)
+	call salloc (l1, LEN_CARD, TY_CHAR)
+	call salloc (l2, LEN_CARD, TY_CHAR)
+
+	call strcpy (s1, Memc[l1], LEN_CARD)
+	call strcpy (s2, Memc[l2], LEN_CARD)
+	call strlwr(Memc[l1])
+	call strlwr(Memc[l2])
+	istat = strcmp (Memc[l1], Memc[l2])
+
+	call sfree (sp)
+	return (istat)
+end
+
+
+# FXF_DATE2LIMTIME -- Convert the IRAF_TLM string (used to record the IMIO
+# time of last modification of the image) into a long integer limtime
+# compatible with routine cnvtime().  The year must be 1980 or later.
+# The input date string has one of the following forms:
+#
+# Old format:			"hh:mm:ss (dd/mm/yyyy)"
+# New (Y2K/ISO) format:		"YYYY-MM-DDThh:mm:ss
+
+procedure fxf_date2limtime (datestr, limtime)
+
+char	datestr[ARB]	#I fixed format date string
+long	limtime		#O output limtime (LST seconds from 1980.0)
+
+double	dsec
+int	hours,minutes,seconds,day,month,year
+int     status, iso, flags, ip, m, d, y
+int	dtm_decode_hms(), btoi(), ctoi()
+long    gmttolst()
+double  jd
+
+begin
+	iso = btoi (datestr[3] != ':')
+	status = OK
+
+	if (iso == YES) {
+	    status = dtm_decode_hms (datestr,
+		year,month,day, hours,minutes,dsec, flags)
+
+	    # If the decoded date string is old style FITS then the HMS
+	    # values are indefinite, and we need to set them to zero.
+
+	    if (and(flags,TF_OLDFITS) != 0) {
+		hours = 0
+		minutes = 0
+		seconds = 0
+	    } else {
+ 		if (IS_INDEFD(dsec)) {
+                    hours   = 0
+                    minutes = 0
+                    seconds = 0
+		} else
+                    seconds = nint(dsec)
+            }
+	} else {
+	    ip = 1;  ip = ctoi (datestr,     ip, hours)
+	    ip = 1;  ip = ctoi (datestr[4],  ip, minutes)
+	    ip = 1;  ip = ctoi (datestr[7],  ip, seconds)
+	    ip = 1;  ip = ctoi (datestr[11], ip, day)
+	    ip = 1;  ip = ctoi (datestr[14], ip, month)
+	    ip = 1;  ip = ctoi (datestr[17], ip, year)
+	}
+
+	if (status == ERR || year < 1980) {
+	    limtime = 0
+	    return
+	}
+
+	seconds = seconds + minutes * 60 + hours * 3600
+
+        # Calculate the Julian day from jan 1, 1980. Algorithm taken
+	# from astutil/asttools/asttimes.x.
+
+        y = year
+	if (month > 2)
+	    m = month + 1
+	else {
+	    m = month + 13
+	    y = y - 1
+	}
+
+	# Original: jd = int (JYEAR * y) + int (30.6001 * m) + day + 1720995
+        # -723244.5 is the number of days to add to get 'jd' from jan 1, 1980.
+
+	jd = int (365.25 * y) + int (30.6001 * m) + day - 723244.5
+	if (day + 31 * (m + 12 * y) >= 588829) {
+	    d = int (y / 100)
+	    m = int (y / 400)
+	    jd = jd + 2 - d + m
+	}
+	jd = jd - 0.5 
+        day = jd
+
+	limtime = seconds + day * 86400
+	if (iso == YES)
+	    limtime = gmttolst (limtime)
+end
+
+
+# FIT_MATCH_STR -- FITS header pattern matching algorithm.  Match mostly one
+# line of lenght LEN_UACARD with the buffer pointed by str; if pattern is not
+# in str, put it in the 'out' buffer.
+
+procedure fxf_match_str (pat, plines, str, slines, merge, po)
+
+pointer pat		#I buffer with pattern
+int	plines		#I number of pattern
+pointer str		#I string to compare the pattern with
+int	slines		#I number of lines in str
+int	merge		#I flag to indicate merging or unmerge
+pointer po		#I matching pattern accumulation pointer
+
+char	line[LEN_UACARD]
+pointer sp, pt, tpt, tst, ps, pkp
+int	nbl, l, k, j, i, strncmp(), nbkw, nsb, cmplen
+int	stridxs()
+
+begin
+	call smark (sp)
+	call salloc (tpt, LEN_UACARD_100+1, TY_CHAR)
+	call salloc (tst, LEN_UACARD_5+1, TY_CHAR)
+
+	Memc[tpt] = EOS
+	Memc[tst] = EOS
+
+	# The temporary buffer is non blank only when it has a blank
+	# keyword following by a comentary:
+
+	#1) '	       '		   / Comment to the block of keyw
+	#2) KEYWORD = Value
+
+	nbl = 0
+	nbkw = 0
+	pt = pat - LEN_UACARD
+
+	for (k=1;  k <= plines;  k=k+1) {
+	    pt = pt + LEN_UACARD
+	    call strcpy (Memc[pt], line, LEN_UACARD)
+
+	    # Do not pass these keywords if merging.
+	    if (merge == YES) {
+		if (strncmp (line, "COMMENT ", 8) == 0 ||
+		    strncmp (line, "HISTORY ", 8) == 0 ||
+		    strncmp (line, "OBJECT  ", 8) == 0 ||
+		    strncmp (line, "EXTEND  ", 8) == 0 ||
+		    strncmp (line, "ORIGIN  ", 8) == 0 ||
+		    strncmp (line, "IRAF-TLM", 8) == 0 ||
+		    strncmp (line, "DATE    ", 8) == 0 ) {
+
+		    next 
+	        }
+	    }	
+	    if (line[1] == ' ') {
+	        call fxf_accum_bufp (line, tpt, nbkw, nbl)
+	        next
+	    }
+
+	    if (Memc[tpt] != EOS) {  
+		nbkw = nbkw + 1
+	        call strcat (line, Memc[tpt], LEN_UACARD_100)
+	        Memc[tst] = EOS
+
+	        # Now that we have a buffer with upto 100 lines, we take its 
+	        # last 5 card and we are going to compare it with upto 5 
+	        # lines (that can contain blank lines in between).
+
+	        pkp = tpt + LEN_UACARD*(nbkw-1)
+	        ps = str - LEN_UACARD
+	        nsb = 0
+
+		do j = 1, slines {
+		    ps = ps + LEN_UACARD
+		    call strcpy (Memc[ps], line, LEN_UACARD)
+
+		    if (line[1] == ' ') {
+			call fxf_accum_buft (line, tst, nsb)
+			next
+
+		    } else if (Memc[tst] != EOS) {
+			nsb = nsb + 1
+			call strcat (line, Memc[tst], LEN_UACARD_5)
+
+			# To begin compare the first character in the
+			# keyword line.
+
+			if (Memc[pkp] == line[1]) {
+			    if (strncmp (Memc[pkp-LEN_UACARD*(nsb-1)],
+				    Memc[tst], LEN_UACARD*nsb) == 0) {
+				nsb = 0
+				break
+			    }
+			}	  
+
+			nsb = 0
+			Memc[tst] = EOS
+		    }
+		}
+
+	        if (j == slines+1) {
+		    if (nbl > 0)
+		        call fxf_blank_lines (nbl, po)
+		    i = tpt
+		    do l = 1, min(100, nbkw) {
+		        call amovc (Memc[i], Memc[po], LEN_UACARD)
+		        i = i + LEN_UACARD
+		        po = po + LEN_UACARD
+		    }
+	        } else {
+		    pt = pt - LEN_UACARD	# push back last line
+		    k = k - 1
+	        }
+
+	        Memc[tpt] = EOS	
+	        nbkw = 0
+	        nbl = 0	
+
+	    } else {
+		# One line to compare.
+		ps = str - LEN_UACARD
+		cmplen = min (stridxs("=", Memc[pt]), LEN_UACARD)
+		if (cmplen == 0)
+		    cmplen = LEN_UACARD
+
+#	        if (merge == YES)
+#		    cmplen = SZ_KEYWORD
+
+	        do j = 1, slines {
+		    ps = ps + LEN_UACARD
+		    if (Memc[ps] == Memc[pt]) {
+			if (merge == NO)
+			    cmplen = LEN_CARD 
+		        if (strncmp (Memc[ps], Memc[pt], cmplen) == 0) {
+			    nbl = 0
+			    break
+			}
+		    }   
+	        }
+
+	        if (j == slines+1) {
+		    if (nbl > 0)
+		        call fxf_blank_lines (nbl, po)
+
+		    call amovc (line, Memc[po], LEN_UACARD)
+		    po = po + LEN_UACARD
+		    nbl = 0
+	        } 
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# FXF_ACCUM_BUFP -- Accumulate blank keyword cards (No keyword and a / card
+# only) and the blank lines in between.
+
+procedure fxf_accum_bufp (line, tpt, nbkw, nbl)
+
+char	line[LEN_UACARD]	#I input card from the pattern buffer
+pointer tpt			#I pointer to the buffer
+int	nbkw			#U number of blank keyword card
+int	nbl			#U number of blank card before the 1st bkw
+
+char	keyw[SZ_KEYWORD]		
+bool	fxf_is_blank()	
+
+begin
+	call strcpy (line, keyw, SZ_KEYWORD)
+
+	if (fxf_is_blank (line)) {
+	    # Accumulate blank cards in between bkw cards.
+	    if (nbkw > 0 && nbkw < 100) {
+		call strcat (line, Memc[tpt], LEN_UACARD_100)
+		nbkw = nbkw + 1
+	    } else if (nbkw >= 100) {
+		nbkw = nbkw - 1
+	    } else
+		nbl = nbl + 1
+
+	} else if (fxf_is_blank (keyw)) {
+	    nbkw = nbkw + 1
+
+	    # We have a blank keyword, but the card is not blank, maybe it is
+	    # a '/ comment' card.  Start accumulating upto 100 blank kwy lines.
+
+	    if (nbkw < 100)
+		call strcat (line, Memc[tpt], LEN_UACARD_100)
+	    else
+		nbkw = nbkw - 1
+	}
+end
+
+
+# FXF_ACCUM_BUFT -- Accumulate blank keyword keeping track of the blank cards.
+
+procedure fxf_accum_buft (line, tst, nsb)
+
+char	line[LEN_UACARD]	#I input card from the target buffer
+pointer tst			#I pointer to output buffer
+int	nsb			#U number of consecutives blank cards
+
+char	keyw[SZ_KEYWORD]
+bool	fxf_is_blank()	
+
+begin
+	call strcpy (line, keyw, SZ_KEYWORD)
+
+	if (fxf_is_blank (line)) {
+	    if (nsb > 0 && nsb < 5) {
+		call strcat (line, Memc[tst], LEN_UACARD_5)
+		nsb = nsb + 1
+	    } else if (nsb > 4)
+		nsb = nsb - 1 
+	} else if (fxf_is_blank (keyw)) {
+	    # We want to pick the last blank kwy only.
+	    call strcpy (line, Memc[tst], LEN_UACARD_5)
+	    nsb = 1
+	}
+end
+
+
+# FXF_BLANK_LINES -- Write a number of blank lines into output buffer.
+
+procedure fxf_blank_lines (nbl, po)
+
+int	nbl			#U number of blank lines to write
+pointer po			#I output buffer pointer
+
+char	blk[1]
+int	i
+
+begin
+	blk[1] = ' '
+	do i = 1, nbl {
+	    call amovkc (blk[1], Memc[po], LEN_UACARD)
+	    po = po +  LEN_UACARD
+	    Memc[po-1] = '\n'
+	}
+	nbl = 0
+end
+
+
+# FXF_IS_BLANK -- Determine is the string is blank.
+
+bool procedure fxf_is_blank (line)
+
+char line[ARB]			#I input string
+int  i
+
+begin
+	for (i=1; IS_WHITE(line[i]); i=i+1)
+	   ;
+
+	if (line[i] == NULL || line[i] == '\n')
+	    return (true)
+	else
+	    return (false)
+end
+
+
+# FXF_FORM_MESSG -- Form string from extname, extver.
+
+procedure fxf_form_messg (fit, messg)
+
+pointer fit			#I fits descriptor
+char	messg[ARB]		#O string
+
+begin
+	if (!IS_INDEFL (FKS_EXTVER(fit))) {
+	    call sprintf (messg, LEN_CARD, "'%s,%d'")
+		call pargstr (FKS_EXTNAME(fit))
+		call pargi (FKS_EXTVER(fit)) 
+	} else {
+	    call sprintf (messg, LEN_CARD, "'%s'")
+		call pargstr (FKS_EXTNAME(fit))
+	}			
+end
diff --git a/sys/imio/iki/fxf/fxfupdhdr.x b/sys/imio/iki/fxf/fxfupdhdr.x
new file mode 100644
index 00000000..40a24763
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfupdhdr.x
@@ -0,0 +1,1478 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include <error.h>
+include	<imhdr.h>
+include	<imio.h>
+include <finfo.h>
+include	<fio.h>
+include	<fset.h>
+include <mii.h>
+include <time.h>
+include <mach.h>
+include	"fxf.h"
+
+# FXFUPDHDR.X -- Routines to update the header of an image extension on
+# disk.
+
+define  SZ_DATESTR    24
+
+
+# FXF_UPDHDR -- Update the FITS header file.  This is done by writing an
+# entire new header file and then replacing the old header file with the
+# new one.  This is necessary since the header file is a text file and text
+# files cannot be randomly updated.
+
+procedure fxf_updhdr (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O return status
+
+pointer	sp, fit, mii, poff
+pointer	outname, fits_file, tmp1, tmp2
+bool    adjust_header, overwrite, append
+int	i, nchars_ua, hdr_fd, group, hdr_off, size
+int	npad, nlines, pixoff, grp_pix_off, nbks
+int	acmode, in_fd, diff, hdr_acmode, in_off, nchars, subtype
+int	read(), fxf_hdr_offset(), access(), strncmp()
+int	open(), fstatl(), fnldir(), strlen(), stridxs()
+bool	fnullfile()
+
+errchk  open, read, write, fxf_header_diff, fxf_write_header, fxf_make_adj_copy
+errchk  fxf_set_cache_time, syserr, syserrs, imerr
+errchk  fxf_expandh, fxf_not_incache, fxf_ren_tmp, fxf_update_extend
+long	clktime()
+
+begin
+	call smark (sp)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+	call salloc (fits_file, SZ_FNAME, TY_CHAR)
+	call salloc (outname, SZ_PATHNAME, TY_CHAR)
+	call salloc (tmp1, max(SZ_PATHNAME,SZ_FNAME*2), TY_CHAR)
+	call salloc (tmp2, max(SZ_PATHNAME,SZ_FNAME*2), TY_CHAR)
+
+	acmode = IM_ACMODE(im)
+	fit = IM_KDES(im)
+	status = OK
+
+	# For all intents and purposes the APPEND access mode is the same
+	# as NEW_IMAGE under the FK.  Let's simplify the code as the user
+	# has requested APPEND.
+
+        if (acmode == APPEND)
+	    acmode = NEW_IMAGE
+
+	if (acmode == READ_ONLY)
+	    call imerr (IM_NAME(im), SYS_IMUPIMHDR)
+
+	if (fnullfile (IM_HDRFILE(im))) {
+	    call sfree (sp)
+	    return
+	}
+
+	group = FIT_GROUP(fit)
+
+        subtype = 0
+	if ((FKS_SUBTYPE(fit) == FK_PLIO || 
+		(strncmp("PLIO_1", FIT_EXTSTYPE(fit), 6) == 0)) && 
+		(IM_PL(im) != NULL))
+	    subtype = FK_PLIO
+
+	if (FIT_EXTTYPE(fit) != EOS && group != -1) {
+	    if (strncmp (FIT_EXTTYPE(fit), "IMAGE", 5) != 0 &&
+		    strncmp (FIT_EXTTYPE(fit), "SIMPLE", 6) != 0 &&
+		    subtype == 0) {
+		call syserr (SYS_FXFUPHBEXTN)
+	    }
+	}
+
+	if (FKS_OVERWRITE(fit) == YES) {
+	    if (group == 0) {
+		# We are overwriting the main unit.
+	        FIT_NEWIMAGE(fit) = YES
+	    }
+
+	    group = -1
+	    acmode = NEW_IMAGE
+
+	    if (IM_PFD(im) == NULL) 
+	        call fxf_overwrite_unit (fit, im)
+
+	    call strcpy (IM_PIXFILE(im), Memc[fits_file], SZ_FNAME)
+
+	} else
+	    call strcpy (IM_HDRFILE(im), Memc[fits_file], SZ_FNAME)
+	
+	# Calculate the header offset corresponding to group number 'group'. 
+	FIT_IM(fit) = im
+	hdr_off = fxf_hdr_offset (group, fit, IM_PFD(im), acmode)
+
+	# If the pixfile has not been created, open new one.  This could
+	# happen if the don't write any pixels to the data portion of the file.
+
+	if (IM_PFD(im) == NULL && (acmode == NEW_COPY || acmode == NEW_IMAGE)) {
+	    FIT_NAXIS(fit) = 0
+	    if (FIT_NEWIMAGE(fit) == YES)
+	        hdr_acmode = NEW_FILE
+	    else {
+	        # We want to append a new extension with no data.
+	        hdr_acmode = READ_WRITE
+	    }
+	} else {
+	    call close(IM_PFD(im))	
+	    hdr_acmode = READ_WRITE
+	}
+
+	append = (acmode == NEW_IMAGE || acmode == NEW_COPY)
+
+	# Calculate header difference. The difference between the original
+	# header length at open time and now. The user could have added or
+	# deleted header keywords.
+
+	call fxf_header_diff (im, group, acmode, hdr_off, diff, nchars_ua)
+
+	# PLIO
+	if (subtype == FK_PLIO && append) 
+	    diff = 0
+
+	# Adjust header only when we need to expand. We fill with trailing 
+	# blanks in case diff .gt. 0. (Reduce header size).
+
+	adjust_header = (diff < 0)
+	if (adjust_header && FIT_EXPAND(fit) == NO) {
+	    call syserr (SYS_FXFUPHEXP)
+	    adjust_header = false
+	}
+
+	overwrite = (FKS_OVERWRITE(fit) == YES)
+	if (adjust_header || overwrite) {
+	    # We need to change the size of header portion in the middle of
+	    # the file. The best thing to do is to make a copy in the output
+	    # filename directory.
+
+	    i = strlen (IM_PIXFILE(im))
+	    nchars = fnldir (IM_PIXFILE(im), Memc[outname], SZ_PATHNAME)
+	    if (nchars > 80 && i > 100) {
+		i = stridxs ("!", Memc[outname])
+	        call strcpy ("tmp$", Memc[outname+i], SZ_PATHNAME-i)
+	    }
+	    call strcpy (Memc[outname], Memc[tmp2], SZ_FNAME)
+            call mktemp ("fx", Memc[tmp1], SZ_PATHNAME)
+	    call strcat (".fits", Memc[tmp1], SZ_PATHNAME)
+	    call strcat ("A", Memc[outname], SZ_PATHNAME)
+	    call strcat (Memc[tmp1], Memc[outname], SZ_PATHNAME)
+	    call strcat ("B", Memc[tmp2], SZ_PATHNAME)
+	    call strcat (Memc[tmp1], Memc[tmp2], SZ_PATHNAME)
+	    in_fd = open (Memc[fits_file], READ_ONLY, BINARY_FILE)
+	    if (access (Memc[outname], 0, 0) == YES)
+		call delete (Memc[outname])
+	    hdr_fd = open (Memc[outname], NEW_FILE, BINARY_FILE)
+
+            # Now expand the current group at least one block of 36 cards
+	    # and guarantee that the other groups in the file will have at
+	    # least 'nlines' of blank cards at the end of the header unit.
+
+	    nlines= FKS_PADLINES(fit)
+	    IM_HFD(im) = in_fd
+
+	    if (adjust_header && acmode != NEW_COPY && 
+		FIT_XTENSION(fit) == YES) {
+		nbks = -diff/1440     # number of blocks to expand
+		call fxf_expandh (in_fd, hdr_fd, nlines, group, nbks,
+		    hdr_off, pixoff)
+		nchars_ua = pixoff - hdr_off
+		# Reload PHU from file if necessary
+	        call fxf_not_incache(im)
+		poff = FIT_PIXPTR(fit)
+		Memi[poff+group] = pixoff
+	    } else {
+		if (append)
+		    grp_pix_off = FIT_PIXOFF(fit)
+		else {
+		    # Reload PHU from file if necessary
+	            call fxf_not_incache(im)
+		    grp_pix_off = Memi[FIT_PIXPTR(fit)+group]
+		}
+		call fxf_make_adj_copy (in_fd, hdr_fd,
+		    hdr_off, grp_pix_off, nchars_ua)
+	    }
+	    diff = 0
+	    group = -1
+
+	    # Reset the time so we can read a fresh header next time.
+	    call fxf_set_cache_time (im, overwrite)
+	} else {
+	    hdr_fd = open (Memc[fits_file], hdr_acmode, BINARY_FILE)
+	    # Do not clear if we are creating a Bintable with type PLIO_1.
+	    if (subtype != FK_PLIO)
+	        IM_PFD(im) = NULL
+	    IM_HFD(im) = NULL
+	}
+
+	if (FIT_NEWIMAGE(fit) == YES)
+	    call seek (hdr_fd, BOF)
+	else if (hdr_off != 0)
+	    call seek (hdr_fd, hdr_off)
+	   
+	if (acmode == NEW_COPY)
+	    call fxf_setbitpix (im, fit)
+
+	# Lets changed the value of FIT_MTIME that will be used as the mtime for
+	# this updated file. This time them will be different in other
+	# executable's FITS cache, hence rereading the PHU. 
+	# We need to use FIT_MTIME since it reflec the value of keyword
+	# IRAF_TLM which could have just recently been modified, hence adding
+	# the 4 seconds.
+	
+        if (abs(FIT_MTIME(fit) - clktime(long(0))) > 60)
+	    FIT_MTIME(fit) = clktime(long(0))
+
+	# We cannot use clktime() directly since the previuos value
+	# of FIT_MTIME might already have a 4 secs increment.
+
+        FIT_MTIME(fit) = FIT_MTIME(fit) + 4
+
+	# Now write default cards and im_userarea to disk.
+	nchars_ua = nchars_ua + diff
+	call fxf_write_header (im, fit, hdr_fd, nchars_ua, group)
+
+ 	size = fstatl (hdr_fd, F_FILESIZE)
+	npad = FITS_BLOCK_CHARS - mod(size,FITS_BLOCK_CHARS)
+
+	# If we are appending a new extension, we need to write padding to
+	# 2880 bytes blocks at the end of the file.
+
+	if (mod(npad,FITS_BLOCK_CHARS) > 0 &&
+		(FIT_NEWIMAGE(fit) == YES || append)) {
+	    call amovki (0, Memi[mii], npad)
+	    call flush (hdr_fd)
+	    call seek (hdr_fd, EOF)
+	    call write (hdr_fd, Memi[mii], npad)
+	}
+	call flush (hdr_fd)
+
+	# Now open the original file and skip to the beginning of (group+1)
+	# to begin copying into hdr_fd. (end of temporary file in tmp$).
+
+	if (FKS_OVERWRITE(fit) == YES) {
+	    if (overwrite) {
+		call close (in_fd)
+		if (access (IM_PIXFILE(im), 0, 0) == YES)
+		    call delete (IM_PIXFILE(im))
+		call strcpy (Memc[outname], IM_PIXFILE(im), SZ_FNAME)
+	    }		
+
+	    in_fd = open (IM_HDRFILE(im), READ_ONLY, BINARY_FILE)
+	    group = FIT_GROUP(fit)
+	    call fxf_not_incache (im)
+	    in_off = Memi[FIT_HDRPTR(fit)+group+1]
+	    call seek (hdr_fd, EOF)
+	    call seek (in_fd, in_off)
+	    size = FITS_BLOCK_CHARS
+
+	    while (read (in_fd, Memi[mii], size) != EOF) 
+		call write (hdr_fd, Memi[mii], size)
+
+	    call close (hdr_fd)
+	    call close (in_fd)
+
+	    call fxf_ren_tmp (IM_PIXFILE(im), IM_HDRFILE(im), Memc[tmp2], 1, 1)
+
+	    # Change the acmode so we can change the modification and
+	    # this way reset the cache for this file.
+
+	    IM_ACMODE(im) = READ_WRITE
+	    call fxf_over_delete(im)
+
+	} else {
+	    if (adjust_header || overwrite)
+	        call close (in_fd)
+	    call close (hdr_fd)
+
+            # If the header has been expanded then rename the temp file
+	    # to the original name.
+	    if (adjust_header)
+		call fxf_ren_tmp (Memc[outname], IM_PIXFILE(im),
+		    Memc[tmp2], 1, 1)
+	}
+
+	# Make sure we reset the modification time for the cached header
+	# since we have written a new version. This way the header will
+	# be read from disk next time the file is accessed.
+
+        if (IM_ACMODE(im) == READ_WRITE || overwrite)  {
+           # The modification time of a file in the cache can be different
+	   # from another mod entry in another executable. We need to make
+	   # sure that the mod time has changed in more than a second so that
+	   # the other executable can read the header from disk and not
+	   # from the cache entry. The FIT_MTIME value has already been
+	   # changed by adding 4 seconds. (See above).
+
+           call futime (IM_HDRFILE(im), NULL, FIT_MTIME(fit))
+#           call futime (IM_HDRFILE(im), NULL, clktime(long(0))+4)
+	}
+
+	if (FIT_GROUP(fit) == 0 || FIT_GROUP(fit) == -1)
+	   call fxf_set_cache_time (im, false)
+
+	# See if we need to add or change the value of EXTEND in the PHU.
+	if (FIT_XTENSION(fit) == YES && 
+	   (FIT_EXTEND(fit) == NO_KEYW || FIT_EXTEND(fit) == NO)) {
+		call fxf_update_extend (im)
+	   }
+
+	call sfree (sp)
+end
+
+
+# FXF_HDR_OFFSET -- Function to calculate the header offset for group number
+# 'group'.
+
+int procedure fxf_hdr_offset (group, fit, pfd, acmode)
+
+int	group			#I extension number
+pointer	fit			#I fits descriptor
+pointer	pfd			#I pixel file descriptor
+int	acmode			#I image acmode
+
+int	hdr_off
+
+begin
+	if (FIT_NEWIMAGE(fit) == YES)
+	    return (0)
+
+	# Look for the beginning of the current group.
+	if (group == -1) {
+	    # We are appending or creating a new FITS IMAGE.
+	    hdr_off = FIT_EOFSIZE(fit)
+	} else {
+	    call fxf_not_incache (FIT_IM(fit))
+	    hdr_off = Memi[FIT_HDRPTR(fit)+group]
+        }
+	
+	# If pixel file descriptor is empty for a newcopy or newimage
+	# in an existent image then the header offset is EOF.
+
+	if (pfd == NULL && (acmode == NEW_COPY || acmode == NEW_IMAGE))
+	    hdr_off = EOF
+
+	return (hdr_off)
+end
+
+
+# FXF_HEADER_DIFF -- Get the difference between the original header at open
+# time and the one at closing time.
+
+procedure fxf_header_diff (im, group, acmode, hdr_off, diff, ualen)
+
+pointer	im			#I image descriptor
+int	group			#I extension number
+int	acmode			#I emage acmode
+int	hdr_off			#I header offset for group
+int	diff			#O difference
+int	ualen			#O new header length
+
+char	temp[LEN_CARD]
+pointer	hoff, poff, sp, pb, tb
+int	ua, fit, hdr_size, pixoff, clines, ulines, len, padlines
+int     merge, usize, excess, nheader_cards, rp, inherit, kmax, kmin
+int     strlen(), imaccf(), imgeti(), strcmp(), idb_findrecord()
+int	btoi(), strncmp()
+bool    imgetb()
+
+errchk  open, fcopyo
+
+begin
+	fit = IM_KDES(im)
+	inherit = NO
+
+	FIT_INHERIT(fit) = FKS_INHERIT(fit)
+
+	# In READ_WRITE mode get the UA value of INHERIT only if it has
+	# change after _open().
+
+	if (acmode == READ_WRITE) {
+	    if (imaccf (im, "INHERIT") == YES) {
+		inherit = btoi (imgetb (im, "INHERIT"))
+		if (inherit != FKS_INHERIT(fit))
+		    FIT_INHERIT(fit) = inherit
+	    }
+	}
+
+	# Allow inheritance only for extensions.
+	inherit = FIT_INHERIT(fit)
+	if (FIT_GROUP(fit) == 0) {
+	    inherit = NO
+  	    FIT_INHERIT(fit) = inherit
+	}
+	# Scale the pixel offset to be zero base rather than the EOF base.
+	if (FIT_NEWIMAGE(fit) == NO) {
+	    pixoff = FIT_PIXOFF(fit) - FIT_EOFSIZE(fit)
+	} else {
+	    if ((hdr_off == EOF || hdr_off == 0)&&
+		(IM_NDIM(im) == 0 || FIT_NAXIS(fit) == 0)) {
+	        diff = 0
+	        return
+	    }
+	    pixoff = FIT_PIXOFF(fit) - 1
+	}
+
+	ua = IM_USERAREA(im)
+
+	if (FIT_NEWIMAGE(fit) == NO && inherit == YES) {
+	    # Form an extension header by copying cards in the UA that
+	    # do not belong in the global header nor in the old
+	    # extension header if the image is open READ_WRITE.
+
+	    # Check if the file is still in cache. We need CACHELEN and
+            # CACHEHDR. 
+
+            call fxf_not_incache (im)
+
+	    len = strlen (Memc[ua])
+	    ulines = len / LEN_UACARD
+	    clines = FIT_CACHEHLEN(fit) / LEN_UACARD
+
+	    call smark (sp)
+	    call salloc (tb, len+1, TY_CHAR)
+
+	    # Now select those lines in UA that are not in fit_cache and
+	    # put them in 'pb'.
+
+	    pb = tb
+	    merge = NO
+	    call fxf_match_str (ua, ulines,
+		FIT_CACHEHDR(fit), clines, merge, pb)
+	    Memc[pb] = EOS
+	    ualen = strlen (Memc[tb])
+
+	    # Now copy the buffer pointed by 'pb' to UA.
+	    call strcpy (Memc[tb], Memc[ua], ualen)
+
+	    call sfree (sp)
+	}
+
+	# See also fitopix.x for an explanation of this call.
+	call fxf_mandatory_cards (im, nheader_cards)
+
+	kmax = idb_findrecord (im, "DATAMAX", rp)
+	kmin = idb_findrecord (im, "DATAMIN", rp)
+
+	if (IM_LIMTIME(im) < IM_MTIME(im)) {
+	    # Keywords should not be in the UA.
+	    if (kmax > 0)
+	        call imdelf (im, "DATAMAX")
+	    if (kmin > 0)
+	        call imdelf (im, "DATAMIN")
+
+	} else {
+	    # Now update the keywords.  If they are not in the UA we need
+	    # to increase the number of mandatory cards.
+
+	    if (kmax == 0)
+		nheader_cards = nheader_cards + 1
+	    if (kmin == 0)
+		nheader_cards = nheader_cards + 1
+        }	     
+
+	# Determine if OBJECT or IM_TITLE have changed. IM_TITLE has
+	# priority.
+
+        # If FIT_OBJECT is empty, then there was no OBJECT card at read
+	# time. If OBJECT is present now, then it was added now. If OBJECT
+	# was present but not now, the keyword was deleted.
+
+	temp[1] = EOS
+	if (imaccf (im, "OBJECT") == YES) {
+	    call imgstr (im, "OBJECT", temp, LEN_CARD)
+	    # If its value is blank, then temp will be NULL
+	    if (temp[1] == EOS)
+		call strcpy ("       ", temp, LEN_CARD)
+	}
+
+	if (temp[1] != EOS)
+	    call strcpy (temp, FIT_OBJECT(fit), LEN_CARD)
+	else
+	    nheader_cards = nheader_cards - 1
+
+	if (FIT_OBJECT(fit) == EOS) {
+	    if (strcmp (IM_TITLE(im), FIT_TITLE(fit)) != 0) {
+		call strcpy (IM_TITLE(im), FIT_OBJECT(fit), LEN_CARD)
+		# The OBJECT keyword will be added.
+		nheader_cards = nheader_cards + 1
+	    }
+	} else {
+	    # See if OBJECT has been deleted from UA.
+	    if (temp[1] == EOS)
+		FIT_OBJECT(fit) = EOS
+	    if (strcmp (IM_TITLE(im), FIT_TITLE(fit)) != 0)
+		call strcpy (IM_TITLE(im), FIT_OBJECT(fit), LEN_CARD)
+	}
+
+
+	# Too many mandatory cards if we are using the PHU in READ_WRITE mode.
+	# Because fxf_mandatory_cards gets call with FIT_NEWIMAGE set to NO,
+	# i.e. an extension. (12-9=3)
+
+	if (FIT_XTENSION(fit) == NO && FIT_NEWIMAGE(fit) == NO)
+	    nheader_cards = nheader_cards - 3
+
+	if (FIT_NEWIMAGE(fit) == NO && FIT_XTENSION(fit) == YES) {
+
+	    # Now take EXTNAME and EXTVER keywords off the UA if they are in
+	    # there. The reason being they can be out of order.
+
+	    iferr (call imgstr (im, "EXTNAME", FIT_EXTNAME(fit), LEN_CARD)) {
+		FIT_EXTNAME(fit) = EOS
+		if (FKS_EXTNAME(fit) != EOS) {
+		   call strcpy (FKS_EXTNAME(fit), FIT_EXTNAME(fit), LEN_CARD)
+		} else {
+		   # We will not create EXTNAME keyword in the output header
+		   nheader_cards = nheader_cards - 1
+		}
+	    } else {
+		call imdelf (im, "EXTNAME")
+		nheader_cards = nheader_cards + 1
+	    }
+
+	    if (imaccf (im, "EXTVER") == YES) {
+		FIT_EXTVER(fit) = imgeti (im, "EXTVER")
+		call imdelf (im, "EXTVER")
+		nheader_cards = nheader_cards + 1
+	    }
+	    if (imaccf (im, "PCOUNT") == YES) {
+		call imdelf (im, "PCOUNT")
+		nheader_cards = nheader_cards + 1
+	    }
+	    if (imaccf (im, "GCOUNT") == YES) {
+		call imdelf (im, "GCOUNT")
+		nheader_cards = nheader_cards + 1
+	    }
+	 
+	    if (IS_INDEFL(FIT_EXTVER(fit)) && !IS_INDEFL(FKS_EXTVER(fit)))
+		FIT_EXTVER(fit) = FKS_EXTVER(fit)
+	}
+
+	# Finally if we are updating a BINTABLE with a PLIO_1 mask we need
+	# to add 3 to the mandatory cards since TFIELDS, TTYPE1, nor
+	# TFORM1 are included.   ### Ugh!!
+	# Also add the Z cards.
+
+	if (strncmp ("PLIO_1", FIT_EXTSTYPE(fit), 6) == 0)
+	    nheader_cards = nheader_cards + 3 + 6 + IM_NDIM(im)*2
+
+	# Compute current header size rounded to a header block.
+	usize = strlen (Memc[ua]) 
+	len = (usize / LEN_UACARD + nheader_cards) * LEN_CARD 
+	len = FITS_LEN_CHAR(len / 2)
+
+	# Ask for more lines if the header can or needs to be expanded.
+	padlines = FKS_PADLINES(fit)
+
+	# Here we go over the FITS header area already allocated?
+	if (acmode == READ_WRITE || acmode == WRITE_ONLY) {
+	    call fxf_not_incache(im)
+	    hoff = FIT_HDRPTR(fit)
+	    poff = FIT_PIXPTR(fit)
+	    hdr_size = Memi[poff+group] - Memi[hoff+group]
+	    ualen = len
+	    diff = hdr_size - ualen
+	    # If the header needs to be expanded add on the pad lines.
+	    if (diff < 0) {
+		ualen = (usize/LEN_UACARD + nheader_cards + padlines) * LEN_CARD
+		ualen = FITS_LEN_CHAR(ualen / 2)
+	    }
+	    diff = hdr_size - ualen
+	} else if ((hdr_off == EOF || hdr_off == 0) && 
+	    (IM_NDIM(im) == 0 || FIT_NAXIS(fit) == 0)) {
+	    hdr_size = len
+	    ualen = len
+	} else {
+	    hdr_size = pixoff
+	    # The header can expand so add on the pad lines.
+	    ualen = (usize / LEN_UACARD + nheader_cards + padlines) * LEN_CARD
+	    ualen = FITS_LEN_CHAR(ualen / 2)
+	    diff = hdr_size - ualen
+        }
+
+        if (diff < 0 && FIT_EXPAND(fit) == NO) {
+	    # We need to reduce the size of the UA becuase we are not
+	    # going to expand the header.
+	    excess = mod (nheader_cards * 81 + usize, 1458)
+	    excess = excess + (((-diff-1400)/1440)*1458)
+	    Memc[ua+usize-excess] = EOS
+	    usize = strlen (Memc[ua]) 
+	    ualen = (usize / LEN_UACARD + nheader_cards) * LEN_CARD 
+	    ualen = FITS_LEN_CHAR(ualen / 2)
+	}
+end
+
+
+# FXF_WRITE_HDR -- Procedure to write header unit onto the PHU or EHU.
+
+procedure fxf_write_header (im, fit, hdr_fd, nchars_ua, group)
+
+pointer	 im		  	#I image structure
+pointer	 fit     		#I fits structure
+int	 hdr_fd  		#I FITS header file descriptor
+int	 nchars_ua		#I header size
+int	group			#I group number
+
+char	temp[SZ_FNAME] 
+bool	xtension, ext_append
+pointer	sp, spp, mii, rp, uap
+char    card[LEN_CARD], blank, keyword[SZ_KEYWORD], datestr[SZ_DATESTR] 
+int	iso_cutover, n, i, sz_rec, up, nblanks, acmode, nbk, len, poff, diff
+int     pos, pcount, depth, subtype, maxlen, ndim
+
+long	clktime()
+int	imaccf(), strlen(), fxf_ua_card(), envgeti()
+int	idb_findrecord(), strncmp(), btoi()
+bool	fxf_fpl_equald(), imgetb(), itob()
+long    note()
+errchk  write 
+
+begin
+	call smark (sp)
+	call salloc (spp, FITS_BLOCK_CHARS*5, TY_CHAR)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+
+	# Write out the standard, reserved header parameters.
+	n = spp
+	blank = ' '
+	acmode = FIT_ACMODE(fit)
+	ext_append = ((acmode == NEW_IMAGE || acmode == NEW_COPY) &&
+	    (FKS_EXTNAME(fit) != EOS || !IS_INDEFL (FKS_EXTVER(fit))))
+
+	xtension = (FIT_XTENSION(fit) == YES)
+	if (FIT_NEWIMAGE(fit) == YES)
+	    xtension = false
+
+	subtype =0
+	if ((FKS_SUBTYPE(fit) == FK_PLIO || 
+		(strncmp("PLIO_1", FIT_EXTSTYPE(fit), 6) == 0)) &&
+		IM_PL(im) != NULL) {
+
+	    subtype = FK_PLIO
+	    ext_append = true
+	}
+
+	# PLIO.  Write BINTABLE header for a PLIO mask.
+	if (subtype == FK_PLIO) {
+
+	    if (IM_PFD(im) != NULL) {
+		call fxf_plinfo (im, maxlen, pcount, depth)
+
+		# If we old heap has change in size, we need to
+		# resize it.
+
+		if (acmode == READ_WRITE && pcount != FIT_PCOUNT(fit))
+		    call fxf_pl_adj_heap (im, hdr_fd, pcount)
+	    } else {
+		pcount = FIT_PCOUNT(fit)
+		depth = DEF_PLDEPTH
+	    }
+
+	    ndim = IM_NDIM(im)
+	    call fxf_akwc ("XTENSION", "BINTABLE", 8, "Mask extension", n)
+	    call fxf_akwi ("BITPIX", 8, "Bits per pixel", n)
+	    call fxf_akwi ("NAXIS", ndim, "Number of axes", n)
+	    call fxf_akwi ("NAXIS1", 8, "Number of bytes per line", n)
+	    do i = 2, ndim {
+		call fxf_encode_axis ("NAXIS", keyword, i)
+	        call fxf_akwi (keyword, IM_LEN(im,i), "axis length", n)
+	    }
+	    call fxf_akwi ("PCOUNT", pcount, "Heap size in bytes", n)
+	    call fxf_akwi ("GCOUNT", 1, "Only one group", n)
+
+	    if (imaccf (im, "TFIELDS") == NO)
+		call fxf_akwi ("TFIELDS", 1, "1 Column field", n)
+	    if (imaccf (im, "TTYPE1") == NO) {
+		call fxf_akwc ("TTYPE1", "COMPRESSED_DATA", 16,
+		    "Type of PLIO_1 data", n)
+	    }
+	    call sprintf (card, LEN_CARD, "PI(%d)")
+		call pargi(maxlen) 
+	    call fxf_filter_keyw (im, "TFORM1")
+	    len = strlen (card)
+	    call fxf_akwc ("TFORM1", card, len, "Variable word array", n)
+
+	} else {
+	    if (xtension)
+		call fxf_akwc ("XTENSION", "IMAGE", 5, "Image extension", n)
+	    else
+		call fxf_akwb ("SIMPLE", YES, "Fits standard", n)
+
+	    if (FIT_NAXIS(fit) == 0 || FIT_BITPIX(fit) == 0) 
+		call fxf_setbitpix (im, fit)
+
+	    call fxf_akwi ("BITPIX", FIT_BITPIX(fit), "Bits per pixel", n)
+	    call fxf_akwi ("NAXIS", FIT_NAXIS(fit), "Number of axes", n)
+
+	    do i = 1, FIT_NAXIS(fit) {
+		call fxf_encode_axis ("NAXIS", keyword, i)
+		call fxf_akwi (keyword, FIT_LENAXIS(fit,i), "Axis length", n)
+	    }
+	
+	    if (xtension) {
+		call fxf_akwi ("PCOUNT", 0, "No 'random' parameters", n)
+		call fxf_akwi ("GCOUNT", 1, "Only one group", n)
+	    } else {
+		if (imaccf (im, "EXTEND") == NO)
+		    i = NO
+		else {
+		   # Keyword exists but it may be in the wrong position. 
+		   # Remove it and write it now.
+
+		   i = btoi (imgetb (im, "EXTEND"))
+		   call fxf_filter_keyw (im, "EXTEND") 
+		}
+		if (FIT_EXTEND(fit) == YES)
+		    i = YES
+		call fxf_akwb ("EXTEND", i, "File may contain extensions", n)
+		FIT_EXTEND(fit) = YES
+	    }
+	}
+
+        # Delete BSCALE and BZERO just in case the application puts them
+        # in the UA after the pixels have been written. The keywords
+        # should not be there since the FK does not allow reading pixels
+        # with BITPIX -32 and BSCALE and BZERO. If the application
+        # really wants to circumvent this restriction the code below
+        # will defeat that. The implications are left to the application.
+        # This fix is put in here to save the ST Hstio interface to be
+        # a victim of the fact that in v2.12 the BSCALE and BZERO keywords
+        # are left in the header for the user to see or change. Previous
+        # FK versions, the keywords were deleted from the UA.
+
+        if ((IM_PIXTYPE(im) == TY_REAL || IM_PIXTYPE(im) == TY_DOUBLE)
+                && (FIT_TOTPIX(fit) > 0 && FIT_BITPIX(fit) <= 0)) {
+
+             call fxf_filter_keyw (im, "BSCALE")
+             call fxf_filter_keyw (im, "BZERO")
+        }
+
+	# Do not write BSCALE and BZERO if they have the default 
+	# values (1.0, 0.0).
+
+	if (IM_PIXTYPE(im) == TY_USHORT) {
+	    call fxf_filter_keyw (im, "BSCALE") 
+	    call fxf_akwd ("BSCALE", 1.0d0,
+		"REAL = TAPE*BSCALE + BZERO", NDEC_REAL, n)
+	    call fxf_filter_keyw (im, "BZERO") 
+	    call fxf_akwd ("BZERO", 32768.0d0,  "", NDEC_REAL, n)
+	} else if (FIT_PIXTYPE(fit) != TY_REAL &&
+	    FIT_PIXTYPE(fit) != TY_DOUBLE && IM_ACMODE(im) != NEW_COPY) {
+	    # Now we have TY_SHORT or TY_(INT,LONG).
+	    # Check the keywords only if they have non_default values.
+
+	    # Do not add the keywords if they have been deleted.
+	    if (!fxf_fpl_equald(1.0d0, FIT_BSCALE(fit), 4)) {
+	        if ((imaccf (im, "BSCALE") == NO) && 
+		     fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 4)) {
+		    call fxf_akwd ("BSCALE",  FIT_BSCALE(fit),
+			"REAL = TAPE*BSCALE + BZERO", NDEC_REAL, n)
+	        }
+	    }
+	    if (!fxf_fpl_equald(0.0d0, FIT_BZERO(fit), 4) ) {
+	        if (imaccf (im, "BZERO") == NO &&
+		    fxf_fpl_equald (1.0d0, FIT_BZERO(fit), 4))
+		    call fxf_akwd ("BZERO", FIT_BZERO(fit),  "", NDEC_REAL, n)
+	    }
+	}
+
+        uap = IM_USERAREA(im)
+
+	if (idb_findrecord (im, "ORIGIN", rp) == 0)  {
+	    call strcpy (FITS_ORIGIN, temp, LEN_CARD)
+	    call fxf_akwc ("ORIGIN",
+		temp, strlen(temp), "FITS file originator", n)
+	} else if (rp - uap > 10*81) {
+	    # Out of place; do not change the value.
+	    call imgstr (im, "ORIGIN", temp, LEN_CARD)
+	    call fxf_filter_keyw (im, "ORIGIN")
+	    call fxf_akwc ("ORIGIN",
+		temp, strlen(temp), "FITS file originator", n)
+	}
+
+	if (xtension) {
+	    # Update the cache in case these values have changed
+	    # in the UA.
+	    call fxf_set_extnv (im)
+
+	    if (FIT_EXTNAME(fit) != EOS) {
+	        call strcpy (FIT_EXTNAME(fit), temp, LEN_CARD)
+	        call fxf_akwc ("EXTNAME",
+		    temp, strlen(temp), "Extension name", n)
+	    }
+	    if (!IS_INDEFL (FIT_EXTVER(fit))) {
+	        call fxf_akwi ("EXTVER",
+		    FIT_EXTVER(fit), "Extension version", n)
+	    }
+            if (idb_findrecord (im, "INHERIT", rp) > 0) {
+		# See if keyword is at the begining of the UA
+		if (rp - uap > 11*81) {
+		    call fxf_filter_keyw (im, "INHERIT")
+		    call fxf_akwb ("INHERIT",
+			FIT_INHERIT(fit), "Inherits global header", n)
+		} else if (acmode != READ_WRITE)
+		    call imputb (im, "INHERIT", itob(FIT_INHERIT(fit)))
+	    } else {
+		call fxf_akwb ("INHERIT",
+		    FIT_INHERIT(fit), "Inherits global header", n)
+	    }
+	}
+
+	# Dates after iso_cutover use ISO format dates.
+	iferr (iso_cutover = envgeti (ENV_ISOCUTOVER))
+	    iso_cutover = DEF_ISOCUTOVER
+
+	# Encode the "DATE" keyword (records create time of imagefile).
+	call fxf_encode_date (clktime(long(0)), datestr, SZ_DATESTR,
+	    "ISO", iso_cutover)
+	len = strlen (datestr)
+
+	if (idb_findrecord (im, "DATE", rp) == 0) {
+	    # Keyword is not in the UA, created with current time
+	    call fxf_akwc ("DATE",
+		datestr, len, "Date FITS file was generated", n)
+	} else { 
+	    if (acmode == READ_WRITE) {
+		# Keep the old DATE, change only the IRAF-TLM keyword value
+		call imgstr (im, "DATE", datestr, SZ_DATESTR)
+	    }
+	    # See if the keyword is out of order.
+	    if (rp - uap > 12*81) {  
+		call fxf_filter_keyw (im, "DATE")
+
+		call fxf_akwc ("DATE",
+		    datestr, len, "Date FITS file was generated", n)
+	    } else
+	        call impstr (im, "DATE", datestr) 
+	}
+
+	# Encode the "IRAF_TLM" keyword (records time of last modification).
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    FIT_MTIME(fit) = IM_MTIME(im)
+	}
+
+	call fxf_encode_date (FIT_MTIME(fit), datestr, SZ_DATESTR, "TLM", 2010)
+#	call fxf_encode_date (clktime(long(0))+4, datestr, SZ_DATESTR, "TLM", 2010)
+	len = strlen (datestr)
+
+	if (idb_findrecord (im, "IRAF-TLM", rp) == 0) {
+	    call fxf_akwc ("IRAF-TLM",
+		datestr, len, "Time of last modification", n)
+	} else if (rp - uap > 13*81) {  
+	    call fxf_filter_keyw (im, "IRAF-TLM")
+	    call fxf_akwc ("IRAF-TLM",
+		datestr, len, "Time of last modification", n)
+	} else 
+	    call impstr (im, "IRAF-TLM", datestr) 
+
+	# Create DATA(MIN,MAX) keywords only if they have the real 
+	# min and max of the data.
+
+	if (IM_LIMTIME(im) >= IM_MTIME(im)) {
+	    if (idb_findrecord (im, "DATAMIN", rp) == 0) {
+		call fxf_akwr ("DATAMIN",
+		    IM_MIN(im), "Minimum data value", NDEC_REAL, n)
+	    } else
+		call imputr (im, "DATAMIN", IM_MIN(im))
+
+	    if (idb_findrecord (im, "DATAMAX", rp) == 0) {
+		call fxf_akwr ("DATAMAX",
+		    IM_MAX(im), "Maximum data value",NDEC_REAL, n)
+	    } else
+		call imputr (im, "DATAMAX", IM_MAX(im))
+	}
+
+	if (FIT_OBJECT(fit) != EOS) {
+	    if (idb_findrecord (im, "OBJECT", rp) == 0) {
+	        call fxf_akwc ("OBJECT", FIT_OBJECT(fit), 
+		    strlen (FIT_OBJECT(fit)), "Name of the object observed", n)
+	    } else if (rp - uap > 14*81) {  
+	        call fxf_filter_keyw (im, "OBJECT")
+	        call fxf_akwc ("OBJECT", FIT_OBJECT(fit),
+		    strlen (FIT_OBJECT(fit)), "Name of the object observed", n)
+	   } else 
+	        call impstr (im, "OBJECT", FIT_OBJECT(fit))
+	}
+
+	# Write Compression keywords for PLIO BINTABLE.
+#	if (subtype == FK_PLIO && IM_PFD(im) != NULL && ext_append) {
+	if (subtype == FK_PLIO) { 
+	    call fxf_akwb ("ZIMAGE", YES, "Is a compressed image", n)
+	    call fxf_akwc ("ZCMPTYPE", "PLIO_1", 6, "IRAF image masks", n) 
+	    call fxf_akwi ("ZBITPIX", 32, "BITPIX for uncompressed image",n)
+
+	    # We use IM_NDIM and IM_LEN here because FIT_NAXIS and _LENAXIS
+	    # are not available for NEW_IMAGE mode.
+
+	    ndim = IM_NDIM(im)
+	    call fxf_akwi ("ZNAXIS", ndim, "NAXIS for uncompressed image",n)
+	    do i = 1, ndim {
+	        call fxf_encode_axis ("ZNAXIS", keyword, i)
+	        call fxf_akwi (keyword, IM_LEN(im,i),  "Axis length", n)
+	    }
+	    call fxf_encode_axis ("ZTILE", keyword, 1)
+	    call fxf_akwi (keyword, IM_LEN(im,1), "Axis length", n)
+	    do i = 2, ndim {
+		call fxf_encode_axis ("ZTILE", keyword, i)
+		call fxf_akwi (keyword, 1, "Axis length", n)
+	    }
+	    call fxf_encode_axis ("ZNAME", keyword, 1)
+	    call fxf_akwc (keyword, "depth", 5, "PLIO mask depth", n)
+	    call fxf_encode_axis ("ZVAL", keyword, 1)
+	    call fxf_akwi (keyword, depth, "Parameter value", n)
+	}
+
+	# Write the UA now.
+	up = 1
+	nbk = 0
+	n = n - spp 
+	sz_rec = 1440
+	while (fxf_ua_card (fit, im, up, card) == YES) {
+	    call amovc (card, Memc[spp+n], LEN_CARD)
+	    n = n + LEN_CARD
+
+	    if (n == 2880) {
+		nbk = nbk + 1
+		call miipak (Memc[spp], Memi[mii], sz_rec*2, TY_CHAR, MII_BYTE)
+		call write (hdr_fd, Memi[mii], sz_rec)
+		n = 0
+	    }
+	}
+
+	# Write the last record.
+	nblanks = 2880 - n
+	call amovkc (blank, Memc[spp+n], nblanks)
+	rp = spp+n+nblanks-LEN_CARD
+
+	# If there are blocks of trailing blanks, write them now.
+	if (n > 0)
+	    nbk = nbk + 1
+	diff = nchars_ua - nbk * 1440
+	if (diff > 0) {
+	    if (n > 0) {
+		call miipak (Memc[spp], Memi[mii], sz_rec*2, TY_CHAR, MII_BYTE)
+		call write (hdr_fd, Memi[mii], sz_rec)
+	    }
+
+	    if (group < 0) {
+		# We are writing blocks of blanks on a new_copy
+		# image which has group=-1 here. Use diff.
+
+		nbk = diff / 1440
+	    } else {
+		pos = note (hdr_fd)
+		call fxf_not_incache(im)
+		poff = FIT_PIXPTR(fit)
+		nbk = (Memi[poff+group] - pos)
+		nbk = nbk / 1440
+	    }
+	    call amovkc (blank, Memc[spp], 2880)
+	    call miipak (Memc[spp], Memi[mii], sz_rec*2, TY_CHAR, MII_BYTE)
+	    do i = 1, nbk-1
+		call write (hdr_fd, Memi[mii], sz_rec)
+	   
+	    call amovkc (blank, Memc[spp], 2880)
+	    rp = spp+2880-LEN_CARD
+	}
+
+	call amovc ("END", Memc[rp], 3)
+	call miipak (Memc[spp], Memi[mii], sz_rec*2, TY_CHAR, MII_BYTE)
+	call write (hdr_fd, Memi[mii], sz_rec)
+	# PLIO: write the mask data to the new extension.
+	if (subtype == FK_PLIO && IM_PFD(im) != NULL) {
+	    call fxf_plwrite (im, hdr_fd)
+	    IM_PFD(im) = NULL
+	}
+
+	call flush (hdr_fd)
+	call  sfree (sp)
+end
+
+
+# FXF_UA_CARD  -- Fetch a single line from the user area, trim newlines and
+# pad with blanks to size LEN_CARD in order to create an unknown keyword card.
+# At present user area information is assumed to be in the form of FITS card
+# images, less then or equal to 80 characters and delimited by a newline.
+
+int procedure fxf_ua_card (fit, im, up, card)
+
+pointer fit			#I points to the fits descriptor
+pointer	im			#I pointer to the IRAF image
+int	up			#I next character in the unknown string
+char	card[ARB]		#O FITS card image
+
+char	cval
+int	stat, diff
+char	chfetch()
+int	strmatch()
+
+begin
+	if (chfetch (UNKNOWN(im), up, cval) == EOS)
+	    return (NO)
+	else {
+	    up = up - 1
+	    stat = NO
+
+	    while (stat == NO)  {
+	        diff = up
+	        call fxf_make_card (UNKNOWN(im), up, card, 1, LEN_CARD, '\n')
+	        diff = up - diff
+		if (card[1] == EOS)
+		    break
+
+	        if (strmatch (     card, "^GROUPS  ") != 0)
+		    stat = NO
+	        else if (strmatch (card, "^GCOUNT  ") != 0)
+		    stat = NO
+	        else if (strmatch (card, "^PCOUNT  ") != 0)
+		    stat = NO
+	        else if (strmatch (card, "^BLOCKED ") != 0)
+		    stat = NO
+	        else if (strmatch (card, "^PSIZE   ") != 0)
+		    stat = NO
+	        else
+		    stat = YES
+	    }
+
+	    return (stat)
+	}
+end
+
+
+# FXF_SETBITPIX -- Set the FIT_BITPIX to the pixel datatype value.
+
+procedure fxf_setbitpix (im, fit)
+
+pointer	im			#I image descriptor 
+pointer fit			#I fit descriptor
+
+int	datatype
+errchk	syserr, syserrs
+
+begin
+	datatype = IM_PIXTYPE(im)
+
+	switch (datatype) {
+	case TY_SHORT, TY_USHORT:
+	    FIT_BITPIX(fit) = FITS_SHORT
+	case TY_INT, TY_LONG:
+	    FIT_BITPIX(fit) = FITS_LONG
+	case TY_REAL:
+	    FIT_BITPIX(fit) = FITS_REAL
+	case TY_DOUBLE:
+	    FIT_BITPIX(fit) = FITS_DOUBLE
+	default:
+	    call flush (STDOUT)
+	    call syserr (SYS_FXFUPHBTYP)
+	}
+end
+
+
+# FXF_MAKE_ADJ_COPY -- Copy a FITS file into a new one, changing the size
+# of a fits header.
+
+procedure fxf_make_adj_copy (in_fd, out_fd, hdr_off, pixoff, chars_ua)
+
+int	in_fd		#I input FITS descriptor
+int	out_fd		#I output FITS descriptor
+int	hdr_off		#I offset to be beginning of the ua to be resized
+int	pixoff		#I offset to be pixel area following hdroff
+int	chars_ua	#I size of the new UA (user area) in units of chars
+
+pointer	mii, sp
+int	nk, nblocks, junk, size_ua
+errchk  read, write
+int	read()
+
+begin
+	call smark (sp)
+	call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+
+	# Number of 1440 chars block up to the beginning of the UA to change.
+	nblocks = hdr_off / FITS_BLOCK_CHARS
+
+	# Copy  everything up to hdroff.
+	call seek (in_fd, BOF)
+	do nk = 1, nblocks {
+	    junk = read (in_fd, Memi[mii], FITS_BLOCK_CHARS)
+	    call write (out_fd, Memi[mii], FITS_BLOCK_CHARS)
+	}
+
+	# Size of the new UA.
+	size_ua = FITS_LEN_CHAR(chars_ua)
+	nblocks = size_ua / FITS_BLOCK_CHARS
+	
+	# Put a blank new header in the meantime.
+	call amovki( 0, Memi[mii], FITS_BLOCK_CHARS)
+	do nk = 1, nblocks
+	    call write (out_fd, Memi[mii], FITS_BLOCK_CHARS)
+
+	# Position after the current input header to continue 
+	# copying.
+
+	call flush (out_fd)
+	call seek (in_fd, pixoff)
+	call fcopyo (in_fd, out_fd)
+	call flush (out_fd)
+	call sfree (sp)
+end
+
+
+# FXF_SET_CACHE_MTIME -- Procedure to reset the modification time on the
+# cached entry for the file pointed by 'im'.
+
+procedure fxf_set_cache_time (im, overwrite)
+
+pointer im			#I image descriptor
+bool    overwrite		#I invalidate entry if true
+
+pointer sp, hdrfile, fit
+long    fi[LEN_FINFO]
+int	finfo(), cindx
+errchk	syserr, syserrs
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	fit = IM_KDES(im)
+
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	if (finfo (Memc[hdrfile], fi) == ERR)
+	    call syserrs (SYS_FOPEN, IM_HDRFILE(im))
+
+	# Search the header file cache for the named image.
+	do cindx = 1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+	        next
+
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+		# Reset cache
+		if (IM_ACMODE(im) == READ_WRITE || overwrite) {
+		    # Invalidate entry.
+		    call mfree (rf_pextv[cindx], TY_INT)
+		    call mfree (rf_pextn[cindx], TY_CHAR)
+		    call mfree (rf_pixp[cindx], TY_INT)
+		    call mfree (rf_hdrp[cindx], TY_INT)
+		    call mfree (rf_fit[cindx], TY_STRUCT)
+		    call mfree (rf_hdr[cindx], TY_CHAR)
+		    rf_fname[1,cindx] = EOS
+		    rf_mtime[cindx] = 0
+	     	    rf_fit[cindx] = NULL
+
+		} else {
+		    # While we are appending we want to keep the cache entry
+		    # in the slot.
+		    rf_mtime[cindx] = FI_MTIME(fi)
+		}
+		break
+	    }
+	}
+
+	call sfree (sp)
+end	
+
+
+# FXF_SET_EXTNV -- Procedure to write UA value of EXTNAME and EXTVER
+# into the cache slot.
+
+procedure fxf_set_extnv (im)
+
+pointer im			#I image descriptor
+
+pointer fit, sp, hdrfile
+int	cindx, ig, extn, extv
+errchk	syserr, syserrs
+bool    bxtn, bxtv
+bool    streq()
+
+include "fxfcache.com"
+
+begin
+	fit = IM_KDES(im)
+	ig = FIT_GROUP(fit)
+
+	call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	# Search the header file cache for the named image.
+	do cindx = 1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+	        next
+
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+		bxtn = (FIT_EXTNAME(fit) != EOS)
+		bxtv = (!IS_INDEFL (FIT_EXTVER(fit)))
+		# Reset cache
+		if (IM_ACMODE(im) == READ_WRITE) {
+		    if (bxtn) {
+			extn = rf_pextn[cindx]
+		        # Just replace the value
+			call strcpy (FIT_EXTNAME(fit), Memc[extn+LEN_CARD*ig],
+			    LEN_CARD)
+		    }
+		    if (bxtv) {
+			extv = rf_pextv[cindx]
+		        # Just replace the value
+			Memi[extv+ig] = FIT_EXTVER(fit)
+		    }
+		}
+		break
+	    }
+	}
+
+	call sfree (sp)
+end	
+
+
+# FXF_REN_TMP -- Rename input file to output file.
+#
+# The output file may already exists in which case it is replaced.
+# Because this operation is critical it is heavily error checked and
+# has retries to deal with networking cases.
+
+procedure fxf_ren_tmp (in, out, tmp, ntry, nsleep)
+
+char 	in[ARB]			#I file to replace output
+char    out[ARB]		#O output file (replaced if it exists)
+char	tmp[ARB]		#I temporary name for in until rename succeeds
+int	ntry			#I number of retries for rename
+int	nsleep			#I Number of seconds to sleep before retry
+
+int	i, stat, err, access(), protect(), errget()
+bool	replace, prot
+pointer	errstr
+
+errchk	access, protect, rename, delete, salloc
+
+begin
+#call eprintf ("fxf_ren_tmp (%s, %s, %s, %d %d)\n")
+#call pargstr (in)
+#call pargstr (out)
+#call pargstr (tmp)
+#call pargi (ntry)
+#call pargi (nsleep)
+	err = 0; errstr = NULL
+
+	iferr {
+	    # Move original output out of the way.
+	    # Don't delete it in case of an error.
+	    replace = (access (out, 0, 0) == YES)
+	    prot = false
+	    if (replace) {
+	        prot = (protect (out, QUERY_PROTECTION) == YES)
+		if (prot)
+		    stat = protect (out, REMOVE_PROTECTION)
+		do i = 0, max(0,ntry) {
+#call eprintf ("1 rename (%s, %s)\n")
+#call pargstr (out)
+#call pargstr (tmp)
+		    ifnoerr (call rename (out, tmp)) {
+			err = 0
+		        break
+		    }
+		    if (errstr == NULL)
+		        call salloc (errstr, SZ_LINE, TY_CHAR)
+		    err = errget (Memc[errstr], SZ_LINE)
+		    if (err == 0)
+		        err = SYS_FMKCOPY
+		    call tsleep (nsleep)
+		}
+		if (err > 0)
+		    call error (err, Memc[errstr])
+	    }
+
+	    # Now rename the input to the output.
+	    do i = 0, max(0,ntry) {
+#call eprintf ("2 rename (%s, %s)\n")
+#call pargstr (in)
+#call pargstr (out)
+		ifnoerr (call rename (in, out)) {
+		    err = 0
+		    break
+		}
+		if (errstr == NULL)
+		    call salloc (errstr, SZ_LINE, TY_CHAR)
+		err = errget (Memc[errstr], SZ_LINE)
+		if (err == 0)
+		    err = SYS_FMKCOPY
+		call tsleep (nsleep)
+	    }
+	    if (err > 0)
+		call error (err, Memc[errstr])
+	    if (prot)
+		stat = protect (out, SET_PROTECTION)
+
+	    # If the rename has succeeded delete the original data.
+	    if (replace) {
+#call eprintf ("delete (%s)\n")
+#call pargstr (tmp)
+	        call delete (tmp)
+	    }
+	} then
+	    call erract (EA_ERROR)
+end
+
+
+# FXF_OVER_TMP -- Rename an entry from the cache.
+
+procedure fxf_over_delete (im)
+
+pointer im			#I image descriptor
+
+pointer fname, sp
+bool	streq()
+int	cindx
+include "fxfcache.com"
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call fpathname (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME)
+
+        # Remove the image from the FITS cache if found.
+	do cindx=1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+		next
+	    if (streq (Memc[fname], rf_fname[1,cindx])) {
+		call mfree (rf_pextv[cindx], TY_INT)
+		call mfree (rf_pextn[cindx], TY_CHAR)
+		call mfree (rf_pixp[cindx], TY_INT)
+		call mfree (rf_hdrp[cindx], TY_INT)
+		call mfree (rf_fit[cindx], TY_STRUCT)
+		call mfree (rf_hdr[cindx], TY_CHAR)
+		rf_fit[cindx] = NULL
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# FXF_UPDATE_EXTEND -- Add or change the value of the EXTEND keyword in PHU.
+# Sometimes the input PHU has not been created by the FK and the EXTEND keyw
+# might not be there as the standard tells when an extension is appended
+# to a file.
+
+procedure fxf_update_extend (im)
+
+pointer	im			#I image descriptor	
+
+pointer sp, hdrfile, tmp1, tmp2
+int	fd, fdout, i, nch, nc, cfit
+char	line[LEN_CARD], blank, cindx
+bool	streq()
+int	open(), naxis, read(), strncmp(), fnroot()
+long    note()
+errchk	open, fxf_ren_tmp
+
+include "fxfcache.com"
+define	cfit_ 91
+
+begin
+	call smark (sp)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	fd = open (IM_HDRFILE(im), READ_WRITE, BINARY_FILE)
+
+	# Look for EXTEND keyword and change its value in place.
+	nc = 0
+	while (read (fd, line, 40) != EOF) {
+	    nc = nc + 1
+	    call achtbc (line, line, LEN_CARD)
+	    if (strncmp ("EXTEND  ", line, 8) == 0) {
+		line[30] = 'T'
+	        call seek (fd, note(fd)-40)
+		call achtcb (line, line, LEN_CARD)
+		call write (fd, line, 40)
+		call close (fd)
+		goto cfit_
+	    } else if (strncmp ("END     ", line, 8) == 0) 
+		break
+	}
+
+	# The EXTEND card is not in the header. Insert it after the
+	# last NAXISi in a temporary file, rename after this.
+	
+	call salloc (tmp1, SZ_FNAME, TY_CHAR)
+	i = fnroot (IM_HDRFILE(im), Memc[tmp1], SZ_FNAME)
+	call mktemp (Memc[tmp1], Memc[tmp1], SZ_FNAME)
+
+	fdout = open (Memc[tmp1], NEW_FILE, BINARY_FILE)
+
+	call seek (fd, BOF)
+	do i = 0, nc-2 {
+	    nch = read (fd, line, 40)
+	    call write (fdout, line, 40)
+	    call achtbc(line, line, LEN_CARD)
+	    if (strncmp ("NAXIS   ", line, 8) == 0) 
+	        call fxf_geti (line, naxis)
+	    else if (strncmp ("NAXIS", line, 5)  == 0){
+		if ((line[6] - '0') == naxis) {
+		    # Now create the EXTEND card in the output file.
+		    call fxf_encodeb ("EXTEND", YES, line, 
+		        "File may contain extensions")
+		    call achtcb (line, line , LEN_CARD)
+		    call write (fdout, line, 40)
+	        }
+	    }
+	}
+
+	if (mod (nc, 36) == 0) {
+	    # We have to write one END card and 35 blank card.
+	    blank = ' '
+	    call amovkc (blank, line, 80)
+	    call amovc ("END", line, 3)
+	    call achtcb (line, line , LEN_CARD)
+	    call write (fdout, line, 40)
+	    call amovkc (blank, line, 80)
+	    call achtcb (line, line , LEN_CARD)
+	    for (i=1;  i < 36;  i=i+1)
+		call write (fdout, line, 40)
+	} else {
+	    nch = read (fd, line, 40)
+	    call write (fdout, line, 40)
+	}
+
+	# Read one more line to synchronize.
+	nch = read (fd, line, 40)
+
+	# Copy the rest of the file. 
+	call fcopyo (fd, fdout)
+	
+	call close (fd)
+	call close (fdout)
+
+	call salloc (tmp2, SZ_FNAME, TY_CHAR)
+	call strcpy (Memc[tmp1], Memc[tmp2], SZ_FNAME)
+	call strcat ("A", Memc[tmp2], SZ_FNAME)
+	call fxf_ren_tmp (Memc[tmp1], IM_HDRFILE(im), Memc[tmp2], 1, 1)
+
+cfit_
+	# Now reset the value in the cache
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+
+	# Search the header file cache for the named image.
+	do cindx = 1, rf_cachesize {
+	    if (rf_fit[cindx] == NULL)
+	        next
+
+	    if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+		# Reset cache
+		cfit = rf_fit[cindx]
+		FIT_EXTEND(cfit) = YES
+		break
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/fxf/fxfupk.x b/sys/imio/iki/fxf/fxfupk.x
new file mode 100644
index 00000000..b6b158ae
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfupk.x
@@ -0,0 +1,155 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include <mach.h>
+include "fxf.h"
+
+# FXFUPK.X -- Routines to upack an IEEE vector into native format.
+#
+#	fxf_unpack_data (cbuf, npix, pixtype, bscale, bzero)
+#	      fxf_altmr (a, b, npix, bscale, bzero)
+#	      fxf_altmd (a, b, npix, bscale, bzero)
+#	      fxf_altmu (a, b, npix)
+#	      fxf_astmr (a, b, npix, bscale, bzero)
+
+define	NBITS_DOU	(SZB_CHAR * SZ_DOUBLE)
+define	IOFF		1
+
+
+# FITUPK -- Unpack cbuf in place from FITS binary format to local machine type.
+
+procedure fxf_unpack_data (cbuf, npix, pixtype, bscale, bzero)
+
+char	cbuf[ARB]		#U buffer with input,output data
+int	npix			#I number of pixels in buffer
+int	pixtype			#I input pixtype
+double	bscale			#I scale factor to applied to input data
+double	bzero			#I offset to applied to input data
+
+int	nchars, nbytes
+bool	fp_equald()
+errchk	syserr
+
+include <szpixtype.inc>
+
+begin
+        nchars = npix * pix_size[pixtype]
+	nbytes = nchars * SZB_CHAR
+
+	switch (pixtype) {
+	case TY_SHORT, TY_USHORT:
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (cbuf, 1, cbuf, 1, nbytes)
+	    if (pixtype == TY_USHORT)
+		call fxf_altmu (cbuf, cbuf, npix)
+
+	case TY_INT, TY_LONG:
+	    if (BYTE_SWAP4 == YES)
+		call bswap4 (cbuf, 1, cbuf, 1, nbytes)
+
+	case TY_REAL:
+	    ### Rather than perform this test redundantly a flag should be
+	    ### passed in from the high level code telling the routine whether
+	    ### or not it should apply the scaling.  Testing for floating
+	    ### point equality (e.g. bscale != 1.0) is not portable.
+
+	    if (!fp_equald(bscale,1.0d0) || !fp_equald(bzero,0.0d0)) {
+		if (BYTE_SWAP4 == YES)
+		    call bswap4 (cbuf, 1, cbuf, 1, nbytes)
+		call iscl32 (cbuf, cbuf, npix, bscale, bzero)
+	    } else
+		call ieevupkr (cbuf, cbuf, npix)
+	   
+	case TY_DOUBLE:
+	    ### Same as above.
+	    if (!fp_equald(bscale,1.0d0) || !fp_equald(bzero,0.0d0)) {
+		if (BYTE_SWAP4 == YES)
+		    call bswap4 (cbuf, 1, cbuf, 1, nbytes)
+		call iscl64 (cbuf, cbuf, npix, bscale, bzero)
+	    } else
+		call ieevupkd (cbuf, cbuf, npix)
+	   
+	default:
+	    call syserr (SYS_FXFUPKDTY)
+	}
+end
+
+
+# FXF_ALTMR -- Scale a real array.
+
+procedure fxf_altmr (a, b, npix, bscale, bzero)
+
+int	a[ARB]			#I input array
+real	b[ARB]			#O output array
+int	npix			#I number of pixels
+double	bscale, bzero		#I scaling parameters
+
+int	i
+
+begin
+	do i = 1, npix
+	    b[i] = a[i] * bscale + bzero
+end
+			       
+
+# FXF_ALTMD -- Scale a double array.
+
+procedure fxf_altmd (a, b, npix, bscale, bzero)
+
+int	a[ARB]			#I input array
+double	b[ARB]			#O output array
+int	npix			#I number of pixels
+double	bscale, bzero		#I scaling parameters
+
+int	i
+
+begin
+	### int and double are not the same size so if this operation is
+	### to allow an in-place conversion it must go right to left instead
+	### of left to right.
+
+	do i = npix, 1, -1
+	    b[i] = a[i] * bscale + bzero
+end
+
+
+# FXF_ALTMU -- Scale an array to unsigned short.
+
+procedure fxf_altmu (a, b, npix)
+
+short	 a[ARB]			 #I input array
+char	 b[ARB]			 #O output array
+int	 npix			 #I number of pixels
+
+int	i
+pointer sp, ip
+
+begin
+	call smark (sp)
+	call salloc (ip, npix+1, TY_INT)
+		 
+	do i = 1, npix
+	    Memi[ip+i] = a[i] + 32768
+
+	call achtlu (Memi[ip+1], b, npix)
+	call sfree (sp)
+end
+
+
+# FXF_ASTMR -- Scale an input short array into a real.
+
+procedure fxf_astmr (a, b, npix, bscale, bzero)
+
+short	a[ARB]			#I input array
+real	b[ARB]			#O output array
+int	npix			#I number of pixels
+double	bscale, bzero		#I scaling parameters
+
+int	i
+
+begin
+	do i = npix, 1, -1
+	    b[i] = a[i] * bscale + bzero
+end
+			       
+
diff --git a/sys/imio/iki/fxf/mkpkg b/sys/imio/iki/fxf/mkpkg
new file mode 100644
index 00000000..859d6f47
--- /dev/null
+++ b/sys/imio/iki/fxf/mkpkg
@@ -0,0 +1,42 @@
+# Build or update the FITS kernel.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	fxfaccess.x	fxf.h
+	fxfaddpar.x	<imhdr.h> <imio.h> <mach.h> fxf.h
+	fxfclose.x	fxf.h <imhdr.h> <imio.h>
+	fxfcopy.x	<error.h>
+	fxfctype.x	fxf.h <ctype.h>
+	fxfdelete.x	<error.h> <imhdr.h> fxf.h fxfcache.com
+	fxfencode.x	fxf.h <time.h>
+	fxfexpandh.x	fxf.h fxfcache.com <fset.h> <imhdr.h> <imio.h>\
+			<mach.h> <mii.h>
+	fxfget.x	fxf.h <ctype.h>
+	fxfhextn.x	fxf.h <imhdr.h> <imio.h>
+	fxfksection.x	<error.h> fxf.h <ctotok.h> <imhdr.h> <lexnum.h>
+	fxfmkcard.x	
+	fxfnull.x	fxf.h
+	fxfopen.x	fxf.h fxfcache.com <error.h> <imhdr.h> <imio.h>\
+			fxfcache.com <finfo.h> <fset.h> <mach.h> <mii.h>\
+			<pmset.h>
+	fxfopix.x	fxf.h <fset.h> <imhdr.h> <imio.h> <error.h> <mach.h>
+	fxfpak.x	fxf.h <mach.h>
+	fxfplread.x	fxf.h <imhdr.h> <imio.h> <mach.h> <plset.h>
+	fxfplwrite.x	fxf.h <imio.h> <mach.h> <mii.h> <plset.h> <pmset.h>\
+			<imhdr.h>
+	fxfrcard.x	fxf.h <mii.h>
+	fxfrdhdr.x	fxf.h <imhdr.h> <imio.h> <mach.h>
+	fxfrename.x	<error.h> fxf.h fxfcache.com
+	fxfrfits.x	fxf.h fxfcache.com <ctype.h> <finfo.h> <fset.h>\
+			<imhdr.h> <imio.h> <imset.h> <mach.h> <time.h>
+	fxfupdhdr.x	fxf.h <fio.h> <fset.h> <imhdr.h> <imio.h>\
+			fxfcache.com <error.h> <finfo.h> <mach.h> <mii.h>\
+			<time.h>
+	fxfupk.x	fxf.h <mach.h>
+	zfiofxf.x	fxf.h <fio.h> <fset.h> <imhdr.h> <imio.h> <knet.h>\
+			<mach.h>
+	;
diff --git a/sys/imio/iki/fxf/zfiofxf.x b/sys/imio/iki/fxf/zfiofxf.x
new file mode 100644
index 00000000..97b36264
--- /dev/null
+++ b/sys/imio/iki/fxf/zfiofxf.x
@@ -0,0 +1,546 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include <mach.h>
+include <knet.h>
+include <fio.h>
+include <fset.h>
+include <imio.h>
+include <imhdr.h>
+include	"fxf.h"
+
+# ZFIOFXF -- FITS kernel virtual file driver.   This maps the actual
+# FITS file into the virtual pixel file expected by IMIO.
+
+
+# FXFZOP -- Open the file driver for i/o.  The filename has appended the
+# string "_nnnnn", where 'nnnnn' is the FIT descriptor to the structure
+# defined in "fit.h".
+
+procedure fxfzop (pkfn, mode, status)
+
+char	pkfn[ARB]		#I packed virtual filename from FIO
+int	mode			#I file access mode (ignored)
+int	status			#O output status - i/o channel if successful
+
+pointer im, fit
+int	ip, indx, channel, strldx(), ctoi()
+bool	lscale, lzero, bfloat, fxf_fpl_equald()
+char    fname[SZ_PATHNAME]
+
+begin
+	# Separate the FIT descriptor from the file name.
+	call strupk (pkfn, fname, SZ_PATHNAME)
+
+        ip = strldx ("_", fname)
+	indx = ip + 1
+	if (ctoi (fname, indx, fit) <= 0) {
+	   status = ERR
+	   return
+	}
+
+	# Determine if we have a Fits Kernel non supported
+	# data format; i.e. Bitpix -32 or -64 and BSCALE and/or
+	# BZERO with non default values.
+
+	### Only "low level" routines can be falled from a file driver:
+	### high level routines like syserr cannot be used due to
+	### recursion/reentrancy problems.
+	# We are calling syserrs at this level because we want to
+	# give the application the freedom to manipulate the FITS header
+	# at will and not imposing restriction at that level.
+
+	im = FIT_IM(fit)
+	lscale = fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 1)
+	lzero =  fxf_fpl_equald (0.0d0, FIT_BZERO(fit), 1)
+
+	# Determine if scaling is necessary.
+	#bfloat = (!lscale || !lzero)
+	#if (bfloat && (FIT_BITPIX(fit) == -32 || FIT_BITPIX(fit) == -64)) {
+	#    FIT_IOSTAT(fit) = ERR
+	#    #call syserrs (SYS_FXFRDHSC,IM_HDRFILE(im))
+	#    status = ERR
+	#    return
+	#}
+
+	fname[ip] = EOS
+	call strpak (fname, fname, SZ_PATHNAME)
+
+	# Open the file.
+	call zopnbf (fname, mode, channel)
+	if (channel == ERR) {
+	   status = ERR
+	   return
+	}
+
+	status = fit
+	FIT_IO(fit) = channel
+end
+
+
+# FITZCL -- Close the FIT binary file driver.
+
+procedure fxfzcl (chan, status)
+
+int	chan			#I FIT i/o channel
+int	status			#O output status
+
+pointer fit
+
+begin
+	fit = chan
+	call zclsbf (FIT_IO(fit), status)
+end
+
+
+# FXFZRD --  Read the FIT file (header and pixel data).  An offset pointer
+# needs to be set to point to the data portion of the file. If we are reading
+# pixel data, the scale routine fxf_unpack_data is called.  We need to keep
+# a counter (npix_read) with the current number of pixels unpacked since we
+# don't want to convert beyond the total number of pixels; where the last
+# block of data read can contain zeros or garbage up to a count of 2880 bytes.
+
+procedure fxfzrd (chan, obuf, nbytes, boffset)
+
+int	chan			#I FIT i/o channel
+char	obuf[ARB]		#O output buffer
+int	nbytes			#I nbytes to be read
+int	boffset			#I file offset at which read commences
+
+pointer fit, im
+int	ip, pixtype, nb
+int	status, totpix, npix
+int	datasizeb, pixoffb, nb_skipped, i
+double  dtemp
+real    rtemp, rscale, roffset
+
+include <szpixtype.inc>
+
+begin
+	fit = chan
+	im = FIT_IM(fit)
+	FIT_IOSTAT(fit) = OK
+
+	totpix = IM_PHYSLEN(im,1)
+	do i = 2, IM_NPHYSDIM(im)
+	    totpix = totpix * IM_PHYSLEN(im,i)
+
+	if (FIT_ZCNV(fit) == YES) {
+	    if (FIT_PIXTYPE(fit) != TY_REAL && FIT_PIXTYPE(fit) != TY_DOUBLE) {
+	       call fxf_cnvpx (im, totpix, obuf, nbytes, boffset)
+	       return
+	    } 
+	}
+
+	pixtype = IM_PIXTYPE(im)
+	datasizeb = totpix * (pix_size[pixtype] * SZB_CHAR)
+	pixoffb = (FIT_PIXOFF(fit) - 1) * SZB_CHAR + 1
+
+	# We can read the data directly into the caller's output buffer as 
+	# any FITS kernel input conversions are guaranteed to not make the
+	# data smaller.  
+
+	call zardbf (FIT_IO(fit), obuf, nbytes, boffset)
+	call zawtbf (FIT_IO(fit), status)
+	if (status == ERR) {
+	    FIT_IOSTAT(fit) = ERR
+	    return
+	}
+
+	### boffset is 1-indexed, so one would expect (boffset/SZB_CHAR) to
+	### be ((boffset - 1) * SZB_CHAR + 1).  This is off by one from what
+	### is being calculated, so if PIXOFF and boffset point to the same
+	### place IP will be one, which happens to be the correct array index. 
+	### Nonehtless expressions like this should be written out so that
+	### they can be verified easily by reading them.  Any modern compiler
+	### will optimize the expression, we don't have to do this in the
+	### source code.
+
+	ip = FIT_PIXOFF(fit) - boffset/SZB_CHAR
+	if (ip <= 0)
+	    ip = 1
+
+	nb_skipped = boffset - pixoffb
+	if (nb_skipped <= 0)
+	    nb = min (status + nb_skipped, datasizeb)
+	else
+	    nb = min (status, datasizeb - nb_skipped)
+	npix = max (0, nb / (pix_size[pixtype] * SZB_CHAR))
+
+	if (FIT_ZCNV(fit) == YES) {
+	    if (FIT_PIXTYPE(fit) == TY_REAL) {
+		# This is for scaling -32 (should not be allowed)
+		call fxf_zaltrr(obuf[ip], npix, FIT_BSCALE(fit), FIT_BZERO(fit))
+            } else if (FIT_PIXTYPE(fit) == TY_DOUBLE) {
+	        # This is for scaling -64 data (should not be allowed)
+		call fxf_zaltrd(obuf[ip], npix, FIT_BSCALE(fit), FIT_BZERO(fit))
+            }	    
+        } else {
+	   call fxf_unpack_data (obuf[ip],
+	       npix, pixtype, FIT_BSCALE(fit), FIT_BZERO(fit)) 
+        }
+end
+
+procedure fxf_zaltrr (data, npix, bscale, bzero)
+
+real data[ARB], rt
+int    npix
+double bscale, bzero
+
+int i
+
+begin
+	call ieevupkr (data, data, npix)
+        do i = 1, npix {
+	   data[i] = data[i] * bscale + bzero
+        }
+end
+
+
+procedure fxf_zaltrd (data, npix, bscale, bzero)
+
+double data[ARB]
+int    npix
+double bscale, bzero
+
+int i
+
+begin
+	call ieevupkd (data, data, npix)
+        do i = 1, npix
+	   data[i] = data[i] * bscale + bzero
+end
+
+
+ 
+# FXFZWR -- Write to the output file. 
+
+procedure fxfzwr (chan, ibuf, nbytes, boffset)
+
+int	chan			#I QPF i/o channel
+char	ibuf[ARB]		#O data buffer
+int	nbytes			#I nbytes to be written
+int	boffset			#I file offset
+
+pointer fit, im, sp, obuf
+bool	noconvert, lscale, lzero, bfloat
+int	ip, op, pixtype, npix, totpix, nb, nchars, i
+int	datasizeb, pixoffb, nb_skipped, obufsize
+
+bool	fxf_fpl_equald()
+
+include	<szpixtype.inc>
+
+begin
+	fit = chan
+	im = FIT_IM(fit)
+	FIT_IOSTAT(fit) = OK
+
+	# We don't have to pack the data if it is integer and we don't need
+	# to byte swap; the data buffer can be written directly out.
+
+
+	# Determine if we are writing into an scaled floating point data
+	# unit; i.e. bitpix > 0 and BSCALE or/and BZERO with non default
+	# values.  This is an error since we are not supporting this
+	# combination for writing at this time.
+
+	lscale = fxf_fpl_equald (1.0d0, FIT_BSCALE(fit), 1)
+	lzero =  fxf_fpl_equald (0.0d0, FIT_BZERO(fit), 1)
+
+	# Determine if scaling is necessary.
+	bfloat = (!lscale || !lzero)
+	if (bfloat &&
+		(IM_PIXTYPE(im) == TY_REAL || IM_PIXTYPE(im) == TY_DOUBLE)) {
+	    FIT_IOSTAT(fit) = ERR
+	    return
+	}
+
+	pixtype = IM_PIXTYPE(im)
+	noconvert = ((pixtype == TY_SHORT && BYTE_SWAP2 == NO) ||
+	    ((pixtype == TY_INT || pixtype == TY_LONG) && BYTE_SWAP4 == NO))
+
+	if (noconvert) {
+	    call zawrbf (FIT_IO(fit), ibuf, nbytes, boffset)
+	    return
+	}
+
+	# Writing pixel data to an image is currently illegal if on-the-fly
+	# conversion is in effect, as on-the-fly conversion is currently only
+	# available for reading.
+
+	if (FIT_ZCNV(fit) == YES) {
+	    FIT_IOSTAT(fit) = ERR
+	    return
+        }		
+
+	totpix = IM_PHYSLEN(im,1)
+	do i = 2, IM_NPHYSDIM(im)
+	    totpix = totpix * IM_PHYSLEN(im,i)
+
+	datasizeb = totpix * (pix_size[pixtype] * SZB_CHAR)
+	pixoffb = (FIT_PIXOFF(fit) - 1) * SZB_CHAR + 1
+
+	### Same comments as for fxfzrd apply here.
+	### There doesn't appear to be any support here for byte data like
+	### in fxfzwr.  This must mean that byte images are read-only.
+	### This shouldn't be necessary, but we shouldn't try to do anything
+	### about it until the fxf_byte_short issue is addressed.
+
+	ip = FIT_PIXOFF(fit) - boffset / SZB_CHAR
+	if (ip <= 0)
+	    ip = 1
+
+	nb_skipped = boffset - pixoffb
+	if (nb_skipped <= 0)
+	    nb = min (nbytes + nb_skipped, datasizeb)
+	else
+	    nb = min (nbytes, datasizeb - nb_skipped)
+	npix = max (0, nb / (pix_size[pixtype] * SZB_CHAR))
+
+	if (npix == 0) 
+	    return
+
+	# We don't do scaling (e.g. BSCALE/BZERO) when writing.  All the
+	# generated FITS files in this interface are ieee fits standard.
+	### I didn't look into it but I don't understand this; when accessing
+	### a BSCALE image read-write, it should be necessary to scale both
+	### when reading and writing if the application sees TY_REAL pixels.
+	### When writing a new image I suppose the application would take
+	### care of any scaling.
+
+	# Convert any pixel data in the input buffer to the binary format
+	# required for FITS and write it out.  Any non-pixel data in the
+	# buffer should be left as-is.
+
+	obufsize = (nbytes + SZB_CHAR-1) / SZB_CHAR
+
+	call smark (sp)
+	call salloc (obuf, obufsize, TY_CHAR)
+
+	# Preserve any leading non-pixel data.
+	op = 1
+	if (ip > 1) {
+	    nchars = min (obufsize, ip - 1) 
+	    call amovc (ibuf[1], Memc[obuf], nchars)
+	    op = op + nchars
+	}
+
+	# Convert and output the pixels.
+	call fxf_pak_data (ibuf[ip], Memc[obuf+op-1], npix, pixtype)
+	op = op + npix * pix_size[pixtype]
+
+	# Preserve any remaining non-pixel data.
+	nchars = obufsize - op + 1
+	if (nchars > 0)
+	    call amovc (ibuf[op], Memc[obuf+op-1], nchars)
+
+	# Write out the data.
+	call zawrbf (FIT_IO(fit), Memc[obuf], nbytes, boffset)
+
+	call sfree (sp)
+end
+
+
+# FXFZWT -- Return the number of bytes transferred in the last i/o request.
+
+procedure fxfzwt (chan, status)
+
+int	chan			#I QPF i/o channel
+int	status			#O i/o channel status
+
+pointer fit, im
+
+begin
+	fit = chan
+	im = FIT_IM(fit)
+
+	# A file driver returns status for i/o only in the AWAIT routine;
+	# hence any i/o errors occurring in the FK itself are indicated by
+	# setting FIT_IOSTAT.  Otherwise the actual i/o operation must have
+	# been submitted, and we call zawtbf to wait for i/o, and get status.
+
+	if (FIT_IOSTAT(fit) != OK)
+	    status = FIT_IOSTAT(fit)
+	else
+	    call zawtbf (FIT_IO(fit), status)
+
+	# FIT_ZBYTES has the correct number of logical bytes that need
+	# to be passed to fio since we are expanding the buffer size
+	# from byte to short or real and short to real.
+
+	if (status > 0) {
+	    if (FIT_PIXTYPE(fit) == TY_UBYTE)
+		status = FIT_ZBYTES(fit)
+	    else if (FIT_PIXTYPE(fit) == TY_SHORT && IM_PIXTYPE(im) == TY_REAL)
+		status = FIT_ZBYTES(fit)
+	}
+end
+
+
+# FXFZST -- Query device/file parameters.
+
+procedure fxfzst (chan, param, value)
+
+int	chan			#I FIT i/o channel
+int	param			#I parameter to be returned
+int	value			#O parameter value
+
+pointer fit, im
+int	i, totpix, szb_pixel, szb_real
+
+include	<szpixtype.inc>
+
+begin
+	fit = chan
+	im = FIT_IM(fit)
+
+    	totpix = IM_PHYSLEN(im,1)
+	do i = 2, IM_NPHYSDIM(im)
+	    totpix = totpix * IM_PHYSLEN(im,i)
+
+        szb_pixel = pix_size[IM_PIXTYPE(im)] * SZB_CHAR
+	szb_real = SZ_REAL * SZB_CHAR
+
+	call zsttbf (FIT_IO(fit), param, value)
+
+	if (param == FSTT_FILSIZE) {
+	    switch (FIT_PIXTYPE(fit)) {
+	    case TY_SHORT:
+		if (IM_PIXTYPE(im) == TY_REAL) {
+		    value = value + int ((totpix * SZ_SHORT * SZB_CHAR) /
+			2880. + .5) * 2880
+		}
+	    case TY_UBYTE:
+		if (IM_PIXTYPE(im) == TY_SHORT)
+		    value = value + int (totpix/2880. + 0.5)*2880
+	        else if (IM_PIXTYPE(im) == TY_REAL)
+		    value = value + int(totpix*(szb_real-1)/2880. + 0.5) * 2880
+            }
+	}
+end
+
+
+# FXF_CNVPX -- Convert FITS type BITPIX = 8 to SHORT or REAL depending
+# on the value of BSCALE, BZERO (1, 32768 is already iraf supported as ushort
+# and is not treated in here). If BITPIX=16 and BSCALE and BZERO are 
+# non-default then the pixels are converted to REAL.
+
+procedure fxf_cnvpx (im, totpix, obuf, nbytes, boffset)
+
+pointer im			#I Image descriptor
+int	totpix			#I Total number of pixels		
+char    obuf[ARB]		#O Output data buffer
+int	nbytes			#I Size in bytes of the output buffer
+int	boffset			#I Byte offset into the virtual image
+
+pointer sp, buf, fit, op
+double	bscale, bzero
+int	ip, nelem, pfactor
+int	pixtype, nb, buf_size, bzoff, nboff
+int	status, offset, npix
+int	datasizeb, pixoffb, nb_skipped
+
+include	<szpixtype.inc>
+
+begin
+	fit = IM_KDES(im)
+	bscale = FIT_BSCALE(fit)
+	bzero  = FIT_BZERO(fit)
+
+	ip = FIT_PIXOFF(fit) - boffset/SZB_CHAR
+	if (ip <= 0)
+	    ip = 1
+
+	# The beginning of the data portion in bytes.
+	pixoffb = (FIT_PIXOFF(fit)-1) * SZB_CHAR + 1
+	
+	# Determine the factor to applied: size(im_pixtype)/size(fit_pixtype)
+	if (FIT_PIXTYPE(fit) == TY_UBYTE) {
+	    if (IM_PIXTYPE(im) == TY_REAL)
+		pfactor = SZ_REAL * SZB_CHAR
+	    else  					# TY_SHORT
+		pfactor = SZB_CHAR
+	    datasizeb = totpix
+	} else if (FIT_PIXTYPE(fit) == TY_SHORT) {
+	    pfactor = SZ_REAL / SZ_SHORT
+	    pixtype = TY_SHORT
+	    datasizeb = totpix * (pix_size[pixtype] * SZB_CHAR)
+	} else {
+	    FIT_IOSTAT(fit) = ERR
+	    return
+	}
+
+	# We need to map the virtual image of type im_pixtype to the actual
+	# file of type fit_pixtype. 'nbytes' is the number of bytes to read
+	# from the virtual image. To find out how many fit_pixtype bytes 
+	# we need to read from disk we need to subtract the FITS
+	# header size (if boffset is 1) from nbytes and then divide
+	# the resultant value by the convertion factor.
+	# We then add the size of the header if necessary.
+
+	# Determine the offset into the pixel area.
+	nboff = boffset - pixoffb
+	if (nboff > 0) {
+	    nelem = nboff / pfactor
+	    offset = nelem + pixoffb
+	} else  {
+	    # Keep the 1st boffset.
+	    bzoff = boffset
+	    offset = boffset
+	}
+
+	# Calculates the number of elements to convert. We keep the offset from
+	# the beginning of the unit (bzoff) and not from file's 1st byte.
+
+	nelem = nbytes - (pixoffb - bzoff + 1)
+	nelem = nelem / pfactor
+	buf_size = nelem + (pixoffb - bzoff + 1)
+	if (buf_size*pfactor > nbytes && ip == 1)
+	    buf_size = (nbytes - 1) / pfactor + 1 
+
+	# Allocate space for TY_SHORT
+	call smark(sp)
+	call salloc (buf, buf_size/SZB_CHAR, TY_SHORT)
+	    
+	call zardbf (FIT_IO(fit), Mems[buf], buf_size, offset)
+	call zawtbf (FIT_IO(fit), status)
+	if (status == ERR) {
+	    FIT_IOSTAT(fit) = ERR
+	    call sfree (sp)
+	    return
+	}
+	    
+	# Map the number of bytes of datatype FIT_PIXTYPE to 
+	# IM_PIXTYPE for use in zfxfwt().
+	     
+	if (status*pfactor >= nbytes)
+	    FIT_ZBYTES(fit) = nbytes
+	else
+	    FIT_ZBYTES(fit) = status * pfactor
+
+	nb_skipped = offset - pixoffb
+	if (nb_skipped <= 0)
+	    nb = min (status + nb_skipped, datasizeb)
+	else
+	    nb = min (status, datasizeb - nb_skipped)
+
+	switch (FIT_PIXTYPE(fit)) {
+	case TY_UBYTE:
+	    npix = max (0, nb)
+	    if (IM_PIXTYPE(im) == TY_SHORT)
+		call achtbs (Mems[buf+ip-1], obuf[ip], npix)
+	    else {
+		# Scaled from byte to REAL.
+		call achtbl (Mems[buf+ip-1], obuf[ip], npix)
+		call fxf_altmr (obuf[ip], obuf[ip], npix, bscale, bzero)
+	    }
+	case TY_SHORT:
+	    op = buf + ip - 1
+	    npix = max (0, nb / (pix_size[pixtype] * SZB_CHAR))
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (Mems[op], 1, Mems[op], 1, npix*SZB_CHAR)
+	    call fxf_astmr (Mems[op], obuf[ip], npix, bscale, bzero)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/iki.com b/sys/imio/iki/iki.com
new file mode 100644
index 00000000..1c8ef719
--- /dev/null
+++ b/sys/imio/iki/iki.com
@@ -0,0 +1,10 @@
+# IKI.COM -- Image Kernel Interface global common.
+
+int	k_nkernels, k_nextn, k_sbufused, k_defimtype, k_inherit
+int	k_kernel[MAX_IMEXTN], k_extn[MAX_IMEXTN], k_pattern[MAX_IMEXTN]
+int	k_table[LEN_KERNEL,MAX_KERNELS]
+char	k_kname[SZ_KNAME,MAX_KERNELS]
+char	k_sbuf[SZ_IKISBUF]
+
+common	/ikicom/ k_nkernels, k_nextn, k_sbufused, k_defimtype, k_inherit,
+	k_kernel, k_extn, k_pattern, k_table, k_kname, k_sbuf
diff --git a/sys/imio/iki/iki.h b/sys/imio/iki/iki.h
new file mode 100644
index 00000000..be7a6bc0
--- /dev/null
+++ b/sys/imio/iki/iki.h
@@ -0,0 +1,35 @@
+# IKI.H -- Image Kernel Interface global definitions.
+
+define	MAX_KERNELS	10		# max loaded IKI kernels
+define	MAX_LENEXTN	4		# max length header filename extension
+define	MIN_LENEXTN	2		# min length header filename extension
+define	MAX_IMEXTN	64		# max image extension patterns
+define	SZ_IKISBUF	512		# string buffer for IKI common
+define	SZ_KNAME	4		# internal kernel name "oif,fxf,.."
+
+# IMTYPE specifies the default type for new images.
+define	ENV_IMTYPE	"imtype"
+define	DEF_IMTYPE	"oif,noinherit"
+
+# IMEXTN specifies the mapping between image types and file extensions.
+define	ENV_IMEXTN	"imextn"
+define	DEF_IMEXTN	"oif:imh fxf:fits,fit plf:pl qpf:qp stf:hhh,??h"
+
+# The standard test image.
+define	STD_TESTIMAGE	"dev$pix"
+define	DEF_TESTIMAGE	"dev$pix.imh"
+
+define	LEN_KERNEL	9		# length of a kernel entry in k_table
+define	IKI_KNAME	k_kname[1,$1]	# image kernel name
+define	IKI_OPEN	k_table[1,$1]	# open/create image
+define	IKI_CLOSE	k_table[2,$1]	# close image
+define	IKI_OPIX	k_table[3,$1]	# open/create pixel file
+define	IKI_UPDHDR	k_table[4,$1]	# update image header
+define	IKI_ACCESS	k_table[5,$1]	# test existence or legal type
+define	IKI_COPY	k_table[6,$1]	# fast copy of entire image
+define	IKI_DELETE	k_table[7,$1]	# delete image
+define	IKI_RENAME	k_table[8,$1]	# rename image
+define	IKI_FLAGS	k_table[9,$1]	# driver flags
+
+# IKI driver flags.
+define	IKF_NOCREATE	1		# kernel cannot create new images
diff --git a/sys/imio/iki/ikiaccess.x b/sys/imio/iki/ikiaccess.x
new file mode 100644
index 00000000..83736b4f
--- /dev/null
+++ b/sys/imio/iki/ikiaccess.x
@@ -0,0 +1,128 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include "iki.h"
+
+# IKI_ACCESS -- Determine if the named image exists, and if so, return the
+# the index of the IKI kernel to be used to access the image, else return 0 if
+# the named image is not found.  If multiple images exist with the same name
+# (e.g. but with different image types) then ERR is returned.  An NEW_IMAGE
+# access mode may be specified to associate an extension with an image kernel
+# without testing for the existence of an image.  If the input image name did
+# not specify an extension or what appeared to be an extension was just a .
+# delimited field, we will patch up the ROOT and EXTN strings to the real
+# values.
+
+int procedure iki_access (image, root, extn, acmode)
+
+char	image[ARB]		#I image/group name
+char	root[ARB]		#O image/group file name
+char	extn[ARB]		#O image/group file extension
+int	acmode
+
+bool	first_time
+int	i, k, status, op
+pointer	sp, osroot, fname, textn, fextn, ip
+data	first_time /true/
+
+bool	fnullfile()
+int	gstrcpy(), strlen()
+errchk	fpathname, syserrs
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (osroot, SZ_PATHNAME, TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (textn, MAX_LENEXTN, TY_CHAR)
+	call salloc (fextn, MAX_LENEXTN, TY_CHAR)
+
+	# The first call makes sure the IKI kernels are loaded into the kernel
+	# table.
+
+	if (first_time) {
+	    call iki_init()
+	    first_time = false
+	}
+
+	call iki_parse (image, root, extn)
+	if (fnullfile (root)) {
+	    call sfree (sp)
+	    return (1)
+	}
+
+	repeat {
+	    # Convert to absolute pathname to render names like file
+	    # and ./file equivalent.  Add a dummy file extension first
+	    # to cause escape sequence encoding of any .DDDD etc. files
+	    # which may be part of the root image name.
+
+	    op = gstrcpy (root, Memc[fname], SZ_PATHNAME)
+	    call strcpy (".x", Memc[fname+op], SZ_PATHNAME-op+1)
+	    call fpathname (Memc[fname], Memc[osroot], SZ_PATHNAME)
+	    Memc[osroot+strlen(Memc[osroot])-2] = EOS
+
+	    # Escape any $ in the pathname since we are still in VOS land.
+	    op = 1
+	    for (ip=osroot;  Memc[ip] != EOS;  ip=ip+1) {
+		if (Memc[ip] == '$' || Memc[ip] == '[') {
+		    root[op] = '\\'
+		    op = op + 1
+		}
+		root[op] = Memc[ip]
+		op = op + 1
+	    }
+
+	    root[op] = EOS
+
+	    # Select an image kernel by calling the access function in each
+	    # loaded kernel until somebody claims the image.  If multiple
+	    # kernels claim the image the image specification (name) is
+	    # ambiguous and we don't know which image was intended, an error.
+	    # Note that in the case of a new image, the access function
+	    # tests only the legality of the extn.
+
+	    k = 0
+	    for (i=1;  i <= k_nkernels;  i=i+1) {
+		call strcpy (extn, Memc[textn], MAX_LENEXTN)
+		call zcall5 (IKI_ACCESS(i), i,root,Memc[textn],acmode,status)
+
+		if (status == YES) {
+		    if (k == 0) {
+			# Stop on the first access if an explicit extension
+			# was given.
+
+			k = i
+			call strcpy (Memc[textn], Memc[fextn], MAX_LENEXTN)
+			if (extn[1] != EOS)
+			    break
+
+		    } else {
+			# The image name is ambiguous.
+			call sfree (sp)
+			return (ERR)
+		    }
+		}
+	    }
+
+	    # Valid image using kernel K.
+	    if (k != 0) {
+		call strcpy (Memc[fextn], extn, MAX_LENEXTN)
+		call sfree (sp)
+		return (k)
+	    }
+
+	    # If the search failed and an extension was given, maybe what
+	    # we thought was an extension was really just part of the root
+	    # filename.  Try again with the extn folded into the root.
+
+	    if (status == NO && extn[1] != EOS) {
+		call strcpy (image, root, SZ_PATHNAME)
+		extn[1] = EOS
+	    } else
+		break
+	}
+
+	call sfree (sp)
+	return (0)
+end
diff --git a/sys/imio/iki/ikiclose.x b/sys/imio/iki/ikiclose.x
new file mode 100644
index 00000000..e4b2ced9
--- /dev/null
+++ b/sys/imio/iki/ikiclose.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <imhdr.h>
+include <imio.h>
+include "iki.h"
+
+# IKI_CLOSE -- Physically close an image opened under the IKI.  It is not
+# necessary to update the image header or flush any pixel data, as IMIO will
+# already have performed those functions.
+
+procedure iki_close (im)
+
+pointer	im			#I image descriptor
+
+int	status
+include	"iki.com"
+
+begin
+	iferr (call zcall2 (IKI_CLOSE(IM_KERNEL(im)), im, status))
+	    status = ERR
+	if (status == ERR)
+	    call syserrs (SYS_IKICLOSE, IM_NAME(im))
+end
diff --git a/sys/imio/iki/ikicopy.x b/sys/imio/iki/ikicopy.x
new file mode 100644
index 00000000..31df1970
--- /dev/null
+++ b/sys/imio/iki/ikicopy.x
@@ -0,0 +1,62 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"iki.h"
+
+# IKI_COPY -- Fast copy of an entire image or group of images.  This function
+# is provided at the IKI level since the kernel has explicit knowledge of the
+# storage format and hence may be able to copy the image by means much simpler
+# and faster way than those available to the high level software.
+
+procedure iki_copy (old, new)
+
+char	old[ARB]		#I name of old image
+char	new[ARB]		#I name of new image
+
+int	k, n, status
+pointer	sp, old_root, old_extn, new_root, new_extn
+int	iki_access()
+bool	streq()
+errchk	syserrs
+
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (old_root, SZ_PATHNAME, TY_CHAR)
+	call salloc (old_extn, MAX_LENEXTN, TY_CHAR)
+	call salloc (new_root, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_extn, MAX_LENEXTN, TY_CHAR)
+
+	# Verify that the old image exists and determine its type.
+	k = iki_access (old, Memc[old_root], Memc[old_extn], READ_ONLY)
+	if (k < 0)
+	    call syserrs (SYS_IKIAMBIG, old)
+	else if (k == 0)
+	    call syserrs (SYS_IKIIMNF, old)
+
+	# Make sure we will not be clobbering an existing image.  Ignore
+	# attempts to rename an image onto itself.
+
+	n = iki_access (new, Memc[new_root], Memc[new_extn], 0)
+	if (n > 0) {
+	    if (streq (Memc[old_root], Memc[new_root]))
+		if (streq (Memc[old_extn], Memc[new_extn])) {
+		    call sfree (sp)
+		    return
+		}
+	    call syserrs (SYS_IKICLOB, new)
+	} else {
+	    # New name is new root plus legal extn for old image.
+	    call iki_parse (new, Memc[new_root], Memc[new_extn])
+	    call strcpy (Memc[old_extn], Memc[new_extn], MAX_LENEXTN)
+	}
+
+	# Copy the image.
+	call zcall6 (IKI_COPY(k), k, Memc[old_root], Memc[old_extn],
+	    Memc[new_root], Memc[new_extn], status)
+	if (status == ERR)
+	    call syserrs (SYS_IKICOPY, old)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikidelete.x b/sys/imio/iki/ikidelete.x
new file mode 100644
index 00000000..a172980b
--- /dev/null
+++ b/sys/imio/iki/ikidelete.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"iki.h"
+
+# IKI_DELETE -- Delete an image or group of images.
+
+procedure iki_delete (image)
+
+char	image[ARB]		#I name of image
+
+int	k, status
+pointer	sp, root, extn
+int	iki_access()
+bool	fnullfile()
+
+errchk	syserrs
+include	"iki.com"
+
+begin
+	if (fnullfile (image))
+	    return
+
+	call smark (sp)
+	call salloc (root, SZ_PATHNAME, TY_CHAR)
+	call salloc (extn, MAX_LENEXTN, TY_CHAR)
+
+	# Verify that the image exists and determine its type.
+	k = iki_access (image, Memc[root], Memc[extn], 0)
+	if (k < 0)
+	    call syserrs (SYS_IKIAMBIG, image)
+	else if (k == 0)
+	    call syserrs (SYS_IKIIMNF, image)
+
+	# Delete the image.
+	call zcall4 (IKI_DELETE(k), k, Memc[root], Memc[extn], status)
+	if (status == ERR)
+	    call syserrs (SYS_IKIDEL, image)
+	
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikiextn.x b/sys/imio/iki/ikiextn.x
new file mode 100644
index 00000000..a5f2aa12
--- /dev/null
+++ b/sys/imio/iki/ikiextn.x
@@ -0,0 +1,372 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include <imhdr.h>
+include "iki.h"
+
+# IKIEXTN.X -- Image extension handling.  This package is used to map image
+# file extensions to image types and vice versa.
+#
+#	       iki_extninit (imtype, def_imtype, imextn, def_imextn)
+#    status = iki_validextn (kernel, extn)
+#      status = iki_getextn (kernel, index, extn, maxch)
+#        value = iki_getpar (param)
+#
+# iki_extninit initializes the image extension handling package.  This parses
+# the lists of extensions and patterns and builds an internal descriptor which
+# will be used by the other routines for extension handling.  iki_validextn
+# tests whether a given extension is valid for a particular image kernel
+# (type of image).  iki_getextn is used with an index argument to get a list
+# of the extensions for a particular image type.  iki_getpar queries the value
+# of IKI global parameters.
+
+define	SZ_IMTYPE	128
+define	SZ_IMEXTN	1024
+
+
+# IKI_EXTNINIT -- Initialize the image extension handling package.  This is
+# typically done once when IKI is first initialized.  Changes to the image
+# typing environment made subsequently have no effect unless the package is
+# reinitialized.
+
+int procedure iki_extninit (env_imtype, def_imtype, env_imextn, def_imextn)
+
+char	env_imtype[ARB]			#I imtype environment variable
+char	def_imtype[ARB]			#I default imtype value string
+char	env_imextn[ARB]			#I imextn environment variable
+char	def_imextn[ARB]			#I default imextn value string
+
+int	kset[MAX_KERNELS]
+pointer	sp, ip, ip_save, imtype, imextn, strval
+int	op, delim, status, nchars, i, j, kernel
+int	envfind(), iki_getfield(), gstrcpy(), iki_validextn()
+bool	streq(), envgetb()
+
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (imtype, SZ_IMTYPE, TY_CHAR)
+	call salloc (imextn, SZ_IMEXTN, TY_CHAR)
+	call salloc (strval, SZ_FNAME, TY_CHAR)
+
+	status = OK
+
+	# Get the imtype string.  The value of the env_imtype variable is used
+	# if the variable is found, otherwise the default is used.
+
+	Memc[imtype] = EOS
+	if (env_imtype[1] != EOS)
+	    if (envfind (env_imtype, Memc[imtype], SZ_IMTYPE) <= 0)
+		Memc[imtype] = EOS
+	if (Memc[imtype] == EOS)
+	    call strcpy (def_imtype, Memc[imtype], SZ_IMTYPE)
+
+	# Get the imextn string.  The value of the env_imextn variable is used
+	# if the variable is found, otherwise the default is used.
+
+	Memc[imextn] = EOS
+	if (env_imextn[1] != EOS)
+	    if (envfind (env_imextn, Memc[imextn], SZ_IMEXTN) <= 0)
+		Memc[imextn] = EOS
+	if (Memc[imextn] == EOS)
+	    call strcpy (def_imextn, Memc[imextn], SZ_IMEXTN)
+
+	# Process imextn.  This specifies the set of valid extensions for
+	# each image type.  This must be done before processing imtype below,
+	# since iki_validextn can be used when processing imtype.  The imextn
+	# string is of the form "<kernel>:<extn>[,<extn>...] ..." where 
+	# <kernel> is the IKI kernel name (k_kname) and <extn> is a regular
+	# expression to be used to test for a matching file extension.
+	# For example, imextn = "oif:imh stf:hhh,??h fits:,fits,fit".
+
+	k_nextn = 0
+	k_sbufused = 0
+	call aclri (kset, MAX_KERNELS)
+
+	# Process the user extension string first followed by the builtin
+	# defaults.  Anything given in the user string takes precedence
+	# while anything omitted uses the builtin defaults instead (if there
+	# is no user imextn this processes the default string twice).
+
+	do i = 1, 2 {
+	    if (i > 1)
+		call strcpy (def_imextn, Memc[imextn], SZ_IMEXTN)
+
+	    ip = imextn
+	    while (Memc[ip] != EOS && IS_WHITE(Memc[ip]))
+		ip = ip + 1
+
+	    repeat {
+		# Get the kernel name.
+		if (iki_getfield (ip, Memc[strval], SZ_FNAME, delim) <= 0)
+		    break
+		call strlwr (Memc[strval])
+		if (delim != ':') {
+		    status = ERR
+		    break
+		}
+
+		# Lookup kernel.
+		kernel = 0
+		do j = 1, k_nkernels {
+		    if (streq (Memc[strval], k_kname[1,j])) {
+			kernel = j
+			break
+		    }
+		}
+		if (kernel <= 0) {
+		    status = ERR
+		    break
+		}
+
+		# Process the list of extension patterns.
+		op = k_sbufused + 1
+		ip_save = ip
+
+		while (iki_getfield (ip, Memc[strval], SZ_FNAME, delim) > 0) {
+		    # call strlwr (Memc[strval])
+
+		    # Skip it if we already have something for this kernel.
+		    if (kset[kernel] == 0) {
+			# Get a new extension descriptor.
+			if (k_nextn >= MAX_IMEXTN) {
+			    status = ERR
+			    break
+			} else
+			    k_nextn = k_nextn + 1
+
+			# Save the kernel index associated with this extension.
+			k_kernel[k_nextn] = kernel
+
+			# Save the extension string.
+			k_extn[k_nextn] = op
+			nchars = gstrcpy(Memc[strval],k_sbuf[op],SZ_IKISBUF-op)
+			op = op + nchars + 1
+
+			# Save the strmatch pattern for the extension.
+			k_pattern[k_nextn] = op
+			k_sbuf[op] = '^';  op = op + 1
+			nchars = gstrcpy(Memc[strval],k_sbuf[op],SZ_IKISBUF-op)
+			op = op + nchars + 1
+		    }
+
+		    ip_save = ip
+		    if (delim != ',')
+			break
+		}
+
+		kset[kernel] = 1
+		k_sbufused = op - 1
+
+	    } until (Memc[ip] == EOS)
+	}
+
+	# Process imtype.  This sets the default image type for new images.
+	# For example, imtype = "oif,inherit" would create OIF (.imh) images
+	# by default, inheriting the old image type if a newcopy image is
+	# being written.
+
+	k_defimtype = 1
+	k_inherit = NO
+	ip = imtype
+	kernel = 0
+
+	while (iki_getfield (ip, Memc[strval], SZ_FNAME, delim) > 0) {
+	    call strlwr (Memc[strval])
+
+	    # Check for the inherit/noinherit keywords.
+	    if (streq (Memc[strval], "inherit")) {
+		k_inherit = YES
+		next
+	    }
+	    if (streq (Memc[strval], "noinherit")) {
+		k_inherit = NO
+		next
+	    }
+
+	    # Scan the kernels to see if we have a kernel name.
+	    if (kernel <= 0)
+		do i = 1, k_nkernels
+		    if (streq (Memc[strval], k_kname[1,i])) {
+			kernel = i
+			break
+		    }
+
+	    # Check for a valid imagefile extension.
+	    if (kernel <= 0)
+		kernel = iki_validextn (0, Memc[strval])
+	}
+
+	if (kernel <= 0)
+	    status = ERR
+	else
+	    k_defimtype = kernel
+
+	if (envgetb ("ikidebug"))
+	    call iki_debug ("IKI debug:", STDERR, 0)
+
+	call sfree (sp)
+	return (status)
+end
+
+
+# IKI_VALIDEXTN -- Determine if the given imagefile extension is valid for
+# the given image kernel (image type).  If kernel=0 the extensions for all
+# kernels are examined.  If a valid match is found the kernel index is
+# returned as the function value, otherwise 0 is returned.
+
+int procedure iki_validextn (kernel, extn)
+
+int	kernel				#I kernel index, zero for all kernels
+char	extn[ARB]			#I extension to be tested
+
+int	i, ip
+int	strmatch()
+include	"iki.com"
+
+begin
+	do i = 1, k_nextn
+	    if (kernel == 0 || k_kernel[i] == kernel) {
+		ip = strmatch (extn, k_sbuf[k_pattern[i]])
+		if (ip > 0 && extn[ip] == EOS)
+		    return (k_kernel[i])
+	    }
+
+	return (0)
+end
+
+
+# IKI_GETEXTN -- Get an entry from the list of valid extensions (actually
+# extension patterns) for the given image kernel.  If kernel=0 all entries
+# are returned.  The kernel index for the output extension is returned as
+# the function value.  ERR is returned if the requested extension does not
+# exist.
+
+int procedure iki_getextn (kernel, index, extn, maxch)
+
+int	kernel				#I kernel index, zero for all kernels
+int	index				#I extension number (1 indexed)
+char	extn[ARB]			#O extension
+int	maxch				#I max chars out
+
+int	i, n
+include	"iki.com"
+
+begin
+	n = 0
+	do i = 1, k_nextn
+	    if (kernel == 0 || k_kernel[i] == kernel) {
+		n = n + 1
+		if (index == n) {
+		    call strcpy (k_sbuf[k_extn[i]], extn, maxch)
+		    return (k_kernel[i])
+		}
+	    }
+
+	return (ERR)
+end
+
+
+# IKI_GETPAR -- Return the value of an IKI global parameter (integer valued).
+
+int procedure iki_getpar (param)
+
+char	param[ARB]			#I parameter name
+
+bool	streq()
+include	"iki.com"
+
+begin
+	if (streq (param, "inherit"))
+	    return (k_inherit)
+	else if (streq (param, "defimtype"))
+	    return (k_defimtype)
+end
+
+
+# IKI_GETFIELD -- Get the next field from a punctuation or whitespace
+# delimited list.  The length of the field is returned as the function value.
+# EOF is returned at the end of the list.  Zero can be returned if a field
+# is zero length, e.g. in "foo,,foo" the second field is zero length.
+
+int procedure iki_getfield (ip, outstr, maxch, delim)
+
+pointer	ip				#U string pointer
+char	outstr[ARB]			#O receives string
+int	maxch				#I max chars out
+int	delim				#O delimiter char
+
+int	op, ch
+
+begin
+	# Skip any leading whitespace.
+	while (Memc[ip] != EOS && IS_WHITE(Memc[ip]))
+	    ip = ip + 1
+
+	# Check for end of list.
+	if (Memc[ip] == EOS || Memc[ip] == '\n')
+	    return (EOF)
+
+	op = 1
+	for (ch=Memc[ip];  ch != EOS && !IS_WHITE(ch);  ch=Memc[ip]) {
+	    if (ch == ',' || ch == ':' || ch == ';')
+		break
+	    else {
+		outstr[op] = ch
+		op = op + 1
+	    }
+	    ip = ip + 1
+	}
+
+	delim = ch
+	if (delim != EOS)
+	    ip = ip + 1
+
+	outstr[op] = EOS
+	return (op - 1)
+end
+
+
+# IKI_DEBUG -- Print debug information on the IKI internal data structures.
+
+procedure iki_debug (str, fd, flags)
+
+char	str[ARB]			#I title string
+int	fd				#I output file
+int	flags				#I (not used)
+
+int	i
+include	"iki.com"
+
+begin
+	# Print global variables.
+	call fprintf (fd, "%s nkernels=%d sbufused=%d deftype=%d ")
+	    call pargstr (str)
+	    call pargi (k_nkernels)
+	    call pargi (k_sbufused)
+	    call pargi (k_defimtype)
+	call fprintf (fd, "inherit=%d nextn=%d\n")
+	    call pargi (k_inherit)
+	    call pargi (k_nextn)
+
+	# List the installed kernels.
+	call fprintf (fd, "installed kernels ")
+	do i = 1, k_nkernels {
+	    call fprintf (fd, "%s=%d ")
+		call pargstr (k_kname[1,i])
+		call pargi (i)
+	}
+	call fprintf (fd, "\n")
+	
+	# Print the extension table.
+	do i = 1, k_nextn {
+	    call fprintf (fd, "%6s %d (%s) %s\n")
+		call pargstr (k_sbuf[k_extn[i]])
+		call pargi (k_kernel[i])
+		call pargstr (k_kname[1,k_kernel[i]])
+		call pargstr (k_sbuf[k_pattern[i]])
+	}
+
+	call flush (fd)
+end
diff --git a/sys/imio/iki/ikiinit.x b/sys/imio/iki/ikiinit.x
new file mode 100644
index 00000000..41de76b6
--- /dev/null
+++ b/sys/imio/iki/ikiinit.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"iki.h"
+
+# IKI_INIT -- Initialize the IKI kernel table, i.e., load all the standard
+# kernels into the table.  Additional kernels may be dynamically added at
+# run time for special applications.
+
+procedure iki_init()
+
+extern	oif_open(), oif_close(), oif_opix(), oif_updhdr(),
+	oif_access(), oif_copy(), oif_delete(), oif_rename()
+extern	fxf_open(), fxf_close(), fxf_opix(), fxf_updhdr(),
+	fxf_access(), fxf_copy(), fxf_delete(), fxf_rename()
+extern	plf_open(), plf_close(), plf_null(), plf_updhdr(),
+	plf_access(), plf_copy(), plf_delete(), plf_rename()
+extern	qpf_open(), qpf_close(), qpf_opix(), qpf_updhdr(),
+	qpf_access(), qpf_copy(), qpf_delete(), qpf_rename()
+extern	stf_open(), stf_close(), stf_opix(), stf_updhdr(),
+	stf_access(), stf_copy(), stf_delete(), stf_rname()
+
+bool	first_time
+data	first_time /true/
+int	iki_extninit()
+include	"iki.com"
+
+begin
+	if (!first_time)
+	    return
+
+	k_nkernels = 0
+
+	# Load the original IRAF format (OIF) kernel.
+	call iki_lddriver ("oif", oif_open, oif_close, oif_opix, oif_updhdr,
+	    oif_access, oif_copy, oif_delete, oif_rename, 0)
+
+	# Load the FITS image kernel (FXF).
+	call iki_lddriver ("fxf", fxf_open, fxf_close, fxf_opix, fxf_updhdr,
+	    fxf_access, fxf_copy, fxf_delete, fxf_rename, 0)
+
+	# Load the PLIO mask image mini-kernel (PLF - not a full kernel).
+	call iki_lddriver ("plf", plf_open, plf_close, plf_null, plf_updhdr,
+	    plf_access, plf_copy, plf_delete, plf_rename, 0)
+
+	# Load the QPOE photon image kernel (QPF).
+	call iki_lddriver ("qpf", qpf_open, qpf_close, qpf_opix, qpf_updhdr,
+	    qpf_access, qpf_copy, qpf_delete, qpf_rename, IKF_NOCREATE)
+
+	# Load the SDAS GEIS format (STF) kernel.
+	call iki_lddriver ("stf", stf_open, stf_close, stf_opix, stf_updhdr,
+	    stf_access, stf_copy, stf_delete, stf_rname, 0)
+
+	# Initialize the extension-based image typing mechanism.
+	if (iki_extninit (ENV_IMTYPE, DEF_IMTYPE, ENV_IMEXTN, DEF_IMEXTN) < 0)
+	    ;
+
+	first_time = false
+end
diff --git a/sys/imio/iki/ikildd.x b/sys/imio/iki/ikildd.x
new file mode 100644
index 00000000..256e7e70
--- /dev/null
+++ b/sys/imio/iki/ikildd.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"iki.h"
+
+# IKI_LDDRIVER -- Load an IKI kernel into the kernel table, i.e., make a new
+# kernel entry in the table containing the entry point address of each of the
+# kernel procedures.
+
+procedure iki_lddriver (kname, ex_open, ex_close, ex_opix, ex_updhdr,
+	ex_access, ex_copy, ex_delete, ex_rename, flags)
+
+char	kname[ARB]
+extern	ex_open(), ex_close(), ex_opix(), ex_updhdr()
+extern	ex_access(), ex_copy(), ex_delete(), ex_rename()
+int	locpr()
+int	flags
+
+include	"iki.com"
+errchk	syserr
+
+begin
+	if (k_nkernels + 1 > MAX_KERNELS)
+	    call syserr (SYS_IKIKTBLOVFL)
+	else
+	    k_nkernels = k_nkernels + 1
+	    
+	call strcpy (kname, IKI_KNAME(k_nkernels), SZ_KNAME)
+	IKI_OPEN(k_nkernels)	= locpr (ex_open)
+	IKI_CLOSE(k_nkernels)	= locpr (ex_close)
+	IKI_OPIX(k_nkernels)	= locpr (ex_opix)
+	IKI_UPDHDR(k_nkernels)	= locpr (ex_updhdr)
+	IKI_ACCESS(k_nkernels)	= locpr (ex_access)
+	IKI_COPY(k_nkernels)	= locpr (ex_copy)
+	IKI_DELETE(k_nkernels)	= locpr (ex_delete)
+	IKI_RENAME(k_nkernels)	= locpr (ex_rename)
+	IKI_FLAGS(k_nkernels)	= flags
+end
diff --git a/sys/imio/iki/ikimkfn.x b/sys/imio/iki/ikimkfn.x
new file mode 100644
index 00000000..a224f728
--- /dev/null
+++ b/sys/imio/iki/ikimkfn.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"iki.h"
+
+# IKI_MKFNAME -- Manufacture a filename from the root and extension fields
+# given.
+
+procedure iki_mkfname (root, extn, fname, maxch)
+
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I filename extension
+char	fname[maxch]		#O output filename
+int	maxch			#I max chars out
+
+int	op
+int	gstrcpy()
+bool	fnullfile()
+
+begin
+	op = gstrcpy (root, fname, maxch) + 1
+	if (extn[1] != EOS && !fnullfile (root)) {
+	    fname[op] = '.'
+	    op = op + 1
+	    call strcpy (extn, fname[op], maxch-op+1)
+	}
+end
diff --git a/sys/imio/iki/ikiopen.x b/sys/imio/iki/ikiopen.x
new file mode 100644
index 00000000..f60a672d
--- /dev/null
+++ b/sys/imio/iki/ikiopen.x
@@ -0,0 +1,153 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <imhdr.h>
+include <imio.h>
+include "iki.h"
+
+# IKI_OPEN -- Open or create an image.  If opening an existing image, determine
+# the type of image and open it with the corresponding kernel.  If creating a
+# new image, the value of the environment variable IMTYPE determines the type
+# of image to be created, i.e., the kernel to be used to open the image.  If
+# opening a new copy image, create an image of the same type as the existing
+# image.
+
+procedure iki_open (n_im, image, ksection, cl_index, cl_size, acmode, o_im)
+
+pointer	n_im			#I descriptor of new image (to be filled in)
+char	image[ARB]		#I name of image or cl_index to be opened
+char	ksection[ARB]		#I information to be passed on to kernel
+int	cl_index		#I index of image within cl_index
+int	cl_size			#I number of images in cl_index
+int	acmode			#I access mode
+pointer	o_im			#I existing image descriptor, if new_copy
+
+bool	inherit
+pointer	sp, root, extn, textn, fextn
+int	status, clmode, i, k
+errchk	syserrs, zcalla
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (root, SZ_PATHNAME, TY_CHAR)
+	call salloc (extn, MAX_LENEXTN, TY_CHAR)
+	call salloc (textn, MAX_LENEXTN, TY_CHAR)
+	call salloc (fextn, MAX_LENEXTN, TY_CHAR)
+
+	# Compute the access mode for the ACCESS test, below.  If opening an
+	# existing image, all we want to do here is test for the existence of
+	# the image.  If opening a new image, use new image mode.
+
+	if ((acmode == NEW_IMAGE || acmode == NEW_COPY))
+	    clmode = NEW_IMAGE
+	else
+	    clmode = 0
+
+	# Parse the image name into the root and extn fields.
+	call iki_parse (image, Memc[root], Memc[extn])
+
+	# If we are opening a new image and an explicit extension is given
+	# this determines the type of image to be created.  Otherwise if we
+	# are opening a new copy image and type inheritance is enabled, the
+	# new image will be the same type as the old one.  Otherwise (new
+	# image, type not specified or inherited) the default image type 
+	# specified by the IMTYPE mechanism is used.  If opening an existing
+	# image the access method of each image kernel is called until a
+	# kernel recognizes the image.
+
+	repeat {
+	    # Is type inheritance permitted?
+	    inherit = (k_inherit == YES)
+	    if (inherit && acmode == NEW_COPY)
+		inherit = (and (IKI_FLAGS(IM_KERNEL(o_im)), IKF_NOCREATE) == 0)
+
+	    # Select the kernel to be used.
+	    if (acmode == NEW_COPY && Memc[extn] == EOS && inherit) {
+		# Inherit the same type as an existing image.
+		k = IM_KERNEL(o_im)
+		break
+
+	    } else if (clmode == NEW_IMAGE && Memc[extn] == EOS) {
+		# Use the default type for new images.
+		k = k_defimtype
+		break
+
+	    } else {
+		# Select an image kernel by calling the access function in each
+		# loaded kernel until somebody claims the image.  In the case
+		# of a new image, the access function tests only the legality
+		# of the extn.  If no extn is given but the imagefile has an
+		# extension, the access procedure will fill in the extn field.
+
+		k = 0
+		for (i=1;  i <= k_nkernels;  i=i+1) {
+		    call strcpy (Memc[extn], Memc[textn], MAX_LENEXTN)
+		    call zcall5 (IKI_ACCESS(i), i, Memc[root], Memc[textn],
+			clmode, status)
+
+		    if (status == YES) {
+			if (k == 0) {
+			    # Stop on the first match if an explicit extension
+			    # was given.
+
+			    k = i
+			    call strcpy (Memc[textn], Memc[fextn], MAX_LENEXTN)
+			    if (Memc[extn] != EOS)
+				break
+
+			} else if (Memc[extn] == EOS) {
+			    # If no extension was given and we match multiple
+			    # files then we have an ambiguous name and k=ERR.
+
+			    k = ERR
+			    break
+			}
+		    }
+		}
+
+		# Update the selected extn field.
+		if (k > 0)
+		    call strcpy (Memc[fextn], Memc[extn], MAX_LENEXTN)
+
+		# If the search failed and an extension was given, maybe what
+		# we thought was an extension was really just part of the root
+		# filename.  Try again with the extn folded into the root.
+
+		if (k == 0 && Memc[extn] != EOS) {
+		    call strcpy (image, Memc[root], SZ_PATHNAME)
+		    Memc[extn] = EOS
+		} else
+		    break
+	    }
+	}
+
+	# The image name is ambiguous; we don't know which image to open.
+	# This can only happen when opening an existing image and multiple
+	# images exist matching the name given.  It is permissible to create
+	# multiple images with the same name but different types.
+
+	if (k == ERR)
+	    call syserrs (SYS_IKIAMBIG, IM_NAME(n_im))
+
+	# Illegal image type or image does not exist.
+	if (k == 0) {
+	    if (acmode == NEW_IMAGE || acmode == NEW_COPY)
+		call syserrs (SYS_IKIEXTN, IM_NAME(n_im))
+	    else
+		call syserrs (SYS_IKIOPEN, IM_NAME(n_im))
+	}
+
+	# Set the image kernel (format) to be used.
+	IM_KERNEL(n_im) = k
+
+	# Open/create the image.  Save the kernel index in the image header
+	# so that subsequent IKI routines know which kernel to use.
+
+	call zcalla (IKI_OPEN(k), k, n_im, o_im, Memc[root], Memc[extn],
+	    ksection, cl_index, cl_size, acmode, status)
+	if (status == ERR)
+	    call syserrs (SYS_IKIOPEN, IM_NAME(n_im))
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikiopix.x b/sys/imio/iki/ikiopix.x
new file mode 100644
index 00000000..33b3a9bc
--- /dev/null
+++ b/sys/imio/iki/ikiopix.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"iki.h"
+
+# IKI_OPIX -- Open or create the pixel storage file, if any.  We are called by
+# IMIO when i/o is first done to the image.  In the case of a new image, IMIO
+# will already have set up the IM_NDIM and IM_LEN fields of the image header.
+
+procedure iki_opix (im)
+
+pointer	im			#I image descriptor
+int	status
+include	"iki.com"
+
+begin
+	iferr (call zcall2 (IKI_OPIX(IM_KERNEL(im)), im, status))
+	    status = ERR
+	if (status == ERR)
+	    call syserrs (SYS_IKIOPIX, IM_NAME(im))
+end
diff --git a/sys/imio/iki/ikiparse.x b/sys/imio/iki/ikiparse.x
new file mode 100644
index 00000000..3ffb7d6c
--- /dev/null
+++ b/sys/imio/iki/ikiparse.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "iki.h"
+
+# IKI_PARSE -- Parse an image name into the root pathname and filename
+# extension, if any.  Only the known image type extensions are recognized
+# as extensions, hence this routine cannot be used to parse general filenames.
+
+procedure iki_parse (image, root, extn)
+
+char	image[ARB]			#I input image name
+char	root[SZ_PATHNAME]		#U output root pathname
+char	extn[MAX_LENEXTN]		#O output extension
+
+pointer	sp, imname
+int	ip, op, dot
+int	strlen(), iki_validextn()
+bool	streq()
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_PATHNAME, TY_CHAR)
+
+	dot = 0
+	op  = 1
+
+	# The following is a backwards-compatibility kludge.  If the image
+	# name we are given is the canonical standard test image STD_TESTIMAGE
+	# ("dev$pix") replace the name with the fully qualified name
+	# DEF_TESTIMAGE.  This is necessary to avoid ambiguous image name
+	# errors due to pix.imh and pix.hhh being in the same directory; these
+	# are well known names, neither of which can easily be changed.
+
+	if (streq (image, STD_TESTIMAGE))
+	    call strcpy (DEF_TESTIMAGE, Memc[imname], SZ_PATHNAME)
+	else
+	    call strcpy (image, Memc[imname], SZ_PATHNAME)
+
+	# Copy image name to root and mark the position of the last dot.
+	for (ip=1;  Memc[imname+ip-1] != EOS;  ip=ip+1) {
+	    root[op] = Memc[imname+ip-1]
+	    if (root[op] == '.')
+		dot = op
+	    op = op + 1
+	}
+
+	root[op] = EOS
+	extn[1]  = EOS
+
+	# Reject . delimited fields longer than the maximum extension length.
+	if (op - dot - 1 > MAX_LENEXTN)
+	    dot = NULL
+
+	# If found extension, chop the root and fill in the extn field.
+	# If no extension found, we are all done.
+
+	if (dot == NULL) {
+	    call sfree (sp)
+	    return
+	} else {
+	    root[dot] = EOS
+	    call strcpy (root[dot+1], extn, MAX_LENEXTN)
+	}
+
+	# Search the list of legal imagefile extensions.  If the extension
+	# given is not found in the list, tack it back onto the root and
+	# return a null extension.  This is necessary if we are to allow
+	# dot delimited fields within image names without requiring the
+	# user to supply the image type extension.  For example, "im.c"
+	# and "im.c.imh" must refer to the same image - ".c" is part of
+	# the image name, not an image type extension.
+
+	if (strlen(extn) >= MIN_LENEXTN)
+	    if (iki_validextn (0, extn) > 0) {
+		call sfree (sp)
+		return
+	    }
+
+	# Not a legal image header extension.  Restore the extn field to the
+	# root and null the extn.
+
+	root[dot] = '.'
+	extn[1] = EOS
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikirename.x b/sys/imio/iki/ikirename.x
new file mode 100644
index 00000000..cdeff731
--- /dev/null
+++ b/sys/imio/iki/ikirename.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"iki.h"
+
+# IKI_RENAME -- Rename an entire image or group of images.
+
+procedure iki_rename (old, new)
+
+char	old[ARB]		#I old name of image
+char	new[ARB]		#I new name of image
+
+int	k, n, status
+pointer	new_root, new_extn
+pointer	sp, old_root, old_extn
+
+bool	streq()
+int	iki_access()
+errchk	syserrs
+include	"iki.com"
+
+begin
+	call smark (sp)
+	call salloc (old_root, SZ_PATHNAME, TY_CHAR)
+	call salloc (old_extn, MAX_LENEXTN, TY_CHAR)
+	call salloc (new_root, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_extn, MAX_LENEXTN, TY_CHAR)
+
+	# Verify that the old image exists and determine its type.
+	k = iki_access (old, Memc[old_root], Memc[old_extn], 0)
+	if (k < 0)
+	    call syserrs (SYS_IKIAMBIG, old)
+	else if (k == 0)
+	    call syserrs (SYS_IKIIMNF, old)
+
+	# Determine if the old image exists.  New name is new root plus
+	# legal extn for old image.
+
+	n = iki_access (new, Memc[new_root], Memc[new_extn], 0)
+	if (n <= 0)
+	    call iki_parse (new, Memc[new_root], Memc[new_extn])
+
+	# If an extension was given for the new image, verify that it is a
+	# valid extension for an image of the same type as the old image.
+	# We cannot change the image type in a rename operation.
+
+	if (Memc[new_extn] != EOS) {
+	    call zcall5 (IKI_ACCESS(k), k, Memc[new_root], Memc[new_extn],
+		NEW_FILE, status)
+	    if (status == NO)
+		call strcpy (Memc[old_extn], Memc[new_extn], MAX_LENEXTN)
+	} else
+	    call strcpy (Memc[old_extn], Memc[new_extn], MAX_LENEXTN)
+
+	# Make sure we will not be clobbering an existing image.  Renaming
+	# an image onto itself is ok; what it means to do this is up to
+	# the specific image kernel.
+
+	if (n > 0) {
+	    if (streq (Memc[old_root], Memc[new_root]) &&
+		streq (Memc[old_extn], Memc[new_extn]))
+		; # rename x -> x; let kernel decide what to do
+	    else
+		call syserrs (SYS_IKICLOB, new)
+	}
+
+	# Rename the image.
+	call zcall6 (IKI_RENAME(k), k, Memc[old_root], Memc[old_extn],
+	    Memc[new_root], Memc[new_extn], status)
+	if (status == ERR)
+	    call syserrs (SYS_IKIRENAME, old)
+	
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/ikiupdhdr.x b/sys/imio/iki/ikiupdhdr.x
new file mode 100644
index 00000000..f7ad22b8
--- /dev/null
+++ b/sys/imio/iki/ikiupdhdr.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <imhdr.h>
+include	<imio.h>
+include "iki.h"
+
+# IKI_UPDHDR -- Update the image header.
+
+procedure iki_updhdr (im)
+
+pointer	im			#I image descriptor
+
+int	status
+include	"iki.com"
+
+begin
+	iferr (call zcall2 (IKI_UPDHDR(IM_KERNEL(im)), im, status))
+	    status = ERR
+	if (status == ERR)
+	    call syserrs (SYS_IKIUPDHDR, IM_NAME(im))
+end
diff --git a/sys/imio/iki/mkpkg b/sys/imio/iki/mkpkg
new file mode 100644
index 00000000..cd8663e9
--- /dev/null
+++ b/sys/imio/iki/mkpkg
@@ -0,0 +1,28 @@
+# Make the Image Kernel Interface.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	@oif		# Original IRAF format
+	@fxf		# FITS extension format
+	@plf		# PLIO mask image mini-kernel (partial)
+	@qpf		# QPOE photon image kernel
+	@stf		# ST SDAS/GEIS format
+
+	ikiaccess.x	iki.com iki.h <imhdr.h>
+	ikiclose.x	iki.com iki.h <imhdr.h> <imio.h>
+	ikicopy.x	iki.com iki.h
+	ikidelete.x	iki.com iki.h
+	ikiextn.x	iki.com iki.h <ctype.h> <imhdr.h>
+	ikiinit.x	iki.com iki.h
+	ikildd.x	iki.com iki.h
+	ikimkfn.x	iki.h
+	ikiopen.x	iki.com iki.h <imhdr.h> <imio.h>
+	ikiopix.x	iki.com iki.h <imhdr.h> <imio.h>
+	ikiparse.x	iki.h
+	ikirename.x	iki.com iki.h
+	ikiupdhdr.x	iki.com <imio.h> iki.h <imhdr.h>
+	;
diff --git a/sys/imio/iki/oif/README b/sys/imio/iki/oif/README
new file mode 100644
index 00000000..01e30678
--- /dev/null
+++ b/sys/imio/iki/oif/README
@@ -0,0 +1 @@
+IKI/OIF -- IKI kernel for the old (original) IRAF image format.
diff --git a/sys/imio/iki/oif/imhv1.h b/sys/imio/iki/oif/imhv1.h
new file mode 100644
index 00000000..a9a37874
--- /dev/null
+++ b/sys/imio/iki/oif/imhv1.h
@@ -0,0 +1,75 @@
+# IMHV1.H -- Version 1 of the OIF binary file header (April 1988).
+
+define	V1_MAGIC	"imhdr"			# file identification tag
+define	V1_PMAGIC	"impix"			# file identification tag
+define	V1_VERSION	1			# header version number
+
+define	SZ_V1IMPIXFILE	79			# name of pixel storage file
+define	SZ_V1IMHDRFILE	79			# name of header storage file
+define	SZ_V1IMTITLE	79			# image title string
+define	SZ_V1IMHIST	511			# image history record
+define	SZ_V1BUNIT	9			# brightness units string
+define	SZ_V1CTYPE	9			# coord axes units string
+
+# The IMIO image header structure.
+
+# Parameters.
+define	LEN_V1IMHDR	513			# length of std header
+define	LEN_V1PIXHDR	183			# length of pixel file header
+define	V1U		LEN_V1IMHDR		# offset to user fields
+define	IM_V1USERAREA	(P2C($1+V1U))		# user area (database)
+
+# Disk resident header.
+define	IM_V1MAGIC	Memi[$1]		# contains the string "imhdr"
+define	IM_V1HDRLEN	Memi[$1+3]		# length of image header
+define	IM_V1PIXTYPE	Memi[$1+4]		# datatype of the pixels
+define	IM_V1NDIM	Memi[$1+5]		# number of dimensions
+define	IM_V1LEN	Meml[$1+$2+6-1]		# length of the dimensions
+define	IM_V1PHYSLEN	Meml[$1+$2+13-1]	# physical length (as stored)
+define	IM_V1SSMTYPE	Meml[$1+20]		# type of subscript mapping
+define	IM_V1LUTOFF	Meml[$1+21]		# offset to subscript map luts
+define	IM_V1PIXOFF	Meml[$1+22]		# offset of the pixels
+define	IM_V1HGMOFF	Meml[$1+23]		# offset of hgm pixels
+define	IM_V1BLIST	Meml[$1+24]		# offset of bad pixel list
+define	IM_V1SZBLIST	Meml[$1+25]		# size of bad pixel list
+define	IM_V1NBPIX	Meml[$1+26]		# number of bad pixels
+define	IM_V1CTIME	Meml[$1+27]		# time of image creation
+define	IM_V1MTIME	Meml[$1+28]		# time of last modify
+define	IM_V1LIMTIME	Meml[$1+29]		# time min,max computed
+define	IM_V1MAX	Memr[P2R($1+30)]	# max pixel value
+define	IM_V1MIN	Memr[P2R($1+31)]	# min pixel value
+define	IM_V1HGM	($1+33)			# histogram descriptor
+define	IM_V1CTRAN	($1+52)			# coordinate transformations
+define	IM_V1PIXFILE	Memc[P2C($1+103)]	# name of pixel storage file
+define	IM_V1HDRFILE	Memc[P2C($1+143)]	# name of header storage file
+define	IM_V1TITLE	Memc[P2C($1+183)]	# image name string
+define	IM_V1HISTORY	Memc[P2C($1+223)]	# history comment string
+
+# The Histogram structure (field IM_HGM)
+define	LEN_HGMSTRUCT	20
+define	HGM_TIME	Meml[$1]		# time when hgm was computed
+define	HGM_LEN		Meml[$1+1]		# number of bins in hgm
+define	HGM_NPIX	Meml[$1+2]		# npix used to compute hgm
+define	HGM_MIN		Memr[P2R($1+3)]		# min hgm value
+define	HGM_MAX		Memr[P2R($1+4)]		# max hgm value
+define	HGM_INTEGRAL	Memr[P2R($1+5)]		# integral of hgm
+define	HGM_MEAN	Memr[P2R($1+6)]		# mean value
+define	HGM_VARIANCE	Memr[P2R($1+7)]		# variance about mean
+define	HGM_SKEWNESS	Memr[P2R($1+8)]		# skewness of hgm
+define	HGM_MODE	Memr[P2R($1+9)]		# modal value of hgm
+define	HGM_LCUT	Memr[P2R($1+10)]	# low cutoff value
+define	HGM_HCUT	Memr[P2R($1+11)]	# high cutoff value
+# next available field: ($1+12)
+
+# The Coordinate Transformation Structure (IM_CTRAN)
+define	LEN_CTSTRUCT	50
+define	CT_VALID	Memi[$1]		# (y/n) is structure valid?
+define	CT_BSCALE	Memr[P2R($1+1)]		# pixval scale factor
+define	CT_BZERO	Memr[P2R($1+2)]		# pixval offset
+define	CT_CRVAL	Memr[P2R($1+$2+3-1)]	# value at pixel
+define	CT_CRPIX	Memr[P2R($1+$2+10-1)]	# index of pixel
+define	CT_CDELT	Memr[P2R($1+$2+17-1)]	# increment along axis
+define	CT_CROTA	Memr[P2R($1+$2+24-1)]	# rotation angle
+define	CT_BUNIT	Memc[P2C($1+31)]	# pixval ("brightness") units
+define	CT_CTYPE	Memc[P2C($1+36)]	# coord units string
+# next available field: ($1+41)
diff --git a/sys/imio/iki/oif/imhv2.h b/sys/imio/iki/oif/imhv2.h
new file mode 100644
index 00000000..d7eaa1f7
--- /dev/null
+++ b/sys/imio/iki/oif/imhv2.h
@@ -0,0 +1,43 @@
+# IMHV2.H -- Version 2 of the OIF binary file header (March 1997).
+
+define	V2_MAGIC	"imhv2"			# file identification tag
+define	V2_PMAGIC	"impv2"			# file identification tag
+define	V2_VERSION	2			# header version
+
+define	SZ_V2IMPIXFILE	255			# name of pixel storage file
+define	SZ_V2IMHDRFILE	255			# name of header storage file
+define	SZ_V2IMTITLE	383			# image title string
+define	SZ_V2IMHIST	1023			# image history record
+
+# The IMIO image header structure.
+
+# Parameters.
+define	LEN_V2IMHDR	1024			# length of std header
+define	LEN_V2PIXHDR	293			# length of pixel file header
+define	V2U		LEN_V2IMHDR		# offset to user fields
+define	IM_V2USERAREA	(P2C($1+V2U))		# user area (database)
+
+# Disk resident header.
+define	IM_V2MAGIC	Memi[$1]		# contains the string "imhdr"
+define	IM_V2HDRLEN	Memi[$1+3]		# length of image header
+define	IM_V2PIXTYPE	Memi[$1+4]		# datatype of the pixels
+define	IM_V2SWAPPED	Memi[$1+5]		# pixels are byte swapped
+define	IM_V2NDIM	Memi[$1+6]		# number of dimensions
+define	IM_V2LEN	Meml[$1+$2+7-1]		# length of the dimensions
+define	IM_V2PHYSLEN	Meml[$1+$2+14-1]	# physical length (as stored)
+define	IM_V2SSMTYPE	Meml[$1+21]		# type of subscript mapping
+define	IM_V2LUTOFF	Meml[$1+22]		# offset to subscript map luts
+define	IM_V2PIXOFF	Meml[$1+23]		# offset of the pixels
+define  IM_V2HGMOFF	Meml[$1+24]		# offset of hgm pixels
+define  IM_V2BLIST	Meml[$1+25]		# offset of bad pixel list
+define  IM_V2SZBLIST	Meml[$1+26]		# size of bad pixel list
+define  IM_V2NBPIX	Meml[$1+27]		# number of bad pixels
+define	IM_V2CTIME	Meml[$1+28]		# time of image creation
+define	IM_V2MTIME	Meml[$1+29]		# time of last modify
+define	IM_V2LIMTIME	Meml[$1+30]		# time min,max computed
+define	IM_V2MAX	Memr[P2R($1+31)]	# max pixel value
+define	IM_V2MIN	Memr[P2R($1+32)]	# min pixel value
+define	IM_V2PIXFILE	Memc[P2C($1+37)]	# name of pixel storage file
+define	IM_V2HDRFILE	Memc[P2C($1+165)]	# name of header storage file
+define	IM_V2TITLE	Memc[P2C($1+293)]	# image name string
+define	IM_V2HISTORY	Memc[P2C($1+485)]	# history comment string
diff --git a/sys/imio/iki/oif/mkpkg b/sys/imio/iki/oif/mkpkg
new file mode 100644
index 00000000..81a4d57e
--- /dev/null
+++ b/sys/imio/iki/oif/mkpkg
@@ -0,0 +1,21 @@
+# Make the IKI/OIF interface (Old IRAF Format images)
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	oifaccess.x	oif.h
+	oifclose.x	<error.h> <imhdr.h> <imio.h> <protect.h>
+	oifcopy.x	oif.h
+	oifdelete.x	<error.h> <imhdr.h> <protect.h>
+	oifgpfn.x	oif.h <knet.h>
+	oifmkpfn.x	oif.h <imhdr.h> <imio.h> <knet.h>
+	oifopen.x	oif.h <imhdr.h> <imio.h> <fio.h> <error.h>
+	oifopix.x	oif.h <config.h> <imhdr.h> <imio.h>
+	oifrdhdr.x	imhv1.h imhv2.h oif.h <imhdr.h> <imio.h> <mach.h>
+	oifrename.x	oif.h <error.h> <imhdr.h> <imio.h>
+	oifupdhdr.x	oif.h <error.h> <imhdr.h> <imio.h>
+	oifwrhdr.x	imhv1.h imhv2.h oif.h <imhdr.h> <imio.h> <mach.h>
+	;
diff --git a/sys/imio/iki/oif/oif.h b/sys/imio/iki/oif/oif.h
new file mode 100644
index 00000000..d1161659
--- /dev/null
+++ b/sys/imio/iki/oif/oif.h
@@ -0,0 +1,15 @@
+# OIF.H -- IKI/OIF internal definitions.
+
+define	MAX_LENEXTN	3		# max length imagefile extension
+define	OIF_HDREXTN	"imh"		# image header filename extension
+define	OIF_PIXEXTN	"pix"		# image pixfile extension
+define	LEN_PIXHDR	512		# max length of PIXHDR structure
+define	COMPRESS	NO		# disable alignment of image lines?
+define	DEF_VERSION	2		# default file version
+
+define	ENV_OIFVER	"oifversion"	# default format for new images
+define	HDR		"HDR$"		# stands for header directory
+define	STRLEN_HDR	4
+
+define	TY_IMHDR	1		# main imagefile header
+define	TY_PIXHDR	2		# pixel file header
diff --git a/sys/imio/iki/oif/oifaccess.x b/sys/imio/iki/oif/oifaccess.x
new file mode 100644
index 00000000..e5dfe28a
--- /dev/null
+++ b/sys/imio/iki/oif/oifaccess.x
@@ -0,0 +1,51 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"oif.h"
+
+# OIF_ACCESS -- Test the accessibility or existence of an existing image, or
+# the legality of the name of a new image.
+
+procedure oif_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O status
+
+pointer	sp, fname
+int	btoi(), access(), iki_validextn()
+string	oif_extn OIF_HDREXTN
+bool	strne()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+	    call sfree (sp)
+	    return
+	}
+
+	# Reject image if an invalid extension is given.
+	if (extn[1] != EOS && strne (extn, oif_extn)) {
+	    status = NO
+	    call sfree (sp)
+	    return
+	}
+
+	# Check for the imagefile.
+	call iki_mkfname (root, oif_extn, Memc[fname], SZ_PATHNAME)
+	if (access (Memc[fname], acmode, 0) == YES) {
+	    if (extn[1] == EOS)
+		call strcpy (oif_extn, extn, MAX_LENEXTN)
+	    status = YES
+	} else
+	    status = NO
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifclose.x b/sys/imio/iki/oif/oifclose.x
new file mode 100644
index 00000000..8eb58b4f
--- /dev/null
+++ b/sys/imio/iki/oif/oifclose.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <protect.h>
+include <error.h>
+include <imhdr.h>
+include <imio.h>
+
+# OIF_CLOSE -- Close an OIF format image.  There is little for us to do, since
+# IMIO will already have updated the header if necessary and flushed any pixel
+# output.  Neither do we have to deallocate the IMIO descriptor, since it was
+# allocated by IMIO.
+
+procedure oif_close (im, status)
+
+pointer	im			# image descriptor
+int	status
+
+int	junk
+int	protect()
+
+begin
+	# Close the pixel file and header file, if open.
+	if (IM_PFD(im) != NULL)
+	    call close (IM_PFD(im))
+	if (IM_HFD(im) != NULL)
+	    call close (IM_HFD(im))
+
+	# If we are closing a new image, set delete protection on the
+	# header file to prevent the user from using DELETE to delete
+	# the image header file, which would leave a headerless pixel
+	# storage file lying about somewhere.
+
+	if (IM_ACMODE(im) == NEW_IMAGE || IM_ACMODE(im) == NEW_COPY)
+	    iferr (junk = protect (IM_HDRFILE(im), SET_PROTECTION))
+		call erract (EA_WARN)
+end
diff --git a/sys/imio/iki/oif/oifcopy.x b/sys/imio/iki/oif/oifcopy.x
new file mode 100644
index 00000000..8a7ea41d
--- /dev/null
+++ b/sys/imio/iki/oif/oifcopy.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"oif.h"
+
+# OIF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure oif_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		# old image root name
+char	old_extn[ARB]		# old image extn
+char	new_root[ARB]		# new image root name
+char	new_extn[ARB]		# new extn
+int	status
+
+pointer	sp
+pointer	old_fname, new_fname
+
+begin
+	call smark (sp)
+	call salloc (old_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filename of old and new images.
+	call iki_mkfname (old_root, old_extn, Memc[old_fname], SZ_PATHNAME)
+	call iki_mkfname (new_root, OIF_HDREXTN, Memc[new_fname], SZ_PATHNAME)
+
+	# For now, this is stubbed out.
+	status = ERR
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifdelete.x b/sys/imio/iki/oif/oifdelete.x
new file mode 100644
index 00000000..758309a7
--- /dev/null
+++ b/sys/imio/iki/oif/oifdelete.x
@@ -0,0 +1,53 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<protect.h>
+include	<error.h>
+include	<imhdr.h>
+
+# OIF_DELETE -- Delete an image.  A special operator is required since the
+# image is stored as two files.
+
+procedure oif_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U extension
+int	status
+
+int	junk
+pointer	sp, fname, pixfile
+int	access(), protect()
+pointer	im, immapz()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (pixfile, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filename.
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+
+	iferr (im = immapz (Memc[fname], READ_ONLY, 0)) {
+	    call erract (EA_WARN)
+
+	} else {
+	    if (IM_PIXFILE(im) != EOS) {
+		call oif_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im),
+		    Memc[pixfile], SZ_PATHNAME)
+		if (access (Memc[pixfile],0,0) == YES)
+		    iferr (call delete (Memc[pixfile]))
+			call erract (EA_WARN)
+	    }
+
+	    call imunmap (im)
+
+	    # Do not complain if the file is not protected.
+	    iferr (junk = protect (Memc[fname], REMOVE_PROTECTION))
+		;
+	    iferr (call delete (Memc[fname]))
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/oif/oifgpfn.x b/sys/imio/iki/oif/oifgpfn.x
new file mode 100644
index 00000000..cc9a7fef
--- /dev/null
+++ b/sys/imio/iki/oif/oifgpfn.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	"oif.h"
+
+# OIF_GPIXFNAME -- Convert a logical pixfile name into a physical pathname.
+
+procedure oif_gpixfname (pixfile, hdrfile, path, maxch)
+
+char	pixfile[ARB]		# pixfile name
+char	hdrfile[ARB]		# header file name (gives hdr directory)
+char	path[maxch]		# receives pathname
+int	maxch
+
+int	ip, nchars
+pointer	sp, fname, op
+int	strncmp(), fnldir()
+
+begin
+	# Merely return pathname if not case "HDR$".
+	if (strncmp (pixfile, HDR, STRLEN_HDR) != 0) {
+	    call fpathname (pixfile, path, maxch)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Get host pathname of pixel file directory.
+	nchars = fnldir (hdrfile, Memc[fname], SZ_PATHNAME)
+	call fpathname (Memc[fname], path, maxch)
+
+	# Fold in any subdirectories from the pixfile name.
+	# (as in HDR$pixels/).
+
+	op = fname
+	nchars = 0
+
+	for (ip=STRLEN_HDR+1;  pixfile[ip] != EOS;  ip=ip+1) {
+	    if (pixfile[ip] == '/') {
+		Memc[op] = EOS
+		call zfsubd (path, maxch, Memc[fname], nchars)
+		op = fname
+	    } else {
+		Memc[op] = pixfile[ip]
+		op = op + 1
+	    }
+	}
+
+	# Tack on the pixel file name, which was left in the fname buf.
+	if (op > fname) {
+	    Memc[op] = EOS
+	    if (nchars > 0)
+		call strcpy (Memc[fname], path[nchars+1], maxch-nchars)
+	    else
+		call strcat (Memc[fname], path, maxch)
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifmkpfn.x b/sys/imio/iki/oif/oifmkpfn.x
new file mode 100644
index 00000000..234fa706
--- /dev/null
+++ b/sys/imio/iki/oif/oifmkpfn.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<knet.h>
+include	"oif.h"
+
+# OIF_MKPIXFNAME -- Generate the pixel file name.  Leave the logical pixfile
+# name in the image header, and return the pathname to the pixel file in the
+# output argument.
+
+procedure oif_mkpixfname (im, pixfile, maxch)
+
+pointer	im			# image descriptor
+char	pixfile[maxch]		# receives pathname to pixfile
+int	maxch
+
+char	suffix[2]
+int	len_osdir, len_root, len_extn, n
+pointer	sp, imdir, osdir, root, extn, subdir, fname, ip, op
+
+bool	fnullfile()
+int	fnroot(), fnldir(), access(), envgets(), strncmp()
+string	pixextn OIF_PIXEXTN
+errchk	fmkdir, imerr
+
+begin
+	# Clear junk text at the end of the filename.
+	call aclrc (IM_PIXFILE(im), SZ_IMPIXFILE)
+
+	# Check for the null image.
+	if (fnullfile (IM_HDRFILE(im))) {
+	    call strcpy ("dev$null", IM_PIXFILE(im), SZ_IMPIXFILE)
+	    call strcpy (IM_PIXFILE(im), pixfile, maxch)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (imdir,  SZ_PATHNAME, TY_CHAR)
+	call salloc (osdir,  SZ_PATHNAME, TY_CHAR)
+	call salloc (root,   SZ_PATHNAME, TY_CHAR)
+	call salloc (subdir, SZ_PATHNAME, TY_CHAR)
+	call salloc (fname,  SZ_PATHNAME, TY_CHAR)
+	call salloc (extn,   SZ_FNAME, TY_CHAR)
+
+	if (envgets ("imdir", Memc[imdir], SZ_PATHNAME) <= 0)
+	    call strcpy (HDR, Memc[imdir], SZ_PATHNAME)
+
+	if (strncmp (Memc[imdir], HDR, STRLEN_HDR) == 0) {
+	    # Put pixfile in same directory as the header or in a subdirectory.
+	    # In the latter case, create the directory if it does not already
+	    # exist.
+
+	    ip = imdir + STRLEN_HDR
+	    for (op=subdir;  Memc[ip] != EOS && Memc[ip] != '/';  ip=ip+1) {
+		Memc[op] = Memc[ip]
+		op = op + 1
+	    }
+	    Memc[op] = EOS
+	    
+	    if (Memc[subdir] != EOS) {
+		n = fnldir (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME)
+		call fpathname (Memc[fname], Memc[fname], SZ_PATHNAME)
+		call zfsubd (Memc[fname], SZ_PATHNAME, Memc[subdir], n)
+		if (access (Memc[fname], 0, DIRECTORY_FILE) == NO)
+		    call fmkdir (Memc[fname])
+	    }
+	} else
+	    call fpathname (Memc[imdir], Memc[imdir], SZ_PATHNAME)
+
+	# Make up the root name of the new pixel file.  Take the root part of
+	# the header file and escape sequence encode it.  We have to do this
+	# because it is to be concatenated to an OS directory name, which will
+	# prevent translation of the root file name during normal filename
+	# mapping.
+
+	if (fnroot (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME) <= 0)
+	    call strcpy (pixextn, Memc[fname], SZ_PATHNAME)
+	call iki_mkfname (Memc[fname], pixextn, Memc[fname], SZ_PATHNAME)
+	call vfn_translate (Memc[fname], Memc[osdir], len_osdir,
+	    Memc[root], len_root, Memc[extn], len_extn)
+
+	suffix[1] = 'a'
+	suffix[2] = 'a'
+	suffix[3] = EOS
+
+	for (n=0;  ;  n=n+1) {
+	    call sprintf (IM_PIXFILE(im), SZ_PATHNAME, "%s%s.%s")
+		call pargstr (Memc[imdir])
+		call pargstr (Memc[root])
+		call pargstr (pixextn)
+
+	    call oif_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), pixfile, maxch)
+
+	    # Ensure that the filename is unique.
+	    if (access (pixfile, 0,0) == YES) {
+		if (n == 0) {
+		    for (op=root;  Memc[op] != EOS;  op=op+1)
+			;
+		} else {
+		    if (suffix[2] == 'z') {
+			suffix[2] = 'a'
+			if (suffix[1] == 'z')
+			    call imerr (IM_NAME(im), SYS_FMKTEMP)
+			else
+			    suffix[1] = suffix[1] + 1
+		    } else
+			suffix[2] = suffix[2] + 1
+		}
+
+		call strcpy (suffix, Memc[op], 2)
+	    } else
+		break
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifopen.x b/sys/imio/iki/oif/oifopen.x
new file mode 100644
index 00000000..a280f163
--- /dev/null
+++ b/sys/imio/iki/oif/oifopen.x
@@ -0,0 +1,137 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fio.h>
+include	"oif.h"
+
+# OIF_OPEN -- Open/create an image.
+
+procedure oif_open (kernel, im, o_im, root, extn, ksection, cl_index, cl_size, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I old image, if new_copy image
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I extension, if any
+char	ksection[ARB]		#I NOT USED
+int	cl_index		#I NOT USED
+int	cl_size			#I NOT USED
+int	acmode			#I access mode
+int	status			#O return value
+
+pointer	sp, fname, pixfile
+int	hfd, nchars, mode, junk
+int	open(), oif_rdhdr(), access(), protect(), envgeti()
+bool	envgetb(), fnullfile()
+errchk	syserrs
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (pixfile, SZ_PATHNAME, TY_CHAR)
+
+	status = OK
+
+	# The only valid cl_index is -1 (none specified) or 1.
+	if (!(cl_index < 0 || cl_index == 1))
+	    goto err_
+
+	# This kernel does not permit a kernel section to be used.
+	if (ksection[1] != EOS)
+	    call syserrs (SYS_IKIKSECTNS, Memc[fname])
+
+	# Determine access mode for header file.
+	if (acmode == NEW_COPY || acmode == NEW_IMAGE)
+	    mode = NEW_FILE
+	else
+	    mode = acmode
+
+	# Generate full header file name; the extension may be either ".imh"
+	# or nothing, and was set earlier by oif_access().
+
+	if (mode == NEW_FILE && extn[1] == EOS)
+	    call iki_mkfname (root, OIF_HDREXTN, Memc[fname], SZ_PATHNAME)
+	else
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+
+	# Delete any old image if one exists and imclobber is enabled.
+	if (mode == NEW_FILE && !fnullfile (Memc[fname]) &&
+	    (access (Memc[fname], 0,0) == YES)) {
+
+	    if (envgetb ("imclobber")) {
+		iferr (hfd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+		    status = ERR
+		    goto err_
+		}
+		nchars = LEN_IMHDR * SZ_MII_INT
+		if (oif_rdhdr (hfd, im, nchars, TY_IMHDR) < 0) {
+		    status = ERR
+		    goto err_
+		}
+		if (IM_PIXFILE(im) != EOS) {
+		    call oif_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im),
+			Memc[pixfile], SZ_PATHNAME)
+		    if (access (Memc[pixfile],0,0) == YES)
+			iferr (call delete (Memc[pixfile]))
+			    call erract (EA_WARN)
+		}
+		call close (hfd)
+		iferr (junk = protect (Memc[fname], REMOVE_PROTECTION))
+		    ;
+		iferr (call delete (Memc[fname]))
+		    call erract (EA_WARN)
+	    } else
+		call syserrs (SYS_IKICLOB, Memc[fname])
+	}
+
+	# Open the image header file.
+	iferr (hfd = open (Memc[fname], mode, BINARY_FILE))
+	    goto err_
+
+	IM_HFD(im) = hfd
+
+	# If opening an existing image, read the OIF fixed format binary
+	# image header into the image descriptor.  If opening a new image,
+	# write out a generic image header so that the image can be accessed
+	# and deleted with imdelete should the operation be aborted before
+	# a full image is written.
+
+	if (mode == NEW_FILE) {
+	    iferr (IM_HDRVER(im) = envgeti (ENV_OIFVER))
+		IM_HDRVER(im) = DEF_VERSION
+	    call aclrc (IM_HDRFILE(im), SZ_IMHDRFILE)
+	    call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+	    iferr (call oif_updhdr (im, status))
+		;
+	} else {
+	    iferr {
+		nchars = (IM_LENHDRMEM(im) - LEN_IMHDR) * SZ_MII_INT
+		if (oif_rdhdr (hfd, im, nchars, TY_IMHDR) < 0)
+		    status = ERR
+		else {
+		    call aclrc (IM_HDRFILE(im), SZ_IMHDRFILE)
+		    call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+		}
+	    } then
+		status = ERR
+	}
+
+	# It is best to close the header file at this point for two reasons:
+	# to improve error recovery (if an abort occurs with a new file still
+	# open FIO will delete it) and to free file descriptors (important for
+	# applications that open many images).  If the header needs to be
+	# updated, oif_updhdr will reopen the header file.
+
+	call close (hfd)
+	IM_HFD(im) = NULL
+
+	call sfree (sp)
+	return
+err_
+	status = ERR
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifopix.x b/sys/imio/iki/oif/oifopix.x
new file mode 100644
index 00000000..c9652374
--- /dev/null
+++ b/sys/imio/iki/oif/oifopix.x
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"oif.h"
+
+# OIF_OPIX -- Open (or create) the pixel storage file.  If the image header file
+# is `image.imh' the associated pixel storage file will be `imdir$image.pix',
+# or some variation thereon should a collision occur.  The environment variable
+# IMDIR controls where the pixfile will be placed.  The following classes of
+# values are provided:
+#
+#	path		Put pixfile in named absolute directory regardless of
+#			    where the header file is.
+#	./		Put pixfile in the current directory at image creation
+#			    time (special case of previous case).
+#	HDR$		Put pixfile in the same directory as the header file.
+#	HDR$subdir/	Put pixfiles in the subdirectory `subdir' of the
+#			    directory containing the header file.  IMIO will
+#			    create the subdirectory if necessary.
+
+procedure oif_opix (im, status)
+
+pointer	im				# image descriptor
+int	status				# return status
+
+long	pixoff
+pointer	sp, pixhdr, pixfile
+int	pfd, blklen
+
+int	open(), fdevblk(), oif_rdhdr()
+errchk	open, falloc, fdevblk, imerr, oif_rdhdr, oif_updhdr
+errchk	imioff, oif_wrhdr, oif_mkpixfname, oif_gpixfname, flush
+
+begin
+	status = OK
+	if (IM_PFD(im) != NULL)
+	    return
+
+
+	call smark (sp)
+	call salloc (pixhdr, LEN_IMDES + LEN_PIXHDR, TY_STRUCT)
+	call salloc (pixfile, SZ_PATHNAME, TY_CHAR)
+
+	switch (IM_ACMODE(im)) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY, APPEND:
+	    if (IM_PIXFILE(im) == EOS)
+		call imerr (IM_NAME(im), SYS_IMRDPIXFILE)
+
+	    call oif_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), Memc[pixfile],
+		SZ_PATHNAME)
+	    pfd = open (Memc[pixfile], IM_ACMODE(im), STATIC_FILE)
+
+	    call seek (pfd, BOFL)
+	    if (oif_rdhdr (pfd, pixhdr, 0, TY_PIXHDR) < 0)
+		call imerr (IM_NAME(im), SYS_IMRDPIXFILE)
+
+	case NEW_COPY, NEW_FILE, TEMP_FILE:
+	    # Generate the pixel file name.
+	    call oif_mkpixfname (im, Memc[pixfile], SZ_PATHNAME)
+
+	    # Compute the offset to the pixels in the pixfile.  Allow space
+	    # for the pixhdr pixel storage file header and start the pixels
+	    # on the next device block boundary.
+
+	    blklen = fdevblk (Memc[pixfile])
+	    pixoff = LEN_PIXHDR * SZ_MII_INT
+	    call imalign (pixoff, blklen)
+
+	    # Call IMIO to initialize the physical dimensions of the image
+	    # and the absolute file offsets of the major components of the
+	    # pixel storage file.
+
+	    call imioff (im, pixoff, COMPRESS, blklen)
+
+	    # Open the new pixel storage file (preallocate space if
+	    # enabled on local system).  Save the physical pathname of
+	    # the pixfile in the image header, in case "imdir$" changes.
+
+	    if (IM_FALLOC == YES) {
+		call falloc (Memc[pixfile], IM_HGMOFF(im) - 1)
+		pfd = open (Memc[pixfile], READ_WRITE, STATIC_FILE)
+	    } else
+		pfd = open (Memc[pixfile], NEW_FILE, BINARY_FILE)
+
+	    # Write small header into pixel storage file.  Allows detection of
+	    # headerless pixfiles, and reconstruction of header if it gets lost.
+
+	    call oif_wrhdr (pfd, im, TY_PIXHDR)
+	    call flush (pfd)
+
+	    # Update the image header so that it knows about the pixel file.
+	    call oif_updhdr (im, status)
+
+	default:
+	    call imerr (IM_NAME(im), SYS_IMACMODE)
+	}
+
+	IM_PFD(im) = pfd
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifrdhdr.x b/sys/imio/iki/oif/oifrdhdr.x
new file mode 100644
index 00000000..b11601cb
--- /dev/null
+++ b/sys/imio/iki/oif/oifrdhdr.x
@@ -0,0 +1,196 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <imhdr.h>
+include <imio.h>
+include "imhv1.h"
+include "imhv2.h"
+include "oif.h"
+
+
+# OIF_RDHDR -- Read the image header.  Either the main image header or the
+# pixel file header can be read.
+
+int procedure oif_rdhdr (fd, im, uchars, htype)
+
+int	fd			#I header file descriptor
+pointer	im			#I image descriptor
+int	uchars			#I maxchars of user area data to read
+int	htype			#I TY_IMHDR or TY_PIXHDR
+
+pointer	sp, v1
+char	immagic[SZ_IMMAGIC]
+int	sulen_userarea, hdrlen, nchars, status
+
+bool	streq()
+int	miireadc(), miireadi(), miireadl(), miireadr()
+int	btoi(), read()
+
+errchk	read, miireadc, miireadi, miireadl, miireadr
+define	readerr_ 91
+
+begin
+	# Determine the file type.
+	call seek (fd, BOFL)
+	if (read (fd, immagic, SZ_IMMAGIC) != SZ_IMMAGIC)
+	    return (ERR)
+
+	if (htype == TY_PIXHDR && streq (immagic, V1_PMAGIC)) {
+	    # V1 Pixel file header.
+	    return (OK)
+
+	} else if (htype == TY_IMHDR && streq (immagic, V1_MAGIC)) {
+	    # Old V1 image header.
+
+	    call smark (sp)
+	    call salloc (v1, LEN_V1IMHDR, TY_STRUCT)
+
+	    call seek (fd, BOFL)
+	    nchars = LEN_V1IMHDR * SZ_MII_INT
+	    if (read (fd, IM_V1MAGIC(v1), nchars) != nchars) {
+		call sfree (sp)
+		return (ERR)
+	    }
+
+	    # Initialize the output image header.
+	    call strcpy (IMH_MAGICSTR, IM_MAGIC(im), SZ_IMMAGIC)
+	    IM_HDRVER(im) = V1_VERSION
+
+	    # The following is the length of the user area in SU.
+	    sulen_userarea = IM_V1HDRLEN(v1) - LEN_V1IMHDR
+	    IM_HDRLEN(im) = LEN_IMHDR + sulen_userarea
+
+	    IM_SWAP(im) = NO
+	    IM_SWAPPED(im) = -1
+	    IM_PIXTYPE(im) = IM_V1PIXTYPE(v1)
+
+	    IM_NDIM(im) = IM_V1NDIM(v1)
+	    call amovl (IM_V1LEN(v1,1), IM_LEN(im,1), IM_MAXDIM)
+	    call amovl (IM_V1PHYSLEN(v1,1), IM_PHYSLEN(im,1), IM_MAXDIM)
+
+	    IM_SSMTYPE(im) = IM_V1SSMTYPE(v1)
+	    IM_LUTOFF(im) = IM_V1LUTOFF(v1)
+	    IM_PIXOFF(im) = IM_V1PIXOFF(v1)
+	    IM_HGMOFF(im) = IM_V1HGMOFF(v1)
+	    IM_CTIME(im) = IM_V1CTIME(v1)
+	    IM_MTIME(im) = IM_V1MTIME(v1)
+	    IM_LIMTIME(im) = IM_V1LIMTIME(v1)
+	    IM_MAX(im) = IM_V1MAX(v1)
+	    IM_MIN(im) = IM_V1MIN(v1)
+
+	    call strcpy (IM_V1PIXFILE(v1), IM_PIXFILE(im), SZ_IMPIXFILE)
+	    call strcpy (IM_V1HDRFILE(v1), IM_HDRFILE(im), SZ_IMHDRFILE)
+	    call strcpy (IM_V1TITLE(v1), IM_TITLE(im), SZ_IMTITLE)
+	    call strcpy (IM_V1HISTORY(v1), IM_HISTORY(im), SZ_IMHIST)
+
+	    # Read and output the user area.
+	    if (uchars > 0 && sulen_userarea > 0) {
+		nchars = min (uchars, sulen_userarea * SZ_MII_INT)
+		if (read (fd, Memc[IM_USERAREA(im)], nchars) <= 0)
+		    return (ERR)
+	    }
+
+	    call sfree (sp)
+	    return (OK)
+	}
+
+	# Check for a new format header.
+	call seek (fd, BOFL)
+	if (miireadc (fd, immagic, SZ_IMMAGIC) < 0)
+	    return (ERR)
+
+	if (htype == TY_PIXHDR && streq (immagic, V2_PMAGIC)) {
+	    # V2 Pixel file header.
+	    return (OK)
+
+	} else if (htype == TY_IMHDR && streq (immagic, V2_MAGIC)) {
+	    # Newer V2 image header.
+	    status = ERR
+
+	    # Initialize the output image header.
+	    call strcpy (IMH_MAGICSTR, IM_MAGIC(im), SZ_IMMAGIC)
+	    IM_HDRVER(im) = V2_VERSION
+
+	    # "sulen_userarea" is the length of the user area in SU.
+	    if (miireadi (fd, hdrlen, 1) != 1)
+		goto readerr_
+	    sulen_userarea = hdrlen - LEN_V2IMHDR
+	    IM_HDRLEN(im) = LEN_IMHDR + sulen_userarea
+
+	    if (miireadi (fd, IM_PIXTYPE(im), 1) != 1)
+		goto readerr_
+
+	    # Determine whether to byte swap the pixels.
+	    if (miireadi (fd, IM_SWAPPED(im), 1) != 1)
+		goto readerr_
+
+	    IM_SWAP(im) = NO
+	    switch (IM_PIXTYPE(im)) {
+	    case TY_SHORT, TY_USHORT:
+		IM_SWAP(im) = btoi (IM_SWAPPED(im) != BYTE_SWAP2)
+	    case TY_INT, TY_LONG:
+		IM_SWAP(im) = btoi (IM_SWAPPED(im) != BYTE_SWAP4)
+	    case TY_REAL:
+		if (IEEE_USED == YES)
+		    IM_SWAP(im) = btoi (IM_SWAPPED(im) != IEEE_SWAP4)
+	    case TY_DOUBLE:
+		if (IEEE_USED == YES)
+		    IM_SWAP(im) = btoi (IM_SWAPPED(im) != IEEE_SWAP8)
+	    }
+
+	    # Read the fixed-format fields of the header.
+	    if (miireadi (fd, IM_NDIM(im), 1) < 0)
+		goto readerr_
+	    if (miireadi (fd, IM_LEN(im,1), IM_MAXDIM) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_PHYSLEN(im,1), IM_MAXDIM) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_SSMTYPE(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_LUTOFF(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_PIXOFF(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_HGMOFF(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_BLIST(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_SZBLIST(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_NBPIX(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_CTIME(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_MTIME(im), 1) < 0)
+		goto readerr_
+	    if (miireadl (fd, IM_LIMTIME(im), 1) < 0)
+		goto readerr_
+
+	    if (miireadr (fd, IM_MAX(im), 1) < 0)
+		goto readerr_
+	    if (miireadr (fd, IM_MIN(im), 1) < 0)
+		goto readerr_
+
+	    if (miireadc (fd, IM_PIXFILE(im), SZ_V2IMPIXFILE) < 0)
+		goto readerr_
+	    if (miireadc (fd, IM_HDRFILE(im), SZ_V2IMHDRFILE) < 0)
+		goto readerr_
+	    if (miireadc (fd, IM_TITLE(im), SZ_V2IMTITLE) < 0)
+		goto readerr_
+	    if (miireadc (fd, IM_HISTORY(im), SZ_V2IMHIST) < 0)
+		goto readerr_
+
+	    # Read the variable-length user area.
+	    if (uchars > 0 && sulen_userarea > 0) {
+		nchars = min (uchars, sulen_userarea * SZ_MII_INT)
+		if (miireadc (fd, Memc[IM_USERAREA(im)], nchars) < 0)
+		    goto readerr_
+	    }
+
+	    status = OK
+readerr_
+	    return (status)
+	}
+
+	return (ERR)
+end
diff --git a/sys/imio/iki/oif/oifrename.x b/sys/imio/iki/oif/oifrename.x
new file mode 100644
index 00000000..edba1bcd
--- /dev/null
+++ b/sys/imio/iki/oif/oifrename.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"oif.h"
+
+# OIF_RENAME -- Rename an image.  A special operator is required since the image
+# is stored as two files.
+
+procedure oif_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		# old image root name
+char	old_extn[ARB]		# old image extn
+char	new_root[ARB]		# new image root name
+char	new_extn[ARB]		# old image extn
+int	status
+
+pointer	sp, im
+bool	heq, peq
+pointer	old_hfn, new_hfn
+pointer	old_pfn, new_pfn
+int	nchars, old_rootoff, new_rootoff, junk
+
+bool	streq()
+pointer	immapz()
+int	access(), strlen(), strncmp()
+errchk	immapz, rename
+
+begin
+	call smark (sp)
+	call salloc (old_hfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_hfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (old_pfn, SZ_PATHNAME, TY_CHAR)
+	call salloc (new_pfn, SZ_PATHNAME, TY_CHAR)
+
+	# Get filenames of old and new images.
+	call iki_mkfname (old_root, old_extn, Memc[old_hfn], SZ_PATHNAME)
+	call iki_mkfname (new_root, OIF_HDREXTN, Memc[new_hfn], SZ_PATHNAME)
+	heq = streq (Memc[old_hfn], Memc[new_hfn])
+
+	# Our task here is nontrivial as the pixel file must be renamed as
+	# well as the header file, e.g., since renaming the header file may
+	# move it to a different directory, and the PIXFILE field in the
+	# image header may indicate that the pixel file is in the same dir
+	# as the header.  Must open image, get pixfile name from the header,
+	# and generate the new pixfile name.  The CURRENT value of IMDIR is
+	# used to generate the new pixfile name.
+
+	im = immapz (Memc[old_hfn], READ_WRITE, 0)
+
+	if (IM_PIXFILE(im) != EOS) {
+	    # Get old pixel file filename.
+	    call oif_gpixfname (IM_PIXFILE(im), Memc[old_hfn], Memc[old_pfn],
+		SZ_PATHNAME)
+
+	    # Get new pixel file filename.
+	    call strcpy (Memc[new_hfn], IM_HDRFILE(im), SZ_IMHDRFILE)
+	    call oif_mkpixfname (im, Memc[new_pfn], SZ_PATHNAME)
+
+	    # Do not change the pixel file name if the name does not change
+	    # other than by the addition of the "aa" style suffix added by
+	    # mkpixfname.
+
+	    peq = false
+	    call zfnbrk (old_root, old_rootoff, junk)
+	    call zfnbrk (new_root, new_rootoff, junk)
+	    peq = streq (old_root[old_rootoff], new_root[new_rootoff])
+
+	    if (peq) {
+		nchars = strlen (Memc[new_pfn]) - strlen ("aa.imh")
+		peq = (strncmp (Memc[old_pfn], Memc[new_pfn], nchars) == 0)
+	    }
+
+	    if (peq)
+		IM_UPDATE(im) = NO
+	    else {
+		# If the pixel file rename fails do not rename the header file
+		# and do not change the name of the pixel file in the header.
+
+		iferr (call rename (Memc[old_pfn], Memc[new_pfn])) {
+		    if (access (Memc[old_pfn], 0, 0) == YES) {
+			IM_UPDATE(im) = NO
+			call imunmap (im)
+			call erract (EA_ERROR)
+		    }
+		}
+	    }
+
+	} else
+	    call strcpy (Memc[new_hfn], IM_HDRFILE(im), SZ_IMHDRFILE)
+
+	call strcpy (Memc[old_hfn], IM_HDRFILE(im), SZ_IMHDRFILE)
+	call imunmap (im)
+
+	# Rename the header file.
+	if (!heq)
+	    call rename (Memc[old_hfn], Memc[new_hfn])
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/oif/oifupdhdr.x b/sys/imio/iki/oif/oifupdhdr.x
new file mode 100644
index 00000000..516d62c1
--- /dev/null
+++ b/sys/imio/iki/oif/oifupdhdr.x
@@ -0,0 +1,34 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"oif.h"
+
+# OIF_UPDHDR -- Update the image header.
+
+procedure oif_updhdr (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O return status
+
+int	hfd
+errchk	imerr, open, oif_wrhdr, flush
+int	open()
+
+begin
+	status = OK
+	hfd = IM_HFD(im)
+
+	if (IM_ACMODE(im) == READ_ONLY)
+	    call imerr (IM_NAME(im), SYS_IMUPIMHDR)
+	if (hfd == NULL)
+	    hfd = open (IM_HDRFILE(im), READ_WRITE, BINARY_FILE)
+
+	call oif_wrhdr (hfd, im, TY_IMHDR)
+	call flush (hfd)
+
+	if (IM_HFD(im) == NULL)
+	    call close (hfd)
+end
diff --git a/sys/imio/iki/oif/oifwrhdr.x b/sys/imio/iki/oif/oifwrhdr.x
new file mode 100644
index 00000000..7b4e7349
--- /dev/null
+++ b/sys/imio/iki/oif/oifwrhdr.x
@@ -0,0 +1,233 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <imhdr.h>
+include <mach.h>
+include <imio.h>
+include "imhv1.h"
+include "imhv2.h"
+include "oif.h"
+
+# OIF_WRHDR -- Write an OIF image header.
+
+procedure oif_wrhdr (fd, im, htype)
+
+int	fd			#I header file descriptor
+pointer	im			#I image descriptor
+int	htype			#I TY_IMHDR or TY_PIXHDR
+
+pointer	sp, v1, fname
+int	status, hdrlen, len_userarea
+errchk	write, miiwritec, miiwritei, miiwritel, miiwriter
+int	strlen()
+
+define	v1done_  91
+define	v2start_ 92
+define	v2done_  93
+
+begin
+	switch (IM_HDRVER(im)) {
+	case V1_VERSION:
+	    # Old V1 image header.
+	    # ----------------------
+
+	    status = ERR
+	    call smark (sp)
+	    call salloc (v1, LEN_V1IMHDR, TY_STRUCT)
+
+	    # Initialize the output image header.
+	    switch (htype) {
+	    case TY_IMHDR:
+		call strcpy (V1_MAGIC, IM_V1MAGIC(v1), SZ_IMMAGIC)
+		hdrlen = LEN_V1IMHDR
+	    case TY_PIXHDR:
+		call strcpy (V1_PMAGIC, IM_V1MAGIC(v1), SZ_IMMAGIC)
+		hdrlen = LEN_V1PIXHDR
+	    default:
+		goto v1done_
+	    }
+
+	    # The following is the length of the user area in chars.
+	    len_userarea = strlen (Memc[IM_USERAREA(im)]) + 1
+	    IM_V1HDRLEN(v1) = LEN_V1IMHDR +
+		(len_userarea + SZ_MII_INT-1) / SZ_MII_INT
+
+	    IM_V1PIXTYPE(v1) = IM_PIXTYPE(im)
+	    IM_V1NDIM(v1) = IM_NDIM(im)
+	    call amovl (IM_LEN(im,1), IM_V1LEN(v1,1), IM_MAXDIM)
+	    call amovl (IM_PHYSLEN(im,1), IM_V1PHYSLEN(v1,1), IM_MAXDIM)
+
+	    IM_V1SSMTYPE(v1) = IM_SSMTYPE(im)
+	    IM_V1LUTOFF(v1) = IM_LUTOFF(im)
+	    IM_V1PIXOFF(v1) = IM_PIXOFF(im)
+	    IM_V1HGMOFF(v1) = IM_HGMOFF(im)
+	    IM_V1CTIME(v1) = IM_CTIME(im)
+	    IM_V1MTIME(v1) = IM_MTIME(im)
+	    IM_V1LIMTIME(v1) = IM_LIMTIME(im)
+	    IM_V1MAX(v1) = IM_MAX(im)
+	    IM_V1MIN(v1) = IM_MIN(im)
+
+	    if (strlen(IM_PIXFILE(im)) > SZ_V1IMPIXFILE)
+		goto v1done_
+	    if (strlen(IM_HDRFILE(im)) > SZ_V1IMHDRFILE)
+		goto v1done_
+
+	    call strcpy (IM_PIXFILE(im), IM_V1PIXFILE(v1), SZ_V1IMPIXFILE)
+	    call strcpy (IM_HDRFILE(im), IM_V1HDRFILE(v1), SZ_V1IMHDRFILE)
+	    call strcpy (IM_TITLE(im), IM_V1TITLE(v1), SZ_V1IMTITLE)
+	    call strcpy (IM_HISTORY(im), IM_V1HISTORY(v1), SZ_V1IMHIST)
+
+	    # For historical reasons the pixel file header stores the host
+	    # pathname of the header file in the PIXFILE field of the pixel
+	    # file header.
+
+	    if (htype == TY_PIXHDR)
+		call fpathname (IM_HDRFILE(im), IM_V1PIXFILE(v1),
+		    SZ_V1IMPIXFILE)
+
+	    # Write the file header.
+	    call seek (fd, BOFL)
+	    call write (fd, IM_V1MAGIC(v1), hdrlen * SZ_MII_INT)
+
+	    # Write the user area.
+	    if (htype == TY_IMHDR)
+		call write (fd, Memc[IM_USERAREA(im)], len_userarea)
+
+	    status = OK
+v1done_
+	    call sfree (sp)
+	    if (status != OK)
+		call syserrs (SYS_IKIUPDHDR, IM_NAME(im))
+
+	case V2_VERSION:
+	    # Newer V2 image header.
+	    # ----------------------
+v2start_
+	    status = ERR
+	    call smark (sp)
+	    call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	    call seek (fd, BOFL)
+
+	    # Initialize the output image header.
+	    switch (htype) {
+	    case TY_IMHDR:
+		call miiwritec (fd, V2_MAGIC, SZ_IMMAGIC)
+		hdrlen = LEN_V2IMHDR
+	    case TY_PIXHDR:
+		call miiwritec (fd, V2_PMAGIC, SZ_IMMAGIC)
+		hdrlen = LEN_V2PIXHDR
+	    default:
+		goto v2done_
+	    }
+
+	    # The following is the length of the user area in SU.
+	    len_userarea = strlen (Memc[IM_USERAREA(im)]) + 1
+	    hdrlen = LEN_V2IMHDR + (len_userarea + SZ_MII_INT-1) / SZ_MII_INT
+
+	    call miiwritei (fd, hdrlen, 1)
+	    call miiwritei (fd, IM_PIXTYPE(im), 1)
+
+	    # Record the byte swapping used for this image.  When writing a
+	    # new image we use the native data type of the host and don't
+	    # swap bytes, so IM_SWAPPED is YES if the host architecture is
+	    # byte swapped.
+
+	    switch (IM_ACMODE(im)) {
+	    case NEW_IMAGE, NEW_COPY, TEMP_FILE:
+		IM_SWAPPED(im) = -1
+		switch (IM_PIXTYPE(im)) {
+		case TY_SHORT, TY_USHORT:
+		    IM_SWAPPED(im) = BYTE_SWAP2
+		case TY_INT, TY_LONG:
+		    IM_SWAPPED(im) = BYTE_SWAP4
+		case TY_REAL:
+		    if (IEEE_USED == YES)
+			IM_SWAPPED(im) = IEEE_SWAP4
+		case TY_DOUBLE:
+		    if (IEEE_USED == YES)
+			IM_SWAPPED(im) = IEEE_SWAP8
+		}
+	    default:
+		# IM_SWAPPED should already be set in header.
+	    }
+
+	    call miiwritei (fd, IM_SWAPPED(im), 1)
+	    call miiwritei (fd, IM_NDIM(im), 1)
+	    call miiwritel (fd, IM_LEN(im,1), IM_MAXDIM)
+	    call miiwritel (fd, IM_PHYSLEN(im,1), IM_MAXDIM)
+	    call miiwritel (fd, IM_SSMTYPE(im), 1)
+	    call miiwritel (fd, IM_LUTOFF(im), 1)
+	    call miiwritel (fd, IM_PIXOFF(im), 1)
+	    call miiwritel (fd, IM_HGMOFF(im), 1)
+	    call miiwritel (fd, IM_BLIST(im), 1)
+	    call miiwritel (fd, IM_SZBLIST(im), 1)
+	    call miiwritel (fd, IM_NBPIX(im), 1)
+	    call miiwritel (fd, IM_CTIME(im), 1)
+	    call miiwritel (fd, IM_MTIME(im), 1)
+	    call miiwritel (fd, IM_LIMTIME(im), 1)
+	    call miiwriter (fd, IM_MAX(im), 1)
+	    call miiwriter (fd, IM_MIN(im), 1)
+
+	    if (strlen(IM_PIXFILE(im)) > SZ_V2IMPIXFILE)
+		goto v2done_
+	    if (strlen(IM_HDRFILE(im)) > SZ_V2IMHDRFILE)
+		goto v2done_
+
+	    # For historical reasons the pixel file header stores the host
+	    # pathname of the header file in the PIXFILE field of the pixel
+	    # file header.
+
+	    if (htype == TY_PIXHDR) {
+		call aclrc (Memc[fname], SZ_PATHNAME)
+		call fpathname (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME)
+		call miiwritec (fd, Memc[fname], SZ_V2IMPIXFILE)
+		status = OK
+		goto v2done_
+	    } else
+		call miiwritec (fd, IM_PIXFILE(im), SZ_V2IMPIXFILE)
+
+	    call oif_trim (IM_HDRFILE(im), SZ_V2IMHDRFILE)
+	    call miiwritec (fd, IM_HDRFILE(im), SZ_V2IMHDRFILE)
+
+	    call oif_trim (IM_TITLE(im), SZ_V2IMTITLE)
+	    call miiwritec (fd, IM_TITLE(im), SZ_V2IMTITLE)
+
+	    call oif_trim (IM_HISTORY(im), SZ_V2IMHIST)
+	    call miiwritec (fd, IM_HISTORY(im), SZ_V2IMHIST)
+
+	    # Write the variable-length user area.
+	    call miiwritec (fd, Memc[IM_USERAREA(im)], len_userarea)
+
+	    status = OK
+v2done_	
+	    call sfree (sp)
+	    if (status != OK)
+		call syserrs (SYS_IKIUPDHDR, IM_NAME(im))
+
+	default:
+	    IM_HDRVER(im) = V2_VERSION
+	    goto v2start_
+	}
+end
+
+
+# OIF_TRIM -- Trim trailing garbage at the end of a string.  This does not
+# affect the value of the string, but makes the contents of the output file
+# clearer when examined with file utilities.
+
+procedure oif_trim (s, nchars)
+
+char	s[ARB]
+int	nchars
+
+int	n, ntrim
+int	strlen()
+
+begin
+	n = strlen(s) + 1
+	ntrim = nchars - n
+
+	if (ntrim > 0)
+	    call aclrc (s[n], ntrim)
+end
diff --git a/sys/imio/iki/plf/README b/sys/imio/iki/plf/README
new file mode 100644
index 00000000..0a2065c7
--- /dev/null
+++ b/sys/imio/iki/plf/README
@@ -0,0 +1,5 @@
+PLF -- Partial, IKI mini-driver for the pixel list (PLIO) image format.
+
+Only part of the IKI routines are implemented here.  The open/close, header
+access, and i/o functions are handled as a special case directly in the
+IMIO code (see the impm*.x routines, and im[rd|wr]px.x).
diff --git a/sys/imio/iki/plf/mkpkg b/sys/imio/iki/plf/mkpkg
new file mode 100644
index 00000000..4253544e
--- /dev/null
+++ b/sys/imio/iki/plf/mkpkg
@@ -0,0 +1,17 @@
+# Make the PLF image kernel (PLIO mask image kernel).
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	plfaccess.x	plf.h
+	plfclose.x	<imhdr.h> <imio.h> <plset.h>
+	plfcopy.x	plf.h <error.h>
+	plfdelete.x	<error.h>
+	plfnull.x	
+	plfopen.x	<imhdr.h> <imio.h> <plio.h> <pmset.h>
+	plfrename.x	plf.h <error.h>
+	plfupdhdr.x	<imhdr.h> <imio.h> <plset.h>
+	;
diff --git a/sys/imio/iki/plf/plf.h b/sys/imio/iki/plf/plf.h
new file mode 100644
index 00000000..7fc666a9
--- /dev/null
+++ b/sys/imio/iki/plf/plf.h
@@ -0,0 +1,4 @@
+# PLF.H -- IKI/PLF internal definitions.
+
+define	PLF_EXTN	"pl"		# image header filename extension
+define	MAX_LENEXTN	3		# max length imagefile extension
diff --git a/sys/imio/iki/plf/plfaccess.x b/sys/imio/iki/plf/plfaccess.x
new file mode 100644
index 00000000..bf4ed5a9
--- /dev/null
+++ b/sys/imio/iki/plf/plfaccess.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"plf.h"
+
+# PLF_ACCESS -- Test the accessibility or existence of an existing image,
+# or the legality of the name of a new image.
+
+procedure plf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O ok or err
+
+pointer	sp, fname
+int	btoi(), access(), iki_validextn()
+string	plf_extn PLF_EXTN
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	status = NO
+	if (extn[1] != EOS)
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+
+	if (acmode != NEW_IMAGE && acmode != NEW_COPY) {
+	    if (extn[1] == EOS) {
+		call iki_mkfname (root, plf_extn, Memc[fname], SZ_PATHNAME)
+		status = access (Memc[fname], acmode, 0)
+		if (status != NO)
+		    call strcpy (plf_extn, extn, MAX_LENEXTN)
+	    } else if (status != NO) {
+		call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+		status = access (Memc[fname], acmode, 0)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfclose.x b/sys/imio/iki/plf/plfclose.x
new file mode 100644
index 00000000..2d2454e0
--- /dev/null
+++ b/sys/imio/iki/plf/plfclose.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <imio.h>
+include <plset.h>
+
+# PLF_CLOSE -- Close a mask image.
+
+procedure plf_close (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+begin
+	if (IM_PFD(im) != NULL)
+	    call close (IM_PFD(im))
+	if (and (IM_PLFLAGS(im), PL_CLOSEPL) != 0)
+	    call pl_close (IM_PL(im))
+
+	IM_PL(im) = NULL
+end
diff --git a/sys/imio/iki/plf/plfcopy.x b/sys/imio/iki/plf/plfcopy.x
new file mode 100644
index 00000000..4cfb2b6e
--- /dev/null
+++ b/sys/imio/iki/plf/plfcopy.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"plf.h"
+
+# PLF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure plf_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I new extn
+int	status			#O output status
+
+pointer	sp
+pointer	oldname, newname
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filename of old and new images.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, PLF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Copy the PLIO mask save file.
+	iferr (call fcopy (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfdelete.x b/sys/imio/iki/plf/plfdelete.x
new file mode 100644
index 00000000..4fad68aa
--- /dev/null
+++ b/sys/imio/iki/plf/plfdelete.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# PLF_DELETE -- Delete a PLIO mask savefile (mask image).
+
+procedure plf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension
+int	status			#O output status
+
+pointer	sp, fname
+errchk	delete
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	iferr (call delete (Memc[fname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfnull.x b/sys/imio/iki/plf/plfnull.x
new file mode 100644
index 00000000..83ec77cd
--- /dev/null
+++ b/sys/imio/iki/plf/plfnull.x
@@ -0,0 +1,9 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PLF_NULL -- Null driver entry point.
+
+procedure plf_null()
+
+begin
+	call error (1, "PLF image kernel abort - null driver entry point")
+end
diff --git a/sys/imio/iki/plf/plfopen.x b/sys/imio/iki/plf/plfopen.x
new file mode 100644
index 00000000..ec65d647
--- /dev/null
+++ b/sys/imio/iki/plf/plfopen.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<pmset.h>
+include	<plio.h>
+
+
+# PLF_OPEN -- Open a PMIO mask on an image descriptor.
+
+procedure plf_open (kernel, im, o_im,
+	root, extn, ksection, cl_index, cl_size, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I [not used]
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I filename extension
+char	ksection[ARB]		#I QPIO filter expression
+int	cl_index		#I [not used]
+int	cl_size			#I [not used]
+int	acmode			#I [not used]
+int	status			#O ok|err
+
+pointer	sp, fname, hp, pl
+int	naxes, axlen[IM_MAXDIM], depth
+bool	envgetb(), fnullfile()
+pointer	pl_open()
+int	access()
+errchk	imerr
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (hp, IM_LENHDRMEM(im), TY_CHAR)
+
+	# The only valid cl_index for a PL image is -1 (none specified) or 1.
+	if (!(cl_index < 0 || cl_index == 1)) {
+	    call sfree (sp)
+	    status = ERR
+	    return
+	}
+
+	# Get mask file name.
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	call aclrc (IM_HDRFILE(im), SZ_IMHDRFILE)
+	call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+
+	# Open an empty mask.
+	pl = pl_open (NULL)
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    # Check that we will not be clobbering an existing mask.
+	    if (!fnullfile(Memc[fname]) && access (Memc[fname], 0, 0) == YES)
+		if (envgetb ("imclobber")) {
+		    iferr (call delete (Memc[fname]))
+			;
+		} else {
+		    call pl_close (pl)
+		    call imerr (IM_NAME(im), SYS_IKICLOB)
+		}
+	} else {
+	    # Load the named mask if opening an existing mask image.
+	    iferr (call pl_loadf (pl,Memc[fname],Memc[hp],IM_LENHDRMEM(im))) {
+		call pl_close (pl)
+		call sfree (sp)
+		status = ERR
+		return
+	    }
+
+	    # Set the image size.
+	    call pl_gsize (pl, naxes, axlen, depth)
+
+	    IM_NDIM(im) = naxes
+	    call amovl (axlen, IM_LEN(im,1), IM_MAXDIM)
+	    call imioff (im, 1, YES, 1)
+
+	    # Restore the header cards.
+	    call im_pmldhdr (im, hp)
+	}
+
+	# More set up of the image descriptor.
+	IM_PL(im)	= pl
+	IM_PLFLAGS(im)	= PL_CLOSEPL
+	IM_PIXTYPE(im)  = TY_INT
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfrename.x b/sys/imio/iki/plf/plfrename.x
new file mode 100644
index 00000000..1ab47507
--- /dev/null
+++ b/sys/imio/iki/plf/plfrename.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"plf.h"
+
+# PLF_RENAME -- Rename a PLIO mask savefile (mask image).
+
+procedure plf_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I old image extn
+int	status			#O output status
+
+pointer	sp, oldname, newname
+errchk	rename
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filenames of old and new datafiles.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, PLF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Rename the datafile.
+	iferr (call rename (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfupdhdr.x b/sys/imio/iki/plf/plfupdhdr.x
new file mode 100644
index 00000000..e8cb8784
--- /dev/null
+++ b/sys/imio/iki/plf/plfupdhdr.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<plset.h>
+
+# PLF_UPDHDR -- Update the image header.
+
+procedure plf_updhdr (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+pointer	bp
+int	nchars, flags, sz_buf
+int	im_pmsvhdr()
+
+begin
+	status = OK
+
+	flags = 0
+	if (IM_ACMODE(im) == READ_WRITE)
+	    flags = PL_UPDATE
+
+	bp = NULL
+	iferr {
+	    nchars = im_pmsvhdr (im, bp, sz_buf)
+	    call pl_savef (IM_PL(im), IM_HDRFILE(im), Memc[bp], flags)
+	} then
+	    status = ERR
+
+	call mfree (bp, TY_CHAR)
+end
diff --git a/sys/imio/iki/qpf/README b/sys/imio/iki/qpf/README
new file mode 100644
index 00000000..cea44538
--- /dev/null
+++ b/sys/imio/iki/qpf/README
@@ -0,0 +1,2 @@
+IKI/QPF -- IKI kernel for the QPOE (position ordered event file) image format.
+See the QPOE source directories for additional information on QPOE.
diff --git a/sys/imio/iki/qpf/mkpkg b/sys/imio/iki/qpf/mkpkg
new file mode 100644
index 00000000..eb3e8efd
--- /dev/null
+++ b/sys/imio/iki/qpf/mkpkg
@@ -0,0 +1,22 @@
+# Make the IKI/QPF interface (photon image kernel).
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	qpfaccess.x	qpf.h
+	qpfclose.x	qpf.h <imhdr.h> <imio.h>
+	qpfcopy.x	qpf.h <error.h>
+	qpfcopypar.x	qpf.h <error.h> <imhdr.h> <imio.h> <qpset.h>
+	qpfdelete.x	<error.h>
+	qpfopen.x	qpf.h <error.h> <imhdr.h> <imio.h> <mach.h>\
+			<qpioset.h> <qpset.h>
+	qpfopix.x	qpf.h <imhdr.h> <imio.h>
+	qpfrename.x	qpf.h <error.h>
+	qpfupdhdr.x	
+	qpfwattr.x	qpf.h <ctype.h> <qpioset.h>
+	qpfwfilter.x	qpf.h
+	zfioqp.x	qpf.h <fio.h> <imhdr.h> <imio.h> <mach.h> <qpioset.h>
+	;
diff --git a/sys/imio/iki/qpf/qpf.h b/sys/imio/iki/qpf/qpf.h
new file mode 100644
index 00000000..37e29cee
--- /dev/null
+++ b/sys/imio/iki/qpf/qpf.h
@@ -0,0 +1,20 @@
+# QPF.H -- IKI/QPF internal definitions.
+
+define	QPF_EXTN	"qp"		# image header filename extension
+define	MAX_LENEXTN	3		# max length imagefile extension
+define	SZ_KWNAME	8		# size of a FITS keyword name
+define	SZ_BIGSTR	64		# max length string per FITS card
+define	SZ_MAXFILTER	4096		# max size QPIO filter (for log only)
+
+define	LEN_QPFDES	10
+define	QPF_IM		Memi[$1]	# backpointer to image descriptor
+define	QPF_QP		Memi[$1+1]	# QPOE datafile descriptor
+define	QPF_IO		Memi[$1+2]	# QPIO descriptor
+define	QPF_XBLOCK	Memr[P2R($1+3)]	# X block factor for sampling
+define	QPF_YBLOCK	Memr[P2R($1+4)]	# Y block factor for sampling
+define	QPF_VS		Memi[$1+5+$2-1]	# start vector of active rect
+define	QPF_VE		Memi[$1+7+$2-1]	# end vector of active rect
+define	QPF_IOSTAT	Memi[$1+9]	# i/o status (byte count)
+
+# QPOE parameters to be omitted from the IMIO header user parameter list.
+define	OMIT "|naxes|axlen|datamin|datamax|cretime|modtime|limtime|"
diff --git a/sys/imio/iki/qpf/qpfaccess.x b/sys/imio/iki/qpf/qpfaccess.x
new file mode 100644
index 00000000..52d0b06f
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfaccess.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpf.h"
+
+# QPF_ACCESS -- Test the accessibility or existence of an existing image,
+# or the legality of the name of a new image.
+
+procedure qpf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O ok or err
+
+pointer	sp, fname
+int	btoi(), qp_access(), iki_validextn()
+string	qpf_extn QPF_EXTN
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	status = NO
+	if (extn[1] != EOS)
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+
+	if (acmode != NEW_IMAGE && acmode != NEW_COPY) {
+	    if (extn[1] == EOS) {
+		call iki_mkfname (root, qpf_extn, Memc[fname], SZ_PATHNAME)
+		status = qp_access (Memc[fname], acmode)
+		if (status != NO)
+		    call strcpy (qpf_extn, extn, MAX_LENEXTN)
+	    } else if (status != NO) {
+		call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+		status = qp_access (Memc[fname], acmode)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfclose.x b/sys/imio/iki/qpf/qpfclose.x
new file mode 100644
index 00000000..b4bad7b4
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfclose.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <imio.h>
+include "qpf.h"
+
+# QPF_CLOSE -- Close a QPOE image.
+
+procedure qpf_close (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+pointer	qpf
+
+begin
+	# Close the QPF virtual file driver.
+	if (IM_PFD(im) != NULL)
+	    call close (IM_PFD(im))
+
+	# Close the various descriptors.
+	qpf = IM_KDES(im)
+	if (QPF_IO(qpf) != NULL)
+	    call qpio_close (QPF_IO(qpf))
+	if (QPF_QP(qpf) != NULL)
+	    call qp_close (QPF_QP(qpf))
+
+	call mfree (qpf, TY_STRUCT)
+end
diff --git a/sys/imio/iki/qpf/qpfcopy.x b/sys/imio/iki/qpf/qpfcopy.x
new file mode 100644
index 00000000..ebc2fa5b
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfcopy.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"qpf.h"
+
+# QPF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure qpf_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I new extn
+int	status			#O output status
+
+pointer	sp
+pointer	oldname, newname
+errchk	qp_copy
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filename of old and new images.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, QPF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Copy the datafile.
+	iferr (call qp_copy (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfcopypar.x b/sys/imio/iki/qpf/qpfcopypar.x
new file mode 100644
index 00000000..cfa94c62
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfcopypar.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<qpset.h>
+include	"qpf.h"
+
+# QPF_COPYPARAMS -- Copy parameters from the QPOE datafile header into the
+# image header.  Only scalar parameters are copied.
+
+procedure qpf_copyparams (im, qp)
+
+pointer	im			#I image descriptor
+pointer	qp			#I QPOE descriptor
+
+int	nelem, dtype, maxelem, flags
+pointer	sp, param, text, comment, datatype, fl, qpf, mw, io
+
+pointer	qp_ofnlu(), qpio_loadwcs()
+int	qp_gnfn(), qp_queryf(), stridx(), strdic()
+errchk	qp_ofnlu, qp_gnfn, qp_queryf, imaddi, qp_geti, mw_saveim
+
+bool	qp_getb()
+short	qp_gets()
+int	qp_geti(), qp_gstr()
+real	qp_getr()
+double	qp_getd()
+
+begin
+	call smark (sp)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+	call salloc (comment, SZ_COMMENT, TY_CHAR)
+	call salloc (datatype, SZ_DATATYPE, TY_CHAR)
+
+	qpf = IM_KDES(im)
+
+	# Copy QPOE special keywords.
+	call imaddi (im, "NAXES",  qp_geti(qp,"naxes"))
+	call imaddi (im, "AXLEN1", qp_geti(qp,"axlen[1]"))
+	call imaddi (im, "AXLEN2", qp_geti(qp,"axlen[2]"))
+	call imaddr (im, "XBLOCK", QPF_XBLOCK(qpf))
+	call imaddr (im, "YBLOCK", QPF_YBLOCK(qpf))
+
+	# Output the QPOE filter.
+	iferr (call qpf_wfilter (qpf, im))
+	    call erract (EA_WARN)
+
+	# Compute and output any filter attributes.
+	iferr (call qpf_wattr (qpf, im))
+	    call erract (EA_WARN)
+
+	# Copy the WCS, if any.
+	io = QPF_IO(qpf)
+	if (io != NULL)
+	    ifnoerr (mw = qpio_loadwcs (io)) {
+		call mw_saveim (mw, im)
+		call mw_close (mw)
+	    }
+
+	# Copy general keywords.
+	fl = qp_ofnlu (qp, "*")
+
+	while (qp_gnfn (fl, Memc[param], SZ_FNAME) != EOF) {
+	    # Get the next scalar parameter which has a nonnull value.
+	    nelem = qp_queryf (qp, Memc[param], Memc[datatype], maxelem,
+		Memc[comment], flags)
+	    if (strdic (Memc[param], Memc[text], SZ_LINE, OMIT) > 0)
+		next
+
+	    dtype = stridx (Memc[datatype], "bcsilrdx")
+
+	    # Make entry for a parameter which has no value, or an unprintable
+	    # value.
+
+	    if (nelem == 0 || (nelem > 1 && dtype != TY_CHAR) ||
+		dtype < TY_BOOL || dtype > TY_COMPLEX) {
+
+		call sprintf (Memc[text], SZ_LINE, "%14s[%03d] %s")
+		    call pargstr (Memc[datatype])
+		    call pargi (nelem)
+		    call pargstr (Memc[comment])
+
+		iferr (call imastr (im, Memc[param], Memc[text]))
+		    call erract (EA_WARN)
+		next
+	    }
+
+	    # Copy parameter to image header.
+	    iferr {
+		switch (dtype) {
+		case TY_BOOL:
+		    call imaddb (im, Memc[param], qp_getb(qp,Memc[param]))
+		case TY_CHAR:
+		    if (qp_gstr (qp, Memc[param], Memc[text], SZ_LINE) > 0)
+			call imastr (im, Memc[param], Memc[text])
+		case TY_SHORT:
+		    call imadds (im, Memc[param], qp_gets(qp,Memc[param]))
+		case TY_INT, TY_LONG:
+		    call imaddi (im, Memc[param], qp_geti(qp,Memc[param]))
+		case TY_REAL:
+		    call imaddr (im, Memc[param], qp_getr(qp,Memc[param]))
+		case TY_DOUBLE:
+		    call imaddd (im, Memc[param], qp_getd(qp,Memc[param]))
+		case TY_COMPLEX:
+		    ; # not supported.
+		}
+	    } then {
+		call erract (EA_WARN)
+		break
+	    }
+	}
+
+	call qp_cfnl (fl)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfdelete.x b/sys/imio/iki/qpf/qpfdelete.x
new file mode 100644
index 00000000..c503c174
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfdelete.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# QPF_DELETE -- Delete a datafile.
+
+procedure qpf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension
+int	status			#O output status
+
+pointer	sp, fname
+errchk	qp_delete
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	iferr (call qp_delete (Memc[fname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfopen.x b/sys/imio/iki/qpf/qpfopen.x
new file mode 100644
index 00000000..99a57df1
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfopen.x
@@ -0,0 +1,165 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<mach.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<qpset.h>
+include	<qpioset.h>
+include	"qpf.h"
+
+# QPF_OPEN -- Open a QPOE image.  New QPOE images can only be written by
+# calling QPOE directly; under IMIO, only READ_ONLY access is supported.
+
+procedure qpf_open (kernel, im, o_im,
+	root, extn, ksection, cl_index, cl_size, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I [not used]
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I filename extension
+char	ksection[ARB]		#I QPIO filter expression
+int	cl_index		#I [not used]
+int	cl_size			#I [not used]
+int	acmode			#I [not used]
+int	status			#O ok|err
+
+int	n
+real	xblock, yblock, tol
+pointer	sp, qp, io, v, fname, qpf
+
+pointer	qp_open, qpio_open()
+real	qpio_statr(), qp_statr()
+int	qpio_getrange(), qp_geti(), qp_gstr(), qp_lenf()
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (v, SZ_FNAME, TY_CHAR)
+
+	io = NULL
+	qp = NULL
+	qpf = NULL
+	tol = EPSILONR * 100
+
+	# The only valid cl_index for a QPOE image is -1 (none specified) or 1.
+	if (!(cl_index < 0 || cl_index == 1))
+	    goto err_
+
+	call malloc (qpf, LEN_QPFDES, TY_STRUCT)
+
+	# Open the QPOE file.
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	iferr (qp = qp_open (Memc[fname], READ_ONLY, 0)) {
+	    qp = NULL
+	    goto err_
+	}
+
+	# Open the event list under QPIO for sampled (pixel) i/o.
+	iferr (io = qpio_open (qp, ksection, READ_ONLY))
+	    io = NULL
+
+	# Determine the data range and pixel type.
+	iferr (IM_CTIME(im) = qp_geti (qp, "cretime"))
+	    IM_CTIME(im) = 0
+	iferr (IM_MTIME(im) = qp_geti (qp, "modtime"))
+	    IM_MTIME(im) = 0
+	iferr (IM_LIMTIME(im) = qp_geti (qp, "limtime"))
+	    IM_LIMTIME(im) = 0
+
+	# The min and max pixel values for a sampled event file depend
+	# strongly on the blocking factor, which is a runtime variable.
+	# Ideally when the poefile is written the vectors 'datamin' and
+	# 'datamax' should be computed for the main event list.  These
+	# give the min and max pixel values (counts/pixel) for each blocking
+	# factor from 1 to len(data[min|max]), i.e., the blocking factor
+	# serves as the index into these vectors.
+
+	if (io != NULL) {
+	    xblock = max (1.0, qpio_statr (io, QPIO_XBLOCKFACTOR))
+	    yblock = max (1.0, qpio_statr (io, QPIO_YBLOCKFACTOR))
+	} else {
+	    xblock = max (1.0, qp_statr (qp, QPOE_XBLOCKFACTOR))
+	    yblock = max (1.0, qp_statr (qp, QPOE_YBLOCKFACTOR))
+	}
+	call strcpy ("datamax", Memc[v], SZ_FNAME)
+	n = qp_lenf (qp, Memc[v])
+
+	if (n >= max(xblock,yblock)) {
+	    call sprintf (Memc[v+7], SZ_FNAME-7, "[%d]")
+		call pargi (nint((xblock+yblock)/2))
+	    IM_MAX(im) = qp_geti (qp, Memc[v])
+	    Memc[v+5] = 'i';  Memc[v+6] = 'n'
+	    IM_MIN(im) = qp_geti (qp, Memc[v])
+	} else
+	    IM_LIMTIME(im) = 0
+
+	# Set the image pixel type.  This is arbitrary, provided we have
+	# enough dynamic range to represent the maximum pixel value.
+
+	IM_PIXTYPE(im) = TY_INT
+	if (IM_LIMTIME(im) != 0 && IM_LIMTIME(im) >= IM_MTIME(im))
+	    if (int(IM_MAX(im)) <= MAX_SHORT)
+		IM_PIXTYPE(im) = TY_SHORT
+
+	# Set the image size parameters.  If the user has specified a rect
+	# within which i/o is to occur, set the logical image size to the
+	# size of the rect rather than the full matrix.
+
+	if (io != NULL) {
+	    IM_NDIM(im)  = qpio_getrange (io, QPF_VS(qpf,1), QPF_VE(qpf,1), 2)
+	    IM_LEN(im,1) = (QPF_VE(qpf,1) - QPF_VS(qpf,1) + 1) / xblock + tol
+	    IM_LEN(im,2) = (QPF_VE(qpf,2) - QPF_VS(qpf,2) + 1) / yblock + tol
+	} else {
+	    IM_NDIM(im)  = 2
+	    IM_LEN(im,1) = qp_geti (qp, "axlen[1]") / xblock + tol
+	    IM_LEN(im,2) = qp_geti (qp, "axlen[2]") / yblock + tol
+	    QPF_VS(qpf,1) = 1;	QPF_VE(qpf,1) = IM_LEN(im,1)
+	    QPF_VS(qpf,2) = 1;	QPF_VE(qpf,2) = IM_LEN(im,2)
+	}
+	call imioff (im, 1, YES, 1)
+
+	iferr (n = qp_gstr (qp, "title", IM_TITLE(im), SZ_IMTITLE))
+	    IM_TITLE(im) = EOS
+	iferr (n = qp_gstr (qp, "history", IM_HISTORY(im), SZ_IMHIST))
+	    IM_HISTORY(im) = EOS
+
+	call strcpy (root, IM_HDRFILE(im), SZ_IMHDRFILE)
+	IM_PIXFILE(im) = EOS
+	IM_HFD(im) = NULL
+	IM_PFD(im) = NULL
+
+	# Set up the QPF descriptor.
+	QPF_IM(qpf)	= im
+	QPF_QP(qpf)	= qp
+	QPF_IO(qpf)	= io
+	QPF_XBLOCK(qpf)	= xblock
+	QPF_YBLOCK(qpf)	= yblock
+	QPF_IOSTAT(qpf)	= 0
+
+	IM_KDES(im) = qpf
+
+	# Copy any scalar QPOE file header parameters into the IMIO header.
+	iferr (call qpf_copyparams (im, qp))
+	    call erract (EA_WARN)
+
+	status = OK
+	call sfree (sp)
+	return
+
+err_
+	# Error abort.
+	if (io != NULL)
+	    call qpio_close (io)
+	if (qp != NULL)
+	    call qp_close (qp)
+
+	call mfree (qpf, TY_STRUCT)
+	IM_KDES(im) = NULL
+
+	status = ERR
+	call erract (EA_WARN)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfopix.x b/sys/imio/iki/qpf/qpfopix.x
new file mode 100644
index 00000000..9b5750ff
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfopix.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"qpf.h"
+
+# QPF_OPIX -- Open the "pixel storage file", i.e., open the special QPF/QPOE
+# virtual file driver, which samples the QPOE event list in real time to
+# produce image "pixels", where each pixel contains a count of the number of
+# photons mapping to that point in the output image matrix.
+
+procedure qpf_opix (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O return status
+
+pointer	sp, fname, qpf
+extern	qpfzop(), qpfzrd(), qpfzwr(), qpfzwt(), qpfzst(), qpfzcl()
+int	fopnbf()
+
+begin
+	status = OK
+	if (IM_PFD(im) != NULL)
+	    return
+
+	# Verify that the QPIO open succeeded at open time; if not, the file
+	# may not have an event list (which is legal, but not for pixel i/o).
+
+	qpf = IM_KDES(im)
+	if (QPF_IO(qpf) == NULL) {
+	    status = ERR
+	    return
+	}
+
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Encode the QPF descriptor as a pseudo-filename to pass the descriptor
+	# through fopnbf to the QPF virtual binary file driver.
+
+	call sprintf (Memc[fname], SZ_FNAME, "QPF%d")
+	    call pargi (IM_KDES(im))
+
+	# Open a file descriptor for the dummy QPOE file driver, used to access
+	# the event list as a virtual pixel array (sampled at runtime).
+
+	iferr (IM_PFD(im) = fopnbf (Memc[fname], READ_ONLY,
+	    qpfzop, qpfzrd, qpfzwr, qpfzwt, qpfzst, qpfzcl)) {
+
+	    IM_PFD(im) = NULL
+	    status = ERR
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfrename.x b/sys/imio/iki/qpf/qpfrename.x
new file mode 100644
index 00000000..70f90626
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfrename.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"qpf.h"
+
+# QPF_RENAME -- Rename a datafile.
+
+procedure qpf_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I old image extn
+int	status			#O output status
+
+pointer	sp, oldname, newname
+errchk	qp_rename
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filenames of old and new datafiles.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, QPF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Rename the datafile.
+	iferr (call qp_rename (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfupdhdr.x b/sys/imio/iki/qpf/qpfupdhdr.x
new file mode 100644
index 00000000..9dd67ea6
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfupdhdr.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# QPF_UPDHDR -- Update the image header.  This is a no-op for QPF since the
+# datafiles can only be accessed READ_ONLY via IMIO.
+
+procedure qpf_updhdr (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+begin
+	status = OK
+end
diff --git a/sys/imio/iki/qpf/qpfwattr.x b/sys/imio/iki/qpf/qpfwattr.x
new file mode 100644
index 00000000..b48a6793
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfwattr.x
@@ -0,0 +1,191 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<qpioset.h>
+include	"qpf.h"
+
+# QPF_WATTR -- Record information about the attributes of the filter
+# expression used to generate an image.  Currently the only value which can be
+# computed and recorded is total range (integral of the in-range intervals) of
+# the range list defining an attribute, for example, the total exposure time
+# defined by the time range list used to filter the data.
+#
+# This routine is driven by a set of optional QPOE header keywords of the
+# form
+#
+#	Keyword		String Value
+#
+#	defattrN	<param-name> = "integral" <attribute-name>[:type]
+# e.g.
+#	defattr1	"exptime = integral time:d"
+#
+# where param-name is the parameter name to be written to the output image
+# header, "integral" is the value to be computed, and attribute-name is the
+# QPEX attribute (e.g., "time") to be used for the computation.  A finite
+# value is returned for the integral if a range list is given for the named
+# attribute and the range is closed.  If the range is open on either or both
+# ends, or no range expression is defined for the attribute, then INDEF is
+# returned for the value of the integral.
+
+procedure qpf_wattr (qpf, im)
+
+pointer	qpf				#I QPF descriptor
+pointer	im				#I image descriptor
+
+real	r1, r2, rsum
+double	d1, d2, dsum
+int	dtype, i, j, xlen, nranges, i1, i2, isum
+pointer	sp, io, qp, ex, kwname, kwval, pname, funame, atname, ip, xs, xe
+
+bool	strne()
+pointer	qpio_stati()
+int	qp_gstr(), ctowrd(), qp_accessf()
+int	qpex_attrli(), qpex_attrlr(), qpex_attrld()
+errchk	qpex_attrli, qpex_attrlr, qpex_attrld, imaddi, imaddr, imaddd
+
+begin
+	io = QPF_IO(qpf)
+	if (io == NULL)
+	    return
+
+	qp = QPF_QP(qpf)
+	ex = qpio_stati (io, QPIO_EX)
+
+	call smark (sp)
+	call salloc (kwname, SZ_FNAME, TY_CHAR)
+	call salloc (kwval, SZ_LINE, TY_CHAR)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+	call salloc (funame, SZ_FNAME, TY_CHAR)
+	call salloc (atname, SZ_FNAME, TY_CHAR)
+
+	# Process a sequence of "defattrN" header parameter definitions.
+	# Each defines a parameter to be computed and added to the output
+	# image header.
+
+	do i = 1, ARB {
+	    # Check for a parameter named "defattrN", get string value.
+	    call sprintf (Memc[kwname], SZ_FNAME, "defattr%d")
+		call pargi (i)
+
+	    if (qp_accessf (qp, Memc[kwname]) == NO)
+		break
+	    if (qp_gstr (qp, Memc[kwname], Memc[kwval], SZ_LINE) <= 0)
+		break
+
+	    # Parse string value into parameter name, function name,
+	    # expression attribute name, and datatype.
+
+	    ip = kwval
+	    if (ctowrd (Memc, ip, Memc[pname], SZ_FNAME) <= 0)
+		break
+	    while (IS_WHITE(Memc[ip]) || Memc[ip] == '=')
+		ip = ip + 1
+	    if (ctowrd (Memc, ip, Memc[funame], SZ_FNAME) <= 0)
+		break
+	    if (ctowrd (Memc, ip, Memc[atname], SZ_FNAME) <= 0)
+		break
+
+	    dtype = TY_INT
+	    for (ip=atname;  Memc[ip] != EOS;  ip=ip+1)
+		if (Memc[ip] == ':') {
+		    Memc[ip] = EOS
+		    if (Memc[ip+1] == 'd')
+			dtype = TY_DOUBLE
+		    else if (Memc[ip+1] == 'r')
+			dtype = TY_REAL
+		    else
+			call eprintf ("QPF.defattr: datatype not recognized\n")
+		}
+
+	    # Verify known function type.
+	    if (strne (Memc[funame], "integral")) {
+		call eprintf ("QPF.defattr: function `%s' not recognized\n")
+		    call pargstr (Memc[funame])
+		break
+	    }
+
+	    # Compute the integral of the range list for the named attribute.
+	    xlen = 0
+	    xs = NULL  
+	    xe = NULL
+
+	    switch (dtype) {
+	    case TY_REAL:
+		if (ex == NULL)
+		    nranges = 0
+		else
+		    nranges = qpex_attrlr (ex, Memc[atname], xs, xe, xlen)
+
+		if (nranges <= 0)
+		    rsum = INDEFR
+		else {
+		    rsum = 0
+		    do j = 1, nranges {
+			r1 = Memr[xs+j-1]
+			r2 = Memr[xe+j-1]
+			if (IS_INDEFR(r1) || IS_INDEFR(r2)) {
+			    rsum = INDEFR
+			    break
+			} else
+			    rsum = rsum + (r2 - r1)
+		    }
+		}
+
+		call mfree (xs, TY_REAL)
+		call mfree (xe, TY_REAL)
+		call imaddr (im, Memc[pname], rsum)
+
+	    case TY_DOUBLE:
+		if (ex == NULL)
+		    nranges = 0
+		else
+		    nranges = qpex_attrld (ex, Memc[atname], xs, xe, xlen)
+
+		if (nranges <= 0)
+		    dsum = INDEFD
+		else {
+		    dsum = 0
+		    do j = 1, nranges {
+			d1 = Memd[xs+j-1]
+			d2 = Memd[xe+j-1]
+			if (IS_INDEFD(d1) || IS_INDEFD(d2)) {
+			    dsum = INDEFD
+			    break
+			} else
+			    dsum = dsum + (d2 - d1)
+		    }
+		}
+
+		call mfree (xs, TY_DOUBLE)
+		call mfree (xe, TY_DOUBLE)
+		call imaddd (im, Memc[pname], dsum)
+
+	    default:
+		if (ex == NULL)
+		    nranges = 0
+		else
+		    nranges = qpex_attrli (ex, Memc[atname], xs, xe, xlen)
+
+		if (nranges <= 0)
+		    isum = INDEFI
+		else {
+		    isum = 0
+		    do j = 1, nranges {
+			i1 = Memi[xs+j-1]
+			i2 = Memi[xe+j-1]
+			if (IS_INDEFI(i1) || IS_INDEFI(i2)) {
+			    isum = INDEFI
+			    break
+			} else
+			    isum = isum + (i2 - i1)
+		    }
+		}
+
+		call mfree (xs, TY_INT)
+		call mfree (xe, TY_INT)
+		call imaddi (im, Memc[pname], isum)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/qpfwfilter.x b/sys/imio/iki/qpf/qpfwfilter.x
new file mode 100644
index 00000000..e521cbc6
--- /dev/null
+++ b/sys/imio/iki/qpf/qpfwfilter.x
@@ -0,0 +1,53 @@
+include	"qpf.h"
+
+# QPF_WFILTER -- Record the QPIO filter used to generate an image as a series
+# of FITS cards in the image header.  Note: excessively long filters are
+# truncated to avoid overfilling the image header.
+
+procedure qpf_wfilter (qpf, im)
+
+pointer	qpf				#I QPF descriptor
+pointer	im				#I image descriptor
+
+int	nchars, nleft, index
+pointer	io, sp, bp, ip, kw, strval
+errchk	qpio_getfilter, impstr
+int	qpio_getfilter()
+
+begin
+	io = QPF_IO(qpf)
+	if (io == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (kw, SZ_KWNAME, TY_CHAR)
+	call salloc (bp, SZ_MAXFILTER, TY_CHAR)
+	call salloc (strval, SZ_BIGSTR, TY_CHAR)
+
+	# Get the filter as as string from QPIO.
+	nchars = qpio_getfilter (io, Memc[bp], SZ_MAXFILTER)
+
+	# If the filter is longer than our string buffer, write a "..." at
+	# the end of the filter to indicate that it is being truncated.
+
+	if (nchars == SZ_MAXFILTER)
+	    call strcpy ("...", Memc[bp+nchars-3], 3)
+
+	index = 1
+	ip = bp
+
+	# Output a series of QPFILTnn cards to record the full filter.
+	for (nleft = nchars;  nleft > 0;  nleft = nleft - SZ_BIGSTR) {
+	    call strcpy (Memc[ip], Memc[strval], SZ_BIGSTR)
+	    call sprintf (Memc[kw], SZ_KWNAME, "QPFILT%02d")
+		call pargi (index)
+	    iferr (call imaddf (im, Memc[kw], "c"))
+		;
+	    call impstr (im, Memc[kw], Memc[strval])
+
+	    ip = ip + SZ_BIGSTR
+	    index = index + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/qpf/zfioqp.x b/sys/imio/iki/qpf/zfioqp.x
new file mode 100644
index 00000000..0e1c38ff
--- /dev/null
+++ b/sys/imio/iki/qpf/zfioqp.x
@@ -0,0 +1,189 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fio.h>
+include	<qpioset.h>
+include	"qpf.h"
+
+# ZFIOQP -- QPF virtual file driver.  This driver presents to the caller a
+# virtual file space containing a two dimensional array of type short or int
+# pixels, wherein each "pixel" is a count of the number of events from a
+# QPOE event list which map into that pixel.  An i/o request results in
+# runtime filtering and sampling of the event list, mapping each event which
+# passes the filter into the corresponding output pixel, and incrementing the
+# value of that pixel to count the event.
+
+# QPFZOP -- Open the file driver for i/o on the QPIO descriptor opened at
+# qpf_open time.
+
+procedure qpfzop (pkfn, mode, status)
+
+char	pkfn[ARB]		#I packed virtual filename from FIO
+int	mode			#I file access mode (ignored)
+int	status			#O output status - i/o channel if successful
+
+int	ip
+pointer	sp, fn, qpf
+int	ctoi()
+
+begin
+	call smark (sp)
+	call salloc (fn, SZ_FNAME, TY_CHAR)
+
+	# The QPF descriptor is passed encoded in the pseudo filename as
+	# "QPFxxxx" (decimal).  Extract this and return it as the i/o
+	# channel for the driver.
+
+	ip = 4
+	call strupk (pkfn, Memc[fn], SZ_FNAME)
+	if (ctoi (Memc[fn], ip, qpf) <= 0)
+	    status = ERR
+	else
+	    status = qpf
+
+	QPF_IOSTAT(qpf) = 0
+	call sfree (sp)
+end
+
+
+# QPFZCL -- Close the QPF binary file driver.
+
+procedure qpfzcl (chan, status)
+
+int	chan			#I QPF i/o channel
+int	status			#O output status
+
+begin
+	status = OK
+end
+
+
+# QPFZRD -- Read a segment of the virtual pixel array into the output buffer,
+# i.e., zero the output buffer and sample the event list, accumulating counts
+# in the output array.
+
+procedure qpfzrd (chan, obuf, nbytes, boffset)
+
+int	chan			#I QPF i/o channel
+char	obuf[ARB]		#O output buffer
+int	nbytes			#I nbytes to be read
+int	boffset			#I file offset at which read commences
+
+pointer	qpf, im, io
+int	vs[2], ve[2]
+real	xblock, yblock
+int	szb_pixel, ncols, pixel, nev, xoff, yoff
+int	qpio_readpixs(), qpio_readpixi()
+
+include	<szpixtype.inc>
+
+begin
+	qpf = chan
+	im  = QPF_IM(qpf)
+	io  = QPF_IO(qpf)
+
+	xblock = QPF_XBLOCK(qpf)
+	yblock = QPF_YBLOCK(qpf)
+	ncols = IM_PHYSLEN(im,1)
+	xoff  = QPF_VS(qpf,1)
+	yoff  = QPF_VS(qpf,2)
+	szb_pixel = pix_size[IM_PIXTYPE(im)] * SZB_CHAR
+
+	# Convert boffset, nbytes to vs, ve.
+	pixel = (boffset - 1) / szb_pixel
+	vs[1] = (mod (pixel, ncols)) * xblock + xoff
+	vs[2] = (pixel / ncols) * yblock + yoff
+
+	pixel = (boffset-1 + nbytes - szb_pixel) / szb_pixel
+	ve[1] = (mod (pixel, ncols)) * xblock + (xblock-1) + xoff
+	ve[2] = (pixel / ncols) * yblock + (yblock-1) + yoff
+
+	# Call readpix to sample image into the output buffer.  Zero the buffer
+	# first since the read is additive.
+
+	call aclrc (obuf, nbytes / SZB_CHAR)
+	iferr {
+	    switch (IM_PIXTYPE(im)) {
+	    case TY_SHORT:
+		nev = qpio_readpixs (io, obuf, vs, ve, 2, xblock, yblock)
+	    case TY_INT:
+		nev = qpio_readpixi (io, obuf, vs, ve, 2, xblock, yblock)
+	    }
+	} then {
+	    QPF_IOSTAT(qpf) = ERR
+	} else
+	    QPF_IOSTAT(qpf) = nbytes
+end
+
+
+# QPFZWR -- Write to the virtual pixel array.  QPF permits only read-only
+# access, but we ignore write requests, so return OK and do nothing if this
+# routine is called.
+
+procedure qpfzwr (chan, ibuf, nbytes, boffset)
+
+int	chan			#I QPF i/o channel
+char	ibuf[ARB]		#O datg buffer
+int	nbytes			#I nbytes to be written
+int	boffset			#I file offset to write at
+
+pointer	qpf
+
+begin
+	qpf = chan
+	QPF_IOSTAT(qpf) = nbytes
+end
+
+
+# QPFZWT -- Return the number of virtual bytes transferred in the last i/o
+# request.
+
+procedure qpfzwt (chan, status)
+
+int	chan			#I QPF i/o channel
+int	status			#O i/o channel status
+
+pointer	qpf
+
+begin
+	qpf = chan
+	status = QPF_IOSTAT(qpf)
+end
+
+
+# QPFZST -- Query device/file parameters.
+
+procedure qpfzst (chan, param, value)
+
+int	chan			#I QPF i/o channel
+int	param			#I parameter to be returned
+int	value			#O parameter value
+
+pointer	qpf, im, io
+int	szb_pixel, npix
+int	qpio_stati()
+
+include	<szpixtype.inc>
+
+begin
+	qpf = chan
+	im = QPF_IM(qpf)
+	io = QPF_IO(qpf)
+	npix = IM_PHYSLEN(im,1) * IM_PHYSLEN(im,2)
+	szb_pixel = pix_size[IM_PIXTYPE(im)] * SZB_CHAR
+
+	switch (param) {
+	case FSTT_BLKSIZE:
+	    value = 1
+	case FSTT_FILSIZE:
+	    value = npix * szb_pixel
+	case FSTT_OPTBUFSIZE:
+	    value = min (npix*szb_pixel, qpio_stati(io,QPIO_OPTBUFSIZE))
+	case FSTT_MAXBUFSIZE:
+	    value = npix * szb_pixel
+	default:
+	    value = ERR
+	}
+end
diff --git a/sys/imio/iki/stf/README b/sys/imio/iki/stf/README
new file mode 100644
index 00000000..5540110b
--- /dev/null
+++ b/sys/imio/iki/stf/README
@@ -0,0 +1,300 @@
+IKI/STF -- IKI kernel for the STScI SDAS/GEIS image format.  This format stores
+images in a format which resembles FITS group format.  A GROUP FORMAT IMAGE is
+a set of one or more images, all of which are the same size, dimension, and
+datatype, and which share a common FITS header.  The individual images in a
+group each has a binary GROUP PARAMETER BLOCK (GPB).  The image and associated
+group parameter block are commonly referred to as a GROUP.  A group format
+image consists of two files, the FITS format header file for the group,
+and the pixel file containing the image data and GPBs.
+
+
+1. Typical STF group format FITS image header (imname.hhh)
+
+	SIMPLE	=		    F		/ Standard STF keywords
+	BITPIX	=		    32
+	DATATYPE= 'REAL*4	'
+	NAXIS	=		    2
+	NAXIS1	=		    512
+	NAXIS2	=		    512
+	GROUPS	=		    T
+	PSIZE	=		    512
+	GCOUNT	=		    1
+	PCOUNT	=		    12
+
+	PTYPE1	= 'DATAMIN	'		/ Define binary group params
+	PSIZE1	= 		    32
+	PDTYPE1	= 'REAL*4	'
+	    (etc, for a total of 3*PCOUNT entries)
+
+	(special keywords and HISTORY cards)
+
+
+2. Pixel file format (imname.hhd) (byte stream, no alignment, no header)
+
+	[1].pixels
+	[1].group parameter block
+	[2].pixels
+	[2].group parameter block
+		...
+	[GCOUNT].pixels
+	[GCOUNT].group parameter block
+
+
+The chief problems with this format are that the FITS format header can contain
+only parameters which pertain to the group as a whole, while the format of the
+GPBs is fixed at image creation time.  Images may be neither deleted from nor
+added to a group.  It is possible for parameters in the FITS header to have
+the same names as parameters in the GPBs.  Multiple entries for the same
+keyword may appear in the FITS header and the format does not define how
+these are to be handled.  Although the format is general enough to support
+any datatype pixels, in practice only REAL*4 can be used as the SDAS software
+maps the pixfile directly into virtual memory.
+
+CAVEAT -- This is an awkward interface and some liberties have been taken in
+the code (hidden, subtle semantics, etc.).  At least we were able to confine
+the bad code to this one directory; any problems can be fixed without any
+changes to the rest of IMIO.  All of this low level code is expected to be
+thrown out when IMIO is cut over onto DBIO (the upcoming IRAF database
+interface).
+
+
+IKI/STF Pseudocode
+----------------------------
+
+1. Data structures:
+
+	1.1 IMIO image descriptor
+	    header, pixel file descriptors
+	    pointer to additional kernel descriptor, if any
+	    index of IKI kernel in use
+	    pathnames of header, pixel files
+	    IM_NDIM, IM_LEN, etc., physical image parameters
+
+	1.2 STF image descriptor
+	    Pointed to by IM_KDES field of IMIO descriptor.
+	    Contains values of all reserved fields of STF image header,
+		some of which duplicate values in IMIO descriptor.
+	    Group, gcount, size of a group in pixfile, description of
+		the group parameter block, i.e., for each parameter,
+		the offset, datatype type, name, length if array, etc.
+
+	1.3 IMIO user area (FITS cards)
+	    While an image is open, the first few cards in the user area
+		contain the FITS encoded group parameters.
+	    The remainder of the user area contains an exact image of
+		all non-reserved keyword cards found in the STF image
+		header (or in the header of some other type of image
+		when making a new_copy of an image stored in some other
+		format).
+
+
+2. Major Procedures
+
+procedure open_image
+
+begin
+	if (mode is not new_image or new_copy) {
+	    open_existing_image
+	    return
+	}
+
+	We are opening a new_image or new_copy image.  The problem here is
+	that the new image might be a group within an existing group format
+	image.  This ambiguity is resolved by a simple test on the group
+	index, rather than by a context dependent test on the existence of
+	the group format image.  If the mode is new_whatever and the group
+	is 1, a new group format image is created, else if the group is > 1,
+	the indicated group is initialized in an existing group format image.
+
+	if (group > 1) {
+	    We are opening a new group within an existing group format image.
+
+	    Call open_existing_image to open the group without reading the
+		group parameter block, which has not yet been initialized.
+
+	    if (mode is new_image)
+		initialize GPB to pixel coords
+	    else if (mode is new_copy)
+		copy old GPB to new image; transform coords if necessary
+
+	    Note that when opening a new copy of an existing image as a new
+	    group within a group format image, it is not clear what to do
+	    with the FITS header of the old image.  Our solution is to ignore
+	    it, and retain only the GPB, the only part of the old header
+	    pertaining directly to the group being accessed.
+
+	} else if (opening group 1 of a new image) {
+	    We are creating a new group format image.
+
+	    if (mode is new_image)
+		open_new_image
+	    else
+		open_new_copy
+	}
+end
+
+
+procedure open_existing_image
+
+begin
+	Allocate STF descriptor, save pointer in imio descriptor.
+	Open image header.
+
+	Read header:
+		process reserved cards into STF descriptor
+		spool other cards
+
+	Load group data block from pixfile, get datamin/datamax:
+		if (there is a gdb) {
+		    open pixfile
+		    read gdb into buffer
+		    for (each param in gdb) {
+			set up parameter descriptor
+			format FITS card and put in imio user area
+		    }
+		}
+
+		fetch datamin, datamax from user area
+
+	Set IM_MIN, IM_MAX, IM_LIMTIME from DATAMIN, DATAMAX.
+	Mark end of user area.
+	Copy spooled cards to user area.
+		(increase size of user area if necessary)
+
+	Call imioff to set up imio pixel offset parameters
+end
+
+
+procedure open_new_image
+
+begin
+	Upon entry, the imio iminie procedure has already been called to
+	    initialize the imio descriptor for the new image.
+
+	Allocate STF descriptor, save pointer in imio descriptor.
+	Create header file from template dev$pix.hhh.
+	Open new image header.
+
+	(At this point the IMIO header fields IM_NDIM, IM_LEN, etc., and
+	(the STF descriptor fields have not yet been set, and cannot be set
+	(until the image dimensions have been defined by the high level code.
+	(imopix() will later have to fix up the remaining header fields and
+	(set up the default group data block.
+end
+
+
+procedure open_new_copy
+
+begin
+	Upon entry, the imio immaky procedure has already been called to
+	    copy the old header to the new and initialize the data
+	    dependent fields.  This will include the FITS encoded group
+	    parameters in the user area of the old image.
+
+	Allocate STF descriptor, save pointer in imio descriptor.
+	Create header file from template dev$pix.hhh.
+	Open new image header.
+
+	Copy the STF descriptor of the old image to the new.  Preserve
+	    the parameter marking the end of the GPB area of the old
+	    user area, as we do not want to write these cards when the
+	    header is updated.
+
+	(At this point all header information is set up, except that there
+	(is no pixel file and the pixfile offsets have not been set.
+	(Provided the image dimensions do not change, one could simply
+	(set the pixfile name, call imioff, and do i/o to the image.
+end
+
+
+procedure open_pixel_file
+
+begin
+	(We are called when the first i/o is done to an image.  When writing
+	(to a new image, the user may change any of the image header attributes
+	(after the open and before we are called.
+
+	if (pixel file already open)
+	    return
+	else if (opening existing image) {
+	    open pixel file
+	    return
+	}
+
+	if (opening a new image) {
+	    Given the values of IM_NDIM and IM_LEN set by the user, set up the
+	    STF descriptor including the default group parameter block.  Add
+	    the FITS encoded cards for the GPB to the image header.  Mark the
+	    end of the GPB cards, i.e., the start of the real user parameter
+	    area.  Ignore IM_PIXTYPE; always open an image of type real since
+	    that is what the SDAS software requires.  Set up the WCS to linear
+	    pixel coordinates.
+
+	} else if (opening a new_copy image) {
+	    (The STF descriptor and GPB will already have been set up as a
+	    (copy of the data structures used by the old image.  However,
+	    (the user may have changed the values of IM_NDIM and IM_LEN
+	    (since the image was opened, and the value of GCOUNT set when
+	    (the image was opened may be different than that of the old image.
+
+	    Transform the coordinate system of the old image to produce the
+	    WCS for the new image, i.e., if an image section was used to
+	    reference the old image.
+
+	    Make a new STF descriptor using the values of IM_NDIM and IM_LEN
+	    given, as for a new_image, but using the WCS information for the
+	    new image.  The FITS encoded fields in the IMIO user area will be
+	    automatically updated by the IMADD functions, or new cards added
+	    if not present.
+
+	    Merge any additional fields from the old STF descriptor into the
+	    new one, e.g., any instrument dependent parameters stored in the
+	    GPB.
+
+	    (The STF and FITS encoded user area should now contain a full
+	    (description of the GPB for the new image.
+	}
+
+	Allocate the pixel file, using the GCOUNT parameter set in the
+	    STF descriptor at stf_open time.
+	Open the pixel file.
+
+	Set IM_MIN and IM_MAX to zero (not defined).
+	Call IMIOFF to initialize the pixel offsets.
+end
+
+
+procedure update_image_header
+
+begin
+	Update the values of DATAMIN, DATAMAX from the IMIO header fields.
+
+	Update the binary GPB in the pixel file from the FITS encoded GPB
+	    in the IMIO user area, using the GPB structure defined in the
+	    STF descriptor.
+
+	Update the STF image header file:
+	    Open a new, empty header file using FMKCOPY and OPEN.
+	    Format and output FITS cards for the reserved header fields,
+		e.g., SIMPLE, BITPIX, GCOUNT, the GPB information, etc.
+	    Copy the user area to the new header file, excluding the
+		GPB cards at the beginning of the user area.
+	    Close the new header file and replace the old header file
+		with the new one via a rename operation.
+end
+
+
+procedure close_image
+
+begin
+	(We assume that IMIO has already update the image header if such
+	(is necessary.
+
+	if (pixel file open)
+	    close pixel file
+	if (header file open)
+	    close header file
+
+	deallocate STF descriptor
+	(IMIO will deallocate the IMIO descriptor)
+end
diff --git a/sys/imio/iki/stf/mkpkg b/sys/imio/iki/stf/mkpkg
new file mode 100644
index 00000000..b28ace96
--- /dev/null
+++ b/sys/imio/iki/stf/mkpkg
@@ -0,0 +1,36 @@
+# Make the IKI/STF interface (STScI SDAS/GEIS group format images)
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	#$set XFLAGS = "$(XFLAGS) -qfx"
+	#$set XFLAGS = "$(XFLAGS) -/pg"
+
+	stfaccess.x	stf.h
+	stfaddpar.x	<imhdr.h> <imio.h> <mach.h> stf.h
+	stfclose.x	stf.h <imhdr.h> <imio.h>
+	stfcopy.x	stf.h <error.h>
+	stfcopyf.x	stf.h
+	stfctype.x	stf.h <ctype.h>
+	stfdelete.x	stf.h <error.h> <imhdr.h>
+	stfget.x	stf.h <ctype.h>
+	stfhextn.x	stf.h <imhdr.h> <imio.h>
+	stfiwcs.x	stf.h <imhdr.h>
+	stfmerge.x	stf.h <imhdr.h> <imio.h> <mach.h>
+	stfmkpfn.x	stf.h
+	stfnewim.x	stf.h <imhdr.h> <imio.h> <mach.h>
+	stfopen.x	stf.h <error.h> <imhdr.h> <imio.h>
+	stfopix.x	stf.h <fset.h> <imhdr.h> <imio.h> <mach.h>
+	stfordgpb.x	stf.h <mach.h>
+	stfrdhdr.x	stf.h <finfo.h> <imhdr.h> <imio.h> <mach.h>
+	stfreblk.x	stf.h <imhdr.h> <imio.h>
+	stfrename.x	stf.h <error.h>
+	stfrfits.x	stf.h <ctype.h> <finfo.h> <fset.h> <imhdr.h> <imio.h>
+	stfrgpb.x	stf.h <imhdr.h> <imio.h> <mach.h>
+	stfupdhdr.x	stf.h <imhdr.h> <imio.h>
+	stfwfits.x	stf.h <error.h> <fio.h> <imhdr.h> <imio.h>
+	stfwgpb.x	stf.h <error.h> <imhdr.h> <imio.h> <mach.h>
+	;
diff --git a/sys/imio/iki/stf/stf.h b/sys/imio/iki/stf/stf.h
new file mode 100644
index 00000000..bf99a07c
--- /dev/null
+++ b/sys/imio/iki/stf/stf.h
@@ -0,0 +1,77 @@
+# STF.H -- IKI/STF internal definitions.
+
+define	HDR_TEMPLATE	"dev$pix.hhh"	# used by fmkcopy to create new header
+define	MAX_LENEXTN	3		# max length imagefile extension
+define	STF_HDRPATTERN	"^??h"		# class of legal header extensions
+define	STF_DEFHDREXTN	"hhh"		# default header file extension
+define	STF_DEFPIXEXTN	"hhd"		# default pixel file extension
+define	ENV_DEFIMTYPE	"imtype"	# name of environment variable
+define	STF_MAXDIM	7		# max NAXIS
+define	MAX_CACHE	5		# max cached header files
+define	DEF_CACHE	3		# default size of header file cache
+define	ENV_STFCACHE	"stfcache"	# environment variable for cache size
+define	MAX_PCOUNT	99		# max param descriptors
+define	SZ_DATATYPE	16		# e.g., `REAL*4'
+define	SZ_KEYWORD	8		# size of a FITS keyword
+define	SZ_PTYPE	8		# e.g., `CRPIX1'
+define	SZ_PDTYPE	16		# e.g., `CHAR*8'
+define	SZ_COMMENT	FITS_SZCOMMENT	# comment string for GPB card
+define	SZ_EXTRASPACE	(81*32)		# extra space for new cards in header
+
+define	FITS_RECLEN	80		# length of a FITS record (card)
+define	FITS_STARTVALUE	10		# first column of value field
+define	FITS_ENDVALUE	30		# last  column of value field
+define	FITS_SZVALSTR	21		# nchars in value string
+define	FITS_SZCOMMENT	50		# max chars in comment, incl. /
+
+# STF image descriptor, used internally by the STF interface.  The required
+# header parameters are maintained in this descriptor, everything else is
+# simply copied into the user area of the IMIO descriptor.
+
+define	LEN_STFDES	(LEN_STFBASE+MAX_PCOUNT*LEN_PDES)
+define	STF_CACHE	STF_BITPIX	# cache descriptor starting here
+define	STF_CACHELEN	(33+STF_PCOUNT($1)*LEN_PDES)
+define	LEN_STFBASE	43
+
+define	STF_ACMODE	Memi[$1]	# image access mode
+define	STF_NEWIMAGE	Memi[$1+1]	# creating entire new STF format image?
+define	STF_GROUP	Memi[$1+2]	# group to be accessed
+define	STF_SZGROUP	Memi[$1+3]	# size of image+hdr in pixfile, chars
+define	STF_PFD		Memi[$1+4]	# pixfile file descriptor
+define	STF_GRARG	Memi[$1+5]	# group index given in image name
+			# (extra space)
+define	STF_BITPIX	Memi[$1+10]	# bits per pixel
+define	STF_NAXIS	Memi[$1+11]	# number of axes in image
+define	STF_GROUPS	Memi[$1+12]	# group format?
+define	STF_GCOUNT	Memi[$1+13]	# number of groups in STF image
+define	STF_PSIZE	Memi[$1+14]	# size of GPB, bits
+define	STF_PCOUNT	Memi[$1+15]	# number of parameters in GPB
+define	STF_DATATYPE	Memc[P2C($1+16)]# datatype string
+define	STF_LENAXIS	Memi[$1+35+$2-1]# 35:41 = [7] max
+define	STF_PDES	(($1)+43+((($2)-1)*LEN_PDES))
+
+# GPB Parameter descriptor.
+define	LEN_PDES	81
+define	P_OFFSET	Memi[$1]	# struct offset of parameter
+define	P_SPPTYPE	Memi[$1+1]	# SPP datatype of parameter
+define	P_LEN		Memi[$1+2]	# number of elements
+define	P_PSIZE		Memi[$1+3]	# field size, bits
+define	P_PTYPEP	(P2C($1+4))	# pointer to parameter name
+define	P_PTYPE		Memc[P2C($1+4)]	# parameter name
+define	P_PDTYPE	Memc[P2C($1+13)]# datatype string
+define	P_COMMENT	Memc[P2C($1+30)]# comment string
+
+# Reserved FITS keywords known to this code.
+define	KW_BITPIX	1
+define	KW_DATATYPE	2
+define	KW_END		3
+define	KW_GCOUNT	4
+define	KW_GROUPS	5
+define	KW_NAXIS	6
+define	KW_NAXISN	7
+define	KW_PCOUNT	8
+define	KW_PDTYPE	9
+define	KW_PSIZE	10
+define	KW_PSIZEN	11
+define	KW_PTYPE	12
+define	KW_SIMPLE	13
diff --git a/sys/imio/iki/stf/stfaccess.x b/sys/imio/iki/stf/stfaccess.x
new file mode 100644
index 00000000..40907c69
--- /dev/null
+++ b/sys/imio/iki/stf/stfaccess.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stf.h"
+
+# STF_ACCESS -- Test the accessibility or existence of an existing image, or
+# the legality of the name of a new image.
+
+procedure stf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O return value
+
+int	i
+pointer	sp, fname, kextn
+int	access(), iki_validextn(), iki_getextn(), btoi()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (kextn, MAX_LENEXTN, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+	    call sfree (sp)
+	    return
+	}
+
+	status = NO
+
+	# If no extension was given, look for a file with the default
+	# extension, and return the actual extension if an image with the
+	# default extension is found.
+
+	if (extn[1] == EOS) {
+	    do i = 1, ARB {
+		if (iki_getextn (kernel, i, Memc[kextn], MAX_LENEXTN) <= 0)
+		    break
+		call iki_mkfname (root, Memc[kextn], Memc[fname], SZ_PATHNAME)
+		if (access (Memc[fname], acmode, 0) == YES) {
+		    call strcpy (Memc[kextn], extn, MAX_LENEXTN)
+		    status = YES
+		    break
+		}
+	    }		
+	} else if (iki_validextn (kernel, extn) == kernel) {
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	    if (access (Memc[fname], acmode, 0) == YES)
+		status = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfaddpar.x b/sys/imio/iki/stf/stfaddpar.x
new file mode 100644
index 00000000..65a90f80
--- /dev/null
+++ b/sys/imio/iki/stf/stfaddpar.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include "stf.h"
+
+# STF_ADDPAR -- Encode a parameter in FITS format and add it to the FITS format
+# IMIO user area; initialize the entry for the parameter in the GPB descriptor
+# as well.
+
+procedure stf_addpar (im, pname, dtype, plen, pval, pno)
+
+pointer	im			#I image descriptor
+char	pname[ARB]		#I parameter name
+int	dtype			#I SPP datatype of parameter
+int	plen			#I length (> 1 if array)
+char	pval[ARB]		#I string encoded initial parameter value
+int	pno			#U parameter number
+
+bool	bval
+real	rval
+double	dval
+short	sval
+long	lval
+pointer	pp, stf
+
+bool	initparam
+int	ival, ip, junk
+int	ctoi(), ctor(), ctod(), imaccf()
+errchk	imadds, imaddl, imaddr, imaddd, imastr
+
+begin
+	stf = IM_KDES(im)
+	pp  = STF_PDES(stf,pno)
+	ip  = 1
+
+	call strcpy (pname, P_PTYPE(pp), SZ_PTYPE)
+
+	# Initialize the parameter only if not already defined in header.
+	initparam = (imaccf (im, pname) == NO)
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call strcpy ("LOGICAL*4", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_BOOL * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		bval = (pval[1] == 'T')
+		call imaddb (im, P_PTYPE(pp), bval)
+	    }
+	case TY_SHORT:
+	    call strcpy ("INTEGER*2", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_SHORT * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctoi (pval, ip, ival)
+		sval = ival
+		call imadds (im, P_PTYPE(pp), sval)
+	    }
+	case TY_LONG:
+	    call strcpy ("INTEGER*4", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_LONG * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctoi (pval, ip, ival)
+		lval = ival
+		call imaddl (im, P_PTYPE(pp), lval)
+	    }
+	case TY_REAL:
+	    call strcpy ("REAL*4", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_REAL * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctor (pval, ip, rval)
+		call imaddr (im, P_PTYPE(pp), rval)
+	    }
+	case TY_DOUBLE:
+	    call strcpy ("REAL*8", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_DOUBLE * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctod (pval, ip, dval)
+		call imaddd (im, P_PTYPE(pp), dval)
+	    }
+	default:
+	    call sprintf (P_PDTYPE(pp), SZ_PDTYPE, "CHARACTER*%d")
+		call pargi (plen)
+	    P_PSIZE(pp) = plen * NBITS_BYTE
+	    if (initparam)
+		call imastr (im, P_PTYPE(pp), pval)
+	}
+
+	P_OFFSET(pp) = 0
+	P_SPPTYPE(pp) = dtype
+	P_LEN(pp) = plen
+
+	pno = pno + 1
+end
diff --git a/sys/imio/iki/stf/stfclose.x b/sys/imio/iki/stf/stfclose.x
new file mode 100644
index 00000000..89981578
--- /dev/null
+++ b/sys/imio/iki/stf/stfclose.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <imio.h>
+include	"stf.h"
+
+# STF_CLOSE -- Close an STF format image.  There is little for us to do, since
+# IMIO will already have updated the header if necessary and flushed any pixel
+# output.  Neither do we have to deallocate the IMIO descriptor, since it was
+# allocated by IMIO.
+
+procedure stf_close (im, status)
+
+pointer	im			# image descriptor
+int	status
+
+pointer	stf
+errchk	close
+
+begin
+	stf = IM_KDES(im)
+
+	# Close the pixel file and header file, if open.
+	if (STF_PFD(stf) != NULL)
+	    call close (STF_PFD(stf))
+	if (IM_HFD(im) != NULL)
+	    call close (IM_HFD(im))
+
+	# Deallocate the STF descirptor.
+	call mfree (IM_KDES(im), TY_STRUCT)
+	status = OK
+end
diff --git a/sys/imio/iki/stf/stfcopy.x b/sys/imio/iki/stf/stfcopy.x
new file mode 100644
index 00000000..e8643600
--- /dev/null
+++ b/sys/imio/iki/stf/stfcopy.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"stf.h"
+
+# STF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure stf_copy (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		# old image root name
+char	oextn[ARB]		# old image extn
+char	nroot[ARB]		# new image root name
+char	nextn[ARB]		# old image extn
+int	status
+
+pointer	sp
+pointer	ohdr_fname, opix_fname, nhdr_fname, npix_fname
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (opix_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (npix_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	call stf_mkpixfname (oroot, oextn, Memc[opix_fname], SZ_PATHNAME)
+	call stf_mkpixfname (nroot, nextn, Memc[npix_fname], SZ_PATHNAME)
+
+	# If the header cannot be copied, leave the pixfile alone.
+	iferr (call fcopy (Memc[ohdr_fname], Memc[nhdr_fname]))
+	    call erract (EA_WARN)
+	else iferr (call fcopy (Memc[opix_fname], Memc[npix_fname]))
+	    call erract (EA_WARN)
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/stf/stfcopyf.x b/sys/imio/iki/stf/stfcopyf.x
new file mode 100644
index 00000000..7402c879
--- /dev/null
+++ b/sys/imio/iki/stf/stfcopyf.x
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "stf.h"
+
+define	NKW	4		# number of reserved header keywords
+
+
+# STF_COPYFITS -- Copy the spooled FITS header, separating out the GPB cards
+# and returning either or both types of cards on the two output streams.
+
+procedure stf_copyfits (stf, spool, gpb, user)
+
+pointer	stf			#I pointer to STF descriptor
+int	spool			#I spooled header to read
+int	gpb			#I stream to receive GPB cards, or NULL
+int	user			#I stream to receive user cards, or NULL
+
+bool	keyword
+int	p_ch[MAX_PCOUNT+NKW]
+pointer	p_len[MAX_PCOUNT+NKW]
+pointer	p_namep[MAX_PCOUNT+NKW]
+int	delim, ch, npars, ngpbpars, i
+pointer	sp, lbuf, sbuf, pp, op, kw[NKW]
+int	strncmp(), getline(), strlen(), gstrcpy()
+errchk	getline, putline
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (sbuf, SZ_LINE, TY_CHAR)
+
+	# The following reserved keywords describing the GPB are added to
+	# the user area by stf_rdheader, and must be filtered out along with
+	# the group parameters.  Since the number of reserved or group
+	# parameters is normally small (only a dozen or so typically) a
+	# simple 1 character - 2 thread hashing scheme is probably faster,
+	# and certainly simpler, than a full hash table keyword lookup.
+
+	op = sbuf
+	npars = NKW
+	kw[1] = op;  op = op + gstrcpy ("GROUPS", Memc[op], ARB) + 1
+	kw[2] = op;  op = op + gstrcpy ("GCOUNT", Memc[op], ARB) + 1
+	kw[3] = op;  op = op + gstrcpy ("PCOUNT", Memc[op], ARB) + 1
+	kw[4] = op;  op = op + gstrcpy ("PSIZE",  Memc[op], ARB) + 1
+
+	do i = 1, npars {
+	    p_namep[i] = kw[i]
+	    p_len[i] = strlen(Memc[kw[i]])
+	    p_ch[i] = Memc[kw[i]+2]
+	}
+
+	# Add the GPB parameters to the list of group related parameters.
+	ngpbpars = min (MAX_PCOUNT, STF_PCOUNT(stf))
+	do i = 1, ngpbpars {
+	    npars = npars + 1
+	    pp = STF_PDES(stf,i)
+	    p_namep[npars] = P_PTYPEP(pp)
+	    p_len[npars] = strlen(P_PTYPE(pp))
+	    p_ch[npars] = Memc[p_namep[npars]+2]
+	}
+
+	# Determine the type of each card and copy it to the appropriate
+	# output stream.
+
+	while (getline (spool, Memc[lbuf]) != EOF) {
+	    # Does this user card redefine a reserved keyword?
+	    keyword = false
+	    ch = Memc[lbuf+2]
+	    do i = 1, npars {
+		if (ch != p_ch[i])
+		    next
+		delim = Memc[lbuf+p_len[i]]
+		if (delim != ' ' && delim != '=')
+		    next
+		if (strncmp (Memc[lbuf], Memc[p_namep[i]], p_len[i]) == 0) {
+		    keyword = true
+		    break
+		}
+	    }
+
+	    # Copy the card to the appropriate stream.
+	    if (keyword) {
+		if (gpb != NULL)
+		    call putline (gpb, Memc[lbuf])
+	    } else {
+		if (user != NULL)
+		    call putline (user, Memc[lbuf])
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfctype.x b/sys/imio/iki/stf/stfctype.x
new file mode 100644
index 00000000..9c48f65a
--- /dev/null
+++ b/sys/imio/iki/stf/stfctype.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stf.h"
+
+# STF_CTYPE -- Determine the type of a FITS card.  STF recognizes only those
+# cards which define the image format and the group parameter block.
+
+int procedure stf_ctype (card, index)
+
+char	card[ARB]			#I FITS card (or keyword)
+int	index				#O index number, if any
+
+int	ch1, ch2, ip
+int	strncmp(), ctoi()
+
+begin
+	ch1 = card[1]
+	ch2 = card[2]
+
+	# The set of keywords is fixed and small, so a simple brute force
+	# recognizer is about as good as anything.
+
+	if (ch1 == 'B') {
+	    if (ch2 == 'I')
+		if (strncmp (card, "BITPIX  ", 8) == 0)
+		    return (KW_BITPIX)				# BITPIX
+	} else if (ch1 == 'D') {
+	    if (ch2 == 'A')
+		if (strncmp (card, "DATATYPE", 8) == 0)
+		    return (KW_DATATYPE)			# DATATYPE
+	} else if (ch1 == 'E') {
+	    if (ch2 == 'N')
+		if (card[3] == 'D' && card[4] == ' ')
+		    return (KW_END)				# END card
+	} else if (ch1 == 'G') {
+	    if (ch2 == 'C') {
+		if (strncmp (card, "GCOUNT  ", 8) == 0)
+		    return (KW_GCOUNT)				# GCOUNT
+	    } else if (ch2 == 'R') {
+		if (strncmp (card, "GROUPS  ", 8) == 0)
+		    return (KW_GROUPS)				# GROUPS
+	    }
+	} else if (ch1 == 'N') {
+	    if (ch2 == 'A')
+		if (strncmp (card, "NAXIS", 5) == 0)
+		    if (card[6] == ' ')
+			return (KW_NAXIS)			# NAXIS
+		    else if (IS_DIGIT(card[6])) {
+			index = TO_INTEG(card[6])
+			return (KW_NAXISN)			# NAXISn
+		    }
+	} else if (ch1 == 'P') {
+	    if (ch2 == 'C') {
+		if (strncmp (card, "PCOUNT  ", 8) == 0)
+		    return (KW_PCOUNT)				# PCOUNT
+	    } else if (ch2 == 'D') {
+		if (strncmp (card, "PDTYPE", 6) == 0) {
+		    ip = 7
+		    if (ctoi (card, ip, index) > 0)
+			return (KW_PDTYPE)			# PDTYPEn
+		}
+	    } else if (ch2 == 'S') {
+		if (strncmp (card, "PSIZE", 5) == 0) {
+		    ip = 6
+		    if (card[ip] == ' ')
+			return (KW_PSIZE)
+		    else if (ctoi (card, ip, index) > 0)
+			return (KW_PSIZEN)			# PSIZEn
+		}
+	    } else if (ch2 == 'T') {
+		if (strncmp (card, "PTYPE", 5) == 0) {
+		    ip = 6
+		    if (ctoi (card, ip, index) > 0)
+			return (KW_PTYPE)			# PTYPEn
+		}
+	    }
+	} else if (ch1 == 'S') {
+	    if (ch2 == 'I')
+		if (strncmp (card, "SIMPLE  ", 8) == 0)
+		    return (KW_SIMPLE)				# SIMPLE
+	}
+
+	return (ERR)
+end
diff --git a/sys/imio/iki/stf/stfdelete.x b/sys/imio/iki/stf/stfdelete.x
new file mode 100644
index 00000000..dd319f12
--- /dev/null
+++ b/sys/imio/iki/stf/stfdelete.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	"stf.h"
+
+# STF_DELETE -- Delete an image.  A special operator is required since the
+# image is stored as two files.
+
+procedure stf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U header file extension
+int	status			#O return value
+
+pointer	sp
+pointer	hdr_fname, pix_fname
+int	access()
+
+begin
+	call smark (sp)
+	call salloc (hdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (pix_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filename.
+	call iki_mkfname (root, extn, Memc[hdr_fname], SZ_PATHNAME)
+	call stf_mkpixfname (root, extn, Memc[pix_fname], SZ_PATHNAME)
+
+	# If the header cannot be deleted, leave the pixfile alone.
+	iferr (call delete (Memc[hdr_fname]))
+	    call erract (EA_WARN)
+	else if (access (Memc[pix_fname],0,0) == YES) {
+	    iferr (call delete (Memc[pix_fname]))
+		call erract (EA_WARN)
+	}
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfget.x b/sys/imio/iki/stf/stfget.x
new file mode 100644
index 00000000..bacbc8d7
--- /dev/null
+++ b/sys/imio/iki/stf/stfget.x
@@ -0,0 +1,97 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stf.h"
+
+# STF_GETI -- Return the integer value of a FITS encoded card.
+
+procedure stf_geti (card, ival)
+
+char	card[ARB]		# card to be decoded
+int	ival			# receives integer value
+
+int	ip, ctoi()
+char	sval[FITS_SZVALSTR]
+
+begin
+	call stf_gets (card, sval, FITS_SZVALSTR)
+	ip = 1
+	if (ctoi (sval, ip, ival) <= 0)
+	    ival = 0
+end
+
+
+# STF_GETB -- Return the boolean/integer value of a FITS encoded card.
+
+procedure stf_getb (card, bval)
+
+char	card[ARB]		# card to be decoded
+int	bval			# receives YES/NO
+
+char	sval[FITS_SZVALSTR]
+
+begin
+	call stf_gets (card, sval, FITS_SZVALSTR)
+	if (sval[1] == 'T')
+	    bval = YES
+	else
+	    bval = NO
+end
+
+
+# STF_GETS -- Get the string value of a FITS encoded card.  Strip leading
+# and trailing whitespace and any quotes.
+
+procedure stf_gets (card, outstr, maxch)
+
+char	card[ARB]		# FITS card to be decoded
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+int	ip, op
+int	ctowrd(), strlen()
+
+begin
+	ip = FITS_STARTVALUE
+	if (ctowrd (card, ip, outstr, maxch) > 0) {
+	    # Strip trailing whitespace.
+	    op = strlen (outstr)
+	    while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n'))
+		op = op - 1
+	    outstr[op+1] = EOS
+	} else
+	    outstr[1] = EOS
+end
+
+
+# STF_GETCMT -- Get the comment field of a FITS encoded card.
+
+procedure stf_getcmt (card, comment, maxch)
+
+char	card[ARB]		#I FITS card to be decoded
+char	comment[ARB]		#O output string to receive comment
+int	maxch			#I max chars out
+
+int	ip, op
+int	lastch
+
+begin
+	# Find the slash which marks the beginning of the comment field.
+	ip = FITS_ENDVALUE + 1
+	while (card[ip] != EOS && card[ip] != '\n' && card[ip] != '/')
+	    ip = ip + 1
+
+	# Copy the comment to the output string, omitting the /, any
+	# trailing blanks, and the newline.
+
+	lastch = 0
+	do op = 1, maxch {
+	    if (card[ip] == EOS)
+		break
+	    ip = ip + 1
+	    comment[op] = card[ip]
+	    if (card[ip] > ' ')
+		lastch = op
+	}
+	comment[lastch+1] = EOS
+end
diff --git a/sys/imio/iki/stf/stfhextn.x b/sys/imio/iki/stf/stfhextn.x
new file mode 100644
index 00000000..45e89f7a
--- /dev/null
+++ b/sys/imio/iki/stf/stfhextn.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+
+# STF_GETHDREXTN -- Get the default header file extension.
+
+procedure stf_gethdrextn (im, o_im, acmode, outstr, maxch)
+
+pointer	im, o_im		#I image descriptors
+int	acmode			#I access mode
+char	outstr[maxch]		#O receives header extension
+int	maxch			#I max chars out
+
+bool	inherit
+int	kernel, old_kernel
+int	fnextn(), iki_getextn(), iki_getpar()
+
+begin
+	# Use the same extension as the input file if this is a new copy
+	# image of the same type as the input and inherit is enabled.
+	# If we have to get the extension using iki_getextn, the default
+	# extension for a new image is the first extension defined (index=1).
+
+	kernel = IM_KERNEL(im)
+
+	old_kernel = 0
+	if (acmode == NEW_COPY && o_im != NULL)
+	    old_kernel = IM_KERNEL(o_im)
+
+	inherit = (iki_getpar ("inherit") == YES)
+	if (inherit && acmode == NEW_COPY && kernel == old_kernel) {
+	    if (fnextn (IM_HDRFILE(im), outstr, maxch) <= 0)
+		call strcpy (STF_DEFHDREXTN, outstr, maxch)
+	} else if (iki_getextn (kernel, 1, outstr, maxch) < 0)
+	    call strcpy (STF_DEFHDREXTN, outstr, maxch)
+end
diff --git a/sys/imio/iki/stf/stfiwcs.x b/sys/imio/iki/stf/stfiwcs.x
new file mode 100644
index 00000000..415b9a76
--- /dev/null
+++ b/sys/imio/iki/stf/stfiwcs.x
@@ -0,0 +1,60 @@
+include	<imhdr.h>
+include	"stf.h"
+
+# STF_INITWCS -- Check for an unitialized WCS and set up a unitary pixel
+# WCS in this case.
+
+procedure stf_initwcs (im)
+
+pointer	im			#I image descriptor
+
+real	v
+int	ndim, i, j
+bool	have_wcs, wcsok
+char	pname[SZ_KEYWORD]
+bool	fp_equalr()
+real	imgetr()
+
+begin
+	ndim = IM_NDIM(im)
+	have_wcs = false
+	wcsok = false
+
+	# Scan the header to determine if we have any WCS information (assume
+	# there is a WCS if any CDi_j cards are found) and if it has been
+	# initialized (at least one matrix element is nonzero).  Note that
+	# we are checking only to see if the WCS has been initialized, not
+	# if it is a valid WCS.
+
+	do j = 1, ndim {
+	    do i = 1, ndim {
+		call sprintf (pname, SZ_KEYWORD, "CD%d_%d")
+		    call pargi (i)
+		    call pargi (j)
+		ifnoerr (v = imgetr (im, pname)) {
+		    have_wcs = true
+		    if (!fp_equalr (v, 0.0)) {
+			wcsok = true
+			break
+		    }
+		}
+	    }
+	    if (wcsok)
+		break
+	}
+
+	# If we found some WCS information and the CD matrix is zero, init
+	# the WCS.
+
+	if (have_wcs && !wcsok)
+	    do i = 1, ndim {
+		call sprintf (pname, SZ_KEYWORD, "CTYPE%d")
+		    call pargi (i)
+		call imastr (im, pname, "PIXEL")
+
+		call sprintf (pname,  SZ_KEYWORD, "CD%d_%d")
+		    call pargi (i)
+		    call pargi (i)
+		call imaddr (im, pname, 1.0)
+	    }
+end
diff --git a/sys/imio/iki/stf/stfmerge.x b/sys/imio/iki/stf/stfmerge.x
new file mode 100644
index 00000000..a98ee877
--- /dev/null
+++ b/sys/imio/iki/stf/stfmerge.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_MERGEGPB -- Merge the non-reserved parameters from an existing GPB into
+# a new GPB; called to construct a new GPB when an image is opened in new-copy
+# mode.  Since the new copy may not be the same size and dimension as the
+# original, the reserved parameters must be set up fresh for the new copy
+# image, i.e., we cannot simply copy them from the old image.  Likewise, the
+# WCS must be transformed if the new copy image does not geometrically overlay
+# the original.
+#
+# NOTE:  no longer called by stf_opix; save this code for future use!
+# <dlb--11/4/87>
+
+procedure stf_mergegpb (n_im, o_im)
+
+pointer	n_im		# new copy image
+pointer	o_im		# image being copied
+
+bool	match
+int	n_i, o_i, n, ip, axis
+int	up_psize
+pointer	sp, cd_pat, n_stf, o_stf, n_pp, o_pp
+int	strncmp(), strlen(), patmake(), patmatch(), ctoi()
+
+begin
+	call smark (sp)
+	call salloc (cd_pat, SZ_LINE, TY_CHAR)
+
+	# Make a pattern to match the CDa_b parameter names.
+	if (patmake ("CD[0-9]_[0-9]", Memc[cd_pat], SZ_LINE) < 0)
+	    ; # cannot happen
+
+	n_stf = IM_KDES(n_im)
+	o_stf = IM_KDES(o_im)
+
+	# Examine each parameter in the old GPB and make an entry for the new
+	# ones in the new GPB.  Note that all we are doing here is defining
+	# the structure; the GPB data is not physically written until the new
+	# header is updated on disk.  The FITS encoded values for the GPB
+	# parameters will already have been copied to the user area of the
+	# new image.
+
+	up_psize = 0
+	for (o_i=1;  o_i <= STF_PCOUNT(o_stf);  o_i=o_i+1) {
+	    o_pp = STF_PDES(o_stf,o_i)
+	    n = strlen (P_PTYPE(o_pp))
+
+	    if (P_PTYPE(o_pp) == 'C')
+		if (strncmp  (P_PTYPE(o_pp), "CRPIX", 5) == 0 ||
+		    strncmp  (P_PTYPE(o_pp), "CRVAL", 5) == 0 ||
+		    strncmp  (P_PTYPE(o_pp), "CTYPE", 5) == 0 ||
+		    patmatch (P_PTYPE(o_pp), Memc[cd_pat]) > 0) {
+
+		    ip = 6
+		    if (ctoi (P_PTYPE(o_pp), ip, axis) <= 0)
+			axis = IM_MAXDIM + 1
+		    if (axis <= STF_NAXIS(n_stf))
+		    	next
+		}
+
+	    # Is there a parameter of the same name in the new descriptor?
+	    match = false
+	    for (n_i=1;  n_i <= STF_PCOUNT(n_stf);  n_i=n_i+1) {
+		n_pp = STF_PDES(n_stf,n_i)
+		if (strncmp (P_PTYPE(o_pp), P_PTYPE(n_pp), n) == 0) {
+		    match = true
+		    break
+		}
+	    }
+
+	    # If there was no match for the parameter, add a definition for
+	    # it to the GPB descriptor for the new image.
+
+	    if (!match) {
+		n = STF_PCOUNT(n_stf) + 1
+		if (n > MAX_PCOUNT)
+		    call error (4, "stf_merge: too many group parameters")
+
+		STF_PCOUNT(n_stf) = n
+		up_psize = up_psize + P_PSIZE(o_pp)
+		n_pp = STF_PDES(n_stf,n)
+	
+		P_SPPTYPE(n_pp)	= P_SPPTYPE(o_pp)
+		P_PSIZE(n_pp)	= P_PSIZE(o_pp)
+		P_LEN(n_pp)	= P_LEN(o_pp)
+
+		call strcpy (P_PTYPE(o_pp), P_PTYPE(n_pp), SZ_PTYPE)
+		call strcpy (P_PDTYPE(o_pp), P_PDTYPE(n_pp), SZ_PDTYPE)
+	    }
+	}
+
+	# Moved the PSIZE, SZGROUP calculations here to fix error in the
+	# computation of PSIZE--dlb, 11/2/87
+
+	STF_PSIZE(n_stf) = STF_PSIZE(n_stf) + up_psize
+	STF_SZGROUP(n_stf) = STF_SZGROUP(n_stf) +
+	    up_psize / (SZB_CHAR * NBITS_BYTE)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfmkpfn.x b/sys/imio/iki/stf/stfmkpfn.x
new file mode 100644
index 00000000..4568efd8
--- /dev/null
+++ b/sys/imio/iki/stf/stfmkpfn.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stf.h"
+
+# STF_MKPIXFNAME -- Given the root and extn fields of the image header filename,
+# construct the pixel file name.  The pixel file has the same root name as
+# the header and the first two characters of the extension are the same as for
+# the header, if a header extension was given.
+
+procedure stf_mkpixfname (hdr_root, hdr_extn, pixfname, maxch)
+
+char	hdr_root[ARB]		# root name of header file
+char	hdr_extn[ARB]		# extension of header file
+char	pixfname[maxch]		# receives pixel filename
+int	maxch
+
+int	i
+char	pix_extn[MAX_LENEXTN]
+
+begin
+	call strcpy (STF_DEFPIXEXTN, pix_extn, MAX_LENEXTN)
+	if (hdr_extn[1] != EOS) {
+	    for (i=1;  i < MAX_LENEXTN;  i=i+1)
+		pix_extn[i] = hdr_extn[i]
+	}
+
+	call iki_mkfname (hdr_root, pix_extn, pixfname, maxch)
+end
diff --git a/sys/imio/iki/stf/stfnewim.x b/sys/imio/iki/stf/stfnewim.x
new file mode 100644
index 00000000..3e8a95ed
--- /dev/null
+++ b/sys/imio/iki/stf/stfnewim.x
@@ -0,0 +1,146 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+define	NBITS_CHAR	(SZB_CHAR * NBITS_BYTE)
+
+
+# STF_NEWIMAGE -- Set up the IMIO/STF descriptor for an image opened with mode
+# new_image or new_copy of non-STF images.  Note that the parameters GROUP 
+# and GCOUNT were set earlier by stf_open().
+
+procedure stf_newimage (im)
+
+pointer	im			# image descriptor
+
+pointer	stf
+pointer	o_im
+long	totpix
+char	pname[SZ_KEYWORD]
+int	old_kernel, pixtype, bitpix, nbytes, pno, ndim, i, j
+errchk	stf_addpar
+string	zero "0"
+string	one  "1"
+
+include <szpixtype.inc>
+
+begin
+	# Get length of axes and datatype from imio descriptor;
+	# these may be changed by the user between image mapping 
+	# and first i/o to pixfile so we set up the group parameter block
+	# and size of pixfile on first i/o operation
+
+	stf = IM_KDES(im)
+	o_im = IM_OHDR(im)
+	ndim = IM_NDIM(im)
+	STF_NAXIS(stf) = ndim
+	do i = 1, ndim
+	    STF_LENAXIS(stf,i) = IM_LEN(im,i)
+
+	# Get datatype for the pixfile; stf_open has set this to datatype 
+	# of template file if it exists, otherwise defaults to real(assuming
+	# the user hasn't changed it by now)
+
+	pixtype = IM_PIXTYPE(im)
+
+	bitpix = pix_size[pixtype] * NBITS_CHAR
+	nbytes = bitpix / NBITS_BYTE
+
+	call sprintf (STF_DATATYPE(stf), SZ_DATATYPE, "%s*%d")
+	    switch (pixtype) {
+	    case TY_USHORT:
+		call pargstr ("UNSIGNED")
+	    case TY_SHORT, TY_LONG, TY_INT:
+		call pargstr ("INTEGER")
+	    case TY_REAL, TY_DOUBLE:
+		call pargstr ("REAL")
+	    case TY_COMPLEX:
+		call pargstr ("COMPLEX")
+	    default:
+		pixtype = TY_REAL
+		bitpix = SZ_REAL * NBITS_CHAR
+		nbytes = bitpix / NBITS_BYTE
+		call pargstr ("REAL")
+	    }
+	    call pargi (nbytes)
+
+	STF_BITPIX(stf) = bitpix
+
+	# Set the IMIO min/max fields.
+
+	IM_MIN(im) = 0.
+	IM_MAX(im) = 0.
+	IM_LIMTIME(im) = 0
+
+	# For a new copy image(of an already-existing file), DO NOT add group
+	# parameters to the GPB, unless the original image is not an STF
+	# image.  The following are the "standard" set of datamin/max and the
+	# FITS coordinate parms which SDAS files are supposed to have.
+
+	if (IM_ACMODE(im) == NEW_COPY && o_im != NULL)
+	    old_kernel = IM_KERNEL(o_im)
+
+	if ((IM_ACMODE(im) == NEW_FILE) || 
+	   ((IM_ACMODE(im) == NEW_COPY) && IM_KERNEL(im) != old_kernel)) {
+
+	    # Set up the standard STF group parameter block parameters.
+	    STF_GROUPS(stf) = YES
+	    STF_PCOUNT(stf) = 2 + (ndim * 3) + (ndim * ndim)
+	    STF_PSIZE(stf) = 2 * (SZ_REAL * NBITS_CHAR) +	# DATAMIN/MAX
+		ndim * (SZ_DOUBLE * NBITS_CHAR) +		# CRVALn
+		ndim * (SZ_REAL * NBITS_CHAR) +			# CRPIXn
+		ndim * (8 * NBITS_BYTE) +			# CTYPEn
+		(ndim * ndim) * (SZ_REAL * NBITS_CHAR)		# CD matrix
+
+	    # Free any unneeded space in the STF descriptor.
+	    if (STF_PCOUNT(stf) > 0) {
+		call realloc (stf,
+		    LEN_STFBASE + STF_PCOUNT(stf)*LEN_PDES, TY_STRUCT)
+		IM_KDES(im) = stf
+	    }
+
+	    # Set up the group data block in the STF descriptor and in 
+	    # the IMIO FITS format user area.  WARNING--the STF kernel
+	    # is implicitly assuming that the GPB related parameters
+	    # in non-STF format images are at the beginning of the user
+	    # area, if they are present at all.   If this is not true
+	    # then the following code will APPEND them to the user area.
+	    # At STScI, non-STF format images are usually made from STF
+	    # images and these parameters are at the beginning of the user
+	    # area in that case.
+
+	    pno = 1
+	    call stf_addpar (im, "DATAMIN", TY_REAL, 1, zero, pno)
+	    call stf_addpar (im, "DATAMAX", TY_REAL, 1, zero, pno)
+
+	    do i = 1, ndim {
+		call sprintf (pname,  SZ_KEYWORD, "CRPIX%d"); call pargi (i)
+		call stf_addpar (im, pname, TY_REAL, 1, zero, pno)
+		call sprintf (pname,  SZ_KEYWORD, "CRVAL%d"); call pargi (i)
+		call stf_addpar (im, pname, TY_DOUBLE, 1, zero, pno)
+		call sprintf (pname,  SZ_KEYWORD, "CTYPE%d"); call pargi (i)
+		call stf_addpar (im, pname, TY_CHAR, 8, "PIXEL", pno)
+
+		do j = 1, ndim {
+		    call sprintf (pname,  SZ_KEYWORD, "CD%d_%d")
+			call pargi (j)
+			call pargi (i)
+		    if (i == j)
+			call stf_addpar (im, pname, TY_REAL, 1, one,  pno)
+		    else
+			call stf_addpar (im, pname, TY_REAL, 1, zero, pno)
+		}
+	    }
+	}
+
+	# Compute the size of each group in the pixel file, in chars.
+	totpix = IM_LEN(im,1)
+	do i = 2, ndim
+	    totpix = totpix * IM_LEN(im,i)
+
+	STF_SZGROUP(stf) = totpix * pix_size[IM_PIXTYPE(im)] +
+	    STF_PSIZE(stf) / (SZB_CHAR * NBITS_BYTE)
+end
diff --git a/sys/imio/iki/stf/stfopen.x b/sys/imio/iki/stf/stfopen.x
new file mode 100644
index 00000000..016c557e
--- /dev/null
+++ b/sys/imio/iki/stf/stfopen.x
@@ -0,0 +1,225 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+# STF_OPEN -- Open/create an STF group format image.
+
+procedure stf_open (kernel, im, o_im,
+	root, extn, ksection, gr_arg, gc_arg, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I other descriptor for NEW_COPY image
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I extension, if any
+char	ksection[ARB]		#I NOT USED
+int	gr_arg			#I index of group to be accessed
+int	gc_arg			#I number of groups in STF image
+int	acmode			#I access mode
+int	status			#O return value
+
+bool	subimage
+pointer	sp, fname, stf, stf_extn, ua, o_stf
+int	group, gcount, newimage, gpb, hdr, o_stflen
+
+bool	fnullfile(), envgetb()
+int	open(), stropen(), access()
+errchk	stf_initwcs, fmkcopy, calloc, realloc, syserrs
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (stf_extn, MAX_LENEXTN, TY_CHAR)
+
+	ua = IM_USERAREA(im)
+
+	# Allocate internal STF image descriptor.
+	call calloc (stf, LEN_STFDES, TY_STRUCT)
+	IM_KDES(im) = stf
+
+	group  = max (1, gr_arg)
+	gcount = max (group, gc_arg)
+
+	STF_GRARG(stf)	= max (0, gr_arg)
+	STF_GROUP(stf)  = group
+	STF_GCOUNT(stf) = gcount
+	STF_ACMODE(stf) = acmode
+	STF_PFD(stf)    = NULL
+
+	# If a nonzero gcount is specified when a new-image or new-copy image
+	# is opened (e.g., [1/10] we assume that an entire new group format
+	# image is to be created with the given group count.  If neither the
+	# group or gcount values are specified we assume that a new image is
+	# to be created.  If the gcount field is zero (e.g., [1/0] or just [1])
+	# then we assume that the image already exists and that we are being
+	# asked to rewrite the indexed image.
+
+	newimage = NO
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY)
+	    if (gc_arg > 0 || (gr_arg <= 0 && gc_arg <= 0))
+		newimage = YES
+	STF_NEWIMAGE(stf) = newimage
+
+	# Generate full header file name.
+	if (extn[1] == EOS) {
+	    call stf_gethdrextn (im, o_im, acmode, Memc[stf_extn], MAX_LENEXTN)
+	    call iki_mkfname (root, Memc[stf_extn], Memc[fname], SZ_PATHNAME)
+	    call strcpy (Memc[stf_extn], extn, MAX_LENEXTN)
+	} else
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+
+	call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+
+	# Generate full pixel file name.
+	call stf_mkpixfname (root, extn, Memc[fname], SZ_PATHNAME)
+	call strcpy (Memc[fname], IM_PIXFILE(im), SZ_IMPIXFILE)
+
+	# Create and open the image header file if create a new physical
+	# image.  If opening an existing image we do not open the header file
+	# here since the header may already be in the STF header cache.
+	# Since STF header files have a weird file type on some systems (VMS)
+	# we must create a new header file with FMKCOPY rather than OPEN.
+
+	if (STF_NEWIMAGE(stf) == YES && !fnullfile (IM_HDRFILE(im))) {
+	    if (access (IM_HDRFILE(im), 0,0) == YES) {
+		subimage = (gr_arg > 0 && gr_arg <= gc_arg)
+		if (subimage || envgetb ("imclobber")) {
+		    iferr (call delete (IM_PIXFILE(im)))
+			goto err_
+		    iferr (call delete (IM_HDRFILE(im)))
+			goto err_
+		} else {
+		    call mfree (stf, TY_STRUCT)
+		    call syserrs (SYS_IKICLOB, IM_HDRFILE(im))
+		}
+	    }
+	    iferr (call fmkcopy (HDR_TEMPLATE, IM_HDRFILE(im)))
+		goto err_
+	    iferr (IM_HFD(im) = open (IM_HDRFILE(im), READ_WRITE, TEXT_FILE))
+		goto err_
+	}
+
+	# If opening an existing image, read the image header into the STF
+	# image descriptor.
+
+	switch (acmode) {
+	case NEW_IMAGE:
+	    # For group formatted images, open NEW_IMAGE can mean either
+	    # creating a new group format image, or opening a new group
+	    # within an existing group format image.  The latter case is
+	    # indicated by a group index greater than 1.  If we are creating
+	    # a new group format image, wait until the user has set up the
+	    # dimension parameters before doing anything further (in stfopix).
+
+	    if (STF_NEWIMAGE(stf) == NO)
+		iferr (call stf_rdheader (im, group, acmode))
+		    goto err_
+
+	case NEW_COPY:
+	    # Make sure the FITS encoded user area we inherited is blocked.
+
+	    ### For now, always reblock the old header as the blocked flag
+	    ### does not seem to be reliable and a header with variable length
+	    ### lines can cause the header update to fail.  This should be
+	    ### fixed as a reblock of the full header is expensive.
+
+	    ### if (IM_UABLOCKED(o_im) != YES)
+		call stf_reblock (im)
+
+	    if (STF_NEWIMAGE(stf) == NO) {
+		# Open new group within existing GF image.  The FITS header and
+		# GPB structure of the image being opened must be used, but the
+		# default data values for the GPB parameters are inherited from
+		# the image being copied.
+
+		# Filter the copied user area to retain only the GPB cards.
+		# Opening the user area on two string file descriptors is a
+		# bit tricky, but will work since fixed size cards are copied,
+		# and the EOS isn't written until close time.
+
+		if (IM_KDES(o_im) != NULL && IM_KERNEL(o_im) == IM_KERNEL(im)) {
+		    hdr = stropen (Memc[ua], ARB, READ_ONLY)
+		    gpb = stropen (Memc[ua], ARB, NEW_FILE)
+		    call stf_copyfits (IM_KDES(o_im), hdr, gpb, NULL)
+		    call close (gpb)
+		    call close (hdr)
+		}
+
+		# Read in the FITS header of the new image after the inherited
+		# GPB data cards, and set up the STF descriptor for the new GPB
+		# as defined in the new FITS header.
+
+		iferr (call stf_rdheader (im, group, acmode))
+		    goto err_
+
+		# Initialize the WCS description if this is not done by the
+		# inherited user header.
+
+		call stf_initwcs (im)
+
+	    } else {
+		# Completely new copy of an existing image, which may or may
+		# not be an STF format image.  IMIO has already copied the
+		# size parameters of the old image as well as the cards in the
+		# user area of the old image (but without leaving space for
+		# the GPB cards if not an STF image).  Copy old STF descriptor
+		# if the old image is also an STF format image, to inherit
+		# GPB structure.  Wait until opix time to init the rest of the
+		# descriptor.  
+
+		if (IM_KDES(o_im) != NULL && IM_KERNEL(o_im) == IM_KERNEL(im)) {
+		    o_stf = IM_KDES(o_im)
+		    o_stflen = LEN_STFBASE + STF_PCOUNT(o_stf) * LEN_PDES
+		    call amovi (Memi[o_stf], Memi[stf], o_stflen)
+		    STF_ACMODE(stf)   = acmode
+		    STF_GROUP(stf)    = group
+		    STF_GCOUNT(stf)   = gcount
+		    STF_NEWIMAGE(stf) = newimage
+		    STF_PFD(stf)      = NULL
+		    if (gcount > 1)
+			STF_GROUPS(stf) = YES
+		} else
+		    STF_GROUPS(stf) = YES
+
+		# Inherit datatype of input template image if specified,
+		# otherwise default datatype to real.
+
+		if (IM_PIXTYPE(o_im) != NULL)
+		    IM_PIXTYPE(im) = IM_PIXTYPE(o_im)
+		else
+		    IM_PIXTYPE(im) = TY_REAL
+	    }
+
+	default:
+	    # Open an existing group within an existing image.
+	    iferr (call stf_rdheader (im, group, acmode))
+		goto err_
+	}
+
+	# Set group number and count for the external world if this is a group
+	# format image.
+
+	if (STF_GROUPS(stf) == YES) {
+	    IM_CLINDEX(im) = STF_GROUP(stf)
+	    IM_CLSIZE(im)  = STF_GCOUNT(stf)
+	}
+
+	# Free any unneeded space in the STF descriptor.
+	if (STF_PCOUNT(stf) > 0)
+	    call realloc (stf,
+		LEN_STFBASE + STF_PCOUNT(stf)*LEN_PDES, TY_STRUCT)
+	IM_KDES(im) = stf
+	status = OK
+
+	call sfree (sp)
+	return
+err_
+	status = ERR
+	call mfree (stf, TY_STRUCT)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfopix.x b/sys/imio/iki/stf/stfopix.x
new file mode 100644
index 00000000..da353119
--- /dev/null
+++ b/sys/imio/iki/stf/stfopix.x
@@ -0,0 +1,202 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fset.h>
+include	<mach.h>
+include	"stf.h"
+
+define	NBITS_CHAR	(SZB_CHAR * NBITS_BYTE)
+
+# STF_OPIX -- Open (or create) the pixel storage file.  If the image header file
+# is `image.hhh' the associated pixel storage file will be `image.hhd' in the
+# same directory as the header file.  STF_PFD is set if the pixel file is
+# physically open.  IM_PFD is not set until we have been called by IMIO, since
+# we must be called to once set up all the descriptors, even if the pixel file
+# was already opened to read the GPB.
+#
+# dlb, 18-may-88: added code to zero out gpb's in multi-group image for groups
+#   other than current; prevents strange numbers and when later programs try to
+#   read the gpb of an otherwise uninitialized group of the image.
+# dlb, 29-dec-1988: added code to get default set of GPB parameters and
+#   correctly initialize STF-kernel descriptor.
+
+procedure stf_opix (im, status)
+
+pointer	im				# image descriptor
+int	status				# return status
+
+int	compress, blklen
+bool	copy_of_stf_image
+int	pfd, sz_gpb, group, i
+pointer	stf, o_stf, o_im, ua, gpb
+long	sz_pixfile, pixoff, totpix, offset
+
+int	open()
+errchk	open, fseti, falloc, seek, syserrs, imioff, calloc
+errchk	write
+
+include <szpixtype.inc>
+
+begin
+	status = OK
+	if (IM_PFD(im) != NULL)
+	    return
+
+	o_im	 = IM_OHDR(im)
+	stf	 = IM_KDES(im)
+	ua	 = IM_USERAREA(im)
+
+	pfd	 = STF_PFD(stf)
+	compress = YES
+	blklen   = 1
+	pixoff   = 1
+
+	switch (IM_ACMODE(im)) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY, APPEND:
+	    if (pfd == NULL)
+		pfd = open (IM_PIXFILE(im), IM_ACMODE(im), BINARY_FILE)
+
+	case NEW_COPY, NEW_FILE:
+	    # Initialize the IMIO and STF descriptors and allocate the pixel
+	    # file.
+
+	    if (STF_NEWIMAGE(stf) == YES) {
+		# Normalize IMIO header parameters for new image.
+		call imioff (im, pixoff, compress, blklen)
+
+		# Set up the required GPB parameters for the new image.
+		# Note - this call can change the STF pointer.
+
+		call stf_newimage (im)
+		stf = IM_KDES(im)
+
+		# Save the size of the old GPB user area header if we are
+		# making a new copy of an old STF format image.
+
+		copy_of_stf_image = false
+		if (IM_ACMODE(im) == NEW_COPY && o_im != NULL)
+		    if (IM_KERNEL(o_im) == IM_KERNEL(im))
+			copy_of_stf_image = true
+
+		if (copy_of_stf_image) {
+		    o_stf = IM_KDES(o_im)
+		    STF_PCOUNT(stf) = STF_PCOUNT(o_stf)
+		    STF_PSIZE(stf) = STF_PSIZE(o_stf)
+		}
+
+#		Since the stf_mergegpb code below has been deactivated,
+#		there is no need to do the complex and expensive spool/copy
+# 		operation below.  (dct 1/4/90)
+#		-------------------------------
+#		# We have to have space for the GPB data cards at the beginning
+#		# of the user area, so spool any existing user cards in a
+#		# buffer and truncate the user area at the end of the GPB.
+#
+#		ua_fd = stropen (Memc[ua+sz_gpbhdr], ARB, READ_ONLY)
+#		spool = open ("opix_spool", READ_WRITE, SPOOL_FILE)
+#		call fcopyo (ua_fd, spool)
+#		call close (ua_fd)
+#		Memc[ua+sz_gpbhdr] = EOS
+#
+#		# Merge any extra GPB parameters from the old image into the
+#		# GPB structure of the new image.  The GPB data cards for
+#		# these parameters should already be in the user area.
+#		# Order the group parameters to match the ordering in the
+#		# old image.  NOTE:  since the STF now copies all relevant
+#		# GPB parameters from an old image into the new or 
+#		# generates a default standard set (in stf_newimage),
+#		# the following is no longer necessary.  Note that if we
+#		# eventually may add parameters to the GPB, these routines
+#		# will again be useful!
+#
+#		#if (copy_of_stf_image) {
+#		#    call stf_mergegpb (im, o_im)
+#		#    call stf_ordergpb (o_stf, stf)
+#		#}
+#			
+#		# Now append the spooled user header cards to the new user
+#		# area following the GPB data cards, deleting any user cards
+#		# which redefine GPB cards in the process.
+#
+#		call seek (spool, BOFL)
+#		ua_size = (IM_LENHDRMEM(im) - LEN_IMHDR) * SZ_STRUCT
+#		ua_fd = stropen (Memc[ua], ua_size, APPEND)
+#		call stf_copyfits (stf, spool, NULL, ua_fd)
+#		call close (ua_fd)
+#		call close (spool)
+#
+#		# Compute the length of the new header
+#		IM_HDRLEN(im) = LEN_IMHDR +
+#		    (strlen(Memc[ua]) + SZ_STRUCT-1) / SZ_STRUCT
+
+		# Open the new pixel storage file (preallocate space if
+		# enabled on local system).  Save the physical pathname of
+		# the pixfile in the image header, in case "imdir$" changes.
+
+		sz_pixfile = STF_SZGROUP(stf) * STF_GCOUNT(stf)
+		call falloc (IM_PIXFILE(im), sz_pixfile)
+
+		# Zero out all remaining groups of the image
+		# Open pixel file if not already open
+
+		if (STF_PFD(stf) == NULL)
+		    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+
+		# Allocate a zeroed block of memory whose length is the same
+		# as that of the group parameter block
+
+		sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
+		call calloc (gpb, sz_gpb, TY_CHAR)
+	
+		# Zero out every group except the current one.
+		do group = 1, STF_GCOUNT(stf) {
+		    if (group != STF_GROUP(stf)) {
+			offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
+			call seek (pfd, offset)
+			call write (pfd, Memc[gpb], sz_gpb)
+		    }
+		}
+
+		# Free the block of memory.
+		call mfree (gpb, TY_CHAR)
+
+	    } else {
+		# If we are writing to a group of an existing multigroup image,
+		# verify that the important image parameters have not been
+		# changed.
+
+		if (STF_NAXIS(stf) != IM_NDIM(im))
+		    call syserrs (SYS_IMGSZNEQ, IM_NAME(im))
+		do i = 1, IM_NDIM(im)
+		    if (STF_LENAXIS(stf,i) != IM_LEN(im,i))
+			call syserrs (SYS_IMGSZNEQ, IM_NAME(im))
+
+		# Added 5/15/87--dlb to get correct size of each data portion
+		# of a group if image opened NEW_COPY and input file was a
+		# template of a different dimensionality used to get GPB.
+		# Compute the size of each group in the pixel file, in chars.
+
+		totpix = IM_LEN(im,1)
+		do i = 2, IM_NDIM(im)
+		    totpix = totpix * IM_LEN(im,i)
+
+		STF_SZGROUP(stf) = totpix * pix_size[IM_PIXTYPE(im)] +
+		    STF_PSIZE(stf) / (SZB_CHAR * NBITS_BYTE)
+	    }
+
+	    if (pfd == NULL)
+		pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+
+	    # Tell IMIO where the pixels are.
+	    pixoff = (STF_GROUP(stf) - 1) * STF_SZGROUP(stf) + 1
+	    call imioff (im, pixoff, compress, blklen)
+
+	default:
+	    call imerr (IM_NAME(im), SYS_IMACMODE)
+	}
+
+	STF_PFD(stf) = pfd
+	IM_PFD(im)   = pfd
+end
diff --git a/sys/imio/iki/stf/stfordgpb.x b/sys/imio/iki/stf/stfordgpb.x
new file mode 100644
index 00000000..7099e106
--- /dev/null
+++ b/sys/imio/iki/stf/stfordgpb.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"stf.h"
+
+# STF_ORDERGPB -- Order the GPB, putting the group parameters in the
+# new image in the same order as in the old image.
+# NOTE:  no longer called by stf_opix; save this code for future use!
+# <dlb--11/4/87>
+
+procedure stf_ordergpb (o_stf, n_stf)
+
+pointer	o_stf			# STF descriptor of old image
+pointer n_stf			# STF descriptor of new image
+
+pointer	sp, temp_pdes, pp, o_plist, n_plist
+int	o_pcount, n_pcount, otop, ntop, op, np, offset, sz_param, pn
+bool	streq()
+
+begin
+	o_pcount = STF_PCOUNT(o_stf)
+	n_pcount = STF_PCOUNT(n_stf)
+	if (o_pcount <= 0)
+	    return
+
+	call smark (sp)
+	call salloc (temp_pdes, LEN_PDES, TY_STRUCT)
+
+	o_plist = STF_PDES(o_stf,1)
+	n_plist = STF_PDES(n_stf,1)
+	otop = (o_pcount * LEN_PDES)
+	ntop = (n_pcount * LEN_PDES)
+
+	# Search the new parameter list for a parameter with the same name
+	# as a parameter in the old parameter list.  When a match is found,
+	# move the new parameter into the same position as it is in the
+	# old parameter list.
+
+	for (op=0; op < otop; op=op+LEN_PDES)
+	    for (np=op; np < ntop; np=np+LEN_PDES)
+		if (streq (P_PTYPE(o_plist+op), P_PTYPE(n_plist+np))) {
+		    if (op != np) {
+			# Swap parameters between old and new positions
+			call amovi (Memi[n_plist+op], Memi[temp_pdes],
+			    LEN_PDES)
+			call amovi (Memi[n_plist+np], Memi[n_plist+op],
+			    LEN_PDES)
+			call amovi (Memi[temp_pdes], Memi[n_plist+np],
+			    LEN_PDES)
+		    }
+		    break
+		}
+
+	# Update the field offsets.
+	offset = 0
+	for (pn=1;  pn <= n_pcount;  pn=pn+1) {
+	    pp = STF_PDES(n_stf,pn)
+	    P_OFFSET(pp) = offset
+	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR
+	    offset = offset + sz_param
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfrdhdr.x b/sys/imio/iki/stf/stfrdhdr.x
new file mode 100644
index 00000000..2c11fec9
--- /dev/null
+++ b/sys/imio/iki/stf/stfrdhdr.x
@@ -0,0 +1,186 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<finfo.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_RDHEADER -- Read the STF format image header for a single group into the
+# IMIO descriptor.  The standard fields are processed into the fields of the
+# descriptor.  The GPB binary parameters are encoded as FITS cards and placed
+# in the IMIO user area, followed by all extra cards in the FITS format STF
+# group header.  Note that no distinction is made between the common FITS
+# keywords and the GPB group parameters at the IMIO level and above.
+
+procedure stf_rdheader (im, group, acmode)
+
+pointer	im		# image descriptor
+int	group		# group to be accessed
+int	acmode		# access mode
+
+long	pixoff
+long	fi[LEN_FINFO]
+real	datamin, datamax
+pointer	sp, stf, lbuf, root, extn, op
+int	compress, devblksz, ival, ch, i , junk
+int	fits, fitslen, sz_userarea, sz_gpbhdr, len_hdrmem
+long	totpix, mtime, ctime
+
+real	imgetr()
+int	fnroot(), strlen(), finfo(), imaccf()
+errchk	stf_rfitshdr, stf_rgpb, open, realloc, imaddb, imaddi, imgetr
+
+include <szpixtype.inc>
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	stf = IM_KDES(im)
+
+	# Read the FITS header, setting the values of all reserved fields
+	# in the STF descriptor and saving all the user FITS cards in the
+	# save buffer "fits".
+
+	call stf_rfitshdr (im, fits, fitslen)
+
+	# Process the reserved keywords (set in the STF descriptor) into the
+	# corresponding fields of the IMIO descriptor.
+
+        # Set group keywords if STF_GROUPS is NO (BPS 12.06.91).
+        if (STF_GROUPS(stf) == NO) {
+            STF_GCOUNT(stf) = 1
+            STF_PCOUNT(stf) = 0
+            STF_PSIZE(stf) = 0
+        }
+
+	if (acmode != NEW_COPY) {
+	    IM_NDIM(im) = STF_NAXIS(stf)		# IM_NDIM
+	    do ival = 1, IM_MAXDIM			# IM_LEN
+		IM_LEN(im,ival) = STF_LENAXIS(stf,ival)
+	}
+
+	ch = STF_DATATYPE(stf)				# IM_PIXTYPE
+	switch (STF_BITPIX(stf)) {
+	case 16:
+	    if (ch == 'U')
+		ival = TY_USHORT
+	    else
+	        ival = TY_SHORT
+	case 32:
+	    if (ch == 'R')
+		ival = TY_REAL
+	    else
+		ival = TY_LONG
+	case 64:
+	    if (ch == 'R')
+		ival = TY_DOUBLE
+	    else
+		ival = TY_COMPLEX
+	default:
+	    ival = ERR
+	}
+	IM_PIXTYPE(im) = ival
+
+	call iki_parse (IM_HDRFILE(im), Memc[root], Memc[extn])
+	call stf_mkpixfname (Memc[root], Memc[extn], IM_PIXFILE(im),
+	    SZ_IMPIXFILE)
+
+	if (finfo (IM_PIXFILE(im), fi) != ERR) {
+	    mtime = FI_MTIME(fi)
+	    ctime = FI_CTIME(fi)
+	}
+
+	IM_NBPIX(im)   = 0			# no. bad pixels
+	IM_CTIME(im)   = ctime			# creation time
+	IM_MTIME(im)   = mtime			# modify time
+	IM_LIMTIME(im) = mtime - 1		# time max/min last updated
+	IM_UABLOCKED(im) = YES			# ua cards blocked to 80 chars
+
+	IM_HISTORY(im) = EOS
+	junk = fnroot (IM_HDRFILE(im), Memc[lbuf], SZ_LINE)
+	call strupr (Memc[lbuf])
+	call sprintf (IM_TITLE(im), SZ_IMTITLE, "%s[%d/%d]")
+	    call pargstr (Memc[lbuf])
+	    call pargi (STF_GROUP(stf))
+	    call pargi (STF_GCOUNT(stf))
+
+	# Compute the size of each group in the pixel file, in chars.
+	totpix = IM_LEN(im,1)
+	do i = 2, IM_NDIM(im)
+	    totpix = totpix * IM_LEN(im,i)
+
+	STF_SZGROUP(stf) = totpix * pix_size[IM_PIXTYPE(im)] +
+	    STF_PSIZE(stf) / (SZB_CHAR * NBITS_BYTE)
+
+	# Write GPB related cards to the beginning of the IMIO user area.
+	call imaddb (im, "GROUPS", STF_GROUPS(stf) == YES)
+	call imaddi (im, "GCOUNT", STF_GCOUNT(stf))
+	call imaddi (im, "PCOUNT", STF_PCOUNT(stf))
+	call imaddi (im, "PSIZE", STF_PSIZE(stf))
+
+	# Extract the group parameter block from the pixfile, encoding the
+	# group parameters as FITS cards and appending to the cards above.
+	# Get the values of DATAMIN and DATAMAX from the GPB so that we can
+	# update the IMIO min/max fields.
+
+	call stf_rgpb (im, group, acmode, datamin, datamax)
+
+	# Reallocate the image descriptor to allow space for the spooled user
+	# FITS cards plus a little extra for new parameters.
+
+	sz_gpbhdr = strlen (Memc[IM_USERAREA(im)])
+	sz_userarea = sz_gpbhdr + fitslen + SZ_EXTRASPACE
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+	# Append the saved FITS cards from the STF header to the user area.
+	# Any cards which redefine GPB cards were already deleted when the
+	# fits save buffer was created (we don't want the GPB cards since
+	# we already output a FITS card for each GPB parameter above).
+
+	op = IM_USERAREA(im) + sz_gpbhdr
+	call amovc (Memc[fits], Memc[op], fitslen+1)
+
+	# Set the IMIO min/max fields.  If the GPB datamin >= datamax the
+	# values are invalidated by setting IM_LIMTIME to before the image
+	# modification time.  Although datamin/datamax were returned by
+	# stg_rgpb above, we refetch the values here to pick up the values
+	# from the spooled main header in case there were no entries for
+	# these keywords in the GPB (if there are values in the GPB they
+	# will override those in the main header).
+
+	if (imaccf (im, "DATAMIN") == YES)
+	    datamin = imgetr (im, "DATAMIN")
+	if (imaccf (im, "DATAMAX") == YES)
+	    datamax = imgetr (im, "DATAMAX")
+
+	IM_MIN(im) = datamin
+	IM_MAX(im) = datamax
+	if (datamin < datamax)
+	    IM_LIMTIME(im) = IM_MTIME(im) + 1
+	else
+	    IM_LIMTIME(im) = IM_MTIME(im) - 1
+
+	# Call up IMIO set set up the remaining image header fields used to
+	# define the physical offsets of the pixels in the pixfile.
+
+	compress = YES		# do not align image lines on blocks
+	devblksz = 1		# disable all alignment
+
+	pixoff = (group - 1) * STF_SZGROUP(stf) + 1
+	call imioff (im, pixoff, compress, devblksz)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfreblk.x b/sys/imio/iki/stf/stfreblk.x
new file mode 100644
index 00000000..9519bd08
--- /dev/null
+++ b/sys/imio/iki/stf/stfreblk.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+# STF_REBLOCK -- If the user area is not blocked to fixed length records, e.g.,
+# as is possible in a new copy image, reblock it fixed length.
+
+procedure stf_reblock (im)
+
+pointer	im			# image descriptor
+
+pointer	sp, lbuf, op, ua
+int	fd, spool, nlines, nchars, sz_userarea, len_hdrmem
+errchk	stropen, open, getline, putline, realloc, seek, fcopyo
+int	open(), stropen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], ARB, READ_ONLY)
+	spool = open ("rb_spool", READ_WRITE, SPOOL_FILE)
+	
+	# Reblock into a spool file, counting the lines.
+	for (nlines=0;  ;  nlines=nlines+1) {
+	    nchars = getline (fd, Memc[lbuf])
+	    if (nchars <= 0)
+		break
+
+	    for (op=nchars;  op <= FITS_RECLEN;  op=op+1)
+		Memc[lbuf+op-1] = ' '
+	    Memc[lbuf+FITS_RECLEN] = '\n'
+	    Memc[lbuf+FITS_RECLEN+1] = EOS
+
+	    call putline (spool, Memc[lbuf])
+	}
+
+	call close (fd)
+
+	# Reallocate header the right size.
+	sz_userarea = nlines * (FITS_RECLEN+1) + SZ_EXTRASPACE
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+	# Move spooled data back to user area.
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], sz_userarea, NEW_FILE)
+	call seek (spool, BOFL)
+	call fcopyo (spool, fd)
+
+	call close (fd)
+	call close (spool)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfrename.x b/sys/imio/iki/stf/stfrename.x
new file mode 100644
index 00000000..0d3c43fd
--- /dev/null
+++ b/sys/imio/iki/stf/stfrename.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"stf.h"
+
+# STF_RENAME -- Rename an image.  A special operator is required since the image
+# is stored as two files.
+#
+# [NOTE] - Name changed to `rname' rather than `rename' to avoid a name
+# collision with the SYMTAB procedure `stfree' (first such collision!).
+
+procedure stf_rname (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		# old image root name
+char	oextn[ARB]		# old image extn
+char	nroot[ARB]		# new image root name
+char	nextn[ARB]		# old image extn
+int	status
+
+pointer	sp
+pointer	ohdr_fname, opix_fname, nhdr_fname, npix_fname
+bool	streq()
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (opix_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (npix_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	if (!streq (Memc[ohdr_fname], Memc[nhdr_fname])) {
+	    call stf_mkpixfname (oroot, oextn, Memc[opix_fname], SZ_PATHNAME)
+	    call stf_mkpixfname (nroot, nextn, Memc[npix_fname], SZ_PATHNAME)
+
+	    # If the header cannot be renamed, don't leave the pixfile alone.
+	    iferr (call rename (Memc[ohdr_fname], Memc[nhdr_fname]))
+		call erract (EA_WARN)
+	    else iferr (call rename (Memc[opix_fname], Memc[npix_fname]))
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/stf/stfrfits.x b/sys/imio/iki/stf/stfrfits.x
new file mode 100644
index 00000000..8ec9e9b0
--- /dev/null
+++ b/sys/imio/iki/stf/stfrfits.x
@@ -0,0 +1,266 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<finfo.h>
+include	<fset.h>
+include	"stf.h"
+
+# STF_RFITSHDR -- Read a STF FITS image header, processing all reserved GPB
+# definition keywords into the STF descriptor in the image descriptor, and
+# saving the remaining cards (excluding cards which GPB keyword names) in
+# in a save buffer.
+# 
+# This routine implements a simple cache of FITS headers.  If a given header
+# is already in the cache and the cached entry is up to date, the cached
+# spool file containing the user FITS cards and the saved STF descriptor are
+# returned immediately without need to access the header file on disk.
+# Otherwise, the new header is read into the oldest cache slot and the cached
+# entry returned in the usual fashion.  Any modifications to the header file
+# which affect the file modify date will invalidate the cached entry.  Note
+# that multiple processes may cache the same header, so it is not permitted
+# to modify the cached entry once the header file has been read.
+# 
+# The following reserved keywords are recognized:
+# 
+# 	SIMPLE BITPIX DATATYPE NAXIS* GROUPS GCOUNT PCOUNT PSIZE 
+# 	PTYPE* PDTYPE* PSIZE* 
+# 
+# All unrecognized cards, including HISTORY and COMMENT cards, blank lines,
+# and any other garbage in the header, are preserved in the user area of the
+# IMIO descriptor (i.e., in the spoolfile).  Certain of the standard reserved
+# cards (GROUPS, GCOUNT, etc.) are saved in the IMIO user area for the sake
+# of the user, although the real values of these parameters are maintained only
+# in the STF descriptor.
+
+procedure stf_rfitshdr (im, fits, fitslen)
+
+pointer	im				#I image descriptor
+pointer	fits				#O pointer to saved FITS cards
+int	fitslen				#O length of FITS save area
+
+long	fi[LEN_FINFO]
+pointer	sp, pp, stf, o_stf, lbuf, op, hdrfile
+int	in, index, nchars, spool, slot, user, i
+
+bool	streq()
+long	clktime(), fstatl()
+int	envgeti(), stf_ctype(), finfo(), getline(), open(), stropen()
+errchk	getline, putline, syserrs, open, seek, calloc, realloc
+errchk	fpathname, malloc, stf_copyfits
+
+bool	initialized			# CACHE definitions...
+bool	reload				# reload cache
+int	rf_refcount			# reference count
+int	rf_cachesize			# number of cache slots
+pointer	rf_stf[MAX_CACHE]		# STF descriptor
+int	rf_lru[MAX_CACHE]		# lowest value is oldest slot
+long	rf_time[MAX_CACHE]		# time when entry was cached
+long	rf_mtime[MAX_CACHE]		# modify time of file in cache
+int	rf_fits[MAX_CACHE]		# FITS data
+int	rf_fitslen[MAX_CACHE]		# size of data area
+char	rf_fname[SZ_PATHNAME,MAX_CACHE]	# header file pathname
+data	initialized /false/
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	# Initialize the header file cache on the first call.
+	if (!initialized) {
+	    rf_refcount = 0
+	    do i = 1, MAX_CACHE
+		rf_stf[i] = 0
+
+	    iferr (rf_cachesize = envgeti (ENV_STFCACHE))
+		rf_cachesize = DEF_CACHE
+	    if (rf_cachesize > MAX_CACHE) {
+		call eprintf ("A maximum of %d STF headers may be cached\n")
+		    call pargi (MAX_CACHE)
+		rf_cachesize = MAX_CACHE
+	    } else if (rf_cachesize <= 0)
+		rf_cachesize = 0
+		
+	    initialized = true
+	}
+
+	rf_refcount = rf_refcount + 1
+	o_stf = IM_KDES(im)
+	reload = false
+	slot = 1
+
+	# Get file system info on the desired header file.
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	if (finfo (Memc[hdrfile], fi) == ERR)
+	    call syserrs (SYS_FOPEN, IM_HDRFILE(im))
+
+	repeat {
+	    # Search the header file cache for the named image.
+	    do i = 1, max(1,rf_cachesize) {
+		if (rf_stf[i] == NULL) {
+		    slot = i
+		    next
+		}
+
+		if (streq (Memc[hdrfile], rf_fname[1,i])) {
+		    # File is in cache; is cached entry still valid?
+		    if (FI_MTIME(fi) != rf_mtime[i]) {
+			# File modify date has changed, reuse slot.
+			slot = i
+			break
+
+		    } else if (!reload && clktime(rf_time[i]) < 2) {
+			# The file modify date has not changed, but the cache
+			# was loaded within the last clock "tick" (second),
+			# so we cannot be sure that the file was not modified.
+			# The cache must be reloaded, but set a flag so that
+			# rf_time is not changed, so that when the cache entry
+			# ages sufficiently it will be considered valid.
+
+			reload = true
+			slot = i
+			break
+
+		    } else {
+			# Return the cached header.
+			rf_lru[i] = rf_refcount
+			call amovi (STF_CACHE(rf_stf[i]), STF_CACHE(o_stf),
+			    STF_CACHELEN(rf_stf[i]))
+			fits = rf_fits[i]
+			fitslen = rf_fitslen[i]
+
+			# Invalidate entry if cache is disabled.
+			if (rf_cachesize <= 0)
+			    rf_time[i] = 0
+
+			call sfree (sp)
+			return 				# IN CACHE
+		    }
+
+		} else {
+		    # Keep track of least recently used slot.
+		    if (rf_lru[i] < rf_lru[slot])
+			slot = i
+		}
+	    }
+
+	    # Either the image header is not in the cache, or the cached
+	    # entry is invalid.  Prepare the given cache slot and read the
+	    # header into it.
+
+	    # Free old save buffer and descriptor.
+	    if (rf_stf[slot] != NULL) {
+		call mfree (rf_stf[slot], TY_STRUCT)
+		call mfree (rf_fits[slot], TY_CHAR)
+	    }
+
+	    # Open the header file.
+	    if (IM_HFD(im) == NULL)
+		in = open (Memc[hdrfile], READ_ONLY, TEXT_FILE)
+	    else {
+		in = IM_HFD(im)
+		call seek (in, BOFL)
+	    }
+
+	    # Allocate a spool file for the FITS data.
+	    call sprintf (rf_fname[1,slot], SZ_PATHNAME, "STFHC#%d")
+		call pargi (slot)
+	    spool = open (rf_fname[1,slot], READ_WRITE, SPOOL_FILE)
+	    call fseti (spool, F_BUFSIZE, FI_SIZE(fi))
+
+	    # Allocate cache version of STF descriptor.
+	    call calloc (stf, LEN_STFDES, TY_STRUCT)
+
+	    # Initialize the cache entry.
+	    call strcpy (Memc[hdrfile], rf_fname[1,slot], SZ_PATHNAME)
+	    rf_stf[slot] = stf
+	    rf_lru[slot] = rf_refcount
+	    rf_mtime[slot] = FI_MTIME(fi)
+	    if (!reload)
+		rf_time[slot] = clktime (0)
+	    reload = true
+
+	    # Read successive lines of the FITS header.  Process reserved
+	    # keywords into the STF descriptor and spool the remaining cards
+	    # to the fits spool file.
+
+	    repeat {
+		# Get the next input line.
+		nchars = getline (in, Memc[lbuf])
+		if (nchars == EOF)
+		    break
+
+		# Block it out to 80 chars (plus newline) if it is not already.
+		if (nchars != FITS_RECLEN + 1) {
+		    for (op=nchars;  op <= FITS_RECLEN;  op=op+1)
+			Memc[lbuf+op-1] = ' '
+		    Memc[lbuf+FITS_RECLEN]   = '\n'
+		    Memc[lbuf+FITS_RECLEN+1] = EOS
+		}
+		    
+		# Process the header card.
+		switch (stf_ctype (Memc[lbuf], index)) {
+		case KW_BITPIX:
+		    call stf_geti (Memc[lbuf], STF_BITPIX(stf))
+		case KW_DATATYPE:
+		    call stf_gets (Memc[lbuf], STF_DATATYPE(stf), SZ_DATATYPE)
+		case KW_END:
+		    break
+		case KW_GCOUNT:
+		    call stf_geti (Memc[lbuf], STF_GCOUNT(stf))
+		case KW_GROUPS:
+		    call stf_getb (Memc[lbuf], STF_GROUPS(stf))
+		case KW_NAXIS:
+		    call stf_geti (Memc[lbuf], STF_NAXIS(stf))
+		case KW_NAXISN:
+		    call stf_geti (Memc[lbuf], STF_LENAXIS(stf,index))
+		case KW_PCOUNT:
+		    call stf_geti (Memc[lbuf], STF_PCOUNT(stf))
+		case KW_PDTYPE:
+		    pp = STF_PDES(stf,min(index,MAX_PCOUNT))
+		    call stf_gets (Memc[lbuf], P_PDTYPE(pp), SZ_PDTYPE)
+		case KW_PSIZE:
+		    call stf_geti (Memc[lbuf], STF_PSIZE(stf))
+		case KW_PSIZEN:
+		    pp = STF_PDES(stf,min(index,MAX_PCOUNT))
+		    call stf_geti (Memc[lbuf], P_PSIZE(pp))
+		case KW_PTYPE:
+		    pp = STF_PDES(stf,min(index,MAX_PCOUNT))
+		    call stf_gets (Memc[lbuf], P_PTYPE(pp), SZ_PTYPE)
+		    call stf_getcmt (Memc[lbuf], P_COMMENT(pp), SZ_COMMENT)
+		case KW_SIMPLE:
+		    ;
+		default:
+		    call putline (spool, Memc[lbuf])
+		}
+	    }
+
+	    # Close the header file if opened locally.
+	    if (IM_HFD(im) == NULL)
+		call close (in)
+
+	    # Free any unneeded space in the STF descriptor.
+	    if (STF_PCOUNT(stf) > 0) {
+		call realloc (stf,
+		    LEN_STFBASE + STF_PCOUNT(stf)*LEN_PDES, TY_STRUCT)
+		rf_stf[slot] = stf
+	    }
+
+	    # Filter the spooled FITS cards to delete any cards which redefine
+	    # GPB keywords.  Store the filtered FITS data in the cache.
+
+	    call seek (spool, BOFL)
+	    nchars = fstatl (spool, F_FILESIZE)
+	    call malloc (fits, nchars, TY_CHAR)
+	    user = stropen (Memc[fits], nchars, NEW_FILE)
+	    call stf_copyfits (stf, spool, NULL, user)
+
+	    rf_fits[slot] = fits
+	    rf_fitslen[slot] = fstatl (user, F_FILESIZE)
+	    call close (user)
+	    call close (spool)
+	}
+end
diff --git a/sys/imio/iki/stf/stfrgpb.x b/sys/imio/iki/stf/stfrgpb.x
new file mode 100644
index 00000000..15c4da0a
--- /dev/null
+++ b/sys/imio/iki/stf/stfrgpb.x
@@ -0,0 +1,179 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_RGPB -- Read the group data block into the first few cards of the user
+# area of the IMIO image header.  The GPB is stored as a binary data structure
+# in the STF pixfile.  The values of the standard GPB parameters DATAMIN and
+# DATAMAX are returned as output arguments.
+#
+# DLB--11/03/87: Made changes to allow i*2 and i*4 integer parameters in GPB.
+# DLB--11/11/87: Changed calculation of character string length in GPB to
+# avoid integer truncation error by using P_PSIZE directly.
+
+procedure stf_rgpb (im, group, acmode, datamin, datamax)
+
+pointer	im			# IMIO image descriptor
+int	group			# group to be accessed
+int	acmode			# image access mode
+real	datamin, datamax	# min,max pixel values from GPB
+
+real	rval
+double	dval
+short	sval
+long	lval, offset
+bool	bval, newgroup
+pointer	sp, stf, gpb, lbuf, pp
+int	pfd, pn, sz_param, sz_gpb
+errchk	imaddb, imadds, imaddl, imaddr, imaddd, imastr
+errchk	imputd, impstr, open, read
+int	open(), read(), imaccf()
+real	imgetr()
+
+string	readerr "cannot read group data block - no such group?"
+string	badtype "illegal group data parameter datatype"
+string	nogroup "group index out of range"
+define	minmax_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	stf = IM_KDES(im)
+	pfd = STF_PFD(stf)
+
+	# Verify that the given group exists.
+	if (group < 1 || group > STF_GCOUNT(stf))
+	    call error (1, nogroup)
+
+	# Skip ahead if there is no group parameter block.
+	if (STF_PSIZE(stf) == 0)
+	    goto minmax_
+
+	# Open the pixel file if not already open.
+	if (pfd == NULL) {
+	    iferr {
+		if (IM_ACMODE(im) == READ_ONLY)
+		    pfd = open (IM_PIXFILE(im), READ_ONLY, BINARY_FILE)
+		else
+		    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+		STF_PFD(stf) = pfd
+	    } then {
+		call eprintf ("Warning: Cannot open pixfile to read GPB (%s)\n")
+		    call pargstr (IM_NAME(im))
+		pfd = NULL
+	    }
+	}
+
+	# Allocate a buffer for the GPB.
+	sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
+	call salloc (gpb, sz_gpb, TY_CHAR)
+
+	# Read the GPB into a buffer.  The GPB is located at the very end of
+	# the data storage area for the group.  If we are opening a new,
+	# uninitialized group (acmode = new_image or new_copy), do not
+	# physically read the GPB as it is will be uninitialized data.
+
+	newgroup = (acmode == NEW_IMAGE || acmode == NEW_COPY || pfd == NULL)
+	if (newgroup)
+	    call aclrc (Memc[gpb], sz_gpb)
+	else {
+	    offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
+	    call seek (pfd, offset)
+	    if (read (pfd, Memc[gpb], sz_gpb) != sz_gpb)
+		call error (1, readerr)
+	}
+
+	# Extract the binary value of each parameter in the GPB and encode it
+	# in FITS format in the IMIO user area.
+
+	offset = 0
+	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
+	    pp = STF_PDES(stf,pn)
+		
+	    # Fill in the unitialized fields of the GPB parameter descriptor.
+	    P_OFFSET(pp) = offset
+	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR
+
+	    switch (P_PDTYPE(pp)) {
+	    # changed case for int to short and long--dlb 11/3/87
+	    case 'I':
+		if (sz_param == SZ_SHORT)
+		    P_SPPTYPE(pp) = TY_SHORT
+		else
+		    P_SPPTYPE(pp) = TY_LONG
+		P_LEN(pp) = 1
+	    case 'R':
+		if (sz_param == SZ_REAL)
+		    P_SPPTYPE(pp) = TY_REAL
+		else
+		    P_SPPTYPE(pp) = TY_DOUBLE
+		P_LEN(pp) = 1
+	    case 'C':
+		P_SPPTYPE(pp) = TY_CHAR
+		# calculate length directly from PSIZE to avoid truncation error
+		P_LEN(pp) = min (SZ_LINE, P_PSIZE(pp) / NBITS_BYTE)
+	    case 'L':
+		P_SPPTYPE(pp) = TY_BOOL
+		P_LEN(pp) = 1
+	    default:
+		call error (1, badtype)
+	    }
+
+	    # Extract the binary parameter value and add a FITS encoded card
+	    # to the IMIO user area.  In the case of a new copy image, the
+	    # GPB values will already be in the image header, do not modify
+	    # the parameter value, but add the parameter if it was not
+	    # inherited from the old image.
+
+	    if (acmode != NEW_COPY || imaccf (im, P_PTYPE(pp)) == NO) {
+		switch (P_SPPTYPE(pp)) {
+		case TY_BOOL:
+                    if (SZ_INT != SZ_INT32)
+		        call amovc (Memc[gpb+offset], bval, SZ_INT32)
+                    else
+		        call amovc (Memc[gpb+offset], bval, SZ_BOOL)
+		    call imaddb (im, P_PTYPE(pp), bval)
+		case TY_SHORT:
+		    call amovc (Memc[gpb+offset], sval, SZ_SHORT)
+		    call imadds (im, P_PTYPE(pp), sval)
+		case TY_LONG:
+                    if (SZ_INT != SZ_INT32)
+		        call amovc (Memc[gpb+offset], lval, SZ_INT32)
+                    else
+		        call amovc (Memc[gpb+offset], lval, SZ_LONG)
+		    call imaddl (im, P_PTYPE(pp), lval)
+		case TY_REAL:
+		    call amovc (Memc[gpb+offset], rval, SZ_REAL)
+		    call imaddr (im, P_PTYPE(pp), rval)
+		case TY_DOUBLE:
+		    call amovc (Memc[gpb+offset], dval, SZ_DOUBLE)
+		    call imaddd (im, P_PTYPE(pp), dval)
+		case TY_CHAR:
+		    call chrupk (Memc[gpb+offset], 1, Memc[lbuf], 1, P_LEN(pp))
+		    Memc[lbuf+P_LEN(pp)] = EOS
+		    call imastr (im, P_PTYPE(pp), Memc[lbuf])
+		default:
+		    call error (1, badtype)
+		}
+	    }
+
+	    offset = offset + sz_param
+	}
+
+minmax_
+	# Return DATAMIN, DATAMAX.  This is done by searching the user area so
+	# that ordinary keywords may be used to set datamin and datamax if the
+	# GPB is not used.
+
+	datamin = 0.0; datamax = 0.0
+	if (imaccf (im, "DATAMIN") == YES)
+	    datamin = imgetr (im, "DATAMIN")
+	if (imaccf (im, "DATAMAX") == YES)
+	    datamax = imgetr (im, "DATAMAX")
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfupdhdr.x b/sys/imio/iki/stf/stfupdhdr.x
new file mode 100644
index 00000000..a4519c24
--- /dev/null
+++ b/sys/imio/iki/stf/stfupdhdr.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+# STF_UPDHDR -- Update the STF/GEIS format image header.
+
+procedure stf_updhdr (im, status)
+
+pointer	im			# image descriptor
+int	status			# return status
+
+pointer	stf
+int	acmode
+real	datamin, datamax
+errchk	imerr, imputr, stf_wgpb
+
+begin
+	acmode = IM_ACMODE(im)
+	status = OK
+	stf    = IM_KDES(im)
+
+	if (acmode == READ_ONLY)
+	    call imerr (IM_NAME(im), SYS_IMUPIMHDR)
+
+	# Compute the values of DATAMIN and DATAMAX.
+	if (IM_LIMTIME(im) == 0 || IM_LIMTIME(im) < IM_MTIME(im)) {
+	    datamin = 0.
+	    datamax = 0.
+	} else {
+	    datamin = IM_MIN(im)
+	    datamax = IM_MAX(im)
+	}
+
+	# Update the group parameter block.
+	call stf_wgpb (im, STF_GROUP(stf), datamin, datamax)
+
+#	# Update the FITS header file, unless we are writing to a new group
+#	# in an existing group format image, in which case only the GPB is
+#	# updated.
+#
+#	if (acmode != NEW_IMAGE && acmode != NEW_COPY)
+#	    call stf_wfitshdr (im)
+#	else if (STF_NEWIMAGE(stf) == YES)
+#	    call stf_wfitshdr (im)
+
+	# The new strategy for FITS header updates is to always update, unless
+	# we are explicitly updating an existing group of a multigroup image.
+	# Hence, the FITS header is always updated for an STF image with only
+	# one group, or when writing the first group of a new STF imagefile.
+	# The FITS header of an existing STF multigroup image can still be
+	# updated, but only if the image is not opened to any particular group,
+	# e.g., as "pix" rather than "pix[n]", N > 0.  NEW_[IMAGE|COPY] or
+	# READ_WRITE access to "pix[n]" will update only the GPB header.
+
+	if (STF_NEWIMAGE(stf)==YES || STF_GCOUNT(stf)<=1 || STF_GRARG(stf)==0)
+	    call stf_wfitshdr (im)
+end
diff --git a/sys/imio/iki/stf/stfwfits.x b/sys/imio/iki/stf/stfwfits.x
new file mode 100644
index 00000000..c444a235
--- /dev/null
+++ b/sys/imio/iki/stf/stfwfits.x
@@ -0,0 +1,147 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fio.h>
+include	"stf.h"
+
+# STF_WFITSHDR -- Update the FITS header file.  This is done by writing an
+# entire new header file and then replacing the old header file with the
+# new one.  This is necessary since the header file is a text file and text
+# files cannot be randomly updated.
+
+procedure stf_wfitshdr (im)
+
+pointer	im			# image descriptor
+
+pointer	sp, fname, lbuf, stf, pp
+int	in, out, pn, junk, i, width
+
+bool	fnullfile()
+int	stropen(), open(), protect(), strlen() #ditto-dlb
+errchk	fmkcopy, open, stropen, fcopyo, fprintf
+
+begin
+	if (fnullfile (IM_HDRFILE(im)))
+	    return
+
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	stf = IM_KDES(im)
+
+	# Open a new header file with a unique, temporary name.  Make a copy
+	# of the template file rather than of the old header file.  Since
+	# we also block header lines out to 80 chars automatically, this
+	# means that we can read any old text file but will always generate
+	# a new header file of the standard type when the header is updated.
+
+	call mktemp (IM_HDRFILE(im), Memc[fname], SZ_FNAME)
+	call fmkcopy (HDR_TEMPLATE, Memc[fname])
+	out = open (Memc[fname], APPEND, TEXT_FILE)
+
+	# Write out the standard, reserved header parameters.
+
+	call fprintf (out, "SIMPLE  =%21s /%81t\n")
+	    call pargstr ("F")
+	call fprintf (out, "BITPIX  =%21d /%81t\n")
+	    call pargi (STF_BITPIX(stf))
+
+	# We want to get the full string length or 8 characters, 
+	# whichever is greater--6/25/87, dlb
+	
+	call fprintf (out, "DATATYPE= '%*.*s'%32t/%81t\n")
+	    width = max(8, strlen(STF_DATATYPE(STF)))
+	    call pargi (-width) # force left-justified field
+	    call pargi (width)
+	    call pargstr (STF_DATATYPE(stf))
+
+	call fprintf (out, "NAXIS   =%21d /%81t\n")
+	    call pargi (STF_NAXIS(stf))
+	do i = 1, STF_NAXIS(stf) {
+	    call fprintf (out, "NAXIS%d%9t=%21d /%81t\n")
+		call pargi (i)
+		call pargi (STF_LENAXIS(stf,i))
+	}
+
+	call fprintf (out, "GROUPS  =%21s /%81t\n")
+	    if (STF_GROUPS(stf) == YES)
+		call pargstr ("T")
+	    else
+		call pargstr ("F")
+
+	# Changed order of the following three cards to conform
+	# to SOGS expectations--dlb, 7/14/87
+	# Only write group keywords if STF_GROUPS is YES (BPS 12.06.91)
+
+	if (STF_GROUPS(stf) == YES) {
+	    call fprintf (out, "GCOUNT  =%21d /%81t\n")
+		call pargi (STF_GCOUNT(stf))
+	    call fprintf (out, "PCOUNT  =%21d /%81t\n")
+		call pargi (STF_PCOUNT(stf))
+	    call fprintf (out, "PSIZE   =%21d /%81t\n")
+		call pargi (STF_PSIZE(stf))
+	}
+
+	# Add cards defining the fields of the group parameter block.  Each
+	# field requires three cards.
+
+	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
+	    pp = STF_PDES(stf,pn)
+
+	    # PTYPE MUST be 8 characters or less.
+	    call fprintf (out, "PTYPE%d%9t= '%-8.8s'%32t/%s%81t\n")
+		call pargi (pn)
+		call pargstr (P_PTYPE(pp))
+		call pargstr (P_COMMENT(pp))
+
+	    # Need width for string--6/26/87, dlb
+	    call fprintf (out, "PDTYPE%d%9t= '%-*.*s'%32t/%81t\n")
+		call pargi (pn)
+		width = max (8, strlen(P_PDTYPE(pp)))
+		call pargi (-width) # force left-justified field
+		call pargi (width)
+		call pargstr (P_PDTYPE(pp))
+
+	    call fprintf (out, "PSIZE%d%9t=%21d /%81t\n")
+		call pargi (pn)
+		call pargi (P_PSIZE(pp))
+	}
+
+	# Add the contents of the IMIO user area, excluding the cards used
+	# to represent GPB parameters.
+
+	in = stropen (Memc[IM_USERAREA(im)], ARB, READ_ONLY)
+	call stf_copyfits (stf, in, NULL, out)
+	call close (in)
+
+	# End of FITS header.
+	call fprintf (out, "END%81t\n")
+	call close (out)
+
+	# Replace the original header file with the new one, even if the
+	# original header is a protected file.  Transfer any file protection
+	# to the new file.
+
+	if (IM_HFD(im) != NULL)
+	    call close (IM_HFD(im))
+
+	if (protect (IM_HDRFILE(im), QUERY_PROTECTION) == YES) {
+	    iferr (junk = protect (IM_HDRFILE(im), REMOVE_PROTECTION))
+		call erract (EA_ERROR)
+	    iferr (junk = protect (Memc[fname], SET_PROTECTION))
+		call erract (EA_ERROR)
+	}
+
+	iferr (call delete (IM_HDRFILE(im)))
+	    call erract (EA_ERROR)
+	iferr (call rename (Memc[fname], IM_HDRFILE(im)))
+	    call erract (EA_ERROR)
+
+	if (IM_HFD(im) != NULL)
+	    IM_HFD(im) = open (IM_HDRFILE(im), READ_ONLY, TEXT_FILE)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfwgpb.x b/sys/imio/iki/stf/stfwgpb.x
new file mode 100644
index 00000000..3a9e8fe8
--- /dev/null
+++ b/sys/imio/iki/stf/stfwgpb.x
@@ -0,0 +1,174 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_WGPB -- Write the group parameter block data back into the pixel file.
+# The GPB is described by a structure member list in the STF descriptor.
+# The values of the GPB parameters are encoded as FITS cards in the user
+# area of the IMIO descriptor.
+#
+# DLB--11/3/87: Made changes to allow i*2 and i*4 integer parameters in gpb.
+
+procedure stf_wgpb (im, group, datamin, datamax)
+
+pointer	im			# IMIO image descriptor
+int	group			# group to be accessed
+real	datamin, datamax	# new min, max pixel values
+
+long	offset
+pointer	sp, stf, gpb, lbuf, pp, op
+int	pfd, pn, sz_param, sz_gpb, i
+
+int	open(), strlen()
+bool	bval, imgetb()
+# changed to short and long for short integers in gpb
+short	sval, imgets()
+long	lval, imgetl()
+#
+real	rval, imgetr()
+double	dval, imgetd()
+errchk	open, seek
+int	imaccf()
+
+string	writerr "cannot update group parameter block"
+string	badtype "illegal group data parameter datatype"
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	stf = IM_KDES(im)
+	pfd = STF_PFD(stf)
+
+	# Not all images have group parameter blocks.
+	if (STF_PSIZE(stf) == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Open the pixel file if not already open.
+	if (pfd == NULL) {
+	    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+	    STF_PFD(stf) = pfd
+	}
+
+	# Update the values of DATAMIN, DATAMAX.
+	if (imaccf (im, "DATAMIN") == YES && 
+            imaccf (im, "DATAMAX") == YES) {
+
+	    iferr {
+	        call imputr (im, "DATAMIN", datamin)
+	        call imputr (im, "DATAMAX", datamax)
+	    } then
+	        call erract (EA_WARN)
+	}
+
+	# Allocate a buffer for the GPB.
+	sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
+	call salloc (gpb, sz_gpb, TY_CHAR)
+
+	# Extract the binary value of each parameter in the GPB and encode it
+	# in FITS format in the IMIO user area.
+
+	offset = 0
+	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
+	    pp = STF_PDES(stf,pn)
+	    op = gpb + offset
+
+	    # Fetch the value of the parameter from IMIO and write it into
+	    # the GPB binary data structure.
+
+	    switch (P_SPPTYPE(pp)) {
+	    case TY_BOOL:
+		iferr (bval = imgetb (im, P_PTYPE(pp))) {
+		    call erract (EA_WARN)
+		    bval = false
+		}
+		# Memb[(op-1)/SZ_BOOL+1] = bval
+		if (SZ_INT != SZ_INT32) {
+		    call i64to32 (bval, bval, 1)
+		    call amovc (bval, Memc[op], SZ_INT32)
+		} else
+		    call amovc (bval, Memc[op], SZ_BOOL)
+
+	    # changed case for int to short and long 
+	    # to allow i*2 in gpb--dlb 11/3/87
+	    case TY_SHORT:
+		iferr (sval = imgets (im, P_PTYPE(pp))) {
+		    call erract (EA_WARN)
+		    sval = 0
+		}
+		call amovc (sval, Memc[op], SZ_SHORT)
+
+	    case TY_LONG:
+		iferr (lval = imgetl (im, P_PTYPE(pp))) {
+		    call erract (EA_WARN)
+		    lval = 0
+		}
+		if (SZ_INT != SZ_INT32) {
+		    call i64to32 (lval, lval, 1)
+		    call amovc (lval, Memc[op], SZ_INT32)
+		} else
+		    call amovc (lval, Memc[op], SZ_LONG)
+
+	    case TY_REAL:
+		iferr (rval = imgetr (im, P_PTYPE(pp))) {
+		    # Currently with MWCS, WCS cards such as CRVAL, CDi_j,
+		    # etc. (always type real or double) are omitted from the
+		    # header if their value is zero.  Hence if the card is
+		    # missing assume a value of zero rather than issue a
+		    # warning.
+
+		    # call erract (EA_WARN)
+		    rval = 0.0
+		}
+		# Memr[(op-1)/SZ_REAL+1] = rval
+		call amovc (rval, Memc[op], SZ_REAL)
+
+	    case TY_DOUBLE:
+		iferr (dval = imgetd (im, P_PTYPE(pp))) {
+		    # Skip warning as assume zero, as above or TY_REAL.
+		    # call erract (EA_WARN)
+		    dval = 0.0D0
+		}
+		# Memd[(op-1)/SZ_DOUBLE+1] = dval
+		call amovc (dval, Memc[op], SZ_DOUBLE)
+
+	    case TY_CHAR:
+		# Blank fill the string buffer.
+		do i = 1, P_LEN(pp)
+		    Memc[lbuf+i-1] = ' '
+
+		# Fetch the string value of the parameter.
+		iferr (call imgstr (im, P_PTYPE(pp), Memc[lbuf], SZ_LINE))
+		    call erract (EA_WARN)
+
+		# Replace the EOS delimiter by a blank.
+		i = strlen (Memc[lbuf])
+		Memc[lbuf+i] = ' '
+
+		# Pack the blank filled array into the GPB.
+		call chrpak (Memc[lbuf], 1, Memc[gpb+offset], 1, P_LEN(pp))
+
+	    default:
+		call error (1, badtype)
+	    }
+
+	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR
+	    offset = offset + sz_param
+	}
+
+	# Write the GPB into the pixfile.  The GPB is located at the very end
+	# of the data storage area for the group.
+
+	offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
+	call seek (pfd, offset)
+	iferr (call write (pfd, Memc[gpb], sz_gpb))
+	    call error (5, writerr)
+
+	call sfree (sp)
+end