Initial commit

27 files changed, 2949 insertions, 0 deletions

diff --git a/sys/imio/iki/stf/README b/sys/imio/iki/stf/README
new file mode 100644
index 00000000..5540110b
--- /dev/null
+++ b/sys/imio/iki/stf/README
@@ -0,0 +1,300 @@
+IKI/STF -- IKI kernel for the STScI SDAS/GEIS image format.  This format stores
+images in a format which resembles FITS group format.  A GROUP FORMAT IMAGE is
+a set of one or more images, all of which are the same size, dimension, and
+datatype, and which share a common FITS header.  The individual images in a
+group each has a binary GROUP PARAMETER BLOCK (GPB).  The image and associated
+group parameter block are commonly referred to as a GROUP.  A group format
+image consists of two files, the FITS format header file for the group,
+and the pixel file containing the image data and GPBs.
+
+
+1. Typical STF group format FITS image header (imname.hhh)
+
+	SIMPLE	=		    F		/ Standard STF keywords
+	BITPIX	=		    32
+	DATATYPE= 'REAL*4	'
+	NAXIS	=		    2
+	NAXIS1	=		    512
+	NAXIS2	=		    512
+	GROUPS	=		    T
+	PSIZE	=		    512
+	GCOUNT	=		    1
+	PCOUNT	=		    12
+
+	PTYPE1	= 'DATAMIN	'		/ Define binary group params
+	PSIZE1	= 		    32
+	PDTYPE1	= 'REAL*4	'
+	    (etc, for a total of 3*PCOUNT entries)
+
+	(special keywords and HISTORY cards)
+
+
+2. Pixel file format (imname.hhd) (byte stream, no alignment, no header)
+
+	[1].pixels
+	[1].group parameter block
+	[2].pixels
+	[2].group parameter block
+		...
+	[GCOUNT].pixels
+	[GCOUNT].group parameter block
+
+
+The chief problems with this format are that the FITS format header can contain
+only parameters which pertain to the group as a whole, while the format of the
+GPBs is fixed at image creation time.  Images may be neither deleted from nor
+added to a group.  It is possible for parameters in the FITS header to have
+the same names as parameters in the GPBs.  Multiple entries for the same
+keyword may appear in the FITS header and the format does not define how
+these are to be handled.  Although the format is general enough to support
+any datatype pixels, in practice only REAL*4 can be used as the SDAS software
+maps the pixfile directly into virtual memory.
+
+CAVEAT -- This is an awkward interface and some liberties have been taken in
+the code (hidden, subtle semantics, etc.).  At least we were able to confine
+the bad code to this one directory; any problems can be fixed without any
+changes to the rest of IMIO.  All of this low level code is expected to be
+thrown out when IMIO is cut over onto DBIO (the upcoming IRAF database
+interface).
+
+
+IKI/STF Pseudocode
+----------------------------
+
+1. Data structures:
+
+	1.1 IMIO image descriptor
+	    header, pixel file descriptors
+	    pointer to additional kernel descriptor, if any
+	    index of IKI kernel in use
+	    pathnames of header, pixel files
+	    IM_NDIM, IM_LEN, etc., physical image parameters
+
+	1.2 STF image descriptor
+	    Pointed to by IM_KDES field of IMIO descriptor.
+	    Contains values of all reserved fields of STF image header,
+		some of which duplicate values in IMIO descriptor.
+	    Group, gcount, size of a group in pixfile, description of
+		the group parameter block, i.e., for each parameter,
+		the offset, datatype type, name, length if array, etc.
+
+	1.3 IMIO user area (FITS cards)
+	    While an image is open, the first few cards in the user area
+		contain the FITS encoded group parameters.
+	    The remainder of the user area contains an exact image of
+		all non-reserved keyword cards found in the STF image
+		header (or in the header of some other type of image
+		when making a new_copy of an image stored in some other
+		format).
+
+
+2. Major Procedures
+
+procedure open_image
+
+begin
+	if (mode is not new_image or new_copy) {
+	    open_existing_image
+	    return
+	}
+
+	We are opening a new_image or new_copy image.  The problem here is
+	that the new image might be a group within an existing group format
+	image.  This ambiguity is resolved by a simple test on the group
+	index, rather than by a context dependent test on the existence of
+	the group format image.  If the mode is new_whatever and the group
+	is 1, a new group format image is created, else if the group is > 1,
+	the indicated group is initialized in an existing group format image.
+
+	if (group > 1) {
+	    We are opening a new group within an existing group format image.
+
+	    Call open_existing_image to open the group without reading the
+		group parameter block, which has not yet been initialized.
+
+	    if (mode is new_image)
+		initialize GPB to pixel coords
+	    else if (mode is new_copy)
+		copy old GPB to new image; transform coords if necessary
+
+	    Note that when opening a new copy of an existing image as a new
+	    group within a group format image, it is not clear what to do
+	    with the FITS header of the old image.  Our solution is to ignore
+	    it, and retain only the GPB, the only part of the old header
+	    pertaining directly to the group being accessed.
+
+	} else if (opening group 1 of a new image) {
+	    We are creating a new group format image.
+
+	    if (mode is new_image)
+		open_new_image
+	    else
+		open_new_copy
+	}
+end
+
+
+procedure open_existing_image
+
+begin
+	Allocate STF descriptor, save pointer in imio descriptor.
+	Open image header.
+
+	Read header:
+		process reserved cards into STF descriptor
+		spool other cards
+
+	Load group data block from pixfile, get datamin/datamax:
+		if (there is a gdb) {
+		    open pixfile
+		    read gdb into buffer
+		    for (each param in gdb) {
+			set up parameter descriptor
+			format FITS card and put in imio user area
+		    }
+		}
+
+		fetch datamin, datamax from user area
+
+	Set IM_MIN, IM_MAX, IM_LIMTIME from DATAMIN, DATAMAX.
+	Mark end of user area.
+	Copy spooled cards to user area.
+		(increase size of user area if necessary)
+
+	Call imioff to set up imio pixel offset parameters
+end
+
+
+procedure open_new_image
+
+begin
+	Upon entry, the imio iminie procedure has already been called to
+	    initialize the imio descriptor for the new image.
+
+	Allocate STF descriptor, save pointer in imio descriptor.
+	Create header file from template dev$pix.hhh.
+	Open new image header.
+
+	(At this point the IMIO header fields IM_NDIM, IM_LEN, etc., and
+	(the STF descriptor fields have not yet been set, and cannot be set
+	(until the image dimensions have been defined by the high level code.
+	(imopix() will later have to fix up the remaining header fields and
+	(set up the default group data block.
+end
+
+
+procedure open_new_copy
+
+begin
+	Upon entry, the imio immaky procedure has already been called to
+	    copy the old header to the new and initialize the data
+	    dependent fields.  This will include the FITS encoded group
+	    parameters in the user area of the old image.
+
+	Allocate STF descriptor, save pointer in imio descriptor.
+	Create header file from template dev$pix.hhh.
+	Open new image header.
+
+	Copy the STF descriptor of the old image to the new.  Preserve
+	    the parameter marking the end of the GPB area of the old
+	    user area, as we do not want to write these cards when the
+	    header is updated.
+
+	(At this point all header information is set up, except that there
+	(is no pixel file and the pixfile offsets have not been set.
+	(Provided the image dimensions do not change, one could simply
+	(set the pixfile name, call imioff, and do i/o to the image.
+end
+
+
+procedure open_pixel_file
+
+begin
+	(We are called when the first i/o is done to an image.  When writing
+	(to a new image, the user may change any of the image header attributes
+	(after the open and before we are called.
+
+	if (pixel file already open)
+	    return
+	else if (opening existing image) {
+	    open pixel file
+	    return
+	}
+
+	if (opening a new image) {
+	    Given the values of IM_NDIM and IM_LEN set by the user, set up the
+	    STF descriptor including the default group parameter block.  Add
+	    the FITS encoded cards for the GPB to the image header.  Mark the
+	    end of the GPB cards, i.e., the start of the real user parameter
+	    area.  Ignore IM_PIXTYPE; always open an image of type real since
+	    that is what the SDAS software requires.  Set up the WCS to linear
+	    pixel coordinates.
+
+	} else if (opening a new_copy image) {
+	    (The STF descriptor and GPB will already have been set up as a
+	    (copy of the data structures used by the old image.  However,
+	    (the user may have changed the values of IM_NDIM and IM_LEN
+	    (since the image was opened, and the value of GCOUNT set when
+	    (the image was opened may be different than that of the old image.
+
+	    Transform the coordinate system of the old image to produce the
+	    WCS for the new image, i.e., if an image section was used to
+	    reference the old image.
+
+	    Make a new STF descriptor using the values of IM_NDIM and IM_LEN
+	    given, as for a new_image, but using the WCS information for the
+	    new image.  The FITS encoded fields in the IMIO user area will be
+	    automatically updated by the IMADD functions, or new cards added
+	    if not present.
+
+	    Merge any additional fields from the old STF descriptor into the
+	    new one, e.g., any instrument dependent parameters stored in the
+	    GPB.
+
+	    (The STF and FITS encoded user area should now contain a full
+	    (description of the GPB for the new image.
+	}
+
+	Allocate the pixel file, using the GCOUNT parameter set in the
+	    STF descriptor at stf_open time.
+	Open the pixel file.
+
+	Set IM_MIN and IM_MAX to zero (not defined).
+	Call IMIOFF to initialize the pixel offsets.
+end
+
+
+procedure update_image_header
+
+begin
+	Update the values of DATAMIN, DATAMAX from the IMIO header fields.
+
+	Update the binary GPB in the pixel file from the FITS encoded GPB
+	    in the IMIO user area, using the GPB structure defined in the
+	    STF descriptor.
+
+	Update the STF image header file:
+	    Open a new, empty header file using FMKCOPY and OPEN.
+	    Format and output FITS cards for the reserved header fields,
+		e.g., SIMPLE, BITPIX, GCOUNT, the GPB information, etc.
+	    Copy the user area to the new header file, excluding the
+		GPB cards at the beginning of the user area.
+	    Close the new header file and replace the old header file
+		with the new one via a rename operation.
+end
+
+
+procedure close_image
+
+begin
+	(We assume that IMIO has already update the image header if such
+	(is necessary.
+
+	if (pixel file open)
+	    close pixel file
+	if (header file open)
+	    close header file
+
+	deallocate STF descriptor
+	(IMIO will deallocate the IMIO descriptor)
+end
diff --git a/sys/imio/iki/stf/mkpkg b/sys/imio/iki/stf/mkpkg
new file mode 100644
index 00000000..b28ace96
--- /dev/null
+++ b/sys/imio/iki/stf/mkpkg
@@ -0,0 +1,36 @@
+# Make the IKI/STF interface (STScI SDAS/GEIS group format images)
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	#$set XFLAGS = "$(XFLAGS) -qfx"
+	#$set XFLAGS = "$(XFLAGS) -/pg"
+
+	stfaccess.x	stf.h
+	stfaddpar.x	<imhdr.h> <imio.h> <mach.h> stf.h
+	stfclose.x	stf.h <imhdr.h> <imio.h>
+	stfcopy.x	stf.h <error.h>
+	stfcopyf.x	stf.h
+	stfctype.x	stf.h <ctype.h>
+	stfdelete.x	stf.h <error.h> <imhdr.h>
+	stfget.x	stf.h <ctype.h>
+	stfhextn.x	stf.h <imhdr.h> <imio.h>
+	stfiwcs.x	stf.h <imhdr.h>
+	stfmerge.x	stf.h <imhdr.h> <imio.h> <mach.h>
+	stfmkpfn.x	stf.h
+	stfnewim.x	stf.h <imhdr.h> <imio.h> <mach.h>
+	stfopen.x	stf.h <error.h> <imhdr.h> <imio.h>
+	stfopix.x	stf.h <fset.h> <imhdr.h> <imio.h> <mach.h>
+	stfordgpb.x	stf.h <mach.h>
+	stfrdhdr.x	stf.h <finfo.h> <imhdr.h> <imio.h> <mach.h>
+	stfreblk.x	stf.h <imhdr.h> <imio.h>
+	stfrename.x	stf.h <error.h>
+	stfrfits.x	stf.h <ctype.h> <finfo.h> <fset.h> <imhdr.h> <imio.h>
+	stfrgpb.x	stf.h <imhdr.h> <imio.h> <mach.h>
+	stfupdhdr.x	stf.h <imhdr.h> <imio.h>
+	stfwfits.x	stf.h <error.h> <fio.h> <imhdr.h> <imio.h>
+	stfwgpb.x	stf.h <error.h> <imhdr.h> <imio.h> <mach.h>
+	;
diff --git a/sys/imio/iki/stf/stf.h b/sys/imio/iki/stf/stf.h
new file mode 100644
index 00000000..bf99a07c
--- /dev/null
+++ b/sys/imio/iki/stf/stf.h
@@ -0,0 +1,77 @@
+# STF.H -- IKI/STF internal definitions.
+
+define	HDR_TEMPLATE	"dev$pix.hhh"	# used by fmkcopy to create new header
+define	MAX_LENEXTN	3		# max length imagefile extension
+define	STF_HDRPATTERN	"^??h"		# class of legal header extensions
+define	STF_DEFHDREXTN	"hhh"		# default header file extension
+define	STF_DEFPIXEXTN	"hhd"		# default pixel file extension
+define	ENV_DEFIMTYPE	"imtype"	# name of environment variable
+define	STF_MAXDIM	7		# max NAXIS
+define	MAX_CACHE	5		# max cached header files
+define	DEF_CACHE	3		# default size of header file cache
+define	ENV_STFCACHE	"stfcache"	# environment variable for cache size
+define	MAX_PCOUNT	99		# max param descriptors
+define	SZ_DATATYPE	16		# e.g., `REAL*4'
+define	SZ_KEYWORD	8		# size of a FITS keyword
+define	SZ_PTYPE	8		# e.g., `CRPIX1'
+define	SZ_PDTYPE	16		# e.g., `CHAR*8'
+define	SZ_COMMENT	FITS_SZCOMMENT	# comment string for GPB card
+define	SZ_EXTRASPACE	(81*32)		# extra space for new cards in header
+
+define	FITS_RECLEN	80		# length of a FITS record (card)
+define	FITS_STARTVALUE	10		# first column of value field
+define	FITS_ENDVALUE	30		# last  column of value field
+define	FITS_SZVALSTR	21		# nchars in value string
+define	FITS_SZCOMMENT	50		# max chars in comment, incl. /
+
+# STF image descriptor, used internally by the STF interface.  The required
+# header parameters are maintained in this descriptor, everything else is
+# simply copied into the user area of the IMIO descriptor.
+
+define	LEN_STFDES	(LEN_STFBASE+MAX_PCOUNT*LEN_PDES)
+define	STF_CACHE	STF_BITPIX	# cache descriptor starting here
+define	STF_CACHELEN	(33+STF_PCOUNT($1)*LEN_PDES)
+define	LEN_STFBASE	43
+
+define	STF_ACMODE	Memi[$1]	# image access mode
+define	STF_NEWIMAGE	Memi[$1+1]	# creating entire new STF format image?
+define	STF_GROUP	Memi[$1+2]	# group to be accessed
+define	STF_SZGROUP	Memi[$1+3]	# size of image+hdr in pixfile, chars
+define	STF_PFD		Memi[$1+4]	# pixfile file descriptor
+define	STF_GRARG	Memi[$1+5]	# group index given in image name
+			# (extra space)
+define	STF_BITPIX	Memi[$1+10]	# bits per pixel
+define	STF_NAXIS	Memi[$1+11]	# number of axes in image
+define	STF_GROUPS	Memi[$1+12]	# group format?
+define	STF_GCOUNT	Memi[$1+13]	# number of groups in STF image
+define	STF_PSIZE	Memi[$1+14]	# size of GPB, bits
+define	STF_PCOUNT	Memi[$1+15]	# number of parameters in GPB
+define	STF_DATATYPE	Memc[P2C($1+16)]# datatype string
+define	STF_LENAXIS	Memi[$1+35+$2-1]# 35:41 = [7] max
+define	STF_PDES	(($1)+43+((($2)-1)*LEN_PDES))
+
+# GPB Parameter descriptor.
+define	LEN_PDES	81
+define	P_OFFSET	Memi[$1]	# struct offset of parameter
+define	P_SPPTYPE	Memi[$1+1]	# SPP datatype of parameter
+define	P_LEN		Memi[$1+2]	# number of elements
+define	P_PSIZE		Memi[$1+3]	# field size, bits
+define	P_PTYPEP	(P2C($1+4))	# pointer to parameter name
+define	P_PTYPE		Memc[P2C($1+4)]	# parameter name
+define	P_PDTYPE	Memc[P2C($1+13)]# datatype string
+define	P_COMMENT	Memc[P2C($1+30)]# comment string
+
+# Reserved FITS keywords known to this code.
+define	KW_BITPIX	1
+define	KW_DATATYPE	2
+define	KW_END		3
+define	KW_GCOUNT	4
+define	KW_GROUPS	5
+define	KW_NAXIS	6
+define	KW_NAXISN	7
+define	KW_PCOUNT	8
+define	KW_PDTYPE	9
+define	KW_PSIZE	10
+define	KW_PSIZEN	11
+define	KW_PTYPE	12
+define	KW_SIMPLE	13
diff --git a/sys/imio/iki/stf/stfaccess.x b/sys/imio/iki/stf/stfaccess.x
new file mode 100644
index 00000000..40907c69
--- /dev/null
+++ b/sys/imio/iki/stf/stfaccess.x
@@ -0,0 +1,58 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stf.h"
+
+# STF_ACCESS -- Test the accessibility or existence of an existing image, or
+# the legality of the name of a new image.
+
+procedure stf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O return value
+
+int	i
+pointer	sp, fname, kextn
+int	access(), iki_validextn(), iki_getextn(), btoi()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (kextn, MAX_LENEXTN, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+	    call sfree (sp)
+	    return
+	}
+
+	status = NO
+
+	# If no extension was given, look for a file with the default
+	# extension, and return the actual extension if an image with the
+	# default extension is found.
+
+	if (extn[1] == EOS) {
+	    do i = 1, ARB {
+		if (iki_getextn (kernel, i, Memc[kextn], MAX_LENEXTN) <= 0)
+		    break
+		call iki_mkfname (root, Memc[kextn], Memc[fname], SZ_PATHNAME)
+		if (access (Memc[fname], acmode, 0) == YES) {
+		    call strcpy (Memc[kextn], extn, MAX_LENEXTN)
+		    status = YES
+		    break
+		}
+	    }		
+	} else if (iki_validextn (kernel, extn) == kernel) {
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	    if (access (Memc[fname], acmode, 0) == YES)
+		status = YES
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfaddpar.x b/sys/imio/iki/stf/stfaddpar.x
new file mode 100644
index 00000000..65a90f80
--- /dev/null
+++ b/sys/imio/iki/stf/stfaddpar.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include "stf.h"
+
+# STF_ADDPAR -- Encode a parameter in FITS format and add it to the FITS format
+# IMIO user area; initialize the entry for the parameter in the GPB descriptor
+# as well.
+
+procedure stf_addpar (im, pname, dtype, plen, pval, pno)
+
+pointer	im			#I image descriptor
+char	pname[ARB]		#I parameter name
+int	dtype			#I SPP datatype of parameter
+int	plen			#I length (> 1 if array)
+char	pval[ARB]		#I string encoded initial parameter value
+int	pno			#U parameter number
+
+bool	bval
+real	rval
+double	dval
+short	sval
+long	lval
+pointer	pp, stf
+
+bool	initparam
+int	ival, ip, junk
+int	ctoi(), ctor(), ctod(), imaccf()
+errchk	imadds, imaddl, imaddr, imaddd, imastr
+
+begin
+	stf = IM_KDES(im)
+	pp  = STF_PDES(stf,pno)
+	ip  = 1
+
+	call strcpy (pname, P_PTYPE(pp), SZ_PTYPE)
+
+	# Initialize the parameter only if not already defined in header.
+	initparam = (imaccf (im, pname) == NO)
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call strcpy ("LOGICAL*4", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_BOOL * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		bval = (pval[1] == 'T')
+		call imaddb (im, P_PTYPE(pp), bval)
+	    }
+	case TY_SHORT:
+	    call strcpy ("INTEGER*2", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_SHORT * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctoi (pval, ip, ival)
+		sval = ival
+		call imadds (im, P_PTYPE(pp), sval)
+	    }
+	case TY_LONG:
+	    call strcpy ("INTEGER*4", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_LONG * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctoi (pval, ip, ival)
+		lval = ival
+		call imaddl (im, P_PTYPE(pp), lval)
+	    }
+	case TY_REAL:
+	    call strcpy ("REAL*4", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_REAL * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctor (pval, ip, rval)
+		call imaddr (im, P_PTYPE(pp), rval)
+	    }
+	case TY_DOUBLE:
+	    call strcpy ("REAL*8", P_PDTYPE(pp), SZ_PDTYPE)
+	    P_PSIZE(pp) = plen * SZ_DOUBLE * SZB_CHAR * NBITS_BYTE
+	    if (initparam) {
+		junk = ctod (pval, ip, dval)
+		call imaddd (im, P_PTYPE(pp), dval)
+	    }
+	default:
+	    call sprintf (P_PDTYPE(pp), SZ_PDTYPE, "CHARACTER*%d")
+		call pargi (plen)
+	    P_PSIZE(pp) = plen * NBITS_BYTE
+	    if (initparam)
+		call imastr (im, P_PTYPE(pp), pval)
+	}
+
+	P_OFFSET(pp) = 0
+	P_SPPTYPE(pp) = dtype
+	P_LEN(pp) = plen
+
+	pno = pno + 1
+end
diff --git a/sys/imio/iki/stf/stfclose.x b/sys/imio/iki/stf/stfclose.x
new file mode 100644
index 00000000..89981578
--- /dev/null
+++ b/sys/imio/iki/stf/stfclose.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <imio.h>
+include	"stf.h"
+
+# STF_CLOSE -- Close an STF format image.  There is little for us to do, since
+# IMIO will already have updated the header if necessary and flushed any pixel
+# output.  Neither do we have to deallocate the IMIO descriptor, since it was
+# allocated by IMIO.
+
+procedure stf_close (im, status)
+
+pointer	im			# image descriptor
+int	status
+
+pointer	stf
+errchk	close
+
+begin
+	stf = IM_KDES(im)
+
+	# Close the pixel file and header file, if open.
+	if (STF_PFD(stf) != NULL)
+	    call close (STF_PFD(stf))
+	if (IM_HFD(im) != NULL)
+	    call close (IM_HFD(im))
+
+	# Deallocate the STF descirptor.
+	call mfree (IM_KDES(im), TY_STRUCT)
+	status = OK
+end
diff --git a/sys/imio/iki/stf/stfcopy.x b/sys/imio/iki/stf/stfcopy.x
new file mode 100644
index 00000000..e8643600
--- /dev/null
+++ b/sys/imio/iki/stf/stfcopy.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"stf.h"
+
+# STF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure stf_copy (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		# old image root name
+char	oextn[ARB]		# old image extn
+char	nroot[ARB]		# new image root name
+char	nextn[ARB]		# old image extn
+int	status
+
+pointer	sp
+pointer	ohdr_fname, opix_fname, nhdr_fname, npix_fname
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (opix_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (npix_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	call stf_mkpixfname (oroot, oextn, Memc[opix_fname], SZ_PATHNAME)
+	call stf_mkpixfname (nroot, nextn, Memc[npix_fname], SZ_PATHNAME)
+
+	# If the header cannot be copied, leave the pixfile alone.
+	iferr (call fcopy (Memc[ohdr_fname], Memc[nhdr_fname]))
+	    call erract (EA_WARN)
+	else iferr (call fcopy (Memc[opix_fname], Memc[npix_fname]))
+	    call erract (EA_WARN)
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/stf/stfcopyf.x b/sys/imio/iki/stf/stfcopyf.x
new file mode 100644
index 00000000..7402c879
--- /dev/null
+++ b/sys/imio/iki/stf/stfcopyf.x
@@ -0,0 +1,92 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "stf.h"
+
+define	NKW	4		# number of reserved header keywords
+
+
+# STF_COPYFITS -- Copy the spooled FITS header, separating out the GPB cards
+# and returning either or both types of cards on the two output streams.
+
+procedure stf_copyfits (stf, spool, gpb, user)
+
+pointer	stf			#I pointer to STF descriptor
+int	spool			#I spooled header to read
+int	gpb			#I stream to receive GPB cards, or NULL
+int	user			#I stream to receive user cards, or NULL
+
+bool	keyword
+int	p_ch[MAX_PCOUNT+NKW]
+pointer	p_len[MAX_PCOUNT+NKW]
+pointer	p_namep[MAX_PCOUNT+NKW]
+int	delim, ch, npars, ngpbpars, i
+pointer	sp, lbuf, sbuf, pp, op, kw[NKW]
+int	strncmp(), getline(), strlen(), gstrcpy()
+errchk	getline, putline
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (sbuf, SZ_LINE, TY_CHAR)
+
+	# The following reserved keywords describing the GPB are added to
+	# the user area by stf_rdheader, and must be filtered out along with
+	# the group parameters.  Since the number of reserved or group
+	# parameters is normally small (only a dozen or so typically) a
+	# simple 1 character - 2 thread hashing scheme is probably faster,
+	# and certainly simpler, than a full hash table keyword lookup.
+
+	op = sbuf
+	npars = NKW
+	kw[1] = op;  op = op + gstrcpy ("GROUPS", Memc[op], ARB) + 1
+	kw[2] = op;  op = op + gstrcpy ("GCOUNT", Memc[op], ARB) + 1
+	kw[3] = op;  op = op + gstrcpy ("PCOUNT", Memc[op], ARB) + 1
+	kw[4] = op;  op = op + gstrcpy ("PSIZE",  Memc[op], ARB) + 1
+
+	do i = 1, npars {
+	    p_namep[i] = kw[i]
+	    p_len[i] = strlen(Memc[kw[i]])
+	    p_ch[i] = Memc[kw[i]+2]
+	}
+
+	# Add the GPB parameters to the list of group related parameters.
+	ngpbpars = min (MAX_PCOUNT, STF_PCOUNT(stf))
+	do i = 1, ngpbpars {
+	    npars = npars + 1
+	    pp = STF_PDES(stf,i)
+	    p_namep[npars] = P_PTYPEP(pp)
+	    p_len[npars] = strlen(P_PTYPE(pp))
+	    p_ch[npars] = Memc[p_namep[npars]+2]
+	}
+
+	# Determine the type of each card and copy it to the appropriate
+	# output stream.
+
+	while (getline (spool, Memc[lbuf]) != EOF) {
+	    # Does this user card redefine a reserved keyword?
+	    keyword = false
+	    ch = Memc[lbuf+2]
+	    do i = 1, npars {
+		if (ch != p_ch[i])
+		    next
+		delim = Memc[lbuf+p_len[i]]
+		if (delim != ' ' && delim != '=')
+		    next
+		if (strncmp (Memc[lbuf], Memc[p_namep[i]], p_len[i]) == 0) {
+		    keyword = true
+		    break
+		}
+	    }
+
+	    # Copy the card to the appropriate stream.
+	    if (keyword) {
+		if (gpb != NULL)
+		    call putline (gpb, Memc[lbuf])
+	    } else {
+		if (user != NULL)
+		    call putline (user, Memc[lbuf])
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfctype.x b/sys/imio/iki/stf/stfctype.x
new file mode 100644
index 00000000..9c48f65a
--- /dev/null
+++ b/sys/imio/iki/stf/stfctype.x
@@ -0,0 +1,85 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stf.h"
+
+# STF_CTYPE -- Determine the type of a FITS card.  STF recognizes only those
+# cards which define the image format and the group parameter block.
+
+int procedure stf_ctype (card, index)
+
+char	card[ARB]			#I FITS card (or keyword)
+int	index				#O index number, if any
+
+int	ch1, ch2, ip
+int	strncmp(), ctoi()
+
+begin
+	ch1 = card[1]
+	ch2 = card[2]
+
+	# The set of keywords is fixed and small, so a simple brute force
+	# recognizer is about as good as anything.
+
+	if (ch1 == 'B') {
+	    if (ch2 == 'I')
+		if (strncmp (card, "BITPIX  ", 8) == 0)
+		    return (KW_BITPIX)				# BITPIX
+	} else if (ch1 == 'D') {
+	    if (ch2 == 'A')
+		if (strncmp (card, "DATATYPE", 8) == 0)
+		    return (KW_DATATYPE)			# DATATYPE
+	} else if (ch1 == 'E') {
+	    if (ch2 == 'N')
+		if (card[3] == 'D' && card[4] == ' ')
+		    return (KW_END)				# END card
+	} else if (ch1 == 'G') {
+	    if (ch2 == 'C') {
+		if (strncmp (card, "GCOUNT  ", 8) == 0)
+		    return (KW_GCOUNT)				# GCOUNT
+	    } else if (ch2 == 'R') {
+		if (strncmp (card, "GROUPS  ", 8) == 0)
+		    return (KW_GROUPS)				# GROUPS
+	    }
+	} else if (ch1 == 'N') {
+	    if (ch2 == 'A')
+		if (strncmp (card, "NAXIS", 5) == 0)
+		    if (card[6] == ' ')
+			return (KW_NAXIS)			# NAXIS
+		    else if (IS_DIGIT(card[6])) {
+			index = TO_INTEG(card[6])
+			return (KW_NAXISN)			# NAXISn
+		    }
+	} else if (ch1 == 'P') {
+	    if (ch2 == 'C') {
+		if (strncmp (card, "PCOUNT  ", 8) == 0)
+		    return (KW_PCOUNT)				# PCOUNT
+	    } else if (ch2 == 'D') {
+		if (strncmp (card, "PDTYPE", 6) == 0) {
+		    ip = 7
+		    if (ctoi (card, ip, index) > 0)
+			return (KW_PDTYPE)			# PDTYPEn
+		}
+	    } else if (ch2 == 'S') {
+		if (strncmp (card, "PSIZE", 5) == 0) {
+		    ip = 6
+		    if (card[ip] == ' ')
+			return (KW_PSIZE)
+		    else if (ctoi (card, ip, index) > 0)
+			return (KW_PSIZEN)			# PSIZEn
+		}
+	    } else if (ch2 == 'T') {
+		if (strncmp (card, "PTYPE", 5) == 0) {
+		    ip = 6
+		    if (ctoi (card, ip, index) > 0)
+			return (KW_PTYPE)			# PTYPEn
+		}
+	    }
+	} else if (ch1 == 'S') {
+	    if (ch2 == 'I')
+		if (strncmp (card, "SIMPLE  ", 8) == 0)
+		    return (KW_SIMPLE)				# SIMPLE
+	}
+
+	return (ERR)
+end
diff --git a/sys/imio/iki/stf/stfdelete.x b/sys/imio/iki/stf/stfdelete.x
new file mode 100644
index 00000000..dd319f12
--- /dev/null
+++ b/sys/imio/iki/stf/stfdelete.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	"stf.h"
+
+# STF_DELETE -- Delete an image.  A special operator is required since the
+# image is stored as two files.
+
+procedure stf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U header file extension
+int	status			#O return value
+
+pointer	sp
+pointer	hdr_fname, pix_fname
+int	access()
+
+begin
+	call smark (sp)
+	call salloc (hdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (pix_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filename.
+	call iki_mkfname (root, extn, Memc[hdr_fname], SZ_PATHNAME)
+	call stf_mkpixfname (root, extn, Memc[pix_fname], SZ_PATHNAME)
+
+	# If the header cannot be deleted, leave the pixfile alone.
+	iferr (call delete (Memc[hdr_fname]))
+	    call erract (EA_WARN)
+	else if (access (Memc[pix_fname],0,0) == YES) {
+	    iferr (call delete (Memc[pix_fname]))
+		call erract (EA_WARN)
+	}
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfget.x b/sys/imio/iki/stf/stfget.x
new file mode 100644
index 00000000..bacbc8d7
--- /dev/null
+++ b/sys/imio/iki/stf/stfget.x
@@ -0,0 +1,97 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stf.h"
+
+# STF_GETI -- Return the integer value of a FITS encoded card.
+
+procedure stf_geti (card, ival)
+
+char	card[ARB]		# card to be decoded
+int	ival			# receives integer value
+
+int	ip, ctoi()
+char	sval[FITS_SZVALSTR]
+
+begin
+	call stf_gets (card, sval, FITS_SZVALSTR)
+	ip = 1
+	if (ctoi (sval, ip, ival) <= 0)
+	    ival = 0
+end
+
+
+# STF_GETB -- Return the boolean/integer value of a FITS encoded card.
+
+procedure stf_getb (card, bval)
+
+char	card[ARB]		# card to be decoded
+int	bval			# receives YES/NO
+
+char	sval[FITS_SZVALSTR]
+
+begin
+	call stf_gets (card, sval, FITS_SZVALSTR)
+	if (sval[1] == 'T')
+	    bval = YES
+	else
+	    bval = NO
+end
+
+
+# STF_GETS -- Get the string value of a FITS encoded card.  Strip leading
+# and trailing whitespace and any quotes.
+
+procedure stf_gets (card, outstr, maxch)
+
+char	card[ARB]		# FITS card to be decoded
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+int	ip, op
+int	ctowrd(), strlen()
+
+begin
+	ip = FITS_STARTVALUE
+	if (ctowrd (card, ip, outstr, maxch) > 0) {
+	    # Strip trailing whitespace.
+	    op = strlen (outstr)
+	    while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n'))
+		op = op - 1
+	    outstr[op+1] = EOS
+	} else
+	    outstr[1] = EOS
+end
+
+
+# STF_GETCMT -- Get the comment field of a FITS encoded card.
+
+procedure stf_getcmt (card, comment, maxch)
+
+char	card[ARB]		#I FITS card to be decoded
+char	comment[ARB]		#O output string to receive comment
+int	maxch			#I max chars out
+
+int	ip, op
+int	lastch
+
+begin
+	# Find the slash which marks the beginning of the comment field.
+	ip = FITS_ENDVALUE + 1
+	while (card[ip] != EOS && card[ip] != '\n' && card[ip] != '/')
+	    ip = ip + 1
+
+	# Copy the comment to the output string, omitting the /, any
+	# trailing blanks, and the newline.
+
+	lastch = 0
+	do op = 1, maxch {
+	    if (card[ip] == EOS)
+		break
+	    ip = ip + 1
+	    comment[op] = card[ip]
+	    if (card[ip] > ' ')
+		lastch = op
+	}
+	comment[lastch+1] = EOS
+end
diff --git a/sys/imio/iki/stf/stfhextn.x b/sys/imio/iki/stf/stfhextn.x
new file mode 100644
index 00000000..45e89f7a
--- /dev/null
+++ b/sys/imio/iki/stf/stfhextn.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+
+# STF_GETHDREXTN -- Get the default header file extension.
+
+procedure stf_gethdrextn (im, o_im, acmode, outstr, maxch)
+
+pointer	im, o_im		#I image descriptors
+int	acmode			#I access mode
+char	outstr[maxch]		#O receives header extension
+int	maxch			#I max chars out
+
+bool	inherit
+int	kernel, old_kernel
+int	fnextn(), iki_getextn(), iki_getpar()
+
+begin
+	# Use the same extension as the input file if this is a new copy
+	# image of the same type as the input and inherit is enabled.
+	# If we have to get the extension using iki_getextn, the default
+	# extension for a new image is the first extension defined (index=1).
+
+	kernel = IM_KERNEL(im)
+
+	old_kernel = 0
+	if (acmode == NEW_COPY && o_im != NULL)
+	    old_kernel = IM_KERNEL(o_im)
+
+	inherit = (iki_getpar ("inherit") == YES)
+	if (inherit && acmode == NEW_COPY && kernel == old_kernel) {
+	    if (fnextn (IM_HDRFILE(im), outstr, maxch) <= 0)
+		call strcpy (STF_DEFHDREXTN, outstr, maxch)
+	} else if (iki_getextn (kernel, 1, outstr, maxch) < 0)
+	    call strcpy (STF_DEFHDREXTN, outstr, maxch)
+end
diff --git a/sys/imio/iki/stf/stfiwcs.x b/sys/imio/iki/stf/stfiwcs.x
new file mode 100644
index 00000000..415b9a76
--- /dev/null
+++ b/sys/imio/iki/stf/stfiwcs.x
@@ -0,0 +1,60 @@
+include	<imhdr.h>
+include	"stf.h"
+
+# STF_INITWCS -- Check for an unitialized WCS and set up a unitary pixel
+# WCS in this case.
+
+procedure stf_initwcs (im)
+
+pointer	im			#I image descriptor
+
+real	v
+int	ndim, i, j
+bool	have_wcs, wcsok
+char	pname[SZ_KEYWORD]
+bool	fp_equalr()
+real	imgetr()
+
+begin
+	ndim = IM_NDIM(im)
+	have_wcs = false
+	wcsok = false
+
+	# Scan the header to determine if we have any WCS information (assume
+	# there is a WCS if any CDi_j cards are found) and if it has been
+	# initialized (at least one matrix element is nonzero).  Note that
+	# we are checking only to see if the WCS has been initialized, not
+	# if it is a valid WCS.
+
+	do j = 1, ndim {
+	    do i = 1, ndim {
+		call sprintf (pname, SZ_KEYWORD, "CD%d_%d")
+		    call pargi (i)
+		    call pargi (j)
+		ifnoerr (v = imgetr (im, pname)) {
+		    have_wcs = true
+		    if (!fp_equalr (v, 0.0)) {
+			wcsok = true
+			break
+		    }
+		}
+	    }
+	    if (wcsok)
+		break
+	}
+
+	# If we found some WCS information and the CD matrix is zero, init
+	# the WCS.
+
+	if (have_wcs && !wcsok)
+	    do i = 1, ndim {
+		call sprintf (pname, SZ_KEYWORD, "CTYPE%d")
+		    call pargi (i)
+		call imastr (im, pname, "PIXEL")
+
+		call sprintf (pname,  SZ_KEYWORD, "CD%d_%d")
+		    call pargi (i)
+		    call pargi (i)
+		call imaddr (im, pname, 1.0)
+	    }
+end
diff --git a/sys/imio/iki/stf/stfmerge.x b/sys/imio/iki/stf/stfmerge.x
new file mode 100644
index 00000000..a98ee877
--- /dev/null
+++ b/sys/imio/iki/stf/stfmerge.x
@@ -0,0 +1,105 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_MERGEGPB -- Merge the non-reserved parameters from an existing GPB into
+# a new GPB; called to construct a new GPB when an image is opened in new-copy
+# mode.  Since the new copy may not be the same size and dimension as the
+# original, the reserved parameters must be set up fresh for the new copy
+# image, i.e., we cannot simply copy them from the old image.  Likewise, the
+# WCS must be transformed if the new copy image does not geometrically overlay
+# the original.
+#
+# NOTE:  no longer called by stf_opix; save this code for future use!
+# <dlb--11/4/87>
+
+procedure stf_mergegpb (n_im, o_im)
+
+pointer	n_im		# new copy image
+pointer	o_im		# image being copied
+
+bool	match
+int	n_i, o_i, n, ip, axis
+int	up_psize
+pointer	sp, cd_pat, n_stf, o_stf, n_pp, o_pp
+int	strncmp(), strlen(), patmake(), patmatch(), ctoi()
+
+begin
+	call smark (sp)
+	call salloc (cd_pat, SZ_LINE, TY_CHAR)
+
+	# Make a pattern to match the CDa_b parameter names.
+	if (patmake ("CD[0-9]_[0-9]", Memc[cd_pat], SZ_LINE) < 0)
+	    ; # cannot happen
+
+	n_stf = IM_KDES(n_im)
+	o_stf = IM_KDES(o_im)
+
+	# Examine each parameter in the old GPB and make an entry for the new
+	# ones in the new GPB.  Note that all we are doing here is defining
+	# the structure; the GPB data is not physically written until the new
+	# header is updated on disk.  The FITS encoded values for the GPB
+	# parameters will already have been copied to the user area of the
+	# new image.
+
+	up_psize = 0
+	for (o_i=1;  o_i <= STF_PCOUNT(o_stf);  o_i=o_i+1) {
+	    o_pp = STF_PDES(o_stf,o_i)
+	    n = strlen (P_PTYPE(o_pp))
+
+	    if (P_PTYPE(o_pp) == 'C')
+		if (strncmp  (P_PTYPE(o_pp), "CRPIX", 5) == 0 ||
+		    strncmp  (P_PTYPE(o_pp), "CRVAL", 5) == 0 ||
+		    strncmp  (P_PTYPE(o_pp), "CTYPE", 5) == 0 ||
+		    patmatch (P_PTYPE(o_pp), Memc[cd_pat]) > 0) {
+
+		    ip = 6
+		    if (ctoi (P_PTYPE(o_pp), ip, axis) <= 0)
+			axis = IM_MAXDIM + 1
+		    if (axis <= STF_NAXIS(n_stf))
+		    	next
+		}
+
+	    # Is there a parameter of the same name in the new descriptor?
+	    match = false
+	    for (n_i=1;  n_i <= STF_PCOUNT(n_stf);  n_i=n_i+1) {
+		n_pp = STF_PDES(n_stf,n_i)
+		if (strncmp (P_PTYPE(o_pp), P_PTYPE(n_pp), n) == 0) {
+		    match = true
+		    break
+		}
+	    }
+
+	    # If there was no match for the parameter, add a definition for
+	    # it to the GPB descriptor for the new image.
+
+	    if (!match) {
+		n = STF_PCOUNT(n_stf) + 1
+		if (n > MAX_PCOUNT)
+		    call error (4, "stf_merge: too many group parameters")
+
+		STF_PCOUNT(n_stf) = n
+		up_psize = up_psize + P_PSIZE(o_pp)
+		n_pp = STF_PDES(n_stf,n)
+	
+		P_SPPTYPE(n_pp)	= P_SPPTYPE(o_pp)
+		P_PSIZE(n_pp)	= P_PSIZE(o_pp)
+		P_LEN(n_pp)	= P_LEN(o_pp)
+
+		call strcpy (P_PTYPE(o_pp), P_PTYPE(n_pp), SZ_PTYPE)
+		call strcpy (P_PDTYPE(o_pp), P_PDTYPE(n_pp), SZ_PDTYPE)
+	    }
+	}
+
+	# Moved the PSIZE, SZGROUP calculations here to fix error in the
+	# computation of PSIZE--dlb, 11/2/87
+
+	STF_PSIZE(n_stf) = STF_PSIZE(n_stf) + up_psize
+	STF_SZGROUP(n_stf) = STF_SZGROUP(n_stf) +
+	    up_psize / (SZB_CHAR * NBITS_BYTE)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfmkpfn.x b/sys/imio/iki/stf/stfmkpfn.x
new file mode 100644
index 00000000..4568efd8
--- /dev/null
+++ b/sys/imio/iki/stf/stfmkpfn.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"stf.h"
+
+# STF_MKPIXFNAME -- Given the root and extn fields of the image header filename,
+# construct the pixel file name.  The pixel file has the same root name as
+# the header and the first two characters of the extension are the same as for
+# the header, if a header extension was given.
+
+procedure stf_mkpixfname (hdr_root, hdr_extn, pixfname, maxch)
+
+char	hdr_root[ARB]		# root name of header file
+char	hdr_extn[ARB]		# extension of header file
+char	pixfname[maxch]		# receives pixel filename
+int	maxch
+
+int	i
+char	pix_extn[MAX_LENEXTN]
+
+begin
+	call strcpy (STF_DEFPIXEXTN, pix_extn, MAX_LENEXTN)
+	if (hdr_extn[1] != EOS) {
+	    for (i=1;  i < MAX_LENEXTN;  i=i+1)
+		pix_extn[i] = hdr_extn[i]
+	}
+
+	call iki_mkfname (hdr_root, pix_extn, pixfname, maxch)
+end
diff --git a/sys/imio/iki/stf/stfnewim.x b/sys/imio/iki/stf/stfnewim.x
new file mode 100644
index 00000000..3e8a95ed
--- /dev/null
+++ b/sys/imio/iki/stf/stfnewim.x
@@ -0,0 +1,146 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+define	NBITS_CHAR	(SZB_CHAR * NBITS_BYTE)
+
+
+# STF_NEWIMAGE -- Set up the IMIO/STF descriptor for an image opened with mode
+# new_image or new_copy of non-STF images.  Note that the parameters GROUP 
+# and GCOUNT were set earlier by stf_open().
+
+procedure stf_newimage (im)
+
+pointer	im			# image descriptor
+
+pointer	stf
+pointer	o_im
+long	totpix
+char	pname[SZ_KEYWORD]
+int	old_kernel, pixtype, bitpix, nbytes, pno, ndim, i, j
+errchk	stf_addpar
+string	zero "0"
+string	one  "1"
+
+include <szpixtype.inc>
+
+begin
+	# Get length of axes and datatype from imio descriptor;
+	# these may be changed by the user between image mapping 
+	# and first i/o to pixfile so we set up the group parameter block
+	# and size of pixfile on first i/o operation
+
+	stf = IM_KDES(im)
+	o_im = IM_OHDR(im)
+	ndim = IM_NDIM(im)
+	STF_NAXIS(stf) = ndim
+	do i = 1, ndim
+	    STF_LENAXIS(stf,i) = IM_LEN(im,i)
+
+	# Get datatype for the pixfile; stf_open has set this to datatype 
+	# of template file if it exists, otherwise defaults to real(assuming
+	# the user hasn't changed it by now)
+
+	pixtype = IM_PIXTYPE(im)
+
+	bitpix = pix_size[pixtype] * NBITS_CHAR
+	nbytes = bitpix / NBITS_BYTE
+
+	call sprintf (STF_DATATYPE(stf), SZ_DATATYPE, "%s*%d")
+	    switch (pixtype) {
+	    case TY_USHORT:
+		call pargstr ("UNSIGNED")
+	    case TY_SHORT, TY_LONG, TY_INT:
+		call pargstr ("INTEGER")
+	    case TY_REAL, TY_DOUBLE:
+		call pargstr ("REAL")
+	    case TY_COMPLEX:
+		call pargstr ("COMPLEX")
+	    default:
+		pixtype = TY_REAL
+		bitpix = SZ_REAL * NBITS_CHAR
+		nbytes = bitpix / NBITS_BYTE
+		call pargstr ("REAL")
+	    }
+	    call pargi (nbytes)
+
+	STF_BITPIX(stf) = bitpix
+
+	# Set the IMIO min/max fields.
+
+	IM_MIN(im) = 0.
+	IM_MAX(im) = 0.
+	IM_LIMTIME(im) = 0
+
+	# For a new copy image(of an already-existing file), DO NOT add group
+	# parameters to the GPB, unless the original image is not an STF
+	# image.  The following are the "standard" set of datamin/max and the
+	# FITS coordinate parms which SDAS files are supposed to have.
+
+	if (IM_ACMODE(im) == NEW_COPY && o_im != NULL)
+	    old_kernel = IM_KERNEL(o_im)
+
+	if ((IM_ACMODE(im) == NEW_FILE) || 
+	   ((IM_ACMODE(im) == NEW_COPY) && IM_KERNEL(im) != old_kernel)) {
+
+	    # Set up the standard STF group parameter block parameters.
+	    STF_GROUPS(stf) = YES
+	    STF_PCOUNT(stf) = 2 + (ndim * 3) + (ndim * ndim)
+	    STF_PSIZE(stf) = 2 * (SZ_REAL * NBITS_CHAR) +	# DATAMIN/MAX
+		ndim * (SZ_DOUBLE * NBITS_CHAR) +		# CRVALn
+		ndim * (SZ_REAL * NBITS_CHAR) +			# CRPIXn
+		ndim * (8 * NBITS_BYTE) +			# CTYPEn
+		(ndim * ndim) * (SZ_REAL * NBITS_CHAR)		# CD matrix
+
+	    # Free any unneeded space in the STF descriptor.
+	    if (STF_PCOUNT(stf) > 0) {
+		call realloc (stf,
+		    LEN_STFBASE + STF_PCOUNT(stf)*LEN_PDES, TY_STRUCT)
+		IM_KDES(im) = stf
+	    }
+
+	    # Set up the group data block in the STF descriptor and in 
+	    # the IMIO FITS format user area.  WARNING--the STF kernel
+	    # is implicitly assuming that the GPB related parameters
+	    # in non-STF format images are at the beginning of the user
+	    # area, if they are present at all.   If this is not true
+	    # then the following code will APPEND them to the user area.
+	    # At STScI, non-STF format images are usually made from STF
+	    # images and these parameters are at the beginning of the user
+	    # area in that case.
+
+	    pno = 1
+	    call stf_addpar (im, "DATAMIN", TY_REAL, 1, zero, pno)
+	    call stf_addpar (im, "DATAMAX", TY_REAL, 1, zero, pno)
+
+	    do i = 1, ndim {
+		call sprintf (pname,  SZ_KEYWORD, "CRPIX%d"); call pargi (i)
+		call stf_addpar (im, pname, TY_REAL, 1, zero, pno)
+		call sprintf (pname,  SZ_KEYWORD, "CRVAL%d"); call pargi (i)
+		call stf_addpar (im, pname, TY_DOUBLE, 1, zero, pno)
+		call sprintf (pname,  SZ_KEYWORD, "CTYPE%d"); call pargi (i)
+		call stf_addpar (im, pname, TY_CHAR, 8, "PIXEL", pno)
+
+		do j = 1, ndim {
+		    call sprintf (pname,  SZ_KEYWORD, "CD%d_%d")
+			call pargi (j)
+			call pargi (i)
+		    if (i == j)
+			call stf_addpar (im, pname, TY_REAL, 1, one,  pno)
+		    else
+			call stf_addpar (im, pname, TY_REAL, 1, zero, pno)
+		}
+	    }
+	}
+
+	# Compute the size of each group in the pixel file, in chars.
+	totpix = IM_LEN(im,1)
+	do i = 2, ndim
+	    totpix = totpix * IM_LEN(im,i)
+
+	STF_SZGROUP(stf) = totpix * pix_size[IM_PIXTYPE(im)] +
+	    STF_PSIZE(stf) / (SZB_CHAR * NBITS_BYTE)
+end
diff --git a/sys/imio/iki/stf/stfopen.x b/sys/imio/iki/stf/stfopen.x
new file mode 100644
index 00000000..016c557e
--- /dev/null
+++ b/sys/imio/iki/stf/stfopen.x
@@ -0,0 +1,225 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+# STF_OPEN -- Open/create an STF group format image.
+
+procedure stf_open (kernel, im, o_im,
+	root, extn, ksection, gr_arg, gc_arg, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I other descriptor for NEW_COPY image
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I extension, if any
+char	ksection[ARB]		#I NOT USED
+int	gr_arg			#I index of group to be accessed
+int	gc_arg			#I number of groups in STF image
+int	acmode			#I access mode
+int	status			#O return value
+
+bool	subimage
+pointer	sp, fname, stf, stf_extn, ua, o_stf
+int	group, gcount, newimage, gpb, hdr, o_stflen
+
+bool	fnullfile(), envgetb()
+int	open(), stropen(), access()
+errchk	stf_initwcs, fmkcopy, calloc, realloc, syserrs
+define	err_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (stf_extn, MAX_LENEXTN, TY_CHAR)
+
+	ua = IM_USERAREA(im)
+
+	# Allocate internal STF image descriptor.
+	call calloc (stf, LEN_STFDES, TY_STRUCT)
+	IM_KDES(im) = stf
+
+	group  = max (1, gr_arg)
+	gcount = max (group, gc_arg)
+
+	STF_GRARG(stf)	= max (0, gr_arg)
+	STF_GROUP(stf)  = group
+	STF_GCOUNT(stf) = gcount
+	STF_ACMODE(stf) = acmode
+	STF_PFD(stf)    = NULL
+
+	# If a nonzero gcount is specified when a new-image or new-copy image
+	# is opened (e.g., [1/10] we assume that an entire new group format
+	# image is to be created with the given group count.  If neither the
+	# group or gcount values are specified we assume that a new image is
+	# to be created.  If the gcount field is zero (e.g., [1/0] or just [1])
+	# then we assume that the image already exists and that we are being
+	# asked to rewrite the indexed image.
+
+	newimage = NO
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY)
+	    if (gc_arg > 0 || (gr_arg <= 0 && gc_arg <= 0))
+		newimage = YES
+	STF_NEWIMAGE(stf) = newimage
+
+	# Generate full header file name.
+	if (extn[1] == EOS) {
+	    call stf_gethdrextn (im, o_im, acmode, Memc[stf_extn], MAX_LENEXTN)
+	    call iki_mkfname (root, Memc[stf_extn], Memc[fname], SZ_PATHNAME)
+	    call strcpy (Memc[stf_extn], extn, MAX_LENEXTN)
+	} else
+	    call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+
+	call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+
+	# Generate full pixel file name.
+	call stf_mkpixfname (root, extn, Memc[fname], SZ_PATHNAME)
+	call strcpy (Memc[fname], IM_PIXFILE(im), SZ_IMPIXFILE)
+
+	# Create and open the image header file if create a new physical
+	# image.  If opening an existing image we do not open the header file
+	# here since the header may already be in the STF header cache.
+	# Since STF header files have a weird file type on some systems (VMS)
+	# we must create a new header file with FMKCOPY rather than OPEN.
+
+	if (STF_NEWIMAGE(stf) == YES && !fnullfile (IM_HDRFILE(im))) {
+	    if (access (IM_HDRFILE(im), 0,0) == YES) {
+		subimage = (gr_arg > 0 && gr_arg <= gc_arg)
+		if (subimage || envgetb ("imclobber")) {
+		    iferr (call delete (IM_PIXFILE(im)))
+			goto err_
+		    iferr (call delete (IM_HDRFILE(im)))
+			goto err_
+		} else {
+		    call mfree (stf, TY_STRUCT)
+		    call syserrs (SYS_IKICLOB, IM_HDRFILE(im))
+		}
+	    }
+	    iferr (call fmkcopy (HDR_TEMPLATE, IM_HDRFILE(im)))
+		goto err_
+	    iferr (IM_HFD(im) = open (IM_HDRFILE(im), READ_WRITE, TEXT_FILE))
+		goto err_
+	}
+
+	# If opening an existing image, read the image header into the STF
+	# image descriptor.
+
+	switch (acmode) {
+	case NEW_IMAGE:
+	    # For group formatted images, open NEW_IMAGE can mean either
+	    # creating a new group format image, or opening a new group
+	    # within an existing group format image.  The latter case is
+	    # indicated by a group index greater than 1.  If we are creating
+	    # a new group format image, wait until the user has set up the
+	    # dimension parameters before doing anything further (in stfopix).
+
+	    if (STF_NEWIMAGE(stf) == NO)
+		iferr (call stf_rdheader (im, group, acmode))
+		    goto err_
+
+	case NEW_COPY:
+	    # Make sure the FITS encoded user area we inherited is blocked.
+
+	    ### For now, always reblock the old header as the blocked flag
+	    ### does not seem to be reliable and a header with variable length
+	    ### lines can cause the header update to fail.  This should be
+	    ### fixed as a reblock of the full header is expensive.
+
+	    ### if (IM_UABLOCKED(o_im) != YES)
+		call stf_reblock (im)
+
+	    if (STF_NEWIMAGE(stf) == NO) {
+		# Open new group within existing GF image.  The FITS header and
+		# GPB structure of the image being opened must be used, but the
+		# default data values for the GPB parameters are inherited from
+		# the image being copied.
+
+		# Filter the copied user area to retain only the GPB cards.
+		# Opening the user area on two string file descriptors is a
+		# bit tricky, but will work since fixed size cards are copied,
+		# and the EOS isn't written until close time.
+
+		if (IM_KDES(o_im) != NULL && IM_KERNEL(o_im) == IM_KERNEL(im)) {
+		    hdr = stropen (Memc[ua], ARB, READ_ONLY)
+		    gpb = stropen (Memc[ua], ARB, NEW_FILE)
+		    call stf_copyfits (IM_KDES(o_im), hdr, gpb, NULL)
+		    call close (gpb)
+		    call close (hdr)
+		}
+
+		# Read in the FITS header of the new image after the inherited
+		# GPB data cards, and set up the STF descriptor for the new GPB
+		# as defined in the new FITS header.
+
+		iferr (call stf_rdheader (im, group, acmode))
+		    goto err_
+
+		# Initialize the WCS description if this is not done by the
+		# inherited user header.
+
+		call stf_initwcs (im)
+
+	    } else {
+		# Completely new copy of an existing image, which may or may
+		# not be an STF format image.  IMIO has already copied the
+		# size parameters of the old image as well as the cards in the
+		# user area of the old image (but without leaving space for
+		# the GPB cards if not an STF image).  Copy old STF descriptor
+		# if the old image is also an STF format image, to inherit
+		# GPB structure.  Wait until opix time to init the rest of the
+		# descriptor.  
+
+		if (IM_KDES(o_im) != NULL && IM_KERNEL(o_im) == IM_KERNEL(im)) {
+		    o_stf = IM_KDES(o_im)
+		    o_stflen = LEN_STFBASE + STF_PCOUNT(o_stf) * LEN_PDES
+		    call amovi (Memi[o_stf], Memi[stf], o_stflen)
+		    STF_ACMODE(stf)   = acmode
+		    STF_GROUP(stf)    = group
+		    STF_GCOUNT(stf)   = gcount
+		    STF_NEWIMAGE(stf) = newimage
+		    STF_PFD(stf)      = NULL
+		    if (gcount > 1)
+			STF_GROUPS(stf) = YES
+		} else
+		    STF_GROUPS(stf) = YES
+
+		# Inherit datatype of input template image if specified,
+		# otherwise default datatype to real.
+
+		if (IM_PIXTYPE(o_im) != NULL)
+		    IM_PIXTYPE(im) = IM_PIXTYPE(o_im)
+		else
+		    IM_PIXTYPE(im) = TY_REAL
+	    }
+
+	default:
+	    # Open an existing group within an existing image.
+	    iferr (call stf_rdheader (im, group, acmode))
+		goto err_
+	}
+
+	# Set group number and count for the external world if this is a group
+	# format image.
+
+	if (STF_GROUPS(stf) == YES) {
+	    IM_CLINDEX(im) = STF_GROUP(stf)
+	    IM_CLSIZE(im)  = STF_GCOUNT(stf)
+	}
+
+	# Free any unneeded space in the STF descriptor.
+	if (STF_PCOUNT(stf) > 0)
+	    call realloc (stf,
+		LEN_STFBASE + STF_PCOUNT(stf)*LEN_PDES, TY_STRUCT)
+	IM_KDES(im) = stf
+	status = OK
+
+	call sfree (sp)
+	return
+err_
+	status = ERR
+	call mfree (stf, TY_STRUCT)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfopix.x b/sys/imio/iki/stf/stfopix.x
new file mode 100644
index 00000000..da353119
--- /dev/null
+++ b/sys/imio/iki/stf/stfopix.x
@@ -0,0 +1,202 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fset.h>
+include	<mach.h>
+include	"stf.h"
+
+define	NBITS_CHAR	(SZB_CHAR * NBITS_BYTE)
+
+# STF_OPIX -- Open (or create) the pixel storage file.  If the image header file
+# is `image.hhh' the associated pixel storage file will be `image.hhd' in the
+# same directory as the header file.  STF_PFD is set if the pixel file is
+# physically open.  IM_PFD is not set until we have been called by IMIO, since
+# we must be called to once set up all the descriptors, even if the pixel file
+# was already opened to read the GPB.
+#
+# dlb, 18-may-88: added code to zero out gpb's in multi-group image for groups
+#   other than current; prevents strange numbers and when later programs try to
+#   read the gpb of an otherwise uninitialized group of the image.
+# dlb, 29-dec-1988: added code to get default set of GPB parameters and
+#   correctly initialize STF-kernel descriptor.
+
+procedure stf_opix (im, status)
+
+pointer	im				# image descriptor
+int	status				# return status
+
+int	compress, blklen
+bool	copy_of_stf_image
+int	pfd, sz_gpb, group, i
+pointer	stf, o_stf, o_im, ua, gpb
+long	sz_pixfile, pixoff, totpix, offset
+
+int	open()
+errchk	open, fseti, falloc, seek, syserrs, imioff, calloc
+errchk	write
+
+include <szpixtype.inc>
+
+begin
+	status = OK
+	if (IM_PFD(im) != NULL)
+	    return
+
+	o_im	 = IM_OHDR(im)
+	stf	 = IM_KDES(im)
+	ua	 = IM_USERAREA(im)
+
+	pfd	 = STF_PFD(stf)
+	compress = YES
+	blklen   = 1
+	pixoff   = 1
+
+	switch (IM_ACMODE(im)) {
+	case READ_ONLY, READ_WRITE, WRITE_ONLY, APPEND:
+	    if (pfd == NULL)
+		pfd = open (IM_PIXFILE(im), IM_ACMODE(im), BINARY_FILE)
+
+	case NEW_COPY, NEW_FILE:
+	    # Initialize the IMIO and STF descriptors and allocate the pixel
+	    # file.
+
+	    if (STF_NEWIMAGE(stf) == YES) {
+		# Normalize IMIO header parameters for new image.
+		call imioff (im, pixoff, compress, blklen)
+
+		# Set up the required GPB parameters for the new image.
+		# Note - this call can change the STF pointer.
+
+		call stf_newimage (im)
+		stf = IM_KDES(im)
+
+		# Save the size of the old GPB user area header if we are
+		# making a new copy of an old STF format image.
+
+		copy_of_stf_image = false
+		if (IM_ACMODE(im) == NEW_COPY && o_im != NULL)
+		    if (IM_KERNEL(o_im) == IM_KERNEL(im))
+			copy_of_stf_image = true
+
+		if (copy_of_stf_image) {
+		    o_stf = IM_KDES(o_im)
+		    STF_PCOUNT(stf) = STF_PCOUNT(o_stf)
+		    STF_PSIZE(stf) = STF_PSIZE(o_stf)
+		}
+
+#		Since the stf_mergegpb code below has been deactivated,
+#		there is no need to do the complex and expensive spool/copy
+# 		operation below.  (dct 1/4/90)
+#		-------------------------------
+#		# We have to have space for the GPB data cards at the beginning
+#		# of the user area, so spool any existing user cards in a
+#		# buffer and truncate the user area at the end of the GPB.
+#
+#		ua_fd = stropen (Memc[ua+sz_gpbhdr], ARB, READ_ONLY)
+#		spool = open ("opix_spool", READ_WRITE, SPOOL_FILE)
+#		call fcopyo (ua_fd, spool)
+#		call close (ua_fd)
+#		Memc[ua+sz_gpbhdr] = EOS
+#
+#		# Merge any extra GPB parameters from the old image into the
+#		# GPB structure of the new image.  The GPB data cards for
+#		# these parameters should already be in the user area.
+#		# Order the group parameters to match the ordering in the
+#		# old image.  NOTE:  since the STF now copies all relevant
+#		# GPB parameters from an old image into the new or 
+#		# generates a default standard set (in stf_newimage),
+#		# the following is no longer necessary.  Note that if we
+#		# eventually may add parameters to the GPB, these routines
+#		# will again be useful!
+#
+#		#if (copy_of_stf_image) {
+#		#    call stf_mergegpb (im, o_im)
+#		#    call stf_ordergpb (o_stf, stf)
+#		#}
+#			
+#		# Now append the spooled user header cards to the new user
+#		# area following the GPB data cards, deleting any user cards
+#		# which redefine GPB cards in the process.
+#
+#		call seek (spool, BOFL)
+#		ua_size = (IM_LENHDRMEM(im) - LEN_IMHDR) * SZ_STRUCT
+#		ua_fd = stropen (Memc[ua], ua_size, APPEND)
+#		call stf_copyfits (stf, spool, NULL, ua_fd)
+#		call close (ua_fd)
+#		call close (spool)
+#
+#		# Compute the length of the new header
+#		IM_HDRLEN(im) = LEN_IMHDR +
+#		    (strlen(Memc[ua]) + SZ_STRUCT-1) / SZ_STRUCT
+
+		# Open the new pixel storage file (preallocate space if
+		# enabled on local system).  Save the physical pathname of
+		# the pixfile in the image header, in case "imdir$" changes.
+
+		sz_pixfile = STF_SZGROUP(stf) * STF_GCOUNT(stf)
+		call falloc (IM_PIXFILE(im), sz_pixfile)
+
+		# Zero out all remaining groups of the image
+		# Open pixel file if not already open
+
+		if (STF_PFD(stf) == NULL)
+		    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+
+		# Allocate a zeroed block of memory whose length is the same
+		# as that of the group parameter block
+
+		sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
+		call calloc (gpb, sz_gpb, TY_CHAR)
+	
+		# Zero out every group except the current one.
+		do group = 1, STF_GCOUNT(stf) {
+		    if (group != STF_GROUP(stf)) {
+			offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
+			call seek (pfd, offset)
+			call write (pfd, Memc[gpb], sz_gpb)
+		    }
+		}
+
+		# Free the block of memory.
+		call mfree (gpb, TY_CHAR)
+
+	    } else {
+		# If we are writing to a group of an existing multigroup image,
+		# verify that the important image parameters have not been
+		# changed.
+
+		if (STF_NAXIS(stf) != IM_NDIM(im))
+		    call syserrs (SYS_IMGSZNEQ, IM_NAME(im))
+		do i = 1, IM_NDIM(im)
+		    if (STF_LENAXIS(stf,i) != IM_LEN(im,i))
+			call syserrs (SYS_IMGSZNEQ, IM_NAME(im))
+
+		# Added 5/15/87--dlb to get correct size of each data portion
+		# of a group if image opened NEW_COPY and input file was a
+		# template of a different dimensionality used to get GPB.
+		# Compute the size of each group in the pixel file, in chars.
+
+		totpix = IM_LEN(im,1)
+		do i = 2, IM_NDIM(im)
+		    totpix = totpix * IM_LEN(im,i)
+
+		STF_SZGROUP(stf) = totpix * pix_size[IM_PIXTYPE(im)] +
+		    STF_PSIZE(stf) / (SZB_CHAR * NBITS_BYTE)
+	    }
+
+	    if (pfd == NULL)
+		pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+
+	    # Tell IMIO where the pixels are.
+	    pixoff = (STF_GROUP(stf) - 1) * STF_SZGROUP(stf) + 1
+	    call imioff (im, pixoff, compress, blklen)
+
+	default:
+	    call imerr (IM_NAME(im), SYS_IMACMODE)
+	}
+
+	STF_PFD(stf) = pfd
+	IM_PFD(im)   = pfd
+end
diff --git a/sys/imio/iki/stf/stfordgpb.x b/sys/imio/iki/stf/stfordgpb.x
new file mode 100644
index 00000000..7099e106
--- /dev/null
+++ b/sys/imio/iki/stf/stfordgpb.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	"stf.h"
+
+# STF_ORDERGPB -- Order the GPB, putting the group parameters in the
+# new image in the same order as in the old image.
+# NOTE:  no longer called by stf_opix; save this code for future use!
+# <dlb--11/4/87>
+
+procedure stf_ordergpb (o_stf, n_stf)
+
+pointer	o_stf			# STF descriptor of old image
+pointer n_stf			# STF descriptor of new image
+
+pointer	sp, temp_pdes, pp, o_plist, n_plist
+int	o_pcount, n_pcount, otop, ntop, op, np, offset, sz_param, pn
+bool	streq()
+
+begin
+	o_pcount = STF_PCOUNT(o_stf)
+	n_pcount = STF_PCOUNT(n_stf)
+	if (o_pcount <= 0)
+	    return
+
+	call smark (sp)
+	call salloc (temp_pdes, LEN_PDES, TY_STRUCT)
+
+	o_plist = STF_PDES(o_stf,1)
+	n_plist = STF_PDES(n_stf,1)
+	otop = (o_pcount * LEN_PDES)
+	ntop = (n_pcount * LEN_PDES)
+
+	# Search the new parameter list for a parameter with the same name
+	# as a parameter in the old parameter list.  When a match is found,
+	# move the new parameter into the same position as it is in the
+	# old parameter list.
+
+	for (op=0; op < otop; op=op+LEN_PDES)
+	    for (np=op; np < ntop; np=np+LEN_PDES)
+		if (streq (P_PTYPE(o_plist+op), P_PTYPE(n_plist+np))) {
+		    if (op != np) {
+			# Swap parameters between old and new positions
+			call amovi (Memi[n_plist+op], Memi[temp_pdes],
+			    LEN_PDES)
+			call amovi (Memi[n_plist+np], Memi[n_plist+op],
+			    LEN_PDES)
+			call amovi (Memi[temp_pdes], Memi[n_plist+np],
+			    LEN_PDES)
+		    }
+		    break
+		}
+
+	# Update the field offsets.
+	offset = 0
+	for (pn=1;  pn <= n_pcount;  pn=pn+1) {
+	    pp = STF_PDES(n_stf,pn)
+	    P_OFFSET(pp) = offset
+	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR
+	    offset = offset + sz_param
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfrdhdr.x b/sys/imio/iki/stf/stfrdhdr.x
new file mode 100644
index 00000000..2c11fec9
--- /dev/null
+++ b/sys/imio/iki/stf/stfrdhdr.x
@@ -0,0 +1,186 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<finfo.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_RDHEADER -- Read the STF format image header for a single group into the
+# IMIO descriptor.  The standard fields are processed into the fields of the
+# descriptor.  The GPB binary parameters are encoded as FITS cards and placed
+# in the IMIO user area, followed by all extra cards in the FITS format STF
+# group header.  Note that no distinction is made between the common FITS
+# keywords and the GPB group parameters at the IMIO level and above.
+
+procedure stf_rdheader (im, group, acmode)
+
+pointer	im		# image descriptor
+int	group		# group to be accessed
+int	acmode		# access mode
+
+long	pixoff
+long	fi[LEN_FINFO]
+real	datamin, datamax
+pointer	sp, stf, lbuf, root, extn, op
+int	compress, devblksz, ival, ch, i , junk
+int	fits, fitslen, sz_userarea, sz_gpbhdr, len_hdrmem
+long	totpix, mtime, ctime
+
+real	imgetr()
+int	fnroot(), strlen(), finfo(), imaccf()
+errchk	stf_rfitshdr, stf_rgpb, open, realloc, imaddb, imaddi, imgetr
+
+include <szpixtype.inc>
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+
+	stf = IM_KDES(im)
+
+	# Read the FITS header, setting the values of all reserved fields
+	# in the STF descriptor and saving all the user FITS cards in the
+	# save buffer "fits".
+
+	call stf_rfitshdr (im, fits, fitslen)
+
+	# Process the reserved keywords (set in the STF descriptor) into the
+	# corresponding fields of the IMIO descriptor.
+
+        # Set group keywords if STF_GROUPS is NO (BPS 12.06.91).
+        if (STF_GROUPS(stf) == NO) {
+            STF_GCOUNT(stf) = 1
+            STF_PCOUNT(stf) = 0
+            STF_PSIZE(stf) = 0
+        }
+
+	if (acmode != NEW_COPY) {
+	    IM_NDIM(im) = STF_NAXIS(stf)		# IM_NDIM
+	    do ival = 1, IM_MAXDIM			# IM_LEN
+		IM_LEN(im,ival) = STF_LENAXIS(stf,ival)
+	}
+
+	ch = STF_DATATYPE(stf)				# IM_PIXTYPE
+	switch (STF_BITPIX(stf)) {
+	case 16:
+	    if (ch == 'U')
+		ival = TY_USHORT
+	    else
+	        ival = TY_SHORT
+	case 32:
+	    if (ch == 'R')
+		ival = TY_REAL
+	    else
+		ival = TY_LONG
+	case 64:
+	    if (ch == 'R')
+		ival = TY_DOUBLE
+	    else
+		ival = TY_COMPLEX
+	default:
+	    ival = ERR
+	}
+	IM_PIXTYPE(im) = ival
+
+	call iki_parse (IM_HDRFILE(im), Memc[root], Memc[extn])
+	call stf_mkpixfname (Memc[root], Memc[extn], IM_PIXFILE(im),
+	    SZ_IMPIXFILE)
+
+	if (finfo (IM_PIXFILE(im), fi) != ERR) {
+	    mtime = FI_MTIME(fi)
+	    ctime = FI_CTIME(fi)
+	}
+
+	IM_NBPIX(im)   = 0			# no. bad pixels
+	IM_CTIME(im)   = ctime			# creation time
+	IM_MTIME(im)   = mtime			# modify time
+	IM_LIMTIME(im) = mtime - 1		# time max/min last updated
+	IM_UABLOCKED(im) = YES			# ua cards blocked to 80 chars
+
+	IM_HISTORY(im) = EOS
+	junk = fnroot (IM_HDRFILE(im), Memc[lbuf], SZ_LINE)
+	call strupr (Memc[lbuf])
+	call sprintf (IM_TITLE(im), SZ_IMTITLE, "%s[%d/%d]")
+	    call pargstr (Memc[lbuf])
+	    call pargi (STF_GROUP(stf))
+	    call pargi (STF_GCOUNT(stf))
+
+	# Compute the size of each group in the pixel file, in chars.
+	totpix = IM_LEN(im,1)
+	do i = 2, IM_NDIM(im)
+	    totpix = totpix * IM_LEN(im,i)
+
+	STF_SZGROUP(stf) = totpix * pix_size[IM_PIXTYPE(im)] +
+	    STF_PSIZE(stf) / (SZB_CHAR * NBITS_BYTE)
+
+	# Write GPB related cards to the beginning of the IMIO user area.
+	call imaddb (im, "GROUPS", STF_GROUPS(stf) == YES)
+	call imaddi (im, "GCOUNT", STF_GCOUNT(stf))
+	call imaddi (im, "PCOUNT", STF_PCOUNT(stf))
+	call imaddi (im, "PSIZE", STF_PSIZE(stf))
+
+	# Extract the group parameter block from the pixfile, encoding the
+	# group parameters as FITS cards and appending to the cards above.
+	# Get the values of DATAMIN and DATAMAX from the GPB so that we can
+	# update the IMIO min/max fields.
+
+	call stf_rgpb (im, group, acmode, datamin, datamax)
+
+	# Reallocate the image descriptor to allow space for the spooled user
+	# FITS cards plus a little extra for new parameters.
+
+	sz_gpbhdr = strlen (Memc[IM_USERAREA(im)])
+	sz_userarea = sz_gpbhdr + fitslen + SZ_EXTRASPACE
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+	# Append the saved FITS cards from the STF header to the user area.
+	# Any cards which redefine GPB cards were already deleted when the
+	# fits save buffer was created (we don't want the GPB cards since
+	# we already output a FITS card for each GPB parameter above).
+
+	op = IM_USERAREA(im) + sz_gpbhdr
+	call amovc (Memc[fits], Memc[op], fitslen+1)
+
+	# Set the IMIO min/max fields.  If the GPB datamin >= datamax the
+	# values are invalidated by setting IM_LIMTIME to before the image
+	# modification time.  Although datamin/datamax were returned by
+	# stg_rgpb above, we refetch the values here to pick up the values
+	# from the spooled main header in case there were no entries for
+	# these keywords in the GPB (if there are values in the GPB they
+	# will override those in the main header).
+
+	if (imaccf (im, "DATAMIN") == YES)
+	    datamin = imgetr (im, "DATAMIN")
+	if (imaccf (im, "DATAMAX") == YES)
+	    datamax = imgetr (im, "DATAMAX")
+
+	IM_MIN(im) = datamin
+	IM_MAX(im) = datamax
+	if (datamin < datamax)
+	    IM_LIMTIME(im) = IM_MTIME(im) + 1
+	else
+	    IM_LIMTIME(im) = IM_MTIME(im) - 1
+
+	# Call up IMIO set set up the remaining image header fields used to
+	# define the physical offsets of the pixels in the pixfile.
+
+	compress = YES		# do not align image lines on blocks
+	devblksz = 1		# disable all alignment
+
+	pixoff = (group - 1) * STF_SZGROUP(stf) + 1
+	call imioff (im, pixoff, compress, devblksz)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfreblk.x b/sys/imio/iki/stf/stfreblk.x
new file mode 100644
index 00000000..9519bd08
--- /dev/null
+++ b/sys/imio/iki/stf/stfreblk.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+# STF_REBLOCK -- If the user area is not blocked to fixed length records, e.g.,
+# as is possible in a new copy image, reblock it fixed length.
+
+procedure stf_reblock (im)
+
+pointer	im			# image descriptor
+
+pointer	sp, lbuf, op, ua
+int	fd, spool, nlines, nchars, sz_userarea, len_hdrmem
+errchk	stropen, open, getline, putline, realloc, seek, fcopyo
+int	open(), stropen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], ARB, READ_ONLY)
+	spool = open ("rb_spool", READ_WRITE, SPOOL_FILE)
+	
+	# Reblock into a spool file, counting the lines.
+	for (nlines=0;  ;  nlines=nlines+1) {
+	    nchars = getline (fd, Memc[lbuf])
+	    if (nchars <= 0)
+		break
+
+	    for (op=nchars;  op <= FITS_RECLEN;  op=op+1)
+		Memc[lbuf+op-1] = ' '
+	    Memc[lbuf+FITS_RECLEN] = '\n'
+	    Memc[lbuf+FITS_RECLEN+1] = EOS
+
+	    call putline (spool, Memc[lbuf])
+	}
+
+	call close (fd)
+
+	# Reallocate header the right size.
+	sz_userarea = nlines * (FITS_RECLEN+1) + SZ_EXTRASPACE
+
+	IM_HDRLEN(im) = LEN_IMHDR +
+	    (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT
+	len_hdrmem = LEN_IMHDR +
+	    (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT
+
+	if (IM_LENHDRMEM(im) < len_hdrmem) {
+	    IM_LENHDRMEM(im) = len_hdrmem
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	}
+
+	# Move spooled data back to user area.
+	ua = IM_USERAREA(im)
+	fd = stropen (Memc[ua], sz_userarea, NEW_FILE)
+	call seek (spool, BOFL)
+	call fcopyo (spool, fd)
+
+	call close (fd)
+	call close (spool)
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfrename.x b/sys/imio/iki/stf/stfrename.x
new file mode 100644
index 00000000..0d3c43fd
--- /dev/null
+++ b/sys/imio/iki/stf/stfrename.x
@@ -0,0 +1,49 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"stf.h"
+
+# STF_RENAME -- Rename an image.  A special operator is required since the image
+# is stored as two files.
+#
+# [NOTE] - Name changed to `rname' rather than `rename' to avoid a name
+# collision with the SYMTAB procedure `stfree' (first such collision!).
+
+procedure stf_rname (kernel, oroot, oextn, nroot, nextn, status)
+
+int	kernel			#I IKI kernel
+char	oroot[ARB]		# old image root name
+char	oextn[ARB]		# old image extn
+char	nroot[ARB]		# new image root name
+char	nextn[ARB]		# old image extn
+int	status
+
+pointer	sp
+pointer	ohdr_fname, opix_fname, nhdr_fname, npix_fname
+bool	streq()
+
+begin
+	call smark (sp)
+	call salloc (ohdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (opix_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (nhdr_fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (npix_fname, SZ_PATHNAME, TY_CHAR)
+
+	# Generate filenames.
+	call iki_mkfname (oroot, oextn, Memc[ohdr_fname], SZ_PATHNAME)
+	call iki_mkfname (nroot, nextn, Memc[nhdr_fname], SZ_PATHNAME)
+
+	if (!streq (Memc[ohdr_fname], Memc[nhdr_fname])) {
+	    call stf_mkpixfname (oroot, oextn, Memc[opix_fname], SZ_PATHNAME)
+	    call stf_mkpixfname (nroot, nextn, Memc[npix_fname], SZ_PATHNAME)
+
+	    # If the header cannot be renamed, don't leave the pixfile alone.
+	    iferr (call rename (Memc[ohdr_fname], Memc[nhdr_fname]))
+		call erract (EA_WARN)
+	    else iferr (call rename (Memc[opix_fname], Memc[npix_fname]))
+		call erract (EA_WARN)
+	}
+
+	call sfree (sp)
+	status = OK
+end
diff --git a/sys/imio/iki/stf/stfrfits.x b/sys/imio/iki/stf/stfrfits.x
new file mode 100644
index 00000000..8ec9e9b0
--- /dev/null
+++ b/sys/imio/iki/stf/stfrfits.x
@@ -0,0 +1,266 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<finfo.h>
+include	<fset.h>
+include	"stf.h"
+
+# STF_RFITSHDR -- Read a STF FITS image header, processing all reserved GPB
+# definition keywords into the STF descriptor in the image descriptor, and
+# saving the remaining cards (excluding cards which GPB keyword names) in
+# in a save buffer.
+# 
+# This routine implements a simple cache of FITS headers.  If a given header
+# is already in the cache and the cached entry is up to date, the cached
+# spool file containing the user FITS cards and the saved STF descriptor are
+# returned immediately without need to access the header file on disk.
+# Otherwise, the new header is read into the oldest cache slot and the cached
+# entry returned in the usual fashion.  Any modifications to the header file
+# which affect the file modify date will invalidate the cached entry.  Note
+# that multiple processes may cache the same header, so it is not permitted
+# to modify the cached entry once the header file has been read.
+# 
+# The following reserved keywords are recognized:
+# 
+# 	SIMPLE BITPIX DATATYPE NAXIS* GROUPS GCOUNT PCOUNT PSIZE 
+# 	PTYPE* PDTYPE* PSIZE* 
+# 
+# All unrecognized cards, including HISTORY and COMMENT cards, blank lines,
+# and any other garbage in the header, are preserved in the user area of the
+# IMIO descriptor (i.e., in the spoolfile).  Certain of the standard reserved
+# cards (GROUPS, GCOUNT, etc.) are saved in the IMIO user area for the sake
+# of the user, although the real values of these parameters are maintained only
+# in the STF descriptor.
+
+procedure stf_rfitshdr (im, fits, fitslen)
+
+pointer	im				#I image descriptor
+pointer	fits				#O pointer to saved FITS cards
+int	fitslen				#O length of FITS save area
+
+long	fi[LEN_FINFO]
+pointer	sp, pp, stf, o_stf, lbuf, op, hdrfile
+int	in, index, nchars, spool, slot, user, i
+
+bool	streq()
+long	clktime(), fstatl()
+int	envgeti(), stf_ctype(), finfo(), getline(), open(), stropen()
+errchk	getline, putline, syserrs, open, seek, calloc, realloc
+errchk	fpathname, malloc, stf_copyfits
+
+bool	initialized			# CACHE definitions...
+bool	reload				# reload cache
+int	rf_refcount			# reference count
+int	rf_cachesize			# number of cache slots
+pointer	rf_stf[MAX_CACHE]		# STF descriptor
+int	rf_lru[MAX_CACHE]		# lowest value is oldest slot
+long	rf_time[MAX_CACHE]		# time when entry was cached
+long	rf_mtime[MAX_CACHE]		# modify time of file in cache
+int	rf_fits[MAX_CACHE]		# FITS data
+int	rf_fitslen[MAX_CACHE]		# size of data area
+char	rf_fname[SZ_PATHNAME,MAX_CACHE]	# header file pathname
+data	initialized /false/
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+	# Initialize the header file cache on the first call.
+	if (!initialized) {
+	    rf_refcount = 0
+	    do i = 1, MAX_CACHE
+		rf_stf[i] = 0
+
+	    iferr (rf_cachesize = envgeti (ENV_STFCACHE))
+		rf_cachesize = DEF_CACHE
+	    if (rf_cachesize > MAX_CACHE) {
+		call eprintf ("A maximum of %d STF headers may be cached\n")
+		    call pargi (MAX_CACHE)
+		rf_cachesize = MAX_CACHE
+	    } else if (rf_cachesize <= 0)
+		rf_cachesize = 0
+		
+	    initialized = true
+	}
+
+	rf_refcount = rf_refcount + 1
+	o_stf = IM_KDES(im)
+	reload = false
+	slot = 1
+
+	# Get file system info on the desired header file.
+	call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+	if (finfo (Memc[hdrfile], fi) == ERR)
+	    call syserrs (SYS_FOPEN, IM_HDRFILE(im))
+
+	repeat {
+	    # Search the header file cache for the named image.
+	    do i = 1, max(1,rf_cachesize) {
+		if (rf_stf[i] == NULL) {
+		    slot = i
+		    next
+		}
+
+		if (streq (Memc[hdrfile], rf_fname[1,i])) {
+		    # File is in cache; is cached entry still valid?
+		    if (FI_MTIME(fi) != rf_mtime[i]) {
+			# File modify date has changed, reuse slot.
+			slot = i
+			break
+
+		    } else if (!reload && clktime(rf_time[i]) < 2) {
+			# The file modify date has not changed, but the cache
+			# was loaded within the last clock "tick" (second),
+			# so we cannot be sure that the file was not modified.
+			# The cache must be reloaded, but set a flag so that
+			# rf_time is not changed, so that when the cache entry
+			# ages sufficiently it will be considered valid.
+
+			reload = true
+			slot = i
+			break
+
+		    } else {
+			# Return the cached header.
+			rf_lru[i] = rf_refcount
+			call amovi (STF_CACHE(rf_stf[i]), STF_CACHE(o_stf),
+			    STF_CACHELEN(rf_stf[i]))
+			fits = rf_fits[i]
+			fitslen = rf_fitslen[i]
+
+			# Invalidate entry if cache is disabled.
+			if (rf_cachesize <= 0)
+			    rf_time[i] = 0
+
+			call sfree (sp)
+			return 				# IN CACHE
+		    }
+
+		} else {
+		    # Keep track of least recently used slot.
+		    if (rf_lru[i] < rf_lru[slot])
+			slot = i
+		}
+	    }
+
+	    # Either the image header is not in the cache, or the cached
+	    # entry is invalid.  Prepare the given cache slot and read the
+	    # header into it.
+
+	    # Free old save buffer and descriptor.
+	    if (rf_stf[slot] != NULL) {
+		call mfree (rf_stf[slot], TY_STRUCT)
+		call mfree (rf_fits[slot], TY_CHAR)
+	    }
+
+	    # Open the header file.
+	    if (IM_HFD(im) == NULL)
+		in = open (Memc[hdrfile], READ_ONLY, TEXT_FILE)
+	    else {
+		in = IM_HFD(im)
+		call seek (in, BOFL)
+	    }
+
+	    # Allocate a spool file for the FITS data.
+	    call sprintf (rf_fname[1,slot], SZ_PATHNAME, "STFHC#%d")
+		call pargi (slot)
+	    spool = open (rf_fname[1,slot], READ_WRITE, SPOOL_FILE)
+	    call fseti (spool, F_BUFSIZE, FI_SIZE(fi))
+
+	    # Allocate cache version of STF descriptor.
+	    call calloc (stf, LEN_STFDES, TY_STRUCT)
+
+	    # Initialize the cache entry.
+	    call strcpy (Memc[hdrfile], rf_fname[1,slot], SZ_PATHNAME)
+	    rf_stf[slot] = stf
+	    rf_lru[slot] = rf_refcount
+	    rf_mtime[slot] = FI_MTIME(fi)
+	    if (!reload)
+		rf_time[slot] = clktime (0)
+	    reload = true
+
+	    # Read successive lines of the FITS header.  Process reserved
+	    # keywords into the STF descriptor and spool the remaining cards
+	    # to the fits spool file.
+
+	    repeat {
+		# Get the next input line.
+		nchars = getline (in, Memc[lbuf])
+		if (nchars == EOF)
+		    break
+
+		# Block it out to 80 chars (plus newline) if it is not already.
+		if (nchars != FITS_RECLEN + 1) {
+		    for (op=nchars;  op <= FITS_RECLEN;  op=op+1)
+			Memc[lbuf+op-1] = ' '
+		    Memc[lbuf+FITS_RECLEN]   = '\n'
+		    Memc[lbuf+FITS_RECLEN+1] = EOS
+		}
+		    
+		# Process the header card.
+		switch (stf_ctype (Memc[lbuf], index)) {
+		case KW_BITPIX:
+		    call stf_geti (Memc[lbuf], STF_BITPIX(stf))
+		case KW_DATATYPE:
+		    call stf_gets (Memc[lbuf], STF_DATATYPE(stf), SZ_DATATYPE)
+		case KW_END:
+		    break
+		case KW_GCOUNT:
+		    call stf_geti (Memc[lbuf], STF_GCOUNT(stf))
+		case KW_GROUPS:
+		    call stf_getb (Memc[lbuf], STF_GROUPS(stf))
+		case KW_NAXIS:
+		    call stf_geti (Memc[lbuf], STF_NAXIS(stf))
+		case KW_NAXISN:
+		    call stf_geti (Memc[lbuf], STF_LENAXIS(stf,index))
+		case KW_PCOUNT:
+		    call stf_geti (Memc[lbuf], STF_PCOUNT(stf))
+		case KW_PDTYPE:
+		    pp = STF_PDES(stf,min(index,MAX_PCOUNT))
+		    call stf_gets (Memc[lbuf], P_PDTYPE(pp), SZ_PDTYPE)
+		case KW_PSIZE:
+		    call stf_geti (Memc[lbuf], STF_PSIZE(stf))
+		case KW_PSIZEN:
+		    pp = STF_PDES(stf,min(index,MAX_PCOUNT))
+		    call stf_geti (Memc[lbuf], P_PSIZE(pp))
+		case KW_PTYPE:
+		    pp = STF_PDES(stf,min(index,MAX_PCOUNT))
+		    call stf_gets (Memc[lbuf], P_PTYPE(pp), SZ_PTYPE)
+		    call stf_getcmt (Memc[lbuf], P_COMMENT(pp), SZ_COMMENT)
+		case KW_SIMPLE:
+		    ;
+		default:
+		    call putline (spool, Memc[lbuf])
+		}
+	    }
+
+	    # Close the header file if opened locally.
+	    if (IM_HFD(im) == NULL)
+		call close (in)
+
+	    # Free any unneeded space in the STF descriptor.
+	    if (STF_PCOUNT(stf) > 0) {
+		call realloc (stf,
+		    LEN_STFBASE + STF_PCOUNT(stf)*LEN_PDES, TY_STRUCT)
+		rf_stf[slot] = stf
+	    }
+
+	    # Filter the spooled FITS cards to delete any cards which redefine
+	    # GPB keywords.  Store the filtered FITS data in the cache.
+
+	    call seek (spool, BOFL)
+	    nchars = fstatl (spool, F_FILESIZE)
+	    call malloc (fits, nchars, TY_CHAR)
+	    user = stropen (Memc[fits], nchars, NEW_FILE)
+	    call stf_copyfits (stf, spool, NULL, user)
+
+	    rf_fits[slot] = fits
+	    rf_fitslen[slot] = fstatl (user, F_FILESIZE)
+	    call close (user)
+	    call close (spool)
+	}
+end
diff --git a/sys/imio/iki/stf/stfrgpb.x b/sys/imio/iki/stf/stfrgpb.x
new file mode 100644
index 00000000..15c4da0a
--- /dev/null
+++ b/sys/imio/iki/stf/stfrgpb.x
@@ -0,0 +1,179 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_RGPB -- Read the group data block into the first few cards of the user
+# area of the IMIO image header.  The GPB is stored as a binary data structure
+# in the STF pixfile.  The values of the standard GPB parameters DATAMIN and
+# DATAMAX are returned as output arguments.
+#
+# DLB--11/03/87: Made changes to allow i*2 and i*4 integer parameters in GPB.
+# DLB--11/11/87: Changed calculation of character string length in GPB to
+# avoid integer truncation error by using P_PSIZE directly.
+
+procedure stf_rgpb (im, group, acmode, datamin, datamax)
+
+pointer	im			# IMIO image descriptor
+int	group			# group to be accessed
+int	acmode			# image access mode
+real	datamin, datamax	# min,max pixel values from GPB
+
+real	rval
+double	dval
+short	sval
+long	lval, offset
+bool	bval, newgroup
+pointer	sp, stf, gpb, lbuf, pp
+int	pfd, pn, sz_param, sz_gpb
+errchk	imaddb, imadds, imaddl, imaddr, imaddd, imastr
+errchk	imputd, impstr, open, read
+int	open(), read(), imaccf()
+real	imgetr()
+
+string	readerr "cannot read group data block - no such group?"
+string	badtype "illegal group data parameter datatype"
+string	nogroup "group index out of range"
+define	minmax_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	stf = IM_KDES(im)
+	pfd = STF_PFD(stf)
+
+	# Verify that the given group exists.
+	if (group < 1 || group > STF_GCOUNT(stf))
+	    call error (1, nogroup)
+
+	# Skip ahead if there is no group parameter block.
+	if (STF_PSIZE(stf) == 0)
+	    goto minmax_
+
+	# Open the pixel file if not already open.
+	if (pfd == NULL) {
+	    iferr {
+		if (IM_ACMODE(im) == READ_ONLY)
+		    pfd = open (IM_PIXFILE(im), READ_ONLY, BINARY_FILE)
+		else
+		    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+		STF_PFD(stf) = pfd
+	    } then {
+		call eprintf ("Warning: Cannot open pixfile to read GPB (%s)\n")
+		    call pargstr (IM_NAME(im))
+		pfd = NULL
+	    }
+	}
+
+	# Allocate a buffer for the GPB.
+	sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
+	call salloc (gpb, sz_gpb, TY_CHAR)
+
+	# Read the GPB into a buffer.  The GPB is located at the very end of
+	# the data storage area for the group.  If we are opening a new,
+	# uninitialized group (acmode = new_image or new_copy), do not
+	# physically read the GPB as it is will be uninitialized data.
+
+	newgroup = (acmode == NEW_IMAGE || acmode == NEW_COPY || pfd == NULL)
+	if (newgroup)
+	    call aclrc (Memc[gpb], sz_gpb)
+	else {
+	    offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
+	    call seek (pfd, offset)
+	    if (read (pfd, Memc[gpb], sz_gpb) != sz_gpb)
+		call error (1, readerr)
+	}
+
+	# Extract the binary value of each parameter in the GPB and encode it
+	# in FITS format in the IMIO user area.
+
+	offset = 0
+	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
+	    pp = STF_PDES(stf,pn)
+		
+	    # Fill in the unitialized fields of the GPB parameter descriptor.
+	    P_OFFSET(pp) = offset
+	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR
+
+	    switch (P_PDTYPE(pp)) {
+	    # changed case for int to short and long--dlb 11/3/87
+	    case 'I':
+		if (sz_param == SZ_SHORT)
+		    P_SPPTYPE(pp) = TY_SHORT
+		else
+		    P_SPPTYPE(pp) = TY_LONG
+		P_LEN(pp) = 1
+	    case 'R':
+		if (sz_param == SZ_REAL)
+		    P_SPPTYPE(pp) = TY_REAL
+		else
+		    P_SPPTYPE(pp) = TY_DOUBLE
+		P_LEN(pp) = 1
+	    case 'C':
+		P_SPPTYPE(pp) = TY_CHAR
+		# calculate length directly from PSIZE to avoid truncation error
+		P_LEN(pp) = min (SZ_LINE, P_PSIZE(pp) / NBITS_BYTE)
+	    case 'L':
+		P_SPPTYPE(pp) = TY_BOOL
+		P_LEN(pp) = 1
+	    default:
+		call error (1, badtype)
+	    }
+
+	    # Extract the binary parameter value and add a FITS encoded card
+	    # to the IMIO user area.  In the case of a new copy image, the
+	    # GPB values will already be in the image header, do not modify
+	    # the parameter value, but add the parameter if it was not
+	    # inherited from the old image.
+
+	    if (acmode != NEW_COPY || imaccf (im, P_PTYPE(pp)) == NO) {
+		switch (P_SPPTYPE(pp)) {
+		case TY_BOOL:
+                    if (SZ_INT != SZ_INT32)
+		        call amovc (Memc[gpb+offset], bval, SZ_INT32)
+                    else
+		        call amovc (Memc[gpb+offset], bval, SZ_BOOL)
+		    call imaddb (im, P_PTYPE(pp), bval)
+		case TY_SHORT:
+		    call amovc (Memc[gpb+offset], sval, SZ_SHORT)
+		    call imadds (im, P_PTYPE(pp), sval)
+		case TY_LONG:
+                    if (SZ_INT != SZ_INT32)
+		        call amovc (Memc[gpb+offset], lval, SZ_INT32)
+                    else
+		        call amovc (Memc[gpb+offset], lval, SZ_LONG)
+		    call imaddl (im, P_PTYPE(pp), lval)
+		case TY_REAL:
+		    call amovc (Memc[gpb+offset], rval, SZ_REAL)
+		    call imaddr (im, P_PTYPE(pp), rval)
+		case TY_DOUBLE:
+		    call amovc (Memc[gpb+offset], dval, SZ_DOUBLE)
+		    call imaddd (im, P_PTYPE(pp), dval)
+		case TY_CHAR:
+		    call chrupk (Memc[gpb+offset], 1, Memc[lbuf], 1, P_LEN(pp))
+		    Memc[lbuf+P_LEN(pp)] = EOS
+		    call imastr (im, P_PTYPE(pp), Memc[lbuf])
+		default:
+		    call error (1, badtype)
+		}
+	    }
+
+	    offset = offset + sz_param
+	}
+
+minmax_
+	# Return DATAMIN, DATAMAX.  This is done by searching the user area so
+	# that ordinary keywords may be used to set datamin and datamax if the
+	# GPB is not used.
+
+	datamin = 0.0; datamax = 0.0
+	if (imaccf (im, "DATAMIN") == YES)
+	    datamin = imgetr (im, "DATAMIN")
+	if (imaccf (im, "DATAMAX") == YES)
+	    datamax = imgetr (im, "DATAMAX")
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfupdhdr.x b/sys/imio/iki/stf/stfupdhdr.x
new file mode 100644
index 00000000..a4519c24
--- /dev/null
+++ b/sys/imio/iki/stf/stfupdhdr.x
@@ -0,0 +1,60 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"stf.h"
+
+# STF_UPDHDR -- Update the STF/GEIS format image header.
+
+procedure stf_updhdr (im, status)
+
+pointer	im			# image descriptor
+int	status			# return status
+
+pointer	stf
+int	acmode
+real	datamin, datamax
+errchk	imerr, imputr, stf_wgpb
+
+begin
+	acmode = IM_ACMODE(im)
+	status = OK
+	stf    = IM_KDES(im)
+
+	if (acmode == READ_ONLY)
+	    call imerr (IM_NAME(im), SYS_IMUPIMHDR)
+
+	# Compute the values of DATAMIN and DATAMAX.
+	if (IM_LIMTIME(im) == 0 || IM_LIMTIME(im) < IM_MTIME(im)) {
+	    datamin = 0.
+	    datamax = 0.
+	} else {
+	    datamin = IM_MIN(im)
+	    datamax = IM_MAX(im)
+	}
+
+	# Update the group parameter block.
+	call stf_wgpb (im, STF_GROUP(stf), datamin, datamax)
+
+#	# Update the FITS header file, unless we are writing to a new group
+#	# in an existing group format image, in which case only the GPB is
+#	# updated.
+#
+#	if (acmode != NEW_IMAGE && acmode != NEW_COPY)
+#	    call stf_wfitshdr (im)
+#	else if (STF_NEWIMAGE(stf) == YES)
+#	    call stf_wfitshdr (im)
+
+	# The new strategy for FITS header updates is to always update, unless
+	# we are explicitly updating an existing group of a multigroup image.
+	# Hence, the FITS header is always updated for an STF image with only
+	# one group, or when writing the first group of a new STF imagefile.
+	# The FITS header of an existing STF multigroup image can still be
+	# updated, but only if the image is not opened to any particular group,
+	# e.g., as "pix" rather than "pix[n]", N > 0.  NEW_[IMAGE|COPY] or
+	# READ_WRITE access to "pix[n]" will update only the GPB header.
+
+	if (STF_NEWIMAGE(stf)==YES || STF_GCOUNT(stf)<=1 || STF_GRARG(stf)==0)
+	    call stf_wfitshdr (im)
+end
diff --git a/sys/imio/iki/stf/stfwfits.x b/sys/imio/iki/stf/stfwfits.x
new file mode 100644
index 00000000..c444a235
--- /dev/null
+++ b/sys/imio/iki/stf/stfwfits.x
@@ -0,0 +1,147 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<fio.h>
+include	"stf.h"
+
+# STF_WFITSHDR -- Update the FITS header file.  This is done by writing an
+# entire new header file and then replacing the old header file with the
+# new one.  This is necessary since the header file is a text file and text
+# files cannot be randomly updated.
+
+procedure stf_wfitshdr (im)
+
+pointer	im			# image descriptor
+
+pointer	sp, fname, lbuf, stf, pp
+int	in, out, pn, junk, i, width
+
+bool	fnullfile()
+int	stropen(), open(), protect(), strlen() #ditto-dlb
+errchk	fmkcopy, open, stropen, fcopyo, fprintf
+
+begin
+	if (fnullfile (IM_HDRFILE(im)))
+	    return
+
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	stf = IM_KDES(im)
+
+	# Open a new header file with a unique, temporary name.  Make a copy
+	# of the template file rather than of the old header file.  Since
+	# we also block header lines out to 80 chars automatically, this
+	# means that we can read any old text file but will always generate
+	# a new header file of the standard type when the header is updated.
+
+	call mktemp (IM_HDRFILE(im), Memc[fname], SZ_FNAME)
+	call fmkcopy (HDR_TEMPLATE, Memc[fname])
+	out = open (Memc[fname], APPEND, TEXT_FILE)
+
+	# Write out the standard, reserved header parameters.
+
+	call fprintf (out, "SIMPLE  =%21s /%81t\n")
+	    call pargstr ("F")
+	call fprintf (out, "BITPIX  =%21d /%81t\n")
+	    call pargi (STF_BITPIX(stf))
+
+	# We want to get the full string length or 8 characters, 
+	# whichever is greater--6/25/87, dlb
+	
+	call fprintf (out, "DATATYPE= '%*.*s'%32t/%81t\n")
+	    width = max(8, strlen(STF_DATATYPE(STF)))
+	    call pargi (-width) # force left-justified field
+	    call pargi (width)
+	    call pargstr (STF_DATATYPE(stf))
+
+	call fprintf (out, "NAXIS   =%21d /%81t\n")
+	    call pargi (STF_NAXIS(stf))
+	do i = 1, STF_NAXIS(stf) {
+	    call fprintf (out, "NAXIS%d%9t=%21d /%81t\n")
+		call pargi (i)
+		call pargi (STF_LENAXIS(stf,i))
+	}
+
+	call fprintf (out, "GROUPS  =%21s /%81t\n")
+	    if (STF_GROUPS(stf) == YES)
+		call pargstr ("T")
+	    else
+		call pargstr ("F")
+
+	# Changed order of the following three cards to conform
+	# to SOGS expectations--dlb, 7/14/87
+	# Only write group keywords if STF_GROUPS is YES (BPS 12.06.91)
+
+	if (STF_GROUPS(stf) == YES) {
+	    call fprintf (out, "GCOUNT  =%21d /%81t\n")
+		call pargi (STF_GCOUNT(stf))
+	    call fprintf (out, "PCOUNT  =%21d /%81t\n")
+		call pargi (STF_PCOUNT(stf))
+	    call fprintf (out, "PSIZE   =%21d /%81t\n")
+		call pargi (STF_PSIZE(stf))
+	}
+
+	# Add cards defining the fields of the group parameter block.  Each
+	# field requires three cards.
+
+	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
+	    pp = STF_PDES(stf,pn)
+
+	    # PTYPE MUST be 8 characters or less.
+	    call fprintf (out, "PTYPE%d%9t= '%-8.8s'%32t/%s%81t\n")
+		call pargi (pn)
+		call pargstr (P_PTYPE(pp))
+		call pargstr (P_COMMENT(pp))
+
+	    # Need width for string--6/26/87, dlb
+	    call fprintf (out, "PDTYPE%d%9t= '%-*.*s'%32t/%81t\n")
+		call pargi (pn)
+		width = max (8, strlen(P_PDTYPE(pp)))
+		call pargi (-width) # force left-justified field
+		call pargi (width)
+		call pargstr (P_PDTYPE(pp))
+
+	    call fprintf (out, "PSIZE%d%9t=%21d /%81t\n")
+		call pargi (pn)
+		call pargi (P_PSIZE(pp))
+	}
+
+	# Add the contents of the IMIO user area, excluding the cards used
+	# to represent GPB parameters.
+
+	in = stropen (Memc[IM_USERAREA(im)], ARB, READ_ONLY)
+	call stf_copyfits (stf, in, NULL, out)
+	call close (in)
+
+	# End of FITS header.
+	call fprintf (out, "END%81t\n")
+	call close (out)
+
+	# Replace the original header file with the new one, even if the
+	# original header is a protected file.  Transfer any file protection
+	# to the new file.
+
+	if (IM_HFD(im) != NULL)
+	    call close (IM_HFD(im))
+
+	if (protect (IM_HDRFILE(im), QUERY_PROTECTION) == YES) {
+	    iferr (junk = protect (IM_HDRFILE(im), REMOVE_PROTECTION))
+		call erract (EA_ERROR)
+	    iferr (junk = protect (Memc[fname], SET_PROTECTION))
+		call erract (EA_ERROR)
+	}
+
+	iferr (call delete (IM_HDRFILE(im)))
+	    call erract (EA_ERROR)
+	iferr (call rename (Memc[fname], IM_HDRFILE(im)))
+	    call erract (EA_ERROR)
+
+	if (IM_HFD(im) != NULL)
+	    IM_HFD(im) = open (IM_HDRFILE(im), READ_ONLY, TEXT_FILE)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/stf/stfwgpb.x b/sys/imio/iki/stf/stfwgpb.x
new file mode 100644
index 00000000..3a9e8fe8
--- /dev/null
+++ b/sys/imio/iki/stf/stfwgpb.x
@@ -0,0 +1,174 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<mach.h>
+include	"stf.h"
+
+# STF_WGPB -- Write the group parameter block data back into the pixel file.
+# The GPB is described by a structure member list in the STF descriptor.
+# The values of the GPB parameters are encoded as FITS cards in the user
+# area of the IMIO descriptor.
+#
+# DLB--11/3/87: Made changes to allow i*2 and i*4 integer parameters in gpb.
+
+procedure stf_wgpb (im, group, datamin, datamax)
+
+pointer	im			# IMIO image descriptor
+int	group			# group to be accessed
+real	datamin, datamax	# new min, max pixel values
+
+long	offset
+pointer	sp, stf, gpb, lbuf, pp, op
+int	pfd, pn, sz_param, sz_gpb, i
+
+int	open(), strlen()
+bool	bval, imgetb()
+# changed to short and long for short integers in gpb
+short	sval, imgets()
+long	lval, imgetl()
+#
+real	rval, imgetr()
+double	dval, imgetd()
+errchk	open, seek
+int	imaccf()
+
+string	writerr "cannot update group parameter block"
+string	badtype "illegal group data parameter datatype"
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	stf = IM_KDES(im)
+	pfd = STF_PFD(stf)
+
+	# Not all images have group parameter blocks.
+	if (STF_PSIZE(stf) == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Open the pixel file if not already open.
+	if (pfd == NULL) {
+	    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
+	    STF_PFD(stf) = pfd
+	}
+
+	# Update the values of DATAMIN, DATAMAX.
+	if (imaccf (im, "DATAMIN") == YES && 
+            imaccf (im, "DATAMAX") == YES) {
+
+	    iferr {
+	        call imputr (im, "DATAMIN", datamin)
+	        call imputr (im, "DATAMAX", datamax)
+	    } then
+	        call erract (EA_WARN)
+	}
+
+	# Allocate a buffer for the GPB.
+	sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
+	call salloc (gpb, sz_gpb, TY_CHAR)
+
+	# Extract the binary value of each parameter in the GPB and encode it
+	# in FITS format in the IMIO user area.
+
+	offset = 0
+	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
+	    pp = STF_PDES(stf,pn)
+	    op = gpb + offset
+
+	    # Fetch the value of the parameter from IMIO and write it into
+	    # the GPB binary data structure.
+
+	    switch (P_SPPTYPE(pp)) {
+	    case TY_BOOL:
+		iferr (bval = imgetb (im, P_PTYPE(pp))) {
+		    call erract (EA_WARN)
+		    bval = false
+		}
+		# Memb[(op-1)/SZ_BOOL+1] = bval
+		if (SZ_INT != SZ_INT32) {
+		    call i64to32 (bval, bval, 1)
+		    call amovc (bval, Memc[op], SZ_INT32)
+		} else
+		    call amovc (bval, Memc[op], SZ_BOOL)
+
+	    # changed case for int to short and long 
+	    # to allow i*2 in gpb--dlb 11/3/87
+	    case TY_SHORT:
+		iferr (sval = imgets (im, P_PTYPE(pp))) {
+		    call erract (EA_WARN)
+		    sval = 0
+		}
+		call amovc (sval, Memc[op], SZ_SHORT)
+
+	    case TY_LONG:
+		iferr (lval = imgetl (im, P_PTYPE(pp))) {
+		    call erract (EA_WARN)
+		    lval = 0
+		}
+		if (SZ_INT != SZ_INT32) {
+		    call i64to32 (lval, lval, 1)
+		    call amovc (lval, Memc[op], SZ_INT32)
+		} else
+		    call amovc (lval, Memc[op], SZ_LONG)
+
+	    case TY_REAL:
+		iferr (rval = imgetr (im, P_PTYPE(pp))) {
+		    # Currently with MWCS, WCS cards such as CRVAL, CDi_j,
+		    # etc. (always type real or double) are omitted from the
+		    # header if their value is zero.  Hence if the card is
+		    # missing assume a value of zero rather than issue a
+		    # warning.
+
+		    # call erract (EA_WARN)
+		    rval = 0.0
+		}
+		# Memr[(op-1)/SZ_REAL+1] = rval
+		call amovc (rval, Memc[op], SZ_REAL)
+
+	    case TY_DOUBLE:
+		iferr (dval = imgetd (im, P_PTYPE(pp))) {
+		    # Skip warning as assume zero, as above or TY_REAL.
+		    # call erract (EA_WARN)
+		    dval = 0.0D0
+		}
+		# Memd[(op-1)/SZ_DOUBLE+1] = dval
+		call amovc (dval, Memc[op], SZ_DOUBLE)
+
+	    case TY_CHAR:
+		# Blank fill the string buffer.
+		do i = 1, P_LEN(pp)
+		    Memc[lbuf+i-1] = ' '
+
+		# Fetch the string value of the parameter.
+		iferr (call imgstr (im, P_PTYPE(pp), Memc[lbuf], SZ_LINE))
+		    call erract (EA_WARN)
+
+		# Replace the EOS delimiter by a blank.
+		i = strlen (Memc[lbuf])
+		Memc[lbuf+i] = ' '
+
+		# Pack the blank filled array into the GPB.
+		call chrpak (Memc[lbuf], 1, Memc[gpb+offset], 1, P_LEN(pp))
+
+	    default:
+		call error (1, badtype)
+	    }
+
+	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR
+	    offset = offset + sz_param
+	}
+
+	# Write the GPB into the pixfile.  The GPB is located at the very end
+	# of the data storage area for the group.
+
+	offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
+	call seek (pfd, offset)
+	iferr (call write (pfd, Memc[gpb], sz_gpb))
+	    call error (5, writerr)
+
+	call sfree (sp)
+end