Initial commit

20 files changed, 3457 insertions, 0 deletions

diff --git a/pkg/xtools/mef/Notes b/pkg/xtools/mef/Notes
new file mode 100644
index 00000000..7f781840
--- /dev/null
+++ b/pkg/xtools/mef/Notes
@@ -0,0 +1,26 @@
+
+mefwrhdr.x
+	Previuolsy we changed the value of INHERIT to NO. Now we pass
+	the card to the output file unchanged with the exception when
+	the output file is new, then we do not pass it along. 3/4/98
+
+mefrdhdr.x
+	When a kernel section is given in the input file, it is
+	necessary to read the entire header in memory rather
+	than the 1st block. An error was found trying to get EXTNAME
+	value when the keyword was not located in the 1st block.
+	nz 10/2/03
+mefldhdr.x
+	New routine to read the entire header in memory. 10.02.03
+
+==================================================
+
+mefrdhdr.x
+	Change mef_rdhdr...() to be a function now rather than a
+	procedure. This way we can return and EOF value to the
+	calling routine.
+	revised. Used mef_ldhdr() now and discard rd1st and rd2end.
+	Took out any eprintf statement and made the code much simpler.
+	Jan.7.04
+
+
diff --git a/pkg/xtools/mef/mefappfile.x b/pkg/xtools/mef/mefappfile.x
new file mode 100644
index 00000000..eae4536b
--- /dev/null
+++ b/pkg/xtools/mef/mefappfile.x
@@ -0,0 +1,109 @@
+include <pkg/mef.h>
+
+# MEFFAPPFILE.X --  Set of routines to append a FITS units to an FITS file.
+#	meff_app_file(mefi, mefo)
+#	mef_pakwr (out, card)
+#	mef_wrpgcount (out)
+#	mef_wrblank (out, nlines)
+
+
+# MEF_APP_FILE -- Append a FITS file to an existant file. This means the
+# first input unit needs to be changed from a Primary to an Extension Unit.
+
+procedure mef_app_file (mefi, mefo)
+
+pointer	mefi	#I input mef descriptor	
+pointer	mefo	#O output mef descriptor	
+
+char    dname[1]
+int	off, status
+bool	in_phdu
+int	access(), mef_rdhdr_gn()
+
+errchk mef_rdhdr_gn
+
+begin
+
+	# If output file does not exist create a dummy extension
+	if (access(MEF_FNAME(mefo), 0,0) == NO) {
+	   dname[1] = EOS
+	   call mef_dummyhdr (MEF_FD(mefo),dname)
+	   MEF_ACMODE(mefo) = APPEND
+	}
+
+	in_phdu = true      # The input file has a PHDU
+
+	# Read the first input header unit (PHDU) and change to extension
+	# unit while writing to output file.
+	status = mef_rdhdr_gn (mefi,0)
+	if (status == EOF)
+	    call error (13, "EOF encountered on input file")
+	call mef_wrhdr (mefi, mefo, in_phdu)
+
+	# Check for dataless unit; if so the data pointer is at the
+	# end of the last header block.
+
+	if (MEF_POFF(mefi) == INDEFI)
+	    off = MEF_HOFF(mefi) + ((MEF_HSIZE(mefi)+2879)/2880)*1440
+	else
+	    off = MEF_POFF(mefi)
+
+	# Now copy the data
+	call seek (MEF_FD(mefi), off)
+	call fcopyo (MEF_FD(mefi), MEF_FD(mefo))
+end
+
+
+# MEF_PAKWR -- Pack a character buffer and write to the output buffer.
+
+procedure mef_pakwr (out, card)
+
+int 	out		#I Output file descriptor	
+char 	card[ARB]	#I Input FITS card
+
+begin
+	call achtcb (card, card, 80)
+	call write(out, card, 40)
+end
+
+
+# MEF_WRPGCOUNT -- Write PCOUNT and GCOUNT to the output buffer.
+
+procedure mef_wrpgcount (out)
+
+int	out		#I file descriptor
+
+char	line[80]
+
+begin
+	call mef_encodei ("PCOUNT", 0, line, "No 'random' parameters")
+	call mef_pakwr (out, line)
+	call mef_encodei ("GCOUNT", 1, line, "Only one group")
+	call mef_pakwr (out, line)
+end
+
+
+# MEF_WRBLANK --  Write a number of blank lines into the output buffer.
+# we reach the END card in the 1st block but we run out
+# to the 2nd block in the output file. Now fill it up
+# with blank.
+
+procedure mef_wrblank (out, olines)
+
+int	out		#I output file descriptor
+int	olines		#I number of blank lines
+
+int	nlines, i, nbk
+char    card[80]
+
+begin
+	   nlines = 36 - mod(olines,36) 
+
+	   do i =1, 80
+	      card[i] = ' '
+
+	   call achtcb (card, card, 80)
+	   for(i=1; i<=nlines; i=i+1) 
+	      call write(out, card, 40)
+	   return
+end
diff --git a/pkg/xtools/mef/mefclose.x b/pkg/xtools/mef/mefclose.x
new file mode 100644
index 00000000..cbae6d54
--- /dev/null
+++ b/pkg/xtools/mef/mefclose.x
@@ -0,0 +1,17 @@
+include <pkg/mef.h>
+
+# MEF_CLOSE -- Closes mef file descriptor and free up mef memory
+# descriptor.
+
+procedure mef_close(mef)
+
+pointer mef  	#I Mef descriptor
+
+begin
+	call close(MEF_FD(mef))
+
+	if (MEF_HDRP(mef) != NULL)
+	   call mfree(MEF_HDRP(mef), TY_CHAR)
+
+	call mfree (mef, TY_STRUCT)
+end
diff --git a/pkg/xtools/mef/mefcpextn.x b/pkg/xtools/mef/mefcpextn.x
new file mode 100644
index 00000000..b1d00af2
--- /dev/null
+++ b/pkg/xtools/mef/mefcpextn.x
@@ -0,0 +1,46 @@
+include <mach.h>
+include <pkg/mef.h>
+
+# MEF_COPY_EXTN -- Append a FITS unit to the output file.
+
+procedure mef_copy_extn (mefi, mefo, gn)
+
+pointer	mefi	#I input mef descriptor
+pointer	mefo	#I output mef descriptor
+int	gn      #I input group number
+
+char    ibuf[FITS_BLKSZ_CHAR]
+int	ndim, totpix, i, k, in, out, status
+int	read(), mef_rdhdr_gn(), mef_totpix()
+bool    iphdu
+
+errchk  mef_rdhdr_gn
+
+begin
+	iphdu = (gn == 0)
+
+	status = mef_rdhdr_gn (mefi, gn)
+	if (status == EOF)
+	   call error (13, " EOF encountered on input file")
+
+	call mef_wrhdr (mefi, mefo, iphdu)
+	MEF_ACMODE(mefo) = APPEND
+
+	# Count the pixels and write data. 
+	ndim = MEF_NDIM(mefi)
+        if (ndim > 0 || MEF_PCOUNT(mefi) > 0) {
+	    # Set in multiple of FITS_BLKSZ_CHAR
+	    totpix = mef_totpix(mefi)
+	    totpix = (totpix + 1439)/1440
+
+	    in = MEF_FD(mefi)
+	    out = MEF_FD(mefo)
+
+	    # Position the input file to the beginning of the pixel area.
+	    call seek (in, MEF_POFF(mefi))
+	    do i = 1, totpix {
+	        k = read (in, ibuf, 1440)
+	        call write (out, ibuf, 1440)
+	    }
+	}
+end
diff --git a/pkg/xtools/mef/mefdummyh.x b/pkg/xtools/mef/mefdummyh.x
new file mode 100644
index 00000000..ba0d38dd
--- /dev/null
+++ b/pkg/xtools/mef/mefdummyh.x
@@ -0,0 +1,84 @@
+include <pkg/mef.h>
+
+# MEF_DUMMYHDR -- Write a dummy Primary header Unit with no data to a new file.
+# Optionaly a header file with user keywords can be used.
+
+procedure mef_dummyhdr (out, hdrfname)
+
+int	out		#I File descriptor
+char	hdrfname[ARB]	#I Header filename
+
+char    card[LEN_CARD]
+pointer sp, path, op
+int	n, nlines, i, nchars, FD
+int	strlen(), open(), getline(), strncmp()
+
+begin
+	call smark(sp)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+
+	n = 0
+	call mef_encodeb ("SIMPLE", YES, card, "FITS STANDARD")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+	call mef_encodei ("BITPIX", 8, card, "Character information")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+	call mef_encodei ("NAXIS", 0, card, "No image data array present")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+	call mef_encodeb ("EXTEND", YES, card,
+	                         "There maybe standard extensions")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+        call mef_encodec ("ORIGIN", FITS_ORIGIN, strlen(FITS_ORIGIN),
+		           card, "FITS file originator")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+        call mef_encode_date (Memc[path], SZ_PATHNAME)
+	call mef_encodec ("DATE", Memc[path], strlen(Memc[path]), 
+			card, "Date FITS file was generated")
+	call mef_pakwr (out, card)
+	n = n + 1
+
+	# Write a header file if one is given
+	if (hdrfname[1] != EOS) {
+	   fd = open (hdrfname, READ_ONLY, TEXT_FILE)
+	   nchars = getline(fd, Memc[path])
+	   repeat {
+	       if ((strncmp (Memc[path], "SIMPLE", 6) == 0) ||
+	           (strncmp (Memc[path], "BITPIX", 6) == 0) ||
+	           (strncmp (Memc[path], "NAXIS",  5) == 0) )
+	            nchars = getline(fd, Memc[path])
+	       for (op=nchars-1; op <= LEN_CARD; op=op+1)
+		   Memc[path+op] = ' '
+	       Memc[path+LEN_CARD] = EOS
+	       call mef_pakwr (out, Memc[path])
+	       n = n + 1
+	       if (n == 36)
+	           n = 0
+	       nchars = getline(fd, Memc[path])
+	   } until (nchars == EOF)
+	   call close (fd)
+	}
+
+        Memc[path] = ' '
+	call amovkc (Memc[path], card, 80)
+	call strcpy ("END", card, 3)
+	card[4] = ' '                           # Clear EOS mark
+	call mef_pakwr (out, card)
+
+	n = n + 1
+
+	call amovkc (" ", card, 80)
+	nlines = 36 - n
+	for (i=1; i<= nlines; i=i+1)
+	   call mef_pakwr (out, card)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/mef/mefencode.x b/pkg/xtools/mef/mefencode.x
new file mode 100644
index 00000000..57b5637d
--- /dev/null
+++ b/pkg/xtools/mef/mefencode.x
@@ -0,0 +1,530 @@
+include <time.h>
+include <pkg/mef.h>
+
+# MEFENCODE -- Routines to encode keyword, value and comment into a FITS card
+
+define  LEN_OBJECT  63
+define  CENTURY     1900
+
+# MEF_ENCODEB -- Procedure to encode a boolean parameter into a FITS card.
+
+procedure mef_encodeb (keyword, param, card, comment)
+
+char	keyword[ARB]	#I FITS keyword
+int	param		#I integer parameter equal to YES/NO
+char	card[ARB]	#O FITS card image
+char	comment[ARB]	#I FITS comment string
+
+char	truth
+
+begin
+	if (param == YES)
+	    truth = 'T'
+	else
+	    truth = 'F'
+
+	call sprintf (card, LEN_CARD, "%-8.8s= %20c / %-47.47s")
+	    call pargstr (keyword)
+	    call pargc (truth)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODEI -- Procedure to encode an integer parameter into a FITS card.
+
+procedure mef_encodei (keyword, param, card, comment)
+
+char	keyword[ARB]	#I FITS keyword
+int	param		#I integer parameter
+char	card[ARB]	#O FITS card image
+char	comment[ARB]	#I FITS comment string
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20d / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (param)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODEL -- Procedure to encode a long parameter into a FITS card.
+
+procedure mef_encodel (keyword, param, card, comment)
+
+char	keyword[ARB]		#I FITS keyword
+long	param			#I long integer parameter
+char	card[ARB]		#O FITS card image
+char	comment[ARB]		#I FITS comment string
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20d / %-47.47s")
+	    call pargstr (keyword)
+	    call pargl (param)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODER -- Procedure to encode a real parameter into a FITS card.
+
+procedure mef_encoder (keyword, param, card, comment, precision)
+
+char	keyword[ARB]		#I FITS keyword
+real	param			#I real parameter
+char	card[ARB]		#O FITS card image
+char	comment[ARB]		#I FITS comment card
+int	precision		#I precision of real
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20.*e / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargr (param)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODED -- Procedure to encode a double parameter into a FITS card.
+
+procedure mef_encoded (keyword, param, card, comment, precision)
+
+char	keyword[ARB]		#I FITS keyword
+double	param			#I double parameter
+char	card[ARB]		#O FITS card image
+char	comment[ARB]		#I FITS comment string
+int	precision		#I FITS precision
+
+begin
+	call sprintf (card, LEN_CARD, "%-8.8s= %20.*e / %-47.47s")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargd (param)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODE_AXIS -- Procedure to add the axis number to axis dependent
+# keywords.
+
+procedure mef_encode_axis (root, keyword, axisno)
+
+char	root[ARB]		#I FITS root keyword
+char	keyword[ARB]		#O FITS keyword
+int	axisno			#I FITS axis number
+
+begin
+	call strcpy (root, keyword, SZ_KEYWORD)
+	call sprintf (keyword, SZ_KEYWORD, "%-5.5s%-3.3s")
+	    call pargstr (root)
+	    call pargi (axisno)
+end
+
+
+# MEF_ENCODEC -- Procedure to encode an IRAF string parameter into a FITS card.
+
+procedure mef_encodec (keyword, param, maxch, card, comment)
+
+char	keyword[LEN_CARD]	#I FITS keyword
+char	param[LEN_CARD]		#I FITS string parameter
+int	maxch			#I maximum number of characters in param
+char	card[LEN_CARD+1]	#O FITS card image
+char	comment[LEN_CARD]	#I comment string
+
+int	nblanks, maxchar, slashp
+
+begin
+	maxchar = max(8, min (maxch, LEN_OBJECT))
+	slashp = 32 
+	nblanks = LEN_CARD - (slashp + 1)
+	if (maxchar >= 19) {
+	   slashp = 1
+	   nblanks = max (LEN_OBJECT - maxchar - slashp+3, 1)
+	}
+        call sprintf (card, LEN_CARD, "%-8.8s= '%*.*s' %*t/ %*.*s")
+	    call pargstr (keyword)
+	    call pargi (-maxchar)
+	    call pargi (maxchar)
+	    call pargstr (param)
+	    call pargi (slashp)
+	    call pargi (-nblanks)
+	    call pargi (nblanks)
+	    call pargstr (comment)
+end
+
+
+# MEF_ENCODE_DATE -- Procedure to encode the date in the form dd/mm/yy.
+
+procedure mef_encode_date (datestr, szdate)
+
+char	datestr[ARB]	# string containing the date
+int	szdate		# number of chars in the date string
+
+long	ctime
+int	time[LEN_TMSTRUCT]
+long	clktime()
+
+begin
+	ctime = clktime (long (0))
+	call brktime (ctime, time)
+
+	call sprintf (datestr, szdate, "%02s/%02s/%02s")
+	    call pargi (TM_MDAY(time))
+	    call pargi (TM_MONTH(time))
+	    call pargi (mod (TM_YEAR(time), CENTURY))
+end
+
+
+# MEF_AKWC -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwc (keyword, value, len, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# keyword name
+char	value[ARB]		# Keyword value
+int	len			# Lenght of value
+char	comment[ARB]		# Comment
+pointer	pn			# Pointer to a char area
+char	card[LEN_CARD]
+
+begin
+	call mef_encodec (keyword, value, len, card, comment)
+	call amovc (card, Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+end
+
+
+# MEF_AKWB -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwb (keyword, value, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+int	value			# I Keyword value (YES, NO)
+char	comment[ARB]		# I Comment
+pointer	pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+        call smark(sp)
+        call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call mef_encodeb (keyword, value, Memc[pc], comment)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree(sp)
+end
+
+
+# MEF_AKWI -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwi (keyword, value, comment, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+int	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+pointer	pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+        call smark(sp)
+        call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call mef_encodei (keyword, value, Memc[pc], comment)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree(sp)
+end
+
+
+# MEF_AKWR -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwr (keyword, value, comment, precision,  pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+real	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+int	precision
+pointer	pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+        call smark(sp)
+        call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call mef_encoder (keyword, value, Memc[pc], comment, precision)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree(sp)
+end
+
+
+# MEF_AKWD -- Encode keyword, value and comment into a FITS card and
+# append it to a buffer pointed by pn.
+ 
+procedure mef_akwd (keyword, value, comment, precision, pn)
+
+char	keyword[SZ_KEYWORD]	# I keyword name
+double	value			# I Keyword value 
+char	comment[ARB]		# I Comment
+int	precision
+pointer	pn			# I/O Pointer to a char area
+
+pointer sp, pc
+
+begin
+        call smark(sp)
+        call salloc (pc, LEN_CARD, TY_CHAR)
+
+	call mef_encoded (keyword, value, Memc[pc], comment, precision)
+	call amovc (Memc[pc], Memc[pn], LEN_CARD)
+	pn = pn + LEN_CARD
+
+	call sfree(sp)
+end
+
+
+# NOTE: This local version of the xtools routine call handle starting
+# index of zero (0). Taken from dataio/lib and modified. NZ March, 98
+#
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+
+define	FIRST	1		# Default starting range
+define	LAST	MAX_INT		# Default ending range
+define	STEP	1		# Default step
+define	NULL	-1		# Ranges delimiter
+
+# DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas.  Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers.  ERR is returned as
+# the function value if a conversion error occurs.  The list of ranges is
+# delimited by a single NULL.
+
+int procedure ldecode_ranges (range_string, ranges, max_ranges, nvalues)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	nvalues			# The number of values in the ranges
+
+int	ip, nrange, first, last, step, ctoi()
+
+begin
+	ip = 1
+	nvalues = 0
+
+	do nrange = 1, max_ranges - 1 {
+	    # Defaults to all positive integers
+	    first = FIRST
+	    last = LAST
+	    step = STEP
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get first limit.
+	    # Must be a number, '-', 'x', or EOS.  If not return ERR.
+	    if (range_string[ip] == EOS) {			# end of list
+		if (nrange == 1) {
+		    # Null string defaults
+		    ranges[1, 1] = first
+		    ranges[2, 1] = last
+		    ranges[3, 1] = step
+		    ranges[1, 2] = NULL
+	    	    nvalues = nvalues + abs (last-first) / step + 1
+		    return (OK)
+		} else {
+		    ranges[1, nrange] = NULL
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, first) == 0)
+		    return (ERR)
+	    } else
+		return (ERR)
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get last limit
+	    # Must be '-', or 'x' otherwise last = first.
+	    if (range_string[ip] == 'x')
+		;
+	    else if (range_string[ip] == '-') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, last) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		last = first
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get step.
+	    # Must be 'x' or assume default step.
+	    if (range_string[ip] == 'x') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, step) == 0)
+		        ;
+		} else if (range_string[ip] == '-')
+		    ;
+		else
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    ranges[1, nrange] = first
+	    ranges[2, nrange] = last
+	    ranges[3, nrange] = step
+	    nvalues = nvalues + abs (last-first) / step + 1
+	}
+
+	return (ERR)					# ran out of space
+end
+
+
+# GET_NEXT_NUMBER -- Given a list of ranges and the current file number,
+# find and return the next file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically increasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure lget_next_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number+1 is anywhere in the list, that is the next number,
+	# otherwise the next number is the smallest number in the list which
+	# is greater than number+1.
+
+	number = number + 1
+	next_number = MAX_INT
+
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder + step <= last)
+		    next_number = number - remainder + step
+	    } else if (first > number)
+		next_number = min (next_number, first)
+	}
+
+	if (next_number == MAX_INT)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# GET_PREVIOUS_NUMBER -- Given a list of ranges and the current file number,
+# find and return the previous file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically decreasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure lget_previous_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number-1 is anywhere in the list, that is the previous number,
+	# otherwise the previous number is the largest number in the list which
+	# is less than number-1.
+
+	number = number - 1
+	next_number = 0
+
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder >= first)
+		    next_number = number - remainder
+	    } else if (last < number) {
+		remainder = mod (last - first, step)
+		if (remainder == 0)
+		    next_number = max (next_number, last)
+		else if (last - remainder >= first)
+		    next_number = max (next_number, last - remainder)
+	    }
+	}
+
+	if (next_number == 0)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# IS_IN_RANGE -- Test number to see if it is in range.
+
+bool procedure lis_in_range (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Number to be tested against ranges
+
+int	ip, first, last, step
+
+begin
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last)
+		if (mod (number - first, step) == 0)
+		    return (true)
+	}
+
+	return (false)
+end
diff --git a/pkg/xtools/mef/mefget.x b/pkg/xtools/mef/mefget.x
new file mode 100644
index 00000000..4860c99e
--- /dev/null
+++ b/pkg/xtools/mef/mefget.x
@@ -0,0 +1,183 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<pkg/mef.h>
+
+# MEFGETB -- Get an image header parameter of type boolean.  False is returned
+# if the parameter cannot be found or if the value is not true.
+
+bool procedure mefgetb (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+pointer	sp, kv, line
+int	strlen()
+bool    bval
+
+errchk mef_findkw
+
+begin
+	call smark (sp)
+	call salloc (kv, LEN_CARD, TY_CHAR)
+	call salloc (line, LEN_CARD, TY_CHAR)
+	
+	call mef_findkw (MEF_HDRP(mef), key, Memc[kv])
+	if (strlen(Memc[kv]) != 1) {
+	    call sprintf(Memc[line], LEN_CARD, "Invalid boolean value: '%s'")
+		 call pargstr (Memc[kv])
+	    call error (0,Memc[line]) 
+	}else
+	    bval = Memc[kv] == 'T'
+
+	call sfree (sp)
+	return (bval)
+end
+
+
+# MEFGETC -- Get an image header parameter of type char.
+
+char procedure mefgetc (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+long	mefgetl()
+
+begin
+	return (mefgetl (mef, key))
+end
+
+
+# MEFGETD -- Get an image header parameter of type double floating.  If the
+# named parameter is a standard parameter return the value directly,
+# else scan the user area for the named parameter and decode the value.
+
+double procedure mefgetd (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+int	ip
+double	dval
+pointer	sp, sval
+int	ctod()
+errchk	syserrs, mefgstr
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_LINE, TY_CHAR)
+
+	ip = 1
+	call mefgstr (mef, key, Memc[sval], SZ_LINE)
+	if(Memc[sval]==EOS)
+	    call syserrs (SYS_IDBKEYNF, key)
+	if (ctod (Memc[sval], ip, dval) == 0)
+	    call syserrs (SYS_IDBTYPE, key)
+
+	call sfree (sp)
+	return (dval)
+end
+
+
+# MEFGETI -- Get an image header parameter of type integer.
+
+int procedure mefgeti (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+long	lval, mefgetl()
+errchk	mefgetl
+
+begin
+	lval = mefgetl (mef, key)
+	if (IS_INDEFL(lval))
+	    return (INDEFI)
+	else
+	    return (lval)
+end
+
+
+# MEFGETL -- Get an image header parameter of type long integer.
+
+long procedure mefgetl (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+double	dval, mefgetd()
+errchk	mefgetd
+
+begin
+	dval = mefgetd (mef, key)
+	if (IS_INDEFD(dval))
+	    return (INDEFL)
+	else
+	    return (nint (dval))
+end
+
+
+# MEFGETR -- Get an image header parameter of type real.
+
+real procedure mefgetr (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+double	dval, mefgetd()
+errchk	mefgetd
+
+begin
+	dval = mefgetd (mef, key)
+	if (IS_INDEFD(dval))
+	    return (INDEFR)
+	else
+	    return (dval)
+end
+
+
+# MEFGETS -- Get an image header parameter of type short integer.
+
+short procedure mefgets (mef, key)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+
+long	lval, mefgetl()
+errchk	mefgetl
+
+begin
+	lval = mefgetl (mef, key)
+	if (IS_INDEFL(lval))
+	    return (INDEFS)
+	else
+	    return (lval)
+end
+
+
+# MEFGSTR -- Get an image header parameter of type string.  If the named
+# parameter is a standard parameter return the value directly, else scan
+# the user area for the named parameter and decode the value.
+
+procedure mefgstr (mef, key, outstr, maxch)
+
+pointer	mef			# image descriptor
+char	key[ARB]		# parameter to be returned
+char	outstr[ARB]		# output string to receive parameter value
+int	maxch
+
+pointer	sp, kv
+
+begin
+	call smark (sp)
+	call salloc (kv, LEN_CARD, TY_CHAR)
+
+	# Find the record.
+	iferr (call mef_findkw (MEF_HDRP(mef), key, Memc[kv]))
+	    Memc[kv] = EOS
+
+	call strcpy (Memc[kv], outstr, min (maxch, LEN_CARD))
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/mef/mefgnbc.x b/pkg/xtools/mef/mefgnbc.x
new file mode 100644
index 00000000..2d370893
--- /dev/null
+++ b/pkg/xtools/mef/mefgnbc.x
@@ -0,0 +1,55 @@
+include <pkg/mef.h>
+
+# MEF_GNBC -- Get the Number of Blank Cards in a FITS header pointed by
+# mef. This is the number of cards available to insert before an expantion by
+# one block is required. If the header has not being read and EOF (-2) is
+# returned.
+
+int procedure mef_gnbc (mef)
+
+pointer mef
+
+int	len, hd, ip, nbc, hsize, k, ncards
+int	strlen(), strncmp()
+
+begin
+	if (MEF_HDRP(mef) == NULL)
+	    return (EOF)
+	    
+	hd = MEF_HDRP(mef)
+	len = strlen(Memc[hd])
+
+	# Go to the end of buffer and get last line
+
+	ip = hd + MEF_HSIZE(mef) - LEN_CARDNL
+	
+	# See if line is blank
+
+	nbc = 0
+	while (ip > 0) {
+	    do k = 0, LEN_CARD-1 
+		if (Memc[ip+k] != ' ')
+		    break
+
+	    if (k != LEN_CARD && k != 0)   # blank keyw card
+		break
+	    else if (k == 0) {
+		if (strncmp ("END     ", Memc[ip], 8) == 0) {
+	    	    ip = ip - LEN_CARDNL
+		    next
+		} else
+		    break
+	    } else
+		nbc = nbc + 1
+	    ip = ip - LEN_CARDNL
+	}
+
+	hsize = MEF_HSIZE(mef)
+	ncards = (hsize + 80)/81
+	
+	ncards = ((ncards + 35)/36)*36 - ncards
+	nbc = nbc + ncards
+
+	return (nbc)
+end
+
diff --git a/pkg/xtools/mef/mefgval.x b/pkg/xtools/mef/mefgval.x
new file mode 100644
index 00000000..aa481a2a
--- /dev/null
+++ b/pkg/xtools/mef/mefgval.x
@@ -0,0 +1,182 @@
+include	<ctype.h>
+include <pkg/mef.h>
+
+
+# MEFGVAL.X -- Set of routines to decode the value  of a FITS keyword given
+# the whole card.
+
+
+# MEF_GVALI -- Return the integer value of a FITS encoded card.
+
+procedure mef_gvali (card, ival)
+
+char	card[ARB]		#I card to be decoded
+int	ival			#O receives integer value
+
+int	ip, ctoi()
+char	sval[MEF_SZVALSTR]
+
+begin
+	call mef_gvalt (card, sval, MEF_SZVALSTR)
+	ip = 1
+	if (ctoi (sval, ip, ival) <= 0)
+	    ival = 0
+end
+
+
+# MEF_GVALR -- Return the real value of a FITS encoded card.
+
+procedure mef_gvalr (card, rval)
+
+char	card[ARB]		#I card to be decoded
+real	rval			#O receives integer value
+
+int	ip, ctor()
+char	sval[MEF_SZVALSTR]
+
+begin
+	call mef_gvalt (card, sval, MEF_SZVALSTR)
+	ip = 1
+	if (ctor (sval, ip, rval) <= 0)
+	    rval = 0.0
+end
+
+
+# MEF_GVALD -- Return the double value of a FITS encoded card.
+
+procedure mef_gvald (card, dval)
+
+char	card[ARB]		#I card to be decoded
+double	dval			#O receives integer value
+
+int	ip, ctod()
+char	sval[MEF_SZVALSTR]
+
+begin
+	call mef_gvalt (card, sval, MEF_SZVALSTR)
+	ip = 1
+	if (ctod (sval, ip, dval) <= 0)
+	    dval = 0.0
+end
+
+
+# MEF_GVALB -- Return the boolean/integer value of a FITS encoded card.
+
+procedure mef_gvalb (card, bval)
+
+char	card[ARB]		#I card to be decoded
+int	bval			#O receives YES/NO
+
+char	sval[MEF_SZVALSTR]
+
+begin
+	call mef_gvalt (card, sval, MEF_SZVALSTR)
+	if (sval[1] == 'T')
+	    bval = YES
+	else
+	    bval = NO
+end
+
+
+# MEF_GVALT -- Get the string value of a FITS encoded card.  Strip leading
+# and trailing whitespace and any quotes.
+
+procedure mef_gvalt (card, outstr, maxch)
+
+char	card[ARB]		#I FITS card to be decoded
+char	outstr[ARB]		#O output string to receive parameter value
+int	maxch			#I length of outstr
+
+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
+
+
+# MEF_GETCMT -- Get the comment field of a FITS encoded card.
+
+procedure mef_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
+
+
+# MEF_GLTM -- Procedure to convert an input time stream with hh:mm:ss
+#	     and date stream dd/mm/yy into seconds from jan 1st 1980.
+
+procedure mef_gltm (time, date, limtime)
+
+char    time[ARB]	#I time
+char	date[ARB]	#I date
+int	limtime		#O seconds
+
+int     hr,mn,sec,days,month,year, ip, iy, days_per_year, ctoi(),i
+int	month_to_days[12], adays
+
+data    month_to_days / 0,31,59,90,120,151,181,212,243,273,304,334/
+
+begin
+	ip = 1
+	ip = ctoi (time, ip, hr)
+	ip = 1 
+	ip = ctoi (time[4], ip, mn)
+	ip = 1 
+	ip = ctoi (time[7], ip, sec)
+
+	sec = sec + mn * 60 + hr * 3600
+
+	ip = 1
+	ip = ctoi (date, ip, days)
+	ip = 1 
+	ip = ctoi (date[4], ip, month)
+	ip = 1 
+	ip = ctoi (date[7], ip, year)
+
+	days_per_year = 0
+
+	iy = year + 1900
+	do i = 1, iy - 1980
+	    days_per_year = days_per_year + 365
+
+	adays= (year-80)/4
+	if (month > 2) adays=adays+1
+
+	days = adays + days-1 + days_per_year + month_to_days[month]
+
+	limtime = sec + days * 86400
+end
diff --git a/pkg/xtools/mef/mefkfind.x b/pkg/xtools/mef/mefkfind.x
new file mode 100644
index 00000000..bfcf393b
--- /dev/null
+++ b/pkg/xtools/mef/mefkfind.x
@@ -0,0 +1,75 @@
+include <syserr.h>
+include <pkg/mef.h>
+
+# MEF_FINDKW -- Search the header database for a particular keyword
+# and get its value. An error is returned if the keyword is not found.
+
+procedure mef_findkw (hdrp, key, keywval)
+
+pointer	hdrp			#I pointer to header buffer 
+char	key[ARB]		#I Keyword name
+char	keywval[ARB]		#O string value
+
+pointer	sp, ukey, lkey, ip
+int	nchars, lch, uch, ch, i
+int	gstrcpy()
+
+errchk  syserrs
+
+begin
+	call smark (sp)
+	call salloc (ukey, SZ_KEYWORD, TY_CHAR)
+	call salloc (lkey, SZ_KEYWORD, TY_CHAR)
+
+	# Prepare U/L FITS keywords, truncated to 8 chars.
+	nchars = gstrcpy (key, Memc[lkey], SZ_KEYWORD)
+	call strlwr (Memc[lkey])
+	nchars = gstrcpy (key, Memc[ukey], SZ_KEYWORD)
+	call strupr (Memc[ukey])
+
+	# Search for the FIRST occurrence of a record with the given key.
+
+	# Fixed length (80 character), newline terminated records, EOS
+	# terminated record group.
+
+	# Simple fast search, fixed length records.  Case insensitive
+	# keyword match.
+
+	lch = Memc[lkey]
+	uch = Memc[ukey]
+
+	for (ip=hdrp;  Memc[ip] != EOS;  ip=ip+LEN_CARDNL) {
+	    ch = Memc[ip]
+	    if (ch == EOS)
+		break
+	    else if (ch != lch && ch != uch)
+		next
+	    else {
+		# Abbreviations are not permitted.
+		ch = Memc[ip+nchars]
+		if (ch != ' ' && ch != '=')
+		  next
+	    }
+
+	    # First char matches; check rest of string.
+	    do i = 1, nchars-1 {
+		ch = Memc[ip+i]
+		if (ch != Memc[lkey+i] && ch != Memc[ukey+i]) {
+		    ch = 0
+		    break
+		}
+	    }
+
+	    if (ch != 0) {
+		#Copy card starting at ip
+		call mef_gvalt (Memc[ip], keywval, MEF_SZVALSTR)
+		call sfree (sp)
+		return
+	    }
+	}
+
+	# Keyword not found
+	call syserrs (SYS_IDBKEYNF, key)
+
+	call sfree (sp)
+end
diff --git a/pkg/xtools/mef/mefksection.x b/pkg/xtools/mef/mefksection.x
new file mode 100644
index 00000000..e6a44b7b
--- /dev/null
+++ b/pkg/xtools/mef/mefksection.x
@@ -0,0 +1,174 @@
+include <ctotok.h>
+include <lexnum.h>
+include <pkg/mef.h>
+
+define	KS_EXTNAME	1
+define	KS_EXTVER	2
+
+# MEF_KSECTION -- Procedure to parse and analyze a string of the form
+#
+#  "(extname=)name,(extver=)23"
+#
+#   The numeric field is position depend if it does not have 'extver'.
+
+procedure mef_ksection (ksection, extname, extver)
+
+char 	ksection[ARB]	#I String with kernel section
+char	extname[ARB]	#O Extname
+int	extver		#O Extver
+
+int     ctotok(),ip, jp, nident, nexpr
+int	junk, nch, lexnum(), ty, token, ival
+char    outstr[LEN_CARD]
+char 	identif[LEN_CARD]
+int	lex_type, mef_klex(), ctoi()
+ 
+begin
+	
+        extname[1] = EOS
+        extver = INDEFL
+	ip = 1
+	nident = 0
+	nexpr = 0
+	identif[1] = EOS
+
+	repeat {
+	    # Advance to the next keyword.
+	    token = ctotok (ksection, ip, outstr, LEN_CARD)
+
+	    switch (token) {
+	    case TOK_EOS:
+		break
+	    case TOK_NEWLINE:
+		break
+	    case TOK_NUMBER:
+	       if (nexpr != 1)
+		  call error(13,
+		  "Numeric value only allow as second term in ksection")
+	       jp = 1
+	       ty = lexnum (outstr, jp, nch)
+	       if (ty != LEX_DECIMAL)
+		  call error(13, "Number is not decimal")
+	       jp = 1
+	       junk = ctoi(outstr, jp, ival)
+	       extver = ival
+	       nexpr = nexpr + 1
+	    case TOK_PUNCTUATION:
+		if (outstr[1] == ',' && identif[1] == EOS)
+		   call error(13,"syntax error in kernel section")
+	    case TOK_STRING:
+	       if (nexpr != 0)
+		  call error(13,
+		   "String value only allow as first term in ksection")
+
+		call strcpy (outstr, extname, LEN_CARD)
+	       nexpr = nexpr + 1
+	    case TOK_IDENTIFIER:
+		nident = nident + 1
+		call strcpy(outstr, identif, LEN_CARD] 
+		call strlwr(outstr)
+		lex_type = mef_klex (outstr)
+		# See if it is a reserved keyword.
+		jp = ip
+		# look for =, + or -
+	        if (lex_type > 0) {
+	            # Now see if of the type lex=<value> or lex+/-
+		    if (ctotok (ksection, ip, outstr, LEN_CARD) == 
+						TOK_OPERATOR) {
+		        if (outstr[1] == '=' ) {
+		            token = ctotok (ksection, ip, outstr, LEN_CARD)
+		            if (token != TOK_IDENTIFIER &&
+				token != TOK_STRING &&
+			        token != TOK_NUMBER)
+			           call error(13,
+				   "syntax error in kernel section")
+		             else
+		                 call mef_kvalue(outstr, lex_type, 
+					   extname, extver)
+	                } else
+		            ip = jp
+	            }
+	        } else {
+	            if (nexpr == 0)
+		        call strcpy (identif, extname, LEN_CARD)
+	            else {
+		        call error(13,
+		           "String value only allow as first term in ksection")
+	            }
+	        }
+		nexpr = nexpr + 1
+	    default:
+	        call error (13, "Syntax error in ksection")
+	    }
+	}	   
+end
+
+
+# MEF_KLEX -- Returns the lexival value of a parameter in string.
+
+int procedure mef_klex (outstr)
+
+char    outstr[ARB]	#I string
+
+int	len, strlen(), strncmp()
+char	tmp[LEN_CARD]
+
+begin
+	len = strlen(outstr)
+	# See if it is extname or extversion
+	if (strncmp (outstr, "ext", 3) == 0 && len < 8 ) {
+	   if (len == 3)
+	      call error(13, "'ext' is ambiguous in ksection")
+	   call strcpy ("name", tmp, 4)
+	   if (strncmp(outstr[4], tmp, len-3) == 0)
+	      return (KS_EXTNAME)
+	   else {
+	      call strcpy ("ver", tmp, 3)
+	      if (strncmp(outstr[4], tmp, len-3) == 0)
+		 return (KS_EXTVER)
+	   }
+	}
+
+	return (0)	# Is a value
+
+end
+
+
+define	ERROR   -2
+# MEF_KVALUE -- Get the value from a string of extname and extver.
+
+procedure mef_kvalue(outstr, lex_type, extname, extver)
+
+char	outstr[ARB]	#I Input string
+int	lex_type	#I Type of value
+char    extname[ARB]	#O Extname
+int	extver		#O Extver
+
+int	ty, lexnum(), ip, ival, ctoi(), nch, junk
+int	strcmp()
+
+begin
+	call strlwr(outstr)
+	if (strcmp (outstr, "yes") == 0)
+	   ival = YES
+	else if (strcmp (outstr, "no") == 0)
+	   ival = NO
+	else
+	   ival = ERROR
+
+	switch (lex_type) {
+	case  KS_EXTNAME:
+	   call strcpy (outstr, extname, LEN_CARD)
+	case  KS_EXTVER:
+	   ip = 1
+	   ty = lexnum (outstr, ip, nch)
+	   if (ty != LEX_DECIMAL)
+	      call error(13, "Number is not a decimal")
+	   ip = 1
+	   junk = ctoi(outstr, ip, ival)
+	   extver = ival
+	default:
+	     call error(13, "Syntax error in ksection")
+
+	}
+end
diff --git a/pkg/xtools/mef/mefldhdr.x b/pkg/xtools/mef/mefldhdr.x
new file mode 100644
index 00000000..c13d7802
--- /dev/null
+++ b/pkg/xtools/mef/mefldhdr.x
@@ -0,0 +1,118 @@
+include <error.h>
+include <mach.h>
+include <ctype.h>
+include <mii.h>
+include <pkg/mef.h>
+
+# MEF_LOAD_HEADER -- Load a FITS header from a file descriptor into a
+# spool file.
+
+int procedure mef_load_header (mef, spool, group)
+
+pointer mef			#I FITS descriptor
+int	spool			#I spool output file descriptor
+int	group			#I Currrent group
+
+pointer lbuf, sp, fb
+int	nchars, index, ncards, pcount, in
+int	mef_read_card(), mef_kctype()
+int	note()
+
+errchk  mef_read_card
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (fb, FITS_BLOCK_BYTES, TY_CHAR)
+
+	MEF_EXTNAME(mef) = EOS
+	MEF_EXTVER(mef) = INDEFL
+
+	in = MEF_FD(mef)
+	MEF_HOFF(mef) = note(in)
+
+	# Read successive lines of the FITS header. 
+	pcount = 0
+	ncards = 0
+	repeat {
+	    # Get the next input line.
+	    nchars = mef_read_card (in, Memc[fb], Memc[lbuf], ncards)
+	    if (nchars == EOF) {
+		call close (spool)
+		return (EOF)
+            }
+	    ncards = ncards + 1
+	    # A FITS header card already has 80 chars, just add the newline.
+	    Memc[lbuf+LEN_CARD] = '\n'
+	    Memc[lbuf+LEN_CARD+1] = EOS
+	    call putline (spool, Memc[lbuf])
+
+	    # Process the header card.
+	    switch (mef_kctype (Memc[lbuf], index)) {
+	    case END:
+		MEF_HSIZE(mef) = ncards*LEN_CARDNL
+		break
+	    case SIMPLE:
+		call strcpy ("SIMPLE", MEF_EXTTYPE(mef), SZ_EXTTYPE)
+	    case XTENSION:
+		call mef_gvalt (Memc[lbuf], MEF_EXTTYPE(mef), SZ_EXTTYPE)
+	    case EXTNAME:
+		call mef_gvalt (Memc[lbuf], MEF_EXTNAME(mef), LEN_CARD)
+	    case EXTVER:
+		call mef_gvali (Memc[lbuf], MEF_EXTVER(mef))
+	    case PCOUNT:
+		call mef_gvali (Memc[lbuf], pcount)
+		MEF_PCOUNT(mef) = pcount
+	    case BITPIX:
+		call mef_gvali (Memc[lbuf], MEF_BITPIX(mef))
+	    case NAXIS:
+		call mef_gvali (Memc[lbuf], MEF_NDIM(mef))
+	    case NAXISN:
+		 call mef_gvali (Memc[lbuf], MEF_NAXIS(mef,index))
+	    case OBJECT:
+		call mef_gvalt (Memc[lbuf], MEF_OBJECT(mef), MEF_SZVALSTR)
+	    default:
+		if (ncards == 1) {
+		    call sprintf(Memc[lbuf], SZ_LINE,
+		    "Header does not start with SIMPLE nor XTENSION: %s[%d]")
+		       call pargstr(MEF_FNAME(mef))
+		       call pargi(group)
+		    call error (13, Memc[lbuf])	
+		}
+	    }
+	}
+
+	call sfree (sp)
+	return (OK)
+end
+
+
+# MEF_GET_CARD -- Read a FITS header card.
+
+int procedure mef_read_card (fd, ibuf, obuf, ncards)
+
+int	fd			#I Input file descriptor
+char	ibuf[ARB]		#I input buffer
+char    obuf[ARB]		#O Output buffer
+int	ncards			#I ncards read so far
+
+int	ip, nchars_read
+int	read()
+errchk	read
+
+begin
+	# We read one FITS block first, read card from it until 36
+	# cards have been processed, where we read again.
+
+	if (mod (ncards, 36) == 0) {
+	    nchars_read = read (fd, ibuf, FITS_BLKSZ_CHAR)
+	    if (nchars_read ==  EOF)
+	        return (EOF)
+	    call miiupk (ibuf, ibuf, FITS_BLOCK_BYTES, MII_BYTE, TY_CHAR)
+	    ip = 1
+	}
+	
+	call amovc (ibuf[ip], obuf, LEN_CARD)
+	ip = ip + LEN_CARD
+
+	return (LEN_CARD)
+end
diff --git a/pkg/xtools/mef/mefopen.x b/pkg/xtools/mef/mefopen.x
new file mode 100644
index 00000000..a7a6529d
--- /dev/null
+++ b/pkg/xtools/mef/mefopen.x
@@ -0,0 +1,93 @@
+include <pkg/mef.h>
+
+# MEFOPEN --- Open a FITS extension, it can be the Primary or extension
+#	      unit, file.fits[0] for the PU or file.fits[extn] for the
+#	      Extension Unit.
+#
+#	filename.ext[abs#][extname,extver]
+#
+#	The absolute extension number (abs#) convention is zero for
+#	the Primary Unit.
+#
+
+
+# MEF_OPEN -- Open a FITS Unit from a file and returns its characteristics.
+
+pointer procedure mef_open (fitsfile, acmode, oldp)
+
+char	fitsfile[ARB]	#I Input FITS filename
+int	acmode		#I access mode
+pointer	oldp		#I Old Fits pointer or header size
+
+pointer	sp, ksec, section, mef
+int	group, clsize, open()
+
+begin
+        call smark (sp)
+	call salloc (ksec, LEN_CARD, TY_CHAR)
+	call salloc (section, LEN_CARD, TY_CHAR)
+
+	call calloc (mef, LEN_MEF, TY_STRUCT)
+
+	MEF_ACMODE(mef) = acmode
+
+	# Get filename components
+	call imparse (fitsfile, MEF_FNAME(mef), SZ_FNAME, Memc[ksec],
+		     LEN_CARD, Memc[section], LEN_CARD, group, clsize)
+
+	# Check if file has an extension and exists.
+	call mef_file_access (MEF_FNAME(mef), acmode)
+
+	if (Memc[section] != EOS) 
+	   call error(13, "mefopen: Image sections not allowed")
+
+	MEF_FD(mef) = open (MEF_FNAME(mef), acmode, BINARY_FILE)
+	MEF_ENUMBER(mef) = group
+	MEF_CGROUP(mef) = -1
+	MEF_KEEPXT(mef) = NO
+
+	call sfree (sp)
+	return(mef)
+end
+
+
+# MEF_FILE_ACCESS -- Check that file exists if READ* mode is given. Mainly we
+# want to check if there is an extension 'fits'. If file was given with no
+# extension, append .fits and see if exists.
+
+procedure mef_file_access (fname, acmode)
+
+char	fname[ARB]
+int	acmode
+
+pointer sp, fext, fn
+int	len, fnextn(), access(), strncmp()
+begin
+	if (acmode == NEW_FILE || acmode == NEW_COPY)
+	    return
+
+	call smark (sp)
+	call salloc (fext, SZ_FNAME, TY_CHAR)
+	call salloc (fn, SZ_FNAME, TY_CHAR)
+
+	call strcpy (fname, Memc[fn], SZ_FNAME)
+
+	len = fnextn (Memc[fn], Memc[fext], SZ_FNAME)
+
+	if (strncmp("fits", Memc[fext], 4) == 0)
+	    return
+
+	# See if file exists with no extension
+	if (access(fname, 0, 0) == YES)
+	    return
+	else {
+	    call strcat( ".fits", Memc[fn], SZ_FNAME)
+	    if (access(Memc[fn], 0, 0) == YES) {
+		call strcpy (Memc[fn], fname, SZ_FNAME)
+		return
+	    }
+	}
+
+	call sfree(sp)
+
+end
diff --git a/pkg/xtools/mef/mefrdhdr.x b/pkg/xtools/mef/mefrdhdr.x
new file mode 100644
index 00000000..a8ac45e8
--- /dev/null
+++ b/pkg/xtools/mef/mefrdhdr.x
@@ -0,0 +1,397 @@
+include <error.h>
+include <mach.h>
+include <ctype.h> 
+include <fset.h>
+include <pkg/mef.h>
+
+# MEFRDHR.X -- Routines to read FITS header units.
+#
+#     eof|stat = mef_rdhdr (mef, group, extname, extver)
+# 	         mef_skip_data_unit (mef)
+#	totpix = mef_totpix (mef)
+#     eof|stat = mef_rdhdr_gn (mef,gn)
+#     eof|stat = mef_rdhdr_exnv (mef,extname, extver)
+
+
+# MEF_RDHR -- Read FITS header on a mef file that matches EXTNAME/EXTVER or 
+# GROUP number. If both are specified, the former takes procedence.
+
+int procedure mef_rdhdr (mef, group, extname, extver)
+
+pointer	mef		#I Mef descriptor
+int	group 		#I Group number to read
+char    extname[ARB]    #I Extname to read		
+int	extver		#I Extver to read
+
+int	open(),in, cur_extn, note(), gnum
+int	spool
+bool	extnv, read_next_group
+int	mef_load_header(), mef_pixtype()
+bool    mef_cmp_extnv
+errchk	open, read, mef_load_header
+
+begin
+	if (group == MEF_CGROUP(mef))
+	    return (group)
+
+	gnum = group
+	if (MEF_FD(mef) == NULL) {
+	    MEF_FD(mef) = open (MEF_FNAME(mef), READ_ONLY, BINARY_FILE)
+	    MEF_ENUMBER(mef) = -1 
+	    MEF_CGROUP(mef) = -1 
+	} 
+	MEF_SKDATA(mef) = NO  
+
+	in = MEF_FD(mef)
+
+	extnv = extname[1] != EOS || extver != INDEFL
+	spool = open ("spool", NEW_FILE, SPOOL_FILE)
+
+	if (gnum == -1 || extnv)
+	    gnum = 0
+	   
+	cur_extn = MEF_CGROUP(mef)
+	read_next_group = true
+
+	repeat {
+	   # If we need to read the next group
+	   if (read_next_group) {
+
+	       cur_extn = cur_extn+1
+
+	       # See if this extension contains the correct 
+	       # extname/extver values.
+
+	       call fseti (spool, F_CANCEL, YES)
+	       if (mef_load_header (mef, spool, cur_extn) == EOF) {
+		   call close (spool)
+		   return (EOF)
+	       }			
+
+	       # We read the header already, marked the spot.
+	       MEF_POFF(mef) = note(in)
+
+	       if (extnv) {
+		   read_next_group = mef_cmp_extnv (mef, extname, extver)
+	       } else {
+		   if (gnum == cur_extn) 
+		       read_next_group = false
+	       }
+	       call mef_skip_data_unit (mef)
+	       next
+
+	   } else {			# This is the group we want
+	       if (MEF_HDRP(mef) != NULL)
+		   call mfree (MEF_HDRP(mef), TY_CHAR)
+
+	       call mef_cp_spool (spool, mef)
+	       MEF_CGROUP(mef) = cur_extn
+
+	       # To indicate that data has been skipped.
+	       MEF_SKDATA(mef) = YES  
+	       break
+	   }
+	}
+	call close (spool)
+	MEF_DATATYPE(mef) = mef_pixtype(mef)
+	return (cur_extn)
+end
+
+int procedure mef_pixtype (mef)
+pointer mef, hdrp
+bool    bfloat, lscale, lzero
+bool    fxf_fpl_equald()
+int	i, impixtype, ctod(), ip
+double  bscale, bzero
+char    sval[LEN_CARD]
+
+begin
+        hdrp= MEF_HDRP(mef)
+	bscale = 1.0d0
+	ip=1
+	ifnoerr (call mef_findkw (hdrp, "BSCALE", sval))
+	     i = ctod(sval,ip,bscale)
+	bzero = 0.0d0
+	ip=1
+	ifnoerr (call mef_findkw (hdrp, "BZERO", sval))
+	     i = ctod(sval,ip,bzero)
+
+	lscale = fxf_fpl_equald (1.0d0, bscale, 1)
+	lzero =  fxf_fpl_equald (0.0d0, bzero, 1)
+
+	# Determine if scaling is necessary.
+	bfloat = (!lscale || !lzero)
+
+	switch (MEF_BITPIX(mef)) {
+	case  8:
+	    if (bfloat)
+		impixtype = TY_REAL
+	    else
+		impixtype = TY_SHORT              # convert from byte to short
+	case 16:
+	    if (bfloat) {
+		impixtype = TY_REAL
+	    } else
+		impixtype = TY_SHORT
+
+	    if (lscale && fxf_fpl_equald (32768.0d0, bzero, 4)) {
+		impixtype = TY_USHORT
+	    }
+	case 32:
+	    if (bfloat)
+		impixtype = TY_REAL
+	    else
+		impixtype = TY_INT
+	case -32:
+	    impixtype = TY_REAL
+	case -64:
+	    impixtype = TY_DOUBLE
+	default:
+	    impixtype = ERR
+	}
+
+	return(impixtype)
+
+end
+
+# MEF_CMP_EXTNV -- Compare the EXTNAME and EXTVER header values with the
+#		  ones passed as arguments. Return false if matched.
+
+bool procedure mef_cmp_extnv (mef, extname, extver)
+pointer	mef
+char	extname[ARB] 	#I extname value
+int	extver		#I extver value
+
+int	mef_strcmp_lwr()
+bool	bxtn, bxtv, bval, bxtn_eq, bxtv_eq
+
+begin
+	bxtn = extname[1] != EOS
+	bxtv = extver != INDEFL
+
+	if (bxtn)
+	    bxtn_eq = (mef_strcmp_lwr(MEF_EXTNAME(mef), extname) == 0)
+	if (bxtv)
+	    bxtv_eq = (MEF_EXTVER(mef) == extver)
+	
+	if (bxtn && bxtv)
+	    # Both EXTNAME and EXTVER are defined.
+	    bval = bxtn_eq && bxtv_eq
+	else if (bxtn && !bxtv)
+	    # Only EXTNAME is defined.
+	    bval = bxtn_eq
+	else if (!bxtn && bxtv)
+	    # Only EXTVER is defined.
+	    bval = bxtv_eq 
+	else
+	    bval = false
+
+	return (!bval)
+end
+
+# MEF_SKIP_DATA_UNIT -- Skip data unit. The file is already position at the
+# end of the last header block.
+
+procedure mef_skip_data_unit (mef)
+
+pointer	mef	#I Input mef descriptor
+
+int	in, ndim, off, note(), mef_totpix()
+errchk  seek
+
+begin
+	# See if data portion has already been skipped.
+	if (MEF_SKDATA(mef) == YES)
+	    return
+
+	in = MEF_FD(mef)
+	ndim = MEF_NDIM (mef)
+        if (ndim > 0 || MEF_PCOUNT(mef) > 0) {
+	   # Skip to the beginning of next extension
+	   off = note(in)
+	   if (off == EOF)
+	      return
+	   off = off + mef_totpix(mef)
+	   call seek (in, off)
+	}
+end
+
+
+# MEF_TOTPIX -- Returns the number of pixels in the data area in units
+#		of chars.
+
+int procedure mef_totpix (mef)
+
+pointer	mef		#I Mef descriptor
+
+int	ndim, totpix, i, bitpix
+
+begin
+	ndim = MEF_NDIM (mef)
+	if (ndim == 0 && MEF_PCOUNT(mef) <= 0)
+	    return (0)
+
+	if (ndim == 0)
+	    totpix = 0
+	else {
+	    totpix = MEF_NAXIS(mef,1) 
+	    do i = 2, ndim
+		  totpix = totpix *  MEF_NAXIS(mef,i)
+	}
+	bitpix = abs(MEF_BITPIX(mef))
+
+	# If PCOUNT is not zero, add it to totpix
+	totpix = MEF_PCOUNT(mef) + totpix
+
+	if (bitpix <= NBITS_BYTE)
+	    totpix = (totpix + 1) / SZB_CHAR
+	else
+	    totpix = totpix * (bitpix / (SZB_CHAR * NBITS_BYTE))
+
+	# Set the number of characters in multiple of 1440.
+	totpix = ((totpix + 1439)/1440) * 1440
+	return (totpix)
+end
+
+
+# MEF_STRCMP_LWR -- Compare 2 strings in lower case
+
+int procedure mef_strcmp_lwr (s1, s2)
+
+char s1[ARB], s2[ARB]
+
+pointer sp, l1, l2
+int	strcmp(), istat
+
+begin
+	call smark(sp)
+	call salloc (l1, SZ_FNAME, TY_CHAR)
+	call salloc (l2, SZ_FNAME, TY_CHAR)
+
+	call strcpy (s1, Memc[l1], SZ_FNAME)
+	call strcpy (s2, Memc[l2], SZ_FNAME)
+	call strlwr(Memc[l1])
+	call strlwr(Memc[l2])
+	istat = strcmp (Memc[l1], Memc[l2])
+
+	call sfree(sp)
+	return (istat)
+end
+
+
+# MEF_KCTYPE -- Find the type of card that is based on the keyword name.
+
+int procedure mef_kctype (card, index)
+
+char	card[ARB]	#I FITS card
+int	index		#O index value
+
+int	strncmp()
+
+begin
+	if (strncmp (card, "SIMPLE  ", 8) == 0)
+	   return (SIMPLE)
+	if (strncmp (card, "NAXIS", 5) == 0) {
+	   if (card[6] == ' ') {
+	      call mef_gvali (card, index)
+	      return (NAXIS)
+    	   } else  if (IS_DIGIT(card[6])) {
+	       index = TO_INTEG(card[6])
+	       return (NAXISN)                      # NAXISn
+     	   }
+	}
+	if (strncmp (card, "BITPIX  ", 8) == 0)
+	   return (BITPIX)
+	if (strncmp (card, "EXTNAME ", 8) == 0)
+	   return (EXTNAME)
+	if (strncmp (card, "EXTVER  ", 8) == 0)
+	   return (EXTVER)
+	if (strncmp (card, "EXTEND  ", 8) == 0)
+	   return (EXTEND)
+	if (strncmp (card, "PCOUNT  ", 8) == 0)
+	   return (PCOUNT)
+	if (strncmp (card, "FILENAME", 8) == 0)
+	   return (FILENAME)
+	if (strncmp (card, "INHERIT ", 8) == 0)
+	   return (INHERIT)
+	if (strncmp (card, "GCOUNT  ", 8) == 0)
+	   return (GCOUNT)
+	if (strncmp (card, "OBJECT  ", 8) == 0)
+	   return (OBJECT)
+	if (strncmp (card, "XTENSION", 8) == 0)
+	   return (XTENSION)
+	if (strncmp (card, "END     ", 8) == 0)
+	   return (END)
+
+        return(ERR)
+end
+
+
+# MEF_RDHDR_GN -- Read group based on group number
+
+int procedure mef_rdhdr_gn (mef,gn)
+
+pointer	mef 		#I mef descriptor
+int	gn		#I group number to read
+
+char	extname[MEF_SZVALSTR]
+int	extver
+int	mef_rdhdr()
+
+errchk  mef_rdhdr
+
+begin
+	extname[1] =EOS
+	extver=INDEFL
+	return (mef_rdhdr (mef, gn, extname, extver))
+end
+
+
+# MEF_RDHDR_EXNV -- Read group based on the Extname and Extver values
+
+int procedure mef_rdhdr_exnv (mef,extname, extver)
+
+pointer	mef		#I, mef descriptor
+char	extname[ARB]	#I, extname value
+int	extver		#I, extver value
+int     mef_rdhdr()
+
+errchk  mef_rdhdr
+
+begin
+	return (mef_rdhdr (mef, 0, extname, extver))
+end
+
+
+# MEF_CP_SPOOL -- 
+
+procedure mef_cp_spool (spool, mef)
+
+int	spool 		#I spool file descriptor
+pointer mef		#
+
+pointer	hdr, lbuf, sp
+int	fitslen, fstatl, user
+int	stropen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	call seek (spool, BOFL)
+	fitslen = fstatl (spool, F_FILESIZE)
+	fitslen = max (fitslen, MEF_HSIZE(mef))
+	call malloc (hdr, fitslen, TY_CHAR)
+	user = stropen (Memc[hdr], fitslen, NEW_FILE)
+
+	# Append the saved FITS cards to saved cache.
+	while (getline (spool, Memc[lbuf]) != EOF)
+	    call putline (user, Memc[lbuf])
+
+	call close (user)
+	call close (spool)
+
+	MEF_HDRP(mef) = hdr
+
+	call sfree(sp)
+end
diff --git a/pkg/xtools/mef/mefrdhdr.x_save b/pkg/xtools/mef/mefrdhdr.x_save
new file mode 100644
index 00000000..a46d5d04
--- /dev/null
+++ b/pkg/xtools/mef/mefrdhdr.x_save
@@ -0,0 +1,529 @@
+include <error.h>
+include <mach.h>
+include <ctype.h> 
+include <fset.h>
+include <mef.h>
+
+# MEFRDHR.X -- Routines to read FITS header units.
+#
+# 	         mef_rdhdr (mef, group, extname, extver)
+# 	         mef_rdblk (in, spp_buf)
+# 	         mef_skip_data_unit (mef)
+#	totpix = mef_totpix (mef)
+# 	         mef_rd2end (mef, read_next_group)
+# 	         mef_rdhdr_gn (mef,gn)
+# 	         mef_rdhdr_exnv (mef,extname, extver)
+
+
+# MEF_RDHR -- Read FITS header on a mef file that matches EXTNAME/EXTVER or 
+# GROUP number. If both are specified, the former takes procedence.
+
+procedure mef_rdhdr (mef, group, extname, extver)
+
+pointer	mef		#I Mef descriptor
+int	group 		#I Group number to read
+char    extname[ARB]    #I Extname to read		
+int	extver		#I Extver to read
+
+int	open(),in, cur_extn, note(), gnum
+int	spool
+char	spp_buf[FITS_BLKSZ_NL]
+bool	extnv, end_card, read_next_group, mef_rd1st()
+bool    mef_cmp_extnv
+errchk	open, read, mef_rd1st, mef_load_header
+
+begin
+	if (group == MEF_CGROUP(mef))
+	    return
+
+	gnum = group
+	if (MEF_FD(mef) == NULL) {
+	    MEF_FD(mef) = open (MEF_FNAME(mef), READ_ONLY, BINARY_FILE)
+	    MEF_ENUMBER(mef) = -1 
+	    MEF_CGROUP(mef) = -1 
+	} 
+	MEF_SKDATA(mef) = NO  
+
+	in = MEF_FD(mef)
+
+	extnv = extname[1] != EOS || extver != INDEFL
+	if (extnv)
+	   spool = open ("spool", NEW_FILE, SPOOL_FILE)
+
+	if (gnum == -1 || extnv)
+	    gnum = 0
+#	else if (gnum != -1 && extnv)
+#	    gnum = -1			# EXTNAME/EXTVER takes precedence
+	   
+	cur_extn = MEF_CGROUP(mef)
+#	if (cur_extn < 0) 
+#	    cur_extn = -1	        # Ready to read PHU
+	read_next_group = true
+
+	repeat {
+	   # If we need to read the next group
+	   if (read_next_group) {
+	       # Read 1st block 
+	       cur_extn = cur_extn+1
+
+	       # See if this extension contains the correct 
+	       # extname/extver values.
+
+	       if (extnv) {
+		   end_card = true
+		   # We are not sure if extname or extver are in the
+		   # 1st block.
+	           call fseti (spool, F_CANCEL, YES)
+		   call mef_load_header (mef, spool)
+#		   iferr (call mef_load_header (mef, spool)) {
+#		       call erract(EA_WARN)
+#		   }
+
+		   read_next_group = mef_cmp_extnv (mef, extname, extver)
+		   MEF_POFF(mef) = note(in)
+		   call mef_skip_data_unit (mef)
+		   next
+	       } else {
+	           end_card = mef_rd1st (mef, spp_buf) 
+		   if (gnum == cur_extn) 
+		       read_next_group = false
+	       }
+
+	       if (read_next_group) {
+		   if (!end_card)
+		       call mef_rd2end (mef, read_next_group)
+		   call mef_skip_data_unit (mef)
+	       }
+	   } else {			# This is the group we want
+	       if (MEF_HDRP(mef) != NULL)
+		   call mfree (MEF_HDRP(mef), TY_CHAR)
+	       if (end_card) {
+		   if (extnv) {
+		       call mef_cp_spool (spool, mef)
+                       cur_extn = cur_extn + 1
+		   } else {
+		       call malloc (MEF_HDRP(mef), MEF_HSIZE(mef)+1, TY_CHAR)
+		       call amovc (spp_buf, Memc[MEF_HDRP(mef)], MEF_HSIZE(mef))
+		       Memc[MEF_HDRP(mef)+MEF_HSIZE(mef)] = EOS
+		   }
+	       } else {
+		   call malloc (MEF_HDRP(mef), FITS_BLKSZ_NL, TY_CHAR)
+		   call amovc (spp_buf, Memc[MEF_HDRP(mef)], FITS_BLKSZ_NL)
+		   call mef_rd2end (mef, read_next_group)
+	       }
+	       if (!extnv) {
+		   if (MEF_NDIM(mef) != 0 || MEF_PCOUNT(mef) > 0) 
+		       MEF_POFF(mef) = note(in)
+		   else
+		       MEF_POFF(mef) = INDEFL
+	           call mef_skip_data_unit (mef)
+	       }
+	       MEF_CGROUP(mef) = cur_extn
+
+	       # To indicate that data has been skipped.
+	       MEF_SKDATA(mef) = YES  
+
+	       return
+	   }
+	}
+end
+
+
+# MEF_RD1ST -- Handle the 1st FITS header block.
+# Return true if the END card is in this 1st block.
+
+bool procedure	mef_rd1st (mef, hbuf)
+
+pointer mef		#I Mef descriptor
+char	hbuf[ARB]	#O Buffer containing the first block of a unit
+
+int	in, k, i, index, mef_kctype()
+int	strncmp(), note()
+pointer	sp, errmsg
+
+errchk  mef_rdblk
+
+begin
+	in = MEF_FD(mef)
+
+	# Read 1st block.
+ 	MEF_HOFF(mef) = note(in)
+	call mef_rdblk (in, hbuf)
+
+	MEF_EXTNAME(mef) = EOS
+	MEF_EXTVER(mef) = INDEFL
+	k = 1
+        # Verify FITS header
+	if (strncmp (hbuf[k], "SIMPLE  ", 8) != 0 &&
+	    strncmp (hbuf[k], "XTENSION", 8) != 0 ) {
+            call smark (sp)
+            call salloc (errmsg, SZ_LINE, TY_CHAR)
+            call sprintf (Memc[errmsg], SZ_LINE, "Extension %s[%d] is not FITS.")
+                call pargstr(MEF_FNAME(mef))
+                call pargi(MEF_CGROUP(mef))
+            call error (13, Memc[errmsg])
+#            iferr (call error (13, Memc[errmsg])) {
+#                call sfree (sp)
+#                call erract (EA_ERROR)
+#            }
+	} else {
+	    call mef_gvalt (hbuf[k], MEF_EXTTYPE(mef), MEF_SZVALSTR)
+	    if (strncmp (hbuf[k], "SIMPLE  ", 8) == 0)
+	        call strcpy (MEF_FNAME(mef), MEF_EXTTYPE(mef), MEF_SZVALSTR)
+	}
+	k = k + LEN_CARDNL
+
+	MEF_PCOUNT(mef) = 0
+
+	for (i=2; i< 37; i=i+1) {
+           switch (mef_kctype(hbuf[k], index)) {
+	   case NAXIS:
+	      MEF_NDIM(mef) = index
+	   case NAXISN:
+	      call mef_gvali (hbuf[k], MEF_NAXIS(mef,index))
+	   case BITPIX:
+	      call mef_gvali (hbuf[k], MEF_BITPIX(mef))
+	   case EXTNAME:
+	      call mef_gvalt (hbuf[k], MEF_EXTNAME(mef), MEF_SZVALSTR)
+	   case EXTVER:
+	      call mef_gvali (hbuf[k], MEF_EXTVER(mef))
+	   case PCOUNT:
+	      call mef_gvali (hbuf[k], MEF_PCOUNT(mef))
+	   case OBJECT:
+	      call mef_gvalt (hbuf[k], MEF_OBJECT(mef), MEF_SZVALSTR)
+	   case END:
+	      MEF_HSIZE(mef) = i*LEN_CARDNL
+              return(true)	
+	      break
+	   default:
+	      ;
+	   }
+	   k = k + LEN_CARDNL
+	}
+	return(false)
+	    
+end
+
+
+# MEF_RDBLK -- Read one header FITS block from disk and add a newline 
+# after each fits record (80 chars).
+
+procedure mef_rdblk (in, spp_buf)
+
+int	in		#I File descriptor
+char    spp_buf[ARB]	#O Buffer with header
+
+char    ibuf[FITS_BLKSZ_CHAR]
+int     nchar, i, read(), k, j
+char    line[LEN_CARD]
+
+begin
+	nchar = read (in, ibuf, FITS_BLKSZ_CHAR)
+	if (nchar == EOF) 
+	   call error(13, "EOF encountered")
+
+	# Unpack the input buffer to spp char with new_line delimited records.
+	line[LEN_CARDNL] = '\n'
+	k = 1
+	j = 1
+	for (i=1; i<37; i=i+1) {
+   	   call achtbc(ibuf[k], line, LEN_CARD)
+	   call amovc (line, spp_buf[j], LEN_CARDNL)
+	   k = k + 40		
+	   j = j + LEN_CARDNL
+	}
+end	 
+
+
+# MEF_CMP_EXTNV -- Compare the EXTNAME and EXTVER header values with the
+#		  ones passed as arguments. Return false if matched.
+
+bool procedure mef_cmp_extnv (mef, extname, extver)
+pointer	mef
+char	extname[ARB] 	#I extname value
+int	extver		#I extver value
+
+int	mef_strcmp_lwr()
+bool	bxtn, bxtv, bval, bxtn_eq, bxtv_eq
+
+begin
+	bxtn = extname[1] != EOS
+	bxtv = extver != INDEFL
+
+	if (bxtn)
+	    bxtn_eq = (mef_strcmp_lwr(MEF_EXTNAME(mef), extname) == 0)
+	if (bxtv)
+	    bxtv_eq = (MEF_EXTVER(mef) == extver)
+	
+	if (bxtn && bxtv)
+	    # Both EXTNAME and EXTVER are defined.
+	    bval = bxtn_eq && bxtv_eq
+	else if (bxtn && !bxtv)
+	    # Only EXTNAME is defined.
+	    bval = bxtn_eq
+	else if (!bxtn && bxtv)
+	    # Only EXTVER is defined.
+	    bval = bxtv_eq 
+	else
+	    bval = false
+
+	return (!bval)
+end
+
+# MEF_SKIP_DATA_UNIT -- Skip data unit. The file is already position at the
+# end of the last header block.
+
+procedure mef_skip_data_unit (mef)
+
+pointer	mef	#I Input mef descriptor
+
+int	in, ndim, off, note(), mef_totpix()
+errchk  seek
+
+begin
+	# See if data portion has already been skipped.
+	if (MEF_SKDATA(mef) == YES)
+	    return
+
+	in = MEF_FD(mef)
+	ndim = MEF_NDIM (mef)
+        if (ndim > 0 || MEF_PCOUNT(mef) > 0) {
+	   # Skip to the beginning of next extension
+	   off = note(in)
+	   if (off == EOF)
+	      return
+	   off = off + mef_totpix(mef)
+	   call seek (in, off)
+	}
+end
+
+
+# MEF_TOTPIX -- Returns the number of pixels in the data area in units
+#		of chars.
+
+int procedure mef_totpix (mef)
+
+pointer	mef		#I Mef descriptor
+
+int	ndim, totpix, i, bitpix
+
+begin
+	ndim = MEF_NDIM (mef)
+	if (ndim == 0 && MEF_PCOUNT(mef) <= 0)
+	    return (0)
+
+	if (ndim == 0)
+	    totpix = 0
+	else {
+	    totpix = MEF_NAXIS(mef,1) 
+	    do i = 2, ndim
+		  totpix = totpix *  MEF_NAXIS(mef,i)
+	}
+	bitpix = abs(MEF_BITPIX(mef))
+
+	# If PCOUNT is not zero, add it to totpix
+	totpix = MEF_PCOUNT(mef) + totpix
+
+	if (bitpix <= NBITS_BYTE)
+	    totpix = (totpix + 1) / SZB_CHAR
+	else
+	    totpix = totpix * (bitpix / (SZB_CHAR * NBITS_BYTE))
+
+	# Set the number of characters in multiple of 1440.
+	totpix = ((totpix + 1439)/1440) * 1440
+	return (totpix)
+end
+
+
+# MEF_RD2END --  Read from block 2 to the end.
+
+procedure mef_rd2end (mef, read_next_group)
+
+pointer	mef			#I mef descriptor	
+bool	read_next_group		#I if true, read current header to END
+
+char	hbuf[FITS_BLKSZ_NL] 
+int	in, k,i, nblks, strncmp(), size_last_block, hoffset
+errchk  mef_rdblk
+
+begin
+	in = MEF_FD(mef)
+	# We need to read the header only.
+        if (read_next_group)
+	   repeat {
+	      k = 1
+	      call mef_rdblk (in, hbuf)
+	      for (i=1; i<37; i=i+1) {
+	          if (strncmp (hbuf[k], "END     " , 8) == 0)
+		     return
+	          else
+		     k = k + LEN_CARDNL
+	      }
+	   }
+	   
+
+	# This is the requested header, copy to user area.
+	nblks = 2
+	repeat {
+	   k = 1
+	   call mef_rdblk (in, hbuf)
+	   # Copy the buffer into the user area.
+	   for (i=1; i<37; i=i+1) {
+	       if (strncmp (hbuf[k], "END     " , 8) == 0) {
+                  size_last_block = i*LEN_CARDNL
+	          call realloc (MEF_HDRP(mef), FITS_BLKSZ_NL*nblks+1, TY_CHAR)
+	          hoffset = MEF_HDRP(mef)+FITS_BLKSZ_NL*(nblks-1)
+		  call amovc (hbuf, Memc[hoffset], size_last_block)
+		  Memc[hoffset+size_last_block] = EOS
+		  MEF_HSIZE(mef) = (nblks-1)*FITS_BLKSZ_NL + size_last_block
+		  return
+	       } else
+		  k = k + LEN_CARDNL
+	   }
+	   call realloc (MEF_HDRP(mef), FITS_BLKSZ_NL*nblks, TY_CHAR)
+	   hoffset = MEF_HDRP(mef)+FITS_BLKSZ_NL*(nblks-1)
+	   call amovc (hbuf, Memc[hoffset], FITS_BLKSZ_NL)
+	   nblks = nblks + 1
+	}
+end
+
+
+# MEF_STRCMP_LWR -- Compare 2 strings in lower case
+
+int procedure mef_strcmp_lwr (s1, s2)
+
+char s1[ARB], s2[ARB]
+
+pointer sp, l1, l2
+int	strcmp(), istat
+
+begin
+	call smark(sp)
+	call salloc (l1, SZ_FNAME, TY_CHAR)
+	call salloc (l2, SZ_FNAME, TY_CHAR)
+
+	call strcpy (s1, Memc[l1], SZ_FNAME)
+	call strcpy (s2, Memc[l2], SZ_FNAME)
+	call strlwr(Memc[l1])
+	call strlwr(Memc[l2])
+	istat = strcmp (Memc[l1], Memc[l2])
+
+	call sfree(sp)
+	return (istat)
+end
+
+
+# MEF_KCTYPE -- Find the type of card that is based on the keyword name.
+
+int procedure mef_kctype (card, index)
+
+char	card[ARB]	#I FITS card
+int	index		#O index value
+
+int	strncmp()
+
+begin
+	if (strncmp (card, "SIMPLE  ", 8) == 0)
+	   return (SIMPLE)
+	if (strncmp (card, "NAXIS", 5) == 0) {
+	   if (card[6] == ' ') {
+	      call mef_gvali (card, index)
+	      return (NAXIS)
+    	   } else  if (IS_DIGIT(card[6])) {
+	       index = TO_INTEG(card[6])
+	       return (NAXISN)                      # NAXISn
+     	   }
+	}
+	if (strncmp (card, "BITPIX  ", 8) == 0)
+	   return (BITPIX)
+	if (strncmp (card, "EXTNAME ", 8) == 0)
+	   return (EXTNAME)
+	if (strncmp (card, "EXTVER  ", 8) == 0)
+	   return (EXTVER)
+	if (strncmp (card, "EXTEND  ", 8) == 0)
+	   return (EXTEND)
+	if (strncmp (card, "PCOUNT  ", 8) == 0)
+	   return (PCOUNT)
+	if (strncmp (card, "FILENAME", 8) == 0)
+	   return (FILENAME)
+	if (strncmp (card, "INHERIT ", 8) == 0)
+	   return (INHERIT)
+	if (strncmp (card, "GCOUNT  ", 8) == 0)
+	   return (GCOUNT)
+	if (strncmp (card, "OBJECT  ", 8) == 0)
+	   return (OBJECT)
+	if (strncmp (card, "XTENSION", 8) == 0)
+	   return (XTENSION)
+	if (strncmp (card, "END     ", 8) == 0)
+	   return (END)
+
+        return(ERR)
+end
+
+
+# MEF_RDHDR_GN -- Read group based on group number
+
+procedure mef_rdhdr_gn (mef,gn)
+
+pointer	mef 		#I mef descriptor
+int	gn		#I group number to read
+
+char	extname[MEF_SZVALSTR]
+int	extver
+
+errchk  mef_rdhdr
+
+begin
+	extname[1] =EOS
+	extver=INDEFL
+	call mef_rdhdr (mef, gn, extname, extver)
+end
+
+
+# MEF_RDHDR_EXNV -- Read group based on the Extname and Extver values
+
+procedure mef_rdhdr_exnv (mef,extname, extver)
+
+pointer	mef		#I, mef descriptor
+char	extname[ARB]	#I, extname value
+int	extver		#I, extver value
+
+errchk  mef_rdhdr
+
+begin
+	call mef_rdhdr (mef, 0, extname, extver)
+end
+
+
+# MEF_CP_SPOOL -- 
+
+procedure mef_cp_spool (spool, mef)
+
+int	spool 		#I spool file descriptor
+pointer mef		#
+
+pointer	hdr, lbuf, sp
+int	fitslen, fstatl, user
+int	stropen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	call seek (spool, BOFL)
+	fitslen = fstatl (spool, F_FILESIZE)
+	fitslen = max (fitslen, MEF_HSIZE(mef))
+	call malloc (hdr, fitslen, TY_CHAR)
+	user = stropen (Memc[hdr], fitslen, NEW_FILE)
+
+	# Append the saved FITS cards to saved cache.
+	while (getline (spool, Memc[lbuf]) != EOF)
+	    call putline (user, Memc[lbuf])
+
+	call close (user)
+	call close (spool)
+
+	MEF_HDRP(mef) = hdr
+
+	call sfree(sp)
+end
diff --git a/pkg/xtools/mef/mefsetpl.x b/pkg/xtools/mef/mefsetpl.x
new file mode 100644
index 00000000..0df45a4a
--- /dev/null
+++ b/pkg/xtools/mef/mefsetpl.x
@@ -0,0 +1,203 @@
+include <pkg/mef.h>
+
+define  MEF_PLVERSION  MEF_HFLAG
+define  MEF_PLSIZE     MEF_CGROUP
+
+define  DEF_SZBUF       32768
+define  INC_SZBUF       16384
+define  INC_HDRMEM      8100
+define  IDB_RECLEN      80
+
+define  KW_TITLE        "$TITLE = "
+define  LEN_KWTITLE     9
+define  KW_CTIME        "$CTIME = "
+define  LEN_KWCTIME     9
+define  KW_MTIME        "$MTIME = "
+define  LEN_KWMTIME     9
+define  KW_LIMTIME      "$LIMTIME = "
+define  LEN_KWLIMTIME   11
+define  KW_MINPIXVAL    "$MINPIXVAL = "
+define  LEN_KWMINPIXVAL 13
+define  KW_MAXPIXVAL    "$MAXPIXVAL = "
+define  LEN_KWMAXPIXVAL 13
+
+define SZ_IMTITLE      383    # image title string
+
+procedure mef_setpl (version, plsize, imhdr, title, ctime, mtime, limtime,
+		minval, maxval, mef)
+
+int     version		#I PL version number
+char    imhdr[ARB]      #I Mask title
+char    title[ARB]
+int     plsize		#I Mask size of TY_SHORT
+int	ctime
+int	mtime
+int	limtime
+real	minval
+real	maxval
+pointer mef		#I Mef descriptor
+
+int	tlen, i, ch, hdrlen, nchars
+pointer	sp, tbuf, ip, op, rp, bp, hd
+int	strncmp(), ctol(), ctor(), strlen()
+errchk	realloc
+
+begin
+	MEF_PLVERSION(mef) = version
+	MEF_PLSIZE(mef) = plsize
+	tlen= strlen(imhdr)
+
+	call smark (sp)
+	call salloc (tbuf, SZ_IMTITLE, TY_CHAR)
+	call salloc (bp, tlen, TY_CHAR)
+
+	call strcpy (imhdr, Memc[bp], tlen)
+
+
+	# Get the image title string.
+	for (ip = bp;  Memc[ip] != EOS;) {
+	    if (Memc[ip] == '$') {
+		if (strncmp (Memc[ip], KW_TITLE, LEN_KWTITLE) == 0) {
+		    # Advance to first character of quoted string.
+		    ip = ip + LEN_KWTITLE
+		    while (Memc[ip] != EOS && Memc[ip] != '"')
+			ip = ip + 1
+		    if (Memc[ip] == '"')
+			ip = ip + 1
+
+		    # Extract the string.
+		    op = tbuf
+		    while (Memc[ip] != EOS && Memc[ip] != '"') {
+			if (Memc[ip] == '\\' && Memc[ip+1] == '"')
+			    ip = ip + 1
+			Memc[op] = Memc[ip]
+			op = min (tbuf + SZ_IMTITLE, op + 1)
+			ip = ip + 1
+		    }
+
+		    # Store in image descriptor.
+		    Memc[op] = EOS
+		    call strcpy (Memc[tbuf], title, SZ_IMTITLE)
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp (Memc[ip], KW_CTIME, LEN_KWCTIME) == 0) {
+		    # Decode the create time.
+		    ip = ip + LEN_KWCTIME
+		    rp = 1
+		    if (ctol (Memc[ip], rp, ctime) <= 0)
+			ctime = 0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp (Memc[ip], KW_MTIME, LEN_KWMTIME) == 0) {
+		    # Decode the modify time.
+		    ip = ip + LEN_KWMTIME
+		    rp = 1
+		    if (ctol (Memc[ip], rp, mtime) <= 0)
+			mtime = 0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp (Memc[ip], KW_LIMTIME, LEN_KWLIMTIME) == 0) {
+		    # Decode the limits time.
+		    ip = ip + LEN_KWLIMTIME
+		    rp = 1
+		    if (ctol (Memc[ip], rp, limtime) <= 0)
+			limtime = 0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp(Memc[ip],KW_MINPIXVAL,LEN_KWMINPIXVAL)==0) {
+		    # Decode the minimum pixel value.
+		    ip = ip + LEN_KWMINPIXVAL
+		    rp = 1
+		    if (ctor (Memc[ip], rp, minval) <= 0)
+			minval = 0.0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+
+		} else if (strncmp(Memc[ip],KW_MAXPIXVAL,LEN_KWMAXPIXVAL)==0) {
+		    # Decode the maximum pixel value.
+		    ip = ip + LEN_KWMAXPIXVAL
+		    rp = 1
+		    if (ctor (Memc[ip], rp, maxval) <= 0)
+			maxval = 0.0
+		    ip = ip + rp - 1
+
+	    	    # Advance to next line.
+	    	    while (Memc[ip] != EOS && Memc[ip] != '\n')
+			ip = ip + 1
+	    	    if (Memc[ip] == '\n')
+			ip = ip + 1
+		}
+	    } else
+		break
+	}
+	
+	hdrlen = tlen*2
+	call malloc (hd, hdrlen, TY_CHAR)
+	op = hd
+
+	while (Memc[ip] != EOS) {
+	    rp = op
+
+	    nchars = rp - hd
+	    if (nchars + IDB_RECLEN + 2 > hdrlen) {
+		hdrlen = hdrlen + INC_HDRMEM
+		call realloc (hd, hdrlen, TY_CHAR)
+		op = hd + nchars
+	    }
+	    # Copy the saved card, leave IP positioned to past newline.
+	    do i = 1, IDB_RECLEN {
+		ch = Memc[ip]
+		if (ch != EOS)
+		    ip = ip + 1
+		if (ch == '\n')
+		    break
+		Memc[op] = ch
+		op = op + 1
+	    }
+
+	    # Blank fill the card.
+	    while (op - rp < IDB_RECLEN) {
+		Memc[op] = ' '
+		op = op + 1
+	    }
+
+	    # Add newline termination.
+	    Memc[op] = '\n';  op = op + 1
+	}
+
+	Memc[op] = EOS
+
+	MEF_HDRP(mef) = hd
+	MEF_HSIZE(mef) = strlen(Memc[hd])
+
+	call sfree (sp)
+end
+
diff --git a/pkg/xtools/mef/mefwrhdr.x b/pkg/xtools/mef/mefwrhdr.x
new file mode 100644
index 00000000..90ec337e
--- /dev/null
+++ b/pkg/xtools/mef/mefwrhdr.x
@@ -0,0 +1,212 @@
+include <error.h>
+include <pkg/mef.h>
+
+# MEF_WRHDR -- Append the header from an input PHU or extension to output file.
+
+procedure mef_wrhdr (mefi, mefo, in_phdu)
+
+pointer	mefi		#I input mef descriptor
+pointer	mefo		#I output mef descriptor
+bool	in_phdu		#I true if input header is Primary Header Unit.
+
+pointer hb, sp, ln
+int	output_lines, out, offset
+int	i, index, naxis, mef_kctype(), strncmp(), note()
+bool    endk, new_outf
+errchk  open, fcopyo
+
+define	nextb_ 99
+
+begin
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	# At this point the input first header has been read
+
+	hb = MEF_HDRP(mefi)
+	if (Memc[hb] == NULL)
+	   call error(13,"mef_wrhdr: input header buffer is empty")
+
+	out = MEF_FD(mefo)
+
+	new_outf = false
+	if (MEF_ACMODE(mefo) == NEW_IMAGE)
+	   new_outf = true
+
+	output_lines = 0
+	endk = false
+
+	# If we want to copy the header with no modification
+	if (MEF_KEEPXT(mefo) == YES) {
+	    for (i=1; i<37; i=i+1) {
+	       switch (mef_kctype(Memc[hb], index)) {
+	       case END:
+		   call mef_pakwr (out, Memc[hb])
+		   endk = true
+		   output_lines = i
+		   break
+	       default:
+		   call mef_pakwr (out, Memc[hb])
+		   hb = hb + LEN_CARDNL
+	       }
+	    }
+	    goto nextb_
+	} 
+
+	# Check for 1st card
+	if (strncmp (Memc[hb], "SIMPLE  ", 8) == 0) {
+	    # Append extension to existing file
+	    if (!new_outf) {            
+	        call mef_encodec ("XTENSION", "IMAGE", 5, Memc[ln],
+		    "Image extension")
+	        call mef_pakwr (out, Memc[ln])
+	    } else
+	        call mef_pakwr (out, Memc[hb])
+	} else if (strncmp (Memc[hb], "XTENSION", 8) == 0 ) {
+	    if (new_outf) {
+	        # Create a PHU
+	        # Must create a dummy header if input extension is not image
+		if (strncmp (MEF_EXTTYPE(mefi), "IMAGE", 5) != 0) {
+		    Memc[ln] = EOS
+		    call mef_dummyhdr (out, Memc[ln])
+		    new_outf = false
+	            call mef_pakwr (out, Memc[hb])
+	        } else {
+	            call mef_encodeb ("SIMPLE", YES, Memc[ln],
+		        "Standard FITS format")
+	            call mef_pakwr (out, Memc[ln])
+		}
+	    } else
+	        call mef_pakwr (out, Memc[hb])
+	} else {
+	    # Is the wrong kind of header
+#	    call eprintf ("File %s is not FITS\n")
+#		call erract (EA_FATAL)
+	    call sprintf (Memc[ln],LEN_CARD, "File %s is not FITS")
+	        call pargstr(MEF_FNAME(mefi))
+            call error(13, Memc[ln])			
+	}
+	hb = hb + LEN_CARDNL
+
+	for (i=2; i<37; i=i+1) {
+	   switch (mef_kctype(Memc[hb], index)) {
+	   case BITPIX:
+	      # Get to calculate totpix value
+	      call mef_gvali (Memc[hb], MEF_BITPIX(mefi))
+	   case NAXIS:
+	      naxis = index
+	      MEF_NDIM(mefi) = index
+	      if (in_phdu && !new_outf && naxis == 0) {
+	         call mef_pakwr (out, Memc[hb])
+		 call mef_wrpgcount (out)
+	         output_lines = output_lines + 2
+		 hb = hb + LEN_CARDNL
+		 next
+	      }
+	   case NAXISN:
+	      call mef_gvali (Memc[hb], MEF_NAXIS(mefi,index))
+	      call mef_pakwr (out, Memc[hb])
+	      if (index == naxis) {
+	          if (in_phdu && !new_outf ) {
+		      # We are writing from a phu to ehu.
+		      # 2 new cards PCOUNT and GCOUNT
+
+		      call mef_wrpgcount (out)
+		      output_lines = output_lines + 2
+	          }			
+	          if (!in_phdu && new_outf) {
+		      # We are writing from a ehu to a phu
+		      call mef_encodeb ("EXTEND", YES, Memc[ln],
+			  "There may be extensions")
+		      call mef_pakwr (out, Memc[ln])
+		      output_lines = output_lines + 1
+		  }   
+	      }
+	      hb = hb + LEN_CARDNL
+	      next
+	   case EXTEND, FILENAME:
+	      if (!new_outf) {
+		  # Do not put these cards  when going to an ehu
+	          output_lines = output_lines - 1
+	          hb = hb + LEN_CARDNL
+		  next
+	      }
+	   case INHERIT:
+	      # Eliminate INHERIT keyword from an input IMAGE extension
+	      # when creating a new output file. If file already exists
+	      # then pass the card along.
+
+	      if (new_outf) {
+	          output_lines = output_lines - 1
+	          hb = hb + LEN_CARDNL
+		  next
+	      } 
+	   case PCOUNT,GCOUNT,EXTNAME,EXTVER:   
+	      # Do not put these cards into PHU
+	      if (new_outf) {
+	         output_lines = output_lines - 1
+	         hb = hb + LEN_CARDNL
+		 next
+	      } 
+	   case END:
+	      call mef_pakwr (out, Memc[hb])
+	      endk = true
+	      output_lines = i + output_lines
+	      break
+	   default:
+	      ;
+	   }
+	   call mef_pakwr (out, Memc[hb])
+	   hb = hb + LEN_CARDNL
+
+	} # end for loop
+
+nextb_
+	# See if we need to keep reading header
+	#
+	if (!endk) 
+	   repeat {
+	      for (i=1; i<37; i=i+1) {
+	        if (strncmp (Memc[hb], "END     ", 8) == 0) {
+	           call mef_pakwr (out, Memc[hb])
+		   endk = true
+		   output_lines = i + output_lines
+		   break
+	        }
+	        call mef_pakwr (out, Memc[hb])
+		hb = hb + LEN_CARDNL
+	      }
+              if (endk) break
+	      
+	   } #end repeat
+           
+	   offset = note(out)-1     # to base zero
+	   call mef_padfile (out, offset)
+	   call flush(out)
+
+	call sfree(sp)
+end
+
+procedure mef_padfile (fd, offset)
+
+int	fd	  # file descriptor
+int	offset    # file position in chars
+
+int     pad, nlines,i
+char	card[LEN_CARDNL]
+
+begin
+        i = mod(offset, 1440)
+	if (i == 0) return
+
+	pad = 1440 - i
+	nlines = pad/40
+
+        do i =1, 80
+              card[i] = ' '
+        call achtcb (card, card, 80)
+
+        for(i=1; i<=nlines; i=i+1)
+           call write(fd, card, 40)
+
+end
diff --git a/pkg/xtools/mef/mefwrhdr.x_save b/pkg/xtools/mef/mefwrhdr.x_save
new file mode 100644
index 00000000..ef1c332b
--- /dev/null
+++ b/pkg/xtools/mef/mefwrhdr.x_save
@@ -0,0 +1,185 @@
+include <error.h>
+include <mef.h>
+
+# MEF_WRHDR -- Append the header from an input PHU or extension to output file.
+
+procedure mef_wrhdr (mefi, mefo, in_phdu)
+
+pointer	mefi		#I input mef descriptor
+pointer	mefo		#I output mef descriptor
+bool	in_phdu		#I true if input header is Primary Header Unit.
+
+pointer hb, sp, ln
+int	output_lines, out
+int	i, index, naxis, mef_kctype(), strncmp()
+bool    endk, new_outf
+errchk  open, fcopyo
+
+define	nextb_ 99
+
+begin
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	# At this point the input first header has been read
+
+	hb = MEF_HDRP(mefi)
+	if (Memc[hb] == NULL)
+	   call error(13,"mef_wrhdr: input header buffer is empty")
+
+	out = MEF_FD(mefo)
+
+	new_outf = false
+	if (MEF_ACMODE(mefo) == NEW_IMAGE)
+	   new_outf = true
+
+	output_lines = 0
+	endk = false
+
+	# If we want to copy the header with no modification
+	if (MEF_KEEPXT(mefo) == YES) {
+	    for (i=1; i<37; i=i+1) {
+	       switch (mef_kctype(Memc[hb], index)) {
+	       case END:
+		   call mef_pakwr (out, Memc[hb])
+		   endk = true
+		   output_lines = i
+		   break
+	       default:
+		   call mef_pakwr (out, Memc[hb])
+		   hb = hb + LEN_CARDNL
+	       }
+	    }
+	    goto nextb_
+	} 
+
+	# Check for 1st card
+	if (strncmp (Memc[hb], "SIMPLE  ", 8) == 0) {
+	    # Append extension to existing file
+	    if (!new_outf) {            
+	        call mef_encodec ("XTENSION", "IMAGE", 5, Memc[ln],
+		    "Image extension")
+	        call mef_pakwr (out, Memc[ln])
+	    } else
+	        call mef_pakwr (out, Memc[hb])
+	} else if (strncmp (Memc[hb], "XTENSION", 8) == 0 ) {
+	    if (new_outf) {
+	        # Create a PHU
+	        # Must create a dummy header if input extension is not image
+		if (strncmp (MEF_EXTTYPE(mefi), "IMAGE", 5) != 0) {
+		    Memc[ln] = EOS
+		    call mef_dummyhdr (out, Memc[ln])
+		    new_outf = false
+	            call mef_pakwr (out, Memc[hb])
+	        } else {
+	            call mef_encodeb ("SIMPLE", YES, Memc[ln],
+		        "Standard FITS format")
+	            call mef_pakwr (out, Memc[ln])
+		}
+	    } else
+	        call mef_pakwr (out, Memc[hb])
+	} else {
+	    # Is the wrong kind of header
+#	    call eprintf ("File %s is not FITS\n")
+#		call erract (EA_FATAL)
+	    call sprintf (Memc[ln],LEN_CARD, "File %s is not FITS")
+	        call pargstr(MEF_FNAME(mefi))
+            call error(13, Memc[ln])			
+	}
+	hb = hb + LEN_CARDNL
+
+	for (i=2; i<37; i=i+1) {
+	   switch (mef_kctype(Memc[hb], index)) {
+	   case BITPIX:
+	      # Get to calculate totpix value
+	      call mef_gvali (Memc[hb], MEF_BITPIX(mefi))
+	   case NAXIS:
+	      naxis = index
+	      MEF_NDIM(mefi) = index
+	      if (in_phdu && !new_outf && naxis == 0) {
+	         call mef_pakwr (out, Memc[hb])
+		 call mef_wrpgcount (out)
+	         output_lines = output_lines + 2
+		 hb = hb + LEN_CARDNL
+		 next
+	      }
+	   case NAXISN:
+	      call mef_gvali (Memc[hb], MEF_NAXIS(mefi,index))
+	      call mef_pakwr (out, Memc[hb])
+	      if (index == naxis) {
+	          if (in_phdu && !new_outf ) {
+		      # We are writing from a phu to ehu.
+		      # 2 new cards PCOUNT and GCOUNT
+
+		      call mef_wrpgcount (out)
+		      output_lines = output_lines + 2
+	          }			
+	          if (!in_phdu && new_outf) {
+		      # We are writing from a ehu to a phu
+		      call mef_encodeb ("EXTEND", YES, Memc[ln],
+			  "There may be extensions")
+		      call mef_pakwr (out, Memc[ln])
+		      output_lines = output_lines + 1
+		  }   
+	      }
+	      hb = hb + LEN_CARDNL
+	      next
+	   case EXTEND, FILENAME:
+	      if (!new_outf) {
+		  # Do not put these cards  when going to an ehu
+	          output_lines = output_lines - 1
+	          hb = hb + LEN_CARDNL
+		  next
+	      }
+	   case INHERIT:
+	      # Eliminate INHERIT keyword from an input IMAGE extension
+	      # when creating a new output file. If file already exists
+	      # then pass the card along.
+
+	      if (new_outf) {
+	          output_lines = output_lines - 1
+	          hb = hb + LEN_CARDNL
+		  next
+	      } 
+	   case PCOUNT,GCOUNT,EXTNAME,EXTVER:   
+	      # Do not put these cards into PHU
+	      if (new_outf) {
+	         output_lines = output_lines - 1
+	         hb = hb + LEN_CARDNL
+		 next
+	      } 
+	   case END:
+	      call mef_pakwr (out, Memc[hb])
+	      endk = true
+	      output_lines = i + output_lines
+	      break
+	   default:
+	      ;
+	   }
+	   call mef_pakwr (out, Memc[hb])
+	   hb = hb + LEN_CARDNL
+
+	} # end for loop
+
+nextb_
+	# See if we need to keep reading header
+	#
+	if (!endk) 
+	   repeat {
+	      for (i=1; i<37; i=i+1) {
+	        if (strncmp (Memc[hb], "END     ", 8) == 0) {
+	           call mef_pakwr (out, Memc[hb])
+		   endk = true
+		   output_lines = i + output_lines
+		   break
+	        }
+	        call mef_pakwr (out, Memc[hb])
+		hb = hb + LEN_CARDNL
+	      }
+              if (endk) break
+	      
+	   } #end repeat
+	call mef_wrblank (out, output_lines)
+
+	call sfree(sp)
+end
diff --git a/pkg/xtools/mef/mefwrpl.x b/pkg/xtools/mef/mefwrpl.x
new file mode 100644
index 00000000..1eef1cc2
--- /dev/null
+++ b/pkg/xtools/mef/mefwrpl.x
@@ -0,0 +1,213 @@
+include <error.h>
+include <pkg/mef.h>
+
+define MEF_PLSIZE  MEF_CGROUP
+# MEF_WRPL -- 
+
+procedure mef_wrpl (mef, title, ctime,mtime, limtime, minval, 
+   	      maxval,plbuf, naxis, axlen)
+
+char    title[ARB]
+int	ctime, mtime, limtime
+real	minval, maxval
+pointer	mef		#I input mef descriptor
+short   plbuf		#I Pixel list buffer
+int	naxis, axlen[ARB]
+
+pointer sp, ln, mii, hb
+char    blank[1]
+int	output_lines, npad, i 
+int	pcount, fd, nlines
+bool    endk, new_outf
+errchk  open, fcopyo
+
+begin
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	# Output file descriptor
+	fd  = MEF_FD(mef)
+
+	new_outf = false
+	if (MEF_ACMODE(mef) == NEW_IMAGE)
+	   new_outf = true
+
+	output_lines = 0
+	endk = false
+
+	# Create a PHU
+	if (new_outf) {
+	    # Must create a dummy header if input extension is not image
+	    Memc[ln] = EOS
+	    call mef_dummyhdr (fd, Memc[ln])
+	    new_outf = false
+	} 
+
+	call mef_wcardc ("XTENSION", "BINTABLE", "Extension type", fd)
+	call mef_wcardi ("BITPIX", 8, "Default value", fd)
+	call mef_wcardi ("NAXIS", 2, "Lines and cols", fd)
+	call mef_wcardi ("NAXIS1", 8, "Nbytes per line", fd)
+	call mef_wcardi ("NAXIS2", 1, "Nlines", fd)
+	
+	# Calculate the number of 2880 bytes block the heap will
+	# occupy.
+
+	pcount = ((MEF_PLSIZE(mef)+1439)/1440)*2880
+	call mef_wcardi ("PCOUNT", pcount, "Heap size in bytes", fd)
+	call mef_wcardi ("GCOUNT", 1, "1 Group", fd)
+	call mef_wcardi ("TFIELDS", 1, "1 Column field", fd)
+	call sprintf (Memc[ln], LEN_CARD, "PI(%d)")
+	    call pargi(MEF_PLSIZE(mef))
+	call mef_wcardc ("TFORM1", Memc[ln], "Variable word array", fd)
+	call mef_wcardb ("INHERIT", NO, "No Inherit", fd)
+        call mef_wcardc ("ORIGIN", FITS_ORIGIN, "FITS file originator", fd)
+	call mef_wcardc ("EXTNAME", MEF_EXTNAME(mef), "", fd)
+	call mef_wcardi ("EXTVER", MEF_EXTVER(mef), "", fd)
+	call mef_wcardi ("CTIME", ctime, "", fd)
+	call mef_wcardi ("MTIME", mtime, "", fd)
+	call mef_wcardi ("LIMTIME", limtime, "", fd)
+	call mef_wcardr ("DATAMIN", minval, "", fd)
+	call mef_wcardr ("DATAMAX", maxval, "", fd)
+	call mef_wcardc ("OBJECT", title, "", fd)
+
+	call mef_wcardb ("CMPIMAGE", YES, "Is a compressed image", fd)
+	call mef_wcardc ("CMPTYPE", "PLIO_1", "IRAF image masks", fd)
+	call mef_wcardi ("CBITPIX", 32, "BITPIX for uncompressed image", fd)
+	call mef_wcardi ("CNAXIS", naxis, "NAXIS for uncompressed image", fd)
+	do i = 1, naxis {
+	    call sprintf (Memc[ln], LEN_CARD, "NAXIS%d")
+		call pargi(i)
+	    call mef_wcardi ("CNAXIS", axlen[i], "axis length", fd)
+	}
+	
+	hb = MEF_HDRP(mef)	
+	output_lines = 23
+	nlines = MEF_HSIZE(mef) / LEN_CARDNL
+
+	for (i=1; i<= nlines; i=i+1) {
+	    call mef_pakwr (fd, Memc[hb])
+	    hb = hb + LEN_CARDNL
+	}
+
+        blank[1] = ' '
+	call amovkc (blank, Memc[ln], 80)
+	call strcpy ("END", Memc[ln], 3)
+	Memc[ln+3] = ' '                           # Clear EOS mark
+	call mef_pakwr (fd, Memc[ln])
+
+	output_lines = output_lines + nlines + 1 + naxis
+	call mef_wrblank (fd, output_lines)
+
+	call salloc (mii, 1400, TY_INT)
+
+	# Now write 2 integers as table data (nelem,offset)
+	Memi[mii] = MEF_PLSIZE(mef)	 # Number of words in pl buff (2bytes)
+	Memi[mii+1] = 0			 # Offset from start of heap
+
+	npad = 1438
+	call amovki (0, Memi[mii+2], npad)
+	call write (fd, Memi[mii], 1440)
+
+	# Write mask in heap area
+	call write (fd, plbuf, MEF_PLSIZE(mef)*SZ_SHORT)
+
+	# Pad to 1440 characters block in case we want to append another
+	# extension
+
+	npad = 1440 - mod (MEF_PLSIZE(mef), 1440)
+
+	call amovki (0, Memi[mii], npad)
+	call write (fd, Memi[mii], npad)
+							 
+
+	call sfree(sp)
+end
+
+procedure mef_wcardi (kname, kvalue, kcomm, fd)
+
+char	kname[ARB]	#I Keyword name
+int	kvalue	        #I Keyword value
+char 	kcomm[ARB]	#I Card comment
+int	fd	        #I file descriptor
+
+pointer sp, ln
+
+begin
+
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	call mef_encodei (kname, kvalue, Memc[ln], kcomm)
+	call mef_pakwr (fd, Memc[ln])
+
+	call sfree (sp)
+
+end
+
+
+procedure mef_wcardc (kname, kvalue, kcomm, fd)
+
+char	kname[ARB]	#I Keyword name
+char	kvalue[ARB]	#I Keyword value
+char 	kcomm[ARB]	#I Card comment
+int	fd   	        #I file descriptor
+
+pointer sp, ln
+int     slen, strlen()
+
+begin
+
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	slen = strlen(kvalue)
+	call mef_encodec (kname, kvalue, slen, Memc[ln], kcomm)
+	call mef_pakwr (fd, Memc[ln])
+
+	call sfree(sp)
+
+end
+
+
+procedure mef_wcardb (kname, kvalue, kcomm, fd)
+
+char	kname[ARB]	#I Keyword name
+int	kvalue	        #I Keyword value
+char 	kcomm[ARB]	#I Card comment
+int	fd	        #I file descriptor
+
+pointer sp, ln
+
+begin
+
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	call mef_encodeb (kname, kvalue, Memc[ln], kcomm)
+	call mef_pakwr (fd, Memc[ln])
+
+	call sfree(sp)
+
+end
+
+procedure mef_wcardr (kname, kvalue, kcomm, fd)
+
+char	kname[ARB]	#I Keyword name
+real	kvalue		#I Keyword value
+char 	kcomm[ARB]	#I Card comment
+int	fd	        #I file descriptor
+
+pointer sp, ln
+
+begin
+
+	call smark (sp)
+	call salloc (ln, LEN_CARDNL, TY_CHAR)
+
+	call mef_encoder (kname, kvalue, Memc[ln], kcomm, 6)
+	call mef_pakwr (fd, Memc[ln])
+
+	call sfree(sp)
+
+end
+
diff --git a/pkg/xtools/mef/mkpkg b/pkg/xtools/mef/mkpkg
new file mode 100644
index 00000000..5a3f358c
--- /dev/null
+++ b/pkg/xtools/mef/mkpkg
@@ -0,0 +1,26 @@
+# MEFLIB
+
+update:
+        $checkout       libxtools.a lib$
+        $update         libxtools.a
+        $checkin        libxtools.a lib$
+        ;
+
+libxtools.a:
+        mefappfile.x    <pkg/mef.h>
+        mefclose.x      <pkg/mef.h>
+        mefcpextn.x     <mach.h> <pkg/mef.h>
+        mefdummyh.x     <pkg/mef.h>
+        mefencode.x     <ctype.h> <mach.h> <pkg/mef.h> <time.h>
+        mefget.x        <ctype.h> <pkg/mef.h>
+        mefgnbc.x       <pkg/mef.h>
+        mefgval.x       <ctype.h> <pkg/mef.h>
+        mefkfind.x      <pkg/mef.h>
+        mefksection.x   <ctotok.h> <lexnum.h> <pkg/mef.h>
+        mefldhdr.x      <ctype.h> <error.h> <mach.h> <pkg/mef.h> <mii.h>
+        mefopen.x       <pkg/mef.h>
+        mefrdhdr.x      <ctype.h> <error.h> <fset.h> <mach.h> <pkg/mef.h>
+        mefsetpl.x      <pkg/mef.h>
+        mefwrhdr.x      <error.h> <pkg/mef.h>
+        mefwrpl.x       <error.h> <pkg/mef.h>
+	;