1 files changed, 155 insertions, 0 deletions
diff --git a/sys/imio/iki/fxf/fxfupk.x b/sys/imio/iki/fxf/fxfupk.x
new file mode 100644
index 00000000..b6b158ae
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfupk.x
@@ -0,0 +1,155 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ 
+include	<syserr.h>
+include <mach.h>
+include "fxf.h"
+
+# FXFUPK.X -- Routines to upack an IEEE vector into native format.
+#
+#	fxf_unpack_data (cbuf, npix, pixtype, bscale, bzero)
+#	      fxf_altmr (a, b, npix, bscale, bzero)
+#	      fxf_altmd (a, b, npix, bscale, bzero)
+#	      fxf_altmu (a, b, npix)
+#	      fxf_astmr (a, b, npix, bscale, bzero)
+
+define	NBITS_DOU	(SZB_CHAR * SZ_DOUBLE)
+define	IOFF		1
+
+
+# FITUPK -- Unpack cbuf in place from FITS binary format to local machine type.
+
+procedure fxf_unpack_data (cbuf, npix, pixtype, bscale, bzero)
+
+char	cbuf[ARB]		#U buffer with input,output data
+int	npix			#I number of pixels in buffer
+int	pixtype			#I input pixtype
+double	bscale			#I scale factor to applied to input data
+double	bzero			#I offset to applied to input data
+
+int	nchars, nbytes
+bool	fp_equald()
+errchk	syserr
+
+include <szpixtype.inc>
+
+begin
+        nchars = npix * pix_size[pixtype]
+	nbytes = nchars * SZB_CHAR
+
+	switch (pixtype) {
+	case TY_SHORT, TY_USHORT:
+	    if (BYTE_SWAP2 == YES)
+		call bswap2 (cbuf, 1, cbuf, 1, nbytes)
+	    if (pixtype == TY_USHORT)
+		call fxf_altmu (cbuf, cbuf, npix)
+
+	case TY_INT, TY_LONG:
+	    if (BYTE_SWAP4 == YES)
+		call bswap4 (cbuf, 1, cbuf, 1, nbytes)
+
+	case TY_REAL:
+	    ### Rather than perform this test redundantly a flag should be
+	    ### passed in from the high level code telling the routine whether
+	    ### or not it should apply the scaling.  Testing for floating
+	    ### point equality (e.g. bscale != 1.0) is not portable.
+
+	    if (!fp_equald(bscale,1.0d0) || !fp_equald(bzero,0.0d0)) {
+		if (BYTE_SWAP4 == YES)
+		    call bswap4 (cbuf, 1, cbuf, 1, nbytes)
+		call iscl32 (cbuf, cbuf, npix, bscale, bzero)
+	    } else
+		call ieevupkr (cbuf, cbuf, npix)
+	   
+	case TY_DOUBLE:
+	    ### Same as above.
+	    if (!fp_equald(bscale,1.0d0) || !fp_equald(bzero,0.0d0)) {
+		if (BYTE_SWAP4 == YES)
+		    call bswap4 (cbuf, 1, cbuf, 1, nbytes)
+		call iscl64 (cbuf, cbuf, npix, bscale, bzero)
+	    } else
+		call ieevupkd (cbuf, cbuf, npix)
+	   
+	default:
+	    call syserr (SYS_FXFUPKDTY)
+	}
+end
+
+
+# FXF_ALTMR -- Scale a real array.
+
+procedure fxf_altmr (a, b, npix, bscale, bzero)
+
+int	a[ARB]			#I input array
+real	b[ARB]			#O output array
+int	npix			#I number of pixels
+double	bscale, bzero		#I scaling parameters
+
+int	i
+
+begin
+	do i = 1, npix
+	    b[i] = a[i] * bscale + bzero
+end
+			       
+
+# FXF_ALTMD -- Scale a double array.
+
+procedure fxf_altmd (a, b, npix, bscale, bzero)
+
+int	a[ARB]			#I input array
+double	b[ARB]			#O output array
+int	npix			#I number of pixels
+double	bscale, bzero		#I scaling parameters
+
+int	i
+
+begin
+	### int and double are not the same size so if this operation is
+	### to allow an in-place conversion it must go right to left instead
+	### of left to right.
+
+	do i = npix, 1, -1
+	    b[i] = a[i] * bscale + bzero
+end
+
+
+# FXF_ALTMU -- Scale an array to unsigned short.
+
+procedure fxf_altmu (a, b, npix)
+
+short	 a[ARB]			 #I input array
+char	 b[ARB]			 #O output array
+int	 npix			 #I number of pixels
+
+int	i
+pointer sp, ip
+
+begin
+	call smark (sp)
+	call salloc (ip, npix+1, TY_INT)
+		 
+	do i = 1, npix
+	    Memi[ip+i] = a[i] + 32768
+
+	call achtlu (Memi[ip+1], b, npix)
+	call sfree (sp)
+end
+
+
+# FXF_ASTMR -- Scale an input short array into a real.
+
+procedure fxf_astmr (a, b, npix, bscale, bzero)
+
+short	a[ARB]			#I input array
+real	b[ARB]			#O output array
+int	npix			#I number of pixels
+double	bscale, bzero		#I scaling parameters
+
+int	i
+
+begin
+	do i = npix, 1, -1
+	    b[i] = a[i] * bscale + bzero
+end
+			       
+