Initial commit

30 files changed, 8285 insertions, 0 deletions

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