Imported Healpix, cfitsio, cosmotool. Added cmake tool to build dependencies (cfitsio, hdf5, netcdf, boost, healpix, gsl, ..). Adjusted CMakeLists.txt

external/cfitsio/License.txt

@@ -0,0 +1,25 @@
+Copyright (Unpublished--all rights reserved under the copyright laws of
+the United States), U.S. Government as represented by the Administrator
+of the National Aeronautics and Space Administration.  No copyright is
+claimed in the United States under Title 17, U.S. Code.
+
+Permission to freely use, copy, modify, and distribute this software
+and its documentation without fee is hereby granted, provided that this
+copyright notice and disclaimer of warranty appears in all copies.
+
+DISCLAIMER:
+
+THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND,
+EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO,
+ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY
+IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
+PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE
+DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE
+SOFTWARE WILL BE ERROR FREE.  IN NO EVENT SHALL NASA BE LIABLE FOR ANY
+DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR
+CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY
+CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY,
+CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY
+PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED
+FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR
+SERVICES PROVIDED HEREUNDER.

external/cfitsio/Makefile.in

@@ -0,0 +1,166 @@
+#
+# Makefile for cfitsio library:
+#       libcfits.a
+#
+# Oct-96 : original version by 
+#
+#       JDD/WDP
+#       NASA GSFC
+#       Oct 1996
+#
+# 25-Jan-01 : removed conditional drvrsmem.c compilation because this
+#             is now handled within the source file itself.
+# 09-Mar-98 : modified to conditionally compile drvrsmem.c. Also
+# changes to target all (deleted clean), added DEFS, LIBS, added
+# DEFS to .c.o, added SOURCES_SHMEM and MY_SHMEM, expanded getcol*
+# and putcol* in SOURCES, modified OBJECTS, mv changed to /bin/mv
+# (to bypass aliasing), cp changed to /bin/cp, add smem and
+# testprog targets. See also changes and comments in configure.in
+#
+
+prefix		= @prefix@
+exec_prefix	= @exec_prefix@
+DESTDIR		= 
+CFITSIO_LIB	= ${DESTDIR}@libdir@
+CFITSIO_INCLUDE	= ${DESTDIR}@includedir@
+INSTALL_DIRS	= @INSTALL_ROOT@ ${CFITSIO_INCLUDE} ${CFITSIO_LIB} ${CFITSIO_LIB}/pkgconfig
+
+
+SHELL =		/bin/sh
+RANLIB =	@RANLIB@
+CC =		@CC@
+CFLAGS =	@CFLAGS@
+SSE_FLAGS =	@SSE_FLAGS@
+FC =		@FC@
+LDFLAGS =	$(CFLAGS)
+DEFS =		@DEFS@
+LIBS =		@LIBS@
+FLEX =		flex
+BISON =		bison
+
+SHLIB_LD =	@SHLIB_LD@
+SHLIB_SUFFIX =	@SHLIB_SUFFIX@
+
+
+CORE_SOURCES = 	buffers.c cfileio.c checksum.c drvrfile.c drvrmem.c \
+		drvrnet.c drvrsmem.c drvrgsiftp.c editcol.c edithdu.c eval_l.c \
+		eval_y.c eval_f.c fitscore.c getcol.c getcolb.c getcold.c getcole.c \
+		getcoli.c getcolj.c getcolk.c getcoll.c getcols.c getcolsb.c \
+		getcoluk.c getcolui.c getcoluj.c getkey.c group.c grparser.c \
+		histo.c iraffits.c \
+		modkey.c putcol.c putcolb.c putcold.c putcole.c putcoli.c \
+		putcolj.c putcolk.c putcoluk.c putcoll.c putcols.c putcolsb.c \
+		putcolu.c putcolui.c putcoluj.c putkey.c region.c scalnull.c \
+		swapproc.c wcssub.c wcsutil.c imcompress.c quantize.c ricecomp.c \
+		pliocomp.c fits_hcompress.c fits_hdecompress.c zuncompress.c zcompress.c \
+		adler32.c crc32.c inffast.c inftrees.c trees.c zutil.c \
+		deflate.c infback.c inflate.c uncompr.c \
+
+SOURCES = ${CORE_SOURCES} @F77_WRAPPERS@
+
+OBJECTS = 	${SOURCES:.c=.o}
+
+CORE_OBJECTS = 	${CORE_SOURCES:.c=.o}
+
+
+FITSIO_SRC =	f77_wrap1.c f77_wrap2.c f77_wrap3.c f77_wrap4.c
+
+# ============ description of all targets =============
+#       -  <<-- ignore error code
+
+all:
+		@if [ "x${FC}" = x ]; then \
+			${MAKE} all-nofitsio; \
+		else \
+			${MAKE} stand_alone; \
+		fi
+
+all-nofitsio:
+		${MAKE} stand_alone "FITSIO_SRC="
+
+stand_alone:	libcfitsio.a
+
+libcfitsio.a:	${OBJECTS}
+		ar rv libcfitsio.a ${OBJECTS}; \
+		${RANLIB} libcfitsio.a;
+
+shared: libcfitsio${SHLIB_SUFFIX}
+
+libcfitsio${SHLIB_SUFFIX}: ${OBJECTS}
+		${SHLIB_LD} ${LDFLAGS} -o $@ ${OBJECTS} -lm ${LIBS}
+
+install:	libcfitsio.a $(INSTALL_DIRS)
+		@if [ -f libcfitsio.a ]; then \
+			/bin/mv libcfitsio.a ${CFITSIO_LIB}; \
+		fi; \
+		if [ -f libcfitsio${SHLIB_SUFFIX} ]; then \
+			/bin/mv libcfitsio${SHLIB_SUFFIX} ${CFITSIO_LIB}; \
+		fi; \
+		/bin/cp fitsio.h fitsio2.h longnam.h drvrsmem.h ${CFITSIO_INCLUDE}/; \
+		/bin/cp cfitsio.pc ${CFITSIO_LIB}/pkgconfig
+
+.c.o:
+		$(CC) -c $(CFLAGS) $(DEFS) $<
+
+swapproc.o:	swapproc.c
+		$(CC) -c $(CFLAGS) $(SSE_FLAGS) $(DEFS) $<
+
+smem:		smem.o libcfitsio.a ${OBJECTS}
+		${CC} $(CFLAGS) $(DEFS) -o smem smem.o -L. -lcfitsio -lm
+
+testprog:	testprog.o libcfitsio.a ${OBJECTS}
+		${CC} $(CFLAGS) $(DEFS) -o testprog testprog.o -L. -lcfitsio -lm ${LIBS}
+
+fpack:		fpack.o fpackutil.o libcfitsio.a ${OBJECTS}
+		${CC} $(CFLAGS) $(DEFS) -o fpack fpack.o fpackutil.o libcfitsio.a -lm ${LIBS}
+
+funpack:	funpack.o fpackutil.o libcfitsio.a ${OBJECTS}
+		${CC} $(CFLAGS) $(DEFS) -o funpack funpack.o fpackutil.o libcfitsio.a -lm ${LIBS}
+
+fitscopy:	fitscopy.o libcfitsio.a ${OBJECTS}
+		${CC} $(CFLAGS) $(DEFS) -o fitscopy fitscopy.o -L. -lcfitsio -lm ${LIBS}
+
+speed:		speed.o libcfitsio.a ${OBJECTS}
+		${CC} $(CFLAGS) $(DEFS) -o speed speed.o -L. -lcfitsio -lm ${LIBS}
+
+imcopy:		imcopy.o libcfitsio.a ${OBJECTS}
+		${CC} $(CFLAGS) $(DEFS) -o imcopy imcopy.o -L. -lcfitsio -lm ${LIBS}
+
+listhead:	listhead.o libcfitsio.a ${OBJECTS}
+		${CC} $(CFLAGS) $(DEFS) -o listhead listhead.o -L. -lcfitsio -lm ${LIBS}
+
+cookbook:	cookbook.o libcfitsio.a ${OBJECTS}
+		${CC} $(CFLAGS) $(DEFS) -o cookbook cookbook.o -L. -lcfitsio -lm ${LIBS}
+
+eval:		# Rebuild eval_* files from flex/bison source
+		$(FLEX) -t eval.l > eval_l.c1
+		/bin/sed -e 's/yy/ff/g' -e 's/YY/FF/g' eval_l.c1 > eval_l.c
+		/bin/rm -f eval_l.c1
+		$(BISON) -d -v -y eval.y
+		/bin/sed -e 's/yy/ff/g' -e 's/YY/FF/g' y.tab.c > eval_y.c
+		/bin/sed -e 's/yy/ff/g' -e 's/YY/FF/g' y.tab.h > eval_tab.h
+		/bin/rm -f y.tab.c y.tab.h
+
+clean:
+	-	/bin/rm -f *.o libcfitsio.a libcfitsio${SHLIB_SUFFIX} \
+			smem testprog y.output
+
+distclean:	clean
+	-	/bin/rm -f Makefile cfitsio.pc config.* configure.lineno
+
+# Make target which outputs the list of the .o contained in the cfitsio lib
+# usefull to build a single big shared library containing Tcl/Tk and other
+# extensions.  used for the Tcl Plugin. 
+
+cfitsioLibObjs:
+	@echo ${CORE_OBJECTS}
+
+cfitsioLibSrcs:
+	@echo ${SOURCES}
+
+# This target actually builds the objects needed for the lib in the above
+# case
+objs: ${CORE_OBJECTS}
+
+$(INSTALL_DIRS):
+	@if [ ! -d $@ ]; then mkdir -p $@; fi

external/cfitsio/README

@@ -0,0 +1,144 @@
+                   CFITSIO Interface Library
+
+CFITSIO is a library of ANSI C routines for reading and writing FITS
+format data files.  A set of Fortran-callable wrapper routines are also
+included for the convenience of Fortran programmers.  This README file
+gives a brief summary of how to build and test CFITSIO, but the CFITSIO
+User's Guide, found in the files cfitsio.doc (plain text), cfitsio.tex
+(LaTeX source file), cfitsio.ps, or cfitsio.pdf should be
+referenced for the latest and most complete information.
+
+BUILDING CFITSIO
+----------------
+
+The CFITSIO code is contained in about 40 *.c source files and several *.h
+header files.  The CFITSIO library is built on Unix systems by typing:
+
+ >  ./configure [--prefix=/target/installation/path]
+ >  make          (or  'make shared')
+ >  make install  (this step is optional)
+
+at the operating system prompt.  The configure command customizes the
+Makefile for the particular system, then the `make' command compiles the
+source files and builds the library.  Type `./configure' and not simply
+`configure' to ensure that the configure script in the current directory
+is run and not some other system-wide configure script.  The optional
+'prefix' argument to configure gives the path to the directory where
+the CFITSIO library and include files should be installed via the later
+'make install' command. For example,
+
+   > ./configure --prefix=/usr1/local
+
+will cause the 'make install' command to copy the CFITSIO libcfitsio file 
+to /usr1/local/lib and the necessary include files to /usr1/local/include
+(assuming of course that the  process has permission to write to these 
+directories).
+
+On VAX/VMS and ALPHA/VMS systems the make.com command file may be used
+to build the cfitsio.olb object library using the default G-floating
+point option for double variables.  The make\_dfloat.com and make\_ieee.com
+files may be used instead to build the library with the other floating
+point options.
+
+A precompiled DLL version of CFITSIO is available for IBM-PC users of
+the Borland or Microsoft Visual C++ compilers in the files
+cfitsiodll_xxxx_borland.zip and cfitsiodll_xxxx_vcc.zip, where 'xxxx'
+represents the current release number.  These zip archives also
+contains other files and instructions on how to use the CFITSIO DLL
+library. The CFITSIO library may also be built from the source code
+using the makefile.bc or makefile.vcc  files.  Finally, the makepc.bat
+file gives an example of  building CFITSIO with the Borland C++ v4.5
+compiler using simpler DOS commands.
+
+When building on Mac OS-X, users should follow the Unix instructions,
+above. Previous MacOS versions of the cfitsio library can be built by
+(1) un binhex and unstuff cfitsio_mac.sit.hqx, (2) put CFitsioPPC.mcp
+in the cfitsio directory, and (3) load CFitsioPPC.mcp into CodeWarrior
+Pro 5 and make.  This builds the cfitsio library for PPC.  There are
+also targets for both the test program and the speed test program.
+
+To use the MacOS port you can add Cfitsio PPC.lib to your Codewarrior
+Pro 5 project.  Note that this only has been tested for the PPC and
+probably won't work
+ on 68k macs.
+
+TESTING CFITSIO
+---------------
+
+The CFITSIO library should be tested by building and running
+the testprog.c program that is included with the release. 
+On Unix systems, type:
+-
+    % make testprog
+    % testprog > testprog.lis
+    % diff testprog.lis testprog.out
+    % cmp testprog.fit testprog.std
+-
+ On VMS systems,
+(assuming cc is the name of the C compiler command), type:
+-
+    $ cc testprog.c
+    $ link testprog, cfitsio/lib
+    $ run testprog
+-
+The testprog program should produce a FITS file called `testprog.fit'
+that is identical to the testprog.std FITS file included in this
+release.  The diagnostic messages (which were piped to the file
+testprog.lis in the Unix example) should be identical to the listing
+contained in the file testprog.out.  The 'diff' and 'cmp' commands
+shown above should not report any differences in the files.
+
+USING CFITSIO
+-------------
+
+The CFITSIO User's Guide, contained in the files cfitsio.doc (plain
+text file) and cfitsio.ps (postscript file), provides detailed
+documentation about how to build and use the CFITSIO library.
+It contains a description of every user-callable routine in the
+CFITSIO interface.
+
+The cookbook.c file provides some sample routines for performing common
+operations on various types of FITS files.  Programmers are urged to
+examine these routines for recommended programming practices when using
+CFITSIO.  Users are free to copy or modify these routines for their own
+purposes.
+
+SUPPORTED PLATFORMS
+-------------------
+
+CFITSIO has currently been tested on the following platforms:
+
+   Operating System          Compiler
+   ----------------          --------
+  OPERATING SYSTEM           COMPILER
+   Sun OS                     gcc and cc (3.0.1)
+   Sun Solaris                gcc and cc
+   Silicon Graphics IRIX      gcc and cc
+   Silicon Graphics IRIX64    MIPS
+   Dec Alpha OSF/1            gcc and cc
+   DECstation  Ultrix         gcc
+   Dec Alpha OpenVMS          cc 
+   DEC VAX/VMS                gcc and cc
+   HP-UX                      gcc
+   IBM AIX                    gcc
+   Linux                      gcc
+   MkLinux                    DR3
+   Windows 95/98/NT           Borland C++ V4.5
+   Windows 95/98/NT/ME/XP     Microsoft/Compaq Visual C++ v5.0, v6.0
+   Windows 95/98/NT           Cygwin gcc
+   OS/2                       gcc + EMX
+   Mac OS 7.1 or greater      Metrowerks 10.+
+   Mac OS-X 10.1 or greater   cc (gcc)
+
+CFITSIO will probably run on most other Unix platforms without
+modification.  Cray supercomputers and IBM mainframe computers are
+currently not supported.
+
+Reports of any success or failure to run CFITSIO on other platforms
+would be appreciated.  Any problem reports or suggestions for
+improvements are also welcome and should be sent to the primary author.
+
+-------------------------------------------------------------------------
+William D. Pence
+HEASARC, NASA/GSFC
+email: William.D.Pence@nasa.gov

external/cfitsio/README.MacOS

@@ -0,0 +1,70 @@
+To build CFITSIO library on an Intel Mac as a Universal Binary
+
+Unzip the library:
+- tar xzf cfitsio3060.tar.gz (or whatever version this is)
+
+- cd cfitsio/
+
+- copy the cfitsio-xcodeproj.zip file here
+
+- unzip cfitsio-xcodeproj.zip
+
+- start Xcode and open cfitsio.xcodeproj
+
+- expand the "Targets" menu under "Groups & Files" 
+
+- choose one of the following build options:
+
+  * right-click on Build PPC -> Build "Build PPC"
+
+  * right-click on Build i386 -> Build "Build i386"
+
+  * right-click on Build x86_64 -> Build "Build x86_64"
+
+  * right-click on Build Universal -> Build "Build Universal"
+    (Builds all three of the above options, i.e. a Universal Binary
+     usable on ppc, i386, and x86_64 architectures)
+
+  (For some reason clicking on the menu "Build" icon doesn't seem to
+   work correctly, but the right-click menus do).
+
+-------------------------------------------------------
+
+Another way to build the universal binary:
+
+- unpack the cfitsio source code tar file
+- cd cfitsio
+
+Set the CFLAGS environment variable for building a Universal Binary:
+
+  C-Shell variants:
+  setenv CFLAGS "-arch ppc -arch i386 -arch x86_64 -g -O2"
+
+  Bourne Shell variants:
+  export CFLAGS="-arch ppc -arch i386 -arch x86_64 -g -O2"
+
+Then proceed with the standard cfitsio build, i.e.:
+
+- ./configure
+- make
+- make install
+
+
+-------------------------------------------------------
+
+Below, are the old (and now obsolete) instructions for building CFITSIO
+on classic Mac OS-9 or earlier versions:
+
+1. Un binhex and unstuff cfitsio_mac.sit.hqx
+2. put CFitsioPPC.mcp in the cfitsio directory.
+2. Load CFitsioPPC.mcp into CodeWarrior Pro 5 and make.
+   This builds the cfitsio library for PPC.  There are also targets for both 
+   the test program and the speed test program.
+
+To use the MacOS port you can add Cfitsio PPC.lib to your Codewarrior Pro 5
+project.  Note that this only has been tested for the PPC. It probably
+won't work on 68k macs.  Also note that the fortran bindings aren't
+included.  I haven't worked with the codewarrior f2c plugin so I don't know
+how these would work.  If one is interested, please write and I can look
+into this.
+

external/cfitsio/README.win32

@@ -0,0 +1,74 @@
+     Instructions on using CFITSIO on Windows platforms for C programmers
+
+These instructions use a simple DOS-style command window. It is also possible
+to build and use CFITSIO within a GUI programming environment such as Visual
+Studio, but this is not supported here.
+
+===============================================================================
+1.  Build the CFITSIO dll library  
+
+This step will create the cfitsio.def, cfitsio.dll, and cfitsio.lib files.
+(If you downloaded the CFITSIO .zip file that contains the pre-built binary
+.dll file, then SKIP THIS STEP).
+
+  A. With Microsoft Visual C++:
+
+      1. Open a DOS command window and execute the vcvars32.bat file that 
+         is distributed with older versions of Visual C++, or simply open 
+         the Visual C++ command window (e.g., when using Visual Studio 2010).
+
+      2. Unpack the CFITSIO source files (cfitxxxx.zip) into a new empty directory
+
+      3. In the DOS command window, cd to that directory and enter the 
+         following commands:
+
+		nmake winDumpExts.mak
+		nmake makefile.vcc
+			(ignore the compiler warning messages)
+
+  B: With  Borland C++:
+
+     First, follow the instructions provided by Borland to set up
+     the proper environment variables and configure files for the compiler.
+   
+     Unpack the cfitsio.zip source file distribution into a suitable directory.
+   
+     In a DOS command window, cd to that directory and then execute the 
+     makepc.bat batch file on the command line to build the CFITSIO library, 
+     and the testprog and cookbook sample programs.
+
+===============================================================================
+2.  Test the CFITSIO library with Visual C++
+
+     Compile and link the testprog.c test program.  When using Visual Studio,
+     the command is:
+
+		cl /MD testprog.c cfitsio.lib
+
+
+     This will create the testprog.exe executable program.  Running this
+     program should print out a long series of diagnostic messages
+     that should end with "Status = 0; OK - no error"
+
+===============================================================================
+3.  Compile and link an application program that calls CFITSIO routines
+    with Visual C++
+
+	Include the fitsio.h and longnam.h header files in the C source code.
+
+	Link the program with the cfitsio.lib file:
+
+		cl /MD your_program.c cfitsio.lib
+
+
+	NOTE: The /MD command line switch must be specified on the cl
+	command line to force the compiler/linker to use the
+	appropriete runtime library.   If this switch is omitted, then
+	the fits_report_error function in CFITSIO will likely crash.  
+
+	When building programs in the Visual Studio environment, one
+	can force the equivalent of the /MD switch by selecting
+	'Settings...' under the 'Project' menu, then click on the C/C++
+	tab and select the 'Code Generator' category.  Then under 'User
+	Run-time Library' select 'Multithreaded DLL'.
+

external/cfitsio/adler32.c

@@ -0,0 +1,167 @@
+/* adler32.c -- compute the Adler-32 checksum of a data stream
+ * Copyright (C) 1995-2007 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "zutil.h"
+
+#define local static
+
+local uLong adler32_combine_(uLong adler1, uLong adler2, z_off64_t len2);
+
+#define BASE 65521UL    /* largest prime smaller than 65536 */
+#define NMAX 5552
+/* NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 */
+
+#define DO1(buf,i)  {adler += (buf)[i]; sum2 += adler;}
+#define DO2(buf,i)  DO1(buf,i); DO1(buf,i+1);
+#define DO4(buf,i)  DO2(buf,i); DO2(buf,i+2);
+#define DO8(buf,i)  DO4(buf,i); DO4(buf,i+4);
+#define DO16(buf)   DO8(buf,0); DO8(buf,8);
+
+/* use NO_DIVIDE if your processor does not do division in hardware */
+#ifdef NO_DIVIDE
+#  define MOD(a) \
+    do { \
+        if (a >= (BASE << 16)) a -= (BASE << 16); \
+        if (a >= (BASE << 15)) a -= (BASE << 15); \
+        if (a >= (BASE << 14)) a -= (BASE << 14); \
+        if (a >= (BASE << 13)) a -= (BASE << 13); \
+        if (a >= (BASE << 12)) a -= (BASE << 12); \
+        if (a >= (BASE << 11)) a -= (BASE << 11); \
+        if (a >= (BASE << 10)) a -= (BASE << 10); \
+        if (a >= (BASE << 9)) a -= (BASE << 9); \
+        if (a >= (BASE << 8)) a -= (BASE << 8); \
+        if (a >= (BASE << 7)) a -= (BASE << 7); \
+        if (a >= (BASE << 6)) a -= (BASE << 6); \
+        if (a >= (BASE << 5)) a -= (BASE << 5); \
+        if (a >= (BASE << 4)) a -= (BASE << 4); \
+        if (a >= (BASE << 3)) a -= (BASE << 3); \
+        if (a >= (BASE << 2)) a -= (BASE << 2); \
+        if (a >= (BASE << 1)) a -= (BASE << 1); \
+        if (a >= BASE) a -= BASE; \
+    } while (0)
+#  define MOD4(a) \
+    do { \
+        if (a >= (BASE << 4)) a -= (BASE << 4); \
+        if (a >= (BASE << 3)) a -= (BASE << 3); \
+        if (a >= (BASE << 2)) a -= (BASE << 2); \
+        if (a >= (BASE << 1)) a -= (BASE << 1); \
+        if (a >= BASE) a -= BASE; \
+    } while (0)
+#else
+#  define MOD(a) a %= BASE
+#  define MOD4(a) a %= BASE
+#endif
+
+/* ========================================================================= */
+uLong ZEXPORT adler32(adler, buf, len)
+    uLong adler;
+    const Bytef *buf;
+    uInt len;
+{
+    unsigned long sum2;
+    unsigned n;
+
+    /* split Adler-32 into component sums */
+    sum2 = (adler >> 16) & 0xffff;
+    adler &= 0xffff;
+
+    /* in case user likes doing a byte at a time, keep it fast */
+    if (len == 1) {
+        adler += buf[0];
+        if (adler >= BASE)
+            adler -= BASE;
+        sum2 += adler;
+        if (sum2 >= BASE)
+            sum2 -= BASE;
+        return adler | (sum2 << 16);
+    }
+
+    /* initial Adler-32 value (deferred check for len == 1 speed) */
+    if (buf == Z_NULL)
+        return 1L;
+
+    /* in case short lengths are provided, keep it somewhat fast */
+    if (len < 16) {
+        while (len--) {
+            adler += *buf++;
+            sum2 += adler;
+        }
+        if (adler >= BASE)
+            adler -= BASE;
+        MOD4(sum2);             /* only added so many BASE's */
+        return adler | (sum2 << 16);
+    }
+
+    /* do length NMAX blocks -- requires just one modulo operation */
+    while (len >= NMAX) {
+        len -= NMAX;
+        n = NMAX / 16;          /* NMAX is divisible by 16 */
+        do {
+            DO16(buf);          /* 16 sums unrolled */
+            buf += 16;
+        } while (--n);
+        MOD(adler);
+        MOD(sum2);
+    }
+
+    /* do remaining bytes (less than NMAX, still just one modulo) */
+    if (len) {                  /* avoid modulos if none remaining */
+        while (len >= 16) {
+            len -= 16;
+            DO16(buf);
+            buf += 16;
+        }
+        while (len--) {
+            adler += *buf++;
+            sum2 += adler;
+        }
+        MOD(adler);
+        MOD(sum2);
+    }
+
+    /* return recombined sums */
+    return adler | (sum2 << 16);
+}
+
+/* ========================================================================= */
+local uLong adler32_combine_(adler1, adler2, len2)
+    uLong adler1;
+    uLong adler2;
+    z_off64_t len2;
+{
+    unsigned long sum1;
+    unsigned long sum2;
+    unsigned rem;
+
+    /* the derivation of this formula is left as an exercise for the reader */
+    rem = (unsigned)(len2 % BASE);
+    sum1 = adler1 & 0xffff;
+    sum2 = rem * sum1;
+    MOD(sum2);
+    sum1 += (adler2 & 0xffff) + BASE - 1;
+    sum2 += ((adler1 >> 16) & 0xffff) + ((adler2 >> 16) & 0xffff) + BASE - rem;
+    if (sum1 >= BASE) sum1 -= BASE;
+    if (sum1 >= BASE) sum1 -= BASE;
+    if (sum2 >= (BASE << 1)) sum2 -= (BASE << 1);
+    if (sum2 >= BASE) sum2 -= BASE;
+    return sum1 | (sum2 << 16);
+}
+
+/* ========================================================================= */
+uLong ZEXPORT adler32_combine(adler1, adler2, len2)
+    uLong adler1;
+    uLong adler2;
+    z_off_t len2;
+{
+    return adler32_combine_(adler1, adler2, len2);
+}
+
+uLong ZEXPORT adler32_combine64(adler1, adler2, len2)
+    uLong adler1;
+    uLong adler2;
+    z_off64_t len2;
+{
+    return adler32_combine_(adler1, adler2, len2);
+}

external/cfitsio/cfitsio.pc.in

@@ -0,0 +1,11 @@
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+includedir=@includedir@
+
+Name: cfitsio
+Description: FITS File Subroutine Library
+Version: 3.31
+Libs: -L${libdir} -lcfitsio @LIBS@
+Libs.private: -lm
+Cflags: -I${includedir}

external/cfitsio/checksum.c

@@ -0,0 +1,508 @@
+/*  This file, checksum.c, contains the checksum-related routines in the   */
+/*  FITSIO library.                                                        */
+
+/*  The FITSIO software was written by William Pence at the High Energy    */
+/*  Astrophysic Science Archive Research Center (HEASARC) at the NASA      */
+/*  Goddard Space Flight Center.                                           */
+
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+/*------------------------------------------------------------------------*/
+int ffcsum(fitsfile *fptr,      /* I - FITS file pointer                  */
+           long nrec,           /* I - number of 2880-byte blocks to sum  */
+           unsigned long *sum,  /* IO - accumulated checksum              */
+           int *status)         /* IO - error status                      */
+/*
+    Calculate a 32-bit 1's complement checksum of the FITS 2880-byte blocks.
+    This routine is based on the C algorithm developed by Rob
+    Seaman at NOAO that was presented at the 1994 ADASS conference,  
+    published in the Astronomical Society of the Pacific Conference Series.
+    This uses a 32-bit 1's complement checksum in which the overflow bits
+    are permuted back into the sum and therefore all bit positions are
+    sampled evenly. 
+*/
+{
+    long ii, jj;
+    unsigned short sbuf[1440];
+    unsigned long hi, lo, hicarry, locarry;
+
+    if (*status > 0)
+        return(*status);
+  /*
+    Sum the specified number of FITS 2880-byte records.  This assumes that
+    the FITSIO file pointer points to the start of the records to be summed.
+    Read each FITS block as 1440 short values (do byte swapping if needed).
+  */
+    for (jj = 0; jj < nrec; jj++)
+    {
+      ffgbyt(fptr, 2880, sbuf, status);
+
+#if BYTESWAPPED
+
+      ffswap2( (short *)sbuf, 1440); /* reverse order of bytes in each value */
+
+#endif
+
+      hi = (*sum >> 16);
+      lo = *sum & 0xFFFF;
+
+      for (ii = 0; ii < 1440; ii += 2)
+      {
+        hi += sbuf[ii];
+        lo += sbuf[ii+1];
+      }
+
+      hicarry = hi >> 16;    /* fold carry bits in */
+      locarry = lo >> 16;
+
+      while (hicarry | locarry)
+      {
+        hi = (hi & 0xFFFF) + locarry;
+        lo = (lo & 0xFFFF) + hicarry;
+        hicarry = hi >> 16;
+        locarry = lo >> 16;
+      }
+
+      *sum = (hi << 16) + lo;
+    }
+    return(*status);
+}
+/*-------------------------------------------------------------------------*/
+void ffesum(unsigned long sum,  /* I - accumulated checksum                */
+           int complm,          /* I - = 1 to encode complement of the sum */
+           char *ascii)         /* O - 16-char ASCII encoded checksum      */
+/*
+    encode the 32 bit checksum by converting every 
+    2 bits of each byte into an ASCII character (32 bit word encoded 
+    as 16 character string).   Only ASCII letters and digits are used
+    to encode the values (no ASCII punctuation characters).
+
+    If complm=TRUE, then the complement of the sum will be encoded.
+
+    This routine is based on the C algorithm developed by Rob
+    Seaman at NOAO that was presented at the 1994 ADASS conference,
+    published in the Astronomical Society of the Pacific Conference Series.
+*/
+{
+    unsigned int exclude[13] = { 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f, 0x40,
+                                       0x5b, 0x5c, 0x5d, 0x5e, 0x5f, 0x60 };
+    unsigned long mask[4] = { 0xff000000, 0xff0000, 0xff00, 0xff  };
+
+    int offset = 0x30;     /* ASCII 0 (zero) */
+
+    unsigned long value;
+    int byte, quotient, remainder, ch[4], check, ii, jj, kk;
+    char asc[32];
+
+    if (complm)
+        value = 0xFFFFFFFF - sum;   /* complement each bit of the value */
+    else
+        value = sum;
+
+    for (ii = 0; ii < 4; ii++)
+    {
+        byte = (value & mask[ii]) >> (24 - (8 * ii));
+        quotient = byte / 4 + offset;
+        remainder = byte % 4;
+        for (jj = 0; jj < 4; jj++)
+            ch[jj] = quotient;
+
+        ch[0] += remainder;
+
+        for (check = 1; check;)   /* avoid ASCII  punctuation */
+            for (check = 0, kk = 0; kk < 13; kk++)
+                for (jj = 0; jj < 4; jj += 2)
+                    if ((unsigned char) ch[jj] == exclude[kk] ||
+                        (unsigned char) ch[jj+1] == exclude[kk])
+                    {
+                        ch[jj]++;
+                        ch[jj+1]--;
+                        check++;
+                    }
+
+        for (jj = 0; jj < 4; jj++)        /* assign the bytes */
+            asc[4*jj+ii] = ch[jj];
+    }
+
+    for (ii = 0; ii < 16; ii++)       /* shift the bytes 1 to the right */
+        ascii[ii] = asc[(ii+15)%16];
+
+    ascii[16] = '\0';
+}
+/*-------------------------------------------------------------------------*/
+unsigned long ffdsum(char *ascii,  /* I - 16-char ASCII encoded checksum   */
+                     int complm,   /* I - =1 to decode complement of the   */
+                     unsigned long *sum)  /* O - 32-bit checksum           */
+/*
+    decode the 16-char ASCII encoded checksum into an unsigned 32-bit long.
+    If complm=TRUE, then the complement of the sum will be decoded.
+
+    This routine is based on the C algorithm developed by Rob
+    Seaman at NOAO that was presented at the 1994 ADASS conference,
+    published in the Astronomical Society of the Pacific Conference Series.
+*/
+{
+    char cbuf[16];
+    unsigned long hi = 0, lo = 0, hicarry, locarry;
+    int ii;
+
+    /* remove the permuted FITS byte alignment and the ASCII 0 offset */
+    for (ii = 0; ii < 16; ii++)
+    {
+        cbuf[ii] = ascii[(ii+1)%16];
+        cbuf[ii] -= 0x30;
+    }
+
+    for (ii = 0; ii < 16; ii += 4)
+    {
+        hi += (cbuf[ii]   << 8) + cbuf[ii+1];
+        lo += (cbuf[ii+2] << 8) + cbuf[ii+3];
+    }
+
+    hicarry = hi >> 16;
+    locarry = lo >> 16;
+    while (hicarry || locarry)
+    {
+        hi = (hi & 0xFFFF) + locarry;
+        lo = (lo & 0xFFFF) + hicarry;
+        hicarry = hi >> 16;
+        locarry = lo >> 16;
+    }
+
+    *sum = (hi << 16) + lo;
+    if (complm)
+        *sum = 0xFFFFFFFF - *sum;   /* complement each bit of the value */
+
+    return(*sum);
+}
+/*------------------------------------------------------------------------*/
+int ffpcks(fitsfile *fptr,      /* I - FITS file pointer                  */
+           int *status)         /* IO - error status                      */
+/*
+   Create or update the checksum keywords in the CHDU.  These keywords
+   provide a checksum verification of the FITS HDU based on the ASCII
+   coded 1's complement checksum algorithm developed by Rob Seaman at NOAO.
+*/
+{
+    char datestr[20], checksum[FLEN_VALUE], datasum[FLEN_VALUE];
+    char  comm[FLEN_COMMENT], chkcomm[FLEN_COMMENT], datacomm[FLEN_COMMENT];
+    int tstatus;
+    long nrec;
+    LONGLONG headstart, datastart, dataend;
+    unsigned long dsum, olddsum, sum;
+    double tdouble;
+
+    if (*status > 0)           /* inherit input status value if > 0 */
+        return(*status);
+
+    /* generate current date string and construct the keyword comments */
+    ffgstm(datestr, NULL, status);
+    strcpy(chkcomm, "HDU checksum updated ");
+    strcat(chkcomm, datestr);
+    strcpy(datacomm, "data unit checksum updated ");
+    strcat(datacomm, datestr);
+
+    /* write the CHECKSUM keyword if it does not exist */
+    tstatus = *status;
+    if (ffgkys(fptr, "CHECKSUM", checksum, comm, status) == KEY_NO_EXIST)
+    {
+        *status = tstatus;
+        strcpy(checksum, "0000000000000000");
+        ffpkys(fptr, "CHECKSUM", checksum, chkcomm, status);
+    }
+
+    /* write the DATASUM keyword if it does not exist */
+    tstatus = *status;
+    if (ffgkys(fptr, "DATASUM", datasum, comm, status) == KEY_NO_EXIST)
+    {
+        *status = tstatus;
+        olddsum = 0;
+        ffpkys(fptr, "DATASUM", "         0", datacomm, status);
+
+        /* set the CHECKSUM keyword as undefined, if it isn't already */
+        if (strcmp(checksum, "0000000000000000") )
+        {
+            strcpy(checksum, "0000000000000000");
+            ffmkys(fptr, "CHECKSUM", checksum, chkcomm, status);
+        }
+    }
+    else
+    {
+        /* decode the datasum into an unsigned long variable */
+
+        /* olddsum = strtoul(datasum, 0, 10); doesn't work on SUN OS */
+
+        tdouble = atof(datasum);
+        olddsum = (unsigned long) tdouble;
+    }
+
+    /* close header: rewrite END keyword and following blank fill */
+    /* and re-read the required keywords to determine the structure */
+    if (ffrdef(fptr, status) > 0)
+        return(*status);
+
+    if ((fptr->Fptr)->heapsize > 0)
+         ffuptf(fptr, status);  /* update the variable length TFORM values */
+
+    /* write the correct data fill values, if they are not already correct */
+    if (ffpdfl(fptr, status) > 0)
+        return(*status);
+
+    /* calc size of data unit, in FITS 2880-byte blocks */
+    if (ffghadll(fptr, &headstart, &datastart, &dataend, status) > 0)
+        return(*status);
+
+    nrec = (long) ((dataend - datastart) / 2880);
+    dsum = 0;
+
+    if (nrec > 0)
+    {
+        /* accumulate the 32-bit 1's complement checksum */
+        ffmbyt(fptr, datastart, REPORT_EOF, status);
+        if (ffcsum(fptr, nrec, &dsum, status) > 0)
+            return(*status);
+    }
+
+    if (dsum != olddsum)
+    {
+        /* update the DATASUM keyword with the correct value */ 
+        sprintf(datasum, "%lu", dsum);
+        ffmkys(fptr, "DATASUM", datasum, datacomm, status);
+
+        /* set the CHECKSUM keyword as undefined, if it isn't already */
+        if (strcmp(checksum, "0000000000000000") )
+        {
+            strcpy(checksum, "0000000000000000");
+            ffmkys(fptr, "CHECKSUM", checksum, chkcomm, status);
+        }
+    }        
+
+    if (strcmp(checksum, "0000000000000000") )
+    {
+        /* check if CHECKSUM is still OK; move to the start of the header */
+        ffmbyt(fptr, headstart, REPORT_EOF, status);
+
+        /* accumulate the header checksum into the previous data checksum */
+        nrec = (long) ((datastart - headstart) / 2880);
+        sum = dsum;
+        if (ffcsum(fptr, nrec, &sum, status) > 0)
+            return(*status);
+
+        if (sum == 0 || sum == 0xFFFFFFFF)
+           return(*status);            /* CHECKSUM is correct */
+
+        /* Zero the CHECKSUM and recompute the new value */
+        ffmkys(fptr, "CHECKSUM", "0000000000000000", chkcomm, status);
+    }
+
+    /* move to the start of the header */
+    ffmbyt(fptr, headstart, REPORT_EOF, status);
+
+    /* accumulate the header checksum into the previous data checksum */
+    nrec = (long) ((datastart - headstart) / 2880);
+    sum = dsum;
+    if (ffcsum(fptr, nrec, &sum, status) > 0)
+           return(*status);
+
+    /* encode the COMPLEMENT of the checksum into a 16-character string */
+    ffesum(sum, TRUE, checksum);
+
+    /* update the CHECKSUM keyword value with the new string */
+    ffmkys(fptr, "CHECKSUM", checksum, "&", status);
+
+    return(*status);
+}
+/*------------------------------------------------------------------------*/
+int ffupck(fitsfile *fptr,      /* I - FITS file pointer                  */
+           int *status)         /* IO - error status                      */
+/*
+   Update the CHECKSUM keyword value.  This assumes that the DATASUM
+   keyword exists and has the correct value.
+*/
+{
+    char datestr[20], chkcomm[FLEN_COMMENT], comm[FLEN_COMMENT];
+    char checksum[FLEN_VALUE], datasum[FLEN_VALUE];
+    int tstatus;
+    long nrec;
+    LONGLONG headstart, datastart, dataend;
+    unsigned long sum, dsum;
+    double tdouble;
+
+    if (*status > 0)           /* inherit input status value if > 0 */
+        return(*status);
+
+    /* generate current date string and construct the keyword comments */
+    ffgstm(datestr, NULL, status);
+    strcpy(chkcomm, "HDU checksum updated ");
+    strcat(chkcomm, datestr);
+
+    /* get the DATASUM keyword and convert it to a unsigned long */
+    if (ffgkys(fptr, "DATASUM", datasum, comm, status) == KEY_NO_EXIST)
+    {
+        ffpmsg("DATASUM keyword not found (ffupck");
+        return(*status);
+    }
+
+    tdouble = atof(datasum); /* read as a double as a workaround */
+    dsum = (unsigned long) tdouble;
+
+    /* get size of the HDU */
+    if (ffghadll(fptr, &headstart, &datastart, &dataend, status) > 0)
+        return(*status);
+
+    /* get the checksum keyword, if it exists */
+    tstatus = *status;
+    if (ffgkys(fptr, "CHECKSUM", checksum, comm, status) == KEY_NO_EXIST)
+    {
+        *status = tstatus;
+        strcpy(checksum, "0000000000000000");
+        ffpkys(fptr, "CHECKSUM", checksum, chkcomm, status);
+    }
+    else
+    {
+        /* check if CHECKSUM is still OK */
+        /* rewrite END keyword and following blank fill */
+        if (ffwend(fptr, status) > 0)
+            return(*status);
+
+        /* move to the start of the header */
+        ffmbyt(fptr, headstart, REPORT_EOF, status);
+
+        /* accumulate the header checksum into the previous data checksum */
+        nrec = (long) ((datastart - headstart) / 2880);
+        sum = dsum;
+        if (ffcsum(fptr, nrec, &sum, status) > 0)
+           return(*status);
+
+        if (sum == 0 || sum == 0xFFFFFFFF)
+           return(*status);    /* CHECKSUM is already correct */
+
+        /* Zero the CHECKSUM and recompute the new value */
+        ffmkys(fptr, "CHECKSUM", "0000000000000000", chkcomm, status);
+    }
+
+    /* move to the start of the header */
+    ffmbyt(fptr, headstart, REPORT_EOF, status);
+
+    /* accumulate the header checksum into the previous data checksum */
+    nrec = (long) ((datastart - headstart) / 2880);
+    sum = dsum;
+    if (ffcsum(fptr, nrec, &sum, status) > 0)
+           return(*status);
+
+    /* encode the COMPLEMENT of the checksum into a 16-character string */
+    ffesum(sum, TRUE, checksum);
+
+    /* update the CHECKSUM keyword value with the new string */
+    ffmkys(fptr, "CHECKSUM", checksum, "&", status);
+
+    return(*status);
+}
+/*------------------------------------------------------------------------*/
+int ffvcks(fitsfile *fptr,      /* I - FITS file pointer                  */
+           int *datastatus,     /* O - data checksum status               */
+           int *hdustatus,      /* O - hdu checksum status                */
+                                /*     1  verification is correct         */
+                                /*     0  checksum keyword is not present */
+                                /*    -1 verification not correct         */
+           int *status)         /* IO - error status                      */
+/*
+    Verify the HDU by comparing the value of the computed checksums against
+    the values of the DATASUM and CHECKSUM keywords if they are present.
+*/
+{
+    int tstatus;
+    double tdouble;
+    unsigned long datasum, hdusum, olddatasum;
+    char chksum[FLEN_VALUE], comm[FLEN_COMMENT];
+
+    if (*status > 0)           /* inherit input status value if > 0 */
+        return(*status);
+
+    *datastatus = -1;
+    *hdustatus  = -1;
+
+    tstatus = *status;
+    if (ffgkys(fptr, "CHECKSUM", chksum, comm, status) == KEY_NO_EXIST)
+    {
+        *hdustatus = 0;             /* CHECKSUM keyword does not exist */
+        *status = tstatus;
+    }
+    if (chksum[0] == '\0')
+        *hdustatus = 0;    /* all blank checksum means it is undefined */
+
+    if (ffgkys(fptr, "DATASUM", chksum, comm, status) == KEY_NO_EXIST)
+    {
+        *datastatus = 0;            /* DATASUM keyword does not exist */
+        *status = tstatus;
+    }
+    if (chksum[0] == '\0')
+        *datastatus = 0;    /* all blank checksum means it is undefined */
+
+    if ( *status > 0 || (!(*hdustatus) && !(*datastatus)) )
+        return(*status);            /* return if neither keywords exist */
+
+    /* convert string to unsigned long */
+
+    /* olddatasum = strtoul(chksum, 0, 10);  doesn't work w/ gcc on SUN OS */
+    /* sscanf(chksum, "%u", &olddatasum);   doesn't work w/ cc on VAX/VMS */
+
+    tdouble = atof(chksum); /* read as a double as a workaround */
+    olddatasum = (unsigned long) tdouble;
+
+    /*  calculate the data checksum and the HDU checksum */
+    if (ffgcks(fptr, &datasum, &hdusum, status) > 0)
+        return(*status);
+
+    if (*datastatus)
+        if (datasum == olddatasum)
+            *datastatus = 1;
+
+    if (*hdustatus)
+        if (hdusum == 0 || hdusum == 0xFFFFFFFF)
+            *hdustatus = 1;
+
+    return(*status);
+}
+/*------------------------------------------------------------------------*/
+int ffgcks(fitsfile *fptr,           /* I - FITS file pointer             */
+           unsigned long *datasum,   /* O - data checksum                 */
+           unsigned long *hdusum,    /* O - hdu checksum                  */
+           int *status)              /* IO - error status                 */
+
+    /* calculate the checksums of the data unit and the total HDU */
+{
+    long nrec;
+    LONGLONG headstart, datastart, dataend;
+
+    if (*status > 0)           /* inherit input status value if > 0 */
+        return(*status);
+
+    /* get size of the HDU */
+    if (ffghadll(fptr, &headstart, &datastart, &dataend, status) > 0)
+        return(*status);
+
+    nrec = (long) ((dataend - datastart) / 2880);
+
+    *datasum = 0;
+
+    if (nrec > 0)
+    {
+        /* accumulate the 32-bit 1's complement checksum */
+        ffmbyt(fptr, datastart, REPORT_EOF, status);
+        if (ffcsum(fptr, nrec, datasum, status) > 0)
+            return(*status);
+    }
+
+    /* move to the start of the header and calc. size of header */
+    ffmbyt(fptr, headstart, REPORT_EOF, status);
+    nrec = (long) ((datastart - headstart) / 2880);
+
+    /* accumulate the header checksum into the previous data checksum */
+    *hdusum = *datasum;
+    ffcsum(fptr, nrec, hdusum, status);
+
+    return(*status);
+}
+

external/cfitsio/configure.in

@@ -0,0 +1,507 @@
+#
+# configure.in for cfitsio
+#
+# /redshift/sgi6/lheavc/ftools/cfitsio/configure.in,v 3.4 1996/07/26 20:27:53 pence Exp
+#
+#  copied from host and modified
+#
+
+dnl Process this file with autoconf to produce a configure script.
+AC_INIT
+AC_CONFIG_SRCDIR([fitscore.c])
+
+#--------------------------------------------------------------------
+# Command options
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(
+  reentrant,
+  [AS_HELP_STRING([--enable-reentrant],[Enable reentrant multithreading])],
+  [ if test $enableval = yes; then BUILD_REENTRANT=yes; fi ]
+)
+
+SSE_FLAGS=""
+AC_ARG_ENABLE(
+  sse2,
+  [AS_HELP_STRING([--enable-sse2],[Enable use of instructions in the SSE2 extended instruction set])],
+  [ if test $enableval = yes; then SSE_FLAGS="-msse2"; fi ]
+)
+
+AC_ARG_ENABLE(
+  ssse3,
+  [AS_HELP_STRING([--enable-ssse3],[Enable use of instructions in the SSSE3 extended instruction set])],
+  [ if test $enableval = yes; then SSE_FLAGS="$SSE_FLAGS -mssse3"; fi ]
+)
+
+# Define BUILD_HERA when building for HERA project to activate code in
+# drvrfile.c (by way of fitsio2.h):
+AC_ARG_ENABLE(
+  hera,
+  [AS_HELP_STRING([--enable-hera],[Build for HERA (ASD use only)])],
+  [ if test $enableval = yes; then BUILD_HERA=yes; fi ]
+)
+if test "x$BUILD_HERA" = xyes; then
+  AC_DEFINE(BUILD_HERA)
+fi
+
+AC_ARG_WITH(
+  gsiftp-flavour,
+  [AS_HELP_STRING([--with-gsiftp-flavour[[=PATH]]],[Enable Globus Toolkit gsiftp protocol support])],
+  [ if test "x$withval" != "xno"; then
+
+        if test "x$withval" != "xyes" ; then
+            GSIFTP_FLAVOUR=${withval}
+        fi
+        AC_DEFINE(GSIFTP_FLAVOUR,1,[Define Globus Toolkit architecture])
+    fi
+  ]
+)
+
+AC_ARG_WITH(
+  gsiftp,
+  [AS_HELP_STRING([--with-gsiftp[[=PATH]]],[Enable Globus Toolkit gsiftp protocol support])],
+  [ if test "x$withval" != "xno"; then
+
+        if test "x$withval" != "xyes" ; then
+            CFLAGS="$CFLAGS -I${withval}/include/${GSIFTP_FLAVOUR}"
+            LDFLAGS="$LDFLAGS -L${withval}/lib -lglobus_ftp_client_${GSIFTP_FLAVOUR}"
+            HAVE_GSIFTP=yes
+        fi
+        AC_DEFINE(HAVE_GSIFTP,1,[Define if you want Globus Toolkit gsiftp protocol support])
+    fi
+  ]
+)
+
+#--------------------------------------------------------------------
+# Check for install location prefix
+#--------------------------------------------------------------------
+
+AC_PREFIX_DEFAULT(`pwd`)
+
+# make will complain about duplicate targets for the install directories
+# if prefix == exec_prefix
+AC_SUBST(INSTALL_ROOT,'${prefix}')
+test "$exec_prefix" != NONE -a "$prefix" != "$exec_prefix" \
+  && INSTALL_ROOT="$INSTALL_ROOT "'${exec_prefix}'
+	
+
+#--------------------------------------------------------------------
+# Check "uname" to determine system type
+#--------------------------------------------------------------------
+AC_CHECK_PROG([uname_found],[uname],[1],[0])
+if test $uname_found -eq 0 ; then
+    echo "cfitsio: No uname found; setting system type to unknown."
+    system="unknown"
+else
+    system=`uname -s`-`uname -r`
+fi
+
+
+dnl Checks for programs.
+
+# Try first to find a proprietary C compiler, then gcc
+if test "x$CC" = x; then
+  AC_CHECK_PROGS(CC, cc)
+fi
+AC_PROG_CC
+
+if test "x$FC" = "xnone" ; then
+  AC_MSG_NOTICE(cfitsio: == Fortran compiler search has been overridden)
+  AC_MSG_NOTICE(cfitsio: == Cfitsio will be built without Fortran wrapper support)
+  FC=
+  F77_WRAPPERS=
+else
+  AC_CHECK_PROGS(FC, gfortran g95 g77 f77 ifort f95 f90 xlf cf77 gf77 af77 ncf f2c, notfound)
+  if test $FC = 'notfound' ; then
+    AC_MSG_WARN(cfitsio: == No acceptable Fortran compiler found in \$PATH)
+    AC_MSG_NOTICE(cfitsio: == Adding wrapper support for GNU Fortran by default)
+    CFORTRANFLAGS="-Dg77Fortran"
+    F77_WRAPPERS="\${FITSIO_SRC}"
+  else
+    CFORTRANFLAGS=
+    F77_WRAPPERS="\${FITSIO_SRC}"
+    echo $ac_n "checking whether we are using GNU Fortran""... $ac_c" 1>&6
+    if test `$FC --version -c < /dev/null 2> /dev/null | grep -c GNU` -gt 0 -o \
+            `$FC --version -c < /dev/null 2> /dev/null | grep -ic egcs` -gt 0
+    then
+      echo "$ac_t""yes" 1>&6
+      echo $ac_n "cfitsio: == Adding wrapper support for GNU Fortran""... $ac_c" 1>&6
+      CFORTRANFLAGS="-Dg77Fortran"
+      echo "$ac_t"" done" 1>&6
+    else
+      echo "$ac_t""no" 1>&6
+      if test $FC = 'f2c' ; then
+        echo $ac_n "cfitsio: == Adding wrapper support for f2c""... $ac_c" 1>&6
+        CFORTRANFLAGS="-Df2cFortran"
+        echo "$ac_t"" done" 1>&6
+      fi
+    fi
+  fi
+fi
+
+AC_PROG_RANLIB
+
+dnl Checks for ANSI stdlib.h.
+AC_CHECK_HEADERS(stdlib.h string.h math.h limits.h ,ANSI_HEADER=yes,ANSI_HEADER=no)dnl
+
+dnl Check if prototyping is allowed.
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[void d( int , double) ]])],[PROTO=yes],[PROTO=no])dnl
+
+if test $ANSI_HEADER = no -o $PROTO = no; then
+     echo "   *********** WARNING: CFITSIO CONFIGURE FAILURE ************  "
+     echo "cfitsio: ANSI C environment NOT found. Aborting cfitsio configure."
+     if test $ANSI_HEADER = no; then 
+        echo "cfitsio: You're missing a needed ANSI header file."
+     fi
+     if test $PROTO = no; then
+        echo "cfitsio: Your compiler can't do ANSI function prototypes."
+     fi
+     echo "cfitsio: You need an ANSI C compiler and all ANSI trappings"
+     echo "cfitsio: to build cfitsio.   "
+     echo "     *******************************************************  "
+     exit 0;
+fi
+
+dnl Check if C compiler supports sse extended instruction flags.
+if test "x$SSE_FLAGS" != x; then
+    SAVE_CFLAGS="$CFLAGS"
+    CFLAGS="$CFLAGS $SSE_FLAGS"
+    AC_MSG_CHECKING([whether $CC accepts $SSE_FLAGS])
+    AC_LANG_PUSH([C])
+    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])],[c_has_option=yes],[c_has_option=no])
+    AC_MSG_RESULT($c_has_option)
+    AC_LANG_POP([])
+    if test "$c_has_option" = no; then SSE_FLAGS=""; fi
+    CFLAGS="$SAVE_CFLAGS"
+fi
+AC_SUBST(SSE_FLAGS)
+
+CFLAGS="$CFLAGS"
+LIBPRE=""
+
+case $system in
+    Darwin-*)
+        # Build for i386 & x86_64 architectures on Darwin 10.x or newer:
+        changequote(,)
+        case $system in
+            Darwin-[56789]*)
+                ;;
+            *)
+                changequote([,])
+                # Test to see whether the C compiler accepts the "-arch"
+                # flags for building "universal" binaries (Apple XCode only):
+                SAVE_CFLAGS="$CFLAGS"
+                C_UNIV_SWITCH="-arch i386 -arch x86_64"
+                CFLAGS="$CFLAGS $C_UNIV_SWITCH"
+                AC_MSG_CHECKING([whether $CC accepts $C_UNIV_SWITCH])
+                AC_LANG_PUSH([C])
+                AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])],[c_has_option=yes],[c_has_option=no])
+                AC_MSG_RESULT($c_has_option)
+                AC_LANG_POP([])
+                # Value of C_UNIV_SWITCH will be needed later for SHLIB_LD:
+                if test "$c_has_option" = no; then C_UNIV_SWITCH=""; fi
+                CFLAGS="$SAVE_CFLAGS $C_UNIV_SWITCH"
+                ;;
+        esac
+        # Darwin can be powerpc, i386, or x86_64
+	ARCH=`uname -p`
+	EXT="darwin"
+        # For large file support (but may break Absoft compilers):
+        AC_DEFINE(_LARGEFILE_SOURCE)
+        AC_DEFINE(_FILE_OFFSET_BITS,64)
+	;;
+    SunOS-4*)
+	ARCH="sun"
+	EXT="sun"
+	;;
+    HP-UX-*)
+	ARCH="hp"
+	EXT="hpu"
+	if test "x$CFORTRANFLAGS" = x ; then
+		CFORTRANFLAGS="-Dappendus"
+	fi
+	CFLAGS="$CFLAGS -DPG_PPU" 
+	LIBPRE="-Wl,"
+	;;
+    SunOS-5*)
+	ARCH="solaris"
+	EXT="sol"
+	if test "x$CFORTRANFLAGS" = x ; then
+		CFORTRANFLAGS="-Dsolaris"
+	fi
+        # We need libm on Solaris:
+        AC_CHECK_LIB(m, frexp)
+        # For large file support:
+        AC_DEFINE(_LARGEFILE_SOURCE)
+        AC_DEFINE(_FILE_OFFSET_BITS,64)
+	;;
+    OSF1*)
+	ARCH="alpha"
+	EXT="osf"
+	;;
+    IRIX*)
+	ARCH="sgi"
+	EXT="sgi"
+	CFLAGS="$CFLAGS -DHAVE_POSIX_SIGNALS"
+	RANLIB="touch"
+	;;
+    ULTRIX*)
+	ARCH="dec"
+	EXT="dec"
+	;;
+    Linux*)
+	ARCH="linux"
+	EXT="lnx"
+        # For large file support:
+        AC_DEFINE(_LARGEFILE_SOURCE)
+        AC_DEFINE(_FILE_OFFSET_BITS,64)
+	;;
+    FREEBSD*|FreeBSD*)
+	ARCH="linux"
+	EXT="lnx"
+	;;
+    CYGWIN*)
+	ARCH="cygwin"
+	EXT="cygwin"
+	CFLAGS="$CFLAGS -DHAVE_POSIX_SIGNALS"
+	;;
+    *)
+		echo "cfitsio: == Don't know what do do with $system"
+	;;
+esac
+
+CFLAGS="$CFLAGS $CFORTRANFLAGS"
+
+case $GCC in
+	yes)
+		GCCVERSION="`$CC -dumpversion 2>&1`"
+		echo "cfitsio: == Using gcc version $GCCVERSION"
+		AC_SUBST(GCCVERSION)
+                changequote(,)
+		gcc_test=`echo $GCCVERSION | grep -c '2\.[45678]'`
+		changequote([,])
+		if test $gcc_test -gt 0
+		then
+		    changequote(,)
+		    CFLAGS=`echo $CFLAGS | sed 's:-O[^ ]* *::'`
+		    changequote([,])
+		    AC_MSG_WARN(This gcc is pretty old. Disabling optimization to be safe.)
+		fi
+		;;
+	no)
+		echo "cfitsio: Old CFLAGS is $CFLAGS"
+		CFLAGS=`echo $CFLAGS | sed -e "s/-g/-O/"`
+		case $system in
+		    SunOS-5*)
+			changequote(,)
+			if test `echo $CFLAGS | grep -c fast` -gt 0
+			then
+			   echo "cfitsio: Replacing -fast with -O3"
+			   CFLAGS=`echo $CFLAGS | sed 's:-fast:-O3:'`
+			fi
+			changequote([,])
+         		CFLAGS="$CFLAGS -DHAVE_ALLOCA_H -DHAVE_POSIX_SIGNALS"
+			;;
+		    *)
+			echo "== No special changes for $system"
+			;;
+		esac
+		echo "New CFLAGS is $CFLAGS"
+		;;
+	*)
+		# Don't do anything now
+		;;
+esac
+		
+# Shared library section
+#-------------------------------------------------------------------------------
+SHLIB_LD=:
+SHLIB_SUFFIX=".so"
+lhea_shlib_cflags=
+case $EXT in
+  cygwin)
+    SHLIB_LD="$CC -shared"
+    SHLIB_SUFFIX=".dll"
+    ;;
+  darwin)
+    changequote(,)
+    case $system in
+        Darwin-[56789]*)
+            SHLIB_LD="$CC -dynamiclib"
+            ;;
+        *)
+            # Build for i386 & x86_64 architectures on Darwin 10.x or newer:
+            SHLIB_LD="$CC -dynamiclib $C_UNIV_SWITCH" 
+            ;;
+    esac
+    changequote([,])
+    SHLIB_SUFFIX=".dylib"
+    lhea_shlib_cflags="-fPIC -fno-common"
+    ;;
+  hpu)
+    SHLIB_LD="ld -b" 
+    SHLIB_SUFFIX=".sl"
+    ;;
+  lnx)
+    SHLIB_LD=":"
+    ;;
+  osf)
+    SHLIB_LD="ld -shared -expect_unresolved '*'"
+    LD_FLAGS="-taso"
+    ;;
+  sol)
+    SHLIB_LD="/usr/ccs/bin/ld -G"
+    lhea_shlib_cflags="-KPIC"
+    ;;
+  sgi)
+    SHLIB_LD="ld -shared -rdata_shared"
+    ;;
+  *)
+    AC_MSG_WARN(Unable to determine how to make a shared library)
+    ;;
+esac
+# Darwin uses gcc (=cc), but needs different flags (see above)
+# if test "x$GCC" = xyes; then
+if test "x$GCC" = xyes && test "x$EXT" != xdarwin && test "x$EXT" != xcygwin; then
+  SHLIB_LD="$CC -shared"
+  lhea_shlib_cflags='-fPIC'
+fi
+if test "x$lhea_shlib_cflags" != x; then
+  CFLAGS="$CFLAGS $lhea_shlib_cflags"
+fi
+
+AC_SUBST(ARCH)dnl
+AC_SUBST(CFLAGS)dnl
+AC_SUBST(CC)dnl
+AC_SUBST(FC)dnl
+AC_SUBST(LIBPRE)dnl
+AC_SUBST(SHLIB_LD)dnl
+AC_SUBST(SHLIB_SUFFIX)dnl
+AC_SUBST(F77_WRAPPERS)
+
+# ================= test for the unix ftruncate function ================
+
+AC_MSG_CHECKING("whether ftruncate works")
+AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <unistd.h>
+]], [[
+ftruncate(0, 0);
+]])],[
+AC_DEFINE(HAVE_FTRUNCATE)
+AC_MSG_RESULT("yes")
+],[AC_MSG_RESULT("no") ])
+
+# ---------------------------------------------------------
+# some systems define long long for 64-bit ints
+# ---------------------------------------------------------
+ 
+AC_MSG_CHECKING("whether long long is defined")
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <stdlib.h>
+]], [[
+long long filler;
+]])],[
+AC_DEFINE(HAVE_LONGLONG)
+AC_MSG_RESULT("yes")
+],[AC_MSG_RESULT("no") ])
+
+# ==================== SHARED MEMORY DRIVER SECTION =======================
+#
+# 09-Mar-98 : modified by JB/ISDC
+# 3 checks added to support autoconfiguration of shared memory
+# driver. First generic check is made whether shared memory is supported
+# at all, then 2 more specific checks are made (architecture dependent).
+# Currently tested on : sparc-solaris, intel-linux, sgi-irix, dec-alpha-osf
+
+# -------------------------------------------------------------------------
+# check is System V IPC is supported on this machine
+# -------------------------------------------------------------------------
+
+AC_MSG_CHECKING("whether system V style IPC services are supported")
+AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <sys/ipc.h>
+#include <sys/shm.h>
+#include <sys/sem.h>
+]], [[
+shmat(0, 0, 0);
+shmdt(0);
+shmget(0, 0, 0);
+semget(0, 0, 0);
+]])],[
+AC_DEFINE(HAVE_SHMEM_SERVICES)
+my_shmem=\${SOURCES_SHMEM}
+AC_MSG_RESULT("yes")
+],[AC_MSG_RESULT("no") ])
+
+AC_SUBST(my_shmem)
+
+# -------------------------------------------------------------------------
+# some systems define flock_t, for others we have to define it ourselves
+# -------------------------------------------------------------------------
+
+AC_MSG_CHECKING("do we have flock_t defined in sys/fcntl.h")
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/fcntl.h>
+]], [[
+flock_t filler;
+]])],[
+AC_DEFINE(HAVE_FLOCK_T)
+AC_MSG_RESULT("yes") 
+],[AC_MSG_RESULT("no") ])
+
+if test "$HAVE_FLOCK_T" != 1; then
+   AC_MSG_CHECKING("do we have flock_t defined in sys/flock.h")
+   AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/flock.h>
+   ]], [[
+   flock_t filler;
+   ]])],[
+   AC_DEFINE(HAVE_FLOCK_T)
+   AC_MSG_RESULT("yes") 
+   ],[AC_MSG_RESULT("no") ])
+fi
+
+# -------------------------------------------------------------------------
+# there are some idiosyncrasies with semun defs (used in semxxx). Solaris
+# does not define it at all
+# -------------------------------------------------------------------------
+
+AC_MSG_CHECKING("do we have union semun defined")
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/ipc.h>
+#include <sys/shm.h>
+#include <sys/sem.h>
+]], [[
+union semun filler;
+]])],[
+AC_DEFINE(HAVE_UNION_SEMUN)   
+AC_MSG_RESULT("yes")
+],[AC_MSG_RESULT("no") ])
+
+# ==================== END OF SHARED MEMORY DRIVER SECTION ================
+# ================= test for the unix networking functions ================
+
+AC_SEARCH_LIBS([gethostbyname], [nsl], cfitsio_have_nsl=1, cfitsio_have_nsl=0)
+AC_SEARCH_LIBS([connect], [socket], cfitsio_have_socket=1,
+               cfitsio_have_socket=0, [-lnsl])
+
+if test "$cfitsio_have_nsl" = 1 -a "$cfitsio_have_socket" = 1; then
+   AC_DEFINE(HAVE_NET_SERVICES)
+fi
+
+# ==================== END OF unix networking SECTION ================
+
+# ------------------------------------------------------------------------------
+# Define _REENTRANT & add -lpthread to LIBS if reentrant multithreading enabled:
+# ------------------------------------------------------------------------------
+if test "x$BUILD_REENTRANT" = xyes; then
+  AC_DEFINE(_REENTRANT)
+  AC_CHECK_LIB([pthread],[main],[],[AC_MSG_ERROR(Unable to locate pthread library needed when enabling reentrant multithreading)])
+fi
+# ------------------------------------------------------------------------------
+
+AC_CONFIG_FILES([Makefile])
+AC_OUTPUT
+AC_CONFIG_FILES([cfitsio.pc])
+AC_OUTPUT
+
+
+AC_MSG_RESULT([])
+AC_MSG_RESULT([    Congratulations, Makefile update was successful.])
+AC_MSG_RESULT([    You may want to run \"make\" now.])
+AC_MSG_RESULT([])
+

external/cfitsio/cookbook.c

@@ -0,0 +1,571 @@
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+/*
+  Every program which uses the CFITSIO interface must include the
+  the fitsio.h header file.  This contains the prototypes for all
+  the routines and defines the error status values and other symbolic
+  constants used in the interface.  
+*/
+#include "fitsio.h"
+
+int main( void );
+void writeimage( void );
+void writeascii( void );
+void writebintable( void );
+void copyhdu( void );
+void selectrows( void );
+void readheader( void );
+void readimage( void );
+void readtable( void );
+void printerror( int status);
+
+int main()
+{
+/*************************************************************************
+   This is a simple main program that calls the following routines:
+
+    writeimage    - write a FITS primary array image
+    writeascii    - write a FITS ASCII table extension
+    writebintable - write a FITS binary table extension
+    copyhdu       - copy a header/data unit from one FITS file to another
+    selectrows    - copy selected row from one HDU to another
+    readheader    - read and print the header keywords in every extension
+    readimage     - read a FITS image and compute the min and max value
+    readtable     - read columns of data from ASCII and binary tables
+
+**************************************************************************/
+
+    writeimage();
+    writeascii();
+    writebintable();
+    copyhdu();
+    selectrows();
+    readheader();
+    readimage();
+    readtable();
+
+    printf("\nAll the cfitsio cookbook routines ran successfully.\n");
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+void writeimage( void )
+
+    /******************************************************/
+    /* Create a FITS primary array containing a 2-D image */
+    /******************************************************/
+{
+    fitsfile *fptr;       /* pointer to the FITS file, defined in fitsio.h */
+    int status, ii, jj;
+    long  fpixel, nelements, exposure;
+    unsigned short *array[200];
+
+    /* initialize FITS image parameters */
+    char filename[] = "atestfil.fit";             /* name for new FITS file */
+    int bitpix   =  USHORT_IMG; /* 16-bit unsigned short pixel values       */
+    long naxis    =   2;  /* 2-dimensional image                            */    
+    long naxes[2] = { 300, 200 };   /* image is 300 pixels wide by 200 rows */
+
+    /* allocate memory for the whole image */ 
+    array[0] = (unsigned short *)malloc( naxes[0] * naxes[1]
+                                        * sizeof( unsigned short ) );
+
+    /* initialize pointers to the start of each row of the image */
+    for( ii=1; ii<naxes[1]; ii++ )
+      array[ii] = array[ii-1] + naxes[0];
+
+    remove(filename);               /* Delete old file if it already exists */
+
+    status = 0;         /* initialize status before calling fitsio routines */
+
+    if (fits_create_file(&fptr, filename, &status)) /* create new FITS file */
+         printerror( status );           /* call printerror if error occurs */
+
+    /* write the required keywords for the primary array image.     */
+    /* Since bitpix = USHORT_IMG, this will cause cfitsio to create */
+    /* a FITS image with BITPIX = 16 (signed short integers) with   */
+    /* BSCALE = 1.0 and BZERO = 32768.  This is the convention that */
+    /* FITS uses to store unsigned integers.  Note that the BSCALE  */
+    /* and BZERO keywords will be automatically written by cfitsio  */
+    /* in this case.                                                */
+
+    if ( fits_create_img(fptr,  bitpix, naxis, naxes, &status) )
+         printerror( status );          
+
+    /* initialize the values in the image with a linear ramp function */
+    for (jj = 0; jj < naxes[1]; jj++)
+    {   for (ii = 0; ii < naxes[0]; ii++)
+        {
+            array[jj][ii] = ii + jj;
+        }
+    }
+
+    fpixel = 1;                               /* first pixel to write      */
+    nelements = naxes[0] * naxes[1];          /* number of pixels to write */
+
+    /* write the array of unsigned integers to the FITS file */
+    if ( fits_write_img(fptr, TUSHORT, fpixel, nelements, array[0], &status) )
+        printerror( status );
+      
+    free( array[0] );  /* free previously allocated memory */
+
+    /* write another optional keyword to the header */
+    /* Note that the ADDRESS of the value is passed in the routine */
+    exposure = 1500.;
+    if ( fits_update_key(fptr, TLONG, "EXPOSURE", &exposure,
+         "Total Exposure Time", &status) )
+         printerror( status );           
+
+    if ( fits_close_file(fptr, &status) )                /* close the file */
+         printerror( status );           
+
+    return;
+}
+/*--------------------------------------------------------------------------*/
+void writeascii ( void )
+
+    /*******************************************************************/
+    /* Create an ASCII table extension containing 3 columns and 6 rows */
+    /*******************************************************************/
+{
+    fitsfile *fptr;       /* pointer to the FITS file, defined in fitsio.h */
+    int status;
+    long firstrow, firstelem;
+
+    int tfields = 3;       /* table will have 3 columns */
+    long nrows  = 6;       /* table will have 6 rows    */
+
+    char filename[] = "atestfil.fit";           /* name for new FITS file */
+    char extname[] = "PLANETS_ASCII";             /* extension name */
+
+    /* define the name, datatype, and physical units for the 3 columns */
+    char *ttype[] = { "Planet", "Diameter", "Density" };
+    char *tform[] = { "a8",     "I6",       "F4.2"    };
+    char *tunit[] = { "\0",      "km",       "g/cm"    };
+
+    /* define the name diameter, and density of each planet */
+    char *planet[] = {"Mercury", "Venus", "Earth", "Mars","Jupiter","Saturn"};
+    long  diameter[] = {4880,    12112,    12742,   6800,  143000,   121000};
+    float density[]  = { 5.1,     5.3,      5.52,   3.94,    1.33,    0.69};
+
+    status=0;
+
+    /* open with write access the FITS file containing a primary array */
+    if ( fits_open_file(&fptr, filename, READWRITE, &status) ) 
+         printerror( status );
+
+    /* append a new empty ASCII table onto the FITS file */
+    if ( fits_create_tbl( fptr, ASCII_TBL, nrows, tfields, ttype, tform,
+                tunit, extname, &status) )
+         printerror( status );
+
+    firstrow  = 1;  /* first row in table to write   */
+    firstelem = 1;  /* first element in row  (ignored in ASCII tables) */
+
+    /* write names to the first column (character strings) */
+    /* write diameters to the second column (longs) */
+    /* write density to the third column (floats) */
+
+    fits_write_col(fptr, TSTRING, 1, firstrow, firstelem, nrows, planet,
+                   &status);
+    fits_write_col(fptr, TLONG, 2, firstrow, firstelem, nrows, diameter,
+                   &status);
+    fits_write_col(fptr, TFLOAT, 3, firstrow, firstelem, nrows, density,
+                   &status);
+
+    if ( fits_close_file(fptr, &status) )       /* close the FITS file */
+         printerror( status );
+    return;
+}
+/*--------------------------------------------------------------------------*/
+void writebintable ( void )
+
+    /*******************************************************************/
+    /* Create a binary table extension containing 3 columns and 6 rows */
+    /*******************************************************************/
+{
+    fitsfile *fptr;       /* pointer to the FITS file, defined in fitsio.h */
+    int status, hdutype;
+    long firstrow, firstelem;
+
+    int tfields   = 3;       /* table will have 3 columns */
+    long nrows    = 6;       /* table will have 6 rows    */
+
+    char filename[] = "atestfil.fit";           /* name for new FITS file */
+    char extname[] = "PLANETS_Binary";           /* extension name */
+
+    /* define the name, datatype, and physical units for the 3 columns */
+    char *ttype[] = { "Planet", "Diameter", "Density" };
+    char *tform[] = { "8a",     "1J",       "1E"    };
+    char *tunit[] = { "\0",      "km",       "g/cm"    };
+
+    /* define the name diameter, and density of each planet */
+    char *planet[] = {"Mercury", "Venus", "Earth", "Mars","Jupiter","Saturn"};
+    long  diameter[] = {4880,     12112,   12742,   6800,  143000,   121000};
+    float density[]  = { 5.1,      5.3,     5.52,   3.94,   1.33,     0.69};
+
+    status=0;
+
+    /* open the FITS file containing a primary array and an ASCII table */
+    if ( fits_open_file(&fptr, filename, READWRITE, &status) ) 
+         printerror( status );
+
+    if ( fits_movabs_hdu(fptr, 2, &hdutype, &status) ) /* move to 2nd HDU */
+         printerror( status );
+
+    /* append a new empty binary table onto the FITS file */
+    if ( fits_create_tbl( fptr, BINARY_TBL, nrows, tfields, ttype, tform,
+                tunit, extname, &status) )
+         printerror( status );
+
+    firstrow  = 1;  /* first row in table to write   */
+    firstelem = 1;  /* first element in row  (ignored in ASCII tables) */
+
+    /* write names to the first column (character strings) */
+    /* write diameters to the second column (longs) */
+    /* write density to the third column (floats) */
+
+    fits_write_col(fptr, TSTRING, 1, firstrow, firstelem, nrows, planet,
+                   &status);
+    fits_write_col(fptr, TLONG, 2, firstrow, firstelem, nrows, diameter,
+                   &status);
+    fits_write_col(fptr, TFLOAT, 3, firstrow, firstelem, nrows, density,
+                   &status);
+
+    if ( fits_close_file(fptr, &status) )       /* close the FITS file */
+         printerror( status );
+    return;
+}
+/*--------------------------------------------------------------------------*/
+void copyhdu( void)
+{
+    /********************************************************************/
+    /* copy the 1st and 3rd HDUs from the input file to a new FITS file */
+    /********************************************************************/
+    fitsfile *infptr;      /* pointer to the FITS file, defined in fitsio.h */
+    fitsfile *outfptr;                 /* pointer to the new FITS file      */
+
+    char infilename[]  = "atestfil.fit";  /* name for existing FITS file   */
+    char outfilename[] = "btestfil.fit";  /* name for new FITS file        */
+
+    int status, morekeys, hdutype;
+
+    status = 0;
+
+    remove(outfilename);            /* Delete old file if it already exists */
+
+    /* open the existing FITS file */
+    if ( fits_open_file(&infptr, infilename, READONLY, &status) ) 
+         printerror( status );
+
+    if (fits_create_file(&outfptr, outfilename, &status)) /*create FITS file*/
+         printerror( status );           /* call printerror if error occurs */
+
+    /* copy the primary array from the input file to the output file */
+    morekeys = 0;     /* don't reserve space for additional keywords */
+    if ( fits_copy_hdu(infptr, outfptr, morekeys, &status) )
+         printerror( status );
+
+    /* move to the 3rd HDU in the input file */
+    if ( fits_movabs_hdu(infptr, 3, &hdutype, &status) )
+         printerror( status );
+
+    /* copy 3rd HDU from the input file to the output file (to 2nd HDU) */
+    if ( fits_copy_hdu(infptr, outfptr, morekeys, &status) )
+         printerror( status );
+
+    if (fits_close_file(outfptr, &status) ||
+        fits_close_file(infptr, &status)) /* close files */
+         printerror( status );
+
+    return;
+}
+/*--------------------------------------------------------------------------*/
+void selectrows( void )
+
+    /*********************************************************************/
+    /* select rows from an input table and copy them to the output table */
+    /*********************************************************************/
+{
+    fitsfile *infptr, *outfptr;  /* pointer to input and output FITS files */
+    unsigned char *buffer;
+    char card[FLEN_CARD];
+    int status, hdutype, nkeys, keypos, nfound, colnum, anynulls, ii;
+    long naxes[2], frow, felem, noutrows, irow;
+    float nullval, density[6];
+
+    char infilename[]  = "atestfil.fit";  /* name for existing FITS file   */
+    char outfilename[] = "btestfil.fit";  /* name for new FITS file        */
+
+    status = 0;
+
+    /* open the existing FITS files */
+    if ( fits_open_file(&infptr,  infilename,  READONLY,  &status) ||
+         fits_open_file(&outfptr, outfilename, READWRITE, &status) ) 
+         printerror( status );
+
+    /* move to the 3rd HDU in the input file (a binary table in this case) */
+    if ( fits_movabs_hdu(infptr, 3, &hdutype, &status) )
+         printerror( status );
+
+    if (hdutype != BINARY_TBL)  {
+        printf("Error: expected to find a binary table in this HDU\n");
+        return;
+    }
+    /* move to the last (2rd) HDU in the output file */
+    if ( fits_movabs_hdu(outfptr, 2, &hdutype, &status) )
+         printerror( status );
+
+    /* create new extension in the output file */
+    if ( fits_create_hdu(outfptr, &status) )
+         printerror( status );
+
+    /* get number of keywords */
+    if ( fits_get_hdrpos(infptr, &nkeys, &keypos, &status) ) 
+         printerror( status );
+
+    /* copy all the keywords from the input to the output extension */
+    for (ii = 1; ii <= nkeys; ii++)  {
+        fits_read_record (infptr, ii, card, &status); 
+        fits_write_record(outfptr,    card, &status); 
+    }
+
+    /* read the NAXIS1 and NAXIS2 keyword to get table size */
+    if (fits_read_keys_lng(infptr, "NAXIS", 1, 2, naxes, &nfound, &status) )
+         printerror( status );
+
+    /* find which column contains the DENSITY values */
+    if ( fits_get_colnum(infptr, CASEINSEN, "density", &colnum, &status) )
+         printerror( status );
+
+    /* read the DENSITY column values */
+    frow = 1;
+    felem = 1;
+    nullval = -99.;
+    if (fits_read_col(infptr, TFLOAT, colnum, frow, felem, naxes[1], 
+        &nullval, density, &anynulls, &status) )
+        printerror( status );
+
+    /* allocate buffer large enough for 1 row of the table */
+    buffer = (unsigned char *) malloc(naxes[0]);
+
+    /* If the density is less than 3.0, copy the row to the output table */
+    for (noutrows = 0, irow = 1; irow <= naxes[1]; irow++)  {
+      if (density[irow - 1] < 3.0)  {
+        noutrows++;
+        fits_read_tblbytes( infptr, irow,      1, naxes[0], buffer, &status); 
+        fits_write_tblbytes(outfptr, noutrows, 1, naxes[0], buffer, &status); 
+    } }
+
+    /* update the NAXIS2 keyword with the correct number of rows */
+    if ( fits_update_key(outfptr, TLONG, "NAXIS2", &noutrows, 0, &status) )
+         printerror( status );
+
+    if (fits_close_file(outfptr, &status) || fits_close_file(infptr, &status))
+        printerror( status );
+
+    return;
+}
+/*--------------------------------------------------------------------------*/
+void readheader ( void )
+
+    /**********************************************************************/
+    /* Print out all the header keywords in all extensions of a FITS file */
+    /**********************************************************************/
+{
+    fitsfile *fptr;       /* pointer to the FITS file, defined in fitsio.h */
+
+    int status, nkeys, keypos, hdutype, ii, jj;
+    char filename[]  = "atestfil.fit";     /* name of existing FITS file   */
+    char card[FLEN_CARD];   /* standard string lengths defined in fitsioc.h */
+
+    status = 0;
+
+    if ( fits_open_file(&fptr, filename, READONLY, &status) ) 
+         printerror( status );
+
+    /* attempt to move to next HDU, until we get an EOF error */
+    for (ii = 1; !(fits_movabs_hdu(fptr, ii, &hdutype, &status) ); ii++) 
+    {
+        /* get no. of keywords */
+        if (fits_get_hdrpos(fptr, &nkeys, &keypos, &status) )
+            printerror( status );
+
+        printf("Header listing for HDU #%d:\n", ii);
+        for (jj = 1; jj <= nkeys; jj++)  {
+            if ( fits_read_record(fptr, jj, card, &status) )
+                 printerror( status );
+
+            printf("%s\n", card); /* print the keyword card */
+        }
+        printf("END\n\n");  /* terminate listing with END */
+    }
+
+    if (status == END_OF_FILE)   /* status values are defined in fitsioc.h */
+        status = 0;              /* got the expected EOF error; reset = 0  */
+    else
+       printerror( status );     /* got an unexpected error                */
+
+    if ( fits_close_file(fptr, &status) )
+         printerror( status );
+
+    return;
+}
+/*--------------------------------------------------------------------------*/
+void readimage( void )
+
+    /************************************************************************/
+    /* Read a FITS image and determine the minimum and maximum pixel values */
+    /************************************************************************/
+{
+    fitsfile *fptr;       /* pointer to the FITS file, defined in fitsio.h */
+    int status,  nfound, anynull;
+    long naxes[2], fpixel, nbuffer, npixels, ii;
+
+#define buffsize 1000
+    float datamin, datamax, nullval, buffer[buffsize];
+    char filename[]  = "atestfil.fit";     /* name of existing FITS file   */
+
+    status = 0;
+
+    if ( fits_open_file(&fptr, filename, READONLY, &status) )
+         printerror( status );
+
+    /* read the NAXIS1 and NAXIS2 keyword to get image size */
+    if ( fits_read_keys_lng(fptr, "NAXIS", 1, 2, naxes, &nfound, &status) )
+         printerror( status );
+
+    npixels  = naxes[0] * naxes[1];         /* number of pixels in the image */
+    fpixel   = 1;
+    nullval  = 0;                /* don't check for null values in the image */
+    datamin  = 1.0E30;
+    datamax  = -1.0E30;
+
+    while (npixels > 0)
+    {
+      nbuffer = npixels;
+      if (npixels > buffsize)
+        nbuffer = buffsize;     /* read as many pixels as will fit in buffer */
+
+      /* Note that even though the FITS images contains unsigned integer */
+      /* pixel values (or more accurately, signed integer pixels with    */
+      /* a bias of 32768),  this routine is reading the values into a    */
+      /* float array.   Cfitsio automatically performs the datatype      */
+      /* conversion in cases like this.                                  */
+
+      if ( fits_read_img(fptr, TFLOAT, fpixel, nbuffer, &nullval,
+                  buffer, &anynull, &status) )
+           printerror( status );
+
+      for (ii = 0; ii < nbuffer; ii++)  {
+        if ( buffer[ii] < datamin )
+            datamin = buffer[ii];
+
+        if ( buffer[ii] > datamax )
+            datamax = buffer[ii];
+      }
+      npixels -= nbuffer;    /* increment remaining number of pixels */
+      fpixel  += nbuffer;    /* next pixel to be read in image */
+    }
+
+    printf("\nMin and max image pixels =  %.0f, %.0f\n", datamin, datamax);
+
+    if ( fits_close_file(fptr, &status) )
+         printerror( status );
+
+    return;
+}
+/*--------------------------------------------------------------------------*/
+void readtable( void )
+
+    /************************************************************/
+    /* read and print data values from an ASCII or binary table */
+    /************************************************************/
+{
+    fitsfile *fptr;       /* pointer to the FITS file, defined in fitsio.h */
+    int status, hdunum, hdutype,  nfound, anynull, ii;
+    long frow, felem, nelem, longnull, dia[6];
+    float floatnull, den[6];
+    char strnull[10], *name[6], *ttype[3]; 
+
+    char filename[]  = "atestfil.fit";     /* name of existing FITS file   */
+
+    status = 0;
+
+    if ( fits_open_file(&fptr, filename, READONLY, &status) )
+         printerror( status );
+
+    for (ii = 0; ii < 3; ii++)      /* allocate space for the column labels */
+        ttype[ii] = (char *) malloc(FLEN_VALUE);  /* max label length = 69 */
+
+    for (ii = 0; ii < 6; ii++)    /* allocate space for string column value */
+        name[ii] = (char *) malloc(10);   
+
+    for (hdunum = 2; hdunum <= 3; hdunum++) /*read ASCII, then binary table */
+    {
+      /* move to the HDU */
+      if ( fits_movabs_hdu(fptr, hdunum, &hdutype, &status) ) 
+           printerror( status );
+
+      if (hdutype == ASCII_TBL)
+          printf("\nReading ASCII table in HDU %d:\n",  hdunum);
+      else if (hdutype == BINARY_TBL)
+          printf("\nReading binary table in HDU %d:\n", hdunum);
+      else
+      {
+          printf("Error: this HDU is not an ASCII or binary table\n");
+          printerror( status );
+      }
+
+      /* read the column names from the TTYPEn keywords */
+      fits_read_keys_str(fptr, "TTYPE", 1, 3, ttype, &nfound, &status);
+
+      printf(" Row  %10s %10s %10s\n", ttype[0], ttype[1], ttype[2]);
+
+      frow      = 1;
+      felem     = 1;
+      nelem     = 6;
+      strcpy(strnull, " ");
+      longnull  = 0;
+      floatnull = 0.;
+
+      /*  read the columns */  
+      fits_read_col(fptr, TSTRING, 1, frow, felem, nelem, strnull,  name,
+                    &anynull, &status);
+      fits_read_col(fptr, TLONG, 2, frow, felem, nelem, &longnull,  dia,
+                    &anynull, &status);
+      fits_read_col(fptr, TFLOAT, 3, frow, felem, nelem, &floatnull, den,
+                    &anynull, &status);
+
+      for (ii = 0; ii < 6; ii++)
+        printf("%5d %10s %10ld %10.2f\n", ii + 1, name[ii], dia[ii], den[ii]);
+    }
+
+    for (ii = 0; ii < 3; ii++)      /* free the memory for the column labels */
+        free( ttype[ii] );
+
+    for (ii = 0; ii < 6; ii++)      /* free the memory for the string column */
+        free( name[ii] );
+
+    if ( fits_close_file(fptr, &status) ) 
+         printerror( status );
+
+    return;
+}
+/*--------------------------------------------------------------------------*/
+void printerror( int status)
+{
+    /*****************************************************/
+    /* Print out cfitsio error messages and exit program */
+    /*****************************************************/
+
+
+    if (status)
+    {
+       fits_report_error(stderr, status); /* print error report */
+
+       exit( status );    /* terminate the program, returning error status */
+    }
+    return;
+}

external/cfitsio/cookbook.f

@@ -0,0 +1,772 @@
+      program main
+
+C  This is the FITSIO cookbook program that contains an annotated listing of
+C  various computer programs that read and write files in FITS format
+C  using the FITSIO subroutine interface.  These examples are
+C  working programs which users may adapt and modify for their own
+C  purposes.  This Cookbook serves as a companion to the FITSIO User's
+C  Guide that provides more complete documentation on all the
+C  available FITSIO subroutines.
+
+C  Call each subroutine in turn:
+
+      call writeimage
+      call writeascii
+      call writebintable
+      call copyhdu
+      call selectrows
+      call readheader
+      call readimage
+      call readtable
+      print *
+      print *,"All the fitsio cookbook routines ran successfully."
+
+      end
+C *************************************************************************
+      subroutine writeimage
+
+C  Create a FITS primary array containing a 2-D image
+
+      integer status,unit,blocksize,bitpix,naxis,naxes(2)
+      integer i,j,group,fpixel,nelements,array(300,200)
+      character filename*80
+      logical simple,extend
+
+C  The STATUS parameter must be initialized before using FITSIO.  A
+C  positive value of STATUS is returned whenever a serious error occurs.
+C  FITSIO uses an `inherited status' convention, which means that if a
+C  subroutine is called with a positive input value of STATUS, then the
+C  subroutine will exit immediately, preserving the status value. For 
+C  simplicity, this program only checks the status value at the end of 
+C  the program, but it is usually better practice to check the status 
+C  value more frequently.
+
+      status=0
+
+C  Name of the FITS file to be created:
+      filename='ATESTFILEZ.FITS'
+
+C  Delete the file if it already exists, so we can then recreate it.
+C  The deletefile subroutine is listed at the end of this file.
+      call deletefile(filename,status)
+
+C  Get an unused Logical Unit Number to use to open the FITS file.
+C  This routine is not required;  programmers can choose any unused
+C  unit number to open the file.
+      call ftgiou(unit,status)
+
+C  Create the new empty FITS file.  The blocksize parameter is a
+C  historical artifact and the value is ignored by FITSIO.
+      blocksize=1
+      call ftinit(unit,filename,blocksize,status)
+
+C  Initialize parameters about the FITS image.
+C  BITPIX = 16 means that the image pixels will consist of 16-bit
+C  integers.  The size of the image is given by the NAXES values. 
+C  The EXTEND = TRUE parameter indicates that the FITS file
+C  may contain extensions following the primary array.
+      simple=.true.
+      bitpix=16
+      naxis=2
+      naxes(1)=300
+      naxes(2)=200
+      extend=.true.
+
+C  Write the required header keywords to the file
+      call ftphpr(unit,simple,bitpix,naxis,naxes,0,1,extend,status)
+
+C  Initialize the values in the image with a linear ramp function
+      do j=1,naxes(2)
+          do i=1,naxes(1)
+              array(i,j)=i - 1 +j - 1
+          end do
+      end do
+
+C  Write the array to the FITS file.
+C  The last letter of the subroutine name defines the datatype of the
+C  array argument; in this case the 'J' indicates that the array has an
+C  integer*4 datatype. ('I' = I*2, 'E' = Real*4, 'D' = Real*8).
+C  The 2D array is treated as a single 1-D array with NAXIS1 * NAXIS2
+C  total number of pixels.  GROUP is seldom used parameter that should
+C  almost always be set = 1.
+      group=1
+      fpixel=1
+      nelements=naxes(1)*naxes(2)
+      call ftpprj(unit,group,fpixel,nelements,array,status)
+
+C  Write another optional keyword to the header
+C  The keyword record will look like this in the FITS file:
+C
+C  EXPOSURE=                 1500 / Total Exposure Time
+C
+      call ftpkyj(unit,'EXPOSURE',1500,'Total Exposure Time',status)
+
+C  The FITS file must always be closed before exiting the program. 
+C  Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
+      call ftclos(unit, status)
+      call ftfiou(unit, status)
+
+C  Check for any errors, and if so print out error messages.
+C  The PRINTERROR subroutine is listed near the end of this file.
+      if (status .gt. 0)call printerror(status)
+      end
+C *************************************************************************
+      subroutine writeascii
+
+C  Create an ASCII table containing 3 columns and 6 rows.  For convenience,
+C  the ASCII table extension is appended to the FITS image file created 
+C  previously by the WRITEIMAGE subroutine.
+
+      integer status,unit,readwrite,blocksize,tfields,nrows,rowlen
+      integer nspace,tbcol(3),diameter(6), colnum,frow,felem
+      real density(6)
+      character filename*40,extname*16
+      character*16 ttype(3),tform(3),tunit(3),name(6)
+      data ttype/'Planet','Diameter','Density'/
+      data tform/'A8','I6','F4.2'/
+      data tunit/' ','km','g/cm'/
+      data name/'Mercury','Venus','Earth','Mars','Jupiter','Saturn'/
+      data diameter/4880,12112,12742,6800,143000,121000/
+      data density/5.1,5.3,5.52,3.94,1.33,0.69/
+
+C  The STATUS parameter must always be initialized.
+      status=0
+
+C  Name of the FITS file to append the ASCII table to:
+      filename='ATESTFILEZ.FITS'
+
+C  Get an unused Logical Unit Number to use to open the FITS file.
+      call ftgiou(unit,status)
+
+C  Open the FITS file with write access.
+C  (readwrite = 0 would open the file with readonly access).
+      readwrite=1
+      call ftopen(unit,filename,readwrite,blocksize,status)
+
+C  FTCRHD creates a new empty FITS extension following the current
+C  extension and moves to it.  In this case, FITSIO was initially
+C  positioned on the primary array when the FITS file was first opened, so
+C  FTCRHD appends an empty extension and moves to it.  All future FITSIO
+C  calls then operate on the new extension (which will be an ASCII
+C  table).
+      call ftcrhd(unit,status)
+
+C  define parameters for the ASCII table (see the above data statements)
+      tfields=3
+      nrows=6
+      extname='PLANETS_ASCII'
+      
+C  FTGABC is a convenient subroutine for calculating the total width of
+C  the table and the starting position of each column in an ASCII table.
+C  Any number of blank spaces (including zero)  may be inserted between
+C  each column of the table, as specified by the NSPACE parameter.
+      nspace=1
+      call ftgabc(tfields,tform,nspace,rowlen,tbcol,status)
+
+C  FTPHTB writes all the required header keywords which define the
+C  structure of the ASCII table. NROWS and TFIELDS give the number of
+C  rows and columns in the table, and the TTYPE, TBCOL, TFORM, and TUNIT
+C  arrays give the column name, starting position, format, and units,
+C  respectively of each column. The values of the ROWLEN and TBCOL parameters
+C  were previously calculated by the FTGABC routine.
+      call ftphtb(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,
+     &            extname,status)
+
+C  Write names to the first column, diameters to 2nd col., and density to 3rd
+C  FTPCLS writes the string values to the NAME column (column 1) of the
+C  table.  The FTPCLJ and FTPCLE routines write the diameter (integer) and
+C  density (real) value to the 2nd and 3rd columns.  The FITSIO routines
+C  are column oriented, so it is usually easier to read or write data in a
+C  table in a column by column order rather than row by row.
+      frow=1
+      felem=1
+      colnum=1
+      call ftpcls(unit,colnum,frow,felem,nrows,name,status)
+      colnum=2
+      call ftpclj(unit,colnum,frow,felem,nrows,diameter,status)  
+      colnum=3
+      call ftpcle(unit,colnum,frow,felem,nrows,density,status)  
+
+C  The FITS file must always be closed before exiting the program. 
+C  Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
+      call ftclos(unit, status)
+      call ftfiou(unit, status)
+
+C  Check for any error, and if so print out error messages.
+C  The PRINTERROR subroutine is listed near the end of this file.
+      if (status .gt. 0)call printerror(status)
+      end
+C *************************************************************************
+      subroutine writebintable
+
+C  This routine creates a FITS binary table, or BINTABLE, containing
+C  3 columns and 6 rows.  This routine is nearly identical to the
+C  previous WRITEASCII routine, except that the call to FTGABC is not
+C  needed, and FTPHBN is called rather than FTPHTB to write the
+C  required header keywords.
+
+      integer status,unit,readwrite,blocksize,hdutype,tfields,nrows
+      integer varidat,diameter(6), colnum,frow,felem
+      real density(6)
+      character filename*40,extname*16
+      character*16 ttype(3),tform(3),tunit(3),name(6)
+      data ttype/'Planet','Diameter','Density'/
+      data tform/'8A','1J','1E'/
+      data tunit/' ','km','g/cm'/
+      data name/'Mercury','Venus','Earth','Mars','Jupiter','Saturn'/
+      data diameter/4880,12112,12742,6800,143000,121000/
+      data density/5.1,5.3,5.52,3.94,1.33,0.69/
+
+C  The STATUS parameter must always be initialized.
+      status=0
+
+C  Name of the FITS file to append the ASCII table to:
+      filename='ATESTFILEZ.FITS'
+
+C  Get an unused Logical Unit Number to use to open the FITS file.
+      call ftgiou(unit,status)
+
+C  Open the FITS file, with write access.
+      readwrite=1
+      call ftopen(unit,filename,readwrite,blocksize,status)
+
+C  Move to the last (2nd) HDU in the file (the ASCII table).
+      call ftmahd(unit,2,hdutype,status)
+
+C  Append/create a new empty HDU onto the end of the file and move to it.
+      call ftcrhd(unit,status)
+
+C  Define parameters for the binary table (see the above data statements)
+      tfields=3
+      nrows=6
+      extname='PLANETS_BINARY'
+      varidat=0
+      
+C  FTPHBN writes all the required header keywords which define the
+C  structure of the binary table. NROWS and TFIELDS gives the number of
+C  rows and columns in the table, and the TTYPE, TFORM, and TUNIT arrays
+C  give the column name, format, and units, respectively of each column.
+      call ftphbn(unit,nrows,tfields,ttype,tform,tunit,
+     &            extname,varidat,status)
+
+C  Write names to the first column, diameters to 2nd col., and density to 3rd
+C  FTPCLS writes the string values to the NAME column (column 1) of the
+C  table.  The FTPCLJ and FTPCLE routines write the diameter (integer) and
+C  density (real) value to the 2nd and 3rd columns.  The FITSIO routines
+C  are column oriented, so it is usually easier to read or write data in a
+C  table in a column by column order rather than row by row.  Note that
+C  the identical subroutine calls are used to write to either ASCII or
+C  binary FITS tables.
+      frow=1
+      felem=1
+      colnum=1
+      call ftpcls(unit,colnum,frow,felem,nrows,name,status)
+      colnum=2
+      call ftpclj(unit,colnum,frow,felem,nrows,diameter,status)  
+      colnum=3
+      call ftpcle(unit,colnum,frow,felem,nrows,density,status)  
+
+C  The FITS file must always be closed before exiting the program. 
+C  Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
+      call ftclos(unit, status)
+      call ftfiou(unit, status)
+
+C  Check for any error, and if so print out error messages.
+C  The PRINTERROR subroutine is listed near the end of this file.
+      if (status .gt. 0)call printerror(status)
+      end
+C *************************************************************************
+      subroutine copyhdu
+
+C  Copy the 1st and 3rd HDUs from the input file to a new FITS file
+
+      integer status,inunit,outunit,readwrite,blocksize,morekeys,hdutype
+      character infilename*40,outfilename*40
+
+C  The STATUS parameter must always be initialized.
+      status=0
+
+C     Name of the FITS files:
+      infilename='ATESTFILEZ.FITS'
+      outfilename='BTESTFILEZ.FITS'
+
+C  Delete the file if it already exists, so we can then recreate it
+C  The deletefile subroutine is listed at the end of this file.
+      call deletefile(outfilename,status)
+
+C  Get  unused Logical Unit Numbers to use to open the FITS files.
+      call ftgiou(inunit,status)
+      call ftgiou(outunit,status)
+
+C  Open the input FITS file, with readonly access
+      readwrite=0
+      call ftopen(inunit,infilename,readwrite,blocksize,status)
+
+C  Create the new empty FITS file (value of blocksize is ignored)
+      blocksize=1
+      call ftinit(outunit,outfilename,blocksize,status)
+
+C  FTCOPY copies the current HDU from the input FITS file to the output
+C  file.  The MOREKEY parameter allows one to reserve space for additional
+C  header keywords when the HDU is created.   FITSIO will automatically
+C  insert more header space if required, so programmers do not have to
+C  reserve space ahead of time, although it is more efficient to do so if
+C  it is known that more keywords will be appended to the header.
+      morekeys=0
+      call ftcopy(inunit,outunit,morekeys,status)
+
+C  Append/create a new empty extension on the end of the output file
+      call ftcrhd(outunit,status)
+
+C  Skip to the 3rd extension in the input file which in this case
+C  is the binary table created by the previous WRITEBINARY routine.
+      call ftmahd(inunit,3,hdutype,status)
+
+C  FTCOPY now copies the binary table from the input FITS file
+C  to the output file.
+      call ftcopy(inunit,outunit,morekeys,status)  
+
+C  The FITS files must always be closed before exiting the program. 
+C  Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
+C  Giving -1 for the value of the first argument causes all previously
+C  allocated unit numbers to be released.
+
+      call ftclos(inunit, status)
+      call ftclos(outunit, status)
+      call ftfiou(-1, status)
+
+C  Check for any error, and if so print out error messages.
+C  The PRINTERROR subroutine is listed near the end of this file.
+      if (status .gt. 0)call printerror(status)
+      end
+C *************************************************************************
+      subroutine selectrows
+
+C  This routine copies selected rows from an input table into a new output
+C  FITS table.  In this example all the rows in the input table that have
+C  a value of the DENSITY column less that 3.0 are copied to the output
+C  table.  This program illustrates several generally useful techniques,
+C  including:
+C      how to locate the end of a FITS file
+C      how to create a table when the total number of rows in the table
+C      is not known until the table is completed
+C      how to efficiently copy entire rows from one table to another.
+
+      integer status,inunit,outunit,readwrite,blocksize,hdutype
+      integer nkeys,nspace,naxes(2),nfound,colnum,frow,felem
+      integer noutrows,irow,temp(100),i
+      real nullval,density(6)
+      character infilename*40,outfilename*40,record*80
+      logical exact,anynulls
+
+C  The STATUS parameter must always be initialized.
+      status=0
+
+C     Names of the FITS files:
+      infilename='ATESTFILEZ.FITS'
+      outfilename='BTESTFILEZ.FITS'
+
+C  Get  unused Logical Unit Numbers to use to open the FITS files.
+      call ftgiou(inunit,status)
+      call ftgiou(outunit,status)
+
+C  The input FITS file is opened with READONLY access, and the output
+C  FITS file is opened with WRITE access.
+      readwrite=0
+      call ftopen(inunit,infilename,readwrite,blocksize,status)
+      readwrite=1
+      call ftopen(outunit,outfilename,readwrite,blocksize,status)
+
+C  move to the 3rd HDU in the input file (a binary table in this case)
+      call ftmahd(inunit,3,hdutype,status)
+
+C  This do-loop illustrates how to move to the last extension in any FITS
+C  file.  The call to FTMRHD moves one extension at a time through the
+C  FITS file until an `End-of-file' status value (= 107) is returned.
+      do while (status .eq. 0)
+          call ftmrhd(outunit,1,hdutype,status)
+      end do
+
+C  After locating the end of the FITS file, it is necessary to reset the
+C  status value to zero and also clear the internal error message stack
+C  in FITSIO.  The previous `End-of-file' error will have produced
+C  an unimportant message on the error stack which can be cleared with
+C  the call to the FTCMSG routine (which has no arguments).
+
+      if (status .eq. 107)then
+          status=0
+          call ftcmsg
+      end if
+
+C  Create a new empty extension in the output file.
+      call ftcrhd(outunit,status)
+
+C  Find the number of keywords in the input table header.
+      call ftghsp(inunit,nkeys,nspace,status)
+
+C  This do-loop of calls to FTGREC and FTPREC copies all the keywords from
+C  the input to the output FITS file.  Notice that the specified number
+C  of rows in the output table, as given by the NAXIS2 keyword, will be
+C  incorrect.  This value will be modified later after it is known how many
+C  rows will be in the table, so it does not matter how many rows are specified
+C  initially.
+      do i=1,nkeys
+          call ftgrec(inunit,i,record,status)
+          call ftprec(outunit,record,status)
+      end do
+
+C  FTGKNJ is used to get the value of the NAXIS1 and NAXIS2 keywords,
+C  which define the width of the table in bytes, and the number of
+C  rows in the table.
+      call ftgknj(inunit,'NAXIS',1,2,naxes,nfound,status)
+
+C  FTGCNO gets the column number of the `DENSITY' column; the column
+C  number is needed when reading the data in the column.  The EXACT
+C  parameter determines whether or not the match to the column names
+C  will be case sensitive.
+      exact=.false.
+      call ftgcno(inunit,exact,'DENSITY',colnum,status)
+
+C  FTGCVE reads all 6 rows of data in the `DENSITY' column.  The number
+C  of rows in the table is given by NAXES(2). Any null values in the
+C  table will be returned with the corresponding value set to -99
+C  (= the value of NULLVAL).  The ANYNULLS parameter will be set to TRUE
+C  if any null values were found while reading the data values in the table.
+      frow=1
+      felem=1
+      nullval=-99.
+      call ftgcve(inunit,colnum,frow,felem,naxes(2),nullval,
+     &            density,anynulls,status)
+
+C  If the density is less than 3.0, copy the row to the output table.
+C  FTGTBB and FTPTBB are low-level routines to read and write, respectively,
+C  a specified number of bytes in the table, starting at the specified
+C  row number and beginning byte within the row.  These routines do
+C  not do any interpretation of the bytes, and simply pass them to or
+C  from the FITS file without any modification.  This is a faster
+C  way of transferring large chunks of data from one FITS file to another,
+C  than reading and then writing each column of data individually.
+C  In this case an entire row of bytes (the row length is specified
+C  by the naxes(1) parameter) is transferred.  The datatype of the 
+C  buffer array (TEMP in this case) is immaterial so long as it is
+C  declared large enough to hold the required number of bytes.
+      noutrows=0
+      do irow=1,naxes(2)
+          if (density(irow) .lt. 3.0)then
+              noutrows=noutrows+1
+              call ftgtbb(inunit,irow,1,naxes(1),temp,status)
+              call ftptbb(outunit,noutrows,1,naxes(1),temp,status)
+          end if
+      end do
+
+C  Update the NAXIS2 keyword with the correct no. of rows in the output file.
+C  After all the rows have been written to the output table, the
+C  FTMKYJ routine is used to overwrite the NAXIS2 keyword value with
+C  the correct number of rows.  Specifying `\&' for the comment string
+C  tells FITSIO to keep the current comment string in the keyword and
+C  only modify the value.  Because the total number of rows in the table
+C  was unknown when the table was first created, any value (including 0)
+C  could have been used for the initial NAXIS2 keyword value.
+      call ftmkyj(outunit,'NAXIS2',noutrows,'&',status)
+
+C  The FITS files must always be closed before exiting the program. 
+C  Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
+      call ftclos(inunit, status)
+      call ftclos(outunit, status)
+      call ftfiou(-1, status)
+
+C  Check for any error, and if so print out error messages.
+C  The PRINTERROR subroutine is listed near the end of this file.
+      if (status .gt. 0)call printerror(status)
+      end
+C *************************************************************************
+      subroutine readheader
+
+C  Print out all the header keywords in all extensions of a FITS file
+
+      integer status,unit,readwrite,blocksize,nkeys,nspace,hdutype,i,j
+      character filename*80,record*80
+
+C  The STATUS parameter must always be initialized.
+      status=0
+
+C  Get an unused Logical Unit Number to use to open the FITS file.
+      call ftgiou(unit,status)
+
+C     name of FITS file 
+      filename='ATESTFILEZ.FITS'
+
+C     open the FITS file, with read-only access.  The returned BLOCKSIZE
+C     parameter is obsolete and should be ignored. 
+      readwrite=0
+      call ftopen(unit,filename,readwrite,blocksize,status)
+
+      j = 0
+100   continue
+      j = j + 1
+
+      print *,'Header listing for HDU', j
+
+C  The FTGHSP subroutine returns the number of existing keywords in the
+C  current header data unit (CHDU), not counting the required END keyword,
+      call ftghsp(unit,nkeys,nspace,status)
+
+C  Read each 80-character keyword record, and print it out.
+      do i = 1, nkeys
+          call ftgrec(unit,i,record,status)
+          print *,record
+      end do
+
+C  Print out an END record, and a blank line to mark the end of the header.
+      if (status .eq. 0)then
+          print *,'END'
+          print *,' '
+      end if
+
+C  Try moving to the next extension in the FITS file, if it exists.
+C  The FTMRHD subroutine attempts to move to the next HDU, as specified by
+C  the second parameter.   This subroutine moves by a relative number of
+C  HDUs from the current HDU.  The related FTMAHD routine may be used to
+C  move to an absolute HDU number in the FITS file.  If the end-of-file is
+C  encountered when trying to move to the specified extension, then a
+C  status = 107 is returned.
+      call ftmrhd(unit,1,hdutype,status)
+
+      if (status .eq. 0)then
+C         success, so jump back and print out keywords in this extension
+          go to 100
+
+      else if (status .eq. 107)then
+C         hit end of file, so quit
+          status=0
+      end if
+
+C  The FITS file must always be closed before exiting the program. 
+C  Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
+      call ftclos(unit, status)
+      call ftfiou(unit, status)
+
+C  Check for any error, and if so print out error messages.
+C  The PRINTERROR subroutine is listed near the end of this file.
+      if (status .gt. 0)call printerror(status)
+      end
+C *************************************************************************
+      subroutine readimage
+
+C  Read a FITS image and determine the minimum and maximum pixel value.
+C  Rather than reading the entire image in
+C  at once (which could require a very large array), the image is read
+C  in pieces, 100 pixels at a time.  
+
+      integer status,unit,readwrite,blocksize,naxes(2),nfound
+      integer group,firstpix,nbuffer,npixels,i
+      real datamin,datamax,nullval,buffer(100)
+      logical anynull
+      character filename*80
+
+C  The STATUS parameter must always be initialized.
+      status=0
+
+C  Get an unused Logical Unit Number to use to open the FITS file.
+      call ftgiou(unit,status)
+
+C  Open the FITS file previously created by WRITEIMAGE
+      filename='ATESTFILEZ.FITS'
+      readwrite=0
+      call ftopen(unit,filename,readwrite,blocksize,status)
+
+C  Determine the size of the image.
+      call ftgknj(unit,'NAXIS',1,2,naxes,nfound,status)
+
+C  Check that it found both NAXIS1 and NAXIS2 keywords.
+      if (nfound .ne. 2)then
+          print *,'READIMAGE failed to read the NAXISn keywords.'
+          return
+       end if
+
+C  Initialize variables
+      npixels=naxes(1)*naxes(2)
+      group=1
+      firstpix=1
+      nullval=-999
+      datamin=1.0E30
+      datamax=-1.0E30
+
+      do while (npixels .gt. 0)
+C         read up to 100 pixels at a time 
+          nbuffer=min(100,npixels)
+      
+          call ftgpve(unit,group,firstpix,nbuffer,nullval,
+     &            buffer,anynull,status)
+
+C         find the min and max values
+          do i=1,nbuffer
+              datamin=min(datamin,buffer(i))
+              datamax=max(datamax,buffer(i))
+          end do
+
+C         increment pointers and loop back to read the next group of pixels
+          npixels=npixels-nbuffer
+          firstpix=firstpix+nbuffer
+      end do
+
+      print *
+      print *,'Min and max image pixels = ',datamin,datamax
+
+C  The FITS file must always be closed before exiting the program. 
+C  Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
+      call ftclos(unit, status)
+      call ftfiou(unit, status)
+
+C  Check for any error, and if so print out error messages.
+C  The PRINTERROR subroutine is listed near the end of this file.
+      if (status .gt. 0)call printerror(status)
+      end
+C *************************************************************************
+      subroutine readtable
+
+C  Read and print data values from an ASCII or binary table
+C  This example reads and prints out all the data in the ASCII and
+C  the binary tables that were previously created by WRITEASCII and
+C  WRITEBINTABLE.  Note that the exact same FITSIO routines are
+C  used to read both types of tables.
+
+      integer status,unit,readwrite,blocksize,hdutype,ntable
+      integer felem,nelems,nullj,diameter,nfound,irow,colnum
+      real nulle,density
+      character filename*40,nullstr*1,name*8,ttype(3)*10
+      logical anynull
+
+C  The STATUS parameter must always be initialized.
+      status=0
+
+C  Get an unused Logical Unit Number to use to open the FITS file.
+      call ftgiou(unit,status)
+
+C  Open the FITS file previously created by WRITEIMAGE
+      filename='ATESTFILEZ.FITS'
+      readwrite=0
+      call ftopen(unit,filename,readwrite,blocksize,status)
+
+C  Loop twice, first reading the ASCII table, then the binary table
+      do ntable=2,3
+
+C  Move to the next extension
+          call ftmahd(unit,ntable,hdutype,status)
+
+          print *,' '
+          if (hdutype .eq. 1)then
+              print *,'Reading ASCII table in HDU ',ntable
+          else if (hdutype .eq. 2)then
+              print *,'Reading binary table in HDU ',ntable
+          end if
+
+C  Read the TTYPEn keywords, which give the names of the columns
+          call ftgkns(unit,'TTYPE',1,3,ttype,nfound,status)
+          write(*,2000)ttype
+2000      format(2x,"Row   ",3a10)
+
+C  Read the data, one row at a time, and print them out
+          felem=1
+          nelems=1
+          nullstr=' '
+          nullj=0
+          nulle=0.
+          do irow=1,6
+C             FTGCVS reads the NAMES from the first column of the table.
+              colnum=1
+              call ftgcvs(unit,colnum,irow,felem,nelems,nullstr,name,
+     &                    anynull,status)
+
+C             FTGCVJ reads the DIAMETER values from the second column.
+              colnum=2
+              call ftgcvj(unit,colnum,irow,felem,nelems,nullj,diameter,
+     &                    anynull,status)
+
+C             FTGCVE reads the DENSITY values from the third column.
+              colnum=3
+              call ftgcve(unit,colnum,irow,felem,nelems,nulle,density,
+     &                    anynull,status)
+              write(*,2001)irow,name,diameter,density
+2001          format(i5,a10,i10,f10.2)
+          end do
+      end do
+
+C  The FITS file must always be closed before exiting the program. 
+C  Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
+      call ftclos(unit, status)
+      call ftfiou(unit, status)
+
+C  Check for any error, and if so print out error messages.
+C  The PRINTERROR subroutine is listed near the end of this file.
+      if (status .gt. 0)call printerror(status)
+      end
+C *************************************************************************
+      subroutine printerror(status)
+
+C  This subroutine prints out the descriptive text corresponding to the
+C  error status value and prints out the contents of the internal
+C  error message stack generated by FITSIO whenever an error occurs.
+
+      integer status
+      character errtext*30,errmessage*80
+
+C  Check if status is OK (no error); if so, simply return
+      if (status .le. 0)return
+
+C  The FTGERR subroutine returns a descriptive 30-character text string that
+C  corresponds to the integer error status number.  A complete list of all
+C  the error numbers can be found in the back of the FITSIO User's Guide.
+      call ftgerr(status,errtext)
+      print *,'FITSIO Error Status =',status,': ',errtext
+
+C  FITSIO usually generates an internal stack of error messages whenever
+C  an error occurs.  These messages provide much more information on the
+C  cause of the problem than can be provided by the single integer error
+C  status value.  The FTGMSG subroutine retrieves the oldest message from
+C  the stack and shifts any remaining messages on the stack down one
+C  position.  FTGMSG is called repeatedly until a blank message is
+C  returned, which indicates that the stack is empty.  Each error message
+C  may be up to 80 characters in length.  Another subroutine, called
+C  FTCMSG, is available to simply clear the whole error message stack in
+C  cases where one is not interested in the contents.
+      call ftgmsg(errmessage)
+      do while (errmessage .ne. ' ')
+          print *,errmessage
+          call ftgmsg(errmessage)
+      end do
+      end
+C *************************************************************************
+      subroutine deletefile(filename,status)
+
+C  A simple little routine to delete a FITS file
+
+      integer status,unit,blocksize
+      character*(*) filename
+
+C  Simply return if status is greater than zero
+      if (status .gt. 0)return
+
+C  Get an unused Logical Unit Number to use to open the FITS file
+      call ftgiou(unit,status)
+
+C  Try to open the file, to see if it exists
+      call ftopen(unit,filename,1,blocksize,status)
+
+      if (status .eq. 0)then
+C         file was opened;  so now delete it 
+          call ftdelt(unit,status)
+      else if (status .eq. 103)then
+C         file doesn't exist, so just reset status to zero and clear errors
+          status=0
+          call ftcmsg
+      else
+C         there was some other error opening the file; delete the file anyway
+          status=0
+          call ftcmsg
+          call ftdelt(unit,status)
+      end if
+
+C  Free the unit number for later reuse
+      call ftfiou(unit, status)
+      end

external/cfitsio/crc32.c

@@ -0,0 +1,440 @@
+/* crc32.c -- compute the CRC-32 of a data stream
+ * Copyright (C) 1995-2006, 2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ *
+ * Thanks to Rodney Brown <rbrown64@csc.com.au> for his contribution of faster
+ * CRC methods: exclusive-oring 32 bits of data at a time, and pre-computing
+ * tables for updating the shift register in one step with three exclusive-ors
+ * instead of four steps with four exclusive-ors.  This results in about a
+ * factor of two increase in speed on a Power PC G4 (PPC7455) using gcc -O3.
+ */
+
+/*
+  Note on the use of DYNAMIC_CRC_TABLE: there is no mutex or semaphore
+  protection on the static variables used to control the first-use generation
+  of the crc tables.  Therefore, if you #define DYNAMIC_CRC_TABLE, you should
+  first call get_crc_table() to initialize the tables before allowing more than
+  one thread to use crc32().
+ */
+
+#ifdef MAKECRCH
+#  include <stdio.h>
+#  ifndef DYNAMIC_CRC_TABLE
+#    define DYNAMIC_CRC_TABLE
+#  endif /* !DYNAMIC_CRC_TABLE */
+#endif /* MAKECRCH */
+
+#include "zutil.h"      /* for STDC and FAR definitions */
+
+#define local static
+
+/* Find a four-byte integer type for crc32_little() and crc32_big(). */
+#ifndef NOBYFOUR
+#  ifdef STDC           /* need ANSI C limits.h to determine sizes */
+#    include <limits.h>
+#    define BYFOUR
+#    if (UINT_MAX == 0xffffffffUL)
+       typedef unsigned int u4;
+#    else
+#      if (ULONG_MAX == 0xffffffffUL)
+         typedef unsigned long u4;
+#      else
+#        if (USHRT_MAX == 0xffffffffUL)
+           typedef unsigned short u4;
+#        else
+#          undef BYFOUR     /* can't find a four-byte integer type! */
+#        endif
+#      endif
+#    endif
+#  endif /* STDC */
+#endif /* !NOBYFOUR */
+
+/* Definitions for doing the crc four data bytes at a time. */
+#ifdef BYFOUR
+#  define REV(w) ((((w)>>24)&0xff)+(((w)>>8)&0xff00)+ \
+                (((w)&0xff00)<<8)+(((w)&0xff)<<24))
+   local unsigned long crc32_little OF((unsigned long,
+                        const unsigned char FAR *, unsigned));
+   local unsigned long crc32_big OF((unsigned long,
+                        const unsigned char FAR *, unsigned));
+#  define TBLS 8
+#else
+#  define TBLS 1
+#endif /* BYFOUR */
+
+/* Local functions for crc concatenation */
+local unsigned long gf2_matrix_times OF((unsigned long *mat,
+                                         unsigned long vec));
+local void gf2_matrix_square OF((unsigned long *square, unsigned long *mat));
+local uLong crc32_combine_(uLong crc1, uLong crc2, z_off64_t len2);
+
+
+#ifdef DYNAMIC_CRC_TABLE
+
+local volatile int crc_table_empty = 1;
+local unsigned long FAR crc_table[TBLS][256];
+local void make_crc_table OF((void));
+#ifdef MAKECRCH
+   local void write_table OF((FILE *, const unsigned long FAR *));
+#endif /* MAKECRCH */
+/*
+  Generate tables for a byte-wise 32-bit CRC calculation on the polynomial:
+  x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1.
+
+  Polynomials over GF(2) are represented in binary, one bit per coefficient,
+  with the lowest powers in the most significant bit.  Then adding polynomials
+  is just exclusive-or, and multiplying a polynomial by x is a right shift by
+  one.  If we call the above polynomial p, and represent a byte as the
+  polynomial q, also with the lowest power in the most significant bit (so the
+  byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p,
+  where a mod b means the remainder after dividing a by b.
+
+  This calculation is done using the shift-register method of multiplying and
+  taking the remainder.  The register is initialized to zero, and for each
+  incoming bit, x^32 is added mod p to the register if the bit is a one (where
+  x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by
+  x (which is shifting right by one and adding x^32 mod p if the bit shifted
+  out is a one).  We start with the highest power (least significant bit) of
+  q and repeat for all eight bits of q.
+
+  The first table is simply the CRC of all possible eight bit values.  This is
+  all the information needed to generate CRCs on data a byte at a time for all
+  combinations of CRC register values and incoming bytes.  The remaining tables
+  allow for word-at-a-time CRC calculation for both big-endian and little-
+  endian machines, where a word is four bytes.
+*/
+local void make_crc_table()
+{
+    unsigned long c;
+    int n, k;
+    unsigned long poly;                 /* polynomial exclusive-or pattern */
+    /* terms of polynomial defining this crc (except x^32): */
+    static volatile int first = 1;      /* flag to limit concurrent making */
+    static const unsigned char p[] = {0,1,2,4,5,7,8,10,11,12,16,22,23,26};
+
+    /* See if another task is already doing this (not thread-safe, but better
+       than nothing -- significantly reduces duration of vulnerability in
+       case the advice about DYNAMIC_CRC_TABLE is ignored) */
+    if (first) {
+        first = 0;
+
+        /* make exclusive-or pattern from polynomial (0xedb88320UL) */
+        poly = 0UL;
+        for (n = 0; n < sizeof(p)/sizeof(unsigned char); n++)
+            poly |= 1UL << (31 - p[n]);
+
+        /* generate a crc for every 8-bit value */
+        for (n = 0; n < 256; n++) {
+            c = (unsigned long)n;
+            for (k = 0; k < 8; k++)
+                c = c & 1 ? poly ^ (c >> 1) : c >> 1;
+            crc_table[0][n] = c;
+        }
+
+#ifdef BYFOUR
+        /* generate crc for each value followed by one, two, and three zeros,
+           and then the byte reversal of those as well as the first table */
+        for (n = 0; n < 256; n++) {
+            c = crc_table[0][n];
+            crc_table[4][n] = REV(c);
+            for (k = 1; k < 4; k++) {
+                c = crc_table[0][c & 0xff] ^ (c >> 8);
+                crc_table[k][n] = c;
+                crc_table[k + 4][n] = REV(c);
+            }
+        }
+#endif /* BYFOUR */
+
+        crc_table_empty = 0;
+    }
+    else {      /* not first */
+        /* wait for the other guy to finish (not efficient, but rare) */
+        while (crc_table_empty)
+            ;
+    }
+
+#ifdef MAKECRCH
+    /* write out CRC tables to crc32.h */
+    {
+        FILE *out;
+
+        out = fopen("crc32.h", "w");
+        if (out == NULL) return;
+        fprintf(out, "/* crc32.h -- tables for rapid CRC calculation\n");
+        fprintf(out, " * Generated automatically by crc32.c\n */\n\n");
+        fprintf(out, "local const unsigned long FAR ");
+        fprintf(out, "crc_table[TBLS][256] =\n{\n  {\n");
+        write_table(out, crc_table[0]);
+#  ifdef BYFOUR
+        fprintf(out, "#ifdef BYFOUR\n");
+        for (k = 1; k < 8; k++) {
+            fprintf(out, "  },\n  {\n");
+            write_table(out, crc_table[k]);
+        }
+        fprintf(out, "#endif\n");
+#  endif /* BYFOUR */
+        fprintf(out, "  }\n};\n");
+        fclose(out);
+    }
+#endif /* MAKECRCH */
+}
+
+#ifdef MAKECRCH
+local void write_table(out, table)
+    FILE *out;
+    const unsigned long FAR *table;
+{
+    int n;
+
+    for (n = 0; n < 256; n++)
+        fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : "    ", table[n],
+                n == 255 ? "\n" : (n % 5 == 4 ? ",\n" : ", "));
+}
+#endif /* MAKECRCH */
+
+#else /* !DYNAMIC_CRC_TABLE */
+/* ========================================================================
+ * Tables of CRC-32s of all single-byte values, made by make_crc_table().
+ */
+#include "crc32.h"
+#endif /* DYNAMIC_CRC_TABLE */
+
+/* =========================================================================
+ * This function can be used by asm versions of crc32()
+ */
+const unsigned long FAR * ZEXPORT get_crc_table()
+{
+#ifdef DYNAMIC_CRC_TABLE
+    if (crc_table_empty)
+        make_crc_table();
+#endif /* DYNAMIC_CRC_TABLE */
+    return (const unsigned long FAR *)crc_table;
+}
+
+/* ========================================================================= */
+#define DO1 crc = crc_table[0][((int)crc ^ (*buf++)) & 0xff] ^ (crc >> 8)
+#define DO8 DO1; DO1; DO1; DO1; DO1; DO1; DO1; DO1
+
+/* ========================================================================= */
+unsigned long ZEXPORT crc32(crc, buf, len)
+    unsigned long crc;
+    const unsigned char FAR *buf;
+    uInt len;
+{
+    if (buf == Z_NULL) return 0UL;
+
+#ifdef DYNAMIC_CRC_TABLE
+    if (crc_table_empty)
+        make_crc_table();
+#endif /* DYNAMIC_CRC_TABLE */
+
+#ifdef BYFOUR
+    if (sizeof(void *) == sizeof(ptrdiff_t)) {
+        u4 endian;
+
+        endian = 1;
+        if (*((unsigned char *)(&endian)))
+            return crc32_little(crc, buf, len);
+        else
+            return crc32_big(crc, buf, len);
+    }
+#endif /* BYFOUR */
+    crc = crc ^ 0xffffffffUL;
+    while (len >= 8) {
+        DO8;
+        len -= 8;
+    }
+    if (len) do {
+        DO1;
+    } while (--len);
+    return crc ^ 0xffffffffUL;
+}
+
+#ifdef BYFOUR
+
+/* ========================================================================= */
+#define DOLIT4 c ^= *buf4++; \
+        c = crc_table[3][c & 0xff] ^ crc_table[2][(c >> 8) & 0xff] ^ \
+            crc_table[1][(c >> 16) & 0xff] ^ crc_table[0][c >> 24]
+#define DOLIT32 DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4
+
+/* ========================================================================= */
+local unsigned long crc32_little(crc, buf, len)
+    unsigned long crc;
+    const unsigned char FAR *buf;
+    unsigned len;
+{
+    register u4 c;
+    register const u4 FAR *buf4;
+
+    c = (u4)crc;
+    c = ~c;
+    while (len && ((ptrdiff_t)buf & 3)) {
+        c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8);
+        len--;
+    }
+
+    buf4 = (const u4 FAR *)(const void FAR *)buf;
+    while (len >= 32) {
+        DOLIT32;
+        len -= 32;
+    }
+    while (len >= 4) {
+        DOLIT4;
+        len -= 4;
+    }
+    buf = (const unsigned char FAR *)buf4;
+
+    if (len) do {
+        c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8);
+    } while (--len);
+    c = ~c;
+    return (unsigned long)c;
+}
+
+/* ========================================================================= */
+#define DOBIG4 c ^= *++buf4; \
+        c = crc_table[4][c & 0xff] ^ crc_table[5][(c >> 8) & 0xff] ^ \
+            crc_table[6][(c >> 16) & 0xff] ^ crc_table[7][c >> 24]
+#define DOBIG32 DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4
+
+/* ========================================================================= */
+local unsigned long crc32_big(crc, buf, len)
+    unsigned long crc;
+    const unsigned char FAR *buf;
+    unsigned len;
+{
+    register u4 c;
+    register const u4 FAR *buf4;
+
+    c = REV((u4)crc);
+    c = ~c;
+    while (len && ((ptrdiff_t)buf & 3)) {
+        c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8);
+        len--;
+    }
+
+    buf4 = (const u4 FAR *)(const void FAR *)buf;
+    buf4--;
+    while (len >= 32) {
+        DOBIG32;
+        len -= 32;
+    }
+    while (len >= 4) {
+        DOBIG4;
+        len -= 4;
+    }
+    buf4++;
+    buf = (const unsigned char FAR *)buf4;
+
+    if (len) do {
+        c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8);
+    } while (--len);
+    c = ~c;
+    return (unsigned long)(REV(c));
+}
+
+#endif /* BYFOUR */
+
+#define GF2_DIM 32      /* dimension of GF(2) vectors (length of CRC) */
+
+/* ========================================================================= */
+local unsigned long gf2_matrix_times(mat, vec)
+    unsigned long *mat;
+    unsigned long vec;
+{
+    unsigned long sum;
+
+    sum = 0;
+    while (vec) {
+        if (vec & 1)
+            sum ^= *mat;
+        vec >>= 1;
+        mat++;
+    }
+    return sum;
+}
+
+/* ========================================================================= */
+local void gf2_matrix_square(square, mat)
+    unsigned long *square;
+    unsigned long *mat;
+{
+    int n;
+
+    for (n = 0; n < GF2_DIM; n++)
+        square[n] = gf2_matrix_times(mat, mat[n]);
+}
+
+/* ========================================================================= */
+local uLong crc32_combine_(crc1, crc2, len2)
+    uLong crc1;
+    uLong crc2;
+    z_off64_t len2;
+{
+    int n;
+    unsigned long row;
+    unsigned long even[GF2_DIM];    /* even-power-of-two zeros operator */
+    unsigned long odd[GF2_DIM];     /* odd-power-of-two zeros operator */
+
+    /* degenerate case (also disallow negative lengths) */
+    if (len2 <= 0)
+        return crc1;
+
+    /* put operator for one zero bit in odd */
+    odd[0] = 0xedb88320UL;          /* CRC-32 polynomial */
+    row = 1;
+    for (n = 1; n < GF2_DIM; n++) {
+        odd[n] = row;
+        row <<= 1;
+    }
+
+    /* put operator for two zero bits in even */
+    gf2_matrix_square(even, odd);
+
+    /* put operator for four zero bits in odd */
+    gf2_matrix_square(odd, even);
+
+    /* apply len2 zeros to crc1 (first square will put the operator for one
+       zero byte, eight zero bits, in even) */
+    do {
+        /* apply zeros operator for this bit of len2 */
+        gf2_matrix_square(even, odd);
+        if (len2 & 1)
+            crc1 = gf2_matrix_times(even, crc1);
+        len2 >>= 1;
+
+        /* if no more bits set, then done */
+        if (len2 == 0)
+            break;
+
+        /* another iteration of the loop with odd and even swapped */
+        gf2_matrix_square(odd, even);
+        if (len2 & 1)
+            crc1 = gf2_matrix_times(odd, crc1);
+        len2 >>= 1;
+
+        /* if no more bits set, then done */
+    } while (len2 != 0);
+
+    /* return combined crc */
+    crc1 ^= crc2;
+    return crc1;
+}
+
+/* ========================================================================= */
+uLong ZEXPORT crc32_combine(crc1, crc2, len2)
+    uLong crc1;
+    uLong crc2;
+    z_off_t len2;
+{
+    return crc32_combine_(crc1, crc2, len2);
+}
+
+uLong ZEXPORT crc32_combine64(crc1, crc2, len2)
+    uLong crc1;
+    uLong crc2;
+    z_off64_t len2;
+{
+    return crc32_combine_(crc1, crc2, len2);
+}

external/cfitsio/crc32.h

@@ -0,0 +1,441 @@
+/* crc32.h -- tables for rapid CRC calculation
+ * Generated automatically by crc32.c
+ */
+
+local const unsigned long FAR crc_table[TBLS][256] =
+{
+  {
+    0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL, 0x076dc419UL,
+    0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL, 0x0edb8832UL, 0x79dcb8a4UL,
+    0xe0d5e91eUL, 0x97d2d988UL, 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL,
+    0x90bf1d91UL, 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL,
+    0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL, 0x136c9856UL,
+    0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL, 0x14015c4fUL, 0x63066cd9UL,
+    0xfa0f3d63UL, 0x8d080df5UL, 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL,
+    0xa2677172UL, 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL,
+    0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL, 0x32d86ce3UL,
+    0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL, 0x26d930acUL, 0x51de003aUL,
+    0xc8d75180UL, 0xbfd06116UL, 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL,
+    0xb8bda50fUL, 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL,
+    0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL, 0x76dc4190UL,
+    0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL, 0x71b18589UL, 0x06b6b51fUL,
+    0x9fbfe4a5UL, 0xe8b8d433UL, 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL,
+    0xe10e9818UL, 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL,
+    0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL, 0x6c0695edUL,
+    0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL, 0x65b0d9c6UL, 0x12b7e950UL,
+    0x8bbeb8eaUL, 0xfcb9887cUL, 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL,
+    0xfbd44c65UL, 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL,
+    0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL, 0x4369e96aUL,
+    0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL, 0x44042d73UL, 0x33031de5UL,
+    0xaa0a4c5fUL, 0xdd0d7cc9UL, 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL,
+    0xc90c2086UL, 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL,
+    0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL, 0x59b33d17UL,
+    0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL, 0xedb88320UL, 0x9abfb3b6UL,
+    0x03b6e20cUL, 0x74b1d29aUL, 0xead54739UL, 0x9dd277afUL, 0x04db2615UL,
+    0x73dc1683UL, 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL,
+    0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL, 0xf00f9344UL,
+    0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL, 0xf762575dUL, 0x806567cbUL,
+    0x196c3671UL, 0x6e6b06e7UL, 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL,
+    0x67dd4accUL, 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL,
+    0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL, 0xd1bb67f1UL,
+    0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL, 0xd80d2bdaUL, 0xaf0a1b4cUL,
+    0x36034af6UL, 0x41047a60UL, 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL,
+    0x4669be79UL, 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL,
+    0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL, 0xc5ba3bbeUL,
+    0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL, 0xc2d7ffa7UL, 0xb5d0cf31UL,
+    0x2cd99e8bUL, 0x5bdeae1dUL, 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL,
+    0x026d930aUL, 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL,
+    0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL, 0x92d28e9bUL,
+    0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL, 0x86d3d2d4UL, 0xf1d4e242UL,
+    0x68ddb3f8UL, 0x1fda836eUL, 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL,
+    0x18b74777UL, 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL,
+    0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL, 0xa00ae278UL,
+    0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL, 0xa7672661UL, 0xd06016f7UL,
+    0x4969474dUL, 0x3e6e77dbUL, 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL,
+    0x37d83bf0UL, 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL,
+    0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL, 0xbad03605UL,
+    0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL, 0xb3667a2eUL, 0xc4614ab8UL,
+    0x5d681b02UL, 0x2a6f2b94UL, 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL,
+    0x2d02ef8dUL
+#ifdef BYFOUR
+  },
+  {
+    0x00000000UL, 0x191b3141UL, 0x32366282UL, 0x2b2d53c3UL, 0x646cc504UL,
+    0x7d77f445UL, 0x565aa786UL, 0x4f4196c7UL, 0xc8d98a08UL, 0xd1c2bb49UL,
+    0xfaefe88aUL, 0xe3f4d9cbUL, 0xacb54f0cUL, 0xb5ae7e4dUL, 0x9e832d8eUL,
+    0x87981ccfUL, 0x4ac21251UL, 0x53d92310UL, 0x78f470d3UL, 0x61ef4192UL,
+    0x2eaed755UL, 0x37b5e614UL, 0x1c98b5d7UL, 0x05838496UL, 0x821b9859UL,
+    0x9b00a918UL, 0xb02dfadbUL, 0xa936cb9aUL, 0xe6775d5dUL, 0xff6c6c1cUL,
+    0xd4413fdfUL, 0xcd5a0e9eUL, 0x958424a2UL, 0x8c9f15e3UL, 0xa7b24620UL,
+    0xbea97761UL, 0xf1e8e1a6UL, 0xe8f3d0e7UL, 0xc3de8324UL, 0xdac5b265UL,
+    0x5d5daeaaUL, 0x44469febUL, 0x6f6bcc28UL, 0x7670fd69UL, 0x39316baeUL,
+    0x202a5aefUL, 0x0b07092cUL, 0x121c386dUL, 0xdf4636f3UL, 0xc65d07b2UL,
+    0xed705471UL, 0xf46b6530UL, 0xbb2af3f7UL, 0xa231c2b6UL, 0x891c9175UL,
+    0x9007a034UL, 0x179fbcfbUL, 0x0e848dbaUL, 0x25a9de79UL, 0x3cb2ef38UL,
+    0x73f379ffUL, 0x6ae848beUL, 0x41c51b7dUL, 0x58de2a3cUL, 0xf0794f05UL,
+    0xe9627e44UL, 0xc24f2d87UL, 0xdb541cc6UL, 0x94158a01UL, 0x8d0ebb40UL,
+    0xa623e883UL, 0xbf38d9c2UL, 0x38a0c50dUL, 0x21bbf44cUL, 0x0a96a78fUL,
+    0x138d96ceUL, 0x5ccc0009UL, 0x45d73148UL, 0x6efa628bUL, 0x77e153caUL,
+    0xbabb5d54UL, 0xa3a06c15UL, 0x888d3fd6UL, 0x91960e97UL, 0xded79850UL,
+    0xc7cca911UL, 0xece1fad2UL, 0xf5facb93UL, 0x7262d75cUL, 0x6b79e61dUL,
+    0x4054b5deUL, 0x594f849fUL, 0x160e1258UL, 0x0f152319UL, 0x243870daUL,
+    0x3d23419bUL, 0x65fd6ba7UL, 0x7ce65ae6UL, 0x57cb0925UL, 0x4ed03864UL,
+    0x0191aea3UL, 0x188a9fe2UL, 0x33a7cc21UL, 0x2abcfd60UL, 0xad24e1afUL,
+    0xb43fd0eeUL, 0x9f12832dUL, 0x8609b26cUL, 0xc94824abUL, 0xd05315eaUL,
+    0xfb7e4629UL, 0xe2657768UL, 0x2f3f79f6UL, 0x362448b7UL, 0x1d091b74UL,
+    0x04122a35UL, 0x4b53bcf2UL, 0x52488db3UL, 0x7965de70UL, 0x607eef31UL,
+    0xe7e6f3feUL, 0xfefdc2bfUL, 0xd5d0917cUL, 0xcccba03dUL, 0x838a36faUL,
+    0x9a9107bbUL, 0xb1bc5478UL, 0xa8a76539UL, 0x3b83984bUL, 0x2298a90aUL,
+    0x09b5fac9UL, 0x10aecb88UL, 0x5fef5d4fUL, 0x46f46c0eUL, 0x6dd93fcdUL,
+    0x74c20e8cUL, 0xf35a1243UL, 0xea412302UL, 0xc16c70c1UL, 0xd8774180UL,
+    0x9736d747UL, 0x8e2de606UL, 0xa500b5c5UL, 0xbc1b8484UL, 0x71418a1aUL,
+    0x685abb5bUL, 0x4377e898UL, 0x5a6cd9d9UL, 0x152d4f1eUL, 0x0c367e5fUL,
+    0x271b2d9cUL, 0x3e001cddUL, 0xb9980012UL, 0xa0833153UL, 0x8bae6290UL,
+    0x92b553d1UL, 0xddf4c516UL, 0xc4eff457UL, 0xefc2a794UL, 0xf6d996d5UL,
+    0xae07bce9UL, 0xb71c8da8UL, 0x9c31de6bUL, 0x852aef2aUL, 0xca6b79edUL,
+    0xd37048acUL, 0xf85d1b6fUL, 0xe1462a2eUL, 0x66de36e1UL, 0x7fc507a0UL,
+    0x54e85463UL, 0x4df36522UL, 0x02b2f3e5UL, 0x1ba9c2a4UL, 0x30849167UL,
+    0x299fa026UL, 0xe4c5aeb8UL, 0xfdde9ff9UL, 0xd6f3cc3aUL, 0xcfe8fd7bUL,
+    0x80a96bbcUL, 0x99b25afdUL, 0xb29f093eUL, 0xab84387fUL, 0x2c1c24b0UL,
+    0x350715f1UL, 0x1e2a4632UL, 0x07317773UL, 0x4870e1b4UL, 0x516bd0f5UL,
+    0x7a468336UL, 0x635db277UL, 0xcbfad74eUL, 0xd2e1e60fUL, 0xf9ccb5ccUL,
+    0xe0d7848dUL, 0xaf96124aUL, 0xb68d230bUL, 0x9da070c8UL, 0x84bb4189UL,
+    0x03235d46UL, 0x1a386c07UL, 0x31153fc4UL, 0x280e0e85UL, 0x674f9842UL,
+    0x7e54a903UL, 0x5579fac0UL, 0x4c62cb81UL, 0x8138c51fUL, 0x9823f45eUL,
+    0xb30ea79dUL, 0xaa1596dcUL, 0xe554001bUL, 0xfc4f315aUL, 0xd7626299UL,
+    0xce7953d8UL, 0x49e14f17UL, 0x50fa7e56UL, 0x7bd72d95UL, 0x62cc1cd4UL,
+    0x2d8d8a13UL, 0x3496bb52UL, 0x1fbbe891UL, 0x06a0d9d0UL, 0x5e7ef3ecUL,
+    0x4765c2adUL, 0x6c48916eUL, 0x7553a02fUL, 0x3a1236e8UL, 0x230907a9UL,
+    0x0824546aUL, 0x113f652bUL, 0x96a779e4UL, 0x8fbc48a5UL, 0xa4911b66UL,
+    0xbd8a2a27UL, 0xf2cbbce0UL, 0xebd08da1UL, 0xc0fdde62UL, 0xd9e6ef23UL,
+    0x14bce1bdUL, 0x0da7d0fcUL, 0x268a833fUL, 0x3f91b27eUL, 0x70d024b9UL,
+    0x69cb15f8UL, 0x42e6463bUL, 0x5bfd777aUL, 0xdc656bb5UL, 0xc57e5af4UL,
+    0xee530937UL, 0xf7483876UL, 0xb809aeb1UL, 0xa1129ff0UL, 0x8a3fcc33UL,
+    0x9324fd72UL
+  },
+  {
+    0x00000000UL, 0x01c26a37UL, 0x0384d46eUL, 0x0246be59UL, 0x0709a8dcUL,
+    0x06cbc2ebUL, 0x048d7cb2UL, 0x054f1685UL, 0x0e1351b8UL, 0x0fd13b8fUL,
+    0x0d9785d6UL, 0x0c55efe1UL, 0x091af964UL, 0x08d89353UL, 0x0a9e2d0aUL,
+    0x0b5c473dUL, 0x1c26a370UL, 0x1de4c947UL, 0x1fa2771eUL, 0x1e601d29UL,
+    0x1b2f0bacUL, 0x1aed619bUL, 0x18abdfc2UL, 0x1969b5f5UL, 0x1235f2c8UL,
+    0x13f798ffUL, 0x11b126a6UL, 0x10734c91UL, 0x153c5a14UL, 0x14fe3023UL,
+    0x16b88e7aUL, 0x177ae44dUL, 0x384d46e0UL, 0x398f2cd7UL, 0x3bc9928eUL,
+    0x3a0bf8b9UL, 0x3f44ee3cUL, 0x3e86840bUL, 0x3cc03a52UL, 0x3d025065UL,
+    0x365e1758UL, 0x379c7d6fUL, 0x35dac336UL, 0x3418a901UL, 0x3157bf84UL,
+    0x3095d5b3UL, 0x32d36beaUL, 0x331101ddUL, 0x246be590UL, 0x25a98fa7UL,
+    0x27ef31feUL, 0x262d5bc9UL, 0x23624d4cUL, 0x22a0277bUL, 0x20e69922UL,
+    0x2124f315UL, 0x2a78b428UL, 0x2bbade1fUL, 0x29fc6046UL, 0x283e0a71UL,
+    0x2d711cf4UL, 0x2cb376c3UL, 0x2ef5c89aUL, 0x2f37a2adUL, 0x709a8dc0UL,
+    0x7158e7f7UL, 0x731e59aeUL, 0x72dc3399UL, 0x7793251cUL, 0x76514f2bUL,
+    0x7417f172UL, 0x75d59b45UL, 0x7e89dc78UL, 0x7f4bb64fUL, 0x7d0d0816UL,
+    0x7ccf6221UL, 0x798074a4UL, 0x78421e93UL, 0x7a04a0caUL, 0x7bc6cafdUL,
+    0x6cbc2eb0UL, 0x6d7e4487UL, 0x6f38fadeUL, 0x6efa90e9UL, 0x6bb5866cUL,
+    0x6a77ec5bUL, 0x68315202UL, 0x69f33835UL, 0x62af7f08UL, 0x636d153fUL,
+    0x612bab66UL, 0x60e9c151UL, 0x65a6d7d4UL, 0x6464bde3UL, 0x662203baUL,
+    0x67e0698dUL, 0x48d7cb20UL, 0x4915a117UL, 0x4b531f4eUL, 0x4a917579UL,
+    0x4fde63fcUL, 0x4e1c09cbUL, 0x4c5ab792UL, 0x4d98dda5UL, 0x46c49a98UL,
+    0x4706f0afUL, 0x45404ef6UL, 0x448224c1UL, 0x41cd3244UL, 0x400f5873UL,
+    0x4249e62aUL, 0x438b8c1dUL, 0x54f16850UL, 0x55330267UL, 0x5775bc3eUL,
+    0x56b7d609UL, 0x53f8c08cUL, 0x523aaabbUL, 0x507c14e2UL, 0x51be7ed5UL,
+    0x5ae239e8UL, 0x5b2053dfUL, 0x5966ed86UL, 0x58a487b1UL, 0x5deb9134UL,
+    0x5c29fb03UL, 0x5e6f455aUL, 0x5fad2f6dUL, 0xe1351b80UL, 0xe0f771b7UL,
+    0xe2b1cfeeUL, 0xe373a5d9UL, 0xe63cb35cUL, 0xe7fed96bUL, 0xe5b86732UL,
+    0xe47a0d05UL, 0xef264a38UL, 0xeee4200fUL, 0xeca29e56UL, 0xed60f461UL,
+    0xe82fe2e4UL, 0xe9ed88d3UL, 0xebab368aUL, 0xea695cbdUL, 0xfd13b8f0UL,
+    0xfcd1d2c7UL, 0xfe976c9eUL, 0xff5506a9UL, 0xfa1a102cUL, 0xfbd87a1bUL,
+    0xf99ec442UL, 0xf85cae75UL, 0xf300e948UL, 0xf2c2837fUL, 0xf0843d26UL,
+    0xf1465711UL, 0xf4094194UL, 0xf5cb2ba3UL, 0xf78d95faUL, 0xf64fffcdUL,
+    0xd9785d60UL, 0xd8ba3757UL, 0xdafc890eUL, 0xdb3ee339UL, 0xde71f5bcUL,
+    0xdfb39f8bUL, 0xddf521d2UL, 0xdc374be5UL, 0xd76b0cd8UL, 0xd6a966efUL,
+    0xd4efd8b6UL, 0xd52db281UL, 0xd062a404UL, 0xd1a0ce33UL, 0xd3e6706aUL,
+    0xd2241a5dUL, 0xc55efe10UL, 0xc49c9427UL, 0xc6da2a7eUL, 0xc7184049UL,
+    0xc25756ccUL, 0xc3953cfbUL, 0xc1d382a2UL, 0xc011e895UL, 0xcb4dafa8UL,
+    0xca8fc59fUL, 0xc8c97bc6UL, 0xc90b11f1UL, 0xcc440774UL, 0xcd866d43UL,
+    0xcfc0d31aUL, 0xce02b92dUL, 0x91af9640UL, 0x906dfc77UL, 0x922b422eUL,
+    0x93e92819UL, 0x96a63e9cUL, 0x976454abUL, 0x9522eaf2UL, 0x94e080c5UL,
+    0x9fbcc7f8UL, 0x9e7eadcfUL, 0x9c381396UL, 0x9dfa79a1UL, 0x98b56f24UL,
+    0x99770513UL, 0x9b31bb4aUL, 0x9af3d17dUL, 0x8d893530UL, 0x8c4b5f07UL,
+    0x8e0de15eUL, 0x8fcf8b69UL, 0x8a809decUL, 0x8b42f7dbUL, 0x89044982UL,
+    0x88c623b5UL, 0x839a6488UL, 0x82580ebfUL, 0x801eb0e6UL, 0x81dcdad1UL,
+    0x8493cc54UL, 0x8551a663UL, 0x8717183aUL, 0x86d5720dUL, 0xa9e2d0a0UL,
+    0xa820ba97UL, 0xaa6604ceUL, 0xaba46ef9UL, 0xaeeb787cUL, 0xaf29124bUL,
+    0xad6fac12UL, 0xacadc625UL, 0xa7f18118UL, 0xa633eb2fUL, 0xa4755576UL,
+    0xa5b73f41UL, 0xa0f829c4UL, 0xa13a43f3UL, 0xa37cfdaaUL, 0xa2be979dUL,
+    0xb5c473d0UL, 0xb40619e7UL, 0xb640a7beUL, 0xb782cd89UL, 0xb2cddb0cUL,
+    0xb30fb13bUL, 0xb1490f62UL, 0xb08b6555UL, 0xbbd72268UL, 0xba15485fUL,
+    0xb853f606UL, 0xb9919c31UL, 0xbcde8ab4UL, 0xbd1ce083UL, 0xbf5a5edaUL,
+    0xbe9834edUL
+  },
+  {
+    0x00000000UL, 0xb8bc6765UL, 0xaa09c88bUL, 0x12b5afeeUL, 0x8f629757UL,
+    0x37def032UL, 0x256b5fdcUL, 0x9dd738b9UL, 0xc5b428efUL, 0x7d084f8aUL,
+    0x6fbde064UL, 0xd7018701UL, 0x4ad6bfb8UL, 0xf26ad8ddUL, 0xe0df7733UL,
+    0x58631056UL, 0x5019579fUL, 0xe8a530faUL, 0xfa109f14UL, 0x42acf871UL,
+    0xdf7bc0c8UL, 0x67c7a7adUL, 0x75720843UL, 0xcdce6f26UL, 0x95ad7f70UL,
+    0x2d111815UL, 0x3fa4b7fbUL, 0x8718d09eUL, 0x1acfe827UL, 0xa2738f42UL,
+    0xb0c620acUL, 0x087a47c9UL, 0xa032af3eUL, 0x188ec85bUL, 0x0a3b67b5UL,
+    0xb28700d0UL, 0x2f503869UL, 0x97ec5f0cUL, 0x8559f0e2UL, 0x3de59787UL,
+    0x658687d1UL, 0xdd3ae0b4UL, 0xcf8f4f5aUL, 0x7733283fUL, 0xeae41086UL,
+    0x525877e3UL, 0x40edd80dUL, 0xf851bf68UL, 0xf02bf8a1UL, 0x48979fc4UL,
+    0x5a22302aUL, 0xe29e574fUL, 0x7f496ff6UL, 0xc7f50893UL, 0xd540a77dUL,
+    0x6dfcc018UL, 0x359fd04eUL, 0x8d23b72bUL, 0x9f9618c5UL, 0x272a7fa0UL,
+    0xbafd4719UL, 0x0241207cUL, 0x10f48f92UL, 0xa848e8f7UL, 0x9b14583dUL,
+    0x23a83f58UL, 0x311d90b6UL, 0x89a1f7d3UL, 0x1476cf6aUL, 0xaccaa80fUL,
+    0xbe7f07e1UL, 0x06c36084UL, 0x5ea070d2UL, 0xe61c17b7UL, 0xf4a9b859UL,
+    0x4c15df3cUL, 0xd1c2e785UL, 0x697e80e0UL, 0x7bcb2f0eUL, 0xc377486bUL,
+    0xcb0d0fa2UL, 0x73b168c7UL, 0x6104c729UL, 0xd9b8a04cUL, 0x446f98f5UL,
+    0xfcd3ff90UL, 0xee66507eUL, 0x56da371bUL, 0x0eb9274dUL, 0xb6054028UL,
+    0xa4b0efc6UL, 0x1c0c88a3UL, 0x81dbb01aUL, 0x3967d77fUL, 0x2bd27891UL,
+    0x936e1ff4UL, 0x3b26f703UL, 0x839a9066UL, 0x912f3f88UL, 0x299358edUL,
+    0xb4446054UL, 0x0cf80731UL, 0x1e4da8dfUL, 0xa6f1cfbaUL, 0xfe92dfecUL,
+    0x462eb889UL, 0x549b1767UL, 0xec277002UL, 0x71f048bbUL, 0xc94c2fdeUL,
+    0xdbf98030UL, 0x6345e755UL, 0x6b3fa09cUL, 0xd383c7f9UL, 0xc1366817UL,
+    0x798a0f72UL, 0xe45d37cbUL, 0x5ce150aeUL, 0x4e54ff40UL, 0xf6e89825UL,
+    0xae8b8873UL, 0x1637ef16UL, 0x048240f8UL, 0xbc3e279dUL, 0x21e91f24UL,
+    0x99557841UL, 0x8be0d7afUL, 0x335cb0caUL, 0xed59b63bUL, 0x55e5d15eUL,
+    0x47507eb0UL, 0xffec19d5UL, 0x623b216cUL, 0xda874609UL, 0xc832e9e7UL,
+    0x708e8e82UL, 0x28ed9ed4UL, 0x9051f9b1UL, 0x82e4565fUL, 0x3a58313aUL,
+    0xa78f0983UL, 0x1f336ee6UL, 0x0d86c108UL, 0xb53aa66dUL, 0xbd40e1a4UL,
+    0x05fc86c1UL, 0x1749292fUL, 0xaff54e4aUL, 0x322276f3UL, 0x8a9e1196UL,
+    0x982bbe78UL, 0x2097d91dUL, 0x78f4c94bUL, 0xc048ae2eUL, 0xd2fd01c0UL,
+    0x6a4166a5UL, 0xf7965e1cUL, 0x4f2a3979UL, 0x5d9f9697UL, 0xe523f1f2UL,
+    0x4d6b1905UL, 0xf5d77e60UL, 0xe762d18eUL, 0x5fdeb6ebUL, 0xc2098e52UL,
+    0x7ab5e937UL, 0x680046d9UL, 0xd0bc21bcUL, 0x88df31eaUL, 0x3063568fUL,
+    0x22d6f961UL, 0x9a6a9e04UL, 0x07bda6bdUL, 0xbf01c1d8UL, 0xadb46e36UL,
+    0x15080953UL, 0x1d724e9aUL, 0xa5ce29ffUL, 0xb77b8611UL, 0x0fc7e174UL,
+    0x9210d9cdUL, 0x2aacbea8UL, 0x38191146UL, 0x80a57623UL, 0xd8c66675UL,
+    0x607a0110UL, 0x72cfaefeUL, 0xca73c99bUL, 0x57a4f122UL, 0xef189647UL,
+    0xfdad39a9UL, 0x45115eccUL, 0x764dee06UL, 0xcef18963UL, 0xdc44268dUL,
+    0x64f841e8UL, 0xf92f7951UL, 0x41931e34UL, 0x5326b1daUL, 0xeb9ad6bfUL,
+    0xb3f9c6e9UL, 0x0b45a18cUL, 0x19f00e62UL, 0xa14c6907UL, 0x3c9b51beUL,
+    0x842736dbUL, 0x96929935UL, 0x2e2efe50UL, 0x2654b999UL, 0x9ee8defcUL,
+    0x8c5d7112UL, 0x34e11677UL, 0xa9362eceUL, 0x118a49abUL, 0x033fe645UL,
+    0xbb838120UL, 0xe3e09176UL, 0x5b5cf613UL, 0x49e959fdUL, 0xf1553e98UL,
+    0x6c820621UL, 0xd43e6144UL, 0xc68bceaaUL, 0x7e37a9cfUL, 0xd67f4138UL,
+    0x6ec3265dUL, 0x7c7689b3UL, 0xc4caeed6UL, 0x591dd66fUL, 0xe1a1b10aUL,
+    0xf3141ee4UL, 0x4ba87981UL, 0x13cb69d7UL, 0xab770eb2UL, 0xb9c2a15cUL,
+    0x017ec639UL, 0x9ca9fe80UL, 0x241599e5UL, 0x36a0360bUL, 0x8e1c516eUL,
+    0x866616a7UL, 0x3eda71c2UL, 0x2c6fde2cUL, 0x94d3b949UL, 0x090481f0UL,
+    0xb1b8e695UL, 0xa30d497bUL, 0x1bb12e1eUL, 0x43d23e48UL, 0xfb6e592dUL,
+    0xe9dbf6c3UL, 0x516791a6UL, 0xccb0a91fUL, 0x740cce7aUL, 0x66b96194UL,
+    0xde0506f1UL
+  },
+  {
+    0x00000000UL, 0x96300777UL, 0x2c610eeeUL, 0xba510999UL, 0x19c46d07UL,
+    0x8ff46a70UL, 0x35a563e9UL, 0xa395649eUL, 0x3288db0eUL, 0xa4b8dc79UL,
+    0x1ee9d5e0UL, 0x88d9d297UL, 0x2b4cb609UL, 0xbd7cb17eUL, 0x072db8e7UL,
+    0x911dbf90UL, 0x6410b71dUL, 0xf220b06aUL, 0x4871b9f3UL, 0xde41be84UL,
+    0x7dd4da1aUL, 0xebe4dd6dUL, 0x51b5d4f4UL, 0xc785d383UL, 0x56986c13UL,
+    0xc0a86b64UL, 0x7af962fdUL, 0xecc9658aUL, 0x4f5c0114UL, 0xd96c0663UL,
+    0x633d0ffaUL, 0xf50d088dUL, 0xc8206e3bUL, 0x5e10694cUL, 0xe44160d5UL,
+    0x727167a2UL, 0xd1e4033cUL, 0x47d4044bUL, 0xfd850dd2UL, 0x6bb50aa5UL,
+    0xfaa8b535UL, 0x6c98b242UL, 0xd6c9bbdbUL, 0x40f9bcacUL, 0xe36cd832UL,
+    0x755cdf45UL, 0xcf0dd6dcUL, 0x593dd1abUL, 0xac30d926UL, 0x3a00de51UL,
+    0x8051d7c8UL, 0x1661d0bfUL, 0xb5f4b421UL, 0x23c4b356UL, 0x9995bacfUL,
+    0x0fa5bdb8UL, 0x9eb80228UL, 0x0888055fUL, 0xb2d90cc6UL, 0x24e90bb1UL,
+    0x877c6f2fUL, 0x114c6858UL, 0xab1d61c1UL, 0x3d2d66b6UL, 0x9041dc76UL,
+    0x0671db01UL, 0xbc20d298UL, 0x2a10d5efUL, 0x8985b171UL, 0x1fb5b606UL,
+    0xa5e4bf9fUL, 0x33d4b8e8UL, 0xa2c90778UL, 0x34f9000fUL, 0x8ea80996UL,
+    0x18980ee1UL, 0xbb0d6a7fUL, 0x2d3d6d08UL, 0x976c6491UL, 0x015c63e6UL,
+    0xf4516b6bUL, 0x62616c1cUL, 0xd8306585UL, 0x4e0062f2UL, 0xed95066cUL,
+    0x7ba5011bUL, 0xc1f40882UL, 0x57c40ff5UL, 0xc6d9b065UL, 0x50e9b712UL,
+    0xeab8be8bUL, 0x7c88b9fcUL, 0xdf1ddd62UL, 0x492dda15UL, 0xf37cd38cUL,
+    0x654cd4fbUL, 0x5861b24dUL, 0xce51b53aUL, 0x7400bca3UL, 0xe230bbd4UL,
+    0x41a5df4aUL, 0xd795d83dUL, 0x6dc4d1a4UL, 0xfbf4d6d3UL, 0x6ae96943UL,
+    0xfcd96e34UL, 0x468867adUL, 0xd0b860daUL, 0x732d0444UL, 0xe51d0333UL,
+    0x5f4c0aaaUL, 0xc97c0dddUL, 0x3c710550UL, 0xaa410227UL, 0x10100bbeUL,
+    0x86200cc9UL, 0x25b56857UL, 0xb3856f20UL, 0x09d466b9UL, 0x9fe461ceUL,
+    0x0ef9de5eUL, 0x98c9d929UL, 0x2298d0b0UL, 0xb4a8d7c7UL, 0x173db359UL,
+    0x810db42eUL, 0x3b5cbdb7UL, 0xad6cbac0UL, 0x2083b8edUL, 0xb6b3bf9aUL,
+    0x0ce2b603UL, 0x9ad2b174UL, 0x3947d5eaUL, 0xaf77d29dUL, 0x1526db04UL,
+    0x8316dc73UL, 0x120b63e3UL, 0x843b6494UL, 0x3e6a6d0dUL, 0xa85a6a7aUL,
+    0x0bcf0ee4UL, 0x9dff0993UL, 0x27ae000aUL, 0xb19e077dUL, 0x44930ff0UL,
+    0xd2a30887UL, 0x68f2011eUL, 0xfec20669UL, 0x5d5762f7UL, 0xcb676580UL,
+    0x71366c19UL, 0xe7066b6eUL, 0x761bd4feUL, 0xe02bd389UL, 0x5a7ada10UL,
+    0xcc4add67UL, 0x6fdfb9f9UL, 0xf9efbe8eUL, 0x43beb717UL, 0xd58eb060UL,
+    0xe8a3d6d6UL, 0x7e93d1a1UL, 0xc4c2d838UL, 0x52f2df4fUL, 0xf167bbd1UL,
+    0x6757bca6UL, 0xdd06b53fUL, 0x4b36b248UL, 0xda2b0dd8UL, 0x4c1b0aafUL,
+    0xf64a0336UL, 0x607a0441UL, 0xc3ef60dfUL, 0x55df67a8UL, 0xef8e6e31UL,
+    0x79be6946UL, 0x8cb361cbUL, 0x1a8366bcUL, 0xa0d26f25UL, 0x36e26852UL,
+    0x95770cccUL, 0x03470bbbUL, 0xb9160222UL, 0x2f260555UL, 0xbe3bbac5UL,
+    0x280bbdb2UL, 0x925ab42bUL, 0x046ab35cUL, 0xa7ffd7c2UL, 0x31cfd0b5UL,
+    0x8b9ed92cUL, 0x1daede5bUL, 0xb0c2649bUL, 0x26f263ecUL, 0x9ca36a75UL,
+    0x0a936d02UL, 0xa906099cUL, 0x3f360eebUL, 0x85670772UL, 0x13570005UL,
+    0x824abf95UL, 0x147ab8e2UL, 0xae2bb17bUL, 0x381bb60cUL, 0x9b8ed292UL,
+    0x0dbed5e5UL, 0xb7efdc7cUL, 0x21dfdb0bUL, 0xd4d2d386UL, 0x42e2d4f1UL,
+    0xf8b3dd68UL, 0x6e83da1fUL, 0xcd16be81UL, 0x5b26b9f6UL, 0xe177b06fUL,
+    0x7747b718UL, 0xe65a0888UL, 0x706a0fffUL, 0xca3b0666UL, 0x5c0b0111UL,
+    0xff9e658fUL, 0x69ae62f8UL, 0xd3ff6b61UL, 0x45cf6c16UL, 0x78e20aa0UL,
+    0xeed20dd7UL, 0x5483044eUL, 0xc2b30339UL, 0x612667a7UL, 0xf71660d0UL,
+    0x4d476949UL, 0xdb776e3eUL, 0x4a6ad1aeUL, 0xdc5ad6d9UL, 0x660bdf40UL,
+    0xf03bd837UL, 0x53aebca9UL, 0xc59ebbdeUL, 0x7fcfb247UL, 0xe9ffb530UL,
+    0x1cf2bdbdUL, 0x8ac2bacaUL, 0x3093b353UL, 0xa6a3b424UL, 0x0536d0baUL,
+    0x9306d7cdUL, 0x2957de54UL, 0xbf67d923UL, 0x2e7a66b3UL, 0xb84a61c4UL,
+    0x021b685dUL, 0x942b6f2aUL, 0x37be0bb4UL, 0xa18e0cc3UL, 0x1bdf055aUL,
+    0x8def022dUL
+  },
+  {
+    0x00000000UL, 0x41311b19UL, 0x82623632UL, 0xc3532d2bUL, 0x04c56c64UL,
+    0x45f4777dUL, 0x86a75a56UL, 0xc796414fUL, 0x088ad9c8UL, 0x49bbc2d1UL,
+    0x8ae8effaUL, 0xcbd9f4e3UL, 0x0c4fb5acUL, 0x4d7eaeb5UL, 0x8e2d839eUL,
+    0xcf1c9887UL, 0x5112c24aUL, 0x1023d953UL, 0xd370f478UL, 0x9241ef61UL,
+    0x55d7ae2eUL, 0x14e6b537UL, 0xd7b5981cUL, 0x96848305UL, 0x59981b82UL,
+    0x18a9009bUL, 0xdbfa2db0UL, 0x9acb36a9UL, 0x5d5d77e6UL, 0x1c6c6cffUL,
+    0xdf3f41d4UL, 0x9e0e5acdUL, 0xa2248495UL, 0xe3159f8cUL, 0x2046b2a7UL,
+    0x6177a9beUL, 0xa6e1e8f1UL, 0xe7d0f3e8UL, 0x2483dec3UL, 0x65b2c5daUL,
+    0xaaae5d5dUL, 0xeb9f4644UL, 0x28cc6b6fUL, 0x69fd7076UL, 0xae6b3139UL,
+    0xef5a2a20UL, 0x2c09070bUL, 0x6d381c12UL, 0xf33646dfUL, 0xb2075dc6UL,
+    0x715470edUL, 0x30656bf4UL, 0xf7f32abbUL, 0xb6c231a2UL, 0x75911c89UL,
+    0x34a00790UL, 0xfbbc9f17UL, 0xba8d840eUL, 0x79dea925UL, 0x38efb23cUL,
+    0xff79f373UL, 0xbe48e86aUL, 0x7d1bc541UL, 0x3c2ade58UL, 0x054f79f0UL,
+    0x447e62e9UL, 0x872d4fc2UL, 0xc61c54dbUL, 0x018a1594UL, 0x40bb0e8dUL,
+    0x83e823a6UL, 0xc2d938bfUL, 0x0dc5a038UL, 0x4cf4bb21UL, 0x8fa7960aUL,
+    0xce968d13UL, 0x0900cc5cUL, 0x4831d745UL, 0x8b62fa6eUL, 0xca53e177UL,
+    0x545dbbbaUL, 0x156ca0a3UL, 0xd63f8d88UL, 0x970e9691UL, 0x5098d7deUL,
+    0x11a9ccc7UL, 0xd2fae1ecUL, 0x93cbfaf5UL, 0x5cd76272UL, 0x1de6796bUL,
+    0xdeb55440UL, 0x9f844f59UL, 0x58120e16UL, 0x1923150fUL, 0xda703824UL,
+    0x9b41233dUL, 0xa76bfd65UL, 0xe65ae67cUL, 0x2509cb57UL, 0x6438d04eUL,
+    0xa3ae9101UL, 0xe29f8a18UL, 0x21cca733UL, 0x60fdbc2aUL, 0xafe124adUL,
+    0xeed03fb4UL, 0x2d83129fUL, 0x6cb20986UL, 0xab2448c9UL, 0xea1553d0UL,
+    0x29467efbUL, 0x687765e2UL, 0xf6793f2fUL, 0xb7482436UL, 0x741b091dUL,
+    0x352a1204UL, 0xf2bc534bUL, 0xb38d4852UL, 0x70de6579UL, 0x31ef7e60UL,
+    0xfef3e6e7UL, 0xbfc2fdfeUL, 0x7c91d0d5UL, 0x3da0cbccUL, 0xfa368a83UL,
+    0xbb07919aUL, 0x7854bcb1UL, 0x3965a7a8UL, 0x4b98833bUL, 0x0aa99822UL,
+    0xc9fab509UL, 0x88cbae10UL, 0x4f5def5fUL, 0x0e6cf446UL, 0xcd3fd96dUL,
+    0x8c0ec274UL, 0x43125af3UL, 0x022341eaUL, 0xc1706cc1UL, 0x804177d8UL,
+    0x47d73697UL, 0x06e62d8eUL, 0xc5b500a5UL, 0x84841bbcUL, 0x1a8a4171UL,
+    0x5bbb5a68UL, 0x98e87743UL, 0xd9d96c5aUL, 0x1e4f2d15UL, 0x5f7e360cUL,
+    0x9c2d1b27UL, 0xdd1c003eUL, 0x120098b9UL, 0x533183a0UL, 0x9062ae8bUL,
+    0xd153b592UL, 0x16c5f4ddUL, 0x57f4efc4UL, 0x94a7c2efUL, 0xd596d9f6UL,
+    0xe9bc07aeUL, 0xa88d1cb7UL, 0x6bde319cUL, 0x2aef2a85UL, 0xed796bcaUL,
+    0xac4870d3UL, 0x6f1b5df8UL, 0x2e2a46e1UL, 0xe136de66UL, 0xa007c57fUL,
+    0x6354e854UL, 0x2265f34dUL, 0xe5f3b202UL, 0xa4c2a91bUL, 0x67918430UL,
+    0x26a09f29UL, 0xb8aec5e4UL, 0xf99fdefdUL, 0x3accf3d6UL, 0x7bfde8cfUL,
+    0xbc6ba980UL, 0xfd5ab299UL, 0x3e099fb2UL, 0x7f3884abUL, 0xb0241c2cUL,
+    0xf1150735UL, 0x32462a1eUL, 0x73773107UL, 0xb4e17048UL, 0xf5d06b51UL,
+    0x3683467aUL, 0x77b25d63UL, 0x4ed7facbUL, 0x0fe6e1d2UL, 0xccb5ccf9UL,
+    0x8d84d7e0UL, 0x4a1296afUL, 0x0b238db6UL, 0xc870a09dUL, 0x8941bb84UL,
+    0x465d2303UL, 0x076c381aUL, 0xc43f1531UL, 0x850e0e28UL, 0x42984f67UL,
+    0x03a9547eUL, 0xc0fa7955UL, 0x81cb624cUL, 0x1fc53881UL, 0x5ef42398UL,
+    0x9da70eb3UL, 0xdc9615aaUL, 0x1b0054e5UL, 0x5a314ffcUL, 0x996262d7UL,
+    0xd85379ceUL, 0x174fe149UL, 0x567efa50UL, 0x952dd77bUL, 0xd41ccc62UL,
+    0x138a8d2dUL, 0x52bb9634UL, 0x91e8bb1fUL, 0xd0d9a006UL, 0xecf37e5eUL,
+    0xadc26547UL, 0x6e91486cUL, 0x2fa05375UL, 0xe836123aUL, 0xa9070923UL,
+    0x6a542408UL, 0x2b653f11UL, 0xe479a796UL, 0xa548bc8fUL, 0x661b91a4UL,
+    0x272a8abdUL, 0xe0bccbf2UL, 0xa18dd0ebUL, 0x62defdc0UL, 0x23efe6d9UL,
+    0xbde1bc14UL, 0xfcd0a70dUL, 0x3f838a26UL, 0x7eb2913fUL, 0xb924d070UL,
+    0xf815cb69UL, 0x3b46e642UL, 0x7a77fd5bUL, 0xb56b65dcUL, 0xf45a7ec5UL,
+    0x370953eeUL, 0x763848f7UL, 0xb1ae09b8UL, 0xf09f12a1UL, 0x33cc3f8aUL,
+    0x72fd2493UL
+  },
+  {
+    0x00000000UL, 0x376ac201UL, 0x6ed48403UL, 0x59be4602UL, 0xdca80907UL,
+    0xebc2cb06UL, 0xb27c8d04UL, 0x85164f05UL, 0xb851130eUL, 0x8f3bd10fUL,
+    0xd685970dUL, 0xe1ef550cUL, 0x64f91a09UL, 0x5393d808UL, 0x0a2d9e0aUL,
+    0x3d475c0bUL, 0x70a3261cUL, 0x47c9e41dUL, 0x1e77a21fUL, 0x291d601eUL,
+    0xac0b2f1bUL, 0x9b61ed1aUL, 0xc2dfab18UL, 0xf5b56919UL, 0xc8f23512UL,
+    0xff98f713UL, 0xa626b111UL, 0x914c7310UL, 0x145a3c15UL, 0x2330fe14UL,
+    0x7a8eb816UL, 0x4de47a17UL, 0xe0464d38UL, 0xd72c8f39UL, 0x8e92c93bUL,
+    0xb9f80b3aUL, 0x3cee443fUL, 0x0b84863eUL, 0x523ac03cUL, 0x6550023dUL,
+    0x58175e36UL, 0x6f7d9c37UL, 0x36c3da35UL, 0x01a91834UL, 0x84bf5731UL,
+    0xb3d59530UL, 0xea6bd332UL, 0xdd011133UL, 0x90e56b24UL, 0xa78fa925UL,
+    0xfe31ef27UL, 0xc95b2d26UL, 0x4c4d6223UL, 0x7b27a022UL, 0x2299e620UL,
+    0x15f32421UL, 0x28b4782aUL, 0x1fdeba2bUL, 0x4660fc29UL, 0x710a3e28UL,
+    0xf41c712dUL, 0xc376b32cUL, 0x9ac8f52eUL, 0xada2372fUL, 0xc08d9a70UL,
+    0xf7e75871UL, 0xae591e73UL, 0x9933dc72UL, 0x1c259377UL, 0x2b4f5176UL,
+    0x72f11774UL, 0x459bd575UL, 0x78dc897eUL, 0x4fb64b7fUL, 0x16080d7dUL,
+    0x2162cf7cUL, 0xa4748079UL, 0x931e4278UL, 0xcaa0047aUL, 0xfdcac67bUL,
+    0xb02ebc6cUL, 0x87447e6dUL, 0xdefa386fUL, 0xe990fa6eUL, 0x6c86b56bUL,
+    0x5bec776aUL, 0x02523168UL, 0x3538f369UL, 0x087faf62UL, 0x3f156d63UL,
+    0x66ab2b61UL, 0x51c1e960UL, 0xd4d7a665UL, 0xe3bd6464UL, 0xba032266UL,
+    0x8d69e067UL, 0x20cbd748UL, 0x17a11549UL, 0x4e1f534bUL, 0x7975914aUL,
+    0xfc63de4fUL, 0xcb091c4eUL, 0x92b75a4cUL, 0xa5dd984dUL, 0x989ac446UL,
+    0xaff00647UL, 0xf64e4045UL, 0xc1248244UL, 0x4432cd41UL, 0x73580f40UL,
+    0x2ae64942UL, 0x1d8c8b43UL, 0x5068f154UL, 0x67023355UL, 0x3ebc7557UL,
+    0x09d6b756UL, 0x8cc0f853UL, 0xbbaa3a52UL, 0xe2147c50UL, 0xd57ebe51UL,
+    0xe839e25aUL, 0xdf53205bUL, 0x86ed6659UL, 0xb187a458UL, 0x3491eb5dUL,
+    0x03fb295cUL, 0x5a456f5eUL, 0x6d2fad5fUL, 0x801b35e1UL, 0xb771f7e0UL,
+    0xeecfb1e2UL, 0xd9a573e3UL, 0x5cb33ce6UL, 0x6bd9fee7UL, 0x3267b8e5UL,
+    0x050d7ae4UL, 0x384a26efUL, 0x0f20e4eeUL, 0x569ea2ecUL, 0x61f460edUL,
+    0xe4e22fe8UL, 0xd388ede9UL, 0x8a36abebUL, 0xbd5c69eaUL, 0xf0b813fdUL,
+    0xc7d2d1fcUL, 0x9e6c97feUL, 0xa90655ffUL, 0x2c101afaUL, 0x1b7ad8fbUL,
+    0x42c49ef9UL, 0x75ae5cf8UL, 0x48e900f3UL, 0x7f83c2f2UL, 0x263d84f0UL,
+    0x115746f1UL, 0x944109f4UL, 0xa32bcbf5UL, 0xfa958df7UL, 0xcdff4ff6UL,
+    0x605d78d9UL, 0x5737bad8UL, 0x0e89fcdaUL, 0x39e33edbUL, 0xbcf571deUL,
+    0x8b9fb3dfUL, 0xd221f5ddUL, 0xe54b37dcUL, 0xd80c6bd7UL, 0xef66a9d6UL,
+    0xb6d8efd4UL, 0x81b22dd5UL, 0x04a462d0UL, 0x33cea0d1UL, 0x6a70e6d3UL,
+    0x5d1a24d2UL, 0x10fe5ec5UL, 0x27949cc4UL, 0x7e2adac6UL, 0x494018c7UL,
+    0xcc5657c2UL, 0xfb3c95c3UL, 0xa282d3c1UL, 0x95e811c0UL, 0xa8af4dcbUL,
+    0x9fc58fcaUL, 0xc67bc9c8UL, 0xf1110bc9UL, 0x740744ccUL, 0x436d86cdUL,
+    0x1ad3c0cfUL, 0x2db902ceUL, 0x4096af91UL, 0x77fc6d90UL, 0x2e422b92UL,
+    0x1928e993UL, 0x9c3ea696UL, 0xab546497UL, 0xf2ea2295UL, 0xc580e094UL,
+    0xf8c7bc9fUL, 0xcfad7e9eUL, 0x9613389cUL, 0xa179fa9dUL, 0x246fb598UL,
+    0x13057799UL, 0x4abb319bUL, 0x7dd1f39aUL, 0x3035898dUL, 0x075f4b8cUL,
+    0x5ee10d8eUL, 0x698bcf8fUL, 0xec9d808aUL, 0xdbf7428bUL, 0x82490489UL,
+    0xb523c688UL, 0x88649a83UL, 0xbf0e5882UL, 0xe6b01e80UL, 0xd1dadc81UL,
+    0x54cc9384UL, 0x63a65185UL, 0x3a181787UL, 0x0d72d586UL, 0xa0d0e2a9UL,
+    0x97ba20a8UL, 0xce0466aaUL, 0xf96ea4abUL, 0x7c78ebaeUL, 0x4b1229afUL,
+    0x12ac6fadUL, 0x25c6adacUL, 0x1881f1a7UL, 0x2feb33a6UL, 0x765575a4UL,
+    0x413fb7a5UL, 0xc429f8a0UL, 0xf3433aa1UL, 0xaafd7ca3UL, 0x9d97bea2UL,
+    0xd073c4b5UL, 0xe71906b4UL, 0xbea740b6UL, 0x89cd82b7UL, 0x0cdbcdb2UL,
+    0x3bb10fb3UL, 0x620f49b1UL, 0x55658bb0UL, 0x6822d7bbUL, 0x5f4815baUL,
+    0x06f653b8UL, 0x319c91b9UL, 0xb48adebcUL, 0x83e01cbdUL, 0xda5e5abfUL,
+    0xed3498beUL
+  },
+  {
+    0x00000000UL, 0x6567bcb8UL, 0x8bc809aaUL, 0xeeafb512UL, 0x5797628fUL,
+    0x32f0de37UL, 0xdc5f6b25UL, 0xb938d79dUL, 0xef28b4c5UL, 0x8a4f087dUL,
+    0x64e0bd6fUL, 0x018701d7UL, 0xb8bfd64aUL, 0xddd86af2UL, 0x3377dfe0UL,
+    0x56106358UL, 0x9f571950UL, 0xfa30a5e8UL, 0x149f10faUL, 0x71f8ac42UL,
+    0xc8c07bdfUL, 0xada7c767UL, 0x43087275UL, 0x266fcecdUL, 0x707fad95UL,
+    0x1518112dUL, 0xfbb7a43fUL, 0x9ed01887UL, 0x27e8cf1aUL, 0x428f73a2UL,
+    0xac20c6b0UL, 0xc9477a08UL, 0x3eaf32a0UL, 0x5bc88e18UL, 0xb5673b0aUL,
+    0xd00087b2UL, 0x6938502fUL, 0x0c5fec97UL, 0xe2f05985UL, 0x8797e53dUL,
+    0xd1878665UL, 0xb4e03addUL, 0x5a4f8fcfUL, 0x3f283377UL, 0x8610e4eaUL,
+    0xe3775852UL, 0x0dd8ed40UL, 0x68bf51f8UL, 0xa1f82bf0UL, 0xc49f9748UL,
+    0x2a30225aUL, 0x4f579ee2UL, 0xf66f497fUL, 0x9308f5c7UL, 0x7da740d5UL,
+    0x18c0fc6dUL, 0x4ed09f35UL, 0x2bb7238dUL, 0xc518969fUL, 0xa07f2a27UL,
+    0x1947fdbaUL, 0x7c204102UL, 0x928ff410UL, 0xf7e848a8UL, 0x3d58149bUL,
+    0x583fa823UL, 0xb6901d31UL, 0xd3f7a189UL, 0x6acf7614UL, 0x0fa8caacUL,
+    0xe1077fbeUL, 0x8460c306UL, 0xd270a05eUL, 0xb7171ce6UL, 0x59b8a9f4UL,
+    0x3cdf154cUL, 0x85e7c2d1UL, 0xe0807e69UL, 0x0e2fcb7bUL, 0x6b4877c3UL,
+    0xa20f0dcbUL, 0xc768b173UL, 0x29c70461UL, 0x4ca0b8d9UL, 0xf5986f44UL,
+    0x90ffd3fcUL, 0x7e5066eeUL, 0x1b37da56UL, 0x4d27b90eUL, 0x284005b6UL,
+    0xc6efb0a4UL, 0xa3880c1cUL, 0x1ab0db81UL, 0x7fd76739UL, 0x9178d22bUL,
+    0xf41f6e93UL, 0x03f7263bUL, 0x66909a83UL, 0x883f2f91UL, 0xed589329UL,
+    0x546044b4UL, 0x3107f80cUL, 0xdfa84d1eUL, 0xbacff1a6UL, 0xecdf92feUL,
+    0x89b82e46UL, 0x67179b54UL, 0x027027ecUL, 0xbb48f071UL, 0xde2f4cc9UL,
+    0x3080f9dbUL, 0x55e74563UL, 0x9ca03f6bUL, 0xf9c783d3UL, 0x176836c1UL,
+    0x720f8a79UL, 0xcb375de4UL, 0xae50e15cUL, 0x40ff544eUL, 0x2598e8f6UL,
+    0x73888baeUL, 0x16ef3716UL, 0xf8408204UL, 0x9d273ebcUL, 0x241fe921UL,
+    0x41785599UL, 0xafd7e08bUL, 0xcab05c33UL, 0x3bb659edUL, 0x5ed1e555UL,
+    0xb07e5047UL, 0xd519ecffUL, 0x6c213b62UL, 0x094687daUL, 0xe7e932c8UL,
+    0x828e8e70UL, 0xd49eed28UL, 0xb1f95190UL, 0x5f56e482UL, 0x3a31583aUL,
+    0x83098fa7UL, 0xe66e331fUL, 0x08c1860dUL, 0x6da63ab5UL, 0xa4e140bdUL,
+    0xc186fc05UL, 0x2f294917UL, 0x4a4ef5afUL, 0xf3762232UL, 0x96119e8aUL,
+    0x78be2b98UL, 0x1dd99720UL, 0x4bc9f478UL, 0x2eae48c0UL, 0xc001fdd2UL,
+    0xa566416aUL, 0x1c5e96f7UL, 0x79392a4fUL, 0x97969f5dUL, 0xf2f123e5UL,
+    0x05196b4dUL, 0x607ed7f5UL, 0x8ed162e7UL, 0xebb6de5fUL, 0x528e09c2UL,
+    0x37e9b57aUL, 0xd9460068UL, 0xbc21bcd0UL, 0xea31df88UL, 0x8f566330UL,
+    0x61f9d622UL, 0x049e6a9aUL, 0xbda6bd07UL, 0xd8c101bfUL, 0x366eb4adUL,
+    0x53090815UL, 0x9a4e721dUL, 0xff29cea5UL, 0x11867bb7UL, 0x74e1c70fUL,
+    0xcdd91092UL, 0xa8beac2aUL, 0x46111938UL, 0x2376a580UL, 0x7566c6d8UL,
+    0x10017a60UL, 0xfeaecf72UL, 0x9bc973caUL, 0x22f1a457UL, 0x479618efUL,
+    0xa939adfdUL, 0xcc5e1145UL, 0x06ee4d76UL, 0x6389f1ceUL, 0x8d2644dcUL,
+    0xe841f864UL, 0x51792ff9UL, 0x341e9341UL, 0xdab12653UL, 0xbfd69aebUL,
+    0xe9c6f9b3UL, 0x8ca1450bUL, 0x620ef019UL, 0x07694ca1UL, 0xbe519b3cUL,
+    0xdb362784UL, 0x35999296UL, 0x50fe2e2eUL, 0x99b95426UL, 0xfcdee89eUL,
+    0x12715d8cUL, 0x7716e134UL, 0xce2e36a9UL, 0xab498a11UL, 0x45e63f03UL,
+    0x208183bbUL, 0x7691e0e3UL, 0x13f65c5bUL, 0xfd59e949UL, 0x983e55f1UL,
+    0x2106826cUL, 0x44613ed4UL, 0xaace8bc6UL, 0xcfa9377eUL, 0x38417fd6UL,
+    0x5d26c36eUL, 0xb389767cUL, 0xd6eecac4UL, 0x6fd61d59UL, 0x0ab1a1e1UL,
+    0xe41e14f3UL, 0x8179a84bUL, 0xd769cb13UL, 0xb20e77abUL, 0x5ca1c2b9UL,
+    0x39c67e01UL, 0x80fea99cUL, 0xe5991524UL, 0x0b36a036UL, 0x6e511c8eUL,
+    0xa7166686UL, 0xc271da3eUL, 0x2cde6f2cUL, 0x49b9d394UL, 0xf0810409UL,
+    0x95e6b8b1UL, 0x7b490da3UL, 0x1e2eb11bUL, 0x483ed243UL, 0x2d596efbUL,
+    0xc3f6dbe9UL, 0xa6916751UL, 0x1fa9b0ccUL, 0x7ace0c74UL, 0x9461b966UL,
+    0xf10605deUL
+#endif
+  }
+};

external/cfitsio/deflate.h

@@ -0,0 +1,340 @@
+/* deflate.h -- internal compression state
+ * Copyright (C) 1995-2010 Jean-loup Gailly
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* WARNING: this file should *not* be used by applications. It is
+   part of the implementation of the compression library and is
+   subject to change. Applications should only use zlib.h.
+ */
+
+#ifndef DEFLATE_H
+#define DEFLATE_H
+
+#include "zutil.h"
+
+/* define NO_GZIP when compiling if you want to disable gzip header and
+   trailer creation by deflate().  NO_GZIP would be used to avoid linking in
+   the crc code when it is not needed.  For shared libraries, gzip encoding
+   should be left enabled. */
+#ifndef NO_GZIP
+#  define GZIP
+#endif
+
+/* ===========================================================================
+ * Internal compression state.
+ */
+
+#define LENGTH_CODES 29
+/* number of length codes, not counting the special END_BLOCK code */
+
+#define LITERALS  256
+/* number of literal bytes 0..255 */
+
+#define L_CODES (LITERALS+1+LENGTH_CODES)
+/* number of Literal or Length codes, including the END_BLOCK code */
+
+#define D_CODES   30
+/* number of distance codes */
+
+#define BL_CODES  19
+/* number of codes used to transfer the bit lengths */
+
+#define HEAP_SIZE (2*L_CODES+1)
+/* maximum heap size */
+
+#define MAX_BITS 15
+/* All codes must not exceed MAX_BITS bits */
+
+#define INIT_STATE    42
+#define EXTRA_STATE   69
+#define NAME_STATE    73
+#define COMMENT_STATE 91
+#define HCRC_STATE   103
+#define BUSY_STATE   113
+#define FINISH_STATE 666
+/* Stream status */
+
+
+/* Data structure describing a single value and its code string. */
+typedef struct ct_data_s {
+    union {
+        ush  freq;       /* frequency count */
+        ush  code;       /* bit string */
+    } fc;
+    union {
+        ush  dad;        /* father node in Huffman tree */
+        ush  len;        /* length of bit string */
+    } dl;
+} FAR ct_data;
+
+#define Freq fc.freq
+#define Code fc.code
+#define Dad  dl.dad
+#define Len  dl.len
+
+typedef struct static_tree_desc_s  static_tree_desc;
+
+typedef struct tree_desc_s {
+    ct_data *dyn_tree;           /* the dynamic tree */
+    int     max_code;            /* largest code with non zero frequency */
+    static_tree_desc *stat_desc; /* the corresponding static tree */
+} FAR tree_desc;
+
+typedef ush Pos;
+typedef Pos FAR Posf;
+typedef unsigned IPos;
+
+/* A Pos is an index in the character window. We use short instead of int to
+ * save space in the various tables. IPos is used only for parameter passing.
+ */
+
+typedef struct internal_state {
+    z_streamp strm;      /* pointer back to this zlib stream */
+    int   status;        /* as the name implies */
+    Bytef *pending_buf;  /* output still pending */
+    ulg   pending_buf_size; /* size of pending_buf */
+    Bytef *pending_out;  /* next pending byte to output to the stream */
+    uInt   pending;      /* nb of bytes in the pending buffer */
+    int   wrap;          /* bit 0 true for zlib, bit 1 true for gzip */
+    gz_headerp  gzhead;  /* gzip header information to write */
+    uInt   gzindex;      /* where in extra, name, or comment */
+    Byte  method;        /* STORED (for zip only) or DEFLATED */
+    int   last_flush;    /* value of flush param for previous deflate call */
+
+                /* used by deflate.c: */
+
+    uInt  w_size;        /* LZ77 window size (32K by default) */
+    uInt  w_bits;        /* log2(w_size)  (8..16) */
+    uInt  w_mask;        /* w_size - 1 */
+
+    Bytef *window;
+    /* Sliding window. Input bytes are read into the second half of the window,
+     * and move to the first half later to keep a dictionary of at least wSize
+     * bytes. With this organization, matches are limited to a distance of
+     * wSize-MAX_MATCH bytes, but this ensures that IO is always
+     * performed with a length multiple of the block size. Also, it limits
+     * the window size to 64K, which is quite useful on MSDOS.
+     * To do: use the user input buffer as sliding window.
+     */
+
+    ulg window_size;
+    /* Actual size of window: 2*wSize, except when the user input buffer
+     * is directly used as sliding window.
+     */
+
+    Posf *prev;
+    /* Link to older string with same hash index. To limit the size of this
+     * array to 64K, this link is maintained only for the last 32K strings.
+     * An index in this array is thus a window index modulo 32K.
+     */
+
+    Posf *head; /* Heads of the hash chains or NIL. */
+
+    uInt  ins_h;          /* hash index of string to be inserted */
+    uInt  hash_size;      /* number of elements in hash table */
+    uInt  hash_bits;      /* log2(hash_size) */
+    uInt  hash_mask;      /* hash_size-1 */
+
+    uInt  hash_shift;
+    /* Number of bits by which ins_h must be shifted at each input
+     * step. It must be such that after MIN_MATCH steps, the oldest
+     * byte no longer takes part in the hash key, that is:
+     *   hash_shift * MIN_MATCH >= hash_bits
+     */
+
+    long block_start;
+    /* Window position at the beginning of the current output block. Gets
+     * negative when the window is moved backwards.
+     */
+
+    uInt match_length;           /* length of best match */
+    IPos prev_match;             /* previous match */
+    int match_available;         /* set if previous match exists */
+    uInt strstart;               /* start of string to insert */
+    uInt match_start;            /* start of matching string */
+    uInt lookahead;              /* number of valid bytes ahead in window */
+
+    uInt prev_length;
+    /* Length of the best match at previous step. Matches not greater than this
+     * are discarded. This is used in the lazy match evaluation.
+     */
+
+    uInt max_chain_length;
+    /* To speed up deflation, hash chains are never searched beyond this
+     * length.  A higher limit improves compression ratio but degrades the
+     * speed.
+     */
+
+    uInt max_lazy_match;
+    /* Attempt to find a better match only when the current match is strictly
+     * smaller than this value. This mechanism is used only for compression
+     * levels >= 4.
+     */
+#   define max_insert_length  max_lazy_match
+    /* Insert new strings in the hash table only if the match length is not
+     * greater than this length. This saves time but degrades compression.
+     * max_insert_length is used only for compression levels <= 3.
+     */
+
+    int level;    /* compression level (1..9) */
+    int strategy; /* favor or force Huffman coding*/
+
+    uInt good_match;
+    /* Use a faster search when the previous match is longer than this */
+
+    int nice_match; /* Stop searching when current match exceeds this */
+
+                /* used by trees.c: */
+    /* Didn't use ct_data typedef below to supress compiler warning */
+    struct ct_data_s dyn_ltree[HEAP_SIZE];   /* literal and length tree */
+    struct ct_data_s dyn_dtree[2*D_CODES+1]; /* distance tree */
+    struct ct_data_s bl_tree[2*BL_CODES+1];  /* Huffman tree for bit lengths */
+
+    struct tree_desc_s l_desc;               /* desc. for literal tree */
+    struct tree_desc_s d_desc;               /* desc. for distance tree */
+    struct tree_desc_s bl_desc;              /* desc. for bit length tree */
+
+    ush bl_count[MAX_BITS+1];
+    /* number of codes at each bit length for an optimal tree */
+
+    int heap[2*L_CODES+1];      /* heap used to build the Huffman trees */
+    int heap_len;               /* number of elements in the heap */
+    int heap_max;               /* element of largest frequency */
+    /* The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used.
+     * The same heap array is used to build all trees.
+     */
+
+    uch depth[2*L_CODES+1];
+    /* Depth of each subtree used as tie breaker for trees of equal frequency
+     */
+
+    uchf *l_buf;          /* buffer for literals or lengths */
+
+    uInt  lit_bufsize;
+    /* Size of match buffer for literals/lengths.  There are 4 reasons for
+     * limiting lit_bufsize to 64K:
+     *   - frequencies can be kept in 16 bit counters
+     *   - if compression is not successful for the first block, all input
+     *     data is still in the window so we can still emit a stored block even
+     *     when input comes from standard input.  (This can also be done for
+     *     all blocks if lit_bufsize is not greater than 32K.)
+     *   - if compression is not successful for a file smaller than 64K, we can
+     *     even emit a stored file instead of a stored block (saving 5 bytes).
+     *     This is applicable only for zip (not gzip or zlib).
+     *   - creating new Huffman trees less frequently may not provide fast
+     *     adaptation to changes in the input data statistics. (Take for
+     *     example a binary file with poorly compressible code followed by
+     *     a highly compressible string table.) Smaller buffer sizes give
+     *     fast adaptation but have of course the overhead of transmitting
+     *     trees more frequently.
+     *   - I can't count above 4
+     */
+
+    uInt last_lit;      /* running index in l_buf */
+
+    ushf *d_buf;
+    /* Buffer for distances. To simplify the code, d_buf and l_buf have
+     * the same number of elements. To use different lengths, an extra flag
+     * array would be necessary.
+     */
+
+    ulg opt_len;        /* bit length of current block with optimal trees */
+    ulg static_len;     /* bit length of current block with static trees */
+    uInt matches;       /* number of string matches in current block */
+    int last_eob_len;   /* bit length of EOB code for last block */
+
+#ifdef DEBUG
+    ulg compressed_len; /* total bit length of compressed file mod 2^32 */
+    ulg bits_sent;      /* bit length of compressed data sent mod 2^32 */
+#endif
+
+    ush bi_buf;
+    /* Output buffer. bits are inserted starting at the bottom (least
+     * significant bits).
+     */
+    int bi_valid;
+    /* Number of valid bits in bi_buf.  All bits above the last valid bit
+     * are always zero.
+     */
+
+    ulg high_water;
+    /* High water mark offset in window for initialized bytes -- bytes above
+     * this are set to zero in order to avoid memory check warnings when
+     * longest match routines access bytes past the input.  This is then
+     * updated to the new high water mark.
+     */
+
+} FAR deflate_state;
+
+/* Output a byte on the stream.
+ * IN assertion: there is enough room in pending_buf.
+ */
+#define put_byte(s, c) {s->pending_buf[s->pending++] = (c);}
+
+
+#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1)
+/* Minimum amount of lookahead, except at the end of the input file.
+ * See deflate.c for comments about the MIN_MATCH+1.
+ */
+
+#define MAX_DIST(s)  ((s)->w_size-MIN_LOOKAHEAD)
+/* In order to simplify the code, particularly on 16 bit machines, match
+ * distances are limited to MAX_DIST instead of WSIZE.
+ */
+
+#define WIN_INIT MAX_MATCH
+/* Number of bytes after end of data in window to initialize in order to avoid
+   memory checker errors from longest match routines */
+
+        /* in trees.c */
+void ZLIB_INTERNAL _tr_init OF((deflate_state *s));
+int ZLIB_INTERNAL _tr_tally OF((deflate_state *s, unsigned dist, unsigned lc));
+void ZLIB_INTERNAL _tr_flush_block OF((deflate_state *s, charf *buf,
+                        ulg stored_len, int last));
+void ZLIB_INTERNAL _tr_align OF((deflate_state *s));
+void ZLIB_INTERNAL _tr_stored_block OF((deflate_state *s, charf *buf,
+                        ulg stored_len, int last));
+
+#define d_code(dist) \
+   ((dist) < 256 ? _dist_code[dist] : _dist_code[256+((dist)>>7)])
+/* Mapping from a distance to a distance code. dist is the distance - 1 and
+ * must not have side effects. _dist_code[256] and _dist_code[257] are never
+ * used.
+ */
+
+#ifndef DEBUG
+/* Inline versions of _tr_tally for speed: */
+
+#if defined(GEN_TREES_H) || !defined(STDC)
+  extern uch ZLIB_INTERNAL _length_code[];
+  extern uch ZLIB_INTERNAL _dist_code[];
+#else
+  extern const uch ZLIB_INTERNAL _length_code[];
+  extern const uch ZLIB_INTERNAL _dist_code[];
+#endif
+
+# define _tr_tally_lit(s, c, flush) \
+  { uch cc = (c); \
+    s->d_buf[s->last_lit] = 0; \
+    s->l_buf[s->last_lit++] = cc; \
+    s->dyn_ltree[cc].Freq++; \
+    flush = (s->last_lit == s->lit_bufsize-1); \
+   }
+# define _tr_tally_dist(s, distance, length, flush) \
+  { uch len = (length); \
+    ush dist = (distance); \
+    s->d_buf[s->last_lit] = dist; \
+    s->l_buf[s->last_lit++] = len; \
+    dist--; \
+    s->dyn_ltree[_length_code[len]+LITERALS+1].Freq++; \
+    s->dyn_dtree[d_code(dist)].Freq++; \
+    flush = (s->last_lit == s->lit_bufsize-1); \
+  }
+#else
+# define _tr_tally_lit(s, c, flush) flush = _tr_tally(s, 0, c)
+# define _tr_tally_dist(s, distance, length, flush) \
+              flush = _tr_tally(s, distance, length)
+#endif
+
+#endif /* DEFLATE_H */

external/cfitsio/drvrfile.c

@@ -0,0 +1,966 @@
+/*  This file, drvrfile.c contains driver routines for disk files.         */
+
+/*  The FITSIO software was written by William Pence at the High Energy    */
+/*  Astrophysic Science Archive Research Center (HEASARC) at the NASA      */
+/*  Goddard Space Flight Center.                                           */
+
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+#if defined(unix) || defined(__unix__)  || defined(__unix)
+#include <pwd.h>         /* needed in file_openfile */
+
+#ifdef REPLACE_LINKS
+#include <sys/types.h>
+#include <sys/stat.h>
+#endif
+
+#endif
+
+#ifdef HAVE_FTRUNCATE
+#if defined(unix) || defined(__unix__)  || defined(__unix)
+#include <unistd.h>  /* needed for getcwd prototype on unix machines */
+#endif
+#endif
+
+#define IO_SEEK 0        /* last file I/O operation was a seek */
+#define IO_READ 1        /* last file I/O operation was a read */
+#define IO_WRITE 2       /* last file I/O operation was a write */
+
+static char file_outfile[FLEN_FILENAME];
+
+typedef struct    /* structure containing disk file structure */ 
+{
+    FILE *fileptr;
+    LONGLONG currentpos;
+    int last_io_op;
+} diskdriver;
+
+static diskdriver handleTable[NMAXFILES]; /* allocate diskfile handle tables */
+
+/*--------------------------------------------------------------------------*/
+int file_init(void)
+{
+    int ii;
+
+    for (ii = 0; ii < NMAXFILES; ii++) /* initialize all empty slots in table */
+    {
+       handleTable[ii].fileptr = 0;
+    }
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_setoptions(int options)
+{
+  /* do something with the options argument, to stop compiler warning */
+  options = 0;
+  return(options);
+}
+/*--------------------------------------------------------------------------*/
+int file_getoptions(int *options)
+{
+  *options = 0;
+  return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_getversion(int *version)
+{
+    *version = 10;
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_shutdown(void)
+{
+  return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_open(char *filename, int rwmode, int *handle)
+{
+    FILE *diskfile;
+    int copyhandle, ii, status;
+    char recbuf[2880];
+    size_t nread;
+
+    /*
+       if an output filename has been specified as part of the input
+       file, as in "inputfile.fits(outputfile.fit)" then we have to
+       create the output file, copy the input to it, then reopen the
+       the new copy.
+    */
+
+    if (*file_outfile)
+    {
+      /* open the original file, with readonly access */
+      status = file_openfile(filename, READONLY, &diskfile);
+      if (status) {
+        file_outfile[0] = '\0';
+        return(status);
+      }
+      
+      /* create the output file */
+      status =  file_create(file_outfile,handle);
+      if (status)
+      {
+        ffpmsg("Unable to create output file for copy of input file:");
+        ffpmsg(file_outfile);
+        file_outfile[0] = '\0';
+        return(status);
+      }
+
+      /* copy the file from input to output */
+      while(0 != (nread = fread(recbuf,1,2880, diskfile)))
+      {
+        status = file_write(*handle, recbuf, nread);
+        if (status) {
+	   file_outfile[0] = '\0';
+           return(status);
+        }
+      }
+
+      /* close both files */
+      fclose(diskfile);
+      copyhandle = *handle;
+      file_close(*handle);
+      *handle = copyhandle;  /* reuse the old file handle */
+
+      /* reopen the new copy, with correct rwmode */
+      status = file_openfile(file_outfile, rwmode, &diskfile);
+      file_outfile[0] = '\0';
+    }
+    else
+    {
+      *handle = -1;
+      for (ii = 0; ii < NMAXFILES; ii++)  /* find empty slot in table */
+      {
+        if (handleTable[ii].fileptr == 0)
+        {
+            *handle = ii;
+            break;
+        }
+      }
+
+      if (*handle == -1)
+       return(TOO_MANY_FILES);    /* too many files opened */
+
+      /*open the file */
+      status = file_openfile(filename, rwmode, &diskfile);
+    }
+
+    handleTable[*handle].fileptr = diskfile;
+    handleTable[*handle].currentpos = 0;
+    handleTable[*handle].last_io_op = IO_SEEK;
+
+    return(status);
+}
+/*--------------------------------------------------------------------------*/
+int file_openfile(char *filename, int rwmode, FILE **diskfile)
+/*
+   lowest level routine to physically open a disk file
+*/
+{
+    char mode[4];
+
+#if defined(unix) || defined(__unix__) || defined(__unix)
+    char tempname[1024], *cptr, user[80];
+    struct passwd *pwd;
+    int ii = 0;
+
+#if defined(REPLACE_LINKS)
+    struct stat stbuf;
+    int success = 0;
+    size_t n;
+    FILE *f1, *f2;
+    char buf[BUFSIZ];
+#endif
+
+#endif
+
+    if (rwmode == READWRITE)
+    {
+          strcpy(mode, "r+b");    /* open existing file with read-write */
+    }
+    else
+    {
+          strcpy(mode, "rb");     /* open existing file readonly */
+    }
+
+#if MACHINE == ALPHAVMS || MACHINE == VAXVMS
+        /* specify VMS record structure: fixed format, 2880 byte records */
+        /* but force stream mode access to enable random I/O access      */
+    *diskfile = fopen(filename, mode, "rfm=fix", "mrs=2880", "ctx=stm"); 
+
+#elif defined(unix) || defined(__unix__) || defined(__unix)
+
+    /* support the ~user/file.fits or ~/file.fits filenames in UNIX */
+
+    if (*filename == '~')
+    {
+        if (filename[1] == '/')
+        {
+            cptr = getenv("HOME");
+            if (cptr)
+            {
+                 if (strlen(cptr) + strlen(filename+1) > 1023)
+		      return(FILE_NOT_OPENED); 
+
+                 strcpy(tempname, cptr);
+                 strcat(tempname, filename+1);
+            }
+            else
+            {
+                 if (strlen(filename) > 1023)
+		      return(FILE_NOT_OPENED); 
+
+                 strcpy(tempname, filename);
+            }
+        }
+        else
+        {
+            /* copy user name */
+            cptr = filename+1;
+            while (*cptr && (*cptr != '/'))
+            {
+                user[ii] = *cptr;
+                cptr++;
+                ii++;
+            }
+            user[ii] = '\0';
+
+            /* get structure that includes name of user's home directory */
+            pwd = getpwnam(user);
+
+            /* copy user's home directory */
+            if (strlen(pwd->pw_dir) + strlen(cptr) > 1023)
+		      return(FILE_NOT_OPENED); 
+
+            strcpy(tempname, pwd->pw_dir);
+            strcat(tempname, cptr);
+        }
+
+        *diskfile = fopen(tempname, mode); 
+    }
+    else
+    {
+        /* don't need to expand the input file name */
+        *diskfile = fopen(filename, mode); 
+
+#if defined(REPLACE_LINKS)
+
+        if (!(*diskfile) && (rwmode == READWRITE))  
+        {
+           /* failed to open file with READWRITE privilege.  Test if  */
+           /* the file we are trying to open is a soft link to a file that */
+           /* doesn't have write privilege.  */
+
+           lstat(filename, &stbuf);
+           if ((stbuf.st_mode & S_IFMT) == S_IFLNK) /* is this a soft link? */
+           {
+              if ((f1 = fopen(filename, "rb")) != 0) /* try opening READONLY */
+              {
+
+                 if (strlen(filename) + 7 > 1023)
+		      return(FILE_NOT_OPENED); 
+
+                 strcpy(tempname, filename);
+                 strcat(tempname, ".TmxFil");
+                 if ((f2 = fopen(tempname, "wb")) != 0) /* create temp file */
+                 {
+                    success = 1;
+                    while ((n = fread(buf, 1, BUFSIZ, f1)) > 0)
+                    {
+                       /* copy linked file to local temporary file */
+                       if (fwrite(buf, 1, n, f2) != n) 
+                       {
+                          success = 0;
+                          break;
+                       } 
+                    }
+                    fclose(f2);
+                 }
+                 fclose(f1);
+  
+                 if (success)
+                 {
+                    /* delete link and rename temp file to previous link name */
+                    remove(filename);
+                    rename(tempname, filename);
+
+                    /* try once again to open the file with write access */
+                    *diskfile = fopen(filename, mode); 
+                 }
+                 else
+                    remove(tempname);  /* clean up the failed copy */
+              }
+           }
+        }
+#endif
+
+    }
+
+#else
+
+    /* other non-UNIX machines */
+    *diskfile = fopen(filename, mode); 
+
+#endif
+
+    if (!(*diskfile))           /* couldn't open file */
+    {
+            return(FILE_NOT_OPENED); 
+    }
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_create(char *filename, int *handle)
+{
+    FILE *diskfile;
+    int ii;
+    char mode[4];
+
+#if defined(BUILD_HERA) 
+
+    /* special code to verify that the path to the file to be created */
+    /* is within the users data directory on Hera */
+ 
+    int status = 0, rootlen, slen;
+    char *cpos;
+    char cwd[FLEN_FILENAME], absURL[FLEN_FILENAME];
+    /* note that "/heradata/users/" is actually "/.hera_mountpnt/hera_users/"  */
+    char rootstring[]="/.hera_mountpnt/hera_users/";
+    char username[FLEN_FILENAME], userroot[FLEN_FILENAME];
+
+    /* Get the current working directory */
+    fits_get_cwd(cwd, &status);  
+    slen = strlen(cwd);
+    if (cwd[slen-1] != '/') strcat(cwd,"/"); /* make sure the CWD ends with slash */
+
+/*    printf("CWD = %s\n", cwd);  */
+
+    /* check that CWD string matches the rootstring */
+    rootlen = strlen(rootstring);
+    if (strncmp(rootstring, cwd, rootlen)) {
+       ffpmsg("invalid CWD: does not match Hera data directory");
+/*       ffpmsg(rootstring);  */
+       return(FILE_NOT_CREATED); 
+    } else {
+
+       /* get the user name from CWD (it follows the root string) */
+       strcpy(username, cwd+rootlen);  
+       cpos=strchr(username, '/');
+       if (!cpos) {
+          ffpmsg("invalid CWD: not equal to Hera data directory + username");
+/*          ffpmsg(cwd); */
+          return(FILE_NOT_CREATED); 
+       } else {
+          *(cpos+1) = '\0';   /* truncate user name string */
+
+          /* construct full user root name */
+          strcpy(userroot, rootstring);
+          strcat(userroot, username);
+          rootlen = strlen(userroot);
+
+          /* convert the input filename to absolute path relative to the CWD */
+          fits_relurl2url(cwd,  filename,  absURL, &status);
+/*
+          printf("username = %s\n", username);
+          printf("userroot = %s\n", userroot);
+          printf("filename = %s\n", filename);
+          printf("ABS = %s\n", absURL);
+*/
+          /* check that CWD string matches the rootstring */
+
+          if (strncmp(userroot, absURL, rootlen)) {
+             ffpmsg("invalid filename: path not within user directory");
+/*
+             ffpmsg(absURL);
+             ffpmsg(userroot);
+*/
+             return(FILE_NOT_CREATED); 
+          }
+       }
+    }
+    /* if we got here, then the input filename appears to be valid */
+
+#endif
+
+    *handle = -1;
+    for (ii = 0; ii < NMAXFILES; ii++)  /* find empty slot in table */
+    {
+        if (handleTable[ii].fileptr == 0)
+        {
+            *handle = ii;
+            break;
+        }
+    }
+    if (*handle == -1)
+       return(TOO_MANY_FILES);    /* too many files opened */
+
+    strcpy(mode, "w+b");    /* create new file with read-write */
+
+    diskfile = fopen(filename, "r"); /* does file already exist? */
+
+    if (diskfile)
+    {
+        fclose(diskfile);         /* close file and exit with error */
+        return(FILE_NOT_CREATED); 
+    }
+
+#if MACHINE == ALPHAVMS || MACHINE == VAXVMS
+        /* specify VMS record structure: fixed format, 2880 byte records */
+        /* but force stream mode access to enable random I/O access      */
+    diskfile = fopen(filename, mode, "rfm=fix", "mrs=2880", "ctx=stm"); 
+#else
+    diskfile = fopen(filename, mode); 
+#endif
+
+    if (!(diskfile))           /* couldn't create file */
+    {
+            return(FILE_NOT_CREATED); 
+    }
+
+    handleTable[ii].fileptr = diskfile;
+    handleTable[ii].currentpos = 0;
+    handleTable[ii].last_io_op = IO_SEEK;
+
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_truncate(int handle, LONGLONG filesize)
+/*
+  truncate the diskfile to a new smaller size
+*/
+{
+
+#ifdef HAVE_FTRUNCATE
+    int fdesc;
+
+    fdesc = fileno(handleTable[handle].fileptr);
+    ftruncate(fdesc, (OFF_T) filesize);
+    file_seek(handle, filesize);
+
+    handleTable[handle].currentpos = filesize;
+    handleTable[handle].last_io_op = IO_SEEK;
+
+#endif
+
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_size(int handle, LONGLONG *filesize)
+/*
+  return the size of the file in bytes
+*/
+{
+    OFF_T position1,position2;
+    FILE *diskfile;
+
+    diskfile = handleTable[handle].fileptr;
+
+#if defined(_MSC_VER) && (_MSC_VER >= 1400)
+ 
+/* call the VISUAL C++ version of the routines which support */
+/*  Large Files (> 2GB) if they are supported (since VC 8.0)  */
+
+    position1 = _ftelli64(diskfile);   /* save current postion */
+    if (position1 < 0)
+        return(SEEK_ERROR);
+
+    if (_fseeki64(diskfile, 0, 2) != 0)  /* seek to end of file */
+        return(SEEK_ERROR);
+
+    position2 = _ftelli64(diskfile);     /* get file size */
+    if (position2 < 0)
+        return(SEEK_ERROR);
+
+    if (_fseeki64(diskfile, position1, 0) != 0)  /* seek back to original pos */
+        return(SEEK_ERROR);
+
+#elif _FILE_OFFSET_BITS - 0 == 64
+
+/* call the newer ftello and fseeko routines , which support */
+/*  Large Files (> 2GB) if they are supported.  */
+
+    position1 = ftello(diskfile);   /* save current postion */
+    if (position1 < 0)
+        return(SEEK_ERROR);
+
+    if (fseeko(diskfile, 0, 2) != 0)  /* seek to end of file */
+        return(SEEK_ERROR);
+
+    position2 = ftello(diskfile);     /* get file size */
+    if (position2 < 0)
+        return(SEEK_ERROR);
+
+    if (fseeko(diskfile, position1, 0) != 0)  /* seek back to original pos */
+        return(SEEK_ERROR);
+
+#else
+
+    position1 = ftell(diskfile);   /* save current postion */
+    if (position1 < 0)
+        return(SEEK_ERROR);
+
+    if (fseek(diskfile, 0, 2) != 0)  /* seek to end of file */
+        return(SEEK_ERROR);
+
+    position2 = ftell(diskfile);     /* get file size */
+    if (position2 < 0)
+        return(SEEK_ERROR);
+
+    if (fseek(diskfile, position1, 0) != 0)  /* seek back to original pos */
+        return(SEEK_ERROR);
+
+#endif
+
+    *filesize = (LONGLONG) position2;
+    
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_close(int handle)
+/*
+  close the file
+*/
+{
+    
+    if (fclose(handleTable[handle].fileptr) )
+        return(FILE_NOT_CLOSED);
+
+    handleTable[handle].fileptr = 0;
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_remove(char *filename)
+/*
+  delete the file from disk
+*/
+{
+    remove(filename);
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_flush(int handle)
+/*
+  flush the file
+*/
+{
+    if (fflush(handleTable[handle].fileptr) )
+        return(WRITE_ERROR);
+
+    /* The flush operation is not supposed to move the internal */
+    /* file pointer, but it does on some Windows-95 compilers and */
+    /* perhaps others, so seek to original position to be sure. */
+    /* This seek will do no harm on other systems.   */
+
+#if MACHINE == IBMPC
+
+    if (file_seek(handle, handleTable[handle].currentpos))
+            return(SEEK_ERROR);
+
+#endif
+
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_seek(int handle, LONGLONG offset)
+/*
+  seek to position relative to start of the file
+*/
+{
+
+#if defined(_MSC_VER) && (_MSC_VER >= 1400)
+    
+     /* Microsoft visual studio C++ */
+     /* _fseeki64 supported beginning with version 8.0 */
+ 
+    if (_fseeki64(handleTable[handle].fileptr, (OFF_T) offset, 0) != 0)
+        return(SEEK_ERROR);
+	
+#elif _FILE_OFFSET_BITS - 0 == 64
+
+    if (fseeko(handleTable[handle].fileptr, (OFF_T) offset, 0) != 0)
+        return(SEEK_ERROR);
+
+#else
+
+    if (fseek(handleTable[handle].fileptr, (OFF_T) offset, 0) != 0)
+        return(SEEK_ERROR);
+
+#endif
+
+    handleTable[handle].currentpos = offset;
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_read(int hdl, void *buffer, long nbytes)
+/*
+  read bytes from the current position in the file
+*/
+{
+    long nread;
+    char *cptr;
+
+    if (handleTable[hdl].last_io_op == IO_WRITE)
+    {
+        if (file_seek(hdl, handleTable[hdl].currentpos))
+            return(SEEK_ERROR);
+    }
+  
+    nread = (long) fread(buffer, 1, nbytes, handleTable[hdl].fileptr);
+
+    if (nread == 1)
+    {
+         cptr = (char *) buffer;
+
+         /* some editors will add a single end-of-file character to a file */
+         /* Ignore it if the character is a zero, 10, or 32 */
+         if (*cptr == 0 || *cptr == 10 || *cptr == 32)
+             return(END_OF_FILE);
+         else
+             return(READ_ERROR);
+    }
+    else if (nread != nbytes)
+    {
+        return(READ_ERROR);
+    }
+
+    handleTable[hdl].currentpos += nbytes;
+    handleTable[hdl].last_io_op = IO_READ;
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_write(int hdl, void *buffer, long nbytes)
+/*
+  write bytes at the current position in the file
+*/
+{
+    if (handleTable[hdl].last_io_op == IO_READ) 
+    {
+        if (file_seek(hdl, handleTable[hdl].currentpos))
+            return(SEEK_ERROR);
+    }
+
+    if((long) fwrite(buffer, 1, nbytes, handleTable[hdl].fileptr) != nbytes)
+        return(WRITE_ERROR);
+
+    handleTable[hdl].currentpos += nbytes;
+    handleTable[hdl].last_io_op = IO_WRITE;
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int file_compress_open(char *filename, int rwmode, int *hdl)
+/*
+  This routine opens the compressed diskfile by creating a new uncompressed
+  file then opening it.  The input file name (the name of the compressed
+  file) gets replaced with the name of the uncompressed file, which is
+  initially stored in the global file_outfile string.   file_outfile
+  then gets set to a null string.
+*/
+{
+    FILE *indiskfile, *outdiskfile;
+    int status;
+    char *cptr;
+
+    /* open the compressed disk file */
+    status = file_openfile(filename, READONLY, &indiskfile);
+    if (status)
+    {
+        ffpmsg("failed to open compressed disk file (file_compress_open)");
+        ffpmsg(filename);
+        return(status);
+    }
+
+    /* name of the output uncompressed file is stored in the */
+    /* global variable called 'file_outfile'.                */
+
+    cptr = file_outfile;
+    if (*cptr == '!')
+    {
+        /* clobber any existing file with the same name */
+        cptr++;
+        remove(cptr);
+    }
+    else
+    {
+        outdiskfile = fopen(file_outfile, "r"); /* does file already exist? */
+
+        if (outdiskfile)
+        {
+          ffpmsg("uncompressed file already exists: (file_compress_open)");
+          ffpmsg(file_outfile);
+          fclose(outdiskfile);         /* close file and exit with error */
+	  file_outfile[0] = '\0';
+          return(FILE_NOT_CREATED); 
+        }
+    }
+
+    outdiskfile = fopen(cptr, "w+b"); /* create new file */
+    if (!outdiskfile)
+    {
+        ffpmsg("could not create uncompressed file: (file_compress_open)");
+        ffpmsg(file_outfile);
+	file_outfile[0] = '\0';
+        return(FILE_NOT_CREATED); 
+    }
+
+    /* uncompress file into another file */
+    uncompress2file(filename, indiskfile, outdiskfile, &status);
+    fclose(indiskfile);
+    fclose(outdiskfile);
+
+    if (status)
+    {
+        ffpmsg("error in file_compress_open: failed to uncompressed file:");
+        ffpmsg(filename);
+        ffpmsg(" into new output file:");
+        ffpmsg(file_outfile);
+	file_outfile[0] = '\0';
+        return(status);
+    }
+
+    strcpy(filename, cptr);  /* switch the names */
+    file_outfile[0] = '\0';
+
+    status = file_open(filename, rwmode, hdl);
+
+    return(status);
+}
+/*--------------------------------------------------------------------------*/
+int file_is_compressed(char *filename) /* I - FITS file name          */
+/*
+  Test if the disk file is compressed.  Returns 1 if compressed, 0 if not.
+  This may modify the filename string by appending a compression suffex.
+*/
+{
+    FILE *diskfile;
+    unsigned char buffer[2];
+    char tmpfilename[FLEN_FILENAME];
+
+    /* Open file.  Try various suffix combinations */  
+    if (file_openfile(filename, 0, &diskfile))
+    {
+      if (strlen(filename) > FLEN_FILENAME - 1)
+          return(0);
+
+      strcpy(tmpfilename,filename);
+      strcat(filename,".gz");
+      if (file_openfile(filename, 0, &diskfile))
+      {
+        strcpy(filename, tmpfilename);
+        strcat(filename,".Z");
+        if (file_openfile(filename, 0, &diskfile))
+        {
+          strcpy(filename, tmpfilename);
+          strcat(filename,".z");   /* it's often lower case on CDROMs */
+          if (file_openfile(filename, 0, &diskfile))
+          {
+            strcpy(filename, tmpfilename);
+            strcat(filename,".zip");
+            if (file_openfile(filename, 0, &diskfile))
+            {
+              strcpy(filename, tmpfilename);
+              strcat(filename,"-z");      /* VMS suffix */
+              if (file_openfile(filename, 0, &diskfile))
+              {
+                strcpy(filename, tmpfilename);
+                strcat(filename,"-gz");    /* VMS suffix */
+                if (file_openfile(filename, 0, &diskfile))
+                {
+                  strcpy(filename,tmpfilename);  /* restore original name */
+                  return(0);    /* file not found */
+                }
+              }
+            }
+          }
+        }
+      }
+    }
+
+    if (fread(buffer, 1, 2, diskfile) != 2)  /* read 2 bytes */
+    {
+        fclose(diskfile);   /* error reading file so just return */
+        return(0);
+    }
+
+    fclose(diskfile);
+
+       /* see if the 2 bytes have the magic values for a compressed file */
+    if ( (memcmp(buffer, "\037\213", 2) == 0) ||  /* GZIP  */
+         (memcmp(buffer, "\120\113", 2) == 0) ||  /* PKZIP */
+         (memcmp(buffer, "\037\036", 2) == 0) ||  /* PACK  */
+         (memcmp(buffer, "\037\235", 2) == 0) ||  /* LZW   */
+         (memcmp(buffer, "\037\240", 2) == 0) )   /* LZH   */
+        {
+            return(1);  /* this is a compressed file */
+        }
+    else
+        {
+            return(0);  /* not a compressed file */
+        }
+}
+/*--------------------------------------------------------------------------*/
+int file_checkfile (char *urltype, char *infile, char *outfile) 
+{
+    /* special case: if file:// driver, check if the file is compressed */
+    if ( file_is_compressed(infile) )
+    {
+      /* if output file has been specified, save the name for future use: */
+      /* This is the name of the uncompressed file to be created on disk. */
+      if (strlen(outfile))
+      {
+        if (!strncmp(outfile, "mem:", 4) )
+        {
+           /* uncompress the file in memory, with READ and WRITE access */
+           strcpy(urltype, "compressmem://");  /* use special driver */
+           *file_outfile = '\0';  
+        }
+        else
+        {
+          strcpy(urltype, "compressfile://");  /* use special driver */
+
+          /* don't copy the "file://" prefix, if present.  */
+          if (!strncmp(outfile, "file://", 7) )
+             strcpy(file_outfile,outfile+7);
+          else
+             strcpy(file_outfile,outfile);
+        }
+      }
+      else
+      {
+        /* uncompress the file in memory */
+        strcpy(urltype, "compress://");  /* use special driver */
+        *file_outfile = '\0';  /* no output file was specified */
+      }
+    }
+    else  /* an ordinary, uncompressed FITS file on disk */
+    {
+        /* save the output file name for later use when opening the file. */
+        /* In this case, the file to be opened will be opened READONLY,   */
+        /* and copied to this newly created output file.  The original file */
+        /* will be closed, and the copy will be opened by CFITSIO for     */
+        /* subsequent processing (possibly with READWRITE access).        */
+        if (strlen(outfile)) {
+	    file_outfile[0] = '\0';
+            strncat(file_outfile,outfile,FLEN_FILENAME-1);
+        }
+    }
+
+    return 0;
+}
+/**********************************************************************/
+/**********************************************************************/
+/**********************************************************************/
+
+/****  driver routines for stream//: device (stdin or stdout)  ********/
+
+
+/*--------------------------------------------------------------------------*/
+int stream_open(char *filename, int rwmode, int *handle)
+{
+    /*
+        read from stdin
+    */
+    if (filename)
+      rwmode = 1;  /* dummy statement to suppress unused parameter compiler warning */
+
+    *handle = 1;     /*  1 = stdin */   
+
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int stream_create(char *filename, int *handle)
+{
+    /*
+        write to stdout
+    */
+
+    if (filename)  /* dummy statement to suppress unused parameter compiler warning */
+       *handle = 2;
+    else
+       *handle = 2;         /*  2 = stdout */       
+
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int stream_size(int handle, LONGLONG *filesize)
+/*
+  return the size of the file in bytes
+*/
+{
+    handle = 0;  /* suppress unused parameter compiler warning */
+    
+    /* this operation is not supported in a stream; return large value */
+    *filesize = LONG_MAX;
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int stream_close(int handle)
+/*
+     don't have to close stdin or stdout 
+*/
+{
+    handle = 0;  /* suppress unused parameter compiler warning */
+    
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int stream_flush(int handle)
+/*
+  flush the file
+*/
+{
+    if (handle == 2)
+       fflush(stdout);  
+
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int stream_seek(int handle, LONGLONG offset)
+   /* 
+      seeking is not allowed in a stream
+   */
+{
+    offset = handle;  /* suppress unused parameter compiler warning */
+    return(1);
+}
+/*--------------------------------------------------------------------------*/
+int stream_read(int hdl, void *buffer, long nbytes)
+/*
+     reading from stdin stream 
+*/
+
+{
+    long nread;
+    
+    if (hdl != 1)
+       return(1);  /* can only read from stdin */
+
+    nread = (long) fread(buffer, 1, nbytes, stdin);
+
+    if (nread != nbytes)
+    {
+/*        return(READ_ERROR); */
+        return(END_OF_FILE);
+    }
+
+    return(0);
+}
+/*--------------------------------------------------------------------------*/
+int stream_write(int hdl, void *buffer, long nbytes)
+/*
+  write bytes at the current position in the file
+*/
+{
+    if (hdl != 2)
+       return(1);  /* can only write to stdout */
+
+    if((long) fwrite(buffer, 1, nbytes, stdout) != nbytes)
+        return(WRITE_ERROR);
+
+    return(0);
+}
+
+
+
+

external/cfitsio/drvrgsiftp.c

@@ -0,0 +1,522 @@
+
+/*  This file, drvrgsiftp.c contains driver routines for gsiftp files. */
+/*  Andrea Barisani <lcars@si.inaf.it>                                 */
+/* Taffoni Giuliano <taffoni@oats.inaf.it>                             */
+#ifdef HAVE_NET_SERVICES
+#ifdef HAVE_GSIFTP
+
+#include <sys/types.h>
+#include <string.h>
+#include <signal.h>
+#include <stdlib.h>
+#include <setjmp.h>
+#include "fitsio2.h"
+
+#include <globus_ftp_client.h>
+
+#define MAXLEN 1200
+#define NETTIMEOUT 80
+#define MAX_BUFFER_SIZE_R 1024
+#define MAX_BUFFER_SIZE_W (64*1024)
+
+static int gsiftpopen = 0;
+static int global_offset = 0;
+static int gsiftp_get(char *filename, FILE **gsiftpfile, int num_streams);
+
+static globus_mutex_t lock;
+static globus_cond_t cond;
+static globus_bool_t done;
+
+static char *gsiftp_tmpfile;
+static char *gsiftpurl = NULL;
+static char gsiftp_tmpdir[MAXLEN];
+
+static jmp_buf env; /* holds the jump buffer for setjmp/longjmp pairs */
+static void signal_handler(int sig);
+
+int gsiftp_init(void)
+{
+
+  if (getenv("GSIFTP_TMPFILE")) {
+    gsiftp_tmpfile = getenv("GSIFTP_TMPFILE");
+  } else {
+    strncpy(gsiftp_tmpdir, "/tmp/gsiftp_XXXXXX", sizeof gsiftp_tmpdir);
+    if (mkdtemp(gsiftp_tmpdir) == NULL) {
+        ffpmsg("Cannot create temporary directory!");
+        return (FILE_NOT_OPENED);
+    }
+    gsiftp_tmpfile = malloc(strlen(gsiftp_tmpdir) + strlen("/gsiftp_buffer.tmp"));
+    strcat(gsiftp_tmpfile, gsiftp_tmpdir);
+    strcat(gsiftp_tmpfile, "/gsiftp_buffer.tmp");
+  }
+
+  return file_init();
+}
+
+int gsiftp_shutdown(void)
+{
+  free(gsiftpurl);
+  free(gsiftp_tmpfile);
+  free(gsiftp_tmpdir);
+
+  return file_shutdown();
+}
+
+int gsiftp_setoptions(int options)
+{
+  return file_setoptions(options);
+}
+
+int gsiftp_getoptions(int *options)
+{
+  return file_getoptions(options);
+}
+
+int gsiftp_getversion(int *version)
+{
+  return file_getversion(version);
+}
+
+int gsiftp_checkfile(char *urltype, char *infile, char *outfile)
+{
+  return file_checkfile(urltype, infile, outfile);
+}
+
+int gsiftp_open(char *filename, int rwmode, int *handle)
+{
+  FILE *gsiftpfile;
+  int num_streams;
+
+  if (getenv("GSIFTP_STREAMS")) {
+    num_streams = (int)getenv("GSIFTP_STREAMS");
+  } else {
+    num_streams = 1;
+  }
+  
+  if (rwmode) {
+    gsiftpopen = 2;
+  } else {
+    gsiftpopen = 1;
+  }
+ 
+  if (gsiftpurl)
+    free(gsiftpurl);
+ 
+  gsiftpurl = strdup(filename);
+
+  if (setjmp(env) != 0) {
+    ffpmsg("Timeout (gsiftp_open)");
+    goto error;
+  }
+  
+  signal(SIGALRM, signal_handler);
+  alarm(NETTIMEOUT);
+
+  if (gsiftp_get(filename,&gsiftpfile,num_streams)) {
+    alarm(0);
+    ffpmsg("Unable to open gsiftp file (gsiftp_open)");
+    ffpmsg(filename);
+    goto error;
+  } 
+  
+  fclose(gsiftpfile);
+  
+  signal(SIGALRM, SIG_DFL);
+  alarm(0);
+
+  return file_open(gsiftp_tmpfile, rwmode, handle);
+
+  error:
+   alarm(0);
+   signal(SIGALRM, SIG_DFL);
+   return (FILE_NOT_OPENED);
+}
+
+int gsiftp_create(char *filename, int *handle)
+{
+  if (gsiftpurl)
+    free(gsiftpurl);
+
+  gsiftpurl = strdup(filename);
+
+  return file_create(gsiftp_tmpfile, handle);
+}
+
+int gsiftp_truncate(int handle, LONGLONG filesize)
+{
+  return file_truncate(handle, filesize);
+}
+
+int gsiftp_size(int handle, LONGLONG *filesize)
+{
+  return file_size(handle, filesize);
+}
+
+int gsiftp_flush(int handle)
+{
+  FILE *gsiftpfile;
+  int num_streams;
+
+  if (getenv("GSIFTP_STREAMS")) {
+    num_streams = (int)getenv("GSIFTP_STREAMS");
+  } else {
+    num_streams = 1;
+  }
+  
+  int rc = file_flush(handle);
+
+  if (gsiftpopen != 1) {
+  
+    if (setjmp(env) != 0) {
+      ffpmsg("Timeout (gsiftp_write)");
+      goto error;
+    }
+  
+    signal(SIGALRM, signal_handler);
+    alarm(NETTIMEOUT);
+
+    if (gsiftp_put(gsiftpurl,&gsiftpfile,num_streams)) {
+      alarm(0);
+      ffpmsg("Unable to open gsiftp file (gsiftp_flush)");
+      ffpmsg(gsiftpurl);
+      goto error;
+    } 
+  
+    fclose(gsiftpfile);
+  
+    signal(SIGALRM, SIG_DFL);
+    alarm(0);
+  }
+  
+  return rc;
+
+  error:
+   alarm(0);
+   signal(SIGALRM, SIG_DFL);
+   return (FILE_NOT_OPENED);
+}
+
+int gsiftp_seek(int handle, LONGLONG offset)
+{
+  return file_seek(handle, offset);
+}
+
+int gsiftp_read(int hdl, void *buffer, long nbytes)
+{
+  return file_read(hdl, buffer, nbytes);
+}
+
+int gsiftp_write(int hdl, void *buffer, long nbytes)
+{
+  return file_write(hdl, buffer, nbytes);
+}
+
+int gsiftp_close(int handle)
+{
+    unlink(gsiftp_tmpfile);
+    
+    if (gsiftp_tmpdir)
+        rmdir(gsiftp_tmpdir);
+
+    return file_close(handle);
+}
+
+static void done_cb( void * 				user_arg,
+                     globus_ftp_client_handle_t * 	handle,
+                     globus_object_t * 			err)
+{
+
+    if(err){
+        fprintf(stderr, "%s", globus_object_printable_to_string(err));
+    }
+    
+    globus_mutex_lock(&lock);
+    done = GLOBUS_TRUE;
+    globus_cond_signal(&cond);
+    globus_mutex_unlock(&lock);
+    return;
+}
+
+static void data_cb_read( void * 			user_arg,
+                          globus_ftp_client_handle_t * 	handle,
+                          globus_object_t * 		err,
+                          globus_byte_t * 		buffer,
+                          globus_size_t 		length,
+                          globus_off_t 			offset,
+                          globus_bool_t 		eof)
+{
+    if(err) {
+        fprintf(stderr, "%s", globus_object_printable_to_string(err));
+    }
+    else {
+        FILE* fd = (FILE*) user_arg;
+        int rc = fwrite(buffer, 1, length, fd);
+        if (ferror(fd)) {
+            printf("Read error in function data_cb_read; errno = %d\n", errno);
+            return;
+        }
+
+        if (!eof) {
+            globus_ftp_client_register_read(handle,
+                                            buffer,
+                                            MAX_BUFFER_SIZE_R,
+                                            data_cb_read,
+                                            (void*) fd);
+        }
+    }
+    return;
+}
+
+static void data_cb_write( void * 			user_arg,
+                           globus_ftp_client_handle_t * handle,
+                           globus_object_t * 		err,
+                           globus_byte_t * 		buffer,
+                           globus_size_t 		length,
+                           globus_off_t 		offset,
+                           globus_bool_t 		eof)
+{
+    int curr_offset;
+    if(err) {
+        fprintf(stderr, "%s", globus_object_printable_to_string(err));
+    }
+    else {
+        if (!eof) {
+            FILE* fd = (FILE*) user_arg;
+            int rc;
+            globus_mutex_lock(&lock);
+            curr_offset = global_offset;
+            rc = fread(buffer, 1, MAX_BUFFER_SIZE_W, fd);
+            global_offset += rc;
+            globus_mutex_unlock(&lock);
+            if (ferror(fd)) {
+                printf("Read error in function data_cb_write; errno = %d\n", errno);
+                return;
+            }
+
+            globus_ftp_client_register_write(handle,
+                                             buffer,
+					     rc,
+					     curr_offset,
+                                             feof(fd) != 0,
+                                             data_cb_write,
+                                             (void*) fd);
+        } else {
+            globus_libc_free(buffer);
+        }
+    }
+    return;
+}
+
+int gsiftp_get(char *filename, FILE **gsiftpfile, int num_streams)
+{
+    char gsiurl[MAXLEN];
+
+    globus_ftp_client_handle_t 		handle;
+    globus_ftp_client_operationattr_t 	attr;
+    globus_ftp_client_handleattr_t 	handle_attr;
+    globus_ftp_control_parallelism_t   	parallelism;
+    globus_ftp_control_layout_t		layout;
+    globus_byte_t 			buffer[MAX_BUFFER_SIZE_R];
+    globus_size_t buffer_length = sizeof(buffer);
+    globus_result_t 			result;
+    globus_ftp_client_restart_marker_t	restart;
+    globus_ftp_control_type_t 		filetype;
+   
+    globus_module_activate(GLOBUS_FTP_CLIENT_MODULE);
+    globus_mutex_init(&lock, GLOBUS_NULL);
+    globus_cond_init(&cond, GLOBUS_NULL);
+    globus_ftp_client_handle_init(&handle,  GLOBUS_NULL);
+    globus_ftp_client_handleattr_init(&handle_attr);
+    globus_ftp_client_operationattr_init(&attr);
+    layout.mode = GLOBUS_FTP_CONTROL_STRIPING_NONE;
+    globus_ftp_client_restart_marker_init(&restart);
+    globus_ftp_client_operationattr_set_mode(
+            &attr,
+            GLOBUS_FTP_CONTROL_MODE_EXTENDED_BLOCK);
+   
+    if (num_streams >= 1)
+    {
+        parallelism.mode = GLOBUS_FTP_CONTROL_PARALLELISM_FIXED;
+        parallelism.fixed.size = num_streams;
+       
+        globus_ftp_client_operationattr_set_parallelism(
+            &attr,
+            &parallelism);
+    }
+   
+    globus_ftp_client_operationattr_set_layout(&attr,
+                                               &layout);
+   
+    filetype = GLOBUS_FTP_CONTROL_TYPE_IMAGE;
+    globus_ftp_client_operationattr_set_type (&attr,
+                                              filetype);
+   
+    globus_ftp_client_handle_init(&handle, &handle_attr);
+   
+    done = GLOBUS_FALSE;
+
+    strcpy(gsiurl,"gsiftp://");
+    strcat(gsiurl,filename);
+
+    *gsiftpfile = fopen(gsiftp_tmpfile,"w+");
+    
+    if (!*gsiftpfile) {
+        ffpmsg("Unable to open temporary file!");
+        return (FILE_NOT_OPENED);
+    }
+   
+    result = globus_ftp_client_get(&handle,
+                                   gsiurl,
+                                   &attr,
+                                   &restart,
+                                   done_cb,
+                                   0);
+    if(result != GLOBUS_SUCCESS) {
+        globus_object_t * err;
+        err = globus_error_get(result);
+        fprintf(stderr, "%s", globus_object_printable_to_string(err));
+        done = GLOBUS_TRUE;
+    }
+    else {
+        globus_ftp_client_register_read(&handle,
+                                        buffer,
+                                        buffer_length,
+                                        data_cb_read,
+                                        (void*) *gsiftpfile);
+    }
+   
+    globus_mutex_lock(&lock);
+
+    while(!done) {
+        globus_cond_wait(&cond, &lock);
+    }
+
+    globus_mutex_unlock(&lock);
+    globus_ftp_client_handle_destroy(&handle);
+    globus_module_deactivate_all();
+   
+    return 0;
+}
+
+int gsiftp_put(char *filename, FILE **gsiftpfile, int num_streams)
+{
+    int i;
+    char gsiurl[MAXLEN];
+
+    globus_ftp_client_handle_t 		handle;
+    globus_ftp_client_operationattr_t 	attr;
+    globus_ftp_client_handleattr_t 	handle_attr;
+    globus_ftp_control_parallelism_t   	parallelism;
+    globus_ftp_control_layout_t		layout;
+    globus_byte_t * 			buffer;
+    globus_size_t buffer_length = sizeof(buffer);
+    globus_result_t 			result;
+    globus_ftp_client_restart_marker_t	restart;
+    globus_ftp_control_type_t 		filetype;
+   
+    globus_module_activate(GLOBUS_FTP_CLIENT_MODULE);
+    globus_mutex_init(&lock, GLOBUS_NULL);
+    globus_cond_init(&cond, GLOBUS_NULL);
+    globus_ftp_client_handle_init(&handle,  GLOBUS_NULL);
+    globus_ftp_client_handleattr_init(&handle_attr);
+    globus_ftp_client_operationattr_init(&attr);
+    layout.mode = GLOBUS_FTP_CONTROL_STRIPING_NONE;
+    globus_ftp_client_restart_marker_init(&restart);
+    globus_ftp_client_operationattr_set_mode(
+            &attr,
+            GLOBUS_FTP_CONTROL_MODE_EXTENDED_BLOCK);
+   
+    if (num_streams >= 1)
+    {
+        parallelism.mode = GLOBUS_FTP_CONTROL_PARALLELISM_FIXED;
+        parallelism.fixed.size = num_streams;
+       
+        globus_ftp_client_operationattr_set_parallelism(
+            &attr,
+            &parallelism);
+    }
+   
+    globus_ftp_client_operationattr_set_layout(&attr,
+                                               &layout);
+   
+    filetype = GLOBUS_FTP_CONTROL_TYPE_IMAGE;
+    globus_ftp_client_operationattr_set_type (&attr,
+                                              filetype);
+   
+    globus_ftp_client_handle_init(&handle, &handle_attr);
+   
+    done = GLOBUS_FALSE;
+    
+    strcpy(gsiurl,"gsiftp://");
+    strcat(gsiurl,filename);
+
+    *gsiftpfile = fopen(gsiftp_tmpfile,"r");
+
+    if (!*gsiftpfile) {
+        ffpmsg("Unable to open temporary file!");
+        return (FILE_NOT_OPENED);
+    }
+   
+    result = globus_ftp_client_put(&handle,
+                                   gsiurl,
+                                   &attr,
+                                   &restart,
+                                   done_cb,
+                                   0);
+    if(result != GLOBUS_SUCCESS) {
+        globus_object_t * err;
+        err = globus_error_get(result);
+        fprintf(stderr, "%s", globus_object_printable_to_string(err));
+        done = GLOBUS_TRUE;
+    }
+    else {
+        int rc;
+        int curr_offset;
+
+	for (i = 0; i< 2 * num_streams && feof(*gsiftpfile) == 0; i++)
+        {
+            buffer = malloc(MAX_BUFFER_SIZE_W);
+            globus_mutex_lock(&lock);
+            curr_offset = global_offset;
+            rc = fread(buffer, 1, MAX_BUFFER_SIZE_W, *gsiftpfile);
+            global_offset += rc;
+            globus_mutex_unlock(&lock);
+            globus_ftp_client_register_write(
+                &handle,
+                buffer,
+                rc,
+                curr_offset,
+                feof(*gsiftpfile) != 0,
+                data_cb_write,
+                (void*) *gsiftpfile);
+        }
+    }
+   
+    globus_mutex_lock(&lock);
+
+    while(!done) {
+        globus_cond_wait(&cond, &lock);
+    }
+
+    globus_mutex_unlock(&lock);
+    globus_ftp_client_handle_destroy(&handle);
+    globus_module_deactivate_all();
+   
+    return 0;
+}
+
+static void signal_handler(int sig) {
+
+  switch (sig) {
+  case SIGALRM:    /* process for alarm */
+    longjmp(env,sig);
+    
+  default: {
+      /* Hmm, shouldn't have happend */
+      exit(sig);
+    }
+  }
+}
+
+#endif
+#endif

external/cfitsio/drvrgsiftp.h

@@ -0,0 +1,21 @@
+#ifndef _GSIFTP_H
+#define _GSIFTP_H
+
+int gsiftp_init(void);
+int gsiftp_setoptions(int options);
+int gsiftp_getoptions(int *options);
+int gsiftp_getversion(int *version);
+int gsiftp_shutdown(void);
+int gsiftp_checkfile(char *urltype, char *infile, char *outfile);
+int gsiftp_open(char *filename, int rwmode, int *driverhandle);
+int gsiftp_create(char *filename, int *driverhandle);
+int gsiftp_truncate(int driverhandle, LONGLONG filesize);
+int gsiftp_size(int driverhandle, LONGLONG *filesize);
+int gsiftp_close(int driverhandle);
+int gsiftp_remove(char *filename);
+int gsiftp_flush(int driverhandle);
+int gsiftp_seek(int driverhandle, LONGLONG offset);
+int gsiftp_read (int driverhandle, void *buffer, long nbytes);
+int gsiftp_write(int driverhandle, void *buffer, long nbytes);
+
+#endif

external/cfitsio/drvrsmem.c

@@ -0,0 +1,973 @@
+/*              S H A R E D   M E M O R Y   D R I V E R
+                =======================================
+
+                  by Jerzy.Borkowski@obs.unige.ch
+
+09-Mar-98 : initial version 1.0 released
+23-Mar-98 : shared_malloc now accepts new handle as an argument
+23-Mar-98 : shmem://0, shmem://1, etc changed to shmem://h0, etc due to bug
+            in url parser.
+10-Apr-98 : code cleanup
+13-May-99 : delayed initialization added, global table deleted on exit when
+            no shmem segments remain, and last process terminates
+*/
+
+#ifdef HAVE_SHMEM_SERVICES
+#include "fitsio2.h"                         /* drvrsmem.h is included by it */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+
+#if defined(unix) || defined(__unix__)  || defined(__unix)
+#include <unistd.h> 
+#endif
+
+
+static int shared_kbase = 0;                    /* base for shared memory handles */
+static int shared_maxseg = 0;                   /* max number of shared memory blocks */
+static int shared_range = 0;                    /* max number of tried entries */
+static int shared_fd = SHARED_INVALID;          /* handle of global access lock file */
+static int shared_gt_h = SHARED_INVALID;        /* handle of global table segment */
+static SHARED_LTAB *shared_lt = NULL;           /* local table pointer */
+static SHARED_GTAB *shared_gt = NULL;           /* global table pointer */
+static int shared_create_mode = 0666;           /* permission flags for created objects */
+static int shared_debug = 1;                    /* simple debugging tool, set to 0 to disable messages */
+static int shared_init_called = 0;              /* flag whether shared_init() has been called, used for delayed init */
+
+                /* static support routines prototypes */
+
+static  int shared_clear_entry(int idx);        /* unconditionally clear entry */
+static  int shared_destroy_entry(int idx);      /* unconditionally destroy sema & shseg and clear entry */
+static  int shared_mux(int idx, int mode);      /* obtain exclusive access to specified segment */
+static  int shared_demux(int idx, int mode);    /* free exclusive access to specified segment */
+
+static  int shared_process_count(int sem);      /* valid only for time of invocation */
+static  int shared_delta_process(int sem, int delta); /* change number of processes hanging on segment */
+static  int shared_attach_process(int sem);
+static  int shared_detach_process(int sem);
+static  int shared_get_free_entry(int newhandle);       /* get free entry in shared_key, or -1, entry is set rw locked */
+static  int shared_get_hash(long size, int idx);/* return hash value for malloc */
+static  long shared_adjust_size(long size);     /* size must be >= 0 !!! */
+static  int shared_check_locked_index(int idx); /* verify that given idx is valid */ 
+static  int shared_map(int idx);                /* map all tables for given idx, check for validity */
+static  int shared_validate(int idx, int mode); /* use intrnally inside crit.sect !!! */
+
+                /* support routines - initialization */
+
+
+static  int shared_clear_entry(int idx)         /* unconditionally clear entry */
+ { if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG);
+   shared_gt[idx].key = SHARED_INVALID;         /* clear entries in global table */
+   shared_gt[idx].handle = SHARED_INVALID;
+   shared_gt[idx].sem = SHARED_INVALID;
+   shared_gt[idx].semkey = SHARED_INVALID;
+   shared_gt[idx].nprocdebug = 0;
+   shared_gt[idx].size = 0;
+   shared_gt[idx].attr = 0;
+
+   return(SHARED_OK);
+ }
+
+static  int shared_destroy_entry(int idx)       /* unconditionally destroy sema & shseg and clear entry */
+ { int r, r2;
+   union semun filler;
+
+   if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG);
+   r2 = r = SHARED_OK;
+   filler.val = 0;                              /* this is to make cc happy (warning otherwise) */
+   if (SHARED_INVALID != shared_gt[idx].sem)  r = semctl(shared_gt[idx].sem, 0, IPC_RMID, filler); /* destroy semaphore */
+   if (SHARED_INVALID != shared_gt[idx].handle) r2 = shmctl(shared_gt[idx].handle, IPC_RMID, 0); /* destroy shared memory segment */
+   if (SHARED_OK == r) r = r2;                  /* accumulate error code in r, free r2 */
+   r2 = shared_clear_entry(idx);
+   return((SHARED_OK == r) ? r2 : r);
+ }
+
+void    shared_cleanup(void)                    /* this must (should) be called during exit/abort */
+ { int          i, j, r, oktodelete, filelocked, segmentspresent;
+   flock_t      flk;
+   struct shmid_ds  ds;
+
+   if (shared_debug) printf("shared_cleanup:");
+   if (NULL != shared_lt)
+     { if (shared_debug) printf(" deleting segments:");
+       for (i=0; i<shared_maxseg; i++)
+        { if (0 == shared_lt[i].tcnt) continue; /* we're not using this segment, skip this ... */
+          if (-1 != shared_lt[i].lkcnt) continue;  /* seg not R/W locked by us, skip this ... */
+
+          r = shared_destroy_entry(i);          /* destroy unconditionally sema & segment */
+          if (shared_debug) 
+            { if (SHARED_OK == r) printf(" [%d]", i);
+              else printf(" [error on %d !!!!]", i);
+
+            }
+        }
+       free((void *)shared_lt);                 /* free local table */
+       shared_lt = NULL;
+     }
+   if (NULL != shared_gt)                       /* detach global index table */
+     { oktodelete = 0;
+       filelocked = 0;
+       if (shared_debug) printf(" detaching globalsharedtable");
+       if (SHARED_INVALID != shared_fd)
+
+       flk.l_type = F_WRLCK;                    /* lock whole lock file */
+       flk.l_whence = 0;
+       flk.l_start = 0;
+       flk.l_len = shared_maxseg;
+       if (-1 != fcntl(shared_fd, F_SETLK, &flk))
+         { filelocked = 1;                      /* success, scan global table, to see if there are any segs */
+           segmentspresent = 0;                 /* assume, there are no segs in the system */
+           for (j=0; j<shared_maxseg; j++)
+            { if (SHARED_INVALID != shared_gt[j].key)
+                { segmentspresent = 1;          /* yes, there is at least one */
+                  break;
+                }
+            }
+           if (0 == segmentspresent)            /* if there are no segs ... */
+             if (0 == shmctl(shared_gt_h, IPC_STAT, &ds)) /* get number of processes attached to table */
+               { if (ds.shm_nattch <= 1) oktodelete = 1; /* if only one (we), then it is safe (but see text 4 lines later) to unlink */
+               }
+         }
+       shmdt((char *)shared_gt);                /* detach global table */
+       if (oktodelete)                          /* delete global table from system, if no shm seg present */
+         { shmctl(shared_gt_h, IPC_RMID, 0);    /* there is a race condition here - time window between shmdt and shmctl */
+           shared_gt_h = SHARED_INVALID;
+         }
+       shared_gt = NULL;
+       if (filelocked)                          /* if we locked, we need to unlock */
+         { flk.l_type = F_UNLCK;
+           flk.l_whence = 0;
+           flk.l_start = 0;
+           flk.l_len = shared_maxseg;
+           fcntl(shared_fd, F_SETLK, &flk);
+         }
+     }
+   shared_gt_h = SHARED_INVALID;
+
+   if (SHARED_INVALID != shared_fd)             /* close lock file */
+     { if (shared_debug) printf(" closing lockfile");
+       close(shared_fd);
+       shared_fd = SHARED_INVALID;
+     }
+
+   
+   shared_kbase = 0;
+   shared_maxseg = 0;
+   shared_range = 0;
+   shared_init_called = 0;
+
+   if (shared_debug) printf(" <<done>>\n");
+   return;
+ }
+
+
+int     shared_init(int debug_msgs)             /* initialize shared memory stuff, you have to call this routine once */
+ { int i;
+   char buf[1000], *p;
+   mode_t oldumask;
+
+   shared_init_called = 1;                      /* tell everybody no need to call us for the 2nd time */
+   shared_debug = debug_msgs;                   /* set required debug mode */
+   
+   if (shared_debug) printf("shared_init:");
+
+   shared_kbase = 0;                            /* adapt to current env. settings */
+   if (NULL != (p = getenv(SHARED_ENV_KEYBASE))) shared_kbase = atoi(p);
+   if (0 == shared_kbase) shared_kbase = SHARED_KEYBASE;
+   if (shared_debug) printf(" keybase=%d", shared_kbase);
+
+   shared_maxseg = 0;
+   if (NULL != (p = getenv(SHARED_ENV_MAXSEG))) shared_maxseg = atoi(p);
+   if (0 == shared_maxseg) shared_maxseg = SHARED_MAXSEG;
+   if (shared_debug) printf(" maxseg=%d", shared_maxseg);
+   
+   shared_range = 3 * shared_maxseg;
+
+   if (SHARED_INVALID == shared_fd)             /* create rw locking file (this file is never deleted) */
+     { if (shared_debug) printf(" lockfileinit=");
+       sprintf(buf, "%s.%d.%d", SHARED_FDNAME, shared_kbase, shared_maxseg);
+       oldumask = umask(0);
+
+       shared_fd = open(buf, O_TRUNC | O_EXCL | O_CREAT | O_RDWR, shared_create_mode);
+       umask(oldumask);
+       if (SHARED_INVALID == shared_fd)         /* or just open rw locking file, in case it already exists */
+         { shared_fd = open(buf, O_TRUNC | O_RDWR, shared_create_mode);
+           if (SHARED_INVALID == shared_fd) return(SHARED_NOFILE);
+           if (shared_debug) printf("slave");
+
+         }
+       else
+         { if (shared_debug) printf("master");
+         }
+     }
+
+   if (SHARED_INVALID == shared_gt_h)           /* global table not attached, try to create it in shared memory */
+     { if (shared_debug) printf(" globalsharedtableinit=");
+       shared_gt_h = shmget(shared_kbase, shared_maxseg * sizeof(SHARED_GTAB), IPC_CREAT | IPC_EXCL | shared_create_mode); /* try open as a master */
+       if (SHARED_INVALID == shared_gt_h)       /* if failed, try to open as a slave */
+         { shared_gt_h = shmget(shared_kbase, shared_maxseg * sizeof(SHARED_GTAB), shared_create_mode);
+           if (SHARED_INVALID == shared_gt_h) return(SHARED_IPCERR); /* means deleted ID residing in system, shared mem unusable ... */
+           shared_gt = (SHARED_GTAB *)shmat(shared_gt_h, 0, 0); /* attach segment */
+           if (((SHARED_GTAB *)SHARED_INVALID) == shared_gt) return(SHARED_IPCERR);
+           if (shared_debug) printf("slave");
+         }
+       else
+         { shared_gt = (SHARED_GTAB *)shmat(shared_gt_h, 0, 0); /* attach segment */
+           if (((SHARED_GTAB *)SHARED_INVALID) == shared_gt) return(SHARED_IPCERR);
+           for (i=0; i<shared_maxseg; i++) shared_clear_entry(i);       /* since we are master, init data */
+           if (shared_debug) printf("master");
+         }
+     }
+
+   if (NULL == shared_lt)                       /* initialize local table */
+     { if (shared_debug) printf(" localtableinit=");
+       if (NULL == (shared_lt = (SHARED_LTAB *)malloc(shared_maxseg * sizeof(SHARED_LTAB)))) return(SHARED_NOMEM);
+       for (i=0; i<shared_maxseg; i++)
+        { shared_lt[i].p = NULL;                /* not mapped */
+          shared_lt[i].tcnt = 0;                /* unused (or zero threads using this seg) */
+          shared_lt[i].lkcnt = 0;               /* segment is unlocked */
+          shared_lt[i].seekpos = 0L;            /* r/w pointer at the beginning of file */
+        }
+       if (shared_debug) printf("ok");
+     }
+
+   atexit(shared_cleanup);                      /* we want shared_cleanup to be called at exit or abort */
+
+   if (shared_debug) printf(" <<done>>\n");
+   return(SHARED_OK);
+ }
+
+
+int     shared_recover(int id)                  /* try to recover dormant segments after applic crash */
+ { int i, r, r2;
+
+   if (NULL == shared_gt) return(SHARED_NOTINIT);       /* not initialized */
+   if (NULL == shared_lt) return(SHARED_NOTINIT);       /* not initialized */
+   r = SHARED_OK;
+   for (i=0; i<shared_maxseg; i++)
+    { if (-1 != id) if (i != id) continue;
+      if (shared_lt[i].tcnt) continue;          /* somebody (we) is using it */
+      if (SHARED_INVALID == shared_gt[i].key) continue; /* unused slot */
+      if (shared_mux(i, SHARED_NOWAIT | SHARED_RDWRITE)) continue; /* acquire exclusive access to segment, but do not wait */
+      r2 = shared_process_count(shared_gt[i].sem);
+      if ((shared_gt[i].nprocdebug > r2) || (0 == r2))
+        { if (shared_debug) printf("Bogus handle=%d nproc=%d sema=%d:", i, shared_gt[i].nprocdebug, r2);
+          r = shared_destroy_entry(i);
+          if (shared_debug)
+            { printf("%s", r ? "error couldn't clear handle" : "handle cleared");
+            }
+        }
+      shared_demux(i, SHARED_RDWRITE);
+    }
+   return(r);                                           /* table full */
+ }
+
+                /* API routines - mutexes and locking */
+
+static  int shared_mux(int idx, int mode)       /* obtain exclusive access to specified segment */
+ { flock_t flk;
+
+   int r;
+
+   if (0 == shared_init_called)                 /* delayed initialization */
+     { if (SHARED_OK != (r = shared_init(0))) return(r);
+
+     }
+   if (SHARED_INVALID == shared_fd) return(SHARED_NOTINIT);
+   if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG);
+   flk.l_type = ((mode & SHARED_RDWRITE) ? F_WRLCK : F_RDLCK);
+   flk.l_whence = 0;
+   flk.l_start = idx;
+   flk.l_len = 1;
+   if (shared_debug) printf(" [mux (%d): ", idx);
+   if (-1 == fcntl(shared_fd, ((mode & SHARED_NOWAIT) ? F_SETLK : F_SETLKW), &flk))
+     { switch (errno)
+        { case EAGAIN: ;
+
+          case EACCES: if (shared_debug) printf("again]");
+                       return(SHARED_AGAIN);
+          default:     if (shared_debug) printf("err]");
+                       return(SHARED_IPCERR);
+        }
+     }
+   if (shared_debug) printf("ok]");
+   return(SHARED_OK);
+ }
+
+
+
+static  int shared_demux(int idx, int mode)     /* free exclusive access to specified segment */
+ { flock_t flk;
+
+   if (SHARED_INVALID == shared_fd) return(SHARED_NOTINIT);
+   if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG);
+   flk.l_type = F_UNLCK;
+   flk.l_whence = 0;
+   flk.l_start = idx;
+   flk.l_len = 1;
+   if (shared_debug) printf(" [demux (%d): ", idx);
+   if (-1 == fcntl(shared_fd, F_SETLKW, &flk))
+     { switch (errno)
+        { case EAGAIN: ;
+          case EACCES: if (shared_debug) printf("again]");
+                       return(SHARED_AGAIN);
+          default:     if (shared_debug) printf("err]");
+                       return(SHARED_IPCERR);
+        }
+
+     }
+   if (shared_debug) printf("mode=%d ok]", mode);
+   return(SHARED_OK);
+ }
+
+
+
+static int shared_process_count(int sem)                /* valid only for time of invocation */
+ { union semun su;
+
+   su.val = 0;                                          /* to force compiler not to give warning messages */
+   return(semctl(sem, 0, GETVAL, su));                  /* su is unused here */
+ }
+
+
+static int shared_delta_process(int sem, int delta)     /* change number of processes hanging on segment */
+ { struct sembuf sb;
+ 
+   if (SHARED_INVALID == sem) return(SHARED_BADARG);    /* semaphore not attached */
+   sb.sem_num = 0;
+   sb.sem_op = delta;
+   sb.sem_flg = SEM_UNDO;
+   return((-1 == semop(sem, &sb, 1)) ? SHARED_IPCERR : SHARED_OK);
+ }
+
+
+static int shared_attach_process(int sem)
+ { if (shared_debug) printf(" [attach process]");
+   return(shared_delta_process(sem, 1));
+ }
+
+
+static int shared_detach_process(int sem)
+ { if (shared_debug) printf(" [detach process]");
+   return(shared_delta_process(sem, -1));
+ }
+
+                /* API routines - hashing and searching */
+
+
+static int shared_get_free_entry(int newhandle)         /* get newhandle, or -1, entry is set rw locked */
+ {
+   if (NULL == shared_gt) return(-1);                   /* not initialized */
+   if (NULL == shared_lt) return(-1);                   /* not initialized */
+   if (newhandle < 0) return(-1);
+   if (newhandle >= shared_maxseg) return(-1);
+   if (shared_lt[newhandle].tcnt) return(-1);                   /* somebody (we) is using it */
+   if (shared_mux(newhandle, SHARED_NOWAIT | SHARED_RDWRITE)) return(-1); /* used by others */
+   if (SHARED_INVALID == shared_gt[newhandle].key) return(newhandle); /* we have found free slot, lock it and return index */
+   shared_demux(newhandle, SHARED_RDWRITE);
+   if (shared_debug) printf("[free_entry - ERROR - entry unusable]");
+   return(-1);                                          /* table full */
+ }
+
+
+static int shared_get_hash(long size, int idx)  /* return hash value for malloc */
+ { static int counter = 0;
+   int hash;
+
+   hash = (counter + size * idx) % shared_range;
+   counter = (counter + 1) % shared_range;
+   return(hash);
+ }
+
+
+static  long shared_adjust_size(long size)              /* size must be >= 0 !!! */
+ { return(((size + sizeof(BLKHEAD) + SHARED_GRANUL - 1) / SHARED_GRANUL) * SHARED_GRANUL); }
+
+
+                /* API routines - core : malloc/realloc/free/attach/detach/lock/unlock */
+
+int     shared_malloc(long size, int mode, int newhandle)               /* return idx or SHARED_INVALID */
+ { int h, i, r, idx, key;
+   union semun filler;
+   BLKHEAD *bp;
+   
+   if (0 == shared_init_called)                 /* delayed initialization */
+     { if (SHARED_OK != (r = shared_init(0))) return(r);
+     }
+   if (shared_debug) printf("malloc (size = %ld, mode = %d):", size, mode);
+   if (size < 0) return(SHARED_INVALID);
+   if (-1 == (idx = shared_get_free_entry(newhandle)))  return(SHARED_INVALID);
+   if (shared_debug) printf(" idx=%d", idx);
+   for (i = 0; ; i++)
+    { if (i >= shared_range)                            /* table full, signal error & exit */
+        { shared_demux(idx, SHARED_RDWRITE);
+          return(SHARED_INVALID);
+        }
+      key = shared_kbase + ((i + shared_get_hash(size, idx)) % shared_range);
+      if (shared_debug) printf(" key=%d", key);
+      h = shmget(key, shared_adjust_size(size), IPC_CREAT | IPC_EXCL | shared_create_mode);
+      if (shared_debug) printf(" handle=%d", h);
+      if (SHARED_INVALID == h) continue;                /* segment already accupied */
+      bp = (BLKHEAD *)shmat(h, 0, 0);                   /* try attach */
+      if (shared_debug) printf(" p=%p", bp);
+      if (((BLKHEAD *)SHARED_INVALID) == bp)            /* cannot attach, delete segment, try with another key */
+        { shmctl(h, IPC_RMID, 0);
+          continue;
+        }                                               /* now create semaphor counting number of processes attached */
+      if (SHARED_INVALID == (shared_gt[idx].sem = semget(key, 1, IPC_CREAT | IPC_EXCL | shared_create_mode)))
+        { shmdt((void *)bp);                            /* cannot create segment, delete everything */
+          shmctl(h, IPC_RMID, 0);
+          continue;                                     /* try with another key */
+        }
+      if (shared_debug) printf(" sem=%d", shared_gt[idx].sem);
+      if (shared_attach_process(shared_gt[idx].sem))    /* try attach process */
+        { semctl(shared_gt[idx].sem, 0, IPC_RMID, filler);      /* destroy semaphore */
+          shmdt((char *)bp);                            /* detach shared mem segment */
+          shmctl(h, IPC_RMID, 0);                       /* destroy shared mem segment */
+          continue;                                     /* try with another key */
+        }
+      bp->s.tflag = BLOCK_SHARED;                       /* fill in data in segment's header (this is really not necessary) */
+      bp->s.ID[0] = SHARED_ID_0;
+      bp->s.ID[1] = SHARED_ID_1;
+      bp->s.handle = idx;                               /* used in yorick */
+      if (mode & SHARED_RESIZE)
+        { if (shmdt((char *)bp)) r = SHARED_IPCERR;     /* if segment is resizable, then detach segment */
+          shared_lt[idx].p = NULL;
+        }
+      else  { shared_lt[idx].p = bp; }
+      shared_lt[idx].tcnt = 1;                          /* one thread using segment */
+      shared_lt[idx].lkcnt = 0;                         /* no locks at the moment */
+      shared_lt[idx].seekpos = 0L;                      /* r/w pointer positioned at beg of block */
+      shared_gt[idx].handle = h;                        /* fill in data in global table */
+      shared_gt[idx].size = size;
+      shared_gt[idx].attr = mode;
+      shared_gt[idx].semkey = key;
+      shared_gt[idx].key = key;
+      shared_gt[idx].nprocdebug = 0;
+
+      break;
+    }
+   shared_demux(idx, SHARED_RDWRITE);                   /* hope this will not fail */
+   return(idx);
+ }
+
+
+int     shared_attach(int idx)
+ { int r, r2;
+
+   if (SHARED_OK != (r = shared_mux(idx, SHARED_RDWRITE | SHARED_WAIT))) return(r);
+   if (SHARED_OK != (r = shared_map(idx)))
+     { shared_demux(idx, SHARED_RDWRITE);
+       return(r);
+     }
+   if (shared_attach_process(shared_gt[idx].sem))       /* try attach process */
+     { shmdt((char *)(shared_lt[idx].p));               /* cannot attach process, detach everything */
+       shared_lt[idx].p = NULL;
+       shared_demux(idx, SHARED_RDWRITE);
+       return(SHARED_BADARG);
+     }
+   shared_lt[idx].tcnt++;                               /* one more thread is using segment */
+   if (shared_gt[idx].attr & SHARED_RESIZE)             /* if resizeable, detach and return special pointer */
+     { if (shmdt((char *)(shared_lt[idx].p))) r = SHARED_IPCERR;  /* if segment is resizable, then detach segment */
+       shared_lt[idx].p = NULL;
+     }
+   shared_lt[idx].seekpos = 0L;                         /* r/w pointer positioned at beg of block */
+   r2 = shared_demux(idx, SHARED_RDWRITE);
+   return(r ? r : r2);
+ }
+
+
+
+static int      shared_check_locked_index(int idx)      /* verify that given idx is valid */ 
+ { int r;
+
+   if (0 == shared_init_called)                         /* delayed initialization */
+     { if (SHARED_OK != (r = shared_init(0))) return(r);
+
+     }
+   if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG);
+   if (NULL == shared_lt[idx].p) return(SHARED_BADARG); /* NULL pointer, not attached ?? */
+   if (0 == shared_lt[idx].lkcnt) return(SHARED_BADARG); /* not locked ?? */
+   if ((SHARED_ID_0 != (shared_lt[idx].p)->s.ID[0]) || (SHARED_ID_1 != (shared_lt[idx].p)->s.ID[1]) || 
+       (BLOCK_SHARED != (shared_lt[idx].p)->s.tflag))   /* invalid data in segment */
+     return(SHARED_BADARG);
+   return(SHARED_OK);
+ }
+
+
+
+static int      shared_map(int idx)                     /* map all tables for given idx, check for validity */
+ { int h;                                               /* have to obtain excl. access before calling shared_map */
+   BLKHEAD *bp;
+
+   if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG);
+   if (SHARED_INVALID == shared_gt[idx].key)  return(SHARED_BADARG);
+   if (SHARED_INVALID == (h = shmget(shared_gt[idx].key, 1, shared_create_mode)))  return(SHARED_BADARG);
+   if (((BLKHEAD *)SHARED_INVALID) == (bp = (BLKHEAD *)shmat(h, 0, 0)))  return(SHARED_BADARG);
+   if ((SHARED_ID_0 != bp->s.ID[0]) || (SHARED_ID_1 != bp->s.ID[1]) || (BLOCK_SHARED != bp->s.tflag) || (h != shared_gt[idx].handle))
+     { shmdt((char *)bp);                               /* invalid segment, detach everything */
+       return(SHARED_BADARG);
+
+     }
+   if (shared_gt[idx].sem != semget(shared_gt[idx].semkey, 1, shared_create_mode)) /* check if sema is still there */
+     { shmdt((char *)bp);                               /* cannot attach semaphore, detach everything */
+       return(SHARED_BADARG);
+     }
+   shared_lt[idx].p = bp;                               /* store pointer to shmem data */
+   return(SHARED_OK);
+ }
+
+
+static  int     shared_validate(int idx, int mode)      /* use intrnally inside crit.sect !!! */
+ { int r;
+
+   if (SHARED_OK != (r = shared_mux(idx, mode)))  return(r);            /* idx checked by shared_mux */
+   if (NULL == shared_lt[idx].p)
+     if (SHARED_OK != (r = shared_map(idx)))
+       { shared_demux(idx, mode); 
+         return(r);
+       }
+   if ((SHARED_ID_0 != (shared_lt[idx].p)->s.ID[0]) || (SHARED_ID_1 != (shared_lt[idx].p)->s.ID[1]) || (BLOCK_SHARED != (shared_lt[idx].p)->s.tflag))
+     { shared_demux(idx, mode);
+       return(r);
+     }
+   return(SHARED_OK);
+ }
+
+
+SHARED_P shared_realloc(int idx, long newsize)  /* realloc shared memory segment */
+ { int h, key, i, r;
+   BLKHEAD *bp;
+   long transfersize;
+
+   r = SHARED_OK;
+   if (newsize < 0) return(NULL);
+   if (shared_check_locked_index(idx)) return(NULL);
+   if (0 == (shared_gt[idx].attr & SHARED_RESIZE)) return(NULL);
+   if (-1 != shared_lt[idx].lkcnt) return(NULL); /* check for RW lock */
+   if (shared_adjust_size(shared_gt[idx].size) == shared_adjust_size(newsize))
+     { shared_gt[idx].size = newsize;
+
+       return((SHARED_P)((shared_lt[idx].p) + 1));
+     }
+   for (i = 0; ; i++)
+    { if (i >= shared_range)  return(NULL);     /* table full, signal error & exit */
+      key = shared_kbase + ((i + shared_get_hash(newsize, idx)) % shared_range);
+      h = shmget(key, shared_adjust_size(newsize), IPC_CREAT | IPC_EXCL | shared_create_mode);
+      if (SHARED_INVALID == h) continue;        /* segment already accupied */
+      bp = (BLKHEAD *)shmat(h, 0, 0);           /* try attach */
+      if (((BLKHEAD *)SHARED_INVALID) == bp)    /* cannot attach, delete segment, try with another key */
+        { shmctl(h, IPC_RMID, 0);
+          continue;
+        }
+      *bp = *(shared_lt[idx].p);                /* copy header, then data */
+      transfersize = ((newsize < shared_gt[idx].size) ? newsize : shared_gt[idx].size);
+      if (transfersize > 0)
+        memcpy((void *)(bp + 1), (void *)((shared_lt[idx].p) + 1), transfersize);
+      if (shmdt((char *)(shared_lt[idx].p))) r = SHARED_IPCERR; /* try to detach old segment */
+      if (shmctl(shared_gt[idx].handle, IPC_RMID, 0)) if (SHARED_OK == r) r = SHARED_IPCERR;  /* destroy old shared memory segment */
+      shared_gt[idx].size = newsize;            /* signal new size */
+      shared_gt[idx].handle = h;                /* signal new handle */
+      shared_gt[idx].key = key;                 /* signal new key */
+      shared_lt[idx].p = bp;
+      break;
+    }
+   return((SHARED_P)(bp + 1));
+ }
+
+
+int     shared_free(int idx)                    /* detach segment, if last process & !PERSIST, destroy segment */
+ { int cnt, r, r2;
+
+   if (SHARED_OK != (r = shared_validate(idx, SHARED_RDWRITE | SHARED_WAIT))) return(r);
+   if (SHARED_OK != (r = shared_detach_process(shared_gt[idx].sem)))    /* update number of processes using segment */
+     { shared_demux(idx, SHARED_RDWRITE);
+       return(r);
+     }
+   shared_lt[idx].tcnt--;                       /* update number of threads using segment */
+   if (shared_lt[idx].tcnt > 0)  return(shared_demux(idx, SHARED_RDWRITE));  /* if more threads are using segment we are done */
+   if (shmdt((char *)(shared_lt[idx].p)))       /* if, we are the last thread, try to detach segment */
+     { shared_demux(idx, SHARED_RDWRITE);
+       return(SHARED_IPCERR);
+     }
+   shared_lt[idx].p = NULL;                     /* clear entry in local table */
+   shared_lt[idx].seekpos = 0L;                 /* r/w pointer positioned at beg of block */
+   if (-1 == (cnt = shared_process_count(shared_gt[idx].sem))) /* get number of processes hanging on segment */
+     { shared_demux(idx, SHARED_RDWRITE);
+       return(SHARED_IPCERR);
+     }
+   if ((0 == cnt) && (0 == (shared_gt[idx].attr & SHARED_PERSIST)))  r = shared_destroy_entry(idx); /* no procs on seg, destroy it */
+   r2 = shared_demux(idx, SHARED_RDWRITE);
+   return(r ? r : r2);
+ }
+
+
+SHARED_P shared_lock(int idx, int mode)         /* lock given segment for exclusive access */
+ { int r;
+
+   if (shared_mux(idx, mode))  return(NULL);    /* idx checked by shared_mux */
+   if (0 != shared_lt[idx].lkcnt)               /* are we already locked ?? */
+     if (SHARED_OK != (r = shared_map(idx)))
+       { shared_demux(idx, mode); 
+         return(NULL);
+       }
+   if (NULL == shared_lt[idx].p)                /* stupid pointer ?? */
+     if (SHARED_OK != (r = shared_map(idx)))
+       { shared_demux(idx, mode); 
+         return(NULL);
+       }
+   if ((SHARED_ID_0 != (shared_lt[idx].p)->s.ID[0]) || (SHARED_ID_1 != (shared_lt[idx].p)->s.ID[1]) || (BLOCK_SHARED != (shared_lt[idx].p)->s.tflag))
+     { shared_demux(idx, mode);
+       return(NULL);
+     }
+   if (mode & SHARED_RDWRITE)
+     { shared_lt[idx].lkcnt = -1;
+
+       shared_gt[idx].nprocdebug++;
+     }
+
+   else shared_lt[idx].lkcnt++;
+   shared_lt[idx].seekpos = 0L;                 /* r/w pointer positioned at beg of block */
+   return((SHARED_P)((shared_lt[idx].p) + 1));
+ }
+
+
+int     shared_unlock(int idx)                  /* unlock given segment, assumes seg is locked !! */
+ { int r, r2, mode;
+
+   if (SHARED_OK != (r = shared_check_locked_index(idx))) return(r);
+   if (shared_lt[idx].lkcnt > 0)
+     { shared_lt[idx].lkcnt--;                  /* unlock read lock */
+       mode = SHARED_RDONLY;
+     }
+   else
+     { shared_lt[idx].lkcnt = 0;                /* unlock write lock */
+       shared_gt[idx].nprocdebug--;
+       mode = SHARED_RDWRITE;
+     }
+   if (0 == shared_lt[idx].lkcnt) if (shared_gt[idx].attr & SHARED_RESIZE)
+     { if (shmdt((char *)(shared_lt[idx].p))) r = SHARED_IPCERR; /* segment is resizable, then detach segment */
+       shared_lt[idx].p = NULL;                 /* signal detachment in local table */
+     }
+   r2 = shared_demux(idx, mode);                /* unlock segment, rest is only parameter checking */
+   return(r ? r : r2);
+ }
+
+                /* API routines - support and info routines */
+
+
+int     shared_attr(int idx)                    /* get the attributes of the shared memory segment */
+ { int r;
+
+   if (shared_check_locked_index(idx)) return(SHARED_INVALID);
+   r = shared_gt[idx].attr;
+   return(r);
+ }
+
+
+int     shared_set_attr(int idx, int newattr)   /* get the attributes of the shared memory segment */
+ { int r;
+
+   if (shared_check_locked_index(idx)) return(SHARED_INVALID);
+   if (-1 != shared_lt[idx].lkcnt) return(SHARED_INVALID); /* ADDED - check for RW lock */
+   r = shared_gt[idx].attr;
+   shared_gt[idx].attr = newattr;
+   return(r);
+
+ }
+
+
+int     shared_set_debug(int mode)              /* set/reset debug mode */
+ { int r = shared_debug;
+
+   shared_debug = mode;
+   return(r);
+ }
+
+
+int     shared_set_createmode(int mode)          /* set/reset debug mode */
+ { int r = shared_create_mode;
+
+   shared_create_mode = mode;
+   return(r);
+ }
+
+
+
+
+int     shared_list(int id)
+ { int i, r;
+
+   if (NULL == shared_gt) return(SHARED_NOTINIT);       /* not initialized */
+   if (NULL == shared_lt) return(SHARED_NOTINIT);       /* not initialized */
+   if (shared_debug) printf("shared_list:");
+   r = SHARED_OK;
+   printf(" Idx    Key   Nproc   Size   Flags\n");
+   printf("==============================================\n");
+   for (i=0; i<shared_maxseg; i++)
+    { if (-1 != id) if (i != id) continue;
+      if (SHARED_INVALID == shared_gt[i].key) continue; /* unused slot */
+      switch (shared_mux(i, SHARED_NOWAIT | SHARED_RDONLY)) /* acquire exclusive access to segment, but do not wait */
+
+       { case SHARED_AGAIN:
+                printf("!%3d %08lx %4d  %8d", i, (unsigned long int)shared_gt[i].key,
+                                shared_gt[i].nprocdebug, shared_gt[i].size);
+                if (SHARED_RESIZE & shared_gt[i].attr) printf(" RESIZABLE");
+                if (SHARED_PERSIST & shared_gt[i].attr) printf(" PERSIST");
+                printf("\n");
+                break;
+         case SHARED_OK:
+                printf(" %3d %08lx %4d  %8d", i, (unsigned long int)shared_gt[i].key,
+
+                                shared_gt[i].nprocdebug, shared_gt[i].size);
+                if (SHARED_RESIZE & shared_gt[i].attr) printf(" RESIZABLE");
+                if (SHARED_PERSIST & shared_gt[i].attr) printf(" PERSIST");
+                printf("\n");
+                shared_demux(i, SHARED_RDONLY);
+                break;
+         default:
+                continue;
+       }
+    }
+   if (shared_debug) printf(" done\n");
+   return(r);                                           /* table full */
+ }
+
+int     shared_getaddr(int id, char **address)
+ { int i;
+   char segname[10];
+
+   if (NULL == shared_gt) return(SHARED_NOTINIT);       /* not initialized */
+   if (NULL == shared_lt) return(SHARED_NOTINIT);       /* not initialized */
+ 
+   strcpy(segname,"h");
+   sprintf(segname+1,"%d", id);
+ 
+   if (smem_open(segname,0,&i)) return(SHARED_BADARG);
+ 
+   *address = ((char *)(((DAL_SHM_SEGHEAD *)(shared_lt[i].p + 1)) + 1));
+ /*  smem_close(i); */
+   return(SHARED_OK);
+ }
+
+
+int     shared_uncond_delete(int id)
+ { int i, r;
+
+   if (NULL == shared_gt) return(SHARED_NOTINIT);       /* not initialized */
+   if (NULL == shared_lt) return(SHARED_NOTINIT);       /* not initialized */
+   if (shared_debug) printf("shared_uncond_delete:");
+   r = SHARED_OK;
+   for (i=0; i<shared_maxseg; i++)
+    { if (-1 != id) if (i != id) continue;
+      if (shared_attach(i))
+        { if (-1 != id) printf("no such handle\n");
+          continue;
+        }
+      printf("handle %d:", i);
+      if (NULL == shared_lock(i, SHARED_RDWRITE | SHARED_NOWAIT)) 
+        { printf(" cannot lock in RW mode, not deleted\n");
+          continue;
+        }
+      if (shared_set_attr(i, SHARED_RESIZE) >= SHARED_ERRBASE)
+        { printf(" cannot clear PERSIST attribute");
+        }
+      if (shared_free(i))
+        { printf(" delete failed\n");
+        }
+      else
+        { printf(" deleted\n");
+        }
+    }
+   if (shared_debug) printf(" done\n");
+   return(r);                                           /* table full */
+ }
+
+
+/************************* CFITSIO DRIVER FUNCTIONS ***************************/
+
+int     smem_init(void)
+ { return(0);
+ }
+
+int     smem_shutdown(void)
+
+ { if (shared_init_called) shared_cleanup();
+   return(0);
+ }
+
+int     smem_setoptions(int option)
+ { option = 0;
+   return(0);
+ }
+
+
+int     smem_getoptions(int *options)
+ { if (NULL == options) return(SHARED_NULPTR);
+   *options = 0;
+   return(0);
+ }
+
+int     smem_getversion(int *version)
+ { if (NULL == version) return(SHARED_NULPTR);
+   *version = 10;
+   return(0);
+ }
+
+
+int     smem_open(char *filename, int rwmode, int *driverhandle)
+ { int h, nitems, r;
+   DAL_SHM_SEGHEAD *sp;
+
+
+   if (NULL == filename) return(SHARED_NULPTR);
+   if (NULL == driverhandle) return(SHARED_NULPTR);
+   nitems = sscanf(filename, "h%d", &h);
+   if (1 != nitems) return(SHARED_BADARG);
+
+   if (SHARED_OK != (r = shared_attach(h))) return(r);
+
+   if (NULL == (sp = (DAL_SHM_SEGHEAD *)shared_lock(h,
+                ((READWRITE == rwmode) ? SHARED_RDWRITE : SHARED_RDONLY))))
+     {  shared_free(h);
+        return(SHARED_BADARG);
+     }
+
+   if ((h != sp->h) || (DAL_SHM_SEGHEAD_ID != sp->ID))
+     { shared_unlock(h);
+       shared_free(h);
+
+       return(SHARED_BADARG);
+     }
+
+   *driverhandle = h;
+   return(0);
+ }
+
+
+int     smem_create(char *filename, int *driverhandle)
+ { DAL_SHM_SEGHEAD *sp;
+   int h, sz, nitems;
+
+   if (NULL == filename) return(SHARED_NULPTR);         /* currently ignored */
+   if (NULL == driverhandle) return(SHARED_NULPTR);
+   nitems = sscanf(filename, "h%d", &h);
+   if (1 != nitems) return(SHARED_BADARG);
+
+   if (SHARED_INVALID == (h = shared_malloc(sz = 2880 + sizeof(DAL_SHM_SEGHEAD), 
+                        SHARED_RESIZE | SHARED_PERSIST, h)))
+     return(SHARED_NOMEM);
+
+   if (NULL == (sp = (DAL_SHM_SEGHEAD *)shared_lock(h, SHARED_RDWRITE)))
+     { shared_free(h);
+       return(SHARED_BADARG);
+     }
+
+   sp->ID = DAL_SHM_SEGHEAD_ID;
+   sp->h = h;
+   sp->size = sz;
+   sp->nodeidx = -1;
+
+   *driverhandle = h;
+   
+   return(0);
+ }
+
+
+int     smem_close(int driverhandle)
+ { int r;
+
+   if (SHARED_OK != (r = shared_unlock(driverhandle))) return(r);
+   return(shared_free(driverhandle));
+ }
+
+int     smem_remove(char *filename)
+ { int nitems, h, r;
+
+   if (NULL == filename) return(SHARED_NULPTR);
+   nitems = sscanf(filename, "h%d", &h);
+   if (1 != nitems) return(SHARED_BADARG);
+
+   if (0 == shared_check_locked_index(h))       /* are we locked ? */
+
+     { if (-1 != shared_lt[h].lkcnt)            /* are we locked RO ? */
+         { if (SHARED_OK != (r = shared_unlock(h))) return(r);  /* yes, so relock in RW */
+           if (NULL == shared_lock(h, SHARED_RDWRITE)) return(SHARED_BADARG);
+         }
+
+     }
+   else                                         /* not locked */
+     { if (SHARED_OK != (r = smem_open(filename, READWRITE, &h)))
+         return(r);                             /* so open in RW mode */
+     }
+
+   shared_set_attr(h, SHARED_RESIZE);           /* delete PERSIST attribute */
+   return(smem_close(h));                       /* detach segment (this will delete it) */
+ }
+
+int     smem_size(int driverhandle, LONGLONG *size)
+ {
+   if (NULL == size) return(SHARED_NULPTR);
+   if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID);
+   *size = (LONGLONG) (shared_gt[driverhandle].size - sizeof(DAL_SHM_SEGHEAD));
+   return(0);
+ }
+
+int     smem_flush(int driverhandle)
+ {
+   if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID);
+   return(0);
+ }
+
+int     smem_seek(int driverhandle, LONGLONG offset)
+ {
+   if (offset < 0) return(SHARED_BADARG);
+   if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID);
+   shared_lt[driverhandle].seekpos = offset;
+   return(0);
+ }
+
+int     smem_read(int driverhandle, void *buffer, long nbytes)
+ {
+   if (NULL == buffer) return(SHARED_NULPTR);
+   if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID);
+   if (nbytes < 0) return(SHARED_BADARG);
+   if ((shared_lt[driverhandle].seekpos + nbytes) > shared_gt[driverhandle].size)
+     return(SHARED_BADARG);             /* read beyond EOF */
+
+   memcpy(buffer,
+          ((char *)(((DAL_SHM_SEGHEAD *)(shared_lt[driverhandle].p + 1)) + 1)) +
+                shared_lt[driverhandle].seekpos,
+          nbytes);
+
+   shared_lt[driverhandle].seekpos += nbytes;
+   return(0);
+ }
+
+int     smem_write(int driverhandle, void *buffer, long nbytes)
+ {
+   if (NULL == buffer) return(SHARED_NULPTR);
+   if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID);
+   if (-1 != shared_lt[driverhandle].lkcnt) return(SHARED_INVALID); /* are we locked RW ? */
+
+   if (nbytes < 0) return(SHARED_BADARG);
+   if ((unsigned long)(shared_lt[driverhandle].seekpos + nbytes) > (unsigned long)(shared_gt[driverhandle].size - sizeof(DAL_SHM_SEGHEAD)))
+     {                  /* need to realloc shmem */
+       if (NULL == shared_realloc(driverhandle, shared_lt[driverhandle].seekpos + nbytes + sizeof(DAL_SHM_SEGHEAD)))
+         return(SHARED_NOMEM);
+     }
+
+   memcpy(((char *)(((DAL_SHM_SEGHEAD *)(shared_lt[driverhandle].p + 1)) + 1)) +
+                shared_lt[driverhandle].seekpos,
+          buffer,
+          nbytes);
+
+   shared_lt[driverhandle].seekpos += nbytes;
+   return(0);
+ }
+#endif

external/cfitsio/drvrsmem.h

@@ -0,0 +1,179 @@
+/*		S H A R E D   M E M O R Y   D R I V E R
+		=======================================
+
+		  by Jerzy.Borkowski@obs.unige.ch
+
+09-Mar-98 : initial version 1.0 released
+23-Mar-98 : shared_malloc now accepts new handle as an argument
+*/
+
+
+#include <sys/ipc.h>		/* this is necessary for Solaris/Linux */
+#include <sys/shm.h>
+#include <sys/sem.h>
+
+#ifdef _AIX
+#include <fcntl.h>
+#else
+#include <sys/fcntl.h>
+#endif
+
+		/* configuration parameters */
+
+#define	SHARED_MAXSEG	(16)		/* maximum number of shared memory blocks */
+
+#define	SHARED_KEYBASE	(14011963)	/* base for shared memory keys, may be overriden by getenv */
+#define	SHARED_FDNAME	("/tmp/.shmem-lockfile") /* template for lock file name */
+
+#define	SHARED_ENV_KEYBASE ("SHMEM_LIB_KEYBASE") /* name of environment variable */
+#define	SHARED_ENV_MAXSEG ("SHMEM_LIB_MAXSEG")	/* name of environment variable */
+
+		/* useful constants */
+
+#define	SHARED_RDONLY	(0)		/* flag for shared_(un)lock, lock for read */
+#define	SHARED_RDWRITE	(1)		/* flag for shared_(un)lock, lock for write */
+#define	SHARED_WAIT	(0)		/* flag for shared_lock, block if cannot lock immediate */
+#define	SHARED_NOWAIT	(2)		/* flag for shared_lock, fail if cannot lock immediate */
+#define	SHARED_NOLOCK	(0x100)		/* flag for shared_validate function */
+
+#define	SHARED_RESIZE	(4)		/* flag for shared_malloc, object is resizeable */
+#define	SHARED_PERSIST	(8)		/* flag for shared_malloc, object is not deleted after last proc detaches */
+
+#define	SHARED_INVALID	(-1)		/* invalid handle for semaphore/shared memory */
+
+#define	SHARED_EMPTY	(0)		/* entries for shared_used table */
+#define	SHARED_USED	(1)
+
+#define	SHARED_GRANUL	(16384)		/* granularity of shared_malloc allocation = phys page size, system dependent */
+
+
+
+		/* checkpoints in shared memory segments - might be omitted */
+
+#define	SHARED_ID_0	('J')		/* first byte of identifier in BLKHEAD */
+#define	SHARED_ID_1	('B')		/* second byte of identifier in BLKHEAD */
+
+#define	BLOCK_REG	(0)		/* value for tflag member of BLKHEAD */
+#define	BLOCK_SHARED	(1)		/* value for tflag member of BLKHEAD */
+
+		/* generic error codes */
+
+#define	SHARED_OK	(0)
+
+#define	SHARED_ERR_MIN_IDX	SHARED_BADARG
+#define	SHARED_ERR_MAX_IDX	SHARED_NORESIZE
+
+
+#define	DAL_SHM_FREE	(0)
+#define	DAL_SHM_USED	(1)
+
+#define	DAL_SHM_ID0	('D')
+#define	DAL_SHM_ID1	('S')
+#define	DAL_SHM_ID2	('M')
+
+#define	DAL_SHM_SEGHEAD_ID	(0x19630114)
+
+
+
+		/* data types */
+
+/* BLKHEAD object is placed at the beginning of every memory segment (both
+  shared and regular) to allow automatic recognition of segments type */
+
+typedef union
+      { struct BLKHEADstruct
+	      {	char	ID[2];		/* ID = 'JB', just as a checkpoint */
+		char	tflag;		/* is it shared memory or regular one ? */
+		int	handle;		/* this is not necessary, used only for non-resizeable objects via ptr */
+	      } s;
+	double	d;			/* for proper alignment on every machine */
+      } BLKHEAD;
+
+typedef void *SHARED_P;			/* generic type of shared memory pointer */
+
+typedef	struct SHARED_GTABstruct	/* data type used in global table */
+      {	int	sem;			/* access semaphore (1 field): process count */
+	int	semkey;			/* key value used to generate semaphore handle */
+	int	key;			/* key value used to generate shared memory handle (realloc changes it) */
+	int	handle;			/* handle of shared memory segment */
+	int	size;			/* size of shared memory segment */
+	int	nprocdebug;		/* attached proc counter, helps remove zombie segments */
+	char	attr;			/* attributes of shared memory object */
+      } SHARED_GTAB;
+
+typedef	struct SHARED_LTABstruct	/* data type used in local table */
+      {	BLKHEAD	*p;			/* pointer to segment (may be null) */
+	int	tcnt;			/* number of threads in this process attached to segment */
+	int	lkcnt;			/* >=0 <- number of read locks, -1 - write lock */
+	long	seekpos;		/* current pointer position, read/write/seek operations change it */
+      } SHARED_LTAB;
+
+
+	/* system dependent definitions */
+
+#ifndef HAVE_FLOCK_T
+typedef struct flock flock_t;
+#define HAVE_FLOCK_T
+#endif
+
+#ifndef HAVE_UNION_SEMUN
+union semun
+      {	int val;
+	struct semid_ds *buf;
+	unsigned short *array;
+      };
+#define HAVE_UNION_SEMUN
+#endif
+
+
+typedef struct DAL_SHM_SEGHEAD_STRUCT	DAL_SHM_SEGHEAD;
+
+struct DAL_SHM_SEGHEAD_STRUCT
+      {	int	ID;			/* ID for debugging */
+	int	h;			/* handle of sh. mem */
+	int	size;			/* size of data area */
+	int	nodeidx;		/* offset of root object (node struct typically) */
+      };
+
+		/* API routines */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void	shared_cleanup(void);			/* must be called at exit/abort */
+int	shared_init(int debug_msgs);		/* must be called before any other shared memory routine */
+int	shared_recover(int id);			/* try to recover dormant segment(s) after applic crash */
+int	shared_malloc(long size, int mode, int newhandle);	/* allocate n-bytes of shared memory */
+int	shared_attach(int idx);			/* attach to segment given index to table */
+int	shared_free(int idx);			/* release shared memory */
+SHARED_P shared_lock(int idx, int mode);	/* lock segment for reading */
+SHARED_P shared_realloc(int idx, long newsize);	/* reallocate n-bytes of shared memory (ON LOCKED SEGMENT ONLY) */
+int	shared_size(int idx);			/* get size of attached shared memory segment (ON LOCKED SEGMENT ONLY) */
+int	shared_attr(int idx);			/* get attributes of attached shared memory segment (ON LOCKED SEGMENT ONLY) */
+int	shared_set_attr(int idx, int newattr);	/* set attributes of attached shared memory segment (ON LOCKED SEGMENT ONLY) */
+int	shared_unlock(int idx);			/* unlock segment (ON LOCKED SEGMENT ONLY) */
+int	shared_set_debug(int debug_msgs);	/* set/reset debug mode */
+int	shared_set_createmode(int mode);	/* set/reset debug mode */
+int	shared_list(int id);			/* list segment(s) */
+int	shared_uncond_delete(int id);		/* uncondintionally delete (NOWAIT operation) segment(s) */
+int	shared_getaddr(int id, char **address);	/* get starting address of FITS file in segment */
+
+int	smem_init(void);
+int	smem_shutdown(void);
+int	smem_setoptions(int options);
+int	smem_getoptions(int *options);
+int	smem_getversion(int *version);
+int	smem_open(char *filename, int rwmode, int *driverhandle);
+int	smem_create(char *filename, int *driverhandle);
+int	smem_close(int driverhandle);
+int	smem_remove(char *filename);
+int	smem_size(int driverhandle, LONGLONG *size);
+int	smem_flush(int driverhandle);
+int	smem_seek(int driverhandle, LONGLONG offset);
+int	smem_read(int driverhandle, void *buffer, long nbytes);
+int	smem_write(int driverhandle, void *buffer, long nbytes);
+
+#ifdef __cplusplus
+}
+#endif

external/cfitsio/edithdu.c

@@ -0,0 +1,883 @@
+/*  This file, edithdu.c, contains the FITSIO routines related to       */
+/*  copying, inserting, or deleting HDUs in a FITS file                 */
+
+/*  The FITSIO software was written by William Pence at the High Energy    */
+/*  Astrophysic Science Archive Research Center (HEASARC) at the NASA      */
+/*  Goddard Space Flight Center.                                           */
+
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+/*--------------------------------------------------------------------------*/
+int ffcopy(fitsfile *infptr,    /* I - FITS file pointer to input file  */
+           fitsfile *outfptr,   /* I - FITS file pointer to output file */
+           int morekeys,        /* I - reserve space in output header   */
+           int *status)         /* IO - error status     */
+/*
+  copy the CHDU from infptr to the CHDU of outfptr.
+  This will also allocate space in the output header for MOREKY keywords
+*/
+{
+    int nspace;
+    
+    if (*status > 0)
+        return(*status);
+
+    if (infptr == outfptr)
+        return(*status = SAME_FILE);
+
+    if (ffcphd(infptr, outfptr, status) )  /* copy the header keywords */
+       return(*status);
+
+    if (morekeys > 0) {
+      ffhdef(outfptr, morekeys, status); /* reserve space for more keywords */
+
+    } else {
+        if (ffghsp(infptr, NULL, &nspace, status) > 0) /* get existing space */
+            return(*status);
+
+        if (nspace > 0) {
+            ffhdef(outfptr, nspace, status); /* preserve same amount of space */
+            if (nspace >= 35) {  
+
+	        /* There is at least 1 full empty FITS block in the header. */
+	        /* Physically write the END keyword at the beginning of the */
+	        /* last block to preserve this extra space now rather than */
+		/* later.  This is needed by the stream: driver which cannot */
+		/* seek back to the header to write the END keyword later. */
+
+	        ffwend(outfptr, status);
+            }
+        }
+    }
+
+    ffcpdt(infptr, outfptr, status);  /* now copy the data unit */
+
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcpfl(fitsfile *infptr,    /* I - FITS file pointer to input file  */
+           fitsfile *outfptr,   /* I - FITS file pointer to output file */
+           int previous,        /* I - copy any previous HDUs?   */
+           int current,         /* I - copy the current HDU?     */
+           int following,       /* I - copy any following HDUs?   */
+           int *status)         /* IO - error status     */
+/*
+  copy all or part of the input file to the output file.
+*/
+{
+    int hdunum, ii;
+
+    if (*status > 0)
+        return(*status);
+
+    if (infptr == outfptr)
+        return(*status = SAME_FILE);
+
+    ffghdn(infptr, &hdunum);
+
+    if (previous) {   /* copy any previous HDUs */
+        for (ii=1; ii < hdunum; ii++) {
+            ffmahd(infptr, ii, NULL, status);
+            ffcopy(infptr, outfptr, 0, status);
+        }
+    }
+
+    if (current && (*status <= 0) ) {  /* copy current HDU */
+        ffmahd(infptr, hdunum, NULL, status);
+        ffcopy(infptr, outfptr, 0, status);
+    }
+
+    if (following && (*status <= 0) ) { /* copy any remaining HDUs */
+        ii = hdunum + 1;
+        while (1)
+        { 
+            if (ffmahd(infptr, ii, NULL, status) ) {
+                 /* reset expected end of file status */
+                 if (*status == END_OF_FILE)
+                    *status = 0;
+                 break;
+            }
+
+            if (ffcopy(infptr, outfptr, 0, status))
+                 break;  /* quit on unexpected error */
+
+            ii++;
+        }
+    }
+
+    ffmahd(infptr, hdunum, NULL, status);  /* restore initial position */
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcphd(fitsfile *infptr,    /* I - FITS file pointer to input file  */
+           fitsfile *outfptr,   /* I - FITS file pointer to output file */
+           int *status)         /* IO - error status     */
+/*
+  copy the header keywords from infptr to outfptr.
+*/
+{
+    int nkeys, ii, inPrim = 0, outPrim = 0;
+    long naxis, naxes[1];
+    char *card, comm[FLEN_COMMENT];
+    char *tmpbuff;
+
+    if (*status > 0)
+        return(*status);
+
+    if (infptr == outfptr)
+        return(*status = SAME_FILE);
+
+    /* set the input pointer to the correct HDU */
+    if (infptr->HDUposition != (infptr->Fptr)->curhdu)
+        ffmahd(infptr, (infptr->HDUposition) + 1, NULL, status);
+
+    if (ffghsp(infptr, &nkeys, NULL, status) > 0) /* get no. of keywords */
+        return(*status);
+
+    /* create a memory buffer to hold the header records */
+    tmpbuff = (char*) malloc(nkeys*FLEN_CARD*sizeof(char));
+    if (!tmpbuff)
+        return(*status = MEMORY_ALLOCATION);
+
+    /* read all of the header records in the input HDU */
+    for (ii = 0; ii < nkeys; ii++)
+      ffgrec(infptr, ii+1, tmpbuff + (ii * FLEN_CARD), status);
+
+    if (infptr->HDUposition == 0)  /* set flag if this is the Primary HDU */
+       inPrim = 1;
+
+    /* if input is an image hdu, get the number of axes */
+    naxis = -1;   /* negative if HDU is a table */
+    if ((infptr->Fptr)->hdutype == IMAGE_HDU)
+        ffgkyj(infptr, "NAXIS", &naxis, NULL, status);
+
+    /* set the output pointer to the correct HDU */
+    if (outfptr->HDUposition != (outfptr->Fptr)->curhdu)
+        ffmahd(outfptr, (outfptr->HDUposition) + 1, NULL, status);
+
+    /* check if output header is empty; if not create new empty HDU */
+    if ((outfptr->Fptr)->headend !=
+        (outfptr->Fptr)->headstart[(outfptr->Fptr)->curhdu] )
+           ffcrhd(outfptr, status);   
+
+    if (outfptr->HDUposition == 0)
+    {
+        if (naxis < 0)
+        {
+            /* the input HDU is a table, so we have to create */
+            /* a dummy Primary array before copying it to the output */
+            ffcrim(outfptr, 8, 0, naxes, status);
+            ffcrhd(outfptr, status); /* create new empty HDU */
+        }
+        else
+        {
+            /* set flag that this is the Primary HDU */
+            outPrim = 1;
+        }
+    }
+
+    if (*status > 0)  /* check for errors before proceeding */
+    {
+        free(tmpbuff);
+        return(*status);
+    }
+    if ( inPrim == 1 && outPrim == 0 )
+    {
+        /* copying from primary array to image extension */
+        strcpy(comm, "IMAGE extension");
+        ffpkys(outfptr, "XTENSION", "IMAGE", comm, status);
+
+        /* copy BITPIX through NAXISn keywords */
+        for (ii = 1; ii < 3 + naxis; ii++)
+        {
+            card = tmpbuff + (ii * FLEN_CARD);
+            ffprec(outfptr, card, status);
+        }
+
+        strcpy(comm, "number of random group parameters");
+        ffpkyj(outfptr, "PCOUNT", 0, comm, status);
+  
+        strcpy(comm, "number of random groups");
+        ffpkyj(outfptr, "GCOUNT", 1, comm, status);
+
+
+        /* copy remaining keywords, excluding EXTEND, and reference COMMENT keywords */
+        for (ii = 3 + naxis ; ii < nkeys; ii++)
+        {
+            card = tmpbuff+(ii * FLEN_CARD);
+            if (FSTRNCMP(card, "EXTEND  ", 8) &&
+                FSTRNCMP(card, "COMMENT   FITS (Flexible Image Transport System) format is", 58) && 
+                FSTRNCMP(card, "COMMENT   and Astrophysics', volume 376, page 3", 47) )
+            {
+                 ffprec(outfptr, card, status);
+            }
+        }
+    }
+    else if ( inPrim == 0 && outPrim == 1 )
+    {
+        /* copying between image extension and primary array */
+        strcpy(comm, "file does conform to FITS standard");
+        ffpkyl(outfptr, "SIMPLE", TRUE, comm, status);
+
+        /* copy BITPIX through NAXISn keywords */
+        for (ii = 1; ii < 3 + naxis; ii++)
+        {
+            card = tmpbuff + (ii * FLEN_CARD);
+            ffprec(outfptr, card, status);
+        }
+
+        /* add the EXTEND keyword */
+        strcpy(comm, "FITS dataset may contain extensions");
+        ffpkyl(outfptr, "EXTEND", TRUE, comm, status);
+
+      /* write standard block of self-documentating comments */
+      ffprec(outfptr,
+      "COMMENT   FITS (Flexible Image Transport System) format is defined in 'Astronomy",
+      status);
+      ffprec(outfptr,
+      "COMMENT   and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H",
+      status);
+
+        /* copy remaining keywords, excluding pcount, gcount */
+        for (ii = 3 + naxis; ii < nkeys; ii++)
+        {
+            card = tmpbuff+(ii * FLEN_CARD);
+            if (FSTRNCMP(card, "PCOUNT  ", 8) && FSTRNCMP(card, "GCOUNT  ", 8))
+            {
+                 ffprec(outfptr, card, status);
+            }
+        }
+    }
+    else
+    {
+        /* input and output HDUs are same type; simply copy all keywords */
+        for (ii = 0; ii < nkeys; ii++)
+        {
+            card = tmpbuff+(ii * FLEN_CARD);
+            ffprec(outfptr, card, status);
+        }
+    }
+
+    free(tmpbuff);
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcpdt(fitsfile *infptr,    /* I - FITS file pointer to input file  */
+           fitsfile *outfptr,   /* I - FITS file pointer to output file */
+           int *status)         /* IO - error status     */
+{
+/*
+  copy the data unit from the CHDU of infptr to the CHDU of outfptr. 
+  This will overwrite any data already in the outfptr CHDU.
+*/
+    long nb, ii;
+    LONGLONG indatastart, indataend, outdatastart;
+    char buffer[2880];
+
+    if (*status > 0)
+        return(*status);
+
+    if (infptr == outfptr)
+        return(*status = SAME_FILE);
+
+    ffghadll(infptr,  NULL, &indatastart, &indataend, status);
+    ffghadll(outfptr, NULL, &outdatastart, NULL, status);
+
+    /* Calculate the number of blocks to be copied  */
+    nb = (long) ((indataend - indatastart) / 2880);
+
+    if (nb > 0)
+    {
+      if (infptr->Fptr == outfptr->Fptr)
+      {
+        /* copying between 2 HDUs in the SAME file */
+        for (ii = 0; ii < nb; ii++)
+        {
+            ffmbyt(infptr,  indatastart,  REPORT_EOF, status);
+            ffgbyt(infptr,  2880L, buffer, status); /* read input block */
+
+            ffmbyt(outfptr, outdatastart, IGNORE_EOF, status);
+            ffpbyt(outfptr, 2880L, buffer, status); /* write output block */
+
+            indatastart  += 2880; /* move address */
+            outdatastart += 2880; /* move address */
+        }
+      }
+      else
+      {
+        /* copying between HDUs in separate files */
+        /* move to the initial copy position in each of the files */
+        ffmbyt(infptr,  indatastart,  REPORT_EOF, status);
+        ffmbyt(outfptr, outdatastart, IGNORE_EOF, status);
+
+        for (ii = 0; ii < nb; ii++)
+        {
+            ffgbyt(infptr,  2880L, buffer, status); /* read input block */
+            ffpbyt(outfptr, 2880L, buffer, status); /* write output block */
+        }
+      }
+    }
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffwrhdu(fitsfile *infptr,    /* I - FITS file pointer to input file  */
+            FILE *outstream,     /* I - stream to write HDU to */
+            int *status)         /* IO - error status     */
+{
+/*
+  write the data unit from the CHDU of infptr to the output file stream
+*/
+    long nb, ii;
+    LONGLONG hdustart, hduend;
+    char buffer[2880];
+
+    if (*status > 0)
+        return(*status);
+
+    ffghadll(infptr, &hdustart,  NULL, &hduend, status);
+
+    nb = (long) ((hduend - hdustart) / 2880);  /* number of blocks to copy */
+
+    if (nb > 0)
+    {
+
+        /* move to the start of the HDU */
+        ffmbyt(infptr,  hdustart,  REPORT_EOF, status);
+
+        for (ii = 0; ii < nb; ii++)
+        {
+            ffgbyt(infptr,  2880L, buffer, status); /* read input block */
+            fwrite(buffer, 1, 2880, outstream ); /* write to output stream */
+        }
+    }
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffiimg(fitsfile *fptr,      /* I - FITS file pointer           */
+           int bitpix,          /* I - bits per pixel              */
+           int naxis,           /* I - number of axes in the array */
+           long *naxes,         /* I - size of each axis           */
+           int *status)         /* IO - error status               */
+/*
+  insert an IMAGE extension following the current HDU 
+*/
+{
+    LONGLONG tnaxes[99];
+    int ii;
+    
+    if (*status > 0)
+        return(*status);
+
+    if (naxis > 99) {
+        ffpmsg("NAXIS value is too large (>99)  (ffiimg)");
+	return(*status = 212);
+    }
+
+    for (ii = 0; (ii < naxis); ii++)
+       tnaxes[ii] = naxes[ii];
+       
+    ffiimgll(fptr, bitpix, naxis, tnaxes, status);
+
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffiimgll(fitsfile *fptr,    /* I - FITS file pointer           */
+           int bitpix,          /* I - bits per pixel              */
+           int naxis,           /* I - number of axes in the array */
+           LONGLONG *naxes,     /* I - size of each axis           */
+           int *status)         /* IO - error status               */
+/*
+  insert an IMAGE extension following the current HDU 
+*/
+{
+    int bytlen, nexthdu, maxhdu, ii, onaxis;
+    long nblocks;
+    LONGLONG npixels, newstart, datasize;
+    char errmsg[FLEN_ERRMSG], card[FLEN_CARD], naxiskey[FLEN_KEYWORD];
+
+    if (*status > 0)
+        return(*status);
+
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    maxhdu = (fptr->Fptr)->maxhdu;
+
+    if (*status != PREPEND_PRIMARY)
+    {
+      /* if the current header is completely empty ...  */
+      if (( (fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu])
+        /* or, if we are at the end of the file, ... */
+      ||  ( (((fptr->Fptr)->curhdu) == maxhdu ) &&
+       ((fptr->Fptr)->headstart[maxhdu + 1] >= (fptr->Fptr)->logfilesize ) ) )
+      {
+        /* then simply append new image extension */
+        ffcrimll(fptr, bitpix, naxis, naxes, status);
+        return(*status);
+      }
+    }
+
+    if (bitpix == 8)
+        bytlen = 1;
+    else if (bitpix == 16)
+        bytlen = 2;
+    else if (bitpix == 32 || bitpix == -32)
+        bytlen = 4;
+    else if (bitpix == 64 || bitpix == -64)
+        bytlen = 8;
+    else
+    {
+        sprintf(errmsg,
+        "Illegal value for BITPIX keyword: %d", bitpix);
+        ffpmsg(errmsg);
+        return(*status = BAD_BITPIX);  /* illegal bitpix value */
+    }
+    if (naxis < 0 || naxis > 999)
+    {
+        sprintf(errmsg,
+        "Illegal value for NAXIS keyword: %d", naxis);
+        ffpmsg(errmsg);
+        return(*status = BAD_NAXIS);
+    }
+
+    for (ii = 0; ii < naxis; ii++)
+    {
+        if (naxes[ii] < 0)
+        {
+            sprintf(errmsg,
+            "Illegal value for NAXIS%d keyword: %ld", ii + 1,  (long) naxes[ii]);
+            ffpmsg(errmsg);
+            return(*status = BAD_NAXES);
+        }
+    }
+
+    /* calculate number of pixels in the image */
+    if (naxis == 0)
+        npixels = 0;
+    else 
+        npixels = naxes[0];
+
+    for (ii = 1; ii < naxis; ii++)
+        npixels = npixels * naxes[ii];
+
+    datasize = npixels * bytlen;          /* size of image in bytes */
+    nblocks = (long) (((datasize + 2879) / 2880) + 1);  /* +1 for the header */
+
+    if ((fptr->Fptr)->writemode == READWRITE) /* must have write access */
+    {   /* close the CHDU */
+        ffrdef(fptr, status);  /* scan header to redefine structure */
+        ffpdfl(fptr, status);  /* insure correct data file values */
+    }
+    else
+        return(*status = READONLY_FILE);
+
+    if (*status == PREPEND_PRIMARY)
+    {
+        /* inserting a new primary array; the current primary */
+        /* array must be transformed into an image extension. */
+
+        *status = 0;   
+        ffmahd(fptr, 1, NULL, status);  /* move to the primary array */
+
+        ffgidm(fptr, &onaxis, status);
+        if (onaxis > 0)
+            ffkeyn("NAXIS",onaxis, naxiskey, status);
+        else
+            strcpy(naxiskey, "NAXIS");
+
+        ffgcrd(fptr, naxiskey, card, status);  /* read last NAXIS keyword */
+        
+        ffikyj(fptr, "PCOUNT", 0, "required keyword", status); /* add PCOUNT and */
+        ffikyj(fptr, "GCOUNT", 1, "required keyword", status); /* GCOUNT keywords */
+
+        if (*status > 0)
+            return(*status);
+
+        if (ffdkey(fptr, "EXTEND", status) ) /* delete the EXTEND keyword */
+            *status = 0;
+
+        /* redefine internal structure for this HDU */
+        ffrdef(fptr, status);
+
+
+        /* insert space for the primary array */
+        if (ffiblk(fptr, nblocks, -1, status) > 0)  /* insert the blocks */
+            return(*status);
+
+        nexthdu = 0;  /* number of the new hdu */
+        newstart = 0; /* starting addr of HDU */
+    }
+    else
+    {
+        nexthdu = ((fptr->Fptr)->curhdu) + 1; /* number of the next (new) hdu */
+        newstart = (fptr->Fptr)->headstart[nexthdu]; /* save starting addr of HDU */
+
+        (fptr->Fptr)->hdutype = IMAGE_HDU;  /* so that correct fill value is used */
+        /* ffiblk also increments headstart for all following HDUs */
+        if (ffiblk(fptr, nblocks, 1, status) > 0)  /* insert the blocks */
+            return(*status);
+    }
+
+    ((fptr->Fptr)->maxhdu)++;      /* increment known number of HDUs in the file */
+    for (ii = (fptr->Fptr)->maxhdu; ii > (fptr->Fptr)->curhdu; ii--)
+        (fptr->Fptr)->headstart[ii + 1] = (fptr->Fptr)->headstart[ii]; /* incre start addr */
+
+    if (nexthdu == 0)
+       (fptr->Fptr)->headstart[1] = nblocks * 2880; /* start of the old Primary array */
+
+    (fptr->Fptr)->headstart[nexthdu] = newstart; /* set starting addr of HDU */
+
+    /* set default parameters for this new empty HDU */
+    (fptr->Fptr)->curhdu = nexthdu;   /* we are now located at the next HDU */
+    fptr->HDUposition = nexthdu;      /* we are now located at the next HDU */
+    (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[nexthdu];  
+    (fptr->Fptr)->headend = (fptr->Fptr)->headstart[nexthdu];
+    (fptr->Fptr)->datastart = ((fptr->Fptr)->headstart[nexthdu]) + 2880;
+    (fptr->Fptr)->hdutype = IMAGE_HDU;  /* might need to be reset... */
+
+    /* write the required header keywords */
+    ffphprll(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status);
+
+    /* redefine internal structure for this HDU */
+    ffrdef(fptr, status);
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffitab(fitsfile *fptr,  /* I - FITS file pointer                        */
+           LONGLONG naxis1,     /* I - width of row in the table                */
+           LONGLONG naxis2,     /* I - number of rows in the table              */
+           int tfields,     /* I - number of columns in the table           */
+           char **ttype,    /* I - name of each column                      */
+           long *tbcol,     /* I - byte offset in row to each column        */
+           char **tform,    /* I - value of TFORMn keyword for each column  */
+           char **tunit,    /* I - value of TUNITn keyword for each column  */
+           const char *extnmx,   /* I - value of EXTNAME keyword, if any         */
+           int *status)     /* IO - error status                            */
+/*
+  insert an ASCII table extension following the current HDU 
+*/
+{
+    int nexthdu, maxhdu, ii, nunit, nhead, ncols, gotmem = 0;
+    long nblocks, rowlen;
+    LONGLONG datasize, newstart;
+    char errmsg[81], extnm[FLEN_VALUE];
+
+    if (*status > 0)
+        return(*status);
+
+    extnm[0] = '\0';
+    if (extnmx)
+      strncat(extnm, extnmx, FLEN_VALUE-1);
+
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    maxhdu = (fptr->Fptr)->maxhdu;
+    /* if the current header is completely empty ...  */
+    if (( (fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+        /* or, if we are at the end of the file, ... */
+    ||  ( (((fptr->Fptr)->curhdu) == maxhdu ) &&
+       ((fptr->Fptr)->headstart[maxhdu + 1] >= (fptr->Fptr)->logfilesize ) ) )
+    {
+        /* then simply append new image extension */
+        ffcrtb(fptr, ASCII_TBL, naxis2, tfields, ttype, tform, tunit,
+               extnm, status);
+        return(*status);
+    }
+
+    if (naxis1 < 0)
+        return(*status = NEG_WIDTH);
+    else if (naxis2 < 0)
+        return(*status = NEG_ROWS);
+    else if (tfields < 0 || tfields > 999)
+    {
+        sprintf(errmsg,
+        "Illegal value for TFIELDS keyword: %d", tfields);
+        ffpmsg(errmsg);
+        return(*status = BAD_TFIELDS);
+    }
+
+    /* count number of optional TUNIT keywords to be written */
+    nunit = 0;
+    for (ii = 0; ii < tfields; ii++)
+    {
+        if (tunit && *tunit && *tunit[ii])
+            nunit++;
+    }
+
+    if (extnm && *extnm)
+         nunit++;     /* add one for the EXTNAME keyword */
+
+    rowlen = (long) naxis1;
+
+    if (!tbcol || !tbcol[0] || (!naxis1 && tfields)) /* spacing not defined? */
+    {
+      /* allocate mem for tbcol; malloc may have problems allocating small */
+      /* arrays, so allocate at least 20 bytes */
+
+      ncols = maxvalue(5, tfields);
+      tbcol = (long *) calloc(ncols, sizeof(long));
+
+      if (tbcol)
+      {
+        gotmem = 1;
+
+        /* calculate width of a row and starting position of each column. */
+        /* Each column will be separated by 1 blank space */
+        ffgabc(tfields, tform, 1, &rowlen, tbcol, status);
+      }
+    }
+
+    nhead = (9 + (3 * tfields) + nunit + 35) / 36;  /* no. of header blocks */
+    datasize = (LONGLONG)rowlen * naxis2;          /* size of table in bytes */
+    nblocks = (long) (((datasize + 2879) / 2880) + nhead);  /* size of HDU */
+
+    if ((fptr->Fptr)->writemode == READWRITE) /* must have write access */
+    {   /* close the CHDU */
+        ffrdef(fptr, status);  /* scan header to redefine structure */
+        ffpdfl(fptr, status);  /* insure correct data file values */
+    }
+    else
+        return(*status = READONLY_FILE);
+
+    nexthdu = ((fptr->Fptr)->curhdu) + 1; /* number of the next (new) hdu */
+    newstart = (fptr->Fptr)->headstart[nexthdu]; /* save starting addr of HDU */
+
+    (fptr->Fptr)->hdutype = ASCII_TBL;  /* so that correct fill value is used */
+    /* ffiblk also increments headstart for all following HDUs */
+    if (ffiblk(fptr, nblocks, 1, status) > 0)  /* insert the blocks */
+    {
+        if (gotmem)
+            free(tbcol); 
+        return(*status);
+    }
+
+    ((fptr->Fptr)->maxhdu)++;      /* increment known number of HDUs in the file */
+    for (ii = (fptr->Fptr)->maxhdu; ii > (fptr->Fptr)->curhdu; ii--)
+        (fptr->Fptr)->headstart[ii + 1] = (fptr->Fptr)->headstart[ii]; /* incre start addr */
+
+    (fptr->Fptr)->headstart[nexthdu] = newstart; /* set starting addr of HDU */
+
+    /* set default parameters for this new empty HDU */
+    (fptr->Fptr)->curhdu = nexthdu;   /* we are now located at the next HDU */
+    fptr->HDUposition = nexthdu;      /* we are now located at the next HDU */
+    (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[nexthdu];  
+    (fptr->Fptr)->headend = (fptr->Fptr)->headstart[nexthdu];
+    (fptr->Fptr)->datastart = ((fptr->Fptr)->headstart[nexthdu]) + (nhead * 2880);
+    (fptr->Fptr)->hdutype = ASCII_TBL;  /* might need to be reset... */
+
+    /* write the required header keywords */
+
+    ffphtb(fptr, rowlen, naxis2, tfields, ttype, tbcol, tform, tunit,
+           extnm, status);
+
+    if (gotmem)
+        free(tbcol); 
+
+    /* redefine internal structure for this HDU */
+
+    ffrdef(fptr, status);
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffibin(fitsfile *fptr,  /* I - FITS file pointer                        */
+           LONGLONG naxis2,     /* I - number of rows in the table              */
+           int tfields,     /* I - number of columns in the table           */
+           char **ttype,    /* I - name of each column                      */
+           char **tform,    /* I - value of TFORMn keyword for each column  */
+           char **tunit,    /* I - value of TUNITn keyword for each column  */
+           const char *extnmx,     /* I - value of EXTNAME keyword, if any         */
+           LONGLONG pcount, /* I - size of special data area (heap)         */
+           int *status)     /* IO - error status                            */
+/*
+  insert a Binary table extension following the current HDU 
+*/
+{
+    int nexthdu, maxhdu, ii, nunit, nhead, datacode;
+    LONGLONG naxis1;
+    long nblocks, repeat, width;
+    LONGLONG datasize, newstart;
+    char errmsg[81], extnm[FLEN_VALUE];
+
+    if (*status > 0)
+        return(*status);
+
+    extnm[0] = '\0';
+    if (extnmx)
+      strncat(extnm, extnmx, FLEN_VALUE-1);
+
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    maxhdu = (fptr->Fptr)->maxhdu;
+    /* if the current header is completely empty ...  */
+    if (( (fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+        /* or, if we are at the end of the file, ... */
+    ||  ( (((fptr->Fptr)->curhdu) == maxhdu ) &&
+       ((fptr->Fptr)->headstart[maxhdu + 1] >= (fptr->Fptr)->logfilesize ) ) )
+    {
+        /* then simply append new image extension */
+        ffcrtb(fptr, BINARY_TBL, naxis2, tfields, ttype, tform, tunit,
+               extnm, status);
+        return(*status);
+    }
+
+    if (naxis2 < 0)
+        return(*status = NEG_ROWS);
+    else if (tfields < 0 || tfields > 999)
+    {
+        sprintf(errmsg,
+        "Illegal value for TFIELDS keyword: %d", tfields);
+        ffpmsg(errmsg);
+        return(*status = BAD_TFIELDS);
+    }
+
+    /* count number of optional TUNIT keywords to be written */
+    nunit = 0;
+    for (ii = 0; ii < tfields; ii++)
+    {
+        if (tunit && *tunit && *tunit[ii])
+            nunit++;
+    }
+
+    if (extnm && *extnm)
+         nunit++;     /* add one for the EXTNAME keyword */
+
+    nhead = (9 + (2 * tfields) + nunit + 35) / 36;  /* no. of header blocks */
+
+    /* calculate total width of the table */
+    naxis1 = 0;
+    for (ii = 0; ii < tfields; ii++)
+    {
+        ffbnfm(tform[ii], &datacode, &repeat, &width, status);
+
+        if (datacode == TBIT)
+            naxis1 = naxis1 + ((repeat + 7) / 8);
+        else if (datacode == TSTRING)
+            naxis1 += repeat;
+        else
+            naxis1 = naxis1 + (repeat * width);
+    }
+
+    datasize = ((LONGLONG)naxis1 * naxis2) + pcount;         /* size of table in bytes */
+    nblocks = (long) ((datasize + 2879) / 2880) + nhead;  /* size of HDU */
+
+    if ((fptr->Fptr)->writemode == READWRITE) /* must have write access */
+    {   /* close the CHDU */
+        ffrdef(fptr, status);  /* scan header to redefine structure */
+        ffpdfl(fptr, status);  /* insure correct data file values */
+    }
+    else
+        return(*status = READONLY_FILE);
+
+    nexthdu = ((fptr->Fptr)->curhdu) + 1; /* number of the next (new) hdu */
+    newstart = (fptr->Fptr)->headstart[nexthdu]; /* save starting addr of HDU */
+
+    (fptr->Fptr)->hdutype = BINARY_TBL;  /* so that correct fill value is used */
+
+    /* ffiblk also increments headstart for all following HDUs */
+    if (ffiblk(fptr, nblocks, 1, status) > 0)  /* insert the blocks */
+        return(*status);
+
+    ((fptr->Fptr)->maxhdu)++;      /* increment known number of HDUs in the file */
+    for (ii = (fptr->Fptr)->maxhdu; ii > (fptr->Fptr)->curhdu; ii--)
+        (fptr->Fptr)->headstart[ii + 1] = (fptr->Fptr)->headstart[ii]; /* incre start addr */
+
+    (fptr->Fptr)->headstart[nexthdu] = newstart; /* set starting addr of HDU */
+
+    /* set default parameters for this new empty HDU */
+    (fptr->Fptr)->curhdu = nexthdu;   /* we are now located at the next HDU */
+    fptr->HDUposition = nexthdu;      /* we are now located at the next HDU */
+    (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[nexthdu];  
+    (fptr->Fptr)->headend = (fptr->Fptr)->headstart[nexthdu];
+    (fptr->Fptr)->datastart = ((fptr->Fptr)->headstart[nexthdu]) + (nhead * 2880);
+    (fptr->Fptr)->hdutype = BINARY_TBL;  /* might need to be reset... */
+
+    /* write the required header keywords. This will write PCOUNT = 0 */
+    /* so that the variable length data will be written at the right place */
+    ffphbn(fptr, naxis2, tfields, ttype, tform, tunit, extnm, pcount,
+           status);
+
+    /* redefine internal structure for this HDU (with PCOUNT = 0) */
+    ffrdef(fptr, status);
+
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdhdu(fitsfile *fptr,      /* I - FITS file pointer                   */
+           int *hdutype,        /* O - type of the new CHDU after deletion */
+           int *status)         /* IO - error status                       */
+/*
+  Delete the CHDU.  If the CHDU is the primary array, then replace the HDU
+  with an empty primary array with no data.   Return the
+  type of the new CHDU after the old CHDU is deleted.
+*/
+{
+    int tmptype = 0;
+    long nblocks, ii, naxes[1];
+
+    if (*status > 0)
+        return(*status);
+
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    if ((fptr->Fptr)->curhdu == 0) /* replace primary array with null image */
+    {
+        /* ignore any existing keywords */
+        (fptr->Fptr)->headend = 0;
+        (fptr->Fptr)->nextkey = 0;
+
+        /* write default primary array header */
+        ffphpr(fptr,1,8,0,naxes,0,1,1,status);
+
+        /* calc number of blocks to delete (leave just 1 block) */
+        nblocks = (long) (( (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu + 1] - 
+                2880 ) / 2880);
+
+        /* ffdblk also updates the starting address of all following HDUs */
+        if (nblocks > 0)
+        {
+            if (ffdblk(fptr, nblocks, status) > 0) /* delete the HDU */
+                return(*status);
+        }
+
+        /* this might not be necessary, but is doesn't hurt */
+        (fptr->Fptr)->datastart = DATA_UNDEFINED;
+
+        ffrdef(fptr, status);  /* reinitialize the primary array */
+    }
+    else
+    {
+
+        /* calc number of blocks to delete */
+        nblocks = (long) (( (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu + 1] - 
+                (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) / 2880);
+
+        /* ffdblk also updates the starting address of all following HDUs */
+        if (ffdblk(fptr, nblocks, status) > 0) /* delete the HDU */
+            return(*status);
+
+        /* delete the CHDU from the list of HDUs */
+        for (ii = (fptr->Fptr)->curhdu + 1; ii <= (fptr->Fptr)->maxhdu; ii++)
+            (fptr->Fptr)->headstart[ii] = (fptr->Fptr)->headstart[ii + 1];
+
+        (fptr->Fptr)->headstart[(fptr->Fptr)->maxhdu + 1] = 0;
+        ((fptr->Fptr)->maxhdu)--; /* decrement the known number of HDUs */
+
+        if (ffrhdu(fptr, &tmptype, status) > 0)  /* initialize next HDU */
+        {
+            /* failed (end of file?), so move back one HDU */
+            *status = 0;
+            ffcmsg();       /* clear extraneous error messages */
+            ffgext(fptr, ((fptr->Fptr)->curhdu) - 1, &tmptype, status);
+        }
+    }
+
+    if (hdutype)
+       *hdutype = tmptype;
+
+    return(*status);
+}
+

external/cfitsio/eval.l

@@ -0,0 +1,545 @@
+%{
+/************************************************************************/
+/*                                                                      */
+/*                       CFITSIO Lexical Parser                         */
+/*                                                                      */
+/* This file is one of 3 files containing code which parses an          */
+/* arithmetic expression and evaluates it in the context of an input    */
+/* FITS file table extension.  The CFITSIO lexical parser is divided    */
+/* into the following 3 parts/files: the CFITSIO "front-end",           */
+/* eval_f.c, contains the interface between the user/CFITSIO and the    */
+/* real core of the parser; the FLEX interpreter, eval_l.c, takes the   */
+/* input string and parses it into tokens and identifies the FITS       */
+/* information required to evaluate the expression (ie, keywords and    */
+/* columns); and, the BISON grammar and evaluation routines, eval_y.c,  */
+/* receives the FLEX output and determines and performs the actual      */
+/* operations.  The files eval_l.c and eval_y.c are produced from       */
+/* running flex and bison on the files eval.l and eval.y, respectively. */
+/* (flex and bison are available from any GNU archive: see www.gnu.org) */
+/*                                                                      */
+/* The grammar rules, rather than evaluating the expression in situ,    */
+/* builds a tree, or Nodal, structure mapping out the order of          */
+/* operations and expression dependencies.  This "compilation" process  */
+/* allows for much faster processing of multiple rows.  This technique  */
+/* was developed by Uwe Lammers of the XMM Science Analysis System,     */
+/* although the CFITSIO implementation is entirely code original.       */
+/*                                                                      */
+/*                                                                      */
+/* Modification History:                                                */
+/*                                                                      */
+/*   Kent Blackburn      c1992  Original parser code developed for the  */
+/*                              FTOOLS software package, in particular, */
+/*                              the fselect task.                       */
+/*   Kent Blackburn      c1995  BIT column support added                */
+/*   Peter D Wilson   Feb 1998  Vector column support added             */
+/*   Peter D Wilson   May 1998  Ported to CFITSIO library.  User        */
+/*                              interface routines written, in essence  */
+/*                              making fselect, fcalc, and maketime     */
+/*                              capabilities available to all tools     */
+/*                              via single function calls.              */
+/*   Peter D Wilson   Jun 1998  Major rewrite of parser core, so as to  */
+/*                              create a run-time evaluation tree,      */
+/*                              inspired by the work of Uwe Lammers,    */
+/*                              resulting in a speed increase of        */
+/*                              10-100 times.                           */
+/*   Peter D Wilson   Jul 1998  gtifilter(a,b,c,d) function added       */
+/*   Peter D Wilson   Aug 1998  regfilter(a,b,c,d) function added       */
+/*   Peter D Wilson   Jul 1999  Make parser fitsfile-independent,       */
+/*                              allowing a purely vector-based usage    */
+/*                                                                      */
+/************************************************************************/
+
+#include <math.h>
+#include <string.h>
+#include <ctype.h>
+#ifdef sparc
+#include <malloc.h>
+#else
+#include <stdlib.h>
+#endif
+#include "eval_defs.h"
+
+ParseData gParse;     /* Global structure holding all parser information     */
+
+/*****  Internal functions  *****/
+
+       int yyGetVariable( char *varName, YYSTYPE *varVal );
+
+static int find_variable( char *varName );
+static int expr_read( char *buf, int nbytes );
+
+/*****  Definitions  *****/
+
+#define YY_NO_UNPUT   /*  Don't include YYUNPUT function  */
+#define YY_NEVER_INTERACTIVE 1
+
+#define MAXCHR 256
+#define MAXBIT 128
+
+#define OCT_0 "000"
+#define OCT_1 "001"
+#define OCT_2 "010"
+#define OCT_3 "011"
+#define OCT_4 "100"
+#define OCT_5 "101"
+#define OCT_6 "110"
+#define OCT_7 "111"
+#define OCT_X "xxx"
+
+#define HEX_0 "0000"
+#define HEX_1 "0001"
+#define HEX_2 "0010"
+#define HEX_3 "0011"
+#define HEX_4 "0100"
+#define HEX_5 "0101"
+#define HEX_6 "0110"
+#define HEX_7 "0111"
+#define HEX_8 "1000"
+#define HEX_9 "1001"
+#define HEX_A "1010"
+#define HEX_B "1011"
+#define HEX_C "1100"
+#define HEX_D "1101"
+#define HEX_E "1110"
+#define HEX_F "1111"
+#define HEX_X "xxxx"
+
+/* 
+   MJT - 13 June 1996
+   read from buffer instead of stdin
+   (as per old ftools.skel)
+*/
+#undef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+        if ( (result = expr_read( (char *) buf, max_size )) < 0 ) \
+            YY_FATAL_ERROR( "read() in flex scanner failed" );
+
+%}
+bit		([bB][01xX]+)
+oct		([oO][01234567xX]+)
+hex		([hH][0123456789aAbBcCdDeEfFxX]+)
+integer		[0-9]+
+boolean         (t|f|T|F)
+real		([0-9]*"."[0-9]+)|([0-9]*"."*[0-9]+[eEdD][+-]?[0-9]+)|([0-9]*".")
+constant        ("#"[a-zA-Z0-9_]+)|("#""$"[^\n]*"$")
+string		([\"][^\"\n]*[\"])|([\'][^\'\n]*[\'])
+variable	([a-zA-Z_][a-zA-Z0-9_]*)|("$"[^$\n]*"$")
+function	[a-zA-Z][a-zA-Z0-9]+"("
+intcast		("(int)"|"(INT)")
+fltcast		("(float)"|"(FLOAT)"|"(double)"|"(DOUBLE)")
+power		("^"|"**")
+not             ("!"|".not."|".NOT."|"not."|"NOT.")
+or              ("||"|".or."|".OR."|"or."|"OR.")
+and             ("&&"|".and."|".AND."|"and."|"AND.")
+equal		("=="|".eq."|".EQ."|"eq."|"EQ.")
+not_equal	("!="|".ne."|".NE."|"ne."|"NE.")
+greater         (">"|".gt."|".GT."|"gt."|"GT.")
+lesser          ("<"|".lt."|".LT."|"lt."|"LT.")
+greater_eq	(">="|"=>"|".ge."|".GE."|"ge."|"GE.")
+lesser_eq	("<="|"=<"|".le."|".LE."|"le."|"LE.")
+nl		\n
+
+%%
+
+[ \t]+     ;
+{bit}		{
+                  int len;
+                  len = strlen(yytext);
+		  while (yytext[len] == ' ')
+			len--;
+                  len = len - 1;
+		  strncpy(yylval.str,&yytext[1],len);
+		  yylval.str[len] = '\0';
+		  return( BITSTR );
+		}
+{oct}		{
+                  int len;
+                  char tmpstring[256];
+                  char bitstring[256];
+                  len = strlen(yytext);
+		  if (len >= 256) {
+		    char errMsg[100];
+		    gParse.status = PARSE_SYNTAX_ERR;
+		    strcpy (errMsg,"Bit string exceeds maximum length: '");
+		    strncat(errMsg, &(yytext[0]), 20);
+		    strcat (errMsg,"...'");
+		    ffpmsg (errMsg);
+		    len = 0;
+		  } else {
+		    while (yytext[len] == ' ')
+		      len--;
+		    len = len - 1;
+		    strncpy(tmpstring,&yytext[1],len);
+		  }
+                  tmpstring[len] = '\0';
+                  bitstring[0] = '\0';
+		  len = 0;
+                  while ( tmpstring[len] != '\0')
+                       {
+			switch ( tmpstring[len] )
+			      {
+			       case '0':
+					strcat(bitstring,OCT_0);
+					break;
+			       case '1':
+					strcat(bitstring,OCT_1);
+					break;
+			       case '2':
+					strcat(bitstring,OCT_2);
+					break;
+			       case '3':
+					strcat(bitstring,OCT_3);
+					break;
+			       case '4':
+					strcat(bitstring,OCT_4);
+					break;
+			       case '5':
+					strcat(bitstring,OCT_5);
+					break;
+			       case '6':
+					strcat(bitstring,OCT_6);
+					break;
+			       case '7':
+					strcat(bitstring,OCT_7);
+					break;
+			       case 'x':
+			       case 'X':
+					strcat(bitstring,OCT_X);
+					break;
+			      }
+			len++;
+                       }
+                  strcpy( yylval.str, bitstring );
+		  return( BITSTR );
+		}
+{hex}		{
+                  int len;
+                  char tmpstring[256];
+                  char bitstring[256];
+                  len = strlen(yytext);
+		  if (len >= 256) {
+		    char errMsg[100];
+		    gParse.status = PARSE_SYNTAX_ERR;
+		    strcpy (errMsg,"Hex string exceeds maximum length: '");
+		    strncat(errMsg, &(yytext[0]), 20);
+		    strcat (errMsg,"...'");
+		    ffpmsg (errMsg);
+		    len = 0;
+		  } else {
+		    while (yytext[len] == ' ')
+		      len--;
+		    len = len - 1;
+		    strncpy(tmpstring,&yytext[1],len);
+		  }
+                  tmpstring[len] = '\0';
+                  bitstring[0] = '\0';
+		  len = 0;
+                  while ( tmpstring[len] != '\0')
+                       {
+			switch ( tmpstring[len] )
+			      {
+			       case '0':
+					strcat(bitstring,HEX_0);
+					break;
+			       case '1':
+					strcat(bitstring,HEX_1);
+					break;
+			       case '2':
+					strcat(bitstring,HEX_2);
+					break;
+			       case '3':
+					strcat(bitstring,HEX_3);
+					break;
+			       case '4':
+					strcat(bitstring,HEX_4);
+					break;
+			       case '5':
+					strcat(bitstring,HEX_5);
+					break;
+			       case '6':
+					strcat(bitstring,HEX_6);
+					break;
+			       case '7':
+					strcat(bitstring,HEX_7);
+					break;
+			       case '8':
+					strcat(bitstring,HEX_8);
+					break;
+			       case '9':
+					strcat(bitstring,HEX_9);
+					break;
+			       case 'a':
+			       case 'A':
+					strcat(bitstring,HEX_A);
+					break;
+			       case 'b':
+			       case 'B':
+					strcat(bitstring,HEX_B);
+					break;
+			       case 'c':
+			       case 'C':
+					strcat(bitstring,HEX_C);
+					break;
+			       case 'd':
+			       case 'D':
+					strcat(bitstring,HEX_D);
+					break;
+			       case 'e':
+			       case 'E':
+					strcat(bitstring,HEX_E);
+					break;
+			       case 'f':
+			       case 'F':
+					strcat(bitstring,HEX_F);
+					break;
+			       case 'x':
+			       case 'X':
+					strcat(bitstring,HEX_X);
+					break;
+			      }
+			len++;
+                       }
+
+                  strcpy( yylval.str, bitstring );
+		  return( BITSTR );
+		}
+{integer}	{
+                  yylval.lng = atol(yytext);
+		  return( LONG );
+		}
+{boolean}	{
+                  if ((yytext[0] == 't') || (yytext[0] == 'T'))
+		    yylval.log = 1;
+		  else
+		    yylval.log = 0;
+		  return( BOOLEAN );
+		}
+{real}		{
+                  yylval.dbl = atof(yytext);
+		  return( DOUBLE );
+		}
+{constant}	{
+                  if(        !strcasecmp(yytext,"#PI") ) {
+		     yylval.dbl = (double)(4) * atan((double)(1));
+		     return( DOUBLE );
+		  } else if( !strcasecmp(yytext,"#E") ) {
+		     yylval.dbl = exp((double)(1));
+		     return( DOUBLE );
+		  } else if( !strcasecmp(yytext,"#DEG") ) {
+		     yylval.dbl = ((double)4)*atan((double)1)/((double)180);
+		     return( DOUBLE );
+		  } else if( !strcasecmp(yytext,"#ROW") ) {
+		     return( ROWREF );
+		  } else if( !strcasecmp(yytext,"#NULL") ) {
+		     return( NULLREF );
+		  } else if( !strcasecmp(yytext,"#SNULL") ) {
+		     return( SNULLREF );
+		  } else {
+                     int len; 
+                     if (yytext[1] == '$') {
+                        len = strlen(yytext) - 3;
+                        yylval.str[0]     = '#';
+                        strncpy(yylval.str+1,&yytext[2],len);
+                        yylval.str[len+1] = '\0';
+                        yytext = yylval.str;
+		     }
+                     return( (*gParse.getData)(yytext, &yylval) );
+                  }
+                }
+{string}	{
+                  int len;
+                  len = strlen(yytext) - 2;
+		  if (len >= MAX_STRLEN) {
+		    char errMsg[100];
+		    gParse.status = PARSE_SYNTAX_ERR;
+		    strcpy (errMsg,"String exceeds maximum length: '");
+		    strncat(errMsg, &(yytext[1]), 20);
+		    strcat (errMsg,"...'");
+		    ffpmsg (errMsg);
+		    len = 0;
+		  } else {
+		    strncpy(yylval.str,&yytext[1],len);
+		  }
+		  yylval.str[len] = '\0';
+		  return( STRING );
+		}
+{variable}	{
+		 int    len,type;
+
+                 if (yytext[0] == '$') {
+		    len = strlen(yytext) - 2;
+		    strncpy(yylval.str,&yytext[1],len);
+		    yylval.str[len] = '\0';
+		    yytext = yylval.str;
+		 } 
+		 type = yyGetVariable(yytext, &yylval);
+		 return( type );
+		}
+{function}	{
+                  char *fname;
+		  int len=0;
+                  fname = &yylval.str[0];
+		  while( (fname[len]=toupper(yytext[len])) ) len++;
+
+                  if(      FSTRCMP(fname,"BOX(")==0 
+                        || FSTRCMP(fname,"CIRCLE(")==0 
+                        || FSTRCMP(fname,"ELLIPSE(")==0 
+                        || FSTRCMP(fname,"NEAR(")==0 
+                        || FSTRCMP(fname,"ISNULL(")==0 
+                         )
+                     /* Return type is always boolean  */
+		     return( BFUNCTION );
+
+                  else if( FSTRCMP(fname,"GTIFILTER(")==0 )
+                     return( GTIFILTER );
+
+                  else if( FSTRCMP(fname,"REGFILTER(")==0 )
+                     return( REGFILTER );
+
+                  else if( FSTRCMP(fname,"STRSTR(")==0 )
+                     return( IFUNCTION );  /* Returns integer */
+
+                  else 
+		     return( FUNCTION  );
+		}
+{intcast}	{ return( INTCAST ); }
+{fltcast}	{ return( FLTCAST ); }
+{power}		{ return( POWER   ); }
+{not}		{ return( NOT     ); }
+{or}		{ return( OR      ); }
+{and}		{ return( AND     ); }
+{equal}		{ return( EQ      ); }
+{not_equal}	{ return( NE      ); }
+{greater}	{ return( GT      ); }
+{lesser}	{ return( LT      ); }
+{greater_eq}	{ return( GTE     ); }
+{lesser_eq}	{ return( LTE     ); }
+{nl}		{ return( '\n'    ); }
+.		{ return( yytext[0] ); }
+%%
+
+int yywrap()
+{
+  /* MJT -- 13 June 1996
+     Supplied for compatibility with
+     pre-2.5.1 versions of flex which
+     do not recognize %option noyywrap 
+  */
+  return(1);
+}
+
+/* 
+   expr_read is lifted from old ftools.skel. 
+   Now we can use any version of flex with
+   no .skel file necessary! MJT - 13 June 1996
+
+   keep a memory of how many bytes have been
+   read previously, so that an unlimited-sized
+   buffer can be supported. PDW - 28 Feb 1998
+*/
+
+static int expr_read(char *buf, int nbytes)
+{
+ int n;
+ 
+ n = 0;
+ if( !gParse.is_eobuf ) {
+     do {
+        buf[n++] = gParse.expr[gParse.index++];
+       } while ((n<nbytes)&&(gParse.expr[gParse.index] != '\0'));
+     if( gParse.expr[gParse.index] == '\0' ) gParse.is_eobuf = 1;
+ }
+ buf[n] = '\0';
+ return(n);
+}
+
+int yyGetVariable( char *varName, YYSTYPE *thelval )
+{
+   int varNum, type;
+   char errMsg[MAXVARNAME+25];
+
+   varNum = find_variable( varName );
+   if( varNum<0 ) {
+      if( gParse.getData ) {
+	 type = (*gParse.getData)( varName, thelval );
+      } else {
+	 type = pERROR;
+	 gParse.status = PARSE_SYNTAX_ERR;
+	 strcpy (errMsg,"Unable to find data: ");
+	 strncat(errMsg, varName, MAXVARNAME);
+	 ffpmsg (errMsg);
+      }
+   } else {
+      /*  Convert variable type into expression type  */
+      switch( gParse.varData[ varNum ].type ) {
+      case LONG:
+      case DOUBLE:   type =  COLUMN;  break;
+      case BOOLEAN:  type = BCOLUMN;  break;
+      case STRING:   type = SCOLUMN;  break;
+      case BITSTR:   type =  BITCOL;  break;
+      default:
+	 type = pERROR;
+	 gParse.status = PARSE_SYNTAX_ERR;
+	 strcpy (errMsg,"Bad datatype for data: ");
+	 strncat(errMsg, varName, MAXVARNAME);
+	 ffpmsg (errMsg);
+	 break;
+      }
+      thelval->lng = varNum;
+   }
+   return( type );
+}
+
+static int find_variable(char *varName)
+{
+   int i;
+ 
+   if( gParse.nCols )
+      for( i=0; i<gParse.nCols; i++ ) {
+         if( ! strncasecmp(gParse.varData[i].name,varName,MAXVARNAME) ) {
+            return( i );
+         }
+      }
+   return( -1 );
+}
+
+#if defined(vms) || defined(__vms) || defined(WIN32) || defined(__WIN32__) || defined(macintosh)
+
+/* ================================================================== */
+/* A hack for nonunix machines, which lack strcasecmp and strncasecmp */
+/* ================================================================== */
+
+int strcasecmp(const char *s1, const char *s2)
+{
+   char c1, c2;
+
+   for (;;) {
+      c1 = toupper( *s1 );
+      c2 = toupper( *s2 );
+
+      if (c1 < c2) return(-1);
+      if (c1 > c2) return(1);
+      if (c1 == 0) return(0);
+      s1++;
+      s2++;
+   }
+}
+
+int strncasecmp(const char *s1, const char *s2, size_t n)
+{
+   char c1, c2;
+
+   for (; n-- ;) {
+      c1 = toupper( *s1 );
+      c2 = toupper( *s2 );
+
+      if (c1 < c2) return(-1);
+      if (c1 > c2) return(1);
+      if (c1 == 0) return(0);
+      s1++;
+      s2++;
+   }
+   return(0);
+}
+
+#endif

external/cfitsio/eval_defs.h

@@ -0,0 +1,163 @@
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+#if defined(__sgi) || defined(__hpux)
+#include <alloca.h>
+#endif
+#ifdef sparc
+#include <malloc.h>
+#endif
+#include "fitsio2.h"
+
+#define MAXDIMS       5
+#define MAXSUBS      10
+#define MAXVARNAME   80
+#define CONST_OP  -1000
+#define pERROR       -1
+#define MAX_STRLEN  256
+#define MAX_STRLEN_S "255"
+
+#ifndef FFBISON
+#include "eval_tab.h"
+#endif
+
+
+typedef struct {
+                  char   name[MAXVARNAME+1];
+                  int    type;
+                  long   nelem;
+                  int    naxis;
+                  long   naxes[MAXDIMS];
+                  char   *undef;
+                  void   *data;
+                                } DataInfo;
+
+typedef struct {
+                  long   nelem;
+                  int    naxis;
+                  long   naxes[MAXDIMS];
+                  char   *undef;
+                  union {
+                         double dbl;
+                         long   lng;
+                         char   log;
+                         char   str[MAX_STRLEN];
+                         double *dblptr;
+                         long   *lngptr;
+                         char   *logptr;
+                         char   **strptr;
+                         void   *ptr;
+		  } data;
+                                } lval;
+
+typedef struct Node {
+                  int    operation;
+                  void   (*DoOp)(struct Node *this);
+                  int    nSubNodes;
+                  int    SubNodes[MAXSUBS];
+                  int    type;
+                  lval   value;
+                                } Node;
+
+typedef struct {
+                  fitsfile    *def_fptr;
+                  int         (*getData)( char *dataName, void *dataValue );
+                  int         (*loadData)( int varNum, long fRow, long nRows,
+					   void *data, char *undef );
+
+                  int         compressed;
+                  int         timeCol;
+                  int         parCol;
+                  int         valCol;
+
+                  char        *expr;
+                  int         index;
+                  int         is_eobuf;
+
+                  Node        *Nodes;
+                  int         nNodes;
+                  int         nNodesAlloc;
+                  int         resultNode;
+                  
+                  long        firstRow;
+                  long        nRows;
+
+                  int         nCols;
+                  iteratorCol *colData;
+                  DataInfo    *varData;
+                  PixelFilter *pixFilter;
+
+                  long        firstDataRow;
+                  long        nDataRows;
+                  long        totalRows;
+
+                  int         datatype;
+                  int         hdutype;
+
+                  int         status;
+                                } ParseData;
+
+typedef enum {
+                  rnd_fct = 1001,
+                  sum_fct,
+                  nelem_fct,
+                  sin_fct,
+                  cos_fct,
+                  tan_fct,
+                  asin_fct,
+                  acos_fct,
+                  atan_fct,
+                  sinh_fct,
+                  cosh_fct,
+                  tanh_fct,
+                  exp_fct,
+                  log_fct,
+                  log10_fct,
+                  sqrt_fct,
+                  abs_fct,
+                  atan2_fct,
+                  ceil_fct,
+                  floor_fct,
+                  round_fct,
+		  min1_fct,
+		  min2_fct,
+		  max1_fct,
+		  max2_fct,
+                  near_fct,
+                  circle_fct,
+                  box_fct,
+                  elps_fct,
+                  isnull_fct,
+                  defnull_fct,
+                  gtifilt_fct,
+                  regfilt_fct,
+                  ifthenelse_fct,
+                  row_fct,
+                  null_fct,
+		  median_fct,
+		  average_fct,
+		  stddev_fct,
+		  nonnull_fct,
+		  angsep_fct,
+		  gasrnd_fct,
+		  poirnd_fct,
+		  strmid_fct,
+		  strpos_fct
+                                } funcOp;
+
+extern ParseData gParse;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+   int  ffparse(void);
+   int  fflex(void);
+   void ffrestart(FILE*);
+
+   void Evaluate_Parser( long firstRow, long nRows );
+
+#ifdef __cplusplus
+    }
+#endif

external/cfitsio/eval_tab.h

@@ -0,0 +1,42 @@
+typedef union {
+    int    Node;        /* Index of Node */
+    double dbl;         /* real value    */
+    long   lng;         /* integer value */
+    char   log;         /* logical value */
+    char   str[MAX_STRLEN];    /* string value  */
+} FFSTYPE;
+#define	BOOLEAN	258
+#define	LONG	259
+#define	DOUBLE	260
+#define	STRING	261
+#define	BITSTR	262
+#define	FUNCTION	263
+#define	BFUNCTION	264
+#define	IFUNCTION	265
+#define	GTIFILTER	266
+#define	REGFILTER	267
+#define	COLUMN	268
+#define	BCOLUMN	269
+#define	SCOLUMN	270
+#define	BITCOL	271
+#define	ROWREF	272
+#define	NULLREF	273
+#define	SNULLREF	274
+#define	OR	275
+#define	AND	276
+#define	EQ	277
+#define	NE	278
+#define	GT	279
+#define	LT	280
+#define	LTE	281
+#define	GTE	282
+#define	POWER	283
+#define	NOT	284
+#define	INTCAST	285
+#define	FLTCAST	286
+#define	UMINUS	287
+#define	ACCUM	288
+#define	DIFF	289
+
+
+extern FFSTYPE fflval;

external/cfitsio/f77.inc

@@ -0,0 +1,31 @@
+C     Codes for FITS extension types
+      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
+      parameter (
+     &     IMAGE_HDU  = 0,
+     &     ASCII_TBL  = 1,
+     &     BINARY_TBL = 2  )
+
+C     Codes for FITS table data types
+
+      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
+      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
+      parameter (
+     &     TBIT        =   1,
+     &     TBYTE       =  11,
+     &     TLOGICAL    =  14,
+     &     TSTRING     =  16,
+     &     TSHORT      =  21,
+     &     TINT        =  31,
+     &     TFLOAT      =  42,
+     &     TDOUBLE     =  82,
+     &     TCOMPLEX    =  83,
+     &     TDBLCOMPLEX = 163  )
+
+C     Codes for iterator column types
+
+      integer InputCol, InputOutputCol, OutputCol
+      parameter (
+     &     InputCol       = 0,
+     &     InputOutputCol = 1,
+     &     OutputCol      = 2  )
+

external/cfitsio/f77_wrap.h

@@ -0,0 +1,288 @@
+#define UNSIGNED_BYTE
+
+#include "cfortran.h"
+
+/************************************************************************
+   Some platforms creates longs as 8-byte integers.  On other machines, ints
+   and longs are both 4-bytes, so both are compatible with Fortrans
+   default integer which is 4-bytes.  To support 8-byte longs, we must redefine
+   LONGs and convert them to 8-bytes when going to C, and restore them
+   to 4-bytes when returning to Fortran.  Ugh!!!
+*************************************************************************/
+
+#if defined(DECFortran) || (defined(__alpha) && defined(g77Fortran)) \
+    || (defined(mipsFortran)  && _MIPS_SZLONG==64) \
+    || (defined(IBMR2Fortran) && defined(__64BIT__)) \
+    ||  defined(__ia64__)  \
+    ||  defined (__sparcv9) || (defined(__sparc__) && defined(__arch64__)) \
+    ||  defined (__x86_64__) \
+    ||  defined (_SX) \
+    ||  defined (__powerpc64__)\
+    ||  defined (__s390x__)
+
+#define   LONG8BYTES_INT4BYTES
+
+#undef LONGV_cfSTR
+#undef PLONG_cfSTR
+#undef LONGVVVVVVV_cfTYPE
+#undef PLONG_cfTYPE
+#undef LONGV_cfT
+#undef PLONG_cfT
+
+#define    LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LONGV,A,B,C,D,E)
+#define    PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLONG,A,B,C,D,E)
+#define    LONGVVVVVVV_cfTYPE    int
+#define    PLONG_cfTYPE          int
+#define    LONGV_cfQ(B)          long *B, _(B,N);
+#define    PLONG_cfQ(B)          long B;
+#define    LONGV_cfT(M,I,A,B,D)  ( (_(B,N) = * _3(M,_LONGV_A,I)), \
+				    B = F2Clongv(_(B,N),A) )
+#define    PLONG_cfT(M,I,A,B,D)  ((B=*A),&B)
+#define    LONGV_cfR(A,B,D)      C2Flongv(_(B,N),A,B);
+#define    PLONG_cfR(A,B,D)      *A=B;
+#define    LONGV_cfH(S,U,B)
+#define    PLONG_cfH(S,U,B)
+
+static long *F2Clongv(long size, int *A)
+{
+  long i;
+  long *B;
+
+  B=(long *)malloc( size*sizeof(long) );
+  for(i=0;i<size;i++) B[i]=A[i];
+  return(B);
+}
+
+static void C2Flongv(long size, int *A, long *B)
+{
+  long i;
+
+  for(i=0;i<size;i++) A[i]=B[i];
+  free(B);
+}
+
+#endif
+
+/************************************************************************
+   Modify cfortran.h's handling of strings.  C interprets a "char **"
+   parameter as an array of pointers to the strings (or as a handle),
+   not as a pointer to a block of contiguous strings.  Also set a
+   a minimum length for string allocations, to minimize risk of
+   overflow.
+*************************************************************************/
+
+extern unsigned long gMinStrLen;
+
+#undef  STRINGV_cfQ
+#undef  STRINGV_cfR
+#undef  TTSTR
+#undef  TTTTSTRV
+#undef  RRRRPSTRV
+
+#undef  PPSTRING_cfT
+
+#ifdef vmsFortran
+#define       PPSTRING_cfT(M,I,A,B,D)     (unsigned char*)A->dsc$a_pointer
+
+/*  We want single strings to be equivalent to string vectors with  */
+/*  a single element, so ignore the number of elements info in the  */
+/*  vector structure, and rely on the NUM_ELEM definitions.         */
+
+#undef  STRINGV_cfT
+#define STRINGV_cfT(M,I,A,B,D)  TTTTSTRV(A->dsc$a_pointer, B, \
+                                         A->dsc$w_length, \
+                                         num_elem(A->dsc$a_pointer, \
+                                                  A->dsc$w_length, \
+                                                  _3(M,_STRV_A,I) ) )
+#else
+#ifdef CRAYFortran
+#define       PPSTRING_cfT(M,I,A,B,D)     (unsigned char*)_fcdtocp(A)
+#else
+#define       PPSTRING_cfT(M,I,A,B,D)     (unsigned char*)A
+#endif
+#endif
+
+#define _cfMAX(A,B)  ( (A>B) ? A : B )
+#define  STRINGV_cfQ(B)      char **B; unsigned int _(B,N), _(B,M);
+#define  STRINGV_cfR(A,B,D)  free(B[0]); free(B);
+#define  TTSTR(    A,B,D)  \
+            ((B=(char*)malloc(_cfMAX(D,gMinStrLen)+1))[D]='\0',memcpy(B,A,D), \
+               kill_trailing(B,' '))
+#define  TTTTSTRV( A,B,D,E)  ( \
+            _(B,N)=_cfMAX(E,1), \
+            _(B,M)=_cfMAX(D,gMinStrLen)+1, \
+            B=(char**)malloc(_(B,N)*sizeof(char*)), \
+            B[0]=(char*)malloc(_(B,N)*_(B,M)), \
+            vindex(B,_(B,M),_(B,N),f2cstrv2(A,B[0],D,_(B,M),_(B,N))) \
+            )
+#define  RRRRPSTRV(A,B,D)    \
+            c2fstrv2(B[0],A,_(B,M),D,_(B,N)), \
+            free(B[0]), \
+            free(B);
+
+static char **vindex(char **B, int elem_len, int nelem, char *B0)
+{
+   int i;
+   if( nelem )
+      for( i=0;i<nelem;i++ ) B[i] = B0+i*elem_len;
+   return B;
+}
+
+static char *c2fstrv2(char* cstr, char *fstr, int celem_len, int felem_len,
+               int nelem)
+{
+   int i,j;
+
+   if( nelem )
+      for (i=0; i<nelem; i++) {
+	 for (j=0; j<felem_len && *cstr; j++) *fstr++ = *cstr++;
+	 cstr += celem_len-j;
+	 for (; j<felem_len; j++) *fstr++ = ' ';
+      }
+   return( fstr-felem_len*nelem );
+}
+
+static char *f2cstrv2(char *fstr, char* cstr, int felem_len, int celem_len,
+               int nelem)
+{
+   int i,j;
+
+   if( nelem )
+      for (i=0; i<nelem; i++, cstr+=(celem_len-felem_len)) {
+	 for (j=0; j<felem_len; j++) *cstr++ = *fstr++;
+	 *cstr='\0';
+	 kill_trailingn( cstr-felem_len, ' ', cstr );
+      }
+   return( cstr-celem_len*nelem );
+}
+
+/************************************************************************
+   The following definitions redefine the BYTE data type to be
+   interpretted as a character*1 string instead of an integer*1 which
+   is not supported by all compilers.
+*************************************************************************/
+
+#undef   BYTE_cfT
+#undef   BYTEV_cfT
+#undef   BYTE_cfINT
+#undef   BYTEV_cfINT
+#undef   BYTE_cfSTR
+#undef   BYTEV_cfSTR
+
+#define   BYTE_cfINT(N,A,B,X,Y,Z)      _(CFARGS,N)(A,BYTE,B,X,Y,Z,0)
+#define   BYTEV_cfINT(N,A,B,X,Y,Z)     _(CFARGS,N)(A,BYTEV,B,X,Y,Z,0)
+#define   BYTE_cfSTR(N,T,A,B,C,D,E)    _(CFARGS,N)(T,BYTE,A,B,C,D,E)
+#define   BYTEV_cfSTR(N,T,A,B,C,D,E)   _(CFARGS,N)(T,BYTEV,A,B,C,D,E)
+#define   BYTE_cfSEP(T,B)              INT_cfSEP(T,B)
+#define   BYTEV_cfSEP(T,B)             INT_cfSEP(T,B)
+#define   BYTE_cfH(S,U,B)              STRING_cfH(S,U,B)
+#define   BYTEV_cfH(S,U,B)             STRING_cfH(S,U,B)
+#define   BYTE_cfQ(B)
+#define   BYTEV_cfQ(B)
+#define   BYTE_cfR(A,B,D)
+#define   BYTEV_cfR(A,B,D)
+
+#ifdef vmsFortran
+#define   BYTE_cfN(T,A)           fstring * A
+#define   BYTEV_cfN(T,A)          fstringvector * A
+#define   BYTE_cfT(M,I,A,B,D)     (INTEGER_BYTE)((A->dsc$a_pointer)[0])
+#define   BYTEV_cfT(M,I,A,B,D)    (INTEGER_BYTE*)A->dsc$a_pointer
+#else
+#ifdef CRAYFortran
+#define   BYTE_cfN(T,A)           _fcd A
+#define   BYTEV_cfN(T,A)          _fcd A
+#define   BYTE_cfT(M,I,A,B,D)     (INTEGER_BYTE)((_fcdtocp(A))[0])
+#define   BYTEV_cfT(M,I,A,B,D)    (INTEGER_BYTE*)_fcdtocp(A)
+#else
+#define   BYTE_cfN(T,A)           INTEGER_BYTE * A
+#define   BYTEV_cfN(T,A)          INTEGER_BYTE * A
+#define   BYTE_cfT(M,I,A,B,D)     A[0]
+#define   BYTEV_cfT(M,I,A,B,D)    A
+#endif
+#endif
+
+/************************************************************************
+   The following definitions and functions handle conversions between
+   C and Fortran arrays of LOGICALS.  Individually, LOGICALS are
+   treated as int's but as char's when in an array.  cfortran defines
+   (F2C/C2F)LOGICALV but never uses them, so these routines also
+   handle TRUE/FALSE conversions.
+*************************************************************************/
+
+#undef  LOGICALV_cfSTR
+#undef  LOGICALV_cfT
+#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICALV,A,B,C,D,E)
+#define LOGICALV_cfQ(B)               char *B; unsigned int _(B,N);
+#define LOGICALV_cfT(M,I,A,B,D)       (_(B,N)= * _3(M,_LOGV_A,I), \
+                                            B=F2CcopyLogVect(_(B,N),A))
+#define LOGICALV_cfR(A,B,D)           C2FcopyLogVect(_(B,N),A,B);
+#define LOGICALV_cfH(S,U,B)
+
+static char *F2CcopyLogVect(long size, int *A)
+{
+   long i;
+   char *B;
+
+   B=(char *)malloc(size*sizeof(char));
+   for( i=0; i<size; i++ ) B[i]=F2CLOGICAL(A[i]);
+   return(B);
+}
+
+static void C2FcopyLogVect(long size, int *A, char *B)
+{
+   long i;
+
+   for( i=0; i<size; i++ ) A[i]=C2FLOGICAL(B[i]);
+   free(B);
+}
+
+/*------------------  Fortran File Handling  ----------------------*/
+/*  Fortran uses unit numbers, whereas C uses file pointers, so    */
+/*  a global array of file pointers is setup in which Fortran's    */
+/*  unit number serves as the index.  Two FITSIO routines are      */
+/*  the integer unit number and the fitsfile file pointer.         */
+/*-----------------------------------------------------------------*/
+
+#define MAXFITSFILES 200             /*  Array of file pointers indexed  */
+extern fitsfile *gFitsFiles[];       /*    by Fortran unit numbers       */
+
+#define  FITSUNIT_cfINT(N,A,B,X,Y,Z)   INT_cfINT(N,A,B,X,Y,Z)
+#define  FITSUNIT_cfSTR(N,T,A,B,C,D,E) INT_cfSTR(N,T,A,B,C,D,E)
+#define  FITSUNIT_cfT(M,I,A,B,D)       gFitsFiles[*A]
+#define  FITSUNITVVVVVVV_cfTYPE        int
+#define PFITSUNIT_cfINT(N,A,B,X,Y,Z)   PINT_cfINT(N,A,B,X,Y,Z)
+#define PFITSUNIT_cfSTR(N,T,A,B,C,D,E) PINT_cfSTR(N,T,A,B,C,D,E)
+#define PFITSUNIT_cfT(M,I,A,B,D)       (gFitsFiles + *A)
+#define PFITSUNIT_cfTYPE               int
+
+
+/*---------------------- Make C++ Happy -----------------------------*/
+/* Redefine FCALLSCFUNn so that they create prototypes of themselves */
+/*   and change TTTTSTR to use (char *)0 instead of NULL             */
+/*-------------------------------------------------------------------*/
+
+#undef FCALLSCFUN0
+#undef FCALLSCFUN14
+#undef TTTTSTR
+
+#define TTTTSTR(A,B,D)   ( !(D<4||A[0]||A[1]||A[2]||A[3]) ) ? ((char*)0) :     \
+                             memchr(A,'\0',D) ? A : TTSTR(A,B,D)
+
+#define FCALLSCFUN0(T0,CN,UN,LN) \
+  CFextern _(T0,_cfFZ)(UN,LN) void ABSOFT_cf2(T0)); \
+  CFextern _(T0,_cfFZ)(UN,LN) void ABSOFT_cf2(T0))  \
+  {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)}
+
+#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)    \
+  CFextern _(T0,_cfF)(UN,LN)                                                   \
+  CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
+  CFextern _(T0,_cfF)(UN,LN)                                                   \
+  CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE))  \
+  {                 CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)   \
+  _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0)      CN(  TCF(LN,T1,1,0) TCF(LN,T2,2,1) \
+    TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \
+    TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \
+    TCF(LN,TD,13,1) TCF(LN,TE,14,1) );                          _Icf(0,K,T0,0,0) \
+    CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)        _(T0,_cfI) \
+  }
+

external/cfitsio/f77_wrap1.c

@@ -0,0 +1,345 @@
+/************************************************************************
+
+     f77_wrap1.c and f77_wrap2.c have now been split into 4 files to
+     prevent compile-time memory errors (from expansion of compiler commands).
+     f77_wrap1.c was split into f77_wrap1.c and f77_wrap3.c, and
+     f77_wrap2.c was split into f77_wrap2.c and f77_wrap4.c:
+       
+       f77_wrap1.c contains routines operating on whole files and some 
+       utility routines.
+     
+       f77_wrap2.c contains routines operating on primary array, image, 
+       or column elements.
+
+       f77_wrap3.c contains routines operating on headers & keywords.
+
+       f77_wrap4.c contains miscellaneous routines.
+
+     Peter's original comments:
+
+     Together, f77_wrap1.c and f77_wrap2.c contain C wrappers for all
+     the CFITSIO routines prototyped in fitsio.h, except for the
+     generic datatype routines and features not supported in fortran
+     (eg, unsigned integers), a few routines prototyped in fitsio2.h,
+     which only a handful of FTOOLS use, plus a few obsolete FITSIO
+     routines not present in CFITSIO.  This file allows Fortran code
+     to use the CFITSIO library instead of the FITSIO library without
+     modification.  It also gives access to new routines not present
+     in FITSIO.  Fortran FTOOLS must continue using the old routine
+     names from FITSIO (ie, ftxxxx), but most of the C-wrappers simply
+     redirect those calls to the corresponding CFITSIO routines (ie,
+     ffxxxx), with appropriate parameter massaging where necessary.
+     The main exception are read/write routines ending in j (ie, long
+     data) which get redirected to C routines ending in k (ie, int
+     data). This is more consistent with the default integer type in
+     Fortran. f77_wrap1.c primarily holds routines operating on whole
+     files and extension headers.  f77_wrap2.c handle routines which
+     read and write the data portion, plus miscellaneous extra routines.
+     
+        File created by Peter Wilson (HSTX), Oct-Dec. 1997
+************************************************************************/
+
+#include "fitsio2.h"
+#include "f77_wrap.h"
+
+unsigned long gMinStrLen=80L;
+fitsfile *gFitsFiles[MAXFITSFILES]={0};
+
+/*----------------  Fortran Unit Number Allocation -------------*/
+
+void Cffgiou( int *unit, int *status );
+void Cffgiou( int *unit, int *status )
+{
+   int i;
+
+   if( *status>0 ) return;
+   for( i=50;i<MAXFITSFILES;i++ ) /* Using a unit=0 sounds bad, so start at 1 */
+      if( gFitsFiles[i]==NULL ) break;
+   if( i==MAXFITSFILES ) {
+      *unit = 0;
+      *status = TOO_MANY_FILES;
+      ffpmsg("Cffgiou has no more available unit numbers.");
+   } else {
+      *unit=i;
+      gFitsFiles[i] = (fitsfile *)1; /*  Flag it as taken until ftopen/init  */
+                                     /*  can be called and set a real value  */
+   }
+}
+FCALLSCSUB2(Cffgiou,FTGIOU,ftgiou,PINT,PINT)
+
+void Cfffiou( int unit, int *status );
+void Cfffiou( int unit, int *status )
+{
+   if( *status>0 ) return;
+   if( unit == -1 ) {
+      int i; for( i=50; i<MAXFITSFILES; ) gFitsFiles[i++]=NULL;
+   } else if( unit<1 || unit>=MAXFITSFILES ) {
+      *status = BAD_FILEPTR;
+      ffpmsg("Cfffiou was sent an unacceptable unit number.");
+   } else gFitsFiles[unit]=NULL;
+}
+FCALLSCSUB2(Cfffiou,FTFIOU,ftfiou,INT,PINT)
+
+
+int CFITS2Unit( fitsfile *fptr )
+     /* Utility routine to convert a fitspointer to a Fortran unit number */
+     /* for use when a C program is calling a Fortran routine which could */
+     /* in turn call CFITSIO... Modelled after code by Ning Gan.          */
+{
+   static fitsfile *last_fptr = (fitsfile *)NULL; /* Remember last fptr */
+   static int last_unit = 0;                      /* Remember last unit */
+   int status = 0;
+
+   /*  Test whether we are repeating the last lookup  */
+
+   if( last_unit && fptr==gFitsFiles[last_unit] )
+      return( last_unit );
+
+   /*  Check if gFitsFiles has an entry for this fptr.  */
+   /*  Allows Fortran to call C to call Fortran to      */
+   /*  call CFITSIO... OUCH!!!                          */
+
+   last_fptr = fptr;
+   for( last_unit=1; last_unit<MAXFITSFILES; last_unit++ ) {
+      if( fptr == gFitsFiles[last_unit] )
+	 return( last_unit );
+   }
+
+   /*  Allocate a new unit number for this fptr  */
+   Cffgiou( &last_unit, &status );
+   if( status )
+      last_unit = 0;
+   else
+      gFitsFiles[last_unit] = fptr;
+   return( last_unit );
+}
+
+
+fitsfile* CUnit2FITS(int unit)
+{
+    if( unit<1 || unit>=MAXFITSFILES )
+        return(0);
+	
+    return(gFitsFiles[unit]);
+}
+
+     /**************************************************/
+     /*   Start of wrappers for routines in fitsio.h   */
+     /**************************************************/
+
+/*----------------  FITS file URL parsing routines -------------*/
+
+FCALLSCSUB9(ffiurl,FTIURL,ftiurl,STRING,PSTRING,PSTRING,PSTRING,PSTRING,PSTRING,PSTRING,PSTRING,PINT)
+FCALLSCSUB3(ffrtnm,FTRTNM,ftrtnm,STRING,PSTRING,PINT)
+FCALLSCSUB3(ffexist,FTEXIST,ftexist,STRING,PINT,PINT)
+FCALLSCSUB3(ffextn,FTEXTN,ftextn,STRING,PINT,PINT)
+FCALLSCSUB7(ffrwrg,FTRWRG,ftrwrg,STRING,LONG,INT,PINT,PLONG,PLONG,PINT)
+
+/*---------------- FITS file I/O routines ---------------*/
+
+void Cffopen( fitsfile **fptr, const char *filename, int iomode, int *blocksize, int *status );
+void Cffopen( fitsfile **fptr, const char *filename, int iomode, int *blocksize, int *status )
+{
+   int hdutype;
+
+   if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
+      ffopen( fptr, filename, iomode, status );
+      ffmahd( *fptr, 1, &hdutype, status );
+      *blocksize = 1;
+   } else {
+      *status = FILE_NOT_OPENED;
+      ffpmsg("Cffopen tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB5(Cffopen,FTOPEN,ftopen,PFITSUNIT,STRING,INT,PINT,PINT)
+
+void Cffdkopn( fitsfile **fptr, const char *filename, int iomode, int *blocksize, int *status );
+void Cffdkopn( fitsfile **fptr, const char *filename, int iomode, int *blocksize, int *status )
+{
+   int hdutype;
+
+   if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
+      ffdkopn( fptr, filename, iomode, status );
+      ffmahd( *fptr, 1, &hdutype, status );
+      *blocksize = 1;
+   } else {
+      *status = FILE_NOT_OPENED;
+      ffpmsg("Cffdkopn tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB5(Cffdkopn,FTDKOPN,ftdkopn,PFITSUNIT,STRING,INT,PINT,PINT)
+
+
+void Cffnopn( fitsfile **fptr, const char *filename, int iomode, int *status );
+void Cffnopn( fitsfile **fptr, const char *filename, int iomode, int *status )
+{
+   if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
+      ffopen( fptr, filename, iomode, status );
+   } else {
+      *status = FILE_NOT_OPENED;
+      ffpmsg("Cffnopn tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB4(Cffnopn,FTNOPN,ftnopn,PFITSUNIT,STRING,INT,PINT)
+
+void Cffdopn( fitsfile **fptr, const char *filename, int iomode, int *status );
+void Cffdopn( fitsfile **fptr, const char *filename, int iomode, int *status )
+{
+   if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
+      ffdopn( fptr, filename, iomode, status );
+   } else {
+      *status = FILE_NOT_OPENED;
+      ffpmsg("Cffdopn tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB4(Cffdopn,FTDOPN,ftdopn,PFITSUNIT,STRING,INT,PINT)
+
+void Cfftopn( fitsfile **fptr, const char *filename, int iomode, int *status );
+void Cfftopn( fitsfile **fptr, const char *filename, int iomode, int *status )
+{
+   if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
+      fftopn( fptr, filename, iomode, status );
+   } else {
+      *status = FILE_NOT_OPENED;
+      ffpmsg("Cfftopn tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB4(Cfftopn,FTTOPN,fttopn,PFITSUNIT,STRING,INT,PINT)
+
+void Cffiopn( fitsfile **fptr, const char *filename, int iomode, int *status );
+void Cffiopn( fitsfile **fptr, const char *filename, int iomode, int *status )
+{
+   if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
+      ffiopn( fptr, filename, iomode, status );
+   } else {
+      *status = FILE_NOT_OPENED;
+      ffpmsg("Cffiopn tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB4(Cffiopn,FTIOPN,ftiopn,PFITSUNIT,STRING,INT,PINT)
+
+void Cffreopen( fitsfile *openfptr, fitsfile **newfptr, int *status );
+void Cffreopen( fitsfile *openfptr, fitsfile **newfptr, int *status )
+{
+   if( *newfptr==NULL || *newfptr==(fitsfile*)1 ) {
+      ffreopen( openfptr, newfptr, status );
+   } else {
+      *status = FILE_NOT_OPENED;
+      ffpmsg("Cffreopen tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB3(Cffreopen,FTREOPEN,ftreopen,FITSUNIT,PFITSUNIT,PINT)
+
+void Cffinit( fitsfile **fptr, const char *filename, int blocksize, int *status );
+void Cffinit( fitsfile **fptr, const char *filename, int blocksize, int *status )
+{
+   if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
+      ffinit( fptr, filename, status );
+   } else {
+      *status = FILE_NOT_CREATED;
+      ffpmsg("Cffinit tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB4(Cffinit,FTINIT,ftinit,PFITSUNIT,STRING,INT,PINT)
+
+void Cffdkinit( fitsfile **fptr, const char *filename, int blocksize, int *status );
+void Cffdkinit( fitsfile **fptr, const char *filename, int blocksize, int *status )
+{
+   if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
+      ffdkinit( fptr, filename, status );
+   } else {
+      *status = FILE_NOT_CREATED;
+      ffpmsg("Cffdkinit tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB4(Cffdkinit,FTDKINIT,ftdkinit,PFITSUNIT,STRING,INT,PINT)
+
+void Cfftplt( fitsfile **fptr, const char *filename, const char *tempname,
+	      int *status );
+void Cfftplt( fitsfile **fptr, const char *filename, const char *tempname, 
+	      int *status )
+{
+   if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
+      fftplt( fptr, filename, tempname, status );
+   } else {
+      *status = FILE_NOT_CREATED;
+      ffpmsg("Cfftplt tried to use an already opened unit.");
+   }
+}
+FCALLSCSUB4(Cfftplt,FTTPLT,fttplt,PFITSUNIT,STRING,STRING,PINT)
+
+FCALLSCSUB2(ffflus,FTFLUS,ftflus,FITSUNIT,PINT)
+FCALLSCSUB3(ffflsh,FTFLSH,ftflsh,FITSUNIT, INT, PINT)
+
+void Cffclos( int unit, int *status );
+void Cffclos( int unit, int *status )
+{
+   if( gFitsFiles[unit]!=NULL && gFitsFiles[unit]!=(void*)1 ) {
+      ffclos( gFitsFiles[unit], status );  /* Flag unit number as unavailable */
+      gFitsFiles[unit]=(fitsfile*)1;       /* in case want to reuse it        */
+   }
+}
+FCALLSCSUB2(Cffclos,FTCLOS,ftclos,INT,PINT)
+
+void Cffdelt( int unit, int *status );
+void Cffdelt( int unit, int *status )
+{
+   if( gFitsFiles[unit]!=NULL && gFitsFiles[unit]!=(void*)1 ) {
+      ffdelt( gFitsFiles[unit], status );  /* Flag unit number as unavailable */
+      gFitsFiles[unit]=(fitsfile*)1;       /* in case want to reuse it        */
+   }
+}
+FCALLSCSUB2(Cffdelt,FTDELT,ftdelt,INT,PINT)
+
+FCALLSCSUB3(ffflnm,FTFLNM,ftflnm,FITSUNIT,PSTRING,PINT)
+FCALLSCSUB3(ffflmd,FTFLMD,ftflmd,FITSUNIT,PINT,PINT)
+
+/*--------------- utility routines ---------------*/
+FCALLSCSUB1(ffvers,FTVERS,ftvers,PFLOAT)
+FCALLSCSUB1(ffupch,FTUPCH,ftupch,PSTRING)
+FCALLSCSUB2(ffgerr,FTGERR,ftgerr,INT,PSTRING)
+FCALLSCSUB1(ffpmsg,FTPMSG,ftpmsg,STRING)
+FCALLSCSUB1(ffgmsg,FTGMSG,ftgmsg,PSTRING)
+FCALLSCSUB0(ffcmsg,FTCMSG,ftcmsg)
+FCALLSCSUB0(ffpmrk,FTPMRK,ftpmrk)
+FCALLSCSUB0(ffcmrk,FTCMRK,ftcmrk)
+
+void Cffrprt( char *fname, int status );
+void Cffrprt( char *fname, int status )
+{
+   if( !strcmp(fname,"STDOUT") || !strcmp(fname,"stdout") )
+      ffrprt( stdout, status );
+   else if( !strcmp(fname,"STDERR") || !strcmp(fname,"stderr") )
+      ffrprt( stderr, status );
+   else {
+      FILE *fptr;
+
+      fptr = fopen(fname, "a");
+      if (fptr==NULL)
+	 printf("file pointer is null.\n");
+      else {
+	 ffrprt(fptr,status);
+	 fclose(fptr);
+      }
+   }
+}
+FCALLSCSUB2(Cffrprt,FTRPRT,ftrprt,STRING,INT)
+
+FCALLSCSUB5(ffcmps,FTCMPS,ftcmps,STRING,STRING,LOGICAL,PLOGICAL,PLOGICAL)
+FCALLSCSUB2(fftkey,FTTKEY,fttkey,STRING,PINT)
+FCALLSCSUB2(fftrec,FTTREC,fttrec,STRING,PINT)
+FCALLSCSUB2(ffnchk,FTNCHK,ftnchk,FITSUNIT,PINT)
+FCALLSCSUB4(ffkeyn,FTKEYN,ftkeyn,STRING,INT,PSTRING,PINT)
+FCALLSCSUB4(ffgknm,FTGKNM,ftgknm,STRING,PSTRING, PINT, PINT)
+FCALLSCSUB4(ffnkey,FTNKEY,ftnkey,INT,STRING,PSTRING,PINT)
+FCALLSCSUB3(ffdtyp,FTDTYP,ftdtyp,STRING,PSTRING,PINT)
+FCALLSCFUN1(INT,ffgkcl,FTGKCL,ftgkcl,STRING)
+FCALLSCSUB4(ffpsvc,FTPSVC,ftpsvc,STRING,PSTRING,PSTRING,PINT)
+FCALLSCSUB4(ffgthd,FTGTHD,ftgthd,STRING,PSTRING,PINT,PINT)
+FCALLSCSUB5(ffasfm,FTASFM,ftasfm,STRING,PINT,PLONG,PINT,PINT)
+FCALLSCSUB5(ffbnfm,FTBNFM,ftbnfm,STRING,PINT,PLONG,PLONG,PINT)
+
+#define ftgabc_STRV_A2 NUM_ELEM_ARG(1)
+#define ftgabc_LONGV_A5 A1
+FCALLSCSUB6(ffgabc,FTGABC,ftgabc,INT,STRINGV,INT,PLONG,LONGV,PINT)
+

external/cfitsio/f77_wrap2.c

@@ -0,0 +1,711 @@
+/************************************************************************
+
+     f77_wrap1.c and f77_wrap2.c have now been split into 4 files to
+     prevent compile-time memory errors (from expansion of compiler commands).
+     f77_wrap1.c was split into f77_wrap1.c and f77_wrap3.c, and
+     f77_wrap2.c was split into f77_wrap2.c and f77_wrap4.c:
+       
+       f77_wrap1.c contains routines operating on whole files and some 
+       utility routines.
+     
+       f77_wrap2.c contains routines operating on primary array, image, 
+       or column elements.
+
+       f77_wrap3.c contains routines operating on headers & keywords.
+
+       f77_wrap4.c contains miscellaneous routines.
+
+     Peter's original comments:
+
+     Together, f77_wrap1.c and f77_wrap2.c contain C wrappers for all
+     the CFITSIO routines prototyped in fitsio.h, except for the
+     generic datatype routines and features not supported in fortran
+     (eg, unsigned integers), a few routines prototyped in fitsio2.h,
+     which only a handful of FTOOLS use, plus a few obsolete FITSIO
+     routines not present in CFITSIO.  This file allows Fortran code
+     to use the CFITSIO library instead of the FITSIO library without
+     modification.  It also gives access to new routines not present
+     in FITSIO.  Fortran FTOOLS must continue using the old routine
+     names from FITSIO (ie, ftxxxx), but most of the C-wrappers simply
+     redirect those calls to the corresponding CFITSIO routines (ie,
+     ffxxxx), with appropriate parameter massaging where necessary.
+     The main exception are read/write routines ending in j (ie, long
+     data) which get redirected to C routines ending in k (ie, int
+     data). This is more consistent with the default integer type in
+     Fortran. f77_wrap1.c primarily holds routines operating on whole
+     files and extension headers.  f77_wrap2.c handle routines which
+     read and write the data portion, plus miscellaneous extra routines.
+     
+        File created by Peter Wilson (HSTX), Oct-Dec. 1997
+************************************************************************/
+
+#include "fitsio2.h"
+#include "f77_wrap.h"
+
+
+FCALLSCSUB5(ffgextn,FTGEXTN,ftgextn,FITSUNIT,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB5(ffpextn,FTPEXTN,ftpextn,FITSUNIT,LONG,LONG,BYTEV,PINT)
+
+/*------------ read primary array or image elements -------------*/
+FCALLSCSUB8(ffgpvb,FTGPVB,ftgpvb,FITSUNIT,LONG,LONG,LONG,BYTE,BYTEV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpvi,FTGPVI,ftgpvi,FITSUNIT,LONG,LONG,LONG,SHORT,SHORTV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpvk,FTGPVJ,ftgpvj,FITSUNIT,LONG,LONG,LONG,INT,INTV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpvjj,FTGPVK,ftgpvk,FITSUNIT,LONG,LONG,LONG,LONGLONG,LONGLONGV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpve,FTGPVE,ftgpve,FITSUNIT,LONG,LONG,LONG,FLOAT,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpvd,FTGPVD,ftgpvd,FITSUNIT,LONG,LONG,LONG,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+
+
+#define ftgpfb_LOGV_A6 A4
+FCALLSCSUB8(ffgpfb,FTGPFB,ftgpfb,FITSUNIT,LONG,LONG,LONG,BYTEV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfi_LOGV_A6 A4
+FCALLSCSUB8(ffgpfi,FTGPFI,ftgpfi,FITSUNIT,LONG,LONG,LONG,SHORTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfj_LOGV_A6 A4
+FCALLSCSUB8(ffgpfk,FTGPFJ,ftgpfj,FITSUNIT,LONG,LONG,LONG,INTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfk_LOGV_A6 A4
+FCALLSCSUB8(ffgpfjj,FTGPFK,ftgpfk,FITSUNIT,LONG,LONG,LONG,LONGLONGV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfe_LOGV_A6 A4
+FCALLSCSUB8(ffgpfe,FTGPFE,ftgpfe,FITSUNIT,LONG,LONG,LONG,FLOATV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfd_LOGV_A6 A4
+FCALLSCSUB8(ffgpfd,FTGPFD,ftgpfd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,LOGICALV,PLOGICAL,PINT)
+
+FCALLSCSUB9(ffg2db,FTG2DB,ftg2db,FITSUNIT,LONG,BYTE,LONG,LONG,LONG,BYTEV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2di,FTG2DI,ftg2di,FITSUNIT,LONG,SHORT,LONG,LONG,LONG,SHORTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2dk,FTG2DJ,ftg2dj,FITSUNIT,LONG,INT,LONG,LONG,LONG,INTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2djj,FTG2DK,ftg2dk,FITSUNIT,LONG,LONGLONG,LONG,LONG,LONG,LONGLONGV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2de,FTG2DE,ftg2de,FITSUNIT,LONG,FLOAT,LONG,LONG,LONG,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2dd,FTG2DD,ftg2dd,FITSUNIT,LONG,DOUBLE,LONG,LONG,LONG,DOUBLEV,PLOGICAL,PINT)
+
+FCALLSCSUB11(ffg3db,FTG3DB,ftg3db,FITSUNIT,LONG,BYTE,LONG,LONG,LONG,LONG,LONG,BYTEV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3di,FTG3DI,ftg3di,FITSUNIT,LONG,SHORT,LONG,LONG,LONG,LONG,LONG,SHORTV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3dk,FTG3DJ,ftg3dj,FITSUNIT,LONG,INT,LONG,LONG,LONG,LONG,LONG,INTV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3djj,FTG3DK,ftg3dk,FITSUNIT,LONG,LONGLONG,LONG,LONG,LONG,LONG,LONG,LONGLONGV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3de,FTG3DE,ftg3de,FITSUNIT,LONG,FLOAT,LONG,LONG,LONG,LONG,LONG,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3dd,FTG3DD,ftg3dd,FITSUNIT,LONG,DOUBLE,LONG,LONG,LONG,LONG,LONG,DOUBLEV,PLOGICAL,PINT)
+
+     /*  The follow LONGV definitions have +1 appended because the   */
+     /*  routines use of NAXIS+1 elements of the long vectors.       */
+
+#define ftgsvb_LONGV_A4 A3+1
+#define ftgsvb_LONGV_A5 A3+1
+#define ftgsvb_LONGV_A6 A3+1
+#define ftgsvb_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvb,FTGSVB,ftgsvb,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,BYTE,BYTEV,PLOGICAL,PINT)
+
+#define ftgsvi_LONGV_A4 A3+1
+#define ftgsvi_LONGV_A5 A3+1
+#define ftgsvi_LONGV_A6 A3+1
+#define ftgsvi_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvi,FTGSVI,ftgsvi,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,SHORT,SHORTV,PLOGICAL,PINT)
+
+#define ftgsvj_LONGV_A4 A3+1
+#define ftgsvj_LONGV_A5 A3+1
+#define ftgsvj_LONGV_A6 A3+1
+#define ftgsvj_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvk,FTGSVJ,ftgsvj,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,INT,INTV,PLOGICAL,PINT)
+
+#define ftgsvk_LONGV_A4 A3+1
+#define ftgsvk_LONGV_A5 A3+1
+#define ftgsvk_LONGV_A6 A3+1
+#define ftgsvk_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvjj,FTGSVK,ftgsvk,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,LONGLONG,LONGLONGV,PLOGICAL,PINT)
+
+#define ftgsve_LONGV_A4 A3+1
+#define ftgsve_LONGV_A5 A3+1
+#define ftgsve_LONGV_A6 A3+1
+#define ftgsve_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsve,FTGSVE,ftgsve,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,FLOAT,FLOATV,PLOGICAL,PINT)
+
+#define ftgsvd_LONGV_A4 A3+1
+#define ftgsvd_LONGV_A5 A3+1
+#define ftgsvd_LONGV_A6 A3+1
+#define ftgsvd_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvd,FTGSVD,ftgsvd,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+
+
+/*   Must handle LOGICALV conversion manually   */
+void Cffgsfb( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, unsigned char *array, int *flagval, int *anynul, int *status );
+void Cffgsfb( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, unsigned char *array, int *flagval, int *anynul, int *status )
+{
+   char *Cflagval;
+   long nflagval;
+   int i;
+ 
+   for( nflagval=1, i=0; i<naxis; i++ )
+      nflagval *= (trc[i]-blc[i])/inc[i]+1;
+   Cflagval = F2CcopyLogVect(nflagval, flagval );
+   ffgsfb( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );   
+   C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfb_LONGV_A4 A3+1
+#define ftgsfb_LONGV_A5 A3+1
+#define ftgsfb_LONGV_A6 A3+1
+#define ftgsfb_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfb,FTGSFB,ftgsfb,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,BYTEV,INTV,PLOGICAL,PINT)
+
+/*   Must handle LOGICALV conversion manually   */
+void Cffgsfi( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, short *array, int *flagval, int *anynul, int *status );
+void Cffgsfi( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, short *array, int *flagval, int *anynul, int *status )
+{
+   char *Cflagval;
+   long nflagval;
+   int i;
+ 
+   for( nflagval=1, i=0; i<naxis; i++ )
+      nflagval *= (trc[i]-blc[i])/inc[i]+1;
+   Cflagval = F2CcopyLogVect(nflagval, flagval );
+   ffgsfi( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );   
+   C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfi_LONGV_A4 A3+1
+#define ftgsfi_LONGV_A5 A3+1
+#define ftgsfi_LONGV_A6 A3+1
+#define ftgsfi_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfi,FTGSFI,ftgsfi,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,SHORTV,INTV,PLOGICAL,PINT)
+
+/*   Must handle LOGICALV conversion manually   */
+void Cffgsfk( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, int *array, int *flagval, int *anynul, int *status );
+void Cffgsfk( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, int *array, int *flagval, int *anynul, int *status )
+{
+   char *Cflagval;
+   long nflagval;
+   int i;
+ 
+   for( nflagval=1, i=0; i<naxis; i++ )
+      nflagval *= (trc[i]-blc[i])/inc[i]+1;
+   Cflagval = F2CcopyLogVect(nflagval, flagval );
+   ffgsfk( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );   
+   C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfj_LONGV_A4 A3+1
+#define ftgsfj_LONGV_A5 A3+1
+#define ftgsfj_LONGV_A6 A3+1
+#define ftgsfj_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfk,FTGSFJ,ftgsfj,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,INTV,INTV,PLOGICAL,PINT)
+
+
+/*   Must handle LOGICALV conversion manually   */
+void Cffgsfjj( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, LONGLONG *array, int *flagval, int *anynul, int *status );
+void Cffgsfjj( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, LONGLONG *array, int *flagval, int *anynul, int *status )
+{
+   char *Cflagval;
+   long nflagval;
+   int i;
+ 
+   for( nflagval=1, i=0; i<naxis; i++ )
+      nflagval *= (trc[i]-blc[i])/inc[i]+1;
+   Cflagval = F2CcopyLogVect(nflagval, flagval );
+   ffgsfjj( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );   
+   C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfk_LONGV_A4 A3+1
+#define ftgsfk_LONGV_A5 A3+1
+#define ftgsfk_LONGV_A6 A3+1
+#define ftgsfk_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfjj,FTGSFK,ftgsfk,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,LONGLONGV,INTV,PLOGICAL,PINT)
+
+
+/*   Must handle LOGICALV conversion manually   */
+void Cffgsfe( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, float *array, int *flagval, int *anynul, int *status );
+void Cffgsfe( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, float *array, int *flagval, int *anynul, int *status )
+{
+   char *Cflagval;
+   long nflagval;
+   int i;
+ 
+   for( nflagval=1, i=0; i<naxis; i++ )
+      nflagval *= (trc[i]-blc[i])/inc[i]+1;
+   Cflagval = F2CcopyLogVect(nflagval, flagval );
+   ffgsfe( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );   
+   C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfe_LONGV_A4 A3+1
+#define ftgsfe_LONGV_A5 A3+1
+#define ftgsfe_LONGV_A6 A3+1
+#define ftgsfe_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfe,FTGSFE,ftgsfe,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,FLOATV,INTV,PLOGICAL,PINT)
+
+/*   Must handle LOGICALV conversion manually   */
+void Cffgsfd( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, double *array, int *flagval, int *anynul, int *status );
+void Cffgsfd( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, double *array, int *flagval, int *anynul, int *status )
+{
+   char *Cflagval;
+   long nflagval;
+   int i;
+ 
+   for( nflagval=1, i=0; i<naxis; i++ )
+      nflagval *= (trc[i]-blc[i])/inc[i]+1;
+   Cflagval = F2CcopyLogVect(nflagval, flagval );
+   ffgsfd( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );   
+   C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfd_LONGV_A4 A3+1
+#define ftgsfd_LONGV_A5 A3+1
+#define ftgsfd_LONGV_A6 A3+1
+#define ftgsfd_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfd,FTGSFD,ftgsfd,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,DOUBLEV,INTV,PLOGICAL,PINT)
+
+FCALLSCSUB6(ffggpb,FTGGPB,ftggpb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB6(ffggpi,FTGGPI,ftggpi,FITSUNIT,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB6(ffggpk,FTGGPJ,ftggpj,FITSUNIT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB6(ffggpjj,FTGGPK,ftggpk,FITSUNIT,LONG,LONG,LONG,LONGLONGV,PINT)
+FCALLSCSUB6(ffggpe,FTGGPE,ftggpe,FITSUNIT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB6(ffggpd,FTGGPD,ftggpd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,PINT)
+
+/*--------------------- read column elements -------------*/
+/*   To guarantee that we allocate enough memory to hold strings within
+     a table, call FFGTCL first to obtain width of the unique string
+     and use it as the minimum string width.  Also test whether column
+     has a variable width in which case a single string is read
+     containing all its characters, so only declare a string vector
+     with 1 element.                                                     */
+
+#define ftgcvs_STRV_A7 NUM_ELEMS(velem)
+CFextern VOID_cfF(FTGCVS,ftgcvs)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONG,LONG,LONG,STRING,PSTRINGV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGCVS,ftgcvs)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONG,LONG,LONG,STRING,PSTRINGV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(INT,2)
+   QCF(LONG,3)
+   QCF(LONG,4)
+   QCF(LONG,5)
+   QCF(STRING,6)
+   QCF(PSTRINGV,7)
+   QCF(PLOGICAL,8)
+   QCF(PINT,9)
+
+   fitsfile *fptr;
+   int colnum, *anynul, *status, velem, type;
+   long firstrow, firstelem, nelem;
+   long repeat;
+   unsigned long gMinStrLen=80L;  /* gMin = width */
+   char *nulval, **array;
+
+   fptr =      TCF(ftgcvs,FITSUNIT,1,0);
+   colnum =    TCF(ftgcvs,INT,2,0);
+   firstrow =  TCF(ftgcvs,LONG,3,0);
+   firstelem = TCF(ftgcvs,LONG,4,0);
+   nelem =     TCF(ftgcvs,LONG,5,0);
+   nulval =    TCF(ftgcvs,STRING,6,0);
+   /*  put off variable 7 (array) until column type is learned  */
+   anynul =    TCF(ftgcvs,PLOGICAL,8,0);
+   status =    TCF(ftgcvs,PINT,9,0);
+   
+   ffgtcl( fptr, colnum, &type, &repeat, (long *)&gMinStrLen, status );
+   if( type<0 ) velem = 1;   /*  Variable length column  */
+   else velem = nelem;
+
+   array = TCF(ftgcvs,PSTRINGV,7,0);
+
+   ffgcvs( fptr, colnum, firstrow, firstelem, nelem, nulval, array,
+           anynul, status );
+
+   RCF(FITSUNIT,1)
+   RCF(INT,2)
+   RCF(LONG,3)
+   RCF(LONG,4)
+   RCF(LONG,5)
+   RCF(STRING,6)
+   RCF(PSTRINGV,7)
+   RCF(PLOGICAL,8)
+   RCF(PINT,9)
+}
+
+#define ftgcvsll_STRV_A7 NUM_ELEMS(velem)
+CFextern VOID_cfF(FTGCVSLL,ftgcvsll)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONGLONG,LONGLONG,LONG,STRING,PSTRINGV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGCVSLL,ftgcvsll)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONGLONG,LONGLONG,LONG,STRING,PSTRINGV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(INT,2)
+   QCF(LONGLONG,3)
+   QCF(LONGLONG,4)
+   QCF(LONG,5)
+   QCF(STRING,6)
+   QCF(PSTRINGV,7)
+   QCF(PLOGICAL,8)
+   QCF(PINT,9)
+
+   fitsfile *fptr;
+   int colnum, *anynul, *status, velem, type;
+   LONGLONG firstrow, firstelem;
+   long nelem;
+   long repeat;
+   unsigned long gMinStrLen=80L;  /* gMin = width */
+   char *nulval, **array;
+
+   fptr =      TCF(ftgcvsll,FITSUNIT,1,0);
+   colnum =    TCF(ftgcvsll,INT,2,0);
+   firstrow =  TCF(ftgcvsll,LONGLONG,3,0);
+   firstelem = TCF(ftgcvsll,LONGLONG,4,0);
+   nelem =     TCF(ftgcvsll,LONG,5,0);
+   nulval =    TCF(ftgcvsll,STRING,6,0);
+   /*  put off variable 7 (array) until column type is learned  */
+   anynul =    TCF(ftgcvsll,PLOGICAL,8,0);
+   status =    TCF(ftgcvsll,PINT,9,0);
+   
+   ffgtcl( fptr, colnum, &type, &repeat, (long *)&gMinStrLen, status );
+   if( type<0 ) velem = 1;   /*  Variable length column  */
+   else velem = nelem;
+
+   array = TCF(ftgcvsll,PSTRINGV,7,0);
+
+   ffgcvs( fptr, colnum, firstrow, firstelem, nelem, nulval, array,
+           anynul, status );
+
+   RCF(FITSUNIT,1)
+   RCF(INT,2)
+   RCF(LONGLONG,3)
+   RCF(LONGLONG,4)
+   RCF(LONG,5)
+   RCF(STRING,6)
+   RCF(PSTRINGV,7)
+   RCF(PLOGICAL,8)
+   RCF(PINT,9)
+}
+
+
+#define ftgcl_LOGV_A6 A5
+FCALLSCSUB7(ffgcl,FTGCL,ftgcl,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,PINT)
+
+#define ftgcvl_LOGV_A7 A5
+FCALLSCSUB9(ffgcvl,FTGCVL,ftgcvl,FITSUNIT,INT,LONG,LONG,LONG,LOGICAL,LOGICALV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvb,FTGCVB,ftgcvb,FITSUNIT,INT,LONG,LONG,LONG,BYTE,BYTEV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvi,FTGCVI,ftgcvi,FITSUNIT,INT,LONG,LONG,LONG,SHORT,SHORTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvk,FTGCVJ,ftgcvj,FITSUNIT,INT,LONG,LONG,LONG,INT,INTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvjj,FTGCVK,ftgcvk,FITSUNIT,INT,LONG,LONG,LONG,LONGLONG,LONGLONGV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcve,FTGCVE,ftgcve,FITSUNIT,INT,LONG,LONG,LONG,FLOAT,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvd,FTGCVD,ftgcvd,FITSUNIT,INT,LONG,LONG,LONG,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvc,FTGCVC,ftgcvc,FITSUNIT,INT,LONG,LONG,LONG,FLOAT,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvm,FTGCVM,ftgcvm,FITSUNIT,INT,LONG,LONG,LONG,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+
+#define ftgcvlll_LOGV_A7 A5
+FCALLSCSUB9(ffgcvl,FTGCVLLL,ftgcvlll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,LOGICAL,LOGICALV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvb,FTGCVBLL,ftgcvbll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,BYTE,BYTEV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvi,FTGCVILL,ftgcvill,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,SHORT,SHORTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvk,FTGCVJLL,ftgcvjll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,INT,INTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvjj,FTGCVKLL,ftgcvkll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,LONGLONG,LONGLONGV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcve,FTGCVELL,ftgcvell,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,FLOAT,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvd,FTGCVDLL,ftgcvdll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvc,FTGCVCLL,ftgcvcll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,FLOAT,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvm,FTGCVMLL,ftgcvmll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+
+#define ftgcx_LOGV_A6 A5
+FCALLSCSUB7(ffgcx,FTGCX,ftgcx,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,PINT)
+
+/*   We need to worry about unsigned vs signed pointers in the following  */
+/*   two routines, so use a pair of C wrappers which cast the pointers    */
+/*   before passing them to CFITSIO.                                      */
+
+void Cffgcxui(fitsfile *fptr, int colnum, long firstrow, long nrows,
+              long firstbit, int nbits, short *array, int *status);
+void Cffgcxui(fitsfile *fptr, int colnum, long firstrow, long nrows,
+              long firstbit, int nbits, short *array, int *status)
+{
+   ffgcxui( fptr, colnum, firstrow, nrows, firstbit, nbits,
+	    (unsigned short *)array, status );
+}
+FCALLSCSUB8(Cffgcxui,FTGCXI,ftgcxi,FITSUNIT,INT,LONG,LONG,LONG,INT,SHORTV,PINT)
+
+void Cffgcxuk(fitsfile *fptr, int colnum, long firstrow, long nrows,
+              long firstbit, int nbits, int *array, int *status);
+void Cffgcxuk(fitsfile *fptr, int colnum, long firstrow, long nrows,
+              long firstbit, int nbits, int *array, int *status)
+{
+   ffgcxuk( fptr, colnum, firstrow, nrows, firstbit, nbits,
+	    (unsigned int *)array, status );
+}
+FCALLSCSUB8(Cffgcxuk,FTGCXJ,ftgcxj,FITSUNIT,INT,LONG,LONG,LONG,INT,INTV,PINT)
+
+/*   To guarantee that we allocate enough memory to hold strings within
+     a table, call FFGTCL first to obtain width of the unique string
+     and use it as the minimum string width.  Also test whether column
+     has a variable width in which case a single string is read
+     containing all its characters, so only declare a string vector
+     with 1 element.                                                     */
+
+#define ftgcfs_STRV_A6 NUM_ELEMS(velem)
+#define ftgcfs_LOGV_A7 A5
+CFextern VOID_cfF(FTGCFS,ftgcfs)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONG,LONG,LONG,PSTRINGV,LOGICALV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGCFS,ftgcfs)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONG,LONG,LONG,PSTRINGV,LOGICALV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(INT,2)
+   QCF(LONG,3)
+   QCF(LONG,4)
+   QCF(LONG,5)
+   QCF(PSTRINGV,6)
+   QCF(LOGICALV,7)
+   QCF(PLOGICAL,8)
+   QCF(PINT,9)
+
+   fitsfile *fptr;
+   int colnum, *anynul, *status, velem, type;
+   long firstrow, firstelem, nelem;
+   long repeat;
+   unsigned long gMinStrLen=80L;  /* gMin = width */
+   char **array, *nularray;
+ 
+   fptr =      TCF(ftgcfs,FITSUNIT,1,0);
+   colnum =    TCF(ftgcfs,INT,2,0);
+   firstrow =  TCF(ftgcfs,LONG,3,0);
+   firstelem = TCF(ftgcfs,LONG,4,0);
+   nelem =     TCF(ftgcfs,LONG,5,0);
+   /*  put off variable 6 (array) until column type is learned  */
+   nularray =  TCF(ftgcfs,LOGICALV,7,0);
+   anynul =    TCF(ftgcfs,PLOGICAL,8,0);
+   status =    TCF(ftgcfs,PINT,9,0);
+   
+   ffgtcl( fptr, colnum, &type, &repeat, (long*)&gMinStrLen, status );
+   if( type<0 ) velem = 1;   /*  Variable length column  */
+   else velem = nelem;
+
+   array = TCF(ftgcfs,PSTRINGV,6,0);
+
+   ffgcfs( fptr, colnum, firstrow, firstelem, nelem, array, nularray,
+           anynul, status);
+
+   RCF(FITSUNIT,1)
+   RCF(INT,2)
+   RCF(LONG,3)
+   RCF(LONG,4)
+   RCF(LONG,5)
+   RCF(PSTRINGV,6)
+   RCF(LOGICALV,7)
+   RCF(PLOGICAL,8)
+   RCF(PINT,9)
+}
+
+#define ftgcfl_LOGV_A6 A5
+#define ftgcfl_LOGV_A7 A5
+FCALLSCSUB9(ffgcfl,FTGCFL,ftgcfl,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfb_LOGV_A7 A5
+FCALLSCSUB9(ffgcfb,FTGCFB,ftgcfb,FITSUNIT,INT,LONG,LONG,LONG,BYTEV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfi_LOGV_A7 A5
+FCALLSCSUB9(ffgcfi,FTGCFI,ftgcfi,FITSUNIT,INT,LONG,LONG,LONG,SHORTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfj_LOGV_A7 A5
+FCALLSCSUB9(ffgcfk,FTGCFJ,ftgcfj,FITSUNIT,INT,LONG,LONG,LONG,INTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfk_LOGV_A7 A5
+FCALLSCSUB9(ffgcfjj,FTGCFK,ftgcfk,FITSUNIT,INT,LONG,LONG,LONG,LONGLONGV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfe_LOGV_A7 A5
+FCALLSCSUB9(ffgcfe,FTGCFE,ftgcfe,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfd_LOGV_A7 A5
+FCALLSCSUB9(ffgcfd,FTGCFD,ftgcfd,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,LOGICALV,PLOGICAL,PINT)
+
+/*   Must handle LOGICALV conversion manually   */
+void Cffgcfc( fitsfile *fptr, int colnum, long firstrow, long firstelem, long nelem, float *array, int *nularray, int *anynul, int *status );
+void Cffgcfc( fitsfile *fptr, int colnum, long firstrow, long firstelem, long nelem, float *array, int *nularray, int *anynul, int *status )
+{
+   char *Cnularray;
+ 
+   Cnularray = F2CcopyLogVect(nelem*2, nularray );
+   ffgcfc( fptr, colnum, firstrow, firstelem, nelem, array, Cnularray, anynul, status );   
+   C2FcopyLogVect(nelem*2, nularray, Cnularray );
+}
+FCALLSCSUB9(Cffgcfc,FTGCFC,ftgcfc,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,INTV,PLOGICAL,PINT)
+
+/*   Must handle LOGICALV conversion manually   */
+void Cffgcfm( fitsfile *fptr, int colnum, long firstrow, long firstelem, long nelem, double *array, int *nularray, int *anynul, int *status );
+void Cffgcfm( fitsfile *fptr, int colnum, long firstrow, long firstelem, long nelem, double *array, int *nularray, int *anynul, int *status )
+{
+   char *Cnularray;
+ 
+   Cnularray = F2CcopyLogVect(nelem*2, nularray );
+   ffgcfm( fptr, colnum, firstrow, firstelem, nelem, array, Cnularray, anynul, status );   
+   C2FcopyLogVect(nelem*2, nularray, Cnularray );
+}
+FCALLSCSUB9(Cffgcfm,FTGCFM,ftgcfm,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,INTV,PLOGICAL,PINT)
+
+
+#define ftgcfbll_LOGV_A7 A5
+FCALLSCSUB9(ffgcfb,FTGCFBLL,ftgcfbll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,BYTEV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfill_LOGV_A7 A5
+FCALLSCSUB9(ffgcfi,FTGCFILL,ftgcfill,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,SHORTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfjll_LOGV_A7 A5
+FCALLSCSUB9(ffgcfk,FTGCFJLL,ftgcfjll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,INTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfkll_LOGV_A7 A5
+FCALLSCSUB9(ffgcfjj,FTGCFKLL,ftgcfkll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,LONGLONGV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfell_LOGV_A7 A5
+FCALLSCSUB9(ffgcfe,FTGCFELL,ftgcfell,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,FLOATV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfdll_LOGV_A7 A5
+FCALLSCSUB9(ffgcfd,FTGCFDLL,ftgcfdll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,DOUBLEV,LOGICALV,PLOGICAL,PINT)
+
+FCALLSCSUB6(ffgdes,FTGDES,ftgdes,FITSUNIT,INT,LONG,PLONG,PLONG,PINT)
+FCALLSCSUB6(ffgdesll,FTGDESLL,ftgdesll,FITSUNIT,INT,LONG,PLONGLONG,PLONGLONG,PINT)
+
+#define ftgdess_LONGV_A5 A4
+#define ftgdess_LONGV_A6 A4
+FCALLSCSUB7(ffgdess,FTGDESS,ftgdess,FITSUNIT,INT,LONG,LONG,LONGV,LONGV,PINT)
+#define ftgdessll_LONGV_A5 A4
+#define ftgdessll_LONGV_A6 A4FCALLSCSUB7(ffgdessll,FTGDESSLL,ftgdessll,FITSUNIT,INT,LONG,LONG,LONGLONGV,LONGLONGV,PINT)
+FCALLSCSUB7(ffgdessll,FTGDESSLL,ftgdessll,FITSUNIT,INT,LONG,LONG,LONGLONGV,LONGLONGV,PINT)
+
+FCALLSCSUB6(ffgtbb,FTGTBB,ftgtbb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB6(ffgtbb,FTGTBS,ftgtbs,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+
+/*------------ write primary array or image elements -------------*/
+FCALLSCSUB6(ffpprb,FTPPRB,ftpprb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB6(ffppri,FTPPRI,ftppri,FITSUNIT,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB6(ffpprk,FTPPRJ,ftpprj,FITSUNIT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB6(ffpprjj,FTPPRK,ftpprk,FITSUNIT,LONG,LONG,LONG,LONGLONGV,PINT)
+FCALLSCSUB6(ffppre,FTPPRE,ftppre,FITSUNIT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB6(ffpprd,FTPPRD,ftpprd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,PINT)
+
+FCALLSCSUB7(ffppnb,FTPPNB,ftppnb,FITSUNIT,LONG,LONG,LONG,BYTEV,BYTE,PINT)
+FCALLSCSUB7(ffppni,FTPPNI,ftppni,FITSUNIT,LONG,LONG,LONG,SHORTV,SHORT,PINT)
+FCALLSCSUB7(ffppnk,FTPPNJ,ftppnj,FITSUNIT,LONG,LONG,LONG,INTV,INT,PINT)
+FCALLSCSUB7(ffppnjj,FTPPNK,ftppnk,FITSUNIT,LONG,LONG,LONG,LONGLONGV,LONGLONG,PINT)
+FCALLSCSUB7(ffppne,FTPPNE,ftppne,FITSUNIT,LONG,LONG,LONG,FLOATV,FLOAT,PINT)
+FCALLSCSUB7(ffppnd,FTPPND,ftppnd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,DOUBLE,PINT)
+
+FCALLSCSUB7(ffp2db,FTP2DB,ftp2db,FITSUNIT,LONG,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB7(ffp2di,FTP2DI,ftp2di,FITSUNIT,LONG,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB7(ffp2dk,FTP2DJ,ftp2dj,FITSUNIT,LONG,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB7(ffp2djj,FTP2DK,ftp2dk,FITSUNIT,LONG,LONG,LONG,LONG,LONGLONGV,PINT)
+FCALLSCSUB7(ffp2de,FTP2DE,ftp2de,FITSUNIT,LONG,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB7(ffp2dd,FTP2DD,ftp2dd,FITSUNIT,LONG,LONG,LONG,LONG,DOUBLEV,PINT)
+
+FCALLSCSUB9(ffp3db,FTP3DB,ftp3db,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB9(ffp3di,FTP3DI,ftp3di,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB9(ffp3dk,FTP3DJ,ftp3dj,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB9(ffp3djj,FTP3DK,ftp3dk,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,LONGLONGV,PINT)
+FCALLSCSUB9(ffp3de,FTP3DE,ftp3de,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB9(ffp3dd,FTP3DD,ftp3dd,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,DOUBLEV,PINT)
+
+#define ftpssb_LONGV_A4 A3
+#define ftpssb_LONGV_A5 A3
+#define ftpssb_LONGV_A6 A3
+FCALLSCSUB8(ffpssb,FTPSSB,ftpssb,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,BYTEV,PINT)
+
+#define ftpssi_LONGV_A4 A3
+#define ftpssi_LONGV_A5 A3
+#define ftpssi_LONGV_A6 A3
+FCALLSCSUB8(ffpssi,FTPSSI,ftpssi,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,SHORTV,PINT)
+
+#define ftpssj_LONGV_A4 A3
+#define ftpssj_LONGV_A5 A3
+#define ftpssj_LONGV_A6 A3
+FCALLSCSUB8(ffpssk,FTPSSJ,ftpssj,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,INTV,PINT)
+
+#define ftpssk_LONGV_A4 A3
+#define ftpssk_LONGV_A5 A3
+#define ftpssk_LONGV_A6 A3
+FCALLSCSUB8(ffpssjj,FTPSSK,ftpssk,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,LONGLONGV,PINT)
+
+#define ftpsse_LONGV_A4 A3
+#define ftpsse_LONGV_A5 A3
+#define ftpsse_LONGV_A6 A3
+FCALLSCSUB8(ffpsse,FTPSSE,ftpsse,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,FLOATV,PINT)
+
+#define ftpssd_LONGV_A4 A3
+#define ftpssd_LONGV_A5 A3
+#define ftpssd_LONGV_A6 A3
+FCALLSCSUB8(ffpssd,FTPSSD,ftpssd,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,DOUBLEV,PINT)
+
+FCALLSCSUB6(ffpgpb,FTPGPB,ftpgpb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB6(ffpgpi,FTPGPI,ftpgpi,FITSUNIT,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB6(ffpgpk,FTPGPJ,ftpgpj,FITSUNIT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB6(ffpgpjj,FTPGPK,ftpgpk,FITSUNIT,LONG,LONG,LONG,LONGLONGV,PINT)
+FCALLSCSUB6(ffpgpe,FTPGPE,ftpgpe,FITSUNIT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB6(ffpgpd,FTPGPD,ftpgpd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,PINT)
+
+FCALLSCSUB5(ffppru,FTPPRU,ftppru,FITSUNIT,LONG,LONG,LONG,PINT)
+FCALLSCSUB4(ffpprn,FTPPRN,ftpprn,FITSUNIT,LONG,LONG,PINT)
+
+/*--------------------- write column elements -------------*/
+#define ftpcls_STRV_A6 NUM_ELEM_ARG(5)
+FCALLSCSUB7(ffpcls,FTPCLS,ftpcls,FITSUNIT,INT,LONG,LONG,LONG,STRINGV,PINT)
+
+#define ftpcll_LOGV_A6 A5
+FCALLSCSUB7(ffpcll,FTPCLL,ftpcll,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,PINT)
+FCALLSCSUB7(ffpclb,FTPCLB,ftpclb,FITSUNIT,INT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB7(ffpcli,FTPCLI,ftpcli,FITSUNIT,INT,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB7(ffpclk,FTPCLJ,ftpclj,FITSUNIT,INT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB7(ffpcljj,FTPCLK,ftpclk,FITSUNIT,INT,LONG,LONG,LONG,LONGLONGV,PINT)
+FCALLSCSUB7(ffpcle,FTPCLE,ftpcle,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB7(ffpcld,FTPCLD,ftpcld,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,PINT)
+FCALLSCSUB7(ffpclc,FTPCLC,ftpclc,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB7(ffpclm,FTPCLM,ftpclm,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,PINT)
+FCALLSCSUB6(ffpclu,FTPCLU,ftpclu,FITSUNIT,INT,LONG,LONG,LONG,PINT)
+FCALLSCSUB4(ffprwu,FTPRWU,ftprwu,FITSUNIT,LONG,LONG,PINT)
+
+#define ftpclsll_STRV_A6 NUM_ELEM_ARG(5)
+FCALLSCSUB7(ffpcls,FTPCLSLL,ftpclsll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,STRINGV,PINT)
+
+#define ftpcllll_LOGV_A6 A5
+FCALLSCSUB7(ffpcll,FTPCLLLL,ftpcllll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,LOGICALV,PINT)
+FCALLSCSUB7(ffpclb,FTPCLBLL,ftpclbll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,BYTEV,PINT)
+FCALLSCSUB7(ffpcli,FTPCLILL,ftpclill,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,SHORTV,PINT)
+FCALLSCSUB7(ffpclk,FTPCLJLL,ftpcljll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,INTV,PINT)
+FCALLSCSUB7(ffpcljj,FTPCLKLL,ftpclkll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,LONGLONGV,PINT)
+FCALLSCSUB7(ffpcle,FTPCLELL,ftpclell,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,FLOATV,PINT)
+FCALLSCSUB7(ffpcld,FTPCLDLL,ftpcldll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,DOUBLEV,PINT)
+FCALLSCSUB7(ffpclc,FTPCLCLL,ftpclcll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,FLOATV,PINT)
+FCALLSCSUB7(ffpclm,FTPCLMLL,ftpclmll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,DOUBLEV,PINT)
+FCALLSCSUB6(ffpclu,FTPCLULL,ftpclull,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,PINT)
+
+#define ftpclx_LOGV_A6 A5
+FCALLSCSUB7(ffpclx,FTPCLX,ftpclx,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,PINT)
+
+#define ftpcns_STRV_A6 NUM_ELEM_ARG(5)
+FCALLSCSUB8(ffpcns,FTPCNS,ftpcns,FITSUNIT,INT,LONG,LONG,LONG,STRINGV,STRING,PINT)
+
+FCALLSCSUB8(ffpcnb,FTPCNB,ftpcnb,FITSUNIT,INT,LONG,LONG,LONG,BYTEV,BYTE,PINT)
+FCALLSCSUB8(ffpcni,FTPCNI,ftpcni,FITSUNIT,INT,LONG,LONG,LONG,SHORTV,SHORT,PINT)
+FCALLSCSUB8(ffpcnk,FTPCNJ,ftpcnj,FITSUNIT,INT,LONG,LONG,LONG,INTV,INT,PINT)
+FCALLSCSUB8(ffpcnjj,FTPCNK,ftpcnk,FITSUNIT,INT,LONG,LONG,LONG,LONGLONGV,LONGLONG,PINT)
+FCALLSCSUB8(ffpcne,FTPCNE,ftpcne,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,FLOAT,PINT)
+FCALLSCSUB8(ffpcnd,FTPCND,ftpcnd,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,DOUBLE,PINT)
+
+#define ftpcnsll_STRV_A6 NUM_ELEM_ARG(5)
+FCALLSCSUB8(ffpcns,FTPCNSLL,ftpcnsll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,STRINGV,STRING,PINT)
+
+FCALLSCSUB8(ffpcnb,FTPCNBLL,ftpcnbll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,BYTEV,BYTE,PINT)
+FCALLSCSUB8(ffpcni,FTPCNILL,ftpcnill,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,SHORTV,SHORT,PINT)
+FCALLSCSUB8(ffpcnk,FTPCNJLL,ftpcnjll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,INTV,INT,PINT)
+FCALLSCSUB8(ffpcnjj,FTPCNKLL,ftpcnkll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,LONGLONGV,LONGLONG,PINT)
+FCALLSCSUB8(ffpcne,FTPCNELL,ftpcnell,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,FLOATV,FLOAT,PINT)
+FCALLSCSUB8(ffpcnd,FTPCNDLL,ftpcndll,FITSUNIT,INT,LONGLONG,LONGLONG,LONG,DOUBLEV,DOUBLE,PINT)
+
+FCALLSCSUB6(ffpdes,FTPDES,ftpdes,FITSUNIT,INT,LONG,LONG,LONG,PINT)
+FCALLSCSUB6(ffpdes,FTPDESLL,ftpdesll,FITSUNIT,INT,LONG,LONGLONG,LONGLONG,PINT)
+
+FCALLSCSUB6(ffptbb,FTPTBB,ftptbb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+   /*  Add extra entry point to ffptbb... ftptbs obsolete  */
+FCALLSCSUB6(ffptbb,FTPTBS,ftptbs,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+
+FCALLSCSUB4(ffirow,FTIROW,ftirow,FITSUNIT,LONG,LONG,PINT)
+FCALLSCSUB4(ffirow,FTIROWLL,ftirowll,FITSUNIT,LONGLONG,LONGLONG,PINT)
+FCALLSCSUB4(ffdrow,FTDROW,ftdrow,FITSUNIT,LONG,LONG,PINT)
+FCALLSCSUB4(ffdrow,FTDROWLL,ftdrowll,FITSUNIT,LONGLONG,LONGLONG,PINT)
+FCALLSCSUB3(ffdrrg,FTDRRG,ftdrrg,FITSUNIT,STRING,PINT)
+#define ftdrws_LONGV_A2 A3
+FCALLSCSUB4(ffdrws,FTDRWS,ftdrws,FITSUNIT,LONGV,LONG,PINT)
+FCALLSCSUB5(fficol,FTICOL,fticol,FITSUNIT,INT,STRING,STRING,PINT)
+
+#define fticls_STRV_A4 NUM_ELEM_ARG(3)
+#define fticls_STRV_A5 NUM_ELEM_ARG(3)
+FCALLSCSUB6(fficls,FTICLS,fticls,FITSUNIT,INT,INT,STRINGV,STRINGV,PINT)
+FCALLSCSUB4(ffmvec,FTMVEC,ftmvec,FITSUNIT,INT,LONG,PINT)
+FCALLSCSUB3(ffdcol,FTDCOL,ftdcol,FITSUNIT,INT,PINT)
+FCALLSCSUB6(ffcpcl,FTCPCL,ftcpcl,FITSUNIT,FITSUNIT,INT,INT,INT,PINT)

external/cfitsio/f77_wrap3.c

@@ -0,0 +1,853 @@
+/************************************************************************
+
+     f77_wrap1.c and f77_wrap2.c have now been split into 4 files to
+     prevent compile-time memory errors (from expansion of compiler commands).
+     f77_wrap1.c was split into f77_wrap1.c and f77_wrap3.c, and
+     f77_wrap2.c was split into f77_wrap2.c and f77_wrap4.c:
+
+       f77_wrap1.c contains routines operating on whole files and some
+       utility routines.
+
+       f77_wrap2.c contains routines operating on primary array, image,
+       or column elements.
+
+       f77_wrap3.c contains routines operating on headers & keywords.
+
+       f77_wrap4.c contains miscellaneous routines.
+
+     Peter's original comments:
+
+     Together, f77_wrap1.c and f77_wrap2.c contain C wrappers for all
+     the CFITSIO routines prototyped in fitsio.h, except for the
+     generic datatype routines and features not supported in fortran
+     (eg, unsigned integers), a few routines prototyped in fitsio2.h,
+     which only a handful of FTOOLS use, plus a few obsolete FITSIO
+     routines not present in CFITSIO.  This file allows Fortran code
+     to use the CFITSIO library instead of the FITSIO library without
+     modification.  It also gives access to new routines not present
+     in FITSIO.  Fortran FTOOLS must continue using the old routine
+     names from FITSIO (ie, ftxxxx), but most of the C-wrappers simply
+     redirect those calls to the corresponding CFITSIO routines (ie,
+     ffxxxx), with appropriate parameter massaging where necessary.
+     The main exception are read/write routines ending in j (ie, long
+     data) which get redirected to C routines ending in k (ie, int
+     data). This is more consistent with the default integer type in
+     Fortran. f77_wrap1.c primarily holds routines operating on whole
+     files and extension headers.  f77_wrap2.c handle routines which
+     read and write the data portion, plus miscellaneous extra routines.
+     
+        File created by Peter Wilson (HSTX), Oct-Dec. 1997
+************************************************************************/
+
+#include "fitsio2.h"
+#include "f77_wrap.h"
+
+/*----------------- write single keywords --------------*/
+FCALLSCSUB3(ffprec,FTPREC,ftprec,FITSUNIT,STRING,PINT)
+FCALLSCSUB3(ffpcom,FTPCOM,ftpcom,FITSUNIT,STRING,PINT)
+FCALLSCSUB4(ffpunt,FTPUNT,ftpunt,FITSUNIT,STRING,STRING,PINT)
+FCALLSCSUB3(ffphis,FTPHIS,ftphis,FITSUNIT,STRING,PINT)
+FCALLSCSUB2(ffpdat,FTPDAT,ftpdat,FITSUNIT,PINT)
+FCALLSCSUB3(ffgstm,FTGSTM,ftgstm,PSTRING,PINT,PINT)
+FCALLSCSUB4(ffgsdt,FTGSDT,ftgsdt,PINT,PINT,PINT,PINT)
+FCALLSCSUB5(ffdt2s,FTDT2S,ftdt2s,INT,INT,INT,PSTRING,PINT)
+FCALLSCSUB9(fftm2s,FTTM2S,fttm2s,INT,INT,INT,INT,INT,DOUBLE,INT,PSTRING,PINT)
+FCALLSCSUB5(ffs2dt,FTS2DT,fts2dt,STRING,PINT,PINT,PINT,PINT)
+FCALLSCSUB8(ffs2tm,FTS2TM,fts2tm,STRING,PINT,PINT,PINT,PINT,PINT,PDOUBLE,PINT)
+FCALLSCSUB4(ffpkyu,FTPKYU,ftpkyu,FITSUNIT,STRING,STRING,PINT)
+FCALLSCSUB5(ffpkys,FTPKYS,ftpkys,FITSUNIT,STRING,STRING,STRING,PINT)
+FCALLSCSUB5(ffpkls,FTPKLS,ftpkls,FITSUNIT,STRING,STRING,STRING,PINT)
+FCALLSCSUB2(ffplsw,FTPLSW,ftplsw,FITSUNIT,PINT)
+FCALLSCSUB5(ffpkyl,FTPKYL,ftpkyl,FITSUNIT,STRING,INT,STRING,PINT)
+FCALLSCSUB5(ffpkyj,FTPKYJ,ftpkyj,FITSUNIT,STRING,LONG,STRING,PINT)
+FCALLSCSUB5(ffpkyj,FTPKYK,ftpkyk,FITSUNIT,STRING,LONGLONG,STRING,PINT)
+FCALLSCSUB6(ffpkyf,FTPKYF,ftpkyf,FITSUNIT,STRING,FLOAT,INT,STRING,PINT)
+FCALLSCSUB6(ffpkye,FTPKYE,ftpkye,FITSUNIT,STRING,FLOAT,INT,STRING,PINT)
+FCALLSCSUB6(ffpkyg,FTPKYG,ftpkyg,FITSUNIT,STRING,DOUBLE,INT,STRING,PINT)
+FCALLSCSUB6(ffpkyd,FTPKYD,ftpkyd,FITSUNIT,STRING,DOUBLE,INT,STRING,PINT)
+FCALLSCSUB6(ffpkyc,FTPKYC,ftpkyc,FITSUNIT,STRING,FLOATV,INT,STRING,PINT)
+FCALLSCSUB6(ffpkym,FTPKYM,ftpkym,FITSUNIT,STRING,DOUBLEV,INT,STRING,PINT)
+FCALLSCSUB6(ffpkfc,FTPKFC,ftpkfc,FITSUNIT,STRING,FLOATV,INT,STRING,PINT)
+FCALLSCSUB6(ffpkfm,FTPKFM,ftpkfm,FITSUNIT,STRING,DOUBLEV,INT,STRING,PINT)
+FCALLSCSUB6(ffpkyt,FTPKYT,ftpkyt,FITSUNIT,STRING,LONG,DOUBLE,STRING,PINT)
+
+#define ftptdm_LONGV_A4 A3
+FCALLSCSUB5(ffptdm,FTPTDM,ftptdm,FITSUNIT,INT,INT,LONGV,PINT)
+
+/*----------------- write array of keywords --------------*/
+#define ftpkns_STRV_A5 NUM_ELEM_ARG(4)
+#define ftpkns_STRV_A6 NUM_ELEM_ARG(4)
+FCALLSCSUB7(ffpkns,FTPKNS,ftpkns,FITSUNIT,STRING,INT,INT,STRINGV,STRINGV,PINT)
+
+/*   Must handle LOGICALV conversion manually... ffpknl uses ints   */
+void Cffpknl( fitsfile *fptr, char *keyroot, int nstart, int nkeys,
+              int *numval, char **comment, int *status );
+void Cffpknl( fitsfile *fptr, char *keyroot, int nstart, int nkeys,
+              int *numval, char **comment, int *status )
+{
+   int i;
+ 
+   for( i=0; i<nkeys; i++ )
+      numval[i] = F2CLOGICAL(numval[i]);
+   ffpknl( fptr, keyroot, nstart, nkeys, numval, comment, status );
+   for( i=0; i<nkeys; i++ )
+      numval[i] = C2FLOGICAL(numval[i]);
+}
+#define ftpknl_STRV_A6 NUM_ELEM_ARG(4)
+FCALLSCSUB7(Cffpknl,FTPKNL,ftpknl,FITSUNIT,STRING,INT,INT,INTV,STRINGV,PINT)
+
+#define ftpknj_STRV_A6 NUM_ELEM_ARG(4)
+#define ftpknj_LONGV_A5 A4
+FCALLSCSUB7(ffpknj,FTPKNJ,ftpknj,FITSUNIT,STRING,INT,INT,LONGV,STRINGV,PINT)
+
+#define ftpknk_STRV_A6 NUM_ELEM_ARG(4)
+#define ftpknk_LONGLONGV_A5 A4
+FCALLSCSUB7(ffpknjj,FTPKNK,ftpknk,FITSUNIT,STRING,INT,INT,LONGLONGV,STRINGV,PINT)
+
+#define ftpknf_STRV_A7 NUM_ELEM_ARG(4)
+FCALLSCSUB8(ffpknf,FTPKNF,ftpknf,FITSUNIT,STRING,INT,INT,FLOATV,INT,STRINGV,PINT)
+
+#define ftpkne_STRV_A7 NUM_ELEM_ARG(4)
+FCALLSCSUB8(ffpkne,FTPKNE,ftpkne,FITSUNIT,STRING,INT,INT,FLOATV,INT,STRINGV,PINT)
+
+#define ftpkng_STRV_A7 NUM_ELEM_ARG(4)
+FCALLSCSUB8(ffpkng,FTPKNG,ftpkng,FITSUNIT,STRING,INT,INT,DOUBLEV,INT,STRINGV,PINT)
+
+#define ftpknd_STRV_A7 NUM_ELEM_ARG(4)
+FCALLSCSUB8(ffpknd,FTPKND,ftpknd,FITSUNIT,STRING,INT,INT,DOUBLEV,INT,STRINGV,PINT)
+
+FCALLSCSUB6(ffcpky,FTCPKY,ftcpky,FITSUNIT,FITSUNIT,INT,INT,STRING,PINT)
+
+/*----------------- write required header keywords --------------*/
+#define ftphps_LONGV_A4 A3
+FCALLSCSUB5(ffphps,FTPHPS,ftphps,FITSUNIT,INT,INT,LONGV,PINT)
+
+void Cffphpr( fitsfile *fptr, int simple, int bitpix, int naxis, long naxes[], long pcount, long gcount, int extend, int *status );
+void Cffphpr( fitsfile *fptr, int simple, int bitpix, int naxis, long naxes[], long pcount, long gcount, int extend, int *status )
+{
+   if( gcount==0 ) gcount=1;
+   ffphpr( fptr, simple, bitpix, naxis, naxes, pcount,
+           gcount, extend, status );
+}
+#define ftphpr_LONGV_A5 A4
+FCALLSCSUB9(Cffphpr,FTPHPR,ftphpr,FITSUNIT,LOGICAL,INT,INT,LONGV,LONG,LONG,LOGICAL,PINT)
+
+#define ftphext_LONGV_A5 A4
+FCALLSCSUB8(ffphext,FTPHEXT,ftphext,FITSUNIT,STRING,INT,INT,LONGV,LONG,LONG,PINT)
+
+
+#define ftphtb_STRV_A5 NUM_ELEM_ARG(4)
+#define ftphtb_STRV_A7 NUM_ELEM_ARG(4)
+#define ftphtb_STRV_A8 NUM_ELEM_ARG(4)
+#define ftphtb_LONGV_A6 A4
+FCALLSCSUB10(ffphtb,FTPHTB,ftphtb,FITSUNIT,LONG,LONG,INT,STRINGV,LONGV,STRINGV,STRINGV,STRING,PINT)
+
+#define ftphbn_STRV_A4 NUM_ELEM_ARG(3)
+#define ftphbn_STRV_A5 NUM_ELEM_ARG(3)
+#define ftphbn_STRV_A6 NUM_ELEM_ARG(3)
+FCALLSCSUB9(ffphbn,FTPHBN,ftphbn,FITSUNIT,LONG,INT,STRINGV,STRINGV,STRINGV,STRING,LONG,PINT)
+
+/*  Archaic names exist for preceding 3 functions...
+    continue supporting them.                           */
+
+#define ftpprh_LONGV_A5 A4
+FCALLSCSUB9(Cffphpr,FTPPRH,ftpprh,FITSUNIT,LOGICAL,INT,INT,LONGV,LONG,LONG,LOGICAL,PINT)
+
+#define ftpbnh_STRV_A4 NUM_ELEM_ARG(3)
+#define ftpbnh_STRV_A5 NUM_ELEM_ARG(3)
+#define ftpbnh_STRV_A6 NUM_ELEM_ARG(3)
+FCALLSCSUB9(ffphbn,FTPBNH,ftpbnh,FITSUNIT,LONG,INT,STRINGV,STRINGV,STRINGV,STRING,LONG,PINT)
+
+#define ftptbh_STRV_A5 NUM_ELEM_ARG(4)
+#define ftptbh_STRV_A7 NUM_ELEM_ARG(4)
+#define ftptbh_STRV_A8 NUM_ELEM_ARG(4)
+#define ftptbh_LONGV_A6 A4
+FCALLSCSUB10(ffphtb,FTPTBH,ftptbh,FITSUNIT,LONG,LONG,INT,STRINGV,LONGV,STRINGV,STRINGV,STRING,PINT)
+
+/*----------------- write template keywords --------------*/
+FCALLSCSUB3(ffpktp,FTPKTP,ftpktp,FITSUNIT,STRING,PINT)
+
+/*------------------ get header information --------------*/
+FCALLSCSUB4(ffghsp,FTGHSP,ftghsp,FITSUNIT,PINT,PINT,PINT)
+FCALLSCSUB4(ffghps,FTGHPS,ftghps,FITSUNIT,PINT,PINT,PINT)
+
+/*------------------ move position in header -------------*/
+FCALLSCSUB3(ffmaky,FTMAKY,ftmaky,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffmrky,FTMRKY,ftmrky,FITSUNIT,INT,PINT)
+
+/*------------------ read single keywords ----------------*/
+#define ftgnxk_STRV_A2 NUM_ELEM_ARG(3)
+#define ftgnxk_STRV_A4 NUM_ELEM_ARG(5)
+FCALLSCSUB7(ffgnxk,FTGNXK,ftgnxk,FITSUNIT,STRINGV,INT,STRINGV,INT,PSTRING,PINT)
+FCALLSCSUB4(ffgrec,FTGREC,ftgrec,FITSUNIT,INT,PSTRING,PINT)
+FCALLSCSUB4(ffgcrd,FTGCRD,ftgcrd,FITSUNIT,STRING,PSTRING,PINT)
+FCALLSCSUB4(ffgunt,FTGUNT,ftgunt,FITSUNIT,STRING,PSTRING,PINT)
+FCALLSCSUB6(ffgkyn,FTGKYN,ftgkyn,FITSUNIT,INT,PSTRING,PSTRING,PSTRING,PINT)
+FCALLSCSUB5(ffgkey,FTGKEY,ftgkey,FITSUNIT,STRING,PSTRING,PSTRING,PINT)
+
+/*   FTGKYS supported the long string convention but FFGKYS does not,
+     so redirect to FFGKLS.  To handle the pointer to a pointer,
+     manually expand the FCALLSC macro and modify function call.       */
+
+CFextern VOID_cfF(FTGKYS,ftgkys)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,STRING,PSTRING,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGKYS,ftgkys)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,STRING,PSTRING,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(STRING,2)
+   QCF(PSTRING,3)   /*  Defines a character pointer  */
+   QCF(PSTRING,4)
+   QCF(PINT,5)
+
+   ffgkls( TCF(ftgkys,FITSUNIT,1,0)
+           TCF(ftgkys,STRING,2,1)
+           , &B3                        /*  Pass address of pointer  */
+           TCF(ftgkys,PSTRING,4,1)
+           TCF(ftgkys,PINT,5,1)     );
+
+   RCF(FITSUNIT,1)
+   RCF(STRING,2)
+   RCF(PSTRING,3)      /*  Copies as much of pointer as will fit   */
+   RCF(PSTRING,4)      /*     into fortran string and frees space  */
+   RCF(PINT,5)
+}
+
+/*   This is the *real* wrapper to FFGKLS, although it is exactly the
+     same as the one for FFGKYS.  To handle the pointer to a pointer,
+     manually expand the FCALLSC macro and modify function call.       */
+
+CFextern VOID_cfF(FTGKLS,ftgkls)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,STRING,PSTRING,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGKLS,ftgkls)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,STRING,PSTRING,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(STRING,2)
+   QCF(PSTRING,3)   /*  Defines a character pointer  */
+   QCF(PSTRING,4)
+   QCF(PINT,5)
+
+   ffgkls( TCF(ftgkls,FITSUNIT,1,0)
+           TCF(ftgkls,STRING,2,1)
+           , &B3                        /*  Pass address of pointer  */
+           TCF(ftgkls,PSTRING,4,1)
+           TCF(ftgkls,PINT,5,1)     );
+
+   RCF(FITSUNIT,1)
+   RCF(STRING,2)
+   RCF(PSTRING,3)      /*  Copies as much of pointer as will fit   */
+   RCF(PSTRING,4)      /*     into fortran string and frees space  */
+   RCF(PINT,5)
+}
+
+FCALLSCSUB5(ffgkyl,FTGKYL,ftgkyl,FITSUNIT,STRING,PINT,PSTRING,PINT)
+FCALLSCSUB5(ffgkyj,FTGKYJ,ftgkyj,FITSUNIT,STRING,PLONG,PSTRING,PINT)
+FCALLSCSUB5(ffgkyjj,FTGKYK,ftgkyk,FITSUNIT,STRING,PLONGLONG,PSTRING,PINT)
+FCALLSCSUB5(ffgkye,FTGKYE,ftgkye,FITSUNIT,STRING,PFLOAT,PSTRING,PINT)
+FCALLSCSUB5(ffgkyd,FTGKYD,ftgkyd,FITSUNIT,STRING,PDOUBLE,PSTRING,PINT)
+FCALLSCSUB5(ffgkyc,FTGKYC,ftgkyc,FITSUNIT,STRING,PFLOAT,PSTRING,PINT)
+FCALLSCSUB5(ffgkym,FTGKYM,ftgkym,FITSUNIT,STRING,PDOUBLE,PSTRING,PINT)
+FCALLSCSUB6(ffgkyt,FTGKYT,ftgkyt,FITSUNIT,STRING,PLONG,PDOUBLE,PSTRING,PINT)
+
+#define ftgtdm_LONGV_A5 A3
+FCALLSCSUB6(ffgtdm,FTGTDM,ftgtdm,FITSUNIT,INT,INT,PINT,LONGV,PINT)
+
+/*------------------ read array of keywords -----------------*/
+
+     /*    Handle array of strings such that only the number of     */
+     /*    keywords actually found get copied back to the Fortran   */
+     /*    array.  Faster as well as won't cause array overflows    */
+     /*    if the the array is smaller than nkeys, but larger than  */
+     /*    nfound.                                                  */
+
+#define ftgkns_STRV_A5 NUM_ELEM_ARG(4)
+CFextern VOID_cfF(FTGKNS,ftgkns)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,STRING,INT,INT,PSTRINGV,PINT,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGKNS,ftgkns)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,STRING,INT,INT,PSTRINGV,PINT,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(STRING,2)
+   QCF(INT,3)
+   QCF(INT,4)
+   QCF(PSTRINGV,5)
+   QCF(PINT,6)
+   QCF(PINT,7)
+
+   ffgkns( TCF(ftgkns,FITSUNIT,1,0)
+           TCF(ftgkns,STRING,2,1)
+           TCF(ftgkns,INT,3,1)
+           TCF(ftgkns,INT,4,1)
+           TCF(ftgkns,PSTRINGV,5,1)   /*  Defines the number of strings  */
+                                      /*  in array, B5N                  */
+           TCF(ftgkns,PINT,6,1)
+           TCF(ftgkns,PINT,7,1)     );
+
+   if ( *A7 )       /*  Redefine number of array elements to  */
+      B5N = 0;      /*  number found, or none if error.       */
+   else
+      B5N = *A6;
+		      
+   RCF(FITSUNIT,1)
+   RCF(STRING,2)
+   RCF(INT,3)
+   RCF(INT,4)
+   RCF(PSTRINGV,5)     /*  Copies only found keywords back to Fortran    */
+   RCF(PINT,6)
+   RCF(PINT,7)
+}
+
+/*   Must handle LOGICALV conversion manually... ffgknl uses ints   */
+void Cffgknl( fitsfile *fptr, char *keyroot, int nstart, int nkeys,
+              int *numval, int *nfound, int *status );
+void Cffgknl( fitsfile *fptr, char *keyroot, int nstart, int nkeys,
+              int *numval, int *nfound, int *status )
+{
+   int i;
+ 
+   for( i=0; i<nkeys; i++ )  /*  This preserves array elements across call  */
+      numval[i] = F2CLOGICAL(numval[i]);
+   ffgknl( fptr, keyroot, nstart, nkeys, numval, nfound, status );
+   for( i=0; i<nkeys; i++ )
+      numval[i] = C2FLOGICAL(numval[i]);
+}
+FCALLSCSUB7(Cffgknl,FTGKNL,ftgknl,FITSUNIT,STRING,INT,INT,INTV,PINT,PINT)
+
+#define ftgknj_LONGV_A5 A4
+FCALLSCSUB7(ffgknj,FTGKNJ,ftgknj,FITSUNIT,STRING,INT,INT,LONGV,PINT,PINT)
+
+#define ftgknk_LONGLONGV_A5 A4
+FCALLSCSUB7(ffgknjj,FTGKNK,ftgknk,FITSUNIT,STRING,INT,INT,LONGLONGV,PINT,PINT)
+
+FCALLSCSUB7(ffgkne,FTGKNE,ftgkne,FITSUNIT,STRING,INT,INT,FLOATV,PINT,PINT)
+FCALLSCSUB7(ffgknd,FTGKND,ftgknd,FITSUNIT,STRING,INT,INT,DOUBLEV,PINT,PINT)
+
+/*----------------- read required header keywords --------------*/
+#define ftghpr_LONGV_A6 A2
+FCALLSCSUB10(ffghpr,FTGHPR,ftghpr,FITSUNIT,INT,PLOGICAL,PINT,PINT,LONGV,PLONG,PLONG,PLOGICAL,PINT)
+
+
+    /*  The following 2 routines contain 3 string vector parameters,  */
+    /*  intended to hold column information.  Normally the vectors    */
+    /*  are defined with 500-999 elements, but very rarely do tables  */
+    /*  have that many columns.  So, to prevent the allocation of     */
+    /*  240K of memory to hold all these empty strings and the waste  */
+    /*  of CPU time converting Fortran strings to C, *and* back       */
+    /*  again, get the number of columns in the table and only        */
+    /*  process that many strings (or maxdim, if it is smaller).      */
+
+#define ftghtb_STRV_A6 NUM_ELEMS(maxdim)
+#define ftghtb_STRV_A8 NUM_ELEMS(maxdim)
+#define ftghtb_STRV_A9 NUM_ELEMS(maxdim)
+#define ftghtb_LONGV_A7 A2
+CFextern VOID_cfF(FTGHTB,ftghtb)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,PLONG,PLONG,PINT,PSTRINGV,LONGV,PSTRINGV,PSTRINGV,PSTRING,PINT,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGHTB,ftghtb)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,PLONG,PLONG,PINT,PSTRINGV,LONGV,PSTRINGV,PSTRINGV,PSTRING,PINT,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(INT,2)
+   QCF(PLONG,3)
+   QCF(PLONG,4)
+   QCF(PINT,5)
+   QCF(PSTRINGV,6)
+   QCF(LONGV,7)
+   QCF(PSTRINGV,8)
+   QCF(PSTRINGV,9)
+   QCF(PSTRING,10)
+   QCF(PINT,11)
+
+   fitsfile *fptr;
+   long tfields;
+   int maxdim,*status;
+
+   fptr = TCF(ftghtb,FITSUNIT,1,0);
+   status =  TCF(ftghtb,PINT,11,0);
+   maxdim =  TCF(ftghtb,INT,2,0);
+   ffgkyj( fptr, "TFIELDS", &tfields, 0, status );
+   maxdim = (maxdim<0) ? tfields : _cfMIN(tfields,maxdim);
+
+   ffghtb(   fptr, maxdim
+             TCF(ftghtb,PLONG,3,1)
+             TCF(ftghtb,PLONG,4,1)
+             TCF(ftghtb,PINT,5,1)
+             TCF(ftghtb,PSTRINGV,6,1)
+             TCF(ftghtb,LONGV,7,1)
+             TCF(ftghtb,PSTRINGV,8,1)
+             TCF(ftghtb,PSTRINGV,9,1)
+             TCF(ftghtb,PSTRING,10,1)
+             , status );
+
+   RCF(FITSUNIT,1)
+   RCF(INT,2)
+   RCF(PLONG,3)
+   RCF(PLONG,4)
+   RCF(PINT,5)
+   RCF(PSTRINGV,6)
+   RCF(LONGV,7)
+   RCF(PSTRINGV,8)
+   RCF(PSTRINGV,9)
+   RCF(PSTRING,10)
+   RCF(PINT,11)
+}
+
+#define ftghbn_STRV_A5 NUM_ELEMS(maxdim)
+#define ftghbn_STRV_A6 NUM_ELEMS(maxdim)
+#define ftghbn_STRV_A7 NUM_ELEMS(maxdim)
+CFextern VOID_cfF(FTGHBN,ftghbn)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,PLONG,PINT,PSTRINGV,PSTRINGV,PSTRINGV,PSTRING,PLONG,PINT,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGHBN,ftghbn)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,PLONG,PINT,PSTRINGV,PSTRINGV,PSTRINGV,PSTRING,PLONG,PINT,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(INT,2)
+   QCF(PLONG,3)
+   QCF(PINT,4)
+   QCF(PSTRINGV,5)
+   QCF(PSTRINGV,6)
+   QCF(PSTRINGV,7)
+   QCF(PSTRING,8)
+   QCF(PLONG,9)
+   QCF(PINT,10)
+
+   fitsfile *fptr;
+   long tfields;
+   int maxdim,*status;
+
+   fptr = TCF(ftghbn,FITSUNIT,1,0);
+   status =  TCF(ftghbn,PINT,10,0);
+   maxdim =  TCF(ftghbn,INT,2,0);
+   ffgkyj( fptr, "TFIELDS", &tfields, 0, status );
+   maxdim = (maxdim<0) ? tfields : _cfMIN(tfields,maxdim);
+
+   ffghbn(   fptr, maxdim
+             TCF(ftghbn,PLONG,3,1)
+             TCF(ftghbn,PINT,4,1)
+             TCF(ftghbn,PSTRINGV,5,1)
+             TCF(ftghbn,PSTRINGV,6,1)
+             TCF(ftghbn,PSTRINGV,7,1)
+             TCF(ftghbn,PSTRING,8,1)
+             TCF(ftghbn,PLONG,9,1)
+             , status );
+
+   RCF(FITSUNIT,1)
+   RCF(INT,2)
+   RCF(PLONG,3)
+   RCF(PINT,4)
+   RCF(PSTRINGV,5)
+   RCF(PSTRINGV,6)
+   RCF(PSTRINGV,7)
+   RCF(PSTRING,8)
+   RCF(PLONG,9)
+   RCF(PINT,10)
+}
+
+    /*  LONGLONG version of the ftghbn routine: */
+
+#define ftghbnll_STRV_A5 NUM_ELEMS(maxdim)
+#define ftghbnll_STRV_A6 NUM_ELEMS(maxdim)
+#define ftghbnll_STRV_A7 NUM_ELEMS(maxdim)
+CFextern VOID_cfF(FTGHBNLL,ftghbnll)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,PLONGLONG,PINT,PSTRINGV,PSTRINGV,PSTRINGV,PSTRING,PLONGLONG,PINT,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGHBNLL,ftghbnll)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,PLONGLONG,PINT,PSTRINGV,PSTRINGV,PSTRINGV,PSTRING,PLONGLONG,PINT,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(INT,2)
+   QCF(PLONGLONG,3)
+   QCF(PINT,4)
+   QCF(PSTRINGV,5)
+   QCF(PSTRINGV,6)
+   QCF(PSTRINGV,7)
+   QCF(PSTRING,8)
+   QCF(PLONGLONG,9)
+   QCF(PINT,10)
+
+   fitsfile *fptr;
+   LONGLONG tfields;
+   int maxdim,*status;
+
+   fptr = TCF(ftghbnll,FITSUNIT,1,0);
+   status =  TCF(ftghbnll,PINT,10,0);
+   maxdim =  TCF(ftghbnll,INT,2,0);
+   ffgkyjj( fptr, "TFIELDS", &tfields, 0, status );
+   maxdim = (maxdim<0) ? tfields : _cfMIN(tfields,maxdim);
+
+   ffghbnll( fptr, maxdim
+             TCF(ftghbnll,PLONGLONG,3,1)
+             TCF(ftghbnll,PINT,4,1)
+             TCF(ftghbnll,PSTRINGV,5,1)
+             TCF(ftghbnll,PSTRINGV,6,1)
+             TCF(ftghbnll,PSTRINGV,7,1)
+             TCF(ftghbnll,PSTRING,8,1)
+             TCF(ftghbnll,PLONGLONG,9,1)
+             , status );
+
+   RCF(FITSUNIT,1)
+   RCF(INT,2)
+   RCF(PLONGLONG,3)
+   RCF(PINT,4)
+   RCF(PSTRINGV,5)
+   RCF(PSTRINGV,6)
+   RCF(PSTRINGV,7)
+   RCF(PSTRING,8)
+   RCF(PLONGLONG,9)
+   RCF(PINT,10)
+}
+
+    /*   The following 3 routines are obsolete and dangerous to use as       */
+    /*   there is no bounds checking with the arrays.  Call ftghxx instead.  */
+    /*   To get cfortran to work, ftgtbh and ftgbnh require information      */
+    /*   on the array size of the string vectors.  The "TFIELDS" key word    */
+    /*   is read and used as the vector size.  This *will* cause a           */
+    /*   problem if ttype, tform, and tunit are declared with fewer          */
+    /*   elements than the actual number of columns.                         */
+
+#if defined(LONG8BYTES_INT4BYTES)
+
+    /*  On platforms with 8-byte longs, we also need to worry about the */
+    /*  length of the long naxes array.  So read NAXIS manually. :(     */
+
+void Cffgprh( fitsfile *fptr, int *simple, int *bitpix, int *naxis, int naxes[],
+             long *pcount, long *gcount, int *extend, int *status );
+void Cffgprh( fitsfile *fptr, int *simple, int *bitpix, int *naxis, int naxes[],
+             long *pcount, long *gcount, int *extend, int *status )
+{
+   long *LONGnaxes, size;
+
+   ffgkyj( fptr, "NAXIS", &size, 0, status );
+   LONGnaxes = F2Clongv(size,naxes);
+   ffghpr( fptr, (int)size, simple, bitpix, naxis, LONGnaxes,
+           pcount, gcount, extend, status );
+   C2Flongv(size,naxes,LONGnaxes);
+}
+FCALLSCSUB9(Cffgprh,FTGPRH,ftgprh,FITSUNIT,PLOGICAL,PINT,PINT,INTV,PLONG,PLONG,PLOGICAL,PINT)
+
+#else
+
+void Cffgprh( fitsfile *fptr, int *simple, int *bitpix, int *naxis, long naxes[],
+             long *pcount, long *gcount, int *extend, int *status );
+void Cffgprh( fitsfile *fptr, int *simple, int *bitpix, int *naxis, long naxes[],
+             long *pcount, long *gcount, int *extend, int *status )
+{
+   ffghpr( fptr, -1, simple, bitpix, naxis, naxes,
+           pcount, gcount, extend, status );
+}
+#define ftgprh_LONGV_A5 NONE
+FCALLSCSUB9(Cffgprh,FTGPRH,ftgprh,FITSUNIT,PLOGICAL,PINT,PINT,LONGV,PLONG,PLONG,PLOGICAL,PINT)
+
+#endif
+
+#define ftgtbh_STRV_A5 NUM_ELEMS(tfields)
+#define ftgtbh_STRV_A7 NUM_ELEMS(tfields)
+#define ftgtbh_STRV_A8 NUM_ELEMS(tfields)
+CFextern VOID_cfF(FTGTBH,ftgtbh)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,PLONG,PLONG,PINT,PSTRINGV,PLONG,PSTRINGV,PSTRINGV,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGTBH,ftgtbh)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,PLONG,PLONG,PINT,PSTRINGV,PLONG,PSTRINGV,PSTRINGV,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(PLONG,2)
+   QCF(PLONG,3)
+   QCF(PINT,4)
+   QCF(PSTRINGV,5)
+   QCF(PLONG,6)
+   QCF(PSTRINGV,7)
+   QCF(PSTRINGV,8)
+   QCF(PSTRING,9)
+   QCF(PINT,10)
+
+   fitsfile *fptr;
+   long tfields;
+   int *status;
+
+   fptr = TCF(ftgtbh,FITSUNIT,1,0);
+   status =  TCF(ftgtbh,PINT,10,0);
+   ffgkyj( fptr, "TFIELDS", &tfields, 0, status );
+
+   ffghtb(   fptr, (int)tfields
+             TCF(ftgtbh,PLONG,2,1)
+             TCF(ftgtbh,PLONG,3,1)
+             TCF(ftgtbh,PINT,4,1)
+             TCF(ftgtbh,PSTRINGV,5,1)
+             TCF(ftgtbh,PLONG,6,1)
+             TCF(ftgtbh,PSTRINGV,7,1)
+             TCF(ftgtbh,PSTRINGV,8,1)
+             TCF(ftgtbh,PSTRING,9,1)
+             , status );
+
+   RCF(FITSUNIT,1)
+   RCF(PLONG,2)
+   RCF(PLONG,3)
+   RCF(PINT,4)
+   RCF(PSTRINGV,5)
+   RCF(PLONG,6)
+   RCF(PSTRINGV,7)
+   RCF(PSTRINGV,8)
+   RCF(PSTRING,9)
+   RCF(PINT,10)
+}
+
+#define ftgbnh_STRV_A4 NUM_ELEMS(tfields)
+#define ftgbnh_STRV_A5 NUM_ELEMS(tfields)
+#define ftgbnh_STRV_A6 NUM_ELEMS(tfields)
+CFextern VOID_cfF(FTGBNH,ftgbnh)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,PLONG,PINT,PSTRINGV,PSTRINGV,PSTRINGV,PSTRING,PLONG,PINT,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGBNH,ftgbnh)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,PLONG,PINT,PSTRINGV,PSTRINGV,PSTRINGV,PSTRING,PLONG,PINT,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FITSUNIT,1)
+   QCF(PLONG,2)
+   QCF(PINT,3)
+   QCF(PSTRINGV,4)
+   QCF(PSTRINGV,5)
+   QCF(PSTRINGV,6)
+   QCF(PSTRING,7)
+   QCF(PLONG,8)
+   QCF(PINT,9)
+
+   fitsfile *fptr;
+   long tfields;
+   int *status;
+
+   fptr = TCF(ftgbnh,FITSUNIT,1,0);
+   status =  TCF(ftgbnh,PINT,9,0);
+   ffgkyj( fptr, "TFIELDS", &tfields, 0, status );
+
+   ffghbn(   fptr, (int)tfields
+             TCF(ftgbnh,PLONG,2,1)
+             TCF(ftgbnh,PINT,3,1)
+             TCF(ftgbnh,PSTRINGV,4,1)
+             TCF(ftgbnh,PSTRINGV,5,1)
+             TCF(ftgbnh,PSTRINGV,6,1)
+             TCF(ftgbnh,PSTRING,7,1)
+             TCF(ftgbnh,PLONG,8,1)
+             , status );
+
+   RCF(FITSUNIT,1)
+   RCF(PLONG,2)
+   RCF(PINT,3)
+   RCF(PSTRINGV,4)
+   RCF(PSTRINGV,5)
+   RCF(PSTRINGV,6)
+   RCF(PSTRING,7)
+   RCF(PLONG,8)
+   RCF(PINT,9)
+}
+
+
+/*--------------------- update keywords ---------------*/
+FCALLSCSUB4(ffucrd,FTUCRD,ftucrd,FITSUNIT,STRING,STRING,PINT)
+FCALLSCSUB4(ffukyu,FTUKYU,ftukyu,FITSUNIT,STRING,STRING,PINT)
+FCALLSCSUB5(ffukys,FTUKYS,ftukys,FITSUNIT,STRING,STRING,STRING,PINT)
+FCALLSCSUB5(ffukls,FTUKLS,ftukls,FITSUNIT,STRING,STRING,STRING,PINT)
+FCALLSCSUB5(ffukyl,FTUKYL,ftukyl,FITSUNIT,STRING,INT,STRING,PINT)
+FCALLSCSUB5(ffukyj,FTUKYJ,ftukyj,FITSUNIT,STRING,LONG,STRING,PINT)
+FCALLSCSUB5(ffukyj,FTUKYK,ftukyk,FITSUNIT,STRING,LONGLONG,STRING,PINT)
+FCALLSCSUB6(ffukyf,FTUKYF,ftukyf,FITSUNIT,STRING,FLOAT,INT,STRING,PINT)
+FCALLSCSUB6(ffukye,FTUKYE,ftukye,FITSUNIT,STRING,FLOAT,INT,STRING,PINT)
+FCALLSCSUB6(ffukyg,FTUKYG,ftukyg,FITSUNIT,STRING,DOUBLE,INT,STRING,PINT)
+FCALLSCSUB6(ffukyd,FTUKYD,ftukyd,FITSUNIT,STRING,DOUBLE,INT,STRING,PINT)
+FCALLSCSUB6(ffukyc,FTUKYC,ftukyc,FITSUNIT,STRING,FLOATV,INT,STRING,PINT)
+FCALLSCSUB6(ffukym,FTUKYM,ftukym,FITSUNIT,STRING,DOUBLEV,INT,STRING,PINT)
+FCALLSCSUB6(ffukfc,FTUKFC,ftukfc,FITSUNIT,STRING,FLOATV,INT,STRING,PINT)
+FCALLSCSUB6(ffukfm,FTUKFM,ftukfm,FITSUNIT,STRING,DOUBLEV,INT,STRING,PINT)
+
+/*--------------------- modify keywords ---------------*/
+FCALLSCSUB4(ffmrec,FTMREC,ftmrec,FITSUNIT,INT,STRING,PINT)
+FCALLSCSUB4(ffmcrd,FTMCRD,ftmcrd,FITSUNIT,STRING,STRING,PINT)
+FCALLSCSUB4(ffmnam,FTMNAM,ftmnam,FITSUNIT,STRING,STRING,PINT)
+FCALLSCSUB4(ffmcom,FTMCOM,ftmcom,FITSUNIT,STRING,STRING,PINT)
+FCALLSCSUB4(ffmkyu,FTMKYU,ftmkyu,FITSUNIT,STRING,STRING,PINT)
+FCALLSCSUB5(ffmkys,FTMKYS,ftmkys,FITSUNIT,STRING,STRING,STRING,PINT)
+FCALLSCSUB5(ffmkls,FTMKLS,ftmkls,FITSUNIT,STRING,STRING,STRING,PINT)
+FCALLSCSUB5(ffmkyl,FTMKYL,ftmkyl,FITSUNIT,STRING,INT,STRING,PINT)
+FCALLSCSUB5(ffmkyj,FTMKYJ,ftmkyj,FITSUNIT,STRING,LONG,STRING,PINT)
+FCALLSCSUB5(ffmkyj,FTMKYK,ftmkyk,FITSUNIT,STRING,LONGLONG,STRING,PINT)
+FCALLSCSUB6(ffmkyf,FTMKYF,ftmkyf,FITSUNIT,STRING,FLOAT,INT,STRING,PINT)
+FCALLSCSUB6(ffmkye,FTMKYE,ftmkye,FITSUNIT,STRING,FLOAT,INT,STRING,PINT)
+FCALLSCSUB6(ffmkyg,FTMKYG,ftmkyg,FITSUNIT,STRING,DOUBLE,INT,STRING,PINT)
+FCALLSCSUB6(ffmkyd,FTMKYD,ftmkyd,FITSUNIT,STRING,DOUBLE,INT,STRING,PINT)
+FCALLSCSUB6(ffmkyc,FTMKYC,ftmkyc,FITSUNIT,STRING,FLOATV,INT,STRING,PINT)
+FCALLSCSUB6(ffmkym,FTMKYM,ftmkym,FITSUNIT,STRING,DOUBLEV,INT,STRING,PINT)
+FCALLSCSUB6(ffmkfc,FTMKFC,ftmkfc,FITSUNIT,STRING,FLOATV,INT,STRING,PINT)
+FCALLSCSUB6(ffmkfm,FTMKFM,ftmkfm,FITSUNIT,STRING,DOUBLEV,INT,STRING,PINT)
+
+/*--------------------- insert keywords ---------------*/
+FCALLSCSUB4(ffirec,FTIREC,ftirec,FITSUNIT,INT,STRING,PINT)
+FCALLSCSUB3(ffikey,FTIKEY,ftkey,FITSUNIT,STRING,PINT)
+FCALLSCSUB4(ffikyu,FTIKYU,ftikyu,FITSUNIT,STRING,STRING,PINT)
+FCALLSCSUB5(ffikys,FTIKYS,ftikys,FITSUNIT,STRING,STRING,STRING,PINT)
+FCALLSCSUB5(ffikls,FTIKLS,ftikls,FITSUNIT,STRING,STRING,STRING,PINT)
+FCALLSCSUB5(ffikyl,FTIKYL,ftikyl,FITSUNIT,STRING,INT,STRING,PINT)
+FCALLSCSUB5(ffikyj,FTIKYJ,ftikyj,FITSUNIT,STRING,LONG,STRING,PINT)
+FCALLSCSUB5(ffikyj,FTIKYK,ftikyk,FITSUNIT,STRING,LONGLONG,STRING,PINT)
+FCALLSCSUB6(ffikyf,FTIKYF,ftikyf,FITSUNIT,STRING,FLOAT,INT,STRING,PINT)
+FCALLSCSUB6(ffikye,FTIKYE,ftikye,FITSUNIT,STRING,FLOAT,INT,STRING,PINT)
+FCALLSCSUB6(ffikyg,FTIKYG,ftikyg,FITSUNIT,STRING,DOUBLE,INT,STRING,PINT)
+FCALLSCSUB6(ffikyd,FTIKYD,ftikyd,FITSUNIT,STRING,DOUBLE,INT,STRING,PINT)
+FCALLSCSUB6(ffikyc,FTIKYC,ftikyc,FITSUNIT,STRING,FLOATV,INT,STRING,PINT)
+FCALLSCSUB6(ffikym,FTIKYM,ftikym,FITSUNIT,STRING,DOUBLEV,INT,STRING,PINT)
+FCALLSCSUB6(ffikfc,FTIKFC,ftikfc,FITSUNIT,STRING,FLOATV,INT,STRING,PINT)
+FCALLSCSUB6(ffikfm,FTIKFM,ftikfm,FITSUNIT,STRING,DOUBLEV,INT,STRING,PINT)
+
+/*--------------------- delete keywords ---------------*/
+FCALLSCSUB3(ffdkey,FTDKEY,ftdkey,FITSUNIT,STRING,PINT)
+FCALLSCSUB3(ffdrec,FTDREC,ftdrec,FITSUNIT,INT,PINT)
+
+/*--------------------- get HDU information -------------*/
+FCALLSCSUB2(ffghdn,FTGHDN,ftghdn,FITSUNIT,PINT)
+FCALLSCSUB3(ffghdt,FTGHDT,ftghdt,FITSUNIT,PINT,PINT)
+
+FCALLSCSUB5(ffghad,FTGHAD,ftghad,FITSUNIT,PLONG,PLONG,PLONG,PINT)
+
+FCALLSCSUB3(ffgidt,FTGIDT,ftgidt,FITSUNIT,PINT,PINT)
+FCALLSCSUB3(ffgiet,FTGIET,ftgiet,FITSUNIT,PINT,PINT)
+FCALLSCSUB3(ffgidm,FTGIDM,ftgidm,FITSUNIT,PINT,PINT)
+
+#define ftgisz_LONGV_A3 A2
+FCALLSCSUB4(ffgisz,FTGISZ,ftgisz,FITSUNIT,INT,LONGV,PINT)
+
+#define ftgiszll_LONGLONGV_A3 A2
+FCALLSCSUB4(ffgiszll,FTGISZLL,ftgiszll,FITSUNIT,INT,LONGLONGV,PINT)
+
+#define ftgipr_LONGV_A5 A2
+FCALLSCSUB6(ffgipr,FTGIPR,ftgipr,FITSUNIT,INT,PINT,PINT,LONGV,PINT)
+
+#define ftgiprll_LONGLONGV_A5 A2
+FCALLSCSUB6(ffgiprll,FTGIPRLL,ftgiprll,FITSUNIT,INT,PINT,PINT,LONGLONGV,PINT)
+
+/*--------------------- HDU operations -------------*/
+FCALLSCSUB4(ffmahd,FTMAHD,ftmahd,FITSUNIT,INT,PINT,PINT)
+FCALLSCSUB4(ffmrhd,FTMRHD,ftmrhd,FITSUNIT,INT,PINT,PINT)
+FCALLSCSUB5(ffmnhd,FTMNHD,ftmnhd,FITSUNIT,INT,STRING,INT,PINT)
+FCALLSCSUB3(ffthdu,FTTHDU,ftthdu,FITSUNIT,PINT,PINT)
+FCALLSCSUB2(ffcrhd,FTCRHD,ftcrhd,FITSUNIT,PINT)
+
+#define ftcrim_LONGV_A4 A3
+FCALLSCSUB5(ffcrim,FTCRIM,ftcrim,FITSUNIT,INT,INT,LONGV,PINT)
+
+#define ftcrtb_STRV_A5 NUM_ELEM_ARG(4)
+#define ftcrtb_STRV_A6 NUM_ELEM_ARG(4)
+#define ftcrtb_STRV_A7 NUM_ELEM_ARG(4)
+FCALLSCSUB9(ffcrtb,FTCRTB,ftcrtb,FITSUNIT,INT,LONG,INT,STRINGV,STRINGV,STRINGV,STRING,PINT)
+
+#define ftiimg_LONGV_A4 A3
+FCALLSCSUB5(ffiimg,FTIIMG,ftiimg,FITSUNIT,INT,INT,LONGV,PINT)
+
+#define ftiimgll_LONGLONGV_A4 A3
+FCALLSCSUB5(ffiimgll,FTIIMGLL,ftiimgll,FITSUNIT,INT,INT,LONGLONGV,PINT)
+
+
+#define ftitab_STRV_A5 NUM_ELEM_ARG(4)
+#define ftitab_LONGV_A6 A4
+#define ftitab_STRV_A7 NUM_ELEM_ARG(4)
+#define ftitab_STRV_A8 NUM_ELEM_ARG(4)
+FCALLSCSUB10(ffitab,FTITAB,ftitab,FITSUNIT,LONG,LONG,INT,STRINGV,LONGV,STRINGV,STRINGV,STRING,PINT)
+
+#define ftitabll_STRV_A5 NUM_ELEM_ARG(4)
+#define ftitabll_LONGV_A6 A4
+#define ftitabll_STRV_A7 NUM_ELEM_ARG(4)
+#define ftitabll_STRV_A8 NUM_ELEM_ARG(4)
+FCALLSCSUB10(ffitab,FTITABLL,ftitabll,FITSUNIT,LONGLONG,LONGLONG,INT,STRINGV,LONGV,STRINGV,STRINGV,STRING,PINT)
+
+#define ftibin_STRV_A4 NUM_ELEM_ARG(3)
+#define ftibin_STRV_A5 NUM_ELEM_ARG(3)
+#define ftibin_STRV_A6 NUM_ELEM_ARG(3)
+FCALLSCSUB9(ffibin,FTIBIN,ftibin,FITSUNIT,LONG,INT,STRINGV,STRINGV,STRINGV,STRING,LONG,PINT)
+
+#define ftibinll_STRV_A4 NUM_ELEM_ARG(3)
+#define ftibinll_STRV_A5 NUM_ELEM_ARG(3)
+#define ftibinll_STRV_A6 NUM_ELEM_ARG(3)
+FCALLSCSUB9(ffibin,FTIBINLL,ftibinll,FITSUNIT,LONGLONG,INT,STRINGV,STRINGV,STRINGV,STRING,LONG,PINT)
+
+#define ftrsim_LONGV_A4 A3
+FCALLSCSUB5(ffrsim,FTRSIM,ftrsim,FITSUNIT,INT,INT,LONGV,PINT)
+FCALLSCSUB3(ffdhdu,FTDHDU,ftdhdu,FITSUNIT,PINT,PINT)
+FCALLSCSUB4(ffcopy,FTCOPY,ftcopy,FITSUNIT,FITSUNIT,INT,PINT)
+FCALLSCSUB6(ffcpfl,FTCPFL,ftcpfl,FITSUNIT,FITSUNIT,INT,INT,INT,PINT)
+FCALLSCSUB3(ffcphd,FTCPHD,ftcphd,FITSUNIT,FITSUNIT,PINT)
+FCALLSCSUB3(ffcpdt,FTCPDT,ftcpdt,FITSUNIT,FITSUNIT,PINT)
+FCALLSCSUB2(ffchfl,FTCHFL,ftchfl,FITSUNIT,PINT)
+FCALLSCSUB2(ffcdfl,FTCDFL,ftcdfl,FITSUNIT,PINT)
+
+FCALLSCSUB6(fits_copy_image2cell,FTIM2CELL,ftim2cell,FITSUNIT,FITSUNIT,STRING,LONG,INT,PINT)
+FCALLSCSUB5(fits_copy_cell2image,FTCELL2IM,ftcell2im,FITSUNIT,FITSUNIT,STRING,LONG,PINT)
+
+FCALLSCSUB2(ffrdef,FTRDEF,ftrdef,FITSUNIT,PINT)
+FCALLSCSUB3(ffhdef,FTHDEF,fthdef,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffpthp,FTPTHP,ftpthp,FITSUNIT,LONG,PINT)
+
+FCALLSCSUB2(ffpcks,FTPCKS,ftpcks,FITSUNIT,PINT)
+FCALLSCSUB4(ffvcks,FTVCKS,ftvcks,FITSUNIT,PINT,PINT,PINT)
+
+     /*  Checksum changed from double to long  */
+
+void Cffgcks( fitsfile *fptr, double *datasum, double *hdusum, int *status );
+void Cffgcks( fitsfile *fptr, double *datasum, double *hdusum, int *status )
+{
+   unsigned long data, hdu;
+
+   ffgcks( fptr, &data, &hdu, status );
+   *datasum = data;
+   *hdusum  = hdu;
+}
+FCALLSCSUB4(Cffgcks,FTGCKS,ftgcks,FITSUNIT,PDOUBLE,PDOUBLE,PINT)
+
+void Cffcsum( fitsfile *fptr, long nrec, double *dsum, int *status );
+void Cffcsum( fitsfile *fptr, long nrec, double *dsum, int *status )
+{
+   unsigned long sum;
+
+   ffcsum( fptr, nrec, &sum, status );
+   *dsum = sum;
+}
+FCALLSCSUB4(Cffcsum,FTCSUM,ftcsum,FITSUNIT,LONG,PDOUBLE,PINT)
+
+void Cffesum( double dsum, int complm, char *ascii );
+void Cffesum( double dsum, int complm, char *ascii )
+{
+   unsigned long sum=(unsigned long)dsum;
+
+   ffesum( sum, complm, ascii );
+}
+FCALLSCSUB3(Cffesum,FTESUM,ftesum,DOUBLE,LOGICAL,PSTRING)
+
+void Cffdsum( char *ascii, int complm, double *dsum );
+void Cffdsum( char *ascii, int complm, double *dsum )
+{
+   unsigned long sum;
+
+   ffdsum( ascii, complm, &sum );
+   *dsum = sum;
+}
+FCALLSCSUB3(Cffdsum,FTDSUM,ftdsum,PSTRING,LOGICAL,PDOUBLE)
+
+     /*   Name changed, so support both versions   */
+FCALLSCSUB2(ffupck,FTUPCK,ftupck,FITSUNIT,PINT)
+FCALLSCSUB2(ffupck,FTUCKS,ftucks,FITSUNIT,PINT)
+
+/*--------------- define scaling or null values -------------*/
+FCALLSCSUB4(ffpscl,FTPSCL,ftpscl,FITSUNIT,DOUBLE,DOUBLE,PINT)
+FCALLSCSUB3(ffpnul,FTPNUL,ftpnul,FITSUNIT,LONG,PINT)
+FCALLSCSUB3(ffpnul,FTPNULLL,ftpnulll,FITSUNIT,LONGLONG,PINT)
+FCALLSCSUB5(fftscl,FTTSCL,fttscl,FITSUNIT,INT,DOUBLE,DOUBLE,PINT)
+FCALLSCSUB4(fftnul,FTTNUL,fttnul,FITSUNIT,INT,LONG,PINT)
+FCALLSCSUB4(ffsnul,FTSNUL,ftsnul,FITSUNIT,INT,STRING,PINT)
+
+/*--------------------- get column information -------------*/
+FCALLSCSUB5(ffgcno,FTGCNO,ftgcno,FITSUNIT,LOGICAL,STRING,PINT,PINT)
+FCALLSCSUB6(ffgcnn,FTGCNN,ftgcnn,FITSUNIT,LOGICAL,STRING,PSTRING,PINT,PINT)
+FCALLSCSUB3(ffgnrw,FTGNRW,ftgnrw,FITSUNIT,PLONG,PINT)
+FCALLSCSUB3(ffgnrwll,FTGNRWLL,ftgnrwll,FITSUNIT,PLONGLONG,PINT)
+FCALLSCSUB3(ffgncl,FTGNCL,ftgncl,FITSUNIT,PINT,PINT)
+FCALLSCSUB4(ffgcdw,FTGCDW,ftgcdw,FITSUNIT,INT,PINT,PINT)
+
+FCALLSCSUB6(ffgtcl,FTGTCL,ftgtcl,FITSUNIT,INT,PINT,PLONG,PLONG,PINT)
+FCALLSCSUB6(ffeqty,FTEQTY,fteqty,FITSUNIT,INT,PINT,PLONG,PLONG,PINT)
+FCALLSCSUB11(ffgacl,FTGACL,ftgacl,FITSUNIT,INT,PSTRING,PLONG,PSTRING,PSTRING,PDOUBLE,PDOUBLE,PSTRING,PSTRING,PINT)
+FCALLSCSUB11(ffgbcl,FTGBCL,ftgbcl,FITSUNIT,INT,PSTRING,PSTRING,PSTRING,PLONG,PDOUBLE,PDOUBLE,PLONG,PSTRING,PINT)
+FCALLSCSUB3(ffgrsz,FTGRSZ,ftgrsz,FITSUNIT,PLONG,PINT)
+
+

external/cfitsio/f77_wrap4.c

@@ -0,0 +1,572 @@
+/************************************************************************
+
+     f77_wrap1.c and f77_wrap2.c have now been split into 4 files to
+     prevent compile-time memory errors (from expansion of compiler commands).
+     f77_wrap1.c was split into f77_wrap1.c and f77_wrap3.c, and
+     f77_wrap2.c was split into f77_wrap2.c and f77_wrap4.c:
+       
+       f77_wrap1.c contains routines operating on whole files and some 
+       utility routines.
+     
+       f77_wrap2.c contains routines operating on primary array, image, 
+       or column elements.
+
+       f77_wrap3.c contains routines operating on headers & keywords.
+
+       f77_wrap4.c contains miscellaneous routines.
+
+     Peter's original comments:
+
+     Together, f77_wrap1.c and f77_wrap2.c contain C wrappers for all
+     the CFITSIO routines prototyped in fitsio.h, except for the
+     generic datatype routines and features not supported in fortran
+     (eg, unsigned integers), a few routines prototyped in fitsio2.h,
+     which only a handful of FTOOLS use, plus a few obsolete FITSIO
+     routines not present in CFITSIO.  This file allows Fortran code
+     to use the CFITSIO library instead of the FITSIO library without
+     modification.  It also gives access to new routines not present
+     in FITSIO.  Fortran FTOOLS must continue using the old routine
+     names from FITSIO (ie, ftxxxx), but most of the C-wrappers simply
+     redirect those calls to the corresponding CFITSIO routines (ie,
+     ffxxxx), with appropriate parameter massaging where necessary.
+     The main exception are read/write routines ending in j (ie, long
+     data) which get redirected to C routines ending in k (ie, int
+     data). This is more consistent with the default integer type in
+     Fortran. f77_wrap1.c primarily holds routines operating on whole
+     files and extension headers.  f77_wrap2.c handle routines which
+     read and write the data portion, plus miscellaneous extra routines.
+     
+        File created by Peter Wilson (HSTX), Oct-Dec. 1997
+************************************************************************/
+
+#include "fitsio2.h"
+#include "f77_wrap.h"
+
+/*********************************************************************/
+/*                     Iterator Functions                            */
+/*********************************************************************/
+
+/* Use a simple ellipse prototype for Fwork_fn to satisfy finicky compilers */
+typedef struct {
+   void *userData;
+   void (*Fwork_fn)(PLONG_cfTYPE *total_n, ...);
+} FtnUserData;
+
+/*        Declare protoypes to make C++ happy       */
+int Cwork_fn(long, long, long, long, int, iteratorCol *, void *);
+void Cffiter( int n_cols, int *units, int *colnum, char *colname[], 
+	      int *datatype, int *iotype,
+              long offset, long n_per_loop, void *Fwork_fn,
+	      void *userData, int *status);
+
+/******************************************************************/
+/*  Cffiter is the wrapper for CFITSIO's ffiter which takes most  */
+/*  of its arguments via a structure, iteratorCol.  This routine  */
+/*  takes a list of arrays and converts them into a single array  */
+/*  of type iteratorCol and passes it to CFITSIO.  Because ffiter */
+/*  will be passing control to a Fortran work function, the C     */
+/*  wrapper, Cwork_fn, must be passed in its place which then     */
+/*  calls the Fortran routine after the necessary data            */
+/*  manipulation.  The Fortran routine is passed via the user-    */
+/*  supplied parameter pointer.                                   */
+/******************************************************************/
+
+void Cffiter( int n_cols, int *units, int *colnum, char *colname[], 
+	      int *datatype, int *iotype,
+              long offset, long n_per_loop, void *Fwork_fn,
+	      void *userData, int *status)
+{
+   iteratorCol *cols;
+   int i;
+   FtnUserData FuserData;
+
+   FuserData.Fwork_fn = (void(*)(PLONG_cfTYPE *,...))Fwork_fn;
+   FuserData.userData = userData;
+
+   cols = (iteratorCol *)malloc( n_cols*sizeof(iteratorCol) );
+   if( cols==NULL ) {
+      *status = MEMORY_ALLOCATION;
+      return;
+   }
+   for(i=0;i<n_cols;i++) {
+      cols[i].fptr     = gFitsFiles[ units[i] ];
+      cols[i].colnum   = colnum[i];
+      strncpy(cols[i].colname,colname[i],70);
+      cols[i].datatype = datatype[i];
+      cols[i].iotype   = iotype[i];
+   }
+
+   ffiter( n_cols, cols, offset, n_per_loop, Cwork_fn, 
+	   (void*)&FuserData, status );
+   free(cols);
+}
+#define ftiter_STRV_A4 NUM_ELEM_ARG(1)
+FCALLSCSUB11(Cffiter,FTITER,ftiter,INT,INTV,INTV,STRINGV,INTV,INTV,LONG,LONG,PVOID,PVOID,PINT)
+
+/*-----------------------------------------------------------------*/
+/*  This function is called by CFITSIO's ffiter and serves as the  */
+/*  wrapper for the Fortran work function which is passed in the   */
+/*  extra user-supplied pointer.  It breaks up C's iteratorCol     */
+/*  into several separate arrays.  Because we cannot send an       */
+/*  array of pointers for the column data, we instead send *many*  */
+/*  arrays as final parameters.                                    */
+/*-----------------------------------------------------------------*/
+
+int Cwork_fn( long total_n, long offset,       long first_n,    long n_values,
+	      int n_cols,   iteratorCol *cols, void *FuserData )
+{
+   int  *units, *colnum, *datatype, *iotype, *repeat;
+   char **sptr;
+   void **ptrs;
+   int  i,j,k,nstr,status=0;
+   long *slen;
+
+#ifdef vmsFortran
+   /*  Passing strings under VMS require a special structure  */
+   fstringvector *vmsStrs;
+#endif
+
+   /*  Allocate memory for all the arrays.  Grab all the int's  */
+   /*  at once and divide up among parameters                   */
+
+   ptrs  = (void**)malloc(2*n_cols*sizeof(void*));
+   if( ptrs==NULL )
+      return( MEMORY_ALLOCATION );
+   units = (int*)malloc(5*n_cols*sizeof(int));
+   if( units==NULL ) {
+      free(ptrs);
+      return( MEMORY_ALLOCATION );
+   }
+   colnum   = units + 1 * n_cols;
+   datatype = units + 2 * n_cols;
+   iotype   = units + 3 * n_cols;
+   repeat   = units + 4 * n_cols;
+
+   nstr = 0;
+   slen = (long*)(ptrs+n_cols);
+#ifdef vmsFortran
+   vmsStrs = (fstringvector *)calloc(sizeof(fstringvector),n_cols);
+   if( vmsStrs==NULL ) {
+      free(ptrs);
+      free(units);
+      return( MEMORY_ALLOCATION );
+   }
+#endif
+
+   for(i=0;i<n_cols;i++) {
+      for(j=0;j<MAXFITSFILES;j++)
+	 if( cols[i].fptr==gFitsFiles[j] )
+	    units[i] = j;
+      colnum[i]   = cols[i].colnum;
+      datatype[i] = cols[i].datatype;
+      iotype[i]   = cols[i].iotype;
+      repeat[i]   = cols[i].repeat;
+
+      if( datatype[i]==TLOGICAL ) {
+	 /*  Don't forget first element is null value  */
+	 ptrs[i] = (void *)malloc( (n_values*repeat[i]+1)*4 );
+	 if( ptrs[i]==NULL ) {
+	    free(ptrs);
+	    free(units);
+	    return( MEMORY_ALLOCATION );
+	 }
+	 for( j=0;j<=n_values*repeat[i]; j++ )
+	    ((int*)ptrs[i])[j] = C2FLOGICAL( ((char*)cols[i].array)[j]);
+      } else if ( datatype[i]==TSTRING ) {
+	 sptr = (char**)cols[i].array;
+	 slen[nstr] = sptr[1] - sptr[0];
+	 for(j=0;j<=n_values;j++)
+	    for(k=strlen( sptr[j] );k<slen[nstr];k++)
+	       sptr[j][k] = ' ';
+#ifdef vmsFortran
+	 vmsStrs[nstr].dsc$a_pointer         = sptr[0];
+	 vmsStrs[nstr].dsc$w_length          = slen[nstr];
+	 vmsStrs[nstr].dsc$l_m[0]            = n_values+1;
+	 vmsStrs[nstr].dsc$l_arsize          = slen[nstr] * (n_values+1);
+	 vmsStrs[nstr].dsc$bounds[0].dsc$l_u = n_values+1;
+	 vmsStrs[nstr].dsc$a_a0              = sptr[0] - slen[nstr];
+	 ptrs[i] = (void *)(vmsStrs+nstr);
+#else
+	 ptrs[i] = (void *)sptr[0];
+#endif
+	 nstr++;
+      } else
+	 ptrs[i] = (void *)cols[i].array;
+   }
+
+   if(!status) {
+              /*  Handle Fortran function call manually...  */
+	      /*  cfortran.h cannot handle all the desired  */
+              /*  'ptrs' nor the indirect function call.    */
+
+      PLONG_cfTYPE a1,a2,a3,a4;    /* Do this in case longs are */ 
+      FtnUserData *f;              /* not the same size as ints */
+
+      a1 = total_n;
+      a2 = offset;
+      a3 = first_n;
+      a4 = n_values;
+      f  = (FtnUserData *)FuserData;
+
+      f->Fwork_fn(&a1,&a2,&a3,&a4,&n_cols,units,colnum,datatype,
+		  iotype,repeat,&status,f->userData,
+		  ptrs[ 0], ptrs[ 1], ptrs[ 2], ptrs[ 3], ptrs[ 4],
+		  ptrs[ 5], ptrs[ 6], ptrs[ 7], ptrs[ 8], ptrs[ 9],
+		  ptrs[10], ptrs[11], ptrs[12], ptrs[13], ptrs[14],
+		  ptrs[15], ptrs[16], ptrs[17], ptrs[18], ptrs[19],
+		  ptrs[20], ptrs[21], ptrs[22], ptrs[23], ptrs[24] );
+   }
+
+   /*  Check whether there are any LOGICAL or STRING columns being outputted  */
+   nstr=0;
+   for( i=0;i<n_cols;i++ ) {
+      if( iotype[i]!=InputCol ) {
+	 if( datatype[i]==TLOGICAL ) {
+	    for( j=0;j<=n_values*repeat[i];j++ )
+	       ((char*)cols[i].array)[j] = F2CLOGICAL( ((int*)ptrs[i])[j] );
+	    free(ptrs[i]);
+	 } else if( datatype[i]==TSTRING ) {
+	    for( j=0;j<=n_values;j++ )
+	       ((char**)cols[i].array)[j][slen[nstr]-1] = '\0';
+	 }
+      }
+      if( datatype[i]==TSTRING ) nstr++;
+   }
+
+   free(ptrs);
+   free(units);
+#ifdef vmsFortran
+   free(vmsStrs);
+#endif
+   return(status);
+}
+
+
+/*--------------------- WCS Utilities ----------------------------*/
+FCALLSCSUB10(ffgics, FTGICS, ftgics, FITSUNIT,     PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PSTRING,PINT)
+FCALLSCSUB11(ffgicsa,FTGICSA,ftgicsa,FITSUNIT,BYTE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PSTRING,PINT)
+FCALLSCSUB12(ffgtcs,FTGTCS,ftgtcs,FITSUNIT,INT,INT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PSTRING,PINT)
+FCALLSCSUB13(ffwldp,FTWLDP,ftwldp,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,STRING,PDOUBLE,PDOUBLE,PINT)
+FCALLSCSUB13(ffxypx,FTXYPX,ftxypx,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,STRING,PDOUBLE,PDOUBLE,PINT)
+
+/*------------------- Conversion Utilities -----------------*/
+/*                 (prototyped in fitsio2.h)                */
+/*----------------------------------------------------------*/
+
+CFextern VOID_cfF(FTI2C,fti2c)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),LONG,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTI2C,fti2c)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),LONG,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(LONG,1)
+   QCF(PSTRING,2)
+   QCF(PINT,3)
+   char str[21];
+
+   ffi2c( TCF(fti2c,LONG,1,0) 
+          TCF(fti2c,PSTRING,2,1) 
+          TCF(fti2c,PINT,3,1) );
+
+   sprintf(str,"%20s",B2);
+   strcpy(B2,str);
+
+   RCF(LONG,1)
+   RCF(PSTRING,2)
+   RCF(PINT,3)
+}
+
+CFextern VOID_cfF(FTL2C,ftl2c)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),LOGICAL,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTL2C,ftl2c)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),LOGICAL,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(LOGICAL,1)
+   QCF(PSTRING,2)
+   QCF(PINT,3)
+   char str[21];
+
+   ffl2c( TCF(ftl2c,LOGICAL,1,0) 
+          TCF(ftl2c,PSTRING,2,1) 
+          TCF(ftl2c,PINT,3,1) );
+
+   sprintf(str,"%20s",B2);
+   strcpy(B2,str);
+
+   RCF(LOGICAL,1)
+   RCF(PSTRING,2)
+   RCF(PINT,3)
+}
+
+FCALLSCSUB3(ffs2c,FTS2C,fts2c,STRING,PSTRING,PINT)
+
+CFextern VOID_cfF(FTR2F,ftr2f)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FLOAT,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTR2F,ftr2f)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FLOAT,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FLOAT,1)
+   QCF(INT,2)
+   QCF(PSTRING,3)
+   QCF(PINT,4)
+   char str[21];
+
+   ffr2f( TCF(ftr2f,FLOAT,1,0) 
+          TCF(ftr2f,INT,2,1) 
+          TCF(ftr2f,PSTRING,3,1) 
+          TCF(ftr2f,PINT,4,1) );
+
+   sprintf(str,"%20s",B3);
+   strcpy(B3,str);
+
+   RCF(FLOAT,1)
+   RCF(INT,2)
+   RCF(PSTRING,3)
+   RCF(PINT,4)
+}
+
+CFextern VOID_cfF(FTR2E,ftr2e)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FLOAT,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTR2E,ftr2e)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FLOAT,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(FLOAT,1)
+   QCF(INT,2)
+   QCF(PSTRING,3)
+   QCF(PINT,4)
+   char str[21];
+
+   ffr2e( TCF(ftr2e,FLOAT,1,0) 
+          TCF(ftr2e,INT,2,1) 
+          TCF(ftr2e,PSTRING,3,1) 
+          TCF(ftr2e,PINT,4,1) );
+
+   sprintf(str,"%20s",B3);
+   strcpy(B3,str);
+
+   RCF(FLOAT,1)
+   RCF(INT,2)
+   RCF(PSTRING,3)
+   RCF(PINT,4)
+}
+
+CFextern VOID_cfF(FTD2F,ftd2f)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),DOUBLE,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTD2F,ftd2f)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),DOUBLE,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(DOUBLE,1)
+   QCF(INT,2)
+   QCF(PSTRING,3)
+   QCF(PINT,4)
+   char str[21];
+
+   ffd2f( TCF(ftd2f,DOUBLE,1,0) 
+          TCF(ftd2f,INT,2,1) 
+          TCF(ftd2f,PSTRING,3,1) 
+          TCF(ftd2f,PINT,4,1) );
+
+   sprintf(str,"%20s",B3);
+   strcpy(B3,str);
+
+   RCF(DOUBLE,1)
+   RCF(INT,2)
+   RCF(PSTRING,3)
+   RCF(PINT,4)
+}
+
+CFextern VOID_cfF(FTD2E,ftd2e)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),DOUBLE,INT,PSTRING,PINT,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTD2E,ftd2e)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),DOUBLE,INT,PSTRING,PINT,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+   QCF(DOUBLE,1)
+   QCF(INT,2)
+   QCF(PSTRING,3)
+   QCF(PINT,4)
+   QCF(PINT,5)
+   char str[21];
+   int *vlen;
+
+   vlen = TCF(ftd2e,PINT,4,0);
+
+   /*  C version of routine doesn't use the 4th parameter, vlen  */
+   ffd2e( TCF(ftd2e,DOUBLE,1,0) 
+          TCF(ftd2e,INT,2,1) 
+          TCF(ftd2e,PSTRING,3,1) 
+          TCF(ftd2e,PINT,5,1) );
+
+   *vlen = strlen(B3);
+   if ( *vlen<20 ) {
+      sprintf(str,"%20s",B3);  /* right justify if vlen<20 characters */
+      strcpy(B3,str);
+      *vlen = 20;
+   }
+
+   RCF(DOUBLE,1)
+   RCF(INT,2)
+   RCF(PSTRING,3)
+   RCF(PINT,4)
+   RCF(PINT,5)
+}
+
+FCALLSCSUB3(ffc2ii,FTC2II,ftc2ii,STRING,PLONG,PINT)
+FCALLSCSUB3(ffc2ll,FTC2LL,ftc2ll,STRING,PINT,PINT)
+FCALLSCSUB3(ffc2rr,FTC2RR,ftc2rr,STRING,PFLOAT,PINT)
+FCALLSCSUB3(ffc2dd,FTC2DD,ftc2dd,STRING,PDOUBLE,PINT)
+FCALLSCSUB7(ffc2x,FTC2X,ftc2x,STRING,PSTRING,PLONG,PINT,PSTRING,PDOUBLE,PINT)
+FCALLSCSUB3(ffc2s,FTC2S,ftc2s,STRING,PSTRING,PINT)
+FCALLSCSUB3(ffc2i,FTC2I,ftc2i,STRING,PLONG,PINT)
+FCALLSCSUB3(ffc2r,FTC2R,ftc2r,STRING,PFLOAT,PINT)
+FCALLSCSUB3(ffc2d,FTC2D,ftc2d,STRING,PDOUBLE,PINT)
+FCALLSCSUB3(ffc2l,FTC2L,ftc2l,STRING,PINT,PINT)
+
+/*------------------ Byte-level read/seek/write -----------------*/
+/*                   (prototyped in fitsio2.h)                   */
+/*---------------------------------------------------------------*/
+
+/*
+  ffmbyt should not be called by any application programs, so
+  the wrapper should not need to be defined.  If it is needed then
+  the second parameter (LONG) will need to be changed to the
+  equivalent of the C 'off_t' type, which may be 32 or 64 bits long
+  depending on the compiler.
+  -W.Pence (7/21/00)
+  
+FCALLSCSUB4(ffmbyt,FTMBYT,ftmbyt,FITSUNIT,LONG,LOGICAL,PINT)
+*/
+
+FCALLSCSUB4(ffgbyt,FTGCBF,ftgcbf,FITSUNIT,LONG,PVOID,PINT)
+FCALLSCSUB4(ffgbyt,FTGBYT,ftgbyt,FITSUNIT,LONG,PVOID,PINT)
+
+FCALLSCSUB4(ffpbyt,FTPCBF,ftpcbf,FITSUNIT,LONG,PVOID,PINT)
+FCALLSCSUB4(ffpbyt,FTPBYT,ftpbyt,FITSUNIT,LONG,PVOID,PINT)
+
+
+/*-------------- Additional missing FITSIO routines -------------*/
+/*                   (abandoned in CFITSIO)                      */
+/*---------------------------------------------------------------*/
+
+void Cffcrep( char *comm, char *comm1, int *repeat );
+void Cffcrep( char *comm, char *comm1, int *repeat )
+{
+/*
+   check if the first comment string is to be repeated for all keywords
+   (if the last non-blank character is '&', then it is to be repeated)
+
+   comm    input comment string
+   OUTPUT PARAMETERS:
+   comm1   output comment string, = COMM minus the last '&' character
+   repeat  TRUE if the last character of COMM was the '&' character
+
+   written by Wm Pence, HEASARC/GSFC, June 1991
+   translated to C by Peter Wilson, HSTX/GSFC, Oct 1997
+*/
+
+   int len;
+
+   *repeat=FALSE;
+   len=strlen(comm);
+       /* cfortran strips trailing spaces so only check last character  */
+   if( len && comm[ len-1 ]=='&' ) {
+      strncpy(comm1,comm,len-1);  /*  Don't copy '&'  */
+      comm1[len-1]='\0';
+      *repeat=TRUE;
+   }
+   return;
+}
+FCALLSCSUB3(Cffcrep,FTCREP,ftcrep,STRING,PSTRING,PLOGICAL)
+
+
+/*------------------ Test floats for NAN values -----------------*/
+/*                     (defined in fitsio2.h)                    */
+/*---------------------------------------------------------------*/
+
+int Cfnan( float *val );
+int Cfnan( float *val )
+{
+   int code;
+
+#if BYTESWAPPED
+   short *sptr = (short*)val + 1;
+#else
+   short *sptr = (short*)val;
+#endif
+
+   code = fnan(*sptr);
+   if( code==2 ) *val = 0.0;   /* Underflow */
+
+   return( code!=0 );
+}
+FCALLSCFUN1(LOGICAL,Cfnan,FTTRNN,fttrnn,PFLOAT)
+
+
+int Cdnan( double *val );
+int Cdnan( double *val )
+{
+   int code;
+
+#if BYTESWAPPED
+   short *sptr = (short*)val + 3;
+#else
+   short *sptr = (short*)val;
+#endif
+
+   code = dnan(*sptr);
+   if( code==2 ) *val = 0.0;   /* Underflow */
+
+   return( code!=0 );
+}
+FCALLSCFUN1(LOGICAL,Cdnan,FTTDNN,fttdnn,PDOUBLE)
+
+/*-------- Functions no longer supported... normally redundant -----------*/
+/*                Included only to support older code                     */
+/*------------------------------------------------------------------------*/
+
+void Cffempty(void);
+void Cffempty(void)
+{ return; }
+FCALLSCSUB0(Cffempty,FTPDEF,ftpdef)
+FCALLSCSUB0(Cffempty,FTBDEF,ftbdef)
+FCALLSCSUB0(Cffempty,FTADEF,ftadef)
+FCALLSCSUB0(Cffempty,FTDDEF,ftddef)
+
+
+/*-------- Functions which use the lex and yacc/bison parser code -----------*/
+/*---------------------------------------------------------------------------*/
+
+#define fttexp_LONGV_A7 A3
+FCALLSCSUB8(fftexp,FTTEXP,fttexp,FITSUNIT,STRING,INT,PINT,PLONG,PINT,LONGV,PINT)
+
+#define ftfrow_LOGV_A6 A4
+FCALLSCSUB7(fffrow,FTFROW,ftfrow,FITSUNIT,STRING,LONG,LONG,PLONG,LOGICALV,PINT)
+
+#define ftfrwc_LOGV_A8 A6
+FCALLSCSUB9(fffrwc,FTFRWC,ftfrwc,FITSUNIT,STRING,STRING,STRING,STRING,LONG,DOUBLEV,LOGICALV,PINT)
+FCALLSCSUB4(ffffrw,FTFFRW,ftffrw,FITSUNIT,STRING,PLONG,PINT)
+
+FCALLSCSUB4(ffsrow,FTSROW,ftsrow,FITSUNIT,FITSUNIT,STRING,PINT)
+FCALLSCSUB9(ffcrow,FTCROW,ftcrow,FITSUNIT,INT,STRING,LONG,LONG,PVOID,PVOID,PLOGICAL,PINT)
+FCALLSCSUB6(ffcalc,FTCALC,ftcalc,FITSUNIT,STRING,FITSUNIT,STRING,STRING,PINT)
+
+#define ftcalc_rng_LONGV_A7 A6
+#define ftcalc_rng_LONGV_A8 A6
+FCALLSCSUB9(ffcalc_rng,FTCALC_RNG,ftcalc_rng,FITSUNIT,STRING,FITSUNIT,STRING,STRING,INT,LONGV,LONGV,PINT)
+
+/*--------------------- grouping routines ------------------*/
+
+FCALLSCSUB4(ffgtcr,FTGTCR,ftgtcr,FITSUNIT,STRING,INT,PINT)
+FCALLSCSUB4(ffgtis,FTGTIS,ftgtis,FITSUNIT,STRING,INT,PINT)
+FCALLSCSUB3(ffgtch,FTGTCH,ftgtch,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffgtrm,FTGTRM,ftgtrm,FITSUNIT,INT,PINT)
+FCALLSCSUB4(ffgtcp,FTGTCP,ftgtcp,FITSUNIT,FITSUNIT,INT,PINT)
+FCALLSCSUB4(ffgtmg,FTGTMG,ftgtmg,FITSUNIT,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffgtcm,FTGTCM,ftgtcm,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffgtvf,FTGTVF,ftgtvf,FITSUNIT,PLONG,PINT)
+FCALLSCSUB4(ffgtop,FTGTOP,ftgtop,FITSUNIT,INT,PFITSUNIT,PINT)
+FCALLSCSUB4(ffgtam,FTGTAM,ftgtam,FITSUNIT,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffgtnm,FTGTNM,ftgtnm,FITSUNIT,PLONG,PINT)
+FCALLSCSUB3(ffgmng,FTGMNG,ftgmng,FITSUNIT,PLONG,PINT)
+FCALLSCSUB4(ffgmop,FTGMOP,ftgmop,FITSUNIT,LONG,PFITSUNIT,PINT)
+FCALLSCSUB5(ffgmcp,FTGMCP,ftgmcp,FITSUNIT,FITSUNIT,LONG,INT,PINT)
+FCALLSCSUB5(ffgmtf,FTGMTF,ftgmtf,FITSUNIT,FITSUNIT,LONG,INT,PINT)
+FCALLSCSUB4(ffgmrm,FTGMRM,ftgmrm,FITSUNIT,LONG,INT,PINT)

external/cfitsio/fitscopy.c

@@ -0,0 +1,60 @@
+#include <stdio.h>
+#include "fitsio.h"
+
+int main(int argc, char *argv[])
+{
+    fitsfile *infptr, *outfptr;   /* FITS file pointers defined in fitsio.h */
+    int status = 0;       /* status must always be initialized = 0  */
+
+    if (argc != 3)
+    {
+ printf("Usage:  fitscopy inputfile outputfile\n");
+ printf("\n");
+ printf("Copy an input file to an output file, optionally filtering\n");
+ printf("the file in the process.  This seemingly simple program can\n");
+ printf("apply powerful filters which transform the input file as\n");
+ printf("it is being copied.  Filters may be used to extract a\n");
+ printf("subimage from a larger image, select rows from a table,\n");
+ printf("filter a table with a GTI time extension or a SAO region file,\n");
+ printf("create or delete columns in a table, create an image by\n");
+ printf("binning (histogramming) 2 table columns, and convert IRAF\n");
+ printf("format *.imh or raw binary data files into FITS images.\n");
+ printf("See the CFITSIO User's Guide for a complete description of\n");
+ printf("the Extended File Name filtering syntax.\n");
+ printf("\n");
+ printf("Examples:\n");
+ printf("\n");
+ printf("fitscopy in.fit out.fit                   (simple file copy)\n");
+ printf("fitscopy - -                              (stdin to stdout)\n");
+ printf("fitscopy in.fit[11:50,21:60] out.fit      (copy a subimage)\n");
+ printf("fitscopy iniraf.imh out.fit               (IRAF image to FITS)\n");
+ printf("fitscopy in.dat[i512,512] out.fit         (raw array to FITS)\n");
+ printf("fitscopy in.fit[events][pi>35] out.fit    (copy rows with pi>35)\n");
+ printf("fitscopy in.fit[events][bin X,Y] out.fit  (bin an image) \n");
+ printf("fitscopy in.fit[events][col x=.9*y] out.fit        (new x column)\n");
+ printf("fitscopy in.fit[events][gtifilter()] out.fit       (time filter)\n");
+ printf("fitscopy in.fit[2][regfilter(\"pow.reg\")] out.fit (spatial filter)\n");
+ printf("\n");
+ printf("Note that it may be necessary to enclose the input file name\n");
+ printf("in single quote characters on the Unix command line.\n");
+      return(0);
+    }
+    /* Open the input file */
+    if ( !fits_open_file(&infptr, argv[1], READONLY, &status) )
+    {
+      /* Create the output file */
+      if ( !fits_create_file(&outfptr, argv[2], &status) )
+      {
+ 
+        /* copy the previous, current, and following HDUs */
+        fits_copy_file(infptr, outfptr, 1, 1, 1, &status);
+
+        fits_close_file(outfptr,  &status);
+      }
+      fits_close_file(infptr, &status);
+    }
+
+    /* if error occured, print out error message */
+    if (status) fits_report_error(stderr, status);
+    return(status);
+}

external/cfitsio/fitsfile.tpt

@@ -0,0 +1,8 @@
+xtension = 'bintable'
+naxis2 = 20
+TTYPE1 = 'SIZE' / comment here
+TFORM1 = 1J / my first column
+TTYPE2 = 'DISTANCE'
+TFORM2 = 1E / my second column
+mykey = 16 / this is my comment
+

external/cfitsio/fitsio.toc

@@ -0,0 +1,95 @@
+\contentsline {chapter}{\numberline {1}Introduction }{1}
+\contentsline {chapter}{\numberline {2} Creating FITSIO/CFITSIO }{3}
+\contentsline {section}{\numberline {2.1}Building the Library}{3}
+\contentsline {section}{\numberline {2.2}Testing the Library}{6}
+\contentsline {section}{\numberline {2.3}Linking Programs with FITSIO}{8}
+\contentsline {section}{\numberline {2.4}Getting Started with FITSIO}{8}
+\contentsline {section}{\numberline {2.5}Example Program}{8}
+\contentsline {section}{\numberline {2.6}Legal Stuff}{10}
+\contentsline {section}{\numberline {2.7}Acknowledgments}{10}
+\contentsline {chapter}{\numberline {3} A FITS Primer }{13}
+\contentsline {chapter}{\numberline {4}FITSIO Conventions and Guidelines }{15}
+\contentsline {section}{\numberline {4.1}CFITSIO Size Limitations}{15}
+\contentsline {section}{\numberline {4.2}Multiple Access to the Same FITS File}{16}
+\contentsline {section}{\numberline {4.3}Current Header Data Unit (CHDU)}{16}
+\contentsline {section}{\numberline {4.4}Subroutine Names}{16}
+\contentsline {section}{\numberline {4.5}Subroutine Families and Datatypes}{17}
+\contentsline {section}{\numberline {4.6}Implicit Data Type Conversion}{17}
+\contentsline {section}{\numberline {4.7}Data Scaling}{18}
+\contentsline {section}{\numberline {4.8}Error Status Values and the Error Message Stack}{18}
+\contentsline {section}{\numberline {4.9}Variable-Length Array Facility in Binary Tables}{19}
+\contentsline {section}{\numberline {4.10}Support for IEEE Special Values}{20}
+\contentsline {section}{\numberline {4.11}When the Final Size of the FITS HDU is Unknown}{21}
+\contentsline {section}{\numberline {4.12}Local FITS Conventions supported by FITSIO}{21}
+\contentsline {subsection}{\numberline {4.12.1}Support for Long String Keyword Values.}{21}
+\contentsline {subsection}{\numberline {4.12.2}Arrays of Fixed-Length Strings in Binary Tables}{22}
+\contentsline {subsection}{\numberline {4.12.3}Keyword Units Strings}{23}
+\contentsline {subsection}{\numberline {4.12.4}HIERARCH Convention for Extended Keyword Names}{23}
+\contentsline {section}{\numberline {4.13}Optimizing Code for Maximum Processing Speed}{24}
+\contentsline {subsection}{\numberline {4.13.1}Background Information: How CFITSIO Manages Data I/O}{25}
+\contentsline {subsection}{\numberline {4.13.2}Optimization Strategies}{25}
+\contentsline {chapter}{\numberline {5} Basic Interface Routines }{29}
+\contentsline {section}{\numberline {5.1}FITSIO Error Status Routines }{29}
+\contentsline {section}{\numberline {5.2}File I/O Routines}{30}
+\contentsline {section}{\numberline {5.3}Keyword I/O Routines}{32}
+\contentsline {section}{\numberline {5.4}Data I/O Routines}{33}
+\contentsline {chapter}{\numberline {6} Advanced Interface Subroutines }{35}
+\contentsline {section}{\numberline {6.1}FITS File Open and Close Subroutines: }{35}
+\contentsline {section}{\numberline {6.2}HDU-Level Operations }{38}
+\contentsline {section}{\numberline {6.3}Define or Redefine the structure of the CHDU }{41}
+\contentsline {section}{\numberline {6.4}FITS Header I/O Subroutines}{43}
+\contentsline {subsection}{\numberline {6.4.1}Header Space and Position Routines }{43}
+\contentsline {subsection}{\numberline {6.4.2}Read or Write Standard Header Routines }{43}
+\contentsline {subsection}{\numberline {6.4.3}Write Keyword Subroutines }{45}
+\contentsline {subsection}{\numberline {6.4.4}Insert Keyword Subroutines }{47}
+\contentsline {subsection}{\numberline {6.4.5}Read Keyword Subroutines }{47}
+\contentsline {subsection}{\numberline {6.4.6}Modify Keyword Subroutines }{49}
+\contentsline {subsection}{\numberline {6.4.7}Update Keyword Subroutines }{50}
+\contentsline {subsection}{\numberline {6.4.8}Delete Keyword Subroutines }{50}
+\contentsline {section}{\numberline {6.5}Data Scaling and Undefined Pixel Parameters }{51}
+\contentsline {section}{\numberline {6.6}FITS Primary Array or IMAGE Extension I/O Subroutines }{52}
+\contentsline {section}{\numberline {6.7}FITS ASCII and Binary Table Data I/O Subroutines}{55}
+\contentsline {subsection}{\numberline {6.7.1}Column Information Subroutines }{55}
+\contentsline {subsection}{\numberline {6.7.2}Low-Level Table Access Subroutines }{58}
+\contentsline {subsection}{\numberline {6.7.3}Edit Rows or Columns }{58}
+\contentsline {subsection}{\numberline {6.7.4}Read and Write Column Data Routines }{60}
+\contentsline {section}{\numberline {6.8}Row Selection and Calculator Routines }{64}
+\contentsline {section}{\numberline {6.9}Celestial Coordinate System Subroutines }{65}
+\contentsline {section}{\numberline {6.10}File Checksum Subroutines }{67}
+\contentsline {section}{\numberline {6.11} Date and Time Utility Routines }{68}
+\contentsline {section}{\numberline {6.12}General Utility Subroutines }{69}
+\contentsline {chapter}{\numberline {7} The CFITSIO Iterator Function }{75}
+\contentsline {chapter}{\numberline {8} Extended File Name Syntax }{77}
+\contentsline {section}{\numberline {8.1}Overview}{77}
+\contentsline {section}{\numberline {8.2}Filetype}{80}
+\contentsline {subsection}{\numberline {8.2.1}Notes about HTTP proxy servers}{80}
+\contentsline {subsection}{\numberline {8.2.2}Notes about the stream filetype driver}{81}
+\contentsline {subsection}{\numberline {8.2.3}Notes about the gsiftp filetype}{82}
+\contentsline {subsection}{\numberline {8.2.4}Notes about the root filetype}{82}
+\contentsline {subsection}{\numberline {8.2.5}Notes about the shmem filetype:}{84}
+\contentsline {section}{\numberline {8.3}Base Filename}{84}
+\contentsline {section}{\numberline {8.4}Output File Name when Opening an Existing File}{86}
+\contentsline {section}{\numberline {8.5}Template File Name when Creating a New File}{88}
+\contentsline {section}{\numberline {8.6}Image Tile-Compression Specification}{88}
+\contentsline {section}{\numberline {8.7}HDU Location Specification}{88}
+\contentsline {section}{\numberline {8.8}Image Section}{89}
+\contentsline {section}{\numberline {8.9}Image Transform Filters}{90}
+\contentsline {section}{\numberline {8.10}Column and Keyword Filtering Specification}{92}
+\contentsline {section}{\numberline {8.11}Row Filtering Specification}{94}
+\contentsline {subsection}{\numberline {8.11.1}General Syntax}{94}
+\contentsline {subsection}{\numberline {8.11.2}Bit Masks}{97}
+\contentsline {subsection}{\numberline {8.11.3}Vector Columns}{98}
+\contentsline {subsection}{\numberline {8.11.4}Good Time Interval Filtering}{99}
+\contentsline {subsection}{\numberline {8.11.5}Spatial Region Filtering}{100}
+\contentsline {subsection}{\numberline {8.11.6}Example Row Filters}{103}
+\contentsline {section}{\numberline {8.12} Binning or Histogramming Specification}{104}
+\contentsline {chapter}{\numberline {9}Template Files }{107}
+\contentsline {section}{\numberline {9.1}Detailed Template Line Format}{107}
+\contentsline {section}{\numberline {9.2}Auto-indexing of Keywords}{108}
+\contentsline {section}{\numberline {9.3}Template Parser Directives}{109}
+\contentsline {section}{\numberline {9.4}Formal Template Syntax}{109}
+\contentsline {section}{\numberline {9.5}Errors}{110}
+\contentsline {section}{\numberline {9.6}Examples}{110}
+\contentsline {chapter}{\numberline {10} Summary of all FITSIO User-Interface Subroutines }{113}
+\contentsline {chapter}{\numberline {11} Parameter Definitions }{121}
+\contentsline {chapter}{\numberline {12} FITSIO Error Status Codes }{127}

external/cfitsio/fpack.c

@@ -0,0 +1,387 @@
+/* FPACK
+ * R. Seaman, NOAO, with a few enhancements by W. Pence, HEASARC
+ *
+ * Calls fits_img_compress in the CFITSIO library by W. Pence, HEASARC
+ */
+
+#include <ctype.h>
+/* #include <signal.h> */
+#include "fitsio.h"
+#include "fpack.h"
+
+/* ================================================================== */
+int main(int argc, char *argv[])
+{
+	fpstate	fpvar;
+
+	if (argc <= 1) { fp_usage (); fp_hint (); exit (-1); }
+
+	fp_init (&fpvar);
+	fp_get_param (argc, argv, &fpvar);
+
+	if (fpvar.listonly) {
+	    fp_list (argc, argv, fpvar);
+
+	} else {
+	    fp_preflight (argc, argv, FPACK, &fpvar);
+	    fp_loop (argc, argv, FPACK, fpvar);
+	}
+
+	exit (0);
+}
+/* ================================================================== */
+int fp_get_param (int argc, char *argv[], fpstate *fpptr)
+{
+	int	gottype=0, gottile=0, wholetile=0, iarg, len, ndim, ii, doffset;
+	char	tmp[SZ_STR], tile[SZ_STR];
+
+        if (fpptr->initialized != FP_INIT_MAGIC) {
+            fp_msg ("Error: internal initialization error\n"); exit (-1);
+        }
+
+	tile[0] = 0;
+
+	/* flags must come first and be separately specified
+	 */
+	for (iarg = 1; iarg < argc; iarg++) {
+	    if ((argv[iarg][0] == '-' && strlen (argv[iarg]) == 2) ||
+	        !strncmp(argv[iarg], "-q", 2) ||   /*  special case */
+	        !strncmp(argv[iarg], "-g1", 3) ||   /*  special case */
+	        !strncmp(argv[iarg], "-g2", 3) ||   /*  special case */
+	        !strncmp(argv[iarg], "-i2f", 4) ||  /*  special case */
+	        !strncmp(argv[iarg], "-fast", 5) ||  /*  special case */
+	        !strncmp(argv[iarg], "-n3ratio", 8) ||  /*  special case */
+	        !strncmp(argv[iarg], "-n3min", 6) ||  /*  special case */
+	        !strncmp(argv[iarg], "-BETAtable", 10) )  /*  special case */
+	    {
+
+		/* Rice is the default, so -r is superfluous 
+		 */
+		if (       argv[iarg][1] == 'r') {
+		    fpptr->comptype = RICE_1;
+		    if (gottype) {
+			fp_msg ("Error: multiple compression flags\n");
+			fp_usage (); exit (-1);
+		    } else
+			gottype++;
+
+		} else if (argv[iarg][1] == 'p') {
+		    fpptr->comptype = PLIO_1;
+		    if (gottype) {
+			fp_msg ("Error: multiple compression flags\n");
+			fp_usage (); exit (-1);
+		    } else
+			gottype++;
+
+		} else if (argv[iarg][1] == 'g') {
+		    /* test for modifiers following the 'g' */
+                    if (argv[iarg][2] == '2')
+		        fpptr->comptype = GZIP_2;
+		    else
+		        fpptr->comptype = GZIP_1;
+
+		    if (gottype) {
+			fp_msg ("Error: multiple compression flags\n");
+			fp_usage (); exit (-1);
+		    } else
+			gottype++;
+/*
+		} else if (argv[iarg][1] == 'b') {
+		    fpptr->comptype = BZIP2_1;
+		    if (gottype) {
+			fp_msg ("Error: multiple compression flags\n");
+			fp_usage (); exit (-1);
+		    } else
+			gottype++;
+*/
+		} else if (argv[iarg][1] == 'h') {
+		    fpptr->comptype = HCOMPRESS_1;
+		    if (gottype) {
+			fp_msg ("Error: multiple compression flags\n");
+			fp_usage (); exit (-1);
+		    } else
+			gottype++;
+
+		} else if (argv[iarg][1] == 'd') {
+		    fpptr->comptype = NOCOMPRESS;
+		    if (gottype) {
+			fp_msg ("Error: multiple compression flags\n");
+			fp_usage (); exit (-1);
+		    } else
+			gottype++;
+
+		} else if (!strcmp(argv[iarg], "-i2f")) {
+		    /* this means convert integer images to float, and then */
+		    /* quantize and compress the float image.  This lossy */
+		    /* compression method may give higher compression than the */
+		    /* lossless compression method that is usually applied to */
+		    /* integer images. */
+		    
+		    fpptr->int_to_float = 1;
+
+		} else if (!strcmp(argv[iarg], "-n3ratio")) {
+		    /* this is the minimum ratio between the MAD noise sigma */
+		    /* and the q parameter value in the case where the integer */
+		    /* image is quantized and compressed like a float image. */
+		    if (++iarg >= argc) {
+			fp_usage (); exit (-1);
+		    } else {
+			fpptr->n3ratio = (float) atof (argv[iarg]);
+		    }
+		} else if (!strcmp(argv[iarg], "-n3min")) {
+		    /* this is the minimum  MAD noise sigma in the case where the */
+		    /* integer image is quantized and compressed like a float image. */
+		    if (++iarg >= argc) {
+			fp_usage (); exit (-1);
+		    } else {
+			fpptr->n3min = (float) atof (argv[iarg]);
+		    }
+		} else if (argv[iarg][1] == 'q') {
+		    /* test for modifiers following the 'q' */
+                    if (argv[iarg][2] == 't') {
+		        fpptr->dither_offset = -1;  /* dither based on tile checksum */
+
+                    } else if (isdigit(argv[iarg][2])) { /* is a number appended to q? */
+		       doffset = atoi(argv[iarg]+2);
+
+                       if (doffset == 0) {
+		          fpptr->no_dither = 1;  /* don't dither the quantized values */
+		       } else if (doffset > 0 && doffset <= 10000) {
+		          fpptr->dither_offset = doffset;
+		       } else {
+			  fp_msg ("Error: invalid q suffix\n");
+			  fp_usage (); exit (-1);
+		       }
+		    }
+
+		    if (++iarg >= argc) {
+			fp_usage (); exit (-1);
+		    } else {
+			fpptr->quantize_level = (float) atof (argv[iarg]);
+		    }
+		} else if (argv[iarg][1] == 'n') {
+		    if (++iarg >= argc) {
+			fp_usage (); exit (-1);
+		    } else {
+			fpptr->rescale_noise = (float) atof (argv[iarg]);
+		    }
+		} else if (argv[iarg][1] == 's') {
+		    if (++iarg >= argc) {
+			fp_usage (); exit (-1);
+		    } else {
+			fpptr->scale = (float) atof (argv[iarg]);
+		    }
+		} else if (argv[iarg][1] == 't') {
+		    if (gottile) {
+			fp_msg ("Error: multiple tile specifications\n");
+			fp_usage (); exit (-1);
+		    } else
+			gottile++;
+
+		    if (++iarg >= argc) {
+			fp_usage (); exit (-1);
+		    } else
+			strncpy (tile, argv[iarg], SZ_STR); /* checked below */
+
+		} else if (argv[iarg][1] == 'v') {
+		    fpptr->verbose = 1;
+
+		} else if (argv[iarg][1] == 'w') {
+		    wholetile++;
+		    if (gottile) {
+			fp_msg ("Error: multiple tile specifications\n");
+			fp_usage (); exit (-1);
+		    } else
+			gottile++;
+
+		} else if (argv[iarg][1] == 'F') {
+		    fpptr->clobber++;       /* overwrite existing file */
+
+		} else if (argv[iarg][1] == 'D') {
+		    fpptr->delete_input++;
+
+		} else if (argv[iarg][1] == 'Y') {
+		    fpptr->do_not_prompt++;
+
+		} else if (argv[iarg][1] == 'S') {
+		    fpptr->to_stdout++;
+
+		} else if (argv[iarg][1] == 'L') {
+		    fpptr->listonly++;
+
+		} else if (argv[iarg][1] == 'C') {
+		    fpptr->do_checksums = 0;
+
+		} else if (argv[iarg][1] == 'T') {
+		    fpptr->test_all = 1;
+
+		} else if (argv[iarg][1] == 'R') {
+		    if (++iarg >= argc) {
+			fp_usage (); fp_hint (); exit (-1);
+		    } else
+			strncpy (fpptr->outfile, argv[iarg], SZ_STR);
+
+		} else if (argv[iarg][1] == 'H') {
+		    fp_help (); exit (0);
+
+		} else if (argv[iarg][1] == 'V') {
+		    fp_version (); exit (0);
+
+		} else if (!strcmp(argv[iarg], "-BETAtable")) {
+		    fpptr->do_tables = 1;
+		    fp_msg ("Caution: -BETAtable is for feasibility studies, not general use.\n");
+
+		} else if (!strcmp(argv[iarg], "-fast")) {
+		    fpptr->do_fast = 1;
+
+		} else {
+		    fp_msg ("Error: unknown command line flag `");
+		    fp_msg (argv[iarg]); fp_msg ("'\n");
+		    fp_usage (); fp_hint (); exit (-1);
+		}
+
+	    } else
+		break;
+	}
+
+	if (fpptr->scale != 0. && 
+	         fpptr->comptype != HCOMPRESS_1 && fpptr->test_all != 1) {
+
+	    fp_msg ("Error: `-s' requires `-h or -T'\n"); exit (-1);
+	}
+
+	if (fpptr->quantize_level == 0) {
+	
+	    if ((fpptr->comptype != GZIP_1) && (fpptr->comptype != GZIP_2)) {
+	        fp_msg ("Error: `-q 0' only allowed with GZIP\n"); exit (-1);
+	    }
+
+            if (fpptr->int_to_float == 1) {
+	        fp_msg ("Error: `-q 0' not allowed with -i2f\n"); exit (-1);
+	    }
+	}
+
+	if (wholetile) {
+	    for (ndim=0; ndim < MAX_COMPRESS_DIM; ndim++)
+		fpptr->ntile[ndim] = (long) 0;
+
+	} else if (gottile) {
+	    len = strlen (tile);
+	    for (ii=0, ndim=0; ii < len; ) {
+		if (! (isdigit (tile[ii]) || tile[ii] == ',')) {
+		    fp_msg ("Error: `-t' requires comma separated tile dims, ");
+		    fp_msg ("e.g., `-t 100,100'\n"); exit (-1);
+		}
+
+		if (tile[ii] == ',') { ii++; continue; }
+
+		fpptr->ntile[ndim] = atol (&tile[ii]);
+		for ( ; isdigit(tile[ii]); ii++);
+
+		if (++ndim > MAX_COMPRESS_DIM) {
+		    fp_msg ("Error: too many dimensions for `-t', max=");
+		    sprintf (tmp, "%d\n", MAX_COMPRESS_DIM); fp_msg (tmp);
+		    exit (-1);
+		}
+	    }
+	}
+
+	if (iarg >= argc) {
+	    fp_msg ("Error: no FITS files to compress\n");
+	    fp_usage (); exit (-1);
+	} else
+	    fpptr->firstfile = iarg;
+
+	return(0);
+}
+
+/* ================================================================== */
+int fp_usage (void)
+{
+fp_msg ("usage: fpack ");
+fp_msg (
+"[-r|-h|-g|-p] [-w|-t <axes>] [-q <level>] [-s <scale>] [-n <noise>] -v <FITS>\n");
+fp_msg ("more:   [-T] [-R] [-F] [-D] [-Y] [-S] [-L] [-C] [-H] [-V] [-i2f]\n");
+return(0);
+}
+
+/* ================================================================== */
+int fp_hint (void) 
+{ fp_msg ("      `fpack -H' for help\n"); 
+return(0);
+}
+
+/* ================================================================== */
+int fp_help (void)
+{
+fp_msg ("fpack, a FITS image compression program.  Version ");
+fp_version ();
+fp_usage ();
+fp_msg ("\n");
+
+fp_msg ("Flags must be separate and appear before filenames:\n");
+fp_msg (" -r          Rice compression [default], or\n");
+fp_msg (" -h          Hcompress compression, or\n");
+fp_msg (" -g  or -g1  GZIP_1 (per-tile) compression, or\n");
+fp_msg (" -g2         GZIP_2 (per-tile) compression (with byte shuffling), or\n");
+/*
+fp_msg (" -b          BZIP2 (per-tile) compression, or\n");
+*/
+fp_msg (" -p          PLIO compression (only for positive 8 or 16-bit integer images).\n");
+fp_msg (" -d          Tile the image without compression (debugging mode).\n");
+
+fp_msg (" -w          Compress the whole image as a single large tile.\n");
+fp_msg (" -t <axes>   Comma separated list of tile dimensions [default is row by row].\n");
+
+fp_msg (" -q <level>  Quantized level spacing when converting floating point images to\n");
+fp_msg ("             scaled integers. (+value relative to sigma of background noise;\n");
+fp_msg ("             -value is absolute). Default q value of 4 gives a compression ratio\n");
+fp_msg ("             of about 6 with very high fidelity (only 0.26% increase in noise).\n");
+fp_msg ("             Using q values of  2, or 1 will give compression ratios of\n");
+fp_msg ("             about 8, or 10, respectively (with 1.0% or 4.1% noise increase).\n");
+fp_msg ("             The scaled quantized values are randomly dithered using a seed \n");
+fp_msg ("             value determined from the system clock at run time.\n");
+fp_msg ("             Use -q0 instead of -q to suppress random dithering.\n");
+fp_msg ("             Use -qt to compute random dithering seed from first tile checksum.\n");
+fp_msg ("             Use -qN, (N in range 1 to 10000) to use a specific dithering seed.\n");
+fp_msg ("             Floating-point images can be losslessly compressed by selecting\n");
+fp_msg ("             the GZIP algorithm and specifying -q 0, but this is slower and often\n");
+fp_msg ("             produces much less compression than the default quantization method.\n");
+fp_msg (" -i2f        Convert integer images to floating point, then quantize and compress\n");
+fp_msg ("             using the specified q level.  When used appropriately, this lossy\n");
+fp_msg ("             compression method can give much better compression than the normal\n");
+fp_msg ("             lossless compression methods without significant loss of information.\n");
+fp_msg ("             The -n3ratio and -n3min flags control the minimum noise thresholds;\n");
+fp_msg ("             Images below these thresholds will be losslessly compressed.\n");
+fp_msg (" -n3ratio    Minimum ratio of background noise sigma divided by q.  Default = 1.2.\n");
+fp_msg (" -n3min      Minimum background noise sigma. Default = 6. The -i2f flag will be ignored\n");
+fp_msg ("             if the noise level in the image does not exceed both thresholds.\n");
+fp_msg (" -s <scale>  Scale factor for lossy Hcompress [default = 0 = lossless]\n");
+fp_msg ("             (+values relative to RMS noise; -value is absolute)\n");
+fp_msg (" -n <noise>  Rescale scaled-integer images to reduce noise and improve compression.\n");
+fp_msg (" -v          Verbose mode; list each file as it is processed.\n");
+fp_msg (" -T          Show compression algorithm comparison test statistics; files unchanged.\n");
+fp_msg (" -R <file>   Write the comparison test report (above) to a text file.\n");
+fp_msg (" -BETAtable  Compress FITS binary tables using prototype method.\n");
+fp_msg ("             This option is ONLY for experimental use!  Do NOT use\n");
+fp_msg ("             on FITS data files that are to be publicly distributed.\n");
+fp_msg (" -fast       Used with -BETAtable to favor speed over maximum compression.\n");
+
+fp_msg ("\nkeywords shared with funpack:\n");
+
+fp_msg (" -F          Overwrite input file by output file with same name.\n");
+fp_msg (" -D          Delete input file after writing output.\n");
+fp_msg (" -Y          Suppress prompts to confirm -F or -D options.\n");
+
+fp_msg (" -S          Output compressed FITS files to STDOUT.\n");
+fp_msg (" -L          List contents; files unchanged.\n");
+
+fp_msg (" -C          Don't update FITS checksum keywords.\n");
+
+fp_msg (" -H          Show this message.\n");
+fp_msg (" -V          Show version number.\n");
+
+fp_msg ("\n <FITS>      FITS files to pack; enter '-' (a hyphen) to read input from stdin stream.\n");
+fp_msg (" Refer to the fpack User's Guide for more extensive help.\n");
+return(0);
+}

external/cfitsio/fpack.h

@@ -0,0 +1,171 @@
+/* used by FPACK and FUNPACK
+ * R. Seaman, NOAO
+ * W. Pence, NASA/GSFC
+ */
+
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+/* not needed any more */
+/* #include <unistd.h> */
+/* #include <sys/stat.h> */
+/* #include <sys/types.h> */
+
+#define	FPACK_VERSION	"1.6.0 (Feb 2011)"
+/*
+VERSION	History
+
+1.6.0 (June 2012)
+    - Fixed behavior of the "rename" function on Windows platforms so that
+      it will clobber/delete an existing file before renaming a file to 
+      that name (the rename command behaves differently on POSIX and non-POSIX
+      environments).
+
+1.6.0 (February 2011)
+    - Added full support for compressing and uncompressing FITS binary tables
+      using a newly proposed format convention.  This is intended only for
+      further feasibility studies, and is not recommended for use with publicly
+      distributed FITS files.
+    - Use the minimum of the MAD 2nd, 3rd, and 5th order values as a more
+      conservative extimate of the noise when quantizing floating point images.
+    - Enhanced the tile compression routines so that a tile that contains all
+      NaN pixel values will be compressed.
+    - When uncompressing an image that was originally in a FITS primary array,
+      funpack will also append any new keywords that were written into the 
+      primary array of the compressed FITS file after the file was compressed.
+    - Added support for the GZIP_2 algorithm, which shuffles the bytes in the
+      pixel values prior to compressing them with gzip.      
+1.5.1 (December 2010) Added prototype, mainly hidden, support for compressing 
+      binary tables.  
+1.5.0 (August 2010) Added the -i2f option to lossy compress integer images.
+1.4.0 (Jan 2010) Reduced the default value for the q floating point image 
+      quantization parameter from 16 to 4.  This results in about 50% better
+      compression (from about 4.6x to 6.4) with no lost of significant information 
+      (with the new subtractive dithering enhancement).  Replaced the code for
+      generating temporary filenames to make the code more portable (to Windows). 
+      Replaced calls to the unix 'access' and 'stat' functions with more portable
+      code.   When unpacking a file, write it first to a temporary file, then
+      rename it when finished, so that other tasks cannot try to read the file
+      before it is complete.
+1.3.0 (Oct 2009) added randomization to the dithering pattern so that
+      the same pattern is not used for every image; also added an option
+      for losslessly compressing floating point images with GZIP for test 
+      purposes (not recommended for general use).  Also added support for
+      reading the input FITS file from the stdin file streams.
+1.2.0 (Sept 2009) added subtractive dithering feature (in CFITSIO) when
+      quantizing floating point images; When packing an IRAF .imh + .pix image,
+      the file name is changed to FILE.fits.fz, and if the original file is
+      deleted, then both the .imh and .pix files are deleted.
+1.1.4 (May 2009) added -E option to funpack to unpack a list of HDUs
+1.1.3 (March 2009)  minor modifications to the content and format of the -T report
+1.1.2 (September 2008)
+*/
+
+#define	FP_INIT_MAGIC	42
+#define	FPACK		0
+#define	FUNPACK		1
+
+/* changed from 16 in Jan. 2010 */
+#define	DEF_QLEVEL	4.  
+
+#define	DEF_HCOMP_SCALE	 0.
+#define	DEF_HCOMP_SMOOTH 0
+#define	DEF_RESCALE_NOISE 0
+
+#define	SZ_STR		513
+#define	SZ_CARD		81
+
+
+typedef struct
+{
+	int	comptype;
+	float	quantize_level;
+	int     no_dither;
+	int     dither_offset;
+	float	scale;
+	float	rescale_noise;
+	int	smooth;
+	int	int_to_float;
+	float	n3ratio;
+	float	n3min;
+	long	ntile[MAX_COMPRESS_DIM];
+
+	int	to_stdout;
+	int	listonly;
+	int	clobber;
+	int	delete_input;
+	int	do_not_prompt;
+	int	do_checksums;
+	int	do_gzip_file;
+	int     do_tables;  
+	int     do_fast;
+	int	test_all;
+	int	verbose;
+
+	char	prefix[SZ_STR];
+	char	extname[SZ_STR];
+	int	delete_suffix;
+	char	outfile[SZ_STR];
+	int	firstfile;
+
+	int	initialized;
+	int	preflight_checked;
+} fpstate;
+
+typedef struct
+{
+	int	n_nulls;
+	double	minval;
+	double 	maxval;
+	double	mean;
+	double	sigma;
+	double	noise1;
+	double	noise2;
+	double	noise3;
+	double	noise5;
+} imgstats;
+
+int fp_get_param (int argc, char *argv[], fpstate *fpptr);
+void abort_fpack(int sig);
+void fp_abort_output (fitsfile *infptr, fitsfile *outfptr, int stat); 
+int fp_usage (void);
+int fp_help (void);
+int fp_hint (void); 
+int fp_init (fpstate *fpptr);
+int fp_list (int argc, char *argv[], fpstate fpvar);
+int fp_info (char *infits);
+int fp_info_hdu (fitsfile *infptr);
+int fp_preflight (int argc, char *argv[], int unpack, fpstate *fpptr);
+int fp_loop (int argc, char *argv[], int unpack, fpstate fpvar);
+int fp_pack (char *infits, char *outfits, fpstate fpvar, int *islossless);
+int fp_unpack (char *infits, char *outfits, fpstate fpvar);
+int fp_test (char *infits, char *outfits, char *outfits2, fpstate fpvar);
+int fp_pack_hdu (fitsfile *infptr, fitsfile *outfptr, fpstate fpvar, 
+    int *islossless, int *status);
+int fp_unpack_hdu (fitsfile *infptr, fitsfile *outfptr, fpstate fpvar, int *status);
+int fits_read_image_speed (fitsfile *infptr, float *whole_elapse, 
+    float *whole_cpu, float *row_elapse, float *row_cpu, int *status);
+int fp_test_hdu (fitsfile *infptr, fitsfile *outfptr, fitsfile *outfptr2, 
+	fpstate fpvar, int *status);
+int marktime(int *status);
+int gettime(float *elapse, float *elapscpu, int *status);
+int fits_read_image_speed (fitsfile *infptr, float *whole_elapse, 
+    float *whole_cpu, float *row_elapse, float *row_cpu, int *status);
+
+int fp_i2stat(fitsfile *infptr, int naxis, long *naxes, imgstats *imagestats, int *status);
+int fp_i4stat(fitsfile *infptr, int naxis, long *naxes, imgstats *imagestats, int *status);
+int fp_r4stat(fitsfile *infptr, int naxis, long *naxes, imgstats *imagestats, int *status);
+int fp_i2rescale(fitsfile *infptr, int naxis, long *naxes, double rescale,
+    fitsfile *outfptr, int *status);
+int fp_i4rescale(fitsfile *infptr, int naxis, long *naxes, double rescale,
+    fitsfile *outfptr, int *status);
+    
+int fp_msg (char *msg);
+int fp_version (void);
+int fp_noop (void);
+
+int fu_get_param (int argc, char *argv[], fpstate *fpptr);
+int fu_usage (void);
+int fu_hint (void);
+int fu_help (void);

external/cfitsio/funpack.c

@@ -0,0 +1,168 @@
+/* FUNPACK
+ * R. Seaman, NOAO
+ * uses fits_img_compress by W. Pence, HEASARC
+ */
+
+#include "fitsio.h"
+#include "fpack.h"
+
+int main (int argc, char *argv[])
+{
+	fpstate	fpvar;
+
+	if (argc <= 1) { fu_usage (); fu_hint (); exit (-1); }
+
+	fp_init (&fpvar);
+	fu_get_param (argc, argv, &fpvar);
+
+	if (fpvar.listonly) {
+	    fp_list (argc, argv, fpvar);
+
+	} else {
+	    fp_preflight (argc, argv, FUNPACK, &fpvar);
+	    fp_loop (argc, argv, FUNPACK, fpvar);
+	}
+
+	exit (0);
+}
+
+int fu_get_param (int argc, char *argv[], fpstate *fpptr)
+{
+	int	gottype=0, gottile=0, wholetile=0, iarg, len, ndim, ii;
+	char	tmp[SZ_STR], tile[SZ_STR];
+
+        if (fpptr->initialized != FP_INIT_MAGIC) {
+            fp_msg ("Error: internal initialization error\n"); exit (-1);
+        }
+
+	tile[0] = 0;
+
+        /* by default, .fz suffix characters to be deleted from compressed file */
+	fpptr->delete_suffix = 1;
+
+	/* flags must come first and be separately specified
+	 */
+	for (iarg = 1; iarg < argc; iarg++) {
+	    if (argv[iarg][0] == '-' && strlen (argv[iarg]) == 2) {
+
+		if (argv[iarg][1] == 'F') {
+		    fpptr->clobber++;
+                    fpptr->delete_suffix = 0;  /* no suffix in this case */
+
+		} else if (argv[iarg][1] == 'D') {
+		    fpptr->delete_input++;
+
+		} else if (argv[iarg][1] == 'P') {
+		    if (++iarg >= argc) {
+			fu_usage (); fu_hint (); exit (-1);
+		    } else
+			strncpy (fpptr->prefix, argv[iarg], SZ_STR);
+
+		} else if (argv[iarg][1] == 'E') {
+		    if (++iarg >= argc) {
+			fu_usage (); fu_hint (); exit (-1);
+		    } else
+			strncpy (fpptr->extname, argv[iarg], SZ_STR);
+
+		} else if (argv[iarg][1] == 'S') {
+		    fpptr->to_stdout++;
+
+		} else if (argv[iarg][1] == 'L') {
+		    fpptr->listonly++;
+
+		} else if (argv[iarg][1] == 'C') {
+		    fpptr->do_checksums = 0;
+
+		} else if (argv[iarg][1] == 'H') {
+		    fu_help (); exit (0);
+
+		} else if (argv[iarg][1] == 'V') {
+		    fp_version (); exit (0);
+
+		} else if (argv[iarg][1] == 'Z') {
+		    fpptr->do_gzip_file++;
+
+		} else if (argv[iarg][1] == 'v') {
+		    fpptr->verbose = 1;
+
+		} else if (argv[iarg][1] == 'O') {
+		    if (++iarg >= argc) {
+			fu_usage (); fu_hint (); exit (-1);
+		    } else
+			strncpy (fpptr->outfile, argv[iarg], SZ_STR);
+
+		} else {
+		    fp_msg ("Error: unknown command line flag `");
+		    fp_msg (argv[iarg]); fp_msg ("'\n");
+		    fu_usage (); fu_hint (); exit (-1);
+		}
+
+	    } else
+		break;
+	}
+	
+	if (fpptr->extname[0] && (fpptr->clobber || fpptr->delete_input)) {
+	    fp_msg ("Error: -E option may not be used with -F or -D\n");
+	    fu_usage (); exit (-1);
+        }
+
+	if (fpptr->to_stdout && (fpptr->outfile[0] || fpptr->prefix[0]) ) {
+
+	    fp_msg ("Error: -S option may not be used with -P or -O\n");
+	    fu_usage (); exit (-1);
+        }
+
+	if (fpptr->outfile[0] && fpptr->prefix[0] ) {
+	    fp_msg ("Error: -P and -O options may not be used together\n");
+	    fu_usage (); exit (-1);
+        }
+
+	if (iarg >= argc) {
+	    fp_msg ("Error: no FITS files to uncompress\n");
+	    fu_usage (); exit (-1);
+	} else
+	    fpptr->firstfile = iarg;
+
+	return(0);
+}
+
+int fu_usage (void)
+{
+	fp_msg ("usage: funpack [-E <HDUlist>] [-P <pre>] [-O <name>] [-Z] -v <FITS>\n");
+        fp_msg ("more:   [-F] [-D] [-S] [-L] [-C] [-H] [-V] \n");
+	return(0);
+}
+
+int fu_hint (void)
+{
+	fp_msg ("      `funpack -H' for help\n");
+	return(0);
+}
+
+int fu_help (void)
+{
+fp_msg ("funpack, decompress fpacked files.  Version ");
+fp_version ();
+fu_usage ();
+fp_msg ("\n");
+
+fp_msg ("Flags must be separate and appear before filenames:\n");
+fp_msg (" -E <HDUlist> Unpack only the list of HDU names or numbers in the file.\n");
+fp_msg (" -P <pre>    Prepend <pre> to create new output filenames.\n");
+fp_msg (" -O <name>   Specify full output file name.\n");
+fp_msg (" -Z          Recompress the output file with host GZIP program.\n");
+fp_msg (" -F          Overwrite input file by output file with same name.\n");
+fp_msg (" -D          Delete input file after writing output.\n");
+fp_msg (" -S          Output uncompressed file to STDOUT file stream.\n");
+fp_msg (" -L          List contents, files unchanged.\n");
+
+fp_msg (" -C          Don't update FITS checksum keywords.\n");
+
+fp_msg (" -v          Verbose mode; list each file as it is processed.\n");
+fp_msg (" -H          Show this message.\n");
+fp_msg (" -V          Show version number.\n");
+
+fp_msg (" \n<FITS>       FITS files to unpack; enter '-' (a hyphen) to read from stdin.\n");
+fp_msg (" Refer to the fpack User's Guide for more extensive help.\n");
+	return(0);
+}

external/cfitsio/getcoll.c

@@ -0,0 +1,614 @@
+/*  This file, getcoll.c, contains routines that read data elements from   */
+/*  a FITS image or table, with logical datatype.                          */
+
+/*  The FITSIO software was written by William Pence at the High Energy    */
+/*  Astrophysic Science Archive Research Center (HEASARC) at the NASA      */
+/*  Goddard Space Flight Center.                                           */
+
+#include <stdlib.h>
+#include <string.h>
+#include "fitsio2.h"
+/*--------------------------------------------------------------------------*/
+int ffgcvl( fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col)  */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
+            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
+            LONGLONG  nelem,      /* I - number of values to read                */
+            char  nulval,     /* I - value for null pixels                   */
+            char *array,      /* O - array of values                         */
+            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
+            int  *status)     /* IO - error status                           */
+/*
+  Read an array of logical values from a column in the current FITS HDU.
+  Any undefined pixels will be set equal to the value of 'nulval' unless
+  nulval = 0 in which case no checks for undefined pixels will be made.
+*/
+{
+    char cdummy;
+
+    ffgcll( fptr, colnum, firstrow, firstelem, nelem, 1, nulval, array,
+            &cdummy, anynul, status);
+
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcl(  fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col)  */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
+            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
+            LONGLONG  nelem,      /* I - number of values to read                */
+            char *array,      /* O - array of values                         */
+            int  *status)     /* IO - error status                           */
+/*
+  !!!! THIS ROUTINE IS DEPRECATED AND SHOULD NOT BE USED !!!!!!
+                  !!!! USE ffgcvl INSTEAD  !!!!!!
+  Read an array of logical values from a column in the current FITS HDU.
+  No checking for null values will be performed.
+*/
+{
+    char nulval = 0;
+    int anynul;
+
+    ffgcvl( fptr, colnum, firstrow, firstelem, nelem, nulval, array,
+            &anynul, status);
+
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfl( fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col)  */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
+            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
+            LONGLONG  nelem,      /* I - number of values to read                */
+            char *array,      /* O - array of values                         */
+            char *nularray,   /* O - array of flags = 1 if nultyp = 2        */
+            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
+            int  *status)     /* IO - error status                           */
+/*
+  Read an array of logical values from a column in the current FITS HDU.
+*/
+{
+    char nulval = 0;
+
+    ffgcll( fptr, colnum, firstrow, firstelem, nelem, 2, nulval, array,
+            nularray, anynul, status);
+
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcll( fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col)  */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
+            LONGLONG  firstelem, /* I - first vector element to read (1 = 1st)  */
+            LONGLONG  nelem,      /* I - number of values to read                */
+            int   nultyp,     /* I - null value handling code:               */
+                              /*     1: set undefined pixels = nulval        */
+                              /*     2: set nularray=1 for undefined pixels  */
+            char nulval,      /* I - value for null pixels if nultyp = 1     */
+            char *array,      /* O - array of values                         */
+            char *nularray,   /* O - array of flags = 1 if nultyp = 2        */
+            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
+            int  *status)     /* IO - error status                           */
+/*
+  Read an array of logical values from a column in the current FITS HDU.
+*/
+{
+    double dtemp;
+    int tcode, maxelem, hdutype, ii, nulcheck;
+    long twidth, incre;
+    long ntodo;
+    LONGLONG repeat, startpos, elemnum, readptr, tnull, rowlen, rownum, remain, next;
+    double scale, zero;
+    char tform[20];
+    char message[FLEN_ERRMSG];
+    char snull[20];   /*  the FITS null value  */
+    unsigned char buffer[DBUFFSIZE], *buffptr;
+
+    if (*status > 0 || nelem == 0)  /* inherit input status value if > 0 */
+        return(*status);
+
+    if (anynul)
+       *anynul = 0;
+
+    if (nultyp == 2)      
+       memset(nularray, 0, (size_t) nelem);   /* initialize nullarray */
+
+    /*---------------------------------------------------*/
+    /*  Check input and get parameters about the column: */
+    /*---------------------------------------------------*/
+    if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 0, &scale, &zero,
+        tform, &twidth, &tcode, &maxelem, &startpos,  &elemnum, &incre,
+        &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+        return(*status);
+
+    if (tcode != TLOGICAL)   
+        return(*status = NOT_LOGICAL_COL);
+ 
+    /*------------------------------------------------------------------*/
+    /*  Decide whether to check for null values in the input FITS file: */
+    /*------------------------------------------------------------------*/
+    nulcheck = nultyp; /* by default, check for null values in the FITS file */
+
+    if (nultyp == 1 && nulval == 0)
+       nulcheck = 0;    /* calling routine does not want to check for nulls */
+
+    /*---------------------------------------------------------------------*/
+    /*  Now read the logical values from the FITS column.                  */
+    /*---------------------------------------------------------------------*/
+
+    remain = nelem;           /* remaining number of values to read */
+    next = 0;                 /* next element in array to be read   */
+    rownum = 0;               /* row number, relative to firstrow   */
+    ntodo = (long) remain;           /* max number of elements to read at one time */
+
+    while (ntodo)
+    {
+      /*
+         limit the number of pixels to read at one time to the number that
+         remain in the current vector.    
+      */
+      ntodo = (long) minvalue(ntodo, maxelem);      
+      ntodo = (long) minvalue(ntodo, (repeat - elemnum));
+
+      readptr = startpos + (rowlen * rownum) + (elemnum * incre);
+
+      ffgi1b(fptr, readptr, ntodo, incre, buffer, status);
+
+      /* convert from T or F to 1 or 0 */
+      buffptr = buffer;
+      for (ii = 0; ii < ntodo; ii++, next++, buffptr++)
+      {
+        if (*buffptr == 'T')
+          array[next] = 1;
+        else if (*buffptr =='F') 
+          array[next] = 0;
+        else if (*buffptr == 0)
+        {
+          array[next] = nulval;  /* set null values to input nulval */
+          if (anynul)
+              *anynul = 1;
+
+          if (nulcheck == 2)
+          {
+            nularray[next] = 1;  /* set null flags */
+          }
+        }
+        else  /* some other illegal character; return the char value */
+        {
+          array[next] = (char) *buffptr;
+        }
+      }
+
+      if (*status > 0)  /* test for error during previous read operation */
+      {
+	dtemp = (double) next;
+        sprintf(message,
+          "Error reading elements %.0f thruough %.0f of logical array (ffgcl).",
+           dtemp+1., dtemp + ntodo);
+        ffpmsg(message);
+        return(*status);
+      }
+
+      /*--------------------------------------------*/
+      /*  increment the counters for the next loop  */
+      /*--------------------------------------------*/
+      remain -= ntodo;
+      if (remain)
+      {
+        elemnum += ntodo;
+
+        if (elemnum == repeat)  /* completed a row; start on later row */
+          {
+            elemnum = 0;
+            rownum++;
+          }
+      }
+      ntodo = (long) remain;  /* this is the maximum number to do in next loop */
+
+    }  /*  End of main while Loop  */
+
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcx(  fitsfile *fptr,  /* I - FITS file pointer                       */
+            int   colnum,    /* I - number of column to write (1 = 1st col) */
+            LONGLONG  frow,      /* I - first row to write (1 = 1st row)        */
+            LONGLONG  fbit,      /* I - first bit to write (1 = 1st)            */
+            LONGLONG  nbit,      /* I - number of bits to write                 */
+            char *larray,    /* O - array of logicals corresponding to bits */
+            int  *status)    /* IO - error status                           */
+/*
+  read an array of logical values from a specified bit or byte
+  column of the binary table.    larray is set = TRUE, if the corresponding
+  bit = 1, otherwise it is set to FALSE.
+  The binary table column being read from must have datatype 'B' or 'X'. 
+*/
+{
+    LONGLONG bstart;
+    long offset, ndone, ii, repeat, bitloc, fbyte;
+    LONGLONG  rstart, estart;
+    int tcode, descrp;
+    unsigned char cbuff;
+    static unsigned char onbit[8] = {128,  64,  32,  16,   8,   4,   2,   1};
+    tcolumn *colptr;
+
+    if (*status > 0)           /* inherit input status value if > 0 */
+        return(*status);
+
+    /*  check input parameters */
+    if (nbit < 1)
+        return(*status);
+    else if (frow < 1)
+        return(*status = BAD_ROW_NUM);
+    else if (fbit < 1)
+        return(*status = BAD_ELEM_NUM);
+
+    /* position to the correct HDU */
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    /* rescan header if data structure is undefined */
+    else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+        if ( ffrdef(fptr, status) > 0)               
+            return(*status);
+
+    fbyte = (long) ((fbit + 7) / 8);
+    bitloc = (long) (fbit - 1 - ((fbit - 1) / 8 * 8));
+    ndone = 0;
+    rstart = frow - 1;
+    estart = fbyte - 1;
+
+    colptr  = (fptr->Fptr)->tableptr;   /* point to first column */
+    colptr += (colnum - 1);     /* offset to correct column structure */
+
+    tcode = colptr->tdatatype;
+
+    if (abs(tcode) > TBYTE)
+        return(*status = NOT_LOGICAL_COL); /* not correct datatype column */
+
+    if (tcode > 0)
+    {
+        descrp = FALSE;  /* not a variable length descriptor column */
+        /* N.B: REPEAT is the number of bytes, not number of bits */
+        repeat = (long) colptr->trepeat;
+
+        if (tcode == TBIT)
+            repeat = (repeat + 7) / 8;  /* convert from bits to bytes */
+
+        if (fbyte > repeat)
+            return(*status = BAD_ELEM_NUM);
+
+        /* calc the i/o pointer location to start of sequence of pixels */
+        bstart = (fptr->Fptr)->datastart + ((fptr->Fptr)->rowlength * rstart) +
+               colptr->tbcol + estart;
+    }
+    else
+    {
+        descrp = TRUE;  /* a variable length descriptor column */
+        /* only bit arrays (tform = 'X') are supported for variable */
+        /* length arrays.  REPEAT is the number of BITS in the array. */
+
+        ffgdes(fptr, colnum, frow, &repeat, &offset, status);
+
+        if (tcode == -TBIT)
+            repeat = (repeat + 7) / 8;
+
+        if ((fbit + nbit + 6) / 8 > repeat)
+            return(*status = BAD_ELEM_NUM);
+
+        /* calc the i/o pointer location to start of sequence of pixels */
+        bstart = (fptr->Fptr)->datastart + offset + (fptr->Fptr)->heapstart + estart;
+    }
+
+    /* move the i/o pointer to the start of the pixel sequence */
+    if (ffmbyt(fptr, bstart, REPORT_EOF, status) > 0)
+        return(*status);
+
+    /* read the next byte */
+    while (1)
+    {
+      if (ffgbyt(fptr, 1, &cbuff, status) > 0)
+        return(*status);
+
+      for (ii = bitloc; (ii < 8) && (ndone < nbit); ii++, ndone++)
+      {
+        if(cbuff & onbit[ii])       /* test if bit is set */
+          larray[ndone] = TRUE;
+        else
+          larray[ndone] = FALSE;
+      }
+
+      if (ndone == nbit)   /* finished all the bits */
+        return(*status);
+
+      /* not done, so get the next byte */
+      if (!descrp)
+      {
+        estart++;
+        if (estart == repeat) 
+        {
+          /* move the i/o pointer to the next row of pixels */
+          estart = 0;
+          rstart = rstart + 1;
+          bstart = (fptr->Fptr)->datastart + ((fptr->Fptr)->rowlength * rstart) +
+               colptr->tbcol;
+
+          ffmbyt(fptr, bstart, REPORT_EOF, status);
+        }
+      }
+      bitloc = 0;
+    }
+}
+/*--------------------------------------------------------------------------*/
+int ffgcxui(fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col)  */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
+            LONGLONG  nrows,      /* I - no. of rows to read                     */
+            long  input_first_bit, /* I - first bit to read (1 = 1st)        */
+            int   input_nbits,     /* I - number of bits to read (<= 32)     */
+            unsigned short *array, /* O - array of integer values            */
+            int  *status)     /* IO - error status                           */
+/*
+  Read a consecutive string of bits from an 'X' or 'B' column and
+  interprete them as an unsigned integer.  The number of bits must be
+  less than or equal to 16 or the total number of bits in the column, 
+  which ever is less.
+*/
+{
+    int ii, firstbit, nbits, bytenum, startbit, numbits, endbit;
+    int firstbyte, lastbyte, nbytes, rshift, lshift;
+    unsigned short colbyte[5];
+    tcolumn *colptr;
+    char message[81];
+
+    if (*status > 0 || nrows == 0)
+        return(*status);
+
+    /*  check input parameters */
+    if (firstrow < 1)
+    {
+          sprintf(message, "Starting row number is less than 1: %ld (ffgcxui)",
+                (long) firstrow);
+          ffpmsg(message);
+          return(*status = BAD_ROW_NUM);
+    }
+    else if (input_first_bit < 1)
+    {
+          sprintf(message, "Starting bit number is less than 1: %ld (ffgcxui)",
+                input_first_bit);
+          ffpmsg(message);
+          return(*status = BAD_ELEM_NUM);
+    }
+    else if (input_nbits > 16)
+    {
+          sprintf(message, "Number of bits to read is > 16: %d (ffgcxui)",
+                input_nbits);
+          ffpmsg(message);
+          return(*status = BAD_ELEM_NUM);
+    }
+
+    /* position to the correct HDU */
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    /* rescan header if data structure is undefined */
+    else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+        if ( ffrdef(fptr, status) > 0)               
+            return(*status);
+
+    if ((fptr->Fptr)->hdutype != BINARY_TBL)
+    {
+        ffpmsg("This is not a binary table extension (ffgcxui)");
+        return(*status = NOT_BTABLE);
+    }
+
+    if (colnum > (fptr->Fptr)->tfield)
+    {
+      sprintf(message, "Specified column number is out of range: %d (ffgcxui)",
+                colnum);
+        ffpmsg(message);
+        sprintf(message, "  There are %d columns in this table.",
+                (fptr->Fptr)->tfield );
+        ffpmsg(message);
+
+        return(*status = BAD_COL_NUM);
+    }       
+
+    colptr  = (fptr->Fptr)->tableptr;   /* point to first column */
+    colptr += (colnum - 1);     /* offset to correct column structure */
+
+    if (abs(colptr->tdatatype) > TBYTE)
+    {
+        ffpmsg("Can only read bits from X or B type columns. (ffgcxui)");
+        return(*status = NOT_LOGICAL_COL); /* not correct datatype column */
+    }
+
+    firstbyte = (input_first_bit - 1              ) / 8 + 1;
+    lastbyte  = (input_first_bit + input_nbits - 2) / 8 + 1;
+    nbytes = lastbyte - firstbyte + 1;
+
+    if (colptr->tdatatype == TBIT && 
+        input_first_bit + input_nbits - 1 > (long) colptr->trepeat)
+    {
+        ffpmsg("Too many bits. Tried to read past width of column (ffgcxui)");
+        return(*status = BAD_ELEM_NUM);
+    }
+    else if (colptr->tdatatype == TBYTE && lastbyte > (long) colptr->trepeat)
+    {
+        ffpmsg("Too many bits. Tried to read past width of column (ffgcxui)");
+        return(*status = BAD_ELEM_NUM);
+    }
+
+    for (ii = 0; ii < nrows; ii++)
+    {
+        /* read the relevant bytes from the row */
+        if (ffgcvui(fptr, colnum, firstrow+ii, firstbyte, nbytes, 0, 
+               colbyte, NULL, status) > 0)
+        {
+             ffpmsg("Error reading bytes from column (ffgcxui)");
+             return(*status);
+        }
+
+        firstbit = (input_first_bit - 1) % 8; /* modulus operator */
+        nbits = input_nbits;
+
+        array[ii] = 0;
+
+        /* select and shift the bits from each byte into the output word */
+        while(nbits)
+        {
+            bytenum = firstbit / 8;
+
+            startbit = firstbit % 8;  
+            numbits = minvalue(nbits, 8 - startbit);
+            endbit = startbit + numbits - 1;
+
+            rshift = 7 - endbit;
+            lshift = nbits - numbits;
+
+            array[ii] = ((colbyte[bytenum] >> rshift) << lshift) | array[ii];
+
+            nbits -= numbits;
+            firstbit += numbits;
+        }
+    }
+
+    return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int ffgcxuk(fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col)  */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
+            LONGLONG  nrows,      /* I - no. of rows to read                     */
+            long  input_first_bit, /* I - first bit to read (1 = 1st)        */
+            int   input_nbits,     /* I - number of bits to read (<= 32)     */
+            unsigned int *array,   /* O - array of integer values            */
+            int  *status)     /* IO - error status                           */
+/*
+  Read a consecutive string of bits from an 'X' or 'B' column and
+  interprete them as an unsigned integer.  The number of bits must be
+  less than or equal to 32 or the total number of bits in the column, 
+  which ever is less.
+*/
+{
+    int ii, firstbit, nbits, bytenum, startbit, numbits, endbit;
+    int firstbyte, lastbyte, nbytes, rshift, lshift;
+    unsigned int colbyte[5];
+    tcolumn *colptr;
+    char message[81];
+
+    if (*status > 0 || nrows == 0)
+        return(*status);
+
+    /*  check input parameters */
+    if (firstrow < 1)
+    {
+          sprintf(message, "Starting row number is less than 1: %ld (ffgcxuk)",
+                (long) firstrow);
+          ffpmsg(message);
+          return(*status = BAD_ROW_NUM);
+    }
+    else if (input_first_bit < 1)
+    {
+          sprintf(message, "Starting bit number is less than 1: %ld (ffgcxuk)",
+                input_first_bit);
+          ffpmsg(message);
+          return(*status = BAD_ELEM_NUM);
+    }
+    else if (input_nbits > 32)
+    {
+          sprintf(message, "Number of bits to read is > 32: %d (ffgcxuk)",
+                input_nbits);
+          ffpmsg(message);
+          return(*status = BAD_ELEM_NUM);
+    }
+
+    /* position to the correct HDU */
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    /* rescan header if data structure is undefined */
+    else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+        if ( ffrdef(fptr, status) > 0)               
+            return(*status);
+
+    if ((fptr->Fptr)->hdutype != BINARY_TBL)
+    {
+        ffpmsg("This is not a binary table extension (ffgcxuk)");
+        return(*status = NOT_BTABLE);
+    }
+
+    if (colnum > (fptr->Fptr)->tfield)
+    {
+      sprintf(message, "Specified column number is out of range: %d (ffgcxuk)",
+                colnum);
+        ffpmsg(message);
+        sprintf(message, "  There are %d columns in this table.",
+                (fptr->Fptr)->tfield );
+        ffpmsg(message);
+
+        return(*status = BAD_COL_NUM);
+    }       
+
+    colptr  = (fptr->Fptr)->tableptr;   /* point to first column */
+    colptr += (colnum - 1);     /* offset to correct column structure */
+
+    if (abs(colptr->tdatatype) > TBYTE)
+    {
+        ffpmsg("Can only read bits from X or B type columns. (ffgcxuk)");
+        return(*status = NOT_LOGICAL_COL); /* not correct datatype column */
+    }
+
+    firstbyte = (input_first_bit - 1              ) / 8 + 1;
+    lastbyte  = (input_first_bit + input_nbits - 2) / 8 + 1;
+    nbytes = lastbyte - firstbyte + 1;
+
+    if (colptr->tdatatype == TBIT && 
+        input_first_bit + input_nbits - 1 > (long) colptr->trepeat)
+    {
+        ffpmsg("Too many bits. Tried to read past width of column (ffgcxuk)");
+        return(*status = BAD_ELEM_NUM);
+    }
+    else if (colptr->tdatatype == TBYTE && lastbyte > (long) colptr->trepeat)
+    {
+        ffpmsg("Too many bits. Tried to read past width of column (ffgcxuk)");
+        return(*status = BAD_ELEM_NUM);
+    }
+
+    for (ii = 0; ii < nrows; ii++)
+    {
+        /* read the relevant bytes from the row */
+        if (ffgcvuk(fptr, colnum, firstrow+ii, firstbyte, nbytes, 0, 
+               colbyte, NULL, status) > 0)
+        {
+             ffpmsg("Error reading bytes from column (ffgcxuk)");
+             return(*status);
+        }
+
+        firstbit = (input_first_bit - 1) % 8; /* modulus operator */
+        nbits = input_nbits;
+
+        array[ii] = 0;
+
+        /* select and shift the bits from each byte into the output word */
+        while(nbits)
+        {
+            bytenum = firstbit / 8;
+
+            startbit = firstbit % 8;  
+            numbits = minvalue(nbits, 8 - startbit);
+            endbit = startbit + numbits - 1;
+
+            rshift = 7 - endbit;
+            lshift = nbits - numbits;
+
+            array[ii] = ((colbyte[bytenum] >> rshift) << lshift) | array[ii];
+
+            nbits -= numbits;
+            firstbit += numbits;
+        }
+    }
+
+    return(*status);
+}

external/cfitsio/getcols.c

@@ -0,0 +1,835 @@
+/*  This file, getcols.c, contains routines that read data elements from   */
+/*  a FITS image or table, with a character string datatype.               */
+
+/*  The FITSIO software was written by William Pence at the High Energy    */
+/*  Astrophysic Science Archive Research Center (HEASARC) at the NASA      */
+/*  Goddard Space Flight Center.                                           */
+
+#include <stdlib.h>
+#include <string.h>
+/* stddef.h is apparently needed to define size_t */
+#include <stddef.h>
+#include <ctype.h>
+#include "fitsio2.h"
+/*--------------------------------------------------------------------------*/
+int ffgcvs( fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col)  */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
+            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
+            LONGLONG  nelem,      /* I - number of strings to read               */
+            char *nulval,     /* I - string for null pixels                  */
+            char **array,     /* O - array of values that are read           */
+            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
+            int  *status)     /* IO - error status                           */
+/*
+  Read an array of string values from a column in the current FITS HDU.
+  Any undefined pixels will be set equal to the value of 'nulval' unless
+  nulval = null in which case no checks for undefined pixels will be made.
+*/
+{
+    char cdummy[2];
+
+    ffgcls(fptr, colnum, firstrow, firstelem, nelem, 1, nulval,
+           array, cdummy, anynul, status);
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfs( fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col) */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)        */
+            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st) */
+            LONGLONG  nelem,      /* I - number of strings to read              */
+            char **array,     /* O - array of values that are read           */
+            char *nularray,   /* O - array of flags = 1 if nultyp = 2        */
+            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
+            int  *status)     /* IO - error status                           */
+/*
+  Read an array of string values from a column in the current FITS HDU.
+  Nularray will be set = 1 if the corresponding array pixel is undefined, 
+  otherwise nularray will = 0.
+*/
+{
+    char dummy[2];
+
+    ffgcls(fptr, colnum, firstrow, firstelem, nelem, 2, dummy,
+           array, nularray, anynul, status);
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcls( fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col) */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)        */
+            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st) */
+            LONGLONG  nelem,      /* I - number of strings to read              */
+            int   nultyp,     /* I - null value handling code:               */
+                              /*     1: set undefined pixels = nulval        */
+                              /*     2: set nularray=1 for undefined pixels  */
+            char  *nulval,    /* I - value for null pixels if nultyp = 1     */
+            char **array,     /* O - array of values that are read           */
+            char *nularray,   /* O - array of flags = 1 if nultyp = 2        */
+            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
+            int  *status)     /* IO - error status                           */
+/*
+  Read an array of string values from a column in the current FITS HDU.
+  Returns a formated string value, regardless of the datatype of the column
+*/
+{
+    int tcode, hdutype, tstatus, scaled, intcol, dwidth, nulwidth, ll, dlen;
+    long ii, jj;
+    tcolumn *colptr;
+    char message[FLEN_ERRMSG], *carray, keyname[FLEN_KEYWORD];
+    char cform[20], dispfmt[20], tmpstr[400], *flgarray, tmpnull[80];
+    unsigned char byteval;
+    float *earray;
+    double *darray, tscale = 1.0;
+    LONGLONG *llarray;
+
+    if (*status > 0 || nelem == 0)  /* inherit input status value if > 0 */
+        return(*status);
+
+    /* reset position to the correct HDU if necessary */
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    /* rescan header if data structure is undefined */
+    else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+        if ( ffrdef(fptr, status) > 0)               
+            return(*status);
+
+    if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+    {
+        sprintf(message, "Specified column number is out of range: %d",
+                colnum);
+        ffpmsg(message);
+        return(*status = BAD_COL_NUM);
+    }
+
+    colptr  = (fptr->Fptr)->tableptr;   /* point to first column */
+    colptr += (colnum - 1);     /* offset to correct column structure */
+    tcode = abs(colptr->tdatatype);
+
+    if (tcode == TSTRING)
+    {
+      /* simply call the string column reading routine */
+      ffgcls2(fptr, colnum, firstrow, firstelem, nelem, nultyp, nulval,
+           array, nularray, anynul, status);
+    }
+    else if (tcode == TLOGICAL)
+    {
+      /* allocate memory for the array of logical values */
+      carray = (char *) malloc((size_t) nelem);
+
+      /*  call the logical column reading routine */
+      ffgcll(fptr, colnum, firstrow, firstelem, nelem, nultyp, *nulval,
+           carray, nularray, anynul, status); 
+
+      if (*status <= 0)
+      {
+         /* convert logical values to "T", "F", or "N" (Null) */
+         for (ii = 0; ii < nelem; ii++)
+         {
+           if (carray[ii] == 1)
+              strcpy(array[ii], "T");
+           else if (carray[ii] == 0)
+              strcpy(array[ii], "F");
+           else  /* undefined values = 2 */
+              strcpy(array[ii],"N");
+         }
+      }
+
+      free(carray);  /* free the memory */
+    }
+    else if (tcode == TCOMPLEX)
+    {
+      /* allocate memory for the array of double values */
+      earray = (float *) calloc((size_t) (nelem * 2), sizeof(float) );
+      
+      ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+        1, 1, FLOATNULLVALUE, earray, nularray, anynul, status);
+
+      if (*status <= 0)
+      {
+
+         /* determine the format for the output strings */
+
+         ffgcdw(fptr, colnum, &dwidth, status);
+         dwidth = (dwidth - 3) / 2;
+ 
+         /* use the TDISPn keyword if it exists */
+         ffkeyn("TDISP", colnum, keyname, status);
+         tstatus = 0;
+         cform[0] = '\0';
+
+         if (ffgkys(fptr, keyname, dispfmt, NULL, &tstatus) == 0)
+         {
+             /* convert the Fortran style format to a C style format */
+             ffcdsp(dispfmt, cform);
+         }
+
+         if (!cform[0])
+             strcpy(cform, "%14.6E");
+
+         /* write the formated string for each value:  "(real,imag)" */
+         jj = 0;
+         for (ii = 0; ii < nelem; ii++)
+         {
+           strcpy(array[ii], "(");
+
+           /* test for null value */
+           if (earray[jj] == FLOATNULLVALUE)
+           {
+             strcpy(tmpstr, "NULL");
+             if (nultyp == 2)
+                nularray[ii] = 1;
+           }
+           else
+             sprintf(tmpstr, cform, earray[jj]);
+
+           strncat(array[ii], tmpstr, dwidth);
+           strcat(array[ii], ",");
+           jj++;
+
+           /* test for null value */
+           if (earray[jj] == FLOATNULLVALUE)
+           {
+             strcpy(tmpstr, "NULL");
+             if (nultyp == 2)
+                nularray[ii] = 1;
+           }
+           else
+             sprintf(tmpstr, cform, earray[jj]);
+
+           strncat(array[ii], tmpstr, dwidth);
+           strcat(array[ii], ")");
+           jj++;
+         }
+      }
+
+      free(earray);  /* free the memory */
+    }
+    else if (tcode == TDBLCOMPLEX)
+    {
+      /* allocate memory for the array of double values */
+      darray = (double *) calloc((size_t) (nelem * 2), sizeof(double) );
+      
+      ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+        1, 1, DOUBLENULLVALUE, darray, nularray, anynul, status);
+
+      if (*status <= 0)
+      {
+         /* determine the format for the output strings */
+
+         ffgcdw(fptr, colnum, &dwidth, status);
+         dwidth = (dwidth - 3) / 2;
+
+         /* use the TDISPn keyword if it exists */
+         ffkeyn("TDISP", colnum, keyname, status);
+         tstatus = 0;
+         cform[0] = '\0';
+ 
+         if (ffgkys(fptr, keyname, dispfmt, NULL, &tstatus) == 0)
+         {
+             /* convert the Fortran style format to a C style format */
+             ffcdsp(dispfmt, cform);
+         }
+
+         if (!cform[0])
+            strcpy(cform, "%23.15E");
+
+         /* write the formated string for each value:  "(real,imag)" */
+         jj = 0;
+         for (ii = 0; ii < nelem; ii++)
+         {
+           strcpy(array[ii], "(");
+
+           /* test for null value */
+           if (darray[jj] == DOUBLENULLVALUE)
+           {
+             strcpy(tmpstr, "NULL");
+             if (nultyp == 2)
+                nularray[ii] = 1;
+           }
+           else
+             sprintf(tmpstr, cform, darray[jj]);
+
+           strncat(array[ii], tmpstr, dwidth);
+           strcat(array[ii], ",");
+           jj++;
+
+           /* test for null value */
+           if (darray[jj] == DOUBLENULLVALUE)
+           {
+             strcpy(tmpstr, "NULL");
+             if (nultyp == 2)
+                nularray[ii] = 1;
+           }
+           else
+             sprintf(tmpstr, cform, darray[jj]);
+
+           strncat(array[ii], tmpstr, dwidth);
+           strcat(array[ii], ")");
+           jj++;
+         }
+      }
+
+      free(darray);  /* free the memory */
+    }
+    else if (tcode == TLONGLONG)
+    {
+      /* allocate memory for the array of LONGLONG values */
+      llarray = (LONGLONG *) calloc((size_t) nelem, sizeof(LONGLONG) );
+      flgarray = (char *) calloc((size_t) nelem, sizeof(char) );
+      dwidth = 20;  /* max width of displayed long long integer value */
+
+      if (ffgcfjj(fptr, colnum, firstrow, firstelem, nelem,
+            llarray, flgarray, anynul, status) > 0)
+      {
+         free(flgarray);
+         free(llarray);
+         return(*status);
+      }
+
+      /* write the formated string for each value */
+      if (nulval) {
+          strcpy(tmpnull, nulval);
+          nulwidth = strlen(nulval);
+      } else {
+          strcpy(tmpnull, " ");
+          nulwidth = 1;
+      }
+
+      for (ii = 0; ii < nelem; ii++)
+      {
+           if ( flgarray[ii] )
+           {
+              *array[ii] = '\0';
+              if (dwidth < nulwidth)
+                  strncat(array[ii], tmpnull, dwidth);
+              else
+                  sprintf(array[ii],"%*s",dwidth,tmpnull);
+		  
+              if (nultyp == 2)
+	          nularray[ii] = 1;
+           }
+           else
+           {	   
+
+#if defined(_MSC_VER)
+    /* Microsoft Visual C++ 6.0 uses '%I64d' syntax  for 8-byte integers */
+        sprintf(tmpstr, "%20I64d", llarray[ii]);
+#elif (USE_LL_SUFFIX == 1)
+        sprintf(tmpstr, "%20lld", llarray[ii]);
+#else
+        sprintf(tmpstr, "%20ld", llarray[ii]);
+#endif
+              *array[ii] = '\0';
+              strncat(array[ii], tmpstr, 20);
+           }
+      }
+
+      free(flgarray);
+      free(llarray);  /* free the memory */
+
+    }
+    else
+    {
+      /* allocate memory for the array of double values */
+      darray = (double *) calloc((size_t) nelem, sizeof(double) );
+      
+      /* read all other numeric type columns as doubles */
+      if (ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, nultyp, 
+           DOUBLENULLVALUE, darray, nularray, anynul, status) > 0)
+      {
+         free(darray);
+         return(*status);
+      }
+
+      /* determine the format for the output strings */
+
+      ffgcdw(fptr, colnum, &dwidth, status);
+
+      /* check if  column is scaled */
+      ffkeyn("TSCAL", colnum, keyname, status);
+      tstatus = 0;
+      scaled = 0;
+      if (ffgkyd(fptr, keyname, &tscale, NULL, &tstatus) == 0)
+      {
+            if (tscale != 1.0)
+                scaled = 1;    /* yes, this is a scaled column */
+      }
+
+      intcol = 0;
+      if (tcode <= TLONG && !scaled)
+             intcol = 1;   /* this is an unscaled integer column */
+
+      /* use the TDISPn keyword if it exists */
+      ffkeyn("TDISP", colnum, keyname, status);
+      tstatus = 0;
+      cform[0] = '\0';
+
+      if (ffgkys(fptr, keyname, dispfmt, NULL, &tstatus) == 0)
+      {
+           /* convert the Fortran style TDISPn to a C style format */
+           ffcdsp(dispfmt, cform);
+      }
+
+      if (!cform[0])
+      {
+            /* no TDISPn keyword; use TFORMn instead */
+
+            ffkeyn("TFORM", colnum, keyname, status);
+            ffgkys(fptr, keyname, dispfmt, NULL, status);
+
+            if (scaled && tcode <= TSHORT)
+            {
+                  /* scaled short integer column == float */
+                  strcpy(cform, "%#14.6G");
+            }
+            else if (scaled && tcode == TLONG)
+            {
+                  /* scaled long integer column == double */
+                  strcpy(cform, "%#23.15G");
+            }
+            else
+            {
+               ffghdt(fptr, &hdutype, status);
+               if (hdutype == ASCII_TBL)
+               {
+                  /* convert the Fortran style TFORMn to a C style format */
+                  ffcdsp(dispfmt, cform);
+               }
+               else
+               {
+                 /* this is a binary table, need to convert the format */
+                  if (tcode == TBIT) {            /* 'X' */
+                     strcpy(cform, "%4d");
+                  } else if (tcode == TBYTE) {    /* 'B' */
+                     strcpy(cform, "%4d");
+                  } else if (tcode == TSHORT) {   /* 'I' */
+                     strcpy(cform, "%6d");
+                  } else if (tcode == TLONG) {    /* 'J' */
+                     strcpy(cform, "%11.0f");
+                     intcol = 0;  /* needed to support unsigned int */
+                  } else if (tcode == TFLOAT) {   /* 'E' */
+                     strcpy(cform, "%#14.6G");
+                  } else if (tcode == TDOUBLE) {  /* 'D' */
+                     strcpy(cform, "%#23.15G");
+                  }
+               }
+            }
+      } 
+
+      if (nulval) {
+          strcpy(tmpnull, nulval);
+          nulwidth = strlen(nulval);
+      } else {
+          strcpy(tmpnull, " ");
+          nulwidth = 1;
+      }
+
+      /* write the formated string for each value */
+      for (ii = 0; ii < nelem; ii++)
+      {
+           if (tcode == TBIT)
+           {
+               byteval = (char) darray[ii];
+
+               for (ll=0; ll < 8; ll++)
+               {
+                   if ( ((unsigned char) (byteval << ll)) >> 7 )
+                       *(array[ii] + ll) = '1';
+                   else
+                       *(array[ii] + ll) = '0';
+               }
+               *(array[ii] + 8) = '\0';
+           }
+           /* test for null value */
+           else if ( (nultyp == 1 && darray[ii] == DOUBLENULLVALUE) ||
+                (nultyp == 2 && nularray[ii]) )
+           {
+              *array[ii] = '\0';
+              if (dwidth < nulwidth)
+                  strncat(array[ii], tmpnull, dwidth);
+              else
+                  sprintf(array[ii],"%*s",dwidth,tmpnull);
+           }
+           else
+           {	   
+              if (intcol)
+                sprintf(tmpstr, cform, (int) darray[ii]);
+              else
+                sprintf(tmpstr, cform, darray[ii]);
+
+              /* fill field with '*' if number is too wide */
+              dlen = strlen(tmpstr);
+	      if (dlen > dwidth) {
+	         memset(tmpstr, '*', dwidth);
+              }
+
+              *array[ii] = '\0';
+              strncat(array[ii], tmpstr, dwidth);
+           }
+      }
+
+      free(darray);  /* free the memory */
+    }
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcdw( fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column (1 = 1st col)      */
+            int  *width,      /* O - display width                       */
+            int  *status)     /* IO - error status                           */
+/*
+  Get Column Display Width.
+*/
+{
+    tcolumn *colptr;
+    char *cptr;
+    char message[FLEN_ERRMSG], keyname[FLEN_KEYWORD], dispfmt[20];
+    int tcode, hdutype, tstatus, scaled;
+    double tscale;
+
+    if (*status > 0)  /* inherit input status value if > 0 */
+        return(*status);
+
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+    {
+        sprintf(message, "Specified column number is out of range: %d",
+                colnum);
+        ffpmsg(message);
+        return(*status = BAD_COL_NUM);
+    }
+
+    colptr  = (fptr->Fptr)->tableptr;   /* point to first column */
+    colptr += (colnum - 1);     /* offset to correct column structure */
+    tcode = abs(colptr->tdatatype);
+
+    /* use the TDISPn keyword if it exists */
+    ffkeyn("TDISP", colnum, keyname, status);
+
+    *width = 0;
+    tstatus = 0;
+    if (ffgkys(fptr, keyname, dispfmt, NULL, &tstatus) == 0)
+    {
+          /* parse TDISPn get the display width */
+          cptr = dispfmt;
+          while(*cptr == ' ') /* skip leading blanks */
+              cptr++;
+
+          if (*cptr == 'A' || *cptr == 'a' ||
+              *cptr == 'I' || *cptr == 'i' ||
+              *cptr == 'O' || *cptr == 'o' ||
+              *cptr == 'Z' || *cptr == 'z' ||
+              *cptr == 'F' || *cptr == 'f' ||
+              *cptr == 'E' || *cptr == 'e' ||
+              *cptr == 'D' || *cptr == 'd' ||
+              *cptr == 'G' || *cptr == 'g')
+          {
+
+            while(!isdigit((int) *cptr) && *cptr != '\0') /* find 1st digit */
+              cptr++;
+
+            *width = atoi(cptr);
+            if (tcode >= TCOMPLEX)
+              *width = (2 * (*width)) + 3;
+          }
+    }
+
+    if (*width == 0)
+    {
+        /* no valid TDISPn keyword; use TFORMn instead */
+
+        ffkeyn("TFORM", colnum, keyname, status);
+        ffgkys(fptr, keyname, dispfmt, NULL, status);
+
+        /* check if  column is scaled */
+        ffkeyn("TSCAL", colnum, keyname, status);
+        tstatus = 0;
+        scaled = 0;
+
+        if (ffgkyd(fptr, keyname, &tscale, NULL, &tstatus) == 0)
+        {
+            if (tscale != 1.0)
+                scaled = 1;    /* yes, this is a scaled column */
+        }
+
+        if (scaled && tcode <= TSHORT)
+        {
+            /* scaled short integer col == float; default format is 14.6G */
+            *width = 14;
+        }
+        else if (scaled && tcode == TLONG)
+        {
+            /* scaled long integer col == double; default format is 23.15G */
+            *width = 23;
+        }
+        else
+        {
+           ffghdt(fptr, &hdutype, status);  /* get type of table */
+           if (hdutype == ASCII_TBL)
+           {
+              /* parse TFORMn get the display width */
+              cptr = dispfmt;
+              while(!isdigit((int) *cptr) && *cptr != '\0') /* find 1st digit */
+                 cptr++;
+
+              *width = atoi(cptr);
+           }
+           else
+           {
+                 /* this is a binary table */
+                  if (tcode == TBIT)           /* 'X' */
+                     *width = 8;
+                  else if (tcode == TBYTE)     /* 'B' */
+                     *width = 4;
+                  else if (tcode == TSHORT)    /* 'I' */
+                     *width = 6;
+                  else if (tcode == TLONG)     /* 'J' */
+                     *width = 11;
+                  else if (tcode == TLONGLONG) /* 'K' */
+                     *width = 20;
+                  else if (tcode == TFLOAT)    /* 'E' */
+                     *width = 14;
+                  else if (tcode == TDOUBLE)   /* 'D' */
+                     *width = 23;
+                  else if (tcode == TCOMPLEX)  /* 'C' */
+                     *width = 31;
+                  else if (tcode == TDBLCOMPLEX)  /* 'M' */
+                     *width = 49;
+                  else if (tcode == TLOGICAL)  /* 'L' */
+                     *width = 1;
+                  else if (tcode == TSTRING)   /* 'A' */
+                  {
+                     cptr = dispfmt;
+                     while(!isdigit((int) *cptr) && *cptr != '\0') 
+                         cptr++;
+
+                     *width = atoi(cptr);
+
+                     if (*width < 1)
+                         *width = 1;  /* default is at least 1 column */
+                  }
+            }
+        }
+    } 
+    return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcls2 ( fitsfile *fptr,   /* I - FITS file pointer                       */
+            int  colnum,      /* I - number of column to read (1 = 1st col) */
+            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)        */
+            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st) */
+            LONGLONG  nelem,      /* I - number of strings to read              */
+            int   nultyp,     /* I - null value handling code:               */
+                              /*     1: set undefined pixels = nulval        */
+                              /*     2: set nularray=1 for undefined pixels  */
+            char  *nulval,    /* I - value for null pixels if nultyp = 1     */
+            char **array,     /* O - array of values that are read           */
+            char *nularray,   /* O - array of flags = 1 if nultyp = 2        */
+            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
+            int  *status)     /* IO - error status                           */
+/*
+  Read an array of string values from a column in the current FITS HDU.
+*/
+{
+    double dtemp;
+    long nullen; 
+    int tcode, maxelem, hdutype, nulcheck;
+    long twidth, incre;
+    long ii, jj, ntodo;
+    LONGLONG repeat, startpos, elemnum, readptr, tnull, rowlen, rownum, remain, next;
+    double scale, zero;
+    char tform[20];
+    char message[FLEN_ERRMSG];
+    char snull[20];   /*  the FITS null value  */
+    tcolumn *colptr;
+
+    double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+    char *buffer, *arrayptr;
+
+    if (*status > 0 || nelem == 0)  /* inherit input status value if > 0 */
+        return(*status);
+
+    if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+        ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+    if (anynul)
+        *anynul = 0;
+
+    if (nultyp == 2)
+        memset(nularray, 0, (size_t) nelem);   /* initialize nullarray */
+
+    /*---------------------------------------------------*/
+    /*  Check input and get parameters about the column: */
+    /*---------------------------------------------------*/
+    if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+    {
+        sprintf(message, "Specified column number is out of range: %d",
+                colnum);
+        ffpmsg(message);
+        return(*status = BAD_COL_NUM);
+    }
+
+    colptr  = (fptr->Fptr)->tableptr;   /* point to first column */
+    colptr += (colnum - 1);     /* offset to correct column structure */
+    tcode = colptr->tdatatype;
+
+    if (tcode == -TSTRING) /* variable length column in a binary table? */
+    {
+      /* only read a single string; ignore value of firstelem */
+
+      if (ffgcprll( fptr, colnum, firstrow, 1, 1, 0, &scale, &zero,
+        tform, &twidth, &tcode, &maxelem, &startpos,  &elemnum, &incre,
+        &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+        return(*status);
+
+      remain = 1;
+      twidth = (long) repeat;  
+    }
+    else if (tcode == TSTRING)
+    {
+      if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 0, &scale, &zero,
+        tform, &twidth, &tcode, &maxelem, &startpos,  &elemnum, &incre,
+        &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+        return(*status);
+
+      /* if string length is greater than a FITS block (2880 char) then must */
+      /* only read 1 string at a time, to force reading by ffgbyt instead of */
+      /* ffgbytoff (ffgbytoff can't handle this case) */
+      if (twidth > IOBUFLEN) {
+        maxelem = 1;
+        incre = twidth;
+        repeat = 1;
+      }   
+
+      remain = nelem;
+    }
+    else
+        return(*status = NOT_ASCII_COL);
+
+    nullen = strlen(snull);   /* length of the undefined pixel string */
+    if (nullen == 0)
+        nullen = 1;
+ 
+    /*------------------------------------------------------------------*/
+    /*  Decide whether to check for null values in the input FITS file: */
+    /*------------------------------------------------------------------*/
+    nulcheck = nultyp; /* by default check for null values in the FITS file */
+
+    if (nultyp == 1 && nulval == 0)
+       nulcheck = 0;    /* calling routine does not want to check for nulls */
+
+    else if (nultyp == 1 && nulval && nulval[0] == 0)
+       nulcheck = 0;    /* calling routine does not want to check for nulls */
+
+    else if (snull[0] == ASCII_NULL_UNDEFINED)
+       nulcheck = 0;   /* null value string in ASCII table not defined */
+
+    else if (nullen > twidth)
+       nulcheck = 0;   /* null value string is longer than width of column  */
+                       /* thus impossible for any column elements to = null */
+
+    /*---------------------------------------------------------------------*/
+    /*  Now read the strings one at a time from the FITS column.           */
+    /*---------------------------------------------------------------------*/
+    next = 0;                 /* next element in array to be read  */
+    rownum = 0;               /* row number, relative to firstrow     */
+
+    while (remain)
+    {
+      /* limit the number of pixels to process at one time to the number that
+         will fit in the buffer space or to the number of pixels that remain
+         in the current vector, which ever is smaller.
+      */
+      ntodo = (long) minvalue(remain, maxelem);      
+      ntodo = (long) minvalue(ntodo, (repeat - elemnum));
+
+      readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+      ffmbyt(fptr, readptr, REPORT_EOF, status);  /* move to read position */
+
+      /* read the array of strings from the FITS file into the buffer */
+
+      if (incre == twidth)
+         ffgbyt(fptr, ntodo * twidth, cbuff, status);
+      else
+         ffgbytoff(fptr, twidth, ntodo, incre - twidth, cbuff, status);
+
+      /* copy from the buffer into the user's array of strings */
+      /* work backwards from last char of last string to 1st char of 1st */
+
+      buffer = ((char *) cbuff) + (ntodo * twidth) - 1;
+
+      for (ii = (long) (next + ntodo - 1); ii >= next; ii--)
+      {
+         arrayptr = array[ii] + twidth - 1;
+
+         for (jj = twidth - 1; jj > 0; jj--)  /* ignore trailing blanks */
+         {
+            if (*buffer == ' ')
+            {
+              buffer--;
+              arrayptr--;
+            }
+            else
+              break;
+         }
+         *(arrayptr + 1) = 0;  /* write the string terminator */
+         
+         for (; jj >= 0; jj--)    /* copy the string itself */
+         {
+           *arrayptr = *buffer;
+           buffer--;
+           arrayptr--;
+         }
+
+         /* check if null value is defined, and if the   */
+         /* column string is identical to the null string */
+         if (nulcheck && !strncmp(snull, array[ii], nullen) )
+         {
+           *anynul = 1;   /* this is a null value */
+           if (nultyp == 1) {
+	   
+	     if (nulval)
+                strcpy(array[ii], nulval);
+	     else
+	        strcpy(array[ii], " ");
+	     
+           } else
+             nularray[ii] = 1;
+         }
+      }
+    
+      if (*status > 0)  /* test for error during previous read operation */
+      {
+         dtemp = (double) next;
+         sprintf(message,
+          "Error reading elements %.0f thru %.0f of data array (ffpcls).",
+             dtemp+1., dtemp+ntodo);
+
+         ffpmsg(message);
+         return(*status);
+      }
+
+      /*--------------------------------------------*/
+      /*  increment the counters for the next loop  */
+      /*--------------------------------------------*/
+      next += ntodo;
+      remain -= ntodo;
+      if (remain)
+      {
+          elemnum += ntodo;
+          if (elemnum == repeat)  /* completed a row; start on next row */
+          {
+              elemnum = 0;
+              rownum++;
+          }
+      }
+    }  /*  End of main while Loop  */
+
+    return(*status);
+}
+

external/cfitsio/group.h

@@ -0,0 +1,65 @@
+#define MAX_HDU_TRACKER 1000
+
+typedef struct _HDUtracker HDUtracker;
+
+struct _HDUtracker
+{
+  int nHDU;
+
+  char *filename[MAX_HDU_TRACKER];
+  int  position[MAX_HDU_TRACKER];
+
+  char *newFilename[MAX_HDU_TRACKER];
+  int  newPosition[MAX_HDU_TRACKER];
+};
+
+/* functions used internally in the grouping convention module */
+
+int ffgtdc(int grouptype, int xtensioncol, int extnamecol, int extvercol,
+	   int positioncol, int locationcol, int uricol, char *ttype[],
+	   char *tform[], int *ncols, int  *status);
+
+int ffgtgc(fitsfile *gfptr, int *xtensionCol, int *extnameCol, int *extverCol,
+	   int *positionCol, int *locationCol, int *uriCol, int *grptype,
+	   int *status);
+
+int ffgmul(fitsfile *mfptr, int rmopt, int *status);
+
+int ffgmf(fitsfile *gfptr, char *xtension, char *extname, int extver,	   
+	  int position,	char *location,	long *member, int *status);
+
+int ffgtrmr(fitsfile *gfptr, HDUtracker *HDU, int *status);
+
+int ffgtcpr(fitsfile *infptr, fitsfile *outfptr, int cpopt, HDUtracker *HDU,
+	    int *status);
+
+int fftsad(fitsfile *mfptr, HDUtracker *HDU, int *newPosition, 
+	   char *newFileName);
+
+int fftsud(fitsfile *mfptr, HDUtracker *HDU, int newPosition, 
+	   char *newFileName);
+
+void prepare_keyvalue(char *keyvalue);
+
+int fits_path2url(char *inpath, char *outpath, int  *status);
+
+int fits_url2path(char *inpath, char *outpath, int  *status);
+
+int fits_get_cwd(char *cwd, int *status);
+
+int fits_get_url(fitsfile *fptr, char *realURL, char *startURL, 
+		 char *realAccess, char *startAccess, int *iostate, 
+		 int *status);
+
+int fits_clean_url(char *inURL, char *outURL, int *status);
+
+int fits_relurl2url(char *refURL, char *relURL, char *absURL, int *status);
+
+int fits_url2relurl(char *refURL, char *absURL, char *relURL, int *status);
+
+int fits_encode_url(char *inpath, char *outpath, int *status);
+
+int fits_unencode_url(char *inpath, char *outpath, int *status);
+
+int fits_is_url_absolute(char *url);
+

external/cfitsio/grparser.h

@@ -0,0 +1,185 @@
+/*		T E M P L A T E   P A R S E R   H E A D E R   F I L E
+		=====================================================
+
+		by Jerzy.Borkowski@obs.unige.ch
+
+		Integral Science Data Center
+		ch. d'Ecogia 16
+		1290 Versoix
+		Switzerland
+
+14-Oct-98: initial release
+16-Oct-98: reference to fitsio.h removed, also removed strings after #endif
+		directives to make gcc -Wall not to complain
+20-Oct-98: added declarations NGP_XTENSION_SIMPLE and NGP_XTENSION_FIRST
+24-Oct-98: prototype of ngp_read_line() function updated.
+22-Jan-99: prototype for ngp_set_extver() function added.
+20-Jun-2002 Wm Pence, added support for the HIERARCH keyword convention
+            (changed NGP_MAX_NAME from (20) to FLEN_KEYWORD)
+*/
+
+#ifndef	GRPARSER_H_INCLUDED
+#define	GRPARSER_H_INCLUDED
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+	/* error codes  - now defined in fitsio.h */
+
+	/* common constants definitions */
+
+#define	NGP_ALLOCCHUNK		(1000)
+#define	NGP_MAX_INCLUDE		(10)			/* include file nesting limit */
+#define	NGP_MAX_COMMENT		(80)			/* max size for comment */
+#define	NGP_MAX_NAME		FLEN_KEYWORD		/* max size for KEYWORD (FITS limits it to 8 chars) */
+                                                        /* except HIERARCH can have longer effective keyword names */
+#define	NGP_MAX_STRING		(80)			/* max size for various strings */
+#define	NGP_MAX_ARRAY_DIM	(999)			/* max. number of dimensions in array */
+#define NGP_MAX_FNAME           (1000)                  /* max size of combined path+fname */
+#define	NGP_MAX_ENVFILES	(10000)			/* max size of CFITSIO_INCLUDE_FILES env. variable */
+
+#define	NGP_TOKEN_UNKNOWN	(-1)			/* token type unknown */
+#define	NGP_TOKEN_INCLUDE	(0)			/* \INCLUDE token */
+#define	NGP_TOKEN_GROUP		(1)			/* \GROUP token */
+#define	NGP_TOKEN_END		(2)			/* \END token */
+#define	NGP_TOKEN_XTENSION	(3)			/* XTENSION token */
+#define	NGP_TOKEN_SIMPLE	(4)			/* SIMPLE token */
+#define	NGP_TOKEN_EOF		(5)			/* End Of File pseudo token */
+
+#define	NGP_TTYPE_UNKNOWN	(0)			/* undef (yet) token type - invalid to print/write to disk */
+#define	NGP_TTYPE_BOOL		(1)			/* boolean, it is 'T' or 'F' */
+#define	NGP_TTYPE_STRING	(2)			/* something withing "" or starting with letter */
+#define	NGP_TTYPE_INT		(3)			/* starting with digit and not with '.' */
+#define	NGP_TTYPE_REAL		(4)			/* digits + '.' */
+#define	NGP_TTYPE_COMPLEX	(5)			/* 2 reals, separated with ',' */
+#define	NGP_TTYPE_NULL		(6)			/* NULL token, format is : NAME = / comment */
+#define	NGP_TTYPE_RAW		(7)			/* HISTORY/COMMENT/8SPACES + comment string without / */
+
+#define	NGP_FOUND_EQUAL_SIGN	(1)			/* line contains '=' after keyword name */
+
+#define	NGP_FORMAT_OK		(0)			/* line format OK */
+#define	NGP_FORMAT_ERROR	(1)			/* line format error */
+
+#define	NGP_NODE_INVALID	(0)			/* default node type - invalid (to catch errors) */
+#define	NGP_NODE_IMAGE		(1)			/* IMAGE type */
+#define	NGP_NODE_ATABLE		(2)			/* ASCII table type */
+#define	NGP_NODE_BTABLE		(3)			/* BINARY table type */
+
+#define	NGP_NON_SYSTEM_ONLY	(0)			/* save all keywords except NAXIS,BITPIX,etc.. */
+#define	NGP_REALLY_ALL		(1)			/* save really all keywords */
+
+#define	NGP_XTENSION_SIMPLE	(1)			/* HDU defined with SIMPLE T */
+#define	NGP_XTENSION_FIRST	(2)			/* this is first extension in template */
+
+#define	NGP_LINE_REREAD		(1)			/* reread line */
+
+#define	NGP_BITPIX_INVALID	(-12345)		/* default BITPIX (to catch errors) */
+
+	/* common macro definitions */
+
+#ifdef	NGP_PARSER_DEBUG_MALLOC
+
+#define	ngp_alloc(x)		dal_malloc(x)
+#define	ngp_free(x)		dal_free(x)
+#define	ngp_realloc(x,y)	dal_realloc(x,y)
+
+#else
+
+#define	ngp_alloc(x)		malloc(x)
+#define	ngp_free(x)		free(x)
+#define	ngp_realloc(x,y)	realloc(x,y)
+
+#endif
+
+	/* type definitions */
+
+typedef struct NGP_RAW_LINE_STRUCT
+      {	char	*line;
+	char	*name;
+	char	*value;
+	int	type;
+	char	*comment;
+	int	format;
+	int	flags;
+      } NGP_RAW_LINE;
+
+
+typedef union NGP_TOKVAL_UNION
+      {	char	*s;		/* space allocated separately, be careful !!! */
+	char	b;
+	int	i;
+	double	d;
+	struct NGP_COMPLEX_STRUCT
+	 { double re;
+	   double im;
+	 } c;			/* complex value */
+      } NGP_TOKVAL;
+
+
+typedef struct NGP_TOKEN_STRUCT
+      { int		type;
+        char		name[NGP_MAX_NAME];
+        NGP_TOKVAL	value;
+        char		comment[NGP_MAX_COMMENT];
+      } NGP_TOKEN;
+
+
+typedef struct NGP_HDU_STRUCT
+      {	int		tokcnt;
+        NGP_TOKEN	*tok;
+      } NGP_HDU;
+
+
+typedef struct NGP_TKDEF_STRUCT
+      {	char	*name;
+	int	code;
+      } NGP_TKDEF;
+
+
+typedef struct NGP_EXTVER_TAB_STRUCT
+      {	char	*extname;
+	int	version;
+      } NGP_EXTVER_TAB;
+
+
+	/* globally visible variables declarations */
+
+extern	NGP_RAW_LINE	ngp_curline;
+extern	NGP_RAW_LINE	ngp_prevline;
+
+extern	int		ngp_extver_tab_size;
+extern	NGP_EXTVER_TAB	*ngp_extver_tab;
+
+
+	/* globally visible functions declarations */
+
+int	ngp_get_extver(char *extname, int *version);
+int	ngp_set_extver(char *extname, int version);
+int	ngp_delete_extver_tab(void);
+int	ngp_strcasecmp(char *p1, char *p2);
+int	ngp_strcasencmp(char *p1, char *p2, int n);
+int	ngp_line_from_file(FILE *fp, char **p);
+int	ngp_free_line(void);
+int	ngp_free_prevline(void);
+int	ngp_read_line_buffered(FILE *fp);
+int	ngp_unread_line(void);
+int	ngp_extract_tokens(NGP_RAW_LINE *cl);
+int	ngp_include_file(char *fname);
+int	ngp_read_line(int ignore_blank_lines);
+int	ngp_keyword_is_write(NGP_TOKEN *ngp_tok);
+int     ngp_keyword_all_write(NGP_HDU *ngph, fitsfile *ffp, int mode);
+int	ngp_hdu_init(NGP_HDU *ngph);
+int	ngp_hdu_clear(NGP_HDU *ngph);
+int	ngp_hdu_insert_token(NGP_HDU *ngph, NGP_TOKEN *newtok);
+int	ngp_append_columns(fitsfile *ff, NGP_HDU *ngph, int aftercol);
+int	ngp_read_xtension(fitsfile *ff, int parent_hn, int simple_mode);
+int	ngp_read_group(fitsfile *ff, char *grpname, int parent_hn);
+
+		/* top level API function - now defined in fitsio.h */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif

external/cfitsio/imcopy.c

@@ -0,0 +1,233 @@
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "fitsio.h"
+
+int main(int argc, char *argv[])
+{
+    fitsfile *infptr, *outfptr;   /* FITS file pointers defined in fitsio.h */
+    int status = 0, tstatus, ii = 1, iteration = 0, single = 0, hdupos;
+    int hdutype, bitpix, bytepix, naxis = 0, nkeys, datatype = 0, anynul;
+    long naxes[9] = {1, 1, 1, 1, 1, 1, 1, 1, 1};
+    long first, totpix = 0, npix;
+    double *array, bscale = 1.0, bzero = 0.0, nulval = 0.;
+    char card[81];
+
+    if (argc != 3)
+    {
+ printf("\n");
+ printf("Usage:  imcopy inputImage outputImage[compress]\n");
+ printf("\n");
+ printf("Copy an input image to an output image, optionally compressing\n");
+ printf("or uncompressing the image in the process.  If the [compress]\n");
+ printf("qualifier is appended to the output file name then the input image\n");
+ printf("will be compressed using the tile-compressed format.  In this format,\n");
+ printf("the image is divided into rectangular tiles and each tile of pixels\n");
+ printf("is compressed and stored in a variable-length row of a binary table.\n");
+ printf("If the [compress] qualifier is omitted, and the input image is\n");
+ printf("in tile-compressed format, then the output image will be uncompressed.\n");
+ printf("\n");
+ printf("If an extension name or number is appended to the input file name, \n");
+ printf("enclosed in square brackets, then only that single extension will be\n");
+ printf("copied to the output file.  Otherwise, every extension in the input file\n");
+ printf("will be processed in turn and copied to the output file.\n");
+ printf("\n");
+ printf("Examples:\n");
+ printf("\n");
+ printf("1)  imcopy image.fit 'cimage.fit[compress]'\n");
+ printf("\n");
+ printf("    This compresses the input image using the default parameters, i.e.,\n");
+ printf("    using the Rice compression algorithm and using row by row tiles.\n");
+ printf("\n");
+ printf("2)  imcopy cimage.fit image2.fit\n");
+ printf("\n");
+ printf("    This uncompresses the image created in the first example.\n");
+ printf("    image2.fit should be identical to image.fit if the image\n");
+ printf("    has an integer datatype.  There will be small differences\n");
+ printf("    in the pixel values if it is a floating point image.\n");
+ printf("\n");
+ printf("3)  imcopy image.fit 'cimage.fit[compress GZIP 100,100;q 16]'\n");
+ printf("\n");
+ printf("    This compresses the input image using the following parameters:\n");
+ printf("         GZIP compression algorithm;\n");
+ printf("         100 X 100 pixel compression tiles;\n");
+ printf("         quantization level = 16 (only used with floating point images)\n");
+ printf("\n");
+ printf("The full syntax of the compression qualifier is:\n");
+ printf("    [compress ALGORITHM TDIM1,TDIM2,...; q QLEVEL s SCALE]\n");
+ printf("where the allowed ALGORITHM values are:\n");
+ printf("      Rice, HCOMPRESS, HSCOMPRESS, GZIP, or PLIO. \n");
+ printf("       (HSCOMPRESS is a variant of HCOMPRESS in which a small\n");
+ printf("        amount of smoothing is applied to the uncompressed image\n");
+ printf("        to help suppress blocky compression artifacts in the image\n");
+ printf("        when using large values for the 'scale' parameter).\n");
+ printf("TDIMn is the size of the compression tile in each dimension,\n");
+ printf("\n");
+ printf("QLEVEL specifies the quantization level when converting a floating\n");
+ printf("point image into integers, prior to compressing the image.  The\n");
+ printf("default value = 16, which means the image will be quantized into\n");
+ printf("integer levels that are spaced at intervals of sigma/16., where \n");
+ printf("sigma is the estimated noise level in background areas of the image.\n");
+ printf("If QLEVEL is negative, this means use the absolute value for the\n");
+ printf("quantization spacing (e.g. 'q -0.005' means quantize the floating\n");
+ printf("point image such that the scaled integers represent steps of 0.005\n");
+ printf("in the original image).\n");
+ printf("\n");
+ printf("SCALE is the integer scale factor that only applies to the HCOMPRESS\n");
+ printf("algorithm.  The default value SCALE = 0 forces the image to be\n");
+ printf("losslessly compressed; Greater amounts of lossy compression (resulting\n");
+ printf("in smaller compressed files) can be specified with larger SCALE values.\n");
+ printf("\n");
+ printf("\n");
+ printf("Note that it may be necessary to enclose the file names\n");
+ printf("in single quote characters on the Unix command line.\n");
+      return(0);
+    }
+
+    /* Open the input file and create output file */
+    fits_open_file(&infptr, argv[1], READONLY, &status);
+    fits_create_file(&outfptr, argv[2], &status);
+
+    if (status != 0) {    
+        fits_report_error(stderr, status);
+        return(status);
+    }
+
+    fits_get_hdu_num(infptr, &hdupos);  /* Get the current HDU position */
+
+    /* Copy only a single HDU if a specific extension was given */ 
+    if (hdupos != 1 || strchr(argv[1], '[')) single = 1;
+
+    for (; !status; hdupos++)  /* Main loop through each extension */
+    {
+
+      fits_get_hdu_type(infptr, &hdutype, &status);
+
+      if (hdutype == IMAGE_HDU) {
+
+          /* get image dimensions and total number of pixels in image */
+          for (ii = 0; ii < 9; ii++)
+              naxes[ii] = 1;
+
+          fits_get_img_param(infptr, 9, &bitpix, &naxis, naxes, &status);
+
+          totpix = naxes[0] * naxes[1] * naxes[2] * naxes[3] * naxes[4]
+             * naxes[5] * naxes[6] * naxes[7] * naxes[8];
+      }
+
+      if (hdutype != IMAGE_HDU || naxis == 0 || totpix == 0) { 
+
+          /* just copy tables and null images */
+          fits_copy_hdu(infptr, outfptr, 0, &status);
+
+      } else {
+
+          /* Explicitly create new image, to support compression */
+          fits_create_img(outfptr, bitpix, naxis, naxes, &status);
+          if (status) {
+                 fits_report_error(stderr, status);
+                 return(status);
+          }
+
+          if (fits_is_compressed_image(outfptr, &status)) {
+              /* write default EXTNAME keyword if it doesn't already exist */
+	      tstatus = 0;
+              fits_read_card(infptr, "EXTNAME", card, &tstatus);
+	      if (tstatus) {
+	         strcpy(card, "EXTNAME = 'COMPRESSED_IMAGE'   / name of this binary table extension");
+	         fits_write_record(outfptr, card, &status);
+	      }
+          }
+	  	    
+          /* copy all the user keywords (not the structural keywords) */
+          fits_get_hdrspace(infptr, &nkeys, NULL, &status); 
+
+          for (ii = 1; ii <= nkeys; ii++) {
+              fits_read_record(infptr, ii, card, &status);
+              if (fits_get_keyclass(card) > TYP_CMPRS_KEY)
+                  fits_write_record(outfptr, card, &status);
+          }
+
+              /* delete default EXTNAME keyword if it exists */
+/*
+          if (!fits_is_compressed_image(outfptr, &status)) {
+	      tstatus = 0;
+              fits_read_key(outfptr, TSTRING, "EXTNAME", card, NULL, &tstatus);
+	      if (!tstatus) {
+	         if (strcmp(card, "COMPRESSED_IMAGE") == 0)
+	            fits_delete_key(outfptr, "EXTNAME", &status);
+	      }
+          }
+*/
+	  
+          switch(bitpix) {
+              case BYTE_IMG:
+                  datatype = TBYTE;
+                  break;
+              case SHORT_IMG:
+                  datatype = TSHORT;
+                  break;
+              case LONG_IMG:
+                  datatype = TINT;
+                  break;
+              case FLOAT_IMG:
+                  datatype = TFLOAT;
+                  break;
+              case DOUBLE_IMG:
+                  datatype = TDOUBLE;
+                  break;
+          }
+
+          bytepix = abs(bitpix) / 8;
+
+          npix = totpix;
+          iteration = 0;
+
+          /* try to allocate memory for the entire image */
+          /* use double type to force memory alignment */
+          array = (double *) calloc(npix, bytepix);
+
+          /* if allocation failed, divide size by 2 and try again */
+          while (!array && iteration < 10)  {
+              iteration++;
+              npix = npix / 2;
+              array = (double *) calloc(npix, bytepix);
+          }
+
+          if (!array)  {
+              printf("Memory allocation error\n");
+              return(0);
+          }
+
+          /* turn off any scaling so that we copy the raw pixel values */
+          fits_set_bscale(infptr,  bscale, bzero, &status);
+          fits_set_bscale(outfptr, bscale, bzero, &status);
+
+          first = 1;
+          while (totpix > 0 && !status)
+          {
+             /* read all or part of image then write it back to the output file */
+             fits_read_img(infptr, datatype, first, npix, 
+                     &nulval, array, &anynul, &status);
+
+             fits_write_img(outfptr, datatype, first, npix, array, &status);
+             totpix = totpix - npix;
+             first  = first  + npix;
+          }
+          free(array);
+      }
+
+      if (single) break;  /* quit if only copying a single HDU */
+      fits_movrel_hdu(infptr, 1, NULL, &status);  /* try to move to next HDU */
+    }
+
+    if (status == END_OF_FILE)  status = 0; /* Reset after normal error */
+
+    fits_close_file(outfptr,  &status);
+    fits_close_file(infptr, &status);
+
+    /* if error occurred, print out error message */
+    if (status)
+       fits_report_error(stderr, status);
+    return(status);
+}

external/cfitsio/infback.c

@@ -0,0 +1,632 @@
+/* infback.c -- inflate using a call-back interface
+ * Copyright (C) 1995-2009 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/*
+   This code is largely copied from inflate.c.  Normally either infback.o or
+   inflate.o would be linked into an application--not both.  The interface
+   with inffast.c is retained so that optimized assembler-coded versions of
+   inflate_fast() can be used with either inflate.c or infback.c.
+ */
+
+#include "zutil.h"
+#include "inftrees.h"
+#include "inflate.h"
+#include "inffast.h"
+
+/* function prototypes */
+local void fixedtables OF((struct inflate_state FAR *state));
+
+/*
+   strm provides memory allocation functions in zalloc and zfree, or
+   Z_NULL to use the library memory allocation functions.
+
+   windowBits is in the range 8..15, and window is a user-supplied
+   window and output buffer that is 2**windowBits bytes.
+ */
+int ZEXPORT inflateBackInit_(strm, windowBits, window, version, stream_size)
+z_streamp strm;
+int windowBits;
+unsigned char FAR *window;
+const char *version;
+int stream_size;
+{
+    struct inflate_state FAR *state;
+
+    if (version == Z_NULL || version[0] != ZLIB_VERSION[0] ||
+        stream_size != (int)(sizeof(z_stream)))
+        return Z_VERSION_ERROR;
+    if (strm == Z_NULL || window == Z_NULL ||
+        windowBits < 8 || windowBits > 15)
+        return Z_STREAM_ERROR;
+    strm->msg = Z_NULL;                 /* in case we return an error */
+    if (strm->zalloc == (alloc_func)0) {
+        strm->zalloc = zcalloc;
+        strm->opaque = (voidpf)0;
+    }
+    if (strm->zfree == (free_func)0) strm->zfree = zcfree;
+    state = (struct inflate_state FAR *)ZALLOC(strm, 1,
+                                               sizeof(struct inflate_state));
+    if (state == Z_NULL) return Z_MEM_ERROR;
+    Tracev((stderr, "inflate: allocated\n"));
+    strm->state = (struct internal_state FAR *)state;
+    state->dmax = 32768U;
+    state->wbits = windowBits;
+    state->wsize = 1U << windowBits;
+    state->window = window;
+    state->wnext = 0;
+    state->whave = 0;
+    return Z_OK;
+}
+
+/*
+   Return state with length and distance decoding tables and index sizes set to
+   fixed code decoding.  Normally this returns fixed tables from inffixed.h.
+   If BUILDFIXED is defined, then instead this routine builds the tables the
+   first time it's called, and returns those tables the first time and
+   thereafter.  This reduces the size of the code by about 2K bytes, in
+   exchange for a little execution time.  However, BUILDFIXED should not be
+   used for threaded applications, since the rewriting of the tables and virgin
+   may not be thread-safe.
+ */
+local void fixedtables(state)
+struct inflate_state FAR *state;
+{
+#ifdef BUILDFIXED
+    static int virgin = 1;
+    static code *lenfix, *distfix;
+    static code fixed[544];
+
+    /* build fixed huffman tables if first call (may not be thread safe) */
+    if (virgin) {
+        unsigned sym, bits;
+        static code *next;
+
+        /* literal/length table */
+        sym = 0;
+        while (sym < 144) state->lens[sym++] = 8;
+        while (sym < 256) state->lens[sym++] = 9;
+        while (sym < 280) state->lens[sym++] = 7;
+        while (sym < 288) state->lens[sym++] = 8;
+        next = fixed;
+        lenfix = next;
+        bits = 9;
+        inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work);
+
+        /* distance table */
+        sym = 0;
+        while (sym < 32) state->lens[sym++] = 5;
+        distfix = next;
+        bits = 5;
+        inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work);
+
+        /* do this just once */
+        virgin = 0;
+    }
+#else /* !BUILDFIXED */
+#   include "inffixed.h"
+#endif /* BUILDFIXED */
+    state->lencode = lenfix;
+    state->lenbits = 9;
+    state->distcode = distfix;
+    state->distbits = 5;
+}
+
+/* Macros for inflateBack(): */
+
+/* Load returned state from inflate_fast() */
+#define LOAD() \
+    do { \
+        put = strm->next_out; \
+        left = strm->avail_out; \
+        next = strm->next_in; \
+        have = strm->avail_in; \
+        hold = state->hold; \
+        bits = state->bits; \
+    } while (0)
+
+/* Set state from registers for inflate_fast() */
+#define RESTORE() \
+    do { \
+        strm->next_out = put; \
+        strm->avail_out = left; \
+        strm->next_in = next; \
+        strm->avail_in = have; \
+        state->hold = hold; \
+        state->bits = bits; \
+    } while (0)
+
+/* Clear the input bit accumulator */
+#define INITBITS() \
+    do { \
+        hold = 0; \
+        bits = 0; \
+    } while (0)
+
+/* Assure that some input is available.  If input is requested, but denied,
+   then return a Z_BUF_ERROR from inflateBack(). */
+#define PULL() \
+    do { \
+        if (have == 0) { \
+            have = in(in_desc, &next); \
+            if (have == 0) { \
+                next = Z_NULL; \
+                ret = Z_BUF_ERROR; \
+                goto inf_leave; \
+            } \
+        } \
+    } while (0)
+
+/* Get a byte of input into the bit accumulator, or return from inflateBack()
+   with an error if there is no input available. */
+#define PULLBYTE() \
+    do { \
+        PULL(); \
+        have--; \
+        hold += (unsigned long)(*next++) << bits; \
+        bits += 8; \
+    } while (0)
+
+/* Assure that there are at least n bits in the bit accumulator.  If there is
+   not enough available input to do that, then return from inflateBack() with
+   an error. */
+#define NEEDBITS(n) \
+    do { \
+        while (bits < (unsigned)(n)) \
+            PULLBYTE(); \
+    } while (0)
+
+/* Return the low n bits of the bit accumulator (n < 16) */
+#define BITS(n) \
+    ((unsigned)hold & ((1U << (n)) - 1))
+
+/* Remove n bits from the bit accumulator */
+#define DROPBITS(n) \
+    do { \
+        hold >>= (n); \
+        bits -= (unsigned)(n); \
+    } while (0)
+
+/* Remove zero to seven bits as needed to go to a byte boundary */
+#define BYTEBITS() \
+    do { \
+        hold >>= bits & 7; \
+        bits -= bits & 7; \
+    } while (0)
+
+/* Assure that some output space is available, by writing out the window
+   if it's full.  If the write fails, return from inflateBack() with a
+   Z_BUF_ERROR. */
+#define ROOM() \
+    do { \
+        if (left == 0) { \
+            put = state->window; \
+            left = state->wsize; \
+            state->whave = left; \
+            if (out(out_desc, put, left)) { \
+                ret = Z_BUF_ERROR; \
+                goto inf_leave; \
+            } \
+        } \
+    } while (0)
+
+/*
+   strm provides the memory allocation functions and window buffer on input,
+   and provides information on the unused input on return.  For Z_DATA_ERROR
+   returns, strm will also provide an error message.
+
+   in() and out() are the call-back input and output functions.  When
+   inflateBack() needs more input, it calls in().  When inflateBack() has
+   filled the window with output, or when it completes with data in the
+   window, it calls out() to write out the data.  The application must not
+   change the provided input until in() is called again or inflateBack()
+   returns.  The application must not change the window/output buffer until
+   inflateBack() returns.
+
+   in() and out() are called with a descriptor parameter provided in the
+   inflateBack() call.  This parameter can be a structure that provides the
+   information required to do the read or write, as well as accumulated
+   information on the input and output such as totals and check values.
+
+   in() should return zero on failure.  out() should return non-zero on
+   failure.  If either in() or out() fails, than inflateBack() returns a
+   Z_BUF_ERROR.  strm->next_in can be checked for Z_NULL to see whether it
+   was in() or out() that caused in the error.  Otherwise,  inflateBack()
+   returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format
+   error, or Z_MEM_ERROR if it could not allocate memory for the state.
+   inflateBack() can also return Z_STREAM_ERROR if the input parameters
+   are not correct, i.e. strm is Z_NULL or the state was not initialized.
+ */
+int ZEXPORT inflateBack(strm, in, in_desc, out, out_desc)
+z_streamp strm;
+in_func in;
+void FAR *in_desc;
+out_func out;
+void FAR *out_desc;
+{
+    struct inflate_state FAR *state;
+    unsigned char FAR *next;    /* next input */
+    unsigned char FAR *put;     /* next output */
+    unsigned have, left;        /* available input and output */
+    unsigned long hold;         /* bit buffer */
+    unsigned bits;              /* bits in bit buffer */
+    unsigned copy;              /* number of stored or match bytes to copy */
+    unsigned char FAR *from;    /* where to copy match bytes from */
+    code here;                  /* current decoding table entry */
+    code last;                  /* parent table entry */
+    unsigned len;               /* length to copy for repeats, bits to drop */
+    int ret;                    /* return code */
+    static const unsigned short order[19] = /* permutation of code lengths */
+        {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15};
+
+    /* Check that the strm exists and that the state was initialized */
+    if (strm == Z_NULL || strm->state == Z_NULL)
+        return Z_STREAM_ERROR;
+    state = (struct inflate_state FAR *)strm->state;
+
+    /* Reset the state */
+    strm->msg = Z_NULL;
+    state->mode = TYPE;
+    state->last = 0;
+    state->whave = 0;
+    next = strm->next_in;
+    have = next != Z_NULL ? strm->avail_in : 0;
+    hold = 0;
+    bits = 0;
+    put = state->window;
+    left = state->wsize;
+
+    /* Inflate until end of block marked as last */
+    for (;;)
+        switch (state->mode) {
+        case TYPE:
+            /* determine and dispatch block type */
+            if (state->last) {
+                BYTEBITS();
+                state->mode = DONE;
+                break;
+            }
+            NEEDBITS(3);
+            state->last = BITS(1);
+            DROPBITS(1);
+            switch (BITS(2)) {
+            case 0:                             /* stored block */
+                Tracev((stderr, "inflate:     stored block%s\n",
+                        state->last ? " (last)" : ""));
+                state->mode = STORED;
+                break;
+            case 1:                             /* fixed block */
+                fixedtables(state);
+                Tracev((stderr, "inflate:     fixed codes block%s\n",
+                        state->last ? " (last)" : ""));
+                state->mode = LEN;              /* decode codes */
+                break;
+            case 2:                             /* dynamic block */
+                Tracev((stderr, "inflate:     dynamic codes block%s\n",
+                        state->last ? " (last)" : ""));
+                state->mode = TABLE;
+                break;
+            case 3:
+                strm->msg = (char *)"invalid block type";
+                state->mode = BAD;
+            }
+            DROPBITS(2);
+            break;
+
+        case STORED:
+            /* get and verify stored block length */
+            BYTEBITS();                         /* go to byte boundary */
+            NEEDBITS(32);
+            if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) {
+                strm->msg = (char *)"invalid stored block lengths";
+                state->mode = BAD;
+                break;
+            }
+            state->length = (unsigned)hold & 0xffff;
+            Tracev((stderr, "inflate:       stored length %u\n",
+                    state->length));
+            INITBITS();
+
+            /* copy stored block from input to output */
+            while (state->length != 0) {
+                copy = state->length;
+                PULL();
+                ROOM();
+                if (copy > have) copy = have;
+                if (copy > left) copy = left;
+                zmemcpy(put, next, copy);
+                have -= copy;
+                next += copy;
+                left -= copy;
+                put += copy;
+                state->length -= copy;
+            }
+            Tracev((stderr, "inflate:       stored end\n"));
+            state->mode = TYPE;
+            break;
+
+        case TABLE:
+            /* get dynamic table entries descriptor */
+            NEEDBITS(14);
+            state->nlen = BITS(5) + 257;
+            DROPBITS(5);
+            state->ndist = BITS(5) + 1;
+            DROPBITS(5);
+            state->ncode = BITS(4) + 4;
+            DROPBITS(4);
+#ifndef PKZIP_BUG_WORKAROUND
+            if (state->nlen > 286 || state->ndist > 30) {
+                strm->msg = (char *)"too many length or distance symbols";
+                state->mode = BAD;
+                break;
+            }
+#endif
+            Tracev((stderr, "inflate:       table sizes ok\n"));
+
+            /* get code length code lengths (not a typo) */
+            state->have = 0;
+            while (state->have < state->ncode) {
+                NEEDBITS(3);
+                state->lens[order[state->have++]] = (unsigned short)BITS(3);
+                DROPBITS(3);
+            }
+            while (state->have < 19)
+                state->lens[order[state->have++]] = 0;
+            state->next = state->codes;
+            state->lencode = (code const FAR *)(state->next);
+            state->lenbits = 7;
+            ret = inflate_table(CODES, state->lens, 19, &(state->next),
+                                &(state->lenbits), state->work);
+            if (ret) {
+                strm->msg = (char *)"invalid code lengths set";
+                state->mode = BAD;
+                break;
+            }
+            Tracev((stderr, "inflate:       code lengths ok\n"));
+
+            /* get length and distance code code lengths */
+            state->have = 0;
+            while (state->have < state->nlen + state->ndist) {
+                for (;;) {
+                    here = state->lencode[BITS(state->lenbits)];
+                    if ((unsigned)(here.bits) <= bits) break;
+                    PULLBYTE();
+                }
+                if (here.val < 16) {
+                    NEEDBITS(here.bits);
+                    DROPBITS(here.bits);
+                    state->lens[state->have++] = here.val;
+                }
+                else {
+                    if (here.val == 16) {
+                        NEEDBITS(here.bits + 2);
+                        DROPBITS(here.bits);
+                        if (state->have == 0) {
+                            strm->msg = (char *)"invalid bit length repeat";
+                            state->mode = BAD;
+                            break;
+                        }
+                        len = (unsigned)(state->lens[state->have - 1]);
+                        copy = 3 + BITS(2);
+                        DROPBITS(2);
+                    }
+                    else if (here.val == 17) {
+                        NEEDBITS(here.bits + 3);
+                        DROPBITS(here.bits);
+                        len = 0;
+                        copy = 3 + BITS(3);
+                        DROPBITS(3);
+                    }
+                    else {
+                        NEEDBITS(here.bits + 7);
+                        DROPBITS(here.bits);
+                        len = 0;
+                        copy = 11 + BITS(7);
+                        DROPBITS(7);
+                    }
+                    if (state->have + copy > state->nlen + state->ndist) {
+                        strm->msg = (char *)"invalid bit length repeat";
+                        state->mode = BAD;
+                        break;
+                    }
+                    while (copy--)
+                        state->lens[state->have++] = (unsigned short)len;
+                }
+            }
+
+            /* handle error breaks in while */
+            if (state->mode == BAD) break;
+
+            /* check for end-of-block code (better have one) */
+            if (state->lens[256] == 0) {
+                strm->msg = (char *)"invalid code -- missing end-of-block";
+                state->mode = BAD;
+                break;
+            }
+
+            /* build code tables -- note: do not change the lenbits or distbits
+               values here (9 and 6) without reading the comments in inftrees.h
+               concerning the ENOUGH constants, which depend on those values */
+            state->next = state->codes;
+            state->lencode = (code const FAR *)(state->next);
+            state->lenbits = 9;
+            ret = inflate_table(LENS, state->lens, state->nlen, &(state->next),
+                                &(state->lenbits), state->work);
+            if (ret) {
+                strm->msg = (char *)"invalid literal/lengths set";
+                state->mode = BAD;
+                break;
+            }
+            state->distcode = (code const FAR *)(state->next);
+            state->distbits = 6;
+            ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist,
+                            &(state->next), &(state->distbits), state->work);
+            if (ret) {
+                strm->msg = (char *)"invalid distances set";
+                state->mode = BAD;
+                break;
+            }
+            Tracev((stderr, "inflate:       codes ok\n"));
+            state->mode = LEN;
+
+        case LEN:
+            /* use inflate_fast() if we have enough input and output */
+            if (have >= 6 && left >= 258) {
+                RESTORE();
+                if (state->whave < state->wsize)
+                    state->whave = state->wsize - left;
+                inflate_fast(strm, state->wsize);
+                LOAD();
+                break;
+            }
+
+            /* get a literal, length, or end-of-block code */
+            for (;;) {
+                here = state->lencode[BITS(state->lenbits)];
+                if ((unsigned)(here.bits) <= bits) break;
+                PULLBYTE();
+            }
+            if (here.op && (here.op & 0xf0) == 0) {
+                last = here;
+                for (;;) {
+                    here = state->lencode[last.val +
+                            (BITS(last.bits + last.op) >> last.bits)];
+                    if ((unsigned)(last.bits + here.bits) <= bits) break;
+                    PULLBYTE();
+                }
+                DROPBITS(last.bits);
+            }
+            DROPBITS(here.bits);
+            state->length = (unsigned)here.val;
+
+            /* process literal */
+            if (here.op == 0) {
+                Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
+                        "inflate:         literal '%c'\n" :
+                        "inflate:         literal 0x%02x\n", here.val));
+                ROOM();
+                *put++ = (unsigned char)(state->length);
+                left--;
+                state->mode = LEN;
+                break;
+            }
+
+            /* process end of block */
+            if (here.op & 32) {
+                Tracevv((stderr, "inflate:         end of block\n"));
+                state->mode = TYPE;
+                break;
+            }
+
+            /* invalid code */
+            if (here.op & 64) {
+                strm->msg = (char *)"invalid literal/length code";
+                state->mode = BAD;
+                break;
+            }
+
+            /* length code -- get extra bits, if any */
+            state->extra = (unsigned)(here.op) & 15;
+            if (state->extra != 0) {
+                NEEDBITS(state->extra);
+                state->length += BITS(state->extra);
+                DROPBITS(state->extra);
+            }
+            Tracevv((stderr, "inflate:         length %u\n", state->length));
+
+            /* get distance code */
+            for (;;) {
+                here = state->distcode[BITS(state->distbits)];
+                if ((unsigned)(here.bits) <= bits) break;
+                PULLBYTE();
+            }
+            if ((here.op & 0xf0) == 0) {
+                last = here;
+                for (;;) {
+                    here = state->distcode[last.val +
+                            (BITS(last.bits + last.op) >> last.bits)];
+                    if ((unsigned)(last.bits + here.bits) <= bits) break;
+                    PULLBYTE();
+                }
+                DROPBITS(last.bits);
+            }
+            DROPBITS(here.bits);
+            if (here.op & 64) {
+                strm->msg = (char *)"invalid distance code";
+                state->mode = BAD;
+                break;
+            }
+            state->offset = (unsigned)here.val;
+
+            /* get distance extra bits, if any */
+            state->extra = (unsigned)(here.op) & 15;
+            if (state->extra != 0) {
+                NEEDBITS(state->extra);
+                state->offset += BITS(state->extra);
+                DROPBITS(state->extra);
+            }
+            if (state->offset > state->wsize - (state->whave < state->wsize ?
+                                                left : 0)) {
+                strm->msg = (char *)"invalid distance too far back";
+                state->mode = BAD;
+                break;
+            }
+            Tracevv((stderr, "inflate:         distance %u\n", state->offset));
+
+            /* copy match from window to output */
+            do {
+                ROOM();
+                copy = state->wsize - state->offset;
+                if (copy < left) {
+                    from = put + copy;
+                    copy = left - copy;
+                }
+                else {
+                    from = put - state->offset;
+                    copy = left;
+                }
+                if (copy > state->length) copy = state->length;
+                state->length -= copy;
+                left -= copy;
+                do {
+                    *put++ = *from++;
+                } while (--copy);
+            } while (state->length != 0);
+            break;
+
+        case DONE:
+            /* inflate stream terminated properly -- write leftover output */
+            ret = Z_STREAM_END;
+            if (left < state->wsize) {
+                if (out(out_desc, state->window, state->wsize - left))
+                    ret = Z_BUF_ERROR;
+            }
+            goto inf_leave;
+
+        case BAD:
+            ret = Z_DATA_ERROR;
+            goto inf_leave;
+
+        default:                /* can't happen, but makes compilers happy */
+            ret = Z_STREAM_ERROR;
+            goto inf_leave;
+        }
+
+    /* Return unused input */
+  inf_leave:
+    strm->next_in = next;
+    strm->avail_in = have;
+    return ret;
+}
+
+int ZEXPORT inflateBackEnd(strm)
+z_streamp strm;
+{
+    if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0)
+        return Z_STREAM_ERROR;
+    ZFREE(strm, strm->state);
+    strm->state = Z_NULL;
+    Tracev((stderr, "inflate: end\n"));
+    return Z_OK;
+}

external/cfitsio/inffast.c

@@ -0,0 +1,340 @@
+/* inffast.c -- fast decoding
+ * Copyright (C) 1995-2008, 2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "zutil.h"
+#include "inftrees.h"
+#include "inflate.h"
+#include "inffast.h"
+
+#ifndef ASMINF
+
+/* Allow machine dependent optimization for post-increment or pre-increment.
+   Based on testing to date,
+   Pre-increment preferred for:
+   - PowerPC G3 (Adler)
+   - MIPS R5000 (Randers-Pehrson)
+   Post-increment preferred for:
+   - none
+   No measurable difference:
+   - Pentium III (Anderson)
+   - M68060 (Nikl)
+ */
+#ifdef POSTINC
+#  define OFF 0
+#  define PUP(a) *(a)++
+#else
+#  define OFF 1
+#  define PUP(a) *++(a)
+#endif
+
+/*
+   Decode literal, length, and distance codes and write out the resulting
+   literal and match bytes until either not enough input or output is
+   available, an end-of-block is encountered, or a data error is encountered.
+   When large enough input and output buffers are supplied to inflate(), for
+   example, a 16K input buffer and a 64K output buffer, more than 95% of the
+   inflate execution time is spent in this routine.
+
+   Entry assumptions:
+
+        state->mode == LEN
+        strm->avail_in >= 6
+        strm->avail_out >= 258
+        start >= strm->avail_out
+        state->bits < 8
+
+   On return, state->mode is one of:
+
+        LEN -- ran out of enough output space or enough available input
+        TYPE -- reached end of block code, inflate() to interpret next block
+        BAD -- error in block data
+
+   Notes:
+
+    - The maximum input bits used by a length/distance pair is 15 bits for the
+      length code, 5 bits for the length extra, 15 bits for the distance code,
+      and 13 bits for the distance extra.  This totals 48 bits, or six bytes.
+      Therefore if strm->avail_in >= 6, then there is enough input to avoid
+      checking for available input while decoding.
+
+    - The maximum bytes that a single length/distance pair can output is 258
+      bytes, which is the maximum length that can be coded.  inflate_fast()
+      requires strm->avail_out >= 258 for each loop to avoid checking for
+      output space.
+ */
+void ZLIB_INTERNAL inflate_fast(strm, start)
+z_streamp strm;
+unsigned start;         /* inflate()'s starting value for strm->avail_out */
+{
+    struct inflate_state FAR *state;
+    unsigned char FAR *in;      /* local strm->next_in */
+    unsigned char FAR *last;    /* while in < last, enough input available */
+    unsigned char FAR *out;     /* local strm->next_out */
+    unsigned char FAR *beg;     /* inflate()'s initial strm->next_out */
+    unsigned char FAR *end;     /* while out < end, enough space available */
+#ifdef INFLATE_STRICT
+    unsigned dmax;              /* maximum distance from zlib header */
+#endif
+    unsigned wsize;             /* window size or zero if not using window */
+    unsigned whave;             /* valid bytes in the window */
+    unsigned wnext;             /* window write index */
+    unsigned char FAR *window;  /* allocated sliding window, if wsize != 0 */
+    unsigned long hold;         /* local strm->hold */
+    unsigned bits;              /* local strm->bits */
+    code const FAR *lcode;      /* local strm->lencode */
+    code const FAR *dcode;      /* local strm->distcode */
+    unsigned lmask;             /* mask for first level of length codes */
+    unsigned dmask;             /* mask for first level of distance codes */
+    code here;                  /* retrieved table entry */
+    unsigned op;                /* code bits, operation, extra bits, or */
+                                /*  window position, window bytes to copy */
+    unsigned len;               /* match length, unused bytes */
+    unsigned dist;              /* match distance */
+    unsigned char FAR *from;    /* where to copy match from */
+
+    /* copy state to local variables */
+    state = (struct inflate_state FAR *)strm->state;
+    in = strm->next_in - OFF;
+    last = in + (strm->avail_in - 5);
+    out = strm->next_out - OFF;
+    beg = out - (start - strm->avail_out);
+    end = out + (strm->avail_out - 257);
+#ifdef INFLATE_STRICT
+    dmax = state->dmax;
+#endif
+    wsize = state->wsize;
+    whave = state->whave;
+    wnext = state->wnext;
+    window = state->window;
+    hold = state->hold;
+    bits = state->bits;
+    lcode = state->lencode;
+    dcode = state->distcode;
+    lmask = (1U << state->lenbits) - 1;
+    dmask = (1U << state->distbits) - 1;
+
+    /* decode literals and length/distances until end-of-block or not enough
+       input data or output space */
+    do {
+        if (bits < 15) {
+            hold += (unsigned long)(PUP(in)) << bits;
+            bits += 8;
+            hold += (unsigned long)(PUP(in)) << bits;
+            bits += 8;
+        }
+        here = lcode[hold & lmask];
+      dolen:
+        op = (unsigned)(here.bits);
+        hold >>= op;
+        bits -= op;
+        op = (unsigned)(here.op);
+        if (op == 0) {                          /* literal */
+            Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
+                    "inflate:         literal '%c'\n" :
+                    "inflate:         literal 0x%02x\n", here.val));
+            PUP(out) = (unsigned char)(here.val);
+        }
+        else if (op & 16) {                     /* length base */
+            len = (unsigned)(here.val);
+            op &= 15;                           /* number of extra bits */
+            if (op) {
+                if (bits < op) {
+                    hold += (unsigned long)(PUP(in)) << bits;
+                    bits += 8;
+                }
+                len += (unsigned)hold & ((1U << op) - 1);
+                hold >>= op;
+                bits -= op;
+            }
+            Tracevv((stderr, "inflate:         length %u\n", len));
+            if (bits < 15) {
+                hold += (unsigned long)(PUP(in)) << bits;
+                bits += 8;
+                hold += (unsigned long)(PUP(in)) << bits;
+                bits += 8;
+            }
+            here = dcode[hold & dmask];
+          dodist:
+            op = (unsigned)(here.bits);
+            hold >>= op;
+            bits -= op;
+            op = (unsigned)(here.op);
+            if (op & 16) {                      /* distance base */
+                dist = (unsigned)(here.val);
+                op &= 15;                       /* number of extra bits */
+                if (bits < op) {
+                    hold += (unsigned long)(PUP(in)) << bits;
+                    bits += 8;
+                    if (bits < op) {
+                        hold += (unsigned long)(PUP(in)) << bits;
+                        bits += 8;
+                    }
+                }
+                dist += (unsigned)hold & ((1U << op) - 1);
+#ifdef INFLATE_STRICT
+                if (dist > dmax) {
+                    strm->msg = (char *)"invalid distance too far back";
+                    state->mode = BAD;
+                    break;
+                }
+#endif
+                hold >>= op;
+                bits -= op;
+                Tracevv((stderr, "inflate:         distance %u\n", dist));
+                op = (unsigned)(out - beg);     /* max distance in output */
+                if (dist > op) {                /* see if copy from window */
+                    op = dist - op;             /* distance back in window */
+                    if (op > whave) {
+                        if (state->sane) {
+                            strm->msg =
+                                (char *)"invalid distance too far back";
+                            state->mode = BAD;
+                            break;
+                        }
+#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
+                        if (len <= op - whave) {
+                            do {
+                                PUP(out) = 0;
+                            } while (--len);
+                            continue;
+                        }
+                        len -= op - whave;
+                        do {
+                            PUP(out) = 0;
+                        } while (--op > whave);
+                        if (op == 0) {
+                            from = out - dist;
+                            do {
+                                PUP(out) = PUP(from);
+                            } while (--len);
+                            continue;
+                        }
+#endif
+                    }
+                    from = window - OFF;
+                    if (wnext == 0) {           /* very common case */
+                        from += wsize - op;
+                        if (op < len) {         /* some from window */
+                            len -= op;
+                            do {
+                                PUP(out) = PUP(from);
+                            } while (--op);
+                            from = out - dist;  /* rest from output */
+                        }
+                    }
+                    else if (wnext < op) {      /* wrap around window */
+                        from += wsize + wnext - op;
+                        op -= wnext;
+                        if (op < len) {         /* some from end of window */
+                            len -= op;
+                            do {
+                                PUP(out) = PUP(from);
+                            } while (--op);
+                            from = window - OFF;
+                            if (wnext < len) {  /* some from start of window */
+                                op = wnext;
+                                len -= op;
+                                do {
+                                    PUP(out) = PUP(from);
+                                } while (--op);
+                                from = out - dist;      /* rest from output */
+                            }
+                        }
+                    }
+                    else {                      /* contiguous in window */
+                        from += wnext - op;
+                        if (op < len) {         /* some from window */
+                            len -= op;
+                            do {
+                                PUP(out) = PUP(from);
+                            } while (--op);
+                            from = out - dist;  /* rest from output */
+                        }
+                    }
+                    while (len > 2) {
+                        PUP(out) = PUP(from);
+                        PUP(out) = PUP(from);
+                        PUP(out) = PUP(from);
+                        len -= 3;
+                    }
+                    if (len) {
+                        PUP(out) = PUP(from);
+                        if (len > 1)
+                            PUP(out) = PUP(from);
+                    }
+                }
+                else {
+                    from = out - dist;          /* copy direct from output */
+                    do {                        /* minimum length is three */
+                        PUP(out) = PUP(from);
+                        PUP(out) = PUP(from);
+                        PUP(out) = PUP(from);
+                        len -= 3;
+                    } while (len > 2);
+                    if (len) {
+                        PUP(out) = PUP(from);
+                        if (len > 1)
+                            PUP(out) = PUP(from);
+                    }
+                }
+            }
+            else if ((op & 64) == 0) {          /* 2nd level distance code */
+                here = dcode[here.val + (hold & ((1U << op) - 1))];
+                goto dodist;
+            }
+            else {
+                strm->msg = (char *)"invalid distance code";
+                state->mode = BAD;
+                break;
+            }
+        }
+        else if ((op & 64) == 0) {              /* 2nd level length code */
+            here = lcode[here.val + (hold & ((1U << op) - 1))];
+            goto dolen;
+        }
+        else if (op & 32) {                     /* end-of-block */
+            Tracevv((stderr, "inflate:         end of block\n"));
+            state->mode = TYPE;
+            break;
+        }
+        else {
+            strm->msg = (char *)"invalid literal/length code";
+            state->mode = BAD;
+            break;
+        }
+    } while (in < last && out < end);
+
+    /* return unused bytes (on entry, bits < 8, so in won't go too far back) */
+    len = bits >> 3;
+    in -= len;
+    bits -= len << 3;
+    hold &= (1U << bits) - 1;
+
+    /* update state and return */
+    strm->next_in = in + OFF;
+    strm->next_out = out + OFF;
+    strm->avail_in = (unsigned)(in < last ? 5 + (last - in) : 5 - (in - last));
+    strm->avail_out = (unsigned)(out < end ?
+                                 257 + (end - out) : 257 - (out - end));
+    state->hold = hold;
+    state->bits = bits;
+    return;
+}
+
+/*
+   inflate_fast() speedups that turned out slower (on a PowerPC G3 750CXe):
+   - Using bit fields for code structure
+   - Different op definition to avoid & for extra bits (do & for table bits)
+   - Three separate decoding do-loops for direct, window, and wnext == 0
+   - Special case for distance > 1 copies to do overlapped load and store copy
+   - Explicit branch predictions (based on measured branch probabilities)
+   - Deferring match copy and interspersed it with decoding subsequent codes
+   - Swapping literal/length else
+   - Swapping window/direct else
+   - Larger unrolled copy loops (three is about right)
+   - Moving len -= 3 statement into middle of loop
+ */
+
+#endif /* !ASMINF */

external/cfitsio/inffast.h

@@ -0,0 +1,11 @@
+/* inffast.h -- header to use inffast.c
+ * Copyright (C) 1995-2003, 2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* WARNING: this file should *not* be used by applications. It is
+   part of the implementation of the compression library and is
+   subject to change. Applications should only use zlib.h.
+ */
+
+void ZLIB_INTERNAL inflate_fast OF((z_streamp strm, unsigned start));

external/cfitsio/inffixed.h

@@ -0,0 +1,94 @@
+    /* inffixed.h -- table for decoding fixed codes
+     * Generated automatically by makefixed().
+     */
+
+    /* WARNING: this file should *not* be used by applications. It
+       is part of the implementation of the compression library and
+       is subject to change. Applications should only use zlib.h.
+     */
+
+    static const code lenfix[512] = {
+        {96,7,0},{0,8,80},{0,8,16},{20,8,115},{18,7,31},{0,8,112},{0,8,48},
+        {0,9,192},{16,7,10},{0,8,96},{0,8,32},{0,9,160},{0,8,0},{0,8,128},
+        {0,8,64},{0,9,224},{16,7,6},{0,8,88},{0,8,24},{0,9,144},{19,7,59},
+        {0,8,120},{0,8,56},{0,9,208},{17,7,17},{0,8,104},{0,8,40},{0,9,176},
+        {0,8,8},{0,8,136},{0,8,72},{0,9,240},{16,7,4},{0,8,84},{0,8,20},
+        {21,8,227},{19,7,43},{0,8,116},{0,8,52},{0,9,200},{17,7,13},{0,8,100},
+        {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},{16,7,8},
+        {0,8,92},{0,8,28},{0,9,152},{20,7,83},{0,8,124},{0,8,60},{0,9,216},
+        {18,7,23},{0,8,108},{0,8,44},{0,9,184},{0,8,12},{0,8,140},{0,8,76},
+        {0,9,248},{16,7,3},{0,8,82},{0,8,18},{21,8,163},{19,7,35},{0,8,114},
+        {0,8,50},{0,9,196},{17,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2},
+        {0,8,130},{0,8,66},{0,9,228},{16,7,7},{0,8,90},{0,8,26},{0,9,148},
+        {20,7,67},{0,8,122},{0,8,58},{0,9,212},{18,7,19},{0,8,106},{0,8,42},
+        {0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},{16,7,5},{0,8,86},
+        {0,8,22},{64,8,0},{19,7,51},{0,8,118},{0,8,54},{0,9,204},{17,7,15},
+        {0,8,102},{0,8,38},{0,9,172},{0,8,6},{0,8,134},{0,8,70},{0,9,236},
+        {16,7,9},{0,8,94},{0,8,30},{0,9,156},{20,7,99},{0,8,126},{0,8,62},
+        {0,9,220},{18,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142},
+        {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{21,8,131},{18,7,31},
+        {0,8,113},{0,8,49},{0,9,194},{16,7,10},{0,8,97},{0,8,33},{0,9,162},
+        {0,8,1},{0,8,129},{0,8,65},{0,9,226},{16,7,6},{0,8,89},{0,8,25},
+        {0,9,146},{19,7,59},{0,8,121},{0,8,57},{0,9,210},{17,7,17},{0,8,105},
+        {0,8,41},{0,9,178},{0,8,9},{0,8,137},{0,8,73},{0,9,242},{16,7,4},
+        {0,8,85},{0,8,21},{16,8,258},{19,7,43},{0,8,117},{0,8,53},{0,9,202},
+        {17,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},{0,8,69},
+        {0,9,234},{16,7,8},{0,8,93},{0,8,29},{0,9,154},{20,7,83},{0,8,125},
+        {0,8,61},{0,9,218},{18,7,23},{0,8,109},{0,8,45},{0,9,186},{0,8,13},
+        {0,8,141},{0,8,77},{0,9,250},{16,7,3},{0,8,83},{0,8,19},{21,8,195},
+        {19,7,35},{0,8,115},{0,8,51},{0,9,198},{17,7,11},{0,8,99},{0,8,35},
+        {0,9,166},{0,8,3},{0,8,131},{0,8,67},{0,9,230},{16,7,7},{0,8,91},
+        {0,8,27},{0,9,150},{20,7,67},{0,8,123},{0,8,59},{0,9,214},{18,7,19},
+        {0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},{0,8,75},{0,9,246},
+        {16,7,5},{0,8,87},{0,8,23},{64,8,0},{19,7,51},{0,8,119},{0,8,55},
+        {0,9,206},{17,7,15},{0,8,103},{0,8,39},{0,9,174},{0,8,7},{0,8,135},
+        {0,8,71},{0,9,238},{16,7,9},{0,8,95},{0,8,31},{0,9,158},{20,7,99},
+        {0,8,127},{0,8,63},{0,9,222},{18,7,27},{0,8,111},{0,8,47},{0,9,190},
+        {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},{0,8,16},
+        {20,8,115},{18,7,31},{0,8,112},{0,8,48},{0,9,193},{16,7,10},{0,8,96},
+        {0,8,32},{0,9,161},{0,8,0},{0,8,128},{0,8,64},{0,9,225},{16,7,6},
+        {0,8,88},{0,8,24},{0,9,145},{19,7,59},{0,8,120},{0,8,56},{0,9,209},
+        {17,7,17},{0,8,104},{0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72},
+        {0,9,241},{16,7,4},{0,8,84},{0,8,20},{21,8,227},{19,7,43},{0,8,116},
+        {0,8,52},{0,9,201},{17,7,13},{0,8,100},{0,8,36},{0,9,169},{0,8,4},
+        {0,8,132},{0,8,68},{0,9,233},{16,7,8},{0,8,92},{0,8,28},{0,9,153},
+        {20,7,83},{0,8,124},{0,8,60},{0,9,217},{18,7,23},{0,8,108},{0,8,44},
+        {0,9,185},{0,8,12},{0,8,140},{0,8,76},{0,9,249},{16,7,3},{0,8,82},
+        {0,8,18},{21,8,163},{19,7,35},{0,8,114},{0,8,50},{0,9,197},{17,7,11},
+        {0,8,98},{0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229},
+        {16,7,7},{0,8,90},{0,8,26},{0,9,149},{20,7,67},{0,8,122},{0,8,58},
+        {0,9,213},{18,7,19},{0,8,106},{0,8,42},{0,9,181},{0,8,10},{0,8,138},
+        {0,8,74},{0,9,245},{16,7,5},{0,8,86},{0,8,22},{64,8,0},{19,7,51},
+        {0,8,118},{0,8,54},{0,9,205},{17,7,15},{0,8,102},{0,8,38},{0,9,173},
+        {0,8,6},{0,8,134},{0,8,70},{0,9,237},{16,7,9},{0,8,94},{0,8,30},
+        {0,9,157},{20,7,99},{0,8,126},{0,8,62},{0,9,221},{18,7,27},{0,8,110},
+        {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},{96,7,0},
+        {0,8,81},{0,8,17},{21,8,131},{18,7,31},{0,8,113},{0,8,49},{0,9,195},
+        {16,7,10},{0,8,97},{0,8,33},{0,9,163},{0,8,1},{0,8,129},{0,8,65},
+        {0,9,227},{16,7,6},{0,8,89},{0,8,25},{0,9,147},{19,7,59},{0,8,121},
+        {0,8,57},{0,9,211},{17,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9},
+        {0,8,137},{0,8,73},{0,9,243},{16,7,4},{0,8,85},{0,8,21},{16,8,258},
+        {19,7,43},{0,8,117},{0,8,53},{0,9,203},{17,7,13},{0,8,101},{0,8,37},
+        {0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},{16,7,8},{0,8,93},
+        {0,8,29},{0,9,155},{20,7,83},{0,8,125},{0,8,61},{0,9,219},{18,7,23},
+        {0,8,109},{0,8,45},{0,9,187},{0,8,13},{0,8,141},{0,8,77},{0,9,251},
+        {16,7,3},{0,8,83},{0,8,19},{21,8,195},{19,7,35},{0,8,115},{0,8,51},
+        {0,9,199},{17,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131},
+        {0,8,67},{0,9,231},{16,7,7},{0,8,91},{0,8,27},{0,9,151},{20,7,67},
+        {0,8,123},{0,8,59},{0,9,215},{18,7,19},{0,8,107},{0,8,43},{0,9,183},
+        {0,8,11},{0,8,139},{0,8,75},{0,9,247},{16,7,5},{0,8,87},{0,8,23},
+        {64,8,0},{19,7,51},{0,8,119},{0,8,55},{0,9,207},{17,7,15},{0,8,103},
+        {0,8,39},{0,9,175},{0,8,7},{0,8,135},{0,8,71},{0,9,239},{16,7,9},
+        {0,8,95},{0,8,31},{0,9,159},{20,7,99},{0,8,127},{0,8,63},{0,9,223},
+        {18,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},{0,8,79},
+        {0,9,255}
+    };
+
+    static const code distfix[32] = {
+        {16,5,1},{23,5,257},{19,5,17},{27,5,4097},{17,5,5},{25,5,1025},
+        {21,5,65},{29,5,16385},{16,5,3},{24,5,513},{20,5,33},{28,5,8193},
+        {18,5,9},{26,5,2049},{22,5,129},{64,5,0},{16,5,2},{23,5,385},
+        {19,5,25},{27,5,6145},{17,5,7},{25,5,1537},{21,5,97},{29,5,24577},
+        {16,5,4},{24,5,769},{20,5,49},{28,5,12289},{18,5,13},{26,5,3073},
+        {22,5,193},{64,5,0}
+    };

external/cfitsio/inflate.h

@@ -0,0 +1,122 @@
+/* inflate.h -- internal inflate state definition
+ * Copyright (C) 1995-2009 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* WARNING: this file should *not* be used by applications. It is
+   part of the implementation of the compression library and is
+   subject to change. Applications should only use zlib.h.
+ */
+
+/* define NO_GZIP when compiling if you want to disable gzip header and
+   trailer decoding by inflate().  NO_GZIP would be used to avoid linking in
+   the crc code when it is not needed.  For shared libraries, gzip decoding
+   should be left enabled. */
+#ifndef NO_GZIP
+#  define GUNZIP
+#endif
+
+/* Possible inflate modes between inflate() calls */
+typedef enum {
+    HEAD,       /* i: waiting for magic header */
+    FLAGS,      /* i: waiting for method and flags (gzip) */
+    TIME,       /* i: waiting for modification time (gzip) */
+    OS,         /* i: waiting for extra flags and operating system (gzip) */
+    EXLEN,      /* i: waiting for extra length (gzip) */
+    EXTRA,      /* i: waiting for extra bytes (gzip) */
+    NAME,       /* i: waiting for end of file name (gzip) */
+    COMMENT,    /* i: waiting for end of comment (gzip) */
+    HCRC,       /* i: waiting for header crc (gzip) */
+    DICTID,     /* i: waiting for dictionary check value */
+    DICT,       /* waiting for inflateSetDictionary() call */
+        TYPE,       /* i: waiting for type bits, including last-flag bit */
+        TYPEDO,     /* i: same, but skip check to exit inflate on new block */
+        STORED,     /* i: waiting for stored size (length and complement) */
+        COPY_,      /* i/o: same as COPY below, but only first time in */
+        COPY,       /* i/o: waiting for input or output to copy stored block */
+        TABLE,      /* i: waiting for dynamic block table lengths */
+        LENLENS,    /* i: waiting for code length code lengths */
+        CODELENS,   /* i: waiting for length/lit and distance code lengths */
+            LEN_,       /* i: same as LEN below, but only first time in */
+            LEN,        /* i: waiting for length/lit/eob code */
+            LENEXT,     /* i: waiting for length extra bits */
+            DIST,       /* i: waiting for distance code */
+            DISTEXT,    /* i: waiting for distance extra bits */
+            MATCH,      /* o: waiting for output space to copy string */
+            LIT,        /* o: waiting for output space to write literal */
+    CHECK,      /* i: waiting for 32-bit check value */
+    LENGTH,     /* i: waiting for 32-bit length (gzip) */
+    DONE,       /* finished check, done -- remain here until reset */
+    BAD,        /* got a data error -- remain here until reset */
+    MEM,        /* got an inflate() memory error -- remain here until reset */
+    SYNC        /* looking for synchronization bytes to restart inflate() */
+} inflate_mode;
+
+/*
+    State transitions between above modes -
+
+    (most modes can go to BAD or MEM on error -- not shown for clarity)
+
+    Process header:
+        HEAD -> (gzip) or (zlib) or (raw)
+        (gzip) -> FLAGS -> TIME -> OS -> EXLEN -> EXTRA -> NAME -> COMMENT ->
+                  HCRC -> TYPE
+        (zlib) -> DICTID or TYPE
+        DICTID -> DICT -> TYPE
+        (raw) -> TYPEDO
+    Read deflate blocks:
+            TYPE -> TYPEDO -> STORED or TABLE or LEN_ or CHECK
+            STORED -> COPY_ -> COPY -> TYPE
+            TABLE -> LENLENS -> CODELENS -> LEN_
+            LEN_ -> LEN
+    Read deflate codes in fixed or dynamic block:
+                LEN -> LENEXT or LIT or TYPE
+                LENEXT -> DIST -> DISTEXT -> MATCH -> LEN
+                LIT -> LEN
+    Process trailer:
+        CHECK -> LENGTH -> DONE
+ */
+
+/* state maintained between inflate() calls.  Approximately 10K bytes. */
+struct inflate_state {
+    inflate_mode mode;          /* current inflate mode */
+    int last;                   /* true if processing last block */
+    int wrap;                   /* bit 0 true for zlib, bit 1 true for gzip */
+    int havedict;               /* true if dictionary provided */
+    int flags;                  /* gzip header method and flags (0 if zlib) */
+    unsigned dmax;              /* zlib header max distance (INFLATE_STRICT) */
+    unsigned long check;        /* protected copy of check value */
+    unsigned long total;        /* protected copy of output count */
+    gz_headerp head;            /* where to save gzip header information */
+        /* sliding window */
+    unsigned wbits;             /* log base 2 of requested window size */
+    unsigned wsize;             /* window size or zero if not using window */
+    unsigned whave;             /* valid bytes in the window */
+    unsigned wnext;             /* window write index */
+    unsigned char FAR *window;  /* allocated sliding window, if needed */
+        /* bit accumulator */
+    unsigned long hold;         /* input bit accumulator */
+    unsigned bits;              /* number of bits in "in" */
+        /* for string and stored block copying */
+    unsigned length;            /* literal or length of data to copy */
+    unsigned offset;            /* distance back to copy string from */
+        /* for table and code decoding */
+    unsigned extra;             /* extra bits needed */
+        /* fixed and dynamic code tables */
+    code const FAR *lencode;    /* starting table for length/literal codes */
+    code const FAR *distcode;   /* starting table for distance codes */
+    unsigned lenbits;           /* index bits for lencode */
+    unsigned distbits;          /* index bits for distcode */
+        /* dynamic table building */
+    unsigned ncode;             /* number of code length code lengths */
+    unsigned nlen;              /* number of length code lengths */
+    unsigned ndist;             /* number of distance code lengths */
+    unsigned have;              /* number of code lengths in lens[] */
+    code FAR *next;             /* next available space in codes[] */
+    unsigned short lens[320];   /* temporary storage for code lengths */
+    unsigned short work[288];   /* work area for code table building */
+    code codes[ENOUGH];         /* space for code tables */
+    int sane;                   /* if false, allow invalid distance too far */
+    int back;                   /* bits back of last unprocessed length/lit */
+    unsigned was;               /* initial length of match */
+};

external/cfitsio/inftrees.c

@@ -0,0 +1,330 @@
+/* inftrees.c -- generate Huffman trees for efficient decoding
+ * Copyright (C) 1995-2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "zutil.h"
+#include "inftrees.h"
+
+#define MAXBITS 15
+
+const char inflate_copyright[] =
+   " inflate 1.2.5 Copyright 1995-2010 Mark Adler ";
+/*
+  If you use the zlib library in a product, an acknowledgment is welcome
+  in the documentation of your product. If for some reason you cannot
+  include such an acknowledgment, I would appreciate that you keep this
+  copyright string in the executable of your product.
+ */
+
+/*
+   Build a set of tables to decode the provided canonical Huffman code.
+   The code lengths are lens[0..codes-1].  The result starts at *table,
+   whose indices are 0..2^bits-1.  work is a writable array of at least
+   lens shorts, which is used as a work area.  type is the type of code
+   to be generated, CODES, LENS, or DISTS.  On return, zero is success,
+   -1 is an invalid code, and +1 means that ENOUGH isn't enough.  table
+   on return points to the next available entry's address.  bits is the
+   requested root table index bits, and on return it is the actual root
+   table index bits.  It will differ if the request is greater than the
+   longest code or if it is less than the shortest code.
+ */
+int ZLIB_INTERNAL inflate_table(type, lens, codes, table, bits, work)
+codetype type;
+unsigned short FAR *lens;
+unsigned codes;
+code FAR * FAR *table;
+unsigned FAR *bits;
+unsigned short FAR *work;
+{
+    unsigned len;               /* a code's length in bits */
+    unsigned sym;               /* index of code symbols */
+    unsigned min, max;          /* minimum and maximum code lengths */
+    unsigned root;              /* number of index bits for root table */
+    unsigned curr;              /* number of index bits for current table */
+    unsigned drop;              /* code bits to drop for sub-table */
+    int left;                   /* number of prefix codes available */
+    unsigned used;              /* code entries in table used */
+    unsigned huff;              /* Huffman code */
+    unsigned incr;              /* for incrementing code, index */
+    unsigned fill;              /* index for replicating entries */
+    unsigned low;               /* low bits for current root entry */
+    unsigned mask;              /* mask for low root bits */
+    code here;                  /* table entry for duplication */
+    code FAR *next;             /* next available space in table */
+    const unsigned short FAR *base;     /* base value table to use */
+    const unsigned short FAR *extra;    /* extra bits table to use */
+    int end;                    /* use base and extra for symbol > end */
+    unsigned short count[MAXBITS+1];    /* number of codes of each length */
+    unsigned short offs[MAXBITS+1];     /* offsets in table for each length */
+    static const unsigned short lbase[31] = { /* Length codes 257..285 base */
+        3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
+        35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0};
+    static const unsigned short lext[31] = { /* Length codes 257..285 extra */
+        16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18,
+        19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 73, 195};
+    static const unsigned short dbase[32] = { /* Distance codes 0..29 base */
+        1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193,
+        257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145,
+        8193, 12289, 16385, 24577, 0, 0};
+    static const unsigned short dext[32] = { /* Distance codes 0..29 extra */
+        16, 16, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22,
+        23, 23, 24, 24, 25, 25, 26, 26, 27, 27,
+        28, 28, 29, 29, 64, 64};
+
+    /*
+       Process a set of code lengths to create a canonical Huffman code.  The
+       code lengths are lens[0..codes-1].  Each length corresponds to the
+       symbols 0..codes-1.  The Huffman code is generated by first sorting the
+       symbols by length from short to long, and retaining the symbol order
+       for codes with equal lengths.  Then the code starts with all zero bits
+       for the first code of the shortest length, and the codes are integer
+       increments for the same length, and zeros are appended as the length
+       increases.  For the deflate format, these bits are stored backwards
+       from their more natural integer increment ordering, and so when the
+       decoding tables are built in the large loop below, the integer codes
+       are incremented backwards.
+
+       This routine assumes, but does not check, that all of the entries in
+       lens[] are in the range 0..MAXBITS.  The caller must assure this.
+       1..MAXBITS is interpreted as that code length.  zero means that that
+       symbol does not occur in this code.
+
+       The codes are sorted by computing a count of codes for each length,
+       creating from that a table of starting indices for each length in the
+       sorted table, and then entering the symbols in order in the sorted
+       table.  The sorted table is work[], with that space being provided by
+       the caller.
+
+       The length counts are used for other purposes as well, i.e. finding
+       the minimum and maximum length codes, determining if there are any
+       codes at all, checking for a valid set of lengths, and looking ahead
+       at length counts to determine sub-table sizes when building the
+       decoding tables.
+     */
+
+    /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */
+    for (len = 0; len <= MAXBITS; len++)
+        count[len] = 0;
+    for (sym = 0; sym < codes; sym++)
+        count[lens[sym]]++;
+
+    /* bound code lengths, force root to be within code lengths */
+    root = *bits;
+    for (max = MAXBITS; max >= 1; max--)
+        if (count[max] != 0) break;
+    if (root > max) root = max;
+    if (max == 0) {                     /* no symbols to code at all */
+        here.op = (unsigned char)64;    /* invalid code marker */
+        here.bits = (unsigned char)1;
+        here.val = (unsigned short)0;
+        *(*table)++ = here;             /* make a table to force an error */
+        *(*table)++ = here;
+        *bits = 1;
+        return 0;     /* no symbols, but wait for decoding to report error */
+    }
+    for (min = 1; min < max; min++)
+        if (count[min] != 0) break;
+    if (root < min) root = min;
+
+    /* check for an over-subscribed or incomplete set of lengths */
+    left = 1;
+    for (len = 1; len <= MAXBITS; len++) {
+        left <<= 1;
+        left -= count[len];
+        if (left < 0) return -1;        /* over-subscribed */
+    }
+    if (left > 0 && (type == CODES || max != 1))
+        return -1;                      /* incomplete set */
+
+    /* generate offsets into symbol table for each length for sorting */
+    offs[1] = 0;
+    for (len = 1; len < MAXBITS; len++)
+        offs[len + 1] = offs[len] + count[len];
+
+    /* sort symbols by length, by symbol order within each length */
+    for (sym = 0; sym < codes; sym++)
+        if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym;
+
+    /*
+       Create and fill in decoding tables.  In this loop, the table being
+       filled is at next and has curr index bits.  The code being used is huff
+       with length len.  That code is converted to an index by dropping drop
+       bits off of the bottom.  For codes where len is less than drop + curr,
+       those top drop + curr - len bits are incremented through all values to
+       fill the table with replicated entries.
+
+       root is the number of index bits for the root table.  When len exceeds
+       root, sub-tables are created pointed to by the root entry with an index
+       of the low root bits of huff.  This is saved in low to check for when a
+       new sub-table should be started.  drop is zero when the root table is
+       being filled, and drop is root when sub-tables are being filled.
+
+       When a new sub-table is needed, it is necessary to look ahead in the
+       code lengths to determine what size sub-table is needed.  The length
+       counts are used for this, and so count[] is decremented as codes are
+       entered in the tables.
+
+       used keeps track of how many table entries have been allocated from the
+       provided *table space.  It is checked for LENS and DIST tables against
+       the constants ENOUGH_LENS and ENOUGH_DISTS to guard against changes in
+       the initial root table size constants.  See the comments in inftrees.h
+       for more information.
+
+       sym increments through all symbols, and the loop terminates when
+       all codes of length max, i.e. all codes, have been processed.  This
+       routine permits incomplete codes, so another loop after this one fills
+       in the rest of the decoding tables with invalid code markers.
+     */
+
+    /* set up for code type */
+    switch (type) {
+    case CODES:
+        base = extra = work;    /* dummy value--not used */
+        end = 19;
+        break;
+    case LENS:
+        base = lbase;
+        base -= 257;
+        extra = lext;
+        extra -= 257;
+        end = 256;
+        break;
+    default:            /* DISTS */
+        base = dbase;
+        extra = dext;
+        end = -1;
+    }
+
+    /* initialize state for loop */
+    huff = 0;                   /* starting code */
+    sym = 0;                    /* starting code symbol */
+    len = min;                  /* starting code length */
+    next = *table;              /* current table to fill in */
+    curr = root;                /* current table index bits */
+    drop = 0;                   /* current bits to drop from code for index */
+    low = (unsigned)(-1);       /* trigger new sub-table when len > root */
+    used = 1U << root;          /* use root table entries */
+    mask = used - 1;            /* mask for comparing low */
+
+    /* check available table space */
+    if ((type == LENS && used >= ENOUGH_LENS) ||
+        (type == DISTS && used >= ENOUGH_DISTS))
+        return 1;
+
+    /* process all codes and make table entries */
+    for (;;) {
+        /* create table entry */
+        here.bits = (unsigned char)(len - drop);
+        if ((int)(work[sym]) < end) {
+            here.op = (unsigned char)0;
+            here.val = work[sym];
+        }
+        else if ((int)(work[sym]) > end) {
+            here.op = (unsigned char)(extra[work[sym]]);
+            here.val = base[work[sym]];
+        }
+        else {
+            here.op = (unsigned char)(32 + 64);         /* end of block */
+            here.val = 0;
+        }
+
+        /* replicate for those indices with low len bits equal to huff */
+        incr = 1U << (len - drop);
+        fill = 1U << curr;
+        min = fill;                 /* save offset to next table */
+        do {
+            fill -= incr;
+            next[(huff >> drop) + fill] = here;
+        } while (fill != 0);
+
+        /* backwards increment the len-bit code huff */
+        incr = 1U << (len - 1);
+        while (huff & incr)
+            incr >>= 1;
+        if (incr != 0) {
+            huff &= incr - 1;
+            huff += incr;
+        }
+        else
+            huff = 0;
+
+        /* go to next symbol, update count, len */
+        sym++;
+        if (--(count[len]) == 0) {
+            if (len == max) break;
+            len = lens[work[sym]];
+        }
+
+        /* create new sub-table if needed */
+        if (len > root && (huff & mask) != low) {
+            /* if first time, transition to sub-tables */
+            if (drop == 0)
+                drop = root;
+
+            /* increment past last table */
+            next += min;            /* here min is 1 << curr */
+
+            /* determine length of next table */
+            curr = len - drop;
+            left = (int)(1 << curr);
+            while (curr + drop < max) {
+                left -= count[curr + drop];
+                if (left <= 0) break;
+                curr++;
+                left <<= 1;
+            }
+
+            /* check for enough space */
+            used += 1U << curr;
+            if ((type == LENS && used >= ENOUGH_LENS) ||
+                (type == DISTS && used >= ENOUGH_DISTS))
+                return 1;
+
+            /* point entry in root table to sub-table */
+            low = huff & mask;
+            (*table)[low].op = (unsigned char)curr;
+            (*table)[low].bits = (unsigned char)root;
+            (*table)[low].val = (unsigned short)(next - *table);
+        }
+    }
+
+    /*
+       Fill in rest of table for incomplete codes.  This loop is similar to the
+       loop above in incrementing huff for table indices.  It is assumed that
+       len is equal to curr + drop, so there is no loop needed to increment
+       through high index bits.  When the current sub-table is filled, the loop
+       drops back to the root table to fill in any remaining entries there.
+     */
+    here.op = (unsigned char)64;                /* invalid code marker */
+    here.bits = (unsigned char)(len - drop);
+    here.val = (unsigned short)0;
+    while (huff != 0) {
+        /* when done with sub-table, drop back to root table */
+        if (drop != 0 && (huff & mask) != low) {
+            drop = 0;
+            len = root;
+            next = *table;
+            here.bits = (unsigned char)len;
+        }
+
+        /* put invalid code marker in table */
+        next[huff >> drop] = here;
+
+        /* backwards increment the len-bit code huff */
+        incr = 1U << (len - 1);
+        while (huff & incr)
+            incr >>= 1;
+        if (incr != 0) {
+            huff &= incr - 1;
+            huff += incr;
+        }
+        else
+            huff = 0;
+    }
+
+    /* set return parameters */
+    *table += used;
+    *bits = root;
+    return 0;
+}

external/cfitsio/inftrees.h

@@ -0,0 +1,62 @@
+/* inftrees.h -- header to use inftrees.c
+ * Copyright (C) 1995-2005, 2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* WARNING: this file should *not* be used by applications. It is
+   part of the implementation of the compression library and is
+   subject to change. Applications should only use zlib.h.
+ */
+
+/* Structure for decoding tables.  Each entry provides either the
+   information needed to do the operation requested by the code that
+   indexed that table entry, or it provides a pointer to another
+   table that indexes more bits of the code.  op indicates whether
+   the entry is a pointer to another table, a literal, a length or
+   distance, an end-of-block, or an invalid code.  For a table
+   pointer, the low four bits of op is the number of index bits of
+   that table.  For a length or distance, the low four bits of op
+   is the number of extra bits to get after the code.  bits is
+   the number of bits in this code or part of the code to drop off
+   of the bit buffer.  val is the actual byte to output in the case
+   of a literal, the base length or distance, or the offset from
+   the current table to the next table.  Each entry is four bytes. */
+typedef struct {
+    unsigned char op;           /* operation, extra bits, table bits */
+    unsigned char bits;         /* bits in this part of the code */
+    unsigned short val;         /* offset in table or code value */
+} code;
+
+/* op values as set by inflate_table():
+    00000000 - literal
+    0000tttt - table link, tttt != 0 is the number of table index bits
+    0001eeee - length or distance, eeee is the number of extra bits
+    01100000 - end of block
+    01000000 - invalid code
+ */
+
+/* Maximum size of the dynamic table.  The maximum number of code structures is
+   1444, which is the sum of 852 for literal/length codes and 592 for distance
+   codes.  These values were found by exhaustive searches using the program
+   examples/enough.c found in the zlib distribtution.  The arguments to that
+   program are the number of symbols, the initial root table size, and the
+   maximum bit length of a code.  "enough 286 9 15" for literal/length codes
+   returns returns 852, and "enough 30 6 15" for distance codes returns 592.
+   The initial root table size (9 or 6) is found in the fifth argument of the
+   inflate_table() calls in inflate.c and infback.c.  If the root table size is
+   changed, then these maximum sizes would be need to be recalculated and
+   updated. */
+#define ENOUGH_LENS 852
+#define ENOUGH_DISTS 592
+#define ENOUGH (ENOUGH_LENS+ENOUGH_DISTS)
+
+/* Type of code to build for inflate_table() */
+typedef enum {
+    CODES,
+    LENS,
+    DISTS
+} codetype;
+
+int ZLIB_INTERNAL inflate_table OF((codetype type, unsigned short FAR *lens,
+                             unsigned codes, code FAR * FAR *table,
+                             unsigned FAR *bits, unsigned short FAR *work));

external/cfitsio/iter_a.c

@@ -0,0 +1,147 @@
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "fitsio.h"
+
+/*
+  This program illustrates how to use the CFITSIO iterator function.
+  It reads and modifies the input 'iter_a.fit' file by computing a
+  value for the 'rate' column as a function of the values in the other
+  'counts' and 'time' columns.
+*/
+main()
+{
+    extern flux_rate(); /* external work function is passed to the iterator */
+    fitsfile *fptr;
+    iteratorCol cols[3];  /* structure used by the iterator function */
+    int n_cols;
+    long rows_per_loop, offset;
+
+    int status, nkeys, keypos, hdutype, ii, jj;
+    char filename[]  = "iter_a.fit";     /* name of rate FITS file */
+
+    status = 0; 
+
+    fits_open_file(&fptr, filename, READWRITE, &status); /* open file */
+
+    /* move to the desired binary table extension */
+    if (fits_movnam_hdu(fptr, BINARY_TBL, "RATE", 0, &status) )
+        fits_report_error(stderr, status);    /* print out error messages */
+
+    n_cols  = 3;   /* number of columns */
+
+    /* define input column structure members for the iterator function */
+    fits_iter_set_by_name(&cols[0], fptr, "COUNTS", TLONG,  InputCol);
+    fits_iter_set_by_name(&cols[1], fptr, "TIME",   TFLOAT, InputCol);
+    fits_iter_set_by_name(&cols[2], fptr, "RATE",   TFLOAT, OutputCol);
+
+    rows_per_loop = 0;  /* use default optimum number of rows */
+    offset = 0;         /* process all the rows */
+
+    /* apply the rate function to each row of the table */
+    printf("Calling iterator function...%d\n", status);
+
+    fits_iterate_data(n_cols, cols, offset, rows_per_loop,
+                      flux_rate, 0L, &status);
+
+    fits_close_file(fptr, &status);      /* all done */
+
+    if (status)
+        fits_report_error(stderr, status);  /* print out error messages */
+
+    return(status);
+}
+/*--------------------------------------------------------------------------*/
+int flux_rate(long totalrows, long offset, long firstrow, long nrows,
+             int ncols, iteratorCol *cols, void *user_strct ) 
+
+/*
+   Sample iterator function that calculates the output flux 'rate' column
+   by dividing the input 'counts' by the 'time' column.
+   It also applies a constant deadtime correction factor if the 'deadtime'
+   keyword exists.  Finally, this creates or updates the 'LIVETIME'
+   keyword with the sum of all the individual integration times.
+*/
+{
+    int ii, status = 0;
+
+    /* declare variables static to preserve their values between calls */
+    static long *counts;
+    static float *interval;
+    static float *rate;
+    static float deadtime, livetime; /* must preserve values between calls */
+
+    /*--------------------------------------------------------*/
+    /*  Initialization procedures: execute on the first call  */
+    /*--------------------------------------------------------*/
+    if (firstrow == 1)
+    {
+       if (ncols != 3)
+           return(-1);  /* number of columns incorrect */
+
+       if (fits_iter_get_datatype(&cols[0]) != TLONG  ||
+           fits_iter_get_datatype(&cols[1]) != TFLOAT ||
+           fits_iter_get_datatype(&cols[2]) != TFLOAT )
+           return(-2);  /* bad data type */
+
+       /* assign the input pointers to the appropriate arrays and null ptrs*/
+       counts       = (long *)  fits_iter_get_array(&cols[0]);
+       interval     = (float *) fits_iter_get_array(&cols[1]);
+       rate         = (float *) fits_iter_get_array(&cols[2]);
+
+       livetime = 0;  /* initialize the total integration time */
+
+       /* try to get the deadtime keyword value */
+       fits_read_key(cols[0].fptr, TFLOAT, "DEADTIME", &deadtime, '\0',
+                     &status);
+       if (status)
+       {
+           deadtime = 1.0;  /* default deadtime if keyword doesn't exist */
+       }
+       else if (deadtime < 0. || deadtime > 1.0)
+       {
+           return(-1);    /* bad deadtime value */
+       }
+
+       printf("deadtime = %f\n", deadtime);
+    }
+
+    /*--------------------------------------------*/
+    /*  Main loop: process all the rows of data */
+    /*--------------------------------------------*/
+
+    /*  NOTE: 1st element of array is the null pixel value!  */
+    /*  Loop from 1 to nrows, not 0 to nrows - 1.  */
+
+    /* this version tests for null values */
+    rate[0] = DOUBLENULLVALUE;   /* define the value that represents null */
+
+    for (ii = 1; ii <= nrows; ii++)
+    {
+       if (counts[ii] == counts[0])   /*  undefined counts value? */
+       {
+           rate[ii] = DOUBLENULLVALUE;
+       }
+       else if (interval[ii] > 0.)
+       {
+           rate[ii] = counts[ii] / interval[ii] / deadtime;
+           livetime += interval[ii];  /* accumulate total integration time */
+       }
+       else
+           return(-2);  /* bad integration time */
+    }
+
+    /*-------------------------------------------------------*/
+    /*  Clean up procedures:  after processing all the rows  */
+    /*-------------------------------------------------------*/
+
+    if (firstrow + nrows - 1 == totalrows)
+    {
+        /*  update the LIVETIME keyword value */
+
+        fits_update_key(cols[0].fptr, TFLOAT, "LIVETIME", &livetime, 
+                 "total integration time", &status);
+        printf("livetime = %f\n", livetime);
+   }
+    return(0);  /* return successful status */
+}

external/cfitsio/iter_a.f

@@ -0,0 +1,224 @@
+      program f77iterate_a
+
+      external flux_rate
+      integer ncols
+      parameter (ncols=3)
+      integer units(ncols), colnum(ncols), datatype(ncols)
+      integer iotype(ncols), offset, rows_per_loop, status
+      character*70 colname(ncols)
+      integer iunit, blocksize
+      character*80 fname
+
+C     include f77.inc -------------------------------------
+C     Codes for FITS extension types
+      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
+      parameter (
+     &     IMAGE_HDU  = 0,
+     &     ASCII_TBL  = 1,
+     &     BINARY_TBL = 2  )
+
+C     Codes for FITS table data types
+
+      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
+      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
+      parameter (
+     &     TBIT        =   1,
+     &     TBYTE       =  11,
+     &     TLOGICAL    =  14,
+     &     TSTRING     =  16,
+     &     TSHORT      =  21,
+     &     TINT        =  31,
+     &     TFLOAT      =  42,
+     &     TDOUBLE     =  82,
+     &     TCOMPLEX    =  83,
+     &     TDBLCOMPLEX = 163  )
+
+C     Codes for iterator column types
+
+      integer InputCol, InputOutputCol, OutputCol
+      parameter (
+     &     InputCol       = 0,
+     &     InputOutputCol = 1,
+     &     OutputCol      = 2  )
+C     End of f77.inc -------------------------------------
+
+
+      iunit = 15
+
+      units(1) = iunit
+      units(2) = iunit
+      units(3) = iunit
+
+C open the file
+      fname = 'iter_a.fit'
+      call ftopen(iunit,fname,1,blocksize,status)
+
+C move to the HDU containing the rate table
+      call ftmnhd(iunit, BINARY_TBL, 'RATE', 0, status)
+
+C Select iotypes for column data
+      iotype(1) = InputCol
+      iotype(2) = InputCol
+      iotype(3) = OutputCol
+
+C Select desired datatypes for column data
+      datatype(1) = TINT
+      datatype(2) = TFLOAT
+      datatype(3) = TFLOAT
+
+C find the column number corresponding to each column
+      call ftgcno( iunit, 0, 'counts', colnum(1), status )
+      call ftgcno( iunit, 0, 'time', colnum(2), status )
+      call ftgcno( iunit, 0, 'rate', colnum(3), status )
+
+C use default optimum number of rows
+      rows_per_loop = 0
+      offset = 0
+
+C apply the rate function to each row of the table
+      print *, 'Calling iterator function...', status
+
+C although colname is not being used, still need to send a string
+C array in the function
+      call ftiter( ncols, units, colnum, colname, datatype, iotype,
+     &      offset, rows_per_loop, flux_rate, 3, status )
+
+      call ftclos(iunit, status)
+      stop
+      end
+
+C***************************************************************************
+C   Sample iterator function that calculates the output flux 'rate' column
+C   by dividing the input 'counts' by the 'time' column.
+C   It also applies a constant deadtime correction factor if the 'deadtime'
+C   keyword exists.  Finally, this creates or updates the 'LIVETIME'
+C   keyword with the sum of all the individual integration times.
+C***************************************************************************
+      subroutine flux_rate(totalrows, offset, firstrow, nrows, ncols,
+     &     units, colnum, datatype, iotype, repeat, status, userData,
+     &     counts, interval, rate )
+
+      integer totalrows, offset, firstrow, nrows, ncols
+      integer units(ncols), colnum(ncols), datatype(ncols)
+      integer iotype(ncols), repeat(ncols)
+      integer userData
+
+C     include f77.inc -------------------------------------
+C     Codes for FITS extension types
+      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
+      parameter (
+     &     IMAGE_HDU  = 0,
+     &     ASCII_TBL  = 1,
+     &     BINARY_TBL = 2  )
+
+C     Codes for FITS table data types
+
+      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
+      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
+      parameter (
+     &     TBIT        =   1,
+     &     TBYTE       =  11,
+     &     TLOGICAL    =  14,
+     &     TSTRING     =  16,
+     &     TSHORT      =  21,
+     &     TINT        =  31,
+     &     TFLOAT      =  42,
+     &     TDOUBLE     =  82,
+     &     TCOMPLEX    =  83,
+     &     TDBLCOMPLEX = 163  )
+
+C     Codes for iterator column types
+
+      integer InputCol, InputOutputCol, OutputCol
+      parameter (
+     &     InputCol       = 0,
+     &     InputOutputCol = 1,
+     &     OutputCol      = 2  )
+C     End of f77.inc -------------------------------------
+
+      integer counts(*)
+      real interval(*),rate(*)
+
+      integer ii, status
+      character*80 comment
+
+C**********************************************************************
+C  must preserve these values between calls
+      real deadtime, livetime
+      common /fluxblock/ deadtime, livetime
+C**********************************************************************
+
+      if (status .ne. 0) return
+
+C    --------------------------------------------------------
+C      Initialization procedures: execute on the first call  
+C    --------------------------------------------------------
+      if (firstrow .eq. 1) then
+         if (ncols .ne. 3) then
+C     wrong number of columns
+            status = -1
+            return
+         endif
+
+         if (datatype(1).ne.TINT .or. datatype(2).ne.TFLOAT .or.
+     &        datatype(3).ne.TFLOAT ) then
+C     bad data type
+            status = -2
+            return
+         endif
+
+C     try to get the deadtime keyword value
+         call ftgkye( units(1), 'DEADTIME', deadtime, comment, status )
+
+         if (status.ne.0) then
+C     default deadtime if keyword doesn't exist
+            deadtime = 1.0
+            status = 0
+         elseif (deadtime .lt. 0.0 .or. deadtime .gt. 1.0) then
+C     bad deadtime value
+            status = -3
+            return
+         endif
+
+         print *, 'deadtime = ', deadtime
+
+         livetime = 0.0
+      endif
+
+C    --------------------------------------------
+C      Main loop: process all the rows of data
+C    --------------------------------------------
+      
+C     NOTE: 1st element of array is the null pixel value!
+C     Loop over elements 2 to nrows+1, not 1 to nrows.
+      
+C     this version ignores null values
+
+C     set the output null value to zero to ignore nulls */
+      rate(1) = 0.0
+      do 10 ii = 2,nrows+1
+         if ( interval(ii) .gt. 0.0) then
+           rate(ii) = counts(ii) / interval(ii) / deadtime
+           livetime = livetime + interval(ii)
+        else
+C     Nonsensical negative time interval
+           status = -3
+           return
+        endif
+ 10   continue
+
+C    -------------------------------------------------------
+C      Clean up procedures:  after processing all the rows  
+C    -------------------------------------------------------
+
+      if (firstrow + nrows - 1 .eq. totalrows) then
+C     update the LIVETIME keyword value
+
+         call ftukye( units(1),'LIVETIME', livetime, 3,
+     &        'total integration time', status )
+         print *,'livetime = ', livetime
+
+      endif
+ 
+      return
+      end

external/cfitsio/iter_b.c

@@ -0,0 +1,114 @@
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "fitsio.h"
+
+/*
+  This program illustrates how to use the CFITSIO iterator function.
+  It simply prints out the values in a character string and a logical
+  type column in a table, and toggles the value in the logical column
+  so that T -> F and F -> T.
+*/
+main()
+{
+    extern str_iter(); /* external work function is passed to the iterator */
+    fitsfile *fptr;
+    iteratorCol cols[2];
+    int n_cols;
+    long rows_per_loop, offset;
+    int status = 0;
+    char filename[]  = "iter_b.fit";     /* name of rate FITS file */
+
+    /* open the file and move to the correct extension */
+    fits_open_file(&fptr, filename, READWRITE, &status);
+    fits_movnam_hdu(fptr, BINARY_TBL, "iter_test", 0, &status);
+
+    /* define input column structure members for the iterator function */
+    n_cols  = 2;   /* number of columns */
+
+    /* define input column structure members for the iterator function */
+    fits_iter_set_by_name(&cols[0], fptr, "Avalue", TSTRING,  InputOutputCol);
+    fits_iter_set_by_name(&cols[1], fptr, "Lvalue", TLOGICAL, InputOutputCol);
+
+    rows_per_loop = 0;  /* use default optimum number of rows */
+    offset = 0;         /* process all the rows */
+
+    /* apply the  function to each row of the table */
+    printf("Calling iterator function...%d\n", status);
+
+    fits_iterate_data(n_cols, cols, offset, rows_per_loop,
+                      str_iter, 0L, &status);
+
+    fits_close_file(fptr, &status);      /* all done */
+
+    if (status)
+       fits_report_error(stderr, status); /* print out error messages */
+
+    return(status);
+}
+/*--------------------------------------------------------------------------*/
+int str_iter(long totalrows, long offset, long firstrow, long nrows,
+             int ncols, iteratorCol *cols, void *user_strct )
+
+/*
+   Sample iterator function.
+*/
+{
+    int ii;
+
+    /* declare variables static to preserve their values between calls */
+    static char **stringvals;
+    static char *logicalvals;
+
+    /*--------------------------------------------------------*/
+    /*  Initialization procedures: execute on the first call  */
+    /*--------------------------------------------------------*/
+    if (firstrow == 1)
+    {
+       if (ncols != 2)
+           return(-1);  /* number of columns incorrect */
+
+       if (fits_iter_get_datatype(&cols[0]) != TSTRING ||
+           fits_iter_get_datatype(&cols[1]) != TLOGICAL )
+           return(-2);  /* bad data type */
+
+       /* assign the input pointers to the appropriate arrays */
+       stringvals       = (char **) fits_iter_get_array(&cols[0]);
+       logicalvals      = (char *)  fits_iter_get_array(&cols[1]);
+
+       printf("Total rows, No. rows = %d %d\n",totalrows, nrows);
+    }
+
+    /*------------------------------------------*/
+    /*  Main loop: process all the rows of data */
+    /*------------------------------------------*/
+
+    /*  NOTE: 1st element of array is the null pixel value!  */
+    /*  Loop from 1 to nrows, not 0 to nrows - 1.  */
+   
+    for (ii = 1; ii <= nrows; ii++)
+    {
+      printf("%s %d\n", stringvals[ii], logicalvals[ii]);
+      if (logicalvals[ii])
+      {
+         logicalvals[ii] = FALSE;
+         strcpy(stringvals[ii], "changed to false");
+      }
+      else
+      {
+         logicalvals[ii] = TRUE;
+         strcpy(stringvals[ii], "changed to true");
+      }
+    }
+
+    /*-------------------------------------------------------*/
+    /*  Clean up procedures:  after processing all the rows  */
+    /*-------------------------------------------------------*/
+
+    if (firstrow + nrows - 1 == totalrows)
+    {
+      /* no action required in this case */
+    }
+ 
+    return(0);
+}

external/cfitsio/iter_b.f

@@ -0,0 +1,193 @@
+      program f77iterate_b
+
+C     external work function is passed to the iterator
+      external str_iter
+
+      integer ncols
+      parameter (ncols=2)
+      integer units(ncols), colnum(ncols), datatype(ncols)
+      integer iotype(ncols), offset, rows_per_loop, status
+      character*70 colname(ncols)
+
+      integer iunit, blocksize
+      character*80 fname
+
+C     include f77.inc -------------------------------------
+C     Codes for FITS extension types
+      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
+      parameter (
+     &     IMAGE_HDU  = 0,
+     &     ASCII_TBL  = 1,
+     &     BINARY_TBL = 2  )
+
+C     Codes for FITS table data types
+
+      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
+      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
+      parameter (
+     &     TBIT        =   1,
+     &     TBYTE       =  11,
+     &     TLOGICAL    =  14,
+     &     TSTRING     =  16,
+     &     TSHORT      =  21,
+     &     TINT        =  31,
+     &     TFLOAT      =  42,
+     &     TDOUBLE     =  82,
+     &     TCOMPLEX    =  83,
+     &     TDBLCOMPLEX = 163  )
+
+C     Codes for iterator column types
+
+      integer InputCol, InputOutputCol, OutputCol
+      parameter (
+     &     InputCol       = 0,
+     &     InputOutputCol = 1,
+     &     OutputCol      = 2  )
+C     End of f77.inc -------------------------------------
+
+      status = 0
+
+      fname = 'iter_b.fit'
+      iunit = 15
+
+C     both columns are in the same FITS file
+      units(1) = iunit
+      units(2) = iunit
+
+C     open the file and move to the correct extension
+      call ftopen(iunit,fname,1,blocksize,status)
+      call ftmnhd(iunit, BINARY_TBL, 'iter_test', 0, status)
+
+C     define the desired columns by name
+      colname(1) = 'Avalue'
+      colname(2) = 'Lvalue'
+
+C     leave column numbers undefined
+      colnum(1) = 0
+      colnum(2) = 0  
+
+C     define the desired datatype for each column: TSTRING & TLOGICAL
+      datatype(1) = TSTRING
+      datatype(2) = TLOGICAL
+
+C     define whether columns are input, input/output, or output only
+C     Both in/out
+      iotype(1) = InputOutputCol
+      iotype(2) = InputOutputCol
+ 
+C     use default optimum number of rows and process all the rows
+      rows_per_loop = 0
+      offset = 0
+
+C     apply the  function to each row of the table
+      print *,'Calling iterator function...', status
+
+      call ftiter( ncols, units, colnum, colname, datatype, iotype,
+     &      offset, rows_per_loop, str_iter, 0, status )
+
+      call ftclos(iunit, status)
+
+C     print out error messages if problem
+      if (status.ne.0) call ftrprt('STDERR', status)
+      stop
+      end
+
+C--------------------------------------------------------------------------
+C
+C   Sample iterator function.
+C
+C--------------------------------------------------------------------------
+      subroutine str_iter(totalrows, offset, firstrow, nrows, ncols,
+     &     units, colnum, datatype, iotype, repeat, status, 
+     &     userData, stringCol, logicalCol )
+
+      integer totalrows,offset,firstrow,nrows,ncols,status
+      integer units(*),colnum(*),datatype(*),iotype(*),repeat(*)
+      integer userData
+      character*(*) stringCol(*)
+      logical logicalCol(*)
+
+      integer ii
+
+C     include f77.inc -------------------------------------
+C     Codes for FITS extension types
+      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
+      parameter (
+     &     IMAGE_HDU  = 0,
+     &     ASCII_TBL  = 1,
+     &     BINARY_TBL = 2  )
+
+C     Codes for FITS table data types
+
+      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
+      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
+      parameter (
+     &     TBIT        =   1,
+     &     TBYTE       =  11,
+     &     TLOGICAL    =  14,
+     &     TSTRING     =  16,
+     &     TSHORT      =  21,
+     &     TINT        =  31,
+     &     TFLOAT      =  42,
+     &     TDOUBLE     =  82,
+     &     TCOMPLEX    =  83,
+     &     TDBLCOMPLEX = 163  )
+
+C     Codes for iterator column types
+
+      integer InputCol, InputOutputCol, OutputCol
+      parameter (
+     &     InputCol       = 0,
+     &     InputOutputCol = 1,
+     &     OutputCol      = 2  )
+C     End of f77.inc -------------------------------------
+
+      if (status .ne. 0) return
+
+C    --------------------------------------------------------
+C      Initialization procedures: execute on the first call  
+C    --------------------------------------------------------
+      if (firstrow .eq. 1) then
+         if (ncols .ne. 2) then
+            status = -1
+            return
+         endif
+         
+         if (datatype(1).ne.TSTRING .or. datatype(2).ne.TLOGICAL) then
+            status = -2
+            return
+         endif
+         
+         print *,'Total rows, No. rows = ',totalrows, nrows
+         
+      endif
+      
+C     -------------------------------------------
+C       Main loop: process all the rows of data 
+C     -------------------------------------------
+      
+C     NOTE: 1st element of array is the null pixel value!
+C     Loop over elements 2 to nrows+1, not 1 to nrows.
+      
+      do 10 ii=2,nrows+1
+         print *, stringCol(ii), logicalCol(ii)
+         if( logicalCol(ii) ) then
+            logicalCol(ii) = .false.
+            stringCol(ii) = 'changed to false'
+         else
+            logicalCol(ii) = .true.
+            stringCol(ii) = 'changed to true'
+         endif
+ 10   continue
+      
+C     -------------------------------------------------------
+C     Clean up procedures:  after processing all the rows  
+C     -------------------------------------------------------
+      
+      if (firstrow + nrows - 1 .eq. totalrows) then
+C     no action required in this case
+      endif
+      
+      return
+      end
+      

external/cfitsio/iter_c.c

@@ -0,0 +1,171 @@
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "fitsio.h"
+
+/*
+    This example program illustrates how to use the CFITSIO iterator function.
+
+    This program creates a 2D histogram of the X and Y columns of an event
+    list.  The 'main' routine just creates the empty new image, then executes
+    the 'writehisto' work function by calling the CFITSIO iterator function.
+
+    'writehisto' opens the FITS event list that contains the X and Y columns.
+    It then calls a second work function, calchisto, (by recursively calling
+    the CFITSIO iterator function) which actually computes the 2D histogram.
+*/
+
+/*   Globally defined parameters */
+
+long xsize = 480; /* size of the histogram image */
+long ysize = 480;
+long xbinsize = 32;
+long ybinsize = 32;
+
+main()
+{
+    extern writehisto();  /* external work function passed to the iterator */
+    extern long xsize, ysize;  /* size of image */
+
+    fitsfile *fptr;
+    iteratorCol cols[1];
+    int n_cols, status = 0;
+    long n_per_loop, offset, naxes[2];
+    char filename[]  = "histoimg.fit";     /* name of FITS image */
+
+    remove(filename);   /* delete previous version of the file if it exists */
+    fits_create_file(&fptr, filename, &status);  /* create new output image */
+
+    naxes[0] = xsize;
+    naxes[1] = ysize;
+    fits_create_img(fptr, LONG_IMG, 2, naxes, &status); /* create primary HDU */
+
+    n_cols  = 1;   /* number of columns */
+
+    /* define input column structure members for the iterator function */
+    fits_iter_set_by_name(&cols[0], fptr, " ", TLONG, OutputCol);
+
+    n_per_loop = -1;  /* force whole array to be passed at one time */
+    offset = 0;       /* don't skip over any pixels */
+
+    /* execute the function to create and write the 2D histogram */
+    printf("Calling writehisto iterator work function... %d\n", status);
+
+    fits_iterate_data(n_cols, cols, offset, n_per_loop,
+                      writehisto, 0L, &status);
+
+    fits_close_file(fptr, &status);      /* all done; close the file */
+
+    if (status)
+        fits_report_error(stderr, status);  /* print out error messages */
+    else
+        printf("Program completed successfully.\n");
+
+    return(status);
+}
+/*--------------------------------------------------------------------------*/
+int writehisto(long totaln, long offset, long firstn, long nvalues,
+             int narrays, iteratorCol *histo, void *userPointer)
+/*
+   Iterator work function that writes out the 2D histogram.
+   The histogram values are calculated by another work function, calchisto.
+
+   This routine is executed only once since nvalues was forced to = totaln.
+*/
+{
+    extern calchisto();  /* external function called by the iterator */
+    long *histogram;
+    fitsfile *tblptr;
+    iteratorCol cols[2];
+    int n_cols, status = 0;
+    long rows_per_loop, rowoffset;
+    char filename[]  = "iter_c.fit";     /* name of FITS table */
+
+    /* do sanity checking of input values */
+    if (totaln != nvalues)
+        return(-1);  /* whole image must be passed at one time */
+
+    if (narrays != 1)
+        return(-2);  /* number of images is incorrect */
+
+    if (fits_iter_get_datatype(&histo[0]) != TLONG)
+        return(-3);  /* input array has wrong data type */
+
+    /* assign the FITS array pointer to the global histogram pointer */
+    histogram = (long *) fits_iter_get_array(&histo[0]);
+
+    /* open the file and move to the table containing the X and Y columns */
+    fits_open_file(&tblptr, filename, READONLY, &status);
+    fits_movnam_hdu(tblptr, BINARY_TBL, "EVENTS", 0, &status);
+    if (status)
+       return(status);
+   
+    n_cols = 2; /* number of columns */
+
+    /* define input column structure members for the iterator function */
+    fits_iter_set_by_name(&cols[0], tblptr, "X", TLONG,  InputCol);
+    fits_iter_set_by_name(&cols[1], tblptr, "Y", TLONG, InputCol);
+
+    rows_per_loop = 0;  /* take default number of rows per interation */
+    rowoffset = 0;     
+
+    /* calculate the histogram */
+    printf("Calling calchisto iterator work function... %d\n", status);
+
+    fits_iterate_data(n_cols, cols, rowoffset, rows_per_loop,
+                      calchisto, histogram, &status);
+
+    fits_close_file(tblptr, &status);      /* all done */
+    return(status);
+}
+/*--------------------------------------------------------------------------*/
+int calchisto(long totalrows, long offset, long firstrow, long nrows,
+             int ncols, iteratorCol *cols, void *userPointer)
+
+/*
+   Interator work function that calculates values for the 2D histogram.
+*/
+{
+    extern long xsize, ysize, xbinsize, ybinsize;
+    long ii, ihisto, xbin, ybin;
+    static long *xcol, *ycol, *histogram;  /* static to preserve values */
+
+    /*--------------------------------------------------------*/
+    /*  Initialization procedures: execute on the first call  */
+    /*--------------------------------------------------------*/
+    if (firstrow == 1)
+    {
+        /* do sanity checking of input values */
+       if (ncols != 2)
+         return(-3);  /* number of arrays is incorrect */
+
+       if (fits_iter_get_datatype(&cols[0]) != TLONG ||
+           fits_iter_get_datatype(&cols[1]) != TLONG)
+         return(-4);  /* wrong datatypes */
+
+       /* assign the input array points to the X and Y arrays */
+       xcol = (long *) fits_iter_get_array(&cols[0]);
+       ycol = (long *) fits_iter_get_array(&cols[1]);
+       histogram = (long *) userPointer;
+
+       /* initialize the histogram image pixels = 0 */
+       for (ii = 0; ii <= xsize * ysize; ii++)
+           histogram[ii] = 0L;
+    }
+
+    /*------------------------------------------------------------------*/
+    /*  Main loop: increment the 2D histogram at position of each event */
+    /*------------------------------------------------------------------*/
+
+    for (ii = 1; ii <= nrows; ii++) 
+    {
+        xbin = xcol[ii] / xbinsize;
+        ybin = ycol[ii] / ybinsize;
+
+        ihisto = ( ybin * xsize ) + xbin + 1;
+        histogram[ihisto]++;
+    }
+
+    return(0);
+}
+

external/cfitsio/iter_c.f

@@ -0,0 +1,347 @@
+      program f77iterate_c
+C
+C    This example program illustrates how to use the CFITSIO iterator function.
+C
+C    This program creates a 2D histogram of the X and Y columns of an event
+C    list.  The 'main' routine just creates the empty new image, then executes
+C    the 'writehisto' work function by calling the CFITSIO iterator function.
+C
+C    'writehisto' opens the FITS event list that contains the X and Y columns.
+C    It then calls a second work function, calchisto, (by recursively calling
+C    the CFITSIO iterator function) which actually computes the 2D histogram.
+
+C     external work function to be passed to the iterator
+      external writehisto
+
+      integer ncols
+      parameter (ncols=1)
+      integer units(ncols), colnum(ncols), datatype(ncols)
+      integer iotype(ncols), offset, n_per_loop, status
+      character*70 colname(ncols)
+
+      integer naxes(2), ounit, blocksize
+      character*80 fname
+      logical exists
+
+C     include f77.inc -------------------------------------
+C     Codes for FITS extension types
+      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
+      parameter (
+     &     IMAGE_HDU  = 0,
+     &     ASCII_TBL  = 1,
+     &     BINARY_TBL = 2  )
+
+C     Codes for FITS table data types
+
+      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
+      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
+      parameter (
+     &     TBIT        =   1,
+     &     TBYTE       =  11,
+     &     TLOGICAL    =  14,
+     &     TSTRING     =  16,
+     &     TSHORT      =  21,
+     &     TINT        =  31,
+     &     TFLOAT      =  42,
+     &     TDOUBLE     =  82,
+     &     TCOMPLEX    =  83,
+     &     TDBLCOMPLEX = 163  )
+
+C     Codes for iterator column types
+
+      integer InputCol, InputOutputCol, OutputCol
+      parameter (
+     &     InputCol       = 0,
+     &     InputOutputCol = 1,
+     &     OutputCol      = 2  )
+C     End of f77.inc -------------------------------------
+
+C**********************************************************************
+C     Need to make these variables available to the 2 work functions
+      integer xsize,ysize,xbinsize,ybinsize
+      common /histcomm/ xsize,ysize,xbinsize,ybinsize
+C**********************************************************************
+
+      status = 0
+
+      xsize = 480
+      ysize = 480
+      xbinsize = 32
+      ybinsize = 32
+
+      fname = 'histoimg.fit'
+      ounit = 15
+
+C     delete previous version of the file if it exists
+      inquire(file=fname,exist=exists)
+      if( exists ) then
+         open(ounit,file=fname,status='old')
+         close(ounit,status='delete')
+      endif
+ 99   blocksize = 2880
+
+C     create new output image
+      call ftinit(ounit,fname,blocksize,status)
+
+      naxes(1) = xsize
+      naxes(2) = ysize
+
+C     create primary HDU
+      call ftiimg(ounit,32,2,naxes,status)
+
+      units(1) = ounit
+
+C     Define column as TINT and Output
+      datatype(1) = TINT
+      iotype(1) = OutputCol
+
+C     force whole array to be passed at one time
+      n_per_loop = -1
+      offset = 0
+
+C     execute the function to create and write the 2D histogram
+      print *,'Calling writehisto iterator work function... ',status
+
+      call ftiter( ncols, units, colnum, colname, datatype, iotype,
+     &      offset, n_per_loop, writehisto, 0, status )
+
+      call ftclos(ounit, status)
+
+C     print out error messages if problem
+      if (status.ne.0) then
+         call ftrprt('STDERR', status)
+      else
+        print *,'Program completed successfully.'
+      endif
+
+      stop
+      end
+
+C--------------------------------------------------------------------------
+C
+C   Sample iterator function.
+C
+C   Iterator work function that writes out the 2D histogram.
+C   The histogram values are calculated by another work function, calchisto.
+C
+C--------------------------------------------------------------------------
+      subroutine writehisto(totaln, offset, firstn, nvalues, narrays,
+     &     units_out, colnum_out, datatype_out, iotype_out, repeat,
+     &     status, userData, histogram )
+
+      integer totaln,offset,firstn,nvalues,narrays,status
+      integer units_out(narrays),colnum_out(narrays)
+      integer datatype_out(narrays),iotype_out(narrays)
+      integer repeat(narrays)
+      integer histogram(*), userData
+
+      external calchisto
+      integer ncols
+      parameter (ncols=2)
+      integer units(ncols), colnum(ncols), datatype(ncols)
+      integer iotype(ncols), rowoffset, rows_per_loop
+      character*70 colname(ncols)
+
+      integer iunit, blocksize
+      character*80 fname
+
+C     include f77.inc -------------------------------------
+C     Codes for FITS extension types
+      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
+      parameter (
+     &     IMAGE_HDU  = 0,
+     &     ASCII_TBL  = 1,
+     &     BINARY_TBL = 2  )
+
+C     Codes for FITS table data types
+
+      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
+      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
+      parameter (
+     &     TBIT        =   1,
+     &     TBYTE       =  11,
+     &     TLOGICAL    =  14,
+     &     TSTRING     =  16,
+     &     TSHORT      =  21,
+     &     TINT        =  31,
+     &     TFLOAT      =  42,
+     &     TDOUBLE     =  82,
+     &     TCOMPLEX    =  83,
+     &     TDBLCOMPLEX = 163  )
+
+C     Codes for iterator column types
+
+      integer InputCol, InputOutputCol, OutputCol
+      parameter (
+     &     InputCol       = 0,
+     &     InputOutputCol = 1,
+     &     OutputCol      = 2  )
+C     End of f77.inc -------------------------------------
+
+C**********************************************************************
+C     Need to make these variables available to the 2 work functions
+      integer xsize,ysize,xbinsize,ybinsize
+      common /histcomm/ xsize,ysize,xbinsize,ybinsize
+C**********************************************************************
+
+      if (status .ne. 0) return
+
+C     name of FITS table
+      fname = 'iter_c.fit'
+      iunit = 16
+
+C     do sanity checking of input values
+      if (totaln .ne. nvalues) then
+C     whole image must be passed at one time
+         status = -1
+         return
+      endif
+
+      if (narrays .ne. 1) then
+C     number of images is incorrect
+         status = -2
+         return
+      endif
+
+      if (datatype_out(1) .ne. TINT) then
+C     input array has wrong data type
+         status = -3
+         return
+      endif
+
+C     open the file and move to the table containing the X and Y columns
+      call ftopen(iunit,fname,0,blocksize,status)
+      call ftmnhd(iunit, BINARY_TBL, 'EVENTS', 0, status)
+      if (status) return
+   
+C     both the columns are in the same FITS file
+      units(1) = iunit
+      units(2) = iunit
+
+C     desired datatype for each column: TINT
+      datatype(1) = TINT
+      datatype(2) = TINT
+
+C     names of the columns
+      colname(1) = 'X'
+      colname(2) = 'Y'
+
+C     leave column numbers undefined
+      colnum(1) = 0
+      colnum(2) = 0
+
+C     define whether columns are input, input/output, or output only
+C     Both input
+      iotype(1) = InputCol
+      iotype(1) = InputCol
+ 
+C     take default number of rows per iteration
+      rows_per_loop = 0
+      rowoffset = 0
+
+C     calculate the histogram
+      print *,'Calling calchisto iterator work function... ', status
+
+      call ftiter( ncols, units, colnum, colname, datatype, iotype,
+     &      rowoffset, rows_per_loop, calchisto, histogram, status )
+
+      call ftclos(iunit,status)
+      return
+      end
+
+C--------------------------------------------------------------------------
+C
+C   Iterator work function that calculates values for the 2D histogram.
+C
+C--------------------------------------------------------------------------
+      subroutine calchisto(totalrows, offset, firstrow, nrows, ncols,
+     &     units, colnum, datatype, iotype, repeat, status, 
+     &     histogram, xcol, ycol )
+
+      integer totalrows,offset,firstrow,nrows,ncols,status
+      integer units(ncols),colnum(ncols),datatype(ncols)
+      integer iotype(ncols),repeat(ncols)
+      integer histogram(*),xcol(*),ycol(*)
+C     include f77.inc -------------------------------------
+C     Codes for FITS extension types
+      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
+      parameter (
+     &     IMAGE_HDU  = 0,
+     &     ASCII_TBL  = 1,
+     &     BINARY_TBL = 2  )
+
+C     Codes for FITS table data types
+
+      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
+      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
+      parameter (
+     &     TBIT        =   1,
+     &     TBYTE       =  11,
+     &     TLOGICAL    =  14,
+     &     TSTRING     =  16,
+     &     TSHORT      =  21,
+     &     TINT        =  31,
+     &     TFLOAT      =  42,
+     &     TDOUBLE     =  82,
+     &     TCOMPLEX    =  83,
+     &     TDBLCOMPLEX = 163  )
+
+C     Codes for iterator column types
+
+      integer InputCol, InputOutputCol, OutputCol
+      parameter (
+     &     InputCol       = 0,
+     &     InputOutputCol = 1,
+     &     OutputCol      = 2  )
+C     End of f77.inc -------------------------------------
+
+      integer ii, ihisto, xbin, ybin
+
+C**********************************************************************
+C     Need to make these variables available to the 2 work functions
+      integer xsize,ysize,xbinsize,ybinsize
+      common /histcomm/ xsize,ysize,xbinsize,ybinsize
+C**********************************************************************
+
+      if (status .ne. 0) return
+
+C    --------------------------------------------------------
+C      Initialization procedures: execute on the first call  
+C    --------------------------------------------------------
+      if (firstrow .eq. 1) then
+C     do sanity checking of input values
+
+         if (ncols .ne. 2) then
+C     number of arrays is incorrect
+            status = -4
+            return
+         endif
+
+         if (datatype(1).ne.TINT .or. datatype(2).ne.TINT) then
+C     wrong datatypes
+            status = -5
+            return
+         endif
+
+C     initialize the histogram image pixels = 0, including null value
+         do 10 ii = 1, xsize * ysize + 1
+            histogram(ii) = 0
+ 10     continue
+
+      endif
+
+C     ------------------------------------------------------------------
+C       Main loop: increment the 2D histogram at position of each event 
+C     ------------------------------------------------------------------
+
+      do 20 ii=2,nrows+1
+        xbin = xcol(ii) / xbinsize
+        ybin = ycol(ii) / ybinsize
+
+        ihisto = ( ybin * xsize ) + xbin + 2
+        histogram(ihisto) = histogram(ihisto) + 1
+ 20   continue
+
+      return
+      end
+